commit e4de91d8dd2a06125140fb42772ec84a2f7ab290 (HEAD, refs/remotes/origin/master) Author: Alan Mackenzie Date: Wed Aug 12 21:28:55 2015 +0000 Introduce new macros to cover Emacs's new names in cl-lib.el. This also eliminates `mapcan' warnings in XEmacs. progmodes/cc-defs.el (c--mapcan-status): new variable to characterise [X]Emacs versions. (top-level): Require either 'cl or 'cl-lib, depending on c--mapcan-status. Change this back to cc-external-require from an eval-when-compile require. (c--mapcan, c--set-difference, c--intersection, c--macroexpand-all) (c--delete-duplicates): New macros which expand into either old or new names. (c-make-keywords-re, c-lang-defconst, c-lang-const) Use the new macros rather than the old names. progmodes/cc-engine.el (c-declare-lang-variables): Use c--mapcan rather than mapcan. progmodes/cc-fonts.el (c-compose-keywords-list): Use c--mapcan. progmodes/cc-langs.el (top-level): Require either 'cl or 'cl-lib, depending on c--mapcan-status. (c-filter-ops, c-all-op-syntax-tokens, c-assignment-op-regexp) (c-type-start-kwds, c-prefix-spec-kwds, c-specifier-key) (c-not-decl-init-keywords, c-not-primitive-type-keywords) (c-paren-any-kwds, c-<>-sexp-kwds, c-block-stmt-kwds, c-expr-kwds) (c-decl-block-key, c-keywords, c-keywords-obarray) (c-regular-keywords-regexp, c-primary-expr-regexp, c-primary-expr-regexp) (c-block-prefix-disallowed-chars, c-known-type-key, c-nonlabel-token-key) (c-make-init-lang-vars-fun): Use the new macros rather than the old names. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index fd4bfb3..9e750a4 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -43,7 +43,23 @@ load-path))) (load "cc-bytecomp" nil t))) -(eval-when-compile (require 'cl)) ; was (cc-external-require 'cl). ACM 2005/11/29. +(eval-and-compile + (defvar c--mapcan-status + (cond ((and (fboundp 'mapcan) + (subrp (symbol-function 'mapcan))) + ;; XEmacs + 'mapcan) + ((locate-file "cl-lib.elc" load-path) + ;; Emacs >= 24.3 + 'cl-mapcan) + (t + ;; Emacs <= 24.2 + nil)))) + +(cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl)) +; was (cc-external-require 'cl). ACM 2005/11/29. +; Changed from (eval-when-compile (require 'cl)) back to +; cc-external-require, 2015-08-12. (cc-external-require 'regexp-opt) ;; Silence the compiler. @@ -173,12 +189,47 @@ This variant works around bugs in `eval-when-compile' in various (put 'cc-eval-when-compile 'lisp-indent-hook 0)) -(eval-and-compile - (defalias 'c--macroexpand-all - (if (fboundp 'macroexpand-all) - 'macroexpand-all 'cl-macroexpand-all))) ;;; Macros. +(defmacro c--mapcan (fun liszt) + ;; CC Mode equivalent of `mapcan' which bridges the difference + ;; between the host [X]Emacsen." + ;; The motivation for this macro is to avoid the irritating message + ;; "function `mapcan' from cl package called at runtime" produced by Emacs. + (cond + ((eq c--mapcan-status 'mapcan) + `(mapcan ,fun ,liszt)) + ((eq c--mapcan-status 'cl-mapcan) + `(cl-mapcan ,fun ,liszt)) + (t + ;; Emacs <= 24.2. It would be nice to be able to distinguish between + ;; compile-time and run-time use here. + `(apply 'nconc (mapcar ,fun ,liszt))))) + +(defmacro c--set-difference (liszt1 liszt2 &rest other-args) + ;; Macro to smooth out the renaming of `set-difference' in Emacs 24.3. + (if (eq c--mapcan-status 'cl-mapcan) + `(cl-set-difference ,liszt1 ,liszt2 ,@other-args) + `(set-difference ,liszt1 ,liszt2 ,@other-args))) + +(defmacro c--intersection (liszt1 liszt2 &rest other-args) + ;; Macro to smooth out the renaming of `intersection' in Emacs 24.3. + (if (eq c--mapcan-status 'cl-mapcan) + `(cl-intersection ,liszt1 ,liszt2 ,@other-args) + `(intersection ,liszt1 ,liszt2 ,@other-args))) + +(eval-and-compile + (defmacro c--macroexpand-all (form &optional environment) + ;; Macro to smooth out the renaming of `cl-macroexpand-all' in Emacs 24.3. + (if (eq c--mapcan-status 'cl-mapcan) + `(macroexpand-all ,form ,environment) + `(cl-macroexpand-all ,form ,environment))) + + (defmacro c--delete-duplicates (cl-seq &rest cl-keys) + ;; Macro to smooth out the renaming of `delete-duplicates' in Emacs 24.3. + (if (eq c--mapcan-status 'cl-mapcan) + `(cl-delete-duplicates ,cl-seq ,@cl-keys) + `(delete-duplicates ,cl-seq ,@cl-keys)))) (defmacro c-point (position &optional point) "Return the value of certain commonly referenced POSITIONs relative to POINT. @@ -2228,12 +2279,12 @@ quoted." ;; are no file dependencies needed. (nreverse ;; Reverse to get the right load order. - (apply 'nconc - (mapcar (lambda (elem) - (if (eq file (car elem)) - nil ; Exclude our own file. - (list (car elem)))) - (get sym 'source)))))) + (c--mapcan (lambda (elem) + (if (eq file (car elem)) + nil ; Exclude our own file. + (list (car elem)))) + (get sym 'source))))) + ;; Make some effort to do a compact call to ;; `c-get-lang-constant' since it will be compiled in. (args (and mode `(',mode)))) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 06b03a2..f5285a6 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -154,12 +154,12 @@ (defmacro c-declare-lang-variables () `(progn - ,@(mapcan (lambda (init) - `(,(if (elt init 2) - `(defvar ,(car init) nil ,(elt init 2)) - `(defvar ,(car init) nil)) - (make-variable-buffer-local ',(car init)))) - (cdr c-lang-variable-inits)))) + ,@(c--mapcan (lambda (init) + `(,(if (elt init 2) + `(defvar ,(car init) nil ,(elt init 2)) + `(defvar ,(car init) nil)) + (make-variable-buffer-local ',(car init)))) + (cdr c-lang-variable-inits)))) (c-declare-lang-variables) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 0f9b2d3..02599e8 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1958,19 +1958,18 @@ higher." (cdr-safe (or (assq c-buffer-is-cc-mode c-doc-comment-style) (assq 'other c-doc-comment-style))) c-doc-comment-style)) - (list (nconc (apply 'nconc - (mapcar - (lambda (doc-style) - (let ((sym (intern - (concat (symbol-name doc-style) - "-font-lock-keywords")))) - (cond ((fboundp sym) - (funcall sym)) - ((boundp sym) - (append (eval sym) nil))))) - (if (listp doc-keywords) - doc-keywords - (list doc-keywords)))) + (list (nconc (c--mapcan + (lambda (doc-style) + (let ((sym (intern + (concat (symbol-name doc-style) + "-font-lock-keywords")))) + (cond ((fboundp sym) + (funcall sym)) + ((boundp sym) + (append (eval sym) nil))))) + (if (listp doc-keywords) + doc-keywords + (list doc-keywords))) base-list))) ;; Kludge: If `c-font-lock-complex-decl-prepare' is on the list we diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 07f5ef4..f971956 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -130,7 +130,7 @@ ;; This file is not always loaded. See note above. -(cc-external-require 'cl) +(cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl)) ;;; Setup for the `c-lang-defvar' system. @@ -251,19 +251,19 @@ the evaluated constant value at compile time." (unless xlate (setq xlate 'identity)) (c-with-syntax-table (c-lang-const c-mode-syntax-table) - (delete-duplicates - (mapcan (lambda (opgroup) - (when (if (symbolp (car opgroup)) - (when (funcall opgroup-filter (car opgroup)) - (setq opgroup (cdr opgroup)) - t) - t) - (mapcan (lambda (op) - (when (funcall op-filter op) - (let ((res (funcall xlate op))) - (if (listp res) res (list res))))) - opgroup))) - ops) + (c--delete-duplicates + (c--mapcan (lambda (opgroup) + (when (if (symbolp (car opgroup)) + (when (funcall opgroup-filter (car opgroup)) + (setq opgroup (cdr opgroup)) + t) + t) + (c--mapcan (lambda (op) + (when (funcall op-filter op) + (let ((res (funcall xlate op))) + (if (listp res) res (list res))))) + opgroup))) + ops) :test 'equal)))) @@ -1165,9 +1165,9 @@ operators." (c-lang-defconst c-all-op-syntax-tokens ;; List of all tokens in the punctuation and parenthesis syntax ;; classes. - t (delete-duplicates (append (c-lang-const c-other-op-syntax-tokens) - (c-lang-const c-operator-list)) - :test 'string-equal)) + t (c--delete-duplicates (append (c-lang-const c-other-op-syntax-tokens) + (c-lang-const c-operator-list)) + :test 'string-equal)) (c-lang-defconst c-nonsymbol-token-char-list ;; List containing all chars not in the word, symbol or @@ -1204,9 +1204,9 @@ operators." "=\\([^=]\\|$\\)" "\\|" (c-make-keywords-re nil - (set-difference (c-lang-const c-assignment-operators) - '("=") - :test 'string-equal))) + (c--set-difference (c-lang-const c-assignment-operators) + '("=") + :test 'string-equal))) "\\<\\>")) (c-lang-defvar c-assignment-op-regexp (c-lang-const c-assignment-op-regexp)) @@ -1256,7 +1256,7 @@ operators." ;; multicharacter tokens that begin with ">" except for those beginning with ;; ">>". t (c-make-keywords-re nil - (set-difference + (c--set-difference (c-lang-const c->-op-cont-tokens) (c-filter-ops (c-lang-const c-all-op-syntax-tokens) t @@ -1765,10 +1765,10 @@ not the type face." (c-lang-defconst c-type-start-kwds ;; All keywords that can start a type (i.e. are either a type prefix ;; or a complete type). - t (delete-duplicates (append (c-lang-const c-primitive-type-kwds) - (c-lang-const c-type-prefix-kwds) - (c-lang-const c-type-modifier-kwds)) - :test 'string-equal)) + t (c--delete-duplicates (append (c-lang-const c-primitive-type-kwds) + (c-lang-const c-type-prefix-kwds) + (c-lang-const c-type-modifier-kwds)) + :test 'string-equal)) (c-lang-defconst c-class-decl-kwds "Keywords introducing declarations where the following block (if any) @@ -2030,16 +2030,16 @@ one of `c-type-list-kwds', `c-ref-list-kwds', ;; something is a type or just some sort of macro in front of the ;; declaration. They might be ambiguous with types or type ;; prefixes. - t (delete-duplicates (append (c-lang-const c-class-decl-kwds) - (c-lang-const c-brace-list-decl-kwds) - (c-lang-const c-other-block-decl-kwds) - (c-lang-const c-typedef-decl-kwds) - (c-lang-const c-typeless-decl-kwds) - (c-lang-const c-modifier-kwds) - (c-lang-const c-other-decl-kwds) - (c-lang-const c-decl-start-kwds) - (c-lang-const c-decl-hangon-kwds)) - :test 'string-equal)) + t (c--delete-duplicates (append (c-lang-const c-class-decl-kwds) + (c-lang-const c-brace-list-decl-kwds) + (c-lang-const c-other-block-decl-kwds) + (c-lang-const c-typedef-decl-kwds) + (c-lang-const c-typeless-decl-kwds) + (c-lang-const c-modifier-kwds) + (c-lang-const c-other-decl-kwds) + (c-lang-const c-decl-start-kwds) + (c-lang-const c-decl-hangon-kwds)) + :test 'string-equal)) (c-lang-defconst c-prefix-spec-kwds-re ;; Adorned regexp of `c-prefix-spec-kwds'. @@ -2052,10 +2052,10 @@ one of `c-type-list-kwds', `c-ref-list-kwds', ;; ambiguous with types or type prefixes. These are the keywords (like ;; extern, namespace, but NOT template) that can modify a declaration. t (c-make-keywords-re t - (set-difference (c-lang-const c-prefix-spec-kwds) - (append (c-lang-const c-type-start-kwds) - (c-lang-const c-<>-arglist-kwds)) - :test 'string-equal))) + (c--set-difference (c-lang-const c-prefix-spec-kwds) + (append (c-lang-const c-type-start-kwds) + (c-lang-const c-<>-arglist-kwds)) + :test 'string-equal))) (c-lang-defvar c-specifier-key (c-lang-const c-specifier-key)) (c-lang-defconst c-postfix-spec-kwds @@ -2068,19 +2068,19 @@ one of `c-type-list-kwds', `c-ref-list-kwds', ;; Adorned regexp matching all keywords that can't appear at the ;; start of a declaration. t (c-make-keywords-re t - (set-difference (c-lang-const c-keywords) - (append (c-lang-const c-type-start-kwds) - (c-lang-const c-prefix-spec-kwds) - (c-lang-const c-typeof-kwds)) - :test 'string-equal))) + (c--set-difference (c-lang-const c-keywords) + (append (c-lang-const c-type-start-kwds) + (c-lang-const c-prefix-spec-kwds) + (c-lang-const c-typeof-kwds)) + :test 'string-equal))) (c-lang-defvar c-not-decl-init-keywords (c-lang-const c-not-decl-init-keywords)) (c-lang-defconst c-not-primitive-type-keywords "List of all keywords apart from primitive types (like \"int\")." - t (set-difference (c-lang-const c-keywords) - (c-lang-const c-primitive-type-kwds) - :test 'string-equal) + t (c--set-difference (c-lang-const c-keywords) + (c-lang-const c-primitive-type-kwds) + :test 'string-equal) ;; The "more" for C++ is the QT keyword (as in "more slots:"). ;; This variable is intended for use in c-beginning-of-statement-1. c++ (append (c-lang-const c-not-primitive-type-keywords) '("more"))) @@ -2224,9 +2224,9 @@ type identifiers separated by arbitrary tokens." pike '("array" "function" "int" "mapping" "multiset" "object" "program")) (c-lang-defconst c-paren-any-kwds - t (delete-duplicates (append (c-lang-const c-paren-nontype-kwds) - (c-lang-const c-paren-type-kwds)) - :test 'string-equal)) + t (c--delete-duplicates (append (c-lang-const c-paren-nontype-kwds) + (c-lang-const c-paren-type-kwds)) + :test 'string-equal)) (c-lang-defconst c-<>-type-kwds "Keywords that may be followed by an angle bracket expression @@ -2250,9 +2250,9 @@ assumed to be set if this isn't nil." (c-lang-defconst c-<>-sexp-kwds ;; All keywords that can be followed by an angle bracket sexp. - t (delete-duplicates (append (c-lang-const c-<>-type-kwds) - (c-lang-const c-<>-arglist-kwds)) - :test 'string-equal)) + t (c--delete-duplicates (append (c-lang-const c-<>-type-kwds) + (c-lang-const c-<>-arglist-kwds)) + :test 'string-equal)) (c-lang-defconst c-opt-<>-sexp-key ;; Adorned regexp matching keywords that can be followed by an angle @@ -2310,9 +2310,9 @@ Keywords here should also be in `c-block-stmt-1-kwds'." (c-lang-defconst c-block-stmt-kwds ;; Union of `c-block-stmt-1-kwds' and `c-block-stmt-2-kwds'. - t (delete-duplicates (append (c-lang-const c-block-stmt-1-kwds) - (c-lang-const c-block-stmt-2-kwds)) - :test 'string-equal)) + t (c--delete-duplicates (append (c-lang-const c-block-stmt-1-kwds) + (c-lang-const c-block-stmt-2-kwds)) + :test 'string-equal)) (c-lang-defconst c-opt-block-stmt-key ;; Regexp matching the start of any statement that has a @@ -2417,7 +2417,7 @@ This construct is \" :\"." (c-lang-defconst c-expr-kwds ;; Keywords that can occur anywhere in expressions. Built from ;; `c-primary-expr-kwds' and all keyword operators in `c-operators'. - t (delete-duplicates + t (c--delete-duplicates (append (c-lang-const c-primary-expr-kwds) (c-filter-ops (c-lang-const c-operator-list) t @@ -2468,12 +2468,12 @@ Note that Java specific rules are currently applied to tell this from t (let* ((decl-kwds (append (c-lang-const c-class-decl-kwds) (c-lang-const c-other-block-decl-kwds) (c-lang-const c-inexpr-class-kwds))) - (unambiguous (set-difference decl-kwds - (c-lang-const c-type-start-kwds) - :test 'string-equal)) - (ambiguous (intersection decl-kwds - (c-lang-const c-type-start-kwds) - :test 'string-equal))) + (unambiguous (c--set-difference decl-kwds + (c-lang-const c-type-start-kwds) + :test 'string-equal)) + (ambiguous (c--intersection decl-kwds + (c-lang-const c-type-start-kwds) + :test 'string-equal))) (if ambiguous (concat (c-make-keywords-re t unambiguous) "\\|" @@ -2521,7 +2521,7 @@ Note that Java specific rules are currently applied to tell this from (c-lang-defconst c-keywords ;; All keywords as a list. - t (delete-duplicates + t (c--delete-duplicates (c-lang-defconst-eval-immediately `(append ,@(mapcar (lambda (kwds-lang-const) `(c-lang-const ,kwds-lang-const)) @@ -2585,6 +2585,7 @@ Note that Java specific rules are currently applied to tell this from (setplist (intern kwd obarray) ;; Emacs has an odd bug that causes `mapcan' to fail ;; with unintelligible errors. (XEmacs works.) + ;; (2015-06-24): This bug has not yet been fixed. ;;(mapcan (lambda (lang-const) ;; (list lang-const t)) ;; lang-const-list) @@ -2597,10 +2598,10 @@ Note that Java specific rules are currently applied to tell this from ;; Adorned regexp matching all keywords that should be fontified ;; with the keywords face. I.e. that aren't types or constants. t (c-make-keywords-re t - (set-difference (c-lang-const c-keywords) - (append (c-lang-const c-primitive-type-kwds) - (c-lang-const c-constant-kwds)) - :test 'string-equal))) + (c--set-difference (c-lang-const c-keywords) + (append (c-lang-const c-primitive-type-kwds) + (c-lang-const c-constant-kwds)) + :test 'string-equal))) (c-lang-defvar c-regular-keywords-regexp (c-lang-const c-regular-keywords-regexp)) @@ -2635,12 +2636,12 @@ Note that Java specific rules are currently applied to tell this from right-assoc-sequence) t)) - (unambiguous-prefix-ops (set-difference nonkeyword-prefix-ops - in-or-postfix-ops - :test 'string-equal)) - (ambiguous-prefix-ops (intersection nonkeyword-prefix-ops - in-or-postfix-ops - :test 'string-equal))) + (unambiguous-prefix-ops (c--set-difference nonkeyword-prefix-ops + in-or-postfix-ops + :test 'string-equal)) + (ambiguous-prefix-ops (c--intersection nonkeyword-prefix-ops + in-or-postfix-ops + :test 'string-equal))) (concat "\\(" @@ -2648,14 +2649,14 @@ Note that Java specific rules are currently applied to tell this from ;; first submatch from them together with `c-primary-expr-kwds'. (c-make-keywords-re t (append (c-lang-const c-primary-expr-kwds) - (set-difference prefix-ops nonkeyword-prefix-ops - :test 'string-equal))) + (c--set-difference prefix-ops nonkeyword-prefix-ops + :test 'string-equal))) "\\|" ;; Match all ambiguous operators. (c-make-keywords-re nil - (intersection nonkeyword-prefix-ops in-or-postfix-ops - :test 'string-equal)) + (c--intersection nonkeyword-prefix-ops in-or-postfix-ops + :test 'string-equal)) "\\)" "\\|" @@ -2670,8 +2671,8 @@ Note that Java specific rules are currently applied to tell this from "\\|" ;; The unambiguous operators from `prefix-ops'. (c-make-keywords-re nil - (set-difference nonkeyword-prefix-ops in-or-postfix-ops - :test 'string-equal)) + (c--set-difference nonkeyword-prefix-ops in-or-postfix-ops + :test 'string-equal)) "\\|" ;; Match string and character literals. @@ -2816,7 +2817,7 @@ possible for good performance." ;; Default to all chars that only occurs in nonsymbol tokens outside ;; identifiers. - t (set-difference + t (c--set-difference (c-lang-const c-nonsymbol-token-char-list) (c-filter-ops (append (c-lang-const c-identifier-ops) (list (cons nil @@ -2833,26 +2834,26 @@ possible for good performance." ;; Allow cpp operations (where applicable). t (if (c-lang-const c-opt-cpp-prefix) - (set-difference (c-lang-const c-block-prefix-disallowed-chars) - '(?#)) + (c--set-difference (c-lang-const c-block-prefix-disallowed-chars) + '(?#)) (c-lang-const c-block-prefix-disallowed-chars)) ;; Allow ':' for inherit list starters. - (c++ objc idl) (set-difference (c-lang-const c-block-prefix-disallowed-chars) - '(?:)) + (c++ objc idl) (c--set-difference (c-lang-const c-block-prefix-disallowed-chars) + '(?:)) ;; Allow ',' for multiple inherits. - (c++ java) (set-difference (c-lang-const c-block-prefix-disallowed-chars) - '(?,)) + (c++ java) (c--set-difference (c-lang-const c-block-prefix-disallowed-chars) + '(?,)) ;; Allow parentheses for anonymous inner classes in Java and class ;; initializer lists in Pike. - (java pike) (set-difference (c-lang-const c-block-prefix-disallowed-chars) - '(?\( ?\))) + (java pike) (c--set-difference (c-lang-const c-block-prefix-disallowed-chars) + '(?\( ?\))) ;; Allow '"' for extern clauses (e.g. extern "C" {...}). - (c c++ objc) (set-difference (c-lang-const c-block-prefix-disallowed-chars) - '(?\" ?'))) + (c c++ objc) (c--set-difference (c-lang-const c-block-prefix-disallowed-chars) + '(?\" ?'))) (c-lang-defconst c-block-prefix-charset ;; `c-block-prefix-disallowed-chars' as an inverted charset suitable @@ -3157,10 +3158,10 @@ i.e. before \":\". Only used if `c-recognize-colon-labels' is set." t (concat ;; All keywords except `c-label-kwds' and `c-protection-kwds'. (c-make-keywords-re t - (set-difference (c-lang-const c-keywords) - (append (c-lang-const c-label-kwds) - (c-lang-const c-protection-kwds)) - :test 'string-equal))) + (c--set-difference (c-lang-const c-keywords) + (append (c-lang-const c-label-kwds) + (c-lang-const c-protection-kwds)) + :test 'string-equal))) ;; Don't allow string literals, except in AWK. Character constants are OK. (c objc java pike idl) (concat "\"\\|" (c-lang-const c-nonlabel-token-key)) @@ -3280,16 +3281,16 @@ accomplish that conveniently." ;; `c-lang-const' will expand to the evaluated ;; constant immediately in `c--macroexpand-all' ;; below. - (mapcan + (c--mapcan (lambda (init) `(current-var ',(car init) - ,(car init) ,(c--macroexpand-all - (elt init 1)))) + ,(car init) ,(c--macroexpand-all + (elt init 1)))) ;; Note: The following `append' copies the ;; first argument. That list is small, so ;; this doesn't matter too much. - (append (cdr c-emacs-variable-inits) - (cdr c-lang-variable-inits))))) + (append (cdr c-emacs-variable-inits) + (cdr c-lang-variable-inits))))) ;; This diagnostic message isn't useful for end ;; users, so it's disabled. commit 401bc8b28d47db697e4997d35059ce5bc45f5648 Author: Oleh Krehel Date: Wed Aug 12 20:12:14 2015 +0200 loadhist.el (read-feature): Conform to completing-read * lisp/loadhist.el (read-feature): According to `completing-read' documentation, if collection is a list, then it must be a list of strings. And not a list of symbols like before. diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 056a4ef..52fd047 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -101,10 +101,15 @@ A library name is equivalent to the file name that `load-library' would load." "Read feature name from the minibuffer, prompting with string PROMPT. If optional second arg LOADED-P is non-nil, the feature must be loaded from a file." - (intern (completing-read prompt - features - (and loaded-p #'feature-file) - loaded-p))) + (intern (completing-read + prompt + (mapcar #'symbol-name + (if loaded-p + (delq nil + (mapcar + (lambda (x) (and (feature-file x) x)) + features)) + features))))) (defvaralias 'loadhist-hook-functions 'unload-feature-special-hooks) (defvar unload-feature-special-hooks commit ad0b6dd05a1a782dc12e921fc077aef46698e063 Author: David Kastrup Date: Wed Jan 28 11:53:54 2015 +0100 Deal gracefully with up-events (Bug#19746) * keyboard.c (apply_modifiers_uncached, parse_solitary_modifier) (parse_modifiers_uncached): React gracefully to "up-" modifiers: those may easily be injected by user-level Lisp code. (read_key_sequence): Discard unbound up-events like unbound down-events: they are even more likely only relevant for special purposes. While Emacs will not produce up-events on its own currently (those are converted to drag or click events before being converted to Lisp-readable structures), the input queue can be made to contain them by synthesizing events to `unread-command-events'. Emacs should deal consistently with such events. diff --git a/src/keyboard.c b/src/keyboard.c index f670da3..6f626b7 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -6241,6 +6241,10 @@ parse_modifiers_uncached (Lisp_Object symbol, ptrdiff_t *modifier_end) case 't': MULTI_LETTER_MOD (triple_modifier, "triple", 6); break; + + case 'u': + MULTI_LETTER_MOD (up_modifier, "up", 2); + break; #undef MULTI_LETTER_MOD } @@ -6288,16 +6292,19 @@ apply_modifiers_uncached (int modifiers, char *base, int base_len, int base_len_ /* Since BASE could contain nulls, we can't use intern here; we have to use Fintern, which expects a genuine Lisp_String, and keeps a reference to it. */ - char new_mods[sizeof "A-C-H-M-S-s-down-drag-double-triple-"]; + char new_mods[sizeof "A-C-H-M-S-s-up-down-drag-double-triple-"]; int mod_len; { char *p = new_mods; - /* Only the event queue may use the `up' modifier; it should always - be turned into a click or drag event before presented to lisp code. */ - if (modifiers & up_modifier) - emacs_abort (); + /* Mouse events should not exhibit the `up' modifier once they + leave the event queue only accessible to C code; `up' will + always be turned into a click or drag event before being + presented to lisp code. But since lisp events can be + synthesized bypassing the event queue and pushed into + `unread-command-events' or its companions, it's better to just + deal with unexpected modifier combinations. */ if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; } if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; } @@ -6307,6 +6314,7 @@ apply_modifiers_uncached (int modifiers, char *base, int base_len, int base_len_ if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; } if (modifiers & double_modifier) p = stpcpy (p, "double-"); if (modifiers & triple_modifier) p = stpcpy (p, "triple-"); + if (modifiers & up_modifier) p = stpcpy (p, "up-"); if (modifiers & down_modifier) p = stpcpy (p, "down-"); if (modifiers & drag_modifier) p = stpcpy (p, "drag-"); /* The click modifier is denoted by the absence of other modifiers. */ @@ -6426,8 +6434,7 @@ DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers, BASE must be unmodified. This is like apply_modifiers_uncached, but uses BASE's - Qmodifier_cache property, if present. It also builds - Qevent_symbol_elements properties, since it has that info anyway. + Qmodifier_cache property, if present. apply_modifiers copies the value of BASE's Qevent_kind property to the modified symbol. */ @@ -6773,6 +6780,10 @@ parse_solitary_modifier (Lisp_Object symbol) MULTI_LETTER_MOD (triple_modifier, "triple", 6); break; + case 'u': + MULTI_LETTER_MOD (up_modifier, "up", 2); + break; + #undef SINGLE_LETTER_MOD #undef MULTI_LETTER_MOD } @@ -9486,14 +9497,16 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, Drags reduce to clicks. Double-clicks reduce to clicks. Triple-clicks reduce to double-clicks, then to clicks. - Down-clicks are eliminated. + Up/Down-clicks are eliminated. Double-downs reduce to downs, then are eliminated. Triple-downs reduce to double-downs, then to downs, then are eliminated. */ - if (modifiers & (down_modifier | drag_modifier + if (modifiers & (up_modifier | down_modifier + | drag_modifier | double_modifier | triple_modifier)) { - while (modifiers & (down_modifier | drag_modifier + while (modifiers & (up_modifier | down_modifier + | drag_modifier | double_modifier | triple_modifier)) { Lisp_Object new_head, new_click; @@ -9505,7 +9518,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, modifiers &= ~drag_modifier; else { - /* Dispose of this `down' event by simply jumping + /* Dispose of this `up/down' event by simply jumping back to replay_key, to get another event. Note that if this event came from mock input, commit b367d7fc7b234bb98b330ac61bf35372f0f0acae Author: Eli Zaretskii Date: Wed Aug 12 18:55:38 2015 +0300 Fix display of thin lines whose newline has line-height property of t * src/xdisp.c (append_space_for_newline): Don't try to fix ascent and descent values of non-empty glyph rows, since they could have forced low values deliberately. (Bug#21243) diff --git a/src/xdisp.c b/src/xdisp.c index 7371216..9b76174 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -19229,7 +19229,7 @@ append_space_for_newline (struct it *it, bool default_face_p) funny, and height of empty lines will be incorrect. */ g = it->glyph_row->glyphs[TEXT_AREA] + n; struct font *font = face->font ? face->font : FRAME_FONT (it->f); - if (n == 0 || it->glyph_row->height < font->pixel_size) + if (n == 0) { Lisp_Object height, total_height; int extra_line_spacing = it->extra_line_spacing; commit 79a169684dfad2c0bbb9fdbae539c1f30d9f0ac3 Author: Richard Stallman Date: Wed Aug 12 11:25:26 2015 -0400 Offer to combine multiple To or CC fields. * sendmail.el (mail-combine-fields): New function. (mail-send): Call 'mail-combine-fields'. diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 2b9d8fa..5b5ee4e 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -907,6 +907,8 @@ the user from the mailer." (concat "\\(?:[[:space:];,]\\|\\`\\)" (regexp-opt mail-mailing-lists t) "\\(?:[[:space:];,]\\|\\'\\)")))) + (mail-combine-fields "To") + (mail-combine-fields "CC") ;; If there are mailing lists defined (when ml (save-excursion @@ -1075,6 +1077,71 @@ This function does not perform RFC2047 encoding." (goto-char fullname-start)))) (insert ")\n"))))) +(defun mail-combine-fields (field) + "Offer to combine all FIELD fields in buffer into one FIELD field. +If this finds multiple FIELD fields, it asks the user whether +to combine them into one, and does so if the user says y." + (let ((search-pattern (format "^%s[ \t]*:" field)) + first-to-end + query-asked + query-answer + (old-point (point)) + (old-max (point-max))) + (save-excursion + (save-restriction + (goto-char (point-min)) + (narrow-to-region (point-min) (mail-header-end)) + ;; Find the first FIELD field and record where it ends. + (when (re-search-forward search-pattern nil t) + (forward-line 1) + (re-search-forward "^[^ \t]" nil t) + (beginning-of-line) + (setq first-to-end (point-marker)) + (set-marker-insertion-type first-to-end t) + ;; Find each following FIELD field + ;; and combine it with the first FIELD field. + (while (re-search-forward search-pattern nil t) + ;; For the second FIELD field, ask user to + ;; approve combining them. + ;; But if the user refuse to combine them, signal error. + (unless query-asked + (save-restriction + ;; This is just so the screen doesn't change. + (narrow-to-region (point-min) old-max) + (goto-char old-point) + (setq query-asked t) + (if (y-or-n-p (format "Message contains multiple %s fields. Combine? " field)) + (setq query-answer t)))) + (when query-answer + (let ((this-to-start (line-beginning-position)) + this-to-end + this-to) + (forward-line 1) + (re-search-forward "^[^ \t]" nil t) + (beginning-of-line) + (setq this-to-end (point)) + ;; Get the text of this FIELD field. + (setq this-to (buffer-substring this-to-start this-to-end)) + ;; Delete it. + (delete-region this-to-start this-to-end) + (save-excursion + ;; Put a comma after the first FIELD field. + (goto-char first-to-end) + (forward-char -1) + (insert ",") + ;; Copy this one after it. + (goto-char first-to-end) + (save-excursion + (insert this-to)) + ;; Replace the FIELD: with spaces. + (looking-at search-pattern) + ;; Try to preserve alignment of contents of the field + (let ((prefix-length (length (match-string 0)))) + (replace-match " ") + (dotimes (i (1- prefix-length)) + (insert " "))))))) + (set-marker first-to-end nil)))))) + (defun mail-encode-header (beg end) "Encode the mail header between BEG and END according to RFC2047. Return non-nil if and only if some part of the header is encoded." commit 9bb90024e2c7383494e91dd58a21c78faea7255b Author: Richard Stallman Date: Wed Aug 12 11:24:30 2015 -0400 Don't decrypt encrypted files. * mail-utils.el (mail-file-babyl-p): Bind epa-inhibit to t. diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index 736e3f5..3d5d7c9 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -50,9 +50,10 @@ also the To field, unless this would leave an empty To field." ;;;###autoload (defun mail-file-babyl-p (file) "Return non-nil if FILE is a Babyl file." - (with-temp-buffer - (insert-file-contents file nil 0 100) - (looking-at "BABYL OPTIONS:"))) + (let ((epa-inhibit t)) + (with-temp-buffer + (insert-file-contents file nil 0 100) + (looking-at "BABYL OPTIONS:")))) (defun mail-string-delete (string start end) "Returns a string containing all of STRING except the part commit fe45243b6ae8129bea99f79acc55c77bfd0d1d22 Author: Richard Stallman Date: Wed Aug 12 11:23:11 2015 -0400 Handle encrypted mbox files. * rmailout.el (rmail-output-as-mbox): Decrypt and reencrypt the mbox file if necessary. diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index a00c66c..6b753b3 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el @@ -345,6 +345,7 @@ the text directly to FILE-NAME, and displays a \"Wrote file\" message unless NOMSG is a symbol (neither nil nor t). AS-SEEN is non-nil if we are copying the message \"as seen\"." (let ((case-fold-search t) + encrypted-file-name from date) (goto-char (point-min)) ;; Preserve the Mail-From and MIME-Version fields @@ -364,10 +365,45 @@ AS-SEEN is non-nil if we are copying the message \"as seen\"." (goto-char (point-min)) (let ((buf (find-buffer-visiting file-name)) (tembuf (current-buffer))) + (when (string-match "[.]gpg\\'" file-name) + (setq encrypted-file-name file-name + file-name (substring file-name 0 (match-beginning 0)))) (if (null buf) - (let ((coding-system-for-write 'raw-text-unix)) + (let ((coding-system-for-write 'raw-text-unix) + (coding-system-for-read 'raw-text-unix)) + ;; If the specified file is encrypted, decrypt it. + (when encrypted-file-name + (with-temp-buffer + (insert-file-contents encrypted-file-name) + (write-region 1 (point-max) file-name nil 'nomsg))) ;; FIXME should ensure existing file ends with a blank line. - (write-region (point-min) (point-max) file-name t nomsg)) + (write-region (point-min) (point-max) file-name t + (if (or nomsg encrypted-file-name) + 'nomsg)) + ;; If the specified file was encrypted, re-encrypt it. + (when encrypted-file-name + ;; Save the old encrypted file as a backup. + (rename-file encrypted-file-name + (make-backup-file-name encrypted-file-name) + t) + (if (= 0 + (call-process "gpg" nil nil + "--use-agent" "--batch" "--no-tty" + "--encrypt" "-r" + user-mail-address + file-name)) + ;; Delete the unencrypted file if encryption succeeded. + (delete-file file-name) + ;; If encrypting failed, put back the original + ;; encrypted file and signal an error. + (rename-file (make-backup-file-name encrypted-file-name) + encrypted-file-name + t) + (error "Encryption failed; %s unchanged" + encrypted-file-name)) + (unless nomsg + (message "Added to %s" encrypted-file-name))) + ) (if (eq buf (current-buffer)) (error "Can't output message to same file it's already in")) ;; File has been visited, in buffer BUF. commit 503058a1d6df415331167ec6ada3559da431bdf8 Author: Richard Stallman Date: Wed Aug 12 11:21:49 2015 -0400 Re-enable mime processing after decryption. Add 'decrypt' keyword. * rmail.el (rmail-epa-decrypt-1): New subroutine. (rmail-epa-decrypt): rmail-epa-decrypt-1 broken out. In a mime message, reenable Mime and show the parts that were shown before. Add keyword "decrypt" if anything decrypted. diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 26c91bb..1ccf5e2 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4508,9 +4508,78 @@ encoded string (and the same mask) will decode the string." (setq i (1+ i))) (concat string-vector))) +(defun rmail-epa-decrypt-1 (mime) + "Decrypt a single GnuPG encrypted text in a message. +The starting string of the encrypted text should have just been regexp-matched. +Argument MIME is non-nil if this is a mime message." + (let* ((armor-start (match-beginning 0)) + (armor-prefix (buffer-substring + (line-beginning-position) + armor-start)) + (armor-end-regexp) + armor-end after-end + unquote) + (if (string-match "
\\'" armor-prefix)
+        (setq armor-prefix ""))
+
+    (setq armor-end-regexp
+          (concat "^"
+                  armor-prefix
+                  "-----END PGP MESSAGE-----$"))
+    (setq armor-end (re-search-forward armor-end-regexp
+                                       nil t))
+
+    (unless armor-end
+      (error "Encryption armor beginning has no matching end"))
+    (goto-char armor-start)
+
+    ;; Because epa--find-coding-system-for-mime-charset not autoloaded.
+    (require 'epa)
+
+    ;; Advance over this armor.
+    (goto-char armor-end)
+    (setq after-end (- (point-max) armor-end))
+
+    (when mime
+      (save-excursion
+        (goto-char armor-start)
+        (re-search-backward "^--" nil t)
+        (save-restriction
+          (narrow-to-region (point) armor-start)
+
+          ;; Use the charset specified in the armor.
+          (unless coding-system-for-read
+            (if (re-search-forward "^[ \t]*Charset[ \t\n]*:[ \t\n]*\\(.*\\)" nil t)
+                (setq coding-system-for-read
+                      (epa--find-coding-system-for-mime-charset
+                       (intern (downcase (match-string 1)))))))
+
+          (goto-char (point-min))
+          (if (re-search-forward "^[ \t]*Content-transfer-encoding[ \t\n]*:[ \t\n]*quoted-printable[ \t]*$" nil t)
+              (setq unquote t)))))
+
+    (when unquote
+      (let ((inhibit-read-only t))
+        (mail-unquote-printable-region armor-start
+                                       (- (point-max) after-end))))
+
+    ;; Decrypt it, maybe in place, maybe making new buffer.
+    (epa-decrypt-region
+     armor-start (- (point-max) after-end)
+     ;; Call back this function to prepare the output.
+     (lambda ()
+       (let ((inhibit-read-only t))
+         (delete-region armor-start (- (point-max) after-end))
+         (goto-char armor-start)
+         (current-buffer))))
+
+    (list armor-start (- (point-max) after-end) mime
+          armor-end-regexp)))
+
 ;; Should this have a key-binding, or be in a menu?
 ;; There doesn't really seem to be an appropriate menu.
 ;; Eg the edit command is not in a menu either.
+
 (defun rmail-epa-decrypt ()
   "Decrypt GnuPG or OpenPGP armors in current message."
   (interactive)
@@ -4519,12 +4588,14 @@ encoded string (and the same mask) will decode the string."
   ;; change it in one of the calls to `epa-decrypt-region'.
 
   (save-excursion
-    (let (decrypts (mime (rmail-mime-message-p)))
+    (let (decrypts (mime (rmail-mime-message-p))
+                   mime-disabled)
       (goto-char (point-min))
 
       ;; Turn off mime processing.
       (when (and mime
 		 (not (get-text-property (point-min) 'rmail-mime-hidden)))
+        (setq mime-disabled t)
 	(rmail-mime))
 
       ;; Now find all armored messages in the buffer
@@ -4532,74 +4603,12 @@ encoded string (and the same mask) will decode the string."
       (goto-char (point-min))
       (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
 	(let ((coding-system-for-read coding-system-for-read)
-	      (case-fold-search t)
-	      unquote
-	      armor-start armor-prefix armor-end-regexp armor-end after-end)
-
-	  (setq armor-start (match-beginning 0)
-		armor-prefix (buffer-substring
-			      (line-beginning-position)
-			      armor-start))
-	  (if (string-match "
\\'" armor-prefix)
-	      (setq armor-prefix ""))
-
-	  (setq armor-end-regexp
-		(concat "^"
-			armor-prefix
-			"-----END PGP MESSAGE-----$"))
-	  (setq armor-end (re-search-forward armor-end-regexp
-					     nil t))
-
-	  (unless armor-end
-	    (error "Encryption armor beginning has no matching end"))
-	  (goto-char armor-start)
-
-	  ;; Because epa--find-coding-system-for-mime-charset not autoloaded.
-	  (require 'epa)
-
-	  ;; Advance over this armor.
-	  (goto-char armor-end)
-	  (setq after-end (- (point-max) armor-end))
-
-	  (when mime
-	    (save-excursion
-	      (goto-char armor-start)
-	      (re-search-backward "^--" nil t)
-	      (save-restriction
-		(narrow-to-region (point) armor-start)
-
-		;; Use the charset specified in the armor.
-		(unless coding-system-for-read
-		  (if (re-search-forward "^[ \t]*Charset[ \t\n]*:[ \t\n]*\\(.*\\)" nil t)
-		      (setq coding-system-for-read
-			    (epa--find-coding-system-for-mime-charset
-			     (intern (downcase (match-string 1)))))))
-
-		(goto-char (point-min))
-		(if (re-search-forward "^[ \t]*Content-transfer-encoding[ \t\n]*:[ \t\n]*quoted-printable[ \t]*$" nil t)
-		    (setq unquote t)))))
-
-	  (when unquote
-	    (let ((inhibit-read-only t))
-	      (mail-unquote-printable-region armor-start
-					     (- (point-max) after-end))))
-
-	  ;; Decrypt it, maybe in place, maybe making new buffer.
-	  (epa-decrypt-region
-	   armor-start (- (point-max) after-end)
-	   ;; Call back this function to prepare the output.
-	   (lambda ()
-	     (let ((inhibit-read-only t))
-	       (delete-region armor-start (- (point-max) after-end))
-	       (goto-char armor-start)
-	       (current-buffer))))
-
-	  (push (list armor-start (- (point-max) after-end) mime
-		      armor-end-regexp)
-		decrypts)))
+	      (case-fold-search t))
 
-      (unless decrypts
-	(error "Nothing to decrypt"))
+          (push (rmail-epa-decrypt-1 mime) decrypts)))
+
+      (when (and decrypts (eq major-mode 'rmail-mode))
+        (rmail-add-label "decrypt"))
 
       (when (and decrypts (rmail-buffers-swapped-p))
 	(when (y-or-n-p "Replace the original message? ")
@@ -4639,7 +4648,30 @@ encoded string (and the same mask) will decode the string."
 				(let ((value (match-string 0)))
 				  (unless (member value '("text/plain" "text/html"))
 				    (replace-match "text/plain"))))))))
-		      ))))))))))
+		      )))))))
+
+      (when (and (null decrypts)
+                 mime mime-disabled)
+        ;; Re-enable mime processinjg
+	(rmail-mime)
+        ;; Find each Show button and show that part.
+	(while (search-forward " Show " nil t)
+	  (forward-char -2)
+	  (let ((rmail-mime-render-html-function nil)
+		(entity (get-text-property (point) 'rmail-mime-entity)))
+            (unless (and (not (stringp entity))
+                         (rmail-mime-entity-truncated entity))
+              (push-button))))
+        (goto-char (point-min))
+        (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
+          (let ((coding-system-for-read coding-system-for-read)
+                (case-fold-search t))
+            (push (rmail-epa-decrypt-1 mime) decrypts)))
+
+        )
+
+      (unless decrypts
+	(error "Nothing to decrypt")))))
  
 
 ;;;;  Desktop support

commit 472addd6f2b693e171fc5096d78dbca1536bfb8e
Author: Richard Stallman 
Date:   Wed Aug 12 11:19:47 2015 -0400

    epa-inhibit inhibits auto-recognition of .gpg files
    
    * lisp/epa-file.el (epa-inhibit): New variable.
    (epa-file-handler): Check epa-inhibit.

diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index db8613a..88d25a5 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -82,12 +82,15 @@ encryption is used."
 		passphrase))))
     (epa-passphrase-callback-function context key-id file)))
 
+(defvar epa-inhibit nil
+  "Non-nil means don't try to decrypt .gpg files when operating on them.")
+
 ;;;###autoload
 (defun epa-file-handler (operation &rest args)
   (save-match-data
     (let ((op (get operation 'epa-file)))
-      (if op
-  	  (apply op args)
+      (if (and op (not epa-inhibit))
+          (apply op args)
   	(epa-file-run-real-handler operation args)))))
 
 (defun epa-file-run-real-handler (operation args)