diff options
Diffstat (limited to 'lisp')
37 files changed, 940 insertions, 544 deletions
diff --git a/lisp/ChangeLog.trunk b/lisp/ChangeLog.trunk index d087982edee..7ce8b62b333 100644 --- a/lisp/ChangeLog.trunk +++ b/lisp/ChangeLog.trunk | |||
| @@ -1,3 +1,154 @@ | |||
| 1 | 2011-03-30 Leo Liu <sdl.web@gmail.com> | ||
| 2 | |||
| 3 | * abbrev.el (abbrev-edit-save-to-file, abbrev-edit-save-buffer): | ||
| 4 | New commands. | ||
| 5 | (edit-abbrevs-map): Bind them here. | ||
| 6 | (write-abbrev-file): New optinal arg VERBOSE. (Bug#5937) | ||
| 7 | |||
| 8 | 2011-03-29 Ken Manheimer <ken.manheimer@gmail.com> | ||
| 9 | |||
| 10 | * allout.el (allout-hide-by-annotation, allout-flag-region): | ||
| 11 | Reduce possibility of overlay leakage by making them volatile. | ||
| 12 | |||
| 13 | * allout-widgets.el (allout-widgets-tally): Define as nil so the | ||
| 14 | hash is not shared between buffers. Mode initialization is | ||
| 15 | responsible for giving it a useful starting value. | ||
| 16 | (allout-item-span): Reduce possibility of overlay leakage by | ||
| 17 | making them volatile. | ||
| 18 | (allout-widgets-count-buttons-in-region): Add diagnostic function | ||
| 19 | for tracking down button overlay leaks. | ||
| 20 | |||
| 21 | 2011-03-29 Leo Liu <sdl.web@gmail.com> | ||
| 22 | |||
| 23 | * ido.el (ido-read-internal): Use the default history var | ||
| 24 | minibuffer-history if no HISTORY is specified. | ||
| 25 | |||
| 26 | 2011-03-28 Brian T. Sniffen <bsniffen@akamai.com> (tiny change) | ||
| 27 | |||
| 28 | * net/imap.el (imap-shell-open, imap-process-connection-type): Use | ||
| 29 | imap-process-connection-type for 'shell' streams as well as | ||
| 30 | Kerberos, SSL, other subprocesses. | ||
| 31 | |||
| 32 | 2011-03-28 Leo Liu <sdl.web@gmail.com> | ||
| 33 | |||
| 34 | * abbrev.el (abbrev-table-empty-p): New function. | ||
| 35 | (prepare-abbrev-list-buffer): Place empty abbrev tables after | ||
| 36 | nonempty ones. (Bug#5937) | ||
| 37 | |||
| 38 | 2011-03-27 Jan Djärv <jan.h.d@swipnet.se> | ||
| 39 | |||
| 40 | * cus-start.el (all): Add boolean ns-auto-hide-menu-bar. | ||
| 41 | |||
| 42 | 2011-03-27 Leo Liu <sdl.web@gmail.com> | ||
| 43 | |||
| 44 | * ansi-color.el (ansi-color-names-vector): Allow cons cell value | ||
| 45 | for foreground and background colors. | ||
| 46 | (ansi-color-make-color-map): Adapt. | ||
| 47 | |||
| 48 | 2011-03-25 Leo Liu <sdl.web@gmail.com> | ||
| 49 | |||
| 50 | * midnight.el (midnight-time-float): Remove. Note it calculates | ||
| 51 | the microsecond component incorrectly and seconds-to-time does the | ||
| 52 | same job. | ||
| 53 | Remove redundant (require 'timer). | ||
| 54 | |||
| 55 | * ido.el (ido-read-internal): Simplify with read-from-minibuffer. | ||
| 56 | (ido-completions): Remove unused arguments. (Bug#8329) | ||
| 57 | |||
| 58 | 2011-03-24 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 59 | |||
| 60 | * minibuffer.el (completion--flush-all-sorted-completions): | ||
| 61 | Remove itself from hook. | ||
| 62 | (completion-at-point): Let the functions perform the completion | ||
| 63 | immediately and return nil or t. | ||
| 64 | * comint.el (comint-dynamic-complete-functions): Now identical to | ||
| 65 | completion-at-point-functions. | ||
| 66 | (comint-dynamic-list-input-ring): Remove unused var `index'. | ||
| 67 | (comint--match-partial-filename, comint--unquote&expand-filename): | ||
| 68 | New funs, split from comint-match-partial-filename. | ||
| 69 | (comint-dynamic-complete): Use completion-at-point. | ||
| 70 | (comint-dynamic-complete-filename): Use comint--match-partial-filename. | ||
| 71 | |||
| 72 | 2011-03-24 Drew Adams <drew.adams@oracle.com> | ||
| 73 | |||
| 74 | * thingatpt.el: Support `defun'. | ||
| 75 | |||
| 76 | 2011-03-23 Leo Liu <sdl.web@gmail.com> | ||
| 77 | |||
| 78 | * abbrevlist.el: Move to obsolete/abbrevlist.el. | ||
| 79 | |||
| 80 | * help-mode.el (help-mode-finish): Tweak regexp. | ||
| 81 | |||
| 82 | 2011-03-23 Glenn Morris <rgm@gnu.org> | ||
| 83 | |||
| 84 | * eshell/esh-opt.el (eshell-eval-using-options): | ||
| 85 | Do not bind unused local variable `eshell-option-stub'. | ||
| 86 | |||
| 87 | * progmodes/gdb-mi.el (gdb): Fix typo in previous change. | ||
| 88 | |||
| 89 | 2011-03-22 Juanma Barranquero <lekktu@gmail.com> | ||
| 90 | |||
| 91 | * emacs-lisp/derived.el (define-derived-mode): Wrap declaration of | ||
| 92 | keymap variable in `with-no-warnings' to avoid a warning when the | ||
| 93 | keymap has been already `defconst'ed. | ||
| 94 | |||
| 95 | 2011-03-22 Leo Liu <sdl.web@gmail.com> | ||
| 96 | |||
| 97 | * abbrev.el (write-abbrev-file): Use utf-8 for writing if it can | ||
| 98 | encode all chars in abbrevs; otherwise use emacs-mule or | ||
| 99 | utf-8-emacs. (Bug#8308) | ||
| 100 | |||
| 101 | 2011-03-22 Juanma Barranquero <lekktu@gmail.com> | ||
| 102 | |||
| 103 | * simple.el (backward-delete-char-untabify): | ||
| 104 | Avoid warning about using `delete-backward-char'. | ||
| 105 | |||
| 106 | * image.el (image-type-file-name-regexps): Make it variable. | ||
| 107 | `imagemagick-register-types' modifies it, and the user may want | ||
| 108 | to add new extensions for known image types. | ||
| 109 | (imagemagick-register-types): Throw error if not using ImageMagick. | ||
| 110 | |||
| 111 | 2011-03-22 Leo Liu <sdl.web@gmail.com> | ||
| 112 | |||
| 113 | * net/rcirc.el (rcirc-completion-at-point): Return nil if point is | ||
| 114 | located before rcirc-prompt-end-marker. | ||
| 115 | (rcirc-complete): Error if point is not after rcirc prompt. | ||
| 116 | Handle the case when table is nil. | ||
| 117 | (rcirc-user-authenticated): Define to fix compiler warning. | ||
| 118 | |||
| 119 | 2011-03-22 Chong Yidong <cyd@stupidchicken.com> | ||
| 120 | |||
| 121 | * custom.el (custom--inhibit-theme-enable): Make it affect only | ||
| 122 | custom-theme-set-variables and custom-theme-set-faces. | ||
| 123 | (provide-theme): Ignore custom--inhibit-theme-enable. | ||
| 124 | (load-theme): Enable the theme explicitly if NO-ENABLE is non-nil. | ||
| 125 | (custom-enabling-themes): Delete variable. | ||
| 126 | (enable-theme): Accept only loaded themes as arguments. | ||
| 127 | Ignore the special custom-enabled-themes variable. | ||
| 128 | (custom-enabled-themes): Forbid themes from setting this. | ||
| 129 | Eliminate use of custom-enabling-themes. | ||
| 130 | (custom-push-theme): Quote "changed" custom var entry. | ||
| 131 | |||
| 132 | 2011-03-21 Leo Liu <sdl.web@gmail.com> | ||
| 133 | |||
| 134 | * ido.el (ido-read-internal): Add ido-selected to history instead | ||
| 135 | of user input. | ||
| 136 | |||
| 137 | 2011-03-21 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 138 | |||
| 139 | * subr.el (deferred-action-list, deferred-action-function): | ||
| 140 | Mark obsolete. | ||
| 141 | |||
| 142 | 2011-03-21 Leo Liu <sdl.web@gmail.com> | ||
| 143 | |||
| 144 | * vc/log-view.el: Remove (require 'wid-edit), not needed after the | ||
| 145 | change on 2011-02-13 (bug#8309). | ||
| 146 | |||
| 147 | * minibuffer.el (read-file-name-function): Change default value. | ||
| 148 | (read-file-name--defaults): Rename from read-file-name-defaults. | ||
| 149 | (read-file-name-default): Rename from read-file-name. | ||
| 150 | (read-file-name): Call read-file-name-function. | ||
| 151 | |||
| 1 | 2011-03-21 Glenn Morris <rgm@gnu.org> | 152 | 2011-03-21 Glenn Morris <rgm@gnu.org> |
| 2 | 153 | ||
| 3 | * eshell/esh-opt.el (eshell-eval-using-options, eshell-process-args): | 154 | * eshell/esh-opt.el (eshell-eval-using-options, eshell-process-args): |
| @@ -310,8 +461,8 @@ | |||
| 310 | 461 | ||
| 311 | 2011-03-09 Michael Albinus <michael.albinus@gmx.de> | 462 | 2011-03-09 Michael Albinus <michael.albinus@gmx.de> |
| 312 | 463 | ||
| 313 | * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Do | 464 | * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): |
| 314 | not use `tramp-file-name-port', because this returns also | 465 | Do not use `tramp-file-name-port', because this returns also |
| 315 | `tramp-default-port'. | 466 | `tramp-default-port'. |
| 316 | 467 | ||
| 317 | 2011-03-09 Deniz Dogan <deniz.a.m.dogan@gmail.com> | 468 | 2011-03-09 Deniz Dogan <deniz.a.m.dogan@gmail.com> |
| @@ -340,8 +491,8 @@ | |||
| 340 | * emacs-lisp/package.el (package-tar-file-info): Handle also | 491 | * emacs-lisp/package.el (package-tar-file-info): Handle also |
| 341 | remote files. | 492 | remote files. |
| 342 | 493 | ||
| 343 | * emacs-lisp/package-x.el (package-upload-buffer-internal): Use | 494 | * emacs-lisp/package-x.el (package-upload-buffer-internal): |
| 344 | `equal' for upload base check. | 495 | Use `equal' for upload base check. |
| 345 | 496 | ||
| 346 | 2011-03-08 Arni Magnusson <arnima@hafro.is> (tiny change) | 497 | 2011-03-08 Arni Magnusson <arnima@hafro.is> (tiny change) |
| 347 | 498 | ||
| @@ -670,9 +821,9 @@ | |||
| 670 | 2011-03-03 Christian Ohler <ohler@gnu.org> | 821 | 2011-03-03 Christian Ohler <ohler@gnu.org> |
| 671 | 822 | ||
| 672 | * emacs-lisp/ert.el (ert--explain-equal): New function. | 823 | * emacs-lisp/ert.el (ert--explain-equal): New function. |
| 673 | (ert--explain-equal-rec): Renamed from `ert--explain-not-equal'. | 824 | (ert--explain-equal-rec): Rename from `ert--explain-not-equal'. |
| 674 | All callers changed. | 825 | All callers changed. |
| 675 | (ert--explain-equal-including-properties): Renamed from | 826 | (ert--explain-equal-including-properties): Rename from |
| 676 | `ert--explain-not-equal-including-properties'. All callers | 827 | `ert--explain-not-equal-including-properties'. All callers |
| 677 | changed. | 828 | changed. |
| 678 | 829 | ||
| @@ -8195,8 +8346,8 @@ | |||
| 8195 | 8346 | ||
| 8196 | Sync with Tramp 2.1.19. | 8347 | Sync with Tramp 2.1.19. |
| 8197 | 8348 | ||
| 8198 | * net/tramp-gvfs.el (tramp-gvfs-handle-write-region): Protect | 8349 | * net/tramp-gvfs.el (tramp-gvfs-handle-write-region): |
| 8199 | deleting tmpfile. | 8350 | Protect deleting tmpfile. |
| 8200 | (tramp-gvfs-maybe-open-connection): Use `tramp-compat-funcall'. | 8351 | (tramp-gvfs-maybe-open-connection): Use `tramp-compat-funcall'. |
| 8201 | 8352 | ||
| 8202 | * net/tramp.el (tramp-handle-expand-file-name) | 8353 | * net/tramp.el (tramp-handle-expand-file-name) |
| @@ -10474,8 +10625,8 @@ | |||
| 10474 | * net/tramp-ftp.el (tramp-ftp-file-name-handler): | 10625 | * net/tramp-ftp.el (tramp-ftp-file-name-handler): |
| 10475 | Use `delete-file' instead of `tramp-compat-delete-file'. | 10626 | Use `delete-file' instead of `tramp-compat-delete-file'. |
| 10476 | 10627 | ||
| 10477 | * net/tramp-gvfs.el (tramp-gvfs-handle-write-region): Use | 10628 | * net/tramp-gvfs.el (tramp-gvfs-handle-write-region): |
| 10478 | `delete-file' instead of `tramp-compat-delete-file'. | 10629 | Use `delete-file' instead of `tramp-compat-delete-file'. |
| 10479 | 10630 | ||
| 10480 | * net/tramp-imap.el (tramp-imap-do-copy-or-rename-file): | 10631 | * net/tramp-imap.el (tramp-imap-do-copy-or-rename-file): |
| 10481 | Use `delete-file' instead of `tramp-compat-delete-file'. | 10632 | Use `delete-file' instead of `tramp-compat-delete-file'. |
diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 3844391a180..b2cd2064da2 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el | |||
| @@ -65,7 +65,8 @@ abbreviation causes it to expand and be replaced by its expansion." | |||
| 65 | 65 | ||
| 66 | (defvar edit-abbrevs-map | 66 | (defvar edit-abbrevs-map |
| 67 | (let ((map (make-sparse-keymap))) | 67 | (let ((map (make-sparse-keymap))) |
| 68 | (define-key map "\C-x\C-s" 'edit-abbrevs-redefine) | 68 | (define-key map "\C-x\C-s" 'abbrev-edit-save-buffer) |
| 69 | (define-key map "\C-x\C-w" 'abbrev-edit-save-to-file) | ||
| 69 | (define-key map "\C-c\C-c" 'edit-abbrevs-redefine) | 70 | (define-key map "\C-c\C-c" 'edit-abbrevs-redefine) |
| 70 | map) | 71 | map) |
| 71 | "Keymap used in `edit-abbrevs'.") | 72 | "Keymap used in `edit-abbrevs'.") |
| @@ -123,8 +124,13 @@ Otherwise display all abbrevs." | |||
| 123 | (if local | 124 | (if local |
| 124 | (insert-abbrev-table-description | 125 | (insert-abbrev-table-description |
| 125 | (abbrev-table-name local-table) t) | 126 | (abbrev-table-name local-table) t) |
| 126 | (dolist (table abbrev-table-name-list) | 127 | (let (empty-tables) |
| 127 | (insert-abbrev-table-description table t))) | 128 | (dolist (table abbrev-table-name-list) |
| 129 | (if (abbrev-table-empty-p (symbol-value table)) | ||
| 130 | (push table empty-tables) | ||
| 131 | (insert-abbrev-table-description table t))) | ||
| 132 | (dolist (table (nreverse empty-tables)) | ||
| 133 | (insert-abbrev-table-description table t)))) | ||
| 128 | (goto-char (point-min)) | 134 | (goto-char (point-min)) |
| 129 | (set-buffer-modified-p nil) | 135 | (set-buffer-modified-p nil) |
| 130 | (edit-abbrevs-mode) | 136 | (edit-abbrevs-mode) |
| @@ -211,13 +217,15 @@ Does not display any message." | |||
| 211 | ;(interactive "fRead abbrev file: ") | 217 | ;(interactive "fRead abbrev file: ") |
| 212 | (read-abbrev-file file t)) | 218 | (read-abbrev-file file t)) |
| 213 | 219 | ||
| 214 | (defun write-abbrev-file (&optional file) | 220 | (defun write-abbrev-file (&optional file verbose) |
| 215 | "Write all user-level abbrev definitions to a file of Lisp code. | 221 | "Write all user-level abbrev definitions to a file of Lisp code. |
| 216 | This does not include system abbrevs; it includes only the abbrev tables | 222 | This does not include system abbrevs; it includes only the abbrev tables |
| 217 | listed in listed in `abbrev-table-name-list'. | 223 | listed in listed in `abbrev-table-name-list'. |
| 218 | The file written can be loaded in another session to define the same abbrevs. | 224 | The file written can be loaded in another session to define the same abbrevs. |
| 219 | The argument FILE is the file name to write. If omitted or nil, the file | 225 | The argument FILE is the file name to write. If omitted or nil, the file |
| 220 | specified in `abbrev-file-name' is used." | 226 | specified in `abbrev-file-name' is used. |
| 227 | If VERBOSE is non-nil, display a message indicating where abbrevs | ||
| 228 | have been saved." | ||
| 221 | (interactive | 229 | (interactive |
| 222 | (list | 230 | (list |
| 223 | (read-file-name "Write abbrev file: " | 231 | (read-file-name "Write abbrev file: " |
| @@ -225,21 +233,47 @@ specified in `abbrev-file-name' is used." | |||
| 225 | abbrev-file-name))) | 233 | abbrev-file-name))) |
| 226 | (or (and file (> (length file) 0)) | 234 | (or (and file (> (length file) 0)) |
| 227 | (setq file abbrev-file-name)) | 235 | (setq file abbrev-file-name)) |
| 228 | (let ((coding-system-for-write 'emacs-mule)) | 236 | (let ((coding-system-for-write 'utf-8)) |
| 229 | (with-temp-file file | 237 | (with-temp-buffer |
| 230 | (insert ";;-*-coding: emacs-mule;-*-\n") | ||
| 231 | (dolist (table | 238 | (dolist (table |
| 232 | ;; We sort the table in order to ease the automatic | 239 | ;; We sort the table in order to ease the automatic |
| 233 | ;; merging of different versions of the user's abbrevs | 240 | ;; merging of different versions of the user's abbrevs |
| 234 | ;; file. This is useful, for example, for when the | 241 | ;; file. This is useful, for example, for when the |
| 235 | ;; user keeps their home directory in a revision | 242 | ;; user keeps their home directory in a revision |
| 236 | ;; control system, and is therefore keeping multiple | 243 | ;; control system, and is therefore keeping multiple |
| 237 | ;; slightly-differing copies loosely synchronized. | 244 | ;; slightly-differing copies loosely synchronized. |
| 238 | (sort (copy-sequence abbrev-table-name-list) | 245 | (sort (copy-sequence abbrev-table-name-list) |
| 239 | (lambda (s1 s2) | 246 | (lambda (s1 s2) |
| 240 | (string< (symbol-name s1) | 247 | (string< (symbol-name s1) |
| 241 | (symbol-name s2))))) | 248 | (symbol-name s2))))) |
| 242 | (insert-abbrev-table-description table nil))))) | 249 | (insert-abbrev-table-description table nil)) |
| 250 | (when (unencodable-char-position (point-min) (point-max) 'utf-8) | ||
| 251 | (setq coding-system-for-write | ||
| 252 | (if (> emacs-major-version 24) | ||
| 253 | 'utf-8-emacs | ||
| 254 | ;; For compatibility with Emacs 22 (See Bug#8308) | ||
| 255 | 'emacs-mule))) | ||
| 256 | (goto-char (point-min)) | ||
| 257 | (insert (format ";;-*-coding: %s;-*-\n" coding-system-for-write)) | ||
| 258 | (write-region nil nil file nil (and (not verbose) 0))))) | ||
| 259 | |||
| 260 | (defun abbrev-edit-save-to-file (file) | ||
| 261 | "Save all user-level abbrev definitions in current buffer to FILE." | ||
| 262 | (interactive | ||
| 263 | (list (read-file-name "Save abbrevs to file: " | ||
| 264 | (file-name-directory | ||
| 265 | (expand-file-name abbrev-file-name)) | ||
| 266 | abbrev-file-name))) | ||
| 267 | (edit-abbrevs-redefine) | ||
| 268 | (write-abbrev-file file t)) | ||
| 269 | |||
| 270 | (defun abbrev-edit-save-buffer () | ||
| 271 | "Save all user-level abbrev definitions in current buffer. | ||
| 272 | The saved abbrevs are written to the file specified by | ||
| 273 | `abbrev-file-name'." | ||
| 274 | (interactive) | ||
| 275 | (abbrev-edit-save-to-file abbrev-file-name)) | ||
| 276 | |||
| 243 | 277 | ||
| 244 | (defun add-mode-abbrev (arg) | 278 | (defun add-mode-abbrev (arg) |
| 245 | "Define mode-specific abbrev for last word(s) before point. | 279 | "Define mode-specific abbrev for last word(s) before point. |
| @@ -412,6 +446,19 @@ PROPS is a list of properties." | |||
| 412 | (and (vectorp object) | 446 | (and (vectorp object) |
| 413 | (numberp (abbrev-table-get object :abbrev-table-modiff)))) | 447 | (numberp (abbrev-table-get object :abbrev-table-modiff)))) |
| 414 | 448 | ||
| 449 | (defun abbrev-table-empty-p (object &optional ignore-system) | ||
| 450 | "Return nil if there are no abbrev symbols in OBJECT. | ||
| 451 | If IGNORE-SYSTEM is non-nil, system definitions are ignored." | ||
| 452 | (unless (abbrev-table-p object) | ||
| 453 | (error "Non abbrev table object")) | ||
| 454 | (not (catch 'some | ||
| 455 | (mapatoms (lambda (abbrev) | ||
| 456 | (unless (or (zerop (length (symbol-name abbrev))) | ||
| 457 | (and ignore-system | ||
| 458 | (abbrev-get abbrev :system))) | ||
| 459 | (throw 'some t))) | ||
| 460 | object)))) | ||
| 461 | |||
| 415 | (defvar global-abbrev-table (make-abbrev-table) | 462 | (defvar global-abbrev-table (make-abbrev-table) |
| 416 | "The abbrev table whose abbrevs affect all buffers. | 463 | "The abbrev table whose abbrevs affect all buffers. |
| 417 | Each buffer may also have a local abbrev table. | 464 | Each buffer may also have a local abbrev table. |
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 47f181ab76b..ae4265bda1f 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el | |||
| @@ -238,7 +238,7 @@ buffer, and tracking increases as new widgets are added and | |||
| 238 | decreases as obsolete widgets are garbage collected." | 238 | decreases as obsolete widgets are garbage collected." |
| 239 | :type 'boolean | 239 | :type 'boolean |
| 240 | :group 'allout-widgets-developer) | 240 | :group 'allout-widgets-developer) |
| 241 | (defvar allout-widgets-tally (make-hash-table :test 'eq :weakness 'key) | 241 | (defvar allout-widgets-tally nil |
| 242 | "Hash-table of existing allout widgets, for debugging. | 242 | "Hash-table of existing allout widgets, for debugging. |
| 243 | 243 | ||
| 244 | Table is maintained iff `allout-widgets-maintain-tally' is non-nil. | 244 | Table is maintained iff `allout-widgets-maintain-tally' is non-nil. |
| @@ -2100,6 +2100,7 @@ previously established or is not moved." | |||
| 2100 | (cond ((not overlay) (when start | 2100 | (cond ((not overlay) (when start |
| 2101 | (setq overlay (make-overlay start end nil t nil)) | 2101 | (setq overlay (make-overlay start end nil t nil)) |
| 2102 | (overlay-put overlay 'button item-widget) | 2102 | (overlay-put overlay 'button item-widget) |
| 2103 | (overlay-put overlay 'evaporate t) | ||
| 2103 | (widget-put item-widget :span-overlay overlay) | 2104 | (widget-put item-widget :span-overlay overlay) |
| 2104 | t)) | 2105 | t)) |
| 2105 | ;; report: | 2106 | ;; report: |
| @@ -2343,6 +2344,19 @@ The elements of LIST are not copied, just the list structure itself." | |||
| 2343 | (while (consp list) (push (pop list) res)) | 2344 | (while (consp list) (push (pop list) res)) |
| 2344 | (prog1 (nreverse res) (setcdr res list))) | 2345 | (prog1 (nreverse res) (setcdr res list))) |
| 2345 | (car list))) | 2346 | (car list))) |
| 2347 | ;;;_ . allout-widgets-count-buttons-in-region (start end) | ||
| 2348 | (defun allout-widgets-count-buttons-in-region (start end) | ||
| 2349 | "Debugging/diagnostic tool - count overlays with 'button' property in region." | ||
| 2350 | (interactive "r") | ||
| 2351 | (setq start (or start (point-min)) | ||
| 2352 | end (or end (point-max))) | ||
| 2353 | (if (> start end) (let ((interim start)) (setq start end end interim))) | ||
| 2354 | (let ((button-overlays (delq nil | ||
| 2355 | (mapcar (function (lambda (o) | ||
| 2356 | (if (overlay-get o 'button) | ||
| 2357 | o))) | ||
| 2358 | (overlays-in start end))))) | ||
| 2359 | (length button-overlays))) | ||
| 2346 | 2360 | ||
| 2347 | ;;;_ : Run unit tests: | 2361 | ;;;_ : Run unit tests: |
| 2348 | (defun allout-widgets-run-unit-tests () | 2362 | (defun allout-widgets-run-unit-tests () |
diff --git a/lisp/allout.el b/lisp/allout.el index 3fb8ed7ccd5..736ec42718b 100644 --- a/lisp/allout.el +++ b/lisp/allout.el | |||
| @@ -4489,8 +4489,9 @@ Topic exposure is marked with text-properties, to be used by | |||
| 4489 | ;; advance to just after end of this annotation: | 4489 | ;; advance to just after end of this annotation: |
| 4490 | (setq next (allout-next-single-char-property-change | 4490 | (setq next (allout-next-single-char-property-change |
| 4491 | (point) 'allout-was-hidden nil end)) | 4491 | (point) 'allout-was-hidden nil end)) |
| 4492 | (overlay-put (make-overlay prev next nil 'front-advance) | 4492 | (let ((o (make-overlay prev next nil 'front-advance))) |
| 4493 | 'category 'allout-exposure-category) | 4493 | (overlay-put o 'category 'allout-exposure-category) |
| 4494 | (overlay-put o 'evaporate t)) | ||
| 4494 | (allout-deannotate-hidden prev next) | 4495 | (allout-deannotate-hidden prev next) |
| 4495 | (setq prev next) | 4496 | (setq prev next) |
| 4496 | (if next (goto-char next))))) | 4497 | (if next (goto-char next))))) |
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 2b43940c1bd..ff7edf40dcb 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el | |||
| @@ -132,8 +132,18 @@ Parameter Color | |||
| 132 | 37 47 white | 132 | 37 47 white |
| 133 | 133 | ||
| 134 | This vector is used by `ansi-color-make-color-map' to create a color | 134 | This vector is used by `ansi-color-make-color-map' to create a color |
| 135 | map. This color map is stored in the variable `ansi-color-map'." | 135 | map. This color map is stored in the variable `ansi-color-map'. |
| 136 | :type '(vector string string string string string string string string) | 136 | |
| 137 | Each element may also be a cons cell where the car and cdr specify the | ||
| 138 | foreground and background colors, respectively." | ||
| 139 | :type '(vector (choice color (cons color color)) | ||
| 140 | (choice color (cons color color)) | ||
| 141 | (choice color (cons color color)) | ||
| 142 | (choice color (cons color color)) | ||
| 143 | (choice color (cons color color)) | ||
| 144 | (choice color (cons color color)) | ||
| 145 | (choice color (cons color color)) | ||
| 146 | (choice color (cons color color))) | ||
| 137 | :set 'ansi-color-map-update | 147 | :set 'ansi-color-map-update |
| 138 | :initialize 'custom-initialize-default | 148 | :initialize 'custom-initialize-default |
| 139 | :group 'ansi-colors) | 149 | :group 'ansi-colors) |
| @@ -528,7 +538,8 @@ The face definitions are based upon the variables | |||
| 528 | (mapc | 538 | (mapc |
| 529 | (function (lambda (e) | 539 | (function (lambda (e) |
| 530 | (aset ansi-color-map index | 540 | (aset ansi-color-map index |
| 531 | (ansi-color-make-face 'foreground e)) | 541 | (ansi-color-make-face 'foreground |
| 542 | (if (consp e) (car e) e))) | ||
| 532 | (setq index (1+ index)) )) | 543 | (setq index (1+ index)) )) |
| 533 | ansi-color-names-vector) | 544 | ansi-color-names-vector) |
| 534 | ;; background attributes | 545 | ;; background attributes |
| @@ -536,7 +547,8 @@ The face definitions are based upon the variables | |||
| 536 | (mapc | 547 | (mapc |
| 537 | (function (lambda (e) | 548 | (function (lambda (e) |
| 538 | (aset ansi-color-map index | 549 | (aset ansi-color-map index |
| 539 | (ansi-color-make-face 'background e)) | 550 | (ansi-color-make-face 'background |
| 551 | (if (consp e) (cdr e) e))) | ||
| 540 | (setq index (1+ index)) )) | 552 | (setq index (1+ index)) )) |
| 541 | ansi-color-names-vector) | 553 | ansi-color-names-vector) |
| 542 | ansi-color-map)) | 554 | ansi-color-map)) |
diff --git a/lisp/comint.el b/lisp/comint.el index 711ebce20a3..c9d2108f132 100644 --- a/lisp/comint.el +++ b/lisp/comint.el | |||
| @@ -368,7 +368,7 @@ text matching `comint-prompt-regexp', depending on the value of | |||
| 368 | (defvar comint-dynamic-complete-functions | 368 | (defvar comint-dynamic-complete-functions |
| 369 | '(comint-replace-by-expanded-history comint-dynamic-complete-filename) | 369 | '(comint-replace-by-expanded-history comint-dynamic-complete-filename) |
| 370 | "List of functions called to perform completion. | 370 | "List of functions called to perform completion. |
| 371 | Functions should return non-nil if completion was performed. | 371 | Works like `completion-at-point-functions'. |
| 372 | See also `comint-dynamic-complete'. | 372 | See also `comint-dynamic-complete'. |
| 373 | 373 | ||
| 374 | This is a good thing to set in mode hooks.") | 374 | This is a good thing to set in mode hooks.") |
| @@ -1008,7 +1008,6 @@ See also `comint-read-input-ring'." | |||
| 1008 | (message "No history") | 1008 | (message "No history") |
| 1009 | (let ((history nil) | 1009 | (let ((history nil) |
| 1010 | (history-buffer " *Input History*") | 1010 | (history-buffer " *Input History*") |
| 1011 | (index (1- (ring-length comint-input-ring))) | ||
| 1012 | (conf (current-window-configuration))) | 1011 | (conf (current-window-configuration))) |
| 1013 | ;; We have to build up a list ourselves from the ring vector. | 1012 | ;; We have to build up a list ourselves from the ring vector. |
| 1014 | (dotimes (index (ring-length comint-input-ring)) | 1013 | (dotimes (index (ring-length comint-input-ring)) |
| @@ -2946,13 +2945,22 @@ interpreter (e.g., the percent notation of cmd.exe on NT)." | |||
| 2946 | (setq name (replace-match env-var-val t t name)))))) | 2945 | (setq name (replace-match env-var-val t t name)))))) |
| 2947 | name)) | 2946 | name)) |
| 2948 | 2947 | ||
| 2948 | (defun comint--match-partial-filename () | ||
| 2949 | "Return the filename at point as-is, or nil if none is found. | ||
| 2950 | See `comint-word'." | ||
| 2951 | (comint-word comint-file-name-chars)) | ||
| 2952 | |||
| 2953 | (defun comint--unquote&expand-filename (filename) | ||
| 2954 | ;; FIXME: The code below does unquote-then-expand which means that "\\$HOME" | ||
| 2955 | ;; gets expanded to the same as "$HOME" | ||
| 2956 | (comint-substitute-in-file-name | ||
| 2957 | (comint-unquote-filename filename))) | ||
| 2958 | |||
| 2949 | (defun comint-match-partial-filename () | 2959 | (defun comint-match-partial-filename () |
| 2950 | "Return the filename at point, or nil if none is found. | 2960 | "Return the unquoted&expanded filename at point, or nil if none is found. |
| 2951 | Environment variables are substituted. See `comint-word'." | 2961 | Environment variables are substituted. See `comint-word'." |
| 2952 | (let ((filename (comint-word comint-file-name-chars))) | 2962 | (let ((filename (comint--match-partial-filename))) |
| 2953 | (and filename (comint-substitute-in-file-name | 2963 | (and filename (comint--unquote&expand-filename filename)))) |
| 2954 | (comint-unquote-filename filename))))) | ||
| 2955 | |||
| 2956 | 2964 | ||
| 2957 | (defun comint-quote-filename (filename) | 2965 | (defun comint-quote-filename (filename) |
| 2958 | "Return FILENAME with magic characters quoted. | 2966 | "Return FILENAME with magic characters quoted. |
| @@ -2987,13 +2995,13 @@ Calls the functions in `comint-dynamic-complete-functions' to perform | |||
| 2987 | completion until a function returns non-nil, at which point completion is | 2995 | completion until a function returns non-nil, at which point completion is |
| 2988 | assumed to have occurred." | 2996 | assumed to have occurred." |
| 2989 | (interactive) | 2997 | (interactive) |
| 2990 | (run-hook-with-args-until-success 'comint-dynamic-complete-functions)) | 2998 | (let ((completion-at-point-functions comint-dynamic-complete-functions)) |
| 2999 | (completion-at-point))) | ||
| 2991 | 3000 | ||
| 2992 | 3001 | ||
| 2993 | (defun comint-dynamic-complete-filename () | 3002 | (defun comint-dynamic-complete-filename () |
| 2994 | "Dynamically complete the filename at point. | 3003 | "Dynamically complete the filename at point. |
| 2995 | Completes if after a filename. See `comint-match-partial-filename' and | 3004 | Completes if after a filename. |
| 2996 | `comint-dynamic-complete-as-filename'. | ||
| 2997 | This function is similar to `comint-replace-by-expanded-filename', except that | 3005 | This function is similar to `comint-replace-by-expanded-filename', except that |
| 2998 | it won't change parts of the filename already entered in the buffer; it just | 3006 | it won't change parts of the filename already entered in the buffer; it just |
| 2999 | adds completion characters to the end of the filename. A completions listing | 3007 | adds completion characters to the end of the filename. A completions listing |
| @@ -3005,7 +3013,7 @@ completions listing is dependent on the value of `comint-completion-autolist'. | |||
| 3005 | 3013 | ||
| 3006 | Returns t if successful." | 3014 | Returns t if successful." |
| 3007 | (interactive) | 3015 | (interactive) |
| 3008 | (when (comint-match-partial-filename) | 3016 | (when (comint--match-partial-filename) |
| 3009 | (unless (window-minibuffer-p (selected-window)) | 3017 | (unless (window-minibuffer-p (selected-window)) |
| 3010 | (message "Completing file name...")) | 3018 | (message "Completing file name...")) |
| 3011 | (comint-dynamic-complete-as-filename))) | 3019 | (comint-dynamic-complete-as-filename))) |
| @@ -3021,18 +3029,12 @@ See `comint-dynamic-complete-filename'. Returns t if successful." | |||
| 3021 | ;;(file-name-handler-alist nil) | 3029 | ;;(file-name-handler-alist nil) |
| 3022 | (minibuffer-p (window-minibuffer-p (selected-window))) | 3030 | (minibuffer-p (window-minibuffer-p (selected-window))) |
| 3023 | (success t) | 3031 | (success t) |
| 3024 | (dirsuffix (cond ((not comint-completion-addsuffix) | 3032 | (dirsuffix (cond ((not comint-completion-addsuffix) "") |
| 3025 | "") | 3033 | ((not (consp comint-completion-addsuffix)) "/") |
| 3026 | ((not (consp comint-completion-addsuffix)) | 3034 | (t (car comint-completion-addsuffix)))) |
| 3027 | "/") | 3035 | (filesuffix (cond ((not comint-completion-addsuffix) "") |
| 3028 | (t | 3036 | ((not (consp comint-completion-addsuffix)) " ") |
| 3029 | (car comint-completion-addsuffix)))) | 3037 | (t (cdr comint-completion-addsuffix)))) |
| 3030 | (filesuffix (cond ((not comint-completion-addsuffix) | ||
| 3031 | "") | ||
| 3032 | ((not (consp comint-completion-addsuffix)) | ||
| 3033 | " ") | ||
| 3034 | (t | ||
| 3035 | (cdr comint-completion-addsuffix)))) | ||
| 3036 | (filename (comint-match-partial-filename)) | 3038 | (filename (comint-match-partial-filename)) |
| 3037 | (filename-beg (if filename (match-beginning 0) (point))) | 3039 | (filename-beg (if filename (match-beginning 0) (point))) |
| 3038 | (filename-end (if filename (match-end 0) (point))) | 3040 | (filename-end (if filename (match-end 0) (point))) |
diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 788731e4dbc..1188d37150a 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el | |||
| @@ -356,6 +356,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of | |||
| 356 | (const alt) (const hyper) | 356 | (const alt) (const hyper) |
| 357 | (const super)) "23.1") | 357 | (const super)) "23.1") |
| 358 | (ns-antialias-text ns boolean "23.1") | 358 | (ns-antialias-text ns boolean "23.1") |
| 359 | (ns-auto-hide-menu-bar ns boolean "24.0") | ||
| 359 | ;; process.c | 360 | ;; process.c |
| 360 | (delete-exited-processes processes-basics boolean) | 361 | (delete-exited-processes processes-basics boolean) |
| 361 | ;; syntax.c | 362 | ;; syntax.c |
diff --git a/lisp/custom.el b/lisp/custom.el index d9bb4f954bc..5b5592698d8 100644 --- a/lisp/custom.el +++ b/lisp/custom.el | |||
| @@ -852,10 +852,10 @@ See `custom-known-themes' for a list of known themes." | |||
| 852 | ;; theme is later disabled. | 852 | ;; theme is later disabled. |
| 853 | (cond ((and (eq prop 'theme-value) | 853 | (cond ((and (eq prop 'theme-value) |
| 854 | (boundp symbol)) | 854 | (boundp symbol)) |
| 855 | (let ((sv (get symbol 'standard-value))) | 855 | (let ((sv (get symbol 'standard-value)) |
| 856 | (unless (and sv | 856 | (val (symbol-value symbol))) |
| 857 | (equal (eval (car sv)) (symbol-value symbol))) | 857 | (unless (and sv (equal (eval (car sv)) val)) |
| 858 | (setq old (list (list 'changed (symbol-value symbol))))))) | 858 | (setq old `((changed ,(custom-quote val))))))) |
| 859 | ((and (facep symbol) | 859 | ((and (facep symbol) |
| 860 | (not (face-attr-match-p | 860 | (not (face-attr-match-p |
| 861 | symbol | 861 | symbol |
| @@ -1084,10 +1084,10 @@ name." | |||
| 1084 | :version "24.1") | 1084 | :version "24.1") |
| 1085 | 1085 | ||
| 1086 | (defvar custom--inhibit-theme-enable nil | 1086 | (defvar custom--inhibit-theme-enable nil |
| 1087 | "If non-nil, loading a theme does not enable it. | 1087 | "Whether the custom-theme-set-* functions act immediately. |
| 1088 | This internal variable is set by `load-theme' when its NO-ENABLE | 1088 | If nil, `custom-theme-set-variables' and `custom-theme-set-faces' |
| 1089 | argument is non-nil, and it affects `custom-theme-set-variables', | 1089 | change the current values of the given variable or face. If |
| 1090 | `custom-theme-set-faces', and `provide-theme'." ) | 1090 | non-nil, they just make a record of the theme settings.") |
| 1091 | 1091 | ||
| 1092 | (defun provide-theme (theme) | 1092 | (defun provide-theme (theme) |
| 1093 | "Indicate that this file provides THEME. | 1093 | "Indicate that this file provides THEME. |
| @@ -1097,15 +1097,7 @@ property `theme-feature' (which is usually a symbol created by | |||
| 1097 | (unless (custom-theme-name-valid-p theme) | 1097 | (unless (custom-theme-name-valid-p theme) |
| 1098 | (error "Custom theme cannot be named %S" theme)) | 1098 | (error "Custom theme cannot be named %S" theme)) |
| 1099 | (custom-check-theme theme) | 1099 | (custom-check-theme theme) |
| 1100 | (provide (get theme 'theme-feature)) | 1100 | (provide (get theme 'theme-feature))) |
| 1101 | (unless custom--inhibit-theme-enable | ||
| 1102 | ;; By default, loading a theme also enables it. | ||
| 1103 | (push theme custom-enabled-themes) | ||
| 1104 | ;; `user' must always be the highest-precedence enabled theme. | ||
| 1105 | ;; Make that remain true. (This has the effect of making user | ||
| 1106 | ;; settings override the ones just loaded, too.) | ||
| 1107 | (let ((custom-enabling-themes t)) | ||
| 1108 | (enable-theme 'user)))) | ||
| 1109 | 1101 | ||
| 1110 | (defcustom custom-safe-themes '(default) | 1102 | (defcustom custom-safe-themes '(default) |
| 1111 | "List of themes that are considered safe to load. | 1103 | "List of themes that are considered safe to load. |
| @@ -1157,9 +1149,11 @@ Return t if THEME was successfully loaded, nil otherwise." | |||
| 1157 | (expand-file-name "themes/" data-directory))) | 1149 | (expand-file-name "themes/" data-directory))) |
| 1158 | (member hash custom-safe-themes) | 1150 | (member hash custom-safe-themes) |
| 1159 | (custom-theme-load-confirm hash)) | 1151 | (custom-theme-load-confirm hash)) |
| 1160 | (let ((custom--inhibit-theme-enable no-enable)) | 1152 | (let ((custom--inhibit-theme-enable t)) |
| 1161 | (eval-buffer) | 1153 | (eval-buffer)) |
| 1162 | t))))) | 1154 | (unless no-enable |
| 1155 | (enable-theme theme)) | ||
| 1156 | t)))) | ||
| 1163 | 1157 | ||
| 1164 | (defun custom-theme-load-confirm (hash) | 1158 | (defun custom-theme-load-confirm (hash) |
| 1165 | "Query the user about loading a Custom theme that may not be safe. | 1159 | "Query the user about loading a Custom theme that may not be safe. |
| @@ -1238,68 +1232,70 @@ NAME should be a symbol." | |||
| 1238 | 1232 | ||
| 1239 | ;;; Enabling and disabling loaded themes. | 1233 | ;;; Enabling and disabling loaded themes. |
| 1240 | 1234 | ||
| 1241 | (defvar custom-enabling-themes nil) | ||
| 1242 | |||
| 1243 | (defun enable-theme (theme) | 1235 | (defun enable-theme (theme) |
| 1244 | "Reenable all variable and face settings defined by THEME. | 1236 | "Reenable all variable and face settings defined by THEME. |
| 1245 | The newly enabled theme gets the highest precedence (after `user'). | 1237 | THEME should be either `user', or a theme loaded via `load-theme'. |
| 1246 | If it is already enabled, just give it highest precedence (after `user'). | 1238 | After this function completes, THEME will have the highest |
| 1247 | 1239 | precedence (after `user')." | |
| 1248 | If THEME does not specify any theme settings, this tries to load | ||
| 1249 | the theme from its theme file, by calling `load-theme'." | ||
| 1250 | (interactive (list (intern | 1240 | (interactive (list (intern |
| 1251 | (completing-read | 1241 | (completing-read |
| 1252 | "Enable custom theme: " | 1242 | "Enable custom theme: " |
| 1253 | obarray (lambda (sym) (get sym 'theme-settings)))))) | 1243 | obarray (lambda (sym) (get sym 'theme-settings)) t)))) |
| 1254 | (if (not (custom-theme-p theme)) | 1244 | (if (not (custom-theme-p theme)) |
| 1255 | (load-theme theme) | 1245 | (error "Undefined Custom theme %s" theme)) |
| 1256 | ;; This could use a bit of optimization -- cyd | 1246 | (let ((settings (get theme 'theme-settings))) |
| 1257 | (let ((settings (get theme 'theme-settings))) | 1247 | ;; Loop through theme settings, recalculating vars/faces. |
| 1258 | (dolist (s settings) | 1248 | (dolist (s settings) |
| 1259 | (let* ((prop (car s)) | 1249 | (let* ((prop (car s)) |
| 1260 | (symbol (cadr s)) | 1250 | (symbol (cadr s)) |
| 1261 | (spec-list (get symbol prop))) | 1251 | (spec-list (get symbol prop))) |
| 1262 | (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list))) | 1252 | (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list))) |
| 1263 | (if (eq prop 'theme-value) | 1253 | (cond |
| 1264 | (custom-theme-recalc-variable symbol) | 1254 | ((eq prop 'theme-face) |
| 1265 | (custom-theme-recalc-face symbol))))) | 1255 | (custom-theme-recalc-face symbol)) |
| 1266 | (unless (eq theme 'user) | 1256 | ((eq prop 'theme-value) |
| 1267 | (setq custom-enabled-themes | 1257 | ;; Don't change `custom-enabled-themes'; that's special. |
| 1268 | (cons theme (delq theme custom-enabled-themes))) | 1258 | (unless (eq symbol 'custom-enabled-themes) |
| 1269 | (unless custom-enabling-themes | 1259 | (custom-theme-recalc-variable symbol))))))) |
| 1270 | (enable-theme 'user))))) | 1260 | (unless (eq theme 'user) |
| 1261 | (setq custom-enabled-themes | ||
| 1262 | (cons theme (delq theme custom-enabled-themes))) | ||
| 1263 | ;; Give the `user' theme the highest priority. | ||
| 1264 | (enable-theme 'user))) | ||
| 1271 | 1265 | ||
| 1272 | (defcustom custom-enabled-themes nil | 1266 | (defcustom custom-enabled-themes nil |
| 1273 | "List of enabled Custom Themes, highest precedence first. | 1267 | "List of enabled Custom Themes, highest precedence first. |
| 1268 | This list does not include the `user' theme, which is set by | ||
| 1269 | Customize and always takes precedence over other Custom Themes. | ||
| 1274 | 1270 | ||
| 1275 | This does not include the `user' theme, which is set by Customize, | 1271 | This variable cannot be defined inside a Custom theme; there, it |
| 1276 | and always takes precedence over other Custom Themes." | 1272 | is simply ignored." |
| 1277 | :group 'customize | 1273 | :group 'customize |
| 1278 | :type '(repeat symbol) | 1274 | :type '(repeat symbol) |
| 1279 | :set-after '(custom-theme-directory custom-theme-load-path | 1275 | :set-after '(custom-theme-directory custom-theme-load-path |
| 1280 | custom-safe-themes) | 1276 | custom-safe-themes) |
| 1281 | :risky t | 1277 | :risky t |
| 1282 | :set (lambda (symbol themes) | 1278 | :set (lambda (symbol themes) |
| 1283 | ;; Avoid an infinite loop when custom-enabled-themes is | 1279 | (let (failures) |
| 1284 | ;; defined in a theme (e.g. `user'). Enabling the theme sets | 1280 | (setq themes (delq 'user (delete-dups themes))) |
| 1285 | ;; custom-enabled-themes, which enables the theme... | 1281 | ;; Disable all themes not in THEMES. |
| 1286 | (unless custom-enabling-themes | 1282 | (if (boundp symbol) |
| 1287 | (let ((custom-enabling-themes t) failures) | 1283 | (dolist (theme (symbol-value symbol)) |
| 1288 | (setq themes (delq 'user (delete-dups themes))) | 1284 | (if (not (memq theme themes)) |
| 1289 | (if (boundp symbol) | 1285 | (disable-theme theme)))) |
| 1290 | (dolist (theme (symbol-value symbol)) | 1286 | ;; Call `enable-theme' or `load-theme' on each of THEMES. |
| 1291 | (if (not (memq theme themes)) | 1287 | (dolist (theme (reverse themes)) |
| 1292 | (disable-theme theme)))) | 1288 | (condition-case nil |
| 1293 | (dolist (theme (reverse themes)) | 1289 | (if (custom-theme-p theme) |
| 1294 | (condition-case nil | 1290 | (enable-theme theme) |
| 1295 | (enable-theme theme) | 1291 | (load-theme theme)) |
| 1296 | (error (progn (push theme failures) | 1292 | (error (setq failures (cons theme failures) |
| 1297 | (setq themes (delq theme themes)))))) | 1293 | themes (delq theme themes))))) |
| 1298 | (enable-theme 'user) | 1294 | (enable-theme 'user) |
| 1299 | (custom-set-default symbol themes) | 1295 | (custom-set-default symbol themes) |
| 1300 | (if failures | 1296 | (if failures |
| 1301 | (message "Failed to enable themes: %s" | 1297 | (message "Failed to enable theme: %s" |
| 1302 | (mapconcat 'symbol-name failures " "))))))) | 1298 | (mapconcat 'symbol-name failures ", ")))))) |
| 1303 | 1299 | ||
| 1304 | (defsubst custom-theme-enabled-p (theme) | 1300 | (defsubst custom-theme-enabled-p (theme) |
| 1305 | "Return non-nil if THEME is enabled." | 1301 | "Return non-nil if THEME is enabled." |
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 425a77ee77f..1db98ac39c8 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el | |||
| @@ -201,7 +201,7 @@ No problems result if this variable is not bound. | |||
| 201 | name)))) | 201 | name)))) |
| 202 | (unless (boundp ',map) | 202 | (unless (boundp ',map) |
| 203 | (put ',map 'definition-name ',child)) | 203 | (put ',map 'definition-name ',child)) |
| 204 | (defvar ,map (make-sparse-keymap)) | 204 | (with-no-warnings (defvar ,map (make-sparse-keymap))) |
| 205 | (unless (get ',map 'variable-documentation) | 205 | (unless (get ',map 'variable-documentation) |
| 206 | (put ',map 'variable-documentation | 206 | (put ',map 'variable-documentation |
| 207 | (purecopy ,(format "Keymap for `%s'." child)))) | 207 | (purecopy ,(format "Keymap for `%s'." child)))) |
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index a9e8f11c39a..91d3cac198a 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el | |||
| @@ -102,10 +102,9 @@ interned variable `args' (created using a `let' form)." | |||
| 102 | macro-args | 102 | macro-args |
| 103 | (list 'eshell-stringify-list | 103 | (list 'eshell-stringify-list |
| 104 | (list 'eshell-flatten-list macro-args))))) | 104 | (list 'eshell-flatten-list macro-args))))) |
| 105 | (let ,(append (mapcar (lambda (opt) | 105 | (let ,(append (delq nil (mapcar (lambda (opt) |
| 106 | (or (and (listp opt) (nth 3 opt)) | 106 | (and (listp opt) (nth 3 opt))) |
| 107 | 'eshell-option-stub)) | 107 | (cadr options))) |
| 108 | (cadr options)) | ||
| 109 | '(usage-msg last-value ext-command args)) | 108 | '(usage-msg last-value ext-command args)) |
| 110 | (eshell-do-opt ,name ,options (quote ,body-forms))))) | 109 | (eshell-do-opt ,name ,options (quote ,body-forms))))) |
| 111 | 110 | ||
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 7eca03bd93b..51169f7b9df 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,137 @@ | |||
| 1 | 2011-03-30 Chong Yidong <cyd@stupidchicken.com> | ||
| 2 | |||
| 3 | * proto-stream.el (open-protocol-stream): Bring back `network' type. | ||
| 4 | Make this the default type. | ||
| 5 | (proto-stream-open-plain): Rename from proto-stream-open-default. | ||
| 6 | (open-protocol-stream, proto-stream-open-starttls) | ||
| 7 | (proto-stream-open-tls, proto-stream-open-shell): Replace `default' | ||
| 8 | with `plain'. | ||
| 9 | |||
| 10 | * nnimap.el (nnimap-stream, nnimap-open-connection-1): Accept `network' | ||
| 11 | value. | ||
| 12 | |||
| 13 | * nntp.el (nntp-open-connection-function): Document the fact that some | ||
| 14 | values are not functions but are instead handled specially. Recognize | ||
| 15 | nntp-open-plain-stream value. | ||
| 16 | (nntp-open-connection): Recognize that value. | ||
| 17 | |||
| 18 | 2011-03-29 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 19 | |||
| 20 | * gssapi.el (open-gssapi-stream): Remove the last mentions of the IMAP | ||
| 21 | stuff. | ||
| 22 | |||
| 23 | * gnus-score.el (gnus-score-string): Fix calling convention of | ||
| 24 | `gnus-simplify-buffer-fuzzy' after last patches. | ||
| 25 | |||
| 26 | * gnus-sum.el (gnus-update-marks): Don't send any marks updates to the | ||
| 27 | server for articles we didn't get any headers for. This is a sanity | ||
| 28 | check. | ||
| 29 | |||
| 30 | 2011-03-29 Michael Welsh Duggan <md5i@md5i.com> | ||
| 31 | |||
| 32 | * nnimap.el (nnimap-open-connection-1): Is the login responds with a | ||
| 33 | new CAPABILITY, use it. | ||
| 34 | |||
| 35 | 2011-03-29 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 36 | |||
| 37 | * gnus-agent.el (gnus-agent-fetch-headers): Don't message if we're not | ||
| 38 | downloading anything. | ||
| 39 | |||
| 40 | * gnus.el (gnus-splash-svg-color-symbols): Removed superfluous `and'. | ||
| 41 | |||
| 42 | 2011-03-29 Adam Sjøgren <asjo@koldfront.dk> | ||
| 43 | |||
| 44 | * gnus.el (gnus-group-startup-message): Prefer svg file and replace | ||
| 45 | colors. | ||
| 46 | (gnus-splash-svg-color-symbols): New function. | ||
| 47 | |||
| 48 | 2011-03-29 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 49 | |||
| 50 | * gnus-sum.el (gnus-simplify-buffer-fuzzy): Take the regexp explicitly | ||
| 51 | instead of using the global gnus-simplify-subject-fuzzy-regexp. | ||
| 52 | (gnus-simplify-subject-fuzzy): Use the local | ||
| 53 | gnus-simplify-subject-fuzzy-regex instead of the global one. This | ||
| 54 | makes using this variable in group parameters work. | ||
| 55 | |||
| 56 | 2011-03-29 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 57 | |||
| 58 | * gnus-registry.el (gnus-registry-unfollowed-groups): Add | ||
| 59 | "archive:sent" to the unfollowed group regex (for the recent Gnus | ||
| 60 | archive:sent-YYYY-MM-DD groups). | ||
| 61 | (gnus-registry-split-fancy-with-parent): Bail out early in sender | ||
| 62 | tracking if there are more than `gnus-registry-max-track-groups' | ||
| 63 | matches. | ||
| 64 | |||
| 65 | 2011-03-29 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 66 | |||
| 67 | * message.el (message--yank-original-internal): New function to do the | ||
| 68 | insertion cleanly inside eval in `message-yank-original'. | ||
| 69 | (message-yank-original): Use it. | ||
| 70 | |||
| 71 | 2011-03-29 Julien Danjou <julien@danjou.info> | ||
| 72 | |||
| 73 | * mm-view.el (mm-display-inline-fontify): Use `set-normal-mode' with | ||
| 74 | local variables disabled rather than `normal-mode'. | ||
| 75 | |||
| 76 | 2011-03-26 Chong Yidong <cyd@stupidchicken.com> | ||
| 77 | |||
| 78 | * proto-stream.el: Changes preparatory to merging open-protocol-stream | ||
| 79 | with open-network-stream. | ||
| 80 | (proto-stream-always-use-starttls): Option removed. | ||
| 81 | (open-protocol-stream): Return a process object by default. Provide a | ||
| 82 | new parameter :return-list specifying a list-type return value, which | ||
| 83 | now has the form (PROP . PLIST) instead of a fixed-length list. Change | ||
| 84 | :type `network' to `try-starttls', and `network-only' to `default'. | ||
| 85 | Make `default' the default, for compatibility with open-network-stream. | ||
| 86 | Handle the no-parameter case exactly as open-network-stream, with no | ||
| 87 | additional stream processing. Search plists using plist-get. | ||
| 88 | Explicitly add :end-of-commend parameter if it is missing. | ||
| 89 | (proto-stream-open-default): Renamed from | ||
| 90 | proto-stream-open-network-only. Return 'default as the type. | ||
| 91 | (proto-stream-open-starttls): Rename from proto-stream-open-network. | ||
| 92 | Use plist-get. Don't return `tls' as the type if STARTTLS negotiation | ||
| 93 | failed. Always return a list with a (possibly dead) process as the | ||
| 94 | first element, for compatibility with open-network-stream. | ||
| 95 | (proto-stream-open-tls): Use plist-get. Always return a list. | ||
| 96 | (proto-stream-open-shell): Return `default' as connection type. | ||
| 97 | (proto-stream-capability-open): Use plist-get. | ||
| 98 | (proto-stream-eoc): Function deleted. | ||
| 99 | |||
| 100 | * nnimap.el (nnimap-stream, nnimap-open-connection) | ||
| 101 | (nnimap-open-connection-1): Handle renaming of :type parameter for | ||
| 102 | open-protocol-stream. | ||
| 103 | (nnimap-open-connection-1): Pass a :return-list parameter | ||
| 104 | open-protocol-stream to obtain a list return value. Parse this list | ||
| 105 | using plist-get. | ||
| 106 | |||
| 107 | * nntp.el (nntp-open-connection): Handle renaming of :type parameter | ||
| 108 | for open-protocol-stream. Accept open-protocol-stream return value | ||
| 109 | that is a subprocess object instead of a list. Handle the case of a | ||
| 110 | dead returned process. | ||
| 111 | |||
| 112 | 2011-03-25 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 113 | |||
| 114 | * mm-util.el (mm-handle-filename): Move to mm-decode.el (bug#8330). | ||
| 115 | |||
| 116 | * mm-decode.el (mm-handle-filename): Move from mm-util.el (bug#8330). | ||
| 117 | |||
| 118 | 2011-03-21 Julien Danjou <julien@danjou.info> | ||
| 119 | |||
| 120 | * mm-view.el (mm-display-inline-fontify): Make mode optional, and call | ||
| 121 | normal-mode if not set. Set temp buffer unmodified to avoid kill-buffer | ||
| 122 | query. | ||
| 123 | (mm-inline-text): Render normal text with fontification whenever | ||
| 124 | possible. | ||
| 125 | |||
| 126 | * gnus-sum.el (gnus-summary-save-parts-1): | ||
| 127 | * gnus-art.el (gnus-article-browse-html-save-cid-content) | ||
| 128 | (gnus-article-browse-html-parts, gnus-mime-delete-part) | ||
| 129 | (gnus-mime-copy-part, gnus-mime-inline-part, gnus-insert-mime-button): | ||
| 130 | Use `mm-handle-filename'. | ||
| 131 | |||
| 132 | * mm-util.el (mm-handle-filename): New function, return the filename of | ||
| 133 | an handle. | ||
| 134 | |||
| 1 | 2011-03-18 Julien Danjou <julien@danjou.info> | 135 | 2011-03-18 Julien Danjou <julien@danjou.info> |
| 2 | 136 | ||
| 3 | * gnus-util.el (gnus-buffer-live-p): Simplify gnus-buffer-live-p. | 137 | * gnus-util.el (gnus-buffer-live-p): Simplify gnus-buffer-live-p. |
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 989488c0995..52fbe9da11f 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el | |||
| @@ -1925,9 +1925,10 @@ article numbers will be returned." | |||
| 1925 | (setq articles (gnus-list-range-intersection | 1925 | (setq articles (gnus-list-range-intersection |
| 1926 | articles (list (cons low high))))))) | 1926 | articles (list (cons low high))))))) |
| 1927 | 1927 | ||
| 1928 | (gnus-message | 1928 | (when articles |
| 1929 | 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'" | 1929 | (gnus-message |
| 1930 | (gnus-compress-sequence articles t)) | 1930 | 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'" |
| 1931 | (gnus-compress-sequence articles t))) | ||
| 1931 | 1932 | ||
| 1932 | (with-current-buffer nntp-server-buffer | 1933 | (with-current-buffer nntp-server-buffer |
| 1933 | (if articles | 1934 | (if articles |
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 7c7e0531926..97677988f0a 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -2811,14 +2811,11 @@ Return file name." | |||
| 2811 | ((equal (concat "<" cid ">") (mm-handle-id handle)) | 2811 | ((equal (concat "<" cid ">") (mm-handle-id handle)) |
| 2812 | (setq file | 2812 | (setq file |
| 2813 | (expand-file-name | 2813 | (expand-file-name |
| 2814 | (or (mail-content-type-get | 2814 | (or (mm-handle-filename handle) |
| 2815 | (mm-handle-disposition handle) 'filename) | 2815 | (concat |
| 2816 | (mail-content-type-get | 2816 | (make-temp-name "cid") |
| 2817 | (setq type (mm-handle-type handle)) 'name) | 2817 | (car (rassoc (car (mm-handle-type handle)) mailcap-mime-extensions)))) |
| 2818 | (concat | 2818 | directory)) |
| 2819 | (make-temp-name "cid") | ||
| 2820 | (car (rassoc (car type) mailcap-mime-extensions)))) | ||
| 2821 | directory)) | ||
| 2822 | (mm-save-part-to-file handle file) | 2819 | (mm-save-part-to-file handle file) |
| 2823 | (throw 'found file)))))))) | 2820 | (throw 'found file)))))))) |
| 2824 | 2821 | ||
| @@ -2835,10 +2832,7 @@ message header will be added to the bodies of the \"text/html\" parts." | |||
| 2835 | ((or (equal (car (setq type (mm-handle-type handle))) "text/html") | 2832 | ((or (equal (car (setq type (mm-handle-type handle))) "text/html") |
| 2836 | (and (equal (car type) "message/external-body") | 2833 | (and (equal (car type) "message/external-body") |
| 2837 | (or header | 2834 | (or header |
| 2838 | (setq file (or (mail-content-type-get type 'name) | 2835 | (setq file (mm-handle-filename handle))) |
| 2839 | (mail-content-type-get | ||
| 2840 | (mm-handle-disposition handle) | ||
| 2841 | 'filename)))) | ||
| 2842 | (or (mm-handle-cache handle) | 2836 | (or (mm-handle-cache handle) |
| 2843 | (condition-case code | 2837 | (condition-case code |
| 2844 | (progn (mm-extern-cache-contents handle) t) | 2838 | (progn (mm-extern-cache-contents handle) t) |
| @@ -5043,14 +5037,11 @@ Deleting parts may malfunction or destroy the article; continue? ")) | |||
| 5043 | (let* ((data (get-text-property (point) 'gnus-data)) | 5037 | (let* ((data (get-text-property (point) 'gnus-data)) |
| 5044 | (id (get-text-property (point) 'gnus-part)) | 5038 | (id (get-text-property (point) 'gnus-part)) |
| 5045 | (handles gnus-article-mime-handles) | 5039 | (handles gnus-article-mime-handles) |
| 5046 | (none "(none)") | ||
| 5047 | (description | 5040 | (description |
| 5048 | (let ((desc (mm-handle-description data))) | 5041 | (let ((desc (mm-handle-description data))) |
| 5049 | (when desc | 5042 | (when desc |
| 5050 | (mail-decode-encoded-word-string desc)))) | 5043 | (mail-decode-encoded-word-string desc)))) |
| 5051 | (filename | 5044 | (filename (or (mm-handle-filename (mm-handle-disposition data)) "(none)")) |
| 5052 | (or (mail-content-type-get (mm-handle-disposition data) 'filename) | ||
| 5053 | none)) | ||
| 5054 | (type (mm-handle-media-type data))) | 5045 | (type (mm-handle-media-type data))) |
| 5055 | (unless data | 5046 | (unless data |
| 5056 | (error "No MIME part under point")) | 5047 | (error "No MIME part under point")) |
| @@ -5168,10 +5159,7 @@ are decompressed." | |||
| 5168 | (unless handle | 5159 | (unless handle |
| 5169 | (setq handle (get-text-property (point) 'gnus-data))) | 5160 | (setq handle (get-text-property (point) 'gnus-data))) |
| 5170 | (when handle | 5161 | (when handle |
| 5171 | (let ((filename (or (mail-content-type-get (mm-handle-type handle) | 5162 | (let ((filename (mm-handle-filename handle)) |
| 5172 | 'name) | ||
| 5173 | (mail-content-type-get (mm-handle-disposition handle) | ||
| 5174 | 'filename))) | ||
| 5175 | contents dont-decode charset coding-system) | 5163 | contents dont-decode charset coding-system) |
| 5176 | (mm-with-unibyte-buffer | 5164 | (mm-with-unibyte-buffer |
| 5177 | (mm-insert-part handle) | 5165 | (mm-insert-part handle) |
| @@ -5261,12 +5249,7 @@ Compressed files like .gz and .bz2 are decompressed." | |||
| 5261 | (mm-with-unibyte-buffer | 5249 | (mm-with-unibyte-buffer |
| 5262 | (mm-insert-part handle) | 5250 | (mm-insert-part handle) |
| 5263 | (setq contents | 5251 | (setq contents |
| 5264 | (or (mm-decompress-buffer | 5252 | (or (mm-decompress-buffer (mm-handle-filename handle) nil t) |
| 5265 | (or (mail-content-type-get (mm-handle-type handle) | ||
| 5266 | 'name) | ||
| 5267 | (mail-content-type-get (mm-handle-disposition handle) | ||
| 5268 | 'filename)) | ||
| 5269 | nil t) | ||
| 5270 | (buffer-string)))) | 5253 | (buffer-string)))) |
| 5271 | (cond | 5254 | (cond |
| 5272 | ((not arg) | 5255 | ((not arg) |
| @@ -5671,8 +5654,7 @@ all parts." | |||
| 5671 | 5654 | ||
| 5672 | (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) | 5655 | (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) |
| 5673 | (let ((gnus-tmp-name | 5656 | (let ((gnus-tmp-name |
| 5674 | (or (mail-content-type-get (mm-handle-type handle) 'name) | 5657 | (or (mm-handle-filename handle) |
| 5675 | (mail-content-type-get (mm-handle-disposition handle) 'filename) | ||
| 5676 | (mail-content-type-get (mm-handle-type handle) 'url) | 5658 | (mail-content-type-get (mm-handle-type handle) 'url) |
| 5677 | "")) | 5659 | "")) |
| 5678 | (gnus-tmp-type (mm-handle-media-type handle)) | 5660 | (gnus-tmp-type (mm-handle-media-type handle)) |
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index cef173ce1ec..db3cc06e9aa 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el | |||
| @@ -124,7 +124,7 @@ display." | |||
| 124 | :type 'symbol) | 124 | :type 'symbol) |
| 125 | 125 | ||
| 126 | (defcustom gnus-registry-unfollowed-groups | 126 | (defcustom gnus-registry-unfollowed-groups |
| 127 | '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:") | 127 | '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:" "archive") |
| 128 | "List of groups that gnus-registry-split-fancy-with-parent won't return. | 128 | "List of groups that gnus-registry-split-fancy-with-parent won't return. |
| 129 | The group names are matched, they don't have to be fully | 129 | The group names are matched, they don't have to be fully |
| 130 | qualified. This parameter tells the Registry 'never split a | 130 | qualified. This parameter tells the Registry 'never split a |
| @@ -541,24 +541,26 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." | |||
| 541 | user-mail-address))) | 541 | user-mail-address))) |
| 542 | (maphash | 542 | (maphash |
| 543 | (lambda (key value) | 543 | (lambda (key value) |
| 544 | (let ((this-sender (cdr | 544 | ;; don't use more than gnus-registry-max-track-groups |
| 545 | (gnus-registry-fetch-extra key 'sender))) | 545 | (when (< (length found-full) gnus-registry-max-track-groups) |
| 546 | matches) | 546 | (let ((this-sender |
| 547 | (when (and this-sender | 547 | (cdr (gnus-registry-fetch-extra key 'sender))) |
| 548 | (equal sender this-sender)) | 548 | matches) |
| 549 | (let ((groups (gnus-registry-fetch-groups | 549 | (when (and this-sender |
| 550 | key | 550 | (equal sender this-sender)) |
| 551 | gnus-registry-max-track-groups))) | 551 | (let ((groups (gnus-registry-fetch-groups |
| 552 | (dolist (group groups) | 552 | key |
| 553 | (when (and group (gnus-registry-follow-group-p group)) | 553 | gnus-registry-max-track-groups))) |
| 554 | (push group found-full) | 554 | (dolist (group groups) |
| 555 | (setq found (append (list group) (delete group found)))))) | 555 | (when (and group (gnus-registry-follow-group-p group)) |
| 556 | (push key matches) | 556 | (push group found-full) |
| 557 | (gnus-message | 557 | (setq found (append (list group) (delete group found)))))) |
| 558 | ;; raise level of messaging if gnus-registry-track-extra | 558 | (push key matches) |
| 559 | (if gnus-registry-track-extra 7 9) | 559 | (gnus-message |
| 560 | "%s (extra tracking) traced sender %s to groups %s (keys %s)" | 560 | ;; raise level of messaging if gnus-registry-track-extra |
| 561 | log-agent sender found matches)))) | 561 | (if gnus-registry-track-extra 7 9) |
| 562 | "%s (extra tracking) traced sender %s to groups %s (keys %s)" | ||
| 563 | log-agent sender found matches))))) | ||
| 562 | gnus-registry-hashtb) | 564 | gnus-registry-hashtb) |
| 563 | ;; filter the found groups and return them | 565 | ;; filter the found groups and return them |
| 564 | ;; the found groups are NOT the full groups | 566 | ;; the found groups are NOT the full groups |
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index e376b7a7b6e..9bbfbfb057e 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el | |||
| @@ -2151,7 +2151,7 @@ score in `gnus-newsgroup-scored' by SCORE." | |||
| 2151 | ;; Find fuzzy matches. | 2151 | ;; Find fuzzy matches. |
| 2152 | (when fuzzies | 2152 | (when fuzzies |
| 2153 | ;; Simplify the entire buffer for easy matching. | 2153 | ;; Simplify the entire buffer for easy matching. |
| 2154 | (gnus-simplify-buffer-fuzzy) | 2154 | (gnus-simplify-buffer-fuzzy gnus-simplify-subject-fuzzy-regexp) |
| 2155 | (while (setq kill (cadaar fuzzies)) | 2155 | (while (setq kill (cadaar fuzzies)) |
| 2156 | (let* ((match (nth 0 kill)) | 2156 | (let* ((match (nth 0 kill)) |
| 2157 | (type (nth 3 kill)) | 2157 | (type (nth 3 kill)) |
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 29a98b7d11d..91dc6fb9595 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el | |||
| @@ -1734,7 +1734,7 @@ If RE-ONLY is non-nil, strip leading `Re:'s only." | |||
| 1734 | (while (re-search-forward regexp nil t) | 1734 | (while (re-search-forward regexp nil t) |
| 1735 | (replace-match (or newtext "")))) | 1735 | (replace-match (or newtext "")))) |
| 1736 | 1736 | ||
| 1737 | (defun gnus-simplify-buffer-fuzzy () | 1737 | (defun gnus-simplify-buffer-fuzzy (regexp) |
| 1738 | "Simplify string in the buffer fuzzily. | 1738 | "Simplify string in the buffer fuzzily. |
| 1739 | The string in the accessible portion of the current buffer is simplified. | 1739 | The string in the accessible portion of the current buffer is simplified. |
| 1740 | It is assumed to be a single-line subject. | 1740 | It is assumed to be a single-line subject. |
| @@ -1748,11 +1748,10 @@ matter is removed. Additional things can be deleted by setting | |||
| 1748 | (while (not (eq modified-tick (buffer-modified-tick))) | 1748 | (while (not (eq modified-tick (buffer-modified-tick))) |
| 1749 | (setq modified-tick (buffer-modified-tick)) | 1749 | (setq modified-tick (buffer-modified-tick)) |
| 1750 | (cond | 1750 | (cond |
| 1751 | ((listp gnus-simplify-subject-fuzzy-regexp) | 1751 | ((listp regexp) |
| 1752 | (mapc 'gnus-simplify-buffer-fuzzy-step | 1752 | (mapc 'gnus-simplify-buffer-fuzzy-step regexp)) |
| 1753 | gnus-simplify-subject-fuzzy-regexp)) | 1753 | (regexp |
| 1754 | (gnus-simplify-subject-fuzzy-regexp | 1754 | (gnus-simplify-buffer-fuzzy-step regexp))) |
| 1755 | (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp))) | ||
| 1756 | (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *") | 1755 | (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *") |
| 1757 | (gnus-simplify-buffer-fuzzy-step | 1756 | (gnus-simplify-buffer-fuzzy-step |
| 1758 | "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") | 1757 | "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") |
| @@ -1767,15 +1766,16 @@ matter is removed. Additional things can be deleted by setting | |||
| 1767 | "Simplify a subject string fuzzily. | 1766 | "Simplify a subject string fuzzily. |
| 1768 | See `gnus-simplify-buffer-fuzzy' for details." | 1767 | See `gnus-simplify-buffer-fuzzy' for details." |
| 1769 | (save-excursion | 1768 | (save-excursion |
| 1770 | (gnus-set-work-buffer) | 1769 | (let ((regexp gnus-simplify-subject-fuzzy-regexp)) |
| 1771 | (let ((case-fold-search t)) | 1770 | (gnus-set-work-buffer) |
| 1772 | ;; Remove uninteresting prefixes. | 1771 | (let ((case-fold-search t)) |
| 1773 | (when (and gnus-simplify-ignored-prefixes | 1772 | ;; Remove uninteresting prefixes. |
| 1774 | (string-match gnus-simplify-ignored-prefixes subject)) | 1773 | (when (and gnus-simplify-ignored-prefixes |
| 1775 | (setq subject (substring subject (match-end 0)))) | 1774 | (string-match gnus-simplify-ignored-prefixes subject)) |
| 1776 | (insert subject) | 1775 | (setq subject (substring subject (match-end 0)))) |
| 1777 | (inline (gnus-simplify-buffer-fuzzy)) | 1776 | (insert subject) |
| 1778 | (buffer-string)))) | 1777 | (inline (gnus-simplify-buffer-fuzzy regexp)) |
| 1778 | (buffer-string))))) | ||
| 1779 | 1779 | ||
| 1780 | (defsubst gnus-simplify-subject-fully (subject) | 1780 | (defsubst gnus-simplify-subject-fully (subject) |
| 1781 | "Simplify a subject string according to `gnus-summary-gather-subject-limit'." | 1781 | "Simplify a subject string according to `gnus-summary-gather-subject-limit'." |
| @@ -6068,14 +6068,23 @@ If SELECT-ARTICLES, only select those articles from GROUP." | |||
| 6068 | 'request-set-mark gnus-newsgroup-name) | 6068 | 'request-set-mark gnus-newsgroup-name) |
| 6069 | (not (gnus-article-unpropagatable-p (cdr type)))) | 6069 | (not (gnus-article-unpropagatable-p (cdr type)))) |
| 6070 | (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) | 6070 | (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) |
| 6071 | (del (gnus-remove-from-range (gnus-copy-sequence old) list)) | 6071 | ;; Don't do anything about marks for articles we |
| 6072 | (add (gnus-remove-from-range | 6072 | ;; didn't actually get any headers for. |
| 6073 | (gnus-copy-sequence list) old))) | 6073 | (existing (gnus-compress-sequence gnus-newsgroup-articles)) |
| 6074 | (del | ||
| 6075 | (gnus-sorted-range-intersection | ||
| 6076 | existing | ||
| 6077 | (gnus-remove-from-range (gnus-copy-sequence old) list))) | ||
| 6078 | (add | ||
| 6079 | (gnus-sorted-range-intersection | ||
| 6080 | existing | ||
| 6081 | (gnus-remove-from-range | ||
| 6082 | (gnus-copy-sequence list) old)))) | ||
| 6074 | (when add | 6083 | (when add |
| 6075 | (push (list add 'add (list (cdr type))) delta-marks)) | 6084 | (push (list add 'add (list (cdr type))) delta-marks)) |
| 6076 | (when del | 6085 | (when del |
| 6077 | ;; Don't delete marks from outside the active range. This | 6086 | ;; Don't delete marks from outside the active range. |
| 6078 | ;; shouldn't happen, but is a sanity check. | 6087 | ;; This shouldn't happen, but is a sanity check. |
| 6079 | (setq del (gnus-sorted-range-intersection | 6088 | (setq del (gnus-sorted-range-intersection |
| 6080 | (gnus-active gnus-newsgroup-name) del)) | 6089 | (gnus-active gnus-newsgroup-name) del)) |
| 6081 | (push (list del 'del (list (cdr type))) delta-marks)))) | 6090 | (push (list del 'del (list (cdr type))) delta-marks)))) |
| @@ -12142,10 +12151,7 @@ If REVERSE, save parts that do not match TYPE." | |||
| 12142 | mm-file-name-rewrite-functions | 12151 | mm-file-name-rewrite-functions |
| 12143 | (file-name-nondirectory | 12152 | (file-name-nondirectory |
| 12144 | (or | 12153 | (or |
| 12145 | (mail-content-type-get | 12154 | (mm-handle-filename handle) |
| 12146 | (mm-handle-disposition handle) 'filename) | ||
| 12147 | (mail-content-type-get | ||
| 12148 | (mm-handle-type handle) 'name) | ||
| 12149 | (format "%s.%d.%d" gnus-newsgroup-name | 12155 | (format "%s.%d.%d" gnus-newsgroup-name |
| 12150 | (cdr gnus-article-current) | 12156 | (cdr gnus-article-current) |
| 12151 | gnus-summary-save-parts-counter)))) | 12157 | gnus-summary-save-parts-counter)))) |
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 57d085a0380..d4ecd89db92 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el | |||
| @@ -1043,12 +1043,15 @@ be set in `.emacs' instead." | |||
| 1043 | ((boundp 'image-load-path) | 1043 | ((boundp 'image-load-path) |
| 1044 | (symbol-value 'image-load-path)) | 1044 | (symbol-value 'image-load-path)) |
| 1045 | (t load-path))) | 1045 | (t load-path))) |
| 1046 | (image (find-image | 1046 | (image (gnus-splash-svg-color-symbols (find-image |
| 1047 | `((:type xpm :file "gnus.xpm" | 1047 | `((:type svg :file "gnus.svg" |
| 1048 | :color-symbols | ||
| 1049 | (("#bf9900" . ,(car gnus-logo-colors)) | ||
| 1050 | ("#ffcc00" . ,(cadr gnus-logo-colors)))) | ||
| 1051 | (:type xpm :file "gnus.xpm" | ||
| 1048 | :color-symbols | 1052 | :color-symbols |
| 1049 | (("thing" . ,(car gnus-logo-colors)) | 1053 | (("thing" . ,(car gnus-logo-colors)) |
| 1050 | ("shadow" . ,(cadr gnus-logo-colors)))) | 1054 | ("shadow" . ,(cadr gnus-logo-colors)))) |
| 1051 | (:type svg :file "gnus.svg") | ||
| 1052 | (:type png :file "gnus.png") | 1055 | (:type png :file "gnus.png") |
| 1053 | (:type pbm :file "gnus.pbm" | 1056 | (:type pbm :file "gnus.pbm" |
| 1054 | ;; Account for the pbm's background. | 1057 | ;; Account for the pbm's background. |
| @@ -1057,7 +1060,7 @@ be set in `.emacs' instead." | |||
| 1057 | (:type xbm :file "gnus.xbm" | 1060 | (:type xbm :file "gnus.xbm" |
| 1058 | ;; Account for the xbm's background. | 1061 | ;; Account for the xbm's background. |
| 1059 | :background ,(face-foreground 'gnus-splash) | 1062 | :background ,(face-foreground 'gnus-splash) |
| 1060 | :foreground ,(face-background 'default)))))) | 1063 | :foreground ,(face-background 'default))))))) |
| 1061 | (when image | 1064 | (when image |
| 1062 | (let ((size (image-size image))) | 1065 | (let ((size (image-size image))) |
| 1063 | (insert-char ?\n (max 0 (round (- (window-height) | 1066 | (insert-char ?\n (max 0 (round (- (window-height) |
| @@ -1103,6 +1106,20 @@ be set in `.emacs' instead." | |||
| 1103 | (setq mode-line-buffer-identification (concat " " gnus-version)) | 1106 | (setq mode-line-buffer-identification (concat " " gnus-version)) |
| 1104 | (set-buffer-modified-p t))) | 1107 | (set-buffer-modified-p t))) |
| 1105 | 1108 | ||
| 1109 | (defun gnus-splash-svg-color-symbols (list) | ||
| 1110 | "Do color-symbol search-and-replace in svg file" | ||
| 1111 | (let ((type (plist-get (cdr list) :type)) | ||
| 1112 | (file (plist-get (cdr list) :file)) | ||
| 1113 | (color-symbols (plist-get (cdr list) :color-symbols))) | ||
| 1114 | (if (string= type "svg") | ||
| 1115 | (let ((data (with-temp-buffer (insert-file file) (buffer-string)))) | ||
| 1116 | (mapc (lambda (rule) | ||
| 1117 | (setq data (replace-regexp-in-string | ||
| 1118 | (concat "fill:" (car rule)) | ||
| 1119 | (concat "fill:" (cdr rule)) data))) color-symbols) | ||
| 1120 | (cons (car list) (list :type type :data data))) | ||
| 1121 | list))) | ||
| 1122 | |||
| 1106 | (eval-when (load) | 1123 | (eval-when (load) |
| 1107 | (let ((command (format "%s" this-command))) | 1124 | (let ((command (format "%s" this-command))) |
| 1108 | (when (string-match "gnus" command) | 1125 | (when (string-match "gnus" command) |
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el index 3765fb84ee8..e96c23b14ac 100644 --- a/lisp/gnus/gssapi.el +++ b/lisp/gnus/gssapi.el | |||
| @@ -33,14 +33,14 @@ | |||
| 33 | "--authentication-id %l") | 33 | "--authentication-id %l") |
| 34 | "imtest -m gssapi -u %l -p %p %s") | 34 | "imtest -m gssapi -u %l -p %p %s") |
| 35 | "List of strings containing commands for GSSAPI (krb5) authentication. | 35 | "List of strings containing commands for GSSAPI (krb5) authentication. |
| 36 | %s is replaced with server hostname, %p with port to connect to, and | 36 | %s is replaced with server hostname, %p with port to connect to, |
| 37 | %l with the value of `imap-default-user'. The program should accept | 37 | and %l with the user name. The program should accept commands on |
| 38 | IMAP commands on stdin and return responses to stdout. Each entry in | 38 | stdin and return responses to stdout. Each entry in the list is |
| 39 | the list is tried until a successful connection is made." | 39 | tried until a successful connection is made." |
| 40 | :group 'network | 40 | :group 'network |
| 41 | :type '(repeat string)) | 41 | :type '(repeat string)) |
| 42 | 42 | ||
| 43 | (defun open-gssapi-stream (name buffer server port) | 43 | (defun open-gssapi-stream (name buffer server port user) |
| 44 | (let ((cmds gssapi-program) | 44 | (let ((cmds gssapi-program) |
| 45 | cmd done) | 45 | cmd done) |
| 46 | (with-current-buffer buffer | 46 | (with-current-buffer buffer |
| @@ -57,7 +57,7 @@ the list is tried until a successful connection is made." | |||
| 57 | (format-spec-make | 57 | (format-spec-make |
| 58 | ?s server | 58 | ?s server |
| 59 | ?p (number-to-string port) | 59 | ?p (number-to-string port) |
| 60 | ?l imap-default-user)))) | 60 | ?l user)))) |
| 61 | response) | 61 | response) |
| 62 | (when process | 62 | (when process |
| 63 | (while (and (memq (process-status process) '(open run)) | 63 | (while (and (memq (process-status process) '(open run)) |
| @@ -92,7 +92,7 @@ the list is tried until a successful connection is made." | |||
| 92 | (accept-process-output process 1) | 92 | (accept-process-output process 1) |
| 93 | (sit-for 1)) | 93 | (sit-for 1)) |
| 94 | (erase-buffer) | 94 | (erase-buffer) |
| 95 | (message "GSSAPI IMAP connection: %s" (or response "failed")) | 95 | (message "GSSAPI connection: %s" (or response "failed")) |
| 96 | (if (and response (let ((case-fold-search nil)) | 96 | (if (and response (let ((case-fold-search nil)) |
| 97 | (not (string-match "failed" response)))) | 97 | (not (string-match "failed" response)))) |
| 98 | (setq done process) | 98 | (setq done process) |
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index bb9215aca7c..6d9fd712c33 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -3712,22 +3712,9 @@ To use this automatically, you may add this function to | |||
| 3712 | (while (re-search-forward citexp nil t) | 3712 | (while (re-search-forward citexp nil t) |
| 3713 | (replace-match (if remove "" "\n")))))) | 3713 | (replace-match (if remove "" "\n")))))) |
| 3714 | 3714 | ||
| 3715 | (defun message-yank-original (&optional arg) | 3715 | (defun message--yank-original-internal (arg) |
| 3716 | "Insert the message being replied to, if any. | ||
| 3717 | Puts point before the text and mark after. | ||
| 3718 | Normally indents each nonblank line ARG spaces (default 3). However, | ||
| 3719 | if `message-yank-prefix' is non-nil, insert that prefix on each line. | ||
| 3720 | |||
| 3721 | This function uses `message-cite-function' to do the actual citing. | ||
| 3722 | |||
| 3723 | Just \\[universal-argument] as argument means don't indent, insert no | ||
| 3724 | prefix, and don't delete any headers." | ||
| 3725 | (interactive "P") | ||
| 3726 | (let ((modified (buffer-modified-p)) | 3716 | (let ((modified (buffer-modified-p)) |
| 3727 | body-text) | 3717 | body-text) |
| 3728 | ;; eval the let forms contained in message-cite-style | ||
| 3729 | (eval | ||
| 3730 | `(let ,message-cite-style | ||
| 3731 | (when (and message-reply-buffer | 3718 | (when (and message-reply-buffer |
| 3732 | message-cite-function) | 3719 | message-cite-function) |
| 3733 | (when (equal message-cite-reply-position 'above) | 3720 | (when (equal message-cite-reply-position 'above) |
| @@ -3767,7 +3754,23 @@ prefix, and don't delete any headers." | |||
| 3767 | ;; Add a `message-setup-very-last-hook' here? | 3754 | ;; Add a `message-setup-very-last-hook' here? |
| 3768 | ;; Add `gnus-article-highlight-citation' here? | 3755 | ;; Add `gnus-article-highlight-citation' here? |
| 3769 | (unless modified | 3756 | (unless modified |
| 3770 | (setq message-checksum (message-checksum)))))))) | 3757 | (setq message-checksum (message-checksum)))))) |
| 3758 | |||
| 3759 | (defun message-yank-original (&optional arg) | ||
| 3760 | "Insert the message being replied to, if any. | ||
| 3761 | Puts point before the text and mark after. | ||
| 3762 | Normally indents each nonblank line ARG spaces (default 3). However, | ||
| 3763 | if `message-yank-prefix' is non-nil, insert that prefix on each line. | ||
| 3764 | |||
| 3765 | This function uses `message-cite-function' to do the actual citing. | ||
| 3766 | |||
| 3767 | Just \\[universal-argument] as argument means don't indent, insert no | ||
| 3768 | prefix, and don't delete any headers." | ||
| 3769 | (interactive "P") | ||
| 3770 | ;; eval the let forms contained in message-cite-style | ||
| 3771 | (eval | ||
| 3772 | `(let ,message-cite-style | ||
| 3773 | (message--yank-original-internal ',arg)))) | ||
| 3771 | 3774 | ||
| 3772 | (defun message-yank-buffer (buffer) | 3775 | (defun message-yank-buffer (buffer) |
| 3773 | "Insert BUFFER into the current buffer and quote it." | 3776 | "Insert BUFFER into the current buffer and quote it." |
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 3909e12186f..f543920446b 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el | |||
| @@ -1744,6 +1744,13 @@ If RECURSIVE, search recursively." | |||
| 1744 | (delete-region ,(point-min-marker) | 1744 | (delete-region ,(point-min-marker) |
| 1745 | ,(point-max-marker)))))))) | 1745 | ,(point-max-marker)))))))) |
| 1746 | 1746 | ||
| 1747 | (defun mm-handle-filename (handle) | ||
| 1748 | "Return filename of HANDLE if any." | ||
| 1749 | (or (mail-content-type-get (mm-handle-type handle) | ||
| 1750 | 'name) | ||
| 1751 | (mail-content-type-get (mm-handle-disposition handle) | ||
| 1752 | 'filename))) | ||
| 1753 | |||
| 1747 | (provide 'mm-decode) | 1754 | (provide 'mm-decode) |
| 1748 | 1755 | ||
| 1749 | ;;; mm-decode.el ends here | 1756 | ;;; mm-decode.el ends here |
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index d63d20239dc..abd78b8de02 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el | |||
| @@ -455,7 +455,7 @@ | |||
| 455 | (narrow-to-region (point) (point)) | 455 | (narrow-to-region (point) (point)) |
| 456 | (mm-insert-part handle) | 456 | (mm-insert-part handle) |
| 457 | (goto-char (point-max))) | 457 | (goto-char (point-max))) |
| 458 | (insert (mm-decode-string (mm-get-part handle) charset))) | 458 | (mm-display-inline-fontify handle)) |
| 459 | (when (and mm-fill-flowed | 459 | (when (and mm-fill-flowed |
| 460 | (equal type "plain") | 460 | (equal type "plain") |
| 461 | (equal (cdr (assoc 'format (mm-handle-type handle))) | 461 | (equal (cdr (assoc 'format (mm-handle-type handle))) |
| @@ -565,15 +565,16 @@ | |||
| 565 | (face-property 'default prop) (current-buffer)))) | 565 | (face-property 'default prop) (current-buffer)))) |
| 566 | (delete-region ,(point-min-marker) ,(point-max-marker))))))))) | 566 | (delete-region ,(point-min-marker) ,(point-max-marker))))))))) |
| 567 | 567 | ||
| 568 | (defun mm-display-inline-fontify (handle mode) | 568 | (defun mm-display-inline-fontify (handle &optional mode) |
| 569 | "Insert HANDLE inline fontifying with MODE. | ||
| 570 | If MODE is not set, try to find mode automatically." | ||
| 569 | (let ((charset (mail-content-type-get (mm-handle-type handle) 'charset)) | 571 | (let ((charset (mail-content-type-get (mm-handle-type handle) 'charset)) |
| 570 | text coding-system) | 572 | text coding-system) |
| 571 | (unless (eq charset 'gnus-decoded) | 573 | (unless (eq charset 'gnus-decoded) |
| 572 | (mm-with-unibyte-buffer | 574 | (mm-with-unibyte-buffer |
| 573 | (mm-insert-part handle) | 575 | (mm-insert-part handle) |
| 574 | (mm-decompress-buffer | 576 | (mm-decompress-buffer |
| 575 | (or (mail-content-type-get (mm-handle-disposition handle) 'name) | 577 | (mm-handle-filename handle) |
| 576 | (mail-content-type-get (mm-handle-disposition handle) 'filename)) | ||
| 577 | t t) | 578 | t t) |
| 578 | (unless charset | 579 | (unless charset |
| 579 | (setq coding-system (mm-find-buffer-file-coding-system))) | 580 | (setq coding-system (mm-find-buffer-file-coding-system))) |
| @@ -601,7 +602,11 @@ | |||
| 601 | (font-lock-support-mode nil) | 602 | (font-lock-support-mode nil) |
| 602 | ;; I find font-lock a bit too verbose. | 603 | ;; I find font-lock a bit too verbose. |
| 603 | (font-lock-verbose nil)) | 604 | (font-lock-verbose nil)) |
| 604 | (funcall mode) | 605 | (setq buffer-file-name (mm-handle-filename handle)) |
| 606 | (set (make-local-variable 'enable-local-variables) nil) | ||
| 607 | (if mode | ||
| 608 | (funcall mode) | ||
| 609 | (set-auto-mode)) | ||
| 605 | ;; The mode function might have already turned on font-lock. | 610 | ;; The mode function might have already turned on font-lock. |
| 606 | (unless (symbol-value 'font-lock-mode) | 611 | (unless (symbol-value 'font-lock-mode) |
| 607 | (font-lock-fontify-buffer))) | 612 | (font-lock-fontify-buffer))) |
| @@ -614,6 +619,9 @@ | |||
| 614 | nil) | 619 | nil) |
| 615 | nil nil nil nil nil 'text-prop)) | 620 | nil nil nil nil nil 'text-prop)) |
| 616 | (setq text (buffer-string)) | 621 | (setq text (buffer-string)) |
| 622 | ;; Set buffer unmodified to avoid confirmation when killing the | ||
| 623 | ;; buffer. | ||
| 624 | (set-buffer-modified-p nil) | ||
| 617 | (kill-buffer (current-buffer))) | 625 | (kill-buffer (current-buffer))) |
| 618 | (mm-insert-inline handle text))) | 626 | (mm-insert-inline handle text))) |
| 619 | 627 | ||
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index bcbe7b678d5..fa09c7ff165 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el | |||
| @@ -61,10 +61,12 @@ If nnimap-stream is `ssl', this will default to `imaps'. If not, | |||
| 61 | it will default to `imap'.") | 61 | it will default to `imap'.") |
| 62 | 62 | ||
| 63 | (defvoo nnimap-stream 'undecided | 63 | (defvoo nnimap-stream 'undecided |
| 64 | "How nnimap will talk to the IMAP server. | 64 | "How nnimap talks to the IMAP server. |
| 65 | Values are `ssl', `network', `network-only, `starttls' or | 65 | The value should be either `undecided', `ssl' or `tls', |
| 66 | `shell'. The default is to try `ssl' first, and then | 66 | `network', `starttls', `plain', or `shell'. |
| 67 | `network'.") | 67 | |
| 68 | If the value is `undecided', nnimap tries `ssl' first, then falls | ||
| 69 | back on `network'.") | ||
| 68 | 70 | ||
| 69 | (defvoo nnimap-shell-program (if (boundp 'imap-shell-program) | 71 | (defvoo nnimap-shell-program (if (boundp 'imap-shell-program) |
| 70 | (if (listp imap-shell-program) | 72 | (if (listp imap-shell-program) |
| @@ -339,9 +341,7 @@ textual parts.") | |||
| 339 | (port nil) | 341 | (port nil) |
| 340 | (ports | 342 | (ports |
| 341 | (cond | 343 | (cond |
| 342 | ((or (eq nnimap-stream 'network) | 344 | ((memq nnimap-stream '(network plain starttls)) |
| 343 | (eq nnimap-stream 'network-only) | ||
| 344 | (eq nnimap-stream 'starttls)) | ||
| 345 | (nnheader-message 7 "Opening connection to %s..." | 345 | (nnheader-message 7 "Opening connection to %s..." |
| 346 | nnimap-address) | 346 | nnimap-address) |
| 347 | '("imap" "143")) | 347 | '("imap" "143")) |
| @@ -355,21 +355,28 @@ textual parts.") | |||
| 355 | '("imaps" "imap" "993" "143")) | 355 | '("imaps" "imap" "993" "143")) |
| 356 | (t | 356 | (t |
| 357 | (error "Unknown stream type: %s" nnimap-stream)))) | 357 | (error "Unknown stream type: %s" nnimap-stream)))) |
| 358 | (proto-stream-always-use-starttls t) | ||
| 359 | login-result credentials) | 358 | login-result credentials) |
| 360 | (when nnimap-server-port | 359 | (when nnimap-server-port |
| 361 | (push nnimap-server-port ports)) | 360 | (push nnimap-server-port ports)) |
| 362 | (destructuring-bind (stream greeting capabilities stream-type) | 361 | (let* ((stream-list |
| 363 | (open-protocol-stream | 362 | (open-protocol-stream |
| 364 | "*nnimap*" (current-buffer) nnimap-address (car ports) | 363 | "*nnimap*" (current-buffer) nnimap-address (car ports) |
| 365 | :type nnimap-stream | 364 | :type nnimap-stream |
| 366 | :shell-command nnimap-shell-program | 365 | :return-list t |
| 367 | :capability-command "1 CAPABILITY\r\n" | 366 | :shell-command nnimap-shell-program |
| 368 | :success " OK " | 367 | :capability-command "1 CAPABILITY\r\n" |
| 369 | :starttls-function | 368 | :success " OK " |
| 370 | (lambda (capabilities) | 369 | :starttls-function |
| 371 | (when (gnus-string-match-p "STARTTLS" capabilities) | 370 | (lambda (capabilities) |
| 372 | "1 STARTTLS\r\n"))) | 371 | (when (gnus-string-match-p "STARTTLS" capabilities) |
| 372 | "1 STARTTLS\r\n")))) | ||
| 373 | (stream (car stream-list)) | ||
| 374 | (props (cdr stream-list)) | ||
| 375 | (greeting (plist-get props :greeting)) | ||
| 376 | (capabilities (plist-get props :capabilities)) | ||
| 377 | (stream-type (plist-get props :type))) | ||
| 378 | (when (and stream (not (memq (process-status stream) '(open run)))) | ||
| 379 | (setq stream nil)) | ||
| 373 | (setf (nnimap-process nnimap-object) stream) | 380 | (setf (nnimap-process nnimap-object) stream) |
| 374 | (setf (nnimap-stream-type nnimap-object) stream-type) | 381 | (setf (nnimap-stream-type nnimap-object) stream-type) |
| 375 | (if (not stream) | 382 | (if (not stream) |
| @@ -403,11 +410,18 @@ textual parts.") | |||
| 403 | (setq login-result | 410 | (setq login-result |
| 404 | (nnimap-login (car credentials) (cadr credentials)))) | 411 | (nnimap-login (car credentials) (cadr credentials)))) |
| 405 | (if (car login-result) | 412 | (if (car login-result) |
| 406 | ;; save the credentials if a save function exists | 413 | (progn |
| 414 | ;; Save the credentials if a save function exists | ||
| 407 | ;; (such a function will only be passed if a new | 415 | ;; (such a function will only be passed if a new |
| 408 | ;; token was created) | 416 | ;; token was created). |
| 409 | (when (functionp (nth 2 credentials)) | 417 | (when (functionp (nth 2 credentials)) |
| 410 | (funcall (nth 2 credentials))) | 418 | (funcall (nth 2 credentials))) |
| 419 | ;; See if CAPABILITY is set as part of login | ||
| 420 | ;; response. | ||
| 421 | (dolist (response (cddr login-result)) | ||
| 422 | (when (string= "CAPABILITY" (upcase (car response))) | ||
| 423 | (setf (nnimap-capabilities nnimap-object) | ||
| 424 | (mapcar #'upcase (cdr response)))))) | ||
| 411 | ;; If the login failed, then forget the credentials | 425 | ;; If the login failed, then forget the credentials |
| 412 | ;; that are now possibly cached. | 426 | ;; that are now possibly cached. |
| 413 | (dolist (host (list (nnoo-current-server 'nnimap) | 427 | (dolist (host (list (nnoo-current-server 'nnimap) |
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 66a6365cb3b..fa765e17463 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el | |||
| @@ -76,27 +76,27 @@ to innd, you could say something like: | |||
| 76 | You probably don't want to do that, though.") | 76 | You probably don't want to do that, though.") |
| 77 | 77 | ||
| 78 | (defvoo nntp-open-connection-function 'nntp-open-network-stream | 78 | (defvoo nntp-open-connection-function 'nntp-open-network-stream |
| 79 | "*Function used for connecting to a remote system. | 79 | "Method for connecting to a remote system. |
| 80 | It will be called with the buffer to output in as argument. | 80 | It should be a function, which is called with the output buffer |
| 81 | 81 | as its single argument, or one of the following special values: | |
| 82 | Currently, five such functions are provided (please refer to their | 82 | |
| 83 | respective doc string for more information), three of them establishing | 83 | - `nntp-open-network-stream' specifies a network connection, |
| 84 | direct connections to the nntp server, and two of them using an indirect | 84 | upgrading to a TLS connection via STARTTLS if possible. |
| 85 | host. | 85 | - `nntp-open-plain-stream' specifies an unencrypted network |
| 86 | 86 | connection (no STARTTLS upgrade is attempted). | |
| 87 | Direct connections: | 87 | - `nntp-open-ssl-stream' or `nntp-open-tls-stream' specify a TLS |
| 88 | - `nntp-open-network-stream' (the default), | 88 | network connection. |
| 89 | - `network-only' (the same as the above, but don't do automatic | 89 | |
| 90 | STARTTLS upgrades). | 90 | Apart from the above special values, valid functions are as |
| 91 | - `nntp-open-ssl-stream', | 91 | follows; please refer to their respective doc string for more |
| 92 | - `nntp-open-tls-stream', | 92 | information. |
| 93 | - `nntp-open-netcat-stream'. | 93 | For direct connections: |
| 94 | - `nntp-open-telnet-stream'. | 94 | - `nntp-open-netcat-stream' |
| 95 | 95 | - `nntp-open-telnet-stream' | |
| 96 | Indirect connections: | 96 | For indirect connections: |
| 97 | - `nntp-open-via-rlogin-and-netcat', | 97 | - `nntp-open-via-rlogin-and-netcat' |
| 98 | - `nntp-open-via-rlogin-and-telnet', | 98 | - `nntp-open-via-rlogin-and-telnet' |
| 99 | - `nntp-open-via-telnet-and-telnet'.") | 99 | - `nntp-open-via-telnet-and-telnet'") |
| 100 | 100 | ||
| 101 | (defvoo nntp-never-echoes-commands nil | 101 | (defvoo nntp-never-echoes-commands nil |
| 102 | "*Non-nil means the nntp server never echoes commands. | 102 | "*Non-nil means the nntp server never echoes commands. |
| @@ -1340,25 +1340,25 @@ password contained in '~/.nntp-authinfo'." | |||
| 1340 | (let ((coding-system-for-read nntp-coding-system-for-read) | 1340 | (let ((coding-system-for-read nntp-coding-system-for-read) |
| 1341 | (coding-system-for-write nntp-coding-system-for-write) | 1341 | (coding-system-for-write nntp-coding-system-for-write) |
| 1342 | (map '((nntp-open-network-stream network) | 1342 | (map '((nntp-open-network-stream network) |
| 1343 | (network-only network-only) | 1343 | (network-only plain) ; compat |
| 1344 | (nntp-open-plain-stream plain) | ||
| 1344 | (nntp-open-ssl-stream tls) | 1345 | (nntp-open-ssl-stream tls) |
| 1345 | (nntp-open-tls-stream tls)))) | 1346 | (nntp-open-tls-stream tls)))) |
| 1346 | (if (assoc nntp-open-connection-function map) | 1347 | (if (assoc nntp-open-connection-function map) |
| 1347 | (car (open-protocol-stream | 1348 | (open-protocol-stream |
| 1348 | "nntpd" pbuffer nntp-address nntp-port-number | 1349 | "nntpd" pbuffer nntp-address nntp-port-number |
| 1349 | :type (cadr | 1350 | :type (cadr (assoc nntp-open-connection-function map)) |
| 1350 | (assoc nntp-open-connection-function map)) | 1351 | :end-of-command "^\\([2345]\\|[.]\\).*\n" |
| 1351 | :end-of-command "^\\([2345]\\|[.]\\).*\n" | 1352 | :capability-command "CAPABILITIES\r\n" |
| 1352 | :capability-command "CAPABILITIES\r\n" | 1353 | :success "^3" |
| 1353 | :success "^3" | 1354 | :starttls-function |
| 1354 | :starttls-function | 1355 | (lambda (capabilities) |
| 1355 | (lambda (capabilities) | 1356 | (if (not (string-match "STARTTLS" capabilities)) |
| 1356 | (if (not (string-match "STARTTLS" capabilities)) | 1357 | nil |
| 1357 | nil | 1358 | "STARTTLS\r\n"))) |
| 1358 | "STARTTLS\r\n")))) | ||
| 1359 | (funcall nntp-open-connection-function pbuffer))) | 1359 | (funcall nntp-open-connection-function pbuffer))) |
| 1360 | (error | 1360 | (error |
| 1361 | (nnheader-report 'nntp "%s" err)) | 1361 | (nnheader-report 'nntp ">>> %s" err)) |
| 1362 | (quit | 1362 | (quit |
| 1363 | (message "Quit opening connection to %s" nntp-address) | 1363 | (message "Quit opening connection to %s" nntp-address) |
| 1364 | (nntp-kill-buffer pbuffer) | 1364 | (nntp-kill-buffer pbuffer) |
| @@ -1366,6 +1366,9 @@ password contained in '~/.nntp-authinfo'." | |||
| 1366 | nil)))) | 1366 | nil)))) |
| 1367 | (when timer | 1367 | (when timer |
| 1368 | (nnheader-cancel-timer timer)) | 1368 | (nnheader-cancel-timer timer)) |
| 1369 | (when (and process | ||
| 1370 | (not (memq (process-status process) '(open run)))) | ||
| 1371 | (setq process nil)) | ||
| 1369 | (unless process | 1372 | (unless process |
| 1370 | (nntp-kill-buffer pbuffer)) | 1373 | (nntp-kill-buffer pbuffer)) |
| 1371 | (when (and (buffer-name pbuffer) | 1374 | (when (and (buffer-name pbuffer) |
diff --git a/lisp/gnus/proto-stream.el b/lisp/gnus/proto-stream.el index fdf2abfea05..45cc974e7a9 100644 --- a/lisp/gnus/proto-stream.el +++ b/lisp/gnus/proto-stream.el | |||
| @@ -48,171 +48,162 @@ | |||
| 48 | 48 | ||
| 49 | ;;; Code: | 49 | ;;; Code: |
| 50 | 50 | ||
| 51 | (eval-when-compile | ||
| 52 | (require 'cl)) | ||
| 53 | (require 'tls) | 51 | (require 'tls) |
| 54 | (require 'starttls) | 52 | (require 'starttls) |
| 55 | (require 'format-spec) | ||
| 56 | |||
| 57 | (defcustom proto-stream-always-use-starttls (fboundp 'open-gnutls-stream) | ||
| 58 | "If non-nil, always try to upgrade network connections with STARTTLS." | ||
| 59 | :version "24.1" | ||
| 60 | :type 'boolean | ||
| 61 | :group 'comm) | ||
| 62 | 53 | ||
| 63 | (declare-function gnutls-negotiate "gnutls" | 54 | (declare-function gnutls-negotiate "gnutls" |
| 64 | (proc type &optional priority-string trustfiles keyfiles)) | 55 | (proc type &optional priority-string trustfiles keyfiles)) |
| 65 | 56 | ||
| 66 | ;;;###autoload | 57 | ;;;###autoload |
| 67 | (defun open-protocol-stream (name buffer host service &rest parameters) | 58 | (defun open-protocol-stream (name buffer host service &rest parameters) |
| 68 | "Open a network stream to HOST, upgrading to STARTTLS if possible. | 59 | "Open a network stream to HOST, possibly with encryption. |
| 69 | The first four parameters have the same meaning as in | 60 | Normally, return a network process object; with a non-nil |
| 70 | `open-network-stream'. The function returns a list where the | 61 | :return-list parameter, return a list instead (see below). |
| 71 | first element is the stream, the second element is the greeting | 62 | |
| 72 | the server replied with after connecting, and the third element | 63 | The first four parameters, NAME, BUFFER, HOST, and SERVICE, have |
| 73 | is a string representing the capabilities of the server (if any). | 64 | the same meanings as in `open-network-stream'. The remaining |
| 74 | 65 | PARAMETERS should be a sequence of keywords and values: | |
| 75 | The PARAMETERS is a keyword list that can have the following | 66 | |
| 76 | values: | 67 | :type specifies the connection type, one of the following: |
| 77 | 68 | nil or `network' | |
| 78 | :type -- either `network', `network-only, `tls', `shell' or | 69 | -- Begin with an ordinary network connection, and if |
| 79 | `starttls'. If omitted, the default is `network'. `network' | 70 | the parameters :success and :capability-command |
| 80 | will be opportunistically upgraded to STARTTLS if both the server | 71 | are also supplied, try to upgrade to an encrypted |
| 81 | and Emacs supports it. If you don't want STARTTLS upgrades, use | 72 | connection via STARTTLS. Even if that |
| 82 | `network-only'. | 73 | fails (e.g. if HOST does not support TLS), retain |
| 83 | 74 | an unencrypted connection. | |
| 84 | :end-of-command -- a regexp saying what the end of a command is. | 75 | `plain' -- An ordinary, unencrypted network connection. |
| 85 | This defaults to \"\\n\". | 76 | `starttls' -- Begin with an ordinary connection, and try |
| 86 | 77 | upgrading via STARTTLS. If that fails for any | |
| 87 | :success -- a regexp saying whether the STARTTLS command was | 78 | reason, drop the connection; in that case the |
| 88 | successful or not. For instance, for NNTP this is \"^3\". | 79 | returned object is a killed process. |
| 89 | 80 | `tls' -- A TLS connection. | |
| 90 | :capability-command -- a string representing the command used to | 81 | `ssl' -- Equivalent to `tls'. |
| 91 | query server for capabilities. For instance, for IMAP this is | 82 | `shell' -- A shell connection. |
| 92 | \"1 CAPABILITY\\r\\n\". | 83 | |
| 93 | 84 | :return-list specifies this function's return value. | |
| 94 | :starttls-function -- a function that takes one parameter, which | 85 | If omitted or nil, return a process object. A non-nil means to |
| 95 | is the response to the capaibility command. It should return nil | 86 | return (PROC . PROPS), where PROC is a process object and PROPS |
| 96 | if it turns out that the server doesn't support STARTTLS, or the | 87 | is a plist of connection properties, with these keywords: |
| 97 | command to switch on STARTTLS otherwise. | 88 | :greeting -- the greeting returned by HOST (a string), or nil. |
| 98 | 89 | :capabilities -- a string representing HOST's capabilities, | |
| 99 | The return value from this function is a four-element list, where | 90 | or nil if none could be found. |
| 100 | the first element is the stream (if connection was successful); | 91 | :type -- the resulting connection type; `plain' (unencrypted) |
| 101 | the second element is the \"greeting\", i. e., the string the | 92 | or `tls' (TLS-encrypted). |
| 102 | server sent over on initial contact; the third element is the | 93 | |
| 103 | capability string; and the fourth element is either `network' or | 94 | :end-of-command specifies a regexp matching the end of a command. |
| 104 | `tls', depending on whether the connection ended up being | 95 | If non-nil, it defaults to \"\\n\". |
| 105 | encrypted or not." | 96 | |
| 106 | (let ((type (or (cadr (memq :type parameters)) 'network))) | 97 | :success specifies a regexp matching a message indicating a |
| 107 | (cond | 98 | successful STARTTLS negotiation. For instance, the default |
| 108 | ((eq type 'starttls) | 99 | should be \"^3\" for an NNTP connection. |
| 109 | (setq type 'network)) | 100 | |
| 110 | ((eq type 'ssl) | 101 | :capability-command specifies a command used to query the HOST |
| 111 | (setq type 'tls))) | 102 | for its capabilities. For instance, for IMAP this should be |
| 112 | (let ((open-result | 103 | \"1 CAPABILITY\\r\\n\". |
| 113 | (funcall (intern (format "proto-stream-open-%s" type) obarray) | 104 | |
| 114 | name buffer host service parameters))) | 105 | :starttls-function specifies a function for handling STARTTLS. |
| 115 | (if (null open-result) | 106 | This function should take one parameter, the response to the |
| 116 | (list nil nil nil type) | 107 | capability command, and should return the command to switch on |
| 117 | (let ((stream (car open-result))) | 108 | STARTTLS if the server supports STARTTLS, and nil otherwise." |
| 118 | (list (and stream | 109 | (let ((type (plist-get parameters :type)) |
| 119 | (memq (process-status stream) | 110 | (return-list (plist-get parameters :return-list))) |
| 120 | '(open run)) | 111 | (if (and (not return-list) |
| 121 | stream) | 112 | (or (eq type 'plain) |
| 122 | (nth 1 open-result) | 113 | (and (memq type '(nil network)) |
| 123 | (nth 2 open-result) | 114 | (not (and (plist-get parameters :success) |
| 124 | (nth 3 open-result))))))) | 115 | (plist-get parameters :capability-command)))))) |
| 125 | 116 | ;; The simplest case is equivalent to `open-network-stream'. | |
| 126 | (defun proto-stream-open-network-only (name buffer host service parameters) | 117 | (open-network-stream name buffer host service) |
| 118 | ;; For everything else, refer to proto-stream-open-*. | ||
| 119 | (unless (plist-get parameters :end-of-command) | ||
| 120 | (setq parameters (append '(:end-of-command "\r\n") parameters))) | ||
| 121 | (let* ((connection-function | ||
| 122 | (cond | ||
| 123 | ((eq type 'plain) 'proto-stream-open-plain) | ||
| 124 | ((memq type '(nil network starttls)) | ||
| 125 | 'proto-stream-open-starttls) | ||
| 126 | ((memq type '(tls ssl)) 'proto-stream-open-tls) | ||
| 127 | ((eq type 'shell) 'proto-stream-open-shell) | ||
| 128 | (t (error "Invalid connection type %s" type)))) | ||
| 129 | (result (funcall connection-function | ||
| 130 | name buffer host service parameters))) | ||
| 131 | (if return-list | ||
| 132 | (list (car result) | ||
| 133 | :greeting (nth 1 result) | ||
| 134 | :capabilities (nth 2 result) | ||
| 135 | :type (nth 3 result)) | ||
| 136 | (car result)))))) | ||
| 137 | |||
| 138 | (defun proto-stream-open-plain (name buffer host service parameters) | ||
| 127 | (let ((start (with-current-buffer buffer (point))) | 139 | (let ((start (with-current-buffer buffer (point))) |
| 128 | (stream (open-network-stream name buffer host service))) | 140 | (stream (open-network-stream name buffer host service))) |
| 129 | (list stream | 141 | (list stream |
| 130 | (proto-stream-get-response | 142 | (proto-stream-get-response stream start |
| 131 | stream start (proto-stream-eoc parameters)) | 143 | (plist-get parameters :end-of-command)) |
| 132 | nil | 144 | nil |
| 133 | 'network))) | 145 | 'plain))) |
| 134 | 146 | ||
| 135 | (defun proto-stream-open-network (name buffer host service parameters) | 147 | (defun proto-stream-open-starttls (name buffer host service parameters) |
| 136 | (let* ((start (with-current-buffer buffer (point))) | 148 | (let* ((start (with-current-buffer buffer (point))) |
| 149 | (require-tls (eq (plist-get parameters :type) 'starttls)) | ||
| 150 | (starttls-function (plist-get parameters :starttls-function)) | ||
| 151 | (success-string (plist-get parameters :success)) | ||
| 152 | (capability-command (plist-get parameters :capability-command)) | ||
| 153 | (eoc (plist-get parameters :end-of-command)) | ||
| 154 | ;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE) | ||
| 137 | (stream (open-network-stream name buffer host service)) | 155 | (stream (open-network-stream name buffer host service)) |
| 138 | (capability-command (cadr (memq :capability-command parameters))) | ||
| 139 | (eoc (proto-stream-eoc parameters)) | ||
| 140 | (type (cadr (memq :type parameters))) | ||
| 141 | (greeting (proto-stream-get-response stream start eoc)) | 156 | (greeting (proto-stream-get-response stream start eoc)) |
| 142 | success) | 157 | (capabilities (when capability-command |
| 143 | (if (not capability-command) | 158 | (proto-stream-command stream |
| 144 | (list stream greeting nil 'network) | 159 | capability-command eoc))) |
| 145 | (let* ((capabilities | 160 | (resulting-type 'plain) |
| 146 | (proto-stream-command stream capability-command eoc)) | 161 | starttls-command) |
| 147 | (starttls-command | 162 | |
| 148 | (funcall (cadr (memq :starttls-function parameters)) | 163 | ;; If we have STARTTLS support, try to upgrade the connection. |
| 149 | capabilities))) | 164 | (when (and (or (fboundp 'open-gnutls-stream) |
| 150 | (cond | 165 | (executable-find "gnutls-cli")) |
| 151 | ;; If this server doesn't support STARTTLS, but we have | 166 | capabilities success-string starttls-function |
| 152 | ;; requested it explicitly, then close the connection and | 167 | (setq starttls-command |
| 153 | ;; return nil. | 168 | (funcall starttls-function capabilities))) |
| 154 | ((or (not starttls-command) | 169 | ;; If using external STARTTLS, drop this connection and start |
| 155 | (and (not (eq type 'starttls)) | 170 | ;; anew with `starttls-open-stream'. |
| 156 | (not proto-stream-always-use-starttls))) | 171 | (unless (fboundp 'open-gnutls-stream) |
| 157 | (if (eq type 'starttls) | 172 | (delete-process stream) |
| 158 | (progn | 173 | (setq start (with-current-buffer buffer (point-max))) |
| 159 | (delete-process stream) | 174 | (let* ((starttls-use-gnutls t) |
| 160 | nil) | 175 | (starttls-extra-arguments |
| 161 | ;; Otherwise, just return this plain network connection. | 176 | (if require-tls |
| 162 | (list stream greeting capabilities 'network))) | 177 | starttls-extra-arguments |
| 163 | ;; We have some kind of STARTTLS support, so we try to | 178 | ;; For opportunistic TLS upgrades, we don't really |
| 164 | ;; upgrade the connection opportunistically. | 179 | ;; care about the identity of the peer. |
| 165 | ((or (fboundp 'open-gnutls-stream) | 180 | (cons "--insecure" starttls-extra-arguments)))) |
| 166 | (executable-find "gnutls-cli")) | 181 | (setq stream (starttls-open-stream name buffer host service))) |
| 167 | (unless (fboundp 'open-gnutls-stream) | 182 | (proto-stream-get-response stream start eoc)) |
| 168 | (delete-process stream) | 183 | (when (string-match success-string |
| 169 | (setq start (with-current-buffer buffer (point-max))) | 184 | (proto-stream-command stream starttls-command eoc)) |
| 170 | (let* ((starttls-use-gnutls t) | 185 | ;; The server said it was OK to begin STARTTLS negotiations. |
| 171 | (starttls-extra-arguments | 186 | (if (fboundp 'open-gnutls-stream) |
| 172 | (if (not (eq type 'starttls)) | 187 | (gnutls-negotiate stream nil) |
| 173 | ;; When doing opportunistic TLS upgrades we | 188 | (unless (starttls-negotiate stream) |
| 174 | ;; don't really care about the identity of the | 189 | (delete-process stream))) |
| 175 | ;; peer. | 190 | (if (memq (process-status stream) '(open run)) |
| 176 | (cons "--insecure" starttls-extra-arguments) | 191 | (setq resulting-type 'tls) |
| 177 | starttls-extra-arguments))) | 192 | ;; We didn't successfully negotiate STARTTLS; if TLS |
| 178 | (setq stream (starttls-open-stream name buffer host service))) | 193 | ;; isn't demanded, reopen an unencrypted connection. |
| 179 | (proto-stream-get-response stream start eoc)) | 194 | (unless require-tls |
| 180 | (if (not | 195 | (setq stream (open-network-stream name buffer host service)) |
| 181 | (string-match | 196 | (proto-stream-get-response stream start eoc))) |
| 182 | (cadr (memq :success parameters)) | 197 | ;; Re-get the capabilities, which may have now changed. |
| 183 | (proto-stream-command stream starttls-command eoc))) | 198 | (setq capabilities |
| 184 | ;; We got an error back from the STARTTLS command. | 199 | (proto-stream-command stream capability-command eoc)))) |
| 185 | (progn | 200 | |
| 186 | (if (eq type 'starttls) | 201 | ;; If TLS is mandatory, close the connection if it's unencrypted. |
| 187 | (progn | 202 | (and require-tls |
| 188 | (delete-process stream) | 203 | (eq resulting-type 'plain) |
| 189 | nil) | 204 | (delete-process stream)) |
| 190 | (list stream greeting capabilities 'network))) | 205 | ;; Return value: |
| 191 | ;; The server said it was OK to start doing STARTTLS negotiations. | 206 | (list stream greeting capabilities resulting-type))) |
| 192 | (if (fboundp 'open-gnutls-stream) | ||
| 193 | (gnutls-negotiate stream nil) | ||
| 194 | (unless (starttls-negotiate stream) | ||
| 195 | (delete-process stream) | ||
| 196 | (setq stream nil))) | ||
| 197 | (when (or (null stream) | ||
| 198 | (not (memq (process-status stream) | ||
| 199 | '(open run)))) | ||
| 200 | ;; It didn't successfully negotiate STARTTLS, so we reopen | ||
| 201 | ;; the connection. | ||
| 202 | (setq stream (open-network-stream name buffer host service)) | ||
| 203 | (proto-stream-get-response stream start eoc)) | ||
| 204 | ;; Re-get the capabilities, since they may have changed | ||
| 205 | ;; after switching to TLS. | ||
| 206 | (list stream greeting | ||
| 207 | (proto-stream-command stream capability-command eoc) 'tls))) | ||
| 208 | ;; We don't have STARTTLS support available, but the caller | ||
| 209 | ;; requested a STARTTLS connection, so we give up. | ||
| 210 | ((eq (cadr (memq :type parameters)) 'starttls) | ||
| 211 | (delete-process stream) | ||
| 212 | nil) | ||
| 213 | ;; Fall back on using a plain network stream. | ||
| 214 | (t | ||
| 215 | (list stream greeting capabilities 'network))))))) | ||
| 216 | 207 | ||
| 217 | (defun proto-stream-command (stream command eoc) | 208 | (defun proto-stream-command (stream command eoc) |
| 218 | (let ((start (with-current-buffer (process-buffer stream) (point-max)))) | 209 | (let ((start (with-current-buffer (process-buffer stream) (point-max)))) |
| @@ -241,47 +232,43 @@ encrypted or not." | |||
| 241 | (funcall (if (fboundp 'open-gnutls-stream) | 232 | (funcall (if (fboundp 'open-gnutls-stream) |
| 242 | 'open-gnutls-stream | 233 | 'open-gnutls-stream |
| 243 | 'open-tls-stream) | 234 | 'open-tls-stream) |
| 244 | name buffer host service))) | 235 | name buffer host service)) |
| 236 | (eoc (plist-get parameters :end-of-command))) | ||
| 245 | (if (null stream) | 237 | (if (null stream) |
| 246 | nil | 238 | (list nil nil nil 'plain) |
| 247 | ;; If we're using tls.el, we have to delete the output from | 239 | ;; If we're using tls.el, we have to delete the output from |
| 248 | ;; openssl/gnutls-cli. | 240 | ;; openssl/gnutls-cli. |
| 249 | (unless (fboundp 'open-gnutls-stream) | 241 | (unless (fboundp 'open-gnutls-stream) |
| 250 | (proto-stream-get-response | 242 | (proto-stream-get-response stream start eoc) |
| 251 | stream start (proto-stream-eoc parameters)) | ||
| 252 | (goto-char (point-min)) | 243 | (goto-char (point-min)) |
| 253 | (when (re-search-forward (proto-stream-eoc parameters) nil t) | 244 | (when (re-search-forward eoc nil t) |
| 254 | (goto-char (match-beginning 0)) | 245 | (goto-char (match-beginning 0)) |
| 255 | (delete-region (point-min) (line-beginning-position)))) | 246 | (delete-region (point-min) (line-beginning-position)))) |
| 256 | (proto-stream-capability-open start stream parameters 'tls))))) | 247 | (proto-stream-capability-open start stream parameters 'tls))))) |
| 257 | 248 | ||
| 258 | (defun proto-stream-open-shell (name buffer host service parameters) | 249 | (defun proto-stream-open-shell (name buffer host service parameters) |
| 250 | (require 'format-spec) | ||
| 259 | (proto-stream-capability-open | 251 | (proto-stream-capability-open |
| 260 | (with-current-buffer buffer (point)) | 252 | (with-current-buffer buffer (point)) |
| 261 | (let ((process-connection-type nil)) | 253 | (let ((process-connection-type nil)) |
| 262 | (start-process name buffer shell-file-name | 254 | (start-process name buffer shell-file-name |
| 263 | shell-command-switch | 255 | shell-command-switch |
| 264 | (format-spec | 256 | (format-spec |
| 265 | (cadr (memq :shell-command parameters)) | 257 | (plist-get parameters :shell-command) |
| 266 | (format-spec-make | 258 | (format-spec-make |
| 267 | ?s host | 259 | ?s host |
| 268 | ?p service)))) | 260 | ?p service)))) |
| 269 | parameters 'network)) | 261 | parameters 'plain)) |
| 270 | 262 | ||
| 271 | (defun proto-stream-capability-open (start stream parameters stream-type) | 263 | (defun proto-stream-capability-open (start stream parameters stream-type) |
| 272 | (let ((capability-command (cadr (memq :capability-command parameters))) | 264 | (let* ((capability-command (plist-get parameters :capability-command)) |
| 273 | (greeting (proto-stream-get-response | 265 | (eoc (plist-get parameters :end-of-command)) |
| 274 | stream start (proto-stream-eoc parameters)))) | 266 | (greeting (proto-stream-get-response stream start eoc))) |
| 275 | (list stream greeting | 267 | (list stream greeting |
| 276 | (and capability-command | 268 | (and capability-command |
| 277 | (proto-stream-command | 269 | (proto-stream-command stream capability-command eoc)) |
| 278 | stream capability-command (proto-stream-eoc parameters))) | ||
| 279 | stream-type))) | 270 | stream-type))) |
| 280 | 271 | ||
| 281 | (defun proto-stream-eoc (parameters) | ||
| 282 | (or (cadr (memq :end-of-command parameters)) | ||
| 283 | "\r\n")) | ||
| 284 | |||
| 285 | (provide 'proto-stream) | 272 | (provide 'proto-stream) |
| 286 | 273 | ||
| 287 | ;;; proto-stream.el ends here | 274 | ;;; proto-stream.el ends here |
diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 51d18235e1b..005358e3c7d 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el | |||
| @@ -330,7 +330,7 @@ Commands: | |||
| 330 | (save-excursion | 330 | (save-excursion |
| 331 | (goto-char (point-min)) | 331 | (goto-char (point-min)) |
| 332 | (let ((inhibit-read-only t)) | 332 | (let ((inhibit-read-only t)) |
| 333 | (when (re-search-forward "^This \\w+ is advised.$" nil t) | 333 | (when (re-search-forward "^This [^[:space:]]+ is advised.$" nil t) |
| 334 | (put-text-property (match-beginning 0) | 334 | (put-text-property (match-beginning 0) |
| 335 | (match-end 0) | 335 | (match-end 0) |
| 336 | 'face 'font-lock-warning-face)))) | 336 | 'face 'font-lock-warning-face)))) |
diff --git a/lisp/ido.el b/lisp/ido.el index 2a5c7cf2f0e..0ce83d9b88c 100644 --- a/lisp/ido.el +++ b/lisp/ido.el | |||
| @@ -1964,31 +1964,24 @@ If INITIAL is non-nil, it specifies the initial input string." | |||
| 1964 | (ido-set-matches) | 1964 | (ido-set-matches) |
| 1965 | (if (and ido-matches (eq ido-try-merged-list 'auto)) | 1965 | (if (and ido-matches (eq ido-try-merged-list 'auto)) |
| 1966 | (setq ido-try-merged-list t)) | 1966 | (setq ido-try-merged-list t)) |
| 1967 | (let | 1967 | (let ((max-mini-window-height (or ido-max-window-height |
| 1968 | ((minibuffer-local-completion-map | 1968 | (and (boundp 'max-mini-window-height) |
| 1969 | (if (memq ido-cur-item '(file dir)) | 1969 | max-mini-window-height))) |
| 1970 | minibuffer-local-completion-map | ||
| 1971 | ido-completion-map)) | ||
| 1972 | (minibuffer-local-filename-completion-map | ||
| 1973 | (if (memq ido-cur-item '(file dir)) | ||
| 1974 | ido-completion-map | ||
| 1975 | minibuffer-local-filename-completion-map)) | ||
| 1976 | (max-mini-window-height (or ido-max-window-height | ||
| 1977 | (and (boundp 'max-mini-window-height) max-mini-window-height))) | ||
| 1978 | (ido-completing-read t) | 1970 | (ido-completing-read t) |
| 1979 | (ido-require-match require-match) | 1971 | (ido-require-match require-match) |
| 1980 | (ido-use-mycompletion-depth (1+ (minibuffer-depth))) | 1972 | (ido-use-mycompletion-depth (1+ (minibuffer-depth))) |
| 1981 | (show-paren-mode nil)) | 1973 | (show-paren-mode nil) |
| 1974 | ;; Postpone history adding till later | ||
| 1975 | (history-add-new-input nil)) | ||
| 1982 | ;; prompt the user for the file name | 1976 | ;; prompt the user for the file name |
| 1983 | (setq ido-exit nil) | 1977 | (setq ido-exit nil) |
| 1984 | (setq ido-final-text | 1978 | (setq ido-final-text |
| 1985 | (catch 'ido | 1979 | (catch 'ido |
| 1986 | (completing-read-default | 1980 | (read-from-minibuffer (ido-make-prompt item prompt) |
| 1987 | (ido-make-prompt item prompt) | 1981 | (prog1 ido-text-init |
| 1988 | '(("dummy" . 1)) nil nil ; table predicate require-match | 1982 | (setq ido-text-init nil)) |
| 1989 | (prog1 ido-text-init (setq ido-text-init nil)) ;initial-contents | 1983 | ido-completion-map nil history)))) |
| 1990 | history)))) | 1984 | (ido-trace "read-from-minibuffer" ido-final-text) |
| 1991 | (ido-trace "completing-read" ido-final-text) | ||
| 1992 | (if (get-buffer ido-completion-buffer) | 1985 | (if (get-buffer ido-completion-buffer) |
| 1993 | (kill-buffer ido-completion-buffer)) | 1986 | (kill-buffer ido-completion-buffer)) |
| 1994 | 1987 | ||
| @@ -2158,6 +2151,7 @@ If INITIAL is non-nil, it specifies the initial input string." | |||
| 2158 | 2151 | ||
| 2159 | (t | 2152 | (t |
| 2160 | (setq done t)))))) | 2153 | (setq done t)))))) |
| 2154 | (add-to-history (or history 'minibuffer-history) ido-selected) | ||
| 2161 | ido-selected)) | 2155 | ido-selected)) |
| 2162 | 2156 | ||
| 2163 | (defun ido-edit-input () | 2157 | (defun ido-edit-input () |
| @@ -4491,17 +4485,13 @@ For details of keybindings, see `ido-find-file'." | |||
| 4491 | 4485 | ||
| 4492 | ;; Insert the match-status information: | 4486 | ;; Insert the match-status information: |
| 4493 | (ido-set-common-completion) | 4487 | (ido-set-common-completion) |
| 4494 | (let ((inf (ido-completions | 4488 | (let ((inf (ido-completions contents))) |
| 4495 | contents | ||
| 4496 | minibuffer-completion-table | ||
| 4497 | minibuffer-completion-predicate | ||
| 4498 | (not minibuffer-completion-confirm)))) | ||
| 4499 | (setq ido-show-confirm-message nil) | 4489 | (setq ido-show-confirm-message nil) |
| 4500 | (ido-trace "inf" inf) | 4490 | (ido-trace "inf" inf) |
| 4501 | (insert inf)) | 4491 | (insert inf)) |
| 4502 | )))) | 4492 | )))) |
| 4503 | 4493 | ||
| 4504 | (defun ido-completions (name candidates predicate require-match) | 4494 | (defun ido-completions (name) |
| 4505 | ;; Return the string that is displayed after the user's text. | 4495 | ;; Return the string that is displayed after the user's text. |
| 4506 | ;; Modified from `icomplete-completions'. | 4496 | ;; Modified from `icomplete-completions'. |
| 4507 | 4497 | ||
diff --git a/lisp/image.el b/lisp/image.el index 627d4c69e44..3b90ac46bd1 100644 --- a/lisp/image.el +++ b/lisp/image.el | |||
| @@ -60,7 +60,7 @@ IMAGE-TYPE must be a pair (PREDICATE . TYPE). PREDICATE is called | |||
| 60 | with one argument, a string containing the image data. If PREDICATE returns | 60 | with one argument, a string containing the image data. If PREDICATE returns |
| 61 | a non-nil value, TYPE is the image's type.") | 61 | a non-nil value, TYPE is the image's type.") |
| 62 | 62 | ||
| 63 | (defconst image-type-file-name-regexps | 63 | (defvar image-type-file-name-regexps |
| 64 | '(("\\.png\\'" . png) | 64 | '(("\\.png\\'" . png) |
| 65 | ("\\.gif\\'" . gif) | 65 | ("\\.gif\\'" . gif) |
| 66 | ("\\.jpe?g\\'" . jpeg) | 66 | ("\\.jpe?g\\'" . jpeg) |
| @@ -710,17 +710,19 @@ shall be displayed." | |||
| 710 | ;;;###autoload | 710 | ;;;###autoload |
| 711 | (defun imagemagick-register-types () | 711 | (defun imagemagick-register-types () |
| 712 | "Register the file types that ImageMagick is able to handle." | 712 | "Register the file types that ImageMagick is able to handle." |
| 713 | (let ((im-types (imagemagick-types))) | 713 | (if (fboundp 'imagemagick-types) |
| 714 | (dolist (im-inhibit imagemagick-types-inhibit) | 714 | (let ((im-types (imagemagick-types))) |
| 715 | (setq im-types (remove im-inhibit im-types))) | 715 | (dolist (im-inhibit imagemagick-types-inhibit) |
| 716 | (dolist (im-type im-types) | 716 | (setq im-types (remove im-inhibit im-types))) |
| 717 | (let ((extension (downcase (symbol-name im-type)))) | 717 | (dolist (im-type im-types) |
| 718 | (push | 718 | (let ((extension (downcase (symbol-name im-type)))) |
| 719 | (cons (concat "\\." extension "\\'") 'image-mode) | 719 | (push |
| 720 | auto-mode-alist) | 720 | (cons (concat "\\." extension "\\'") 'image-mode) |
| 721 | (push | 721 | auto-mode-alist) |
| 722 | (cons (concat "\\." extension "\\'") 'imagemagick) | 722 | (push |
| 723 | image-type-file-name-regexps))))) | 723 | (cons (concat "\\." extension "\\'") 'imagemagick) |
| 724 | image-type-file-name-regexps)))) | ||
| 725 | (error "Emacs was not built with ImageMagick support"))) | ||
| 724 | 726 | ||
| 725 | (provide 'image) | 727 | (provide 'image) |
| 726 | 728 | ||
diff --git a/lisp/midnight.el b/lisp/midnight.el index 9a6b162e986..762bc5445ba 100644 --- a/lisp/midnight.el +++ b/lisp/midnight.el | |||
| @@ -39,8 +39,6 @@ | |||
| 39 | (eval-when-compile | 39 | (eval-when-compile |
| 40 | (require 'cl)) | 40 | (require 'cl)) |
| 41 | 41 | ||
| 42 | (require 'timer) | ||
| 43 | |||
| 44 | (defgroup midnight nil | 42 | (defgroup midnight nil |
| 45 | "Run something every day at midnight." | 43 | "Run something every day at midnight." |
| 46 | :group 'calendar | 44 | :group 'calendar |
| @@ -66,12 +64,6 @@ call `cancel-timer' or `timer-activate' on `midnight-timer' instead." | |||
| 66 | 64 | ||
| 67 | ;;; time conversion | 65 | ;;; time conversion |
| 68 | 66 | ||
| 69 | (defun midnight-time-float (num) | ||
| 70 | "Convert the float number of seconds since epoch to the list of 3 integers." | ||
| 71 | (let* ((div (ash 1 16)) (1st (floor num div))) | ||
| 72 | (list 1st (floor (- num (* (float div) 1st))) | ||
| 73 | (round (* 10000000 (mod num 1)))))) | ||
| 74 | |||
| 75 | (defun midnight-buffer-display-time (&optional buffer) | 67 | (defun midnight-buffer-display-time (&optional buffer) |
| 76 | "Return the time-stamp of BUFFER, or current buffer, as float." | 68 | "Return the time-stamp of BUFFER, or current buffer, as float." |
| 77 | (with-current-buffer (or buffer (current-buffer)) | 69 | (with-current-buffer (or buffer (current-buffer)) |
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 4a2deb6b3bf..9d304ca8156 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el | |||
| @@ -682,6 +682,8 @@ scroll the window of possible completions." | |||
| 682 | (t t))))) | 682 | (t t))))) |
| 683 | 683 | ||
| 684 | (defun completion--flush-all-sorted-completions (&rest _ignore) | 684 | (defun completion--flush-all-sorted-completions (&rest _ignore) |
| 685 | (remove-hook 'after-change-functions | ||
| 686 | 'completion--flush-all-sorted-completions t) | ||
| 685 | (setq completion-cycling nil) | 687 | (setq completion-cycling nil) |
| 686 | (setq completion-all-sorted-completions nil)) | 688 | (setq completion-all-sorted-completions nil)) |
| 687 | 689 | ||
| @@ -1236,6 +1238,8 @@ Point needs to be somewhere between START and END." | |||
| 1236 | (assert (<= start (point)) (<= (point) end)) | 1238 | (assert (<= start (point)) (<= (point) end)) |
| 1237 | ;; FIXME: undisplay the *Completions* buffer once the completion is done. | 1239 | ;; FIXME: undisplay the *Completions* buffer once the completion is done. |
| 1238 | (with-wrapper-hook | 1240 | (with-wrapper-hook |
| 1241 | ;; FIXME: Maybe we should use this hook to provide a "display | ||
| 1242 | ;; completions" operation as well. | ||
| 1239 | completion-in-region-functions (start end collection predicate) | 1243 | completion-in-region-functions (start end collection predicate) |
| 1240 | (let ((minibuffer-completion-table collection) | 1244 | (let ((minibuffer-completion-table collection) |
| 1241 | (minibuffer-completion-predicate predicate) | 1245 | (minibuffer-completion-predicate predicate) |
| @@ -1247,7 +1251,9 @@ Point needs to be somewhere between START and END." | |||
| 1247 | 1251 | ||
| 1248 | (defvar completion-at-point-functions '(tags-completion-at-point-function) | 1252 | (defvar completion-at-point-functions '(tags-completion-at-point-function) |
| 1249 | "Special hook to find the completion table for the thing at point. | 1253 | "Special hook to find the completion table for the thing at point. |
| 1250 | It is called without any argument and should return either nil, | 1254 | Each function on this hook is called in turns without any argument and should |
| 1255 | return either nil to mean that it is not applicable at point, | ||
| 1256 | or t to mean that it already performed completion (discouraged), | ||
| 1251 | or a function of no argument to perform completion (discouraged), | 1257 | or a function of no argument to perform completion (discouraged), |
| 1252 | or a list of the form (START END COLLECTION &rest PROPS) where | 1258 | or a list of the form (START END COLLECTION &rest PROPS) where |
| 1253 | START and END delimit the entity to complete and should include point, | 1259 | START and END delimit the entity to complete and should include point, |
| @@ -1265,7 +1271,7 @@ The completion method is determined by `completion-at-point-functions'." | |||
| 1265 | 'completion-at-point-functions))) | 1271 | 'completion-at-point-functions))) |
| 1266 | (cond | 1272 | (cond |
| 1267 | ((functionp res) (funcall res)) | 1273 | ((functionp res) (funcall res)) |
| 1268 | (res | 1274 | ((consp res) |
| 1269 | (let* ((plist (nthcdr 3 res)) | 1275 | (let* ((plist (nthcdr 3 res)) |
| 1270 | (start (nth 0 res)) | 1276 | (start (nth 0 res)) |
| 1271 | (end (nth 1 res)) | 1277 | (end (nth 1 res)) |
| @@ -1273,7 +1279,8 @@ The completion method is determined by `completion-at-point-functions'." | |||
| 1273 | (or (plist-get plist :annotation-function) | 1279 | (or (plist-get plist :annotation-function) |
| 1274 | completion-annotate-function))) | 1280 | completion-annotate-function))) |
| 1275 | (completion-in-region start end (nth 2 res) | 1281 | (completion-in-region start end (nth 2 res) |
| 1276 | (plist-get plist :predicate))))))) | 1282 | (plist-get plist :predicate)))) |
| 1283 | (res)))) ;Maybe completion already happened and the function returned t. | ||
| 1277 | 1284 | ||
| 1278 | ;;; Key bindings. | 1285 | ;;; Key bindings. |
| 1279 | 1286 | ||
| @@ -1480,8 +1487,9 @@ except that it passes the file name through `substitute-in-file-name'." | |||
| 1480 | 'completion--file-name-table) | 1487 | 'completion--file-name-table) |
| 1481 | "Internal subroutine for `read-file-name'. Do not call this.") | 1488 | "Internal subroutine for `read-file-name'. Do not call this.") |
| 1482 | 1489 | ||
| 1483 | (defvar read-file-name-function nil | 1490 | (defvar read-file-name-function 'read-file-name-default |
| 1484 | "If this is non-nil, `read-file-name' does its work by calling this function.") | 1491 | "The function called by `read-file-name' to do its work. |
| 1492 | It should accept the same arguments as `read-file-name'.") | ||
| 1485 | 1493 | ||
| 1486 | (defcustom read-file-name-completion-ignore-case | 1494 | (defcustom read-file-name-completion-ignore-case |
| 1487 | (if (memq system-type '(ms-dos windows-nt darwin cygwin)) | 1495 | (if (memq system-type '(ms-dos windows-nt darwin cygwin)) |
| @@ -1519,7 +1527,7 @@ such as making the current buffer visit no file in the case of | |||
| 1519 | (declare-function x-file-dialog "xfns.c" | 1527 | (declare-function x-file-dialog "xfns.c" |
| 1520 | (prompt dir &optional default-filename mustmatch only-dir-p)) | 1528 | (prompt dir &optional default-filename mustmatch only-dir-p)) |
| 1521 | 1529 | ||
| 1522 | (defun read-file-name-defaults (&optional dir initial) | 1530 | (defun read-file-name--defaults (&optional dir initial) |
| 1523 | (let ((default | 1531 | (let ((default |
| 1524 | (cond | 1532 | (cond |
| 1525 | ;; With non-nil `initial', use `dir' as the first default. | 1533 | ;; With non-nil `initial', use `dir' as the first default. |
| @@ -1586,6 +1594,12 @@ treated as equivalent to nil. | |||
| 1586 | 1594 | ||
| 1587 | See also `read-file-name-completion-ignore-case' | 1595 | See also `read-file-name-completion-ignore-case' |
| 1588 | and `read-file-name-function'." | 1596 | and `read-file-name-function'." |
| 1597 | (funcall (or read-file-name-function #'read-file-name-default) | ||
| 1598 | prompt dir default-filename mustmatch initial predicate)) | ||
| 1599 | |||
| 1600 | (defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate) | ||
| 1601 | "Default method for reading file names. | ||
| 1602 | See `read-file-name' for the meaning of the arguments." | ||
| 1589 | (unless dir (setq dir default-directory)) | 1603 | (unless dir (setq dir default-directory)) |
| 1590 | (unless (file-name-absolute-p dir) (setq dir (expand-file-name dir))) | 1604 | (unless (file-name-absolute-p dir) (setq dir (expand-file-name dir))) |
| 1591 | (unless default-filename | 1605 | (unless default-filename |
| @@ -1607,9 +1621,6 @@ and `read-file-name-function'." | |||
| 1607 | (minibuffer--double-dollars dir))) | 1621 | (minibuffer--double-dollars dir))) |
| 1608 | (initial (cons (minibuffer--double-dollars initial) 0))))) | 1622 | (initial (cons (minibuffer--double-dollars initial) 0))))) |
| 1609 | 1623 | ||
| 1610 | (if read-file-name-function | ||
| 1611 | (funcall read-file-name-function | ||
| 1612 | prompt dir default-filename mustmatch initial predicate) | ||
| 1613 | (let ((completion-ignore-case read-file-name-completion-ignore-case) | 1624 | (let ((completion-ignore-case read-file-name-completion-ignore-case) |
| 1614 | (minibuffer-completing-file-name t) | 1625 | (minibuffer-completing-file-name t) |
| 1615 | (pred (or predicate 'file-exists-p)) | 1626 | (pred (or predicate 'file-exists-p)) |
| @@ -1645,7 +1656,7 @@ and `read-file-name-function'." | |||
| 1645 | (lambda () | 1656 | (lambda () |
| 1646 | (with-current-buffer | 1657 | (with-current-buffer |
| 1647 | (window-buffer (minibuffer-selected-window)) | 1658 | (window-buffer (minibuffer-selected-window)) |
| 1648 | (read-file-name-defaults dir initial))))) | 1659 | (read-file-name--defaults dir initial))))) |
| 1649 | (completing-read prompt 'read-file-name-internal | 1660 | (completing-read prompt 'read-file-name-internal |
| 1650 | pred mustmatch insdef | 1661 | pred mustmatch insdef |
| 1651 | 'file-name-history default-filename))) | 1662 | 'file-name-history default-filename))) |
| @@ -1719,7 +1730,7 @@ and `read-file-name-function'." | |||
| 1719 | (if history-delete-duplicates | 1730 | (if history-delete-duplicates |
| 1720 | (delete val1 file-name-history) | 1731 | (delete val1 file-name-history) |
| 1721 | file-name-history))))))) | 1732 | file-name-history))))))) |
| 1722 | val))))) | 1733 | val)))) |
| 1723 | 1734 | ||
| 1724 | (defun internal-complete-buffer-except (&optional buffer) | 1735 | (defun internal-complete-buffer-except (&optional buffer) |
| 1725 | "Perform completion on all buffers excluding BUFFER. | 1736 | "Perform completion on all buffers excluding BUFFER. |
diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 6d80b97fd23..f4af03f100f 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el | |||
| @@ -211,7 +211,7 @@ until a successful connection is made." | |||
| 211 | :type '(repeat string)) | 211 | :type '(repeat string)) |
| 212 | 212 | ||
| 213 | (defcustom imap-process-connection-type nil | 213 | (defcustom imap-process-connection-type nil |
| 214 | "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL. | 214 | "*Value for `process-connection-type' to use for Kerberos4, GSSAPI, shell, and SSL. |
| 215 | The `process-connection-type' variable controls the type of device | 215 | The `process-connection-type' variable controls the type of device |
| 216 | used to communicate with subprocesses. Values are nil to use a | 216 | used to communicate with subprocesses. Values are nil to use a |
| 217 | pipe, or t or `pty' to use a pty. The value has no effect if the | 217 | pipe, or t or `pty' to use a pty. The value has no effect if the |
| @@ -770,6 +770,7 @@ sure of changing the value of `foo'." | |||
| 770 | (let* ((port (or port imap-default-port)) | 770 | (let* ((port (or port imap-default-port)) |
| 771 | (coding-system-for-read imap-coding-system-for-read) | 771 | (coding-system-for-read imap-coding-system-for-read) |
| 772 | (coding-system-for-write imap-coding-system-for-write) | 772 | (coding-system-for-write imap-coding-system-for-write) |
| 773 | (process-connection-type imap-process-connection-type) | ||
| 773 | (process (start-process | 774 | (process (start-process |
| 774 | name buffer shell-file-name shell-command-switch | 775 | name buffer shell-file-name shell-command-switch |
| 775 | (format-spec | 776 | (format-spec |
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 71aa0dd22bc..eb4ad01ecd7 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el | |||
| @@ -491,6 +491,7 @@ If ARG is non-nil, instead prompt for connection parameters." | |||
| 491 | (defvar rcirc-server nil) ; server provided by server | 491 | (defvar rcirc-server nil) ; server provided by server |
| 492 | (defvar rcirc-server-name nil) ; server name given by 001 response | 492 | (defvar rcirc-server-name nil) ; server name given by 001 response |
| 493 | (defvar rcirc-timeout-timer nil) | 493 | (defvar rcirc-timeout-timer nil) |
| 494 | (defvar rcirc-user-authenticated nil) | ||
| 494 | (defvar rcirc-user-disconnect nil) | 495 | (defvar rcirc-user-disconnect nil) |
| 495 | (defvar rcirc-connecting nil) | 496 | (defvar rcirc-connecting nil) |
| 496 | (defvar rcirc-process nil) | 497 | (defvar rcirc-process nil) |
| @@ -828,18 +829,21 @@ The list is updated automatically by `defun-rcirc-command'.") | |||
| 828 | 829 | ||
| 829 | (defun rcirc-completion-at-point () | 830 | (defun rcirc-completion-at-point () |
| 830 | "Function used for `completion-at-point-functions' in `rcirc-mode'." | 831 | "Function used for `completion-at-point-functions' in `rcirc-mode'." |
| 831 | (let* ((beg (save-excursion | 832 | (and (rcirc-looking-at-input) |
| 832 | (if (re-search-backward " " rcirc-prompt-end-marker t) | 833 | (let* ((beg (save-excursion |
| 833 | (1+ (point)) | 834 | (if (re-search-backward " " rcirc-prompt-end-marker t) |
| 834 | rcirc-prompt-end-marker))) | 835 | (1+ (point)) |
| 835 | (table (if (and (= beg rcirc-prompt-end-marker) | 836 | rcirc-prompt-end-marker))) |
| 836 | (eq (char-after beg) ?/)) | 837 | (table (if (and (= beg rcirc-prompt-end-marker) |
| 837 | (delete-dups | 838 | (eq (char-after beg) ?/)) |
| 838 | (nconc | 839 | (delete-dups |
| 839 | (sort (copy-sequence rcirc-client-commands) 'string-lessp) | 840 | (nconc (sort (copy-sequence rcirc-client-commands) |
| 840 | (sort (copy-sequence rcirc-server-commands) 'string-lessp))) | 841 | 'string-lessp) |
| 841 | (rcirc-channel-nicks (rcirc-buffer-process) rcirc-target)))) | 842 | (sort (copy-sequence rcirc-server-commands) |
| 842 | (list beg (point) table))) | 843 | 'string-lessp))) |
| 844 | (rcirc-channel-nicks (rcirc-buffer-process) | ||
| 845 | rcirc-target)))) | ||
| 846 | (list beg (point) table)))) | ||
| 843 | 847 | ||
| 844 | (defvar rcirc-completions nil) | 848 | (defvar rcirc-completions nil) |
| 845 | (defvar rcirc-completion-start nil) | 849 | (defvar rcirc-completion-start nil) |
| @@ -848,6 +852,8 @@ The list is updated automatically by `defun-rcirc-command'.") | |||
| 848 | "Cycle through completions from list of nicks in channel or IRC commands. | 852 | "Cycle through completions from list of nicks in channel or IRC commands. |
| 849 | IRC command completion is performed only if '/' is the first input char." | 853 | IRC command completion is performed only if '/' is the first input char." |
| 850 | (interactive) | 854 | (interactive) |
| 855 | (unless (rcirc-looking-at-input) | ||
| 856 | (error "Point not located after rcirc prompt")) | ||
| 851 | (if (eq last-command this-command) | 857 | (if (eq last-command this-command) |
| 852 | (setq rcirc-completions | 858 | (setq rcirc-completions |
| 853 | (append (cdr rcirc-completions) (list (car rcirc-completions)))) | 859 | (append (cdr rcirc-completions) (list (car rcirc-completions)))) |
| @@ -855,9 +861,10 @@ IRC command completion is performed only if '/' is the first input char." | |||
| 855 | (table (rcirc-completion-at-point))) | 861 | (table (rcirc-completion-at-point))) |
| 856 | (setq rcirc-completion-start (car table)) | 862 | (setq rcirc-completion-start (car table)) |
| 857 | (setq rcirc-completions | 863 | (setq rcirc-completions |
| 858 | (all-completions (buffer-substring rcirc-completion-start | 864 | (and rcirc-completion-start |
| 859 | (cadr table)) | 865 | (all-completions (buffer-substring rcirc-completion-start |
| 860 | (nth 2 table))))) | 866 | (cadr table)) |
| 867 | (nth 2 table)))))) | ||
| 861 | (let ((completion (car rcirc-completions))) | 868 | (let ((completion (car rcirc-completions))) |
| 862 | (when completion | 869 | (when completion |
| 863 | (delete-region rcirc-completion-start (point)) | 870 | (delete-region rcirc-completion-start (point)) |
diff --git a/lisp/abbrevlist.el b/lisp/obsolete/abbrevlist.el index 79080780005..55940dfc1ce 100644 --- a/lisp/abbrevlist.el +++ b/lisp/obsolete/abbrevlist.el | |||
| @@ -6,6 +6,7 @@ | |||
| 6 | ;; Maintainer: FSF | 6 | ;; Maintainer: FSF |
| 7 | ;; Keywords: abbrev | 7 | ;; Keywords: abbrev |
| 8 | ;; Package: emacs | 8 | ;; Package: emacs |
| 9 | ;; Obsolete-since: 24.1 | ||
| 9 | 10 | ||
| 10 | ;; This file is part of GNU Emacs. | 11 | ;; This file is part of GNU Emacs. |
| 11 | 12 | ||
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index ab315f9eefd..6aece579d5d 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el | |||
| @@ -648,7 +648,7 @@ detailed description of this mode. | |||
| 648 | (set (make-local-variable 'gud-minor-mode) 'gdbmi) | 648 | (set (make-local-variable 'gud-minor-mode) 'gdbmi) |
| 649 | (setq comint-input-sender 'gdb-send) | 649 | (setq comint-input-sender 'gdb-send) |
| 650 | (when (ring-empty-p comint-input-ring) ; cf shell-mode | 650 | (when (ring-empty-p comint-input-ring) ; cf shell-mode |
| 651 | (let ((hfile (expand-file-name (or (getenv "GBDHISTFILE") | 651 | (let ((hfile (expand-file-name (or (getenv "GDBHISTFILE") |
| 652 | (if (eq system-type 'ms-dos) | 652 | (if (eq system-type 'ms-dos) |
| 653 | "_gdb_history" | 653 | "_gdb_history" |
| 654 | ".gdb_history")))) | 654 | ".gdb_history")))) |
diff --git a/lisp/simple.el b/lisp/simple.el index e4c742b56f4..a414fc77a39 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -3346,16 +3346,16 @@ and KILLP is t if a prefix arg was specified." | |||
| 3346 | (delete-char 1))) | 3346 | (delete-char 1))) |
| 3347 | (forward-char -1) | 3347 | (forward-char -1) |
| 3348 | (setq count (1- count)))))) | 3348 | (setq count (1- count)))))) |
| 3349 | (delete-backward-char | 3349 | (let* ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t") |
| 3350 | (let ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t") | ||
| 3351 | ((eq backward-delete-char-untabify-method 'all) | 3350 | ((eq backward-delete-char-untabify-method 'all) |
| 3352 | " \t\n\r")))) | 3351 | " \t\n\r"))) |
| 3353 | (if skip | 3352 | (n (if skip |
| 3354 | (let ((wh (- (point) (save-excursion (skip-chars-backward skip) | 3353 | (let ((wh (- (point) (save-excursion (skip-chars-backward skip) |
| 3355 | (point))))) | 3354 | (point))))) |
| 3356 | (+ arg (if (zerop wh) 0 (1- wh)))) | 3355 | (+ arg (if (zerop wh) 0 (1- wh)))) |
| 3357 | arg)) | 3356 | arg))) |
| 3358 | killp)) | 3357 | ;; Avoid warning about delete-backward-char |
| 3358 | (with-no-warnings (delete-backward-char n killp)))) | ||
| 3359 | 3359 | ||
| 3360 | (defun zap-to-char (arg char) | 3360 | (defun zap-to-char (arg char) |
| 3361 | "Kill up to and including ARGth occurrence of CHAR. | 3361 | "Kill up to and including ARGth occurrence of CHAR. |
diff --git a/lisp/subr.el b/lisp/subr.el index 205828b4169..e6e0c62e0b4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1122,6 +1122,8 @@ is converted into a string by expressing it in decimal." | |||
| 1122 | 1122 | ||
| 1123 | (make-obsolete-variable 'define-key-rebound-commands nil "23.2") | 1123 | (make-obsolete-variable 'define-key-rebound-commands nil "23.2") |
| 1124 | (make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1") | 1124 | (make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1") |
| 1125 | (make-obsolete-variable 'deferred-action-list 'post-command-hook "24.1") | ||
| 1126 | (make-obsolete-variable 'deferred-action-function 'post-command-hook "24.1") | ||
| 1125 | (make-obsolete 'window-redisplay-end-trigger nil "23.1") | 1127 | (make-obsolete 'window-redisplay-end-trigger nil "23.1") |
| 1126 | (make-obsolete 'set-window-redisplay-end-trigger nil "23.1") | 1128 | (make-obsolete 'set-window-redisplay-end-trigger nil "23.1") |
| 1127 | 1129 | ||
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 020faa197cd..a56c3e4d501 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el | |||
| @@ -207,6 +207,12 @@ a symbol as a valid THING." | |||
| 207 | (cons opoint end)))) | 207 | (cons opoint end)))) |
| 208 | (error nil))))) | 208 | (error nil))))) |
| 209 | 209 | ||
| 210 | ;; Defuns | ||
| 211 | |||
| 212 | (put 'defun 'beginning-op 'beginning-of-defun) | ||
| 213 | (put 'defun 'end-op 'end-of-defun) | ||
| 214 | (put 'defun 'forward-op 'end-of-defun) | ||
| 215 | |||
| 210 | ;; Filenames and URLs www.com/foo%32bar | 216 | ;; Filenames and URLs www.com/foo%32bar |
| 211 | 217 | ||
| 212 | (defvar thing-at-point-file-name-chars "-~/[:alnum:]_.${}#%,:" | 218 | (defvar thing-at-point-file-name-chars "-~/[:alnum:]_.${}#%,:" |
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index d9a06c8a401..9f6ad19fdb1 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el | |||
| @@ -122,9 +122,6 @@ | |||
| 122 | :group 'pcl-cvs | 122 | :group 'pcl-cvs |
| 123 | :prefix "log-view-") | 123 | :prefix "log-view-") |
| 124 | 124 | ||
| 125 | ;; Needed because log-view-mode-map inherits from widget-keymap. (Bug#5311) | ||
| 126 | (require 'wid-edit) | ||
| 127 | |||
| 128 | (easy-mmode-defmap log-view-mode-map | 125 | (easy-mmode-defmap log-view-mode-map |
| 129 | '( | 126 | '( |
| 130 | ;; FIXME: (copy-keymap special-mode-map) instead | 127 | ;; FIXME: (copy-keymap special-mode-map) instead |