commit 6f4b0e8153c8e83d03ed1c3c37065e5bf56685f1 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Wed May 20 22:16:53 2015 -0700 Revert doc string changes to f90.el Problem reported by Glenn Morris in: http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00596.html * lisp/progmodes/f90.el (f90-mode, f90-abbrev-start): Revert recent changes to doc strings, as it's intended that they use grave accent, not quote. diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 74e3234..6264d3b 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -1113,7 +1113,7 @@ For fixed format code, use `fortran-mode'. indented line. \\[f90-indent-subprogram] indents the current subprogram. -Type `?' or `\\[help-command]' to display a list of built-in\ +Type `? or `\\[help-command] to display a list of built-in\ abbrevs for F90 keywords. Key definitions: @@ -2267,7 +2267,7 @@ Leave point at the end of line." ;; Abbrevs and keywords. (defun f90-abbrev-start () - "Typing `\\[help-command]' or `?' lists all the F90 abbrevs. + "Typing `\\[help-command] or `? lists all the F90 abbrevs. Any other key combination is executed normally." (interactive "*") (self-insert-command 1) commit 424bfcd0c7029a30a90731856b8fbd9ae59fcdbf Author: Eli Zaretskii Date: Wed May 20 22:07:30 2015 +0300 ; * doc/lispref/nonascii.texi (Character Properties): Fix a typo. (Bug#20618) diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index 28f90d9..f160184 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -540,8 +540,8 @@ property is used for bidirectional display. @item old-name Corresponds to the Unicode @code{Unicode_1_Name} property. The value -is a string. Unassigned codepoints, and characters that have no value -for this property, the value is @code{nil}. +is a string. For unassigned codepoints, and characters that have no +value for this property, the value is @code{nil}. @item iso-10646-comment Corresponds to the Unicode @code{ISO_Comment} property. The value is commit f73e02c516616b468d874827f092f5f25628178a Author: Bozhidar Batsov Date: Wed May 20 18:50:38 2015 +0300 Improve parameter name diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index dc5b7e9..e6d451a 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -140,9 +140,9 @@ to bind a single value, BINDINGS can just be a plain tuple." (declare (indent 1) (debug if-let)) (list 'if-let bindings (macroexp-progn body))) -(defsubst hash-table-empty-p (table) - "Check whether TABLE is empty (has 0 elements)." - (zerop (hash-table-count table))) +(defsubst hash-table-empty-p (hash-table) + "Check whether HASH-TABLE is empty (has 0 elements)." + (zerop (hash-table-count hash-table))) (defsubst hash-table-keys (hash-table) "Return a list of keys in HASH-TABLE." commit 7a22bb66a68d5393a5507ea4226e90090f59fff3 Author: Bozhidar Batsov Date: Wed May 20 18:49:20 2015 +0300 Add new inline function `hash-table-empty-p' diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index bd178fa..dc5b7e9 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -140,6 +140,10 @@ to bind a single value, BINDINGS can just be a plain tuple." (declare (indent 1) (debug if-let)) (list 'if-let bindings (macroexp-progn body))) +(defsubst hash-table-empty-p (table) + "Check whether TABLE is empty (has 0 elements)." + (zerop (hash-table-count table))) + (defsubst hash-table-keys (hash-table) "Return a list of keys in HASH-TABLE." (let ((keys '())) commit e2f5b72f78cbed16c90148d26df393385bacdcaf Author: Glenn Morris Date: Wed May 20 08:34:53 2015 -0700 ; * test/automated/subr-tests.el: Standardize license notice. diff --git a/test/automated/subr-tests.el b/test/automated/subr-tests.el index a42acf5..d29efc6 100644 --- a/test/automated/subr-tests.el +++ b/test/automated/subr-tests.el @@ -5,18 +5,20 @@ ;; Author: Oleh Krehel ;; Keywords: -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: commit 00ec2dd7af3d472fcd5098c74f2e6b8f759e007d Author: Paul Eggert Date: Wed May 20 08:23:09 2015 -0700 Don't require help-fns when not needed * lisp/emacs-lisp/autoload.el, lisp/emacs-lisp/advice.el: * lisp/emacs-lisp/elint.el: Don't require help-fns at the top level. * lisp/emacs-lisp/advice.el (ad-arglist): * lisp/emacs-lisp/cl-macs.el (cl--transform-lambda): Don't require help-fns. (Bug#17001) diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 212ae90..907f03b 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2149,7 +2149,6 @@ the cache-id will clear the cache." (defun ad-arglist (definition) "Return the argument list of DEFINITION." - (require 'help-fns) (help-function-arglist (if (or (macrop definition) (ad-advice-p definition)) (cdr definition) @@ -2474,8 +2473,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return (capitalize (symbol-name class)) (ad-advice-name advice))))))) -(require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage. - (defun ad--make-advised-docstring (function &optional style) "Construct a documentation string for the advised FUNCTION. Concatenate the original documentation with the documentation diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 206d5bb..a6fefeb 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -32,7 +32,6 @@ (require 'lisp-mode) ;for `doc-string-elt' properties. (require 'lisp-mnt) -(require 'help-fns) ;for help-add-fundoc-usage. (eval-when-compile (require 'cl-lib)) (defvar generated-autoload-file nil diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 5bab84e..27d3da3 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -294,7 +294,6 @@ FORM is of the form (ARGS . BODY)." ;; apparently harmless computation, so it should not ;; touch the match-data. (save-match-data - (require 'help-fns) (cons (help-add-fundoc-usage (if (stringp (car header)) (pop header)) ;; Be careful with make-symbol and (back)quote, diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index 317e5a6..fc66c82 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -46,8 +46,6 @@ ;;; Code: -(require 'help-fns) - (defgroup elint nil "Linting for Emacs Lisp." :prefix "elint-" commit e1890e3e829665a54f04284f4e23bd0fd37de06b Author: Eli Zaretskii Date: Wed May 20 18:18:33 2015 +0300 Fix slash collapsing in etags on MS-Windows * lib-src/etags.c (canonicalize_filename) [DOS_NT]: Separate the MS-Windows code from the Posix code, and support collapsing both forward- and back-slashes on MS-Windows. Fixes a regression found by the test suite. diff --git a/lib-src/etags.c b/lib-src/etags.c index 7bacbd3..0a308c1 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -6484,7 +6484,6 @@ static void canonicalize_filename (register char *fn) { register char* cp; - char sep = '/'; #ifdef DOS_NT /* Canonicalize drive letter case. */ @@ -6492,19 +6491,33 @@ canonicalize_filename (register char *fn) if (fn[0] != '\0' && fn[1] == ':' && ISUPPER (fn[0])) fn[0] = lowcase (fn[0]); - sep = '\\'; -#endif + /* Collapse multiple forward- and back-slashes into a single forward + slash. */ + for (cp = fn; *cp != '\0'; cp++, fn++) + if (*cp == '/' || *cp == '\\') + { + *fn = '/'; + while (cp[1] == '/' || cp[1] == '\\') + cp++; + } + else + *fn = *cp; + +#else /* !DOS_NT */ - /* Collapse multiple separators into a single slash. */ + /* Collapse multiple slashes into a single slash. */ for (cp = fn; *cp != '\0'; cp++, fn++) - if (*cp == sep) + if (*cp == '/') { *fn = '/'; - while (cp[1] == sep) + while (cp[1] == '/') cp++; } else *fn = *cp; + +#endif /* !DOS_NT */ + *fn = '\0'; } commit 1a17b775b6bd476c051ae5ef00b752aacb6cf103 Author: Eli Zaretskii Date: Wed May 20 18:14:21 2015 +0300 Improve documentation of glyphless-char-display * doc/lispref/display.texi (Glyphless Chars): Improve documentation of glyphless character display. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index d5d9bb5..05bcd9f 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6614,7 +6614,8 @@ Display a box containing the Unicode codepoint of the character, in hexadecimal notation. @item an @acronym{ASCII} string -Display a box containing that string. +Display a box containing that string. The string should contain at +most 6 @acronym{ASCII} characters. @item a cons cell @code{(@var{graphical} . @var{text})} Display with @var{graphical} on graphical displays, and with @@ -6625,7 +6626,8 @@ must be one of the display methods described above. @noindent The @code{thin-space}, @code{empty-box}, @code{hex-code}, and @acronym{ASCII} string display methods are drawn with the -@code{glyphless-char} face. +@code{glyphless-char} face. On text terminals, a box is emulated by +square brackets, @samp{[]}. The char-table has one extra slot, which determines how to display any character that cannot be displayed with any available font, or cannot commit e8b895342074fec055c54b1fae1a6b6cf7b301d2 Author: Eli Zaretskii Date: Wed May 20 18:09:37 2015 +0300 Fix "acronym" display of glyphless characters on w32 * src/w32term.c (x_draw_glyphless_glyph_string_foreground): Don't ignore "acronym" substitutes of 1 character for glyphless characters. diff --git a/src/w32term.c b/src/w32term.c index d415b13..089c43c 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -1410,7 +1410,7 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s) if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM) { - if (len > 1 + if (len > 0 && CHAR_TABLE_P (Vglyphless_char_display) && (CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (Vglyphless_char_display)) >= 1)) commit 028d80f3a25bd167940e528895185f03960eceb0 Author: Oleh Krehel Date: Wed May 20 15:38:55 2015 +0200 Add an automated test for let-when-compile * test/automated/subr-tests.el (let-when-compile): New test. diff --git a/test/automated/subr-tests.el b/test/automated/subr-tests.el new file mode 100644 index 0000000..a42acf5 --- /dev/null +++ b/test/automated/subr-tests.el @@ -0,0 +1,62 @@ +;;; subr-tests.el --- Tests for subr.el + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Oleh Krehel +;; Keywords: + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) + +(ert-deftest let-when-compile () + ;; good case + (should (equal (macroexpand '(let-when-compile ((foo (+ 2 3))) + (setq bar (eval-when-compile (+ foo foo))) + (setq boo (eval-when-compile (* foo foo))))) + '(progn + (setq bar (quote 10)) + (setq boo (quote 25))))) + ;; bad case: `eval-when-compile' omitted, byte compiler should catch this + (should (equal (macroexpand + '(let-when-compile ((foo (+ 2 3))) + (setq bar (+ foo foo)) + (setq boo (eval-when-compile (* foo foo))))) + '(progn + (setq bar (+ foo foo)) + (setq boo (quote 25))))) + ;; something practical + (should (equal (macroexpand + '(let-when-compile ((keywords '("true" "false"))) + (font-lock-add-keywords + 'c++-mode + `((,(eval-when-compile + (format "\\<%s\\>" (regexp-opt keywords))) + 0 font-lock-keyword-face))))) + '(font-lock-add-keywords + (quote c++-mode) + (list + (cons (quote + "\\<\\(?:\\(?:fals\\|tru\\)e\\)\\>") + (quote + (0 font-lock-keyword-face)))))))) + +(provide 'subr-tests) +;;; subr-tests.el ends here commit 5d752c8a1c28e003ded0f2daa0d93eb12a31195a Author: Oleh Krehel Date: Tue May 19 09:49:12 2015 +0200 Add let-when-compile macro instead of using pcase-let * lisp/subr.el (let-when-compile): New let-like macro that makes its bindings known to macros like `eval-when-compile' in the body. * lisp/emacs-lisp/lisp-mode.el: Change the top-level `pcase-let' to a `let-when-compile'. Also comment out the unused lexical var `el-kws-re'. The change greatly improves readability, while providing almost the same (even shorter) byte code: instead of pre-evaluating 10 variables, tossing them into a list, and destructuring that list a full screen page later, the variables are simply bound as they are evaluated, wrapped individually in `eval-when-compile'. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 108d5cc..6facf57 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -229,248 +229,246 @@ (match-beginning 0))))) (throw 'found t)))))) -(pcase-let - ((`(,vdefs ,tdefs - ,el-defs-re ,cl-defs-re - ,el-kws-re ,cl-kws-re - ,el-errs-re ,cl-errs-re) - (eval-when-compile - (let ((lisp-fdefs '("defmacro" "defsubst" "defun")) - (lisp-vdefs '("defvar")) - (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1" - "prog2" "lambda" "unwind-protect" "condition-case" - "when" "unless" "with-output-to-string" - "ignore-errors" "dotimes" "dolist" "declare")) - (lisp-errs '("warn" "error" "signal")) - ;; Elisp constructs. Now they are update dynamically - ;; from obarray but they are also used for setting up - ;; the keywords for Common Lisp. - (el-fdefs '("define-advice" "defadvice" "defalias" - "define-derived-mode" "define-minor-mode" - "define-generic-mode" "define-global-minor-mode" - "define-globalized-minor-mode" "define-skeleton" - "define-widget")) - (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local" - "defface")) - (el-tdefs '("defgroup" "deftheme")) - (el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive" - "pcase-lambda" "pcase-let" "pcase-let*" "save-restriction" - "save-excursion" "save-selected-window" - ;; "eval-after-load" "eval-next-after-load" - "save-window-excursion" "save-current-buffer" - "save-match-data" "combine-after-change-calls" - "condition-case-unless-debug" "track-mouse" - "eval-and-compile" "eval-when-compile" "with-case-table" - "with-category-table" "with-coding-priority" - "with-current-buffer" "with-demoted-errors" - "with-electric-help" "with-eval-after-load" - "with-file-modes" - "with-local-quit" "with-no-warnings" - "with-output-to-temp-buffer" "with-selected-window" - "with-selected-frame" "with-silent-modifications" - "with-syntax-table" "with-temp-buffer" "with-temp-file" - "with-temp-message" "with-timeout" - "with-timeout-handler")) - (el-errs '("user-error")) - ;; Common-Lisp constructs supported by EIEIO. FIXME: namespace. - (eieio-fdefs '("defgeneric" "defmethod")) - (eieio-tdefs '("defclass")) - (eieio-kw '("with-slots")) - ;; Common-Lisp constructs supported by cl-lib. - (cl-lib-fdefs '("defmacro" "defsubst" "defun" "defmethod")) - (cl-lib-tdefs '("defstruct" "deftype")) - (cl-lib-kw '("progv" "eval-when" "case" "ecase" "typecase" - "etypecase" "ccase" "ctypecase" "loop" "do" "do*" - "the" "locally" "proclaim" "declaim" "letf" "go" - ;; "lexical-let" "lexical-let*" - "symbol-macrolet" "flet" "flet*" "destructuring-bind" - "labels" "macrolet" "tagbody" "multiple-value-bind" - "block" "return" "return-from")) - (cl-lib-errs '("assert" "check-type")) - ;; Common-Lisp constructs not supported by cl-lib. - (cl-fdefs '("defsetf" "define-method-combination" - "define-condition" "define-setf-expander" - ;; "define-function"?? - "define-compiler-macro" "define-modify-macro")) - (cl-vdefs '("define-symbol-macro" "defconstant" "defparameter")) - (cl-tdefs '("defpackage" "defstruct" "deftype")) - (cl-kw '("prog" "prog*" "handler-case" "handler-bind" - "in-package" "restart-case" ;; "inline" - "restart-bind" "break" "multiple-value-prog1" - "compiler-let" "with-accessors" "with-compilation-unit" - "with-condition-restarts" "with-hash-table-iterator" - "with-input-from-string" "with-open-file" - "with-open-stream" "with-package-iterator" - "with-simple-restart" "with-standard-io-syntax")) - (cl-errs '("abort" "cerror"))) - - (list (append lisp-vdefs el-vdefs cl-vdefs) - (append el-tdefs eieio-tdefs cl-tdefs cl-lib-tdefs - (mapcar (lambda (s) (concat "cl-" s)) cl-lib-tdefs)) - - ;; Elisp and Common Lisp definers. - (regexp-opt (append lisp-fdefs lisp-vdefs - el-fdefs el-vdefs el-tdefs - (mapcar (lambda (s) (concat "cl-" s)) - (append cl-lib-fdefs cl-lib-tdefs)) - eieio-fdefs eieio-tdefs) - t) - (regexp-opt (append lisp-fdefs lisp-vdefs - cl-lib-fdefs cl-lib-tdefs - eieio-fdefs eieio-tdefs - cl-fdefs cl-vdefs cl-tdefs) - t) - - ;; Elisp and Common Lisp keywords. - (regexp-opt (append - lisp-kw el-kw eieio-kw - (cons "go" (mapcar (lambda (s) (concat "cl-" s)) - (remove "go" cl-lib-kw)))) - t) - (regexp-opt (append lisp-kw cl-kw eieio-kw cl-lib-kw) - t) - - ;; Elisp and Common Lisp "errors". - (regexp-opt (append (mapcar (lambda (s) (concat "cl-" s)) - cl-lib-errs) - lisp-errs el-errs) - t) - (regexp-opt (append lisp-errs cl-lib-errs cl-errs) t)))))) - - (dolist (v vdefs) - (put (intern v) 'lisp-define-type 'var)) - (dolist (v tdefs) - (put (intern v) 'lisp-define-type 'type)) - - (define-obsolete-variable-alias 'lisp-font-lock-keywords-1 - 'lisp-el-font-lock-keywords-1 "24.4") - (defconst lisp-el-font-lock-keywords-1 - `( ;; Definitions. - (,(concat "(" el-defs-re "\\_>" - ;; Any whitespace and defined object. - "[ \t']*" - "\\(([ \t']*\\)?" ;; An opening paren. - "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?") - (1 font-lock-keyword-face) - (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type))) - (cond ((eq type 'var) font-lock-variable-name-face) - ((eq type 'type) font-lock-type-face) - ;; If match-string 2 is non-nil, we encountered a - ;; form like (defalias (intern (concat s "-p"))), - ;; unless match-string 4 is also there. Then its a - ;; defmethod with (setf foo) as name. - ((or (not (match-string 2)) ;; Normal defun. - (and (match-string 2) ;; Setf method. - (match-string 4))) font-lock-function-name-face))) - nil t)) - ;; Emacs Lisp autoload cookies. Supports the slightly different - ;; forms used by mh-e, calendar, etc. - ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend)) - "Subdued level highlighting for Emacs Lisp mode.") - - (defconst lisp-cl-font-lock-keywords-1 - `( ;; Definitions. - (,(concat "(" cl-defs-re "\\_>" - ;; Any whitespace and defined object. - "[ \t']*" - "\\(([ \t']*\\)?" ;; An opening paren. - "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?") - (1 font-lock-keyword-face) - (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type))) - (cond ((eq type 'var) font-lock-variable-name-face) - ((eq type 'type) font-lock-type-face) - ((or (not (match-string 2)) ;; Normal defun. - (and (match-string 2) ;; Setf function. - (match-string 4))) font-lock-function-name-face))) - nil t))) - "Subdued level highlighting for Lisp modes.") - - (define-obsolete-variable-alias 'lisp-font-lock-keywords-2 - 'lisp-el-font-lock-keywords-2 "24.4") - (defconst lisp-el-font-lock-keywords-2 - (append - lisp-el-font-lock-keywords-1 - `( ;; Regexp negated char group. - ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend) - ;; Control structures. Common Lisp forms. - (lisp--el-match-keyword . 1) - ;; Exit/Feature symbols as constants. - (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>" - "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?") - (1 font-lock-keyword-face) - (2 font-lock-constant-face nil t)) - ;; Erroneous structures. - (,(concat "(" el-errs-re "\\_>") - (1 font-lock-warning-face)) - ;; Words inside \\[] tend to be for `substitute-command-keys'. - ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]" - (1 font-lock-constant-face prepend)) - ;; Words inside `' tend to be symbol names. - ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'" - (1 font-lock-constant-face prepend)) - ;; Constant values. - ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face) - ;; ELisp and CLisp `&' keywords as types. - ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face) - ;; ELisp regexp grouping constructs - (,(lambda (bound) - (catch 'found - ;; The following loop is needed to continue searching after matches - ;; that do not occur in strings. The associated regexp matches one - ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'. `\\\\' has been included to - ;; avoid highlighting, for example, `\\(' in `\\\\('. - (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t) - (unless (match-beginning 2) - (let ((face (get-text-property (1- (point)) 'face))) - (when (or (and (listp face) - (memq 'font-lock-string-face face)) - (eq 'font-lock-string-face face)) - (throw 'found t))))))) - (1 'font-lock-regexp-grouping-backslash prepend) - (3 'font-lock-regexp-grouping-construct prepend)) - ;; This is too general -- rms. - ;; A user complained that he has functions whose names start with `do' - ;; and that they get the wrong color. - ;; ;; CL `with-' and `do-' constructs - ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) - (lisp--match-hidden-arg - (0 '(face font-lock-warning-face - help-echo "Hidden behind deeper element; move to another line?"))) - )) - "Gaudy level highlighting for Emacs Lisp mode.") - - (defconst lisp-cl-font-lock-keywords-2 - (append - lisp-cl-font-lock-keywords-1 - `( ;; Regexp negated char group. - ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend) - ;; Control structures. Common Lisp forms. - (,(concat "(" cl-kws-re "\\_>") . 1) - ;; Exit/Feature symbols as constants. - (,(concat "(\\(catch\\|throw\\|provide\\|require\\)\\_>" - "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?") - (1 font-lock-keyword-face) - (2 font-lock-constant-face nil t)) - ;; Erroneous structures. - (,(concat "(" cl-errs-re "\\_>") - (1 font-lock-warning-face)) - ;; Words inside `' tend to be symbol names. - ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'" - (1 font-lock-constant-face prepend)) - ;; Constant values. - ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face) - ;; ELisp and CLisp `&' keywords as types. - ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face) - ;; This is too general -- rms. - ;; A user complained that he has functions whose names start with `do' - ;; and that they get the wrong color. - ;; ;; CL `with-' and `do-' constructs - ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) - (lisp--match-hidden-arg - (0 '(face font-lock-warning-face - help-echo "Hidden behind deeper element; move to another line?"))) - )) - "Gaudy level highlighting for Lisp modes.")) +(let-when-compile + ((lisp-fdefs '("defmacro" "defsubst" "defun")) + (lisp-vdefs '("defvar")) + (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1" + "prog2" "lambda" "unwind-protect" "condition-case" + "when" "unless" "with-output-to-string" + "ignore-errors" "dotimes" "dolist" "declare")) + (lisp-errs '("warn" "error" "signal")) + ;; Elisp constructs. Now they are update dynamically + ;; from obarray but they are also used for setting up + ;; the keywords for Common Lisp. + (el-fdefs '("define-advice" "defadvice" "defalias" + "define-derived-mode" "define-minor-mode" + "define-generic-mode" "define-global-minor-mode" + "define-globalized-minor-mode" "define-skeleton" + "define-widget")) + (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local" + "defface")) + (el-tdefs '("defgroup" "deftheme")) + (el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive" + "pcase-lambda" "pcase-let" "pcase-let*" "save-restriction" + "save-excursion" "save-selected-window" + ;; "eval-after-load" "eval-next-after-load" + "save-window-excursion" "save-current-buffer" + "save-match-data" "combine-after-change-calls" + "condition-case-unless-debug" "track-mouse" + "eval-and-compile" "eval-when-compile" "with-case-table" + "with-category-table" "with-coding-priority" + "with-current-buffer" "with-demoted-errors" + "with-electric-help" "with-eval-after-load" + "with-file-modes" + "with-local-quit" "with-no-warnings" + "with-output-to-temp-buffer" "with-selected-window" + "with-selected-frame" "with-silent-modifications" + "with-syntax-table" "with-temp-buffer" "with-temp-file" + "with-temp-message" "with-timeout" + "with-timeout-handler")) + (el-errs '("user-error")) + ;; Common-Lisp constructs supported by EIEIO. FIXME: namespace. + (eieio-fdefs '("defgeneric" "defmethod")) + (eieio-tdefs '("defclass")) + (eieio-kw '("with-slots")) + ;; Common-Lisp constructs supported by cl-lib. + (cl-lib-fdefs '("defmacro" "defsubst" "defun" "defmethod")) + (cl-lib-tdefs '("defstruct" "deftype")) + (cl-lib-kw '("progv" "eval-when" "case" "ecase" "typecase" + "etypecase" "ccase" "ctypecase" "loop" "do" "do*" + "the" "locally" "proclaim" "declaim" "letf" "go" + ;; "lexical-let" "lexical-let*" + "symbol-macrolet" "flet" "flet*" "destructuring-bind" + "labels" "macrolet" "tagbody" "multiple-value-bind" + "block" "return" "return-from")) + (cl-lib-errs '("assert" "check-type")) + ;; Common-Lisp constructs not supported by cl-lib. + (cl-fdefs '("defsetf" "define-method-combination" + "define-condition" "define-setf-expander" + ;; "define-function"?? + "define-compiler-macro" "define-modify-macro")) + (cl-vdefs '("define-symbol-macro" "defconstant" "defparameter")) + (cl-tdefs '("defpackage" "defstruct" "deftype")) + (cl-kw '("prog" "prog*" "handler-case" "handler-bind" + "in-package" "restart-case" ;; "inline" + "restart-bind" "break" "multiple-value-prog1" + "compiler-let" "with-accessors" "with-compilation-unit" + "with-condition-restarts" "with-hash-table-iterator" + "with-input-from-string" "with-open-file" + "with-open-stream" "with-package-iterator" + "with-simple-restart" "with-standard-io-syntax")) + (cl-errs '("abort" "cerror"))) + (let ((vdefs (eval-when-compile + (append lisp-vdefs el-vdefs cl-vdefs))) + (tdefs (eval-when-compile + (append el-tdefs eieio-tdefs cl-tdefs cl-lib-tdefs + (mapcar (lambda (s) (concat "cl-" s)) cl-lib-tdefs)))) + ;; Elisp and Common Lisp definers. + (el-defs-re (eval-when-compile + (regexp-opt (append lisp-fdefs lisp-vdefs + el-fdefs el-vdefs el-tdefs + (mapcar (lambda (s) (concat "cl-" s)) + (append cl-lib-fdefs cl-lib-tdefs)) + eieio-fdefs eieio-tdefs) + t))) + (cl-defs-re (eval-when-compile + (regexp-opt (append lisp-fdefs lisp-vdefs + cl-lib-fdefs cl-lib-tdefs + eieio-fdefs eieio-tdefs + cl-fdefs cl-vdefs cl-tdefs) + t))) + ;; Elisp and Common Lisp keywords. + ;; (el-kws-re (eval-when-compile + ;; (regexp-opt (append + ;; lisp-kw el-kw eieio-kw + ;; (cons "go" (mapcar (lambda (s) (concat "cl-" s)) + ;; (remove "go" cl-lib-kw)))) + ;; t))) + (cl-kws-re (eval-when-compile + (regexp-opt (append lisp-kw cl-kw eieio-kw cl-lib-kw) + t))) + ;; Elisp and Common Lisp "errors". + (el-errs-re (eval-when-compile + (regexp-opt (append (mapcar (lambda (s) (concat "cl-" s)) + cl-lib-errs) + lisp-errs el-errs) + t))) + (cl-errs-re (eval-when-compile + (regexp-opt (append lisp-errs cl-lib-errs cl-errs) t)))) + (dolist (v vdefs) + (put (intern v) 'lisp-define-type 'var)) + (dolist (v tdefs) + (put (intern v) 'lisp-define-type 'type)) + + (define-obsolete-variable-alias 'lisp-font-lock-keywords-1 + 'lisp-el-font-lock-keywords-1 "24.4") + (defconst lisp-el-font-lock-keywords-1 + `( ;; Definitions. + (,(concat "(" el-defs-re "\\_>" + ;; Any whitespace and defined object. + "[ \t']*" + "\\(([ \t']*\\)?" ;; An opening paren. + "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?") + (1 font-lock-keyword-face) + (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type))) + (cond ((eq type 'var) font-lock-variable-name-face) + ((eq type 'type) font-lock-type-face) + ;; If match-string 2 is non-nil, we encountered a + ;; form like (defalias (intern (concat s "-p"))), + ;; unless match-string 4 is also there. Then its a + ;; defmethod with (setf foo) as name. + ((or (not (match-string 2)) ;; Normal defun. + (and (match-string 2) ;; Setf method. + (match-string 4))) font-lock-function-name-face))) + nil t)) + ;; Emacs Lisp autoload cookies. Supports the slightly different + ;; forms used by mh-e, calendar, etc. + ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend)) + "Subdued level highlighting for Emacs Lisp mode.") + + (defconst lisp-cl-font-lock-keywords-1 + `( ;; Definitions. + (,(concat "(" cl-defs-re "\\_>" + ;; Any whitespace and defined object. + "[ \t']*" + "\\(([ \t']*\\)?" ;; An opening paren. + "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?") + (1 font-lock-keyword-face) + (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type))) + (cond ((eq type 'var) font-lock-variable-name-face) + ((eq type 'type) font-lock-type-face) + ((or (not (match-string 2)) ;; Normal defun. + (and (match-string 2) ;; Setf function. + (match-string 4))) font-lock-function-name-face))) + nil t))) + "Subdued level highlighting for Lisp modes.") + + (define-obsolete-variable-alias 'lisp-font-lock-keywords-2 + 'lisp-el-font-lock-keywords-2 "24.4") + (defconst lisp-el-font-lock-keywords-2 + (append + lisp-el-font-lock-keywords-1 + `( ;; Regexp negated char group. + ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend) + ;; Control structures. Common Lisp forms. + (lisp--el-match-keyword . 1) + ;; Exit/Feature symbols as constants. + (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>" + "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?") + (1 font-lock-keyword-face) + (2 font-lock-constant-face nil t)) + ;; Erroneous structures. + (,(concat "(" el-errs-re "\\_>") + (1 font-lock-warning-face)) + ;; Words inside \\[] tend to be for `substitute-command-keys'. + ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]" + (1 font-lock-constant-face prepend)) + ;; Words inside `' tend to be symbol names. + ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'" + (1 font-lock-constant-face prepend)) + ;; Constant values. + ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face) + ;; ELisp and CLisp `&' keywords as types. + ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face) + ;; ELisp regexp grouping constructs + (,(lambda (bound) + (catch 'found + ;; The following loop is needed to continue searching after matches + ;; that do not occur in strings. The associated regexp matches one + ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'. `\\\\' has been included to + ;; avoid highlighting, for example, `\\(' in `\\\\('. + (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t) + (unless (match-beginning 2) + (let ((face (get-text-property (1- (point)) 'face))) + (when (or (and (listp face) + (memq 'font-lock-string-face face)) + (eq 'font-lock-string-face face)) + (throw 'found t))))))) + (1 'font-lock-regexp-grouping-backslash prepend) + (3 'font-lock-regexp-grouping-construct prepend)) + ;; This is too general -- rms. + ;; A user complained that he has functions whose names start with `do' + ;; and that they get the wrong color. + ;; ;; CL `with-' and `do-' constructs + ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) + (lisp--match-hidden-arg + (0 '(face font-lock-warning-face + help-echo "Hidden behind deeper element; move to another line?"))) + )) + "Gaudy level highlighting for Emacs Lisp mode.") + + (defconst lisp-cl-font-lock-keywords-2 + (append + lisp-cl-font-lock-keywords-1 + `( ;; Regexp negated char group. + ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend) + ;; Control structures. Common Lisp forms. + (,(concat "(" cl-kws-re "\\_>") . 1) + ;; Exit/Feature symbols as constants. + (,(concat "(\\(catch\\|throw\\|provide\\|require\\)\\_>" + "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?") + (1 font-lock-keyword-face) + (2 font-lock-constant-face nil t)) + ;; Erroneous structures. + (,(concat "(" cl-errs-re "\\_>") + (1 font-lock-warning-face)) + ;; Words inside `' tend to be symbol names. + ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'" + (1 font-lock-constant-face prepend)) + ;; Constant values. + ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face) + ;; ELisp and CLisp `&' keywords as types. + ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face) + ;; This is too general -- rms. + ;; A user complained that he has functions whose names start with `do' + ;; and that they get the wrong color. + ;; ;; CL `with-' and `do-' constructs + ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) + (lisp--match-hidden-arg + (0 '(face font-lock-warning-face + help-echo "Hidden behind deeper element; move to another line?"))) + )) + "Gaudy level highlighting for Lisp modes."))) (define-obsolete-variable-alias 'lisp-font-lock-keywords 'lisp-el-font-lock-keywords "24.4") diff --git a/lisp/subr.el b/lisp/subr.el index 9c56e51..b9a847d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1502,6 +1502,19 @@ All symbols are bound before the VALUEFORMs are evalled." ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) ,@body)) +(defmacro let-when-compile (bindings &rest body) + "Like `let', but allow for compile time optimization. +Use BINDINGS as in regular `let', but in BODY each usage should +be wrapped in `eval-when-compile'. +This will generate compile-time constants from BINDINGS." + (declare (indent 1) (debug let)) + (cl-progv (mapcar #'car bindings) + (mapcar (lambda (x) (eval (cadr x))) bindings) + (macroexpand-all + (macroexp-progn + body) + macroexpand-all-environment))) + (defmacro with-wrapper-hook (hook args &rest body) "Run BODY, using wrapper functions from HOOK with additional ARGS. HOOK is an abnormal hook. Each hook function in HOOK \"wraps\" commit 1972e49f924dc8706aef512a0d69fd7c29a4f1f6 Author: Artur Malabarba Date: Wed May 20 14:13:22 2015 +0100 * lisp/emacs-lisp/package.el: "Delete" button in Help buffer (package-delete-button-action): New function. (describe-package-1): Add Delete button. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 9e849d5..1ab1b4b 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2173,7 +2173,14 @@ will be deleted." (insert "'")) (if signed (insert ".") - (insert " (unsigned)."))) + (insert " (unsigned).")) + (when (and (package-desc-p desc) + (not required-by) + (package-installed-p desc)) + (insert " ") + (package-make-button "Delete" + 'action #'package-delete-button-action + 'package-desc desc))) (incompatible-reason (insert (propertize "Incompatible" 'face font-lock-warning-face) " because it depends on ") @@ -2317,6 +2324,14 @@ will be deleted." (revert-buffer nil t) (goto-char (point-min))))) +(defun package-delete-button-action (button) + (let ((pkg-desc (button-get button 'package-desc))) + (when (y-or-n-p (format "Delete package `%s'? " + (package-desc-full-name pkg-desc))) + (package-delete pkg-desc) + (revert-buffer nil t) + (goto-char (point-min))))) + (defun package-keyword-button-action (button) (let ((pkg-keyword (button-get button 'package-keyword))) (package-show-package-list t (list pkg-keyword)))) commit 578f0067b75ae86f3443bb359554235a40c12c78 Author: Artur Malabarba Date: Wed May 20 14:03:03 2015 +0100 * lisp/emacs-lisp/package.el: Better dependency description (package--used-elsewhere-p): New optional arg, ALL, and return package-desc objects instead of names. (package-delete): Update accordingly. (describe-package-1): Describe which packages require the package. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 55fa962..9e849d5 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1646,21 +1646,25 @@ These are packages which are neither contained in unless (memq p needed) collect p))) -(defun package--used-elsewhere-p (pkg-desc &optional pkg-list) +(defun package--used-elsewhere-p (pkg-desc &optional pkg-list all) "Non-nil if PKG-DESC is a dependency of a package in PKG-LIST. Return the first package found in PKG-LIST of which PKG is a -dependency. +dependency. If ALL is non-nil, return all such packages instead. When not specified, PKG-LIST defaults to `package-alist' with PKG-DESC entry removed." (unless (string= (package-desc-status pkg-desc) "obsolete") - (let ((pkg (package-desc-name pkg-desc))) - (cl-loop with alist = (or pkg-list - (remove (assq pkg package-alist) - package-alist)) - for p in alist thereis - (and (memq pkg (mapcar #'car (package-desc-reqs (cadr p)))) - (car p)))))) + (let* ((pkg (package-desc-name pkg-desc)) + (alist (or pkg-list + (remove (assq pkg package-alist) + package-alist)))) + (if all + (cl-loop for p in alist + if (assq pkg (package-desc-reqs (cadr p))) + collect (cadr p)) + (cl-loop for p in alist thereis + (and (assq pkg (package-desc-reqs (cadr p))) + (cadr p))))))) (defun package--sort-deps-in-alist (package only) "Return a list of dependencies for PACKAGE sorted by dependency. @@ -2027,7 +2031,7 @@ If NOSAVE is non-nil, the package is not removed from ;; Don't delete packages used as dependency elsewhere. (error "Package `%s' is used by `%s' as dependency, not deleting" (package-desc-full-name pkg-desc) - pkg-used-elsewhere-by)) + (package-desc-name pkg-used-elsewhere-by))) (t (delete-directory dir t t) ;; Remove NAME-VERSION.signed file. @@ -2127,6 +2131,7 @@ will be deleted." (name (if desc (package-desc-name desc) pkg)) (pkg-dir (if desc (package-desc-dir desc))) (reqs (if desc (package-desc-reqs desc))) + (required-by (if desc (package--used-elsewhere-p desc nil 'all))) (version (if desc (package-desc-version desc))) (archive (if desc (package-desc-archive desc))) (extras (and desc (package-desc-extras desc))) @@ -2212,6 +2217,19 @@ will be deleted." (help-insert-xref-button text 'help-package name) (insert reason))) (insert "\n"))) + (when required-by + (insert (propertize "Required by" 'font-lock-face 'bold) ": ") + (let ((first t)) + (dolist (pkg required-by) + (let ((text (package-desc-full-name pkg))) + (cond (first (setq first nil)) + ((>= (+ 2 (current-column) (length text)) + (window-width)) + (insert ",\n ")) + (t (insert ", "))) + (help-insert-xref-button text 'help-package + (package-desc-name pkg)))) + (insert "\n"))) (insert " " (propertize "Summary" 'font-lock-face 'bold) ": " (if desc (package-desc-summary desc)) "\n") (when homepage