diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/chart.el | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 8 | ||||
| -rw-r--r-- | lisp/emacs-lisp/copyright.el | 26 | ||||
| -rw-r--r-- | lisp/emacs-lisp/crm.el | 62 | ||||
| -rw-r--r-- | lisp/emacs-lisp/debug.el | 8 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eldoc.el | 41 | ||||
| -rw-r--r-- | lisp/emacs-lisp/ert.el | 9 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package.el | 5 |
9 files changed, 85 insertions, 86 deletions
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 032eced7592..e05c28f23d5 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -1,7 +1,7 @@ ;;; chart.el --- Draw charts (bar charts, etc) -*- lexical-binding: t -*- -;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2013 Free -;; Software Foundation, Inc. +;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2013 +;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.2 @@ -86,10 +86,10 @@ Useful if new Emacs is used on B&W display.") :group 'eieio :type 'boolean) +(declare-function x-display-color-cells "xfns.c" (&optional terminal)) + (defvar chart-face-list - (if (if (fboundp 'display-color-p) - (display-color-p) - window-system) + (if (display-color-p) (let ((cl chart-face-color-list) (pl chart-face-pixmap-list) (faces ()) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index af7c41d5c4c..031bf5553d0 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -209,6 +209,8 @@ The name is made by appending a number to PREFIX, default \"G\"." (def-edebug-spec cl-&key-arg (&or ([&or (symbolp arg) arg] &optional def-form arg) arg)) +(def-edebug-spec cl-type-spec sexp) + (defconst cl--lambda-list-keywords '(&optional &rest &key &allow-other-keys &aux &whole &body &environment)) @@ -2701,8 +2703,10 @@ The function's arguments should be treated as immutable. \(fn NAME ARGLIST [DOCSTRING] BODY...)" (declare (debug cl-defun) (indent 2)) - (let* ((argns (cl--arglist-args args)) (p argns) - (pbody (cons 'progn body))) + (let* ((argns (cl--arglist-args args)) + (p argns) + ;; (pbody (cons 'progn body)) + ) (while (and p (eq (cl--expr-contains args (car p)) 1)) (pop p)) `(progn ,(if p nil ; give up if defaults refer to earlier args diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index b3fc6fb887a..2b2189e70e3 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -1,7 +1,6 @@ ;;; copyright.el --- update the copyright notice in current buffer -;; Copyright (C) 1991-1995, 1998, 2001-2013 Free Software Foundation, -;; Inc. +;; Copyright (C) 1991-1995, 1998, 2001-2013 Free Software Foundation, Inc. ;; Author: Daniel Pfeiffer <occitan@esperanto.org> ;; Keywords: maint, tools @@ -145,18 +144,17 @@ The header must match `copyright-regexp' and `copyright-names-regexp', if set. This function sets the match-data that `copyright-update-year' uses." (widen) (goto-char (copyright-start-point)) - (condition-case err - ;; (1) Need the extra \\( \\) around copyright-regexp because we - ;; goto (match-end 1) below. See note (2) below. - (copyright-re-search (concat "\\(" copyright-regexp - "\\)\\([ \t]*\n\\)?.*\\(?:" - copyright-names-regexp "\\)") - (copyright-limit) - t) - ;; In case the regexp is rejected. This is useful because - ;; copyright-update is typically called from before-save-hook where - ;; such an error is very inconvenient for the user. - (error (message "Can't update copyright: %s" err) nil))) + ;; In case the regexp is rejected. This is useful because + ;; copyright-update is typically called from before-save-hook where + ;; such an error is very inconvenient for the user. + (with-demoted-errors "Can't update copyright: %s" + ;; (1) Need the extra \\( \\) around copyright-regexp because we + ;; goto (match-end 1) below. See note (2) below. + (copyright-re-search (concat "\\(" copyright-regexp + "\\)\\([ \t]*\n\\)?.*\\(?:" + copyright-names-regexp "\\)") + (copyright-limit) + t))) (defun copyright-find-end () "Possibly adjust the search performed by `copyright-find-copyright'. diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index b8e327625e7..750e0709591 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -157,33 +157,32 @@ Functions'." predicate flag))) -(defun crm--select-current-element () +(defun crm--current-element () "Parse the minibuffer to find the current element. -Place an overlay on the element, with a `field' property, and return it." - (let* ((bob (minibuffer-prompt-end)) - (start (save-excursion +Return the element's boundaries as (START . END)." + (let ((bob (minibuffer-prompt-end))) + (cons (save-excursion (if (re-search-backward crm-separator bob t) (match-end 0) - bob))) - (end (save-excursion + bob)) + (save-excursion (if (re-search-forward crm-separator nil t) (match-beginning 0) - (point-max)))) - (ol (make-overlay start end nil nil t))) - (overlay-put ol 'field (make-symbol "crm")) - ol)) - -(defmacro crm--completion-command (command) - "Make COMMAND a completion command for `completing-read-multiple'." - `(let ((ol (crm--select-current-element))) - (unwind-protect - ,command - (delete-overlay ol)))) + (point-max)))))) + +(defmacro crm--completion-command (beg end &rest body) + "Run BODY with BEG and END bound to the current element's boundaries." + (declare (indent 2) (debug (sexp sexp &rest body))) + `(let* ((crm--boundaries (crm--current-element)) + (,beg (car crm--boundaries)) + (,end (cdr crm--boundaries))) + ,@body)) (defun crm-completion-help () "Display a list of possible completions of the current minibuffer element." (interactive) - (crm--completion-command (minibuffer-completion-help)) + (crm--completion-command beg end + (minibuffer-completion-help beg end)) nil) (defun crm-complete () @@ -192,13 +191,18 @@ If no characters can be completed, display a list of possible completions. Return t if the current element is now a valid match; otherwise return nil." (interactive) - (crm--completion-command (minibuffer-complete))) + (crm--completion-command beg end + (completion-in-region beg end + minibuffer-completion-table + minibuffer-completion-predicate))) (defun crm-complete-word () "Complete the current element at most a single word. Like `minibuffer-complete-word' but for `completing-read-multiple'." (interactive) - (crm--completion-command (minibuffer-complete-word))) + (crm--completion-command beg end + (completion-in-region--single-word + beg end minibuffer-completion-table minibuffer-completion-predicate))) (defun crm-complete-and-exit () "If all of the minibuffer elements are valid completions then exit. @@ -211,16 +215,14 @@ This function is modeled after `minibuffer-complete-and-exit'." (goto-char (minibuffer-prompt-end)) (while (and doexit - (let ((ol (crm--select-current-element))) - (goto-char (overlay-end ol)) - (unwind-protect - (catch 'exit - (minibuffer-complete-and-exit) - ;; This did not throw `exit', so there was a problem. - (setq doexit nil)) - (goto-char (overlay-end ol)) - (delete-overlay ol)) - (not (eobp))) + (crm--completion-command beg end + (let ((end (copy-marker end t))) + (goto-char end) + (setq doexit nil) + (completion-complete-and-exit beg end + (lambda () (setq doexit t))) + (goto-char end) + (not (eobp)))) (looking-at crm-separator)) ;; Skip to the next element. (goto-char (match-end 0))) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 709a094e73b..6c7a0d2db1d 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -626,7 +626,7 @@ The environment used is the one when entering the activation frame at point." (put 'debugger-mode 'mode-class 'special) -(defun debugger-mode () +(define-derived-mode debugger-mode fundamental-mode "Debugger" "Mode for backtrace buffers, selected in debugger. \\<debugger-mode-map> A line starts with `*' if exiting that frame will call the debugger. @@ -641,13 +641,9 @@ which functions will enter the debugger when called. Complete list of commands: \\{debugger-mode-map}" - (kill-all-local-variables) - (setq major-mode 'debugger-mode) - (setq mode-name "Debugger") (setq truncate-lines t) (set-syntax-table emacs-lisp-mode-syntax-table) - (use-local-map debugger-mode-map) - (run-mode-hooks 'debugger-mode-hook)) + (use-local-map debugger-mode-map)) (defcustom debugger-record-buffer "*Debugger-record*" "Buffer name for expression values, for \\[debugger-record-expression]." diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index fc5da3198f9..46381ede9d1 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -322,7 +322,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function." (defmacro eieio-class-parent (class) "Return first parent class to CLASS. (overload of variable)." `(car (eieio-class-parents ,class))) -(define-obsolete-function-alias 'class-parent #'eieio-class-parent "24.4") +(define-obsolete-function-alias 'class-parent 'eieio-class-parent "24.4") (defun same-class-p (obj class) "Return t if OBJ is of class-type CLASS." (eieio--check-type class-p class) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 9b9fd325941..250f93800ec 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -309,27 +309,26 @@ This variable is expected to be made buffer-local by modes (other than Emacs Lisp mode) that support ElDoc.") (defun eldoc-print-current-symbol-info () - (condition-case err - (and (or (eldoc-display-message-p) eldoc-post-insert-mode) - (if eldoc-documentation-function - (eldoc-message (funcall eldoc-documentation-function)) - (let* ((current-symbol (eldoc-current-symbol)) - (current-fnsym (eldoc-fnsym-in-current-sexp)) - (doc (cond - ((null current-fnsym) - nil) - ((eq current-symbol (car current-fnsym)) - (or (apply 'eldoc-get-fnsym-args-string - current-fnsym) - (eldoc-get-var-docstring current-symbol))) - (t - (or (eldoc-get-var-docstring current-symbol) - (apply 'eldoc-get-fnsym-args-string - current-fnsym)))))) - (eldoc-message doc)))) - ;; This is run from post-command-hook or some idle timer thing, - ;; so we need to be careful that errors aren't ignored. - (error (message "eldoc error: %s" err)))) + ;; This is run from post-command-hook or some idle timer thing, + ;; so we need to be careful that errors aren't ignored. + (with-demoted-errors "eldoc error: %s" + (and (or (eldoc-display-message-p) eldoc-post-insert-mode) + (if eldoc-documentation-function + (eldoc-message (funcall eldoc-documentation-function)) + (let* ((current-symbol (eldoc-current-symbol)) + (current-fnsym (eldoc-fnsym-in-current-sexp)) + (doc (cond + ((null current-fnsym) + nil) + ((eq current-symbol (car current-fnsym)) + (or (apply 'eldoc-get-fnsym-args-string + current-fnsym) + (eldoc-get-var-docstring current-symbol))) + (t + (or (eldoc-get-var-docstring current-symbol) + (apply 'eldoc-get-fnsym-args-string + current-fnsym)))))) + (eldoc-message doc)))))) (defun eldoc-get-fnsym-args-string (sym &optional index) "Return a string containing the parameter list of the function SYM. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 98576687f3d..409e4faf4d5 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -785,7 +785,7 @@ This mainly sets up debugger-related bindings." "Immediately truncate *Messages* buffer according to `message-log-max'. This can be useful after reducing the value of `message-log-max'." - (with-current-buffer (get-buffer-create "*Messages*") + (with-current-buffer (messages-buffer) ;; This is a reimplementation of this part of message_dolog() in xdisp.c: ;; if (NATNUMP (Vmessage_log_max)) ;; { @@ -798,7 +798,8 @@ This can be useful after reducing the value of `message-log-max'." (end (save-excursion (goto-char (point-max)) (forward-line (- message-log-max)) - (point)))) + (point))) + (inhibit-read-only t)) (delete-region begin end))))) (defvar ert--running-tests nil @@ -818,7 +819,7 @@ Returns the result and stores it in ERT-TEST's `most-recent-result' slot." (setf (ert-test-most-recent-result ert-test) nil) (cl-block error (let ((begin-marker - (with-current-buffer (get-buffer-create "*Messages*") + (with-current-buffer (messages-buffer) (point-max-marker)))) (unwind-protect (let ((info (make-ert--test-execution-info @@ -837,7 +838,7 @@ Returns the result and stores it in ERT-TEST's `most-recent-result' slot." (ert--run-test-internal info)) (let ((result (ert--test-execution-info-result info))) (setf (ert-test-result-messages result) - (with-current-buffer (get-buffer-create "*Messages*") + (with-current-buffer (messages-buffer) (buffer-substring begin-marker (point-max)))) (ert--force-message-log-buffer-truncation) (setq should-form-accu (nreverse should-form-accu)) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7799ee23d62..77496bad441 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -597,7 +597,6 @@ EXTRA-PROPERTIES is currently unused." (defvar version-control) (defun package-generate-autoloads (name pkg-dir) - (require 'autoload) ;Load before we let-bind generated-autoload-file! (let* ((auto-name (format "%s-autoloads.el" name)) ;;(ignore-name (concat name "-pkg.el")) (generated-autoload-file (expand-file-name auto-name pkg-dir)) @@ -1523,7 +1522,7 @@ This fetches the contents of each archive specified in `package-archives', and then refreshes the package menu." (interactive) (unless (derived-mode-p 'package-menu-mode) - (error "The current buffer is not a Package Menu")) + (user-error "The current buffer is not a Package Menu")) (package-refresh-contents) (package-menu--generate t t)) @@ -1535,7 +1534,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (tabulated-list-get-id)))) (if pkg-desc (describe-package pkg-desc) - (error "No package here")))) + (user-error "No package here")))) ;; fixme numeric argument (defun package-menu-mark-delete (&optional _num) |