diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/byte-run.el | 26 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 26 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cconv.el | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 61 | ||||
| -rw-r--r-- | lisp/emacs-lisp/debug.el | 18 | ||||
| -rw-r--r-- | lisp/emacs-lisp/lisp.el | 5 | ||||
| -rw-r--r-- | lisp/emacs-lisp/testcover.el | 2 |
7 files changed, 90 insertions, 58 deletions
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index c76cdffd62f..f79add14836 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -120,13 +120,13 @@ convention was modified." The warning will say that CURRENT-NAME should be used instead. If CURRENT-NAME is a string, that is the `use instead' message \(it should end with a period, and not start with a capital). -If provided, WHEN should be a string indicating when the function +WHEN should be a string indicating when the function was first made obsolete, for example a date or a release number." (interactive "aMake function obsolete: \nxObsoletion replacement: ") (put obsolete-name 'byte-obsolete-info ;; The second entry used to hold the `byte-compile' handler, but ;; is not used any more nowadays. - (list (purecopy current-name) nil (purecopy when))) + (purecopy (list current-name nil when))) obsolete-name) (set-advertised-calling-convention ;; New code should always provide the `when' argument. @@ -153,27 +153,21 @@ See the docstrings of `defalias' and `make-obsolete' for more details." 'define-obsolete-function-alias '(obsolete-name current-name when &optional docstring) "23.1") -(defun make-obsolete-variable (obsolete-name current-name &optional when) +(defun make-obsolete-variable (obsolete-name current-name &optional when access-type) "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. The warning will say that CURRENT-NAME should be used instead. If CURRENT-NAME is a string, that is the `use instead' message. -If provided, WHEN should be a string indicating when the variable -was first made obsolete, for example a date or a release number." - (interactive - (list - (let ((str (completing-read "Make variable obsolete: " obarray 'boundp t))) - (if (equal str "") (error "")) - (intern str)) - (car (read-from-string (read-string "Obsoletion replacement: "))))) +WHEN should be a string indicating when the variable +was first made obsolete, for example a date or a release number. +ACCESS-TYPE if non-nil should specify the kind of access that will trigger + obsolescence warnings; it can be either `get' or `set'." (put obsolete-name 'byte-obsolete-variable - (cons - (if (stringp current-name) - (purecopy current-name) - current-name) (purecopy when))) + (purecopy (list current-name access-type when))) obsolete-name) (set-advertised-calling-convention ;; New code should always provide the `when' argument. - 'make-obsolete-variable '(obsolete-name current-name when) "23.1") + 'make-obsolete-variable + '(obsolete-name current-name when &optional access-type) "23.1") (defmacro define-obsolete-variable-alias (obsolete-name current-name &optional when docstring) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 0dae6748c24..1e7ee315942 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1109,7 +1109,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (let* ((funcp (get symbol 'byte-obsolete-info)) (obsolete (or funcp (get symbol 'byte-obsolete-variable))) (instead (car obsolete)) - (asof (if funcp (nth 2 obsolete) (cdr obsolete)))) + (asof (nth 2 obsolete))) (unless (and funcp (memq symbol byte-compile-not-obsolete-funcs)) (byte-compile-warn "`%s' is an obsolete %s%s%s" symbol (if funcp "function" "variable") @@ -2991,7 +2991,7 @@ That command is designed for interactive use only" fn)) (cond ((<= (+ alen alen) fmax2) ;; Add missing &optional (or &rest) arguments. - (dotimes (i (- (/ (1+ fmax2) 2) alen)) + (dotimes (_ (- (/ (1+ fmax2) 2) alen)) (byte-compile-push-constant nil))) ((zerop (logand fmax2 1)) (byte-compile-log-warning "Too many arguments for inlined function" @@ -3016,20 +3016,24 @@ That command is designed for interactive use only" fn)) (assert (eq byte-compile-depth (1+ start-depth)) nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth))) -(defun byte-compile-check-variable (var &optional binding) - "Do various error checks before a use of the variable VAR. -If BINDING is non-nil, VAR is being bound." +(defun byte-compile-check-variable (var access-type) + "Do various error checks before a use of the variable VAR." (when (symbolp var) (byte-compile-set-symbol-position var)) (cond ((or (not (symbolp var)) (byte-compile-const-symbol-p var)) (when (byte-compile-warning-enabled-p 'constants) - (byte-compile-warn (if binding + (byte-compile-warn (if (eq access-type 'let-bind) "attempt to let-bind %s `%s`" "variable reference to %s `%s'") (if (symbolp var) "constant" "nonvariable") (prin1-to-string var)))) - ((and (get var 'byte-obsolete-variable) - (not (memq var byte-compile-not-obsolete-vars))) + ((let ((od (get var 'byte-obsolete-variable))) + (and od + (not (memq var byte-compile-not-obsolete-vars)) + (or (case (nth 1 od) + (set (not (eq access-type 'reference))) + (get (eq access-type 'reference)) + (t t))))) (byte-compile-warn-obsolete var)))) (defsubst byte-compile-dynamic-variable-op (base-op var) @@ -3041,13 +3045,13 @@ If BINDING is non-nil, VAR is being bound." (defun byte-compile-dynamic-variable-bind (var) "Generate code to bind the lexical variable VAR to the top-of-stack value." - (byte-compile-check-variable var t) + (byte-compile-check-variable var 'let-bind) (push var byte-compile-bound-variables) (byte-compile-dynamic-variable-op 'byte-varbind var)) (defun byte-compile-variable-ref (var) "Generate code to push the value of the variable VAR on the stack." - (byte-compile-check-variable var) + (byte-compile-check-variable var 'reference) (let ((lex-binding (assq var byte-compile--lexical-environment))) (if lex-binding ;; VAR is lexically bound @@ -3063,7 +3067,7 @@ If BINDING is non-nil, VAR is being bound." (defun byte-compile-variable-set (var) "Generate code to set the variable VAR from the top-of-stack value." - (byte-compile-check-variable var) + (byte-compile-check-variable var 'assign) (let ((lex-binding (assq var byte-compile--lexical-environment))) (if lex-binding ;; VAR is lexically bound diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 38584c437b8..742a98f5e7b 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -112,16 +112,6 @@ ;; ,@(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 6 diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 9ce3dd6a7fe..2813cc4f065 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1236,14 +1236,29 @@ Then evaluate RESULT to get return value, default nil. \(fn (VAR LIST [RESULT]) BODY...)" (let ((temp (make-symbol "--cl-dolist-temp--"))) - (list 'block nil - (list* 'let (list (list temp (nth 1 spec)) (car spec)) - (list* 'while temp (list 'setq (car spec) (list 'car temp)) - (append body (list (list 'setq temp - (list 'cdr temp))))) - (if (cdr (cdr spec)) - (cons (list 'setq (car spec) nil) (cdr (cdr spec))) - '(nil)))))) + ;; FIXME: Copy&pasted from subr.el. + `(block nil + ;; This is not a reliable test, but it does not matter because both + ;; semantics are acceptable, tho one is slightly faster with dynamic + ;; scoping and the other is slightly faster (and has cleaner semantics) + ;; with lexical scoping. + ,(if lexical-binding + `(let ((,temp ,(nth 1 spec))) + (while ,temp + (let ((,(car spec) (car ,temp))) + ,@body + (setq ,temp (cdr ,temp)))) + ,@(if (cdr (cdr spec)) + ;; FIXME: This let often leads to "unused var" warnings. + `((let ((,(car spec) nil)) ,@(cdr (cdr spec)))))) + `(let ((,temp ,(nth 1 spec)) + ,(car spec)) + (while ,temp + (setq ,(car spec) (car ,temp)) + ,@body + (setq ,temp (cdr ,temp))) + ,@(if (cdr (cdr spec)) + `((setq ,(car spec) nil) ,@(cddr spec)))))))) ;;;###autoload (defmacro dotimes (spec &rest body) @@ -1253,12 +1268,30 @@ to COUNT, exclusive. Then evaluate RESULT to get return value, default nil. \(fn (VAR COUNT [RESULT]) BODY...)" - (let ((temp (make-symbol "--cl-dotimes-temp--"))) - (list 'block nil - (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0)) - (list* 'while (list '< (car spec) temp) - (append body (list (list 'incf (car spec))))) - (or (cdr (cdr spec)) '(nil)))))) + (let ((temp (make-symbol "--cl-dotimes-temp--")) + (end (nth 1 spec))) + ;; FIXME: Copy&pasted from subr.el. + `(block nil + ;; This is not a reliable test, but it does not matter because both + ;; semantics are acceptable, tho one is slightly faster with dynamic + ;; scoping and the other has cleaner semantics. + ,(if lexical-binding + (let ((counter '--dotimes-counter--)) + `(let ((,temp ,end) + (,counter 0)) + (while (< ,counter ,temp) + (let ((,(car spec) ,counter)) + ,@body) + (setq ,counter (1+ ,counter))) + ,@(if (cddr spec) + ;; FIXME: This let often leads to "unused var" warnings. + `((let ((,(car spec) ,counter)) ,@(cddr spec)))))) + `(let ((,temp ,end) + (,(car spec) 0)) + (while (< ,(car spec) ,temp) + ,@body + (incf ,(car spec))) + ,@(cdr (cdr spec))))))) ;;;###autoload (defmacro do-symbols (spec &rest body) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 88633eaaa46..28962595ace 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -118,6 +118,10 @@ first will be printed into the backtrace buffer." (let (debugger-value (debug-on-error nil) (debug-on-quit nil) + (debugger-previous-state + (if (get-buffer "*Backtrace*") + (with-current-buffer (get-buffer "*Backtrace*") + (list major-mode (buffer-string))))) (debugger-buffer (get-buffer-create "*Backtrace*")) (debugger-old-buffer (current-buffer)) (debugger-step-after-exit nil) @@ -214,8 +218,6 @@ first will be printed into the backtrace buffer." ;; recreate it every time the debugger stops, so instead we'll ;; erase it (and maybe hide it) but keep it alive. (with-current-buffer debugger-buffer - (erase-buffer) - (fundamental-mode) (with-selected-window (get-buffer-window debugger-buffer 0) (when (and (window-dedicated-p (selected-window)) (not debugger-will-be-back)) @@ -232,7 +234,17 @@ first will be printed into the backtrace buffer." ;; to be left at the top-level, still working on how ;; best to do that. (bury-buffer)))) - (kill-buffer debugger-buffer)) + (unless debugger-previous-state + (kill-buffer debugger-buffer))) + ;; Restore the previous state of the debugger-buffer, in case we were + ;; in a recursive invocation of the debugger. + (when (and debugger-previous-state + (buffer-live-p debugger-buffer)) + (with-current-buffer debugger-buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (nth 1 debugger-previous-state)) + (funcall (nth 0 debugger-previous-state))))) (with-timeout-unsuspend debugger-with-timeout-suspend) (set-match-data debugger-outer-match-data))) ;; Put into effect the modified values of these variables diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index ece96fe2515..db6a03333d4 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -636,9 +636,8 @@ considered." (plist (nthcdr 3 data))) (if (null data) (minibuffer-message "Nothing to complete") - (let ((completion-annotate-function - (plist-get plist :annotation-function))) - (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data) + (let ((completion-extra-properties plist)) + (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data) (plist-get plist :predicate)))))) diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index 08f757819f2..2f168180cf6 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -430,7 +430,7 @@ FUN should be `testcover-reinstrument' for compositional functions, "Turn off instrumentation of all macros and functions in FILENAME." (interactive "fStop covering file: ") (let ((buf (find-file-noselect filename))) - (eval-buffer buf t))) + (eval-buffer buf))) ;;;========================================================================= |