diff options
| author | Joakim Verona <joakim@verona.se> | 2015-02-08 21:55:28 +0100 |
|---|---|---|
| committer | Joakim Verona <joakim@verona.se> | 2015-02-08 21:55:28 +0100 |
| commit | 5e1d5ef39ca0d2fbff26d659f2ec6ce863b14529 (patch) | |
| tree | 860e0d53399626aee6249ebb5f972879f403b228 /lisp | |
| parent | 148262ce3db990ed16989341345e232570b3a338 (diff) | |
| parent | 7d631aa0ffab875e4979727f632703ad5b4100a2 (diff) | |
| download | emacs-xwidget.tar.gz | |
merge masterxwidget
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 @@ +2015-02-08 Artur Malabarba <bruce.connor.am@gmail.com> + + * newcomment.el (comment-line): Fix missing paren. + +2015-02-08 Ulrich Müller <ulm@gentoo.org> + + * play/gamegrid.el: Update comment to reflect that the + 'update-game-score' helper program is now setgid by default. + +2015-02-08 David Kastrup <dak@gnu.org> + + * subr.el (apply-partially): Use lexical binding here. + +2015-02-08 Artur Malabarba <bruce.connor.am@gmail.com> + + * newcomment.el (comment-line): New command. + + * bindings.el (ctl-x-map): Bind to `C-x C-;'. + +2015-02-08 Oleh Krehel <ohwoeowho@gmail.com> + + * outline.el (outline-show-entry): Fix one invisible char for the + file's last outline. Fixes Bug#19493. + +2015-02-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (indirect-function): Change advertised calling convention. + +2015-02-08 Fabián Ezequiel Gallina <fgallina@gnu.org> + + python.el: Fix completion-at-point. (Bug#19667) + + * progmodes/python.el + (python-shell-completion-native-get-completions): Force process buffer. + (python-shell-completion-at-point): Handle case where call is not + in a shell buffer. + +2015-02-08 Fabián Ezequiel Gallina <fgallina@gnu.org> + + python.el: Fix shell font-lock multiline input. (Bug#19744) + + * progmodes/python.el + (python-shell-font-lock-post-command-hook): Handle multiline input. + +2015-02-08 Fabián Ezequiel Gallina <fgallina@gnu.org> + + python.el: Make shell font-lock respect markers. (Bug#19650) + + * progmodes/python.el (python-shell-font-lock-cleanup-buffer): + Use `erase-buffer`. + (python-shell-font-lock-comint-output-filter-function): + Handle newlines. + (python-shell-font-lock-post-command-hook): Respect markers on + text fontification. + +2015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org> + + python.el: Keep eldoc visible while typing args. (Bug#19637) + + * progmodes/python.el (python-eldoc--get-symbol-at-point): + New function based on Carlos Pita <carlosjosepita@gmail.com> patch. + (python-eldoc--get-doc-at-point, python-eldoc-at-point): Use it. + +2015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org> + + Fix hideshow integration. (Bug#19761) + + * progmodes/python.el + (python-hideshow-forward-sexp-function): New function based on + Carlos Pita <carlosjosepita@gmail.com> patch. + (python-mode): Make `hs-special-modes-alist` use it and initialize + the end regexp with the empty string to avoid skipping parens. + +2015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (python-check-custom-command): Do not use + defvar-local for compat with Emacs<24.3. + +2015-02-07 Martin Rudalics <rudalics@gmx.at> + + * frame.el (frame-notice-user-settings): + Update `frame-size-history'. + (make-frame): Update `frame-size-history'. + Call `frame-after-make-frame'. + * faces.el (face-set-after-frame-default): Remove call to + frame-can-run-window-configuration-change-hook. + +2015-02-06 Dmitry Gutov <dgutov@yandex.ru> + + * vc/vc-cvs.el (vc-cvs-dir-status-files): Don't pass DIR to + `vc-cvs-command' (bug#19732). + +2015-02-06 Nicolas Petton <nicolas@petton.fr> + + * emacs-lisp/seq.el (seq-mapcat, seq-partition, seq-group-by): New functions. + * emacs-lisp/seq.el (seq-drop-while, seq-take-while, seq-count) + (seq--drop-list, seq--take-list, seq--take-while-list): Better docstring. + +2015-02-06 Artur Malabarba <bruce.connor.am@gmail.com> + + * doc-view.el (doc-view-kill-proc-and-buffer): Obsolete. Use + `image-kill-buffer' instead. + +2015-02-06 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ldap.el (ldap-search-internal): Fix docstring. + +2015-02-06 Lars Ingebrigtsen <larsi@gnus.org> + + * subr.el (define-error): The error conditions may be constant + lists, so use `append' to concatenate them. + +2015-02-06 Wolfgang Jenkner <wjenkner@inode.at> + + * net/network-stream.el (network-stream-open-tls): Respect the + :end-of-capability setting. + +2015-02-05 Artur Malabarba <bruce.connor.am@gmail.com> + + * emacs-lisp/package.el (package--sort-by-dependence): + New function. Return PACKAGE-LIST sorted by dependencies. + (package-menu-execute): Use it to delete packages in order. + (package--sort-deps-in-alist): New function. + (package-menu-mark-install): Can mark dependencies. + (package--newest-p): New function. + (package-delete): Don't delesect when deleting an older version of + an upgraded package. + + * emacs-lisp/package.el: Add missing (require 'subr-x) + +2015-02-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/css-mode.el (scss-smie--not-interpolation-p): Vars can be + hyphenated (bug#19263). + + * textmodes/css-mode.el (css-fill-paragraph): Fix filling in presence + of variable interpolation (bug#19751). + +2015-02-05 Era Eriksson <era+emacs@iki.fi> + + * json.el (json-end-of-file): New error (bug#19768). + (json-pop, json-read): Use it. + +2015-02-05 Kelly Dean <kelly@prtime.org> + + * help-mode.el (help-xref-interned): Pass BUFFER and FRAME to + `describe-variable'. + + * help-fns.el (describe-function-or-variable): New function. + + * help.el (help-map): Bind `describe-function-or-variable' to o. + (help-for-help-internal): Document o key. + +2015-02-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio-compat.el (eieio--defmethod): Use new + special (:documentation ...) feature. + * emacs-lisp/eieio-core.el (eieio-make-class-predicate) + (eieio-make-child-predicate): Same. + (eieio-copy-parents-into-subclass): Remove unused arg. + (eieio-defclass-internal): Adjust call accordingly and remove redundant + `pname' var. + (eieio--slot-name-index): Remove unused arg `obj' and adjust all + callers accordingly. + + * emacs-lisp/cconv.el (cconv--convert-function): + Add `docstring' argument. + (cconv-convert): Use it to handle the new (:documentation ...) form. + (cconv-analyze-form): Handle the new (:documentation ...) form. + + * emacs-lisp/bytecomp.el: + (byte-compile-initial-macro-environment): Use macroexp-progn. + (byte-compile-cl-warn): Don't silence use of cl-macroexpand-all. + (byte-compile-file-form-defvar-function): Rename from + byte-compile-file-form-define-abbrev-table. + (defvaralias, byte-compile-file-form-custom-declare-variable): Use it. + (byte-compile): Use byte-compile-top-level rather than + byte-compile-lambda so we can compile non-values. + (byte-compile-form): Add warnings for failed uses of lexical vars via + quoted symbols. + (byte-compile-unfold-bcf): Improve message for failed inlining. + (byte-compile-make-closure): Handle new format of internal-make-closure + for dynamically-generated docstrings. + + * delsel.el: Deprecate the `kill' option. Use lexical-binding. + (open-line): Delete like all other commands, instead of killing. + (delete-active-region): Don't define any return any value. + + * progmodes/python.el: Try to preserve compatibility with Emacs-24. + (python-mode): Don't assume eldoc-documentation-function has a non-nil + default. + +2015-02-04 Sam Steingold <sds@gnu.org> + + * progmodes/python.el (python-indent-calculate-indentation): + Avoid the error when computing top-level indentation. + 2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/cl-generic.el (cl--generic-member-method): Fix paren typo. @@ -14,6 +211,9 @@ 2015-02-04 Artur Malabarba <bruce.connor.am@gmail.com> + * image-mode.el (image-kill-buffer): New command. + (image-mode-map): Bind it to k. + * emacs-lisp/package.el (package-delete): Remove package from `package-selected-packages' even if it can't be deleted. (package-installed-p): Accept package-desc objects. @@ -14330,7 +14530,7 @@ Change default to "# encoding: %s" to differentiate it from the default Ruby encoding comment template. -2013-11-20 era eriksson <era+emacsbugs@iki.fi> +2013-11-20 Era Eriksson <era+emacsbugs@iki.fi> * ses.el (ses-mode): Doc fix. (Bug#14748) 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." (define-key esc-map "j" 'indent-new-comment-line) (define-key esc-map "\C-j" 'indent-new-comment-line) (define-key ctl-x-map ";" 'comment-set-column) +(define-key ctl-x-map "C-;" 'comment-line) (define-key ctl-x-map "f" 'set-fill-column) (define-key ctl-x-map "$" 'set-selective-display) 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 @@ -;;; delsel.el --- delete selection if you insert +;;; delsel.el --- delete selection if you insert -*- lexical-binding:t -*- ;; Copyright (C) 1992, 1997-1998, 2001-2015 Free Software Foundation, ;; Inc. @@ -35,16 +35,12 @@ ;; property on their symbols; commands which insert text but don't ;; have this property won't delete the selection. It can be one of ;; the values: -;; 'yank +;; `yank' ;; For commands which do a yank; ensures the region about to be ;; deleted isn't yanked. -;; 'supersede +;; `supersede' ;; Delete the active region and ignore the current command, ;; i.e. the command will just delete the region. -;; 'kill -;; `kill-region' is used on the selection, rather than -;; `delete-region'. (Text selected with the mouse will typically -;; be yankable anyhow.) ;; t ;; The normal case: delete the active region prior to executing ;; the command which will insert replacement text. @@ -93,8 +89,7 @@ If KILLP in not-nil, the active region is killed instead of deleted." (cons (current-buffer) (and (consp buffer-undo-list) (car buffer-undo-list))))) (t - (funcall region-extract-function 'delete-only))) - t) + (funcall region-extract-function 'delete-only)))) (defun delete-selection-repeat-replace-region (arg) "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." For commands which need to dynamically determine this behavior. FUNCTION should take no argument and return one of the above values or nil." (condition-case data - (cond ((eq type 'kill) + (cond ((eq type 'kill) ;Deprecated, backward compatibility. (delete-active-region t) (if (and overwrite-mode (eq this-command 'self-insert-command)) @@ -255,7 +250,7 @@ See `delete-selection-helper'." (put 'newline-and-indent 'delete-selection t) (put 'newline 'delete-selection t) (put 'electric-newline-and-maybe-indent 'delete-selection t) -(put 'open-line 'delete-selection 'kill) +(put 'open-line 'delete-selection t) ;; This is very useful for canceling a selection in the minibuffer without ;; 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\".") (define-key map "H" 'doc-view-fit-height-to-window) (define-key map "P" 'doc-view-fit-page-to-window) ;; Killing the buffer (and the process) - (define-key map (kbd "k") 'doc-view-kill-proc-and-buffer) (define-key map (kbd "K") 'doc-view-kill-proc) ;; Slicing the image (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." (setq doc-view--current-timer nil)) (setq mode-line-process nil)) -(defun doc-view-kill-proc-and-buffer () - "Kill the current converter process and buffer." - (interactive) - (doc-view-kill-proc) - (when (eq major-mode 'doc-view-mode) - (kill-buffer (current-buffer)))) +(define-obsolete-function-alias 'doc-view-kill-proc-and-buffer + #'image-kill-buffer "25.1") (defun doc-view-make-safe-dir (dir) (condition-case nil @@ -1685,6 +1680,9 @@ If BACKWARD is non-nil, jump to the previous match." ;; desktop.el integration (defun doc-view-desktop-save-buffer (_desktop-dirname) + ;; FIXME: This is wrong, since this info is per-window but we only do it once + ;; here for the buffer. IOW it should be saved via something like + ;; `window-persistent-parameters'. `((page . ,(doc-view-current-page)) (slice . ,(doc-view-current-slice)))) @@ -1695,8 +1693,13 @@ If BACKWARD is non-nil, jump to the previous match." (let ((page (cdr (assq 'page misc))) (slice (cdr (assq 'slice misc)))) (desktop-restore-file-buffer file name misc) + ;; FIXME: We need to run this code after displaying the buffer. (with-selected-window (or (get-buffer-window (current-buffer) 0) (selected-window)) + ;; FIXME: This should be done for all windows restored that show + ;; this buffer. Basically, the page/slice should be saved as + ;; window-parameters in the window-state(s) and then restoring this + ;; window-state should call us back (to interpret/use those parameters). (doc-view-goto-page page) (when slice (apply 'doc-view-set-slice slice))))) 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 @@ ;; faster. [`LAP' == `Lisp Assembly Program'.] ;; The user entry points are byte-compile-file and byte-recompile-directory. +;;; Todo: + +;; - Turn "not bound at runtime" functions into autoloads. + ;;; Code: ;; ======================================================================== @@ -450,7 +454,7 @@ Return the compile-time value of FORM." (eval-when-compile . ,(lambda (&rest body) (let ((result nil)) (byte-compile-recurse-toplevel - (cons 'progn body) + (macroexp-progn body) (lambda (form) (setf result (byte-compile-eval @@ -459,7 +463,7 @@ Return the compile-time value of FORM." (list 'quote result)))) (eval-and-compile . ,(lambda (&rest body) (byte-compile-recurse-toplevel - (cons 'progn body) + (macroexp-progn body) (lambda (form) ;; Don't compile here, since we don't know ;; whether to compile as byte-compile-form @@ -1458,7 +1462,7 @@ extra args." ;; These would sometimes be warned about ;; but such warnings are never useful, ;; so don't warn about them. - macroexpand cl-macroexpand-all + macroexpand cl--compiling-file)))) (byte-compile-warn "function `%s' from cl package called at runtime" func))) @@ -2319,10 +2323,12 @@ list that represents a doc string reference. form)) (put 'define-abbrev-table 'byte-hunk-handler - 'byte-compile-file-form-define-abbrev-table) -(defun byte-compile-file-form-define-abbrev-table (form) - (if (eq 'quote (car-safe (car-safe (cdr form)))) - (byte-compile--declare-var (car-safe (cdr (cadr form))))) + 'byte-compile-file-form-defvar-function) +(put 'defvaralias 'byte-hunk-handler 'byte-compile-file-form-defvar-function) + +(defun byte-compile-file-form-defvar-function (form) + (pcase-let (((or `',name (let name nil)) (nth 1 form))) + (if name (byte-compile--declare-var name))) (byte-compile-keep-pending form)) (put 'custom-declare-variable 'byte-hunk-handler @@ -2330,8 +2336,7 @@ list that represents a doc string reference. (defun byte-compile-file-form-custom-declare-variable (form) (when (byte-compile-warning-enabled-p 'callargs) (byte-compile-nogroup-warn form)) - (byte-compile--declare-var (nth 1 (nth 1 form))) - (byte-compile-keep-pending form)) + (byte-compile-file-form-defvar-function form)) (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) (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." fun) (t (when (symbolp form) - (unless (memq (car-safe fun) '(closure lambda)) - (error "Don't know how to compile %S" fun)) (setq lexical-binding (eq (car fun) 'closure)) (setq fun (byte-compile--reify-function fun))) - (unless (eq (car-safe fun) 'lambda) - (error "Don't know how to compile %S" fun)) ;; Expand macros. (setq fun (byte-compile-preprocess fun)) - ;; Get rid of the `function' quote added by the `lambda' macro. - (if (eq (car-safe fun) 'function) (setq fun (cadr fun))) - (setq fun (byte-compile-lambda fun)) + (setq fun (byte-compile-top-level fun nil 'eval)) (if macro (push 'macro fun)) (if (symbolp form) (fset form fun) @@ -2966,6 +2965,16 @@ for symbols generated by the byte compiler itself." (interactive-only (or (get fn 'interactive-only) (memq fn byte-compile-interactive-only-functions)))) + (when (memq fn '(set symbol-value run-hooks ;; add-to-list + add-hook remove-hook run-hook-with-args + run-hook-with-args-until-success + run-hook-with-args-until-failure)) + (pcase (cdr form) + (`(',var . ,_) + (when (assq var byte-compile-lexical-variables) + (byte-compile-log-warning + (format "%s cannot use lexical var `%s'" fn var) + nil :error))))) (when (macroexp--const-symbol-p fn) (byte-compile-warn "`%s' called as a function" fn)) (when (and (byte-compile-warning-enabled-p 'interactive-only) @@ -3079,8 +3088,9 @@ for symbols generated by the byte compiler itself." (dotimes (_ (- (/ (1+ fmax2) 2) alen)) (byte-compile-push-constant nil))) ((zerop (logand fmax2 1)) - (byte-compile-log-warning "Too many arguments for inlined function" - nil :error) + (byte-compile-log-warning + (format "Too many arguments for inlined function %S" form) + nil :error) (byte-compile-discard (- alen (/ fmax2 2)))) (t ;; Turn &rest args into a list. @@ -3453,15 +3463,22 @@ discarding." (if byte-compile--for-effect (setq byte-compile--for-effect nil) (let* ((vars (nth 1 form)) (env (nth 2 form)) - (body (nthcdr 3 form)) + (docstring-exp (nth 3 form)) + (body (nthcdr 4 form)) (fun (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) - (cl-assert (> (length env) 0)) ;Otherwise, we don't need a closure. + (cl-assert (or (> (length env) 0) + docstring-exp)) ;Otherwise, we don't need a closure. (cl-assert (byte-code-function-p fun)) (byte-compile-form `(make-byte-code ',(aref fun 0) ',(aref fun 1) (vconcat (vector . ,env) ',(aref fun 2)) - ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun))))))) + ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun)))) + (if docstring-exp + `(,(car rest) + ,docstring-exp + ,@(cddr rest)) + rest))))))) (defun byte-compile-get-closed-var (form) "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 @@ ;; if the function is suitable for lambda lifting (if all calls are known) ;; ;; (lambda (v0 ...) ... fv0 .. fv1 ...) => -;; (internal-make-closure (v0 ...) (fv1 ...) +;; (internal-make-closure (v0 ...) (fv0 ...) <doc> ;; ... (internal-get-closed-var 0) ... (internal-get-closed-var 1) ...) ;; ;; If the function has no free variables, we don't do anything. @@ -65,6 +65,14 @@ ;; ;;; Code: +;; PROBLEM cases found during conversion to lexical binding. +;; We should try and detect and warn about those cases, even +;; for lexical-binding==nil to help prepare the migration. +;; - Uses of run-hooks, and friends. +;; - Cases where we want to apply the same code to different vars depending on +;; some test. These sometimes use a (let ((foo (if bar 'a 'b))) +;; ... (symbol-value foo) ... (set foo ...)). + ;; TODO: (not just for cconv but also for the lexbind changes in general) ;; - let (e)debug find the value of lexical variables from the stack. ;; - make eval-region do the eval-sexp-add-defvars dance. @@ -87,9 +95,8 @@ ;; the bytecomp only compiles it once. ;; - Since we know here when a variable is not mutated, we could pass that ;; info to the byte-compiler, e.g. by using a new `immutable-let'. -;; - add tail-calls to bytecode.c and the byte compiler. ;; - call known non-escaping functions with `goto' rather than `call'. -;; - optimize mapcar to a while loop. +;; - optimize mapc to a dolist loop. ;; (defmacro dlet (binders &rest body) ;; ;; Works in both lexical and non-lexical mode. @@ -195,7 +202,7 @@ Returns a form where all lambdas don't have any free variables." (unless (memq (car b) s) (push b res))) (nreverse res))) -(defun cconv--convert-function (args body env parentform) +(defun cconv--convert-function (args body env parentform &optional docstring) (cl-assert (equal body (caar cconv-freevars-alist))) (let* ((fvs (cdr (pop cconv-freevars-alist))) (body-new '()) @@ -240,11 +247,11 @@ Returns a form where all lambdas don't have any free variables." `(,@(nreverse special-forms) (let ,letbind . ,body-new))))) (cond - ((null envector) ;if no freevars - do nothing + ((not (or envector docstring)) ;If no freevars - do nothing. `(function (lambda ,args . ,body-new))) (t `(internal-make-closure - ,args ,envector . ,body-new))))) + ,args ,envector ,docstring . ,body-new))))) (defun cconv-convert (form env extend) ;; This function actually rewrites the tree. @@ -407,7 +414,9 @@ places where they originally did not directly appear." cond-forms))) (`(function (lambda ,args . ,body) . ,_) - (cconv--convert-function args body env form)) + (let ((docstring (if (eq :documentation (car-safe (car body))) + (cconv-convert (cadr (pop body)) env extend)))) + (cconv--convert-function args body env form docstring))) (`(internal-make-closure . ,_) (byte-compile-report-error @@ -533,7 +542,7 @@ FORM is the parent form that binds this var." ;; use = `(,binder ,read ,mutated ,captured ,called) (pcase vardata (`(,_ nil nil nil nil) nil) - (`((,(and (pred (lambda (var) (eq ?_ (aref (symbol-name var) 0)))) var) . ,_) + (`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_) ,_ ,_ ,_ ,_) (byte-compile-log-warning (format "%s `%S' not left unused" varkind var)))) @@ -643,6 +652,8 @@ and updates the data stored in ENV." (cconv--analyze-use vardata form "variable")))) (`(function (lambda ,vrs . ,body-forms)) + (when (eq :documentation (car-safe (car body-forms))) + (cconv-analyze-form (cadr (pop body-forms)) env)) (cconv--analyze-function vrs body-forms env form)) (`(setq . ,forms) @@ -665,6 +676,10 @@ and updates the data stored in ENV." (dolist (forms cond-forms) (dolist (form forms) (cconv-analyze-form form env)))) + ;; ((and `(quote ,v . ,_) (guard (assq v env))) + ;; (byte-compile-log-warning + ;; (format "Possible confusion variable/symbol for `%S'" v))) + (`(quote . ,_) nil) ; quote form (`(function . ,_) nil) ; same as quote 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. Second, any text properties will be stripped from strings." (cond ((consp proposed-value) ;; Lists with something in them need special treatment. - (let ((slot-idx (eieio--slot-name-index class - nil slot)) + (let ((slot-idx (eieio--slot-name-index class slot)) (type nil) (classtype nil)) (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: (args (help-function-arglist code 'preserve-names)) (doc-only (if docstring (let ((split (help-split-fundoc docstring nil))) - (if split (cdr split) docstring)))) - (new-docstring (help-add-fundoc-usage doc-only - (cons 'cl-cnm args)))) - ;; FIXME: ¡Add new-docstring to those closures! + (if split (cdr split) docstring))))) (lambda (cnm &rest args) + (:documentation + (help-add-fundoc-usage doc-only (cons 'cl-cnm args))) (cl-letf (((symbol-function 'call-next-method) cnm) ((symbol-function 'next-method-p) (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." (defun eieio-make-class-predicate (class) (lambda (obj) - ;; (:docstring (format "Test OBJ to see if it's an object of type %S." - ;; class)) + (:documentation + (format "Return non-nil if OBJ is an object of type `%S'.\n\n(fn OBJ)" + class)) (and (eieio-object-p obj) (same-class-p obj class)))) (defun eieio-make-child-predicate (class) (lambda (obj) - ;; (:docstring (format - ;; "Test OBJ to see if it's an object is a child of type %S." - ;; class)) + (:documentation + (format "Return non-nil if OBJ is an object of type `%S' or a subclass. +\n(fn OBJ)" class)) (and (eieio-object-p obj) (object-of-class-p obj class)))) @@ -312,8 +313,7 @@ See `defclass' for more information." (run-hooks 'eieio-hook) (setq eieio-hook nil) - (let* ((pname superclasses) - (oldc (let ((c (eieio--class-v cname))) (if (eieio--class-p c) c))) + (let* ((oldc (let ((c (eieio--class-v cname))) (if (eieio--class-p c) c))) (newc (if (and oldc (not (eieio--class-default-object-cache oldc))) ;; The oldc class is a stub setup by eieio-defclass-autoload. ;; Reuse it instead of creating a new one, so that existing @@ -338,9 +338,9 @@ See `defclass' for more information." (setf (eieio--class-children newc) children) (remhash cname eieio-defclass-autoload-map)))) - (if pname + (if superclasses (progn - (dolist (p pname) + (dolist (p superclasses) (if (not (and p (symbolp p))) (error "Invalid parent class %S" p) (let ((c (eieio--class-v p))) @@ -396,7 +396,7 @@ See `defclass' for more information." ;; Before adding new slots, let's add all the methods and classes ;; in from the parent class. - (eieio-copy-parents-into-subclass newc superclasses) + (eieio-copy-parents-into-subclass newc) ;; Store the new class vector definition into the symbol. We need to ;; do this first so that we can call defmethod for the accessor. @@ -784,7 +784,7 @@ if default value is nil." )) )) -(defun eieio-copy-parents-into-subclass (newc _parents) +(defun eieio-copy-parents-into-subclass (newc) "Copy into NEWC the slots of PARENTS. Follow the rules of not overwriting early parents when applying to the new child class." @@ -911,7 +911,7 @@ Argument FN is the function calling this verifier." (if (eieio--class-p c) (eieio-class-un-autoload obj)) c)) (t (eieio--object-class-object obj)))) - (c (eieio--slot-name-index class obj slot))) + (c (eieio--slot-name-index class slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. @@ -935,7 +935,7 @@ Fills in OBJ's SLOT with its default value." (cl-check-type slot symbol) (let* ((cl (cond ((symbolp obj) (eieio--class-v obj)) (t (eieio--object-class-object obj)))) - (c (eieio--slot-name-index cl obj slot))) + (c (eieio--slot-name-index cl slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. @@ -973,7 +973,7 @@ Fills in OBJ's SLOT with VALUE." (cl-check-type obj eieio-object) (cl-check-type slot symbol) (let* ((class (eieio--object-class-object obj)) - (c (eieio--slot-name-index class obj slot))) + (c (eieio--slot-name-index class slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. @@ -997,7 +997,7 @@ Fills in the default value in CLASS' in SLOT with VALUE." (setq class (eieio--class-object class)) (cl-check-type class eieio--class) (cl-check-type slot symbol) - (let* ((c (eieio--slot-name-index class nil slot))) + (let* ((c (eieio--slot-name-index class slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. @@ -1021,12 +1021,9 @@ Fills in the default value in CLASS' in SLOT with VALUE." ;;; EIEIO internal search functions ;; -(defun eieio--slot-name-index (class obj slot) - "In CLASS for OBJ find the index of the named SLOT. -The slot is a symbol which is installed in CLASS by the `defclass' -call. OBJ can be nil, but if it is an object, and the slot in question -is protected, access will be allowed if OBJ is a child of the currently -scoped class. +(defun eieio--slot-name-index (class slot) + "In CLASS find the index of the named SLOT. +The slot is a symbol which is installed in CLASS by the `defclass' call. If SLOT is the value created with :initarg instead, reverse-lookup that name, and recurse with the associated slot value." ;; Removed checks to outside this call @@ -1035,7 +1032,7 @@ reverse-lookup that name, and recurse with the associated slot value." (if (integerp fsi) (+ (eval-when-compile eieio--object-num-slots) fsi) (let ((fn (eieio--initarg-to-attribute class slot))) - (if fn (eieio--slot-name-index class obj fn) nil))))) + (if fn (eieio--slot-name-index class fn) nil))))) (defun eieio--class-slot-name-index (class slot) "In CLASS find the index of the named SLOT. @@ -1255,7 +1252,7 @@ method invocation orders of the involved classes." (eieio--class-precedence-list tag)))) -;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "b568ffb3c90ed5d0ae673f0051d608ee") +;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "5b04c9a8fff2bd3f3d3ac54aba0f65b7") ;;; Generated autoloads from eieio-compat.el (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 @@ ;;; Code: +(eval-when-compile (require 'subr-x)) (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'epg)) ;For setf accessors. @@ -1510,6 +1511,11 @@ with PKG-DESC entry removed." (and (memq pkg (mapcar #'car (package-desc-reqs (cadr p)))) (car p)))))) +(defun package--newest-p (pkg) + "Return t if PKG is the newest package with its name." + (equal (cadr (assq (package-desc-name pkg) package-alist)) + pkg)) + (defun package-delete (pkg-desc &optional force nosave) "Delete package PKG-DESC. @@ -1527,7 +1533,10 @@ If NOSAVE is non-nil, the package is not removed from ;; don't want it marked as selected, so we remove it from ;; `package-selected-packages' even if it can't be deleted. (when (and (null nosave) - (package--user-selected-p name)) + (package--user-selected-p name) + ;; Don't delesect if this is an older version of an + ;; upgraded package. + (package--newest-p pkg-desc)) (customize-save-variable 'package-selected-packages (remove name package-selected-packages))) (cond ((not (string-prefix-p (file-name-as-directory @@ -2262,7 +2271,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (defun package-menu-mark-install (&optional _num) "Mark a package for installation and move to the next line." (interactive "p") - (if (member (package-menu-get-status) '("available" "new")) + (if (member (package-menu-get-status) '("available" "new" "dependency")) (tabulated-list-put-tag "I" t) (forward-line))) @@ -2351,6 +2360,40 @@ call will upgrade the package." (length upgrades) (if (= (length upgrades) 1) "" "s"))))) +(defun package--sort-deps-in-alist (package only) + "Return a list of dependencies for PACKAGE sorted by dependency. +PACKAGE is included as the first element of the returned list. +ONLY is an alist associating package names to package objects. +Only these packages will be in the return value an their cdrs are +destructively set to nil in ONLY." + (let ((out)) + (dolist (dep (package-desc-reqs package)) + (when-let ((cell (assq (car dep) only)) + (dep-package (cdr-safe cell))) + (setcdr cell nil) + (setq out (append (package--sort-deps-in-alist dep-package only) + out)))) + (cons package out))) + +(defun package--sort-by-dependence (package-list) + "Return PACKAGE-LIST sorted by dependence. +That is, any element of the returned list is guaranteed to not +directly depend on any elements that come before it. + +PACKAGE-LIST is a list of package-desc objects. +Indirect dependencies are guaranteed to be returned in order only +if all the in-between dependencies are also in PACKAGE-LIST." + (let ((alist (mapcar (lambda (p) (cons (package-desc-name p) p)) package-list)) + out-list) + (dolist (cell alist out-list) + ;; `package--sort-deps-in-alist' destructively changes alist, so + ;; some cells might already be empty. We check this here. + (when-let ((pkg-desc (cdr cell))) + (setcdr cell nil) + (setq out-list + (append (package--sort-deps-in-alist pkg-desc alist) + out-list)))))) + (defun package-menu-execute (&optional noquery) "Perform marked Package Menu actions. 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." (mapconcat #'package-desc-full-name install-list ", "))))) (mapc (lambda (p) - (package-install p (null (package-installed-p p)))) + ;; Mark as selected if it's the exact version of a + ;; package that's already installed, or if it's not + ;; installed at all. Don't mark if it's a new + ;; version of an installed package. + (package-install p (or (package-installed-p p) + (not (package-installed-p + (package-desc-name p)))))) install-list))) ;; Delete packages, prompting if necessary. (when delete-list @@ -2398,7 +2447,7 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." (length delete-list) (mapconcat #'package-desc-full-name delete-list ", "))))) - (dolist (elt delete-list) + (dolist (elt (package--sort-by-dependence delete-list)) (condition-case-unless-debug err (package-delete elt) (error (message (cadr err))))) @@ -2412,7 +2461,8 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." (format "These %d packages are no longer needed, delete them (%s)? " (length removable) (mapconcat #'symbol-name removable ", ")))) - (mapc (lambda (p) (package-delete (cadr (assq p package-alist)))) + ;; We know these are removable, so we can use force instead of sorting them. + (mapc (lambda (p) (package-delete (cadr (assq p package-alist)) 'force 'nosave)) removable)))) (package-menu--generate t t)))) 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 @@ ;; Copyright (C) 2014-2015 Free Software Foundation, Inc. -;; Author: Nicolas Petton <petton.nicolas@gmail.com> +;; Author: Nicolas Petton <nicolas@petton.fr> ;; Keywords: sequences -;; Version: 1.0 +;; Version: 1.1 ;; Maintainer: emacs-devel@gnu.org @@ -92,14 +92,14 @@ returned." (seq-subseq seq 0 (min (max n 0) (seq-length seq))))) (defun seq-drop-while (pred seq) - "Return a sequence, from the first element for which (PRED element) is nil, of SEQ. + "Return a sequence from the first element for which (PRED element) is nil in SEQ. The result is a sequence of the same type as SEQ." (if (listp seq) (seq--drop-while-list pred seq) (seq-drop seq (seq--count-successive pred seq)))) (defun seq-take-while (pred seq) - "Return a sequence of the successive elements for which (PRED element) is non-nil in SEQ. + "Return the successive elements for which (PRED element) is non-nil in SEQ. The result is a sequence of the same type as SEQ." (if (listp seq) (seq--take-while-list pred seq) @@ -152,7 +152,7 @@ If SEQ is empty, return INITIAL-VALUE and FUNCTION is not called." t)) (defun seq-count (pred seq) - "Return the number of elements for which (PRED element) returns non-nil in seq." + "Return the number of elements for which (PRED element) is non-nil in SEQ." (let ((count 0)) (seq-doseq (elt seq) (when (funcall pred elt) @@ -224,15 +224,50 @@ TYPE must be one of following symbols: vector, string or list. (`list (apply #'append (append seqs '(nil)))) (t (error "Not a sequence type name: %s" type)))) +(defun seq-mapcat (function seq &optional type) + "Concatenate the result of applying FUNCTION to each element of SEQ. +The result is a sequence of type TYPE, or a list if TYPE is nil." + (apply #'seq-concatenate (or type 'list) + (seq-map function seq))) + +(defun seq-partition (seq n) + "Return a list of the elements of SEQ grouped into sub-sequences of length N. +The last sequence may contain less than N elements. If N is a +negative integer or 0, nil is returned." + (unless (< n 1) + (let ((result '())) + (while (not (seq-empty-p seq)) + (push (seq-take seq n) result) + (setq seq (seq-drop seq n))) + (nreverse result)))) + +(defun seq-group-by (function seq) + "Apply FUNCTION to each element of SEQ. +Separate the elements of SEQ into an alist using the results as +keys. Keys are compared using `equal'." + (nreverse + (seq-reduce + (lambda (acc elt) + (let* ((key (funcall function elt)) + (cell (assoc key acc))) + (if cell + (setcdr cell (push elt (cdr cell))) + (push (list key elt) acc)) + acc)) + seq + nil))) + (defun seq--drop-list (list n) - "Optimized version of `seq-drop' for lists." + "Return a list from LIST without its first N elements. +This is an optimization for lists in `seq-drop'." (while (and list (> n 0)) (setq list (cdr list) n (1- n))) list) (defun seq--take-list (list n) - "Optimized version of `seq-take' for lists." + "Return a list from LIST made of its first N elements. +This is an optimization for lists in `seq-take'." (let ((result '())) (while (and list (> n 0)) (setq n (1- n)) @@ -240,13 +275,15 @@ TYPE must be one of following symbols: vector, string or list. (nreverse result))) (defun seq--drop-while-list (pred list) - "Optimized version of `seq-drop-while' for lists." + "Return a list from the first element for which (PRED element) is nil in LIST. +This is an optimization for lists in `seq-drop-while'." (while (and list (funcall pred (car list))) (setq list (cdr list))) list) (defun seq--take-while-list (pred list) - "Optimized version of `seq-take-while' for lists." + "Return the successive elements for which (PRED element) is non-nil in LIST. +This is an optimization for lists in `seq-take-while'." (let ((result '())) (while (and list (funcall pred (car list))) (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." (defun viper-ESC (arg) "Emulate ESC key in Emacs. Prevents multiple escape keystrokes if viper-no-multiple-ESC is true. -If viper-no-multiple-ESC is 'twice double ESC would ding in vi-state. +If `viper-no-multiple-ESC' is `twice' double ESC would ding in vi-state. Other ESC sequences are emulated via the current Emacs's major mode keymap. This is more convenient on TTYs, since this won't block function keys such as up, down, etc. ESC will also will also work as -a Meta key in this case. When viper-no-multiple-ESC is nil, ESC works +a Meta key in this case. When `viper-no-multiple-ESC' is nil, ESC works as a Meta key and any number of multiple escapes are allowed." (interactive "P") (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." :group 'viper) (defcustom viper-no-multiple-ESC t - "If true, multiple ESC in Vi mode will cause bell to ring. -This is set to t on a windowing terminal and to 'twice on a dumb + "If non-nil, multiple ESC in Vi mode will cause bell to ring. +This is set to t on a windowing terminal and to `twice' on a dumb terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this enables cursor keys and is generally more convenient, as terminals usually don't have a convenient Meta key. -Setting viper-no-multiple-ESC to nil will allow as many multiple ESC, -as is allowed by the major mode in effect." +Setting it to nil will allow as many multiple ESC, as is allowed by the +major mode in effect." :type 'boolean :group 'viper) 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." (value (cdr (assq param-name parameters)))) (if value (set-face-attribute (nth 1 param) frame - (nth 2 param) value)))) - (frame-can-run-window-configuration-change-hook frame t))) + (nth 2 param) value)))))) (defun tty-handle-reverse-video (frame parameters) "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)." (frame-set-background-mode frame-initial-frame)) (face-set-after-frame-default frame-initial-frame) (setq newparms (delq new-bg newparms))) + + (when (numberp (car frame-size-history)) + (setq frame-size-history + (cons (1- (car frame-size-history)) + (cons + (list frame-initial-frame + "frame-notice-user-settings" + nil newparms) + (cdr frame-size-history))))) + (modify-frame-parameters frame-initial-frame newparms))))) ;; Restore the original buffer. @@ -686,7 +696,7 @@ the new frame according to its own rules." ;; Now make the frame. (run-hooks 'before-make-frame-hook) -;; (setq frame-adjust-size-history '(t)) +;; (setq frame-size-history '(1000)) (setq frame (funcall (gui-method frame-creation-function w) params)) @@ -697,11 +707,14 @@ the new frame according to its own rules." (let ((val (frame-parameter oldframe param))) (when val (set-frame-parameter frame param val))))) - (when (eq (car frame-adjust-size-history) t) - (setq frame-adjust-size-history - (cons t (cons (list "Frame made") - (cdr frame-adjust-size-history))))) + (when (numberp (car frame-size-history)) + (setq frame-size-history + (cons (1- (car frame-size-history)) + (cons (list frame "make-frame") + (cdr frame-size-history))))) + ;; We can run `window-configuration-change-hook' for this frame now. + (frame-after-make-frame frame t) (run-hook-with-args 'after-make-frame-functions frame) frame)) 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 @@ +2015-02-05 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-start.el (gnus-save-newsrc-file-check-timestamp): Remove + variable; always check the newrc timestamp. + (gnus-save-newsrc-file): Always check timestamp. + +2015-02-05 Timo Lilja <timo.lilja@iki.fi> (tiny change) + + * mail-source.el (mail-source-call-script): If scripts exit with an + error, pop up an error buffer. + +2015-02-05 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-extra-headers): Add the popular Gmail X-GM-LABELS + as a default. + + * nnimap.el (nnimap-request-group-scan): Ensure that we've selected the + correct server. + +2015-02-05 Vincent Bernat <bernat@luffy.cx> (tiny change) + + * nnimap.el (nnimap-request-group-scan): Fix the function name. + + * gnus-int.el (gnus-request-group-scan): Use the correct function name. + +2015-02-05 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-select-newsgroup): Pass the group info along so + that nnimap works for non-activated backends. + 2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca> * 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)." (defun gnus-request-group-scan (group info) "Request that GROUP get a complete rescan." (let ((gnus-command-method (gnus-find-method-for-group group)) - (func 'request-group-description)) + (func 'request-group-scan)) (when (gnus-check-backend-function func group) (funcall (gnus-get-function gnus-command-method func) (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'." :group 'gnus-newsrc :type 'hook) -(defcustom gnus-save-newsrc-file-check-timestamp nil - "Check the modification time of the newsrc.eld file before saving it. -When the newsrc.eld file is updated by multiple machines, -checking the file's modification time is a good way to avoid -overwriting updated data." - :version "25.1" - :group 'gnus-newsrc - :type 'boolean) - (defcustom gnus-save-newsrc-hook nil "A hook called before saving any of the newsrc files." :group 'gnus-newsrc @@ -2833,19 +2824,18 @@ If FORCE is non-nil, the .newsrc file is read." ;; check timestamp of `gnus-current-startup-file'.eld against ;; `gnus-save-newsrc-file-last-timestamp' - (when gnus-save-newsrc-file-check-timestamp - (let* ((checkfile (concat gnus-current-startup-file ".eld")) - (mtime (nth 5 (file-attributes checkfile)))) - (when (and gnus-save-newsrc-file-last-timestamp - (time-less-p gnus-save-newsrc-file-last-timestamp - mtime)) - (unless (y-or-n-p - (format "%s was updated externally after %s, save?" - checkfile - (format-time-string - "%c" - gnus-save-newsrc-file-last-timestamp))) - (error "Couldn't save %s: updated externally" checkfile))))) + (let* ((checkfile (concat gnus-current-startup-file ".eld")) + (mtime (nth 5 (file-attributes checkfile)))) + (when (and gnus-save-newsrc-file-last-timestamp + (time-less-p gnus-save-newsrc-file-last-timestamp + mtime)) + (unless (y-or-n-p + (format "%s was updated externally after %s, save?" + checkfile + (format-time-string + "%c" + gnus-save-newsrc-file-last-timestamp))) + (error "Couldn't save %s: updated externally" checkfile)))) (if gnus-save-startup-file-via-temp-buffer (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." 'mail-decode-encoded-address-string "Function used to decode addresses with encoded words.") -(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups) +(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups X-GM-LABELS) "*Extra headers to parse." - :version "24.1" ; added Cc Keywords Gcc + :version "25.1" :group 'gnus-summary :type '(repeat symbol)) @@ -5620,7 +5620,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (mm-decode-coding-string group charset) (mm-decode-coding-string (gnus-status-message group) charset)))) - (unless (gnus-request-group group t) + (unless (gnus-request-group group t nil (gnus-get-info group)) (when (derived-mode-p 'gnus-summary-mode) (gnus-kill-buffer (current-buffer))) (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) (setq script (substring script 0 (match-beginning 0)) background 0)) (setq result - (call-process shell-file-name nil background nil + (call-process shell-file-name nil stderr nil shell-command-switch script)) - (when (and result - (not (zerop result))) - (set-buffer stderr) - (message "Mail source error: %s" (buffer-string))) - (kill-buffer stderr))) + (if (and result + (not (zerop result))) + (progn + (split-window-vertically) + (other-window 1) + (switch-to-buffer stderr) + (message "Mail source error: %s " (buffer-string))) + (kill-buffer stderr)))) ;;; ;;; 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.") group)) t)))) -(deffoo nnimap-request-scan-group (group &optional server info) +(deffoo nnimap-request-group-scan (group &optional server info) (setq group (nnimap-decode-gnus-group group)) - (let (marks high low) - (with-current-buffer (nnimap-buffer) - (erase-buffer) - (let ((group-sequence - (nnimap-send-command "SELECT %S" (utf7-encode group t))) - (flag-sequence - (nnimap-send-command "UID FETCH 1:* FLAGS"))) - (setf (nnimap-group nnimap-object) group) - (nnimap-wait-for-response flag-sequence) - (setq marks - (nnimap-flags-to-marks - (nnimap-parse-flags - (list (list group-sequence flag-sequence - 1 group "SELECT"))))) - (when (and info - marks) - (nnimap-update-infos marks (list info)) - (nnimap-store-info info (gnus-active (gnus-info-group info)))) - (goto-char (point-max)) - (let ((uidnext (nth 5 (car marks)))) - (setq high (or (if uidnext - (1- uidnext) - (nth 3 (car marks))) - 0) - low (or (nth 4 (car marks)) uidnext 1))))) - (with-current-buffer nntp-server-buffer - (erase-buffer) - (insert - (format - "211 %d %d %d %S\n" (1+ (- high low)) low high group)) - t))) + (when (nnimap-change-group nil server) + (let (marks high low) + (with-current-buffer (nnimap-buffer) + (erase-buffer) + (let ((group-sequence + (nnimap-send-command "SELECT %S" (utf7-encode group t))) + (flag-sequence + (nnimap-send-command "UID FETCH 1:* FLAGS"))) + (setf (nnimap-group nnimap-object) group) + (nnimap-wait-for-response flag-sequence) + (setq marks + (nnimap-flags-to-marks + (nnimap-parse-flags + (list (list group-sequence flag-sequence + 1 group "SELECT"))))) + (when (and info + marks) + (nnimap-update-infos marks (list info)) + (nnimap-store-info info (gnus-active (gnus-info-group info)))) + (goto-char (point-max)) + (let ((uidnext (nth 5 (car marks)))) + (setq high (or (if uidnext + (1- uidnext) + (nth 3 (car marks))) + 0) + low (or (nth 4 (car marks)) uidnext 1))))) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (insert + (format + "211 %d %d %d %S\n" (1+ (- high low)) low high group)) + t)))) (deffoo nnimap-request-create-group (group &optional server args) (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") ;;;###autoload +(defun describe-function-or-variable (symbol &optional buffer frame) + "Display the full documentation of the function or variable SYMBOL. +If SYMBOL is a variable and has a buffer-local value in BUFFER or FRAME +\(default to the current buffer and current frame), it is displayed along +with the global value." + (interactive + (let* ((v-or-f (variable-at-point)) + (found (symbolp v-or-f)) + (v-or-f (if found v-or-f (function-called-at-point))) + (found (or found v-or-f)) + (enable-recursive-minibuffers t) + val) + (setq val (completing-read (if found + (format + "Describe function or variable (default %s): " v-or-f) + "Describe function or variable: ") + obarray + (lambda (vv) + (or (fboundp vv) + (get vv 'variable-documentation) + (and (boundp vv) (not (keywordp vv))))) + t nil nil + (if found (symbol-name v-or-f)))) + (list (if (equal val "") + v-or-f (intern val))))) + (if (not (symbolp symbol)) (message "You didn't specify a function or variable") + (unless (buffer-live-p buffer) (setq buffer (current-buffer))) + (unless (frame-live-p frame) (setq frame (selected-frame))) + (help-xref-interned symbol buffer frame))) + +;;;###autoload (defun describe-syntax (&optional buffer) "Describe the syntax specifications in the syntax table of BUFFER. 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'." ;; Additional functions for (re-)creating types of help buffers. -(defun help-xref-interned (symbol) + +;;;###autoload +(defun help-xref-interned (symbol &optional buffer frame) "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL. Both variable, function and face documentation are extracted into a single -help buffer." +help buffer. If SYMBOL is a variable, include buffer-local value for optional +BUFFER or FRAME." (with-current-buffer (help-buffer) ;; Push the previous item on the stack before clobbering the output buffer. (help-setup-xref nil nil) @@ -640,7 +643,7 @@ help buffer." (get symbol 'variable-documentation)) ;; Don't record the current entry in the stack. (setq help-xref-stack-item nil) - (describe-variable symbol)))) + (describe-variable symbol buffer frame)))) (cond (sdoc ;; 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 @@ (define-key map "k" 'describe-key) (define-key map "l" 'view-lossage) (define-key map "m" 'describe-mode) + (define-key map "o" 'describe-function-or-variable) (define-key map "n" 'view-emacs-news) (define-key map "p" 'finder-by-keyword) (define-key map "P" 'describe-package) @@ -218,6 +219,7 @@ L LANG-ENV Describes a specific language environment, or RET for current. m Display documentation of current minor modes and current major mode, including their special commands. n Display news of recent Emacs changes. +o SYMBOL Display the given function or variable's documentation and value. p TOPIC Find packages matching a given topic keyword. P PACKAGE Describe the given Emacs Lisp package. 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." (define-key map "a-" 'image-decrease-speed) (define-key map "a0" 'image-reset-speed) (define-key map "ar" 'image-reverse-speed) + (define-key map "k" 'image-kill-buffer) (define-key map [remap forward-char] 'image-forward-hscroll) (define-key map [remap backward-char] 'image-backward-hscroll) (define-key map [remap right-char] 'image-forward-hscroll) @@ -722,6 +723,11 @@ the image by calling `image-mode'." (image-mode-as-text) (image-mode))) +(defun image-kill-buffer () + "Kill the current buffer." + (interactive) + (kill-buffer (current-buffer))) + (defun image-after-revert-hook () (when (image-get-display-property) (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.") "Advance past the character at point, returning it." (let ((char (json-peek))) (if (eq char :json-eof) - (signal 'end-of-file nil) + (signal 'json-end-of-file nil) (json-advance) char))) @@ -186,6 +186,8 @@ without indentation.") (define-error 'json-string-format "Bad string format" 'json-error) (define-error 'json-key-format "Bad JSON object key" 'json-error) (define-error 'json-object-format "Bad JSON object" 'json-error) +(define-error 'json-end-of-file "End of file while parsing JSON" + '(end-of-file json-error)) @@ -554,7 +556,7 @@ Advances point just past JSON object." (if (functionp (car record)) (apply (car record) (cdr record)) (signal 'json-readtable-error record))) - (signal 'end-of-file nil)))) + (signal 'json-end-of-file nil)))) ;; Syntactic sugar for the reader 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. `auth' is one of the symbols `simple', `krbv41' or `krbv42'. `base' is the base for the search as described in RFC 1779. `scope' is one of the three symbols `sub', `base' or `one'. - `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). - `auth' is one of the symbols `simple', `krbv41' or `krbv42' + `binddn' is the distinguished name of the user to bind as (in +RFC 1779 syntax). `passwd' is the password to use for simple authentication. `deref' is one of the symbols `never', `always', `search' or `find'. `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." (when (re-search-forward eoc nil t) (goto-char (match-beginning 0)) (delete-region (point-min) (line-beginning-position)))) - (let* ((capability-command (plist-get parameters :capability-command))) + (let ((capability-command (plist-get parameters :capability-command)) + (eo-capa (or (plist-get parameters :end-of-capability) + eoc))) (list stream (network-stream-get-response stream start eoc) - (network-stream-command stream capability-command eoc) + (network-stream-command stream capability-command eo-capa) 'tls)))))) (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." (end-of-line 0) (insert comend)))))))))))) +;;;###autoload +(defun comment-line (n) + "Comment or uncomment current line and leave point after it. +With positive prefix, apply to N lines including current one. +With negative prefix, apply to -N lines above. Also, further +consecutive invocations of this command will inherit the negative +argument. + +If region is active, comment lines in active region instead. +Unlike `comment-dwim', this always comments whole lines." + (interactive "p") + (if (use-region-p) + (comment-or-uncomment-region + (save-excursion + (goto-char (region-beginning)) + (line-beginning-position)) + (save-excursion + (goto-char (region-end)) + (line-end-position))) + (when (and (eq last-command 'comment-line-backward) + (natnump n)) + (setq n (- n))) + (let ((range + (list (line-beginning-position) + (goto-char (line-end-position n))))) + (comment-or-uncomment-region + (apply #'min range) + (apply #'max range))) + (forward-line 1) + (back-to-indentation) + (unless (natnump n) (setq this-command 'comment-line-backward)))) + (provide 'newcomment) ;;; 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." (save-excursion (outline-back-to-heading t) (outline-flag-region (1- (point)) - (progn (outline-next-preface) (point)) nil))) + (progn + (outline-next-preface) + (if (= 1 (- (point-max) (point))) + (point-max) + (point))) + nil))) (define-obsolete-function-alias '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." ;; `gamegrid-add-score' was supposed to be used in the past and ;; is covered here for backward-compatibility. ;; -;; 2. The helper program "update-game-score" is setuid and the -;; file FILE does already exist in a system wide shared game -;; directory. This should be the normal case on POSIX systems, -;; if the game was installed system wide. Use +;; 2. The helper program "update-game-score" is setgid or setuid +;; and the file FILE does already exist in a system wide shared +;; game directory. This should be the normal case on POSIX +;; systems, if the game was installed system wide. Use ;; "update-game-score" to add the score to the file in the ;; shared game directory. ;; -;; 3. "update-game-score" is setuid, but the file FILE does *not* -;; exist in the system wide shared game directory. Use +;; 3. "update-game-score" is setgid/setuid, but the file FILE does +;; *not* exist in the system wide shared game directory. Use ;; `gamegrid-add-score-insecure' to create--if necessary--and ;; update FILE. This is for the case that a user has installed ;; a game on her own. ;; -;; 4. "update-game-score" is not setuid. Use it to create/update -;; FILE in the user's home directory. There is presumably no -;; shared game directory. +;; 4. "update-game-score" is not setgid/setuid. Use it to +;; create/update FILE in the user's home directory. There is +;; presumably no shared game directory. (defvar gamegrid-shared-game-dir) @@ -491,7 +491,7 @@ FILE is created there." (gamegrid-add-score-insecure file score)) ((and gamegrid-shared-game-dir (file-exists-p (expand-file-name file shared-game-score-directory))) - ;; Use the setuid (or setgid) "update-game-score" program + ;; Use the setgid (or setuid) "update-game-score" program ;; to update a system-wide score file. (gamegrid-add-score-with-update-game-score-1 file (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." (levels (python-indent--calculate-levels indentation))) (if previous (python-indent--previous-level levels (current-indentation)) - (apply #'max levels)))) + (if levels + (apply #'max levels) + 0)))) (defun python-indent-line (&optional previous) "Internal implementation of `python-indent-line-function'. @@ -2331,57 +2333,57 @@ goes wrong and syntax highlighting in the shell gets messed up." (interactive) (python-shell-with-shell-buffer (python-shell-font-lock-with-font-lock-buffer - (delete-region (point-min) (point-max))))) + (erase-buffer)))) (defun python-shell-font-lock-comint-output-filter-function (output) "Clean up the font-lock buffer after any OUTPUT." - (when (and (not (string= "" output)) - ;; Is end of output and is not just a prompt. - (not (member - (python-shell-comint-end-of-output-p - (ansi-color-filter-apply output)) - '(nil 0)))) - ;; If output is other than an input prompt then "real" output has - ;; been received and the font-lock buffer must be cleaned up. - (python-shell-font-lock-cleanup-buffer)) + (if (and (not (string= "" output)) + ;; Is end of output and is not just a prompt. + (not (member + (python-shell-comint-end-of-output-p + (ansi-color-filter-apply output)) + '(nil 0)))) + ;; If output is other than an input prompt then "real" output has + ;; been received and the font-lock buffer must be cleaned up. + (python-shell-font-lock-cleanup-buffer) + ;; Otherwise just add a newline. + (python-shell-font-lock-with-font-lock-buffer + (goto-char (point-max)) + (newline))) output) (defun python-shell-font-lock-post-command-hook () "Fontifies current line in shell buffer." - (if (eq this-command 'comint-send-input) - ;; Add a newline when user sends input as this may be a block. - (python-shell-font-lock-with-font-lock-buffer - (goto-char (line-end-position)) - (newline)) - (when (and (python-util-comint-last-prompt) - (> (point) (cdr (python-util-comint-last-prompt)))) - (let ((input (buffer-substring-no-properties - (cdr (python-util-comint-last-prompt)) (point-max))) - (old-input (python-shell-font-lock-with-font-lock-buffer - (buffer-substring-no-properties - (line-beginning-position) (point-max)))) - (current-point (point)) - (buffer-undo-list t)) - ;; When input hasn't changed, do nothing. - (when (not (string= input old-input)) - (delete-region (cdr (python-util-comint-last-prompt)) (point-max)) - (insert - (python-shell-font-lock-with-font-lock-buffer - (delete-region (line-beginning-position) - (line-end-position)) - (insert input) - ;; Ensure buffer is fontified, keeping it - ;; compatible with Emacs < 24.4. - (if (fboundp 'font-lock-ensure) - (funcall 'font-lock-ensure) - (font-lock-default-fontify-buffer)) - ;; Replace FACE text properties with FONT-LOCK-FACE so - ;; they are not overwritten by comint buffer's font lock. - (python-util-text-properties-replace-name - 'face 'font-lock-face) - (buffer-substring (line-beginning-position) - (line-end-position)))) - (goto-char current-point)))))) + (when (and (python-util-comint-last-prompt) + (> (point) (cdr (python-util-comint-last-prompt)))) + (let ((input (buffer-substring-no-properties + (cdr (python-util-comint-last-prompt)) (point-max))) + (pos (point)) + (buffer-undo-list t) + (font-lock-buffer-pos nil)) + ;; Keep all markers untouched, this prevents `hippie-expand' and + ;; others from getting confused. Bug#19650. + (insert-before-markers + (python-shell-font-lock-with-font-lock-buffer + (delete-region (line-beginning-position) + (point-max)) + (setq font-lock-buffer-pos (point)) + (insert input) + ;; Ensure buffer is fontified, keeping it + ;; compatible with Emacs < 24.4. + (if (fboundp 'font-lock-ensure) + (funcall 'font-lock-ensure) + (font-lock-default-fontify-buffer)) + ;; Replace FACE text properties with FONT-LOCK-FACE so + ;; they are not overwritten by comint buffer's font lock. + (python-util-text-properties-replace-name + 'face 'font-lock-face) + (buffer-substring font-lock-buffer-pos + (point-max)))) + ;; Remove non-fontified original text. + (delete-region pos (cdr (python-util-comint-last-prompt))) + ;; Point should be already at pos, this is for extra safety. + (goto-char pos)))) (defun python-shell-font-lock-turn-on (&optional msg) "Turn on shell font-lock. @@ -3148,67 +3150,68 @@ With argument MSG show activation/deactivation message." "Get completions using native readline for PROCESS. When IMPORT is non-nil takes precedence over INPUT for completion." - (when (and python-shell-completion-native-enable - (python-util-comint-last-prompt) - (>= (point) (cdr (python-util-comint-last-prompt)))) - (let* ((input (or import input)) - (original-filter-fn (process-filter process)) - (redirect-buffer (get-buffer-create - python-shell-completion-native-redirect-buffer)) - (separators (python-rx - (or whitespace open-paren close-paren))) - (trigger "\t\t\t") - (new-input (concat input trigger)) - (input-length - (save-excursion - (+ (- (point-max) (comint-bol)) (length new-input)))) - (delete-line-command (make-string input-length ?\b)) - (input-to-send (concat new-input delete-line-command))) - ;; Ensure restoring the process filter, even if the user quits - ;; or there's some other error. - (unwind-protect - (with-current-buffer redirect-buffer - ;; Cleanup the redirect buffer - (delete-region (point-min) (point-max)) - ;; Mimic `comint-redirect-send-command', unfortunately it - ;; can't be used here because it expects a newline in the - ;; command and that's exactly what we are trying to avoid. - (let ((comint-redirect-echo-input nil) - (comint-redirect-verbose nil) - (comint-redirect-perform-sanity-check nil) - (comint-redirect-insert-matching-regexp nil) - ;; Feed it some regex that will never match. - (comint-redirect-finished-regexp "^\\'$") - (comint-redirect-output-buffer redirect-buffer)) - ;; Compatibility with Emacs 24.x. Comint changed and - ;; now `comint-redirect-filter' gets 3 args. This - ;; checks which version of `comint-redirect-filter' is - ;; in use based on its args and uses `apply-partially' - ;; to make it up for the 3 args case. - (if (= (length - (help-function-arglist 'comint-redirect-filter)) 3) - (set-process-filter - process (apply-partially - #'comint-redirect-filter original-filter-fn)) - (set-process-filter process #'comint-redirect-filter)) - (process-send-string process input-to-send) - (accept-process-output - process - python-shell-completion-native-output-timeout) - ;; XXX: can't use `python-shell-accept-process-output' - ;; here because there are no guarantees on how output - ;; ends. The workaround here is to call - ;; `accept-process-output' until we don't find anything - ;; else to accept. - (while (accept-process-output - process - python-shell-completion-native-output-timeout)) - (cl-remove-duplicates - (split-string - (buffer-substring-no-properties - (point-min) (point-max)) - separators t)))) - (set-process-filter process original-filter-fn))))) + (with-current-buffer (process-buffer process) + (when (and python-shell-completion-native-enable + (python-util-comint-last-prompt) + (>= (point) (cdr (python-util-comint-last-prompt)))) + (let* ((input (or import input)) + (original-filter-fn (process-filter process)) + (redirect-buffer (get-buffer-create + python-shell-completion-native-redirect-buffer)) + (separators (python-rx + (or whitespace open-paren close-paren))) + (trigger "\t\t\t") + (new-input (concat input trigger)) + (input-length + (save-excursion + (+ (- (point-max) (comint-bol)) (length new-input)))) + (delete-line-command (make-string input-length ?\b)) + (input-to-send (concat new-input delete-line-command))) + ;; Ensure restoring the process filter, even if the user quits + ;; or there's some other error. + (unwind-protect + (with-current-buffer redirect-buffer + ;; Cleanup the redirect buffer + (delete-region (point-min) (point-max)) + ;; Mimic `comint-redirect-send-command', unfortunately it + ;; can't be used here because it expects a newline in the + ;; command and that's exactly what we are trying to avoid. + (let ((comint-redirect-echo-input nil) + (comint-redirect-verbose nil) + (comint-redirect-perform-sanity-check nil) + (comint-redirect-insert-matching-regexp nil) + ;; Feed it some regex that will never match. + (comint-redirect-finished-regexp "^\\'$") + (comint-redirect-output-buffer redirect-buffer)) + ;; Compatibility with Emacs 24.x. Comint changed and + ;; now `comint-redirect-filter' gets 3 args. This + ;; checks which version of `comint-redirect-filter' is + ;; in use based on its args and uses `apply-partially' + ;; to make it up for the 3 args case. + (if (= (length + (help-function-arglist 'comint-redirect-filter)) 3) + (set-process-filter + process (apply-partially + #'comint-redirect-filter original-filter-fn)) + (set-process-filter process #'comint-redirect-filter)) + (process-send-string process input-to-send) + (accept-process-output + process + python-shell-completion-native-output-timeout) + ;; XXX: can't use `python-shell-accept-process-output' + ;; here because there are no guarantees on how output + ;; ends. The workaround here is to call + ;; `accept-process-output' until we don't find anything + ;; else to accept. + (while (accept-process-output + process + python-shell-completion-native-output-timeout)) + (cl-remove-duplicates + (split-string + (buffer-substring-no-properties + (point-min) (point-max)) + separators t)))) + (set-process-filter process original-filter-fn)))))) (defun python-shell-completion-get-completions (process import input) "Do completion at point using PROCESS for IMPORT or INPUT. @@ -3251,20 +3254,23 @@ completion." Optional argument PROCESS forces completions to be retrieved using that one instead of current buffer's process." (setq process (or process (get-buffer-process (current-buffer)))) - (let* ((last-prompt-end (cdr (python-util-comint-last-prompt))) + (let* ((line-start (if (derived-mode-p 'inferior-python-mode) + ;; Working on a shell buffer: use prompt end. + (cdr (python-util-comint-last-prompt)) + (line-beginning-position))) (import-statement (when (string-match-p (rx (* space) word-start (or "from" "import") word-end space) - (buffer-substring-no-properties last-prompt-end (point))) - (buffer-substring-no-properties last-prompt-end (point)))) + (buffer-substring-no-properties line-start (point))) + (buffer-substring-no-properties line-start (point)))) (start (save-excursion (if (not (re-search-backward (python-rx (or whitespace open-paren close-paren string-delimiter)) - last-prompt-end + line-start t 1)) - last-prompt-end + line-start (forward-char (length (match-string-no-properties 0))) (point)))) (end (point)) @@ -3847,8 +3853,10 @@ The skeleton will be bound to python-skeleton-NAME." :type 'string :group 'python) -(defvar-local python-check-custom-command nil +(defvar python-check-custom-command nil "Internal use.") +;; XXX: Avoid `defvar-local' for compat with Emacs<24.3 +(make-variable-buffer-local 'python-check-custom-command) (defun python-check (command) "Check a Python file (default current buffer's file). @@ -3917,15 +3925,29 @@ See `python-check-command' for the default." :type 'string :group 'python) +(defun python-eldoc--get-symbol-at-point () + "Get the current symbol for eldoc. +Returns the current symbol handling point within arguments." + (save-excursion + (let ((start (python-syntax-context 'paren))) + (when start + (goto-char start)) + (when (or start + (eobp) + (memq (char-syntax (char-after)) '(?\ ?-))) + ;; Try to adjust to closest symbol if not in one. + (python-util-forward-comment -1))) + (python-info-current-symbol t))) + (defun python-eldoc--get-doc-at-point (&optional force-input force-process) "Internal implementation to get documentation at point. -If not FORCE-INPUT is passed then what `python-info-current-symbol' +If not FORCE-INPUT is passed then what `python-eldoc--get-symbol-at-point' returns will be used. If not FORCE-PROCESS is passed what `python-shell-get-process' returns is used." (let ((process (or force-process (python-shell-get-process)))) (when process (let ((input (or force-input - (python-info-current-symbol t)))) + (python-eldoc--get-symbol-at-point)))) (and input ;; Prevent resizing the echo area when iPython is ;; enabled. Bug#18794. @@ -3945,7 +3967,7 @@ inferior Python process is updated properly." "Get help on SYMBOL using `help'. Interactively, prompt for symbol." (interactive - (let ((symbol (python-info-current-symbol t)) + (let ((symbol (python-eldoc--get-symbol-at-point)) (enable-recursive-minibuffers t)) (list (read-string (if symbol (format "Describe symbol (default %s): " symbol) @@ -3954,6 +3976,17 @@ Interactively, prompt for symbol." (message (python-eldoc--get-doc-at-point symbol))) +;;; Hideshow + +(defun python-hideshow-forward-sexp-function (arg) + "Python specific `forward-sexp' function for `hs-minor-mode'. +Argument ARG is ignored." + arg ; Shut up, byte compiler. + (python-nav-end-of-defun) + (unless (python-info-current-line-empty-p) + (backward-char))) + + ;;; Imenu (defvar python-imenu-format-item-label-function @@ -4682,14 +4715,23 @@ Arguments START and END narrow the buffer region to work on." (current-column)))) (^ '(- (1+ (current-indentation)))))) - (add-function :before-until (local 'eldoc-documentation-function) - #'python-eldoc-function) - - (add-to-list 'hs-special-modes-alist - `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#" - ,(lambda (_arg) - (python-nav-end-of-defun)) - nil)) + (if (null eldoc-documentation-function) + ;; Emacs<25 + (setq (make-local-variable 'eldoc-documentation-function) + #'python-eldoc-function) + (add-function :before-until (local 'eldoc-documentation-function) + #'python-eldoc-function)) + + (add-to-list + 'hs-special-modes-alist + `(python-mode + "\\s-*\\(?:def\\|class\\)\\>" + ;; Use the empty string as end regexp so it doesn't default to + ;; "\\s)". This way parens at end of defun are properly hidden. + "" + "#" + python-hideshow-forward-sexp-function + nil)) (set (make-local-variable 'outline-regexp) (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. The result is a new function which does the same as FUN, except that the first N arguments are fixed at the values with which this function was called." - `(closure (t) (&rest args) - (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args))) + (lambda (&rest args2) + (apply fun (append args args2)))) (defmacro push (newelt place) "Add NEWELT to the list stored in the generalized variable PLACE. @@ -316,7 +316,7 @@ Defaults to `error'." (unless parent (setq parent 'error)) (let ((conditions (if (consp parent) - (apply #'nconc + (apply #'append (mapcar (lambda (parent) (cons parent (or (get parent 'error-conditions) @@ -1274,6 +1274,7 @@ is converted into a string by expressing it in decimal." (set-advertised-calling-convention 'all-completions '(string collection &optional predicate) "23.1") (set-advertised-calling-convention 'unintern '(name obarray) "23.3") +(set-advertised-calling-convention 'indirect-function '(object) "25.1") (set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3") (set-advertised-calling-convention 'decode-char '(ch charset) "21.4") (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 @@ -;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*- +;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*- ;; Copyright (C) 2006-2015 Free Software Foundation, Inc. @@ -401,11 +401,16 @@ (cond ;; This is a false positive inside a string or comment. ((nth 8 (syntax-ppss)) nil) + ;; This is a false positive when encountering an + ;; interpolated variable (bug#19751). + ((eq (char-before (- (point) 1)) ?#) nil) ((eq (char-before) ?\}) (save-excursion (forward-char -1) (skip-chars-backward " \t") - (unless (bolp) (newline)))) + (when (and (not (bolp)) + (scss-smie--not-interpolation-p)) + (newline)))) (t (while (progn @@ -450,7 +455,7 @@ (defun scss-smie--not-interpolation-p () (save-excursion (forward-char -1) - (or (zerop (skip-chars-backward "[:alnum:]")) + (or (zerop (skip-chars-backward "-[:alnum:]")) (not (looking-back "#{\\$" (- (point) 3)))))) ;;;###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." (if (and (not files) local (not (eq local 'only-file))) (vc-cvs-dir-status-heuristic dir update-function) (if (not files) (setq files (vc-expand-dirs (list dir) 'CVS))) - (vc-cvs-command (current-buffer) 'async dir "-f" "status" files) + (vc-cvs-command (current-buffer) 'async files "-f" "status") ;; Alternative implementation: use the "update" command instead of ;; the "status" command. ;; (vc-cvs-command (current-buffer) 'async |