diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 30 | ||||
| -rw-r--r-- | lisp/ChangeLog.funvec | 10 | ||||
| -rw-r--r-- | lisp/Makefile.in | 3 | ||||
| -rw-r--r-- | lisp/custom.el | 39 | ||||
| -rw-r--r-- | lisp/dired.el | 22 | ||||
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 4 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 28 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cconv.el | 128 | ||||
| -rw-r--r-- | lisp/emacs-lisp/pcase.el | 4 | ||||
| -rw-r--r-- | lisp/help-fns.el | 7 | ||||
| -rw-r--r-- | lisp/minibuffer.el | 24 | ||||
| -rw-r--r-- | lisp/mpc.el | 21 | ||||
| -rw-r--r-- | lisp/server.el | 15 |
13 files changed, 220 insertions, 115 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4a22b148469..10f57c2b96a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,24 @@ +2011-03-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cconv.el (cconv-liftwhen): Increase threshold. + (cconv-closure-convert-rec): Convert interactive spec in empty lexenv. + (cconv-analyse-use): Improve unused vars warnings. + (cconv-analyse-form): Analyze interactive spec in empty lexenv. + * emacs-lisp/bytecomp.el (byte-compile-lambda): Always byte-compile + the interactive spec in lexical-binding mode. + (byte-compile-refresh-preloaded): Don't reload byte-compiler files. + * custom.el (custom-initialize-default): Use defvar. + (custom-declare-variable): Set the special-variable-p flag. + * help-fns.el (help-make-usage): Drop leading underscores. + * dired.el (dired-revert, dired-make-relative): Mark unused args. + (dired-unmark-all-files): Remove unused var `query'. + (dired-overwrite-confirmed): Declare. + (dired-restore-desktop-buffer): Don't use dynamically scoped arg names. + * mpc.el: Mark unused args. + (mpc--faster-toggle): Remove unused var `songnb'. + * server.el (server-kill-buffer-running): Move before first use. + * minibuffer.el: Mark unused args. + 2011-02-26 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/cconv.el (cconv-closure-convert-rec): Fix last change for @@ -335,6 +356,15 @@ Merge funvec patch. +2004-05-20 Miles Bader <miles@gnu.org> + + * subr.el (functionp): Use `funvecp' instead of + `byte-compiled-function-p'. + * help-fns.el (describe-function-1): Describe curried functions + and other funvecs as such. + (help-highlight-arguments): Only format things that look like a + function. + 2004-04-29 Miles Bader <miles@gnu.org> * emacs-lisp/bytecomp.el (byte-compile-top-level): Add new entries diff --git a/lisp/ChangeLog.funvec b/lisp/ChangeLog.funvec deleted file mode 100644 index 0a31b9a590f..00000000000 --- a/lisp/ChangeLog.funvec +++ /dev/null @@ -1,10 +0,0 @@ -2004-05-20 Miles Bader <miles@gnu.org> - - * subr.el (functionp): Use `funvecp' instead of - `byte-compiled-function-p'. - * help-fns.el (describe-function-1): Describe curried functions - and other funvecs as such. - (help-highlight-arguments): Only format things that look like a - function. - -;; arch-tag: 87f75aac-de53-40d7-96c7-3befaa771cb1 diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 0182b7f5072..268a45d8948 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -222,6 +222,9 @@ compile-onefile: # cannot have prerequisites. .el.elc: @echo Compiling $< + @# The BIG_STACK_OPTS are only needed to byte-compile the byte-compiler + @# files, which is normally done in compile-first, but may also be + @# recompiled via this rule. @$(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \ -f batch-byte-compile $< diff --git a/lisp/custom.el b/lisp/custom.el index e41e7c7bdf8..d0d11610b91 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -55,11 +55,9 @@ Otherwise, if symbol has a `saved-value' property, it will evaluate the car of that and use it as the default binding for symbol. Otherwise, VALUE will be evaluated and used as the default binding for symbol." - (unless (default-boundp symbol) - ;; Use the saved value if it exists, otherwise the standard setting. - (set-default symbol (eval (if (get symbol 'saved-value) - (car (get symbol 'saved-value)) - value))))) + (eval `(defvar ,symbol ,(if (get symbol 'saved-value) + (car (get symbol 'saved-value)) + value)))) (defun custom-initialize-set (symbol value) "Initialize SYMBOL based on VALUE. @@ -81,15 +79,15 @@ The value is either the symbol's current value \(as obtained using the `:get' function), if any, or the value in the symbol's `saved-value' property if any, or (last of all) VALUE." - (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (cond ((default-boundp symbol) - (funcall (or (get symbol 'custom-get) 'default-value) - symbol)) - ((get symbol 'saved-value) - (eval (car (get symbol 'saved-value)))) - (t - (eval value))))) + (funcall (or (get symbol 'custom-set) 'set-default) + symbol + (cond ((default-boundp symbol) + (funcall (or (get symbol 'custom-get) 'default-value) + symbol)) + ((get symbol 'saved-value) + (eval (car (get symbol 'saved-value)))) + (t + (eval value))))) (defun custom-initialize-changed (symbol value) "Initialize SYMBOL with VALUE. @@ -142,10 +140,8 @@ set to nil, as the value is no longer rogue." ;; Maybe this option was rogue in an earlier version. It no longer is. (when (get symbol 'force-value) (put symbol 'force-value nil)) - (when doc - (if (keywordp doc) - (error "Doc string is missing") - (put symbol 'variable-documentation doc))) + (if (keywordp doc) + (error "Doc string is missing")) (let ((initialize 'custom-initialize-reset) (requests nil)) (unless (memq :group args) @@ -189,6 +185,13 @@ set to nil, as the value is no longer rogue." ;; Do the actual initialization. (unless custom-dont-initialize (funcall initialize symbol default))) + ;; Use defvar to set the docstring as well as the special-variable-p flag. + ;; FIXME: We should reproduce more of `defvar's behavior, such as the warning + ;; when the var is currently let-bound. + (if (not (default-boundp symbol)) + ;; Don't use defvar to avoid setting a default-value when undesired. + (when doc (put symbol 'variable-documentation doc)) + (eval `(defvar ,symbol nil ,@(when doc (list doc))))) (push symbol current-load-list) (run-hooks 'custom-define-hook) symbol) diff --git a/lisp/dired.el b/lisp/dired.el index 4a17b443cfa..af99d4c7413 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1168,7 +1168,7 @@ If HDR is non-nil, insert a header line with the directory name." ;; Reverting a dired buffer -(defun dired-revert (&optional arg noconfirm) +(defun dired-revert (&optional _arg _noconfirm) "Reread the dired buffer. Must also be called after `dired-actual-switches' have changed. Should not fail even on completely garbaged buffers. @@ -2129,7 +2129,7 @@ Optional arg GLOBAL means to replace all matches." ;; dired-get-filename. (concat (or dir default-directory) file)) -(defun dired-make-relative (file &optional dir ignore) +(defun dired-make-relative (file &optional dir _ignore) "Convert FILE (an absolute file name) to a name relative to DIR. If this is impossible, return FILE unchanged. DIR must be a directory name, not a file name." @@ -3219,7 +3219,7 @@ Type \\[help-command] at that time for help." (interactive "cRemove marks (RET means all): \nP") (save-excursion (let* ((count 0) - (inhibit-read-only t) case-fold-search query + (inhibit-read-only t) case-fold-search (string (format "\n%c" mark)) (help-form "\ Type SPC or `y' to unmark one file, DEL or `n' to skip to next, @@ -3494,6 +3494,8 @@ Anything else means ask for each directory." (declare-function dnd-get-local-file-name "dnd" (uri &optional must-exist)) (declare-function dnd-get-local-file-uri "dnd" (uri)) +(defvar dired-overwrite-confirmed) ;Defined in dired-aux. + (defun dired-dnd-handle-local-file (uri action) "Copy, move or link a file to the dired directory. URI is the file to handle, ACTION is one of copy, move, link or ask. @@ -3572,21 +3574,21 @@ Ask means pop up a menu for the user to select one of copy, move or link." (function (lambda (f) (desktop-file-name (car f) dirname))) dired-subdir-alist))))) -(defun dired-restore-desktop-buffer (desktop-buffer-file-name - desktop-buffer-name - desktop-buffer-misc) +(defun dired-restore-desktop-buffer (_file-name + _buffer-name + misc-data) "Restore a dired buffer specified in a desktop file." - ;; First element of `desktop-buffer-misc' is the value of `dired-directory'. + ;; First element of `misc-data' is the value of `dired-directory'. ;; This value is a directory name, optionally with shell wildcard or ;; a directory name followed by list of files. - (let* ((dired-dir (car desktop-buffer-misc)) + (let* ((dired-dir (car misc-data)) (dir (if (consp dired-dir) (car dired-dir) dired-dir))) (if (file-directory-p (file-name-directory dir)) (progn (dired dired-dir) - ;; The following elements of `desktop-buffer-misc' are the keys + ;; The following elements of `misc-data' are the keys ;; from `dired-subdir-alist'. - (mapc 'dired-maybe-insert-subdir (cdr desktop-buffer-misc)) + (mapc 'dired-maybe-insert-subdir (cdr misc-data)) (current-buffer)) (message "Desktop: Directory %s no longer exists." dir) (when desktop-missing-file-warning (sit-for 1)) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 342dd8b71d1..d86cb729081 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -308,6 +308,10 @@ ;; ((lambda ...) ...) (defun byte-compile-unfold-lambda (form &optional name) + ;; In lexical-binding mode, let and functions don't bind vars in the same way + ;; (let obey special-variable-p, but functions don't). This doesn't matter + ;; here, because function's behavior is underspecified so it can safely be + ;; turned into a `let', even though the reverse is not true. (or name (setq name "anonymous lambda")) (let ((lambda (car form)) (values (cdr form))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 4a53faefa3d..3575b10e1f1 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2563,6 +2563,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial ;; function, or this is Emacs 18, or generate-emacs19-bytecodes is off. ((let (tmp) + ;; FIXME: can this happen? (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun)))) (null (cdr (memq tmp fun)))) ;; Generate a make-byte-code call. @@ -2587,7 +2588,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (list 'quote fun)))))) ;; Turn a function into an ordinary lambda. Needed for v18 files. -(defun byte-compile-byte-code-unmake (function) +(defun byte-compile-byte-code-unmake (function) ;FIXME: what is it? (if (consp function) function;;It already is a lambda. (setq function (append function nil)) ; turn it into a list @@ -2685,16 +2686,19 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; compile it, because `call-interactively' looks at the ;; args of `list'. Actually, compile it to get warnings, ;; but don't use the result. - (let ((form (nth 1 bytecomp-int))) + (let* ((form (nth 1 bytecomp-int)) + (newform (byte-compile-top-level form))) (while (memq (car-safe form) '(let let* progn save-excursion)) (while (consp (cdr form)) (setq form (cdr form))) (setq form (car form))) - (if (eq (car-safe form) 'list) - (byte-compile-top-level (nth 1 bytecomp-int)) - (setq bytecomp-int (list 'interactive - (byte-compile-top-level - (nth 1 bytecomp-int))))))) + (if (and (eq (car-safe form) 'list) + ;; The spec is evaled in callint.c in dynamic-scoping + ;; mode, so just leaving the form unchanged would mean + ;; it won't be eval'd in the right mode. + (not lexical-binding)) + nil + (setq bytecomp-int `(interactive ,newform))))) ((cdr bytecomp-int) (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string bytecomp-int))))) @@ -3826,7 +3830,6 @@ Return the offset in the form (VAR . OFFSET)." (byte-compile-push-constant nil))))) (defun byte-compile-not-lexical-var-p (var) - ;; FIXME: this doesn't catch defcustoms! (or (not (symbolp var)) (special-variable-p var) (memq var byte-compile-bound-variables) @@ -4560,7 +4563,14 @@ Use with caution." (setq f (car f)) (if (string-match "elc\\'" f) (setq f (substring f 0 -1))) (when (and (file-readable-p f) - (file-newer-than-file-p f emacs-file)) + (file-newer-than-file-p f emacs-file) + ;; Don't reload the source version of the files below + ;; because that causes subsequent byte-compilation to + ;; be a lot slower and need a higher max-lisp-eval-depth, + ;; so it can cause recompilation to fail. + (not (member (file-name-nondirectory f) + '("pcase.el" "bytecomp.el" "macroexp.el" + "cconv.el" "byte-opt.el")))) (message "Reloading stale %s" (file-name-nondirectory f)) (condition-case nil (load f 'noerror nil 'nosuffix) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 006e2ef904c..7855193fa3f 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -65,21 +65,54 @@ ;; ;;; Code: -;;; TODO: -;; - pay attention to `interactive': its arg is run in an empty env. +;; TODO: ;; - canonize code in macro-expand so we don't have to handle (let (var) body) ;; and other oddities. ;; - Change new byte-code representation, so it directly gives the ;; number of mandatory and optional arguments as well as whether or ;; not there's a &rest arg. -;; - warn about unused lexical vars. ;; - clean up cconv-closure-convert-rec, especially the `let' binding part. ;; - new byte codes for unwind-protect, catch, and condition-case so that ;; closures aren't needed at all. +;; - a reference to a var that is known statically to always hold a constant +;; should be turned into a byte-constant rather than a byte-stack-ref. +;; Hmm... right, that's called constant propagation and could be done here +;; But when that constant is a function, we have to be careful to make sure +;; 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 bytecompiler. + +;; (defmacro dlet (binders &rest body) +;; ;; Works in both lexical and non-lexical mode. +;; `(progn +;; ,@(mapcar (lambda (binder) +;; `(defvar ,(if (consp binder) (car binder) binder))) +;; binders) +;; (let ,binders ,@body))) + +;; (defmacro llet (binders &rest body) +;; ;; Only works in lexical-binding mode. +;; `(funcall +;; (lambda ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder)) +;; binders) +;; ,@body) +;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder))) +;; binders))) + +;; (defmacro letrec (binders &rest body) +;; ;; Only useful in lexical-binding mode. +;; ;; As a special-form, we could implement it more efficiently (and cleanly, +;; ;; making the vars actually unbound during evaluation of the binders). +;; `(let ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder)) +;; binders) +;; ,@(delq nil (mapcar (lambda (binder) (if (consp binder) `(setq ,@binder))) +;; binders)) +;; ,@body)) (eval-when-compile (require 'cl)) -(defconst cconv-liftwhen 3 +(defconst cconv-liftwhen 6 "Try to do lambda lifting if the number of arguments + free variables is less than this number.") ;; List of all the variables that are both captured by a closure @@ -212,13 +245,13 @@ Returns a form where all lambdas don't have any free variables." ;; This function actually rewrites the tree. "Eliminates all free variables of all lambdas in given forms. Arguments: --- FORM is a piece of Elisp code after macroexpansion. --- LMENVS is a list of environments used for lambda-lifting. Initially empty. --- EMVRS is a list that contains mutated variables that are visible +- FORM is a piece of Elisp code after macroexpansion. +- LMENVS is a list of environments used for lambda-lifting. Initially empty. +- EMVRS is a list that contains mutated variables that are visible within current environment. --- ENVS is an environment(list of free variables) of current closure. +- ENVS is an environment(list of free variables) of current closure. Initially empty. --- FVRS is a list of variables to substitute in each context. +- FVRS is a list of variables to substitute in each context. Initially empty. Returns a form where all lambdas don't have any free variables." @@ -270,10 +303,17 @@ Returns a form where all lambdas don't have any free variables." ; lambda lifting condition (if (or (not fv) (< cconv-liftwhen (length funcvars))) ; do not lift - (cconv-closure-convert-rec - value emvrs fvrs envs lmenvs) + (progn + ;; (byte-compile-log-warning + ;; (format "Not λ-lifting `%S': %d > %d" + ;; var (length funcvars) cconv-liftwhen)) + + (cconv-closure-convert-rec + value emvrs fvrs envs lmenvs)) ; lift (progn + ;; (byte-compile-log-warning + ;; (format "λ-lifting `%S'" var)) (setq cconv-freevars-alist ;; Now that we know we'll λ-lift, consume the ;; freevar data. @@ -579,6 +619,12 @@ Returns a form where all lambdas don't have any free variables." cdr-new)) `(,callsym . ,(reverse cdr-new)))))) + (`(interactive . ,forms) + `(interactive + ,@(mapcar (lambda (form) + (cconv-closure-convert-rec form nil nil nil nil)) + forms))) + (`(,func . ,body-forms) ; first element is function or whatever ; function-like forms are: ; or, and, if, progn, prog1, prog2, @@ -608,23 +654,34 @@ Returns a form where all lambdas don't have any free variables." ;; Only used to test the code in non-lexbind Emacs. (defalias 'byte-compile-not-lexical-var-p 'boundp)) -(defun cconv-analyse-use (vardata form) +(defun cconv-analyse-use (vardata form varkind) + "Analyse the use of a variable. +VARDATA should be (BINDER READ MUTATED CAPTURED CALLED). +VARKIND is the name of the kind of variable. +FORM is the parent form that binds this var." ;; use = `(,binder ,read ,mutated ,captured ,called) (pcase vardata - (`(,binder nil ,_ ,_ nil) - ;; FIXME: Don't warn about unused fun-args. - ;; FIXME: Don't warn about uninterned vars or _ vars. - ;; FIXME: This gives warnings in the wrong order and with wrong line - ;; number and without function name info. - (byte-compile-log-warning (format "Unused variable %S" (car binder)))) + (`(,_ nil nil nil nil) nil) + (`((,(and (pred (lambda (var) (eq ?_ (aref (symbol-name var) 0)))) var) . ,_) + ,_ ,_ ,_ ,_) + (byte-compile-log-warning (format "%s `%S' not left unused" varkind var))) + ((or `(,_ ,_ ,_ ,_ ,_) dontcare) nil)) + (pcase vardata + (`((,var . ,_) nil ,_ ,_ nil) + ;; FIXME: This gives warnings in the wrong order, with imprecise line + ;; numbers and without function name info. + (unless (or ;; Uninterned symbols typically come from macro-expansion, so + ;; it is often non-trivial for the programmer to avoid such + ;; unused vars. + (not (intern-soft var)) + (eq ?_ (aref (symbol-name var) 0))) + (byte-compile-log-warning (format "Unused lexical %s `%S'" + varkind var)))) ;; If it's unused, there's no point converting it into a cons-cell, even if - ;; it's captures and mutated. + ;; it's captured and mutated. (`(,binder ,_ t t ,_) (push (cons binder form) cconv-captured+mutated)) (`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t) - ;; This is very rare in typical Elisp code. It's probably not really - ;; worth the trouble to try and use lambda-lifting in Elisp, but - ;; since we coded it up, we might as well use it. (push (cons binder form) cconv-lambda-candidates)) (`(,_ ,_ ,_ ,_ ,_) nil) (dontcare))) @@ -654,7 +711,7 @@ Returns a form where all lambdas don't have any free variables." (cconv-analyse-form form newenv)) ;; Summarize resulting data about arguments. (dolist (vardata newvars) - (cconv-analyse-use vardata parentform)) + (cconv-analyse-use vardata parentform "argument")) ;; Transfer uses collected in `envcopy' (via `newenv') back to `env'; ;; and compute free variables. (while env @@ -673,8 +730,8 @@ Returns a form where all lambdas don't have any free variables." (defun cconv-analyse-form (form env) "Find mutated variables and variables captured by closure. Analyse lambdas if they are suitable for lambda lifting. --- FORM is a piece of Elisp code after macroexpansion. --- ENV is an alist mapping each enclosing lexical variable to its info. +- FORM is a piece of Elisp code after macroexpansion. +- ENV is an alist mapping each enclosing lexical variable to its info. I.e. each element has the form (VAR . (READ MUTATED CAPTURED CALLED)). This function does not return anything but instead fills the `cconv-captured+mutated' and `cconv-lambda-candidates' variables @@ -707,7 +764,7 @@ and updates the data stored in ENV." (cconv-analyse-form form env)) (dolist (vardata newvars) - (cconv-analyse-use vardata form)))) + (cconv-analyse-use vardata form "variable")))) ; defun special form (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms) @@ -736,8 +793,7 @@ and updates the data stored in ENV." (`(cond . ,cond-forms) ; cond special form (dolist (forms cond-forms) - (dolist (form forms) - (cconv-analyse-form form env)))) + (dolist (form forms) (cconv-analyse-form form env)))) (`(quote . ,_) nil) ; quote form (`(function . ,_) nil) ; same as quote @@ -773,12 +829,18 @@ and updates the data stored in ENV." (if fdata (setf (nth 4 fdata) t) (cconv-analyse-form fun env))) - (dolist (form args) - (cconv-analyse-form form env))) - + (dolist (form args) (cconv-analyse-form form env))) + + (`(interactive . ,forms) + ;; These appear within the function body but they don't have access + ;; to the function's arguments. + ;; We could extend this to allow interactive specs to refer to + ;; variables in the function's enclosing environment, but it doesn't + ;; seem worth the trouble. + (dolist (form forms) (cconv-analyse-form form nil))) + (`(,_ . ,body-forms) ; First element is a function or whatever. - (dolist (form body-forms) - (cconv-analyse-form form env))) + (dolist (form body-forms) (cconv-analyse-form form env))) ((pred symbolp) (let ((dv (assq form env))) ; dv = declared and visible diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index d795dbd390c..89bbff980c4 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -431,7 +431,7 @@ and otherwise defers to REST which is a list of branches of the form rest))))))) ((eq 'match (caar matches)) (let* ((popmatches (pop matches)) - (op (car popmatches)) (cdrpopmatches (cdr popmatches)) + (_op (car popmatches)) (cdrpopmatches (cdr popmatches)) (sym (car cdrpopmatches)) (upat (cdr cdrpopmatches))) (cond @@ -520,7 +520,7 @@ and otherwise defers to REST which is a list of branches of the form (pcase--u1 `((match ,sym . ,(cadr upat))) ;; FIXME: This codegen is not careful to share its ;; code if used several times: code blow up is likely. - (lambda (vars) + (lambda (_vars) ;; `vars' will likely contain bindings which are ;; not always available in other paths to ;; `rest', so there' no point trying to pass diff --git a/lisp/help-fns.el b/lisp/help-fns.el index b488bc40acd..87fb6a02bd3 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -119,8 +119,11 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." (cdr arg)) arg) (let ((name (symbol-name arg))) - (if (string-match "\\`&" name) arg - (intern (upcase name)))))) + (cond + ((string-match "\\`&" name) arg) + ((string-match "\\`_" name) + (intern (upcase (substring name 1)))) + (t (intern (upcase name))))))) arglist))) ;; Could be this, if we make symbol-file do the work below. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 392ec2d3dad..531a0e26eaf 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -210,7 +210,7 @@ You should give VAR a non-nil `risky-local-variable' property." ((vectorp table) ;Obarray. (lambda (sym) (funcall pred (concat prefix (symbol-name sym))))) ((hash-table-p table) - (lambda (s v) (funcall pred (concat prefix s)))) + (lambda (s _v) (funcall pred (concat prefix s)))) ((functionp table) (lambda (s) (funcall pred (concat prefix s)))) (t ;Lists and alists. @@ -681,7 +681,7 @@ scroll the window of possible completions." t) (t t))))) -(defun completion--flush-all-sorted-completions (&rest ignore) +(defun completion--flush-all-sorted-completions (&rest _ignore) (setq completion-cycling nil) (setq completion-all-sorted-completions nil)) @@ -1313,7 +1313,7 @@ The completion method is determined by `completion-at-point-functions'." (concat "\\(?:^\\|[^$]\\(?:\\$\\$\\)*\\)" "$\\([[:alnum:]_]*\\|{\\([^}]*\\)\\)\\'")) -(defun completion--embedded-envvar-table (string pred action) +(defun completion--embedded-envvar-table (string _pred action) "Completion table for envvars embedded in a string. The envvar syntax (and escaping) rules followed by this table are the same as `substitute-in-file-name'." @@ -1726,13 +1726,13 @@ Like `internal-complete-buffer', but removes BUFFER from the completion list." ;;; Old-style completion, used in Emacs-21 and Emacs-22. -(defun completion-emacs21-try-completion (string table pred point) +(defun completion-emacs21-try-completion (string table pred _point) (let ((completion (try-completion string table pred))) (if (stringp completion) (cons completion (length completion)) completion))) -(defun completion-emacs21-all-completions (string table pred point) +(defun completion-emacs21-all-completions (string table pred _point) (completion-hilit-commonality (all-completions string table pred) (length string) @@ -1817,7 +1817,7 @@ Return the new suffix." (let* ((beforepoint (substring string 0 point)) (afterpoint (substring string point)) (bounds (completion-boundaries beforepoint table pred afterpoint)) - (suffix (substring afterpoint (cdr bounds))) + ;; (suffix (substring afterpoint (cdr bounds))) (prefix (substring beforepoint 0 (car bounds))) (pattern (delete "" (list (substring beforepoint (car bounds)) @@ -2006,7 +2006,7 @@ filter out additional entries (because TABLE migth not obey PRED)." ;; The prefix has no completions at all, so we should try and fix ;; that first. (let ((substring (substring prefix 0 -1))) - (destructuring-bind (subpat suball subprefix subsuffix) + (destructuring-bind (subpat suball subprefix _subsuffix) (completion-pcm--find-all-completions substring table pred (length substring) filter) (let ((sep (aref prefix (1- (length prefix)))) @@ -2071,7 +2071,7 @@ filter out additional entries (because TABLE migth not obey PRED)." (list pattern all prefix suffix))))) (defun completion-pcm-all-completions (string table pred point) - (destructuring-bind (pattern all &optional prefix suffix) + (destructuring-bind (pattern all &optional prefix _suffix) (completion-pcm--find-all-completions string table pred point) (when all (nconc (completion-pcm--hilit-commonality pattern all) @@ -2246,14 +2246,14 @@ filter out additional entries (because TABLE migth not obey PRED)." (list all pattern prefix suffix (car bounds)))) (defun completion-substring-try-completion (string table pred point) - (destructuring-bind (all pattern prefix suffix carbounds) + (destructuring-bind (all pattern prefix suffix _carbounds) (completion-substring--all-completions string table pred point) (if minibuffer-completing-file-name (setq all (completion-pcm--filename-try-filter all))) (completion-pcm--merge-try pattern all prefix suffix))) (defun completion-substring-all-completions (string table pred point) - (destructuring-bind (all pattern prefix suffix carbounds) + (destructuring-bind (all pattern prefix _suffix _carbounds) (completion-substring--all-completions string table pred point) (when all (nconc (completion-pcm--hilit-commonality pattern all) @@ -2290,12 +2290,12 @@ filter out additional entries (because TABLE migth not obey PRED)." (concat (substring str 0 (car bounds)) (mapconcat 'string (substring str (car bounds)) sep)))))))) -(defun completion-initials-all-completions (string table pred point) +(defun completion-initials-all-completions (string table pred _point) (let ((newstr (completion-initials-expand string table pred))) (when newstr (completion-pcm-all-completions newstr table pred (length newstr))))) -(defun completion-initials-try-completion (string table pred point) +(defun completion-initials-try-completion (string table pred _point) (let ((newstr (completion-initials-expand string table pred))) (when newstr (completion-pcm-try-completion newstr table pred (length newstr))))) diff --git a/lisp/mpc.el b/lisp/mpc.el index 548fd17d038..10e8c9d7688 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -357,14 +357,14 @@ which will be concatenated with proper quoting before passing them to MPD." (mapconcat 'mpc--proc-quote-string cmd " ")) "\n"))) (if callback - (let ((buf (current-buffer))) + ;; (let ((buf (current-buffer))) (process-put proc 'callback callback ;; (lambda () ;; (funcall callback ;; (prog1 (current-buffer) - ;; (set-buffer buf)))) - )) + ;; (set-buffer buf))))) + ) ;; If `callback' is nil, we're executing synchronously. (process-put proc 'callback 'ignore) ;; This returns the process's buffer. @@ -600,7 +600,7 @@ The songs are returned as alists." (cond ((eq tag 'Playlist) ;; Special case for pseudo-tag playlist. - (let ((l (condition-case err + (let ((l (condition-case nil (mpc-proc-buf-to-alists (mpc-proc-cmd (list "listplaylistinfo" value))) (mpc-proc-error @@ -633,7 +633,7 @@ The songs are returned as alists." (mpc-union (mpc-cmd-find tag1 value) (mpc-cmd-find tag2 value)))) (t - (condition-case err + (condition-case nil (mpc-proc-buf-to-alists (mpc-proc-cmd (list "find" (symbol-name tag) value))) (mpc-proc-error @@ -935,7 +935,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (defun mpc-tempfiles-clean () (let ((live ())) - (maphash (lambda (k v) (push v live)) mpc-tempfiles-reftable) + (maphash (lambda (_k v) (push v live)) mpc-tempfiles-reftable) (dolist (f mpc-tempfiles) (unless (member f live) (ignore-errors (delete-file f)))) (setq mpc-tempfiles live))) @@ -1159,7 +1159,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (mpc-status-mode)) (mpc-proc-buffer (mpc-proc) 'status buf)) (if (null songs-win) (pop-to-buffer buf) - (let ((win (split-window songs-win 20 t))) + (let ((_win (split-window songs-win 20 t))) (set-window-dedicated-p songs-win nil) (set-window-buffer songs-win buf) (set-window-dedicated-p songs-win 'soft))))) @@ -2385,15 +2385,13 @@ This is used so that they can be compared with `eq', which is needed for (mpc--faster-stop) (mpc-status-refresh) (mpc-proc-sync) (let* (songid ;The ID of the currently ffwd/rewinding song. - songnb ;The position of that song in the playlist. songduration ;The duration of that song. songtime ;The time of the song last time we ran. oldtime ;The timeoftheday last time we ran. prevsongid) ;The song we're in the process leaving. (let ((fun (lambda () - (let ((newsongid (cdr (assq 'songid mpc-status))) - (newsongnb (cdr (assq 'song mpc-status)))) + (let ((newsongid (cdr (assq 'songid mpc-status)))) (if (and (equal prevsongid newsongid) (not (equal prevsongid songid))) @@ -2444,8 +2442,7 @@ This is used so that they can be compared with `eq', which is needed for (mpc-proc-cmd (list "seekid" songid songtime) 'mpc-status-refresh) - (mpc-proc-error (mpc-status-refresh))))))) - (setq songnb newsongnb))))) + (mpc-proc-error (mpc-status-refresh))))))))))) (setq mpc--faster-toggle-forward (> step 0)) (funcall fun) ;Initialize values. (setq mpc--faster-toggle-timer diff --git a/lisp/server.el b/lisp/server.el index 79204b3cb8e..019a16a43d7 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -418,10 +418,11 @@ If CLIENT is non-nil, add a description of it to the logged message." (server-delete-client proc 'noframe)))) ; Let delete-frame delete the frame later. (defun server-handle-suspend-tty (terminal) - "Notify the emacsclient process to suspend itself when its tty device is suspended." + "Notify the client process that its tty device is suspended." (dolist (proc (server-clients-with 'terminal terminal)) - (server-log (format "server-handle-suspend-tty, terminal %s" terminal) proc) - (condition-case err + (server-log (format "server-handle-suspend-tty, terminal %s" terminal) + proc) + (condition-case nil (server-send-string proc "-suspend \n") (file-error ;The pipe/socket was closed. (ignore-errors (server-delete-client proc)))))) @@ -1207,7 +1208,10 @@ so don't mark these buffers specially, just visit them normally." (process-put proc 'buffers (nconc (process-get proc 'buffers) client-record))) client-record)) - + +(defvar server-kill-buffer-running nil + "Non-nil while `server-kill-buffer' or `server-buffer-done' is running.") + (defun server-buffer-done (buffer &optional for-killing) "Mark BUFFER as \"done\" for its client(s). This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED). @@ -1329,9 +1333,6 @@ specifically for the clients and did not exist before their request for it." (setq live-client t)))) (yes-or-no-p "This Emacs session has clients; exit anyway? "))) -(defvar server-kill-buffer-running nil - "Non-nil while `server-kill-buffer' or `server-buffer-done' is running.") - (defun server-kill-buffer () "Remove the current buffer from its clients' buffer list. Designed to be added to `kill-buffer-hook'." |