Now on revision 108534. ------------------------------------------------------------ revno: 108534 fixes bug(s): http://debbugs.gnu.org/11225 committer: Chong Yidong branch nick: trunk timestamp: Sat 2012-06-09 14:26:46 +0800 message: Doc improvements for face remapping. * face-remap.el (face-remap-add-relative, face-remap-set-base) (buffer-face-set, buffer-face-toggle, buffer-face-mode-invoke): Doc fixes. * doc/lispref/display.texi (Face Remapping): Minor clarification. * doc/lispref/text.texi (Special Properties): Clarify the meaning of a list of faces in the `face' property. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-06-08 16:39:49 +0000 +++ doc/lispref/ChangeLog 2012-06-09 06:26:46 +0000 @@ -1,3 +1,10 @@ +2012-06-09 Chong Yidong + + * text.texi (Special Properties): Clarify the meaning of a list of + faces in the `face' property. + + * display.texi (Face Remapping): Minor clarification. + 2012-06-08 Chong Yidong * display.texi (Face Attributes): Font family does not accept === modified file 'doc/lispref/display.texi' --- doc/lispref/display.texi 2012-06-08 16:39:49 +0000 +++ doc/lispref/display.texi 2012-06-09 06:26:46 +0000 @@ -2511,39 +2511,34 @@ The value of this variable is an alist whose elements have the form @code{(@var{face} . @var{remapping})}. This causes Emacs to display any text having the face @var{face} with @var{remapping}, rather than -the ordinary definition of @var{face}. @var{remapping} may be any -face specification suitable for a @code{face} text property: either a -face name, or a property list of attribute/value pairs, or a list in -which each element is either a face name or a property list -(@pxref{Special Properties}). +the ordinary definition of @var{face}. + +@var{remapping} may be any face specification suitable for a +@code{face} text property: either a face (i.e.@: a face name or a +property list of attribute/value pairs), or a list of faces. For +details, see the description of the @code{face} text property in +@ref{Special Properties}. @var{remapping} serves as the complete +specification for the remapped face---it replaces the normal +definition of @var{face}, instead of modifying it. If @code{face-remapping-alist} is buffer-local, its local value takes effect only within that buffer. -Two points bear emphasizing: - -@enumerate -@item -@var{remapping} serves as the complete specification for the remapped -face---it replaces the normal definition of @var{face}, instead of -modifying it. - -@item -If @var{remapping} references the same face name @var{face}, either -directly or via the @code{:inherit} attribute of some other face in -@var{remapping}, that reference uses the normal definition of -@var{face}. In other words, the remapping cannot be recursive. - -For instance, if the @code{mode-line} face is remapped using this -entry in @code{face-remapping-alist}: +Note: face remapping is non-recursive. If @var{remapping} references +the same face name @var{face}, either directly or via the +@code{:inherit} attribute of some other face in @var{remapping}, that +reference uses the normal definition of @var{face}. For instance, if +the @code{mode-line} face is remapped using this entry in +@code{face-remapping-alist}: + @example (mode-line italic mode-line) @end example + @noindent then the new definition of the @code{mode-line} face inherits from the @code{italic} face, and the @emph{normal} (non-remapped) definition of @code{mode-line} face. -@end enumerate @end defvar The following functions implement a higher-level interface to === modified file 'doc/lispref/text.texi' --- doc/lispref/text.texi 2012-05-27 01:34:14 +0000 +++ doc/lispref/text.texi 2012-06-09 06:26:46 +0000 @@ -3004,7 +3004,11 @@ @xref{Face Attributes}. @item -A list, where each element uses one of the two forms listed above. +A list of faces. This specifies a face which is an aggregate of the +attributes of each of the listed faces. Faces occurring earlier in +the list have higher priority. Each list element must have one of the +two above forms (i.e.@: either a face name or a property list of face +attributes). @end itemize Font Lock mode (@pxref{Font Lock Mode}) works in most buffers by === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-09 02:26:47 +0000 +++ lisp/ChangeLog 2012-06-09 06:26:46 +0000 @@ -1,3 +1,9 @@ +2012-06-09 Chong Yidong + + * face-remap.el (face-remap-add-relative, face-remap-set-base) + (buffer-face-set, buffer-face-toggle, buffer-face-mode-invoke): + Doc fixes (Bug#11225). + 2012-06-09 Stefan Monnier * emacs-lisp/macroexp.el (macroexp--expand-all): Only autoload === modified file 'lisp/face-remap.el' --- lisp/face-remap.el 2012-05-05 02:50:20 +0000 +++ lisp/face-remap.el 2012-06-09 06:26:46 +0000 @@ -109,14 +109,19 @@ Return a cookie which can be used to delete this remapping with `face-remap-remove-relative'. -The remaining arguments, SPECS, should be either a list of face -names, or a property list of face attribute/value pairs. The -remapping specified by SPECS takes effect alongside the -remappings from other calls to `face-remap-add-relative', as well -as the normal definition of FACE (at lowest priority). This -function tries to sort multiple remappings for the same face, so -that remappings specifying relative face attributes are applied -after remappings specifying absolute face attributes. +The remaining arguments, SPECS, should form a list of faces. +Each list element should be either a face name or a property list +of face attribute/value pairs. If more than one face is listed, +that specifies an aggregate face, in the same way as in a `face' +text property, except for possible priority changes noted below. + +The face remapping specified by SPECS takes effect alongside the +remappings from other calls to `face-remap-add-relative' for the +same FACE, as well as the normal definition of FACE (at lowest +priority). This function tries to sort multiple remappings for +the same face, so that remappings specifying relative face +attributes are applied after remappings specifying absolute face +attributes. The base (lowest priority) remapping may be set to something other than the normal definition of FACE via `face-remap-set-base'." @@ -165,9 +170,11 @@ (defun face-remap-set-base (face &rest specs) "Set the base remapping of FACE in the current buffer to SPECS. This causes the remappings specified by `face-remap-add-relative' -to apply on top of the face specification given by SPECS. SPECS -should be either a list of face names, or a property list of face -attribute/value pairs. +to apply on top of the face specification given by SPECS. + +The remaining arguments, SPECS, should form a list of faces. +Each list element should be either a face name or a property list +of face attribute/value pairs, like in a `face' text property. If SPECS is empty, call `face-remap-reset-base' to use the normal definition of FACE as the base remapping; note that this is @@ -361,12 +368,14 @@ ;;;###autoload (defun buffer-face-set (&rest specs) "Enable `buffer-face-mode', using face specs SPECS. -SPECS can be any value suitable for the `face' text property, -including a face name, a list of face names, or a face-attribute -If SPECS is nil, then `buffer-face-mode' is disabled. +Each argument in SPECS should be a face, i.e. either a face name +or a property list of face attributes and values. If more than +one face is listed, that specifies an aggregate face, like in a +`face' text property. If SPECS is nil or omitted, disable +`buffer-face-mode'. -This function will make the variable `buffer-face-mode-face' -buffer local, and set it to FACE." +This function makes the variable `buffer-face-mode-face' buffer +local, and sets it to FACE." (interactive (list (read-face-name "Set buffer face"))) (while (and (consp specs) (null (cdr specs))) (setq specs (car specs))) @@ -378,8 +387,10 @@ ;;;###autoload (defun buffer-face-toggle (&rest specs) "Toggle `buffer-face-mode', using face specs SPECS. -SPECS can be any value suitable for the `face' text property, -including a face name, a list of face names, or a face-attribute +Each argument in SPECS should be a face, i.e. either a face name +or a property list of face attributes and values. If more than +one face is listed, that specifies an aggregate face, like in a +`face' text property. If `buffer-face-mode' is already enabled, and is currently using the face specs SPECS, then it is disabled; if buffer-face-mode is @@ -402,10 +413,12 @@ ARG controls whether the mode is enabled or disabled, and is interpreted in the usual manner for minor-mode commands. -SPECS can be any value suitable for the `face' text property, -including a face name, a list of face names, or a face-attribute +SPECS can be any value suitable for a `face' text property, +including a face name, a plist of face attributes and values, or +a list of faces. -If INTERACTIVE is non-nil, a message will be displayed describing the result. +If INTERACTIVE is non-nil, display a message describing the +result. This is a wrapper function which calls `buffer-face-set' or `buffer-face-toggle' (depending on ARG), and prints a status ------------------------------------------------------------ revno: 108533 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2012-06-08 22:26:47 -0400 message: Don't autoload functions too eagerly during macroexpansion. * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Only autoload a function if there's a clear indication that it has a compiler-macro. * lisp/emacs-lisp/byte-run.el (defun-declarations-alist, defmacro, defun) (macro-declarations-alist): Add arglist to declaration functions. (defun-declarations-alist): Add `obsolete' and `compiler-macro'. * lisp/emacs-lisp/cl-seq.el (cl-member, cl-assoc): * lisp/emacs-lisp/cl-lib.el (cl-list*, cl-adjoin): * lisp/emacs-lisp/cl-extra.el (cl-get): Use the new `declare' statement. Also add autoload to find the compiler macro. * lisp/emacs-lisp/cl-macs.el (eql) [compiler-macro]: Remove. (cl--compiler-macro-member, cl--compiler-macro-assoc) (cl--compiler-macro-adjoin, cl--compiler-macro-list*) (cl--compiler-macro-get): New functions, replacing calls to cl-define-compiler-macro. (cl-typep) [compiler-macro]: Use macroexp-let². diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-08 18:35:28 +0000 +++ lisp/ChangeLog 2012-06-09 02:26:47 +0000 @@ -1,3 +1,21 @@ +2012-06-09 Stefan Monnier + + * emacs-lisp/macroexp.el (macroexp--expand-all): Only autoload + a function if there's a clear indication that it has a compiler-macro. + * emacs-lisp/byte-run.el (defun-declarations-alist, defmacro, defun) + (macro-declarations-alist): Add arglist to declaration functions. + (defun-declarations-alist): Add `obsolete' and `compiler-macro'. + * emacs-lisp/cl-seq.el (cl-member, cl-assoc): + * emacs-lisp/cl-lib.el (cl-list*, cl-adjoin): + * emacs-lisp/cl-extra.el (cl-get): Use the new `declare' statement. + Also add autoload to find the compiler macro. + * emacs-lisp/cl-macs.el (eql) [compiler-macro]: Remove. + (cl--compiler-macro-member, cl--compiler-macro-assoc) + (cl--compiler-macro-adjoin, cl--compiler-macro-list*) + (cl--compiler-macro-get): New functions, replacing calls to + cl-define-compiler-macro. + (cl-typep) [compiler-macro]: Use macroexp-let². + 2012-06-08 Nick Dokos (tiny change) * calendar/icalendar.el (icalendar--parse-vtimezone): Import TZID === modified file 'lisp/emacs-lisp/byte-run.el' --- lisp/emacs-lisp/byte-run.el 2012-05-31 01:41:17 +0000 +++ lisp/emacs-lisp/byte-run.el 2012-06-09 02:26:47 +0000 @@ -70,30 +70,37 @@ ;; loaded by loadup.el that uses declarations in macros. (defvar defun-declarations-alist - ;; FIXME: Should we also add an `obsolete' property? (list - ;; Too bad we can't use backquote yet at this stage of the bootstrap. + ;; We can only use backquotes inside the lambdas and not for those + ;; properties that are used by functions loaded before backquote.el. (list 'advertised-calling-convention - #'(lambda (f arglist when) + #'(lambda (f _args arglist when) (list 'set-advertised-calling-convention (list 'quote f) (list 'quote arglist) (list 'quote when)))) + (list 'obsolete + #'(lambda (f _args new-name when) + `(make-obsolete ',f ',new-name ,when))) + (list 'compiler-macro + #'(lambda (f _args compiler-function) + `(put ',f 'compiler-macro #',compiler-function))) (list 'doc-string - #'(lambda (f pos) + #'(lambda (f _args pos) (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos)))) (list 'indent - #'(lambda (f val) + #'(lambda (f _args val) (list 'put (list 'quote f) ''lisp-indent-function (list 'quote val))))) "List associating function properties to their macro expansion. Each element of the list takes the form (PROP FUN) where FUN is a function. For each (PROP . VALUES) in a function's declaration, -the FUN corresponding to PROP is called with the function name -and the VALUES and should return the code to use to set this property.") +the FUN corresponding to PROP is called with the function name, +the function's arglist, and the VALUES and should return the code to use +to set this property.") (defvar macro-declarations-alist (cons (list 'debug - #'(lambda (name spec) + #'(lambda (name _args spec) (list 'progn :autoload-end (list 'put (list 'quote name) ''edebug-form-spec (list 'quote spec))))) @@ -135,7 +142,7 @@ (mapcar #'(lambda (x) (let ((f (cdr (assq (car x) macro-declarations-alist)))) - (if f (apply (car f) name (cdr x)) + (if f (apply (car f) name arglist (cdr x)) (message "Warning: Unknown macro property %S in %S" (car x) name)))) (cdr decl)))) @@ -171,7 +178,7 @@ #'(lambda (x) (let ((f (cdr (assq (car x) defun-declarations-alist)))) (cond - (f (apply (car f) name (cdr x))) + (f (apply (car f) name arglist (cdr x))) ;; Yuck!! ((and (featurep 'cl) (memq (car x) ;C.f. cl-do-proclaim. === modified file 'lisp/emacs-lisp/cl-extra.el' --- lisp/emacs-lisp/cl-extra.el 2012-06-07 19:48:22 +0000 +++ lisp/emacs-lisp/cl-extra.el 2012-06-09 02:26:47 +0000 @@ -584,15 +584,17 @@ ;;; Property lists. ;;;###autoload -(defun cl-get (sym tag &optional def) ; See compiler macro in cl-macs.el +(defun cl-get (sym tag &optional def) "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. \n(fn SYMBOL PROPNAME &optional DEFAULT)" + (declare (compiler-macro cl--compiler-macro-get)) (or (get sym tag) (and def (let ((plist (symbol-plist sym))) (while (and plist (not (eq (car plist) tag))) (setq plist (cdr (cdr plist)))) (if plist (car (cdr plist)) def))))) +(autoload 'cl--compiler-macro-get "cl-macs") ;;;###autoload (defun cl-getf (plist tag &optional def) === modified file 'lisp/emacs-lisp/cl-lib.el' --- lisp/emacs-lisp/cl-lib.el 2012-06-07 19:48:22 +0000 +++ lisp/emacs-lisp/cl-lib.el 2012-06-09 02:26:47 +0000 @@ -544,11 +544,12 @@ ;; (while (consp (cdr x)) (pop x)) ;; x)) -(defun cl-list* (arg &rest rest) ; See compiler macro in cl-macs.el +(defun cl-list* (arg &rest rest) "Return a new list with specified ARGs as elements, consed to last ARG. Thus, `(cl-list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to `(cons A (cons B (cons C D)))'. \n(fn ARG...)" + (declare (compiler-macro cl--compiler-macro-list*)) (cond ((not rest) arg) ((not (cdr rest)) (cons arg (car rest))) (t (let* ((n (length rest)) @@ -556,6 +557,7 @@ (last (nthcdr (- n 2) copy))) (setcdr last (car (cdr last))) (cons arg copy))))) +(autoload 'cl--compiler-macro-list* "cl-macs") (defun cl-ldiff (list sublist) "Return a copy of LIST with the tail SUBLIST removed." @@ -584,17 +586,19 @@ (declare-function cl-round "cl-extra" (x &optional y)) (declare-function cl-mod "cl-extra" (x y)) -(defun cl-adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs +(defun cl-adjoin (cl-item cl-list &rest cl-keys) "Return ITEM consed onto the front of LIST only if it's not already there. Otherwise, return LIST unmodified. \nKeywords supported: :test :test-not :key \n(fn ITEM LIST [KEYWORD VALUE]...)" + (declare (compiler-macro cl--compiler-macro-adjoin)) (cond ((or (equal cl-keys '(:test eq)) (and (null cl-keys) (not (numberp cl-item)))) (if (memq cl-item cl-list) cl-list (cons cl-item cl-list))) ((or (equal cl-keys '(:test equal)) (null cl-keys)) (if (member cl-item cl-list) cl-list (cons cl-item cl-list))) (t (apply 'cl--adjoin cl-item cl-list cl-keys)))) +(autoload 'cl--compiler-macro-adjoin "cl-macs") (defun cl-subst (cl-new cl-old cl-tree &rest cl-keys) "Substitute NEW for OLD everywhere in TREE (non-destructively). === modified file 'lisp/emacs-lisp/cl-loaddefs.el' --- lisp/emacs-lisp/cl-loaddefs.el 2012-06-08 13:18:26 +0000 +++ lisp/emacs-lisp/cl-loaddefs.el 2012-06-09 02:26:47 +0000 @@ -11,7 +11,7 @@ ;;;;;; cl-set-frame-visible-p cl-map-overlays cl-map-intervals cl-map-keymap-recursively ;;;;;; cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan ;;;;;; cl-mapl cl-maplist cl-map cl-mapcar-many cl-equalp cl-coerce) -;;;;;; "cl-extra" "cl-extra.el" "fecce2e361fd06364d2ffd8c0d482cd0") +;;;;;; "cl-extra" "cl-extra.el" "6661c504c379dfde0c37a0f8e2ba6568") ;;; Generated autoloads from cl-extra.el (autoload 'cl-coerce "cl-extra" "\ @@ -224,6 +224,8 @@ \(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil) +(put 'cl-get 'compiler-macro #'cl--compiler-macro-get) + (autoload 'cl-getf "cl-extra" "\ Search PROPLIST for property PROPNAME; return its value or DEFAULT. PROPLIST is a list of the sort returned by `symbol-plist'. @@ -263,7 +265,7 @@ ;;;;;; cl-do* cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp -;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "07b3d08f956d6740ea1979825c84bc01") +;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "9eb287dd2a8d20f1c6459a9d095fa335") ;;; Generated autoloads from cl-macs.el (autoload 'cl-gensym "cl-macs" "\ @@ -789,7 +791,7 @@ ;;;;;; cl-nsubstitute-if cl-nsubstitute cl-substitute-if-not cl-substitute-if ;;;;;; cl-substitute cl-delete-duplicates cl-remove-duplicates cl-delete-if-not ;;;;;; cl-delete-if cl-delete cl-remove-if-not cl-remove-if cl-remove -;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "d3eaca7a24bdb10b381bb94729c5d7e9") +;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "8877479cb008b43a94098f3e6ec85d91") ;;; Generated autoloads from cl-seq.el (autoload 'cl-reduce "cl-seq" "\ @@ -1050,6 +1052,8 @@ \(fn ITEM LIST [KEYWORD VALUE]...)" nil nil) +(put 'cl-member 'compiler-macro #'cl--compiler-macro-member) + (autoload 'cl-member-if "cl-seq" "\ Find the first item satisfying PREDICATE in LIST. Return the sublist of LIST whose car matches. @@ -1078,6 +1082,8 @@ \(fn ITEM LIST [KEYWORD VALUE]...)" nil nil) +(put 'cl-assoc 'compiler-macro #'cl--compiler-macro-assoc) + (autoload 'cl-assoc-if "cl-seq" "\ Find the first item whose car satisfies PREDICATE in LIST. === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2012-06-08 13:18:26 +0000 +++ lisp/emacs-lisp/cl-macs.el 2012-06-09 02:26:47 +0000 @@ -1,4 +1,4 @@ -;;; cl-macs.el --- Common Lisp macros --*- lexical-binding: t -*- +;;; cl-macs.el --- Common Lisp macros -*- lexical-binding: t; coding: utf-8 -*- ;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc. @@ -2993,30 +2993,7 @@ ;; Note that cl.el arranges to force cl-macs to be loaded at compile-time, ;; mainly to make sure these macros will be present. -(put 'eql 'byte-compile nil) -(cl-define-compiler-macro eql (&whole form a b) - (cond ((macroexp-const-p a) - (let ((val (cl--const-expr-val a))) - (if (and (numberp val) (not (integerp val))) - `(equal ,a ,b) - `(eq ,a ,b)))) - ((macroexp-const-p b) - (let ((val (cl--const-expr-val b))) - (if (and (numberp val) (not (integerp val))) - `(equal ,a ,b) - `(eq ,a ,b)))) - ((cl--simple-expr-p a 5) - `(if (numberp ,a) - (equal ,a ,b) - (eq ,a ,b))) - ((and (cl--safe-expr-p a) - (cl--simple-expr-p b 5)) - `(if (numberp ,b) - (equal ,a ,b) - (eq ,a ,b))) - (t form))) - -(cl-define-compiler-macro cl-member (&whole form a list &rest keys) +(defun cl--compiler-macro-member (form a list &rest keys) (let ((test (and (= (length keys) 2) (eq (car keys) :test) (cl--const-expr-val (nth 1 keys))))) (cond ((eq test 'eq) `(memq ,a ,list)) @@ -3024,7 +3001,7 @@ ((or (null keys) (eq test 'eql)) `(memql ,a ,list)) (t form)))) -(cl-define-compiler-macro cl-assoc (&whole form a list &rest keys) +(defun cl--compiler-macro-assoc (form a list &rest keys) (let ((test (and (= (length keys) 2) (eq (car keys) :test) (cl--const-expr-val (nth 1 keys))))) (cond ((eq test 'eq) `(assq ,a ,list)) @@ -3034,31 +3011,28 @@ `(assoc ,a ,list) `(assq ,a ,list))) (t form)))) -(cl-define-compiler-macro cl-adjoin (&whole form a list &rest keys) +(defun cl--compiler-macro-adjoin (form a list &rest keys) (if (and (cl--simple-expr-p a) (cl--simple-expr-p list) (not (memq :key keys))) `(if (cl-member ,a ,list ,@keys) ,list (cons ,a ,list)) form)) -(cl-define-compiler-macro cl-list* (arg &rest others) +(defun cl--compiler-macro-list* (_form arg &rest others) (let* ((args (reverse (cons arg others))) (form (car args))) (while (setq args (cdr args)) (setq form `(cons ,(car args) ,form))) form)) -(cl-define-compiler-macro cl-get (sym prop &optional def) +(defun cl--compiler-macro-get (_form sym prop &optional def) (if def `(cl-getf (symbol-plist ,sym) ,prop ,def) `(get ,sym ,prop))) (cl-define-compiler-macro cl-typep (&whole form val type) (if (macroexp-const-p type) - (let ((res (cl--make-type-test val (cl--const-expr-val type)))) - (if (or (memq (cl--expr-contains res val) '(nil 1)) - (cl--simple-expr-p val)) res - (let ((temp (make-symbol "--cl-var--"))) - `(let ((,temp ,val)) ,(cl-subst temp val res))))) + (macroexp-let² macroexp-copyable-p temp val + (cl--make-type-test temp (cl--const-expr-val type))) form)) === modified file 'lisp/emacs-lisp/cl-seq.el' --- lisp/emacs-lisp/cl-seq.el 2012-06-04 01:05:17 +0000 +++ lisp/emacs-lisp/cl-seq.el 2012-06-09 02:26:47 +0000 @@ -676,6 +676,7 @@ Return the sublist of LIST whose car is ITEM. \nKeywords supported: :test :test-not :key \n(fn ITEM LIST [KEYWORD VALUE]...)" + (declare (compiler-macro cl--compiler-macro-member)) (if cl-keys (cl-parsing-keywords (:test :test-not :key :if :if-not) () (while (and cl-list (not (cl-check-test cl-item (car cl-list)))) @@ -684,6 +685,7 @@ (if (and (numberp cl-item) (not (integerp cl-item))) (member cl-item cl-list) (memq cl-item cl-list)))) +(autoload 'cl--compiler-macro-member "cl-macs") ;;;###autoload (defun cl-member-if (cl-pred cl-list &rest cl-keys) @@ -714,6 +716,7 @@ "Find the first item whose car matches ITEM in LIST. \nKeywords supported: :test :test-not :key \n(fn ITEM LIST [KEYWORD VALUE]...)" + (declare (compiler-macro cl--compiler-macro-assoc)) (if cl-keys (cl-parsing-keywords (:test :test-not :key :if :if-not) () (while (and cl-alist @@ -724,6 +727,7 @@ (if (and (numberp cl-item) (not (integerp cl-item))) (assoc cl-item cl-alist) (assq cl-item cl-alist)))) +(autoload 'cl--compiler-macro-assoc "cl-macs") ;;;###autoload (defun cl-assoc-if (cl-pred cl-list &rest cl-keys) === modified file 'lisp/emacs-lisp/macroexp.el' --- lisp/emacs-lisp/macroexp.el 2012-06-08 13:18:26 +0000 +++ lisp/emacs-lisp/macroexp.el 2012-06-09 02:26:47 +0000 @@ -182,12 +182,7 @@ (let ((handler nil)) (while (and (symbolp func) (not (setq handler (get func 'compiler-macro))) - (fboundp func) - (or (not (eq (car-safe (symbol-function func)) - 'autoload)) - (ignore-errors - (load (nth 1 (symbol-function func)) - 'noerror 'nomsg)))) + (fboundp func)) ;; Follow the sequence of aliases. (setq func (symbol-function func))) (if (null handler) @@ -195,6 +190,14 @@ ;; setq/setq-default this works alright because the variable names ;; are symbols). (macroexp--all-forms form 1) + ;; If the handler is not loaded yet, try (auto)loading the + ;; function itself, which may in turn load the handler. + (when (and (not (functionp handler)) + (fboundp func) (eq (car-safe (symbol-function func)) + 'autoload)) + (ignore-errors + (load (nth 1 (symbol-function func)) + 'noerror 'nomsg))) (let ((newform (condition-case err (apply handler form (cdr form)) (error (message "Compiler-macro error: %S" err) ------------------------------------------------------------ revno: 108532 committer: Andreas Schwab branch nick: emacs timestamp: Fri 2012-06-08 23:33:58 +0200 message: * make-docfile.c (search_lisp_doc_at_eol): Unget last read character. diff: === modified file 'lib-src/ChangeLog' --- lib-src/ChangeLog 2012-06-06 01:38:04 +0000 +++ lib-src/ChangeLog 2012-06-08 21:33:58 +0000 @@ -1,3 +1,8 @@ +2012-06-08 Andreas Schwab + + * make-docfile.c (search_lisp_doc_at_eol): Unget last read + character. + 2012-06-06 Glenn Morris * Makefile.in (STAMP_INST_SCRIPTS, STAMP_SCRIPTS, insrcdir) === modified file 'lib-src/make-docfile.c' --- lib-src/make-docfile.c 2012-05-30 03:59:42 +0000 +++ lib-src/make-docfile.c 2012-06-08 21:33:58 +0000 @@ -1025,7 +1025,7 @@ char c = 0, c1 = 0, c2 = 0; /* Skip until the end of line; remember two previous chars. */ - while (c != '\n' && c != '\r' && c >= 0) + while (c != '\n' && c != '\r' && c != EOF) { c2 = c1; c1 = c; @@ -1040,6 +1040,8 @@ fprintf (stderr, "## non-docstring in %s (%s)\n", buffer, filename); #endif + if (c != EOF) + ungetc (c, infile); return 0; } return 1; ------------------------------------------------------------ revno: 108531 committer: Glenn Morris branch nick: trunk timestamp: Fri 2012-06-08 14:35:28 -0400 message: Mark tiny change diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-08 17:34:09 +0000 +++ lisp/ChangeLog 2012-06-08 18:35:28 +0000 @@ -1,4 +1,4 @@ -2012-06-08 Nick Dokos +2012-06-08 Nick Dokos (tiny change) * calendar/icalendar.el (icalendar--parse-vtimezone): Import TZID string properly, fixes Bug#11473. ------------------------------------------------------------ revno: 108530 committer: Paul Eggert branch nick: trunk timestamp: Fri 2012-06-08 10:50:17 -0700 message: * xdisp.c (vmessage): Treat frame message as multibyte. Without this change, (let ((§ 1)) (make-variable-buffer-local '§)) would generate the diagnostic "Making \302\247 buffer-local while let-bound!". diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-06-08 13:59:28 +0000 +++ src/ChangeLog 2012-06-08 17:50:17 +0000 @@ -1,3 +1,10 @@ +2012-06-08 Paul Eggert + + * xdisp.c (vmessage): Treat frame message as multibyte. + Without this change, (let ((§ 1)) (make-variable-buffer-local '§)) + would generate the diagnostic "Making \302\247 buffer-local while + let-bound!". + 2012-06-08 Eli Zaretskii * dispnew.c (showing_window_margins_p): Undo last change, which === modified file 'src/xdisp.c' --- src/xdisp.c 2012-06-04 06:03:19 +0000 +++ src/xdisp.c 2012-06-08 17:50:17 +0000 @@ -9765,7 +9765,7 @@ len = doprnt (FRAME_MESSAGE_BUF (f), FRAME_MESSAGE_BUF_SIZE (f), m, (char *)0, ap); - message2 (FRAME_MESSAGE_BUF (f), len, 0); + message2 (FRAME_MESSAGE_BUF (f), len, 1); } else message1 (0); ------------------------------------------------------------ revno: 108529 committer: Ulf Jasper branch nick: trunk timestamp: Fri 2012-06-08 19:34:09 +0200 message: icalendar / icalendar-tests: Fix Bug#11473 -- unescape commas in timezone specs 2012-06-08 Nick Dokos * calendar/icalendar.el (icalendar--parse-vtimezone): Import TZID string properly, fixes Bug#11473. 2012-06-08 Ulf Jasper * automated/icalendar-tests.el (icalendar--parse-vtimezone): Test escaped commas in TZID (Bug#11473). (icalendar-import-with-timezone): New. (icalendar-real-world): Add new testcase as found in the bugreport of Bug#11473. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-08 16:39:49 +0000 +++ lisp/ChangeLog 2012-06-08 17:34:09 +0000 @@ -1,3 +1,8 @@ +2012-06-08 Nick Dokos + + * calendar/icalendar.el (icalendar--parse-vtimezone): Import TZID + string properly, fixes Bug#11473. + 2012-06-08 Chong Yidong * faces.el (set-face-attribute): Doc fix. === modified file 'lisp/calendar/icalendar.el' --- lisp/calendar/icalendar.el 2012-05-29 19:42:49 +0000 +++ lisp/calendar/icalendar.el 2012-06-08 17:34:09 +0000 @@ -500,7 +500,8 @@ (defun icalendar--parse-vtimezone (alist) "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING). Return nil if timezone cannot be parsed." - (let* ((tz-id (icalendar--get-event-property alist 'TZID)) + (let* ((tz-id (icalendar--convert-string-for-import + (icalendar--get-event-property alist 'TZID))) (daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT)))) (day (and daylight (icalendar--convert-tz-offset daylight t))) (standard (cadr (cdar (icalendar--get-children alist 'STANDARD)))) === modified file 'test/ChangeLog' --- test/ChangeLog 2012-05-29 19:42:49 +0000 +++ test/ChangeLog 2012-06-08 17:34:09 +0000 @@ -1,3 +1,11 @@ +2012-06-08 Ulf Jasper + + * automated/icalendar-tests.el (icalendar--parse-vtimezone): Test + escaped commas in TZID (Bug#11473). + (icalendar-import-with-timezone): New. + (icalendar-real-world): Add new testcase as given in the bugreport + of Bug#11473. + 2012-05-29 Ulf Jasper * automated/icalendar-tests.el (icalendar-tests--test-import): === modified file 'test/automated/icalendar-tests.el' --- test/automated/icalendar-tests.el 2012-05-29 19:42:49 +0000 +++ test/automated/icalendar-tests.el 2012-06-08 17:34:09 +0000 @@ -188,7 +188,7 @@ (should (string= "STD-02:00DST-03:00,M3.5.0/03:00:00,M10.5.0/04:00:00" (cdr result))) (setq vtimezone (icalendar-tests--get-ical-event "BEGIN:VTIMEZONE -TZID:anothername +TZID:anothername\, with a comma BEGIN:STANDARD DTSTART:16010101T040000 TZOFFSETFROM:+0300 @@ -204,7 +204,7 @@ END:VTIMEZONE ")) (setq result (icalendar--parse-vtimezone vtimezone)) - (should (string= "anothername" (car result))) + (should (string= "anothername, with a comma" (car result))) (message (cdr result)) (should (string= "STD-02:00DST-03:00,M3.2.1/03:00:00,M10.2.1/04:00:00" (cdr result))))) @@ -1103,6 +1103,44 @@ "&19/9/2003 09:00-11:30 non-recurring\n UID: 1234567890uid\n" "&9/19/2003 09:00-11:30 non-recurring\n UID: 1234567890uid\n")) +(ert-deftest icalendar-import-with-timezone () + ;; bug#11473 + (icalendar-tests--test-import + "BEGIN:VCALENDAR +BEGIN:VTIMEZONE +TZID:fictional\, nonexistent\, arbitrary +BEGIN:STANDARD +DTSTART:20100101T000000 +TZOFFSETFROM:+0200 +TZOFFSETTO:-0200 +RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=1SU;BYMONTH=01 +END:STANDARD +BEGIN:DAYLIGHT +DTSTART:20101201T000000 +TZOFFSETFROM:-0200 +TZOFFSETTO:+0200 +RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=1SU;BYMONTH=11 +END:DAYLIGHT +END:VTIMEZONE +BEGIN:VEVENT +SUMMARY:standardtime +DTSTART;TZID=\"fictional, nonexistent, arbitrary\":20120115T120000 +DTEND;TZID=\"fictional, nonexistent, arbitrary\":20120115T123000 +END:VEVENT +BEGIN:VEVENT +SUMMARY:daylightsavingtime +DTSTART;TZID=\"fictional, nonexistent, arbitrary\":20121215T120000 +DTEND;TZID=\"fictional, nonexistent, arbitrary\":20121215T123000 +END:VEVENT +END:VCALENDAR" + ;; "standardtime" begins first sunday in january and is 4 hours behind CET + ;; "daylightsavingtime" begins first sunday in november and is 1 hour before CET + "&2012/1/15 15:00-15:30 standardtime +&2012/12/15 11:00-11:30 daylightsavingtime +" + nil + nil) + ) ;; ====================================================================== ;; Cycle ;; ====================================================================== @@ -1863,7 +1901,72 @@ RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=11;BYMONTHDAY=1 SUMMARY:NNN Wwwwwwww Wwwww - Aaaaaa Pppppppp rrrrrr ddd oo Nnnnnnnn 30 ") - ) + + ;; bug#11473 + (icalendar-tests--test-import + "BEGIN:VCALENDAR +METHOD:REQUEST +PRODID:Microsoft Exchange Server 2007 +VERSION:2.0 +BEGIN:VTIMEZONE +TZID:(UTC+01:00) Amsterdam\, Berlin\, Bern\, Rome\, Stockholm\, Vienna +BEGIN:STANDARD +DTSTART:16010101T030000 +TZOFFSETFROM:+0200 +TZOFFSETTO:+0100 +RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=-1SU;BYMONTH=10 +END:STANDARD +BEGIN:DAYLIGHT +DTSTART:16010101T020000 +TZOFFSETFROM:+0100 +TZOFFSETTO:+0200 +RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=-1SU;BYMONTH=3 +END:DAYLIGHT +END:VTIMEZONE +BEGIN:VEVENT +ORGANIZER;CN=\"A. Luser\":MAILTO:a.luser@foo.com +ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;CN=\"Luser, Oth + er\":MAILTO:other.luser@foo.com +DESCRIPTION;LANGUAGE=en-US:\nWhassup?\n\n +SUMMARY;LANGUAGE=en-US:Query +DTSTART;TZID=\"(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, Vienna\" + :20120515T150000 +DTEND;TZID=\"(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, Vienna\":2 + 0120515T153000 +UID:040000008200E00074C5B7101A82E0080000000020FFAED0CFEFCC01000000000000000 + 010000000575268034ECDB649A15349B1BF240F15 +RECURRENCE-ID;TZID=\"(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, V + ienna\":20120515T170000 +CLASS:PUBLIC +PRIORITY:5 +DTSTAMP:20120514T153645Z +TRANSP:OPAQUE +STATUS:CONFIRMED +SEQUENCE:15 +LOCATION;LANGUAGE=en-US:phone +X-MICROSOFT-CDO-APPT-SEQUENCE:15 +X-MICROSOFT-CDO-OWNERAPPTID:1907632092 +X-MICROSOFT-CDO-BUSYSTATUS:TENTATIVE +X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY +X-MICROSOFT-CDO-ALLDAYEVENT:FALSE +X-MICROSOFT-CDO-IMPORTANCE:1 +X-MICROSOFT-CDO-INSTTYPE:3 +BEGIN:VALARM +ACTION:DISPLAY +DESCRIPTION:REMINDER +TRIGGER;RELATED=START:-PT15M +END:VALARM +END:VEVENT +END:VCALENDAR" + nil + "&15/5/2012 15:00-15:30 Query + Location: phone + Organizer: MAILTO:a.luser@foo.com + Status: CONFIRMED + Class: PUBLIC + UID: 040000008200E00074C5B7101A82E0080000000020FFAED0CFEFCC01000000000000000010000000575268034ECDB649A15349B1BF240F15 +" nil) +) (provide 'icalendar-tests) ;;; icalendar-tests.el ends here ------------------------------------------------------------ revno: 108528 committer: Chong Yidong branch nick: trunk timestamp: Sat 2012-06-09 00:39:49 +0800 message: Face cleanups. Remove some uses of old-style face spec and :bold/:italic. * faces.el (set-face-attribute): Doc fix. (modify-face): Don't use :bold and :italic. (error, warning, success): Tweak definitions. * cus-edit.el (custom-modified, custom-invalid, custom-rogue) (custom-modified, custom-set, custom-changed, custom-themed) (custom-saved, custom-button, custom-button-mouse) (custom-button-pressed, custom-state, custom-comment-tag) (custom-variable-tag, custom-group-tag-1, custom-group-tag) (custom-group-subtitle): Use new-style face specs. (custom-invalid-face, custom-rogue-face, custom-modified-face) (custom-set-face, custom-changed-face, custom-saved-face) (custom-button-face, custom-button-pressed-face) (custom-documentation-face, custom-state-face) (custom-comment-face, custom-comment-tag-face) (custom-variable-tag-face, custom-variable-button-face) (custom-face-tag-face, custom-group-tag-face-1) (custom-group-tag-face): Remove obsolete face alias. * epa.el (epa-validity-high, epa-validity-medium) (epa-validity-low, epa-mark, epa-field-name, epa-string) (epa-field-name, epa-field-body): * font-lock.el (font-lock-comment-face, font-lock-string-face) (font-lock-keyword-face, font-lock-builtin-face) (font-lock-function-name-face, font-lock-variable-name-face) (font-lock-type-face, font-lock-constant-face): * ido.el (ido-first-match, ido-only-match, ido-subdir) (ido-virtual, ido-indicator, ido-incomplete-regexp): * speedbar.el (speedbar-button-face, speedbar-file-face) (speedbar-directory-face, speedbar-tag-face) (speedbar-selected-face, speedbar-highlight-face) (speedbar-separator-face): * whitespace.el (whitespace-newline, whitespace-space) (whitespace-hspace, whitespace-tab, whitespace-trailing) (whitespace-line, whitespace-space-before-tab) (whitespace-space-after-tab, whitespace-indentation) (whitespace-empty): * emulation/cua-base.el (cua-global-mark): * eshell/em-prompt.el (eshell-prompt): * net/newst-plainview.el (newsticker-new-item-face) (newsticker-old-item-face, newsticker-immortal-item-face) (newsticker-obsolete-item-face, newsticker-date-face) (newsticker-statistics-face, newsticker-default-face): * net/newst-reader.el (newsticker-feed-face) (newsticker-extra-face, newsticker-enclosure-face): * net/newst-treeview.el (newsticker-treeview-face) (newsticker-treeview-new-face, newsticker-treeview-old-face) (newsticker-treeview-immortal-face) (newsticker-treeview-obsolete-face) (newsticker-treeview-selection-face): * net/rcirc.el (rcirc-my-nick, rcirc-other-nick) (rcirc-bright-nick, rcirc-server, rcirc-timestamp) (rcirc-nick-in-message, rcirc-nick-in-message-full-line) (rcirc-prompt, rcirc-track-keyword, rcirc-url, rcirc-keyword): * nxml/nxml-outln.el (nxml-heading, nxml-outline-indicator) (nxml-outline-active-indicator, nxml-outline-ellipsis): * play/mpuz.el (mpuz-unsolved, mpuz-solved, mpuz-trivial) (mpuz-text): * progmodes/vera-mode.el (vera-font-lock-number) (vera-font-lock-function, vera-font-lock-interface): * textmodes/table.el (table-cell): Use new-style face specs, and don't use the old :bold and :italic attributes. * erc-button.el (erc-button): * erc-goodies.el (erc-bold-face, erc-inverse-face) (erc-underline-face, fg:erc-color-*): * erc-match.el (erc-current-nick-face, erc-dangerous-host-face) (erc-pal-face, erc-fool-face, erc-keyword-face): * erc-stamp.el (erc-timestamp-face): Likewise. * erc.el (erc-direct-msg-face, erc-header-line, erc-input-face) (erc-command-indicator-face, erc-notice-face, erc-action-face) (erc-error-face, erc-my-nick-face, erc-nick-default-face) (erc-nick-msg-face): Use new-style face specs, and avoid :bold. * progmodes/ebrowse.el (ebrowse-tree-mark, ebrowse-root-class) (ebrowse-member-attribute, ebrowse-default, ebrowse-file-name) (ebrowse-member-class, ebrowse-progress): Likewise. (ebrowse-tree-mark-face, ebrowse-root-class-face) (ebrowse-file-name-face, ebrowse-default-face) (ebrowse-member-attribute-face, ebrowse-member-class-face) (ebrowse-progress-face): Remove obsolete faces. * progmodes/flymake.el (flymake-errline, flymake-warnline): Inherit from error and warning faces respectively. * textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate): Likewise. (flyspell-incorrect-face, flyspell-duplicate-face): Remove obsolete aliases. * display.texi (Face Attributes): Font family does not accept wildcards. De-document obsolete :bold and :italic attributes. (Defining Faces): Use new-style face spec format. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-06-08 08:44:30 +0000 +++ doc/lispref/ChangeLog 2012-06-08 16:39:49 +0000 @@ -1,3 +1,9 @@ +2012-06-08 Chong Yidong + + * display.texi (Face Attributes): Font family does not accept + wildcards. De-document obsolete :bold and :italic attributes. + (Defining Faces): Use new-style face spec format. + 2012-06-08 Dmitry Antipov * internals.text (Garbage Collection): Document new === modified file 'doc/lispref/display.texi' --- doc/lispref/display.texi 2012-05-27 01:34:14 +0000 +++ doc/lispref/display.texi 2012-06-08 16:39:49 +0000 @@ -1927,11 +1927,16 @@ @cindex face specification The @var{spec} argument is a @dfn{face specification}, which states how the face should appear on different kinds of terminals. It should -be an alist whose elements each have the form @code{(@var{display} -@var{atts})}. @var{display} specifies a class of terminals (see -below), while @var{atts} is a property list of face attributes and -their values, specifying the appearance of the face on matching -terminals +be an alist whose elements each have the form + +@example +(@var{display} . @var{plist}) +@end example + +@noindent +@var{display} specifies a class of terminals (see below), while +@var{plist} is a property list of face attributes and their values, +specifying how the face appears on such terminals @iftex (see the next section for details about face attributes). @end iftex @@ -1947,8 +1952,8 @@ @table @asis @item @code{default} This element of @var{spec} doesn't match any frames; instead, it -specifies defaults that apply to all frames. This kind of element, if -used, must be the first element of @var{spec}. Each of the following +specifies defaults that apply to all frames. This element, if used, +must be the first element of @var{spec}. Each of the following elements can override any or all of these defaults. @item @code{t} @@ -2066,16 +2071,14 @@ @table @code @item :family Font family or fontset (a string). @xref{Fonts,,, emacs, The GNU -Emacs Manual}. If you specify a font family name, the wild-card -characters @samp{*} and @samp{?} are allowed. The function -@code{font-family-list}, described below, returns a list of available -family names. @xref{Fontsets}, for information about fontsets. +Emacs Manual}, for more information about font families; the function +@code{font-family-list} (see below) returns a list of available family +names. @xref{Fontsets}, for information about fontsets. @item :foundry The name of the @dfn{font foundry} for the font family specified by -the @code{:family} attribute (a string). The wild-card characters -@samp{*} and @samp{?} are allowed. @xref{Fonts,,, emacs, The GNU -Emacs Manual}. +the @code{:family} attribute (a string). @xref{Fonts,,, emacs, The +GNU Emacs Manual}. @item :width Relative proportionate character width, also known as the character @@ -2221,16 +2224,6 @@ faces. @end table -For compatibility with Emacs 20, you can also specify values for two -``fake'' face attributes: @code{:bold} and @code{:italic}. Their -values must be either @code{t} or @code{nil}; a value of -@code{unspecified} is not allowed. Setting @code{:bold} to @code{t} -is equivalent to setting the @code{:weight} attribute to @code{bold}, -and setting it to @code{nil} is equivalent to setting @code{:weight} -to @code{normal}. Setting @code{:italic} to @code{t} is equivalent to -setting the @code{:slant} attribute to @code{italic}, and setting it -to @code{nil} is equivalent to setting @code{:slant} to @code{normal}. - @defun font-family-list &optional frame This function returns a list of available font family names. The optional argument @var{frame} specifies the frame on which the text is === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-08 13:27:06 +0000 +++ lisp/ChangeLog 2012-06-08 16:39:49 +0000 @@ -1,3 +1,84 @@ +2012-06-08 Chong Yidong + + * faces.el (set-face-attribute): Doc fix. + (modify-face): Don't use :bold and :italic. + (error, warning, success): Tweak definitions. + + * cus-edit.el (custom-modified, custom-invalid, custom-rogue) + (custom-modified, custom-set, custom-changed, custom-themed) + (custom-saved, custom-button, custom-button-mouse) + (custom-button-pressed, custom-state, custom-comment-tag) + (custom-variable-tag, custom-group-tag-1, custom-group-tag) + (custom-group-subtitle): Use new-style face specs. + (custom-invalid-face, custom-rogue-face, custom-modified-face) + (custom-set-face, custom-changed-face, custom-saved-face) + (custom-button-face, custom-button-pressed-face) + (custom-documentation-face, custom-state-face) + (custom-comment-face, custom-comment-tag-face) + (custom-variable-tag-face, custom-variable-button-face) + (custom-face-tag-face, custom-group-tag-face-1) + (custom-group-tag-face): Remove obsolete face alias. + + * epa.el (epa-validity-high, epa-validity-medium) + (epa-validity-low, epa-mark, epa-field-name, epa-string) + (epa-field-name, epa-field-body): + * font-lock.el (font-lock-comment-face, font-lock-string-face) + (font-lock-keyword-face, font-lock-builtin-face) + (font-lock-function-name-face, font-lock-variable-name-face) + (font-lock-type-face, font-lock-constant-face): + * ido.el (ido-first-match, ido-only-match, ido-subdir) + (ido-virtual, ido-indicator, ido-incomplete-regexp): + * speedbar.el (speedbar-button-face, speedbar-file-face) + (speedbar-directory-face, speedbar-tag-face) + (speedbar-selected-face, speedbar-highlight-face) + (speedbar-separator-face): + * whitespace.el (whitespace-newline, whitespace-space) + (whitespace-hspace, whitespace-tab, whitespace-trailing) + (whitespace-line, whitespace-space-before-tab) + (whitespace-space-after-tab, whitespace-indentation) + (whitespace-empty): + * emulation/cua-base.el (cua-global-mark): + * eshell/em-prompt.el (eshell-prompt): + * net/newst-plainview.el (newsticker-new-item-face) + (newsticker-old-item-face, newsticker-immortal-item-face) + (newsticker-obsolete-item-face, newsticker-date-face) + (newsticker-statistics-face, newsticker-default-face): + * net/newst-reader.el (newsticker-feed-face) + (newsticker-extra-face, newsticker-enclosure-face): + * net/newst-treeview.el (newsticker-treeview-face) + (newsticker-treeview-new-face, newsticker-treeview-old-face) + (newsticker-treeview-immortal-face) + (newsticker-treeview-obsolete-face) + (newsticker-treeview-selection-face): + * net/rcirc.el (rcirc-my-nick, rcirc-other-nick) + (rcirc-bright-nick, rcirc-server, rcirc-timestamp) + (rcirc-nick-in-message, rcirc-nick-in-message-full-line) + (rcirc-prompt, rcirc-track-keyword, rcirc-url, rcirc-keyword): + * nxml/nxml-outln.el (nxml-heading, nxml-outline-indicator) + (nxml-outline-active-indicator, nxml-outline-ellipsis): + * play/mpuz.el (mpuz-unsolved, mpuz-solved, mpuz-trivial) + (mpuz-text): + * progmodes/vera-mode.el (vera-font-lock-number) + (vera-font-lock-function, vera-font-lock-interface): + * textmodes/table.el (table-cell): Use new-style face specs, and + don't use the old :bold and :italic attributes. + + * progmodes/ebrowse.el (ebrowse-tree-mark, ebrowse-root-class) + (ebrowse-member-attribute, ebrowse-default, ebrowse-file-name) + (ebrowse-member-class, ebrowse-progress): Likewise. + (ebrowse-tree-mark-face, ebrowse-root-class-face) + (ebrowse-file-name-face, ebrowse-default-face) + (ebrowse-member-attribute-face, ebrowse-member-class-face) + (ebrowse-progress-face): Remove obsolete faces. + + * progmodes/flymake.el (flymake-errline, flymake-warnline): + Inherit from error and warning faces respectively. + + * textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate): + Likewise. + (flyspell-incorrect-face, flyspell-duplicate-face): Remove + obsolete aliases. + 2012-06-08 Michael Albinus * net/tramp-compat.el (tramp-compat-temporary-file-directory): === modified file 'lisp/cus-edit.el' --- lisp/cus-edit.el 2012-06-02 10:56:09 +0000 +++ lisp/cus-edit.el 2012-06-08 16:39:49 +0000 @@ -1853,64 +1853,52 @@ :group 'custom-buffer) (defface custom-invalid '((((class color)) - (:foreground "yellow1" :background "red1")) - (t - (:weight bold :slant italic :underline t))) + :foreground "yellow1" :background "red1") + (t :weight bold :slant italic :underline t)) "Face used when the customize item is invalid." :group 'custom-magic-faces) -(define-obsolete-face-alias 'custom-invalid-face 'custom-invalid "22.1") (defface custom-rogue '((((class color)) - (:foreground "pink" :background "black")) - (t - (:underline t))) + :foreground "pink" :background "black") + (t :underline t)) "Face used when the customize item is not defined for customization." :group 'custom-magic-faces) -(define-obsolete-face-alias 'custom-rogue-face 'custom-rogue "22.1") (defface custom-modified '((((min-colors 88) (class color)) - (:foreground "white" :background "blue1")) + :foreground "white" :background "blue1") (((class color)) - (:foreground "white" :background "blue")) - (t - (:slant italic :bold))) + :foreground "white" :background "blue") + (t :slant italic)) "Face used when the customize item has been modified." :group 'custom-magic-faces) -(define-obsolete-face-alias 'custom-modified-face 'custom-modified "22.1") (defface custom-set '((((min-colors 88) (class color)) - (:foreground "blue1" :background "white")) + :foreground "blue1" :background "white") (((class color)) - (:foreground "blue" :background "white")) - (t - (:slant italic))) + :foreground "blue" :background "white") + (t :slant italic)) "Face used when the customize item has been set." :group 'custom-magic-faces) -(define-obsolete-face-alias 'custom-set-face 'custom-set "22.1") (defface custom-changed '((((min-colors 88) (class color)) - (:foreground "white" :background "blue1")) + :foreground "white" :background "blue1") (((class color)) - (:foreground "white" :background "blue")) - (t - (:slant italic))) + :foreground "white" :background "blue") + (t :slant italic)) "Face used when the customize item has been changed." :group 'custom-magic-faces) -(define-obsolete-face-alias 'custom-changed-face 'custom-changed "22.1") (defface custom-themed '((((min-colors 88) (class color)) - (:foreground "white" :background "blue1")) - (((class color)) - (:foreground "white" :background "blue")) - (t - (:slant italic))) + :foreground "white" :background "blue1") + (((class color)) + :foreground "white" :background "blue") + (t :slant italic)) "Face used when the customize item has been set by a theme." :group 'custom-magic-faces) -(defface custom-saved '((t (:underline t))) +(defface custom-saved '((t :underline t)) "Face used when the customize item has been saved." :group 'custom-magic-faces) -(define-obsolete-face-alias 'custom-saved-face 'custom-saved "22.1") (defconst custom-magic-alist '((nil "#" underline "\ @@ -2102,24 +2090,21 @@ (defface custom-button '((((type x w32 ns) (class color)) ; Like default mode line - (:box (:line-width 2 :style released-button) - :background "lightgrey" :foreground "black")) - (t - nil)) + :box (:line-width 2 :style released-button) + :background "lightgrey" :foreground "black")) "Face for custom buffer buttons if `custom-raised-buttons' is non-nil." :version "21.1" :group 'custom-faces) -(define-obsolete-face-alias 'custom-button-face 'custom-button "22.1") (defface custom-button-mouse '((((type x w32 ns) (class color)) - (:box (:line-width 2 :style released-button) - :background "grey90" :foreground "black")) + :box (:line-width 2 :style released-button) + :background "grey90" :foreground "black") (t ;; This is for text terminals that support mouse, like GPM mouse ;; or the MS-DOS terminal: inverse-video makes the button stand ;; out on mouse-over. - (:inverse-video t))) + :inverse-video t)) "Mouse face for custom buffer buttons if `custom-raised-buttons' is non-nil." :version "22.1" :group 'custom-faces) @@ -2138,15 +2123,12 @@ (defface custom-button-pressed '((((type x w32 ns) (class color)) - (:box (:line-width 2 :style pressed-button) - :background "lightgrey" :foreground "black")) - (t - (:inverse-video t))) + :box (:line-width 2 :style pressed-button) + :background "lightgrey" :foreground "black") + (t :inverse-video t)) "Face for pressed custom buttons if `custom-raised-buttons' is non-nil." :version "21.1" :group 'custom-faces) -(define-obsolete-face-alias 'custom-button-pressed-face - 'custom-button-pressed "22.1") (defface custom-button-pressed-unraised '((default :inherit custom-button-unraised) @@ -2164,22 +2146,15 @@ (defface custom-documentation '((t nil)) "Face used for documentation strings in customization buffers." :group 'custom-faces) -(define-obsolete-face-alias 'custom-documentation-face - 'custom-documentation "22.1") -(defface custom-state '((((class color) - (background dark)) - (:foreground "lime green")) - (((class color) - (background light)) - (:foreground "dark green")) - (t nil)) +(defface custom-state '((((class color) (background dark)) + :foreground "lime green") + (((class color) (background light)) + :foreground "dark green")) "Face used for State descriptions in the customize buffer." :group 'custom-faces) -(define-obsolete-face-alias 'custom-state-face 'custom-state "22.1") -(defface custom-link - '((t :inherit link)) +(defface custom-link '((t :inherit link)) "Face for links in customization buffers." :version "22.1" :group 'custom-faces) @@ -2376,20 +2351,18 @@ "Face used for comments on variables or faces." :version "21.1" :group 'custom-faces) -(define-obsolete-face-alias 'custom-comment-face 'custom-comment "22.1") ;; like font-lock-comment-face (defface custom-comment-tag - '((((class color) (background dark)) (:foreground "gray80")) - (((class color) (background light)) (:foreground "blue4")) + '((((class color) (background dark)) :foreground "gray80") + (((class color) (background light)) :foreground "blue4") (((class grayscale) (background light)) - (:foreground "DimGray" :weight bold :slant italic)) + :foreground "DimGray" :weight bold :slant italic) (((class grayscale) (background dark)) - (:foreground "LightGray" :weight bold :slant italic)) - (t (:weight bold))) + :foreground "LightGray" :weight bold :slant italic) + (t :weight bold)) "Face used for the comment tag on variables or faces." :group 'custom-faces) -(define-obsolete-face-alias 'custom-comment-tag-face 'custom-comment-tag "22.1") (define-widget 'custom-comment 'string "User comment." @@ -2428,26 +2401,19 @@ ;;; The `custom-variable' Widget. (defface custom-variable-tag - `((((class color) - (background dark)) - (:foreground "light blue" :weight bold)) - (((min-colors 88) (class color) - (background light)) - (:foreground "blue1" :weight bold)) - (((class color) - (background light)) - (:foreground "blue" :weight bold)) - (t (:weight bold))) + `((((class color) (background dark)) + :foreground "light blue" :weight bold) + (((min-colors 88) (class color) (background light)) + :foreground "blue1" :weight bold) + (((class color) (background light)) + :foreground "blue" :weight bold) + (t :weight bold)) "Face used for unpushable variable tags." :group 'custom-faces) -(define-obsolete-face-alias 'custom-variable-tag-face - 'custom-variable-tag "22.1") -(defface custom-variable-button '((t (:underline t :weight bold))) +(defface custom-variable-button '((t :underline t :weight bold)) "Face used for pushable variable tags." :group 'custom-faces) -(define-obsolete-face-alias 'custom-variable-button-face - 'custom-variable-button "22.1") (defcustom custom-variable-default-form 'edit "Default form of displaying variable values." @@ -3314,10 +3280,9 @@ ;;; The `custom-face' Widget. (defface custom-face-tag - `((t :inherit custom-variable-tag)) + '((t :inherit custom-variable-tag)) "Face used for face tags." :group 'custom-faces) -(define-obsolete-face-alias 'custom-face-tag-face 'custom-face-tag "22.1") (defcustom custom-face-default-form 'selected "Default form of displaying face definition." @@ -3932,37 +3897,24 @@ :group 'custom-faces) (defface custom-group-tag-1 - `((((class color) - (background dark)) - (:foreground "pink" :weight bold :height 1.2 :inherit variable-pitch)) - (((min-colors 88) (class color) - (background light)) - (:foreground "red1" :weight bold :height 1.2 :inherit variable-pitch)) - (((class color) - (background light)) - (:foreground "red" :weight bold :height 1.2 :inherit variable-pitch)) - (t (:weight bold))) - "Face used for group tags." + '((default :weight bold :height 1.2 :inherit variable-pitch) + (((class color) (background dark)) :foreground "pink") + (((min-colors 88) (class color) (background light)) :foreground "red1") + (((class color) (background light)) :foreground "red")) + "Face for group tags." :group 'custom-faces) -(define-obsolete-face-alias 'custom-group-tag-face-1 'custom-group-tag-1 "22.1") (defface custom-group-tag - `((((class color) - (background dark)) - (:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch)) - (((min-colors 88) (class color) - (background light)) - (:foreground "blue1" :weight bold :height 1.2 :inherit variable-pitch)) - (((class color) - (background light)) - (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch)) - (t (:weight bold))) - "Face used for low level group tags." + '((default :weight bold :height 1.2 :inherit variable-pitch) + (((class color) (background dark)) :foreground "light blue") + (((min-colors 88) (class color) (background light)) :foreground "blue1") + (((class color) (background light)) :foreground "blue") + (t :weight bold)) + "Face for low level group tags." :group 'custom-faces) -(define-obsolete-face-alias 'custom-group-tag-face 'custom-group-tag "22.1") (defface custom-group-subtitle - `((t (:weight bold))) + '((t :weight bold)) "Face for the \"Subgroups:\" subtitle in Custom buffers." :group 'custom-faces) === modified file 'lisp/emulation/cua-base.el' --- lisp/emulation/cua-base.el 2012-04-14 01:46:06 +0000 +++ lisp/emulation/cua-base.el 2012-06-08 16:39:49 +0000 @@ -463,7 +463,7 @@ (defface cua-global-mark '((((min-colors 88)(class color)) :foreground "black" :background "yellow1") (((class color)) :foreground "black" :background "yellow") - (t :bold t)) + (t :weight bold)) "Font used by CUA for highlighting the global mark." :group 'cua) === modified file 'lisp/epa.el' --- lisp/epa.el 2012-04-09 13:05:48 +0000 +++ lisp/epa.el 2012-06-08 16:39:49 +0000 @@ -50,97 +50,51 @@ :group 'epa) (defface epa-validity-high - `((((class color) (background dark)) - (:foreground "PaleTurquoise" - ,@(if (assq ':weight custom-face-attributes) - '(:weight bold) - '(:bold t)))) - (t - (,@(if (assq ':weight custom-face-attributes) - '(:weight bold) - '(:bold t))))) - "Face used for displaying the high validity." + '((default :weight bold) + (((class color) (background dark)) :foreground "PaleTurquoise")) + "Face for high validity EPA information." :group 'epa-faces) (defface epa-validity-medium - `((((class color) (background dark)) - (:foreground "PaleTurquoise" - ,@(if (assq ':slant custom-face-attributes) - '(:slant italic) - '(:italic t)))) - (t - (,@(if (assq ':slant custom-face-attributes) - '(:slant italic) - '(:italic t))))) - "Face used for displaying the medium validity." + '((default :slant italic) + (((class color) (background dark)) :foreground "PaleTurquoise")) + "Face for medium validity EPA information." :group 'epa-faces) (defface epa-validity-low - `((t - (,@(if (assq ':slant custom-face-attributes) - '(:slant italic) - '(:italic t))))) + '((t :slant italic)) "Face used for displaying the low validity." :group 'epa-faces) (defface epa-validity-disabled - `((t - (,@(if (assq ':slant custom-face-attributes) - '(:slant italic) - '(:italic t)) - :inverse-video t))) + '((t :slant italic :inverse-video t)) "Face used for displaying the disabled validity." :group 'epa-faces) (defface epa-string '((((class color) (background dark)) - (:foreground "lightyellow")) + :foreground "lightyellow") (((class color) (background light)) - (:foreground "blue4"))) + :foreground "blue4")) "Face used for displaying the string." :group 'epa-faces) (defface epa-mark - `((((class color) (background dark)) - (:foreground "orange" - ,@(if (assq ':weight custom-face-attributes) - '(:weight bold) - '(:bold t)))) - (((class color) (background light)) - (:foreground "red" - ,@(if (assq ':weight custom-face-attributes) - '(:weight bold) - '(:bold t)))) - (t - (,@(if (assq ':weight custom-face-attributes) - '(:weight bold) - '(:bold t))))) + '((default :weight bold) + (((class color) (background dark)) :foreground "orange") + (((class color) (background light)) :foreground "red")) "Face used for displaying the high validity." :group 'epa-faces) (defface epa-field-name - `((((class color) (background dark)) - (:foreground "PaleTurquoise" - ,@(if (assq ':weight custom-face-attributes) - '(:weight bold) - '(:bold t)))) - (t - (,@(if (assq ':weight custom-face-attributes) - '(:weight bold) - '(:bold t))))) + '((default :weight bold) + (((class color) (background dark)) :foreground "PaleTurquoise")) "Face for the name of the attribute field." :group 'epa) (defface epa-field-body - `((((class color) (background dark)) - (:foreground "turquoise" - ,@(if (assq ':slant custom-face-attributes) - '(:slant italic) - '(:italic t)))) - (t - (,@(if (assq ':slant custom-face-attributes) - '(:slant italic) - '(:italic t))))) + '((default :slant italic) + (((class color) (background dark)) :foreground "turquoise")) "Face for the body of the attribute field." :group 'epa) === modified file 'lisp/erc/ChangeLog' --- lisp/erc/ChangeLog 2012-06-02 10:56:09 +0000 +++ lisp/erc/ChangeLog 2012-06-08 16:39:49 +0000 @@ -1,3 +1,17 @@ +2012-06-08 Chong Yidong + + * erc.el (erc-direct-msg-face, erc-header-line, erc-input-face) + (erc-command-indicator-face, erc-notice-face, erc-action-face) + (erc-error-face, erc-my-nick-face, erc-nick-default-face) + (erc-nick-msg-face): Use new-style face specs, and avoid :bold. + + * erc-button.el (erc-button): + * erc-goodies.el (erc-bold-face, erc-inverse-face) + (erc-underline-face, fg:erc-color-*): + * erc-match.el (erc-current-nick-face, erc-dangerous-host-face) + (erc-pal-face, erc-fool-face, erc-keyword-face): + * erc-stamp.el (erc-timestamp-face): Likewise. + 2012-06-02 Chong Yidong * erc-track.el (erc-track, erc-track-faces-priority-list) === modified file 'lisp/erc/erc-button.el' --- lisp/erc/erc-button.el 2012-04-09 13:05:48 +0000 +++ lisp/erc/erc-button.el 2012-06-08 16:39:49 +0000 @@ -66,7 +66,7 @@ ;;; Variables -(defface erc-button '((t (:bold t))) +(defface erc-button '((t :weight bold)) "ERC button face." :group 'erc-faces) === modified file 'lisp/erc/erc-goodies.el' --- lisp/erc/erc-goodies.el 2012-04-09 13:05:48 +0000 +++ lisp/erc/erc-goodies.el 2012-06-08 16:39:49 +0000 @@ -206,112 +206,114 @@ :group 'erc-control-characters :type 'boolean) -(defface erc-bold-face '((t (:bold t))) +(defface erc-bold-face '((t :weight bold)) "ERC bold face." :group 'erc-faces) + (defface erc-inverse-face - '((t (:foreground "White" :background "Black"))) + '((t :foreground "White" :background "Black")) "ERC inverse face." :group 'erc-faces) -(defface erc-underline-face '((t (:underline t))) + +(defface erc-underline-face '((t :underline t)) "ERC underline face." :group 'erc-faces) -(defface fg:erc-color-face0 '((t (:foreground "White"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face1 '((t (:foreground "black"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face2 '((t (:foreground "blue4"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face3 '((t (:foreground "green4"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face4 '((t (:foreground "red"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face5 '((t (:foreground "brown"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face6 '((t (:foreground "purple"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face7 '((t (:foreground "orange"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face8 '((t (:foreground "yellow"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face9 '((t (:foreground "green"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face10 '((t (:foreground "lightblue1"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face11 '((t (:foreground "cyan"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face12 '((t (:foreground "blue"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face13 '((t (:foreground "deeppink"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face14 '((t (:foreground "gray50"))) - "ERC face." - :group 'erc-faces) -(defface fg:erc-color-face15 '((t (:foreground "gray90"))) +(defface fg:erc-color-face0 '((t :foreground "White")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face1 '((t :foreground "black")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face2 '((t :foreground "blue4")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face3 '((t :foreground "green4")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face4 '((t :foreground "red")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face5 '((t :foreground "brown")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face6 '((t :foreground "purple")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face7 '((t :foreground "orange")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face8 '((t :foreground "yellow")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face9 '((t :foreground "green")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face10 '((t :foreground "lightblue1")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face11 '((t :foreground "cyan")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face12 '((t :foreground "blue")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face13 '((t :foreground "deeppink")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face14 '((t :foreground "gray50")) + "ERC face." + :group 'erc-faces) +(defface fg:erc-color-face15 '((t :foreground "gray90")) "ERC face." :group 'erc-faces) -(defface bg:erc-color-face0 '((t (:background "White"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face1 '((t (:background "black"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face2 '((t (:background "blue4"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face3 '((t (:background "green4"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face4 '((t (:background "red"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face5 '((t (:background "brown"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face6 '((t (:background "purple"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face7 '((t (:background "orange"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face8 '((t (:background "yellow"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face9 '((t (:background "green"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face10 '((t (:background "lightblue1"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face11 '((t (:background "cyan"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face12 '((t (:background "blue"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face13 '((t (:background "deeppink"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face14 '((t (:background "gray50"))) - "ERC face." - :group 'erc-faces) -(defface bg:erc-color-face15 '((t (:background "gray90"))) +(defface bg:erc-color-face0 '((t :background "White")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face1 '((t :background "black")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face2 '((t :background "blue4")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face3 '((t :background "green4")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face4 '((t :background "red")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face5 '((t :background "brown")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face6 '((t :background "purple")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face7 '((t :background "orange")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face8 '((t :background "yellow")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face9 '((t :background "green")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face10 '((t :background "lightblue1")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face11 '((t :background "cyan")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face12 '((t :background "blue")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face13 '((t :background "deeppink")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face14 '((t :background "gray50")) + "ERC face." + :group 'erc-faces) +(defface bg:erc-color-face15 '((t :background "gray90")) "ERC face." :group 'erc-faces) === modified file 'lisp/erc/erc-match.el' --- lisp/erc/erc-match.el 2012-04-09 13:05:48 +0000 +++ lisp/erc/erc-match.el 2012-06-08 16:39:49 +0000 @@ -258,26 +258,26 @@ ;; Faces: -(defface erc-current-nick-face '((t (:bold t :foreground "DarkTurquoise"))) +(defface erc-current-nick-face '((t :weight bold :foreground "DarkTurquoise")) "ERC face for occurrences of your current nickname." :group 'erc-faces) -(defface erc-dangerous-host-face '((t (:foreground "red"))) +(defface erc-dangerous-host-face '((t :foreground "red")) "ERC face for people on dangerous hosts. See `erc-dangerous-hosts'." :group 'erc-faces) -(defface erc-pal-face '((t (:bold t :foreground "Magenta"))) +(defface erc-pal-face '((t :weight bold :foreground "Magenta")) "ERC face for your pals. See `erc-pals'." :group 'erc-faces) -(defface erc-fool-face '((t (:foreground "dim gray"))) +(defface erc-fool-face '((t :foreground "dim gray")) "ERC face for fools on the channel. See `erc-fools'." :group 'erc-faces) -(defface erc-keyword-face '((t (:bold t :foreground "pale green"))) +(defface erc-keyword-face '((t :weight bold :foreground "pale green")) "ERC face for your keywords. Note that this is the default face to use if `erc-keywords' does not specify another." === modified file 'lisp/erc/erc-stamp.el' --- lisp/erc/erc-stamp.el 2012-04-09 13:05:48 +0000 +++ lisp/erc/erc-stamp.el 2012-06-08 16:39:49 +0000 @@ -152,7 +152,7 @@ :group 'erc-stamp :type 'boolean) -(defface erc-timestamp-face '((t (:bold t :foreground "green"))) +(defface erc-timestamp-face '((t :weight bold :foreground "green")) "ERC timestamp face." :group 'erc-faces) === modified file 'lisp/erc/erc.el' --- lisp/erc/erc.el 2012-04-10 02:51:39 +0000 +++ lisp/erc/erc.el 2012-06-08 16:39:49 +0000 @@ -1140,61 +1140,58 @@ "ERC default face." :group 'erc-faces) -(defface erc-direct-msg-face '((t (:foreground "IndianRed"))) +(defface erc-direct-msg-face '((t :foreground "IndianRed")) "ERC face used for messages you receive in the main erc buffer." :group 'erc-faces) (defface erc-header-line - '((t (:foreground "grey20" :background "grey90"))) + '((t :foreground "grey20" :background "grey90")) "ERC face used for the header line. This will only be used if `erc-header-line-face-method' is non-nil." :group 'erc-faces) -(defface erc-input-face '((t (:foreground "brown"))) +(defface erc-input-face '((t :foreground "brown")) "ERC face used for your input." :group 'erc-faces) (defface erc-prompt-face - '((t (:bold t :foreground "Black" :background "lightBlue2"))) + '((t :weight bold :foreground "Black" :background "lightBlue2")) "ERC face for the prompt." :group 'erc-faces) (defface erc-command-indicator-face - '((t (:bold t))) + '((t :weight bold)) "ERC face for the command indicator. See the variable `erc-command-indicator'." :group 'erc-faces) (defface erc-notice-face - (if (or (featurep 'xemacs) - (< emacs-major-version 22)) - '((t (:bold t :foreground "blue"))) - '((((class color) (min-colors 88)) - (:bold t :foreground "SlateBlue")) - (t (:bold t :foreground "blue")))) + '((default :weight bold) + (((class color) (min-colors 88)) :foreground "SlateBlue") + (t :foreground "blue")) "ERC face for notices." :group 'erc-faces) -(defface erc-action-face '((t (:bold t))) +(defface erc-action-face '((t :weight bold)) "ERC face for actions generated by /ME." :group 'erc-faces) -(defface erc-error-face '((t (:foreground "red"))) +(defface erc-error-face '((t :foreground "red")) "ERC face for errors." :group 'erc-faces) ;; same default color as `erc-input-face' -(defface erc-my-nick-face '((t (:bold t :foreground "brown"))) +(defface erc-my-nick-face '((t :weight bold :foreground "brown")) "ERC face for your current nickname in messages sent by you. See also `erc-show-my-nick'." :group 'erc-faces) -(defface erc-nick-default-face '((t (:bold t))) +(defface erc-nick-default-face '((t :weight bold)) "ERC nickname default face." :group 'erc-faces) -(defface erc-nick-msg-face '((t (:bold t :foreground "IndianRed"))) +(defface erc-nick-msg-face '((t :weight bold :foreground "IndianRed")) "ERC nickname face for private messages." :group 'erc-faces) === modified file 'lisp/eshell/em-prompt.el' --- lisp/eshell/em-prompt.el 2012-01-19 07:21:25 +0000 +++ lisp/eshell/em-prompt.el 2012-06-08 16:39:49 +0000 @@ -69,9 +69,9 @@ :group 'eshell-prompt) (defface eshell-prompt - '((((class color) (background light)) (:foreground "Red" :bold t)) - (((class color) (background dark)) (:foreground "Pink" :bold t)) - (t (:bold t))) + '((default :weight bold) + (((class color) (background light)) :foreground "Red") + (((class color) (background dark)) :foreground "Pink")) "The face used to highlight prompt strings. For highlighting other kinds of strings -- similar to shell mode's behavior -- simply use an output filer which changes text properties." === modified file 'lisp/faces.el' --- lisp/faces.el 2012-05-24 07:53:21 +0000 +++ lisp/faces.el 2012-06-08 16:39:49 +0000 @@ -563,23 +563,23 @@ (defun set-face-attribute (face frame &rest args) "Set attributes of FACE on FRAME from ARGS. - -If FRAME is nil this function sets the attributes for all -existing frames, and the default for new frames. If FRAME is t, -change the default for new frames (this is done automatically -each time an attribute is changed on all frames). - -ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a valid -face attribute name. All attributes can be set to `unspecified'; -this fact is not further mentioned below. +This function overrides the face attributes specified by FACE's +face spec. It is mostly intended for internal use only. + +If FRAME is nil, set the attributes for all existing frames, as +well as the default for new frames. If FRAME is t, change the +default for new frames only. + +ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a +valid face attribute name. All attributes can be set to +`unspecified'; this fact is not further mentioned below. The following attributes are recognized: `:family' -VALUE must be a string specifying the font family, e.g. ``monospace'', -or a fontset alias name. If a font family is specified, wild-cards `*' -and `?' are allowed. +VALUE must be a string specifying the font family +\(e.g. \"Monospace\") or a fontset. `:foundry' @@ -596,13 +596,13 @@ `:height' -VALUE specifies the height of the font, in either absolute or relative -terms. An absolute height is an integer, and specifies font height in -units of 1/10 pt. A relative height is either a floating point number, +VALUE specifies the relative or absolute height of the font. An +absolute height is an integer, and specifies font height in units +of 1/10 pt. A relative height is either a floating point number, which specifies a scaling factor for the underlying face height; -or a function that takes a single argument (the underlying face height) -and returns the new height. Note that for the `default' face, -you can only specify an absolute height (since there is nothing +or a function that takes a single argument (the underlying face +height) and returns the new height. Note that for the `default' +face, you must specify an absolute height (since there is nothing for it to be relative to). `:weight' @@ -684,19 +684,26 @@ `:font' -Set font-related face attributes from VALUE. VALUE must be a valid -XLFD font name. If it is a font name pattern, the first matching font -will be used. - -For compatibility with Emacs 20, keywords `:bold' and `:italic' can -be used to specify that a bold or italic font should be used. VALUE -must be t or nil in that case. A value of `unspecified' is not allowed. +Set font-related face attributes from VALUE. VALUE must be a +valid font name or font object. Setting this attribute will also +set the `:family', `:foundry', `:width', `:height', `:weight', +and `:slant' attributes. `:inherit' -VALUE is the name of a face from which to inherit attributes, or a list -of face names. Attributes from inherited faces are merged into the face -like an underlying face would be, with higher priority than underlying faces." +VALUE is the name of a face from which to inherit attributes, or +a list of face names. Attributes from inherited faces are merged +into the face like an underlying face would be, with higher +priority than underlying faces. + +For backward compatibility, the keywords `:bold' and `:italic' +can be used to specify weight and slant respectively. This usage +is considered obsolete. For these two keywords, the VALUE must +be either t or nil. A value of t for `:bold' is equivalent to +setting `:weight' to `bold', and a value of t for `:italic' is +equivalent to setting `:slant' to `italic'. But if `:weight' is +specified in the face spec, `:bold' is ignored, and if `:slant' +is specified, `:italic' is ignored." (setq args (purecopy args)) (let ((where (if (null frame) 0 frame)) (spec args) @@ -1188,8 +1195,8 @@ :foreground (or foreground 'unspecified) :background (or background 'unspecified) :stipple stipple - :bold bold-p - :italic italic-p + :weight (if bold-p 'bold 'normal) + :slant (if italic-p 'italic 'normal) :underline underline :inverse-video inverse-p) (setq face (read-face-name "Modify face")) @@ -2439,33 +2446,31 @@ :group 'basic-faces) (defface error - '((((class color) (min-colors 88) (background light)) (:foreground "Red1" :weight bold)) - (((class color) (min-colors 88) (background dark)) (:foreground "Pink" :weight bold)) - (((class color) (min-colors 16) (background light)) (:foreground "Red1" :weight bold)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :weight bold)) - (((class color) (min-colors 8)) (:foreground "red")) - (t (:inverse-video t :weight bold))) + '((default :weight bold) + (((class color) (min-colors 88) (background light)) :foreground "Red1") + (((class color) (min-colors 88) (background dark)) :foreground "Pink") + (((class color) (min-colors 16) (background light)) :foreground "Red1") + (((class color) (min-colors 16) (background dark)) :foreground "Pink") + (((class color) (min-colors 8)) :foreground "red") + (t :inverse-video t)) "Basic face used to highlight errors and to denote failure." :version "24.1" :group 'basic-faces) (defface warning - '((((class color) (min-colors 16)) (:foreground "DarkOrange" :weight bold)) - (((class color)) (:foreground "yellow" :weight bold)) - (t (:weight bold))) + '((default :weight bold) + (((class color) (min-colors 16)) :foreground "DarkOrange") + (((class color)) :foreground "yellow")) "Basic face used to highlight warnings." :version "24.1" :group 'basic-faces) (defface success - '((((class color) (min-colors 16) (background light)) - (:foreground "ForestGreen" :weight bold)) - (((class color) (min-colors 88) (background dark)) - (:foreground "Green1" :weight bold)) - (((class color) (min-colors 16) (background dark)) - (:foreground "Green" :weight bold)) - (((class color)) (:foreground "green" :weight bold)) - (t (:weight bold))) + '((default :weight bold) + (((class color) (min-colors 16) (background light)) :foreground "ForestGreen") + (((class color) (min-colors 88) (background dark)) :foreground "Green1") + (((class color) (min-colors 16) (background dark)) :foreground "Green") + (((class color)) :foreground "green")) "Basic face used to indicate successful operation." :version "24.1" :group 'basic-faces) === modified file 'lisp/font-lock.el' --- lisp/font-lock.el 2012-04-20 11:36:21 +0000 +++ lisp/font-lock.el 2012-06-08 16:39:49 +0000 @@ -1877,22 +1877,22 @@ ;; `custom-declare-face'. (defface font-lock-comment-face '((((class grayscale) (background light)) - (:foreground "DimGray" :weight bold :slant italic)) + :foreground "DimGray" :weight bold :slant italic) (((class grayscale) (background dark)) - (:foreground "LightGray" :weight bold :slant italic)) + :foreground "LightGray" :weight bold :slant italic) (((class color) (min-colors 88) (background light)) - (:foreground "Firebrick")) + :foreground "Firebrick") (((class color) (min-colors 88) (background dark)) - (:foreground "chocolate1")) + :foreground "chocolate1") (((class color) (min-colors 16) (background light)) - (:foreground "red")) + :foreground "red") (((class color) (min-colors 16) (background dark)) - (:foreground "red1")) + :foreground "red1") (((class color) (min-colors 8) (background light)) - (:foreground "red")) + :foreground "red") (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")) - (t (:weight bold :slant italic))) + :foreground "yellow") + (t :weight bold :slant italic)) "Font Lock mode face used to highlight comments." :group 'font-lock-faces) @@ -1902,14 +1902,14 @@ :group 'font-lock-faces) (defface font-lock-string-face - '((((class grayscale) (background light)) (:foreground "DimGray" :slant italic)) - (((class grayscale) (background dark)) (:foreground "LightGray" :slant italic)) - (((class color) (min-colors 88) (background light)) (:foreground "VioletRed4")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:slant italic))) + '((((class grayscale) (background light)) :foreground "DimGray" :slant italic) + (((class grayscale) (background dark)) :foreground "LightGray" :slant italic) + (((class color) (min-colors 88) (background light)) :foreground "VioletRed4") + (((class color) (min-colors 88) (background dark)) :foreground "LightSalmon") + (((class color) (min-colors 16) (background light)) :foreground "RosyBrown") + (((class color) (min-colors 16) (background dark)) :foreground "LightSalmon") + (((class color) (min-colors 8)) :foreground "green") + (t :slant italic)) "Font Lock mode face used to highlight strings." :group 'font-lock-faces) @@ -1919,76 +1919,76 @@ :group 'font-lock-faces) (defface font-lock-keyword-face - '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold)) - (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold)) - (((class color) (min-colors 88) (background light)) (:foreground "Purple")) - (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) - (((class color) (min-colors 16) (background light)) (:foreground "Purple")) - (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) - (((class color) (min-colors 8)) (:foreground "cyan" :weight bold)) - (t (:weight bold))) + '((((class grayscale) (background light)) :foreground "LightGray" :weight bold) + (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) + (((class color) (min-colors 88) (background light)) :foreground "Purple") + (((class color) (min-colors 88) (background dark)) :foreground "Cyan1") + (((class color) (min-colors 16) (background light)) :foreground "Purple") + (((class color) (min-colors 16) (background dark)) :foreground "Cyan") + (((class color) (min-colors 8)) :foreground "cyan" :weight bold) + (t :weight bold)) "Font Lock mode face used to highlight keywords." :group 'font-lock-faces) (defface font-lock-builtin-face - '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold)) - (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold)) - (((class color) (min-colors 88) (background light)) (:foreground "dark slate blue")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSteelBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Orchid")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :weight bold)) - (t (:weight bold))) + '((((class grayscale) (background light)) :foreground "LightGray" :weight bold) + (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) + (((class color) (min-colors 88) (background light)) :foreground "dark slate blue") + (((class color) (min-colors 88) (background dark)) :foreground "LightSteelBlue") + (((class color) (min-colors 16) (background light)) :foreground "Orchid") + (((class color) (min-colors 16) (background dark)) :foreground "LightSteelBlue") + (((class color) (min-colors 8)) :foreground "blue" :weight bold) + (t :weight bold)) "Font Lock mode face used to highlight builtins." :group 'font-lock-faces) (defface font-lock-function-name-face - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :weight bold)) - (t (:inverse-video t :weight bold))) + '((((class color) (min-colors 88) (background light)) :foreground "Blue1") + (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue") + (((class color) (min-colors 16) (background light)) :foreground "Blue") + (((class color) (min-colors 16) (background dark)) :foreground "LightSkyBlue") + (((class color) (min-colors 8)) :foreground "blue" :weight bold) + (t :inverse-video t :weight bold)) "Font Lock mode face used to highlight function names." :group 'font-lock-faces) (defface font-lock-variable-name-face '((((class grayscale) (background light)) - (:foreground "Gray90" :weight bold :slant italic)) + :foreground "Gray90" :weight bold :slant italic) (((class grayscale) (background dark)) - (:foreground "DimGray" :weight bold :slant italic)) - (((class color) (min-colors 88) (background light)) (:foreground "sienna")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8)) (:foreground "yellow" :weight light)) - (t (:weight bold :slant italic))) + :foreground "DimGray" :weight bold :slant italic) + (((class color) (min-colors 88) (background light)) :foreground "sienna") + (((class color) (min-colors 88) (background dark)) :foreground "LightGoldenrod") + (((class color) (min-colors 16) (background light)) :foreground "DarkGoldenrod") + (((class color) (min-colors 16) (background dark)) :foreground "LightGoldenrod") + (((class color) (min-colors 8)) :foreground "yellow" :weight light) + (t :weight bold :slant italic)) "Font Lock mode face used to highlight variable names." :group 'font-lock-faces) (defface font-lock-type-face - '((((class grayscale) (background light)) (:foreground "Gray90" :weight bold)) - (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold)) - (((class color) (min-colors 88) (background light)) (:foreground "ForestGreen")) - (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:weight bold :underline t))) + '((((class grayscale) (background light)) :foreground "Gray90" :weight bold) + (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) + (((class color) (min-colors 88) (background light)) :foreground "ForestGreen") + (((class color) (min-colors 88) (background dark)) :foreground "PaleGreen") + (((class color) (min-colors 16) (background light)) :foreground "ForestGreen") + (((class color) (min-colors 16) (background dark)) :foreground "PaleGreen") + (((class color) (min-colors 8)) :foreground "green") + (t :weight bold :underline t)) "Font Lock mode face used to highlight type and classes." :group 'font-lock-faces) (defface font-lock-constant-face '((((class grayscale) (background light)) - (:foreground "LightGray" :weight bold :underline t)) + :foreground "LightGray" :weight bold :underline t) (((class grayscale) (background dark)) - (:foreground "Gray50" :weight bold :underline t)) - (((class color) (min-colors 88) (background light)) (:foreground "dark cyan")) - (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine")) - (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) - (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) - (((class color) (min-colors 8)) (:foreground "magenta")) - (t (:weight bold :underline t))) + :foreground "Gray50" :weight bold :underline t) + (((class color) (min-colors 88) (background light)) :foreground "dark cyan") + (((class color) (min-colors 88) (background dark)) :foreground "Aquamarine") + (((class color) (min-colors 16) (background light)) :foreground "CadetBlue") + (((class color) (min-colors 16) (background dark)) :foreground "Aquamarine") + (((class color) (min-colors 8)) :foreground "magenta") + (t :weight bold :underline t)) "Font Lock mode face used to highlight constants and labels." :group 'font-lock-faces) === modified file 'lisp/ido.el' --- lisp/ido.el 2012-05-04 05:14:14 +0000 +++ lisp/ido.el 2012-06-08 16:39:49 +0000 @@ -791,44 +791,39 @@ :type 'boolean :group 'ido) -(defface ido-first-match '((t (:bold t))) +(defface ido-first-match '((t :weight bold)) "Face used by ido for highlighting first match." :group 'ido) (defface ido-only-match '((((class color)) - (:foreground "ForestGreen")) - (t (:italic t))) + :foreground "ForestGreen") + (t :slant italic)) "Face used by ido for highlighting only match." :group 'ido) (defface ido-subdir '((((min-colors 88) (class color)) - (:foreground "red1")) - (((class color)) - (:foreground "red")) - (t (:underline t))) + :foreground "red1") + (((class color)) + :foreground "red") + (t :underline t)) "Face used by ido for highlighting subdirs in the alternatives." :group 'ido) -(defface ido-virtual '((t (:inherit font-lock-builtin-face))) +(defface ido-virtual '((t :inherit font-lock-builtin-face)) "Face used by ido for matching virtual buffer names." :version "24.1" :group 'ido) -(defface ido-indicator '((((min-colors 88) (class color)) - (:foreground "yellow1" - :background "red1" - :width condensed)) - (((class color)) - (:foreground "yellow" - :background "red" - :width condensed)) - (t (:inverse-video t))) +(defface ido-indicator '((((min-colors 88) (class color)) + :foreground "yellow1" :background "red1" :width condensed) + (((class color)) + :foreground "yellow" :background "red" :width condensed) + (t :inverse-video t)) "Face used by ido for highlighting its indicators." :group 'ido) (defface ido-incomplete-regexp - '((t - (:inherit font-lock-warning-face))) + '((t :inherit font-lock-warning-face)) "Ido face for indicating incomplete regexps." :group 'ido) === modified file 'lisp/net/newst-plainview.el' --- lisp/net/newst-plainview.el 2012-01-19 07:21:25 +0000 +++ lisp/net/newst-plainview.el 2012-06-08 16:39:49 +0000 @@ -155,61 +155,39 @@ ;; ====================================================================== ;; faces -(defface newsticker-new-item-face - '((((class color) (background dark)) - (:family "sans" :bold t)) - (((class color) (background light)) - (:family "sans" :bold t))) +(defface newsticker-new-item-face '((t :weight bold)) "Face for new news items." :group 'newsticker-faces) (defface newsticker-old-item-face - '((((class color) (background dark)) - (:family "sans" :bold t :foreground "orange3")) - (((class color) (background light)) - (:family "sans" :bold t :foreground "red4"))) + '((default :weight bold) + (((class color) (background dark)) :foreground "orange3") + (((class color) (background light)) :foreground "red4")) "Face for old news items." :group 'newsticker-faces) (defface newsticker-immortal-item-face - '((((class color) (background dark)) - (:family "sans" :bold t :italic t :foreground "orange")) - (((class color) (background light)) - (:family "sans" :bold t :italic t :foreground "blue"))) + '((default :weight bold :slant italic) + (((class color) (background dark)) :foreground "orange") + (((class color) (background light)) :foreground "blue")) "Face for immortal news items." :group 'newsticker-faces) (defface newsticker-obsolete-item-face - '((((class color) (background dark)) - (:family "sans" :bold t :strike-through t)) - (((class color) (background light)) - (:family "sans" :bold t :strike-through t))) + '((t :weight bold :strike-through t)) "Face for old news items." :group 'newsticker-faces) -(defface newsticker-date-face - '((((class color) (background dark)) - (:family "sans" :italic t :height 0.8)) - (((class color) (background light)) - (:family "sans" :italic t :height 0.8))) - "Face for newsticker dates." - :group 'newsticker-faces) - -(defface newsticker-statistics-face - '((((class color) (background dark)) - (:family "sans" :italic t :height 0.8)) - (((class color) (background light)) - (:family "sans" :italic t :height 0.8))) - "Face for newsticker dates." - :group 'newsticker-faces) - -(defface newsticker-default-face - '((((class color) (background dark)) - (:inherit default)) - (((class color) (background light)) - (:inherit default))) +(defface newsticker-date-face '((t :slant italic :height 0.8)) + "Face for newsticker dates." + :group 'newsticker-faces) + +(defface newsticker-statistics-face '((t :slant italic :height 0.8)) + "Face for newsticker dates." + :group 'newsticker-faces) + +(defface newsticker-default-face '((t)) "Face for the description of news items." - ;;:set 'newsticker--set-customvar :group 'newsticker-faces) (defcustom newsticker-hide-old-items-in-newsticker-buffer === modified file 'lisp/net/newst-reader.el' --- lisp/net/newst-reader.el 2012-01-19 07:21:25 +0000 +++ lisp/net/newst-reader.el 2012-06-08 16:39:49 +0000 @@ -129,26 +129,23 @@ :group 'newsticker-reader) (defface newsticker-feed-face - '((((class color) (background dark)) - (:family "sans" :bold t :height 1.2 :foreground "white")) - (((class color) (background light)) - (:family "sans" :bold t :height 1.2 :foreground "black"))) + '((default :weight bold :height 1.2) + (((class color) (background dark)) :foreground "white") + (((class color) (background light)) :foreground "black")) "Face for news feeds." :group 'newsticker-faces) (defface newsticker-extra-face - '((((class color) (background dark)) - (:italic t :foreground "gray50" :height 0.8)) - (((class color) (background light)) - (:italic t :foreground "gray50" :height 0.8))) + '((default :slant italic :height 0.8) + (((class color) (background dark)) :foreground "gray50") + (((class color) (background light)) :foreground "gray50")) "Face for newsticker dates." :group 'newsticker-faces) (defface newsticker-enclosure-face - '((((class color) (background dark)) - (:bold t :background "orange")) - (((class color) (background light)) - (:bold t :background "orange"))) + '((default :weight bold) + (((class color) (background dark)) :background "orange") + (((class color) (background light)) :background "orange")) "Face for enclosed elements." :group 'newsticker-faces) === modified file 'lisp/net/newst-treeview.el' --- lisp/net/newst-treeview.el 2012-01-19 07:21:25 +0000 +++ lisp/net/newst-treeview.el 2012-06-08 16:39:49 +0000 @@ -50,50 +50,36 @@ :group 'newsticker-reader) (defface newsticker-treeview-face - '((((class color) (background dark)) - (:family "sans" :foreground "white" :bold nil)) - (((class color) (background light)) - (:family "sans" :foreground "black" :bold nil))) + '((((class color) (background dark)) :foreground "white") + (((class color) (background light)) :foreground "black")) "Face for newsticker tree." :group 'newsticker-treeview) (defface newsticker-treeview-new-face - '((((class color) (background dark)) - (:inherit newsticker-treeview-face :bold t)) - (((class color) (background light)) - (:inherit newsticker-treeview-face :bold t))) + '((t :inherit newsticker-treeview-face :weight bold)) "Face for newsticker tree." :group 'newsticker-treeview) (defface newsticker-treeview-old-face - '((((class color) (background dark)) - (:inherit newsticker-treeview-face)) - (((class color) (background light)) - (:inherit newsticker-treeview-face))) + '((t :inherit newsticker-treeview-face)) "Face for newsticker tree." :group 'newsticker-treeview) (defface newsticker-treeview-immortal-face - '((((class color) (background dark)) - (:inherit newsticker-treeview-face :foreground "orange" :italic t)) - (((class color) (background light)) - (:inherit newsticker-treeview-face :foreground "blue" :italic t))) + '((default :inherit newsticker-treeview-face :slant italic) + (((class color) (background dark)) :foreground "orange") + (((class color) (background light)) :foreground "blue")) "Face for newsticker tree." :group 'newsticker-treeview) (defface newsticker-treeview-obsolete-face - '((((class color) (background dark)) - (:inherit newsticker-treeview-face :strike-through t)) - (((class color) (background light)) - (:inherit newsticker-treeview-face :strike-through t))) + '((t :inherit newsticker-treeview-face :strike-through t)) "Face for newsticker tree." :group 'newsticker-treeview) (defface newsticker-treeview-selection-face - '((((class color) (background dark)) - (:background "#bbbbff")) - (((class color) (background light)) - (:background "#bbbbff"))) + '((((class color) (background dark)) :background "#bbbbff") + (((class color) (background light)) :background "#bbbbff")) "Face for newsticker selection." :group 'newsticker-treeview) === modified file 'lisp/net/rcirc.el' --- lisp/net/rcirc.el 2012-06-02 10:56:09 +0000 +++ lisp/net/rcirc.el 2012-06-08 16:39:49 +0000 @@ -2886,67 +2886,65 @@ :group 'faces) (defface rcirc-my-nick ; font-lock-function-name-face - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :weight bold)) - (t (:inverse-video t :weight bold))) - "The face used to highlight my messages." + '((((class color) (min-colors 88) (background light)) :foreground "Blue1") + (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue") + (((class color) (min-colors 16) (background light)) :foreground "Blue") + (((class color) (min-colors 16) (background dark)) :foreground "LightSkyBlue") + (((class color) (min-colors 8)) :foreground "blue" :weight bold) + (t :inverse-video t :weight bold)) + "Rcirc face for my messages." :group 'rcirc-faces) (defface rcirc-other-nick ; font-lock-variable-name-face '((((class grayscale) (background light)) - (:foreground "Gray90" :weight bold :slant italic)) + :foreground "Gray90" :weight bold :slant italic) (((class grayscale) (background dark)) - (:foreground "DimGray" :weight bold :slant italic)) - (((class color) (min-colors 88) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8)) (:foreground "yellow" :weight light)) - (t (:weight bold :slant italic))) - "The face used to highlight other messages." + :foreground "DimGray" :weight bold :slant italic) + (((class color) (min-colors 88) (background light)) :foreground "DarkGoldenrod") + (((class color) (min-colors 88) (background dark)) :foreground "LightGoldenrod") + (((class color) (min-colors 16) (background light)) :foreground "DarkGoldenrod") + (((class color) (min-colors 16) (background dark)) :foreground "LightGoldenrod") + (((class color) (min-colors 8)) :foreground "yellow" :weight light) + (t :weight bold :slant italic)) + "Rcirc face for other users' messages." :group 'rcirc-faces) (defface rcirc-bright-nick '((((class grayscale) (background light)) - (:foreground "LightGray" :weight bold :underline t)) + :foreground "LightGray" :weight bold :underline t) (((class grayscale) (background dark)) - (:foreground "Gray50" :weight bold :underline t)) - (((class color) (min-colors 88) (background light)) (:foreground "CadetBlue")) - (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine")) - (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) - (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) - (((class color) (min-colors 8)) (:foreground "magenta")) - (t (:weight bold :underline t))) - "Face used for nicks matched by `rcirc-bright-nicks'." + :foreground "Gray50" :weight bold :underline t) + (((class color) (min-colors 88) (background light)) :foreground "CadetBlue") + (((class color) (min-colors 88) (background dark)) :foreground "Aquamarine") + (((class color) (min-colors 16) (background light)) :foreground "CadetBlue") + (((class color) (min-colors 16) (background dark)) :foreground "Aquamarine") + (((class color) (min-colors 8)) :foreground "magenta") + (t :weight bold :underline t)) + "Rcirc face for nicks matched by `rcirc-bright-nicks'." :group 'rcirc-faces) (defface rcirc-dim-nick '((t :inherit default)) - "Face used for nicks in `rcirc-dim-nicks'." + "Rcirc face for nicks in `rcirc-dim-nicks'." :group 'rcirc-faces) (defface rcirc-server ; font-lock-comment-face '((((class grayscale) (background light)) - (:foreground "DimGray" :weight bold :slant italic)) + :foreground "DimGray" :weight bold :slant italic) (((class grayscale) (background dark)) - (:foreground "LightGray" :weight bold :slant italic)) + :foreground "LightGray" :weight bold :slant italic) (((class color) (min-colors 88) (background light)) - (:foreground "Firebrick")) + :foreground "Firebrick") (((class color) (min-colors 88) (background dark)) - (:foreground "chocolate1")) + :foreground "chocolate1") (((class color) (min-colors 16) (background light)) - (:foreground "red")) + :foreground "red") (((class color) (min-colors 16) (background dark)) - (:foreground "red1")) - (((class color) (min-colors 8) (background light)) - ) - (((class color) (min-colors 8) (background dark)) - ) - (t (:weight bold :slant italic))) - "The face used to highlight server messages." + :foreground "red1") + (((class color) (min-colors 8) (background light))) + (((class color) (min-colors 8) (background dark))) + (t :weight bold :slant italic)) + "Rcirc face for server messages." :group 'rcirc-faces) (defface rcirc-server-prefix ; font-lock-comment-delimiter-face @@ -2957,57 +2955,53 @@ :foreground "red") (((class color) (min-colors 8) (background dark)) :foreground "red1")) - "The face used to highlight server prefixes." + "Rcirc face for server prefixes." :group 'rcirc-faces) (defface rcirc-timestamp - '((t (:inherit default))) - "The face used to highlight timestamps." + '((t :inherit default)) + "Rcirc face for timestamps." :group 'rcirc-faces) (defface rcirc-nick-in-message ; font-lock-keyword-face - '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold)) - (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold)) - (((class color) (min-colors 88) (background light)) (:foreground "Purple")) - (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) - (((class color) (min-colors 16) (background light)) (:foreground "Purple")) - (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) - (((class color) (min-colors 8)) (:foreground "cyan" :weight bold)) - (t (:weight bold))) - "The face used to highlight instances of your nick within messages." + '((((class grayscale) (background light)) :foreground "LightGray" :weight bold) + (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) + (((class color) (min-colors 88) (background light)) :foreground "Purple") + (((class color) (min-colors 88) (background dark)) :foreground "Cyan1") + (((class color) (min-colors 16) (background light)) :foreground "Purple") + (((class color) (min-colors 16) (background dark)) :foreground "Cyan") + (((class color) (min-colors 8)) :foreground "cyan" :weight bold) + (t :weight bold)) + "Rcirc face for instances of your nick within messages." :group 'rcirc-faces) -(defface rcirc-nick-in-message-full-line - '((t (:bold t))) - "The face used emphasize the entire message when your nick is mentioned." +(defface rcirc-nick-in-message-full-line '((t :weight bold)) + "Rcirc face for emphasizing the entire message when your nick is mentioned." :group 'rcirc-faces) (defface rcirc-prompt ; comint-highlight-prompt - '((((min-colors 88) (background dark)) (:foreground "cyan1")) - (((background dark)) (:foreground "cyan")) - (t (:foreground "dark blue"))) - "The face used to highlight prompts." + '((((min-colors 88) (background dark)) :foreground "cyan1") + (((background dark)) :foreground "cyan") + (t :foreground "dark blue")) + "Rcirc face for prompts." :group 'rcirc-faces) (defface rcirc-track-nick - '((((type tty)) (:inherit default)) - (t (:inverse-video t))) - "The face used in the mode-line when your nick is mentioned." - :group 'rcirc-faces) - -(defface rcirc-track-keyword - '((t (:bold t ))) - "The face used in the mode-line when keywords are mentioned." - :group 'rcirc-faces) - -(defface rcirc-url - '((t (:bold t))) - "The face used to highlight urls." - :group 'rcirc-faces) - -(defface rcirc-keyword - '((t (:inherit highlight))) - "The face used to highlight keywords." + '((((type tty)) :inherit default) + (t :inverse-video t)) + "Rcirc face used in the mode-line when your nick is mentioned." + :group 'rcirc-faces) + +(defface rcirc-track-keyword '((t :weight bold)) + "Rcirc face used in the mode-line when keywords are mentioned." + :group 'rcirc-faces) + +(defface rcirc-url '((t :weight bold)) + "Rcirc face used to highlight urls." + :group 'rcirc-faces) + +(defface rcirc-keyword '((t :inherit highlight)) + "Rcirc face used to highlight keywords." :group 'rcirc-faces) === modified file 'lisp/nxml/nxml-outln.el' --- lisp/nxml/nxml-outln.el 2012-01-19 07:21:25 +0000 +++ lisp/nxml/nxml-outln.el 2012-06-08 16:39:49 +0000 @@ -109,23 +109,20 @@ :group 'nxml :type 'integer) -(defface nxml-heading - '((t (:weight bold))) - "Face used for the contents of abbreviated heading elements." +(defface nxml-heading '((t :weight bold)) + "Face for the contents of abbreviated heading elements." :group 'nxml-faces) -(defface nxml-outline-indicator - '((t (:inherit default))) - "Face used for `+' or `-' before element names in outlines." +(defface nxml-outline-indicator '((t)) + "Face for `+' or `-' before element names in outlines." :group 'nxml-faces) (defface nxml-outline-active-indicator - '((t (:box t :inherit nxml-outline-indicator))) - "Face used for clickable `+' or `-' before element names in outlines." + '((t :box t :inherit nxml-outline-indicator)) + "Face for clickable `+' or `-' before element names in outlines." :group 'nxml-faces) -(defface nxml-outline-ellipsis - '((t (:bold t :inherit default))) +(defface nxml-outline-ellipsis '((t :weight bold)) "Face used for `...' in outlines." :group 'nxml-faces) === modified file 'lisp/play/mpuz.el' --- lisp/play/mpuz.el 2012-01-19 07:21:25 +0000 +++ lisp/play/mpuz.el 2012-06-08 16:39:49 +0000 @@ -56,26 +56,26 @@ :group 'mpuz) (defface mpuz-unsolved - '((((class color)) (:foreground "red1" :bold t)) - (t (:bold t))) - "Face to use for letters to be solved." + '((default :weight bold) + (((class color)) :foreground "red1")) + "Face for letters to be solved." :group 'mpuz) (defface mpuz-solved - '((((class color)) (:foreground "green1" :bold t)) - (t (:bold t))) - "Face to use for solved digits." + '((default :weight bold) + (((class color)) :foreground "green1")) + "Face for solved digits." :group 'mpuz) (defface mpuz-trivial - '((((class color)) (:foreground "blue" :bold t)) - (t (:bold t))) - "Face to use for trivial digits solved for you." + '((default :weight bold) + (((class color)) :foreground "blue")) + "Face for trivial digits solved for you." :group 'mpuz) (defface mpuz-text - '((t (:inherit variable-pitch))) - "Face to use for text on right." + '((t :inherit variable-pitch)) + "Face for text on right." :group 'mpuz) === modified file 'lisp/progmodes/ebrowse.el' --- lisp/progmodes/ebrowse.el 2012-04-09 13:05:48 +0000 +++ lisp/progmodes/ebrowse.el 2012-06-08 16:39:49 +0000 @@ -48,7 +48,6 @@ "Settings for the C++ class browser." :group 'tools) - (defcustom ebrowse-search-path nil "List of directories to search for source files in a class tree. Elements should be directory names; nil as an element means to try @@ -154,61 +153,42 @@ "Faces used by Ebrowse." :group 'ebrowse) - (defface ebrowse-tree-mark - '((((min-colors 88)) (:foreground "red1")) - (t (:foreground "red"))) - "The face used for the mark character in the tree." + '((((min-colors 88)) :foreground "red1") + (t :foreground "red")) + "Face for the mark character in the Ebrowse tree." :group 'ebrowse-faces) -(define-obsolete-face-alias 'ebrowse-tree-mark-face 'ebrowse-tree-mark "22.1") - (defface ebrowse-root-class - '((((min-colors 88)) (:weight bold :foreground "blue1")) - (t (:weight bold :foreground "blue"))) - "The face used for root classes in the tree." - :group 'ebrowse-faces) -(define-obsolete-face-alias 'ebrowse-root-class-face 'ebrowse-root-class "22.1") - - -(defface ebrowse-file-name - '((t (:italic t))) - "The face for filenames displayed in the tree." - :group 'ebrowse-faces) -(define-obsolete-face-alias 'ebrowse-file-name-face 'ebrowse-file-name "22.1") - - -(defface ebrowse-default - '((t nil)) - "Face for everything else in the tree not having other faces." - :group 'ebrowse-faces) -(define-obsolete-face-alias 'ebrowse-default-face 'ebrowse-default "22.1") - + '((((min-colors 88)) :weight bold :foreground "blue1") + (t :weight bold :foreground "blue")) + "Face for root classes in the Ebrowse tree." + :group 'ebrowse-faces) + +(defface ebrowse-file-name '((t :slant italic)) + "Face for filenames in the Ebrowse tree." + :group 'ebrowse-faces) + +(defface ebrowse-default '((t)) + "Face for items in the Ebrowse tree which do not have other faces." + :group 'ebrowse-faces) (defface ebrowse-member-attribute - '((((min-colors 88)) (:foreground "red1")) - (t (:foreground "red"))) - "Face used to display member attributes." + '((((min-colors 88)) :foreground "red1") + (t :foreground "red")) + "Face for member attributes." :group 'ebrowse-faces) -(define-obsolete-face-alias 'ebrowse-member-attribute-face - 'ebrowse-member-attribute "22.1") - (defface ebrowse-member-class - '((t (:foreground "purple"))) + '((t :foreground "purple")) "Face used to display the class title in member buffers." :group 'ebrowse-faces) -(define-obsolete-face-alias 'ebrowse-member-class-face - 'ebrowse-member-class "22.1") - (defface ebrowse-progress - '((((min-colors 88)) (:background "blue1")) - (t (:background "blue"))) + '((((min-colors 88)) :background "blue1") + (t :background "blue")) "Face for progress indicator." :group 'ebrowse-faces) -(define-obsolete-face-alias 'ebrowse-progress-face 'ebrowse-progress "22.1") - ;;; Utilities. === modified file 'lisp/progmodes/flymake.el' --- lisp/progmodes/flymake.el 2012-04-22 13:58:00 +0000 +++ lisp/progmodes/flymake.el 2012-06-08 16:39:49 +0000 @@ -796,16 +796,12 @@ has-flymake-overlays)) (defface flymake-errline - '((((class color) (background dark)) (:background "Firebrick4")) - (((class color) (background light)) (:background "LightPink")) - (t (:bold t))) + '((t :inherit error)) "Face used for marking error lines." :group 'flymake) (defface flymake-warnline - '((((class color) (background dark)) (:background "DarkBlue")) - (((class color) (background light)) (:background "LightBlue2")) - (t (:bold t))) + '((t :inherit warning)) "Face used for marking warning lines." :group 'flymake) === modified file 'lisp/progmodes/vera-mode.el' --- lisp/progmodes/vera-mode.el 2012-04-09 13:05:48 +0000 +++ lisp/progmodes/vera-mode.el 2012-06-08 16:39:49 +0000 @@ -670,23 +670,23 @@ "Face name to use for interface names.") (defface vera-font-lock-number - '((((class color) (background light)) (:foreground "Gold4")) - (((class color) (background dark)) (:foreground "BurlyWood1")) - (t (:italic t :bold t))) + '((((class color) (background light)) :foreground "Gold4") + (((class color) (background dark)) :foreground "BurlyWood1") + (t :slant italic :weight bold)) "Font lock mode face used to highlight @ definitions." :group 'font-lock-highlighting-faces) (defface vera-font-lock-function - '((((class color) (background light)) (:foreground "DarkCyan")) - (((class color) (background dark)) (:foreground "Orchid1")) - (t (:italic t :bold t))) + '((((class color) (background light)) :foreground "DarkCyan") + (((class color) (background dark)) :foreground "Orchid1") + (t :slant italic :weight bold)) "Font lock mode face used to highlight predefined functions and tasks." :group 'font-lock-highlighting-faces) (defface vera-font-lock-interface - '((((class color) (background light)) (:foreground "Grey40")) - (((class color) (background dark)) (:foreground "Grey80")) - (t (:italic t :bold t))) + '((((class color) (background light)) :foreground "Grey40") + (((class color) (background dark)) :foreground "Grey80") + (t :slant italic :weight bold)) "Font lock mode face used to highlight interface names." :group 'font-lock-highlighting-faces) === modified file 'lisp/speedbar.el' --- lisp/speedbar.el 2012-05-13 03:05:06 +0000 +++ lisp/speedbar.el 2012-06-08 16:39:49 +0000 @@ -4005,73 +4005,68 @@ ;;; Color loading section. ;; (defface speedbar-button-face '((((class color) (background light)) - (:foreground "green4")) + :foreground "green4") (((class color) (background dark)) - (:foreground "green3"))) - "Face used for +/- buttons." + :foreground "green3")) + "Speedbar face for +/- buttons." :group 'speedbar-faces) (defface speedbar-file-face '((((class color) (background light)) - (:foreground "cyan4")) + :foreground "cyan4") (((class color) (background dark)) - (:foreground "cyan")) - (t (:bold t))) - "Face used for file names." + :foreground "cyan") + (t :weight bold)) + "Speedbar face for file names." :group 'speedbar-faces) (defface speedbar-directory-face '((((class color) (background light)) - (:foreground "blue4")) + :foreground "blue4") (((class color) (background dark)) - (:foreground "light blue"))) - "Face used for directory names." + :foreground "light blue")) + "Speedbar face for directory names." :group 'speedbar-faces) + (defface speedbar-tag-face '((((class color) (background light)) - (:foreground "brown")) + :foreground "brown") (((class color) (background dark)) - (:foreground "yellow"))) - "Face used for displaying tags." + :foreground "yellow")) + "Speedbar face for tags." :group 'speedbar-faces) (defface speedbar-selected-face '((((class color) (background light)) - (:foreground "red" :underline t)) + :foreground "red" :underline t) (((class color) (background dark)) - (:foreground "red" :underline t)) - (t (:underline t))) - "Face used to underline the file in the active window." + :foreground "red" :underline t) + (t :underline t)) + "Speedbar face for the file in the active window." :group 'speedbar-faces) (defface speedbar-highlight-face '((((class color) (background light)) - (:background "green")) + :background "green") (((class color) (background dark)) - (:background "sea green")) - (((class grayscale monochrome) - (background light)) - (:background "black")) - (((class grayscale monochrome) - (background dark)) - (:background "white"))) - "Face used for highlighting buttons with the mouse." + :background "sea green")) + "Speedbar face for highlighting buttons with the mouse." :group 'speedbar-faces) (defface speedbar-separator-face '((((class color) (background light)) - (:background "blue" - :foreground "white" - :overline "gray")) + :background "blue" + :foreground "white" + :overline "gray") (((class color) (background dark)) - (:background "blue" - :foreground "white" - :overline "gray")) + :background "blue" + :foreground "white" + :overline "gray") (((class grayscale monochrome) (background light)) - (:background "black" - :foreground "white" - :overline "white")) + :background "black" + :foreground "white" + :overline "white") (((class grayscale monochrome) (background dark)) - (:background "white" - :foreground "black" - :overline "black"))) - "Face used for separator labels in a display." + :background "white" + :foreground "black" + :overline "black")) + "Speedbar face for separator labels in a display." :group 'speedbar-faces) ;; some edebug hooks === modified file 'lisp/textmodes/flyspell.el' --- lisp/textmodes/flyspell.el 2012-06-02 10:56:09 +0000 +++ lisp/textmodes/flyspell.el 2012-06-08 16:39:49 +0000 @@ -445,24 +445,14 @@ ;;*---------------------------------------------------------------------*/ ;;* Highlighting */ ;;*---------------------------------------------------------------------*/ -(defface flyspell-incorrect - '((((class color)) (:foreground "OrangeRed" :bold t :underline t)) - (t (:bold t))) - "Face used for marking a misspelled word in Flyspell." +(defface flyspell-incorrect '((t :underline t :inherit error)) + "Flyspell face for misspelled words." :group 'flyspell) -(if (featurep 'emacs) - (define-obsolete-face-alias 'flyspell-incorrect-face 'flyspell-incorrect "22.1") - (put 'flyspell-incorrect-face 'face-alias 'flyspell-incorrect)) -(defface flyspell-duplicate - '((((class color)) (:foreground "Gold3" :bold t :underline t)) - (t (:bold t))) - "Face used for marking a misspelled word that appears twice in the buffer. +(defface flyspell-duplicate '((t :underline t :inherit warning)) + "Flyspell face for words that appear twice in a row. See also `flyspell-duplicate-distance'." :group 'flyspell) -(if (featurep 'emacs) - (define-obsolete-face-alias 'flyspell-duplicate-face 'flyspell-duplicate "22.1") - (put 'flyspell-duplicate-face 'face-alias 'flyspell-duplicate)) (defvar flyspell-overlay nil) === modified file 'lisp/textmodes/table.el' --- lisp/textmodes/table.el 2012-04-09 13:05:48 +0000 +++ lisp/textmodes/table.el 2012-06-08 16:39:49 +0000 @@ -678,11 +678,9 @@ :group 'table) (defface table-cell - '((((min-colors 88) (class color)) - (:foreground "gray90" :background "blue1")) - (((class color)) - (:foreground "gray90" :background "blue")) - (t (:bold t))) + '((((min-colors 88) (class color)) :foreground "gray90" :background "blue1") + (((class color)) :foreground "gray90" :background "blue") + (t :weight bold)) "Face used for table cell contents." :tag "Cell Face" :group 'table) === modified file 'lisp/whitespace.el' --- lisp/whitespace.el 2012-06-02 10:56:09 +0000 +++ lisp/whitespace.el 2012-06-08 16:39:49 +0000 @@ -565,10 +565,10 @@ (defface whitespace-space '((((class color) (background dark)) - (:background "grey20" :foreground "darkgray")) + :background "grey20" :foreground "darkgray") (((class color) (background light)) - (:background "LightYellow" :foreground "lightgray")) - (t (:inverse-video t))) + :background "LightYellow" :foreground "lightgray") + (t :inverse-video t)) "Face used to visualize SPACE." :group 'whitespace) @@ -583,10 +583,10 @@ (defface whitespace-hspace ; 'nobreak-space '((((class color) (background dark)) - (:background "grey24" :foreground "darkgray")) + :background "grey24" :foreground "darkgray") (((class color) (background light)) - (:background "LemonChiffon3" :foreground "lightgray")) - (t (:inverse-video t))) + :background "LemonChiffon3" :foreground "lightgray") + (t :inverse-video t)) "Face used to visualize HARD SPACE." :group 'whitespace) @@ -601,10 +601,10 @@ (defface whitespace-tab '((((class color) (background dark)) - (:background "grey22" :foreground "darkgray")) + :background "grey22" :foreground "darkgray") (((class color) (background light)) - (:background "beige" :foreground "lightgray")) - (t (:inverse-video t))) + :background "beige" :foreground "lightgray") + (t :inverse-video t)) "Face used to visualize TAB." :group 'whitespace) @@ -621,15 +621,13 @@ (defface whitespace-newline - '((((class color) (background dark)) - (:foreground "darkgray" :bold nil)) - (((class color) (min-colors 88) (background light)) - (:foreground "lightgray" :bold nil)) + '((default :weight normal) + (((class color) (background dark)) :foreground "darkgray") + (((class color) (min-colors 88) (background light)) :foreground "lightgray") ;; Displays with 16 colors use lightgray as background, so using a ;; lightgray foreground makes the newline mark invisible. - (((class color) (background light)) - (:foreground "brown" :bold nil)) - (t (:underline t :bold nil))) + (((class color) (background light)) :foreground "brown") + (t :underline t)) "Face used to visualize NEWLINE char mapping. See `whitespace-display-mappings'." @@ -645,8 +643,9 @@ (defface whitespace-trailing ; 'trailing-whitespace - '((((class mono)) (:inverse-video t :bold t :underline t)) - (t (:background "red1" :foreground "yellow" :bold t))) + '((default :weight bold) + (((class mono)) :inverse-video t :underline t) + (t :background "red1" :foreground "yellow")) "Face used to visualize trailing blanks." :group 'whitespace) @@ -662,8 +661,8 @@ (defface whitespace-line - '((((class mono)) (:inverse-video t :bold t :underline t)) - (t (:background "gray20" :foreground "violet"))) + '((((class mono)) :inverse-video t :weight bold :underline t) + (t :background "gray20" :foreground "violet")) "Face used to visualize \"long\" lines. See `whitespace-line-column'." @@ -679,8 +678,8 @@ (defface whitespace-space-before-tab - '((((class mono)) (:inverse-video t :bold t :underline t)) - (t (:background "DarkOrange" :foreground "firebrick"))) + '((((class mono)) :inverse-video t :weight bold :underline t) + (t :background "DarkOrange" :foreground "firebrick")) "Face used to visualize SPACEs before TAB." :group 'whitespace) @@ -694,8 +693,8 @@ (defface whitespace-indentation - '((((class mono)) (:inverse-video t :bold t :underline t)) - (t (:background "yellow" :foreground "firebrick"))) + '((((class mono)) :inverse-video t :weight bold :underline t) + (t :background "yellow" :foreground "firebrick")) "Face used to visualize 8 or more SPACEs at beginning of line." :group 'whitespace) @@ -709,8 +708,8 @@ (defface whitespace-empty - '((((class mono)) (:inverse-video t :bold t :underline t)) - (t (:background "yellow" :foreground "firebrick"))) + '((((class mono)) :inverse-video t :weight bold :underline t) + (t :background "yellow" :foreground "firebrick")) "Face used to visualize empty lines at beginning and/or end of buffer." :group 'whitespace) @@ -724,8 +723,8 @@ (defface whitespace-space-after-tab - '((((class mono)) (:inverse-video t :bold t :underline t)) - (t (:background "yellow" :foreground "firebrick"))) + '((((class mono)) :inverse-video t :weight bold :underline t) + (t :background "yellow" :foreground "firebrick")) "Face used to visualize 8 or more SPACEs after TAB." :group 'whitespace) ------------------------------------------------------------ revno: 108527 committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2012-06-08 16:59:28 +0300 message: Revert inadvertent commit in dispnew.c as part of revno 108521. src/dispnew.c (showing_window_margins_p): Undo last change, which was done due to an inadvertent commit. (adjust_frame_glyphs_for_frame_redisplay): Do call showing_window_margins_p. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-06-08 13:18:26 +0000 +++ src/ChangeLog 2012-06-08 13:59:28 +0000 @@ -1,3 +1,10 @@ +2012-06-08 Eli Zaretskii + + * dispnew.c (showing_window_margins_p): Undo last change, which + was done due to an inadvertent commit. + (adjust_frame_glyphs_for_frame_redisplay): Do call + showing_window_margins_p. + 2012-06-08 Stefan Monnier * eval.c (Fmake_var_non_special): New primitive. === modified file 'src/dispnew.c' --- src/dispnew.c 2012-06-08 12:19:28 +0000 +++ src/dispnew.c 2012-06-08 13:59:28 +0000 @@ -1962,7 +1962,6 @@ /* Return 1 if any window in the tree has nonzero window margins. See the hack at the end of adjust_frame_glyphs_for_frame_redisplay. */ -#if 0 static int showing_window_margins_p (struct window *w) { @@ -1986,7 +1985,6 @@ } return 0; } -#endif /* In the window tree with root W, build current matrices of leaf @@ -2175,10 +2173,7 @@ any of the windows contain margins. I haven't been able to hunt down the reason, but for the moment this prevents the problem from manifesting. -- cyd */ -#if 0 - && !showing_window_margins_p (XWINDOW (FRAME_ROOT_WINDOW (f))) -#endif - ) + && !showing_window_margins_p (XWINDOW (FRAME_ROOT_WINDOW (f)))) { struct glyph_matrix *copy = save_current_matrix (f); adjust_glyph_matrix (NULL, f->desired_matrix, 0, 0, matrix_dim); ------------------------------------------------------------ revno: 108526 committer: Michael Albinus branch nick: trunk timestamp: Fri 2012-06-08 15:27:06 +0200 message: * net/tramp-compat.el (tramp-compat-temporary-file-directory): Avoid infloop. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-08 13:18:26 +0000 +++ lisp/ChangeLog 2012-06-08 13:27:06 +0000 @@ -1,3 +1,8 @@ +2012-06-08 Michael Albinus + + * net/tramp-compat.el (tramp-compat-temporary-file-directory): + Avoid infloop. + 2012-06-08 Stefan Monnier * startup.el (argv, argi): Make lexically scoped. === modified file 'lisp/net/tramp-compat.el' --- lisp/net/tramp-compat.el 2012-06-06 13:32:36 +0000 +++ lisp/net/tramp-compat.el 2012-06-08 13:27:06 +0000 @@ -204,21 +204,23 @@ "Return name of directory for temporary files (compat function). For Emacs, this is the variable `temporary-file-directory', for XEmacs this is the function `temp-directory'." - (cond - ((and (boundp 'temporary-file-directory) - (not (file-remote-p (symbol-value 'temporary-file-directory)))) - (symbol-value 'temporary-file-directory)) - ((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory)) - ((let ((d (getenv "TEMP"))) (and d (file-directory-p d))) - (file-name-as-directory (getenv "TEMP"))) - ((let ((d (getenv "TMP"))) (and d (file-directory-p d))) - (file-name-as-directory (getenv "TMP"))) - ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d))) - (file-name-as-directory (getenv "TMPDIR"))) - ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp")) - (t (message (concat "Neither `temporary-file-directory' nor " - "`temp-directory' is defined -- using /tmp.")) - (file-name-as-directory "/tmp")))) + (let (file-name-handler-alist) + (cond + ;; We must return a local directory. If it is remote, we could + ;; run into an infloop. + ((boundp 'temporary-file-directory) + (eval (car (get 'temporary-file-directory 'standard-value)))) + ((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory)) + ((let ((d (getenv "TEMP"))) (and d (file-directory-p d))) + (file-name-as-directory (getenv "TEMP"))) + ((let ((d (getenv "TMP"))) (and d (file-directory-p d))) + (file-name-as-directory (getenv "TMP"))) + ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d))) + (file-name-as-directory (getenv "TMPDIR"))) + ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp")) + (t (message (concat "Neither `temporary-file-directory' nor " + "`temp-directory' is defined -- using /tmp.")) + (file-name-as-directory "/tmp"))))) ;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own ;; implementation with `make-temp-name', creating the temporary file ------------------------------------------------------------ revno: 108525 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2012-06-08 09:18:26 -0400 message: Clean up scoping rule of predefined single-word vars. * lisp/startup.el (argv, argi): Make lexically scoped. * lisp/emacs-lisp/float-sup.el (pi): Use internal-make-var-non-special. * lisp/emacs-lisp/cl-macs.el: Use lexical-binding. Rename cl-bind-* to cl--bind-*. * lisp/files.el: Don't require `cl' since it doesn't use it. * lisp/emacs-lisp/pcase.el, lisp/emacs-lisp/macroexp.el: Add coding cookie. * src/eval.c (Fmake_var_non_special): New primitive. (syms_of_eval): Defsubr it. * src/lread.c (syms_of_lread): Mark `values' as lexically scoped. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-08 12:24:27 +0000 +++ lisp/ChangeLog 2012-06-08 13:18:26 +0000 @@ -1,3 +1,12 @@ +2012-06-08 Stefan Monnier + + * startup.el (argv, argi): Make lexically scoped. + * emacs-lisp/float-sup.el (pi): Use internal-make-var-non-special. + * emacs-lisp/cl-macs.el: Use lexical-binding. + Rename cl-bind-* to cl--bind-*. + * files.el: Don't require `cl' since it doesn't use it. + * emacs-lisp/pcase.el, emacs-lisp/macroexp.el: Add coding cookie. + 2012-06-08 Juanma Barranquero * textmodes/texinfmt.el: Fix bug#11640 (reverts part of revno:89810). === modified file 'lisp/emacs-lisp/cl-loaddefs.el' --- lisp/emacs-lisp/cl-loaddefs.el 2012-06-08 08:44:45 +0000 +++ lisp/emacs-lisp/cl-loaddefs.el 2012-06-08 13:18:26 +0000 @@ -263,7 +263,7 @@ ;;;;;; cl-do* cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp -;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "ce1ef5c6c925f03cb425d9a46cfa6d5f") +;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "07b3d08f956d6740ea1979825c84bc01") ;;; Generated autoloads from cl-macs.el (autoload 'cl-gensym "cl-macs" "\ === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2012-06-08 02:54:35 +0000 +++ lisp/emacs-lisp/cl-macs.el 2012-06-08 13:18:26 +0000 @@ -1,4 +1,4 @@ -;;; cl-macs.el --- Common Lisp macros +;;; cl-macs.el --- Common Lisp macros --*- lexical-binding: t -*- ;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc. @@ -310,8 +310,8 @@ (defconst cl-lambda-list-keywords '(&optional &rest &key &allow-other-keys &aux &whole &body &environment)) -(defvar cl-bind-block) (defvar cl-bind-defs) (defvar cl-bind-enquote) -(defvar cl-bind-inits) (defvar cl-bind-lets) (defvar cl-bind-forms) +(defvar cl--bind-block) (defvar cl--bind-defs) (defvar cl--bind-enquote) +(defvar cl--bind-inits) (defvar cl--bind-lets) (defvar cl--bind-forms) (declare-function help-add-fundoc-usage "help-fns" (docstring arglist)) @@ -346,20 +346,20 @@ )))) arglist))) -(defun cl--transform-lambda (form cl-bind-block) +(defun cl--transform-lambda (form bind-block) (let* ((args (car form)) (body (cdr form)) (orig-args args) - (cl-bind-defs nil) (cl-bind-enquote nil) - (cl-bind-inits nil) (cl-bind-lets nil) (cl-bind-forms nil) + (cl--bind-block bind-block) (cl--bind-defs nil) (cl--bind-enquote nil) + (cl--bind-inits nil) (cl--bind-lets nil) (cl--bind-forms nil) (header nil) (simple-args nil)) (while (or (stringp (car body)) (memq (car-safe (car body)) '(interactive cl-declare))) (push (pop body) header)) (setq args (if (listp args) (cl-copy-list args) (list '&rest args))) (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) - (if (setq cl-bind-defs (cadr (memq '&cl-defs args))) - (setq args (delq '&cl-defs (delq cl-bind-defs args)) - cl-bind-defs (cadr cl-bind-defs))) - (if (setq cl-bind-enquote (memq '&cl-quote args)) + (if (setq cl--bind-defs (cadr (memq '&cl-defs args))) + (setq args (delq '&cl-defs (delq cl--bind-defs args)) + cl--bind-defs (cadr cl--bind-defs))) + (if (setq cl--bind-enquote (memq '&cl-quote args)) (setq args (delq '&cl-quote args))) (if (memq '&whole args) (error "&whole not currently implemented")) (let* ((p (memq '&environment args)) (v (cadr p)) @@ -369,20 +369,20 @@ (while (and args (symbolp (car args)) (not (memq (car args) '(nil &rest &body &key &aux))) (not (and (eq (car args) '&optional) - (or cl-bind-defs (consp (cadr args)))))) + (or cl--bind-defs (consp (cadr args)))))) (push (pop args) simple-args)) - (or (eq cl-bind-block 'cl-none) - (setq body (list `(cl-block ,cl-bind-block ,@body)))) + (or (eq cl--bind-block 'cl-none) + (setq body (list `(cl-block ,cl--bind-block ,@body)))) (if (null args) (cl-list* nil (nreverse simple-args) (nconc (nreverse header) body)) (if (memq '&optional simple-args) (push '&optional args)) (cl--do-arglist args nil (- (length simple-args) (if (memq '&optional simple-args) 1 0))) - (setq cl-bind-lets (nreverse cl-bind-lets)) - (cl-list* (and cl-bind-inits `(cl-eval-when (compile load eval) - ,@(nreverse cl-bind-inits))) + (setq cl--bind-lets (nreverse cl--bind-lets)) + (cl-list* (and cl--bind-inits `(cl-eval-when (compile load eval) + ,@(nreverse cl--bind-inits))) (nconc (nreverse simple-args) - (list '&rest (car (pop cl-bind-lets)))) + (list '&rest (car (pop cl--bind-lets)))) (nconc (let ((hdr (nreverse header))) ;; Macro expansion can take place in the middle of ;; apparently harmless computation, so it should not @@ -395,15 +395,15 @@ (cons 'fn (cl--make-usage-args orig-args)))) hdr))) - (list `(let* ,cl-bind-lets - ,@(nreverse cl-bind-forms) + (list `(let* ,cl--bind-lets + ,@(nreverse cl--bind-forms) ,@body))))))) (defun cl--do-arglist (args expr &optional num) ; uses bind-* (if (nlistp args) (if (or (memq args cl-lambda-list-keywords) (not (symbolp args))) (error "Invalid argument name: %s" args) - (push (list args expr) cl-bind-lets)) + (push (list args expr) cl--bind-lets)) (setq args (cl-copy-list args)) (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) (let ((p (memq '&body args))) (if p (setcar p '&rest))) @@ -417,9 +417,9 @@ (if (listp (cadr restarg)) (setq restarg (make-symbol "--cl-rest--")) (setq restarg (cadr restarg))) - (push (list restarg expr) cl-bind-lets) + (push (list restarg expr) cl--bind-lets) (if (eq (car args) '&whole) - (push (list (cl-pop2 args) restarg) cl-bind-lets)) + (push (list (cl-pop2 args) restarg) cl--bind-lets)) (let ((p args)) (setq minarg restarg) (while (and p (not (memq (car p) cl-lambda-list-keywords))) @@ -437,8 +437,8 @@ (if (or laterarg (= safety 0)) poparg `(if ,minarg ,poparg (signal 'wrong-number-of-arguments - (list ,(and (not (eq cl-bind-block 'cl-none)) - `',cl-bind-block) + (list ,(and (not (eq cl--bind-block 'cl-none)) + `',cl--bind-block) (length ,restarg))))))) (setq num (1+ num) laterarg t)) (while (and (eq (car args) '&optional) (pop args)) @@ -447,10 +447,10 @@ (or (consp arg) (setq arg (list arg))) (if (cddr arg) (cl--do-arglist (nth 2 arg) `(and ,restarg t))) (let ((def (if (cdr arg) (nth 1 arg) - (or (car cl-bind-defs) - (nth 1 (assq (car arg) cl-bind-defs))))) + (or (car cl--bind-defs) + (nth 1 (assq (car arg) cl--bind-defs))))) (poparg `(pop ,restarg))) - (and def cl-bind-enquote (setq def `',def)) + (and def cl--bind-enquote (setq def `',def)) (cl--do-arglist (car arg) (if def `(if ,restarg ,poparg ,def) poparg)) (setq num (1+ num)))))) @@ -461,10 +461,10 @@ (push `(if ,restarg (signal 'wrong-number-of-arguments (list - ,(and (not (eq cl-bind-block 'cl-none)) - `',cl-bind-block) + ,(and (not (eq cl--bind-block 'cl-none)) + `',cl--bind-block) (+ ,num (length ,restarg))))) - cl-bind-forms))) + cl--bind-forms))) (while (and (eq (car args) '&key) (pop args)) (while (and args (not (memq (car args) cl-lambda-list-keywords))) (let ((arg (pop args))) @@ -473,9 +473,9 @@ (intern (format ":%s" (car arg))))) (varg (if (consp (car arg)) (cl-cadar arg) (car arg))) (def (if (cdr arg) (cadr arg) - (or (car cl-bind-defs) (cadr (assq varg cl-bind-defs))))) + (or (car cl--bind-defs) (cadr (assq varg cl--bind-defs))))) (look `(memq ',karg ,restarg))) - (and def cl-bind-enquote (setq def `',def)) + (and def cl--bind-enquote (setq def `',def)) (if (cddr arg) (let* ((temp (or (nth 2 arg) (make-symbol "--cl-var--"))) (val `(car (cdr ,temp)))) @@ -509,11 +509,11 @@ ,(format "Keyword argument %%s not one of %s" keys) (car ,var))))))) - (push `(let ((,var ,restarg)) ,check) cl-bind-forms))) + (push `(let ((,var ,restarg)) ,check) cl--bind-forms))) (while (and (eq (car args) '&aux) (pop args)) (while (and args (not (memq (car args) cl-lambda-list-keywords))) (if (consp (car args)) - (if (and cl-bind-enquote (cl-cadar args)) + (if (and cl--bind-enquote (cl-cadar args)) (cl--do-arglist (caar args) `',(cadr (pop args))) (cl--do-arglist (caar args) (cadr (pop args)))) @@ -536,12 +536,12 @@ (defmacro cl-destructuring-bind (args expr &rest body) (declare (indent 2) (debug (&define cl-macro-list def-form cl-declarations def-body))) - (let* ((cl-bind-lets nil) (cl-bind-forms nil) (cl-bind-inits nil) - (cl-bind-defs nil) (cl-bind-block 'cl-none) (cl-bind-enquote nil)) + (let* ((cl--bind-lets nil) (cl--bind-forms nil) (cl--bind-inits nil) + (cl--bind-defs nil) (cl--bind-block 'cl-none) (cl--bind-enquote nil)) (cl--do-arglist (or args '(&aux)) expr) - (append '(progn) cl-bind-inits - (list `(let* ,(nreverse cl-bind-lets) - ,@(nreverse cl-bind-forms) ,@body))))) + (append '(progn) cl--bind-inits + (list `(let* ,(nreverse cl--bind-lets) + ,@(nreverse cl--bind-forms) ,@body))))) ;;; The `cl-eval-when' form. @@ -582,7 +582,7 @@ (t (eval form) form))) ;;;###autoload -(defmacro cl-load-time-value (form &optional read-only) +(defmacro cl-load-time-value (form &optional _read-only) "Like `progn', but evaluates the body at load time. The result of the body appears to the compiler as a quoted constant." (declare (debug (form &optional sexp))) @@ -734,7 +734,7 @@ (defvar cl--loop-result-var) (defvar cl--loop-steps) (defvar cl--loop-symbol-macs) ;;;###autoload -(defmacro cl-loop (&rest cl--loop-args) +(defmacro cl-loop (&rest loop-args) "The Common Lisp `cl-loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, @@ -750,9 +750,9 @@ \(fn CLAUSE...)" (declare (debug (&rest &or symbolp form))) - (if (not (memq t (mapcar 'symbolp (delq nil (delq t (cl-copy-list cl--loop-args)))))) - `(cl-block nil (while t ,@cl--loop-args)) - (let ((cl--loop-name nil) (cl--loop-bindings nil) + (if (not (memq t (mapcar 'symbolp (delq nil (delq t (cl-copy-list loop-args)))))) + `(cl-block nil (while t ,@loop-args)) + (let ((cl--loop-args loop-args) (cl--loop-name nil) (cl--loop-bindings nil) (cl--loop-body nil) (cl--loop-steps nil) (cl--loop-result nil) (cl--loop-result-explicit nil) (cl--loop-result-var nil) (cl--loop-finish-flag nil) @@ -1807,7 +1807,7 @@ (declare (debug t)) (cons 'progn body)) ;;;###autoload -(defmacro cl-the (type form) +(defmacro cl-the (_type form) (declare (indent 1) (debug (cl-type-spec form))) form) @@ -2386,8 +2386,8 @@ (declare (indent 1) (debug ((&rest (gate place &optional form)) body))) (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings))) `(let ,bindings ,@body) - (let ((lets nil) (sets nil) - (unsets nil) (rev (reverse bindings))) + (let ((lets nil) + (rev (reverse bindings))) (while rev (let* ((place (if (symbolp (caar rev)) `(symbol-value ',(caar rev)) @@ -2822,11 +2822,13 @@ ((eq (car type) 'satisfies) (list (cadr type) val)) (t (error "Bad type spec: %s" type))))) +(defvar cl--object) ;;;###autoload (defun cl-typep (object type) ; See compiler macro below. "Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier." - (eval (cl--make-type-test 'object type))) + (let ((cl--object object)) ;; Yuck!! + (eval (cl--make-type-test 'cl--object type)))) ;;;###autoload (defmacro cl-check-type (form type &optional string) === modified file 'lisp/emacs-lisp/float-sup.el' --- lisp/emacs-lisp/float-sup.el 2012-01-19 07:21:25 +0000 +++ lisp/emacs-lisp/float-sup.el 2012-06-08 13:18:26 +0000 @@ -28,13 +28,9 @@ ;; Provide an easy hook to tell if we are running with floats or not. ;; Define pi and e via math-lib calls (much less prone to killer typos). (defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...).") -(progn - ;; Simulate a defconst that doesn't declare the variable dynamically bound. - (setq-default pi float-pi) - (put 'pi 'variable-documentation - "Obsolete since Emacs-23.3. Use `float-pi' instead.") - (put 'pi 'risky-local-variable t) - (push 'pi current-load-list)) +(defconst pi float-pi + "Obsolete since Emacs-23.3. Use `float-pi' instead.") +(internal-make-var-non-special 'pi) (defconst float-e (exp 1) "The value of e (2.7182818...).") === modified file 'lisp/emacs-lisp/macroexp.el' --- lisp/emacs-lisp/macroexp.el 2012-06-08 02:54:35 +0000 +++ lisp/emacs-lisp/macroexp.el 2012-06-08 13:18:26 +0000 @@ -1,4 +1,4 @@ -;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t -*- +;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t; coding: utf-8 -*- ;; ;; Copyright (C) 2004-2012 Free Software Foundation, Inc. ;; === modified file 'lisp/emacs-lisp/pcase.el' --- lisp/emacs-lisp/pcase.el 2012-06-07 19:25:48 +0000 +++ lisp/emacs-lisp/pcase.el 2012-06-08 13:18:26 +0000 @@ -1,4 +1,4 @@ -;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t -*- +;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t; coding: utf-8 -*- ;; Copyright (C) 2010-2012 Free Software Foundation, Inc. === modified file 'lisp/files.el' --- lisp/files.el 2012-06-06 12:34:09 +0000 +++ lisp/files.el 2012-06-08 13:18:26 +0000 @@ -28,8 +28,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defvar font-lock-keywords) (defgroup backup nil === modified file 'lisp/startup.el' --- lisp/startup.el 2012-04-27 05:40:46 +0000 +++ lisp/startup.el 2012-06-08 13:18:26 +0000 @@ -101,16 +101,15 @@ "List of command-line args not yet processed.") (defvaralias 'argv 'command-line-args-left - ;; FIXME: Bad name for a dynamically bound variable. "List of command-line args not yet processed. This is a convenience alias, so that one can write \(pop argv\) inside of --eval command line arguments in order to access following arguments.") +(internal-make-var-non-special 'argv) -(with-no-warnings - ;; FIXME: Bad name for a dynamically bound variable - (defvar argi nil - "Current command-line argument.")) +(defvar argi nil + "Current command-line argument.") +(internal-make-var-non-special 'argi) (defvar command-line-functions nil ;; lrs 7/31/89 "List of functions to process unrecognized command-line arguments. === modified file 'src/ChangeLog' --- src/ChangeLog 2012-06-08 12:19:28 +0000 +++ src/ChangeLog 2012-06-08 13:18:26 +0000 @@ -1,3 +1,9 @@ +2012-06-08 Stefan Monnier + + * eval.c (Fmake_var_non_special): New primitive. + (syms_of_eval): Defsubr it. + * lread.c (syms_of_lread): Mark `values' as lexically scoped. + 2012-06-08 Juanma Barranquero * dispnew.c (showing_window_margins_p): Wrap in #if 0 to prevent unused @@ -23,7 +29,7 @@ (roundup_size): New constant. (struct vector_block): New data type. (vector_blocks, vector_free_lists, zero_vector): New variables. - (all_vectors): Renamed to `large_vectors'. + (all_vectors): Rename to `large_vectors'. (allocate_vector_from_block, init_vectors, allocate_vector_from_block) (sweep_vectors): New functions. (allocate_vectorlike): Return `zero_vector' as the only vector of === modified file 'src/eval.c' --- src/eval.c 2012-06-08 02:47:26 +0000 +++ src/eval.c 2012-06-08 13:18:26 +0000 @@ -790,6 +790,17 @@ return sym; } +/* Make SYMBOL lexically scoped. */ +DEFUN ("internal-make-var-non-special", Fmake_var_non_special, + Smake_var_non_special, 1, 1, 0, + doc: /* Internal function. */) + (Lisp_Object symbol) +{ + CHECK_SYMBOL (symbol); + XSYMBOL (symbol)->declared_special = 0; + return Qnil; +} + DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0, doc: /* Bind variables according to VARLIST then eval BODY. @@ -3582,6 +3593,7 @@ defsubr (&Sdefvar); defsubr (&Sdefvaralias); defsubr (&Sdefconst); + defsubr (&Smake_var_non_special); defsubr (&Slet); defsubr (&SletX); defsubr (&Swhile); === modified file 'src/lread.c' --- src/lread.c 2012-05-30 03:59:42 +0000 +++ src/lread.c 2012-06-08 13:18:26 +0000 @@ -4375,7 +4375,8 @@ DEFVAR_LISP ("values", Vvalues, doc: /* List of values of all expressions which were read, evaluated and printed. -Order is reverse chronological. */); + Order is reverse chronological. */); + XSYMBOL (intern ("values"))->declared_special = 0; DEFVAR_LISP ("standard-input", Vstandard_input, doc: /* Stream for read to get input from. @@ -4393,7 +4394,7 @@ The positions are relative to the last call to `read' or `read-from-string'. It is probably a bad idea to set this variable at -the toplevel; bind it instead. */); +the toplevel; bind it instead. */); Vread_with_symbol_positions = Qnil; DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list, @@ -4408,7 +4409,7 @@ Note that a symbol will appear multiple times in this list, if it was read multiple times. The list is in the same order as the symbols -were read in. */); +were read in. */); Vread_symbol_positions_list = Qnil; DEFVAR_LISP ("read-circle", Vread_circle, ------------------------------------------------------------ revno: 108524 committer: Juanma Barranquero branch nick: trunk timestamp: Fri 2012-06-08 14:24:27 +0200 message: lisp/textmodes/texinfmt.el: Fix bug#11640 (reverts part of revno:89810). (texinfo-format-printindex): Use `texinfo-sort-region' in all platforms, instead of calling external sort utility. (texinfo-sort-region, texinfo-sort-startkeyfun): Restore functions. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-08 08:44:45 +0000 +++ lisp/ChangeLog 2012-06-08 12:24:27 +0000 @@ -1,3 +1,10 @@ +2012-06-08 Juanma Barranquero + + * textmodes/texinfmt.el: Fix bug#11640 (reverts part of revno:89810). + (texinfo-format-printindex): Use `texinfo-sort-region' in all platforms, + instead of calling external sort utility. + (texinfo-sort-region, texinfo-sort-startkeyfun): Restore functions. + 2012-06-08 Eli Zaretskii * descr-text.el (describe-char): Mention how to insert the === modified file 'lisp/textmodes/texinfmt.el' --- lisp/textmodes/texinfmt.el 2012-04-09 13:05:48 +0000 +++ lisp/textmodes/texinfmt.el 2012-06-08 12:24:27 +0000 @@ -2958,6 +2958,28 @@ ("ky" . texinfo-format-kindex))) +;;; Sort and index + +;; Sort an index which is in the current buffer between START and END. +(defun texinfo-sort-region (start end) + (require 'sort) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (sort-subr nil 'forward-line 'end-of-line 'texinfo-sort-startkeyfun))) + +;; Subroutine for sorting an index. +;; At start of a line, return a string to sort the line under. +(defun texinfo-sort-startkeyfun () + (let ((line (buffer-substring-no-properties (point) (line-end-position)))) + ;; Canonicalize whitespace and eliminate funny chars. + (while (string-match "[ \t][ \t]+\\|[^a-z0-9 ]+" line) + (setq line (concat (substring line 0 (match-beginning 0)) + " " + (substring line (match-end 0))))) + line)) + + ;;; @printindex (put 'printindex 'texinfo-format 'texinfo-format-printindex) @@ -2974,7 +2996,7 @@ (insert "\n* Menu:\n\n") (setq opoint (point)) (texinfo-print-index nil indexelts) - (shell-command-on-region opoint (point) "sort -fd" 1))) + (texinfo-sort-region opoint (point)))) (defun texinfo-print-index (file indexelts) (while indexelts ------------------------------------------------------------ revno: 108523 committer: Juanma Barranquero branch nick: trunk timestamp: Fri 2012-06-08 14:19:28 +0200 message: src/dispnew.c (showing_window_margins_p): Wrap in #if 0. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-06-08 09:58:43 +0000 +++ src/ChangeLog 2012-06-08 12:19:28 +0000 @@ -1,3 +1,8 @@ +2012-06-08 Juanma Barranquero + + * dispnew.c (showing_window_margins_p): Wrap in #if 0 to prevent unused + function warning (the only call is inside #if 0 since revno:108521). + 2012-06-08 Eli Zaretskii * alloc.c (allocate_vectorlike): Fix last change. === modified file 'src/dispnew.c' --- src/dispnew.c 2012-06-08 08:44:45 +0000 +++ src/dispnew.c 2012-06-08 12:19:28 +0000 @@ -1962,6 +1962,7 @@ /* Return 1 if any window in the tree has nonzero window margins. See the hack at the end of adjust_frame_glyphs_for_frame_redisplay. */ +#if 0 static int showing_window_margins_p (struct window *w) { @@ -1985,6 +1986,7 @@ } return 0; } +#endif /* In the window tree with root W, build current matrices of leaf ------------------------------------------------------------ revno: 108522 committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2012-06-08 12:58:43 +0300 message: Fix BLOCK_INPUT/UNBLOCK_INPUT mismatch in revision 108520. src/alloc.c (allocate_vectorlike): Fix last change. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-06-08 08:44:30 +0000 +++ src/ChangeLog 2012-06-08 09:58:43 +0000 @@ -1,3 +1,7 @@ +2012-06-08 Eli Zaretskii + + * alloc.c (allocate_vectorlike): Fix last change. + 2012-06-08 Dmitry Antipov Block-based vector allocation of small vectors. === modified file 'src/alloc.c' --- src/alloc.c 2012-06-08 08:44:30 +0000 +++ src/alloc.c 2012-06-08 09:58:43 +0000 @@ -3254,7 +3254,10 @@ /* eassert (!handling_signal); */ if (len == 0) - return zero_vector; + { + MALLOC_UNBLOCK_INPUT; + return zero_vector; + } nbytes = header_size + len * word_size; ------------------------------------------------------------ revno: 108521 committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2012-06-08 11:44:45 +0300 message: Mention in "C-u C-x =" display how to insert the character w/o input methods. lisp/descr-text.el (describe-char): Mention how to insert the character, if the current input method doesn't support it. See the discussion in this thread for the details: http://lists.gnu.org/archive/html/emacs-devel/2012-05/msg00533.html. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-08 04:23:26 +0000 +++ lisp/ChangeLog 2012-06-08 08:44:45 +0000 @@ -1,3 +1,10 @@ +2012-06-08 Eli Zaretskii + + * descr-text.el (describe-char): Mention how to insert the + character, if the current input method doesn't support it. + See the discussion in this thread for the details: + http://lists.gnu.org/archive/html/emacs-devel/2012-05/msg00533.html. + 2012-06-08 Sam Steingold * bindings.el (global-map): Bind XF86Forward to next-buffer and === modified file 'lisp/descr-text.el' --- lisp/descr-text.el 2012-04-19 16:50:07 +0000 +++ lisp/descr-text.el 2012-06-08 08:44:45 +0000 @@ -597,7 +597,10 @@ `(insert-text-button ,current-input-method 'type 'help-input-method - 'help-args '(,current-input-method))))))) + 'help-args '(,current-input-method)) + "input method") + (list + "type \"C-x 8 RET HEX-CODEPOINT\" or \"C-x 8 RET NAME\""))))) ("buffer code" ,(if multibyte-p (encoded-string-description === modified file 'lisp/emacs-lisp/cl-loaddefs.el' --- lisp/emacs-lisp/cl-loaddefs.el 2012-06-08 02:54:35 +0000 +++ lisp/emacs-lisp/cl-loaddefs.el 2012-06-08 08:44:45 +0000 @@ -263,7 +263,7 @@ ;;;;;; cl-do* cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp -;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "4c0f605e3c7454488cc9d498b611f422") +;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "ce1ef5c6c925f03cb425d9a46cfa6d5f") ;;; Generated autoloads from cl-macs.el (autoload 'cl-gensym "cl-macs" "\ === modified file 'src/dispnew.c' --- src/dispnew.c 2012-05-30 19:23:37 +0000 +++ src/dispnew.c 2012-06-08 08:44:45 +0000 @@ -2173,7 +2173,10 @@ any of the windows contain margins. I haven't been able to hunt down the reason, but for the moment this prevents the problem from manifesting. -- cyd */ - && !showing_window_margins_p (XWINDOW (FRAME_ROOT_WINDOW (f)))) +#if 0 + && !showing_window_margins_p (XWINDOW (FRAME_ROOT_WINDOW (f))) +#endif + ) { struct glyph_matrix *copy = save_current_matrix (f); adjust_glyph_matrix (NULL, f->desired_matrix, 0, 0, matrix_dim); ------------------------------------------------------------ revno: 108520 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2012-06-08 12:44:30 +0400 message: Block-based vector allocation of small vectors. * src/lisp.h (struct vectorlike_header): New field `nbytes', adjust comment accordingly. * src/alloc.c (enum mem_type): New type `MEM_TYPE_VECTOR_BLOCK' to denote vector blocks. Adjust users (live_vector_p, mark_maybe_pointer, valid_lisp_object_p) accordingly. (COMMON_MULTIPLE): Move outside #if USE_LSB_TAG. (VECTOR_BLOCK_SIZE, vroundup, VECTOR_BLOCK_BYTES), (VBLOCK_BYTES_MIN, VBLOCK_BYTES_MAX, VECTOR_MAX_FREE_LIST_INDEX), (VECTOR_FREE_LIST_FLAG, ADVANCE, VINDEX, SETUP_ON_FREE_LIST), (VECTOR_SIZE, VECTOR_IN_BLOCK): New macros. (roundup_size): New constant. (struct vector_block): New data type. (vector_blocks, vector_free_lists, zero_vector): New variables. (all_vectors): Renamed to `large_vectors'. (allocate_vector_from_block, init_vectors, allocate_vector_from_block) (sweep_vectors): New functions. (allocate_vectorlike): Return `zero_vector' as the only vector of 0 items. Allocate new vector from block if vector size is less than or equal to VBLOCK_BYTES_MAX. (Fgarbage_collect): Move all vector sweeping code to sweep_vectors. (init_alloc_once): Add call to init_vectors. * doc/lispref/internals.text (Garbage Collection): Document new vector management code and vectorlike_header structure. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-06-03 09:03:23 +0000 +++ doc/lispref/ChangeLog 2012-06-08 08:44:30 +0000 @@ -1,3 +1,8 @@ +2012-06-08 Dmitry Antipov + + * internals.text (Garbage Collection): Document new + vector management code and vectorlike_header structure. + 2012-06-03 Chong Yidong * modes.texi (Mode Line Data): Use "mode line construct" === modified file 'doc/lispref/internals.texi' --- doc/lispref/internals.texi 2012-05-27 01:34:14 +0000 +++ doc/lispref/internals.texi 2012-06-08 08:44:30 +0000 @@ -215,10 +215,23 @@ (such as by loading a library), that data is placed in normal storage. If normal storage runs low, then Emacs asks the operating system to allocate more memory. Different types of Lisp objects, such as -symbols, cons cells, markers, etc., are segregated in distinct blocks -in memory. (Vectors, long strings, buffers and certain other editing -types, which are fairly large, are allocated in individual blocks, one -per object, while small strings are packed into blocks of 8k bytes.) +symbols, cons cells, small vectors, markers, etc., are segregated in +distinct blocks in memory. (Large vectors, long strings, buffers and +certain other editing types, which are fairly large, are allocated in +individual blocks, one per object; small strings are packed into blocks +of 8k bytes, and small vectors are packed into blocks of 4k bytes). + +@cindex vector-like objects, storage +@cindex storage of vector-like Lisp objects + Beyond the basic vector, a lot of objects like window, buffer, and +frame are managed as if they were vectors. The corresponding C data +structures include the @code{struct vectorlike_header} field whose +@code{next} field points to the next object in the chain: +@code{header.next.buffer} points to the next buffer (which could be +a killed buffer), and @code{header.next.vector} points to the next +vector in a free list. If a vector is small (smaller than or equal to +@code{VBLOCK_BYTES_MIN} bytes, see @file{alloc.c}), then +@code{header.next.nbytes} contains the vector size in bytes. @cindex garbage collection It is quite common to use some storage for a while, then release it @@ -243,8 +256,12 @@ The sweep phase puts unused cons cells onto a @dfn{free list} for future allocation; likewise for symbols and markers. It compacts the accessible strings so they occupy fewer 8k blocks; then it frees the -other 8k blocks. Vectors, buffers, windows, and other large objects are -individually allocated and freed using @code{malloc} and @code{free}. +other 8k blocks. Unreachable vectors from vector blocks are coalesced +to create largest possible free areas; if a free area spans a complete +4k block, that block is freed. Otherwise, the free area is recorded +in a free list array, where each entry corresponds to a free list +of areas of the same size. Large vectors, buffers, and other large +objects are allocated and freed individually. @cindex CL note---allocate more storage @quotation === modified file 'src/ChangeLog' --- src/ChangeLog 2012-06-08 02:47:26 +0000 +++ src/ChangeLog 2012-06-08 08:44:30 +0000 @@ -1,3 +1,28 @@ +2012-06-08 Dmitry Antipov + + Block-based vector allocation of small vectors. + * lisp.h (struct vectorlike_header): New field `nbytes', + adjust comment accordingly. + * alloc.c (enum mem_type): New type `MEM_TYPE_VECTOR_BLOCK' + to denote vector blocks. Adjust users (live_vector_p, + mark_maybe_pointer, valid_lisp_object_p) accordingly. + (COMMON_MULTIPLE): Move outside #if USE_LSB_TAG. + (VECTOR_BLOCK_SIZE, vroundup, VECTOR_BLOCK_BYTES), + (VBLOCK_BYTES_MIN, VBLOCK_BYTES_MAX, VECTOR_MAX_FREE_LIST_INDEX), + (VECTOR_FREE_LIST_FLAG, ADVANCE, VINDEX, SETUP_ON_FREE_LIST), + (VECTOR_SIZE, VECTOR_IN_BLOCK): New macros. + (roundup_size): New constant. + (struct vector_block): New data type. + (vector_blocks, vector_free_lists, zero_vector): New variables. + (all_vectors): Renamed to `large_vectors'. + (allocate_vector_from_block, init_vectors, allocate_vector_from_block) + (sweep_vectors): New functions. + (allocate_vectorlike): Return `zero_vector' as the only vector of + 0 items. Allocate new vector from block if vector size is less than + or equal to VBLOCK_BYTES_MAX. + (Fgarbage_collect): Move all vector sweeping code to sweep_vectors. + (init_alloc_once): Add call to init_vectors. + 2012-06-08 Stefan Monnier * eval.c (Fmacroexpand): Stop if the macro returns the same form. === modified file 'src/alloc.c' --- src/alloc.c 2012-06-02 08:52:27 +0000 +++ src/alloc.c 2012-06-08 08:44:30 +0000 @@ -304,7 +304,9 @@ process, hash_table, frame, terminal, and window, but we never made use of the distinction, so it only caused source-code complexity and runtime slowdown. Minor but pointless. */ - MEM_TYPE_VECTORLIKE + MEM_TYPE_VECTORLIKE, + /* Special type to denote vector blocks. */ + MEM_TYPE_VECTOR_BLOCK }; static void *lisp_malloc (size_t, enum mem_type); @@ -494,6 +496,11 @@ xsignal (Qnil, Vmemory_signal_data); } +/* A common multiple of the positive integers A and B. Ideally this + would be the least common multiple, but there's no way to do that + as a constant expression in C, so do the best that we can easily do. */ +#define COMMON_MULTIPLE(a, b) \ + ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b)) #ifndef XMALLOC_OVERRUN_CHECK #define XMALLOC_OVERRUN_CHECK_OVERHEAD 0 @@ -525,12 +532,8 @@ char c; \ }, \ c) + #ifdef USE_LSB_TAG -/* A common multiple of the positive integers A and B. Ideally this - would be the least common multiple, but there's no way to do that - as a constant expression in C, so do the best that we can easily do. */ -# define COMMON_MULTIPLE(a, b) \ - ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b)) # define XMALLOC_HEADER_ALIGNMENT \ COMMON_MULTIPLE (1 << GCTYPEBITS, XMALLOC_BASE_ALIGNMENT) #else @@ -2928,17 +2931,307 @@ Vector Allocation ***********************************************************************/ -/* Singly-linked list of all vectors. */ +/* This value is balanced well enough to avoid too much internal overhead + for the most common cases; it's not required to be a power of two, but + it's expected to be a mult-of-ROUNDUP_SIZE (see below). */ -static struct Lisp_Vector *all_vectors; +#define VECTOR_BLOCK_SIZE 4096 /* Handy constants for vectorlike objects. */ enum { header_size = offsetof (struct Lisp_Vector, contents), - word_size = sizeof (Lisp_Object) + word_size = sizeof (Lisp_Object), + roundup_size = COMMON_MULTIPLE (sizeof (Lisp_Object), +#ifdef USE_LSB_TAG + 8 /* Helps to maintain alignment constraints imposed by + assumption that least 3 bits of pointers are always 0. */ +#else + 1 /* If alignment doesn't matter, should round up + to sizeof (Lisp_Object) at least. */ +#endif + ) }; +/* Round up X to nearest mult-of-ROUNDUP_SIZE, + assuming ROUNDUP_SIZE is a power of 2. */ + +#define vroundup(x) (((x) + (roundup_size - 1)) & ~(roundup_size - 1)) + +/* Rounding helps to maintain alignment constraints if USE_LSB_TAG. */ + +#define VECTOR_BLOCK_BYTES (VECTOR_BLOCK_SIZE - vroundup (sizeof (void *))) + +/* Size of the minimal vector allocated from block. */ + +#define VBLOCK_BYTES_MIN vroundup (sizeof (struct Lisp_Vector)) + +/* Size of the largest vector allocated from block. */ + +#define VBLOCK_BYTES_MAX \ + vroundup ((VECTOR_BLOCK_BYTES / 2) - sizeof (Lisp_Object)) + +/* We maintain one free list for each possible block-allocated + vector size, and this is the number of free lists we have. */ + +#define VECTOR_MAX_FREE_LIST_INDEX \ + ((VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) / roundup_size + 1) + +/* When the vector is on a free list, vectorlike_header.SIZE is set to + this special value ORed with vector's memory footprint size. */ + +#define VECTOR_FREE_LIST_FLAG (~(ARRAY_MARK_FLAG | PSEUDOVECTOR_FLAG \ + | (VECTOR_BLOCK_SIZE - 1))) + +/* Common shortcut to advance vector pointer over a block data. */ + +#define ADVANCE(v, nbytes) ((struct Lisp_Vector *) ((char *) (v) + (nbytes))) + +/* Common shortcut to calculate NBYTES-vector index in VECTOR_FREE_LISTS. */ + +#define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size) + +/* Common shortcut to setup vector on a free list. */ + +#define SETUP_ON_FREE_LIST(v, nbytes, index) \ + do { \ + (v)->header.size = VECTOR_FREE_LIST_FLAG | (nbytes); \ + eassert ((nbytes) % roundup_size == 0); \ + (index) = VINDEX (nbytes); \ + eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \ + (v)->header.next.vector = vector_free_lists[index]; \ + vector_free_lists[index] = (v); \ + } while (0) + +struct vector_block +{ + char data[VECTOR_BLOCK_BYTES]; + struct vector_block *next; +}; + +/* Chain of vector blocks. */ + +static struct vector_block *vector_blocks; + +/* Vector free lists, where NTH item points to a chain of free + vectors of the same NBYTES size, so NTH == VINDEX (NBYTES). */ + +static struct Lisp_Vector *vector_free_lists[VECTOR_MAX_FREE_LIST_INDEX]; + +/* Singly-linked list of large vectors. */ + +static struct Lisp_Vector *large_vectors; + +/* The only vector with 0 slots, allocated from pure space. */ + +static struct Lisp_Vector *zero_vector; + +/* Get a new vector block. */ + +static struct vector_block * +allocate_vector_block (void) +{ + struct vector_block *block; + +#ifdef DOUG_LEA_MALLOC + mallopt (M_MMAP_MAX, 0); +#endif + + block = xmalloc (sizeof (struct vector_block)); + +#ifdef DOUG_LEA_MALLOC + mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); +#endif + +#if GC_MARK_STACK && !defined GC_MALLOC_CHECK + mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES, + MEM_TYPE_VECTOR_BLOCK); +#endif + + block->next = vector_blocks; + vector_blocks = block; + return block; +} + +/* Called once to initialize vector allocation. */ + +static void +init_vectors (void) +{ + zero_vector = pure_alloc (header_size, Lisp_Vectorlike); + zero_vector->header.size = 0; +} + +/* Allocate vector from a vector block. */ + +static struct Lisp_Vector * +allocate_vector_from_block (size_t nbytes) +{ + struct Lisp_Vector *vector, *rest; + struct vector_block *block; + size_t index, restbytes; + + eassert (VBLOCK_BYTES_MIN <= nbytes && nbytes <= VBLOCK_BYTES_MAX); + eassert (nbytes % roundup_size == 0); + + /* First, try to allocate from a free list + containing vectors of the requested size. */ + index = VINDEX (nbytes); + if (vector_free_lists[index]) + { + vector = vector_free_lists[index]; + vector_free_lists[index] = vector->header.next.vector; + vector->header.next.nbytes = nbytes; + return vector; + } + + /* Next, check free lists containing larger vectors. Since + we will split the result, we should have remaining space + large enough to use for one-slot vector at least. */ + for (index = VINDEX (nbytes + VBLOCK_BYTES_MIN); + index < VECTOR_MAX_FREE_LIST_INDEX; index++) + if (vector_free_lists[index]) + { + /* This vector is larger than requested. */ + vector = vector_free_lists[index]; + vector_free_lists[index] = vector->header.next.vector; + vector->header.next.nbytes = nbytes; + + /* Excess bytes are used for the smaller vector, + which should be set on an appropriate free list. */ + restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes; + eassert (restbytes % roundup_size == 0); + rest = ADVANCE (vector, nbytes); + SETUP_ON_FREE_LIST (rest, restbytes, index); + return vector; + } + + /* Finally, need a new vector block. */ + block = allocate_vector_block (); + + /* New vector will be at the beginning of this block. */ + vector = (struct Lisp_Vector *) block->data; + vector->header.next.nbytes = nbytes; + + /* If the rest of space from this block is large enough + for one-slot vector at least, set up it on a free list. */ + restbytes = VECTOR_BLOCK_BYTES - nbytes; + if (restbytes >= VBLOCK_BYTES_MIN) + { + eassert (restbytes % roundup_size == 0); + rest = ADVANCE (vector, nbytes); + SETUP_ON_FREE_LIST (rest, restbytes, index); + } + return vector; + } + +/* Return how many Lisp_Objects can be stored in V. */ + +#define VECTOR_SIZE(v) ((v)->header.size & PSEUDOVECTOR_FLAG ? \ + (PSEUDOVECTOR_SIZE_MASK & (v)->header.size) : \ + (v)->header.size) + +/* Nonzero if VECTOR pointer is valid pointer inside BLOCK. */ + +#define VECTOR_IN_BLOCK(vector, block) \ + ((char *) (vector) <= (block)->data \ + + VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) + +/* Reclaim space used by unmarked vectors. */ + +static void +sweep_vectors (void) +{ + struct vector_block *block = vector_blocks, **bprev = &vector_blocks; + struct Lisp_Vector *vector, *next, **vprev = &large_vectors; + + total_vector_size = 0; + memset (vector_free_lists, 0, sizeof (vector_free_lists)); + + /* Looking through vector blocks. */ + + for (block = vector_blocks; block; block = *bprev) + { + int free_this_block = 0; + + for (vector = (struct Lisp_Vector *) block->data; + VECTOR_IN_BLOCK (vector, block); vector = next) + { + if (VECTOR_MARKED_P (vector)) + { + VECTOR_UNMARK (vector); + total_vector_size += VECTOR_SIZE (vector); + next = ADVANCE (vector, vector->header.next.nbytes); + } + else + { + ptrdiff_t nbytes; + + if ((vector->header.size & VECTOR_FREE_LIST_FLAG) + == VECTOR_FREE_LIST_FLAG) + vector->header.next.nbytes = + vector->header.size & (VECTOR_BLOCK_SIZE - 1); + + next = ADVANCE (vector, vector->header.next.nbytes); + + /* While NEXT is not marked, try to coalesce with VECTOR, + thus making VECTOR of the largest possible size. */ + + while (VECTOR_IN_BLOCK (next, block)) + { + if (VECTOR_MARKED_P (next)) + break; + if ((next->header.size & VECTOR_FREE_LIST_FLAG) + == VECTOR_FREE_LIST_FLAG) + nbytes = next->header.size & (VECTOR_BLOCK_SIZE - 1); + else + nbytes = next->header.next.nbytes; + vector->header.next.nbytes += nbytes; + next = ADVANCE (next, nbytes); + } + + eassert (vector->header.next.nbytes % roundup_size == 0); + + if (vector == (struct Lisp_Vector *) block->data + && !VECTOR_IN_BLOCK (next, block)) + /* This block should be freed because all of it's + space was coalesced into the only free vector. */ + free_this_block = 1; + else + SETUP_ON_FREE_LIST (vector, vector->header.next.nbytes, nbytes); + } + } + + if (free_this_block) + { + *bprev = block->next; +#if GC_MARK_STACK && !defined GC_MALLOC_CHECK + mem_delete (mem_find (block->data)); +#endif + xfree (block); + } + else + bprev = &block->next; + } + + /* Sweep large vectors. */ + + for (vector = large_vectors; vector; vector = *vprev) + { + if (VECTOR_MARKED_P (vector)) + { + VECTOR_UNMARK (vector); + total_vector_size += VECTOR_SIZE (vector); + vprev = &vector->header.next.vector; + } + else + { + *vprev = vector->header.next.vector; + lisp_free (vector); + } + } +} + /* Value is a pointer to a newly allocated Lisp_Vector structure with room for LEN Lisp_Objects. */ @@ -2960,8 +3253,19 @@ /* This gets triggered by code which I haven't bothered to fix. --Stef */ /* eassert (!handling_signal); */ + if (len == 0) + return zero_vector; + nbytes = header_size + len * word_size; - p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE); + + if (nbytes <= VBLOCK_BYTES_MAX) + p = allocate_vector_from_block (vroundup (nbytes)); + else + { + p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE); + p->header.next.vector = large_vectors; + large_vectors = p; + } #ifdef DOUG_LEA_MALLOC /* Back to a reasonable maximum of mmap'ed areas. */ @@ -2971,9 +3275,6 @@ consing_since_gc += nbytes; vector_cells_consed += len; - p->header.next.vector = all_vectors; - all_vectors = p; - MALLOC_UNBLOCK_INPUT; return p; @@ -4072,7 +4373,34 @@ static inline int live_vector_p (struct mem_node *m, void *p) { - return (p == m->start && m->type == MEM_TYPE_VECTORLIKE); + if (m->type == MEM_TYPE_VECTOR_BLOCK) + { + /* This memory node corresponds to a vector block. */ + struct vector_block *block = (struct vector_block *) m->start; + struct Lisp_Vector *vector = (struct Lisp_Vector *) block->data; + + /* P is in the block's allocation range. Scan the block + up to P and see whether P points to the start of some + vector which is not on a free list. FIXME: check whether + some allocation patterns (probably a lot of short vectors) + may cause a substantial overhead of this loop. */ + while (VECTOR_IN_BLOCK (vector, block) + && vector <= (struct Lisp_Vector *) p) + { + if ((vector->header.size & VECTOR_FREE_LIST_FLAG) + == VECTOR_FREE_LIST_FLAG) + vector = ADVANCE (vector, (vector->header.size + & (VECTOR_BLOCK_SIZE - 1))); + else if (vector == p) + return 1; + else + vector = ADVANCE (vector, vector->header.next.nbytes); + } + } + else if (m->type == MEM_TYPE_VECTORLIKE && p == m->start) + /* This memory node corresponds to a large vector. */ + return 1; + return 0; } @@ -4272,6 +4600,7 @@ break; case MEM_TYPE_VECTORLIKE: + case MEM_TYPE_VECTOR_BLOCK: if (live_vector_p (m, p)) { Lisp_Object tem; @@ -4705,6 +5034,7 @@ return live_float_p (m, p); case MEM_TYPE_VECTORLIKE: + case MEM_TYPE_VECTOR_BLOCK: return live_vector_p (m, p); default: @@ -6241,33 +6571,7 @@ } } - /* Free all unmarked vectors */ - { - register struct Lisp_Vector *vector = all_vectors, *prev = 0, *next; - total_vector_size = 0; - - while (vector) - if (!VECTOR_MARKED_P (vector)) - { - if (prev) - prev->header.next = vector->header.next; - else - all_vectors = vector->header.next.vector; - next = vector->header.next.vector; - lisp_free (vector); - vector = next; - - } - else - { - VECTOR_UNMARK (vector); - if (vector->header.size & PSEUDOVECTOR_FLAG) - total_vector_size += PSEUDOVECTOR_SIZE_MASK & vector->header.size; - else - total_vector_size += vector->header.size; - prev = vector, vector = vector->header.next.vector; - } - } + sweep_vectors (); #ifdef GC_CHECK_STRING_BYTES if (!noninteractive) @@ -6404,7 +6708,6 @@ Vdead = make_pure_string ("DEAD", 4, 4, 0); #endif - all_vectors = 0; ignore_warnings = 1; #ifdef DOUG_LEA_MALLOC mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */ @@ -6417,6 +6720,7 @@ init_marker (); init_float (); init_intervals (); + init_vectors (); init_weak_hash_tables (); #ifdef REL_ALLOC === modified file 'src/lisp.h' --- src/lisp.h 2012-05-30 19:23:37 +0000 +++ src/lisp.h 2012-06-08 08:44:30 +0000 @@ -916,11 +916,15 @@ { ptrdiff_t size; - /* Pointer to the next vector-like object. It is generally a buffer or a + /* When the vector is allocated from a vector block, NBYTES is used + if the vector is not on a free list, and VECTOR is used otherwise. + For large vector-like objects, BUFFER or VECTOR is used as a pointer + to the next vector-like object. It is generally a buffer or a Lisp_Vector alias, so for convenience it is a union instead of a pointer: this way, one can write P->next.vector instead of ((struct Lisp_Vector *) P->next). */ union { + ptrdiff_t nbytes; struct buffer *buffer; struct Lisp_Vector *vector; } next; ------------------------------------------------------------ revno: 108519 committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2012-06-08 04:38:56 +0000 message: Merge bugfixes done in Gnus trunk Those changes fix only the bugs having appeared in the bug list. Many other Gnus changes not yet merged to Emacs are in: ftp://ftp.jpl.org/pub/tmp/MaGnus-to-Emacs.patch (or http://www.jpl.org/ftp/pub/tmp/MaGnus-to-Emacs.patch) 2012-06-07 Lars Magne Ingebrigtsen * gnus-msg.el (gnus-msg-mail): Warn the user about Gnus not running (bug#11514). 2012-04-10 Lars Magne Ingebrigtsen * gnus-msg.el (gnus-summary-cancel-article): See what From header we would have gotten if we posted to the group, and use that to compare against the message we want to cancel (bug#10808). diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2012-06-01 20:24:17 +0000 +++ lisp/gnus/ChangeLog 2012-06-08 04:38:56 +0000 @@ -1,3 +1,8 @@ +2012-06-07 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-msg-mail): Warn the user about Gnus not running + (bug#11514). + 2012-06-01 Stefan Monnier * nntp.el: Stop the `letf' madness. @@ -98,6 +103,12 @@ * gnus-start.el (gnus-read-newsrc-el-file): Protect against broken .newsrc.el files. +2012-04-10 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-summary-cancel-article): See what From header we + would have gotten if we posted to the group, and use that to compare + against the message we want to cancel (bug#10808). + 2012-03-22 Lars Magne Ingebrigtsen * auth-source.el (auth-source-netrc-create): Quote tokens that contain === modified file 'lisp/gnus/gnus-msg.el' --- lisp/gnus/gnus-msg.el 2012-05-21 23:29:03 +0000 +++ lisp/gnus/gnus-msg.el 2012-06-08 04:38:56 +0000 @@ -487,8 +487,10 @@ instead." (interactive) (if (not (gnus-alive-p)) - (message-mail to subject other-headers continue - nil yank-action send-actions return-action) + (progn + (message "Gnus not running; using plain Message mode") + (message-mail to subject other-headers continue + nil yank-action send-actions return-action)) (let ((buf (current-buffer)) (gnus-newsgroup-name (or gnus-newsgroup-name "")) mail-buf) @@ -810,9 +812,21 @@ (interactive (gnus-interactive "P\ny")) (let ((message-post-method `(lambda (arg) - (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))) + (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))) + (user-mail-address user-mail-address)) (dolist (article (gnus-summary-work-articles n)) (when (gnus-summary-select-article t nil nil article) + ;; Pretend that we're doing a followup so that we can see what + ;; the From header would have ended up being. + (save-window-excursion + (save-excursion + (gnus-summary-followup nil) + (let ((from (message-fetch-field "from"))) + (when from + (setq user-mail-address + (car (mail-header-parse-address from))))) + (kill-buffer (current-buffer)))) + ;; Now cancel the article using the From header we got. (when (gnus-eval-in-buffer-window gnus-original-article-buffer (message-cancel-news)) (gnus-summary-mark-as-read article gnus-canceled-mark)