diff options
Diffstat (limited to 'lisp')
35 files changed, 798 insertions, 318 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9e473e21626..ad4f3b9a7f3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,200 @@ | |||
| 1 | 2015-02-08 Artur Malabarba <bruce.connor.am@gmail.com> | ||
| 2 | |||
| 3 | * newcomment.el (comment-line): Fix missing paren. | ||
| 4 | |||
| 5 | 2015-02-08 Ulrich Müller <ulm@gentoo.org> | ||
| 6 | |||
| 7 | * play/gamegrid.el: Update comment to reflect that the | ||
| 8 | 'update-game-score' helper program is now setgid by default. | ||
| 9 | |||
| 10 | 2015-02-08 David Kastrup <dak@gnu.org> | ||
| 11 | |||
| 12 | * subr.el (apply-partially): Use lexical binding here. | ||
| 13 | |||
| 14 | 2015-02-08 Artur Malabarba <bruce.connor.am@gmail.com> | ||
| 15 | |||
| 16 | * newcomment.el (comment-line): New command. | ||
| 17 | |||
| 18 | * bindings.el (ctl-x-map): Bind to `C-x C-;'. | ||
| 19 | |||
| 20 | 2015-02-08 Oleh Krehel <ohwoeowho@gmail.com> | ||
| 21 | |||
| 22 | * outline.el (outline-show-entry): Fix one invisible char for the | ||
| 23 | file's last outline. Fixes Bug#19493. | ||
| 24 | |||
| 25 | 2015-02-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 26 | |||
| 27 | * subr.el (indirect-function): Change advertised calling convention. | ||
| 28 | |||
| 29 | 2015-02-08 Fabián Ezequiel Gallina <fgallina@gnu.org> | ||
| 30 | |||
| 31 | python.el: Fix completion-at-point. (Bug#19667) | ||
| 32 | |||
| 33 | * progmodes/python.el | ||
| 34 | (python-shell-completion-native-get-completions): Force process buffer. | ||
| 35 | (python-shell-completion-at-point): Handle case where call is not | ||
| 36 | in a shell buffer. | ||
| 37 | |||
| 38 | 2015-02-08 Fabián Ezequiel Gallina <fgallina@gnu.org> | ||
| 39 | |||
| 40 | python.el: Fix shell font-lock multiline input. (Bug#19744) | ||
| 41 | |||
| 42 | * progmodes/python.el | ||
| 43 | (python-shell-font-lock-post-command-hook): Handle multiline input. | ||
| 44 | |||
| 45 | 2015-02-08 Fabián Ezequiel Gallina <fgallina@gnu.org> | ||
| 46 | |||
| 47 | python.el: Make shell font-lock respect markers. (Bug#19650) | ||
| 48 | |||
| 49 | * progmodes/python.el (python-shell-font-lock-cleanup-buffer): | ||
| 50 | Use `erase-buffer`. | ||
| 51 | (python-shell-font-lock-comint-output-filter-function): | ||
| 52 | Handle newlines. | ||
| 53 | (python-shell-font-lock-post-command-hook): Respect markers on | ||
| 54 | text fontification. | ||
| 55 | |||
| 56 | 2015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org> | ||
| 57 | |||
| 58 | python.el: Keep eldoc visible while typing args. (Bug#19637) | ||
| 59 | |||
| 60 | * progmodes/python.el (python-eldoc--get-symbol-at-point): | ||
| 61 | New function based on Carlos Pita <carlosjosepita@gmail.com> patch. | ||
| 62 | (python-eldoc--get-doc-at-point, python-eldoc-at-point): Use it. | ||
| 63 | |||
| 64 | 2015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org> | ||
| 65 | |||
| 66 | Fix hideshow integration. (Bug#19761) | ||
| 67 | |||
| 68 | * progmodes/python.el | ||
| 69 | (python-hideshow-forward-sexp-function): New function based on | ||
| 70 | Carlos Pita <carlosjosepita@gmail.com> patch. | ||
| 71 | (python-mode): Make `hs-special-modes-alist` use it and initialize | ||
| 72 | the end regexp with the empty string to avoid skipping parens. | ||
| 73 | |||
| 74 | 2015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org> | ||
| 75 | |||
| 76 | * progmodes/python.el (python-check-custom-command): Do not use | ||
| 77 | defvar-local for compat with Emacs<24.3. | ||
| 78 | |||
| 79 | 2015-02-07 Martin Rudalics <rudalics@gmx.at> | ||
| 80 | |||
| 81 | * frame.el (frame-notice-user-settings): | ||
| 82 | Update `frame-size-history'. | ||
| 83 | (make-frame): Update `frame-size-history'. | ||
| 84 | Call `frame-after-make-frame'. | ||
| 85 | * faces.el (face-set-after-frame-default): Remove call to | ||
| 86 | frame-can-run-window-configuration-change-hook. | ||
| 87 | |||
| 88 | 2015-02-06 Dmitry Gutov <dgutov@yandex.ru> | ||
| 89 | |||
| 90 | * vc/vc-cvs.el (vc-cvs-dir-status-files): Don't pass DIR to | ||
| 91 | `vc-cvs-command' (bug#19732). | ||
| 92 | |||
| 93 | 2015-02-06 Nicolas Petton <nicolas@petton.fr> | ||
| 94 | |||
| 95 | * emacs-lisp/seq.el (seq-mapcat, seq-partition, seq-group-by): New functions. | ||
| 96 | * emacs-lisp/seq.el (seq-drop-while, seq-take-while, seq-count) | ||
| 97 | (seq--drop-list, seq--take-list, seq--take-while-list): Better docstring. | ||
| 98 | |||
| 99 | 2015-02-06 Artur Malabarba <bruce.connor.am@gmail.com> | ||
| 100 | |||
| 101 | * doc-view.el (doc-view-kill-proc-and-buffer): Obsolete. Use | ||
| 102 | `image-kill-buffer' instead. | ||
| 103 | |||
| 104 | 2015-02-06 Thomas Fitzsimmons <fitzsim@fitzsim.org> | ||
| 105 | |||
| 106 | * net/ldap.el (ldap-search-internal): Fix docstring. | ||
| 107 | |||
| 108 | 2015-02-06 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 109 | |||
| 110 | * subr.el (define-error): The error conditions may be constant | ||
| 111 | lists, so use `append' to concatenate them. | ||
| 112 | |||
| 113 | 2015-02-06 Wolfgang Jenkner <wjenkner@inode.at> | ||
| 114 | |||
| 115 | * net/network-stream.el (network-stream-open-tls): Respect the | ||
| 116 | :end-of-capability setting. | ||
| 117 | |||
| 118 | 2015-02-05 Artur Malabarba <bruce.connor.am@gmail.com> | ||
| 119 | |||
| 120 | * emacs-lisp/package.el (package--sort-by-dependence): | ||
| 121 | New function. Return PACKAGE-LIST sorted by dependencies. | ||
| 122 | (package-menu-execute): Use it to delete packages in order. | ||
| 123 | (package--sort-deps-in-alist): New function. | ||
| 124 | (package-menu-mark-install): Can mark dependencies. | ||
| 125 | (package--newest-p): New function. | ||
| 126 | (package-delete): Don't delesect when deleting an older version of | ||
| 127 | an upgraded package. | ||
| 128 | |||
| 129 | * emacs-lisp/package.el: Add missing (require 'subr-x) | ||
| 130 | |||
| 131 | 2015-02-05 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 132 | |||
| 133 | * textmodes/css-mode.el (scss-smie--not-interpolation-p): Vars can be | ||
| 134 | hyphenated (bug#19263). | ||
| 135 | |||
| 136 | * textmodes/css-mode.el (css-fill-paragraph): Fix filling in presence | ||
| 137 | of variable interpolation (bug#19751). | ||
| 138 | |||
| 139 | 2015-02-05 Era Eriksson <era+emacs@iki.fi> | ||
| 140 | |||
| 141 | * json.el (json-end-of-file): New error (bug#19768). | ||
| 142 | (json-pop, json-read): Use it. | ||
| 143 | |||
| 144 | 2015-02-05 Kelly Dean <kelly@prtime.org> | ||
| 145 | |||
| 146 | * help-mode.el (help-xref-interned): Pass BUFFER and FRAME to | ||
| 147 | `describe-variable'. | ||
| 148 | |||
| 149 | * help-fns.el (describe-function-or-variable): New function. | ||
| 150 | |||
| 151 | * help.el (help-map): Bind `describe-function-or-variable' to o. | ||
| 152 | (help-for-help-internal): Document o key. | ||
| 153 | |||
| 154 | 2015-02-05 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 155 | |||
| 156 | * emacs-lisp/eieio-compat.el (eieio--defmethod): Use new | ||
| 157 | special (:documentation ...) feature. | ||
| 158 | * emacs-lisp/eieio-core.el (eieio-make-class-predicate) | ||
| 159 | (eieio-make-child-predicate): Same. | ||
| 160 | (eieio-copy-parents-into-subclass): Remove unused arg. | ||
| 161 | (eieio-defclass-internal): Adjust call accordingly and remove redundant | ||
| 162 | `pname' var. | ||
| 163 | (eieio--slot-name-index): Remove unused arg `obj' and adjust all | ||
| 164 | callers accordingly. | ||
| 165 | |||
| 166 | * emacs-lisp/cconv.el (cconv--convert-function): | ||
| 167 | Add `docstring' argument. | ||
| 168 | (cconv-convert): Use it to handle the new (:documentation ...) form. | ||
| 169 | (cconv-analyze-form): Handle the new (:documentation ...) form. | ||
| 170 | |||
| 171 | * emacs-lisp/bytecomp.el: | ||
| 172 | (byte-compile-initial-macro-environment): Use macroexp-progn. | ||
| 173 | (byte-compile-cl-warn): Don't silence use of cl-macroexpand-all. | ||
| 174 | (byte-compile-file-form-defvar-function): Rename from | ||
| 175 | byte-compile-file-form-define-abbrev-table. | ||
| 176 | (defvaralias, byte-compile-file-form-custom-declare-variable): Use it. | ||
| 177 | (byte-compile): Use byte-compile-top-level rather than | ||
| 178 | byte-compile-lambda so we can compile non-values. | ||
| 179 | (byte-compile-form): Add warnings for failed uses of lexical vars via | ||
| 180 | quoted symbols. | ||
| 181 | (byte-compile-unfold-bcf): Improve message for failed inlining. | ||
| 182 | (byte-compile-make-closure): Handle new format of internal-make-closure | ||
| 183 | for dynamically-generated docstrings. | ||
| 184 | |||
| 185 | * delsel.el: Deprecate the `kill' option. Use lexical-binding. | ||
| 186 | (open-line): Delete like all other commands, instead of killing. | ||
| 187 | (delete-active-region): Don't define any return any value. | ||
| 188 | |||
| 189 | * progmodes/python.el: Try to preserve compatibility with Emacs-24. | ||
| 190 | (python-mode): Don't assume eldoc-documentation-function has a non-nil | ||
| 191 | default. | ||
| 192 | |||
| 193 | 2015-02-04 Sam Steingold <sds@gnu.org> | ||
| 194 | |||
| 195 | * progmodes/python.el (python-indent-calculate-indentation): | ||
| 196 | Avoid the error when computing top-level indentation. | ||
| 197 | |||
| 1 | 2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca> | 198 | 2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 199 | ||
| 3 | * emacs-lisp/cl-generic.el (cl--generic-member-method): Fix paren typo. | 200 | * emacs-lisp/cl-generic.el (cl--generic-member-method): Fix paren typo. |
| @@ -14,6 +211,9 @@ | |||
| 14 | 211 | ||
| 15 | 2015-02-04 Artur Malabarba <bruce.connor.am@gmail.com> | 212 | 2015-02-04 Artur Malabarba <bruce.connor.am@gmail.com> |
| 16 | 213 | ||
| 214 | * image-mode.el (image-kill-buffer): New command. | ||
| 215 | (image-mode-map): Bind it to k. | ||
| 216 | |||
| 17 | * emacs-lisp/package.el (package-delete): Remove package from | 217 | * emacs-lisp/package.el (package-delete): Remove package from |
| 18 | `package-selected-packages' even if it can't be deleted. | 218 | `package-selected-packages' even if it can't be deleted. |
| 19 | (package-installed-p): Accept package-desc objects. | 219 | (package-installed-p): Accept package-desc objects. |
| @@ -14330,7 +14530,7 @@ | |||
| 14330 | Change default to "# encoding: %s" to differentiate it from the | 14530 | Change default to "# encoding: %s" to differentiate it from the |
| 14331 | default Ruby encoding comment template. | 14531 | default Ruby encoding comment template. |
| 14332 | 14532 | ||
| 14333 | 2013-11-20 era eriksson <era+emacsbugs@iki.fi> | 14533 | 2013-11-20 Era Eriksson <era+emacsbugs@iki.fi> |
| 14334 | 14534 | ||
| 14335 | * ses.el (ses-mode): Doc fix. (Bug#14748) | 14535 | * ses.el (ses-mode): Doc fix. (Bug#14748) |
| 14336 | 14536 | ||
diff --git a/lisp/bindings.el b/lisp/bindings.el index 883914ecdc2..4cc9f6ad368 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el | |||
| @@ -1130,6 +1130,7 @@ if `inhibit-field-text-motion' is non-nil." | |||
| 1130 | (define-key esc-map "j" 'indent-new-comment-line) | 1130 | (define-key esc-map "j" 'indent-new-comment-line) |
| 1131 | (define-key esc-map "\C-j" 'indent-new-comment-line) | 1131 | (define-key esc-map "\C-j" 'indent-new-comment-line) |
| 1132 | (define-key ctl-x-map ";" 'comment-set-column) | 1132 | (define-key ctl-x-map ";" 'comment-set-column) |
| 1133 | (define-key ctl-x-map "C-;" 'comment-line) | ||
| 1133 | (define-key ctl-x-map "f" 'set-fill-column) | 1134 | (define-key ctl-x-map "f" 'set-fill-column) |
| 1134 | (define-key ctl-x-map "$" 'set-selective-display) | 1135 | (define-key ctl-x-map "$" 'set-selective-display) |
| 1135 | 1136 | ||
diff --git a/lisp/delsel.el b/lisp/delsel.el index e6bb3b952b3..740b60345ed 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; delsel.el --- delete selection if you insert | 1 | ;;; delsel.el --- delete selection if you insert -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1992, 1997-1998, 2001-2015 Free Software Foundation, | 3 | ;; Copyright (C) 1992, 1997-1998, 2001-2015 Free Software Foundation, |
| 4 | ;; Inc. | 4 | ;; Inc. |
| @@ -35,16 +35,12 @@ | |||
| 35 | ;; property on their symbols; commands which insert text but don't | 35 | ;; property on their symbols; commands which insert text but don't |
| 36 | ;; have this property won't delete the selection. It can be one of | 36 | ;; have this property won't delete the selection. It can be one of |
| 37 | ;; the values: | 37 | ;; the values: |
| 38 | ;; 'yank | 38 | ;; `yank' |
| 39 | ;; For commands which do a yank; ensures the region about to be | 39 | ;; For commands which do a yank; ensures the region about to be |
| 40 | ;; deleted isn't yanked. | 40 | ;; deleted isn't yanked. |
| 41 | ;; 'supersede | 41 | ;; `supersede' |
| 42 | ;; Delete the active region and ignore the current command, | 42 | ;; Delete the active region and ignore the current command, |
| 43 | ;; i.e. the command will just delete the region. | 43 | ;; i.e. the command will just delete the region. |
| 44 | ;; 'kill | ||
| 45 | ;; `kill-region' is used on the selection, rather than | ||
| 46 | ;; `delete-region'. (Text selected with the mouse will typically | ||
| 47 | ;; be yankable anyhow.) | ||
| 48 | ;; t | 44 | ;; t |
| 49 | ;; The normal case: delete the active region prior to executing | 45 | ;; The normal case: delete the active region prior to executing |
| 50 | ;; the command which will insert replacement text. | 46 | ;; the command which will insert replacement text. |
| @@ -93,8 +89,7 @@ If KILLP in not-nil, the active region is killed instead of deleted." | |||
| 93 | (cons (current-buffer) | 89 | (cons (current-buffer) |
| 94 | (and (consp buffer-undo-list) (car buffer-undo-list))))) | 90 | (and (consp buffer-undo-list) (car buffer-undo-list))))) |
| 95 | (t | 91 | (t |
| 96 | (funcall region-extract-function 'delete-only))) | 92 | (funcall region-extract-function 'delete-only)))) |
| 97 | t) | ||
| 98 | 93 | ||
| 99 | (defun delete-selection-repeat-replace-region (arg) | 94 | (defun delete-selection-repeat-replace-region (arg) |
| 100 | "Repeat replacing text of highlighted region with typed text. | 95 | "Repeat replacing text of highlighted region with typed text. |
| @@ -167,7 +162,7 @@ With ARG, repeat that many times. `C-u' means until end of buffer." | |||
| 167 | For commands which need to dynamically determine this behavior. | 162 | For commands which need to dynamically determine this behavior. |
| 168 | FUNCTION should take no argument and return one of the above values or nil." | 163 | FUNCTION should take no argument and return one of the above values or nil." |
| 169 | (condition-case data | 164 | (condition-case data |
| 170 | (cond ((eq type 'kill) | 165 | (cond ((eq type 'kill) ;Deprecated, backward compatibility. |
| 171 | (delete-active-region t) | 166 | (delete-active-region t) |
| 172 | (if (and overwrite-mode | 167 | (if (and overwrite-mode |
| 173 | (eq this-command 'self-insert-command)) | 168 | (eq this-command 'self-insert-command)) |
| @@ -255,7 +250,7 @@ See `delete-selection-helper'." | |||
| 255 | (put 'newline-and-indent 'delete-selection t) | 250 | (put 'newline-and-indent 'delete-selection t) |
| 256 | (put 'newline 'delete-selection t) | 251 | (put 'newline 'delete-selection t) |
| 257 | (put 'electric-newline-and-maybe-indent 'delete-selection t) | 252 | (put 'electric-newline-and-maybe-indent 'delete-selection t) |
| 258 | (put 'open-line 'delete-selection 'kill) | 253 | (put 'open-line 'delete-selection t) |
| 259 | 254 | ||
| 260 | ;; This is very useful for canceling a selection in the minibuffer without | 255 | ;; This is very useful for canceling a selection in the minibuffer without |
| 261 | ;; aborting the minibuffer. | 256 | ;; aborting the minibuffer. |
diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 0e63d37adc5..5f1c94a0128 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el | |||
| @@ -415,7 +415,6 @@ Typically \"page-%s.png\".") | |||
| 415 | (define-key map "H" 'doc-view-fit-height-to-window) | 415 | (define-key map "H" 'doc-view-fit-height-to-window) |
| 416 | (define-key map "P" 'doc-view-fit-page-to-window) | 416 | (define-key map "P" 'doc-view-fit-page-to-window) |
| 417 | ;; Killing the buffer (and the process) | 417 | ;; Killing the buffer (and the process) |
| 418 | (define-key map (kbd "k") 'doc-view-kill-proc-and-buffer) | ||
| 419 | (define-key map (kbd "K") 'doc-view-kill-proc) | 418 | (define-key map (kbd "K") 'doc-view-kill-proc) |
| 420 | ;; Slicing the image | 419 | ;; Slicing the image |
| 421 | (define-key map (kbd "s s") 'doc-view-set-slice) | 420 | (define-key map (kbd "s s") 'doc-view-set-slice) |
| @@ -645,12 +644,8 @@ at the top edge of the page moves to the previous page." | |||
| 645 | (setq doc-view--current-timer nil)) | 644 | (setq doc-view--current-timer nil)) |
| 646 | (setq mode-line-process nil)) | 645 | (setq mode-line-process nil)) |
| 647 | 646 | ||
| 648 | (defun doc-view-kill-proc-and-buffer () | 647 | (define-obsolete-function-alias 'doc-view-kill-proc-and-buffer |
| 649 | "Kill the current converter process and buffer." | 648 | #'image-kill-buffer "25.1") |
| 650 | (interactive) | ||
| 651 | (doc-view-kill-proc) | ||
| 652 | (when (eq major-mode 'doc-view-mode) | ||
| 653 | (kill-buffer (current-buffer)))) | ||
| 654 | 649 | ||
| 655 | (defun doc-view-make-safe-dir (dir) | 650 | (defun doc-view-make-safe-dir (dir) |
| 656 | (condition-case nil | 651 | (condition-case nil |
| @@ -1685,6 +1680,9 @@ If BACKWARD is non-nil, jump to the previous match." | |||
| 1685 | ;; desktop.el integration | 1680 | ;; desktop.el integration |
| 1686 | 1681 | ||
| 1687 | (defun doc-view-desktop-save-buffer (_desktop-dirname) | 1682 | (defun doc-view-desktop-save-buffer (_desktop-dirname) |
| 1683 | ;; FIXME: This is wrong, since this info is per-window but we only do it once | ||
| 1684 | ;; here for the buffer. IOW it should be saved via something like | ||
| 1685 | ;; `window-persistent-parameters'. | ||
| 1688 | `((page . ,(doc-view-current-page)) | 1686 | `((page . ,(doc-view-current-page)) |
| 1689 | (slice . ,(doc-view-current-slice)))) | 1687 | (slice . ,(doc-view-current-slice)))) |
| 1690 | 1688 | ||
| @@ -1695,8 +1693,13 @@ If BACKWARD is non-nil, jump to the previous match." | |||
| 1695 | (let ((page (cdr (assq 'page misc))) | 1693 | (let ((page (cdr (assq 'page misc))) |
| 1696 | (slice (cdr (assq 'slice misc)))) | 1694 | (slice (cdr (assq 'slice misc)))) |
| 1697 | (desktop-restore-file-buffer file name misc) | 1695 | (desktop-restore-file-buffer file name misc) |
| 1696 | ;; FIXME: We need to run this code after displaying the buffer. | ||
| 1698 | (with-selected-window (or (get-buffer-window (current-buffer) 0) | 1697 | (with-selected-window (or (get-buffer-window (current-buffer) 0) |
| 1699 | (selected-window)) | 1698 | (selected-window)) |
| 1699 | ;; FIXME: This should be done for all windows restored that show | ||
| 1700 | ;; this buffer. Basically, the page/slice should be saved as | ||
| 1701 | ;; window-parameters in the window-state(s) and then restoring this | ||
| 1702 | ;; window-state should call us back (to interpret/use those parameters). | ||
| 1700 | (doc-view-goto-page page) | 1703 | (doc-view-goto-page page) |
| 1701 | (when slice (apply 'doc-view-set-slice slice))))) | 1704 | (when slice (apply 'doc-view-set-slice slice))))) |
| 1702 | 1705 | ||
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2bd8d07851b..548aaa9626b 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -31,6 +31,10 @@ | |||
| 31 | ;; faster. [`LAP' == `Lisp Assembly Program'.] | 31 | ;; faster. [`LAP' == `Lisp Assembly Program'.] |
| 32 | ;; The user entry points are byte-compile-file and byte-recompile-directory. | 32 | ;; The user entry points are byte-compile-file and byte-recompile-directory. |
| 33 | 33 | ||
| 34 | ;;; Todo: | ||
| 35 | |||
| 36 | ;; - Turn "not bound at runtime" functions into autoloads. | ||
| 37 | |||
| 34 | ;;; Code: | 38 | ;;; Code: |
| 35 | 39 | ||
| 36 | ;; ======================================================================== | 40 | ;; ======================================================================== |
| @@ -450,7 +454,7 @@ Return the compile-time value of FORM." | |||
| 450 | (eval-when-compile . ,(lambda (&rest body) | 454 | (eval-when-compile . ,(lambda (&rest body) |
| 451 | (let ((result nil)) | 455 | (let ((result nil)) |
| 452 | (byte-compile-recurse-toplevel | 456 | (byte-compile-recurse-toplevel |
| 453 | (cons 'progn body) | 457 | (macroexp-progn body) |
| 454 | (lambda (form) | 458 | (lambda (form) |
| 455 | (setf result | 459 | (setf result |
| 456 | (byte-compile-eval | 460 | (byte-compile-eval |
| @@ -459,7 +463,7 @@ Return the compile-time value of FORM." | |||
| 459 | (list 'quote result)))) | 463 | (list 'quote result)))) |
| 460 | (eval-and-compile . ,(lambda (&rest body) | 464 | (eval-and-compile . ,(lambda (&rest body) |
| 461 | (byte-compile-recurse-toplevel | 465 | (byte-compile-recurse-toplevel |
| 462 | (cons 'progn body) | 466 | (macroexp-progn body) |
| 463 | (lambda (form) | 467 | (lambda (form) |
| 464 | ;; Don't compile here, since we don't know | 468 | ;; Don't compile here, since we don't know |
| 465 | ;; whether to compile as byte-compile-form | 469 | ;; whether to compile as byte-compile-form |
| @@ -1458,7 +1462,7 @@ extra args." | |||
| 1458 | ;; These would sometimes be warned about | 1462 | ;; These would sometimes be warned about |
| 1459 | ;; but such warnings are never useful, | 1463 | ;; but such warnings are never useful, |
| 1460 | ;; so don't warn about them. | 1464 | ;; so don't warn about them. |
| 1461 | macroexpand cl-macroexpand-all | 1465 | macroexpand |
| 1462 | cl--compiling-file)))) | 1466 | cl--compiling-file)))) |
| 1463 | (byte-compile-warn "function `%s' from cl package called at runtime" | 1467 | (byte-compile-warn "function `%s' from cl package called at runtime" |
| 1464 | func))) | 1468 | func))) |
| @@ -2319,10 +2323,12 @@ list that represents a doc string reference. | |||
| 2319 | form)) | 2323 | form)) |
| 2320 | 2324 | ||
| 2321 | (put 'define-abbrev-table 'byte-hunk-handler | 2325 | (put 'define-abbrev-table 'byte-hunk-handler |
| 2322 | 'byte-compile-file-form-define-abbrev-table) | 2326 | 'byte-compile-file-form-defvar-function) |
| 2323 | (defun byte-compile-file-form-define-abbrev-table (form) | 2327 | (put 'defvaralias 'byte-hunk-handler 'byte-compile-file-form-defvar-function) |
| 2324 | (if (eq 'quote (car-safe (car-safe (cdr form)))) | 2328 | |
| 2325 | (byte-compile--declare-var (car-safe (cdr (cadr form))))) | 2329 | (defun byte-compile-file-form-defvar-function (form) |
| 2330 | (pcase-let (((or `',name (let name nil)) (nth 1 form))) | ||
| 2331 | (if name (byte-compile--declare-var name))) | ||
| 2326 | (byte-compile-keep-pending form)) | 2332 | (byte-compile-keep-pending form)) |
| 2327 | 2333 | ||
| 2328 | (put 'custom-declare-variable 'byte-hunk-handler | 2334 | (put 'custom-declare-variable 'byte-hunk-handler |
| @@ -2330,8 +2336,7 @@ list that represents a doc string reference. | |||
| 2330 | (defun byte-compile-file-form-custom-declare-variable (form) | 2336 | (defun byte-compile-file-form-custom-declare-variable (form) |
| 2331 | (when (byte-compile-warning-enabled-p 'callargs) | 2337 | (when (byte-compile-warning-enabled-p 'callargs) |
| 2332 | (byte-compile-nogroup-warn form)) | 2338 | (byte-compile-nogroup-warn form)) |
| 2333 | (byte-compile--declare-var (nth 1 (nth 1 form))) | 2339 | (byte-compile-file-form-defvar-function form)) |
| 2334 | (byte-compile-keep-pending form)) | ||
| 2335 | 2340 | ||
| 2336 | (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) | 2341 | (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) |
| 2337 | (defun byte-compile-file-form-require (form) | 2342 | (defun byte-compile-file-form-require (form) |
| @@ -2580,17 +2585,11 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2580 | fun) | 2585 | fun) |
| 2581 | (t | 2586 | (t |
| 2582 | (when (symbolp form) | 2587 | (when (symbolp form) |
| 2583 | (unless (memq (car-safe fun) '(closure lambda)) | ||
| 2584 | (error "Don't know how to compile %S" fun)) | ||
| 2585 | (setq lexical-binding (eq (car fun) 'closure)) | 2588 | (setq lexical-binding (eq (car fun) 'closure)) |
| 2586 | (setq fun (byte-compile--reify-function fun))) | 2589 | (setq fun (byte-compile--reify-function fun))) |
| 2587 | (unless (eq (car-safe fun) 'lambda) | ||
| 2588 | (error "Don't know how to compile %S" fun)) | ||
| 2589 | ;; Expand macros. | 2590 | ;; Expand macros. |
| 2590 | (setq fun (byte-compile-preprocess fun)) | 2591 | (setq fun (byte-compile-preprocess fun)) |
| 2591 | ;; Get rid of the `function' quote added by the `lambda' macro. | 2592 | (setq fun (byte-compile-top-level fun nil 'eval)) |
| 2592 | (if (eq (car-safe fun) 'function) (setq fun (cadr fun))) | ||
| 2593 | (setq fun (byte-compile-lambda fun)) | ||
| 2594 | (if macro (push 'macro fun)) | 2593 | (if macro (push 'macro fun)) |
| 2595 | (if (symbolp form) | 2594 | (if (symbolp form) |
| 2596 | (fset form fun) | 2595 | (fset form fun) |
| @@ -2966,6 +2965,16 @@ for symbols generated by the byte compiler itself." | |||
| 2966 | (interactive-only | 2965 | (interactive-only |
| 2967 | (or (get fn 'interactive-only) | 2966 | (or (get fn 'interactive-only) |
| 2968 | (memq fn byte-compile-interactive-only-functions)))) | 2967 | (memq fn byte-compile-interactive-only-functions)))) |
| 2968 | (when (memq fn '(set symbol-value run-hooks ;; add-to-list | ||
| 2969 | add-hook remove-hook run-hook-with-args | ||
| 2970 | run-hook-with-args-until-success | ||
| 2971 | run-hook-with-args-until-failure)) | ||
| 2972 | (pcase (cdr form) | ||
| 2973 | (`(',var . ,_) | ||
| 2974 | (when (assq var byte-compile-lexical-variables) | ||
| 2975 | (byte-compile-log-warning | ||
| 2976 | (format "%s cannot use lexical var `%s'" fn var) | ||
| 2977 | nil :error))))) | ||
| 2969 | (when (macroexp--const-symbol-p fn) | 2978 | (when (macroexp--const-symbol-p fn) |
| 2970 | (byte-compile-warn "`%s' called as a function" fn)) | 2979 | (byte-compile-warn "`%s' called as a function" fn)) |
| 2971 | (when (and (byte-compile-warning-enabled-p 'interactive-only) | 2980 | (when (and (byte-compile-warning-enabled-p 'interactive-only) |
| @@ -3079,8 +3088,9 @@ for symbols generated by the byte compiler itself." | |||
| 3079 | (dotimes (_ (- (/ (1+ fmax2) 2) alen)) | 3088 | (dotimes (_ (- (/ (1+ fmax2) 2) alen)) |
| 3080 | (byte-compile-push-constant nil))) | 3089 | (byte-compile-push-constant nil))) |
| 3081 | ((zerop (logand fmax2 1)) | 3090 | ((zerop (logand fmax2 1)) |
| 3082 | (byte-compile-log-warning "Too many arguments for inlined function" | 3091 | (byte-compile-log-warning |
| 3083 | nil :error) | 3092 | (format "Too many arguments for inlined function %S" form) |
| 3093 | nil :error) | ||
| 3084 | (byte-compile-discard (- alen (/ fmax2 2)))) | 3094 | (byte-compile-discard (- alen (/ fmax2 2)))) |
| 3085 | (t | 3095 | (t |
| 3086 | ;; Turn &rest args into a list. | 3096 | ;; Turn &rest args into a list. |
| @@ -3453,15 +3463,22 @@ discarding." | |||
| 3453 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) | 3463 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) |
| 3454 | (let* ((vars (nth 1 form)) | 3464 | (let* ((vars (nth 1 form)) |
| 3455 | (env (nth 2 form)) | 3465 | (env (nth 2 form)) |
| 3456 | (body (nthcdr 3 form)) | 3466 | (docstring-exp (nth 3 form)) |
| 3467 | (body (nthcdr 4 form)) | ||
| 3457 | (fun | 3468 | (fun |
| 3458 | (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) | 3469 | (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) |
| 3459 | (cl-assert (> (length env) 0)) ;Otherwise, we don't need a closure. | 3470 | (cl-assert (or (> (length env) 0) |
| 3471 | docstring-exp)) ;Otherwise, we don't need a closure. | ||
| 3460 | (cl-assert (byte-code-function-p fun)) | 3472 | (cl-assert (byte-code-function-p fun)) |
| 3461 | (byte-compile-form `(make-byte-code | 3473 | (byte-compile-form `(make-byte-code |
| 3462 | ',(aref fun 0) ',(aref fun 1) | 3474 | ',(aref fun 0) ',(aref fun 1) |
| 3463 | (vconcat (vector . ,env) ',(aref fun 2)) | 3475 | (vconcat (vector . ,env) ',(aref fun 2)) |
| 3464 | ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun))))))) | 3476 | ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun)))) |
| 3477 | (if docstring-exp | ||
| 3478 | `(,(car rest) | ||
| 3479 | ,docstring-exp | ||
| 3480 | ,@(cddr rest)) | ||
| 3481 | rest))))))) | ||
| 3465 | 3482 | ||
| 3466 | (defun byte-compile-get-closed-var (form) | 3483 | (defun byte-compile-get-closed-var (form) |
| 3467 | "Byte-compile the special `internal-get-closed-var' form." | 3484 | "Byte-compile the special `internal-get-closed-var' form." |
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index e9d33e6c646..fa824075933 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el | |||
| @@ -48,7 +48,7 @@ | |||
| 48 | ;; if the function is suitable for lambda lifting (if all calls are known) | 48 | ;; if the function is suitable for lambda lifting (if all calls are known) |
| 49 | ;; | 49 | ;; |
| 50 | ;; (lambda (v0 ...) ... fv0 .. fv1 ...) => | 50 | ;; (lambda (v0 ...) ... fv0 .. fv1 ...) => |
| 51 | ;; (internal-make-closure (v0 ...) (fv1 ...) | 51 | ;; (internal-make-closure (v0 ...) (fv0 ...) <doc> |
| 52 | ;; ... (internal-get-closed-var 0) ... (internal-get-closed-var 1) ...) | 52 | ;; ... (internal-get-closed-var 0) ... (internal-get-closed-var 1) ...) |
| 53 | ;; | 53 | ;; |
| 54 | ;; If the function has no free variables, we don't do anything. | 54 | ;; If the function has no free variables, we don't do anything. |
| @@ -65,6 +65,14 @@ | |||
| 65 | ;; | 65 | ;; |
| 66 | ;;; Code: | 66 | ;;; Code: |
| 67 | 67 | ||
| 68 | ;; PROBLEM cases found during conversion to lexical binding. | ||
| 69 | ;; We should try and detect and warn about those cases, even | ||
| 70 | ;; for lexical-binding==nil to help prepare the migration. | ||
| 71 | ;; - Uses of run-hooks, and friends. | ||
| 72 | ;; - Cases where we want to apply the same code to different vars depending on | ||
| 73 | ;; some test. These sometimes use a (let ((foo (if bar 'a 'b))) | ||
| 74 | ;; ... (symbol-value foo) ... (set foo ...)). | ||
| 75 | |||
| 68 | ;; TODO: (not just for cconv but also for the lexbind changes in general) | 76 | ;; TODO: (not just for cconv but also for the lexbind changes in general) |
| 69 | ;; - let (e)debug find the value of lexical variables from the stack. | 77 | ;; - let (e)debug find the value of lexical variables from the stack. |
| 70 | ;; - make eval-region do the eval-sexp-add-defvars dance. | 78 | ;; - make eval-region do the eval-sexp-add-defvars dance. |
| @@ -87,9 +95,8 @@ | |||
| 87 | ;; the bytecomp only compiles it once. | 95 | ;; the bytecomp only compiles it once. |
| 88 | ;; - Since we know here when a variable is not mutated, we could pass that | 96 | ;; - Since we know here when a variable is not mutated, we could pass that |
| 89 | ;; info to the byte-compiler, e.g. by using a new `immutable-let'. | 97 | ;; info to the byte-compiler, e.g. by using a new `immutable-let'. |
| 90 | ;; - add tail-calls to bytecode.c and the byte compiler. | ||
| 91 | ;; - call known non-escaping functions with `goto' rather than `call'. | 98 | ;; - call known non-escaping functions with `goto' rather than `call'. |
| 92 | ;; - optimize mapcar to a while loop. | 99 | ;; - optimize mapc to a dolist loop. |
| 93 | 100 | ||
| 94 | ;; (defmacro dlet (binders &rest body) | 101 | ;; (defmacro dlet (binders &rest body) |
| 95 | ;; ;; Works in both lexical and non-lexical mode. | 102 | ;; ;; Works in both lexical and non-lexical mode. |
| @@ -195,7 +202,7 @@ Returns a form where all lambdas don't have any free variables." | |||
| 195 | (unless (memq (car b) s) (push b res))) | 202 | (unless (memq (car b) s) (push b res))) |
| 196 | (nreverse res))) | 203 | (nreverse res))) |
| 197 | 204 | ||
| 198 | (defun cconv--convert-function (args body env parentform) | 205 | (defun cconv--convert-function (args body env parentform &optional docstring) |
| 199 | (cl-assert (equal body (caar cconv-freevars-alist))) | 206 | (cl-assert (equal body (caar cconv-freevars-alist))) |
| 200 | (let* ((fvs (cdr (pop cconv-freevars-alist))) | 207 | (let* ((fvs (cdr (pop cconv-freevars-alist))) |
| 201 | (body-new '()) | 208 | (body-new '()) |
| @@ -240,11 +247,11 @@ Returns a form where all lambdas don't have any free variables." | |||
| 240 | `(,@(nreverse special-forms) (let ,letbind . ,body-new))))) | 247 | `(,@(nreverse special-forms) (let ,letbind . ,body-new))))) |
| 241 | 248 | ||
| 242 | (cond | 249 | (cond |
| 243 | ((null envector) ;if no freevars - do nothing | 250 | ((not (or envector docstring)) ;If no freevars - do nothing. |
| 244 | `(function (lambda ,args . ,body-new))) | 251 | `(function (lambda ,args . ,body-new))) |
| 245 | (t | 252 | (t |
| 246 | `(internal-make-closure | 253 | `(internal-make-closure |
| 247 | ,args ,envector . ,body-new))))) | 254 | ,args ,envector ,docstring . ,body-new))))) |
| 248 | 255 | ||
| 249 | (defun cconv-convert (form env extend) | 256 | (defun cconv-convert (form env extend) |
| 250 | ;; This function actually rewrites the tree. | 257 | ;; This function actually rewrites the tree. |
| @@ -407,7 +414,9 @@ places where they originally did not directly appear." | |||
| 407 | cond-forms))) | 414 | cond-forms))) |
| 408 | 415 | ||
| 409 | (`(function (lambda ,args . ,body) . ,_) | 416 | (`(function (lambda ,args . ,body) . ,_) |
| 410 | (cconv--convert-function args body env form)) | 417 | (let ((docstring (if (eq :documentation (car-safe (car body))) |
| 418 | (cconv-convert (cadr (pop body)) env extend)))) | ||
| 419 | (cconv--convert-function args body env form docstring))) | ||
| 411 | 420 | ||
| 412 | (`(internal-make-closure . ,_) | 421 | (`(internal-make-closure . ,_) |
| 413 | (byte-compile-report-error | 422 | (byte-compile-report-error |
| @@ -533,7 +542,7 @@ FORM is the parent form that binds this var." | |||
| 533 | ;; use = `(,binder ,read ,mutated ,captured ,called) | 542 | ;; use = `(,binder ,read ,mutated ,captured ,called) |
| 534 | (pcase vardata | 543 | (pcase vardata |
| 535 | (`(,_ nil nil nil nil) nil) | 544 | (`(,_ nil nil nil nil) nil) |
| 536 | (`((,(and (pred (lambda (var) (eq ?_ (aref (symbol-name var) 0)))) var) . ,_) | 545 | (`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_) |
| 537 | ,_ ,_ ,_ ,_) | 546 | ,_ ,_ ,_ ,_) |
| 538 | (byte-compile-log-warning | 547 | (byte-compile-log-warning |
| 539 | (format "%s `%S' not left unused" varkind var)))) | 548 | (format "%s `%S' not left unused" varkind var)))) |
| @@ -643,6 +652,8 @@ and updates the data stored in ENV." | |||
| 643 | (cconv--analyze-use vardata form "variable")))) | 652 | (cconv--analyze-use vardata form "variable")))) |
| 644 | 653 | ||
| 645 | (`(function (lambda ,vrs . ,body-forms)) | 654 | (`(function (lambda ,vrs . ,body-forms)) |
| 655 | (when (eq :documentation (car-safe (car body-forms))) | ||
| 656 | (cconv-analyze-form (cadr (pop body-forms)) env)) | ||
| 646 | (cconv--analyze-function vrs body-forms env form)) | 657 | (cconv--analyze-function vrs body-forms env form)) |
| 647 | 658 | ||
| 648 | (`(setq . ,forms) | 659 | (`(setq . ,forms) |
| @@ -665,6 +676,10 @@ and updates the data stored in ENV." | |||
| 665 | (dolist (forms cond-forms) | 676 | (dolist (forms cond-forms) |
| 666 | (dolist (form forms) (cconv-analyze-form form env)))) | 677 | (dolist (form forms) (cconv-analyze-form form env)))) |
| 667 | 678 | ||
| 679 | ;; ((and `(quote ,v . ,_) (guard (assq v env))) | ||
| 680 | ;; (byte-compile-log-warning | ||
| 681 | ;; (format "Possible confusion variable/symbol for `%S'" v))) | ||
| 682 | |||
| 668 | (`(quote . ,_) nil) ; quote form | 683 | (`(quote . ,_) nil) ; quote form |
| 669 | (`(function . ,_) nil) ; same as quote | 684 | (`(function . ,_) nil) ; same as quote |
| 670 | 685 | ||
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 46585ee76c6..fcf02b92736 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el | |||
| @@ -290,8 +290,7 @@ constructor functions are considered valid. | |||
| 290 | Second, any text properties will be stripped from strings." | 290 | Second, any text properties will be stripped from strings." |
| 291 | (cond ((consp proposed-value) | 291 | (cond ((consp proposed-value) |
| 292 | ;; Lists with something in them need special treatment. | 292 | ;; Lists with something in them need special treatment. |
| 293 | (let ((slot-idx (eieio--slot-name-index class | 293 | (let ((slot-idx (eieio--slot-name-index class slot)) |
| 294 | nil slot)) | ||
| 295 | (type nil) | 294 | (type nil) |
| 296 | (classtype nil)) | 295 | (classtype nil)) |
| 297 | (setq slot-idx (- slot-idx | 296 | (setq slot-idx (- slot-idx |
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index fcca99d79d5..7468c040e10 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el | |||
| @@ -188,11 +188,10 @@ Summary: | |||
| 188 | (args (help-function-arglist code 'preserve-names)) | 188 | (args (help-function-arglist code 'preserve-names)) |
| 189 | (doc-only (if docstring | 189 | (doc-only (if docstring |
| 190 | (let ((split (help-split-fundoc docstring nil))) | 190 | (let ((split (help-split-fundoc docstring nil))) |
| 191 | (if split (cdr split) docstring)))) | 191 | (if split (cdr split) docstring))))) |
| 192 | (new-docstring (help-add-fundoc-usage doc-only | ||
| 193 | (cons 'cl-cnm args)))) | ||
| 194 | ;; FIXME: ¡Add new-docstring to those closures! | ||
| 195 | (lambda (cnm &rest args) | 192 | (lambda (cnm &rest args) |
| 193 | (:documentation | ||
| 194 | (help-add-fundoc-usage doc-only (cons 'cl-cnm args))) | ||
| 196 | (cl-letf (((symbol-function 'call-next-method) cnm) | 195 | (cl-letf (((symbol-function 'call-next-method) cnm) |
| 197 | ((symbol-function 'next-method-p) | 196 | ((symbol-function 'next-method-p) |
| 198 | (lambda () (cl--generic-isnot-nnm-p cnm)))) | 197 | (lambda () (cl--generic-isnot-nnm-p cnm)))) |
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 77d8c01388b..fa8fefa1df0 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el | |||
| @@ -288,16 +288,17 @@ It creates an autoload function for CNAME's constructor." | |||
| 288 | 288 | ||
| 289 | (defun eieio-make-class-predicate (class) | 289 | (defun eieio-make-class-predicate (class) |
| 290 | (lambda (obj) | 290 | (lambda (obj) |
| 291 | ;; (:docstring (format "Test OBJ to see if it's an object of type %S." | 291 | (:documentation |
| 292 | ;; class)) | 292 | (format "Return non-nil if OBJ is an object of type `%S'.\n\n(fn OBJ)" |
| 293 | class)) | ||
| 293 | (and (eieio-object-p obj) | 294 | (and (eieio-object-p obj) |
| 294 | (same-class-p obj class)))) | 295 | (same-class-p obj class)))) |
| 295 | 296 | ||
| 296 | (defun eieio-make-child-predicate (class) | 297 | (defun eieio-make-child-predicate (class) |
| 297 | (lambda (obj) | 298 | (lambda (obj) |
| 298 | ;; (:docstring (format | 299 | (:documentation |
| 299 | ;; "Test OBJ to see if it's an object is a child of type %S." | 300 | (format "Return non-nil if OBJ is an object of type `%S' or a subclass. |
| 300 | ;; class)) | 301 | \n(fn OBJ)" class)) |
| 301 | (and (eieio-object-p obj) | 302 | (and (eieio-object-p obj) |
| 302 | (object-of-class-p obj class)))) | 303 | (object-of-class-p obj class)))) |
| 303 | 304 | ||
| @@ -312,8 +313,7 @@ See `defclass' for more information." | |||
| 312 | (run-hooks 'eieio-hook) | 313 | (run-hooks 'eieio-hook) |
| 313 | (setq eieio-hook nil) | 314 | (setq eieio-hook nil) |
| 314 | 315 | ||
| 315 | (let* ((pname superclasses) | 316 | (let* ((oldc (let ((c (eieio--class-v cname))) (if (eieio--class-p c) c))) |
| 316 | (oldc (let ((c (eieio--class-v cname))) (if (eieio--class-p c) c))) | ||
| 317 | (newc (if (and oldc (not (eieio--class-default-object-cache oldc))) | 317 | (newc (if (and oldc (not (eieio--class-default-object-cache oldc))) |
| 318 | ;; The oldc class is a stub setup by eieio-defclass-autoload. | 318 | ;; The oldc class is a stub setup by eieio-defclass-autoload. |
| 319 | ;; Reuse it instead of creating a new one, so that existing | 319 | ;; Reuse it instead of creating a new one, so that existing |
| @@ -338,9 +338,9 @@ See `defclass' for more information." | |||
| 338 | (setf (eieio--class-children newc) children) | 338 | (setf (eieio--class-children newc) children) |
| 339 | (remhash cname eieio-defclass-autoload-map)))) | 339 | (remhash cname eieio-defclass-autoload-map)))) |
| 340 | 340 | ||
| 341 | (if pname | 341 | (if superclasses |
| 342 | (progn | 342 | (progn |
| 343 | (dolist (p pname) | 343 | (dolist (p superclasses) |
| 344 | (if (not (and p (symbolp p))) | 344 | (if (not (and p (symbolp p))) |
| 345 | (error "Invalid parent class %S" p) | 345 | (error "Invalid parent class %S" p) |
| 346 | (let ((c (eieio--class-v p))) | 346 | (let ((c (eieio--class-v p))) |
| @@ -396,7 +396,7 @@ See `defclass' for more information." | |||
| 396 | 396 | ||
| 397 | ;; Before adding new slots, let's add all the methods and classes | 397 | ;; Before adding new slots, let's add all the methods and classes |
| 398 | ;; in from the parent class. | 398 | ;; in from the parent class. |
| 399 | (eieio-copy-parents-into-subclass newc superclasses) | 399 | (eieio-copy-parents-into-subclass newc) |
| 400 | 400 | ||
| 401 | ;; Store the new class vector definition into the symbol. We need to | 401 | ;; Store the new class vector definition into the symbol. We need to |
| 402 | ;; do this first so that we can call defmethod for the accessor. | 402 | ;; do this first so that we can call defmethod for the accessor. |
| @@ -784,7 +784,7 @@ if default value is nil." | |||
| 784 | )) | 784 | )) |
| 785 | )) | 785 | )) |
| 786 | 786 | ||
| 787 | (defun eieio-copy-parents-into-subclass (newc _parents) | 787 | (defun eieio-copy-parents-into-subclass (newc) |
| 788 | "Copy into NEWC the slots of PARENTS. | 788 | "Copy into NEWC the slots of PARENTS. |
| 789 | Follow the rules of not overwriting early parents when applying to | 789 | Follow the rules of not overwriting early parents when applying to |
| 790 | the new child class." | 790 | the new child class." |
| @@ -911,7 +911,7 @@ Argument FN is the function calling this verifier." | |||
| 911 | (if (eieio--class-p c) (eieio-class-un-autoload obj)) | 911 | (if (eieio--class-p c) (eieio-class-un-autoload obj)) |
| 912 | c)) | 912 | c)) |
| 913 | (t (eieio--object-class-object obj)))) | 913 | (t (eieio--object-class-object obj)))) |
| 914 | (c (eieio--slot-name-index class obj slot))) | 914 | (c (eieio--slot-name-index class slot))) |
| 915 | (if (not c) | 915 | (if (not c) |
| 916 | ;; It might be missing because it is a :class allocated slot. | 916 | ;; It might be missing because it is a :class allocated slot. |
| 917 | ;; Let's check that info out. | 917 | ;; Let's check that info out. |
| @@ -935,7 +935,7 @@ Fills in OBJ's SLOT with its default value." | |||
| 935 | (cl-check-type slot symbol) | 935 | (cl-check-type slot symbol) |
| 936 | (let* ((cl (cond ((symbolp obj) (eieio--class-v obj)) | 936 | (let* ((cl (cond ((symbolp obj) (eieio--class-v obj)) |
| 937 | (t (eieio--object-class-object obj)))) | 937 | (t (eieio--object-class-object obj)))) |
| 938 | (c (eieio--slot-name-index cl obj slot))) | 938 | (c (eieio--slot-name-index cl slot))) |
| 939 | (if (not c) | 939 | (if (not c) |
| 940 | ;; It might be missing because it is a :class allocated slot. | 940 | ;; It might be missing because it is a :class allocated slot. |
| 941 | ;; Let's check that info out. | 941 | ;; Let's check that info out. |
| @@ -973,7 +973,7 @@ Fills in OBJ's SLOT with VALUE." | |||
| 973 | (cl-check-type obj eieio-object) | 973 | (cl-check-type obj eieio-object) |
| 974 | (cl-check-type slot symbol) | 974 | (cl-check-type slot symbol) |
| 975 | (let* ((class (eieio--object-class-object obj)) | 975 | (let* ((class (eieio--object-class-object obj)) |
| 976 | (c (eieio--slot-name-index class obj slot))) | 976 | (c (eieio--slot-name-index class slot))) |
| 977 | (if (not c) | 977 | (if (not c) |
| 978 | ;; It might be missing because it is a :class allocated slot. | 978 | ;; It might be missing because it is a :class allocated slot. |
| 979 | ;; Let's check that info out. | 979 | ;; Let's check that info out. |
| @@ -997,7 +997,7 @@ Fills in the default value in CLASS' in SLOT with VALUE." | |||
| 997 | (setq class (eieio--class-object class)) | 997 | (setq class (eieio--class-object class)) |
| 998 | (cl-check-type class eieio--class) | 998 | (cl-check-type class eieio--class) |
| 999 | (cl-check-type slot symbol) | 999 | (cl-check-type slot symbol) |
| 1000 | (let* ((c (eieio--slot-name-index class nil slot))) | 1000 | (let* ((c (eieio--slot-name-index class slot))) |
| 1001 | (if (not c) | 1001 | (if (not c) |
| 1002 | ;; It might be missing because it is a :class allocated slot. | 1002 | ;; It might be missing because it is a :class allocated slot. |
| 1003 | ;; Let's check that info out. | 1003 | ;; Let's check that info out. |
| @@ -1021,12 +1021,9 @@ Fills in the default value in CLASS' in SLOT with VALUE." | |||
| 1021 | 1021 | ||
| 1022 | ;;; EIEIO internal search functions | 1022 | ;;; EIEIO internal search functions |
| 1023 | ;; | 1023 | ;; |
| 1024 | (defun eieio--slot-name-index (class obj slot) | 1024 | (defun eieio--slot-name-index (class slot) |
| 1025 | "In CLASS for OBJ find the index of the named SLOT. | 1025 | "In CLASS find the index of the named SLOT. |
| 1026 | The slot is a symbol which is installed in CLASS by the `defclass' | 1026 | The slot is a symbol which is installed in CLASS by the `defclass' call. |
| 1027 | call. OBJ can be nil, but if it is an object, and the slot in question | ||
| 1028 | is protected, access will be allowed if OBJ is a child of the currently | ||
| 1029 | scoped class. | ||
| 1030 | If SLOT is the value created with :initarg instead, | 1027 | If SLOT is the value created with :initarg instead, |
| 1031 | reverse-lookup that name, and recurse with the associated slot value." | 1028 | reverse-lookup that name, and recurse with the associated slot value." |
| 1032 | ;; Removed checks to outside this call | 1029 | ;; Removed checks to outside this call |
| @@ -1035,7 +1032,7 @@ reverse-lookup that name, and recurse with the associated slot value." | |||
| 1035 | (if (integerp fsi) | 1032 | (if (integerp fsi) |
| 1036 | (+ (eval-when-compile eieio--object-num-slots) fsi) | 1033 | (+ (eval-when-compile eieio--object-num-slots) fsi) |
| 1037 | (let ((fn (eieio--initarg-to-attribute class slot))) | 1034 | (let ((fn (eieio--initarg-to-attribute class slot))) |
| 1038 | (if fn (eieio--slot-name-index class obj fn) nil))))) | 1035 | (if fn (eieio--slot-name-index class fn) nil))))) |
| 1039 | 1036 | ||
| 1040 | (defun eieio--class-slot-name-index (class slot) | 1037 | (defun eieio--class-slot-name-index (class slot) |
| 1041 | "In CLASS find the index of the named SLOT. | 1038 | "In CLASS find the index of the named SLOT. |
| @@ -1255,7 +1252,7 @@ method invocation orders of the involved classes." | |||
| 1255 | (eieio--class-precedence-list tag)))) | 1252 | (eieio--class-precedence-list tag)))) |
| 1256 | 1253 | ||
| 1257 | 1254 | ||
| 1258 | ;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "b568ffb3c90ed5d0ae673f0051d608ee") | 1255 | ;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "5b04c9a8fff2bd3f3d3ac54aba0f65b7") |
| 1259 | ;;; Generated autoloads from eieio-compat.el | 1256 | ;;; Generated autoloads from eieio-compat.el |
| 1260 | 1257 | ||
| 1261 | (autoload 'eieio--defalias "eieio-compat" "\ | 1258 | (autoload 'eieio--defalias "eieio-compat" "\ |
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 67cd44d6758..c3a2061aae2 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el | |||
| @@ -161,6 +161,7 @@ | |||
| 161 | 161 | ||
| 162 | ;;; Code: | 162 | ;;; Code: |
| 163 | 163 | ||
| 164 | (eval-when-compile (require 'subr-x)) | ||
| 164 | (eval-when-compile (require 'cl-lib)) | 165 | (eval-when-compile (require 'cl-lib)) |
| 165 | (eval-when-compile (require 'epg)) ;For setf accessors. | 166 | (eval-when-compile (require 'epg)) ;For setf accessors. |
| 166 | 167 | ||
| @@ -1510,6 +1511,11 @@ with PKG-DESC entry removed." | |||
| 1510 | (and (memq pkg (mapcar #'car (package-desc-reqs (cadr p)))) | 1511 | (and (memq pkg (mapcar #'car (package-desc-reqs (cadr p)))) |
| 1511 | (car p)))))) | 1512 | (car p)))))) |
| 1512 | 1513 | ||
| 1514 | (defun package--newest-p (pkg) | ||
| 1515 | "Return t if PKG is the newest package with its name." | ||
| 1516 | (equal (cadr (assq (package-desc-name pkg) package-alist)) | ||
| 1517 | pkg)) | ||
| 1518 | |||
| 1513 | (defun package-delete (pkg-desc &optional force nosave) | 1519 | (defun package-delete (pkg-desc &optional force nosave) |
| 1514 | "Delete package PKG-DESC. | 1520 | "Delete package PKG-DESC. |
| 1515 | 1521 | ||
| @@ -1527,7 +1533,10 @@ If NOSAVE is non-nil, the package is not removed from | |||
| 1527 | ;; don't want it marked as selected, so we remove it from | 1533 | ;; don't want it marked as selected, so we remove it from |
| 1528 | ;; `package-selected-packages' even if it can't be deleted. | 1534 | ;; `package-selected-packages' even if it can't be deleted. |
| 1529 | (when (and (null nosave) | 1535 | (when (and (null nosave) |
| 1530 | (package--user-selected-p name)) | 1536 | (package--user-selected-p name) |
| 1537 | ;; Don't delesect if this is an older version of an | ||
| 1538 | ;; upgraded package. | ||
| 1539 | (package--newest-p pkg-desc)) | ||
| 1531 | (customize-save-variable | 1540 | (customize-save-variable |
| 1532 | 'package-selected-packages (remove name package-selected-packages))) | 1541 | 'package-selected-packages (remove name package-selected-packages))) |
| 1533 | (cond ((not (string-prefix-p (file-name-as-directory | 1542 | (cond ((not (string-prefix-p (file-name-as-directory |
| @@ -2262,7 +2271,7 @@ If optional arg BUTTON is non-nil, describe its associated package." | |||
| 2262 | (defun package-menu-mark-install (&optional _num) | 2271 | (defun package-menu-mark-install (&optional _num) |
| 2263 | "Mark a package for installation and move to the next line." | 2272 | "Mark a package for installation and move to the next line." |
| 2264 | (interactive "p") | 2273 | (interactive "p") |
| 2265 | (if (member (package-menu-get-status) '("available" "new")) | 2274 | (if (member (package-menu-get-status) '("available" "new" "dependency")) |
| 2266 | (tabulated-list-put-tag "I" t) | 2275 | (tabulated-list-put-tag "I" t) |
| 2267 | (forward-line))) | 2276 | (forward-line))) |
| 2268 | 2277 | ||
| @@ -2351,6 +2360,40 @@ call will upgrade the package." | |||
| 2351 | (length upgrades) | 2360 | (length upgrades) |
| 2352 | (if (= (length upgrades) 1) "" "s"))))) | 2361 | (if (= (length upgrades) 1) "" "s"))))) |
| 2353 | 2362 | ||
| 2363 | (defun package--sort-deps-in-alist (package only) | ||
| 2364 | "Return a list of dependencies for PACKAGE sorted by dependency. | ||
| 2365 | PACKAGE is included as the first element of the returned list. | ||
| 2366 | ONLY is an alist associating package names to package objects. | ||
| 2367 | Only these packages will be in the return value an their cdrs are | ||
| 2368 | destructively set to nil in ONLY." | ||
| 2369 | (let ((out)) | ||
| 2370 | (dolist (dep (package-desc-reqs package)) | ||
| 2371 | (when-let ((cell (assq (car dep) only)) | ||
| 2372 | (dep-package (cdr-safe cell))) | ||
| 2373 | (setcdr cell nil) | ||
| 2374 | (setq out (append (package--sort-deps-in-alist dep-package only) | ||
| 2375 | out)))) | ||
| 2376 | (cons package out))) | ||
| 2377 | |||
| 2378 | (defun package--sort-by-dependence (package-list) | ||
| 2379 | "Return PACKAGE-LIST sorted by dependence. | ||
| 2380 | That is, any element of the returned list is guaranteed to not | ||
| 2381 | directly depend on any elements that come before it. | ||
| 2382 | |||
| 2383 | PACKAGE-LIST is a list of package-desc objects. | ||
| 2384 | Indirect dependencies are guaranteed to be returned in order only | ||
| 2385 | if all the in-between dependencies are also in PACKAGE-LIST." | ||
| 2386 | (let ((alist (mapcar (lambda (p) (cons (package-desc-name p) p)) package-list)) | ||
| 2387 | out-list) | ||
| 2388 | (dolist (cell alist out-list) | ||
| 2389 | ;; `package--sort-deps-in-alist' destructively changes alist, so | ||
| 2390 | ;; some cells might already be empty. We check this here. | ||
| 2391 | (when-let ((pkg-desc (cdr cell))) | ||
| 2392 | (setcdr cell nil) | ||
| 2393 | (setq out-list | ||
| 2394 | (append (package--sort-deps-in-alist pkg-desc alist) | ||
| 2395 | out-list)))))) | ||
| 2396 | |||
| 2354 | (defun package-menu-execute (&optional noquery) | 2397 | (defun package-menu-execute (&optional noquery) |
| 2355 | "Perform marked Package Menu actions. | 2398 | "Perform marked Package Menu actions. |
| 2356 | Packages marked for installation are downloaded and installed; | 2399 | Packages marked for installation are downloaded and installed; |
| @@ -2384,7 +2427,13 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." | |||
| 2384 | (mapconcat #'package-desc-full-name | 2427 | (mapconcat #'package-desc-full-name |
| 2385 | install-list ", "))))) | 2428 | install-list ", "))))) |
| 2386 | (mapc (lambda (p) | 2429 | (mapc (lambda (p) |
| 2387 | (package-install p (null (package-installed-p p)))) | 2430 | ;; Mark as selected if it's the exact version of a |
| 2431 | ;; package that's already installed, or if it's not | ||
| 2432 | ;; installed at all. Don't mark if it's a new | ||
| 2433 | ;; version of an installed package. | ||
| 2434 | (package-install p (or (package-installed-p p) | ||
| 2435 | (not (package-installed-p | ||
| 2436 | (package-desc-name p)))))) | ||
| 2388 | install-list))) | 2437 | install-list))) |
| 2389 | ;; Delete packages, prompting if necessary. | 2438 | ;; Delete packages, prompting if necessary. |
| 2390 | (when delete-list | 2439 | (when delete-list |
| @@ -2398,7 +2447,7 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." | |||
| 2398 | (length delete-list) | 2447 | (length delete-list) |
| 2399 | (mapconcat #'package-desc-full-name | 2448 | (mapconcat #'package-desc-full-name |
| 2400 | delete-list ", "))))) | 2449 | delete-list ", "))))) |
| 2401 | (dolist (elt delete-list) | 2450 | (dolist (elt (package--sort-by-dependence delete-list)) |
| 2402 | (condition-case-unless-debug err | 2451 | (condition-case-unless-debug err |
| 2403 | (package-delete elt) | 2452 | (package-delete elt) |
| 2404 | (error (message (cadr err))))) | 2453 | (error (message (cadr err))))) |
| @@ -2412,7 +2461,8 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." | |||
| 2412 | (format "These %d packages are no longer needed, delete them (%s)? " | 2461 | (format "These %d packages are no longer needed, delete them (%s)? " |
| 2413 | (length removable) | 2462 | (length removable) |
| 2414 | (mapconcat #'symbol-name removable ", ")))) | 2463 | (mapconcat #'symbol-name removable ", ")))) |
| 2415 | (mapc (lambda (p) (package-delete (cadr (assq p package-alist)))) | 2464 | ;; We know these are removable, so we can use force instead of sorting them. |
| 2465 | (mapc (lambda (p) (package-delete (cadr (assq p package-alist)) 'force 'nosave)) | ||
| 2416 | removable)))) | 2466 | removable)))) |
| 2417 | (package-menu--generate t t)))) | 2467 | (package-menu--generate t t)))) |
| 2418 | 2468 | ||
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index b28153b7f81..025d94e10b9 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el | |||
| @@ -2,9 +2,9 @@ | |||
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2014-2015 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2014-2015 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Nicolas Petton <petton.nicolas@gmail.com> | 5 | ;; Author: Nicolas Petton <nicolas@petton.fr> |
| 6 | ;; Keywords: sequences | 6 | ;; Keywords: sequences |
| 7 | ;; Version: 1.0 | 7 | ;; Version: 1.1 |
| 8 | 8 | ||
| 9 | ;; Maintainer: emacs-devel@gnu.org | 9 | ;; Maintainer: emacs-devel@gnu.org |
| 10 | 10 | ||
| @@ -92,14 +92,14 @@ returned." | |||
| 92 | (seq-subseq seq 0 (min (max n 0) (seq-length seq))))) | 92 | (seq-subseq seq 0 (min (max n 0) (seq-length seq))))) |
| 93 | 93 | ||
| 94 | (defun seq-drop-while (pred seq) | 94 | (defun seq-drop-while (pred seq) |
| 95 | "Return a sequence, from the first element for which (PRED element) is nil, of SEQ. | 95 | "Return a sequence from the first element for which (PRED element) is nil in SEQ. |
| 96 | The result is a sequence of the same type as SEQ." | 96 | The result is a sequence of the same type as SEQ." |
| 97 | (if (listp seq) | 97 | (if (listp seq) |
| 98 | (seq--drop-while-list pred seq) | 98 | (seq--drop-while-list pred seq) |
| 99 | (seq-drop seq (seq--count-successive pred seq)))) | 99 | (seq-drop seq (seq--count-successive pred seq)))) |
| 100 | 100 | ||
| 101 | (defun seq-take-while (pred seq) | 101 | (defun seq-take-while (pred seq) |
| 102 | "Return a sequence of the successive elements for which (PRED element) is non-nil in SEQ. | 102 | "Return the successive elements for which (PRED element) is non-nil in SEQ. |
| 103 | The result is a sequence of the same type as SEQ." | 103 | The result is a sequence of the same type as SEQ." |
| 104 | (if (listp seq) | 104 | (if (listp seq) |
| 105 | (seq--take-while-list pred seq) | 105 | (seq--take-while-list pred seq) |
| @@ -152,7 +152,7 @@ If SEQ is empty, return INITIAL-VALUE and FUNCTION is not called." | |||
| 152 | t)) | 152 | t)) |
| 153 | 153 | ||
| 154 | (defun seq-count (pred seq) | 154 | (defun seq-count (pred seq) |
| 155 | "Return the number of elements for which (PRED element) returns non-nil in seq." | 155 | "Return the number of elements for which (PRED element) is non-nil in SEQ." |
| 156 | (let ((count 0)) | 156 | (let ((count 0)) |
| 157 | (seq-doseq (elt seq) | 157 | (seq-doseq (elt seq) |
| 158 | (when (funcall pred elt) | 158 | (when (funcall pred elt) |
| @@ -224,15 +224,50 @@ TYPE must be one of following symbols: vector, string or list. | |||
| 224 | (`list (apply #'append (append seqs '(nil)))) | 224 | (`list (apply #'append (append seqs '(nil)))) |
| 225 | (t (error "Not a sequence type name: %s" type)))) | 225 | (t (error "Not a sequence type name: %s" type)))) |
| 226 | 226 | ||
| 227 | (defun seq-mapcat (function seq &optional type) | ||
| 228 | "Concatenate the result of applying FUNCTION to each element of SEQ. | ||
| 229 | The result is a sequence of type TYPE, or a list if TYPE is nil." | ||
| 230 | (apply #'seq-concatenate (or type 'list) | ||
| 231 | (seq-map function seq))) | ||
| 232 | |||
| 233 | (defun seq-partition (seq n) | ||
| 234 | "Return a list of the elements of SEQ grouped into sub-sequences of length N. | ||
| 235 | The last sequence may contain less than N elements. If N is a | ||
| 236 | negative integer or 0, nil is returned." | ||
| 237 | (unless (< n 1) | ||
| 238 | (let ((result '())) | ||
| 239 | (while (not (seq-empty-p seq)) | ||
| 240 | (push (seq-take seq n) result) | ||
| 241 | (setq seq (seq-drop seq n))) | ||
| 242 | (nreverse result)))) | ||
| 243 | |||
| 244 | (defun seq-group-by (function seq) | ||
| 245 | "Apply FUNCTION to each element of SEQ. | ||
| 246 | Separate the elements of SEQ into an alist using the results as | ||
| 247 | keys. Keys are compared using `equal'." | ||
| 248 | (nreverse | ||
| 249 | (seq-reduce | ||
| 250 | (lambda (acc elt) | ||
| 251 | (let* ((key (funcall function elt)) | ||
| 252 | (cell (assoc key acc))) | ||
| 253 | (if cell | ||
| 254 | (setcdr cell (push elt (cdr cell))) | ||
| 255 | (push (list key elt) acc)) | ||
| 256 | acc)) | ||
| 257 | seq | ||
| 258 | nil))) | ||
| 259 | |||
| 227 | (defun seq--drop-list (list n) | 260 | (defun seq--drop-list (list n) |
| 228 | "Optimized version of `seq-drop' for lists." | 261 | "Return a list from LIST without its first N elements. |
| 262 | This is an optimization for lists in `seq-drop'." | ||
| 229 | (while (and list (> n 0)) | 263 | (while (and list (> n 0)) |
| 230 | (setq list (cdr list) | 264 | (setq list (cdr list) |
| 231 | n (1- n))) | 265 | n (1- n))) |
| 232 | list) | 266 | list) |
| 233 | 267 | ||
| 234 | (defun seq--take-list (list n) | 268 | (defun seq--take-list (list n) |
| 235 | "Optimized version of `seq-take' for lists." | 269 | "Return a list from LIST made of its first N elements. |
| 270 | This is an optimization for lists in `seq-take'." | ||
| 236 | (let ((result '())) | 271 | (let ((result '())) |
| 237 | (while (and list (> n 0)) | 272 | (while (and list (> n 0)) |
| 238 | (setq n (1- n)) | 273 | (setq n (1- n)) |
| @@ -240,13 +275,15 @@ TYPE must be one of following symbols: vector, string or list. | |||
| 240 | (nreverse result))) | 275 | (nreverse result))) |
| 241 | 276 | ||
| 242 | (defun seq--drop-while-list (pred list) | 277 | (defun seq--drop-while-list (pred list) |
| 243 | "Optimized version of `seq-drop-while' for lists." | 278 | "Return a list from the first element for which (PRED element) is nil in LIST. |
| 279 | This is an optimization for lists in `seq-drop-while'." | ||
| 244 | (while (and list (funcall pred (car list))) | 280 | (while (and list (funcall pred (car list))) |
| 245 | (setq list (cdr list))) | 281 | (setq list (cdr list))) |
| 246 | list) | 282 | list) |
| 247 | 283 | ||
| 248 | (defun seq--take-while-list (pred list) | 284 | (defun seq--take-while-list (pred list) |
| 249 | "Optimized version of `seq-take-while' for lists." | 285 | "Return the successive elements for which (PRED element) is non-nil in LIST. |
| 286 | This is an optimization for lists in `seq-take-while'." | ||
| 250 | (let ((result '())) | 287 | (let ((result '())) |
| 251 | (while (and list (funcall pred (car list))) | 288 | (while (and list (funcall pred (car list))) |
| 252 | (push (pop list) result)) | 289 | (push (pop list) result)) |
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index e41109a5619..bd03a870fdb 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el | |||
| @@ -961,11 +961,11 @@ Suffixes such as .el or .elc should be stripped." | |||
| 961 | (defun viper-ESC (arg) | 961 | (defun viper-ESC (arg) |
| 962 | "Emulate ESC key in Emacs. | 962 | "Emulate ESC key in Emacs. |
| 963 | Prevents multiple escape keystrokes if viper-no-multiple-ESC is true. | 963 | Prevents multiple escape keystrokes if viper-no-multiple-ESC is true. |
| 964 | If viper-no-multiple-ESC is 'twice double ESC would ding in vi-state. | 964 | If `viper-no-multiple-ESC' is `twice' double ESC would ding in vi-state. |
| 965 | Other ESC sequences are emulated via the current Emacs's major mode | 965 | Other ESC sequences are emulated via the current Emacs's major mode |
| 966 | keymap. This is more convenient on TTYs, since this won't block | 966 | keymap. This is more convenient on TTYs, since this won't block |
| 967 | function keys such as up, down, etc. ESC will also will also work as | 967 | function keys such as up, down, etc. ESC will also will also work as |
| 968 | a Meta key in this case. When viper-no-multiple-ESC is nil, ESC works | 968 | a Meta key in this case. When `viper-no-multiple-ESC' is nil, ESC works |
| 969 | as a Meta key and any number of multiple escapes are allowed." | 969 | as a Meta key and any number of multiple escapes are allowed." |
| 970 | (interactive "P") | 970 | (interactive "P") |
| 971 | (let (char) | 971 | (let (char) |
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 179ae169eca..250c292d72e 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el | |||
| @@ -60,13 +60,13 @@ Full Vi compatibility is not recommended for power use of Viper." | |||
| 60 | :group 'viper) | 60 | :group 'viper) |
| 61 | 61 | ||
| 62 | (defcustom viper-no-multiple-ESC t | 62 | (defcustom viper-no-multiple-ESC t |
| 63 | "If true, multiple ESC in Vi mode will cause bell to ring. | 63 | "If non-nil, multiple ESC in Vi mode will cause bell to ring. |
| 64 | This is set to t on a windowing terminal and to 'twice on a dumb | 64 | This is set to t on a windowing terminal and to `twice' on a dumb |
| 65 | terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this | 65 | terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this |
| 66 | enables cursor keys and is generally more convenient, as terminals usually | 66 | enables cursor keys and is generally more convenient, as terminals usually |
| 67 | don't have a convenient Meta key. | 67 | don't have a convenient Meta key. |
| 68 | Setting viper-no-multiple-ESC to nil will allow as many multiple ESC, | 68 | Setting it to nil will allow as many multiple ESC, as is allowed by the |
| 69 | as is allowed by the major mode in effect." | 69 | major mode in effect." |
| 70 | :type 'boolean | 70 | :type 'boolean |
| 71 | :group 'viper) | 71 | :group 'viper) |
| 72 | 72 | ||
diff --git a/lisp/faces.el b/lisp/faces.el index 22bf2626722..ce74c728474 100644 --- a/lisp/faces.el +++ b/lisp/faces.el | |||
| @@ -2092,8 +2092,7 @@ frame parameters in PARAMETERS." | |||
| 2092 | (value (cdr (assq param-name parameters)))) | 2092 | (value (cdr (assq param-name parameters)))) |
| 2093 | (if value | 2093 | (if value |
| 2094 | (set-face-attribute (nth 1 param) frame | 2094 | (set-face-attribute (nth 1 param) frame |
| 2095 | (nth 2 param) value)))) | 2095 | (nth 2 param) value)))))) |
| 2096 | (frame-can-run-window-configuration-change-hook frame t))) | ||
| 2097 | 2096 | ||
| 2098 | (defun tty-handle-reverse-video (frame parameters) | 2097 | (defun tty-handle-reverse-video (frame parameters) |
| 2099 | "Handle the reverse-video frame parameter for terminal frames." | 2098 | "Handle the reverse-video frame parameter for terminal frames." |
diff --git a/lisp/frame.el b/lisp/frame.el index 1d5bbf2317e..ecb433e8335 100644 --- a/lisp/frame.el +++ b/lisp/frame.el | |||
| @@ -465,6 +465,16 @@ there (in decreasing order of priority)." | |||
| 465 | (frame-set-background-mode frame-initial-frame)) | 465 | (frame-set-background-mode frame-initial-frame)) |
| 466 | (face-set-after-frame-default frame-initial-frame) | 466 | (face-set-after-frame-default frame-initial-frame) |
| 467 | (setq newparms (delq new-bg newparms))) | 467 | (setq newparms (delq new-bg newparms))) |
| 468 | |||
| 469 | (when (numberp (car frame-size-history)) | ||
| 470 | (setq frame-size-history | ||
| 471 | (cons (1- (car frame-size-history)) | ||
| 472 | (cons | ||
| 473 | (list frame-initial-frame | ||
| 474 | "frame-notice-user-settings" | ||
| 475 | nil newparms) | ||
| 476 | (cdr frame-size-history))))) | ||
| 477 | |||
| 468 | (modify-frame-parameters frame-initial-frame newparms))))) | 478 | (modify-frame-parameters frame-initial-frame newparms))))) |
| 469 | 479 | ||
| 470 | ;; Restore the original buffer. | 480 | ;; Restore the original buffer. |
| @@ -686,7 +696,7 @@ the new frame according to its own rules." | |||
| 686 | ;; Now make the frame. | 696 | ;; Now make the frame. |
| 687 | (run-hooks 'before-make-frame-hook) | 697 | (run-hooks 'before-make-frame-hook) |
| 688 | 698 | ||
| 689 | ;; (setq frame-adjust-size-history '(t)) | 699 | ;; (setq frame-size-history '(1000)) |
| 690 | 700 | ||
| 691 | (setq frame | 701 | (setq frame |
| 692 | (funcall (gui-method frame-creation-function w) params)) | 702 | (funcall (gui-method frame-creation-function w) params)) |
| @@ -697,11 +707,14 @@ the new frame according to its own rules." | |||
| 697 | (let ((val (frame-parameter oldframe param))) | 707 | (let ((val (frame-parameter oldframe param))) |
| 698 | (when val (set-frame-parameter frame param val))))) | 708 | (when val (set-frame-parameter frame param val))))) |
| 699 | 709 | ||
| 700 | (when (eq (car frame-adjust-size-history) t) | 710 | (when (numberp (car frame-size-history)) |
| 701 | (setq frame-adjust-size-history | 711 | (setq frame-size-history |
| 702 | (cons t (cons (list "Frame made") | 712 | (cons (1- (car frame-size-history)) |
| 703 | (cdr frame-adjust-size-history))))) | 713 | (cons (list frame "make-frame") |
| 714 | (cdr frame-size-history))))) | ||
| 704 | 715 | ||
| 716 | ;; We can run `window-configuration-change-hook' for this frame now. | ||
| 717 | (frame-after-make-frame frame t) | ||
| 705 | (run-hook-with-args 'after-make-frame-functions frame) | 718 | (run-hook-with-args 'after-make-frame-functions frame) |
| 706 | frame)) | 719 | frame)) |
| 707 | 720 | ||
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 841cff57ea2..32d3f08f586 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,33 @@ | |||
| 1 | 2015-02-05 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 2 | |||
| 3 | * gnus-start.el (gnus-save-newsrc-file-check-timestamp): Remove | ||
| 4 | variable; always check the newrc timestamp. | ||
| 5 | (gnus-save-newsrc-file): Always check timestamp. | ||
| 6 | |||
| 7 | 2015-02-05 Timo Lilja <timo.lilja@iki.fi> (tiny change) | ||
| 8 | |||
| 9 | * mail-source.el (mail-source-call-script): If scripts exit with an | ||
| 10 | error, pop up an error buffer. | ||
| 11 | |||
| 12 | 2015-02-05 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 13 | |||
| 14 | * gnus-sum.el (gnus-extra-headers): Add the popular Gmail X-GM-LABELS | ||
| 15 | as a default. | ||
| 16 | |||
| 17 | * nnimap.el (nnimap-request-group-scan): Ensure that we've selected the | ||
| 18 | correct server. | ||
| 19 | |||
| 20 | 2015-02-05 Vincent Bernat <bernat@luffy.cx> (tiny change) | ||
| 21 | |||
| 22 | * nnimap.el (nnimap-request-group-scan): Fix the function name. | ||
| 23 | |||
| 24 | * gnus-int.el (gnus-request-group-scan): Use the correct function name. | ||
| 25 | |||
| 26 | 2015-02-05 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 27 | |||
| 28 | * gnus-sum.el (gnus-select-newsgroup): Pass the group info along so | ||
| 29 | that nnimap works for non-activated backends. | ||
| 30 | |||
| 1 | 2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca> | 31 | 2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 32 | ||
| 3 | * mm-util.el (mm-with-unibyte-current-buffer): Don't emit a warning | 33 | * mm-util.el (mm-with-unibyte-current-buffer): Don't emit a warning |
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index dd938ce0758..4e870bb84bb 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el | |||
| @@ -442,7 +442,7 @@ If it is down, start it up (again)." | |||
| 442 | (defun gnus-request-group-scan (group info) | 442 | (defun gnus-request-group-scan (group info) |
| 443 | "Request that GROUP get a complete rescan." | 443 | "Request that GROUP get a complete rescan." |
| 444 | (let ((gnus-command-method (gnus-find-method-for-group group)) | 444 | (let ((gnus-command-method (gnus-find-method-for-group group)) |
| 445 | (func 'request-group-description)) | 445 | (func 'request-group-scan)) |
| 446 | (when (gnus-check-backend-function func group) | 446 | (when (gnus-check-backend-function func group) |
| 447 | (funcall (gnus-get-function gnus-command-method func) | 447 | (funcall (gnus-get-function gnus-command-method func) |
| 448 | (gnus-group-real-name group) (nth 1 gnus-command-method) info)))) | 448 | (gnus-group-real-name group) (nth 1 gnus-command-method) info)))) |
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index aa2568d5559..0c0246a4e14 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el | |||
| @@ -442,15 +442,6 @@ See also `gnus-before-startup-hook'." | |||
| 442 | :group 'gnus-newsrc | 442 | :group 'gnus-newsrc |
| 443 | :type 'hook) | 443 | :type 'hook) |
| 444 | 444 | ||
| 445 | (defcustom gnus-save-newsrc-file-check-timestamp nil | ||
| 446 | "Check the modification time of the newsrc.eld file before saving it. | ||
| 447 | When the newsrc.eld file is updated by multiple machines, | ||
| 448 | checking the file's modification time is a good way to avoid | ||
| 449 | overwriting updated data." | ||
| 450 | :version "25.1" | ||
| 451 | :group 'gnus-newsrc | ||
| 452 | :type 'boolean) | ||
| 453 | |||
| 454 | (defcustom gnus-save-newsrc-hook nil | 445 | (defcustom gnus-save-newsrc-hook nil |
| 455 | "A hook called before saving any of the newsrc files." | 446 | "A hook called before saving any of the newsrc files." |
| 456 | :group 'gnus-newsrc | 447 | :group 'gnus-newsrc |
| @@ -2833,19 +2824,18 @@ If FORCE is non-nil, the .newsrc file is read." | |||
| 2833 | 2824 | ||
| 2834 | ;; check timestamp of `gnus-current-startup-file'.eld against | 2825 | ;; check timestamp of `gnus-current-startup-file'.eld against |
| 2835 | ;; `gnus-save-newsrc-file-last-timestamp' | 2826 | ;; `gnus-save-newsrc-file-last-timestamp' |
| 2836 | (when gnus-save-newsrc-file-check-timestamp | 2827 | (let* ((checkfile (concat gnus-current-startup-file ".eld")) |
| 2837 | (let* ((checkfile (concat gnus-current-startup-file ".eld")) | 2828 | (mtime (nth 5 (file-attributes checkfile)))) |
| 2838 | (mtime (nth 5 (file-attributes checkfile)))) | 2829 | (when (and gnus-save-newsrc-file-last-timestamp |
| 2839 | (when (and gnus-save-newsrc-file-last-timestamp | 2830 | (time-less-p gnus-save-newsrc-file-last-timestamp |
| 2840 | (time-less-p gnus-save-newsrc-file-last-timestamp | 2831 | mtime)) |
| 2841 | mtime)) | 2832 | (unless (y-or-n-p |
| 2842 | (unless (y-or-n-p | 2833 | (format "%s was updated externally after %s, save?" |
| 2843 | (format "%s was updated externally after %s, save?" | 2834 | checkfile |
| 2844 | checkfile | 2835 | (format-time-string |
| 2845 | (format-time-string | 2836 | "%c" |
| 2846 | "%c" | 2837 | gnus-save-newsrc-file-last-timestamp))) |
| 2847 | gnus-save-newsrc-file-last-timestamp))) | 2838 | (error "Couldn't save %s: updated externally" checkfile)))) |
| 2848 | (error "Couldn't save %s: updated externally" checkfile))))) | ||
| 2849 | 2839 | ||
| 2850 | (if gnus-save-startup-file-via-temp-buffer | 2840 | (if gnus-save-startup-file-via-temp-buffer |
| 2851 | (let ((coding-system-for-write gnus-ding-file-coding-system) | 2841 | (let ((coding-system-for-write gnus-ding-file-coding-system) |
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index efe7a4d3d65..66b1050acc4 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el | |||
| @@ -1160,9 +1160,9 @@ which it may alter in any way." | |||
| 1160 | 'mail-decode-encoded-address-string | 1160 | 'mail-decode-encoded-address-string |
| 1161 | "Function used to decode addresses with encoded words.") | 1161 | "Function used to decode addresses with encoded words.") |
| 1162 | 1162 | ||
| 1163 | (defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups) | 1163 | (defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups X-GM-LABELS) |
| 1164 | "*Extra headers to parse." | 1164 | "*Extra headers to parse." |
| 1165 | :version "24.1" ; added Cc Keywords Gcc | 1165 | :version "25.1" |
| 1166 | :group 'gnus-summary | 1166 | :group 'gnus-summary |
| 1167 | :type '(repeat symbol)) | 1167 | :type '(repeat symbol)) |
| 1168 | 1168 | ||
| @@ -5620,7 +5620,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." | |||
| 5620 | (mm-decode-coding-string group charset) | 5620 | (mm-decode-coding-string group charset) |
| 5621 | (mm-decode-coding-string (gnus-status-message group) charset)))) | 5621 | (mm-decode-coding-string (gnus-status-message group) charset)))) |
| 5622 | 5622 | ||
| 5623 | (unless (gnus-request-group group t) | 5623 | (unless (gnus-request-group group t nil (gnus-get-info group)) |
| 5624 | (when (derived-mode-p 'gnus-summary-mode) | 5624 | (when (derived-mode-p 'gnus-summary-mode) |
| 5625 | (gnus-kill-buffer (current-buffer))) | 5625 | (gnus-kill-buffer (current-buffer))) |
| 5626 | (error "Couldn't request group %s: %s" | 5626 | (error "Couldn't request group %s: %s" |
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index eb05d714aba..94c8950988d 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el | |||
| @@ -750,13 +750,16 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) | |||
| 750 | (setq script (substring script 0 (match-beginning 0)) | 750 | (setq script (substring script 0 (match-beginning 0)) |
| 751 | background 0)) | 751 | background 0)) |
| 752 | (setq result | 752 | (setq result |
| 753 | (call-process shell-file-name nil background nil | 753 | (call-process shell-file-name nil stderr nil |
| 754 | shell-command-switch script)) | 754 | shell-command-switch script)) |
| 755 | (when (and result | 755 | (if (and result |
| 756 | (not (zerop result))) | 756 | (not (zerop result))) |
| 757 | (set-buffer stderr) | 757 | (progn |
| 758 | (message "Mail source error: %s" (buffer-string))) | 758 | (split-window-vertically) |
| 759 | (kill-buffer stderr))) | 759 | (other-window 1) |
| 760 | (switch-to-buffer stderr) | ||
| 761 | (message "Mail source error: %s " (buffer-string))) | ||
| 762 | (kill-buffer stderr)))) | ||
| 760 | 763 | ||
| 761 | ;;; | 764 | ;;; |
| 762 | ;;; Different fetchers | 765 | ;;; Different fetchers |
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index e619c0f13c2..e7f91b7cc33 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el | |||
| @@ -820,39 +820,40 @@ textual parts.") | |||
| 820 | group)) | 820 | group)) |
| 821 | t)))) | 821 | t)))) |
| 822 | 822 | ||
| 823 | (deffoo nnimap-request-scan-group (group &optional server info) | 823 | (deffoo nnimap-request-group-scan (group &optional server info) |
| 824 | (setq group (nnimap-decode-gnus-group group)) | 824 | (setq group (nnimap-decode-gnus-group group)) |
| 825 | (let (marks high low) | 825 | (when (nnimap-change-group nil server) |
| 826 | (with-current-buffer (nnimap-buffer) | 826 | (let (marks high low) |
| 827 | (erase-buffer) | 827 | (with-current-buffer (nnimap-buffer) |
| 828 | (let ((group-sequence | 828 | (erase-buffer) |
| 829 | (nnimap-send-command "SELECT %S" (utf7-encode group t))) | 829 | (let ((group-sequence |
| 830 | (flag-sequence | 830 | (nnimap-send-command "SELECT %S" (utf7-encode group t))) |
| 831 | (nnimap-send-command "UID FETCH 1:* FLAGS"))) | 831 | (flag-sequence |
| 832 | (setf (nnimap-group nnimap-object) group) | 832 | (nnimap-send-command "UID FETCH 1:* FLAGS"))) |
| 833 | (nnimap-wait-for-response flag-sequence) | 833 | (setf (nnimap-group nnimap-object) group) |
| 834 | (setq marks | 834 | (nnimap-wait-for-response flag-sequence) |
| 835 | (nnimap-flags-to-marks | 835 | (setq marks |
| 836 | (nnimap-parse-flags | 836 | (nnimap-flags-to-marks |
| 837 | (list (list group-sequence flag-sequence | 837 | (nnimap-parse-flags |
| 838 | 1 group "SELECT"))))) | 838 | (list (list group-sequence flag-sequence |
| 839 | (when (and info | 839 | 1 group "SELECT"))))) |
| 840 | marks) | 840 | (when (and info |
| 841 | (nnimap-update-infos marks (list info)) | 841 | marks) |
| 842 | (nnimap-store-info info (gnus-active (gnus-info-group info)))) | 842 | (nnimap-update-infos marks (list info)) |
| 843 | (goto-char (point-max)) | 843 | (nnimap-store-info info (gnus-active (gnus-info-group info)))) |
| 844 | (let ((uidnext (nth 5 (car marks)))) | 844 | (goto-char (point-max)) |
| 845 | (setq high (or (if uidnext | 845 | (let ((uidnext (nth 5 (car marks)))) |
| 846 | (1- uidnext) | 846 | (setq high (or (if uidnext |
| 847 | (nth 3 (car marks))) | 847 | (1- uidnext) |
| 848 | 0) | 848 | (nth 3 (car marks))) |
| 849 | low (or (nth 4 (car marks)) uidnext 1))))) | 849 | 0) |
| 850 | (with-current-buffer nntp-server-buffer | 850 | low (or (nth 4 (car marks)) uidnext 1))))) |
| 851 | (erase-buffer) | 851 | (with-current-buffer nntp-server-buffer |
| 852 | (insert | 852 | (erase-buffer) |
| 853 | (format | 853 | (insert |
| 854 | "211 %d %d %d %S\n" (1+ (- high low)) low high group)) | 854 | (format |
| 855 | t))) | 855 | "211 %d %d %d %S\n" (1+ (- high low)) low high group)) |
| 856 | t)))) | ||
| 856 | 857 | ||
| 857 | (deffoo nnimap-request-create-group (group &optional server args) | 858 | (deffoo nnimap-request-create-group (group &optional server args) |
| 858 | (setq group (nnimap-decode-gnus-group group)) | 859 | (setq group (nnimap-decode-gnus-group group)) |
diff --git a/lisp/help-fns.el b/lisp/help-fns.el index c0d63935035..61e8d54acb3 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el | |||
| @@ -930,6 +930,37 @@ file-local variable.\n") | |||
| 930 | 930 | ||
| 931 | 931 | ||
| 932 | ;;;###autoload | 932 | ;;;###autoload |
| 933 | (defun describe-function-or-variable (symbol &optional buffer frame) | ||
| 934 | "Display the full documentation of the function or variable SYMBOL. | ||
| 935 | If SYMBOL is a variable and has a buffer-local value in BUFFER or FRAME | ||
| 936 | \(default to the current buffer and current frame), it is displayed along | ||
| 937 | with the global value." | ||
| 938 | (interactive | ||
| 939 | (let* ((v-or-f (variable-at-point)) | ||
| 940 | (found (symbolp v-or-f)) | ||
| 941 | (v-or-f (if found v-or-f (function-called-at-point))) | ||
| 942 | (found (or found v-or-f)) | ||
| 943 | (enable-recursive-minibuffers t) | ||
| 944 | val) | ||
| 945 | (setq val (completing-read (if found | ||
| 946 | (format | ||
| 947 | "Describe function or variable (default %s): " v-or-f) | ||
| 948 | "Describe function or variable: ") | ||
| 949 | obarray | ||
| 950 | (lambda (vv) | ||
| 951 | (or (fboundp vv) | ||
| 952 | (get vv 'variable-documentation) | ||
| 953 | (and (boundp vv) (not (keywordp vv))))) | ||
| 954 | t nil nil | ||
| 955 | (if found (symbol-name v-or-f)))) | ||
| 956 | (list (if (equal val "") | ||
| 957 | v-or-f (intern val))))) | ||
| 958 | (if (not (symbolp symbol)) (message "You didn't specify a function or variable") | ||
| 959 | (unless (buffer-live-p buffer) (setq buffer (current-buffer))) | ||
| 960 | (unless (frame-live-p frame) (setq frame (selected-frame))) | ||
| 961 | (help-xref-interned symbol buffer frame))) | ||
| 962 | |||
| 963 | ;;;###autoload | ||
| 933 | (defun describe-syntax (&optional buffer) | 964 | (defun describe-syntax (&optional buffer) |
| 934 | "Describe the syntax specifications in the syntax table of BUFFER. | 965 | "Describe the syntax specifications in the syntax table of BUFFER. |
| 935 | The descriptions are inserted in a help buffer, which is then displayed. | 966 | The descriptions are inserted in a help buffer, which is then displayed. |
diff --git a/lisp/help-mode.el b/lisp/help-mode.el index c62ddc3dcd0..564362a0c43 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el | |||
| @@ -621,10 +621,13 @@ See `help-make-xrefs'." | |||
| 621 | 621 | ||
| 622 | 622 | ||
| 623 | ;; Additional functions for (re-)creating types of help buffers. | 623 | ;; Additional functions for (re-)creating types of help buffers. |
| 624 | (defun help-xref-interned (symbol) | 624 | |
| 625 | ;;;###autoload | ||
| 626 | (defun help-xref-interned (symbol &optional buffer frame) | ||
| 625 | "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL. | 627 | "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL. |
| 626 | Both variable, function and face documentation are extracted into a single | 628 | Both variable, function and face documentation are extracted into a single |
| 627 | help buffer." | 629 | help buffer. If SYMBOL is a variable, include buffer-local value for optional |
| 630 | BUFFER or FRAME." | ||
| 628 | (with-current-buffer (help-buffer) | 631 | (with-current-buffer (help-buffer) |
| 629 | ;; Push the previous item on the stack before clobbering the output buffer. | 632 | ;; Push the previous item on the stack before clobbering the output buffer. |
| 630 | (help-setup-xref nil nil) | 633 | (help-setup-xref nil nil) |
| @@ -640,7 +643,7 @@ help buffer." | |||
| 640 | (get symbol 'variable-documentation)) | 643 | (get symbol 'variable-documentation)) |
| 641 | ;; Don't record the current entry in the stack. | 644 | ;; Don't record the current entry in the stack. |
| 642 | (setq help-xref-stack-item nil) | 645 | (setq help-xref-stack-item nil) |
| 643 | (describe-variable symbol)))) | 646 | (describe-variable symbol buffer frame)))) |
| 644 | (cond | 647 | (cond |
| 645 | (sdoc | 648 | (sdoc |
| 646 | ;; We now have a help buffer on the variable. | 649 | ;; We now have a help buffer on the variable. |
diff --git a/lisp/help.el b/lisp/help.el index bf724252d5a..fb1719ac9c9 100644 --- a/lisp/help.el +++ b/lisp/help.el | |||
| @@ -95,6 +95,7 @@ | |||
| 95 | (define-key map "k" 'describe-key) | 95 | (define-key map "k" 'describe-key) |
| 96 | (define-key map "l" 'view-lossage) | 96 | (define-key map "l" 'view-lossage) |
| 97 | (define-key map "m" 'describe-mode) | 97 | (define-key map "m" 'describe-mode) |
| 98 | (define-key map "o" 'describe-function-or-variable) | ||
| 98 | (define-key map "n" 'view-emacs-news) | 99 | (define-key map "n" 'view-emacs-news) |
| 99 | (define-key map "p" 'finder-by-keyword) | 100 | (define-key map "p" 'finder-by-keyword) |
| 100 | (define-key map "P" 'describe-package) | 101 | (define-key map "P" 'describe-package) |
| @@ -218,6 +219,7 @@ L LANG-ENV Describes a specific language environment, or RET for current. | |||
| 218 | m Display documentation of current minor modes and current major mode, | 219 | m Display documentation of current minor modes and current major mode, |
| 219 | including their special commands. | 220 | including their special commands. |
| 220 | n Display news of recent Emacs changes. | 221 | n Display news of recent Emacs changes. |
| 222 | o SYMBOL Display the given function or variable's documentation and value. | ||
| 221 | p TOPIC Find packages matching a given topic keyword. | 223 | p TOPIC Find packages matching a given topic keyword. |
| 222 | P PACKAGE Describe the given Emacs Lisp package. | 224 | P PACKAGE Describe the given Emacs Lisp package. |
| 223 | r Display the Emacs manual in Info mode. | 225 | r Display the Emacs manual in Info mode. |
diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 9e527f1f0b3..e6d6a3edb71 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el | |||
| @@ -380,6 +380,7 @@ call." | |||
| 380 | (define-key map "a-" 'image-decrease-speed) | 380 | (define-key map "a-" 'image-decrease-speed) |
| 381 | (define-key map "a0" 'image-reset-speed) | 381 | (define-key map "a0" 'image-reset-speed) |
| 382 | (define-key map "ar" 'image-reverse-speed) | 382 | (define-key map "ar" 'image-reverse-speed) |
| 383 | (define-key map "k" 'image-kill-buffer) | ||
| 383 | (define-key map [remap forward-char] 'image-forward-hscroll) | 384 | (define-key map [remap forward-char] 'image-forward-hscroll) |
| 384 | (define-key map [remap backward-char] 'image-backward-hscroll) | 385 | (define-key map [remap backward-char] 'image-backward-hscroll) |
| 385 | (define-key map [remap right-char] 'image-forward-hscroll) | 386 | (define-key map [remap right-char] 'image-forward-hscroll) |
| @@ -722,6 +723,11 @@ the image by calling `image-mode'." | |||
| 722 | (image-mode-as-text) | 723 | (image-mode-as-text) |
| 723 | (image-mode))) | 724 | (image-mode))) |
| 724 | 725 | ||
| 726 | (defun image-kill-buffer () | ||
| 727 | "Kill the current buffer." | ||
| 728 | (interactive) | ||
| 729 | (kill-buffer (current-buffer))) | ||
| 730 | |||
| 725 | (defun image-after-revert-hook () | 731 | (defun image-after-revert-hook () |
| 726 | (when (image-get-display-property) | 732 | (when (image-get-display-property) |
| 727 | (image-toggle-display-text) | 733 | (image-toggle-display-text) |
diff --git a/lisp/json.el b/lisp/json.el index 68ab020c379..98974e67b7e 100644 --- a/lisp/json.el +++ b/lisp/json.el | |||
| @@ -166,7 +166,7 @@ without indentation.") | |||
| 166 | "Advance past the character at point, returning it." | 166 | "Advance past the character at point, returning it." |
| 167 | (let ((char (json-peek))) | 167 | (let ((char (json-peek))) |
| 168 | (if (eq char :json-eof) | 168 | (if (eq char :json-eof) |
| 169 | (signal 'end-of-file nil) | 169 | (signal 'json-end-of-file nil) |
| 170 | (json-advance) | 170 | (json-advance) |
| 171 | char))) | 171 | char))) |
| 172 | 172 | ||
| @@ -186,6 +186,8 @@ without indentation.") | |||
| 186 | (define-error 'json-string-format "Bad string format" 'json-error) | 186 | (define-error 'json-string-format "Bad string format" 'json-error) |
| 187 | (define-error 'json-key-format "Bad JSON object key" 'json-error) | 187 | (define-error 'json-key-format "Bad JSON object key" 'json-error) |
| 188 | (define-error 'json-object-format "Bad JSON object" 'json-error) | 188 | (define-error 'json-object-format "Bad JSON object" 'json-error) |
| 189 | (define-error 'json-end-of-file "End of file while parsing JSON" | ||
| 190 | '(end-of-file json-error)) | ||
| 189 | 191 | ||
| 190 | 192 | ||
| 191 | 193 | ||
| @@ -554,7 +556,7 @@ Advances point just past JSON object." | |||
| 554 | (if (functionp (car record)) | 556 | (if (functionp (car record)) |
| 555 | (apply (car record) (cdr record)) | 557 | (apply (car record) (cdr record)) |
| 556 | (signal 'json-readtable-error record))) | 558 | (signal 'json-readtable-error record))) |
| 557 | (signal 'end-of-file nil)))) | 559 | (signal 'json-end-of-file nil)))) |
| 558 | 560 | ||
| 559 | ;; Syntactic sugar for the reader | 561 | ;; Syntactic sugar for the reader |
| 560 | 562 | ||
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index a77fc3c6514..1df975af3d9 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el | |||
| @@ -546,8 +546,8 @@ not their associated values. | |||
| 546 | `auth' is one of the symbols `simple', `krbv41' or `krbv42'. | 546 | `auth' is one of the symbols `simple', `krbv41' or `krbv42'. |
| 547 | `base' is the base for the search as described in RFC 1779. | 547 | `base' is the base for the search as described in RFC 1779. |
| 548 | `scope' is one of the three symbols `sub', `base' or `one'. | 548 | `scope' is one of the three symbols `sub', `base' or `one'. |
| 549 | `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). | 549 | `binddn' is the distinguished name of the user to bind as (in |
| 550 | `auth' is one of the symbols `simple', `krbv41' or `krbv42' | 550 | RFC 1779 syntax). |
| 551 | `passwd' is the password to use for simple authentication. | 551 | `passwd' is the password to use for simple authentication. |
| 552 | `deref' is one of the symbols `never', `always', `search' or `find'. | 552 | `deref' is one of the symbols `never', `always', `search' or `find'. |
| 553 | `timelimit' is the timeout limit for the connection in seconds. | 553 | `timelimit' is the timeout limit for the connection in seconds. |
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index e7b3150b792..0104fa7dd12 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el | |||
| @@ -374,10 +374,12 @@ asynchronously, if possible." | |||
| 374 | (when (re-search-forward eoc nil t) | 374 | (when (re-search-forward eoc nil t) |
| 375 | (goto-char (match-beginning 0)) | 375 | (goto-char (match-beginning 0)) |
| 376 | (delete-region (point-min) (line-beginning-position)))) | 376 | (delete-region (point-min) (line-beginning-position)))) |
| 377 | (let* ((capability-command (plist-get parameters :capability-command))) | 377 | (let ((capability-command (plist-get parameters :capability-command)) |
| 378 | (eo-capa (or (plist-get parameters :end-of-capability) | ||
| 379 | eoc))) | ||
| 378 | (list stream | 380 | (list stream |
| 379 | (network-stream-get-response stream start eoc) | 381 | (network-stream-get-response stream start eoc) |
| 380 | (network-stream-command stream capability-command eoc) | 382 | (network-stream-command stream capability-command eo-capa) |
| 381 | 'tls)))))) | 383 | 'tls)))))) |
| 382 | 384 | ||
| 383 | (defun network-stream-open-shell (name buffer host service parameters) | 385 | (defun network-stream-open-shell (name buffer host service parameters) |
diff --git a/lisp/newcomment.el b/lisp/newcomment.el index e307eac94eb..172a5634a57 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el | |||
| @@ -1451,6 +1451,38 @@ unless optional argument SOFT is non-nil." | |||
| 1451 | (end-of-line 0) | 1451 | (end-of-line 0) |
| 1452 | (insert comend)))))))))))) | 1452 | (insert comend)))))))))))) |
| 1453 | 1453 | ||
| 1454 | ;;;###autoload | ||
| 1455 | (defun comment-line (n) | ||
| 1456 | "Comment or uncomment current line and leave point after it. | ||
| 1457 | With positive prefix, apply to N lines including current one. | ||
| 1458 | With negative prefix, apply to -N lines above. Also, further | ||
| 1459 | consecutive invocations of this command will inherit the negative | ||
| 1460 | argument. | ||
| 1461 | |||
| 1462 | If region is active, comment lines in active region instead. | ||
| 1463 | Unlike `comment-dwim', this always comments whole lines." | ||
| 1464 | (interactive "p") | ||
| 1465 | (if (use-region-p) | ||
| 1466 | (comment-or-uncomment-region | ||
| 1467 | (save-excursion | ||
| 1468 | (goto-char (region-beginning)) | ||
| 1469 | (line-beginning-position)) | ||
| 1470 | (save-excursion | ||
| 1471 | (goto-char (region-end)) | ||
| 1472 | (line-end-position))) | ||
| 1473 | (when (and (eq last-command 'comment-line-backward) | ||
| 1474 | (natnump n)) | ||
| 1475 | (setq n (- n))) | ||
| 1476 | (let ((range | ||
| 1477 | (list (line-beginning-position) | ||
| 1478 | (goto-char (line-end-position n))))) | ||
| 1479 | (comment-or-uncomment-region | ||
| 1480 | (apply #'min range) | ||
| 1481 | (apply #'max range))) | ||
| 1482 | (forward-line 1) | ||
| 1483 | (back-to-indentation) | ||
| 1484 | (unless (natnump n) (setq this-command 'comment-line-backward)))) | ||
| 1485 | |||
| 1454 | (provide 'newcomment) | 1486 | (provide 'newcomment) |
| 1455 | 1487 | ||
| 1456 | ;;; newcomment.el ends here | 1488 | ;;; newcomment.el ends here |
diff --git a/lisp/outline.el b/lisp/outline.el index ae31b8088f0..059ca626586 100644 --- a/lisp/outline.el +++ b/lisp/outline.el | |||
| @@ -777,7 +777,12 @@ Show the heading too, if it is currently invisible." | |||
| 777 | (save-excursion | 777 | (save-excursion |
| 778 | (outline-back-to-heading t) | 778 | (outline-back-to-heading t) |
| 779 | (outline-flag-region (1- (point)) | 779 | (outline-flag-region (1- (point)) |
| 780 | (progn (outline-next-preface) (point)) nil))) | 780 | (progn |
| 781 | (outline-next-preface) | ||
| 782 | (if (= 1 (- (point-max) (point))) | ||
| 783 | (point-max) | ||
| 784 | (point))) | ||
| 785 | nil))) | ||
| 781 | 786 | ||
| 782 | (define-obsolete-function-alias | 787 | (define-obsolete-function-alias |
| 783 | 'show-entry 'outline-show-entry "25.1") | 788 | 'show-entry 'outline-show-entry "25.1") |
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index b4c3c594731..df06d5a6ab2 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el | |||
| @@ -462,22 +462,22 @@ FILE is created there." | |||
| 462 | ;; `gamegrid-add-score' was supposed to be used in the past and | 462 | ;; `gamegrid-add-score' was supposed to be used in the past and |
| 463 | ;; is covered here for backward-compatibility. | 463 | ;; is covered here for backward-compatibility. |
| 464 | ;; | 464 | ;; |
| 465 | ;; 2. The helper program "update-game-score" is setuid and the | 465 | ;; 2. The helper program "update-game-score" is setgid or setuid |
| 466 | ;; file FILE does already exist in a system wide shared game | 466 | ;; and the file FILE does already exist in a system wide shared |
| 467 | ;; directory. This should be the normal case on POSIX systems, | 467 | ;; game directory. This should be the normal case on POSIX |
| 468 | ;; if the game was installed system wide. Use | 468 | ;; systems, if the game was installed system wide. Use |
| 469 | ;; "update-game-score" to add the score to the file in the | 469 | ;; "update-game-score" to add the score to the file in the |
| 470 | ;; shared game directory. | 470 | ;; shared game directory. |
| 471 | ;; | 471 | ;; |
| 472 | ;; 3. "update-game-score" is setuid, but the file FILE does *not* | 472 | ;; 3. "update-game-score" is setgid/setuid, but the file FILE does |
| 473 | ;; exist in the system wide shared game directory. Use | 473 | ;; *not* exist in the system wide shared game directory. Use |
| 474 | ;; `gamegrid-add-score-insecure' to create--if necessary--and | 474 | ;; `gamegrid-add-score-insecure' to create--if necessary--and |
| 475 | ;; update FILE. This is for the case that a user has installed | 475 | ;; update FILE. This is for the case that a user has installed |
| 476 | ;; a game on her own. | 476 | ;; a game on her own. |
| 477 | ;; | 477 | ;; |
| 478 | ;; 4. "update-game-score" is not setuid. Use it to create/update | 478 | ;; 4. "update-game-score" is not setgid/setuid. Use it to |
| 479 | ;; FILE in the user's home directory. There is presumably no | 479 | ;; create/update FILE in the user's home directory. There is |
| 480 | ;; shared game directory. | 480 | ;; presumably no shared game directory. |
| 481 | 481 | ||
| 482 | (defvar gamegrid-shared-game-dir) | 482 | (defvar gamegrid-shared-game-dir) |
| 483 | 483 | ||
| @@ -491,7 +491,7 @@ FILE is created there." | |||
| 491 | (gamegrid-add-score-insecure file score)) | 491 | (gamegrid-add-score-insecure file score)) |
| 492 | ((and gamegrid-shared-game-dir | 492 | ((and gamegrid-shared-game-dir |
| 493 | (file-exists-p (expand-file-name file shared-game-score-directory))) | 493 | (file-exists-p (expand-file-name file shared-game-score-directory))) |
| 494 | ;; Use the setuid (or setgid) "update-game-score" program | 494 | ;; Use the setgid (or setuid) "update-game-score" program |
| 495 | ;; to update a system-wide score file. | 495 | ;; to update a system-wide score file. |
| 496 | (gamegrid-add-score-with-update-game-score-1 file | 496 | (gamegrid-add-score-with-update-game-score-1 file |
| 497 | (expand-file-name file shared-game-score-directory) score)) | 497 | (expand-file-name file shared-game-score-directory) score)) |
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d340550a017..303c36c3932 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el | |||
| @@ -1068,7 +1068,9 @@ minimum." | |||
| 1068 | (levels (python-indent--calculate-levels indentation))) | 1068 | (levels (python-indent--calculate-levels indentation))) |
| 1069 | (if previous | 1069 | (if previous |
| 1070 | (python-indent--previous-level levels (current-indentation)) | 1070 | (python-indent--previous-level levels (current-indentation)) |
| 1071 | (apply #'max levels)))) | 1071 | (if levels |
| 1072 | (apply #'max levels) | ||
| 1073 | 0)))) | ||
| 1072 | 1074 | ||
| 1073 | (defun python-indent-line (&optional previous) | 1075 | (defun python-indent-line (&optional previous) |
| 1074 | "Internal implementation of `python-indent-line-function'. | 1076 | "Internal implementation of `python-indent-line-function'. |
| @@ -2331,57 +2333,57 @@ goes wrong and syntax highlighting in the shell gets messed up." | |||
| 2331 | (interactive) | 2333 | (interactive) |
| 2332 | (python-shell-with-shell-buffer | 2334 | (python-shell-with-shell-buffer |
| 2333 | (python-shell-font-lock-with-font-lock-buffer | 2335 | (python-shell-font-lock-with-font-lock-buffer |
| 2334 | (delete-region (point-min) (point-max))))) | 2336 | (erase-buffer)))) |
| 2335 | 2337 | ||
| 2336 | (defun python-shell-font-lock-comint-output-filter-function (output) | 2338 | (defun python-shell-font-lock-comint-output-filter-function (output) |
| 2337 | "Clean up the font-lock buffer after any OUTPUT." | 2339 | "Clean up the font-lock buffer after any OUTPUT." |
| 2338 | (when (and (not (string= "" output)) | 2340 | (if (and (not (string= "" output)) |
| 2339 | ;; Is end of output and is not just a prompt. | 2341 | ;; Is end of output and is not just a prompt. |
| 2340 | (not (member | 2342 | (not (member |
| 2341 | (python-shell-comint-end-of-output-p | 2343 | (python-shell-comint-end-of-output-p |
| 2342 | (ansi-color-filter-apply output)) | 2344 | (ansi-color-filter-apply output)) |
| 2343 | '(nil 0)))) | 2345 | '(nil 0)))) |
| 2344 | ;; If output is other than an input prompt then "real" output has | 2346 | ;; If output is other than an input prompt then "real" output has |
| 2345 | ;; been received and the font-lock buffer must be cleaned up. | 2347 | ;; been received and the font-lock buffer must be cleaned up. |
| 2346 | (python-shell-font-lock-cleanup-buffer)) | 2348 | (python-shell-font-lock-cleanup-buffer) |
| 2349 | ;; Otherwise just add a newline. | ||
| 2350 | (python-shell-font-lock-with-font-lock-buffer | ||
| 2351 | (goto-char (point-max)) | ||
| 2352 | (newline))) | ||
| 2347 | output) | 2353 | output) |
| 2348 | 2354 | ||
| 2349 | (defun python-shell-font-lock-post-command-hook () | 2355 | (defun python-shell-font-lock-post-command-hook () |
| 2350 | "Fontifies current line in shell buffer." | 2356 | "Fontifies current line in shell buffer." |
| 2351 | (if (eq this-command 'comint-send-input) | 2357 | (when (and (python-util-comint-last-prompt) |
| 2352 | ;; Add a newline when user sends input as this may be a block. | 2358 | (> (point) (cdr (python-util-comint-last-prompt)))) |
| 2353 | (python-shell-font-lock-with-font-lock-buffer | 2359 | (let ((input (buffer-substring-no-properties |
| 2354 | (goto-char (line-end-position)) | 2360 | (cdr (python-util-comint-last-prompt)) (point-max))) |
| 2355 | (newline)) | 2361 | (pos (point)) |
| 2356 | (when (and (python-util-comint-last-prompt) | 2362 | (buffer-undo-list t) |
| 2357 | (> (point) (cdr (python-util-comint-last-prompt)))) | 2363 | (font-lock-buffer-pos nil)) |
| 2358 | (let ((input (buffer-substring-no-properties | 2364 | ;; Keep all markers untouched, this prevents `hippie-expand' and |
| 2359 | (cdr (python-util-comint-last-prompt)) (point-max))) | 2365 | ;; others from getting confused. Bug#19650. |
| 2360 | (old-input (python-shell-font-lock-with-font-lock-buffer | 2366 | (insert-before-markers |
| 2361 | (buffer-substring-no-properties | 2367 | (python-shell-font-lock-with-font-lock-buffer |
| 2362 | (line-beginning-position) (point-max)))) | 2368 | (delete-region (line-beginning-position) |
| 2363 | (current-point (point)) | 2369 | (point-max)) |
| 2364 | (buffer-undo-list t)) | 2370 | (setq font-lock-buffer-pos (point)) |
| 2365 | ;; When input hasn't changed, do nothing. | 2371 | (insert input) |
| 2366 | (when (not (string= input old-input)) | 2372 | ;; Ensure buffer is fontified, keeping it |
| 2367 | (delete-region (cdr (python-util-comint-last-prompt)) (point-max)) | 2373 | ;; compatible with Emacs < 24.4. |
| 2368 | (insert | 2374 | (if (fboundp 'font-lock-ensure) |
| 2369 | (python-shell-font-lock-with-font-lock-buffer | 2375 | (funcall 'font-lock-ensure) |
| 2370 | (delete-region (line-beginning-position) | 2376 | (font-lock-default-fontify-buffer)) |
| 2371 | (line-end-position)) | 2377 | ;; Replace FACE text properties with FONT-LOCK-FACE so |
| 2372 | (insert input) | 2378 | ;; they are not overwritten by comint buffer's font lock. |
| 2373 | ;; Ensure buffer is fontified, keeping it | 2379 | (python-util-text-properties-replace-name |
| 2374 | ;; compatible with Emacs < 24.4. | 2380 | 'face 'font-lock-face) |
| 2375 | (if (fboundp 'font-lock-ensure) | 2381 | (buffer-substring font-lock-buffer-pos |
| 2376 | (funcall 'font-lock-ensure) | 2382 | (point-max)))) |
| 2377 | (font-lock-default-fontify-buffer)) | 2383 | ;; Remove non-fontified original text. |
| 2378 | ;; Replace FACE text properties with FONT-LOCK-FACE so | 2384 | (delete-region pos (cdr (python-util-comint-last-prompt))) |
| 2379 | ;; they are not overwritten by comint buffer's font lock. | 2385 | ;; Point should be already at pos, this is for extra safety. |
| 2380 | (python-util-text-properties-replace-name | 2386 | (goto-char pos)))) |
| 2381 | 'face 'font-lock-face) | ||
| 2382 | (buffer-substring (line-beginning-position) | ||
| 2383 | (line-end-position)))) | ||
| 2384 | (goto-char current-point)))))) | ||
| 2385 | 2387 | ||
| 2386 | (defun python-shell-font-lock-turn-on (&optional msg) | 2388 | (defun python-shell-font-lock-turn-on (&optional msg) |
| 2387 | "Turn on shell font-lock. | 2389 | "Turn on shell font-lock. |
| @@ -3148,67 +3150,68 @@ With argument MSG show activation/deactivation message." | |||
| 3148 | "Get completions using native readline for PROCESS. | 3150 | "Get completions using native readline for PROCESS. |
| 3149 | When IMPORT is non-nil takes precedence over INPUT for | 3151 | When IMPORT is non-nil takes precedence over INPUT for |
| 3150 | completion." | 3152 | completion." |
| 3151 | (when (and python-shell-completion-native-enable | 3153 | (with-current-buffer (process-buffer process) |
| 3152 | (python-util-comint-last-prompt) | 3154 | (when (and python-shell-completion-native-enable |
| 3153 | (>= (point) (cdr (python-util-comint-last-prompt)))) | 3155 | (python-util-comint-last-prompt) |
| 3154 | (let* ((input (or import input)) | 3156 | (>= (point) (cdr (python-util-comint-last-prompt)))) |
| 3155 | (original-filter-fn (process-filter process)) | 3157 | (let* ((input (or import input)) |
| 3156 | (redirect-buffer (get-buffer-create | 3158 | (original-filter-fn (process-filter process)) |
| 3157 | python-shell-completion-native-redirect-buffer)) | 3159 | (redirect-buffer (get-buffer-create |
| 3158 | (separators (python-rx | 3160 | python-shell-completion-native-redirect-buffer)) |
| 3159 | (or whitespace open-paren close-paren))) | 3161 | (separators (python-rx |
| 3160 | (trigger "\t\t\t") | 3162 | (or whitespace open-paren close-paren))) |
| 3161 | (new-input (concat input trigger)) | 3163 | (trigger "\t\t\t") |
| 3162 | (input-length | 3164 | (new-input (concat input trigger)) |
| 3163 | (save-excursion | 3165 | (input-length |
| 3164 | (+ (- (point-max) (comint-bol)) (length new-input)))) | 3166 | (save-excursion |
| 3165 | (delete-line-command (make-string input-length ?\b)) | 3167 | (+ (- (point-max) (comint-bol)) (length new-input)))) |
| 3166 | (input-to-send (concat new-input delete-line-command))) | 3168 | (delete-line-command (make-string input-length ?\b)) |
| 3167 | ;; Ensure restoring the process filter, even if the user quits | 3169 | (input-to-send (concat new-input delete-line-command))) |
| 3168 | ;; or there's some other error. | 3170 | ;; Ensure restoring the process filter, even if the user quits |
| 3169 | (unwind-protect | 3171 | ;; or there's some other error. |
| 3170 | (with-current-buffer redirect-buffer | 3172 | (unwind-protect |
| 3171 | ;; Cleanup the redirect buffer | 3173 | (with-current-buffer redirect-buffer |
| 3172 | (delete-region (point-min) (point-max)) | 3174 | ;; Cleanup the redirect buffer |
| 3173 | ;; Mimic `comint-redirect-send-command', unfortunately it | 3175 | (delete-region (point-min) (point-max)) |
| 3174 | ;; can't be used here because it expects a newline in the | 3176 | ;; Mimic `comint-redirect-send-command', unfortunately it |
| 3175 | ;; command and that's exactly what we are trying to avoid. | 3177 | ;; can't be used here because it expects a newline in the |
| 3176 | (let ((comint-redirect-echo-input nil) | 3178 | ;; command and that's exactly what we are trying to avoid. |
| 3177 | (comint-redirect-verbose nil) | 3179 | (let ((comint-redirect-echo-input nil) |
| 3178 | (comint-redirect-perform-sanity-check nil) | 3180 | (comint-redirect-verbose nil) |
| 3179 | (comint-redirect-insert-matching-regexp nil) | 3181 | (comint-redirect-perform-sanity-check nil) |
| 3180 | ;; Feed it some regex that will never match. | 3182 | (comint-redirect-insert-matching-regexp nil) |
| 3181 | (comint-redirect-finished-regexp "^\\'$") | 3183 | ;; Feed it some regex that will never match. |
| 3182 | (comint-redirect-output-buffer redirect-buffer)) | 3184 | (comint-redirect-finished-regexp "^\\'$") |
| 3183 | ;; Compatibility with Emacs 24.x. Comint changed and | 3185 | (comint-redirect-output-buffer redirect-buffer)) |
| 3184 | ;; now `comint-redirect-filter' gets 3 args. This | 3186 | ;; Compatibility with Emacs 24.x. Comint changed and |
| 3185 | ;; checks which version of `comint-redirect-filter' is | 3187 | ;; now `comint-redirect-filter' gets 3 args. This |
| 3186 | ;; in use based on its args and uses `apply-partially' | 3188 | ;; checks which version of `comint-redirect-filter' is |
| 3187 | ;; to make it up for the 3 args case. | 3189 | ;; in use based on its args and uses `apply-partially' |
| 3188 | (if (= (length | 3190 | ;; to make it up for the 3 args case. |
| 3189 | (help-function-arglist 'comint-redirect-filter)) 3) | 3191 | (if (= (length |
| 3190 | (set-process-filter | 3192 | (help-function-arglist 'comint-redirect-filter)) 3) |
| 3191 | process (apply-partially | 3193 | (set-process-filter |
| 3192 | #'comint-redirect-filter original-filter-fn)) | 3194 | process (apply-partially |
| 3193 | (set-process-filter process #'comint-redirect-filter)) | 3195 | #'comint-redirect-filter original-filter-fn)) |
| 3194 | (process-send-string process input-to-send) | 3196 | (set-process-filter process #'comint-redirect-filter)) |
| 3195 | (accept-process-output | 3197 | (process-send-string process input-to-send) |
| 3196 | process | 3198 | (accept-process-output |
| 3197 | python-shell-completion-native-output-timeout) | 3199 | process |
| 3198 | ;; XXX: can't use `python-shell-accept-process-output' | 3200 | python-shell-completion-native-output-timeout) |
| 3199 | ;; here because there are no guarantees on how output | 3201 | ;; XXX: can't use `python-shell-accept-process-output' |
| 3200 | ;; ends. The workaround here is to call | 3202 | ;; here because there are no guarantees on how output |
| 3201 | ;; `accept-process-output' until we don't find anything | 3203 | ;; ends. The workaround here is to call |
| 3202 | ;; else to accept. | 3204 | ;; `accept-process-output' until we don't find anything |
| 3203 | (while (accept-process-output | 3205 | ;; else to accept. |
| 3204 | process | 3206 | (while (accept-process-output |
| 3205 | python-shell-completion-native-output-timeout)) | 3207 | process |
| 3206 | (cl-remove-duplicates | 3208 | python-shell-completion-native-output-timeout)) |
| 3207 | (split-string | 3209 | (cl-remove-duplicates |
| 3208 | (buffer-substring-no-properties | 3210 | (split-string |
| 3209 | (point-min) (point-max)) | 3211 | (buffer-substring-no-properties |
| 3210 | separators t)))) | 3212 | (point-min) (point-max)) |
| 3211 | (set-process-filter process original-filter-fn))))) | 3213 | separators t)))) |
| 3214 | (set-process-filter process original-filter-fn)))))) | ||
| 3212 | 3215 | ||
| 3213 | (defun python-shell-completion-get-completions (process import input) | 3216 | (defun python-shell-completion-get-completions (process import input) |
| 3214 | "Do completion at point using PROCESS for IMPORT or INPUT. | 3217 | "Do completion at point using PROCESS for IMPORT or INPUT. |
| @@ -3251,20 +3254,23 @@ completion." | |||
| 3251 | Optional argument PROCESS forces completions to be retrieved | 3254 | Optional argument PROCESS forces completions to be retrieved |
| 3252 | using that one instead of current buffer's process." | 3255 | using that one instead of current buffer's process." |
| 3253 | (setq process (or process (get-buffer-process (current-buffer)))) | 3256 | (setq process (or process (get-buffer-process (current-buffer)))) |
| 3254 | (let* ((last-prompt-end (cdr (python-util-comint-last-prompt))) | 3257 | (let* ((line-start (if (derived-mode-p 'inferior-python-mode) |
| 3258 | ;; Working on a shell buffer: use prompt end. | ||
| 3259 | (cdr (python-util-comint-last-prompt)) | ||
| 3260 | (line-beginning-position))) | ||
| 3255 | (import-statement | 3261 | (import-statement |
| 3256 | (when (string-match-p | 3262 | (when (string-match-p |
| 3257 | (rx (* space) word-start (or "from" "import") word-end space) | 3263 | (rx (* space) word-start (or "from" "import") word-end space) |
| 3258 | (buffer-substring-no-properties last-prompt-end (point))) | 3264 | (buffer-substring-no-properties line-start (point))) |
| 3259 | (buffer-substring-no-properties last-prompt-end (point)))) | 3265 | (buffer-substring-no-properties line-start (point)))) |
| 3260 | (start | 3266 | (start |
| 3261 | (save-excursion | 3267 | (save-excursion |
| 3262 | (if (not (re-search-backward | 3268 | (if (not (re-search-backward |
| 3263 | (python-rx | 3269 | (python-rx |
| 3264 | (or whitespace open-paren close-paren string-delimiter)) | 3270 | (or whitespace open-paren close-paren string-delimiter)) |
| 3265 | last-prompt-end | 3271 | line-start |
| 3266 | t 1)) | 3272 | t 1)) |
| 3267 | last-prompt-end | 3273 | line-start |
| 3268 | (forward-char (length (match-string-no-properties 0))) | 3274 | (forward-char (length (match-string-no-properties 0))) |
| 3269 | (point)))) | 3275 | (point)))) |
| 3270 | (end (point)) | 3276 | (end (point)) |
| @@ -3847,8 +3853,10 @@ The skeleton will be bound to python-skeleton-NAME." | |||
| 3847 | :type 'string | 3853 | :type 'string |
| 3848 | :group 'python) | 3854 | :group 'python) |
| 3849 | 3855 | ||
| 3850 | (defvar-local python-check-custom-command nil | 3856 | (defvar python-check-custom-command nil |
| 3851 | "Internal use.") | 3857 | "Internal use.") |
| 3858 | ;; XXX: Avoid `defvar-local' for compat with Emacs<24.3 | ||
| 3859 | (make-variable-buffer-local 'python-check-custom-command) | ||
| 3852 | 3860 | ||
| 3853 | (defun python-check (command) | 3861 | (defun python-check (command) |
| 3854 | "Check a Python file (default current buffer's file). | 3862 | "Check a Python file (default current buffer's file). |
| @@ -3917,15 +3925,29 @@ See `python-check-command' for the default." | |||
| 3917 | :type 'string | 3925 | :type 'string |
| 3918 | :group 'python) | 3926 | :group 'python) |
| 3919 | 3927 | ||
| 3928 | (defun python-eldoc--get-symbol-at-point () | ||
| 3929 | "Get the current symbol for eldoc. | ||
| 3930 | Returns the current symbol handling point within arguments." | ||
| 3931 | (save-excursion | ||
| 3932 | (let ((start (python-syntax-context 'paren))) | ||
| 3933 | (when start | ||
| 3934 | (goto-char start)) | ||
| 3935 | (when (or start | ||
| 3936 | (eobp) | ||
| 3937 | (memq (char-syntax (char-after)) '(?\ ?-))) | ||
| 3938 | ;; Try to adjust to closest symbol if not in one. | ||
| 3939 | (python-util-forward-comment -1))) | ||
| 3940 | (python-info-current-symbol t))) | ||
| 3941 | |||
| 3920 | (defun python-eldoc--get-doc-at-point (&optional force-input force-process) | 3942 | (defun python-eldoc--get-doc-at-point (&optional force-input force-process) |
| 3921 | "Internal implementation to get documentation at point. | 3943 | "Internal implementation to get documentation at point. |
| 3922 | If not FORCE-INPUT is passed then what `python-info-current-symbol' | 3944 | If not FORCE-INPUT is passed then what `python-eldoc--get-symbol-at-point' |
| 3923 | returns will be used. If not FORCE-PROCESS is passed what | 3945 | returns will be used. If not FORCE-PROCESS is passed what |
| 3924 | `python-shell-get-process' returns is used." | 3946 | `python-shell-get-process' returns is used." |
| 3925 | (let ((process (or force-process (python-shell-get-process)))) | 3947 | (let ((process (or force-process (python-shell-get-process)))) |
| 3926 | (when process | 3948 | (when process |
| 3927 | (let ((input (or force-input | 3949 | (let ((input (or force-input |
| 3928 | (python-info-current-symbol t)))) | 3950 | (python-eldoc--get-symbol-at-point)))) |
| 3929 | (and input | 3951 | (and input |
| 3930 | ;; Prevent resizing the echo area when iPython is | 3952 | ;; Prevent resizing the echo area when iPython is |
| 3931 | ;; enabled. Bug#18794. | 3953 | ;; enabled. Bug#18794. |
| @@ -3945,7 +3967,7 @@ inferior Python process is updated properly." | |||
| 3945 | "Get help on SYMBOL using `help'. | 3967 | "Get help on SYMBOL using `help'. |
| 3946 | Interactively, prompt for symbol." | 3968 | Interactively, prompt for symbol." |
| 3947 | (interactive | 3969 | (interactive |
| 3948 | (let ((symbol (python-info-current-symbol t)) | 3970 | (let ((symbol (python-eldoc--get-symbol-at-point)) |
| 3949 | (enable-recursive-minibuffers t)) | 3971 | (enable-recursive-minibuffers t)) |
| 3950 | (list (read-string (if symbol | 3972 | (list (read-string (if symbol |
| 3951 | (format "Describe symbol (default %s): " symbol) | 3973 | (format "Describe symbol (default %s): " symbol) |
| @@ -3954,6 +3976,17 @@ Interactively, prompt for symbol." | |||
| 3954 | (message (python-eldoc--get-doc-at-point symbol))) | 3976 | (message (python-eldoc--get-doc-at-point symbol))) |
| 3955 | 3977 | ||
| 3956 | 3978 | ||
| 3979 | ;;; Hideshow | ||
| 3980 | |||
| 3981 | (defun python-hideshow-forward-sexp-function (arg) | ||
| 3982 | "Python specific `forward-sexp' function for `hs-minor-mode'. | ||
| 3983 | Argument ARG is ignored." | ||
| 3984 | arg ; Shut up, byte compiler. | ||
| 3985 | (python-nav-end-of-defun) | ||
| 3986 | (unless (python-info-current-line-empty-p) | ||
| 3987 | (backward-char))) | ||
| 3988 | |||
| 3989 | |||
| 3957 | ;;; Imenu | 3990 | ;;; Imenu |
| 3958 | 3991 | ||
| 3959 | (defvar python-imenu-format-item-label-function | 3992 | (defvar python-imenu-format-item-label-function |
| @@ -4682,14 +4715,23 @@ Arguments START and END narrow the buffer region to work on." | |||
| 4682 | (current-column)))) | 4715 | (current-column)))) |
| 4683 | (^ '(- (1+ (current-indentation)))))) | 4716 | (^ '(- (1+ (current-indentation)))))) |
| 4684 | 4717 | ||
| 4685 | (add-function :before-until (local 'eldoc-documentation-function) | 4718 | (if (null eldoc-documentation-function) |
| 4686 | #'python-eldoc-function) | 4719 | ;; Emacs<25 |
| 4687 | 4720 | (setq (make-local-variable 'eldoc-documentation-function) | |
| 4688 | (add-to-list 'hs-special-modes-alist | 4721 | #'python-eldoc-function) |
| 4689 | `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#" | 4722 | (add-function :before-until (local 'eldoc-documentation-function) |
| 4690 | ,(lambda (_arg) | 4723 | #'python-eldoc-function)) |
| 4691 | (python-nav-end-of-defun)) | 4724 | |
| 4692 | nil)) | 4725 | (add-to-list |
| 4726 | 'hs-special-modes-alist | ||
| 4727 | `(python-mode | ||
| 4728 | "\\s-*\\(?:def\\|class\\)\\>" | ||
| 4729 | ;; Use the empty string as end regexp so it doesn't default to | ||
| 4730 | ;; "\\s)". This way parens at end of defun are properly hidden. | ||
| 4731 | "" | ||
| 4732 | "#" | ||
| 4733 | python-hideshow-forward-sexp-function | ||
| 4734 | nil)) | ||
| 4693 | 4735 | ||
| 4694 | (set (make-local-variable 'outline-regexp) | 4736 | (set (make-local-variable 'outline-regexp) |
| 4695 | (python-rx (* space) block-start)) | 4737 | (python-rx (* space) block-start)) |
diff --git a/lisp/subr.el b/lisp/subr.el index 68cd230c5e2..deadca6efa0 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -136,8 +136,8 @@ ARGS is a list of the first N arguments to pass to FUN. | |||
| 136 | The result is a new function which does the same as FUN, except that | 136 | The result is a new function which does the same as FUN, except that |
| 137 | the first N arguments are fixed at the values with which this function | 137 | the first N arguments are fixed at the values with which this function |
| 138 | was called." | 138 | was called." |
| 139 | `(closure (t) (&rest args) | 139 | (lambda (&rest args2) |
| 140 | (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args))) | 140 | (apply fun (append args args2)))) |
| 141 | 141 | ||
| 142 | (defmacro push (newelt place) | 142 | (defmacro push (newelt place) |
| 143 | "Add NEWELT to the list stored in the generalized variable PLACE. | 143 | "Add NEWELT to the list stored in the generalized variable PLACE. |
| @@ -316,7 +316,7 @@ Defaults to `error'." | |||
| 316 | (unless parent (setq parent 'error)) | 316 | (unless parent (setq parent 'error)) |
| 317 | (let ((conditions | 317 | (let ((conditions |
| 318 | (if (consp parent) | 318 | (if (consp parent) |
| 319 | (apply #'nconc | 319 | (apply #'append |
| 320 | (mapcar (lambda (parent) | 320 | (mapcar (lambda (parent) |
| 321 | (cons parent | 321 | (cons parent |
| 322 | (or (get parent 'error-conditions) | 322 | (or (get parent 'error-conditions) |
| @@ -1274,6 +1274,7 @@ is converted into a string by expressing it in decimal." | |||
| 1274 | (set-advertised-calling-convention | 1274 | (set-advertised-calling-convention |
| 1275 | 'all-completions '(string collection &optional predicate) "23.1") | 1275 | 'all-completions '(string collection &optional predicate) "23.1") |
| 1276 | (set-advertised-calling-convention 'unintern '(name obarray) "23.3") | 1276 | (set-advertised-calling-convention 'unintern '(name obarray) "23.3") |
| 1277 | (set-advertised-calling-convention 'indirect-function '(object) "25.1") | ||
| 1277 | (set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3") | 1278 | (set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3") |
| 1278 | (set-advertised-calling-convention 'decode-char '(ch charset) "21.4") | 1279 | (set-advertised-calling-convention 'decode-char '(ch charset) "21.4") |
| 1279 | (set-advertised-calling-convention 'encode-char '(ch charset) "21.4") | 1280 | (set-advertised-calling-convention 'encode-char '(ch charset) "21.4") |
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index c171bd50f62..f6a3ca64dd9 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*- | 1 | ;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2006-2015 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2006-2015 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -401,11 +401,16 @@ | |||
| 401 | (cond | 401 | (cond |
| 402 | ;; This is a false positive inside a string or comment. | 402 | ;; This is a false positive inside a string or comment. |
| 403 | ((nth 8 (syntax-ppss)) nil) | 403 | ((nth 8 (syntax-ppss)) nil) |
| 404 | ;; This is a false positive when encountering an | ||
| 405 | ;; interpolated variable (bug#19751). | ||
| 406 | ((eq (char-before (- (point) 1)) ?#) nil) | ||
| 404 | ((eq (char-before) ?\}) | 407 | ((eq (char-before) ?\}) |
| 405 | (save-excursion | 408 | (save-excursion |
| 406 | (forward-char -1) | 409 | (forward-char -1) |
| 407 | (skip-chars-backward " \t") | 410 | (skip-chars-backward " \t") |
| 408 | (unless (bolp) (newline)))) | 411 | (when (and (not (bolp)) |
| 412 | (scss-smie--not-interpolation-p)) | ||
| 413 | (newline)))) | ||
| 409 | (t | 414 | (t |
| 410 | (while | 415 | (while |
| 411 | (progn | 416 | (progn |
| @@ -450,7 +455,7 @@ | |||
| 450 | (defun scss-smie--not-interpolation-p () | 455 | (defun scss-smie--not-interpolation-p () |
| 451 | (save-excursion | 456 | (save-excursion |
| 452 | (forward-char -1) | 457 | (forward-char -1) |
| 453 | (or (zerop (skip-chars-backward "[:alnum:]")) | 458 | (or (zerop (skip-chars-backward "-[:alnum:]")) |
| 454 | (not (looking-back "#{\\$" (- (point) 3)))))) | 459 | (not (looking-back "#{\\$" (- (point) 3)))))) |
| 455 | 460 | ||
| 456 | ;;;###autoload (add-to-list 'auto-mode-alist '("\\.scss\\'" . scss-mode)) | 461 | ;;;###autoload (add-to-list 'auto-mode-alist '("\\.scss\\'" . scss-mode)) |
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index d803c16d7cf..707090a10eb 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el | |||
| @@ -1076,7 +1076,7 @@ Query all files in DIR if files is nil." | |||
| 1076 | (if (and (not files) local (not (eq local 'only-file))) | 1076 | (if (and (not files) local (not (eq local 'only-file))) |
| 1077 | (vc-cvs-dir-status-heuristic dir update-function) | 1077 | (vc-cvs-dir-status-heuristic dir update-function) |
| 1078 | (if (not files) (setq files (vc-expand-dirs (list dir) 'CVS))) | 1078 | (if (not files) (setq files (vc-expand-dirs (list dir) 'CVS))) |
| 1079 | (vc-cvs-command (current-buffer) 'async dir "-f" "status" files) | 1079 | (vc-cvs-command (current-buffer) 'async files "-f" "status") |
| 1080 | ;; Alternative implementation: use the "update" command instead of | 1080 | ;; Alternative implementation: use the "update" command instead of |
| 1081 | ;; the "status" command. | 1081 | ;; the "status" command. |
| 1082 | ;; (vc-cvs-command (current-buffer) 'async | 1082 | ;; (vc-cvs-command (current-buffer) 'async |