diff options
| author | Tom Tromey | 2013-07-12 18:44:13 -0600 |
|---|---|---|
| committer | Tom Tromey | 2013-07-12 18:44:13 -0600 |
| commit | b34a529f177a6ea32da5cb1254f91bf9d71838db (patch) | |
| tree | 477131abc15d3107b30b635223d87a22550b480b /lisp | |
| parent | e6f63071a3f7721f55220514b6d9a8ee8c1232d8 (diff) | |
| parent | 5e301d7651c0691bb2bc7f3fbe711fdbe26ac471 (diff) | |
| download | emacs-b34a529f177a6ea32da5cb1254f91bf9d71838db.tar.gz emacs-b34a529f177a6ea32da5cb1254f91bf9d71838db.zip | |
Merge from trunk
Diffstat (limited to 'lisp')
43 files changed, 875 insertions, 601 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2402ea0cd1f..81bcb1d033c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,237 @@ | |||
| 1 | 2013-07-12 Dmitry Gutov <dgutov@yandex.ru> | ||
| 2 | |||
| 3 | * progmodes/ruby-mode.el (ruby-percent-literals-beg-re): | ||
| 4 | (ruby-syntax-expansion-allowed-p): Support array of symbols, for | ||
| 5 | Ruby 2.0. | ||
| 6 | (ruby-font-lock-keywords): Distinguish calls to functions with | ||
| 7 | module-like names from module references. Highlight character | ||
| 8 | literals. | ||
| 9 | |||
| 10 | 2013-07-12 Sergio Durigan Junior <sergiodj@riseup.net> (tiny change) | ||
| 11 | |||
| 12 | * progmodes/gdb-mi.el (gdb-strip-string-backslash): New function. | ||
| 13 | (gdb-send): Handle continued commands. (Bug#14847) | ||
| 14 | |||
| 15 | 2013-07-12 Juanma Barranquero <lekktu@gmail.com> | ||
| 16 | |||
| 17 | * desktop.el (desktop--v2s): Remove unused local variable. | ||
| 18 | (desktop-save-buffer): Make defvar-local; adjust docstring. | ||
| 19 | (desktop-auto-save-timeout, desktop-owner): Use ignore-errors. | ||
| 20 | (desktop-clear, desktop-save-buffer-p): Use string-match-p. | ||
| 21 | |||
| 22 | 2013-07-12 Andreas Schwab <schwab@linux-m68k.org> | ||
| 23 | |||
| 24 | * emacs-lisp/map-ynp.el (map-y-or-n-p): Fix last change. | ||
| 25 | |||
| 26 | 2013-07-12 Eli Zaretskii <eliz@gnu.org> | ||
| 27 | |||
| 28 | * simple.el (next-line, previous-line): Document TRY-VSCROLL and ARG. | ||
| 29 | (Bug#14842) | ||
| 30 | |||
| 31 | 2013-07-12 Glenn Morris <rgm@gnu.org> | ||
| 32 | |||
| 33 | * doc-view.el: Require cl-lib at runtime too. | ||
| 34 | (doc-view-remove-if): Remove. | ||
| 35 | (doc-view-search-next-match, doc-view-search-previous-match): | ||
| 36 | Use cl-remove-if. | ||
| 37 | |||
| 38 | * edmacro.el: Require cl-lib at runtime too. | ||
| 39 | (edmacro-format-keys, edmacro-parse-keys): Use cl-mismatch, cl-subseq. | ||
| 40 | (edmacro-mismatch, edmacro-subseq): Remove. | ||
| 41 | |||
| 42 | * shadowfile.el: Require cl-lib. | ||
| 43 | (shadow-remove-if): Remove. | ||
| 44 | (shadow-set-cluster, shadow-shadows-of-1, shadow-remove-from-todo): | ||
| 45 | Use cl-remove-if. | ||
| 46 | |||
| 47 | * wid-edit.el: Require cl-lib. | ||
| 48 | (widget-choose): Use cl-remove-if. | ||
| 49 | (widget-remove-if): Remove. | ||
| 50 | |||
| 51 | * progmodes/ebrowse.el: Require cl-lib at runtime too. | ||
| 52 | (ebrowse-delete-if-not): Remove. | ||
| 53 | (ebrowse-browser-buffer-list, ebrowse-member-buffer-list) | ||
| 54 | (ebrowse-tree-buffer-list, ebrowse-same-tree-member-buffer-list): | ||
| 55 | Use cl-delete-if-not. | ||
| 56 | |||
| 57 | 2013-07-12 Juanma Barranquero <lekktu@gmail.com> | ||
| 58 | |||
| 59 | * emacs-lisp/cl-macs.el (cl-multiple-value-bind, cl-multiple-value-setq) | ||
| 60 | (cl-the, cl-declare, cl-defstruct): Fix typos in docstrings. | ||
| 61 | |||
| 62 | 2013-07-12 Leo Liu <sdl.web@gmail.com> | ||
| 63 | |||
| 64 | * ido.el (dired-do-copy, dired): Set 'ido property. (Bug#11954) | ||
| 65 | |||
| 66 | 2013-07-11 Glenn Morris <rgm@gnu.org> | ||
| 67 | |||
| 68 | * emacs-lisp/edebug.el: Require cl-lib at run-time too. | ||
| 69 | (edebug-gensym-index, edebug-gensym): | ||
| 70 | Remove reimplementation of cl-gensym. | ||
| 71 | (edebug-make-enter-wrapper, edebug-make-form-wrapper): Use cl-gensym. | ||
| 72 | |||
| 73 | * thumbs.el: Require cl-lib at run-time too. | ||
| 74 | (thumbs-gensym-counter, thumbs-gensym): | ||
| 75 | Remove reimplementation of cl-gensym. | ||
| 76 | (thumbs-temp-file): Use cl-gensym. | ||
| 77 | |||
| 78 | * emacs-lisp/ert.el: Require cl-lib at runtime too. | ||
| 79 | (ert--cl-do-remf, ert--remprop, ert--remove-if-not) | ||
| 80 | (ert--intersection, ert--set-difference, ert--set-difference-eq) | ||
| 81 | (ert--union, ert--gensym-counter, ert--gensym-counter) | ||
| 82 | (ert--coerce-to-vector, ert--remove*, ert--string-position) | ||
| 83 | (ert--mismatch, ert--subseq): Remove reimplementations of cl funcs. | ||
| 84 | (ert-make-test-unbound, ert--expand-should-1) | ||
| 85 | (ert--expand-should, ert--should-error-handle-error) | ||
| 86 | (should-error, ert--explain-equal-rec) | ||
| 87 | (ert--plist-difference-explanation, ert-select-tests) | ||
| 88 | (ert--make-stats, ert--remove-from-list, ert--string-first-line): | ||
| 89 | Use cl-lib functions rather than reimplementations. | ||
| 90 | |||
| 91 | 2013-07-11 Michael Albinus <michael.albinus@gmx.de> | ||
| 92 | |||
| 93 | * net/tramp.el (tramp-methods): Extend docstring. | ||
| 94 | (tramp-connection-timeout): New defcustom. | ||
| 95 | (tramp-error-with-buffer): Reset timestamp only when appropriate. | ||
| 96 | (with-tramp-progress-reporter): Simplify. | ||
| 97 | (tramp-process-actions): Improve messages. | ||
| 98 | |||
| 99 | * net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection): | ||
| 100 | * net/tramp-sh.el (tramp-maybe-open-connection): | ||
| 101 | Use `tramp-connection-timeout'. | ||
| 102 | (tramp-methods) [su, sudo, ksu]: Add method specific timeouts. | ||
| 103 | (Bug#14808) | ||
| 104 | |||
| 105 | 2013-07-11 Leo Liu <sdl.web@gmail.com> | ||
| 106 | |||
| 107 | * ido.el (ido-read-file-name): Conform to the requirements of | ||
| 108 | read-file-name. (Bug#11861) | ||
| 109 | (ido-read-directory-name): Conform to the requirements of | ||
| 110 | read-directory-name. | ||
| 111 | |||
| 112 | 2013-07-11 Juanma Barranquero <lekktu@gmail.com> | ||
| 113 | |||
| 114 | * subr.el (delay-warning): New function. | ||
| 115 | |||
| 116 | 2013-07-10 Eli Zaretskii <eliz@gnu.org> | ||
| 117 | |||
| 118 | * simple.el (default-line-height): New function. | ||
| 119 | (line-move-partial, line-move): Use it instead of computing the | ||
| 120 | line height inline. | ||
| 121 | (line-move-partial): Always compute ROWH. If the last line is | ||
| 122 | partially-visible, but its text is completely visible, allow | ||
| 123 | cursor to enter such a partially-visible line. | ||
| 124 | |||
| 125 | 2013-07-10 Michael Albinus <michael.albinus@gmx.de> | ||
| 126 | |||
| 127 | Improve error messages. (Bug#14808) | ||
| 128 | |||
| 129 | * net/tramp.el (tramp-current-connection): New defvar, moved from | ||
| 130 | tramp-sh.el. | ||
| 131 | (tramp-message-show-progress-reporter-message): Removed, not | ||
| 132 | needed anymore. | ||
| 133 | (tramp-error-with-buffer): Show message in minibuffer. Discard | ||
| 134 | input before waiting. Reset connection timestamp. | ||
| 135 | (with-tramp-progress-reporter): Improve messages. | ||
| 136 | (tramp-process-actions): Use progress reporter. Delete process in | ||
| 137 | case of error. Improve messages. | ||
| 138 | |||
| 139 | * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use | ||
| 140 | condition-case. Call `tramp-error-with-buffer' with vector and buffer. | ||
| 141 | (tramp-current-connection): Removed. | ||
| 142 | (tramp-maybe-open-connection): The car of | ||
| 143 | `tramp-current-connection' are the first 3 slots of the vector. | ||
| 144 | |||
| 145 | 2013-07-10 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 146 | |||
| 147 | * progmodes/cfengine.el (cfengine3-indent-line): Do not indent | ||
| 148 | inside continued strings. | ||
| 149 | |||
| 150 | 2013-07-10 Paul Eggert <eggert@cs.ucla.edu> | ||
| 151 | |||
| 152 | Timestamp fixes for undo (Bug#14824). | ||
| 153 | * files.el (clear-visited-file-modtime): Move here from fileio.c. | ||
| 154 | |||
| 155 | 2013-07-10 Leo Liu <sdl.web@gmail.com> | ||
| 156 | |||
| 157 | * files.el (require-final-newline): Allow safe local value. | ||
| 158 | (Bug#14834) | ||
| 159 | |||
| 160 | 2013-07-09 Leo Liu <sdl.web@gmail.com> | ||
| 161 | |||
| 162 | * ido.el (ido-read-directory-name): Handle fallback. | ||
| 163 | (ido-read-file-name): Update DIR to ido-current-directory. | ||
| 164 | (Bug#1516) | ||
| 165 | (ido-add-virtual-buffers-to-list): Robustify. (Bug#14552) | ||
| 166 | |||
| 167 | 2013-07-09 Dmitry Gutov <dgutov@yandex.ru> | ||
| 168 | |||
| 169 | * progmodes/ruby-mode.el (ruby-font-lock-keywords): Remove extra | ||
| 170 | "autoload". Remove "warn lower camel case" section, previously | ||
| 171 | commented out. Highlight negation char. Do not highlight the | ||
| 172 | target in singleton method definitions. | ||
| 173 | |||
| 174 | 2013-07-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 175 | |||
| 176 | * faces.el (tty-setup-hook): Declare the hook. | ||
| 177 | |||
| 178 | * emacs-lisp/pcase.el (pcase--split-pred): Add `vars' argument to try | ||
| 179 | and detect when a guard/pred depends on local vars (bug#14773). | ||
| 180 | (pcase--u1): Adjust caller. | ||
| 181 | |||
| 182 | 2013-07-08 Eli Zaretskii <eliz@gnu.org> | ||
| 183 | |||
| 184 | * simple.el (line-move-partial, line-move): Account for | ||
| 185 | line-spacing. | ||
| 186 | (line-move-partial): Avoid setting vscroll when the last | ||
| 187 | partially-visible line in window is of default height. | ||
| 188 | |||
| 189 | 2013-07-08 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 190 | |||
| 191 | * net/shr.el (shr-map): Reinstate the `u' key binding, since it's | ||
| 192 | been used a while. | ||
| 193 | |||
| 194 | 2013-07-07 Juanma Barranquero <lekktu@gmail.com> | ||
| 195 | |||
| 196 | * subr.el (read-quoted-char): Remove unused local variable `char'. | ||
| 197 | |||
| 198 | 2013-07-07 Michael Kifer <kifer@cs.stonybrook.edu> | ||
| 199 | |||
| 200 | * ediff.el (ediff-version): Version update. | ||
| 201 | (ediff-files-command, ediff3-files-command, ediff-merge-command) | ||
| 202 | (ediff-merge-with-ancestor-command, ediff-directories-command) | ||
| 203 | (ediff-directories3-command, ediff-merge-directories-command) | ||
| 204 | (ediff-merge-directories-with-ancestor-command): New functions. | ||
| 205 | All are command-line interfaces to ediff: to facilitate calling | ||
| 206 | Emacs with the appropriate ediff functions invoked. | ||
| 207 | |||
| 208 | * viper-cmd.el (viper-del-forward-char-in-insert): New function. | ||
| 209 | (viper-save-kill-buffer): Check if buffer is modified. | ||
| 210 | |||
| 211 | * viper.el (viper-version): Version update. | ||
| 212 | (viper-emacs-state-mode-list): Add egg-status-buffer-mode. | ||
| 213 | |||
| 214 | 2013-07-07 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 215 | |||
| 216 | * faces.el (tty-run-terminal-initialization): Run new tty-setup-hook. | ||
| 217 | * viper-cmd.el (viper-envelop-ESC-key): Remove function. | ||
| 218 | (viper-intercept-ESC-key): Simplify. | ||
| 219 | * viper-keym.el (viper-ESC-key): Make it a constant, don't use kbd. | ||
| 220 | * viper.el (viper--tty-ESC-filter, viper--lookup-key) | ||
| 221 | (viper-catch-tty-ESC, viper-uncatch-tty-ESC) | ||
| 222 | (viper-setup-ESC-to-escape): New functions. | ||
| 223 | (viper-go-away, viper-set-hooks): Call viper-setup-ESC-to-escape. | ||
| 224 | (viper-set-hooks): Do not modify flyspell-mode-hook. (Bug#13793) | ||
| 225 | |||
| 226 | 2013-07-07 Eli Zaretskii <eliz@gnu.org> | ||
| 227 | |||
| 228 | * simple.el (default-font-height, window-screen-lines): | ||
| 229 | New functions. | ||
| 230 | (line-move, line-move-partial): Use them instead of | ||
| 231 | frame-char-height and window-text-height. This makes scrolling | ||
| 232 | text smoother when the buffer's default face uses a font that is | ||
| 233 | different from the frame's default font. | ||
| 234 | |||
| 1 | 2013-07-06 Jan Djärv <jan.h.d@swipnet.se> | 235 | 2013-07-06 Jan Djärv <jan.h.d@swipnet.se> |
| 2 | 236 | ||
| 3 | * files.el (write-file): Do not display confirm dialog for NS, | 237 | * files.el (write-file): Do not display confirm dialog for NS, |
| @@ -532,7 +766,7 @@ | |||
| 532 | * emacs-lock.el (emacs-lock-mode, emacs-lock--old-mode) | 766 | * emacs-lock.el (emacs-lock-mode, emacs-lock--old-mode) |
| 533 | (emacs-lock--try-unlocking): Make defvar-local. | 767 | (emacs-lock--try-unlocking): Make defvar-local. |
| 534 | 768 | ||
| 535 | 2013-06-22 Glenn Morris <rgm@fencepost.gnu.org> | 769 | 2013-06-22 Glenn Morris <rgm@gnu.org> |
| 536 | 770 | ||
| 537 | * play/cookie1.el (cookie-apropos): Minor simplification. | 771 | * play/cookie1.el (cookie-apropos): Minor simplification. |
| 538 | 772 | ||
| @@ -998,7 +1232,7 @@ | |||
| 998 | 1232 | ||
| 999 | * net/shr.el (shr-map): Bind [down-mouse-1] to browse URLs. | 1233 | * net/shr.el (shr-map): Bind [down-mouse-1] to browse URLs. |
| 1000 | 1234 | ||
| 1001 | 2013-06-19 Glenn Morris <rgm@fencepost.gnu.org> | 1235 | 2013-06-19 Glenn Morris <rgm@gnu.org> |
| 1002 | 1236 | ||
| 1003 | * emacs-lisp/eieio.el (defclass): Make it eval-and-compile once more. | 1237 | * emacs-lisp/eieio.el (defclass): Make it eval-and-compile once more. |
| 1004 | 1238 | ||
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 7a2c5755cc0..705277c97a0 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog | |||
| @@ -2,7 +2,7 @@ | |||
| 2 | 2 | ||
| 3 | * data-debug.el, cedet-idutils.el: Neuter the "Version:" header. | 3 | * data-debug.el, cedet-idutils.el: Neuter the "Version:" header. |
| 4 | 4 | ||
| 5 | 2013-06-19 Glenn Morris <rgm@fencepost.gnu.org> | 5 | 2013-06-19 Glenn Morris <rgm@gnu.org> |
| 6 | 6 | ||
| 7 | * semantic/idle.el (define-semantic-idle-service): | 7 | * semantic/idle.el (define-semantic-idle-service): |
| 8 | No need to use eval-and-compile, progn will do. | 8 | No need to use eval-and-compile, progn will do. |
diff --git a/lisp/desktop.el b/lisp/desktop.el index 2f4c2a8589c..322b95715a2 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el | |||
| @@ -196,9 +196,7 @@ Zero or nil means disable timer-based auto-saving." | |||
| 196 | (integer :tag "Seconds")) | 196 | (integer :tag "Seconds")) |
| 197 | :set (lambda (symbol value) | 197 | :set (lambda (symbol value) |
| 198 | (set-default symbol value) | 198 | (set-default symbol value) |
| 199 | (condition-case nil | 199 | (ignore-errors (desktop-auto-save-set-timer))) |
| 200 | (desktop-auto-save-set-timer) | ||
| 201 | (error nil))) | ||
| 202 | :group 'desktop | 200 | :group 'desktop |
| 203 | :version "24.4") | 201 | :version "24.4") |
| 204 | 202 | ||
| @@ -416,9 +414,8 @@ See `desktop-restore-eager'." | |||
| 416 | :version "22.1") | 414 | :version "22.1") |
| 417 | 415 | ||
| 418 | ;;;###autoload | 416 | ;;;###autoload |
| 419 | (defvar desktop-save-buffer nil | 417 | (defvar-local desktop-save-buffer nil |
| 420 | "When non-nil, save buffer status in desktop file. | 418 | "When non-nil, save buffer status in desktop file. |
| 421 | This variable becomes buffer local when set. | ||
| 422 | 419 | ||
| 423 | If the value is a function, it is called by `desktop-save' with argument | 420 | If the value is a function, it is called by `desktop-save' with argument |
| 424 | DESKTOP-DIRNAME to obtain auxiliary information to save in the desktop | 421 | DESKTOP-DIRNAME to obtain auxiliary information to save in the desktop |
| @@ -430,7 +427,6 @@ When file names are returned, they should be formatted using the call | |||
| 430 | Later, when `desktop-read' evaluates the desktop file, auxiliary information | 427 | Later, when `desktop-read' evaluates the desktop file, auxiliary information |
| 431 | is passed as the argument DESKTOP-BUFFER-MISC to functions in | 428 | is passed as the argument DESKTOP-BUFFER-MISC to functions in |
| 432 | `desktop-buffer-mode-handlers'.") | 429 | `desktop-buffer-mode-handlers'.") |
| 433 | (make-variable-buffer-local 'desktop-save-buffer) | ||
| 434 | (make-obsolete-variable 'desktop-buffer-modes-to-save | 430 | (make-obsolete-variable 'desktop-buffer-modes-to-save |
| 435 | 'desktop-save-buffer "22.1") | 431 | 'desktop-save-buffer "22.1") |
| 436 | (make-obsolete-variable 'desktop-buffer-misc-functions | 432 | (make-obsolete-variable 'desktop-buffer-misc-functions |
| @@ -582,15 +578,15 @@ Used to detect desktop file conflicts.") | |||
| 582 | "Return the PID of the Emacs process that owns the desktop file in DIRNAME. | 578 | "Return the PID of the Emacs process that owns the desktop file in DIRNAME. |
| 583 | Return nil if no desktop file found or no Emacs process is using it. | 579 | Return nil if no desktop file found or no Emacs process is using it. |
| 584 | DIRNAME omitted or nil means use `desktop-dirname'." | 580 | DIRNAME omitted or nil means use `desktop-dirname'." |
| 585 | (let (owner) | 581 | (let (owner |
| 586 | (and (file-exists-p (desktop-full-lock-name dirname)) | 582 | (file (desktop-full-lock-name dirname))) |
| 587 | (condition-case nil | 583 | (and (file-exists-p file) |
| 588 | (with-temp-buffer | 584 | (ignore-errors |
| 589 | (insert-file-contents-literally (desktop-full-lock-name dirname)) | 585 | (with-temp-buffer |
| 590 | (goto-char (point-min)) | 586 | (insert-file-contents-literally file) |
| 591 | (setq owner (read (current-buffer))) | 587 | (goto-char (point-min)) |
| 592 | (integerp owner)) | 588 | (setq owner (read (current-buffer))) |
| 593 | (error nil)) | 589 | (integerp owner))) |
| 594 | owner))) | 590 | owner))) |
| 595 | 591 | ||
| 596 | (defun desktop-claim-lock (&optional dirname) | 592 | (defun desktop-claim-lock (&optional dirname) |
| @@ -636,7 +632,7 @@ Furthermore, it clears the variables listed in `desktop-globals-to-clear'." | |||
| 636 | (let ((bufname (buffer-name (car buffers)))) | 632 | (let ((bufname (buffer-name (car buffers)))) |
| 637 | (or | 633 | (or |
| 638 | (null bufname) | 634 | (null bufname) |
| 639 | (string-match preserve-regexp bufname) | 635 | (string-match-p preserve-regexp bufname) |
| 640 | ;; Don't kill buffers made for internal purposes. | 636 | ;; Don't kill buffers made for internal purposes. |
| 641 | (and (not (equal bufname "")) (eq (aref bufname 0) ?\s)) | 637 | (and (not (equal bufname "")) (eq (aref bufname 0) ?\s)) |
| 642 | (kill-buffer (car buffers)))) | 638 | (kill-buffer (car buffers)))) |
| @@ -758,8 +754,7 @@ QUOTE may be `may' (value may be quoted), | |||
| 758 | ((consp value) | 754 | ((consp value) |
| 759 | (let ((p value) | 755 | (let ((p value) |
| 760 | newlist | 756 | newlist |
| 761 | use-list* | 757 | use-list*) |
| 762 | anynil) | ||
| 763 | (while (consp p) | 758 | (while (consp p) |
| 764 | (let ((q.sexp (desktop--v2s (car p)))) | 759 | (let ((q.sexp (desktop--v2s (car p)))) |
| 765 | (push q.sexp newlist)) | 760 | (push q.sexp newlist)) |
| @@ -841,17 +836,17 @@ MODE is the major mode. | |||
| 841 | dired-skip) | 836 | dired-skip) |
| 842 | (and (not (and (stringp desktop-buffers-not-to-save) | 837 | (and (not (and (stringp desktop-buffers-not-to-save) |
| 843 | (not filename) | 838 | (not filename) |
| 844 | (string-match desktop-buffers-not-to-save bufname))) | 839 | (string-match-p desktop-buffers-not-to-save bufname))) |
| 845 | (not (memq mode desktop-modes-not-to-save)) | 840 | (not (memq mode desktop-modes-not-to-save)) |
| 846 | ;; FIXME this is broken if desktop-files-not-to-save is nil. | 841 | ;; FIXME this is broken if desktop-files-not-to-save is nil. |
| 847 | (or (and filename | 842 | (or (and filename |
| 848 | (stringp desktop-files-not-to-save) | 843 | (stringp desktop-files-not-to-save) |
| 849 | (not (string-match desktop-files-not-to-save filename))) | 844 | (not (string-match-p desktop-files-not-to-save filename))) |
| 850 | (and (memq mode '(dired-mode vc-dir-mode)) | 845 | (and (memq mode '(dired-mode vc-dir-mode)) |
| 851 | (with-current-buffer bufname | 846 | (with-current-buffer bufname |
| 852 | (not (setq dired-skip | 847 | (not (setq dired-skip |
| 853 | (string-match desktop-files-not-to-save | 848 | (string-match-p desktop-files-not-to-save |
| 854 | default-directory))))) | 849 | default-directory))))) |
| 855 | (and (null filename) | 850 | (and (null filename) |
| 856 | (null dired-skip) ; bug#5755 | 851 | (null dired-skip) ; bug#5755 |
| 857 | (with-current-buffer bufname desktop-save-buffer)))))) | 852 | (with-current-buffer bufname desktop-save-buffer)))))) |
diff --git a/lisp/doc-view.el b/lisp/doc-view.el index e4434c3a0d8..10968f7f8dd 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el | |||
| @@ -136,7 +136,7 @@ | |||
| 136 | 136 | ||
| 137 | ;;; Code: | 137 | ;;; Code: |
| 138 | 138 | ||
| 139 | (eval-when-compile (require 'cl-lib)) | 139 | (require 'cl-lib) |
| 140 | (require 'dired) | 140 | (require 'dired) |
| 141 | (require 'image-mode) | 141 | (require 'image-mode) |
| 142 | (require 'jka-compr) | 142 | (require 'jka-compr) |
| @@ -698,14 +698,6 @@ It's a subdirectory of `doc-view-cache-directory'." | |||
| 698 | (md5 (current-buffer))))) | 698 | (md5 (current-buffer))))) |
| 699 | doc-view-cache-directory))))) | 699 | doc-view-cache-directory))))) |
| 700 | 700 | ||
| 701 | (defun doc-view-remove-if (predicate list) | ||
| 702 | "Return LIST with all items removed that satisfy PREDICATE." | ||
| 703 | (let (new-list) | ||
| 704 | (dolist (item list) | ||
| 705 | (when (not (funcall predicate item)) | ||
| 706 | (setq new-list (cons item new-list)))) | ||
| 707 | (nreverse new-list))) | ||
| 708 | |||
| 709 | ;;;###autoload | 701 | ;;;###autoload |
| 710 | (defun doc-view-mode-p (type) | 702 | (defun doc-view-mode-p (type) |
| 711 | "Return non-nil if document type TYPE is available for `doc-view'. | 703 | "Return non-nil if document type TYPE is available for `doc-view'. |
| @@ -1488,7 +1480,7 @@ If BACKWARD is non-nil, jump to the previous match." | |||
| 1488 | (defun doc-view-search-next-match (arg) | 1480 | (defun doc-view-search-next-match (arg) |
| 1489 | "Go to the ARGth next matching page." | 1481 | "Go to the ARGth next matching page." |
| 1490 | (interactive "p") | 1482 | (interactive "p") |
| 1491 | (let* ((next-pages (doc-view-remove-if | 1483 | (let* ((next-pages (cl-remove-if |
| 1492 | (lambda (i) (<= (car i) (doc-view-current-page))) | 1484 | (lambda (i) (<= (car i) (doc-view-current-page))) |
| 1493 | doc-view--current-search-matches)) | 1485 | doc-view--current-search-matches)) |
| 1494 | (page (car (nth (1- arg) next-pages)))) | 1486 | (page (car (nth (1- arg) next-pages)))) |
| @@ -1502,7 +1494,7 @@ If BACKWARD is non-nil, jump to the previous match." | |||
| 1502 | (defun doc-view-search-previous-match (arg) | 1494 | (defun doc-view-search-previous-match (arg) |
| 1503 | "Go to the ARGth previous matching page." | 1495 | "Go to the ARGth previous matching page." |
| 1504 | (interactive "p") | 1496 | (interactive "p") |
| 1505 | (let* ((prev-pages (doc-view-remove-if | 1497 | (let* ((prev-pages (cl-remove-if |
| 1506 | (lambda (i) (>= (car i) (doc-view-current-page))) | 1498 | (lambda (i) (>= (car i) (doc-view-current-page))) |
| 1507 | doc-view--current-search-matches)) | 1499 | doc-view--current-search-matches)) |
| 1508 | (page (car (nth (1- arg) (nreverse prev-pages))))) | 1500 | (page (car (nth (1- arg) (nreverse prev-pages))))) |
diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 6ef2e29dc83..67992d16527 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el | |||
| @@ -62,9 +62,8 @@ | |||
| 62 | ;; macro in a more concise way that omits the comments. | 62 | ;; macro in a more concise way that omits the comments. |
| 63 | 63 | ||
| 64 | ;;; Code: | 64 | ;;; Code: |
| 65 | |||
| 66 | (eval-when-compile (require 'cl-lib)) | ||
| 67 | 65 | ||
| 66 | (require 'cl-lib) | ||
| 68 | (require 'kmacro) | 67 | (require 'kmacro) |
| 69 | 68 | ||
| 70 | ;;; The user-level commands for editing macros. | 69 | ;;; The user-level commands for editing macros. |
| @@ -444,14 +443,14 @@ doubt, use whitespace." | |||
| 444 | (let* ((prefix | 443 | (let* ((prefix |
| 445 | (or (and (integerp (aref rest-mac 0)) | 444 | (or (and (integerp (aref rest-mac 0)) |
| 446 | (memq (aref rest-mac 0) mdigs) | 445 | (memq (aref rest-mac 0) mdigs) |
| 447 | (memq (key-binding (edmacro-subseq rest-mac 0 1)) | 446 | (memq (key-binding (cl-subseq rest-mac 0 1)) |
| 448 | '(digit-argument negative-argument)) | 447 | '(digit-argument negative-argument)) |
| 449 | (let ((i 1)) | 448 | (let ((i 1)) |
| 450 | (while (memq (aref rest-mac i) (cdr mdigs)) | 449 | (while (memq (aref rest-mac i) (cdr mdigs)) |
| 451 | (cl-incf i)) | 450 | (cl-incf i)) |
| 452 | (and (not (memq (aref rest-mac i) pkeys)) | 451 | (and (not (memq (aref rest-mac i) pkeys)) |
| 453 | (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ") | 452 | (prog1 (vconcat "M-" (cl-subseq rest-mac 0 i) " ") |
| 454 | (cl-callf edmacro-subseq rest-mac i))))) | 453 | (cl-callf cl-subseq rest-mac i))))) |
| 455 | (and (eq (aref rest-mac 0) ?\C-u) | 454 | (and (eq (aref rest-mac 0) ?\C-u) |
| 456 | (eq (key-binding [?\C-u]) 'universal-argument) | 455 | (eq (key-binding [?\C-u]) 'universal-argument) |
| 457 | (let ((i 1)) | 456 | (let ((i 1)) |
| @@ -459,7 +458,7 @@ doubt, use whitespace." | |||
| 459 | (cl-incf i)) | 458 | (cl-incf i)) |
| 460 | (and (not (memq (aref rest-mac i) pkeys)) | 459 | (and (not (memq (aref rest-mac i) pkeys)) |
| 461 | (prog1 (cl-loop repeat i concat "C-u ") | 460 | (prog1 (cl-loop repeat i concat "C-u ") |
| 462 | (cl-callf edmacro-subseq rest-mac i))))) | 461 | (cl-callf cl-subseq rest-mac i))))) |
| 463 | (and (eq (aref rest-mac 0) ?\C-u) | 462 | (and (eq (aref rest-mac 0) ?\C-u) |
| 464 | (eq (key-binding [?\C-u]) 'universal-argument) | 463 | (eq (key-binding [?\C-u]) 'universal-argument) |
| 465 | (let ((i 1)) | 464 | (let ((i 1)) |
| @@ -469,18 +468,18 @@ doubt, use whitespace." | |||
| 469 | '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) | 468 | '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) |
| 470 | (cl-incf i)) | 469 | (cl-incf i)) |
| 471 | (and (not (memq (aref rest-mac i) pkeys)) | 470 | (and (not (memq (aref rest-mac i) pkeys)) |
| 472 | (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ") | 471 | (prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ") |
| 473 | (cl-callf edmacro-subseq rest-mac i))))))) | 472 | (cl-callf cl-subseq rest-mac i))))))) |
| 474 | (bind-len (apply 'max 1 | 473 | (bind-len (apply 'max 1 |
| 475 | (cl-loop for map in maps | 474 | (cl-loop for map in maps |
| 476 | for b = (lookup-key map rest-mac) | 475 | for b = (lookup-key map rest-mac) |
| 477 | when b collect b))) | 476 | when b collect b))) |
| 478 | (key (edmacro-subseq rest-mac 0 bind-len)) | 477 | (key (cl-subseq rest-mac 0 bind-len)) |
| 479 | (fkey nil) tlen tkey | 478 | (fkey nil) tlen tkey |
| 480 | (bind (or (cl-loop for map in maps for b = (lookup-key map key) | 479 | (bind (or (cl-loop for map in maps for b = (lookup-key map key) |
| 481 | thereis (and (not (integerp b)) b)) | 480 | thereis (and (not (integerp b)) b)) |
| 482 | (and (setq fkey (lookup-key local-function-key-map rest-mac)) | 481 | (and (setq fkey (lookup-key local-function-key-map rest-mac)) |
| 483 | (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen) | 482 | (setq tlen fkey tkey (cl-subseq rest-mac 0 tlen) |
| 484 | fkey (lookup-key local-function-key-map tkey)) | 483 | fkey (lookup-key local-function-key-map tkey)) |
| 485 | (cl-loop for map in maps | 484 | (cl-loop for map in maps |
| 486 | for b = (lookup-key map fkey) | 485 | for b = (lookup-key map fkey) |
| @@ -507,7 +506,7 @@ doubt, use whitespace." | |||
| 507 | (> first 32) (<= first maxkey) (/= first 92) | 506 | (> first 32) (<= first maxkey) (/= first 92) |
| 508 | (progn | 507 | (progn |
| 509 | (if (> text 30) (setq text 30)) | 508 | (if (> text 30) (setq text 30)) |
| 510 | (setq desc (concat (edmacro-subseq rest-mac 0 text))) | 509 | (setq desc (concat (cl-subseq rest-mac 0 text))) |
| 511 | (when (string-match "^[ACHMsS]-." desc) | 510 | (when (string-match "^[ACHMsS]-." desc) |
| 512 | (setq text 2) | 511 | (setq text 2) |
| 513 | (cl-callf substring desc 0 2)) | 512 | (cl-callf substring desc 0 2)) |
| @@ -524,7 +523,7 @@ doubt, use whitespace." | |||
| 524 | (> text bind-len) | 523 | (> text bind-len) |
| 525 | (memq (aref rest-mac text) '(return 13)) | 524 | (memq (aref rest-mac text) '(return 13)) |
| 526 | (progn | 525 | (progn |
| 527 | (setq desc (concat (edmacro-subseq rest-mac bind-len text))) | 526 | (setq desc (concat (cl-subseq rest-mac bind-len text))) |
| 528 | (commandp (intern-soft desc)))) | 527 | (commandp (intern-soft desc)))) |
| 529 | (if (commandp (intern-soft desc)) (setq bind desc)) | 528 | (if (commandp (intern-soft desc)) (setq bind desc)) |
| 530 | (setq desc (format "<<%s>>" desc)) | 529 | (setq desc (format "<<%s>>" desc)) |
| @@ -562,14 +561,14 @@ doubt, use whitespace." | |||
| 562 | (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) | 561 | (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) |
| 563 | (unless (string-match " " desc) | 562 | (unless (string-match " " desc) |
| 564 | (let ((times 1) (pos bind-len)) | 563 | (let ((times 1) (pos bind-len)) |
| 565 | (while (not (edmacro-mismatch rest-mac rest-mac | 564 | (while (not (cl-mismatch rest-mac rest-mac |
| 566 | 0 bind-len pos (+ bind-len pos))) | 565 | 0 bind-len pos (+ bind-len pos))) |
| 567 | (cl-incf times) | 566 | (cl-incf times) |
| 568 | (cl-incf pos bind-len)) | 567 | (cl-incf pos bind-len)) |
| 569 | (when (> times 1) | 568 | (when (> times 1) |
| 570 | (setq desc (format "%d*%s" times desc)) | 569 | (setq desc (format "%d*%s" times desc)) |
| 571 | (setq bind-len (* bind-len times))))) | 570 | (setq bind-len (* bind-len times))))) |
| 572 | (setq rest-mac (edmacro-subseq rest-mac bind-len)) | 571 | (setq rest-mac (cl-subseq rest-mac bind-len)) |
| 573 | (if verbose | 572 | (if verbose |
| 574 | (progn | 573 | (progn |
| 575 | (unless (equal res "") (cl-callf concat res "\n")) | 574 | (unless (equal res "") (cl-callf concat res "\n")) |
| @@ -590,50 +589,6 @@ doubt, use whitespace." | |||
| 590 | (cl-incf len (length desc))))) | 589 | (cl-incf len (length desc))))) |
| 591 | res)) | 590 | res)) |
| 592 | 591 | ||
| 593 | (defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2) | ||
| 594 | "Compare SEQ1 with SEQ2, return index of first mismatching element. | ||
| 595 | Return nil if the sequences match. If one sequence is a prefix of the | ||
| 596 | other, the return value indicates the end of the shorted sequence. | ||
| 597 | \n(fn SEQ1 SEQ2 START1 END1 START2 END2)" | ||
| 598 | (or cl-end1 (setq cl-end1 (length cl-seq1))) | ||
| 599 | (or cl-end2 (setq cl-end2 (length cl-seq2))) | ||
| 600 | (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1))) | ||
| 601 | (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2)))) | ||
| 602 | (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) | ||
| 603 | (eql (if cl-p1 (car cl-p1) | ||
| 604 | (aref cl-seq1 cl-start1)) | ||
| 605 | (if cl-p2 (car cl-p2) | ||
| 606 | (aref cl-seq2 cl-start2)))) | ||
| 607 | (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2) | ||
| 608 | cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2))) | ||
| 609 | (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) | ||
| 610 | cl-start1))) | ||
| 611 | |||
| 612 | (defun edmacro-subseq (seq start &optional end) | ||
| 613 | "Return the subsequence of SEQ from START to END. | ||
| 614 | If END is omitted, it defaults to the length of the sequence. | ||
| 615 | If START or END is negative, it counts from the end." | ||
| 616 | (if (stringp seq) (substring seq start end) | ||
| 617 | (let (len) | ||
| 618 | (and end (< end 0) (setq end (+ end (setq len (length seq))))) | ||
| 619 | (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) | ||
| 620 | (cond ((listp seq) | ||
| 621 | (if (> start 0) (setq seq (nthcdr start seq))) | ||
| 622 | (if end | ||
| 623 | (let ((res nil)) | ||
| 624 | (while (>= (setq end (1- end)) start) | ||
| 625 | (push (pop seq) res)) | ||
| 626 | (nreverse res)) | ||
| 627 | (copy-sequence seq))) | ||
| 628 | (t | ||
| 629 | (or end (setq end (or len (length seq)))) | ||
| 630 | (let ((res (make-vector (max (- end start) 0) nil)) | ||
| 631 | (i 0)) | ||
| 632 | (while (< start end) | ||
| 633 | (aset res i (aref seq start)) | ||
| 634 | (setq i (1+ i) start (1+ start))) | ||
| 635 | res)))))) | ||
| 636 | |||
| 637 | (defun edmacro-sanitize-for-string (seq) | 592 | (defun edmacro-sanitize-for-string (seq) |
| 638 | "Convert a key sequence vector SEQ into a string. | 593 | "Convert a key sequence vector SEQ into a string. |
| 639 | The string represents the same events; Meta is indicated by bit 7. | 594 | The string represents the same events; Meta is indicated by bit 7. |
| @@ -760,7 +715,7 @@ This function assumes that the events can be stored in a string." | |||
| 760 | (eq (aref res 1) ?\() | 715 | (eq (aref res 1) ?\() |
| 761 | (eq (aref res (- (length res) 2)) ?\C-x) | 716 | (eq (aref res (- (length res) 2)) ?\C-x) |
| 762 | (eq (aref res (- (length res) 1)) ?\))) | 717 | (eq (aref res (- (length res) 1)) ?\))) |
| 763 | (setq res (edmacro-subseq res 2 -2))) | 718 | (setq res (cl-subseq res 2 -2))) |
| 764 | (if (and (not need-vector) | 719 | (if (and (not need-vector) |
| 765 | (cl-loop for ch across res | 720 | (cl-loop for ch across res |
| 766 | always (and (characterp ch) | 721 | always (and (characterp ch) |
diff --git a/lisp/emacs-lisp/.gitignore b/lisp/emacs-lisp/.gitignore deleted file mode 100644 index 133e79e817a..00000000000 --- a/lisp/emacs-lisp/.gitignore +++ /dev/null | |||
| @@ -1,2 +0,0 @@ | |||
| 1 | !*-loaddefs.el | ||
| 2 | |||
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 3cf744f1245..c47c9b61030 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -1957,7 +1957,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). | |||
| 1957 | "Collect multiple return values. | 1957 | "Collect multiple return values. |
| 1958 | FORM must return a list; the BODY is then executed with the first N elements | 1958 | FORM must return a list; the BODY is then executed with the first N elements |
| 1959 | of this list bound (`let'-style) to each of the symbols SYM in turn. This | 1959 | of this list bound (`let'-style) to each of the symbols SYM in turn. This |
| 1960 | is analogous to the Common Lisp `cl-multiple-value-bind' macro, using lists to | 1960 | is analogous to the Common Lisp `multiple-value-bind' macro, using lists to |
| 1961 | simulate true multiple return values. For compatibility, (cl-values A B C) is | 1961 | simulate true multiple return values. For compatibility, (cl-values A B C) is |
| 1962 | a synonym for (list A B C). | 1962 | a synonym for (list A B C). |
| 1963 | 1963 | ||
| @@ -1975,7 +1975,7 @@ a synonym for (list A B C). | |||
| 1975 | "Collect multiple return values. | 1975 | "Collect multiple return values. |
| 1976 | FORM must return a list; the first N elements of this list are stored in | 1976 | FORM must return a list; the first N elements of this list are stored in |
| 1977 | each of the symbols SYM in turn. This is analogous to the Common Lisp | 1977 | each of the symbols SYM in turn. This is analogous to the Common Lisp |
| 1978 | `cl-multiple-value-setq' macro, using lists to simulate true multiple return | 1978 | `multiple-value-setq' macro, using lists to simulate true multiple return |
| 1979 | values. For compatibility, (cl-values A B C) is a synonym for (list A B C). | 1979 | values. For compatibility, (cl-values A B C) is a synonym for (list A B C). |
| 1980 | 1980 | ||
| 1981 | \(fn (SYM...) FORM)" | 1981 | \(fn (SYM...) FORM)" |
| @@ -2002,7 +2002,7 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). | |||
| 2002 | (cons 'progn body)) | 2002 | (cons 'progn body)) |
| 2003 | ;;;###autoload | 2003 | ;;;###autoload |
| 2004 | (defmacro cl-the (_type form) | 2004 | (defmacro cl-the (_type form) |
| 2005 | "At present this ignores _TYPE and is simply equivalent to FORM." | 2005 | "At present this ignores TYPE and is simply equivalent to FORM." |
| 2006 | (declare (indent 1) (debug (cl-type-spec form))) | 2006 | (declare (indent 1) (debug (cl-type-spec form))) |
| 2007 | form) | 2007 | form) |
| 2008 | 2008 | ||
| @@ -2059,7 +2059,7 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). | |||
| 2059 | "Declare SPECS about the current function while compiling. | 2059 | "Declare SPECS about the current function while compiling. |
| 2060 | For instance | 2060 | For instance |
| 2061 | 2061 | ||
| 2062 | \(cl-declare (warn 0)) | 2062 | (cl-declare (warn 0)) |
| 2063 | 2063 | ||
| 2064 | will turn off byte-compile warnings in the function. | 2064 | will turn off byte-compile warnings in the function. |
| 2065 | See Info node `(cl)Declarations' for details." | 2065 | See Info node `(cl)Declarations' for details." |
| @@ -2279,8 +2279,8 @@ KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, | |||
| 2279 | Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where | 2279 | Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where |
| 2280 | SDEFAULT is the default value of that slot and SOPTIONS are keyword-value | 2280 | SDEFAULT is the default value of that slot and SOPTIONS are keyword-value |
| 2281 | pairs for that slot. | 2281 | pairs for that slot. |
| 2282 | Currently, only one keyword is supported, `:read-only'. If this has a non-nil | 2282 | Currently, only one keyword is supported, `:read-only'. If this has a |
| 2283 | value, that slot cannot be set via `setf'. | 2283 | non-nil value, that slot cannot be set via `setf'. |
| 2284 | 2284 | ||
| 2285 | \(fn NAME SLOTS...)" | 2285 | \(fn NAME SLOTS...)" |
| 2286 | (declare (doc-string 2) (indent 1) | 2286 | (declare (doc-string 2) (indent 1) |
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 319af588eac..36c72f3a3bd 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el | |||
| @@ -53,7 +53,7 @@ | |||
| 53 | ;;; Code: | 53 | ;;; Code: |
| 54 | 54 | ||
| 55 | (require 'macroexp) | 55 | (require 'macroexp) |
| 56 | (eval-when-compile (require 'cl-lib)) | 56 | (require 'cl-lib) |
| 57 | (eval-when-compile (require 'pcase)) | 57 | (eval-when-compile (require 'pcase)) |
| 58 | 58 | ||
| 59 | ;;; Options | 59 | ;;; Options |
| @@ -263,26 +263,6 @@ An extant spec symbol is a symbol that is not a function and has a | |||
| 263 | 263 | ||
| 264 | ;;; Utilities | 264 | ;;; Utilities |
| 265 | 265 | ||
| 266 | ;; Define edebug-gensym - from old cl.el | ||
| 267 | (defvar edebug-gensym-index 0 | ||
| 268 | "Integer used by `edebug-gensym' to produce new names.") | ||
| 269 | |||
| 270 | (defun edebug-gensym (&optional prefix) | ||
| 271 | "Generate a fresh uninterned symbol. | ||
| 272 | There is an optional argument, PREFIX. PREFIX is the string | ||
| 273 | that begins the new name. Most people take just the default, | ||
| 274 | except when debugging needs suggest otherwise." | ||
| 275 | (if (null prefix) | ||
| 276 | (setq prefix "G")) | ||
| 277 | (let ((newsymbol nil) | ||
| 278 | (newname "")) | ||
| 279 | (while (not newsymbol) | ||
| 280 | (setq newname (concat prefix (int-to-string edebug-gensym-index))) | ||
| 281 | (setq edebug-gensym-index (+ edebug-gensym-index 1)) | ||
| 282 | (if (not (intern-soft newname)) | ||
| 283 | (setq newsymbol (make-symbol newname)))) | ||
| 284 | newsymbol)) | ||
| 285 | |||
| 286 | (defun edebug-lambda-list-keywordp (object) | 266 | (defun edebug-lambda-list-keywordp (object) |
| 287 | "Return t if OBJECT is a lambda list keyword. | 267 | "Return t if OBJECT is a lambda list keyword. |
| 288 | A lambda list keyword is a symbol that starts with `&'." | 268 | A lambda list keyword is a symbol that starts with `&'." |
| @@ -1186,7 +1166,7 @@ Maybe clear the markers and delete the symbol's edebug property?" | |||
| 1186 | ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. | 1166 | ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. |
| 1187 | ;; Do this after parsing since that may find a name. | 1167 | ;; Do this after parsing since that may find a name. |
| 1188 | (setq edebug-def-name | 1168 | (setq edebug-def-name |
| 1189 | (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon"))) | 1169 | (or edebug-def-name edebug-old-def-name (cl-gensym "edebug-anon"))) |
| 1190 | `(edebug-enter | 1170 | `(edebug-enter |
| 1191 | (quote ,edebug-def-name) | 1171 | (quote ,edebug-def-name) |
| 1192 | ,(if edebug-inside-func | 1172 | ,(if edebug-inside-func |
| @@ -1299,7 +1279,7 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 1299 | 1279 | ||
| 1300 | ;; Set the name here if it was not set by edebug-make-enter-wrapper. | 1280 | ;; Set the name here if it was not set by edebug-make-enter-wrapper. |
| 1301 | (setq edebug-def-name | 1281 | (setq edebug-def-name |
| 1302 | (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon"))) | 1282 | (or edebug-def-name edebug-old-def-name (cl-gensym "edebug-anon"))) |
| 1303 | 1283 | ||
| 1304 | ;; Add this def as a dependent of containing def. Buggy. | 1284 | ;; Add this def as a dependent of containing def. Buggy. |
| 1305 | '(if (and edebug-containing-def-name | 1285 | '(if (and edebug-containing-def-name |
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 656cb0a6a14..1f5edefea08 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el | |||
| @@ -54,7 +54,7 @@ | |||
| 54 | 54 | ||
| 55 | ;;; Code: | 55 | ;;; Code: |
| 56 | 56 | ||
| 57 | (eval-when-compile (require 'cl-lib)) | 57 | (require 'cl-lib) |
| 58 | (require 'button) | 58 | (require 'button) |
| 59 | (require 'debug) | 59 | (require 'debug) |
| 60 | (require 'easymenu) | 60 | (require 'easymenu) |
| @@ -87,127 +87,6 @@ | |||
| 87 | 87 | ||
| 88 | ;;; Copies/reimplementations of cl functions. | 88 | ;;; Copies/reimplementations of cl functions. |
| 89 | 89 | ||
| 90 | (defun ert--cl-do-remf (plist tag) | ||
| 91 | "Copy of `cl-do-remf'. Modify PLIST by removing TAG." | ||
| 92 | (let ((p (cdr plist))) | ||
| 93 | (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) | ||
| 94 | (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) | ||
| 95 | |||
| 96 | (defun ert--remprop (sym tag) | ||
| 97 | "Copy of `cl-remprop'. Modify SYM's plist by removing TAG." | ||
| 98 | (let ((plist (symbol-plist sym))) | ||
| 99 | (if (and plist (eq tag (car plist))) | ||
| 100 | (progn (setplist sym (cdr (cdr plist))) t) | ||
| 101 | (ert--cl-do-remf plist tag)))) | ||
| 102 | |||
| 103 | (defun ert--remove-if-not (ert-pred ert-list) | ||
| 104 | "A reimplementation of `remove-if-not'. | ||
| 105 | |||
| 106 | ERT-PRED is a predicate, ERT-LIST is the input list." | ||
| 107 | (cl-loop for ert-x in ert-list | ||
| 108 | if (funcall ert-pred ert-x) | ||
| 109 | collect ert-x)) | ||
| 110 | |||
| 111 | (defun ert--intersection (a b) | ||
| 112 | "A reimplementation of `intersection'. Intersect the sets A and B. | ||
| 113 | |||
| 114 | Elements are compared using `eql'." | ||
| 115 | (cl-loop for x in a | ||
| 116 | if (memql x b) | ||
| 117 | collect x)) | ||
| 118 | |||
| 119 | (defun ert--set-difference (a b) | ||
| 120 | "A reimplementation of `set-difference'. Subtract the set B from the set A. | ||
| 121 | |||
| 122 | Elements are compared using `eql'." | ||
| 123 | (cl-loop for x in a | ||
| 124 | unless (memql x b) | ||
| 125 | collect x)) | ||
| 126 | |||
| 127 | (defun ert--set-difference-eq (a b) | ||
| 128 | "A reimplementation of `set-difference'. Subtract the set B from the set A. | ||
| 129 | |||
| 130 | Elements are compared using `eq'." | ||
| 131 | (cl-loop for x in a | ||
| 132 | unless (memq x b) | ||
| 133 | collect x)) | ||
| 134 | |||
| 135 | (defun ert--union (a b) | ||
| 136 | "A reimplementation of `union'. Compute the union of the sets A and B. | ||
| 137 | |||
| 138 | Elements are compared using `eql'." | ||
| 139 | (append a (ert--set-difference b a))) | ||
| 140 | |||
| 141 | (eval-and-compile | ||
| 142 | (defvar ert--gensym-counter 0)) | ||
| 143 | |||
| 144 | (eval-and-compile | ||
| 145 | (defun ert--gensym (&optional prefix) | ||
| 146 | "Only allows string PREFIX, not compatible with CL." | ||
| 147 | (unless prefix (setq prefix "G")) | ||
| 148 | (make-symbol (format "%s%s" | ||
| 149 | prefix | ||
| 150 | (prog1 ert--gensym-counter | ||
| 151 | (cl-incf ert--gensym-counter)))))) | ||
| 152 | |||
| 153 | (defun ert--coerce-to-vector (x) | ||
| 154 | "Coerce X to a vector." | ||
| 155 | (when (char-table-p x) (error "Not supported")) | ||
| 156 | (if (vectorp x) | ||
| 157 | x | ||
| 158 | (vconcat x))) | ||
| 159 | |||
| 160 | (cl-defun ert--remove* (x list &key key test) | ||
| 161 | "Does not support all the keywords of remove*." | ||
| 162 | (unless key (setq key #'identity)) | ||
| 163 | (unless test (setq test #'eql)) | ||
| 164 | (cl-loop for y in list | ||
| 165 | unless (funcall test x (funcall key y)) | ||
| 166 | collect y)) | ||
| 167 | |||
| 168 | (defun ert--string-position (c s) | ||
| 169 | "Return the position of the first occurrence of C in S, or nil if none." | ||
| 170 | (cl-loop for i from 0 | ||
| 171 | for x across s | ||
| 172 | when (eql x c) return i)) | ||
| 173 | |||
| 174 | (defun ert--mismatch (a b) | ||
| 175 | "Return index of first element that differs between A and B. | ||
| 176 | |||
| 177 | Like `mismatch'. Uses `equal' for comparison." | ||
| 178 | (cond ((or (listp a) (listp b)) | ||
| 179 | (ert--mismatch (ert--coerce-to-vector a) | ||
| 180 | (ert--coerce-to-vector b))) | ||
| 181 | ((> (length a) (length b)) | ||
| 182 | (ert--mismatch b a)) | ||
| 183 | (t | ||
| 184 | (let ((la (length a)) | ||
| 185 | (lb (length b))) | ||
| 186 | (cl-assert (arrayp a) t) | ||
| 187 | (cl-assert (arrayp b) t) | ||
| 188 | (cl-assert (<= la lb) t) | ||
| 189 | (cl-loop for i below la | ||
| 190 | when (not (equal (aref a i) (aref b i))) return i | ||
| 191 | finally (cl-return (if (/= la lb) | ||
| 192 | la | ||
| 193 | (cl-assert (equal a b) t) | ||
| 194 | nil))))))) | ||
| 195 | |||
| 196 | (defun ert--subseq (seq start &optional end) | ||
| 197 | "Return a subsequence of SEQ from START to END." | ||
| 198 | (when (char-table-p seq) (error "Not supported")) | ||
| 199 | (let ((vector (substring (ert--coerce-to-vector seq) start end))) | ||
| 200 | (cl-etypecase seq | ||
| 201 | (vector vector) | ||
| 202 | (string (concat vector)) | ||
| 203 | (list (append vector nil)) | ||
| 204 | (bool-vector (cl-loop with result | ||
| 205 | = (make-bool-vector (length vector) nil) | ||
| 206 | for i below (length vector) do | ||
| 207 | (setf (aref result i) (aref vector i)) | ||
| 208 | finally (cl-return result))) | ||
| 209 | (char-table (cl-assert nil))))) | ||
| 210 | |||
| 211 | (defun ert-equal-including-properties (a b) | 90 | (defun ert-equal-including-properties (a b) |
| 212 | "Return t if A and B have similar structure and contents. | 91 | "Return t if A and B have similar structure and contents. |
| 213 | 92 | ||
| @@ -258,7 +137,7 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." | |||
| 258 | 137 | ||
| 259 | (defun ert-make-test-unbound (symbol) | 138 | (defun ert-make-test-unbound (symbol) |
| 260 | "Make SYMBOL name no test. Return SYMBOL." | 139 | "Make SYMBOL name no test. Return SYMBOL." |
| 261 | (ert--remprop symbol 'ert--test) | 140 | (cl-remprop symbol 'ert--test) |
| 262 | symbol) | 141 | symbol) |
| 263 | 142 | ||
| 264 | (defun ert--parse-keys-and-body (keys-and-body) | 143 | (defun ert--parse-keys-and-body (keys-and-body) |
| @@ -396,8 +275,8 @@ DATA is displayed to the user and should state the reason of the failure." | |||
| 396 | cl-macro-environment))))) | 275 | cl-macro-environment))))) |
| 397 | (cond | 276 | (cond |
| 398 | ((or (atom form) (ert--special-operator-p (car form))) | 277 | ((or (atom form) (ert--special-operator-p (car form))) |
| 399 | (let ((value (ert--gensym "value-"))) | 278 | (let ((value (cl-gensym "value-"))) |
| 400 | `(let ((,value (ert--gensym "ert-form-evaluation-aborted-"))) | 279 | `(let ((,value (cl-gensym "ert-form-evaluation-aborted-"))) |
| 401 | ,(funcall inner-expander | 280 | ,(funcall inner-expander |
| 402 | `(setq ,value ,form) | 281 | `(setq ,value ,form) |
| 403 | `(list ',whole :form ',form :value ,value) | 282 | `(list ',whole :form ',form :value ,value) |
| @@ -410,10 +289,10 @@ DATA is displayed to the user and should state the reason of the failure." | |||
| 410 | (and (consp fn-name) | 289 | (and (consp fn-name) |
| 411 | (eql (car fn-name) 'lambda) | 290 | (eql (car fn-name) 'lambda) |
| 412 | (listp (cdr fn-name))))) | 291 | (listp (cdr fn-name))))) |
| 413 | (let ((fn (ert--gensym "fn-")) | 292 | (let ((fn (cl-gensym "fn-")) |
| 414 | (args (ert--gensym "args-")) | 293 | (args (cl-gensym "args-")) |
| 415 | (value (ert--gensym "value-")) | 294 | (value (cl-gensym "value-")) |
| 416 | (default-value (ert--gensym "ert-form-evaluation-aborted-"))) | 295 | (default-value (cl-gensym "ert-form-evaluation-aborted-"))) |
| 417 | `(let ((,fn (function ,fn-name)) | 296 | `(let ((,fn (function ,fn-name)) |
| 418 | (,args (list ,@arg-forms))) | 297 | (,args (list ,@arg-forms))) |
| 419 | (let ((,value ',default-value)) | 298 | (let ((,value ',default-value)) |
| @@ -450,7 +329,7 @@ FORM-DESCRIPTION-FORM before it has called INNER-FORM." | |||
| 450 | (ert--expand-should-1 | 329 | (ert--expand-should-1 |
| 451 | whole form | 330 | whole form |
| 452 | (lambda (inner-form form-description-form value-var) | 331 | (lambda (inner-form form-description-form value-var) |
| 453 | (let ((form-description (ert--gensym "form-description-"))) | 332 | (let ((form-description (cl-gensym "form-description-"))) |
| 454 | `(let (,form-description) | 333 | `(let (,form-description) |
| 455 | ,(funcall inner-expander | 334 | ,(funcall inner-expander |
| 456 | `(unwind-protect | 335 | `(unwind-protect |
| @@ -491,7 +370,7 @@ and aborts the current test as failed if it doesn't." | |||
| 491 | (list type) | 370 | (list type) |
| 492 | (symbol (list type))))) | 371 | (symbol (list type))))) |
| 493 | (cl-assert signaled-conditions) | 372 | (cl-assert signaled-conditions) |
| 494 | (unless (ert--intersection signaled-conditions handled-conditions) | 373 | (unless (cl-intersection signaled-conditions handled-conditions) |
| 495 | (ert-fail (append | 374 | (ert-fail (append |
| 496 | (funcall form-description-fn) | 375 | (funcall form-description-fn) |
| 497 | (list | 376 | (list |
| @@ -528,8 +407,8 @@ failed." | |||
| 528 | `(should-error ,form ,@keys) | 407 | `(should-error ,form ,@keys) |
| 529 | form | 408 | form |
| 530 | (lambda (inner-form form-description-form value-var) | 409 | (lambda (inner-form form-description-form value-var) |
| 531 | (let ((errorp (ert--gensym "errorp")) | 410 | (let ((errorp (cl-gensym "errorp")) |
| 532 | (form-description-fn (ert--gensym "form-description-fn-"))) | 411 | (form-description-fn (cl-gensym "form-description-fn-"))) |
| 533 | `(let ((,errorp nil) | 412 | `(let ((,errorp nil) |
| 534 | (,form-description-fn (lambda () ,form-description-form))) | 413 | (,form-description-fn (lambda () ,form-description-form))) |
| 535 | (condition-case -condition- | 414 | (condition-case -condition- |
| @@ -591,7 +470,7 @@ Returns nil if they are." | |||
| 591 | `(proper-lists-of-different-length ,(length a) ,(length b) | 470 | `(proper-lists-of-different-length ,(length a) ,(length b) |
| 592 | ,a ,b | 471 | ,a ,b |
| 593 | first-mismatch-at | 472 | first-mismatch-at |
| 594 | ,(ert--mismatch a b)) | 473 | ,(cl-mismatch a b :test 'equal)) |
| 595 | (cl-loop for i from 0 | 474 | (cl-loop for i from 0 |
| 596 | for ai in a | 475 | for ai in a |
| 597 | for bi in b | 476 | for bi in b |
| @@ -611,7 +490,7 @@ Returns nil if they are." | |||
| 611 | ,a ,b | 490 | ,a ,b |
| 612 | ,@(unless (char-table-p a) | 491 | ,@(unless (char-table-p a) |
| 613 | `(first-mismatch-at | 492 | `(first-mismatch-at |
| 614 | ,(ert--mismatch a b)))) | 493 | ,(cl-mismatch a b :test 'equal)))) |
| 615 | (cl-loop for i from 0 | 494 | (cl-loop for i from 0 |
| 616 | for ai across a | 495 | for ai across a |
| 617 | for bi across b | 496 | for bi across b |
| @@ -656,8 +535,8 @@ key/value pairs in each list does not matter." | |||
| 656 | ;; work, so let's punt on it for now. | 535 | ;; work, so let's punt on it for now. |
| 657 | (let* ((keys-a (ert--significant-plist-keys a)) | 536 | (let* ((keys-a (ert--significant-plist-keys a)) |
| 658 | (keys-b (ert--significant-plist-keys b)) | 537 | (keys-b (ert--significant-plist-keys b)) |
| 659 | (keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b)) | 538 | (keys-in-a-not-in-b (cl-set-difference keys-a keys-b :test 'eq)) |
| 660 | (keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a))) | 539 | (keys-in-b-not-in-a (cl-set-difference keys-b keys-a :test 'eq))) |
| 661 | (cl-flet ((explain-with-key (key) | 540 | (cl-flet ((explain-with-key (key) |
| 662 | (let ((value-a (plist-get a key)) | 541 | (let ((value-a (plist-get a key)) |
| 663 | (value-b (plist-get b key))) | 542 | (value-b (plist-get b key))) |
| @@ -1090,7 +969,7 @@ contained in UNIVERSE." | |||
| 1090 | (cl-etypecase universe | 969 | (cl-etypecase universe |
| 1091 | ((member t) (mapcar #'ert-get-test | 970 | ((member t) (mapcar #'ert-get-test |
| 1092 | (apropos-internal selector #'ert-test-boundp))) | 971 | (apropos-internal selector #'ert-test-boundp))) |
| 1093 | (list (ert--remove-if-not (lambda (test) | 972 | (list (cl-remove-if-not (lambda (test) |
| 1094 | (and (ert-test-name test) | 973 | (and (ert-test-name test) |
| 1095 | (string-match selector | 974 | (string-match selector |
| 1096 | (ert-test-name test)))) | 975 | (ert-test-name test)))) |
| @@ -1123,13 +1002,13 @@ contained in UNIVERSE." | |||
| 1123 | (not | 1002 | (not |
| 1124 | (cl-assert (eql (length operands) 1)) | 1003 | (cl-assert (eql (length operands) 1)) |
| 1125 | (let ((all-tests (ert-select-tests 't universe))) | 1004 | (let ((all-tests (ert-select-tests 't universe))) |
| 1126 | (ert--set-difference all-tests | 1005 | (cl-set-difference all-tests |
| 1127 | (ert-select-tests (car operands) | 1006 | (ert-select-tests (car operands) |
| 1128 | all-tests)))) | 1007 | all-tests)))) |
| 1129 | (or | 1008 | (or |
| 1130 | (cl-case (length operands) | 1009 | (cl-case (length operands) |
| 1131 | (0 (ert-select-tests 'nil universe)) | 1010 | (0 (ert-select-tests 'nil universe)) |
| 1132 | (t (ert--union (ert-select-tests (car operands) universe) | 1011 | (t (cl-union (ert-select-tests (car operands) universe) |
| 1133 | (ert-select-tests `(or ,@(cdr operands)) | 1012 | (ert-select-tests `(or ,@(cdr operands)) |
| 1134 | universe))))) | 1013 | universe))))) |
| 1135 | (tag | 1014 | (tag |
| @@ -1141,7 +1020,7 @@ contained in UNIVERSE." | |||
| 1141 | universe))) | 1020 | universe))) |
| 1142 | (satisfies | 1021 | (satisfies |
| 1143 | (cl-assert (eql (length operands) 1)) | 1022 | (cl-assert (eql (length operands) 1)) |
| 1144 | (ert--remove-if-not (car operands) | 1023 | (cl-remove-if-not (car operands) |
| 1145 | (ert-select-tests 't universe)))))))) | 1024 | (ert-select-tests 't universe)))))))) |
| 1146 | 1025 | ||
| 1147 | (defun ert--insert-human-readable-selector (selector) | 1026 | (defun ert--insert-human-readable-selector (selector) |
| @@ -1285,7 +1164,7 @@ Also changes the counters in STATS to match." | |||
| 1285 | "Create a new `ert--stats' object for running TESTS. | 1164 | "Create a new `ert--stats' object for running TESTS. |
| 1286 | 1165 | ||
| 1287 | SELECTOR is the selector that was used to select TESTS." | 1166 | SELECTOR is the selector that was used to select TESTS." |
| 1288 | (setq tests (ert--coerce-to-vector tests)) | 1167 | (setq tests (cl-coerce tests 'vector)) |
| 1289 | (let ((map (make-hash-table :size (length tests)))) | 1168 | (let ((map (make-hash-table :size (length tests)))) |
| 1290 | (cl-loop for i from 0 | 1169 | (cl-loop for i from 0 |
| 1291 | for test across tests | 1170 | for test across tests |
| @@ -1548,10 +1427,10 @@ This can be used as an inverse of `add-to-list'." | |||
| 1548 | (unless key (setq key #'identity)) | 1427 | (unless key (setq key #'identity)) |
| 1549 | (unless test (setq test #'equal)) | 1428 | (unless test (setq test #'equal)) |
| 1550 | (setf (symbol-value list-var) | 1429 | (setf (symbol-value list-var) |
| 1551 | (ert--remove* element | 1430 | (cl-remove element |
| 1552 | (symbol-value list-var) | 1431 | (symbol-value list-var) |
| 1553 | :key key | 1432 | :key key |
| 1554 | :test test))) | 1433 | :test test))) |
| 1555 | 1434 | ||
| 1556 | 1435 | ||
| 1557 | ;;; Some basic interactive functions. | 1436 | ;;; Some basic interactive functions. |
| @@ -1810,7 +1689,7 @@ BEGIN and END specify a region in the current buffer." | |||
| 1810 | "Return the first line of S, or S if it contains no newlines. | 1689 | "Return the first line of S, or S if it contains no newlines. |
| 1811 | 1690 | ||
| 1812 | The return value does not include the line terminator." | 1691 | The return value does not include the line terminator." |
| 1813 | (substring s 0 (ert--string-position ?\n s))) | 1692 | (substring s 0 (cl-position ?\n s))) |
| 1814 | 1693 | ||
| 1815 | (defun ert-face-for-test-result (expectedp) | 1694 | (defun ert-face-for-test-result (expectedp) |
| 1816 | "Return a face that shows whether a test result was expected or unexpected. | 1695 | "Return a face that shows whether a test result was expected or unexpected. |
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 1919d47687b..56bfe04f9ce 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el | |||
| @@ -131,8 +131,9 @@ Returns the number of actions taken." | |||
| 131 | (unwind-protect | 131 | (unwind-protect |
| 132 | (progn | 132 | (progn |
| 133 | (if (stringp prompter) | 133 | (if (stringp prompter) |
| 134 | (setq prompter (lambda (object) | 134 | (setq prompter (let ((prompter prompter)) |
| 135 | (format prompter object)))) | 135 | (lambda (object) |
| 136 | (format prompter object))))) | ||
| 136 | (while (funcall next) | 137 | (while (funcall next) |
| 137 | (setq prompt (funcall prompter elt)) | 138 | (setq prompt (funcall prompter elt)) |
| 138 | (cond ((stringp prompt) | 139 | (cond ((stringp prompt) |
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index e000c343721..511f1480099 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el | |||
| @@ -482,12 +482,19 @@ MATCH is the pattern that needs to be matched, of the form: | |||
| 482 | all)) | 482 | all)) |
| 483 | '(:pcase--succeed . nil)))) | 483 | '(:pcase--succeed . nil)))) |
| 484 | 484 | ||
| 485 | (defun pcase--split-pred (upat pat) | 485 | (defun pcase--split-pred (vars upat pat) |
| 486 | ;; FIXME: For predicates like (pred (> a)), two such predicates may | ||
| 487 | ;; actually refer to different variables `a'. | ||
| 488 | (let (test) | 486 | (let (test) |
| 489 | (cond | 487 | (cond |
| 490 | ((equal upat pat) '(:pcase--succeed . :pcase--fail)) | 488 | ((and (equal upat pat) |
| 489 | ;; For predicates like (pred (> a)), two such predicates may | ||
| 490 | ;; actually refer to different variables `a'. | ||
| 491 | (or (and (eq 'pred (car upat)) (symbolp (cadr upat))) | ||
| 492 | ;; FIXME: `vars' gives us the environment in which `upat' will | ||
| 493 | ;; run, but we don't have the environment in which `pat' will | ||
| 494 | ;; run, so we can't do a reliable verification. But let's try | ||
| 495 | ;; and catch at least the easy cases such as (bug#14773). | ||
| 496 | (not (pcase--fgrep (mapcar #'car vars) (cadr upat))))) | ||
| 497 | '(:pcase--succeed . :pcase--fail)) | ||
| 491 | ((and (eq 'pred (car upat)) | 498 | ((and (eq 'pred (car upat)) |
| 492 | (eq 'pred (car-safe pat)) | 499 | (eq 'pred (car-safe pat)) |
| 493 | (or (member (cons (cadr upat) (cadr pat)) | 500 | (or (member (cons (cadr upat) (cadr pat)) |
| @@ -589,7 +596,7 @@ Otherwise, it defers to REST which is a list of branches of the form | |||
| 589 | (if (eq (car upat) 'pred) (pcase--mark-used sym)) | 596 | (if (eq (car upat) 'pred) (pcase--mark-used sym)) |
| 590 | (let* ((splitrest | 597 | (let* ((splitrest |
| 591 | (pcase--split-rest | 598 | (pcase--split-rest |
| 592 | sym (lambda (pat) (pcase--split-pred upat pat)) rest)) | 599 | sym (lambda (pat) (pcase--split-pred vars upat pat)) rest)) |
| 593 | (then-rest (car splitrest)) | 600 | (then-rest (car splitrest)) |
| 594 | (else-rest (cdr splitrest))) | 601 | (else-rest (cdr splitrest))) |
| 595 | (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat))) | 602 | (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat))) |
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index e7b371365e4..c39d896f3d3 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el | |||
| @@ -996,93 +996,7 @@ as a Meta key and any number of multiple escapes are allowed." | |||
| 996 | (suspend-emacs)) | 996 | (suspend-emacs)) |
| 997 | (viper-change-state-to-emacs))) | 997 | (viper-change-state-to-emacs))) |
| 998 | 998 | ||
| 999 | |||
| 1000 | ;; Intercept ESC sequences on dumb terminals. | ||
| 1001 | ;; Based on the idea contributed by Marcelino Veiga Tuimil <mveiga@dit.upm.es> | ||
| 1002 | |||
| 1003 | ;; Check if last key was ESC and if so try to reread it as a function key. | ||
| 1004 | ;; But only if there are characters to read during a very short time. | ||
| 1005 | ;; Returns the last event, if any. | ||
| 1006 | (defun viper-envelop-ESC-key () | ||
| 1007 | (let ((event last-input-event) | ||
| 1008 | (keyseq [nil]) | ||
| 1009 | (inhibit-quit t)) | ||
| 1010 | (if (viper-ESC-event-p event) | ||
| 1011 | (progn | ||
| 1012 | ;; Some versions of Emacs (eg., 22.50.8 (?)) have a bug, which makes | ||
| 1013 | ;; even a single ESC into a fast keyseq. To guard against this, we | ||
| 1014 | ;; added a check if there are other events as well. Keep the next | ||
| 1015 | ;; line for the next time the bug reappears, so that will remember to | ||
| 1016 | ;; report it. | ||
| 1017 | ;;(if (and (viper-fast-keysequence-p) unread-command-events) | ||
| 1018 | (if (viper-fast-keysequence-p) ;; for Emacsen without the above bug | ||
| 1019 | (progn | ||
| 1020 | (let (minor-mode-map-alist emulation-mode-map-alists) | ||
| 1021 | (viper-set-unread-command-events event) | ||
| 1022 | (setq keyseq (read-key-sequence nil 'continue-echo)) | ||
| 1023 | ) ; let | ||
| 1024 | ;; If keyseq translates into something that still has ESC | ||
| 1025 | ;; at the beginning, separate ESC from the rest of the seq. | ||
| 1026 | ;; In XEmacs we check for events that are keypress meta-key | ||
| 1027 | ;; and convert them into [escape key] | ||
| 1028 | ;; | ||
| 1029 | ;; This is needed for the following reason: | ||
| 1030 | ;; If ESC is the first symbol, we interpret it as if the | ||
| 1031 | ;; user typed ESC and then quickly some other symbols. | ||
| 1032 | ;; If ESC is not the first one, then the key sequence | ||
| 1033 | ;; entered was apparently translated into a function key or | ||
| 1034 | ;; something (e.g., one may have | ||
| 1035 | ;; (define-key function-key-map "\e[192z" [f11]) | ||
| 1036 | ;; which would translate the escape-sequence generated by | ||
| 1037 | ;; f11 in an xterm window into the symbolic key f11. | ||
| 1038 | ;; | ||
| 1039 | ;; If `first-key' is not an ESC event, we make it into the | ||
| 1040 | ;; last-command-event in order to pretend that this key was | ||
| 1041 | ;; pressed. This is needed to allow arrow keys to be bound to | ||
| 1042 | ;; macros. Otherwise, viper-exec-mapped-kbd-macro will think | ||
| 1043 | ;; that the last event was ESC and so it'll execute whatever is | ||
| 1044 | ;; bound to ESC. (Viper macros can't be bound to | ||
| 1045 | ;; ESC-sequences). | ||
| 1046 | (let* ((first-key (elt keyseq 0)) | ||
| 1047 | (key-mod (event-modifiers first-key))) | ||
| 1048 | (cond ((and (viper-ESC-event-p first-key) | ||
| 1049 | (not (viper-translate-all-ESC-keysequences))) | ||
| 1050 | ;; put keys following ESC on the unread list | ||
| 1051 | ;; and return ESC as the key-sequence | ||
| 1052 | (viper-set-unread-command-events (viper-subseq keyseq 1)) | ||
| 1053 | (setq last-input-event event | ||
| 1054 | keyseq (if (featurep 'emacs) | ||
| 1055 | "\e" | ||
| 1056 | (vector (character-to-event ?\e))))) | ||
| 1057 | ((and (featurep 'xemacs) | ||
| 1058 | (key-press-event-p first-key) | ||
| 1059 | (equal '(meta) key-mod)) | ||
| 1060 | (viper-set-unread-command-events | ||
| 1061 | (vconcat (vector | ||
| 1062 | (character-to-event (event-key first-key))) | ||
| 1063 | (viper-subseq keyseq 1))) | ||
| 1064 | (setq last-input-event event | ||
| 1065 | keyseq (vector (character-to-event ?\e)))) | ||
| 1066 | ((eventp first-key) | ||
| 1067 | (setq last-command-event | ||
| 1068 | (viper-copy-event first-key))) | ||
| 1069 | )) | ||
| 1070 | ) ; end progn | ||
| 1071 | |||
| 1072 | ;; this is escape event with nothing after it | ||
| 1073 | ;; put in unread-command-event and then re-read | ||
| 1074 | (viper-set-unread-command-events event) | ||
| 1075 | (setq keyseq (read-key-sequence nil)) | ||
| 1076 | )) | ||
| 1077 | ;; not an escape event | ||
| 1078 | (setq keyseq (vector event))) | ||
| 1079 | keyseq)) | ||
| 1080 | |||
| 1081 | |||
| 1082 | |||
| 1083 | ;; Listen to ESC key. | 999 | ;; Listen to ESC key. |
| 1084 | ;; If a sequence of keys starting with ESC is issued with very short delays, | ||
| 1085 | ;; interpret these keys in Emacs mode, so ESC won't be interpreted as a Vi key. | ||
| 1086 | (defun viper-intercept-ESC-key () | 1000 | (defun viper-intercept-ESC-key () |
| 1087 | "Function that implements ESC key in Viper emulation of Vi." | 1001 | "Function that implements ESC key in Viper emulation of Vi." |
| 1088 | (interactive) | 1002 | (interactive) |
| @@ -1090,13 +1004,7 @@ as a Meta key and any number of multiple escapes are allowed." | |||
| 1090 | ;; minor-mode map(s) have been temporarily disabled so the ESC | 1004 | ;; minor-mode map(s) have been temporarily disabled so the ESC |
| 1091 | ;; binding to viper-intercept-ESC-key doesn't hide the binding we're | 1005 | ;; binding to viper-intercept-ESC-key doesn't hide the binding we're |
| 1092 | ;; looking for (Bug#9146): | 1006 | ;; looking for (Bug#9146): |
| 1093 | (let* ((event (viper-envelop-ESC-key)) | 1007 | (let* ((cmd 'viper-intercept-ESC-key)) |
| 1094 | (cmd (cond ((equal event viper-ESC-key) | ||
| 1095 | 'viper-intercept-ESC-key) | ||
| 1096 | ((let ((emulation-mode-map-alists nil)) | ||
| 1097 | (key-binding event))) | ||
| 1098 | (t | ||
| 1099 | (error "Viper bell"))))) | ||
| 1100 | 1008 | ||
| 1101 | ;; call the actual function to execute ESC (if no other symbols followed) | 1009 | ;; call the actual function to execute ESC (if no other symbols followed) |
| 1102 | ;; or the key bound to the ESC sequence (if the sequence was issued | 1010 | ;; or the key bound to the ESC sequence (if the sequence was issued |
| @@ -4289,6 +4197,11 @@ cursor move past the beginning of line." | |||
| 4289 | (t | 4197 | (t |
| 4290 | (backward-char 1)))) | 4198 | (backward-char 1)))) |
| 4291 | 4199 | ||
| 4200 | (defun viper-del-forward-char-in-insert () | ||
| 4201 | "Delete 1 char forward if in insert or replace state." | ||
| 4202 | (interactive) | ||
| 4203 | ;; don't put on kill ring | ||
| 4204 | (delete-char 1 nil)) | ||
| 4292 | 4205 | ||
| 4293 | 4206 | ||
| 4294 | ;; join lines. | 4207 | ;; join lines. |
| @@ -4947,7 +4860,7 @@ Please, specify your level now: ") | |||
| 4947 | (interactive) | 4860 | (interactive) |
| 4948 | (if (< viper-expert-level 2) | 4861 | (if (< viper-expert-level 2) |
| 4949 | (save-buffers-kill-emacs) | 4862 | (save-buffers-kill-emacs) |
| 4950 | (save-buffer) | 4863 | (if (buffer-modified-p) (save-buffer)) |
| 4951 | (kill-buffer (current-buffer)))) | 4864 | (kill-buffer (current-buffer)))) |
| 4952 | 4865 | ||
| 4953 | 4866 | ||
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 0d9d300ab1a..d33b5f4ed58 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el | |||
| @@ -192,7 +192,7 @@ Enter as a sexp. Examples: \"\\C-z\", [(control ?z)]." | |||
| 192 | :type 'string | 192 | :type 'string |
| 193 | :group 'viper) | 193 | :group 'viper) |
| 194 | 194 | ||
| 195 | (defvar viper-ESC-key (kbd "ESC") | 195 | (defconst viper-ESC-key [escape] |
| 196 | "Key used to ESC.") | 196 | "Key used to ESC.") |
| 197 | 197 | ||
| 198 | 198 | ||
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 7f432cdc143..266af1abf2b 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el | |||
| @@ -14,7 +14,7 @@ | |||
| 14 | ;; filed in the Emacs bug reporting system against this file, a copy | 14 | ;; filed in the Emacs bug reporting system against this file, a copy |
| 15 | ;; of the bug report be sent to the maintainer's email address. | 15 | ;; of the bug report be sent to the maintainer's email address. |
| 16 | 16 | ||
| 17 | (defconst viper-version "3.14.1 of August 15, 2009" | 17 | (defconst viper-version "3.14.2 of July 4, 2013" |
| 18 | "The current version of Viper") | 18 | "The current version of Viper") |
| 19 | 19 | ||
| 20 | ;; This file is part of GNU Emacs. | 20 | ;; This file is part of GNU Emacs. |
| @@ -411,6 +411,7 @@ widget." | |||
| 411 | dired-mode | 411 | dired-mode |
| 412 | efs-mode | 412 | efs-mode |
| 413 | tar-mode | 413 | tar-mode |
| 414 | egg-status-buffer-mode | ||
| 414 | 415 | ||
| 415 | browse-kill-ring-mode | 416 | browse-kill-ring-mode |
| 416 | recentf-mode | 417 | recentf-mode |
| @@ -660,7 +661,7 @@ user customization, unrelated to Viper. For instance, if the user advised | |||
| 660 | undone. | 661 | undone. |
| 661 | It also can't undo some Viper settings." | 662 | It also can't undo some Viper settings." |
| 662 | (interactive) | 663 | (interactive) |
| 663 | 664 | (viper-setup-ESC-to-escape nil) | |
| 664 | ;; restore non-viper vars | 665 | ;; restore non-viper vars |
| 665 | (setq-default | 666 | (setq-default |
| 666 | next-line-add-newlines | 667 | next-line-add-newlines |
| @@ -825,6 +826,58 @@ It also can't undo some Viper settings." | |||
| 825 | (add-hook 'viper-post-command-hooks 'set-viper-state-in-major-mode t)) | 826 | (add-hook 'viper-post-command-hooks 'set-viper-state-in-major-mode t)) |
| 826 | 827 | ||
| 827 | 828 | ||
| 829 | ;;; Handling of tty's ESC event | ||
| 830 | |||
| 831 | ;; On a tty, an ESC event can either be the user hitting the escape key, or | ||
| 832 | ;; some element of a byte sequence used to encode for example cursor keys. | ||
| 833 | ;; So we try to recognize those events that correspond to the escape key and | ||
| 834 | ;; turn them into `escape' events (same as used under GUIs). The heuristic we | ||
| 835 | ;; use to distinguish the two cases is based, as usual, on a timeout, and on | ||
| 836 | ;; the fact that the special ESC=>escape mapping only takes place if the whole | ||
| 837 | ;; last key-sequence so far is just [?\e], i.e. either we're still in | ||
| 838 | ;; read-key-sequence, or the last read-key-sequence only read [?\e], which | ||
| 839 | ;; should ideally never happen because it should have been mapped to [escape]. | ||
| 840 | |||
| 841 | (defun viper--tty-ESC-filter (map) | ||
| 842 | (if (and (equal (this-single-command-keys) [?\e]) | ||
| 843 | (sit-for (/ viper-fast-keyseq-timeout 1000))) | ||
| 844 | [escape] map)) | ||
| 845 | |||
| 846 | (defun viper--lookup-key (map key) | ||
| 847 | "Kind of like `lookup-key'. | ||
| 848 | Two differences: | ||
| 849 | - KEY is a single key, not a sequence. | ||
| 850 | - the result is the \"raw\" binding, so it can be a `menu-item', rather than the | ||
| 851 | binding contained in that menu item." | ||
| 852 | (catch 'found | ||
| 853 | (map-keymap (lambda (k b) (if (equal key k) (throw 'found b))) map))) | ||
| 854 | |||
| 855 | (defun viper-catch-tty-ESC () | ||
| 856 | "Setup key mappings of current terminal to turn a tty's ESC into `escape'." | ||
| 857 | (when (memq (terminal-live-p (frame-terminal)) '(t pc)) | ||
| 858 | (let ((esc-binding (viper-uncatch-tty-ESC))) | ||
| 859 | (define-key input-decode-map | ||
| 860 | [?\e] `(menu-item "" ,esc-binding :filter viper--tty-ESC-filter))))) | ||
| 861 | |||
| 862 | (defun viper-uncatch-tty-ESC () | ||
| 863 | "Don't hack ESC into `escape' any more." | ||
| 864 | (let ((b (viper--lookup-key input-decode-map ?\e))) | ||
| 865 | (and (eq 'menu-item (car-safe b)) | ||
| 866 | (eq 'viper--tty-ESC-filter (nth 4 b)) | ||
| 867 | (define-key input-decode-map [?\e] (setq b (nth 2 b)))) | ||
| 868 | b)) | ||
| 869 | |||
| 870 | (defun viper-setup-ESC-to-escape (enable) | ||
| 871 | (if enable | ||
| 872 | (add-hook 'tty-setup-hook 'viper-catch-tty-ESC) | ||
| 873 | (remove-hook 'tty-setup-hook 'viper-catch-tty-ESC)) | ||
| 874 | (let ((seen ())) | ||
| 875 | (dolist (frame (frame-list)) | ||
| 876 | (let ((terminal (frame-terminal frame))) | ||
| 877 | (unless (memq terminal seen) | ||
| 878 | (push terminal seen) | ||
| 879 | (with-selected-frame frame | ||
| 880 | (if enable (viper-catch-tty-ESC) (viper-uncatch-tty-ESC)))))))) | ||
| 828 | 881 | ||
| 829 | ;; This sets major mode hooks to make them come up in vi-state. | 882 | ;; This sets major mode hooks to make them come up in vi-state. |
| 830 | (defun viper-set-hooks () | 883 | (defun viper-set-hooks () |
| @@ -837,6 +890,8 @@ It also can't undo some Viper settings." | |||
| 837 | (if (eq (default-value 'major-mode) 'fundamental-mode) | 890 | (if (eq (default-value 'major-mode) 'fundamental-mode) |
| 838 | (setq-default major-mode 'viper-mode)) | 891 | (setq-default major-mode 'viper-mode)) |
| 839 | 892 | ||
| 893 | (viper-setup-ESC-to-escape t) | ||
| 894 | |||
| 840 | (add-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel) | 895 | (add-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel) |
| 841 | (add-hook 'find-file-hooks 'set-viper-state-in-major-mode) | 896 | (add-hook 'find-file-hooks 'set-viper-state-in-major-mode) |
| 842 | 897 | ||
| @@ -847,13 +902,6 @@ It also can't undo some Viper settings." | |||
| 847 | (defvar emerge-startup-hook) | 902 | (defvar emerge-startup-hook) |
| 848 | (add-hook 'emerge-startup-hook 'viper-change-state-to-emacs) | 903 | (add-hook 'emerge-startup-hook 'viper-change-state-to-emacs) |
| 849 | 904 | ||
| 850 | ;; Zap bad bindings in flyspell-mouse-map, which prevent ESC from working | ||
| 851 | ;; over misspelled words (due to the overlay keymaps) | ||
| 852 | (defvar flyspell-mode-hook) | ||
| 853 | (defvar flyspell-mouse-map) | ||
| 854 | (add-hook 'flyspell-mode-hook | ||
| 855 | (lambda () | ||
| 856 | (define-key flyspell-mouse-map viper-ESC-key nil))) | ||
| 857 | ;; if viper is started from .emacs, it might be impossible to get certain | 905 | ;; if viper is started from .emacs, it might be impossible to get certain |
| 858 | ;; info about the display and windows until emacs initialization is complete | 906 | ;; info about the display and windows until emacs initialization is complete |
| 859 | ;; So do it via the window-setup-hook | 907 | ;; So do it via the window-setup-hook |
diff --git a/lisp/faces.el b/lisp/faces.el index 0a3f0551325..9a34aec2549 100644 --- a/lisp/faces.el +++ b/lisp/faces.el | |||
| @@ -2097,6 +2097,10 @@ the above example." | |||
| 2097 | nil)))) | 2097 | nil)))) |
| 2098 | type) | 2098 | type) |
| 2099 | 2099 | ||
| 2100 | (defvar tty-setup-hook nil | ||
| 2101 | "Hook run after running the initialization function of a new text terminal. | ||
| 2102 | This can be used to fine tune the `input-decode-map', for example.") | ||
| 2103 | |||
| 2100 | (defun tty-run-terminal-initialization (frame &optional type) | 2104 | (defun tty-run-terminal-initialization (frame &optional type) |
| 2101 | "Run the special initialization code for the terminal type of FRAME. | 2105 | "Run the special initialization code for the terminal type of FRAME. |
| 2102 | The optional TYPE parameter may be used to override the autodetected | 2106 | The optional TYPE parameter may be used to override the autodetected |
| @@ -2122,7 +2126,8 @@ terminal type to a different value." | |||
| 2122 | type) | 2126 | type) |
| 2123 | (when (fboundp term-init-func) | 2127 | (when (fboundp term-init-func) |
| 2124 | (funcall term-init-func)) | 2128 | (funcall term-init-func)) |
| 2125 | (set-terminal-parameter frame 'terminal-initted term-init-func))))) | 2129 | (set-terminal-parameter frame 'terminal-initted term-init-func) |
| 2130 | (run-hooks 'tty-setup-hook))))) | ||
| 2126 | 2131 | ||
| 2127 | ;; Called from C function init_display to initialize faces of the | 2132 | ;; Called from C function init_display to initialize faces of the |
| 2128 | ;; dumped terminal frame on startup. | 2133 | ;; dumped terminal frame on startup. |
diff --git a/lisp/files.el b/lisp/files.el index 9b56dfa9693..ff4ccec2279 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -316,6 +316,7 @@ A value of nil means don't add newlines. | |||
| 316 | 316 | ||
| 317 | Certain major modes set this locally to the value obtained | 317 | Certain major modes set this locally to the value obtained |
| 318 | from `mode-require-final-newline'." | 318 | from `mode-require-final-newline'." |
| 319 | :safe #'symbolp | ||
| 319 | :type '(choice (const :tag "When visiting" visit) | 320 | :type '(choice (const :tag "When visiting" visit) |
| 320 | (const :tag "When saving" t) | 321 | (const :tag "When saving" t) |
| 321 | (const :tag "When visiting or saving" visit-save) | 322 | (const :tag "When visiting or saving" visit-save) |
| @@ -4916,6 +4917,11 @@ change the additional actions you can take on files." | |||
| 4916 | (length autosaved-buffers) | 4917 | (length autosaved-buffers) |
| 4917 | (mapconcat 'identity autosaved-buffers ", ")))))))) | 4918 | (mapconcat 'identity autosaved-buffers ", ")))))))) |
| 4918 | 4919 | ||
| 4920 | (defun clear-visited-file-modtime () | ||
| 4921 | "Clear out records of last mod time of visited file. | ||
| 4922 | Next attempt to save will certainly not complain of a discrepancy." | ||
| 4923 | (set-visited-file-modtime 0)) | ||
| 4924 | |||
| 4919 | (defun not-modified (&optional arg) | 4925 | (defun not-modified (&optional arg) |
| 4920 | "Mark current buffer as unmodified, not needing to be saved. | 4926 | "Mark current buffer as unmodified, not needing to be saved. |
| 4921 | With prefix ARG, mark buffer as modified, so \\[save-buffer] will save. | 4927 | With prefix ARG, mark buffer as modified, so \\[save-buffer] will save. |
diff --git a/lisp/filesets.el b/lisp/filesets.el index 978512bd3a4..fbf28dbecbc 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el | |||
| @@ -149,7 +149,7 @@ is loaded before custom.el, set this variable to t.") | |||
| 149 | (defun filesets-filter-list (lst cond-fn) | 149 | (defun filesets-filter-list (lst cond-fn) |
| 150 | "Remove all elements not conforming to COND-FN from list LST. | 150 | "Remove all elements not conforming to COND-FN from list LST. |
| 151 | COND-FN takes one argument: the current element." | 151 | COND-FN takes one argument: the current element." |
| 152 | ; (remove* 'dummy lst :test (lambda (dummy elt) | 152 | ; (cl-remove 'dummy lst :test (lambda (dummy elt) |
| 153 | ; (not (funcall cond-fn elt))))) | 153 | ; (not (funcall cond-fn elt))))) |
| 154 | (let ((rv nil)) | 154 | (let ((rv nil)) |
| 155 | (dolist (elt lst rv) | 155 | (dolist (elt lst rv) |
| @@ -175,7 +175,7 @@ Like `some', return the first value of FSS-PRED that is non-nil." | |||
| 175 | (let ((fss-rv (funcall fss-pred fss-this))) | 175 | (let ((fss-rv (funcall fss-pred fss-this))) |
| 176 | (when fss-rv | 176 | (when fss-rv |
| 177 | (throw 'exit fss-rv)))))) | 177 | (throw 'exit fss-rv)))))) |
| 178 | ;(fset 'filesets-some 'some) ;; or use the cl function | 178 | ;(fset 'filesets-some 'cl-some) ;; or use the cl function |
| 179 | 179 | ||
| 180 | (defun filesets-member (fsm-item fsm-lst &rest fsm-keys) | 180 | (defun filesets-member (fsm-item fsm-lst &rest fsm-keys) |
| 181 | "Find the first occurrence of FSM-ITEM in FSM-LST. | 181 | "Find the first occurrence of FSM-ITEM in FSM-LST. |
| @@ -186,7 +186,7 @@ key is supported." | |||
| 186 | (filesets-ormap (lambda (fsm-this) | 186 | (filesets-ormap (lambda (fsm-this) |
| 187 | (funcall fsm-test fsm-item fsm-this)) | 187 | (funcall fsm-test fsm-item fsm-this)) |
| 188 | fsm-lst))) | 188 | fsm-lst))) |
| 189 | ;(fset 'filesets-member 'member*) ;; or use the cl function | 189 | ;(fset 'filesets-member 'cl-member) ;; or use the cl function |
| 190 | 190 | ||
| 191 | (defun filesets-sublist (lst beg &optional end) | 191 | (defun filesets-sublist (lst beg &optional end) |
| 192 | "Get the sublist of LST from BEG to END - 1." | 192 | "Get the sublist of LST from BEG to END - 1." |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 34eb28f0965..006b415b180 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,47 @@ | |||
| 1 | 2013-07-10 David Engster <deng@randomsample.de> | ||
| 2 | |||
| 3 | * gnus-start.el (gnus-clean-old-newsrc): Always remove 'unexist' marks | ||
| 4 | if `gnus-newsrc-file-version' does not match `gnus-version'. This | ||
| 5 | fixes a bug in Emacs trunk where the 'unexist' marks were always | ||
| 6 | removed at startup because "Gnus v5.13" was considered smaller than "Ma | ||
| 7 | Gnus v0.03". | ||
| 8 | |||
| 9 | 2013-07-10 Tassilo Horn <tsdh@gnu.org> | ||
| 10 | |||
| 11 | * gnus.el (gnus-summary-line-format): Reference | ||
| 12 | `gnus-user-date-format-alist' for the &user-date; format, not | ||
| 13 | `gnus-summary-user-date-format-alist'. | ||
| 14 | |||
| 15 | 2013-07-08 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 16 | |||
| 17 | * nnml.el (nnml-request-compact-group): Don't bug out if we can't | ||
| 18 | delete files (bug#13481). | ||
| 19 | |||
| 20 | 2013-07-08 Tassilo Horn <tsdh@gnu.org> | ||
| 21 | |||
| 22 | * gnus-registry.el (gnus-registry-remove-extra-data): New function. | ||
| 23 | |||
| 24 | 2013-07-06 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 25 | |||
| 26 | * gnus-art.el (gnus-block-private-groups): Allow `global' methods to | ||
| 27 | display images. | ||
| 28 | |||
| 29 | * gnus.el (gnus-valid-select-methods): Mark nnrss as global. | ||
| 30 | |||
| 31 | * message.el (message-cancel-news): According to | ||
| 32 | <mailman.216.1372942181.12400.help-gnu-emacs@gnu.org>, "cancel" is | ||
| 33 | preferred over "cmsg cancel" in the Subject. | ||
| 34 | |||
| 35 | * nnir.el (nnir-engines): Note that the group specs are regexps | ||
| 36 | (bug#13238). | ||
| 37 | |||
| 38 | * gnus-msg.el (gnus-copy-article-buffer): If the article buffer has | ||
| 39 | gotten read-only text properties, ensure that those aren't heeded when | ||
| 40 | copying stuff over (bug#13434). | ||
| 41 | |||
| 42 | * mm-view.el (mm-inline-text-html): Don't bug out on multipart messages | ||
| 43 | (bug#13762). | ||
| 44 | |||
| 1 | 2013-07-05 David Kastrup <dak@gnu.org> | 45 | 2013-07-05 David Kastrup <dak@gnu.org> |
| 2 | 46 | ||
| 3 | * auth-source.el (auth-source-netrc-parse-one): Allow empty strings in | 47 | * auth-source.el (auth-source-netrc-parse-one): Allow empty strings in |
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 5840aacd7a3..b41ff9c0550 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -6947,7 +6947,8 @@ If given a prefix, show the hidden text instead." | |||
| 6947 | (set-buffer buf)))))) | 6947 | (set-buffer buf)))))) |
| 6948 | 6948 | ||
| 6949 | (defun gnus-block-private-groups (group) | 6949 | (defun gnus-block-private-groups (group) |
| 6950 | (if (gnus-news-group-p group) | 6950 | (if (or (gnus-news-group-p group) |
| 6951 | (gnus-member-of-valid 'global group)) | ||
| 6951 | ;; Block nothing in news groups. | 6952 | ;; Block nothing in news groups. |
| 6952 | nil | 6953 | nil |
| 6953 | ;; Block everything anywhere else. | 6954 | ;; Block everything anywhere else. |
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index fce9a3633c2..e3f18662af4 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el | |||
| @@ -920,6 +920,7 @@ header line with the old Message-ID." | |||
| 920 | (with-current-buffer article-buffer | 920 | (with-current-buffer article-buffer |
| 921 | (let ((gnus-newsgroup-charset (or gnus-article-charset | 921 | (let ((gnus-newsgroup-charset (or gnus-article-charset |
| 922 | gnus-newsgroup-charset)) | 922 | gnus-newsgroup-charset)) |
| 923 | (inhibit-read-only t) | ||
| 923 | (gnus-newsgroup-ignored-charsets | 924 | (gnus-newsgroup-ignored-charsets |
| 924 | (or gnus-article-ignored-charsets | 925 | (or gnus-article-ignored-charsets |
| 925 | gnus-newsgroup-ignored-charsets))) | 926 | gnus-newsgroup-ignored-charsets))) |
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 5a7dfd82d28..6f2fe78c3d8 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el | |||
| @@ -1186,6 +1186,29 @@ data stored in the registry." | |||
| 1186 | (gnus-select-group-with-message-id group message-id) t) | 1186 | (gnus-select-group-with-message-id group message-id) t) |
| 1187 | (throw 'found t)))))))) | 1187 | (throw 'found t)))))))) |
| 1188 | 1188 | ||
| 1189 | (defun gnus-registry-remove-extra-data (extra) | ||
| 1190 | "Remove tracked EXTRA data from the gnus registry. | ||
| 1191 | EXTRA is a list of symbols. Valid symbols are those contained in | ||
| 1192 | the docs of `gnus-registry-track-extra'. This command is useful | ||
| 1193 | when you stop tracking some extra data and now want to purge it | ||
| 1194 | from your existing entries." | ||
| 1195 | (interactive (list (mapcar 'intern | ||
| 1196 | (completing-read-multiple | ||
| 1197 | "Extra data: " | ||
| 1198 | '("subject" "sender" "recipient"))))) | ||
| 1199 | (when extra | ||
| 1200 | (let ((db gnus-registry-db)) | ||
| 1201 | (registry-reindex db) | ||
| 1202 | (loop for k being the hash-keys of (oref db :data) | ||
| 1203 | using (hash-value v) | ||
| 1204 | do (let ((newv (delq nil (mapcar #'(lambda (entry) | ||
| 1205 | (unless (member (car entry) extra) | ||
| 1206 | entry)) | ||
| 1207 | v)))) | ||
| 1208 | (registry-delete db (list k) nil) | ||
| 1209 | (gnus-registry-insert db k newv))) | ||
| 1210 | (registry-reindex db)))) | ||
| 1211 | |||
| 1189 | ;; TODO: a few things | 1212 | ;; TODO: a few things |
| 1190 | 1213 | ||
| 1191 | (provide 'gnus-registry) | 1214 | (provide 'gnus-registry) |
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 084af884930..94803800e0b 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el | |||
| @@ -2314,8 +2314,9 @@ If FORCE is non-nil, the .newsrc file is read." | |||
| 2314 | (gnus-info-set-marks | 2314 | (gnus-info-set-marks |
| 2315 | info (delete exist (gnus-info-marks info)))))) | 2315 | info (delete exist (gnus-info-marks info)))))) |
| 2316 | (when (or force | 2316 | (when (or force |
| 2317 | (< (gnus-continuum-version gnus-newsrc-file-version) | 2317 | (not (string= gnus-newsrc-file-version gnus-version))) |
| 2318 | (gnus-continuum-version "Ma Gnus v0.03"))) | 2318 | (message (concat "Removing unexist marks because newsrc " |
| 2319 | "version does not match Gnus version.")) | ||
| 2319 | ;; Remove old `exist' marks from old nnimap groups. | 2320 | ;; Remove old `exist' marks from old nnimap groups. |
| 2320 | (dolist (info (cdr gnus-newsrc-alist)) | 2321 | (dolist (info (cdr gnus-newsrc-alist)) |
| 2321 | (let ((exist (assoc 'unexist (gnus-info-marks info)))) | 2322 | (let ((exist (assoc 'unexist (gnus-info-marks info)))) |
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 9a927a1cfab..8741a03b54d 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el | |||
| @@ -1628,7 +1628,7 @@ slower." | |||
| 1628 | ("nnfolder" mail respool address) | 1628 | ("nnfolder" mail respool address) |
| 1629 | ("nngateway" post-mail address prompt-address physical-address) | 1629 | ("nngateway" post-mail address prompt-address physical-address) |
| 1630 | ("nnweb" none) | 1630 | ("nnweb" none) |
| 1631 | ("nnrss" none) | 1631 | ("nnrss" none global) |
| 1632 | ("nnagent" post-mail) | 1632 | ("nnagent" post-mail) |
| 1633 | ("nnimap" post-mail address prompt-address physical-address respool | 1633 | ("nnimap" post-mail address prompt-address physical-address respool |
| 1634 | server-marks) | 1634 | server-marks) |
| @@ -3007,7 +3007,7 @@ with some simple extensions. | |||
| 3007 | summary just like information from any other summary | 3007 | summary just like information from any other summary |
| 3008 | specifier. | 3008 | specifier. |
| 3009 | &user-date; Age sensitive date format. Various date format is | 3009 | &user-date; Age sensitive date format. Various date format is |
| 3010 | defined in `gnus-summary-user-date-format-alist'. | 3010 | defined in `gnus-user-date-format-alist'. |
| 3011 | 3011 | ||
| 3012 | 3012 | ||
| 3013 | The %U (status), %R (replied) and %z (zcore) specs have to be handled | 3013 | The %U (status), %R (replied) and %z (zcore) specs have to be handled |
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index c6f5d904677..b35eb9dca12 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -7145,7 +7145,7 @@ If ARG, allow editing of the cancellation message." | |||
| 7145 | (erase-buffer) | 7145 | (erase-buffer) |
| 7146 | (insert "Newsgroups: " newsgroups "\n" | 7146 | (insert "Newsgroups: " newsgroups "\n" |
| 7147 | "From: " from "\n" | 7147 | "From: " from "\n" |
| 7148 | "Subject: cmsg cancel " message-id "\n" | 7148 | "Subject: cancel " message-id "\n" |
| 7149 | "Control: cancel " message-id "\n" | 7149 | "Control: cancel " message-id "\n" |
| 7150 | (if distribution | 7150 | (if distribution |
| 7151 | (concat "Distribution: " distribution "\n") | 7151 | (concat "Distribution: " distribution "\n") |
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index b1cba27c335..9512a411d81 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el | |||
| @@ -419,16 +419,18 @@ | |||
| 419 | (buffer-string))))) | 419 | (buffer-string))))) |
| 420 | 420 | ||
| 421 | (defun mm-inline-text-html (handle) | 421 | (defun mm-inline-text-html (handle) |
| 422 | (let* ((func mm-text-html-renderer) | 422 | (if (stringp (car handle)) |
| 423 | (entry (assq func mm-text-html-renderer-alist)) | 423 | (mapcar 'mm-inline-text-html (cdr handle)) |
| 424 | (inhibit-read-only t)) | 424 | (let* ((func mm-text-html-renderer) |
| 425 | (if entry | 425 | (entry (assq func mm-text-html-renderer-alist)) |
| 426 | (setq func (cdr entry))) | 426 | (inhibit-read-only t)) |
| 427 | (cond | 427 | (if entry |
| 428 | ((functionp func) | 428 | (setq func (cdr entry))) |
| 429 | (funcall func handle)) | 429 | (cond |
| 430 | (t | 430 | ((functionp func) |
| 431 | (apply (car func) handle (cdr func)))))) | 431 | (funcall func handle)) |
| 432 | (t | ||
| 433 | (apply (car func) handle (cdr func))))))) | ||
| 432 | 434 | ||
| 433 | (defun mm-inline-text-vcard (handle) | 435 | (defun mm-inline-text-vcard (handle) |
| 434 | (let ((inhibit-read-only t)) | 436 | (let ((inhibit-read-only t)) |
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 22dee30e8fa..4dd123bf2c7 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el | |||
| @@ -548,15 +548,15 @@ that it is for notmuch, not Namazu." | |||
| 548 | (gmane nnir-run-gmane | 548 | (gmane nnir-run-gmane |
| 549 | ((gmane-author . "Gmane Author: "))) | 549 | ((gmane-author . "Gmane Author: "))) |
| 550 | (swish++ nnir-run-swish++ | 550 | (swish++ nnir-run-swish++ |
| 551 | ((swish++-group . "Swish++ Group spec: "))) | 551 | ((swish++-group . "Swish++ Group spec (regexp): "))) |
| 552 | (swish-e nnir-run-swish-e | 552 | (swish-e nnir-run-swish-e |
| 553 | ((swish-e-group . "Swish-e Group spec: "))) | 553 | ((swish-e-group . "Swish-e Group spec (regexp): "))) |
| 554 | (namazu nnir-run-namazu | 554 | (namazu nnir-run-namazu |
| 555 | ()) | 555 | ()) |
| 556 | (notmuch nnir-run-notmuch | 556 | (notmuch nnir-run-notmuch |
| 557 | ()) | 557 | ()) |
| 558 | (hyrex nnir-run-hyrex | 558 | (hyrex nnir-run-hyrex |
| 559 | ((hyrex-group . "Hyrex Group spec: "))) | 559 | ((hyrex-group . "Hyrex Group spec (regexp): "))) |
| 560 | (find-grep nnir-run-find-grep | 560 | (find-grep nnir-run-find-grep |
| 561 | ((grep-options . "Grep options: ")))) | 561 | ((grep-options . "Grep options: ")))) |
| 562 | "Alist of supported search engines. | 562 | "Alist of supported search engines. |
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 64e1ee11977..05d0c902340 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el | |||
| @@ -1094,7 +1094,10 @@ Use the nov database for the current group if available." | |||
| 1094 | (concat group ":" new-number-string))) | 1094 | (concat group ":" new-number-string))) |
| 1095 | ;; Save to the new file: | 1095 | ;; Save to the new file: |
| 1096 | (nnmail-write-region (point-min) (point-max) newfile)) | 1096 | (nnmail-write-region (point-min) (point-max) newfile)) |
| 1097 | (funcall nnmail-delete-file-function oldfile)) | 1097 | (condition-case () |
| 1098 | (funcall nnmail-delete-file-function oldfile) | ||
| 1099 | (file-error | ||
| 1100 | (message "Couldn't delete %s" oldfile)))) | ||
| 1098 | ;; 2/ Update all marks for this article: | 1101 | ;; 2/ Update all marks for this article: |
| 1099 | ;; #### NOTE: it is possible that the new article number | 1102 | ;; #### NOTE: it is possible that the new article number |
| 1100 | ;; #### already belongs to a range, whereas the corresponding | 1103 | ;; #### already belongs to a range, whereas the corresponding |
diff --git a/lisp/ido.el b/lisp/ido.el index f695ec117f1..9c4e56544cb 100644 --- a/lisp/ido.el +++ b/lisp/ido.el | |||
| @@ -3461,8 +3461,14 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3461 | (setq ido-virtual-buffers nil) | 3461 | (setq ido-virtual-buffers nil) |
| 3462 | (let (name) | 3462 | (let (name) |
| 3463 | (dolist (head recentf-list) | 3463 | (dolist (head recentf-list) |
| 3464 | (and (setq name (file-name-nondirectory head)) | 3464 | (setq name (file-name-nondirectory head)) |
| 3465 | (null (get-file-buffer head)) | 3465 | ;; In case HEAD is a directory with trailing /. See bug#14552. |
| 3466 | (when (equal name "") | ||
| 3467 | (setq name (file-name-nondirectory (directory-file-name head)))) | ||
| 3468 | (when (equal name "") | ||
| 3469 | (setq name head)) | ||
| 3470 | (and (not (equal name "")) | ||
| 3471 | (null (get-file-buffer head)) | ||
| 3466 | (not (assoc name ido-virtual-buffers)) | 3472 | (not (assoc name ido-virtual-buffers)) |
| 3467 | (not (member name ido-temp-list)) | 3473 | (not (member name ido-temp-list)) |
| 3468 | (not (ido-ignore-item-p name ido-ignore-buffers)) | 3474 | (not (ido-ignore-item-p name ido-ignore-buffers)) |
| @@ -4721,9 +4727,12 @@ Modified from `icomplete-completions'." | |||
| 4721 | 4727 | ||
| 4722 | ;;; Helper functions for other programs | 4728 | ;;; Helper functions for other programs |
| 4723 | 4729 | ||
| 4724 | (put 'dired-do-rename 'ido 'ignore) | ||
| 4725 | (put 'ibuffer-find-file 'ido 'find-file) | 4730 | (put 'ibuffer-find-file 'ido 'find-file) |
| 4731 | (put 'dired 'ido 'dir) | ||
| 4726 | (put 'dired-other-window 'ido 'dir) | 4732 | (put 'dired-other-window 'ido 'dir) |
| 4733 | ;; See http://debbugs.gnu.org/11954 for reasons. | ||
| 4734 | (put 'dired-do-copy 'ido 'ignore) | ||
| 4735 | (put 'dired-do-rename 'ido 'ignore) | ||
| 4727 | 4736 | ||
| 4728 | ;;;###autoload | 4737 | ;;;###autoload |
| 4729 | (defun ido-read-buffer (prompt &optional default require-match) | 4738 | (defun ido-read-buffer (prompt &optional default require-match) |
| @@ -4754,9 +4763,7 @@ See `read-file-name' for additional parameters." | |||
| 4754 | (eq (get this-command 'ido) 'dir) | 4763 | (eq (get this-command 'ido) 'dir) |
| 4755 | (memq this-command ido-read-file-name-as-directory-commands)) | 4764 | (memq this-command ido-read-file-name-as-directory-commands)) |
| 4756 | (setq filename | 4765 | (setq filename |
| 4757 | (ido-read-directory-name prompt dir default-filename mustmatch initial)) | 4766 | (ido-read-directory-name prompt dir default-filename mustmatch initial))) |
| 4758 | (if (eq ido-exit 'fallback) | ||
| 4759 | (setq filename 'fallback))) | ||
| 4760 | ((and (not (eq (get this-command 'ido) 'ignore)) | 4767 | ((and (not (eq (get this-command 'ido) 'ignore)) |
| 4761 | (not (memq this-command ido-read-file-name-non-ido)) | 4768 | (not (memq this-command ido-read-file-name-non-ido)) |
| 4762 | (or (null predicate) (eq predicate 'file-exists-p))) | 4769 | (or (null predicate) (eq predicate 'file-exists-p))) |
| @@ -4776,7 +4783,15 @@ See `read-file-name' for additional parameters." | |||
| 4776 | (ido-find-literal nil)) | 4783 | (ido-find-literal nil)) |
| 4777 | (setq ido-exit nil) | 4784 | (setq ido-exit nil) |
| 4778 | (setq filename | 4785 | (setq filename |
| 4779 | (ido-read-internal 'file prompt 'ido-file-history default-filename mustmatch initial)) | 4786 | (ido-read-internal 'file prompt 'ido-file-history |
| 4787 | (cond ; Bug#11861. | ||
| 4788 | ((stringp default-filename) default-filename) | ||
| 4789 | ((consp default-filename) (car default-filename)) | ||
| 4790 | ((and (not default-filename) initial) | ||
| 4791 | (expand-file-name initial dir)) | ||
| 4792 | (buffer-file-name buffer-file-name)) | ||
| 4793 | mustmatch initial)) | ||
| 4794 | (setq dir ido-current-directory) ; See bug#1516. | ||
| 4780 | (cond | 4795 | (cond |
| 4781 | ((eq ido-exit 'fallback) | 4796 | ((eq ido-exit 'fallback) |
| 4782 | (setq filename 'fallback)) | 4797 | (setq filename 'fallback)) |
| @@ -4808,12 +4823,21 @@ See `read-directory-name' for additional parameters." | |||
| 4808 | (ido-directory-too-big-p ido-current-directory))) | 4823 | (ido-directory-too-big-p ido-current-directory))) |
| 4809 | (ido-work-directory-index -1) | 4824 | (ido-work-directory-index -1) |
| 4810 | (ido-work-file-index -1)) | 4825 | (ido-work-file-index -1)) |
| 4811 | (setq filename | 4826 | (setq filename (ido-read-internal |
| 4812 | (ido-read-internal 'dir prompt 'ido-file-history default-dirname mustmatch initial)) | 4827 | 'dir prompt 'ido-file-history |
| 4813 | (if filename | 4828 | (or default-dirname ; Bug#11861. |
| 4814 | (if (and (stringp filename) (string-equal filename ".")) | 4829 | (if initial |
| 4815 | ido-current-directory | 4830 | (expand-file-name initial ido-current-directory) |
| 4816 | (concat ido-current-directory filename))))) | 4831 | ido-current-directory)) |
| 4832 | mustmatch initial)) | ||
| 4833 | (cond | ||
| 4834 | ((eq ido-exit 'fallback) | ||
| 4835 | (let ((read-file-name-function nil)) | ||
| 4836 | (run-hook-with-args 'ido-before-fallback-functions 'read-directory-name) | ||
| 4837 | (read-directory-name prompt ido-current-directory | ||
| 4838 | default-dirname mustmatch initial))) | ||
| 4839 | ((equal filename ".") ido-current-directory) | ||
| 4840 | (t (concat ido-current-directory filename))))) | ||
| 4817 | 4841 | ||
| 4818 | ;;;###autoload | 4842 | ;;;###autoload |
| 4819 | (defun ido-completing-read (prompt choices &optional _predicate require-match | 4843 | (defun ido-completing-read (prompt choices &optional _predicate require-match |
diff --git a/lisp/net/shr.el b/lisp/net/shr.el index bdc30bc9292..4506ede8722 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el | |||
| @@ -145,6 +145,7 @@ cid: URL as the argument.") | |||
| 145 | (define-key map [follow-link] 'mouse-face) | 145 | (define-key map [follow-link] 'mouse-face) |
| 146 | (define-key map "I" 'shr-insert-image) | 146 | (define-key map "I" 'shr-insert-image) |
| 147 | (define-key map "w" 'shr-copy-url) | 147 | (define-key map "w" 'shr-copy-url) |
| 148 | (define-key map "u" 'shr-copy-url) | ||
| 148 | (define-key map "v" 'shr-browse-url) | 149 | (define-key map "v" 'shr-browse-url) |
| 149 | (define-key map "o" 'shr-save-contents) | 150 | (define-key map "o" 'shr-save-contents) |
| 150 | (define-key map "\r" 'shr-browse-url) | 151 | (define-key map "\r" 'shr-browse-url) |
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 4c6141fe42b..f7f570590c8 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el | |||
| @@ -38,9 +38,11 @@ | |||
| 38 | ;; | 38 | ;; |
| 39 | ;; - localname is a string. This are temporary properties, which are | 39 | ;; - localname is a string. This are temporary properties, which are |
| 40 | ;; related to the file localname is referring to. Examples: | 40 | ;; related to the file localname is referring to. Examples: |
| 41 | ;; "file-exists-p" is t or nile, depending on the file existence, or | 41 | ;; "file-exists-p" is t or nil, depending on the file existence, or |
| 42 | ;; "file-attributes" caches the result of the function | 42 | ;; "file-attributes" caches the result of the function |
| 43 | ;; `file-attributes'. | 43 | ;; `file-attributes'. These entries have a timestamp, and they |
| 44 | ;; expire after `remote-file-name-inhibit-cache' seconds if this | ||
| 45 | ;; variable is set. | ||
| 44 | ;; | 46 | ;; |
| 45 | ;; - The key is a process. This are temporary properties related to | 47 | ;; - The key is a process. This are temporary properties related to |
| 46 | ;; an open connection. Examples: "scripts" keeps shell script | 48 | ;; an open connection. Examples: "scripts" keeps shell script |
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 6ba055b8bb8..c2fdc0491b6 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el | |||
| @@ -1539,7 +1539,8 @@ connection if a previous connection has died for some reason." | |||
| 1539 | ;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint" | 1539 | ;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint" |
| 1540 | ;; file property. | 1540 | ;; file property. |
| 1541 | (with-timeout | 1541 | (with-timeout |
| 1542 | (60 | 1542 | ((or (tramp-get-method-parameter method 'tramp-connection-timeout) |
| 1543 | tramp-connection-timeout) | ||
| 1543 | (if (zerop (length (tramp-file-name-user vec))) | 1544 | (if (zerop (length (tramp-file-name-user vec))) |
| 1544 | (tramp-error | 1545 | (tramp-error |
| 1545 | vec 'file-error | 1546 | vec 'file-error |
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index d7316b8d2ea..281f497692d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -222,21 +222,24 @@ detected as prompt when being sent on echoing hosts, therefore.") | |||
| 222 | (tramp-login-program "su") | 222 | (tramp-login-program "su") |
| 223 | (tramp-login-args (("-") ("%u"))) | 223 | (tramp-login-args (("-") ("%u"))) |
| 224 | (tramp-remote-shell "/bin/sh") | 224 | (tramp-remote-shell "/bin/sh") |
| 225 | (tramp-remote-shell-args ("-c")))) | 225 | (tramp-remote-shell-args ("-c")) |
| 226 | (tramp-connection-timeout 10))) | ||
| 226 | ;;;###tramp-autoload | 227 | ;;;###tramp-autoload |
| 227 | (add-to-list 'tramp-methods | 228 | (add-to-list 'tramp-methods |
| 228 | '("sudo" | 229 | '("sudo" |
| 229 | (tramp-login-program "sudo") | 230 | (tramp-login-program "sudo") |
| 230 | (tramp-login-args (("-u" "%u") ("-s") ("-H") ("-p" "Password:"))) | 231 | (tramp-login-args (("-u" "%u") ("-s") ("-H") ("-p" "Password:"))) |
| 231 | (tramp-remote-shell "/bin/sh") | 232 | (tramp-remote-shell "/bin/sh") |
| 232 | (tramp-remote-shell-args ("-c")))) | 233 | (tramp-remote-shell-args ("-c")) |
| 234 | (tramp-connection-timeout 10))) | ||
| 233 | ;;;###tramp-autoload | 235 | ;;;###tramp-autoload |
| 234 | (add-to-list 'tramp-methods | 236 | (add-to-list 'tramp-methods |
| 235 | '("ksu" | 237 | '("ksu" |
| 236 | (tramp-login-program "ksu") | 238 | (tramp-login-program "ksu") |
| 237 | (tramp-login-args (("%u") ("-q"))) | 239 | (tramp-login-args (("%u") ("-q"))) |
| 238 | (tramp-remote-shell "/bin/sh") | 240 | (tramp-remote-shell "/bin/sh") |
| 239 | (tramp-remote-shell-args ("-c")))) | 241 | (tramp-remote-shell-args ("-c")) |
| 242 | (tramp-connection-timeout 10))) | ||
| 240 | ;;;###tramp-autoload | 243 | ;;;###tramp-autoload |
| 241 | (add-to-list 'tramp-methods | 244 | (add-to-list 'tramp-methods |
| 242 | '("krlogin" | 245 | '("krlogin" |
| @@ -3752,12 +3755,16 @@ file exists and nonzero exit status otherwise." | |||
| 3752 | "Wait for shell prompt and barf if none appears. | 3755 | "Wait for shell prompt and barf if none appears. |
| 3753 | Looks at process PROC to see if a shell prompt appears in TIMEOUT | 3756 | Looks at process PROC to see if a shell prompt appears in TIMEOUT |
| 3754 | seconds. If not, it produces an error message with the given ERROR-ARGS." | 3757 | seconds. If not, it produces an error message with the given ERROR-ARGS." |
| 3755 | (unless | 3758 | (let ((vec (tramp-get-connection-property proc "vector" nil))) |
| 3756 | (tramp-wait-for-regexp | 3759 | (condition-case err |
| 3757 | proc timeout | 3760 | (tramp-wait-for-regexp |
| 3758 | (format | 3761 | proc timeout |
| 3759 | "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern)) | 3762 | (format |
| 3760 | (apply 'tramp-error-with-buffer nil proc 'file-error error-args))) | 3763 | "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern)) |
| 3764 | (error | ||
| 3765 | (delete-process proc) | ||
| 3766 | (apply 'tramp-error-with-buffer | ||
| 3767 | (tramp-get-connection-buffer vec) vec 'file-error error-args))))) | ||
| 3761 | 3768 | ||
| 3762 | (defun tramp-open-connection-setup-interactive-shell (proc vec) | 3769 | (defun tramp-open-connection-setup-interactive-shell (proc vec) |
| 3763 | "Set up an interactive shell. | 3770 | "Set up an interactive shell. |
| @@ -4332,9 +4339,6 @@ Gateway hops are already opened." | |||
| 4332 | ;; Result. | 4339 | ;; Result. |
| 4333 | target-alist)) | 4340 | target-alist)) |
| 4334 | 4341 | ||
| 4335 | (defvar tramp-current-connection nil | ||
| 4336 | "Last connection timestamp.") | ||
| 4337 | |||
| 4338 | (defun tramp-maybe-open-connection (vec) | 4342 | (defun tramp-maybe-open-connection (vec) |
| 4339 | "Maybe open a connection VEC. | 4343 | "Maybe open a connection VEC. |
| 4340 | Does not do anything if a connection is already open, but re-opens the | 4344 | Does not do anything if a connection is already open, but re-opens the |
| @@ -4348,7 +4352,7 @@ connection if a previous connection has died for some reason." | |||
| 4348 | ;; If Tramp opens the same connection within a short time frame, | 4352 | ;; If Tramp opens the same connection within a short time frame, |
| 4349 | ;; there is a problem. We shall signal this. | 4353 | ;; there is a problem. We shall signal this. |
| 4350 | (unless (or (and p (processp p) (memq (process-status p) '(run open))) | 4354 | (unless (or (and p (processp p) (memq (process-status p) '(run open))) |
| 4351 | (not (equal (butlast (append vec nil)) | 4355 | (not (equal (butlast (append vec nil) 2) |
| 4352 | (car tramp-current-connection))) | 4356 | (car tramp-current-connection))) |
| 4353 | (> (tramp-time-diff | 4357 | (> (tramp-time-diff |
| 4354 | (current-time) (cdr tramp-current-connection)) | 4358 | (current-time) (cdr tramp-current-connection)) |
| @@ -4433,7 +4437,7 @@ connection if a previous connection has died for some reason." | |||
| 4433 | (set-process-sentinel p 'tramp-process-sentinel) | 4437 | (set-process-sentinel p 'tramp-process-sentinel) |
| 4434 | (tramp-compat-set-process-query-on-exit-flag p nil) | 4438 | (tramp-compat-set-process-query-on-exit-flag p nil) |
| 4435 | (setq tramp-current-connection | 4439 | (setq tramp-current-connection |
| 4436 | (cons (butlast (append vec nil)) (current-time)) | 4440 | (cons (butlast (append vec nil) 2) (current-time)) |
| 4437 | tramp-current-host (system-name)) | 4441 | tramp-current-host (system-name)) |
| 4438 | 4442 | ||
| 4439 | (tramp-message | 4443 | (tramp-message |
| @@ -4441,8 +4445,8 @@ connection if a previous connection has died for some reason." | |||
| 4441 | 4445 | ||
| 4442 | ;; Check whether process is alive. | 4446 | ;; Check whether process is alive. |
| 4443 | (tramp-barf-if-no-shell-prompt | 4447 | (tramp-barf-if-no-shell-prompt |
| 4444 | p 60 | 4448 | p 10 |
| 4445 | "Couldn't find local shell prompt %s" tramp-encoding-shell) | 4449 | "Couldn't find local shell prompt for %s" tramp-encoding-shell) |
| 4446 | 4450 | ||
| 4447 | ;; Now do all the connections as specified. | 4451 | ;; Now do all the connections as specified. |
| 4448 | (while target-alist | 4452 | (while target-alist |
| @@ -4460,6 +4464,9 @@ connection if a previous connection has died for some reason." | |||
| 4460 | (async-args | 4464 | (async-args |
| 4461 | (tramp-get-method-parameter | 4465 | (tramp-get-method-parameter |
| 4462 | l-method 'tramp-async-args)) | 4466 | l-method 'tramp-async-args)) |
| 4467 | (connection-timeout | ||
| 4468 | (tramp-get-method-parameter | ||
| 4469 | l-method 'tramp-connection-timeout)) | ||
| 4463 | (gw-args | 4470 | (gw-args |
| 4464 | (tramp-get-method-parameter l-method 'tramp-gw-args)) | 4471 | (tramp-get-method-parameter l-method 'tramp-gw-args)) |
| 4465 | (gw (tramp-get-file-property hop "" "gateway" nil)) | 4472 | (gw (tramp-get-file-property hop "" "gateway" nil)) |
| @@ -4542,7 +4549,8 @@ connection if a previous connection has died for some reason." | |||
| 4542 | (tramp-message vec 3 "Sending command `%s'" command) | 4549 | (tramp-message vec 3 "Sending command `%s'" command) |
| 4543 | (tramp-send-command vec command t t) | 4550 | (tramp-send-command vec command t t) |
| 4544 | (tramp-process-actions | 4551 | (tramp-process-actions |
| 4545 | p vec pos tramp-actions-before-shell 60) | 4552 | p vec pos tramp-actions-before-shell |
| 4553 | (or connection-timeout tramp-connection-timeout)) | ||
| 4546 | (tramp-message | 4554 | (tramp-message |
| 4547 | vec 3 "Found remote shell prompt on `%s'" l-host)) | 4555 | vec 3 "Found remote shell prompt on `%s'" l-host)) |
| 4548 | ;; Next hop. | 4556 | ;; Next hop. |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f114c681fb7..3513701d20e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -252,6 +252,11 @@ pair of the form (KEY VALUE). The following KEYs are defined: | |||
| 252 | * `tramp-tmpdir' | 252 | * `tramp-tmpdir' |
| 253 | A directory on the remote host for temporary files. If not | 253 | A directory on the remote host for temporary files. If not |
| 254 | specified, \"/tmp\" is taken as default. | 254 | specified, \"/tmp\" is taken as default. |
| 255 | * `tramp-connection-timeout' | ||
| 256 | This is the maximum time to be spent for establishing a connection. | ||
| 257 | In general, the global default value shall be used, but for | ||
| 258 | some methods, like \"su\" or \"sudo\", a shorter timeout | ||
| 259 | might be desirable. | ||
| 255 | 260 | ||
| 256 | What does all this mean? Well, you should specify `tramp-login-program' | 261 | What does all this mean? Well, you should specify `tramp-login-program' |
| 257 | for all methods; this program is used to log in to the remote site. Then, | 262 | for all methods; this program is used to log in to the remote site. Then, |
| @@ -1034,6 +1039,13 @@ opening a connection to a remote host." | |||
| 1034 | :group 'tramp | 1039 | :group 'tramp |
| 1035 | :type '(choice (const nil) (const t) (const pty))) | 1040 | :type '(choice (const nil) (const t) (const pty))) |
| 1036 | 1041 | ||
| 1042 | (defcustom tramp-connection-timeout 60 | ||
| 1043 | "Defines the max time to wait for establishing a connection (in seconds). | ||
| 1044 | This can be overwritten for different connection types in `tramp-methods'." | ||
| 1045 | :group 'tramp | ||
| 1046 | :version "24.4" | ||
| 1047 | :type 'integer) | ||
| 1048 | |||
| 1037 | (defcustom tramp-connection-min-time-diff 5 | 1049 | (defcustom tramp-connection-min-time-diff 5 |
| 1038 | "Defines seconds between two consecutive connection attempts. | 1050 | "Defines seconds between two consecutive connection attempts. |
| 1039 | This is necessary as self defense mechanism, in order to avoid | 1051 | This is necessary as self defense mechanism, in order to avoid |
| @@ -1071,6 +1083,9 @@ means to use always cached values for the directory contents." | |||
| 1071 | (defvar tramp-current-host nil | 1083 | (defvar tramp-current-host nil |
| 1072 | "Remote host for this *tramp* buffer.") | 1084 | "Remote host for this *tramp* buffer.") |
| 1073 | 1085 | ||
| 1086 | (defvar tramp-current-connection nil | ||
| 1087 | "Last connection timestamp.") | ||
| 1088 | |||
| 1074 | ;;;###autoload | 1089 | ;;;###autoload |
| 1075 | (defconst tramp-completion-file-name-handler-alist | 1090 | (defconst tramp-completion-file-name-handler-alist |
| 1076 | '((file-name-all-completions . tramp-completion-handle-file-name-all-completions) | 1091 | '((file-name-all-completions . tramp-completion-handle-file-name-all-completions) |
| @@ -1464,10 +1479,6 @@ ARGS to actually emit the message (if applicable)." | |||
| 1464 | This variable is used to disable messages from `tramp-error'. | 1479 | This variable is used to disable messages from `tramp-error'. |
| 1465 | The messages are visible anyway, because an error is raised.") | 1480 | The messages are visible anyway, because an error is raised.") |
| 1466 | 1481 | ||
| 1467 | (defvar tramp-message-show-progress-reporter-message t | ||
| 1468 | "Show Tramp progress reporter message in the minibuffer. | ||
| 1469 | This variable is used to disable recursive progress reporter messages.") | ||
| 1470 | |||
| 1471 | (defsubst tramp-message (vec-or-proc level fmt-string &rest args) | 1482 | (defsubst tramp-message (vec-or-proc level fmt-string &rest args) |
| 1472 | "Emit a message depending on verbosity level. | 1483 | "Emit a message depending on verbosity level. |
| 1473 | VEC-OR-PROC identifies the Tramp buffer to use. It can be either a | 1484 | VEC-OR-PROC identifies the Tramp buffer to use. It can be either a |
| @@ -1536,23 +1547,32 @@ signal identifier to be raised, remaining args passed to | |||
| 1536 | If BUFFER is nil, show the connection buffer. Wait for 30\", or until | 1547 | If BUFFER is nil, show the connection buffer. Wait for 30\", or until |
| 1537 | an input event arrives. The other arguments are passed to `tramp-error'." | 1548 | an input event arrives. The other arguments are passed to `tramp-error'." |
| 1538 | (save-window-excursion | 1549 | (save-window-excursion |
| 1539 | (unwind-protect | 1550 | (let* ((buf (or (and (bufferp buffer) buffer) |
| 1540 | (apply 'tramp-error vec-or-proc signal fmt-string args) | 1551 | (and (processp vec-or-proc) (process-buffer vec-or-proc)) |
| 1541 | (when (and vec-or-proc | 1552 | (and (vectorp vec-or-proc) |
| 1542 | tramp-message-show-message | 1553 | (tramp-get-connection-buffer vec-or-proc)))) |
| 1543 | (not (zerop tramp-verbose)) | 1554 | (vec (or (and (vectorp vec-or-proc) vec-or-proc) |
| 1544 | (not (tramp-completion-mode-p))) | 1555 | (and buf (with-current-buffer buf |
| 1545 | (let ((enable-recursive-minibuffers t)) | 1556 | (tramp-dissect-file-name default-directory)))))) |
| 1546 | (pop-to-buffer | 1557 | (unwind-protect |
| 1547 | (or (and (bufferp buffer) buffer) | 1558 | (apply 'tramp-error vec-or-proc signal fmt-string args) |
| 1548 | (and (processp vec-or-proc) (process-buffer vec-or-proc)) | 1559 | ;; Save exit. |
| 1549 | (tramp-get-connection-buffer vec-or-proc))) | 1560 | (when (and buf |
| 1550 | (when (string-equal fmt-string "Process died") | 1561 | tramp-message-show-message |
| 1551 | (message | 1562 | (not (zerop tramp-verbose)) |
| 1552 | "%s\n %s" | 1563 | (not (tramp-completion-mode-p))) |
| 1553 | "Tramp failed to connect. If this happens repeatedly, try" | 1564 | (let ((enable-recursive-minibuffers t)) |
| 1554 | "`M-x tramp-cleanup-this-connection'")) | 1565 | ;; `tramp-error' does not show messages. So we must do it |
| 1555 | (sit-for 30)))))) | 1566 | ;; ourselves. |
| 1567 | (message fmt-string args) | ||
| 1568 | ;; Show buffer. | ||
| 1569 | (pop-to-buffer buf) | ||
| 1570 | (discard-input) | ||
| 1571 | (sit-for 30))) | ||
| 1572 | ;; Reset timestamp. It would be wrong after waiting for a while. | ||
| 1573 | (when (equal (butlast (append vec nil) 2) | ||
| 1574 | (car tramp-current-connection)) | ||
| 1575 | (setcdr tramp-current-connection (current-time))))))) | ||
| 1556 | 1576 | ||
| 1557 | (defmacro with-parsed-tramp-file-name (filename var &rest body) | 1577 | (defmacro with-parsed-tramp-file-name (filename var &rest body) |
| 1558 | "Parse a Tramp filename and make components available in the body. | 1578 | "Parse a Tramp filename and make components available in the body. |
| @@ -1596,16 +1616,15 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', | |||
| 1596 | 1616 | ||
| 1597 | (defmacro with-tramp-progress-reporter (vec level message &rest body) | 1617 | (defmacro with-tramp-progress-reporter (vec level message &rest body) |
| 1598 | "Executes BODY, spinning a progress reporter with MESSAGE. | 1618 | "Executes BODY, spinning a progress reporter with MESSAGE. |
| 1599 | If LEVEL does not fit for visible messages, or if this is a | 1619 | If LEVEL does not fit for visible messages, there are only traces |
| 1600 | nested call of the macro, there are only traces without a visible | 1620 | without a visible progress reporter." |
| 1601 | progress reporter." | ||
| 1602 | (declare (indent 3) (debug t)) | 1621 | (declare (indent 3) (debug t)) |
| 1603 | `(let (pr tm) | 1622 | `(let ((result "failed") |
| 1623 | pr tm) | ||
| 1604 | (tramp-message ,vec ,level "%s..." ,message) | 1624 | (tramp-message ,vec ,level "%s..." ,message) |
| 1605 | ;; We start a pulsing progress reporter after 3 seconds. Feature | 1625 | ;; We start a pulsing progress reporter after 3 seconds. Feature |
| 1606 | ;; introduced in Emacs 24.1. | 1626 | ;; introduced in Emacs 24.1. |
| 1607 | (when (and tramp-message-show-progress-reporter-message | 1627 | (when (and tramp-message-show-message |
| 1608 | tramp-message-show-message | ||
| 1609 | ;; Display only when there is a minimum level. | 1628 | ;; Display only when there is a minimum level. |
| 1610 | (<= ,level (min tramp-verbose 3))) | 1629 | (<= ,level (min tramp-verbose 3))) |
| 1611 | (ignore-errors | 1630 | (ignore-errors |
| @@ -1613,14 +1632,11 @@ progress reporter." | |||
| 1613 | tm (when pr | 1632 | tm (when pr |
| 1614 | (run-at-time 3 0.1 'tramp-progress-reporter-update pr))))) | 1633 | (run-at-time 3 0.1 'tramp-progress-reporter-update pr))))) |
| 1615 | (unwind-protect | 1634 | (unwind-protect |
| 1616 | ;; Execute the body. Suppress concurrent progress reporter | 1635 | ;; Execute the body. |
| 1617 | ;; messages. | 1636 | (prog1 (progn ,@body) (setq result "done")) |
| 1618 | (let ((tramp-message-show-progress-reporter-message | ||
| 1619 | (and tramp-message-show-progress-reporter-message (not tm)))) | ||
| 1620 | ,@body) | ||
| 1621 | ;; Stop progress reporter. | 1637 | ;; Stop progress reporter. |
| 1622 | (if tm (tramp-compat-funcall 'cancel-timer tm)) | 1638 | (if tm (tramp-compat-funcall 'cancel-timer tm)) |
| 1623 | (tramp-message ,vec ,level "%s...done" ,message)))) | 1639 | (tramp-message ,vec ,level "%s...%s" ,message result)))) |
| 1624 | 1640 | ||
| 1625 | (tramp-compat-font-lock-add-keywords | 1641 | (tramp-compat-font-lock-add-keywords |
| 1626 | 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>")) | 1642 | 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>")) |
| @@ -3393,39 +3409,49 @@ The terminal type can be configured with `tramp-terminal-type'." | |||
| 3393 | PROC and VEC indicate the remote connection to be used. POS, if | 3409 | PROC and VEC indicate the remote connection to be used. POS, if |
| 3394 | set, is the starting point of the region to be deleted in the | 3410 | set, is the starting point of the region to be deleted in the |
| 3395 | connection buffer." | 3411 | connection buffer." |
| 3396 | ;; Preserve message for `progress-reporter'. | 3412 | ;; Enable `auth-source' and `password-cache'. We must use |
| 3397 | (tramp-compat-with-temp-message "" | 3413 | ;; tramp-current-* variables in case we have several hops. |
| 3398 | ;; Enable `auth-source' and `password-cache'. We must use | 3414 | (tramp-set-connection-property |
| 3399 | ;; tramp-current-* variables in case we have several hops. | 3415 | (tramp-dissect-file-name |
| 3400 | (tramp-set-connection-property | 3416 | (tramp-make-tramp-file-name |
| 3401 | (tramp-dissect-file-name | 3417 | tramp-current-method tramp-current-user tramp-current-host "")) |
| 3402 | (tramp-make-tramp-file-name | 3418 | "first-password-request" t) |
| 3403 | tramp-current-method tramp-current-user tramp-current-host "")) | 3419 | (save-restriction |
| 3404 | "first-password-request" t) | 3420 | (with-tramp-progress-reporter |
| 3405 | (save-restriction | 3421 | proc 3 "Waiting for prompts from remote shell" |
| 3406 | (let (exit) | 3422 | (let (exit) |
| 3407 | (while (not exit) | 3423 | (if timeout |
| 3408 | (tramp-message proc 3 "Waiting for prompts from remote shell") | 3424 | (with-timeout (timeout (setq exit 'timeout)) |
| 3409 | (setq exit | 3425 | (while (not exit) |
| 3410 | (catch 'tramp-action | 3426 | (setq exit |
| 3411 | (if timeout | 3427 | (catch 'tramp-action |
| 3412 | (with-timeout (timeout) | 3428 | (tramp-process-one-action proc vec actions))))) |
| 3413 | (tramp-process-one-action proc vec actions)) | 3429 | (while (not exit) |
| 3430 | (setq exit | ||
| 3431 | (catch 'tramp-action | ||
| 3414 | (tramp-process-one-action proc vec actions))))) | 3432 | (tramp-process-one-action proc vec actions))))) |
| 3415 | (with-current-buffer (tramp-get-connection-buffer vec) | 3433 | (with-current-buffer (tramp-get-connection-buffer vec) |
| 3416 | (widen) | 3434 | (widen) |
| 3417 | (tramp-message vec 6 "\n%s" (buffer-string))) | 3435 | (tramp-message vec 6 "\n%s" (buffer-string))) |
| 3418 | (unless (eq exit 'ok) | 3436 | (unless (eq exit 'ok) |
| 3419 | (tramp-clear-passwd vec) | 3437 | (tramp-clear-passwd vec) |
| 3438 | (delete-process proc) | ||
| 3420 | (tramp-error-with-buffer | 3439 | (tramp-error-with-buffer |
| 3421 | nil vec 'file-error | 3440 | (tramp-get-connection-buffer vec) vec 'file-error |
| 3422 | (cond | 3441 | (cond |
| 3423 | ((eq exit 'permission-denied) "Permission denied") | 3442 | ((eq exit 'permission-denied) "Permission denied") |
| 3424 | ((eq exit 'process-died) "Process died") | 3443 | ((eq exit 'process-died) |
| 3425 | (t "Login failed")))) | 3444 | (concat |
| 3426 | (when (numberp pos) | 3445 | "Tramp failed to connect. If this happens repeatedly, try\n" |
| 3427 | (with-current-buffer (tramp-get-connection-buffer vec) | 3446 | " `M-x tramp-cleanup-this-connection'")) |
| 3428 | (let (buffer-read-only) (delete-region pos (point))))))))) | 3447 | ((eq exit 'timeout) |
| 3448 | (format | ||
| 3449 | "Timeout reached, see buffer `%s' for details" | ||
| 3450 | (tramp-get-connection-buffer vec))) | ||
| 3451 | (t "Login failed"))))) | ||
| 3452 | (when (numberp pos) | ||
| 3453 | (with-current-buffer (tramp-get-connection-buffer vec) | ||
| 3454 | (let (buffer-read-only) (delete-region pos (point)))))))) | ||
| 3429 | 3455 | ||
| 3430 | :;; Utility functions: | 3456 | :;; Utility functions: |
| 3431 | 3457 | ||
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 55d5b8b0be7..85a9074760d 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el | |||
| @@ -387,10 +387,10 @@ Intended as the value of `indent-line-function'." | |||
| 387 | (skip-chars-forward " \t") | 387 | (skip-chars-forward " \t") |
| 388 | (current-column))) | 388 | (current-column))) |
| 389 | (error nil))) | 389 | (error nil))) |
| 390 | ;; Inside a string and it starts before this line. | 390 | ;; Inside a string and it starts before this line: do nothing. |
| 391 | ((and (nth 3 parse) | 391 | ((and (nth 3 parse) |
| 392 | (< (nth 8 parse) (save-excursion (beginning-of-line) (point)))) | 392 | (< (nth 8 parse) (save-excursion (beginning-of-line) (point)))) |
| 393 | (indent-line-to 0)) | 393 | ) |
| 394 | 394 | ||
| 395 | ;; Inside a defun, but not a nested list (depth is 1). This is | 395 | ;; Inside a defun, but not a nested list (depth is 1). This is |
| 396 | ;; a promise, usually. | 396 | ;; a promise, usually. |
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 4957b58d469..6a71ab330a8 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el | |||
| @@ -33,12 +33,12 @@ | |||
| 33 | 33 | ||
| 34 | ;;; Code: | 34 | ;;; Code: |
| 35 | 35 | ||
| 36 | (require 'cl-lib) | ||
| 36 | (require 'easymenu) | 37 | (require 'easymenu) |
| 37 | (require 'view) | 38 | (require 'view) |
| 38 | (require 'ebuff-menu) | 39 | (require 'ebuff-menu) |
| 39 | 40 | ||
| 40 | (eval-when-compile | 41 | (eval-when-compile |
| 41 | (require 'cl-lib) | ||
| 42 | (require 'helper)) | 42 | (require 'helper)) |
| 43 | 43 | ||
| 44 | 44 | ||
| @@ -233,19 +233,6 @@ Compare items with `eq' or TEST if specified." | |||
| 233 | found)) | 233 | found)) |
| 234 | 234 | ||
| 235 | 235 | ||
| 236 | (defun ebrowse-delete-if-not (predicate list) | ||
| 237 | "Remove elements not satisfying PREDICATE from LIST and return the result. | ||
| 238 | This is a destructive operation." | ||
| 239 | (let (result) | ||
| 240 | (while list | ||
| 241 | (let ((next (cdr list))) | ||
| 242 | (when (funcall predicate (car list)) | ||
| 243 | (setq result (nconc result list)) | ||
| 244 | (setf (cdr list) nil)) | ||
| 245 | (setq list next))) | ||
| 246 | result)) | ||
| 247 | |||
| 248 | |||
| 249 | (defmacro ebrowse-output (&rest body) | 236 | (defmacro ebrowse-output (&rest body) |
| 250 | "Eval BODY with a writable current buffer. | 237 | "Eval BODY with a writable current buffer. |
| 251 | Preserve buffer's modified state." | 238 | Preserve buffer's modified state." |
| @@ -1310,17 +1297,17 @@ With PREFIX, insert that many filenames." | |||
| 1310 | 1297 | ||
| 1311 | (defun ebrowse-browser-buffer-list () | 1298 | (defun ebrowse-browser-buffer-list () |
| 1312 | "Return a list of all tree or member buffers." | 1299 | "Return a list of all tree or member buffers." |
| 1313 | (ebrowse-delete-if-not 'ebrowse-buffer-p (buffer-list))) | 1300 | (cl-delete-if-not 'ebrowse-buffer-p (buffer-list))) |
| 1314 | 1301 | ||
| 1315 | 1302 | ||
| 1316 | (defun ebrowse-member-buffer-list () | 1303 | (defun ebrowse-member-buffer-list () |
| 1317 | "Return a list of all member buffers." | 1304 | "Return a list of all member buffers." |
| 1318 | (ebrowse-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) | 1305 | (cl-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) |
| 1319 | 1306 | ||
| 1320 | 1307 | ||
| 1321 | (defun ebrowse-tree-buffer-list () | 1308 | (defun ebrowse-tree-buffer-list () |
| 1322 | "Return a list of all tree buffers." | 1309 | "Return a list of all tree buffers." |
| 1323 | (ebrowse-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) | 1310 | (cl-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) |
| 1324 | 1311 | ||
| 1325 | 1312 | ||
| 1326 | (defun ebrowse-known-class-trees-buffer-list () | 1313 | (defun ebrowse-known-class-trees-buffer-list () |
| @@ -1341,7 +1328,7 @@ one buffer. Prefer tree buffers over member buffers." | |||
| 1341 | 1328 | ||
| 1342 | (defun ebrowse-same-tree-member-buffer-list () | 1329 | (defun ebrowse-same-tree-member-buffer-list () |
| 1343 | "Return a list of members buffers with same tree as current buffer." | 1330 | "Return a list of members buffers with same tree as current buffer." |
| 1344 | (ebrowse-delete-if-not | 1331 | (cl-delete-if-not |
| 1345 | (lambda (buffer) | 1332 | (lambda (buffer) |
| 1346 | (eq (buffer-local-value 'ebrowse--tree buffer) | 1333 | (eq (buffer-local-value 'ebrowse--tree buffer) |
| 1347 | ebrowse--tree)) | 1334 | ebrowse--tree)) |
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 2c4d6a0e3d7..10472ec5815 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el | |||
| @@ -1759,6 +1759,9 @@ static char *magick[] = { | |||
| 1759 | As long as GDB is in the recursive reading loop, it does not expect | 1759 | As long as GDB is in the recursive reading loop, it does not expect |
| 1760 | commands to be prefixed by \"-interpreter-exec console\".") | 1760 | commands to be prefixed by \"-interpreter-exec console\".") |
| 1761 | 1761 | ||
| 1762 | (defun gdb-strip-string-backslash (string) | ||
| 1763 | (replace-regexp-in-string "\\\\$" "" string)) | ||
| 1764 | |||
| 1762 | (defun gdb-send (proc string) | 1765 | (defun gdb-send (proc string) |
| 1763 | "A comint send filter for gdb." | 1766 | "A comint send filter for gdb." |
| 1764 | (with-current-buffer gud-comint-buffer | 1767 | (with-current-buffer gud-comint-buffer |
| @@ -1766,10 +1769,15 @@ commands to be prefixed by \"-interpreter-exec console\".") | |||
| 1766 | (remove-text-properties (point-min) (point-max) '(face)))) | 1769 | (remove-text-properties (point-min) (point-max) '(face)))) |
| 1767 | ;; mimic <RET> key to repeat previous command in GDB | 1770 | ;; mimic <RET> key to repeat previous command in GDB |
| 1768 | (if (not (string= "" string)) | 1771 | (if (not (string= "" string)) |
| 1769 | (setq gdb-last-command string) | 1772 | (if gdb-continuation |
| 1770 | (if gdb-last-command (setq string gdb-last-command))) | 1773 | (setq gdb-last-command (concat gdb-continuation |
| 1771 | (if (or (string-match "^-" string) | 1774 | (gdb-strip-string-backslash string) |
| 1772 | (> gdb-control-level 0)) | 1775 | " ")) |
| 1776 | (setq gdb-last-command (gdb-strip-string-backslash string))) | ||
| 1777 | (if gdb-last-command (setq string gdb-last-command)) | ||
| 1778 | (setq gdb-continuation nil)) | ||
| 1779 | (if (and (not gdb-continuation) (or (string-match "^-" string) | ||
| 1780 | (> gdb-control-level 0))) | ||
| 1773 | ;; Either MI command or we are feeding GDB's recursive reading loop. | 1781 | ;; Either MI command or we are feeding GDB's recursive reading loop. |
| 1774 | (progn | 1782 | (progn |
| 1775 | (setq gdb-first-done-or-error t) | 1783 | (setq gdb-first-done-or-error t) |
| @@ -1779,10 +1787,13 @@ commands to be prefixed by \"-interpreter-exec console\".") | |||
| 1779 | (setq gdb-control-level (1- gdb-control-level)))) | 1787 | (setq gdb-control-level (1- gdb-control-level)))) |
| 1780 | ;; CLI command | 1788 | ;; CLI command |
| 1781 | (if (string-match "\\\\$" string) | 1789 | (if (string-match "\\\\$" string) |
| 1782 | (setq gdb-continuation (concat gdb-continuation string "\n")) | 1790 | (setq gdb-continuation |
| 1791 | (concat gdb-continuation (gdb-strip-string-backslash | ||
| 1792 | string) | ||
| 1793 | " ")) | ||
| 1783 | (setq gdb-first-done-or-error t) | 1794 | (setq gdb-first-done-or-error t) |
| 1784 | (let ((to-send (concat "-interpreter-exec console " | 1795 | (let ((to-send (concat "-interpreter-exec console " |
| 1785 | (gdb-mi-quote string) | 1796 | (gdb-mi-quote (concat gdb-continuation string " ")) |
| 1786 | "\n"))) | 1797 | "\n"))) |
| 1787 | (if gdb-enable-debug | 1798 | (if gdb-enable-debug |
| 1788 | (push (cons 'mi-send to-send) gdb-debug-log)) | 1799 | (push (cons 'mi-send to-send) gdb-debug-log)) |
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 5f92d197a66..06dffd80d88 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el | |||
| @@ -1351,7 +1351,7 @@ If the result is do-end block, it will always be multiline." | |||
| 1351 | (progn | 1351 | (progn |
| 1352 | (eval-and-compile | 1352 | (eval-and-compile |
| 1353 | (defconst ruby-percent-literal-beg-re | 1353 | (defconst ruby-percent-literal-beg-re |
| 1354 | "\\(%\\)[qQrswWx]?\\([[:punct:]]\\)" | 1354 | "\\(%\\)[qQrswWxIi]?\\([[:punct:]]\\)" |
| 1355 | "Regexp to match the beginning of percent literal.") | 1355 | "Regexp to match the beginning of percent literal.") |
| 1356 | 1356 | ||
| 1357 | (defconst ruby-syntax-methods-before-regexp | 1357 | (defconst ruby-syntax-methods-before-regexp |
| @@ -1387,7 +1387,7 @@ It will be properly highlighted even when the call omits parens.") | |||
| 1387 | (funcall | 1387 | (funcall |
| 1388 | (syntax-propertize-rules | 1388 | (syntax-propertize-rules |
| 1389 | ;; $' $" $` .... are variables. | 1389 | ;; $' $" $` .... are variables. |
| 1390 | ;; ?' ?" ?` are ascii codes. | 1390 | ;; ?' ?" ?` are character literals (one-char strings in 1.9+). |
| 1391 | ("\\([?$]\\)[#\"'`]" | 1391 | ("\\([?$]\\)[#\"'`]" |
| 1392 | (1 (unless (save-excursion | 1392 | (1 (unless (save-excursion |
| 1393 | ;; Not within a string. | 1393 | ;; Not within a string. |
| @@ -1518,7 +1518,7 @@ It will be properly highlighted even when the call omits parens.") | |||
| 1518 | (save-match-data | 1518 | (save-match-data |
| 1519 | (save-excursion | 1519 | (save-excursion |
| 1520 | (goto-char (nth 8 parse-state)) | 1520 | (goto-char (nth 8 parse-state)) |
| 1521 | (looking-at "%\\(?:[QWrx]\\|\\W\\)"))))))) | 1521 | (looking-at "%\\(?:[QWrxI]\\|\\W\\)"))))))) |
| 1522 | 1522 | ||
| 1523 | (defun ruby-syntax-propertize-expansions (start end) | 1523 | (defun ruby-syntax-propertize-expansions (start end) |
| 1524 | (save-excursion | 1524 | (save-excursion |
| @@ -1721,7 +1721,7 @@ See `font-lock-syntax-table'.") | |||
| 1721 | (defconst ruby-font-lock-keywords | 1721 | (defconst ruby-font-lock-keywords |
| 1722 | (list | 1722 | (list |
| 1723 | ;; functions | 1723 | ;; functions |
| 1724 | '("^\\s *def\\s +\\([^( \t\n]+\\)" | 1724 | '("^\\s *def\\s +\\(?:[^( \t\n.]*\\.\\)?\\([^( \t\n]+\\)" |
| 1725 | 1 font-lock-function-name-face) | 1725 | 1 font-lock-function-name-face) |
| 1726 | (list (concat | 1726 | (list (concat |
| 1727 | "\\(^\\|[^.@$]\\|\\.\\.\\)\\(" | 1727 | "\\(^\\|[^.@$]\\|\\.\\.\\)\\(" |
| @@ -1809,7 +1809,6 @@ See `font-lock-syntax-table'.") | |||
| 1809 | "warn" | 1809 | "warn" |
| 1810 | ;; keyword-like private methods on Module | 1810 | ;; keyword-like private methods on Module |
| 1811 | "alias_method" | 1811 | "alias_method" |
| 1812 | "autoload" | ||
| 1813 | "attr" | 1812 | "attr" |
| 1814 | "attr_accessor" | 1813 | "attr_accessor" |
| 1815 | "attr_reader" | 1814 | "attr_reader" |
| @@ -1850,14 +1849,17 @@ See `font-lock-syntax-table'.") | |||
| 1850 | 0 font-lock-variable-name-face) | 1849 | 0 font-lock-variable-name-face) |
| 1851 | ;; constants | 1850 | ;; constants |
| 1852 | '("\\(?:\\_<\\|::\\)\\([A-Z]+\\(\\w\\|_\\)*\\)" | 1851 | '("\\(?:\\_<\\|::\\)\\([A-Z]+\\(\\w\\|_\\)*\\)" |
| 1853 | 1 font-lock-type-face) | 1852 | 1 (unless (eq ?\( (char-after)) font-lock-type-face)) |
| 1854 | '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face) | 1853 | '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face) |
| 1855 | ;; expression expansion | 1854 | ;; expression expansion |
| 1856 | '(ruby-match-expression-expansion | 1855 | '(ruby-match-expression-expansion |
| 1857 | 2 font-lock-variable-name-face t) | 1856 | 2 font-lock-variable-name-face t) |
| 1858 | ;; warn lower camel case | 1857 | ;; negation char |
| 1859 | ;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)" | 1858 | '("[^[:alnum:]_]\\(!\\)[^=]" |
| 1860 | ; 0 font-lock-warning-face) | 1859 | 1 font-lock-negation-char-face) |
| 1860 | ;; character literals | ||
| 1861 | ;; FIXME: Support longer escape sequences. | ||
| 1862 | '("\\?\\\\?\\S " 0 font-lock-string-face) | ||
| 1861 | ) | 1863 | ) |
| 1862 | "Additional expressions to highlight in Ruby mode.") | 1864 | "Additional expressions to highlight in Ruby mode.") |
| 1863 | 1865 | ||
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index ec6e6e7ff10..3e7789069f9 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el | |||
| @@ -74,6 +74,7 @@ | |||
| 74 | 74 | ||
| 75 | ;;; Code: | 75 | ;;; Code: |
| 76 | 76 | ||
| 77 | (require 'cl-lib) | ||
| 77 | (require 'ange-ftp) | 78 | (require 'ange-ftp) |
| 78 | 79 | ||
| 79 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 80 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| @@ -180,15 +181,6 @@ created by `shadow-define-regexp-group'.") | |||
| 180 | (setq list (cdr list))) | 181 | (setq list (cdr list))) |
| 181 | (car list)) | 182 | (car list)) |
| 182 | 183 | ||
| 183 | (defun shadow-remove-if (func list) | ||
| 184 | "Remove elements satisfying FUNC from LIST. | ||
| 185 | Nondestructive; actually returns a copy of the list with the elements removed." | ||
| 186 | (if list | ||
| 187 | (if (funcall func (car list)) | ||
| 188 | (shadow-remove-if func (cdr list)) | ||
| 189 | (cons (car list) (shadow-remove-if func (cdr list)))) | ||
| 190 | nil)) | ||
| 191 | |||
| 192 | (defun shadow-regexp-superquote (string) | 184 | (defun shadow-regexp-superquote (string) |
| 193 | "Like `regexp-quote', but includes the ^ and $. | 185 | "Like `regexp-quote', but includes the ^ and $. |
| 194 | This makes sure regexp matches nothing but STRING." | 186 | This makes sure regexp matches nothing but STRING." |
| @@ -238,9 +230,8 @@ instead." | |||
| 238 | Replace old definition, if any. PRIMARY and REGEXP are the | 230 | Replace old definition, if any. PRIMARY and REGEXP are the |
| 239 | information defining the cluster. For interactive use, call | 231 | information defining the cluster. For interactive use, call |
| 240 | `shadow-define-cluster' instead." | 232 | `shadow-define-cluster' instead." |
| 241 | (let ((rest (shadow-remove-if | 233 | (let ((rest (cl-remove-if (lambda (x) (equal name (car x))) |
| 242 | (function (lambda (x) (equal name (car x)))) | 234 | shadow-clusters))) |
| 243 | shadow-clusters))) | ||
| 244 | (setq shadow-clusters | 235 | (setq shadow-clusters |
| 245 | (cons (shadow-make-cluster name primary regexp) | 236 | (cons (shadow-make-cluster name primary regexp) |
| 246 | rest)))) | 237 | rest)))) |
| @@ -602,9 +593,8 @@ and to are absolute file names." | |||
| 602 | Consider them as regular expressions if third arg REGEXP is true." | 593 | Consider them as regular expressions if third arg REGEXP is true." |
| 603 | (if groups | 594 | (if groups |
| 604 | (let ((nonmatching | 595 | (let ((nonmatching |
| 605 | (shadow-remove-if | 596 | (cl-remove-if (lambda (x) (shadow-file-match x file regexp)) |
| 606 | (function (lambda (x) (shadow-file-match x file regexp))) | 597 | (car groups)))) |
| 607 | (car groups)))) | ||
| 608 | (append (cond ((equal nonmatching (car groups)) nil) | 598 | (append (cond ((equal nonmatching (car groups)) nil) |
| 609 | (regexp | 599 | (regexp |
| 610 | (let ((realname (nth 2 (shadow-parse-fullname file)))) | 600 | (let ((realname (nth 2 (shadow-parse-fullname file)))) |
| @@ -635,8 +625,7 @@ Consider them as regular expressions if third arg REGEXP is true." | |||
| 635 | "Remove PAIR from `shadow-files-to-copy'. | 625 | "Remove PAIR from `shadow-files-to-copy'. |
| 636 | PAIR must be `eq' to one of the elements of that list." | 626 | PAIR must be `eq' to one of the elements of that list." |
| 637 | (setq shadow-files-to-copy | 627 | (setq shadow-files-to-copy |
| 638 | (shadow-remove-if (function (lambda (s) (eq s pair))) | 628 | (cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy))) |
| 639 | shadow-files-to-copy))) | ||
| 640 | 629 | ||
| 641 | (defun shadow-read-files () | 630 | (defun shadow-read-files () |
| 642 | "Visit and load `shadow-info-file' and `shadow-todo-file'. | 631 | "Visit and load `shadow-info-file' and `shadow-todo-file'. |
diff --git a/lisp/simple.el b/lisp/simple.el index b4b8ddfabed..9158452fd64 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -4602,6 +4602,12 @@ for it.") | |||
| 4602 | (defun next-line (&optional arg try-vscroll) | 4602 | (defun next-line (&optional arg try-vscroll) |
| 4603 | "Move cursor vertically down ARG lines. | 4603 | "Move cursor vertically down ARG lines. |
| 4604 | Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. | 4604 | Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. |
| 4605 | Non-interactively, use TRY-VSCROLL to control whether to vscroll tall | ||
| 4606 | lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this | ||
| 4607 | function will not vscroll. | ||
| 4608 | |||
| 4609 | ARG defaults to 1. | ||
| 4610 | |||
| 4605 | If there is no character in the target line exactly under the current column, | 4611 | If there is no character in the target line exactly under the current column, |
| 4606 | the cursor is positioned after the character in that line which spans this | 4612 | the cursor is positioned after the character in that line which spans this |
| 4607 | column, or at the end of the line if it is not long enough. | 4613 | column, or at the end of the line if it is not long enough. |
| @@ -4646,6 +4652,12 @@ and more reliable (no dependence on goal column, etc.)." | |||
| 4646 | (defun previous-line (&optional arg try-vscroll) | 4652 | (defun previous-line (&optional arg try-vscroll) |
| 4647 | "Move cursor vertically up ARG lines. | 4653 | "Move cursor vertically up ARG lines. |
| 4648 | Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. | 4654 | Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. |
| 4655 | Non-interactively, use TRY-VSCROLL to control whether to vscroll tall | ||
| 4656 | lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this | ||
| 4657 | function will not vscroll. | ||
| 4658 | |||
| 4659 | ARG defaults to 1. | ||
| 4660 | |||
| 4649 | If there is no character in the target line exactly over the current column, | 4661 | If there is no character in the target line exactly over the current column, |
| 4650 | the cursor is positioned after the character in that line which spans this | 4662 | the cursor is positioned after the character in that line which spans this |
| 4651 | column, or at the end of the line if it is not long enough. | 4663 | column, or at the end of the line if it is not long enough. |
| @@ -4725,33 +4737,76 @@ lines." | |||
| 4725 | :group 'editing-basics | 4737 | :group 'editing-basics |
| 4726 | :version "23.1") | 4738 | :version "23.1") |
| 4727 | 4739 | ||
| 4740 | (defun default-font-height () | ||
| 4741 | "Return the height in pixels of the current buffer's default face font." | ||
| 4742 | (cond | ||
| 4743 | ((display-multi-font-p) | ||
| 4744 | (aref (font-info (face-font 'default)) 3)) | ||
| 4745 | (t (frame-char-height)))) | ||
| 4746 | |||
| 4747 | (defun default-line-height () | ||
| 4748 | "Return the pixel height of current buffer's default-face text line. | ||
| 4749 | |||
| 4750 | The value includes `line-spacing', if any, defined for the buffer | ||
| 4751 | or the frame." | ||
| 4752 | (let ((dfh (default-font-height)) | ||
| 4753 | (lsp (if (display-graphic-p) | ||
| 4754 | (or line-spacing | ||
| 4755 | (default-value 'line-spacing) | ||
| 4756 | (frame-parameter nil 'line-spacing) | ||
| 4757 | 0) | ||
| 4758 | 0))) | ||
| 4759 | (if (floatp lsp) | ||
| 4760 | (setq lsp (* dfh lsp))) | ||
| 4761 | (+ dfh lsp))) | ||
| 4762 | |||
| 4763 | (defun window-screen-lines () | ||
| 4764 | "Return the number of screen lines in the text area of the selected window. | ||
| 4765 | |||
| 4766 | This is different from `window-text-height' in that this function counts | ||
| 4767 | lines in units of the height of the font used by the default face displayed | ||
| 4768 | in the window, not in units of the frame's default font, and also accounts | ||
| 4769 | for `line-spacing', if any, defined for the window's buffer or frame. | ||
| 4770 | |||
| 4771 | The value is a floating-point number." | ||
| 4772 | (let ((canonical (window-text-height)) | ||
| 4773 | (fch (frame-char-height)) | ||
| 4774 | (dlh (default-line-height))) | ||
| 4775 | (/ (* (float canonical) fch) dlh))) | ||
| 4776 | |||
| 4728 | ;; Returns non-nil if partial move was done. | 4777 | ;; Returns non-nil if partial move was done. |
| 4729 | (defun line-move-partial (arg noerror to-end) | 4778 | (defun line-move-partial (arg noerror to-end) |
| 4730 | (if (< arg 0) | 4779 | (if (< arg 0) |
| 4731 | ;; Move backward (up). | 4780 | ;; Move backward (up). |
| 4732 | ;; If already vscrolled, reduce vscroll | 4781 | ;; If already vscrolled, reduce vscroll |
| 4733 | (let ((vs (window-vscroll nil t))) | 4782 | (let ((vs (window-vscroll nil t)) |
| 4734 | (when (> vs (frame-char-height)) | 4783 | (dlh (default-line-height))) |
| 4735 | (set-window-vscroll nil (- vs (frame-char-height)) t))) | 4784 | (when (> vs dlh) |
| 4785 | (set-window-vscroll nil (- vs dlh) t))) | ||
| 4736 | 4786 | ||
| 4737 | ;; Move forward (down). | 4787 | ;; Move forward (down). |
| 4738 | (let* ((lh (window-line-height -1)) | 4788 | (let* ((lh (window-line-height -1)) |
| 4789 | (rowh (car lh)) | ||
| 4739 | (vpos (nth 1 lh)) | 4790 | (vpos (nth 1 lh)) |
| 4740 | (ypos (nth 2 lh)) | 4791 | (ypos (nth 2 lh)) |
| 4741 | (rbot (nth 3 lh)) | 4792 | (rbot (nth 3 lh)) |
| 4742 | (this-lh (window-line-height)) | 4793 | (this-lh (window-line-height)) |
| 4743 | (this-height (nth 0 this-lh)) | 4794 | (this-height (car this-lh)) |
| 4744 | (this-ypos (nth 2 this-lh)) | 4795 | (this-ypos (nth 2 this-lh)) |
| 4745 | (fch (frame-char-height)) | 4796 | (dlh (default-line-height)) |
| 4746 | py vs) | 4797 | (wslines (window-screen-lines)) |
| 4798 | py vs last-line) | ||
| 4799 | (if (> (mod wslines 1.0) 0.0) | ||
| 4800 | (setq wslines (round (+ wslines 0.5)))) | ||
| 4747 | (when (or (null lh) | 4801 | (when (or (null lh) |
| 4748 | (>= rbot fch) | 4802 | (>= rbot dlh) |
| 4749 | (<= ypos (- fch)) | 4803 | (<= ypos (- dlh)) |
| 4750 | (null this-lh) | 4804 | (null this-lh) |
| 4751 | (<= this-ypos (- fch))) | 4805 | (<= this-ypos (- dlh))) |
| 4752 | (unless lh | 4806 | (unless lh |
| 4753 | (let ((wend (pos-visible-in-window-p t nil t))) | 4807 | (let ((wend (pos-visible-in-window-p t nil t))) |
| 4754 | (setq rbot (nth 3 wend) | 4808 | (setq rbot (nth 3 wend) |
| 4809 | rowh (nth 4 wend) | ||
| 4755 | vpos (nth 5 wend)))) | 4810 | vpos (nth 5 wend)))) |
| 4756 | (unless this-lh | 4811 | (unless this-lh |
| 4757 | (let ((wstart (pos-visible-in-window-p nil nil t))) | 4812 | (let ((wstart (pos-visible-in-window-p nil nil t))) |
| @@ -4765,35 +4820,57 @@ lines." | |||
| 4765 | (if col-row | 4820 | (if col-row |
| 4766 | (- (cdr col-row) (window-vscroll)) | 4821 | (- (cdr col-row) (window-vscroll)) |
| 4767 | (cdr (posn-col-row ppos)))))) | 4822 | (cdr (posn-col-row ppos)))))) |
| 4823 | ;; VPOS > 0 means the last line is only partially visible. | ||
| 4824 | ;; But if the part that is visible is at least as tall as the | ||
| 4825 | ;; default font, that means the line is actually fully | ||
| 4826 | ;; readable, and something like line-spacing is hidden. So in | ||
| 4827 | ;; that case we accept the last line in the window as still | ||
| 4828 | ;; visible, and consider the margin as starting one line | ||
| 4829 | ;; later. | ||
| 4830 | (if (and vpos (> vpos 0)) | ||
| 4831 | (if (and rowh | ||
| 4832 | (>= rowh (default-font-height)) | ||
| 4833 | (< rowh dlh)) | ||
| 4834 | (setq last-line (min (- wslines scroll-margin) vpos)) | ||
| 4835 | (setq last-line (min (- wslines scroll-margin 1) (1- vpos))))) | ||
| 4768 | (cond | 4836 | (cond |
| 4769 | ;; If last line of window is fully visible, and vscrolling | 4837 | ;; If last line of window is fully visible, and vscrolling |
| 4770 | ;; more would make this line invisible, move forward. | 4838 | ;; more would make this line invisible, move forward. |
| 4771 | ((and (or (< (setq vs (window-vscroll nil t)) fch) | 4839 | ((and (or (< (setq vs (window-vscroll nil t)) dlh) |
| 4772 | (null this-height) | 4840 | (null this-height) |
| 4773 | (<= this-height fch)) | 4841 | (<= this-height dlh)) |
| 4774 | (or (null rbot) (= rbot 0))) | 4842 | (or (null rbot) (= rbot 0))) |
| 4775 | nil) | 4843 | nil) |
| 4776 | ;; If cursor is not in the bottom scroll margin, and the | 4844 | ;; If cursor is not in the bottom scroll margin, and the |
| 4777 | ;; current line is is not too tall, move forward. | 4845 | ;; current line is is not too tall, move forward. |
| 4778 | ((and (or (null this-height) (<= this-height fch)) | 4846 | ((and (or (null this-height) (<= this-height dlh)) |
| 4779 | vpos | 4847 | vpos |
| 4780 | (> vpos 0) | 4848 | (> vpos 0) |
| 4781 | (< py | 4849 | (< py last-line)) |
| 4782 | (min (- (window-text-height) scroll-margin 1) (1- vpos)))) | ||
| 4783 | nil) | 4850 | nil) |
| 4784 | ;; When already vscrolled, we vscroll some more if we can, | 4851 | ;; When already vscrolled, we vscroll some more if we can, |
| 4785 | ;; or clear vscroll and move forward at end of tall image. | 4852 | ;; or clear vscroll and move forward at end of tall image. |
| 4786 | ((> vs 0) | 4853 | ((> vs 0) |
| 4787 | (when (or (and rbot (> rbot 0)) | 4854 | (when (or (and rbot (> rbot 0)) |
| 4788 | (and this-height (> this-height fch))) | 4855 | (and this-height (> this-height dlh))) |
| 4789 | (set-window-vscroll nil (+ vs fch) t))) | 4856 | (set-window-vscroll nil (+ vs dlh) t))) |
| 4790 | ;; If cursor just entered the bottom scroll margin, move forward, | 4857 | ;; If cursor just entered the bottom scroll margin, move forward, |
| 4791 | ;; but also vscroll one line so redisplay won't recenter. | 4858 | ;; but also optionally vscroll one line so redisplay won't recenter. |
| 4792 | ((and vpos | 4859 | ((and vpos |
| 4793 | (> vpos 0) | 4860 | (> vpos 0) |
| 4794 | (= py (min (- (window-text-height) scroll-margin 1) | 4861 | (= py last-line)) |
| 4795 | (1- vpos)))) | 4862 | ;; Don't vscroll if the partially-visible line at window |
| 4796 | (set-window-vscroll nil (frame-char-height) t) | 4863 | ;; bottom has the default height (a.k.a. "just one more text |
| 4864 | ;; line"): in that case, we do want redisplay to behave | ||
| 4865 | ;; normally, i.e. recenter or whatever. | ||
| 4866 | ;; | ||
| 4867 | ;; Note: ROWH + RBOT from the value returned by | ||
| 4868 | ;; pos-visible-in-window-p give the total height of the | ||
| 4869 | ;; partially-visible glyph row at the end of the window. As | ||
| 4870 | ;; we are dealing with floats, we disregard sub-pixel | ||
| 4871 | ;; discrepancies between that and DLH. | ||
| 4872 | (if (and rowh rbot (>= (- (+ rowh rbot) dlh) 1)) | ||
| 4873 | (set-window-vscroll nil dlh t)) | ||
| 4797 | (line-move-1 arg noerror to-end) | 4874 | (line-move-1 arg noerror to-end) |
| 4798 | t) | 4875 | t) |
| 4799 | ;; If there are lines above the last line, scroll-up one line. | 4876 | ;; If there are lines above the last line, scroll-up one line. |
| @@ -4802,7 +4879,7 @@ lines." | |||
| 4802 | t) | 4879 | t) |
| 4803 | ;; Finally, start vscroll. | 4880 | ;; Finally, start vscroll. |
| 4804 | (t | 4881 | (t |
| 4805 | (set-window-vscroll nil (frame-char-height) t))))))) | 4882 | (set-window-vscroll nil dlh t))))))) |
| 4806 | 4883 | ||
| 4807 | 4884 | ||
| 4808 | ;; This is like line-move-1 except that it also performs | 4885 | ;; This is like line-move-1 except that it also performs |
| @@ -4835,11 +4912,14 @@ lines." | |||
| 4835 | (prog1 (line-move-visual arg noerror) | 4912 | (prog1 (line-move-visual arg noerror) |
| 4836 | ;; If we moved into a tall line, set vscroll to make | 4913 | ;; If we moved into a tall line, set vscroll to make |
| 4837 | ;; scrolling through tall images more smooth. | 4914 | ;; scrolling through tall images more smooth. |
| 4838 | (let ((lh (line-pixel-height))) | 4915 | (let ((lh (line-pixel-height)) |
| 4916 | (dlh (default-line-height))) | ||
| 4839 | (if (and (< arg 0) | 4917 | (if (and (< arg 0) |
| 4840 | (< (point) (window-start)) | 4918 | (< (point) (window-start)) |
| 4841 | (> lh (frame-char-height))) | 4919 | (> lh dlh)) |
| 4842 | (set-window-vscroll nil (- lh (frame-char-height)) t)))) | 4920 | (set-window-vscroll |
| 4921 | nil | ||
| 4922 | (- lh dlh) t)))) | ||
| 4843 | (line-move-1 arg noerror to-end))))) | 4923 | (line-move-1 arg noerror to-end))))) |
| 4844 | 4924 | ||
| 4845 | ;; Display-based alternative to line-move-1. | 4925 | ;; Display-based alternative to line-move-1. |
diff --git a/lisp/subr.el b/lisp/subr.el index b2918baf247..a2afe0768c4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1980,7 +1980,7 @@ any other terminator is used itself as input. | |||
| 1980 | The optional argument PROMPT specifies a string to use to prompt the user. | 1980 | The optional argument PROMPT specifies a string to use to prompt the user. |
| 1981 | The variable `read-quoted-char-radix' controls which radix to use | 1981 | The variable `read-quoted-char-radix' controls which radix to use |
| 1982 | for numeric input." | 1982 | for numeric input." |
| 1983 | (let ((message-log-max nil) done (first t) (code 0) char translated) | 1983 | (let ((message-log-max nil) done (first t) (code 0) translated) |
| 1984 | (while (not done) | 1984 | (while (not done) |
| 1985 | (let ((inhibit-quit first) | 1985 | (let ((inhibit-quit first) |
| 1986 | ;; Don't let C-h get the help message--only help function keys. | 1986 | ;; Don't let C-h get the help message--only help function keys. |
| @@ -3853,6 +3853,7 @@ FILE should be the name of a library, with no directory name." | |||
| 3853 | (declare (obsolete eval-after-load "23.2")) | 3853 | (declare (obsolete eval-after-load "23.2")) |
| 3854 | (eval-after-load file (read))) | 3854 | (eval-after-load file (read))) |
| 3855 | 3855 | ||
| 3856 | |||
| 3856 | (defun display-delayed-warnings () | 3857 | (defun display-delayed-warnings () |
| 3857 | "Display delayed warnings from `delayed-warnings-list'. | 3858 | "Display delayed warnings from `delayed-warnings-list'. |
| 3858 | Used from `delayed-warnings-hook' (which see)." | 3859 | Used from `delayed-warnings-hook' (which see)." |
| @@ -3886,6 +3887,12 @@ By default, this hook contains functions to consolidate the | |||
| 3886 | warnings listed in `delayed-warnings-list', display them, and set | 3887 | warnings listed in `delayed-warnings-list', display them, and set |
| 3887 | `delayed-warnings-list' back to nil.") | 3888 | `delayed-warnings-list' back to nil.") |
| 3888 | 3889 | ||
| 3890 | (defun delay-warning (type message &optional level buffer-name) | ||
| 3891 | "Display a delayed warning. | ||
| 3892 | Aside from going through `delayed-warnings-list', this is equivalent | ||
| 3893 | to `display-warning'." | ||
| 3894 | (push (list type message level buffer-name) delayed-warnings-list)) | ||
| 3895 | |||
| 3889 | 3896 | ||
| 3890 | ;;;; invisibility specs | 3897 | ;;;; invisibility specs |
| 3891 | 3898 | ||
diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 3d591303414..8032de85b01 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el | |||
| @@ -57,6 +57,7 @@ | |||
| 57 | ;;; Code: | 57 | ;;; Code: |
| 58 | 58 | ||
| 59 | (require 'dired) | 59 | (require 'dired) |
| 60 | (require 'cl-lib) ; for cl-gensym | ||
| 60 | 61 | ||
| 61 | ;; CUSTOMIZATIONS | 62 | ;; CUSTOMIZATIONS |
| 62 | 63 | ||
| @@ -179,21 +180,6 @@ this value can let another user see some of your images." | |||
| 179 | (make-variable-buffer-local 'thumbs-marked-list) | 180 | (make-variable-buffer-local 'thumbs-marked-list) |
| 180 | (put 'thumbs-marked-list 'permanent-local t) | 181 | (put 'thumbs-marked-list 'permanent-local t) |
| 181 | 182 | ||
| 182 | (defalias 'thumbs-gensym | ||
| 183 | (if (fboundp 'gensym) | ||
| 184 | 'gensym | ||
| 185 | ;; Copied from cl-macs.el | ||
| 186 | (defvar thumbs-gensym-counter 0) | ||
| 187 | (lambda (&optional prefix) | ||
| 188 | "Generate a new uninterned symbol. | ||
| 189 | The name is made by appending a number to PREFIX, default \"G\"." | ||
| 190 | (let ((pfix (if (stringp prefix) prefix "G")) | ||
| 191 | (num (if (integerp prefix) prefix | ||
| 192 | (prog1 thumbs-gensym-counter | ||
| 193 | (setq thumbs-gensym-counter | ||
| 194 | (1+ thumbs-gensym-counter)))))) | ||
| 195 | (make-symbol (format "%s%d" pfix num)))))) | ||
| 196 | |||
| 197 | (defsubst thumbs-temp-dir () | 183 | (defsubst thumbs-temp-dir () |
| 198 | (file-name-as-directory (expand-file-name thumbs-temp-dir))) | 184 | (file-name-as-directory (expand-file-name thumbs-temp-dir))) |
| 199 | 185 | ||
| @@ -202,7 +188,7 @@ The name is made by appending a number to PREFIX, default \"G\"." | |||
| 202 | (format "%s%s-%s.jpg" | 188 | (format "%s%s-%s.jpg" |
| 203 | (thumbs-temp-dir) | 189 | (thumbs-temp-dir) |
| 204 | thumbs-temp-prefix | 190 | thumbs-temp-prefix |
| 205 | (thumbs-gensym "T"))) | 191 | (cl-gensym "T"))) |
| 206 | 192 | ||
| 207 | (defun thumbs-thumbsdir () | 193 | (defun thumbs-thumbsdir () |
| 208 | "Return the current thumbnails directory (from `thumbs-thumbsdir'). | 194 | "Return the current thumbnails directory (from `thumbs-thumbsdir'). |
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index 7a8f399a6ce..e9a6a97409c 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el | |||
| @@ -12,8 +12,8 @@ | |||
| 12 | ;; filed in the Emacs bug reporting system against this file, a copy | 12 | ;; filed in the Emacs bug reporting system against this file, a copy |
| 13 | ;; of the bug report be sent to the maintainer's email address. | 13 | ;; of the bug report be sent to the maintainer's email address. |
| 14 | 14 | ||
| 15 | (defconst ediff-version "2.81.4" "The current version of Ediff") | 15 | (defconst ediff-version "2.81.5" "The current version of Ediff") |
| 16 | (defconst ediff-date "December 7, 2009" "Date of last update") | 16 | (defconst ediff-date "July 4, 2013" "Date of last update") |
| 17 | 17 | ||
| 18 | 18 | ||
| 19 | ;; This file is part of GNU Emacs. | 19 | ;; This file is part of GNU Emacs. |
| @@ -1560,6 +1560,75 @@ With optional NODE, goes to that node." | |||
| 1560 | (add-to-list 'debug-ignored-errors mess)) | 1560 | (add-to-list 'debug-ignored-errors mess)) |
| 1561 | 1561 | ||
| 1562 | 1562 | ||
| 1563 | |||
| 1564 | ;;; Command line interface | ||
| 1565 | |||
| 1566 | ;;;###autoload | ||
| 1567 | (defun ediff-files-command () | ||
| 1568 | (let ((file-a (nth 0 command-line-args-left)) | ||
| 1569 | (file-b (nth 1 command-line-args-left))) | ||
| 1570 | (setq command-line-args-left (nthcdr 2 command-line-args-left)) | ||
| 1571 | (ediff file-a file-b))) | ||
| 1572 | |||
| 1573 | ;;;###autoload | ||
| 1574 | (defun ediff3-files-command () | ||
| 1575 | (let ((file-a (nth 0 command-line-args-left)) | ||
| 1576 | (file-b (nth 1 command-line-args-left)) | ||
| 1577 | (file-c (nth 2 command-line-args-left))) | ||
| 1578 | (setq command-line-args-left (nthcdr 3 command-line-args-left)) | ||
| 1579 | (ediff3 file-a file-b file-c))) | ||
| 1580 | |||
| 1581 | ;;;###autoload | ||
| 1582 | (defun ediff-merge-command () | ||
| 1583 | (let ((file-a (nth 0 command-line-args-left)) | ||
| 1584 | (file-b (nth 1 command-line-args-left))) | ||
| 1585 | (setq command-line-args-left (nthcdr 2 command-line-args-left)) | ||
| 1586 | (ediff-merge-files file-a file-b))) | ||
| 1587 | |||
| 1588 | ;;;###autoload | ||
| 1589 | (defun ediff-merge-with-ancestor-command () | ||
| 1590 | (let ((file-a (nth 0 command-line-args-left)) | ||
| 1591 | (file-b (nth 1 command-line-args-left)) | ||
| 1592 | (ancestor (nth 2 command-line-args-left))) | ||
| 1593 | (setq command-line-args-left (nthcdr 3 command-line-args-left)) | ||
| 1594 | (ediff-merge-files-with-ancestor file-a file-b ancestor))) | ||
| 1595 | |||
| 1596 | ;;;###autoload | ||
| 1597 | (defun ediff-directories-command () | ||
| 1598 | (let ((file-a (nth 0 command-line-args-left)) | ||
| 1599 | (file-b (nth 1 command-line-args-left)) | ||
| 1600 | (regexp (nth 2 command-line-args-left))) | ||
| 1601 | (setq command-line-args-left (nthcdr 3 command-line-args-left)) | ||
| 1602 | (ediff-directories file-a file-b regexp))) | ||
| 1603 | |||
| 1604 | ;;;###autoload | ||
| 1605 | (defun ediff-directories3-command () | ||
| 1606 | (let ((file-a (nth 0 command-line-args-left)) | ||
| 1607 | (file-b (nth 1 command-line-args-left)) | ||
| 1608 | (file-c (nth 2 command-line-args-left)) | ||
| 1609 | (regexp (nth 3 command-line-args-left))) | ||
| 1610 | (setq command-line-args-left (nthcdr 4 command-line-args-left)) | ||
| 1611 | (ediff-directories3 file-a file-b file-c regexp))) | ||
| 1612 | |||
| 1613 | ;;;###autoload | ||
| 1614 | (defun ediff-merge-directories-command () | ||
| 1615 | (let ((file-a (nth 0 command-line-args-left)) | ||
| 1616 | (file-b (nth 1 command-line-args-left)) | ||
| 1617 | (regexp (nth 2 command-line-args-left))) | ||
| 1618 | (setq command-line-args-left (nthcdr 3 command-line-args-left)) | ||
| 1619 | (ediff-merge-directories file-a file-b regexp))) | ||
| 1620 | |||
| 1621 | ;;;###autoload | ||
| 1622 | (defun ediff-merge-directories-with-ancestor-command () | ||
| 1623 | (let ((file-a (nth 0 command-line-args-left)) | ||
| 1624 | (file-b (nth 1 command-line-args-left)) | ||
| 1625 | (ancestor (nth 2 command-line-args-left)) | ||
| 1626 | (regexp (nth 3 command-line-args-left))) | ||
| 1627 | (setq command-line-args-left (nthcdr 4 command-line-args-left)) | ||
| 1628 | (ediff-merge-directories-with-ancestor file-a file-b ancestor regexp))) | ||
| 1629 | |||
| 1630 | |||
| 1631 | |||
| 1563 | (require 'ediff-util) | 1632 | (require 'ediff-util) |
| 1564 | 1633 | ||
| 1565 | (run-hooks 'ediff-load-hook) | 1634 | (run-hooks 'ediff-load-hook) |
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 2dc1e502171..b351d896911 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el | |||
| @@ -55,6 +55,7 @@ | |||
| 55 | ;; See `widget.el'. | 55 | ;; See `widget.el'. |
| 56 | 56 | ||
| 57 | ;;; Code: | 57 | ;;; Code: |
| 58 | (require 'cl-lib) | ||
| 58 | 59 | ||
| 59 | ;;; Compatibility. | 60 | ;;; Compatibility. |
| 60 | 61 | ||
| @@ -221,7 +222,7 @@ minibuffer." | |||
| 221 | ((or widget-menu-minibuffer-flag | 222 | ((or widget-menu-minibuffer-flag |
| 222 | (> (length items) widget-menu-max-shortcuts)) | 223 | (> (length items) widget-menu-max-shortcuts)) |
| 223 | ;; Read the choice of name from the minibuffer. | 224 | ;; Read the choice of name from the minibuffer. |
| 224 | (setq items (widget-remove-if 'stringp items)) | 225 | (setq items (cl-remove-if 'stringp items)) |
| 225 | (let ((val (completing-read (concat title ": ") items nil t))) | 226 | (let ((val (completing-read (concat title ": ") items nil t))) |
| 226 | (if (stringp val) | 227 | (if (stringp val) |
| 227 | (let ((try (try-completion val items))) | 228 | (let ((try (try-completion val items))) |
| @@ -295,14 +296,6 @@ minibuffer." | |||
| 295 | (error "Canceled")) | 296 | (error "Canceled")) |
| 296 | value)))) | 297 | value)))) |
| 297 | 298 | ||
| 298 | (defun widget-remove-if (predicate list) | ||
| 299 | (let (result (tail list)) | ||
| 300 | (while tail | ||
| 301 | (or (funcall predicate (car tail)) | ||
| 302 | (setq result (cons (car tail) result))) | ||
| 303 | (setq tail (cdr tail))) | ||
| 304 | (nreverse result))) | ||
| 305 | |||
| 306 | ;;; Widget text specifications. | 299 | ;;; Widget text specifications. |
| 307 | ;; | 300 | ;; |
| 308 | ;; These functions are for specifying text properties. | 301 | ;; These functions are for specifying text properties. |