diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 58 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-generic.el | 24 | ||||
| -rw-r--r-- | lisp/emacs-lisp/easy-mmode.el | 1 | ||||
| -rw-r--r-- | lisp/emacs-lisp/edebug.el | 1 | ||||
| -rw-r--r-- | lisp/emacs-lisp/ert.el | 6 | ||||
| -rw-r--r-- | lisp/emacs-lisp/map.el | 17 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package.el | 8 | ||||
| -rw-r--r-- | lisp/emacs-lisp/pcase.el | 47 | ||||
| -rw-r--r-- | lisp/emacs-lisp/seq.el | 12 | ||||
| -rw-r--r-- | lisp/emacs-lisp/tabulated-list.el | 1 | ||||
| -rw-r--r-- | lisp/emacs-lisp/timer-list.el | 111 |
11 files changed, 222 insertions, 64 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 4ee8b37719f..11eb44cea31 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1169,7 +1169,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (display-warning 'bytecomp string level byte-compile-log-buffer))) (defun byte-compile-warn (format &rest args) - "Issue a byte compiler warning; use (format FORMAT ARGS...) for message." + "Issue a byte compiler warning; use (format-message FORMAT ARGS...) for message." (setq format (apply #'format-message format args)) (if byte-compile-error-on-warn (error "%s" format) ; byte-compile-file catches and logs it @@ -1360,31 +1360,33 @@ extra args." (dolist (elt '(format message error)) (put elt 'byte-compile-format-like t)) -;; Warn if a custom definition fails to specify :group. +;; Warn if a custom definition fails to specify :group, or :type. (defun byte-compile-nogroup-warn (form) - (if (and (memq (car form) '(custom-declare-face custom-declare-variable)) - byte-compile-current-group) - ;; The group will be provided implicitly. - nil - (let ((keyword-args (cdr (cdr (cdr (cdr form))))) - (name (cadr form))) - (or (not (eq (car-safe name) 'quote)) - (and (eq (car form) 'custom-declare-group) - (equal name ''emacs)) - (plist-get keyword-args :group) - (not (and (consp name) (eq (car name) 'quote))) - (byte-compile-warn - "%s for `%s' fails to specify containing group" - (cdr (assq (car form) - '((custom-declare-group . defgroup) - (custom-declare-face . defface) - (custom-declare-variable . defcustom)))) - (cadr name))) - ;; Update the current group, if needed. - (if (and byte-compile-current-file ;Only when compiling a whole file. - (eq (car form) 'custom-declare-group) - (eq (car-safe name) 'quote)) - (setq byte-compile-current-group (cadr name)))))) + (let ((keyword-args (cdr (cdr (cdr (cdr form))))) + (name (cadr form))) + (when (eq (car-safe name) 'quote) + (or (not (eq (car form) 'custom-declare-variable)) + (plist-get keyword-args :type) + (byte-compile-warn + "defcustom for `%s' fails to specify type" (cadr name))) + (if (and (memq (car form) '(custom-declare-face custom-declare-variable)) + byte-compile-current-group) + ;; The group will be provided implicitly. + nil + (or (and (eq (car form) 'custom-declare-group) + (equal name ''emacs)) + (plist-get keyword-args :group) + (byte-compile-warn + "%s for `%s' fails to specify containing group" + (cdr (assq (car form) + '((custom-declare-group . defgroup) + (custom-declare-face . defface) + (custom-declare-variable . defcustom)))) + (cadr name))) + ;; Update the current group, if needed. + (if (and byte-compile-current-file ;Only when compiling a whole file. + (eq (car form) 'custom-declare-group)) + (setq byte-compile-current-group (cadr name))))))) ;; Warn if the function or macro is being redefined with a different ;; number of arguments. @@ -3746,7 +3748,8 @@ discarding." (if (= (logand len 1) 1) (progn (byte-compile-log-warning - (format "missing value for `%S' at end of setq" (car (last args))) + (format-message + "missing value for `%S' at end of setq" (car (last args))) nil :error) (byte-compile-form `(signal 'wrong-number-of-arguments '(setq ,len)) @@ -4017,7 +4020,8 @@ that suppresses all warnings during execution of BODY." (progn (mapc 'byte-compile-form (cdr form)) (byte-compile-out 'byte-call (length (cdr (cdr form))))) - (byte-compile-log-warning "`funcall' called with no arguments" nil :error) + (byte-compile-log-warning + (format-message "`funcall' called with no arguments") nil :error) (byte-compile-form '(signal 'wrong-number-of-arguments '(funcall 0)) byte-compile--for-effect))) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index b0815f5cf5f..5413bdbdf7f 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -83,8 +83,6 @@ ;; - A generic "filter" generalizer (e.g. could be used to cleanly add methods ;; to cl-generic-combine-methods with a specializer that says it applies only ;; when some particular qualifier is used). -;; - A way to dispatch on the context (e.g. the major-mode, some global -;; variable, you name it). ;;; Code: @@ -195,9 +193,9 @@ OPTIONS-AND-METHODS currently understands: - (declare DECLARATIONS) - (:argument-precedence-order &rest ARGS) - (:method [QUALIFIERS...] ARGS &rest BODY) -BODY, if present, is used as the body of a default method. +DEFAULT-BODY, if present, is used as the body of a default method. -\(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest BODY)" +\(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)" (declare (indent 2) (doc-string 3)) (let* ((doc (if (stringp (car-safe options-and-methods)) (pop options-and-methods))) @@ -360,10 +358,10 @@ the specializer used will be the one returned by BODY." (defmacro cl-defmethod (name args &rest body) "Define a new method for generic function NAME. I.e. it defines the implementation of NAME to use for invocations where the -value of the dispatch argument matches the specified TYPE. -The dispatch argument has to be one of the mandatory arguments, and -all methods of NAME have to use the same argument for dispatch. -The dispatch argument and TYPE are specified in ARGS where the corresponding +values of the dispatch arguments match the specified TYPEs. +The dispatch arguments have to be among the mandatory arguments, and +all methods of NAME have to use the same set of arguments for dispatch. +Each dispatch argument and TYPE are specified in ARGS where the corresponding formal argument appears as (VAR TYPE) rather than just VAR. The optional second argument QUALIFIER is a specifier that @@ -373,8 +371,14 @@ modifies how the method is combined with other methods, including: :around - Method will be called around everything else The absence of QUALIFIER means this is a \"primary\" method. -Other than a type, TYPE can also be of the form `(eql VAL)' in -which case this method will be invoked when the argument is `eql' to VAL. +TYPE can be one of the basic types (see the full list and their +hierarchy in `cl--generic-typeof-types'), CL struct type, or an +EIEIO class. + +Other than that, TYPE can also be of the form `(eql VAL)' in +which case this method will be invoked when the argument is `eql' +to VAL, or `(head VAL)', in which case the argument is required +to be a cons with VAL as its head. \(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" (declare (doc-string 3) (indent 2) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index f29f64f0562..6a4d835b63c 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -68,6 +68,7 @@ replacing its case-insensitive matches with the literal string in LIGHTER." "toggle-\\|-mode\\'" "" (symbol-name mode)))) " mode"))) + (setq name (replace-regexp-in-string "\\`Global-" "Global " name)) (if (not (stringp lighter)) name ;; Strip leading and trailing whitespace from LIGHTER. (setq lighter (replace-regexp-in-string "\\`\\s-+\\|\\s-+\\'" "" diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 5b841e88165..e8484fa1f94 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -225,6 +225,7 @@ After execution is resumed, the error is signaled again." "If non-nil, an expression to test for at every stop point. If the result is non-nil, then break. Errors are ignored." :type 'sexp + :risky t :group 'edebug) (defcustom edebug-sit-for-seconds 1 diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index f4be9473394..7a914da3977 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -2128,12 +2128,12 @@ To be used in the ERT results buffer." "Move point from NODE to the previous or next node. EWOC-FN specifies the direction and should be either `ewoc-prev' -or `ewoc-next'. If there are no more nodes in that direction, an -error is signaled with the message ERROR-MESSAGE." +or `ewoc-next'. If there are no more nodes in that direction, a +user-error is signaled with the message ERROR-MESSAGE." (cl-loop (setq node (funcall ewoc-fn ert--results-ewoc node)) (when (null node) - (error "%s" error-message)) + (user-error "%s" error-message)) (unless (ert--ewoc-entry-hidden-p (ewoc-data node)) (goto-char (ewoc-location node)) (cl-return)))) diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index ebef27185ae..ec8d3d79d9f 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -47,17 +47,18 @@ (pcase-defmacro map (&rest args) "Build a `pcase' pattern matching map elements. -The `pcase' pattern will match each element of PATTERN against -the corresponding elements of the map. +ARGS is a list of elements to be matched in the map. -Extra elements of the map are ignored if fewer ARGS are -given, and the match does not fail. +Each element of ARGS can be of the form (KEY PAT), in which case KEY is +evaluated and searched for in the map. The match fails if for any KEY +found in the map, the corresponding PAT doesn't match the value +associated to the KEY. -ARGS can be a list of the form (KEY PAT), in which case KEY in an -unquoted form. +Each element can also be a SYMBOL, which is an abbreviation of a (KEY +PAT) tuple of the form (\\='SYMBOL SYMBOL). -ARGS can also be a list of symbols, which stands for ('SYMBOL -SYMBOL)." +Keys in ARGS not found in the map are ignored, and the match doesn't +fail." `(and (pred mapp) ,@(map--make-pcase-bindings args))) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 08f64147d44..14650ba3ab6 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -183,7 +183,13 @@ If VERSION is a string, only that version is ever loaded. Any other version, even if newer, is silently ignored. Hence, the package is \"held\" at that version. If VERSION is nil, the package is not loaded (it is \"disabled\")." - :type '(repeat symbol) + :type '(repeat (choice (const all) + (list :tag "Specific package" + (symbol :tag "Package name") + (choice :tag "Version" + (const :tag "disable" nil) + (const :tag "most recent" t) + (string :tag "specific version"))))) :risky t :version "24.1") diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 3b224814e9e..7e164c0fe5c 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -107,12 +107,36 @@ ;;;###autoload (defmacro pcase (exp &rest cases) - "Eval EXP and perform ML-style pattern matching on that value. + "Evaluate EXP and attempt to match it against structural patterns. CASES is a list of elements of the form (PATTERN CODE...). -Patterns can take the following forms: +A structural PATTERN describes a template that identifies a class +of values. For example, the pattern \\=`(,foo ,bar) matches any +two element list, binding its elements to symbols named `foo' and +`bar' -- in much the same way that `cl-destructuring-bind' would. + +A significant difference from `cl-destructuring-bind' is that, if +a pattern match fails, the next case is tried until either a +successful match is found or there are no more cases. + +Another difference is that pattern elements may be quoted, +meaning they must match exactly: The pattern \\='(foo bar) +matches only against two element lists containing the symbols +`foo' and `bar' in that order. (As a short-hand, atoms always +match themselves, such as numbers or strings, and need not be +quoted.) + +Lastly, a pattern can be logical, such as (pred numberp), that +matches any number-like element; or the symbol `_', that matches +anything. Also, when patterns are backquoted, a comma may be +used to introduce logical patterns inside backquoted patterns. + +The complete list of standard patterns is as follows: + _ matches anything. SYMBOL matches anything and binds it to SYMBOL. + If a SYMBOL is used twice in the same pattern + the second occurrence becomes an `eq'uality test. (or PAT...) matches if any of the patterns matches. (and PAT...) matches if all the patterns match. \\='VAL matches if the object is `equal' to VAL. @@ -122,23 +146,18 @@ Patterns can take the following forms: (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. (let PAT EXP) matches if EXP matches PAT. (app FUN PAT) matches if FUN applied to the object matches PAT. -If a SYMBOL is used twice in the same pattern (i.e. the pattern is -\"non-linear\"), then the second occurrence is turned into an `eq'uality test. -FUN can take the form +Additional patterns can be defined using `pcase-defmacro'. + +The FUN argument in the `app' pattern may have the following forms: SYMBOL or (lambda ARGS BODY) in which case it's called with one argument. (F ARG1 .. ARGn) in which case F gets called with an n+1'th argument which is the value being matched. -So a FUN of the form SYMBOL is equivalent to one of the form (FUN). +So a FUN of the form SYMBOL is equivalent to (FUN). FUN can refer to variables bound earlier in the pattern. -E.g. you can match pairs where the cdr is larger than the car with a pattern -like \\=`(,a . ,(pred (< a))) or, with more checks: -\\=`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a)))) -FUN is assumed to be pure, i.e. it can be dropped if its result is not used, -and two identical calls can be merged into one. - -Additional patterns can be defined via `pcase-defmacro'. -Currently, the following patterns are provided this way:" + +See Info node `(elisp) Pattern matching case statement' in the +Emacs Lisp manual for more information and examples." (declare (indent 1) (debug (form &rest (pcase-PAT body)))) ;; We want to use a weak hash table as a cache, but the key will unavoidably ;; be based on `exp' and `cases', yet `cases' is a fresh new list each time diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 300fe5cd1fd..8b7b594f5e1 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -144,6 +144,18 @@ if positive or too small if negative)." sequence) (nreverse result))) +(defun seq-map-indexed (function sequence) + "Return the result of applying FUNCTION to each element of SEQUENCE. +Unlike `seq-map', FUNCTION takes two arguments: the element of +the sequence, and its index within the sequence." + (let ((index 0)) + (seq-map (lambda (elt) + (prog1 + (funcall function elt index) + (setq index (1+ index)))) + sequence))) + + ;; faster implementation for sequences (sequencep) (cl-defmethod seq-map (function (sequence sequence)) (mapcar function sequence)) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 68658d20b37..00b029d8f3e 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -571,7 +571,6 @@ data in an ewoc may instead specify a printer function (e.g., one that calls `ewoc-enter-last'), with `tabulated-list-print-entry' as the ewoc pretty-printer." (setq-local truncate-lines t) - (setq-local buffer-read-only t) (setq-local buffer-undo-list t) (setq-local revert-buffer-function #'tabulated-list-revert) (setq-local glyphless-char-display tabulated-list-glyphless-char-display) diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el new file mode 100644 index 00000000000..eba152325c2 --- /dev/null +++ b/lisp/emacs-lisp/timer-list.el @@ -0,0 +1,111 @@ +;;; timer-list.el --- list active timers in a buffer + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +;;;###autoload +(defun timer-list () + "List all timers in a buffer." + (interactive) + (pop-to-buffer-same-window (get-buffer-create "*timer-list*")) + (let ((inhibit-read-only t)) + (erase-buffer) + (timer-list-mode) + (dolist (timer (append timer-list timer-idle-list)) + (insert (format "%4s %10s %8s %s" + ;; Idle. + (if (aref timer 7) + "*" + " ") + ;; Next time. + (let ((time (float-time (list (aref timer 1) + (aref timer 2) + (aref timer 3))))) + (format "%.2f" + (if (aref timer 7) + time + (- (float-time (list (aref timer 1) + (aref timer 2) + (aref timer 3))) + (float-time))))) + ;; Repeat. + (let ((repeat (aref timer 4))) + (cond + ((numberp repeat) + (format "%.2f" (/ repeat 60))) + ((null repeat) + "-") + (t + (format "%s" repeat)))) + ;; Function. + (let ((function (aref timer 5))) + (replace-regexp-in-string + "\n" " " + (cond + ((byte-code-function-p function) + (replace-regexp-in-string + "[^-A-Za-z0-9 ]" "" + (format "%s" function))) + (t + (format "%s" function))))))) + (put-text-property (line-beginning-position) + (1+ (line-beginning-position)) + 'timer timer) + (insert "\n"))) + (goto-char (point-min))) +;; This command can be destructive if they don't know what they are +;; doing. Kids, don't try this at home! +;;;###autoload (put 'timer-list 'disabled "Beware: manually canceling timers can ruin your Emacs session.") + +(defvar timer-list-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "c" 'timer-list-cancel) + (easy-menu-define nil map "" + '("Timers" + ["Cancel" timer-list-cancel t])) + map)) + +(define-derived-mode timer-list-mode special-mode "timer-list" + "Mode for listing and controlling timers." + (setq truncate-lines t) + (buffer-disable-undo) + (setq buffer-read-only t) + (setq header-line-format + (format "%4s %10s %8s %s" + "Idle" "Next" "Repeat" "Function"))) + +(defun timer-list-cancel () + "Cancel the timer on the line under point." + (interactive) + (let ((timer (get-text-property (line-beginning-position) 'timer)) + (inhibit-read-only t)) + (unless timer + (error "No timer on the current line")) + (cancel-timer timer) + (delete-region (line-beginning-position) + (line-beginning-position 2)))) + +(provide 'timer-list) + +;;; timer-list.el ends here |