Now on revision 111142. ------------------------------------------------------------ revno: 111142 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2012-12-07 11:16:32 +0400 message: Convenient macro to check whether the buffer is hidden. * buffer.h (BUFFER_HIDDEN_P): New macro. * frame.c (make_frame): Use it. Adjust comment. * buffer.c (candidate_buffer): New function. (Fother_buffer, other_buffer_safely): Use it. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-12-06 18:36:22 +0000 +++ src/ChangeLog 2012-12-07 07:16:32 +0000 @@ -1,3 +1,11 @@ +2012-12-07 Dmitry Antipov + + Convenient macro to check whether the buffer is hidden. + * buffer.h (BUFFER_HIDDEN_P): New macro. + * frame.c (make_frame): Use it. Adjust comment. + * buffer.c (candidate_buffer): New function. + (Fother_buffer, other_buffer_safely): Use it. + 2012-12-06 Eli Zaretskii * w32proc.c (waitpid): Avoid busy-waiting when called with WNOHANG === modified file 'src/buffer.c' --- src/buffer.c 2012-11-08 21:58:55 +0000 +++ src/buffer.c 2012-12-07 07:16:32 +0000 @@ -1529,6 +1529,16 @@ return BVAR (current_buffer, name); } +/* True if B can be used as 'other-than-BUFFER' buffer. */ + +static bool +candidate_buffer (Lisp_Object b, Lisp_Object buffer) +{ + return (BUFFERP (b) && !EQ (b, buffer) + && BUFFER_LIVE_P (XBUFFER (b)) + && !BUFFER_HIDDEN_P (XBUFFER (b))); +} + DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0, doc: /* Return most recently selected buffer other than BUFFER. Buffers not visible in windows are preferred to visible buffers, unless @@ -1550,9 +1560,7 @@ for (; CONSP (tail); tail = XCDR (tail)) { buf = XCAR (tail); - if (BUFFERP (buf) && !EQ (buf, buffer) - && BUFFER_LIVE_P (XBUFFER (buf)) - && (SREF (BVAR (XBUFFER (buf), name), 0) != ' ') + if (candidate_buffer (buf, buffer) /* If the frame has a buffer_predicate, disregard buffers that don't fit the predicate. */ && (NILP (pred) || !NILP (call1 (pred, buf)))) @@ -1570,9 +1578,7 @@ for (; CONSP (tail); tail = XCDR (tail)) { buf = Fcdr (XCAR (tail)); - if (BUFFERP (buf) && !EQ (buf, buffer) - && BUFFER_LIVE_P (XBUFFER (buf)) - && (SREF (BVAR (XBUFFER (buf), name), 0) != ' ') + if (candidate_buffer (buf, buffer) /* If the frame has a buffer_predicate, disregard buffers that don't fit the predicate. */ && (NILP (pred) || !NILP (call1 (pred, buf)))) @@ -1608,13 +1614,10 @@ { Lisp_Object tail, buf; - tail = Vbuffer_alist; - for (; CONSP (tail); tail = XCDR (tail)) + for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) { buf = Fcdr (XCAR (tail)); - if (BUFFERP (buf) && !EQ (buf, buffer) - && BUFFER_LIVE_P (XBUFFER (buf)) - && (SREF (BVAR (XBUFFER (buf), name), 0) != ' ')) + if (candidate_buffer (buf, buffer)) return buf; } === modified file 'src/buffer.h' --- src/buffer.h 2012-11-08 14:10:28 +0000 +++ src/buffer.h 2012-12-07 07:16:32 +0000 @@ -982,6 +982,11 @@ #define BUFFER_LIVE_P(b) (!NILP (BVAR (b, name))) +/* Convenient check whether buffer B is hidden (i.e. its name + starts with a space). Caller must ensure that B is live. */ + +#define BUFFER_HIDDEN_P(b) (SREF (BVAR (b, name), 0) == ' ') + /* Verify indirection counters. */ #define BUFFER_CHECK_INDIRECTION(b) \ === modified file 'src/frame.c' --- src/frame.c 2012-12-06 13:48:11 +0000 +++ src/frame.c 2012-12-07 07:16:32 +0000 @@ -346,13 +346,11 @@ /* Choose a buffer for the frame's root window. */ { - Lisp_Object buf; + Lisp_Object buf = Fcurrent_buffer (); wset_buffer (XWINDOW (root_window), Qt); - buf = Fcurrent_buffer (); - /* If buf is a 'hidden' buffer (i.e. one whose name starts with - a space), try to find another one. */ - if (SREF (Fbuffer_name (buf), 0) == ' ') + /* If current buffer is hidden, try to find another one. */ + if (BUFFER_HIDDEN_P (XBUFFER (buf))) buf = other_buffer_safely (buf); /* Use set_window_buffer, not Fset_window_buffer, and don't let ------------------------------------------------------------ revno: 111141 committer: Glenn Morris branch nick: trunk timestamp: Thu 2012-12-06 20:57:43 -0800 message: Fix :type in previous (un)rmail change, use a better :group diff: === modified file 'lisp/mail/rmail.el' --- lisp/mail/rmail.el 2012-12-07 04:37:14 +0000 +++ lisp/mail/rmail.el 2012-12-07 04:57:43 +0000 @@ -2715,10 +2715,10 @@ how Rmail displays lines starting with \">*From \" in non-MIME messages. See also `unrmail-mbox-format'." - :type '(choice (const 'mboxrd) - (const 'mboxro)) + :type '(choice (const mboxrd) + (const mboxro)) :version "24.4" - :group 'rmail) + :group 'rmail-files) (defun rmail-show-message-1 (&optional msg) "Show message MSG (default: current message) using `rmail-view-buffer'. === modified file 'lisp/mail/unrmail.el' --- lisp/mail/unrmail.el 2012-12-07 04:37:14 +0000 +++ lisp/mail/unrmail.el 2012-12-07 04:57:43 +0000 @@ -56,10 +56,10 @@ \">>From \", and so on. For this reason, mboxrd is recommended. See also `rmail-mbox-format'." - :type '(choice (const 'mboxrd) - (const 'mboxro)) + :type '(choice (const mboxrd) + (const mboxro)) :version "24.4" - :group 'rmail) + :group 'rmail-files) ;;;###autoload (defun unrmail (file to-file) ------------------------------------------------------------ revno: 111140 fixes bug: http://debbugs.gnu.org/6574 committer: Glenn Morris branch nick: trunk timestamp: Thu 2012-12-06 20:37:14 -0800 message: Default to mboxrd in Rmail, allow mboxo as an option * lisp/mail/unrmail.el (unrmail-mbox-format): New option. (batch-unrmail, unrmail): Doc fixes. (unrmail): Respect unrmail-mbox-format. * lisp/mail/rmail.el (rmail-mbox-format): New option. (rmail-show-message-1): Respect rmail-mbox-format. * etc/NEWS: Related edits. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-12-07 03:56:57 +0000 +++ etc/NEWS 2012-12-07 04:37:14 +0000 @@ -58,6 +58,14 @@ ** MH-E has been updated to MH-E version 8.4. See MH-E-NEWS for details. +--- +** The unrmail command converts from BABYL to mboxrd rather than mboxo. +Customize `unrmail-mbox-format' to change this. + +--- +** Similarly, customize `rmail-mbox-format' to influence some minor aspects +of how Rmail displays non-MIME messages. + +++ ** New function `ses-rename-cell' to give SES cells arbitrary names. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-12-07 03:56:57 +0000 +++ lisp/ChangeLog 2012-12-07 04:37:14 +0000 @@ -1,3 +1,11 @@ +2012-12-07 Glenn Morris + + * mail/unrmail.el (unrmail-mbox-format): New option. (Bug#6574) + (batch-unrmail, unrmail): Doc fixes. + (unrmail): Respect unrmail-mbox-format. + * mail/rmail.el (rmail-mbox-format): New option. + (rmail-show-message-1): Respect rmail-mbox-format. + 2012-12-07 Stefan Monnier * emacs-lisp/cl-macs.el (cl-tagbody): New macro. === modified file 'lisp/mail/rmail.el' --- lisp/mail/rmail.el 2012-12-06 11:21:08 +0000 +++ lisp/mail/rmail.el 2012-12-07 04:37:14 +0000 @@ -2699,6 +2699,27 @@ :group 'rmail :version "23.1") +;; FIXME? +;; rmail-show-mime-function does not unquote >From lines. Should it? +(defcustom rmail-mbox-format 'mboxrd + "The mbox format that your system uses. +There is no way to determine this, so you should set the appropriate value. +The formats quote lines containing \"From \" differently. +The choices are: + `mboxo' : lines that start with \"From \" quoted as \">From \" + `mboxrd': lines that start with \">*From \" quoted with another \">\" +The `mboxo' format is ambiguous, in that one cannot know whether +a line starting with \">From \" originally had a \">\" or not. + +It is not critical to set this to the correct value; it only affects +how Rmail displays lines starting with \">*From \" in non-MIME messages. + +See also `unrmail-mbox-format'." + :type '(choice (const 'mboxrd) + (const 'mboxro)) + :version "24.4" + :group 'rmail) + (defun rmail-show-message-1 (&optional msg) "Show message MSG (default: current message) using `rmail-view-buffer'. Return text to display in the minibuffer if MSG is out of @@ -2791,11 +2812,15 @@ ;; Prepare the separator (blank line) before the body. (goto-char (point-min)) (insert "\n") - ;; Unquote quoted From lines - (while (re-search-forward "^>+From " nil t) - (beginning-of-line) - (delete-char 1) - (forward-line)) + ;; Unquote quoted From lines. + (let ((fromline (if (eq 'mboxrd rmail-mbox-format) + "^>+From " + "^>From ")) + case-fold-search) + (while (re-search-forward fromline nil t) + (beginning-of-line) + (delete-char 1) + (forward-line))) (goto-char (point-min))) ;; Copy the headers to the front of the message view buffer. (rmail-copy-headers beg end) @@ -3869,6 +3894,7 @@ (msgnum rmail-current-message) (subject (concat "[" (let ((from (or (mail-fetch-field "From") + ;; FIXME - huh? (mail-fetch-field ">From")))) (if from (concat (mail-strip-quoted-names from) ": ") === modified file 'lisp/mail/unrmail.el' --- lisp/mail/unrmail.el 2012-04-19 17:20:26 +0000 +++ lisp/mail/unrmail.el 2012-12-07 04:37:14 +0000 @@ -1,6 +1,6 @@ -;;; unrmail.el --- convert Rmail Babyl files to mailbox files +;;; unrmail.el --- convert Rmail Babyl files to mbox files -;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc. +;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail @@ -26,7 +26,7 @@ ;;;###autoload (defun batch-unrmail () - "Convert old-style Rmail Babyl files to system inbox format. + "Convert old-style Rmail Babyl files to mbox format. Specify the input Rmail Babyl file names as command line arguments. For each Rmail file, the corresponding output file name is made by adding `.mail' at the end. @@ -45,9 +45,26 @@ (declare-function mail-mbox-from "mail-utils" ()) (defvar rmime-magic-string) ; in rmime.el, if you have it +(defcustom unrmail-mbox-format 'mboxrd + "The mbox format that `unrmail' should produce. +These formats separate messages using lines that start with \"From \". +Therefore any lines in the message bodies that start with \"From \" +must be quoted. The `mboxo' format just prepends a \">\" to such lines. +This is not reversible, because given a line starting with \">From \" in +an mboxo file, it is not possible to know whether the original had a \">\" +or not. The `mxbord' format avoids this by also quoting \">From \" as +\">>From \", and so on. For this reason, mboxrd is recommended. + +See also `rmail-mbox-format'." + :type '(choice (const 'mboxrd) + (const 'mboxro)) + :version "24.4" + :group 'rmail) + ;;;###autoload (defun unrmail (file to-file) - "Convert old-style Rmail Babyl file FILE to system inbox format file TO-FILE." + "Convert old-style Rmail Babyl file FILE to mbox format file TO-FILE. +The variable `unrmail-mbox-format' controls which mbox format to use." (interactive "fUnrmail (babyl file): \nFUnrmail into (new mailbox file): ") (with-temp-buffer ;; Read in the old Rmail file with no decoding. @@ -224,13 +241,15 @@ (when keywords (insert "X-RMAIL-KEYWORDS: " keywords "\n")) (goto-char (point-min)) - ;; ``Quote'' "\nFrom " as "\n>From " - ;; (note that this isn't really quoting, as there is no requirement - ;; that "\n[>]+From " be quoted in the same transparent way.) - (let ((case-fold-search nil)) - (while (search-forward "\nFrom " nil t) - (forward-char -5) - (insert ?>))) + ;; Convert From to >From, etc. + (let ((case-fold-search nil) + (fromline (if (eq 'mboxrd unrmail-mbox-format) + "^>*From " + "^From "))) + (while (re-search-forward fromline nil t) + (beginning-of-line) + (insert ?>) + (forward-line 1))) (goto-char (point-max)) ;; Add terminator blank line to message. (insert "\n") ------------------------------------------------------------ revno: 111139 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2012-12-06 22:56:57 -0500 message: * lisp/emacs-lisp/cl-macs.el (cl-tagbody): New macro. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-12-04 17:07:09 +0000 +++ etc/NEWS 2012-12-07 03:56:57 +0000 @@ -29,6 +29,7 @@ * Changes in Specialized Modes and Packages in Emacs 24.4 +** New macro cl-tagbody in cl-lib. ** Calc *** Calc by default now uses the Gregorian calendar for all dates, and === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-12-06 21:29:29 +0000 +++ lisp/ChangeLog 2012-12-07 03:56:57 +0000 @@ -1,3 +1,7 @@ +2012-12-07 Stefan Monnier + + * emacs-lisp/cl-macs.el (cl-tagbody): New macro. + 2012-12-06 Stefan Monnier Further cleanup of the "cl-" namespace. Fit CL in 80 columns. === modified file 'lisp/emacs-lisp/cl-loaddefs.el' --- lisp/emacs-lisp/cl-loaddefs.el 2012-12-06 21:29:29 +0000 +++ lisp/emacs-lisp/cl-loaddefs.el 2012-12-07 03:56:57 +0000 @@ -262,12 +262,12 @@ ;;;;;; cl-rotatef cl-shiftf cl-remf cl-psetf cl-declare cl-the cl-locally ;;;;;; cl-multiple-value-setq cl-multiple-value-bind cl-symbol-macrolet ;;;;;; cl-macrolet cl-labels cl-flet* cl-flet cl-progv cl-psetq -;;;;;; cl-do-all-symbols cl-do-symbols cl-dotimes cl-dolist cl-do* -;;;;;; cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase +;;;;;; cl-do-all-symbols cl-do-symbols cl-tagbody cl-dotimes cl-dolist +;;;;;; 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--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "5df0692d7c4bffb2cc353f802d94f796") +;;;;;; "cl-macs" "cl-macs.el" "d3af72b1cff3398fa1480065fc2887a2") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ @@ -465,6 +465,19 @@ (put 'cl-dotimes 'lisp-indent-function '1) +(autoload 'cl-tagbody "cl-macs" "\ +Execute statements while providing for control transfers to labels. +Each element of LABELS-OR-STMTS can be either a label (integer or symbol) +or a `cons' cell, in which case it's taken to be a statement. +This distinction is made before performing macroexpansion. +Statements are executed in sequence left to right, discarding any return value, +stopping only when reaching the end of LABELS-OR-STMTS. +Any statement can transfer control at any time to the statements that follow +one of the labels with the special form (go LABEL). +Labels have lexical scope and dynamic extent. + +\(fn &rest LABELS-OR-STMTS)" nil t) + (autoload 'cl-do-symbols "cl-macs" "\ Loop over all symbols. Evaluate BODY with VAR bound to each interned symbol, or to each symbol @@ -759,7 +772,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" "697d04e7ae0a9b9c15eea705b359b1bb") +;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "4b8ddc5bea2fcc626526ce3644071568") ;;; Generated autoloads from cl-seq.el (autoload 'cl-reduce "cl-seq" "\ === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2012-12-06 21:29:29 +0000 +++ lisp/emacs-lisp/cl-macs.el 2012-12-07 03:56:57 +0000 @@ -1611,6 +1611,52 @@ (if (advice-member-p #'cl--wrap-in-nil-block 'dotimes) loop `(cl-block nil ,loop)))) +(defvar cl--tagbody-alist nil) + +;;;###autoload +(defmacro cl-tagbody (&rest labels-or-stmts) + "Execute statements while providing for control transfers to labels. +Each element of LABELS-OR-STMTS can be either a label (integer or symbol) +or a `cons' cell, in which case it's taken to be a statement. +This distinction is made before performing macroexpansion. +Statements are executed in sequence left to right, discarding any return value, +stopping only when reaching the end of LABELS-OR-STMTS. +Any statement can transfer control at any time to the statements that follow +one of the labels with the special form (go LABEL). +Labels have lexical scope and dynamic extent." + (let ((blocks '()) + (first-label (if (consp (car labels-or-stmts)) + 'cl--preamble (pop labels-or-stmts)))) + (let ((block (list first-label))) + (dolist (label-or-stmt labels-or-stmts) + (if (consp label-or-stmt) (push label-or-stmt block) + ;; Add a "go to next block" to implement the fallthrough. + (unless (eq 'go (car-safe (car-safe block))) + (push `(go ,label-or-stmt) block)) + (push (nreverse block) blocks) + (setq block (list label-or-stmt)))) + (unless (eq 'go (car-safe (car-safe block))) + (push `(go cl--exit) block)) + (push (nreverse block) blocks)) + (let ((catch-tag (make-symbol "cl--tagbody-tag"))) + (push (cons 'cl--exit catch-tag) cl--tagbody-alist) + (dolist (block blocks) + (push (cons (car block) catch-tag) cl--tagbody-alist)) + (macroexpand-all + `(let ((next-label ',first-label)) + (while + (not (eq (setq next-label + (catch ',catch-tag + (cl-case next-label + ,@blocks))) + 'cl--exit)))) + `((go . ,(lambda (label) + (let ((catch-tag (cdr (assq label cl--tagbody-alist)))) + (unless catch-tag + (error "Unknown cl-tagbody go label `%S'" label)) + `(throw ',catch-tag ',label)))) + ,@macroexpand-all-environment))))) + ;;;###autoload (defmacro cl-do-symbols (spec &rest body) "Loop over all symbols. ------------------------------------------------------------ revno: 111138 committer: Paul Eggert branch nick: trunk timestamp: Thu 2012-12-06 18:37:20 -0800 message: Spelling fixes. diff: === modified file 'doc/lispref/internals.texi' --- doc/lispref/internals.texi 2012-12-07 01:47:14 +0000 +++ doc/lispref/internals.texi 2012-12-07 02:37:20 +0000 @@ -293,7 +293,7 @@ future allocations. So an overall result is: @example -((@code{conses} @var{cons-size} @var{used-conse} @var{free-conses}) +((@code{conses} @var{cons-size} @var{used-conses} @var{free-conses}) (@code{symbols} @var{symbol-size} @var{used-symbols} @var{free-symbols}) (@code{miscs} @var{misc-size} @var{used-miscs} @var{free-miscs}) (@code{strings} @var{string-size} @var{used-strings} @var{free-strings}) @@ -886,7 +886,7 @@ @cindex object internals Emacs Lisp provides a rich set of the data types. Some of them, like cons -cells, integers and stirngs, are common to nearly all Lisp dialects. Some +cells, integers and strings, are common to nearly all Lisp dialects. Some others, like markers and buffers, are quite special and needed to provide the basic support to write editor commands in Lisp. To implement such a variety of object types and provide an efficient way to pass objects between === modified file 'doc/lispref/symbols.texi' --- doc/lispref/symbols.texi 2012-12-05 22:27:56 +0000 +++ doc/lispref/symbols.texi 2012-12-07 02:37:20 +0000 @@ -563,7 +563,7 @@ Safety}) as well as for byte compiler optimizations. Do not set it. @item variable-documentation -If non-@code{nil}, this specifies the named vaariable's documentation +If non-@code{nil}, this specifies the named variable's documentation string. This is set automatically by @code{defvar} and related functions. @xref{Defining Faces}. @end table === modified file 'doc/misc/erc.texi' --- doc/misc/erc.texi 2012-12-05 22:27:56 +0000 +++ doc/misc/erc.texi 2012-12-07 02:37:20 +0000 @@ -752,7 +752,7 @@ @defopt erc-lurker-hide-list Like @code{erc-hide-list}, but only applies to messages sent by lurkers. The function @code{erc-lurker-p} determines whether a given -nickname is considerd a lurker. +nickname is considered a lurker. @end defopt === modified file 'lisp/faces.el' --- lisp/faces.el 2012-11-25 04:50:20 +0000 +++ lisp/faces.el 2012-12-07 02:37:20 +0000 @@ -1622,7 +1622,7 @@ (if (memq spec-type '(reset saved-face)) (put face 'customized-face nil)) ;; Setting the face spec via Custom empties out any override spec, - ;; similar to how setting a variable via Custom changes its valus. + ;; similar to how setting a variable via Custom changes its values. (if (memq spec-type '(customized-face saved-face reset)) (put face 'face-override-spec nil)) ;; If we reset the face based on its custom spec, it is unmodified === modified file 'lisp/mh-e/mh-e.el' --- lisp/mh-e/mh-e.el 2012-11-25 18:26:38 +0000 +++ lisp/mh-e/mh-e.el 2012-12-07 02:37:20 +0000 @@ -2663,7 +2663,7 @@ "X-Mail-from:" ; fastmail.fm "X-MAIL-INFO:" ; NetZero "X-Mailer_" - "X-MailFlowPolicy:" ; Cicso ironport (http://www.ironport.com) + "X-MailFlowPolicy:" ; Cisco Email Security (formerly IronPort; http://www.ironport.com) "X-Mailing-List:" ; Unknown mailing list managers "X-MailingID:" "X-Mailman-Approved-At:" ; Mailman mailing list manager @@ -2743,7 +2743,7 @@ "X-Scanned-By:" "X-Sender-ID:" ; Google+ "X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ - "X-Sendergroup:" ; Cicso ironport (http://www.ironport.com) + "X-Sendergroup:" ; Cisco Email Security (formerly IronPort; http://www.ironport.com) "X-Server-Date:" "X-Server-Uuid:" "X-Service-Code:" === modified file 'lisp/subr.el' --- lisp/subr.el 2012-11-27 03:10:32 +0000 +++ lisp/subr.el 2012-12-07 02:37:20 +0000 @@ -2628,7 +2628,7 @@ On those systems, it is automatically local in every buffer. On other systems, this variable is normally always nil. -WARNING: This variable is obsolete and will disapper Real Soon Now. +WARNING: This variable is obsolete and will disappear Real Soon Now. Don't use it!") ;; The `assert' macro from the cl package signals ------------------------------------------------------------ revno: 111137 fixes bug: http://debbugs.gnu.org/12973 committer: Paul Eggert branch nick: trunk timestamp: Thu 2012-12-06 17:47:14 -0800 message: * doc/lispref/internals.texi: Fix minor whitespace problems. diff: === modified file 'doc/lispref/internals.texi' --- doc/lispref/internals.texi 2012-12-06 06:17:10 +0000 +++ doc/lispref/internals.texi 2012-12-07 01:47:14 +0000 @@ -324,7 +324,7 @@ @table @var @item cons-size -Internal size of a cons cell, i.e.@: @code{sizeof (struct Lisp_Cons)}. +Internal size of a cons cell, i.e., @code{sizeof (struct Lisp_Cons)}. @item used-conses The number of cons cells in use. @@ -334,7 +334,7 @@ the operating system, but that are not currently being used. @item symbol-size -Internal size of a symbol, i.e.@: @code{sizeof (struct Lisp_Symbol)}. +Internal size of a symbol, i.e., @code{sizeof (struct Lisp_Symbol)}. @item used-symbols The number of symbols in use. @@ -344,7 +344,7 @@ the operating system, but that are not currently being used. @item misc-size -Internal size of a miscellaneous entity, i.e.@: +Internal size of a miscellaneous entity, i.e., @code{sizeof (union Lisp_Misc)}, which is a size of the largest type enumerated in @code{enum Lisp_Misc_Type}. @@ -357,7 +357,7 @@ from the operating system, but that are not currently being used. @item string-size -Internal size of a string header, i.e.@: @code{sizeof (struct Lisp_String)}. +Internal size of a string header, i.e., @code{sizeof (struct Lisp_String)}. @item used-strings The number of string headers in use. @@ -373,7 +373,7 @@ The total size of all string data in bytes. @item vector-size -Internal size of a vector header, i.e.@: @code{sizeof (struct Lisp_Vector)}. +Internal size of a vector header, i.e., @code{sizeof (struct Lisp_Vector)}. @item used-vectors The number of vector headers allocated from the vector blocks. @@ -388,7 +388,7 @@ The number of free slots in all vector blocks. @item float-size -Internal size of a float object, i.e.@: @code{sizeof (struct Lisp_Float)}. +Internal size of a float object, i.e., @code{sizeof (struct Lisp_Float)}. (Do not confuse it with the native platform @code{float} or @code{double}.) @item used-floats @@ -399,7 +399,7 @@ the operating system, but that are not currently being used. @item interval-size -Internal size of an interval object, i.e.@: @code{sizeof (struct interval)}. +Internal size of an interval object, i.e., @code{sizeof (struct interval)}. @item used-intervals The number of intervals in use. @@ -409,12 +409,12 @@ the operating system, but that are not currently being used. @item buffer-size -Internal size of a buffer, i.e.@: @code{sizeof (struct buffer)}. +Internal size of a buffer, i.e., @code{sizeof (struct buffer)}. (Do not confuse with the value returned by @code{buffer-size} function.) @item used-buffers The number of buffer objects in use. This includes killed buffers -invisible to users, i.e.@: all buffers in @code{all_buffers} list. +invisible to users, i.e., all buffers in @code{all_buffers} list. @item unit-size The unit of heap space measurement, always equal to 1024 bytes. @@ -699,7 +699,7 @@ the number of Lisp arguments, it must have exactly two C arguments: the first is the number of Lisp arguments, and the second is the address of a block containing their values. These have types -@code{int} and @w{@code{Lisp_Object *}} respectively. Since +@code{int} and @w{@code{Lisp_Object *}} respectively. Since @code{Lisp_Object} can hold any Lisp object of any data type, you can determine the actual data type only at run time; so if you want a primitive to accept only a certain type of argument, you must check @@ -900,11 +900,11 @@ vectorlike or miscellaneous object. Each of these data types has the corresponding tag value. All tags are enumerated by @code{enum Lisp_Type} and placed into a 3-bit bitfield of the @code{Lisp_Object}. The rest of the -bits is the value itself. Integer values are immediate, i.e.@: directly +bits is the value itself. Integer values are immediate, i.e., directly represented by those @dfn{value bits}, and all other objects are represented by the C pointers to a corresponding object allocated from the heap. Width of the @code{Lisp_Object} is platform- and configuration-dependent: usually -it's equal to the width of an underlying platform pointer (i.e.@: 32-bit on +it's equal to the width of an underlying platform pointer (i.e., 32-bit on a 32-bit machine and 64-bit on a 64-bit one), but also there is a special configuration where @code{Lisp_Object} is 64-bit but all pointers are 32-bit. The latter trick was designed to overcome the limited range of values for ------------------------------------------------------------ revno: 111136 committer: Andreas Schwab branch nick: emacs timestamp: Thu 2012-12-06 23:44:05 +0100 message: * themes/leuven-theme.el: Convert to Unix format. diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2012-12-06 02:52:22 +0000 +++ etc/ChangeLog 2012-12-06 22:44:05 +0000 @@ -1,3 +1,7 @@ +2012-12-06 Andreas Schwab + + * themes/leuven-theme.el: Convert to Unix format. + 2012-12-06 Fabrice Niessen * themes/leuven-theme.el: New theme. === modified file 'etc/themes/leuven-theme.el' --- etc/themes/leuven-theme.el 2012-12-06 02:57:59 +0000 +++ etc/themes/leuven-theme.el 2012-12-06 22:44:05 +0000 @@ -1,595 +1,595 @@ -;;; leuven-theme.el --- Emacs custom theme - -;; Copyright (C) 2003-2012 Free Software Foundation, Inc. -;; Time-stamp: <2012-12-05 Wed 10:47> - -;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")> - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Code: - -(deftheme leuven - "Face colors with a light background. -Basic, Font Lock, Isearch, Gnus, Message, Diff, Ediff, Flyspell, -Semantic, and Ansi-Color faces are included -- and much more...") - -(let ((class '((class color) (min-colors 89))) - ;; Leuven generic colors - (cancel '(:slant italic :strike-through t :foreground "gray55")) - (clock-line '(:box (:line-width 1 :color "#335EA8") :foreground "black" :background "#EEC900")) - (code-block '(:foreground "#000088" :background "#FBF9EA")) - (code-inline '(:box (:line-width 1 :color "#DDDDDD") :foreground "#000088" :background "#FFFFE0")) - (column '(:height 1.0 :weight normal :slant normal :underline nil :strike-through nil :foreground "#E6AD4F" :background "#FFF2DE")) - (diff-added '(:foreground "#008000" :background "#DDFFDD")) - (diff-hunk-header '(:box (:line-width 1 :color "#FFE0FF") :foreground "#990099" :background "#FFEEFF")) - (diff-none '(:foreground "gray33")) - (diff-removed '(:foreground "#A60000" :background "#FFDDDD")) - (directory '(:weight bold :foreground "blue" :background "#FFFFD2")) - (highlight-line '(:inverse-video t)) - (link '(:underline t :foreground "#006DAF")) - (mail-header-name '(:weight bold :foreground "black")) - (marked-line '(:weight bold :foreground "white" :background "red")) - (match '(:background "#FFFF99")) - (ol1 '(:height 1.3 :weight bold :overline "#A7A7A7" :foreground "#3C3C3C" :background "#F0F0F0")) - (ol2 '(:height 1.0 :weight bold :overline "#123555" :foreground "#123555" :background "#E5F4FB")) - (ol3 '(:height 1.0 :weight bold :overline "#005522" :foreground "#005522" :background "#EFFFEF")) - (ol4 '(:height 1.0 :weight bold :slant normal :foreground "#EA6300")) - (ol5 '(:height 1.0 :weight bold :slant normal :foreground "#E3258D")) - (ol6 '(:height 1.0 :weight bold :slant italic :foreground "#0077CC")) - (ol7 '(:height 1.0 :weight bold :slant italic :foreground "#2EAE2C")) - (ol8 '(:height 1.0 :weight bold :slant italic :foreground "#FD8008")) - (region '(:background "#D2D9E0")) - (shadow '(:foreground "#7F7F7F")) - (string '(:foreground "#008000")) - (subject '(:weight bold :foreground "#CF5D60")) - (symlink '(:foreground "deep sky blue")) - (vc-branch '(:box (:line-width 1 :color "#00CC33") :foreground "black" :background "#AAFFAA"))) - - (custom-theme-set-faces - 'leuven - `(default ((,class (:background "#ffffff" :foreground "#333333")))) - `(bold ((,class (:weight bold :foreground "black")))) - `(bold-italic ((,class (:weight bold :slant italic :foreground "black")))) - `(italic ((,class (:slant italic :foreground "#1A1A1A")))) - `(underline ((,class (:underline t)))) - `(cursor ((,class (:background "#15ff00")))) - ;; Highlighting faces - `(fringe ((,class (:foreground "#808080" :background "#DDEEFF")))) - `(highlight ((,class (:background "#FFFF00")))) - `(region ((t ,region))) - `(secondary-selection ((t ,match))) ;; used by Org-mode for highlighting matched entries and keywords - `(isearch ((,class (:weight bold :foreground "#00AA00" :background "#99FF99")))) - `(isearch-fail ((,class (:weight bold :foreground "black" :background "#FF9999")))) - `(lazy-highlight ((,class (:weight bold :foreground "#990099" :background "#FF66FF")))) - `(trailing-whitespace ((t (:background "#F6EBFE")))) - `(whitespace-line ((t (:foreground "#CC0000" :background "#FFFF88")))) - `(whitespace-tab ((t (:foreground "lightgray" :background "beige")))) - `(whitespace-indentation ((t (:foreground "firebrick" :background "yellow")))) - `(whitespace-trailing ((t (:weight bold :foreground "yellow" :background "red1")))) - `(whitespace-hspace ((t (:background "#CCE8F6")))) - ;; Mode line faces - `(mode-line ((,class (:box (:line-width 1 :color "#1A2F54") :foreground "#85CEEB" :background "#335EA8")))) - `(mode-line-inactive ((,class (:box (:line-width 1 :color "#4E4E4C") :foreground "#F0F0EF" :background "#9B9C97")))) - `(mode-line-buffer-id ((,class (:weight bold :foreground "white")))) - `(mode-line-emphasis ((,class (:weight bold :foreground "white")))) - `(mode-line-highlight ((,class (:foreground "yellow")))) - ;; Escape and prompt faces - `(minibuffer-prompt ((,class (:weight bold :foreground "black" :background "gold")))) - `(minibuffer-noticeable-prompt ((,class (:weight bold :foreground "black" :background "gold")))) - `(escape-glyph ((,class (:foreground "#008ED1")))) - `(error ((,class (:foreground "red")))) - `(warning ((,class (:foreground "orange")))) - `(success ((,class (:foreground "green")))) - ;; Font lock faces - `(font-lock-builtin-face ((,class (:foreground "#FF5803")))) - `(font-lock-comment-delimiter-face ((,class (:foreground "#EE0000")))) - `(font-lock-comment-face ((,class (:slant italic :foreground "#EE0000")))) - `(font-lock-constant-face ((,class (:foreground "#009944")))) - `(font-lock-doc-face ((,class (:foreground "#BA2121")))) - `(font-lock-doc-string-face ((,class (:foreground "#63639C")))) - `(font-lock-function-name-face ((,class (:foreground "#1A50B8")))) - `(font-lock-keyword-face ((,class (:bold t :foreground "#A535AE")))) - `(font-lock-preprocessor-face ((,class (:bold t :foreground "#A3A3A3")))) - `(font-lock-reference-face ((,class (:foreground "dark cyan")))) - `(font-lock-regexp-grouping-backslash ((,class (:bold t :weight bold)))) - `(font-lock-regexp-grouping-construct ((,class (:bold t :weight bold)))) - `(font-lock-string-face ((t ,string))) - `(font-lock-type-face ((,class (:foreground "#1B781F")))) - `(font-lock-variable-name-face ((,class (:foreground "#2E91AF")))) - `(font-lock-warning-face ((,class (:weight bold :foreground "red")))) - ;; Button and link faces - `(link ((,class (:foreground "#8ac6f2" :underline t)))) - `(link-visited ((,class (:foreground "#e5786d" :underline t)))) - `(button ((,class (:underline t :foreground "#006DAF")))) - `(header-line ((,class (:weight bold :underline "black" :overline "black" :foreground "black" :background "#FFFF88")))) - ;; Gnus faces - `(gnus-group-news-1-empty ((,class (:foreground "#5050B0")))) - `(gnus-group-news-1 ((,class (:weight bold :foreground "#FF50B0")))) - `(gnus-group-news-2-empty ((,class (:foreground "#660066")))) - `(gnus-group-news-2 ((,class (:weight bold :foreground "#FF0066")))) - `(gnus-group-news-3-empty ((,class (:foreground "#808080")))) - `(gnus-group-news-3 ((,class (:weight bold :foreground "black")))) - `(gnus-group-news-4-empty ((,class (:foreground "#990000")))) - `(gnus-group-news-4 ((,class (:weight bold :foreground "#FF0000")))) - `(gnus-group-news-5-empty ((,class (:foreground "#000099")))) - `(gnus-group-news-5 ((,class (:weight bold :foreground "#FF0099")))) - `(gnus-group-news-6-empty ((,class (:foreground "#808080")))) - `(gnus-group-news-6 ((,class (:weight bold :foreground "gray50")))) - `(gnus-group-mail-1-empty ((,class (:foreground "#5050B0")))) - `(gnus-group-mail-1 ((,class (:weight bold :foreground "#FF50B0")))) - `(gnus-group-mail-2-empty ((,class (:foreground "#660066")))) - `(gnus-group-mail-2 ((,class (:weight bold :foreground "#FF0066")))) - `(gnus-group-mail-3-empty ((,class (:foreground "#808080")))) - `(gnus-group-mail-3 ((,class (:weight bold :foreground "black")))) - `(gnus-group-mail-low-empty ((t ,cancel))) - `(gnus-group-mail-low ((t ,cancel))) - `(gnus-header-content ((,class (:family "Sans Serif" :foreground "#786FB4")))) - `(gnus-header-from ((,class (:family "Sans Serif" :foreground "blue")))) - `(gnus-header-subject ((t ,subject))) - `(gnus-header-name ((t ,mail-header-name))) - `(gnus-header-newsgroups ((,class (:family "Sans Serif" :foreground "#3399CC")))) - ;; Message faces - `(message-header-name ((t ,mail-header-name))) - `(message-header-cc ((,class (:family "Sans Serif" :foreground "blue")))) - `(message-header-other ((,class (:family "Sans Serif" :foreground "#3399CC")))) - `(message-header-subject ((t ,subject))) - `(message-header-to ((,class (:family "Sans Serif" :foreground "blue")))) - `(message-cited-text ((,class (:foreground "#5050B0")))) - `(message-separator ((,class (:family "Sans Serif" :weight bold :foreground "red")))) - `(message-header-newsgroups ((,class (:family "Sans Serif" :foreground "#3399CC")))) - `(message-header-xheader ((,class (:foreground "red")))) - `(message-mml ((,class (:foreground "forest green")))) - ;; Diff - `(diff-added ((t ,diff-added))) - `(diff-changed ((,class (:foreground "blue" :background "#DDDDFF")))) - `(diff-context ((t ,diff-none))) - `(diff-file-header ((,class (:foreground "#0000CC" :background "#EAF2F5")))) - `(diff-file1-hunk-header ((,class (:foreground "dark magenta" :background "#EAF2F5")))) - `(diff-file2-hunk-header ((,class (:foreground "#2B7E2A" :background "#EAF2F5")))) - `(diff-header ((,class (:foreground "#999999" :background "#EAF2F5")))) - `(diff-hunk-header ((t ,diff-hunk-header))) - `(diff-index ((,class (:family "Sans Serif" :height 1.1 :weight bold :foreground "#4183C4" :background "#EAF2F5")))) - `(diff-indicator-added ((,class (:background "#AAFFAA")))) - `(diff-indicator-changed ((,class (:background "#AAAAFF")))) - `(diff-indicator-removed ((,class (:background "#FFAAAA")))) - `(diff-refine-change ((,class (:background "#DDDDFF")))) - `(diff-removed ((t ,diff-removed))) - ;; SMerge - `(smerge-refined-change ((,class (:background "#AAAAFF")))) - ;; Ediff - `(ediff-current-diff-A ((,class (:foreground "gray33" :background "#FFDDDD")))) - `(ediff-current-diff-B ((,class (:foreground "gray33" :background "#DDFFDD")))) - `(ediff-current-diff-C ((,class (:foreground "black" :background "cyan")))) - `(ediff-even-diff-A ((,class (:foreground "black" :background "light grey")))) - `(ediff-even-diff-B ((,class (:foreground "black" :background "light grey")))) - `(ediff-fine-diff-A ((,class (:foreground "#A60000" :background "#FFAAAA")))) - `(ediff-fine-diff-B ((,class (:foreground "#008000" :background "#55FF55")))) - `(ediff-odd-diff-A ((,class (:foreground "black" :background "light grey")))) - `(ediff-odd-diff-B ((,class (:foreground "black" :background "light grey")))) - ;; Flyspell - `(flyspell-duplicate ((,class (:underline "#008000")))) - `(flyspell-incorrect ((,class (:underline "red")))) - ;; ;; Semantic faces - ;; `(semantic-decoration-on-includes ((,class (:underline ,cham-4)))) - ;; `(semantic-decoration-on-private-members-face ((,class (:background ,alum-2)))) - ;; `(semantic-decoration-on-protected-members-face ((,class (:background ,alum-2)))) - ;; `(semantic-decoration-on-unknown-includes ((,class (:background ,choc-3)))) - ;; `(semantic-decoration-on-unparsed-includes ((,class (:underline ,orange-3)))) - ;; `(semantic-tag-boundary-face ((,class (:overline ,blue-1)))) - ;; `(semantic-unmatched-syntax-face ((,class (:underline ,red-1)))) - - `(Info-title-1-face ((t ,ol1))) - `(Info-title-2-face ((t ,ol2))) - `(Info-title-3-face ((t ,ol3))) - `(Info-title-4-face ((t ,ol4))) - `(bbdb-company ((,class (:slant italic :foreground "steel blue")))) - `(bbdb-field-name ((,class (:weight bold :foreground "steel blue")))) - `(bbdb-field-value ((,class (:foreground "steel blue")))) - `(bbdb-name ((,class (:underline t :foreground "#FF6633")))) - `(browse-kill-ring-separator-face ((,class (:weight bold :foreground "slate gray")))) - `(calendar-today ((,class (:weight bold :background "#CCCCFF")))) - `(cfw:face-annotation ((,class (:foreground "RosyBrown" :inherit cfw:face-day-title)))) - `(cfw:face-day-title ((,class (:background "#F8F9FF")))) - `(cfw:face-default-content ((,class (:foreground "#2952A3")))) - `(cfw:face-default-day ((,class (:weight bold :inherit cfw:face-day-title)))) - `(cfw:face-disable ((,class (:foreground "DarkGray" :inherit cfw:face-day-title)))) - `(cfw:face-grid ((,class (:foreground "SlateBlue")))) - `(cfw:face-header ((,class (:foreground "blue" :background "#D4E5FF" :weight bold)))) - `(cfw:face-holiday ((,class (:background "#FFD5E5")))) - `(cfw:face-periods ((,class (:background "#668CD9" :foreground "white" :slant italic)))) - `(cfw:face-saturday ((,class (:foreground "SlateGray4" :background "gray90" :weight bold)))) - `(cfw:face-select ((,class (:background "#C3C9F8")))) - `(cfw:face-sunday ((,class (:foreground "red2" :background "#FFD5E5" :weight bold)))) - `(cfw:face-title ((,class (:foreground "DarkGrey" :weight bold :height 2.0 :inherit variable-pitch)))) - `(cfw:face-today ((,class (:background "#FFF7D7")))) - `(cfw:face-today-title ((,class (:background "#FAD163")))) - `(cfw:face-toolbar ((,class (:foreground "gray90" :background "gray90")))) - `(cfw:face-toolbar-button-off ((,class (:foreground "LightSkyBlue4" :background "white")))) - `(cfw:face-toolbar-button-on ((,class (:foreground "LightPink3" :background "gray94")))) - `(change-log-date-face ((,class (:foreground "purple")))) - `(change-log-file ((,class (:weight bold :foreground "#4183C4")))) - `(circe-highlight-all-nicks-face ((,class (:foreground "blue" :background "#F0F0F0")))) ;; other nick names - `(circe-highlight-nick-face ((,class (:foreground "#009300" :background "#F0F0F0")))) ;; messages with my nick cited - `(circe-my-message-face ((,class (:foreground "#8B8B8B" :background "#F0F0F0")))) - `(circe-originator-face ((,class (:foreground "blue")))) - `(circe-prompt-face ((,class (:foreground "red")))) - `(circe-server-face ((,class (:foreground "#99CAE5")))) - `(comint-highlight-input ((t ,code-block))) - `(comint-highlight-prompt ((,class (:foreground "#008ED1" :background "#EAEAFF")))) - `(compare-windows ((,class (:background "#FFFF00")))) - `(compilation-error ((,class (:weight bold :foreground "red")))) - `(compilation-info ((,class (:weight bold :foreground "#2A489E")))) ;; used for grep - `(compilation-line-number ((,class (:bold t :foreground "#A535AE")))) - `(compilation-warning ((,class (:weight bold :foreground "orange")))) - `(css-property ((,class (:foreground "#00AA00")))) - `(css-selector ((,class (:weight bold :foreground "blue")))) - `(custom-button ((,class (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) - `(custom-button-mouse ((,class (:background "grey90" :foreground "black" :box (:line-width 2 :style released-button))))) - `(custom-button-pressed ((,class (:foreground "black" :background "light grey" :box (:line-width 2 :style pressed-button))))) - `(custom-button-pressed-unraised ((,class (:underline t :foreground "magenta4")))) - `(custom-button-unraised ((,class (:underline t)))) - `(custom-changed ((,class (:foreground "white" :background "blue")))) - `(custom-comment ((,class (:background "gray85")))) - `(custom-comment-tag ((,class (:foreground "blue4")))) - `(custom-documentation ((,class (nil)))) - `(custom-face-tag ((,class (:family "Sans Serif" :weight bold :height 1.2)))) - `(custom-group-tag ((,class (:bold t :foreground "blue1" :weight bold :height 1.2)))) - `(custom-group-tag-1 ((,class (:bold t :family "Sans Serif" :foreground "red1" :weight bold :height 1.2)))) - `(custom-invalid ((,class (:foreground "yellow" :background "red")))) - `(custom-link ((,class (:underline t :foreground "blue1")))) - `(custom-modified ((,class (:foreground "white" :background "blue")))) - `(custom-rogue ((,class (:foreground "pink" :background "black")))) - `(custom-saved ((,class (:underline t)))) - `(custom-set ((,class (:foreground "blue" :background "white")))) - `(custom-state ((,class (:foreground "green4")))) - `(custom-themed ((,class (:background "blue1" :foreground "white")))) - `(custom-variable-button ((,class (:weight bold :underline t)))) - `(custom-variable-tag ((,class (:bold t :family "Sans Serif" :foreground "blue1" :weight bold :height 1.2)))) - `(diary-face ((,class (:foreground "#87C9FC")))) - `(dircolors-face-asm ((,class (:foreground "black")))) - `(dircolors-face-backup ((,class (:foreground "black")))) - `(dircolors-face-compress ((,class (:foreground "red")))) - `(dircolors-face-dir ((t ,directory))) - `(dircolors-face-doc ((,class (:foreground "black")))) - `(dircolors-face-dos ((,class (:foreground "green3")))) - `(dircolors-face-emacs ((,class (:foreground "black")))) - `(dircolors-face-exec ((,class (:foreground "green3")))) - `(dircolors-face-html ((,class (:foreground "black")))) - `(dircolors-face-img ((,class (:foreground "black")))) - `(dircolors-face-lang ((,class (:foreground "black")))) - `(dircolors-face-lang-interface ((,class (:foreground "black")))) - `(dircolors-face-make ((,class (:foreground "black")))) - `(dircolors-face-objet ((,class (:foreground "black")))) - `(dircolors-face-package ((,class (:foreground "red")))) - `(dircolors-face-paddb ((,class (:foreground "black")))) - `(dircolors-face-ps ((,class (:foreground "black")))) - `(dircolors-face-sound ((,class (:foreground "black")))) - `(dircolors-face-tar ((,class (:foreground "red")))) - `(dircolors-face-text ((,class (:foreground "black")))) - `(dircolors-face-yacc ((,class (:foreground "black")))) - `(dired-directory ((t ,directory))) - `(dired-header ((t ,directory))) - `(dired-ignored ((,class (:strike-through t :foreground "red")))) - `(dired-mark ((t ,marked-line))) - `(dired-marked ((t ,marked-line))) - `(dired-symlink ((t ,symlink))) - `(diredp-compressed-file-suffix ((,class (:foreground "red")))) - `(diredp-date-time ((,class (:foreground "purple")))) - `(diredp-dir-heading ((t ,directory))) - `(diredp-dir-priv ((t ,directory))) - `(diredp-exec-priv ((,class (:background "#03C03C")))) - `(diredp-executable-tag ((,class (:foreground "green3" :background "white")))) - `(diredp-file-name ((,class (:foreground "black")))) - `(diredp-file-suffix ((,class (:foreground "#008000")))) - `(diredp-flag-mark-line ((t ,marked-line))) - `(diredp-ignored-file-name ((,class (:strike-through t :foreground "red")))) - `(diredp-read-priv ((,class (:background "#0A99FF")))) - `(diredp-write-priv ((,class (:foreground "white" :background "#FF4040")))) - `(file-name-shadow ((t ,shadow))) - `(font-latex-bold-face ((,class (:weight bold :foreground "medium sea green")))) - `(font-latex-math-face ((,class (:foreground "blue")))) - `(font-latex-sectioning-1-face ((,class (:family "Sans Serif" :height 2.7 :weight bold :foreground "cornflower blue")))) - `(font-latex-sectioning-2-face ((t ,ol1))) - `(font-latex-sectioning-3-face ((t ,ol2))) - `(font-latex-sectioning-4-face ((t ,ol3))) - `(font-latex-sectioning-5-face ((t ,ol4))) - `(font-latex-sedate-face ((,class (:foreground "#FF5803")))) - `(font-latex-string-face ((,class (:bold t :foreground "#0066FF")))) - `(font-latex-verbatim-face ((,class (:foreground "tan1")))) - `(gnus-cite-attribution-face ((,class (:foreground "#5050B0")))) - `(gnus-cite-face-1 ((,class (:foreground "#5050B0")))) - `(gnus-cite-face-10 ((,class (:foreground "#990000")))) - `(gnus-cite-face-2 ((,class (:foreground "#660066")))) - `(gnus-cite-face-3 ((,class (:foreground "#007777")))) - `(gnus-cite-face-4 ((,class (:foreground "#990000")))) - `(gnus-cite-face-5 ((,class (:foreground "#000099")))) - `(gnus-cite-face-6 ((,class (:foreground "#BB6600")))) - `(gnus-cite-face-7 ((,class (:foreground "#5050B0")))) - `(gnus-cite-face-8 ((,class (:foreground "#660066")))) - `(gnus-cite-face-9 ((,class (:foreground "#007777")))) - `(gnus-emphasis-bold ((,class (:weight bold)))) - `(gnus-emphasis-highlight-words ((,class (:foreground "yellow" :background "black")))) - `(gnus-picon ((,class (:foreground "yellow" :background "white")))) - `(gnus-picon-xbm ((,class (:foreground "yellow" :background "white")))) - `(gnus-signature ((,class (:foreground "#7F7F7F")))) - `(gnus-splash ((,class (:foreground "#FF8C00")))) - `(gnus-summary-cancelled ((t ,cancel))) - `(gnus-summary-high-ancient ((,class (:weight normal :foreground "#808080" :background "#FFFFE6")))) - `(gnus-summary-high-read ((,class (:weight normal :foreground "#808080" :background "#FFFFE6")))) - `(gnus-summary-high-ticked ((,class (:weight normal :foreground "black" :background "#E7AEB0")))) - `(gnus-summary-high-unread ((,class (:weight normal :foreground "black" :background "#FFFFCC")))) - `(gnus-summary-low-ancient ((,class (:slant italic :foreground "gray55")))) - `(gnus-summary-low-read ((,class (:slant italic :foreground "gray55" :background "#E0E0E0")))) - `(gnus-summary-low-ticked ((,class (:slant italic :foreground "black" :background "#E7AEB0")))) - `(gnus-summary-low-unread ((,class (:slant italic :foreground "black")))) - `(gnus-summary-normal-ancient ((,class (:foreground "#808080")))) - `(gnus-summary-normal-read ((,class (:foreground "#808080")))) - `(gnus-summary-normal-ticked ((,class (:foreground "black" :background "#E7AEB0")))) - `(gnus-summary-normal-unread ((,class (:foreground "black")))) - `(gnus-summary-selected ((,class (:foreground "black" :background "#FFD0D0" :underline t)))) - `(gnus-x-face ((,class (:foreground "black" :background "white")))) - `(helm-action ((,class (:foreground "#335EA8")))) - `(helm-bookmarks-su-face ((,class (:foreground "red")))) - `(helm-candidate-number ((,class (:foreground "black" :background "#FFFF66")))) - `(helm-dir-heading ((,class (:foreground "blue" :background "pink")))) - `(helm-dir-priv ((,class (:foreground "dark red" :background "light grey")))) - `(helm-ff-directory ((t ,directory))) - `(helm-ff-executable ((,class (:foreground "green3" :background "white")))) - `(helm-ff-file ((,class (:foreground "black")))) - `(helm-ff-invalid-symlink ((,class (:foreground "yellow" :background "red")))) - `(helm-ff-symlink ((t ,symlink))) - `(helm-file-name ((,class (:foreground "blue")))) - `(helm-gentoo-match-face ((,class (:foreground "red")))) - `(helm-grep-running ((,class (:weight bold :foreground "white")))) - `(helm-isearch-match ((,class (:background "#CCFFCC")))) - `(helm-match ((t ,match))) - `(helm-overlay-line-face ((,class (:underline t :foreground "white" :background "IndianRed4")))) - `(helm-selection ((t ,highlight-line))) - `(helm-source-header ((,class (:family "Sans Serif" :height 1.3 :weight bold :foreground "white" :background "#666699")))) - `(helm-visible-mark ((t ,marked-line))) - `(helm-w3m-bookmarks-face ((,class (:underline t :foreground "cyan1")))) - `(highlight-symbol-face ((,class (:background "#FFFFA0")))) - `(hl-line ((t ,highlight-line))) - `(holiday-face ((,class (:background "#B6B2AE")))) - `(html-helper-bold-face ((,class (:weight bold :foreground "black")))) - `(html-helper-italic-face ((,class (:slant italic :foreground "black")))) - `(html-helper-underline-face ((,class (:underline t :foreground "black")))) - `(html-tag-face ((,class (:foreground "blue")))) - `(info-file ((,class (:family "Sans Serif" :height 1.8 :weight bold :box (:line-width 1 :color "#0000CC") :foreground "cornflower blue" :background "LightSteelBlue1")))) - `(info-header-node ((,class (:underline t :foreground "orange")))) ;; nodes in header - `(info-header-xref ((,class (:underline t :foreground "dodger blue")))) ;; cross references in header - `(info-menu-header ((,class (:family "Sans Serif" :height 1.6 :weight bold :underline t :foreground "#00CC00")))) ;; menu titles (headers) -- major topics - `(info-menu-star ((,class (:foreground "black")))) ;; every 3rd menu item - `(info-node ((,class (:underline t :foreground "blue")))) ;; node names - `(info-quoted-name ((t ,code-inline))) - `(info-string ((t ,string))) - `(info-title-1 ((t ,ol1))) - `(info-xref ((,class (:weight bold :underline t :foreground "blue")))) ;; unvisited cross-references - `(info-xref-visited ((,class (:weight bold :foreground "magenta4")))) ;; previously visited cross-references - `(light-symbol-face ((,class (:background "#FFFFA0")))) - `(linum ((,class (:foreground "#AFB7BA" :background "#DDEEFF")))) - `(log-view-file ((,class (:foreground "#0000CC" :background "#EAF2F5")))) - `(lui-button-face ((t ,link))) - `(lui-highlight-face ((,class (:box '(:line-width 1 :color "#CC0000") :foreground "#CC0000" :background "#FFFF88")))) ;; my nickname - `(lui-time-stamp-face ((,class (:foreground "purple")))) - `(magit-branch ((t ,vc-branch))) - `(magit-diff-add ((t ,diff-added))) - `(magit-diff-del ((t ,diff-removed))) - `(magit-diff-file-header ((,class (:family "Sans Serif" :height 1.1 :weight bold :foreground "#4183C4")))) - `(magit-diff-hunk-header ((t ,diff-hunk-header))) - `(magit-diff-none ((t ,diff-none))) - `(magit-header ((,class (:foreground "white" :background "#FF4040")))) - `(magit-item-highlight ((,class (:background "#EAF2F5")))) - `(magit-item-mark ((t ,marked-line))) - `(magit-log-head-label ((,class (:box (:line-width 1 :color "blue" :style nil))))) - `(magit-log-tag-label ((,class (:box (:line-width 1 :color "#00CC00" :style nil))))) - `(magit-section-title ((,class (:family "Sans Serif" :height 1.8 :weight bold :foreground "cornflower blue")))) - `(makefile-space-face ((,class (:background "hot pink")))) - `(makefile-targets ((,class (:weight bold :foreground "blue")))) - `(match ((t ,match))) - `(mm-uu-extract ((t ,code-block))) - `(moccur-current-line-face ((,class (:background "#FFFFCC" :foreground "black")))) - `(moccur-face ((,class (:background "#FFFF99" :foreground "black")))) - `(nobreak-space ((,class (:background "#CCE8F6")))) - `(nxml-attribute-local-name-face ((,class (:foreground "magenta")))) - `(nxml-attribute-value-delimiter-face ((,class (:foreground "green4")))) - `(nxml-attribute-value-face ((,class (:foreground "green4")))) - `(nxml-comment-content-face ((,class (:slant italic :foreground "red")))) - `(nxml-comment-delimiter-face ((,class (:foreground "red")))) - `(nxml-element-local-name ((,class (:box (:line-width 1 :color "#999999") :background "#DEDEDE" :foreground "#000088")))) - `(nxml-element-local-name-face ((,class (:foreground "blue")))) - `(nxml-processing-instruction-target-face ((,class (:foreground "purple1")))) - `(nxml-tag-delimiter-face ((,class (:foreground "blue")))) - `(nxml-tag-slash-face ((,class (:foreground "blue")))) - `(org-agenda-calendar-event ((,class (:weight bold :foreground "white" :background "#1662AF")))) - `(org-agenda-calendar-sexp ((,class (:foreground "black" :background "#80CBFF")))) - `(org-agenda-clocking ((t ,clock-line))) - `(org-agenda-column-dateline ((t ,column))) - `(org-agenda-current-time ((,class (:underline t :foreground "#1662AF")))) - `(org-agenda-date ((,class (:height 1.6 :weight normal :foreground "#0063F5")))) - `(org-agenda-date-today ((,class (:height 1.6 :weight bold :foreground "#1662AF")))) - `(org-agenda-date-weekend ((,class (:height 1.6 :weight normal :foreground "dim gray")))) - `(org-agenda-diary ((,class (:weight bold :foreground "green4" :background "light blue")))) - `(org-agenda-dimmed-todo-face ((,class (:foreground "gold2")))) - `(org-agenda-done ((,class (:foreground "#555555" :background "#EEEEEE")))) - `(org-agenda-filter-category ((,class (:weight bold :foreground "orange")))) - `(org-agenda-filter-tags ((,class (:weight bold :foreground "orange")))) - `(org-agenda-restriction-lock ((,class (:weight bold :foreground "white" :background "orange")))) - `(org-agenda-structure ((,class (:height 1.6 :weight bold :box (:line-width 1 :color "#999999") :foreground "#666666" :background "#CCCCCC")))) - `(org-archived ((,class (:foreground "gray70")))) - `(org-beamer-tag ((,class (:box (:line-width 1 :color "#FABC18") :foreground "#2C2C2C" :background "#FFF8D0")))) - `(org-block ((t ,code-block))) - `(org-block-background ((,class (:background "#FFFFE0")))) - `(org-block-begin-line ((,class (:underline "#A7A6AA" :foreground "#555555" :background "#E2E1D5")))) - `(org-block-end-line ((,class (:overline "#A7A6AA" :foreground "#555555" :background "#E2E1D5")))) - `(org-checkbox ((,class (:weight bold :foreground "white" :background "#777777" :box (:line-width 1 :style pressed-button))))) - `(org-clock-overlay ((,class (:foreground "white" :background "SkyBlue4")))) - `(org-code ((t ,code-inline))) - `(org-column ((t ,column))) - `(org-column-title ((t ,column))) - `(org-date ((,class (:underline t :foreground "#00459E")))) - `(org-default ((,class (:foreground "#333333")))) - `(org-dim ((,class (:foreground "#AAAAAA")))) - `(org-document-info ((,class (:foreground "#484848")))) - `(org-document-info-keyword ((,class (:foreground "#008ED1" :background "#EAEAFF")))) - `(org-document-title ((,class (:family "Sans Serif" :height 1.8 :weight bold :foreground "black")))) - `(org-done ((,class (:weight bold :box (:line-width 1 :color "#BBBBBB") :foreground "#BBBBBB" :background "#F0F0F0")))) - `(org-drawer ((,class (:foreground "light sky blue")))) - `(org-ellipsis ((,class (:underline "#B0EEB0" :foreground "#00BB00")))) - `(org-example ((,class (:foreground "blue" :background "#EAFFEA")))) - `(org-footnote ((,class (:underline t :foreground "#008ED1")))) - `(org-formula ((,class (:foreground "chocolate1")))) - `(org-headline-done ((,class (:height 1.0 :weight bold :strike-through "#BEBEBE" :foreground "#C5C5C5")))) - `(org-hide ((,class (:foreground "#E2E2E2")))) - `(org-inlinetask ((,class (:box (:line-width 1 :color "#EBEBEB") :foreground "#777777" :background "#FFFFD6")))) - `(org-latex-and-export-specials ((,class (:foreground "blue")))) - `(org-level-1 ((t ,ol1))) - `(org-level-2 ((t ,ol2))) - `(org-level-3 ((t ,ol3))) - `(org-level-4 ((t ,ol4))) - `(org-level-5 ((t ,ol5))) - `(org-level-6 ((t ,ol6))) - `(org-level-7 ((t ,ol7))) - `(org-level-8 ((t ,ol8))) - `(org-link ((t ,link))) - `(org-list-dt ((,class (:weight bold :foreground "#335EA8")))) - `(org-meta-line ((,class (:slant normal :foreground "#008ED1" :background "#EAEAFF")))) - `(org-mode-line-clock ((t ,clock-line))) - `(org-mode-line-clock-overrun ((,class (:weight bold :box (:line-width 1 :color "#335EA8") :foreground "white" :background "#FF4040")))) - `(org-number-of-items ((,class (:weight bold :foreground "white" :background "#79BA79")))) - `(org-property-value ((,class (:foreground "#00A000")))) - `(org-quote ((,class (:slant italic :foreground "dim gray" :background "#FFFFE0")))) - `(org-scheduled ((,class (:slant italic :foreground "#0063DC")))) - `(org-scheduled-previously ((,class (:weight bold :foreground "#373737")))) - `(org-scheduled-today ((,class (:foreground "black" :background "#FFFFCB")))) - `(org-sexp-date ((,class (:foreground "purple")))) - `(org-special-keyword ((,class (:weight bold :foreground "#00BB00" :background "#EAFFEA")))) - `(org-table ((,class (:foreground "dark green" :background "#EAFFEA")))) - `(org-tag ((,class (:height 1.0 :weight normal :slant italic :foreground "#3C424F" :background "#E5ECFA")))) - `(org-target ((,class (:underline t)))) - `(org-time-grid ((,class (:foreground "#6D6D6D")))) - `(org-todo ((,class (:weight bold :box (:line-width 1 :color "#D8ABA7") :foreground "#D8ABA7" :background "#FFE6E4")))) - `(org-upcoming-deadline ((,class (:foreground "#FF5555")))) - `(org-verbatim ((,class (:box (:line-width 1 :color "#DDDDDD") :foreground "#000088" :background "#E0FFE0")))) - `(org-verse ((,class (:slant italic :foreground "dim gray" :background "#EEEEEE")))) - `(org-warning ((,class (:weight bold :foreground "black" :background "#CCE7FF")))) - `(outline-1 ((t ,ol1))) - `(outline-2 ((t ,ol2))) - `(outline-3 ((t ,ol3))) - `(outline-4 ((t ,ol4))) - `(outline-5 ((t ,ol5))) - `(outline-6 ((t ,ol6))) - `(outline-7 ((t ,ol7))) - `(outline-8 ((t ,ol8))) - `(pabbrev-debug-display-label-face ((,class (:background "chartreuse")))) - `(pabbrev-suggestions-face ((,class (:weight bold :foreground "white" :background "red")))) - `(pabbrev-suggestions-label-face ((,class (:weight bold :foreground "white" :background "purple")))) - `(paren-face-match ((,class (:foreground "white" :background "#FF3F3F")))) - `(paren-face-mismatch ((,class (:weight bold :foreground "white" :background "purple")))) - `(paren-face-no-match ((,class (:weight bold :foreground "white" :background "purple")))) - `(pp^L-highlight ((,class (:strike-through t)))) - `(recover-this-file ((,class (:background "white" :background "#FF3F3F")))) - `(sh-heredoc ((,class (:foreground "blue" :background "#FBF9EA")))) - `(shadow ((t ,shadow))) - `(shell-option-face ((,class (:foreground "forest green")))) - `(shell-output-2-face ((,class (:foreground "blue")))) - `(shell-output-3-face ((,class (:foreground "purple")))) - `(shell-output-face ((,class (:foreground "black")))) - `(shell-prompt-face ((,class (:weight bold :foreground "yellow")))) - `(show-paren-match ((,class (:foreground "white" :background "#FF3F3F")))) - `(show-paren-mismatch ((,class (:weight bold :foreground "white" :background "purple")))) - `(speedbar-button-face ((,class (:foreground "green4")))) - `(speedbar-directory-face ((,class (:foreground "blue4")))) - `(speedbar-file-face ((,class (:foreground "cyan4")))) - `(speedbar-highlight-face ((,class (:background "green")))) - `(speedbar-selected-face ((,class (:underline t :foreground "red")))) - `(speedbar-tag-face ((,class (:foreground "brown")))) - `(svn-status-directory-face ((t ,directory))) - `(svn-status-filename-face ((,class (:weight bold :foreground "#4183C4")))) - `(svn-status-locked-face ((,class (:weight bold :foreground "red")))) - `(svn-status-marked-face ((t ,marked-line))) - `(svn-status-marked-popup-face ((,class (:weight bold :foreground "green3")))) - `(svn-status-switched-face ((,class (:slant italic :foreground "gray55")))) - `(svn-status-symlink-face ((t ,symlink))) - `(svn-status-update-available-face ((,class (:foreground "orange")))) - `(tex-verbatim ((,class (:foreground "blue")))) - `(tool-bar ((,class (:box (:line-width 1 :style released-button) :foreground "black" :background "gray75")))) - `(tooltip ((,class (:foreground "black" :background "light yellow")))) - `(trailing-whitespace ((,class (:background "#F6EBFE")))) - `(traverse-match-face ((,class (:weight bold :foreground "blue violet")))) - `(vc-annotate-face-3F3FFF ((,class (:foreground "#3F3FFF" :background "black")))) - `(vc-annotate-face-3F6CFF ((,class (:foreground "#3F3FFF" :background "black")))) - `(vc-annotate-face-3F99FF ((,class (:foreground "#3F99FF" :background "black")))) - `(vc-annotate-face-3FC6FF ((,class (:foreground "#3F99FF" :background "black")))) - `(vc-annotate-face-3FF3FF ((,class (:foreground "#3FF3FF" :background "black")))) - `(vc-annotate-face-3FFF56 ((,class (:foreground "#4BFF4B" :background "black")))) - `(vc-annotate-face-3FFF83 ((,class (:foreground "#3FFFB0" :background "black")))) - `(vc-annotate-face-3FFFB0 ((,class (:foreground "#3FFFB0" :background "black")))) - `(vc-annotate-face-3FFFDD ((,class (:foreground "#3FF3FF" :background "black")))) - `(vc-annotate-face-56FF3F ((,class (:foreground "#4BFF4B" :background "black")))) - `(vc-annotate-face-83FF3F ((,class (:foreground "#B0FF3F" :background "black")))) - `(vc-annotate-face-B0FF3F ((,class (:foreground "#B0FF3F" :background "black")))) - `(vc-annotate-face-DDFF3F ((,class (:foreground "#FFF33F" :background "black")))) - `(vc-annotate-face-FF3F3F ((,class (:foreground "#FF3F3F" :background "black")))) - `(vc-annotate-face-FF6C3F ((,class (:foreground "#FF3F3F" :background "black")))) - `(vc-annotate-face-FF993F ((,class (:foreground "#FF993F" :background "black")))) - `(vc-annotate-face-FFC63F ((,class (:foreground "#FF993F" :background "black")))) - `(vc-annotate-face-FFF33F ((,class (:foreground "#FFF33F" :background "black")))) - `(w3m-anchor ((t ,link))) - `(w3m-arrived-anchor ((,class (:foreground "purple1")))) - `(w3m-bitmap-image-face ((,class (:foreground "gray4" :background "green")))) - `(w3m-bold ((,class (:weight bold :foreground "medium sea green")))) - `(w3m-current-anchor ((,class (:weight bold :underline t :foreground "blue")))) - `(w3m-form ((,class (:underline t :foreground "tan1")))) - `(w3m-form-button-face ((,class (:weight bold :underline t :foreground "gray4" :background "light grey")))) - `(w3m-form-button-mouse-face ((,class (:underline t :foreground "light grey" :background "#2B7E2A")))) - `(w3m-form-button-pressed-face ((,class (:weight bold :underline t :foreground "gray4" :background "light grey")))) - `(w3m-header-line-location-content-face ((,class (:foreground "#7F7F7F":background "#F7F7F7")))) - `(w3m-header-line-location-title-face ((,class (:foreground "#2C55B1" :background "#F7F7F7")))) - `(w3m-history-current-url-face ((,class (:foreground "lemon chiffon")))) - `(w3m-image-face ((,class (:weight bold :foreground "DarkSeaGreen2")))) - `(w3m-link-numbering ((,class (:foreground "#B4C7EB")))) ;; mouseless browsing - `(w3m-strike-through-face ((,class (:strike-through t)))) - `(w3m-underline-face ((,class (:underline t)))) - `(which-func ((,class (:weight bold :foreground "white")))) - `(whitespace-hspace ((,class (:background "#CCE8F6")))) - `(whitespace-indentation ((,class (:foreground "firebrick" :background "yellow")))) - `(whitespace-line ((,class (:foreground "#CC0000" :background "#FFFF88")))) - `(whitespace-tab ((,class (:foreground "lightgray" :background "beige")))) - `(whitespace-trailing ((,class (:weight bold :foreground "yellow" :background "red1")))) - `(widget-button-face ((t ,link))) - `(widget-button-pressed-face ((,class (:foreground "red")))) - `(widget-documentation-face ((,class (:foreground "green4")))) - `(widget-field-face ((,class (:background "gray85")))) - `(widget-inactive-face ((,class (:foreground "dim gray")))) - `(widget-single-line-field-face ((,class (:background "gray85")))) - `(yas/field-debug-face ((,class (:background "ivory2")))) - `(yas/field-highlight-face ((,class (:background "DarkSeaGreen1")))) - )) - -(custom-theme-set-variables - 'leuven - '(ansi-color-names-vector ["#242424" "#e5786d" "#95e454" "#cae682" - "#8ac6f2" "#333366" "#ccaa8f" "#f6f3e8"])) - -(provide-theme 'leuven) - -;; Local Variables: -;; no-byte-compile: t -;; End: - -;;; leuven-theme.el ends here +;;; leuven-theme.el --- Emacs custom theme + +;; Copyright (C) 2003-2012 Free Software Foundation, Inc. +;; Time-stamp: <2012-12-05 Wed 10:47> + +;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(deftheme leuven + "Face colors with a light background. +Basic, Font Lock, Isearch, Gnus, Message, Diff, Ediff, Flyspell, +Semantic, and Ansi-Color faces are included -- and much more...") + +(let ((class '((class color) (min-colors 89))) + ;; Leuven generic colors + (cancel '(:slant italic :strike-through t :foreground "gray55")) + (clock-line '(:box (:line-width 1 :color "#335EA8") :foreground "black" :background "#EEC900")) + (code-block '(:foreground "#000088" :background "#FBF9EA")) + (code-inline '(:box (:line-width 1 :color "#DDDDDD") :foreground "#000088" :background "#FFFFE0")) + (column '(:height 1.0 :weight normal :slant normal :underline nil :strike-through nil :foreground "#E6AD4F" :background "#FFF2DE")) + (diff-added '(:foreground "#008000" :background "#DDFFDD")) + (diff-hunk-header '(:box (:line-width 1 :color "#FFE0FF") :foreground "#990099" :background "#FFEEFF")) + (diff-none '(:foreground "gray33")) + (diff-removed '(:foreground "#A60000" :background "#FFDDDD")) + (directory '(:weight bold :foreground "blue" :background "#FFFFD2")) + (highlight-line '(:inverse-video t)) + (link '(:underline t :foreground "#006DAF")) + (mail-header-name '(:weight bold :foreground "black")) + (marked-line '(:weight bold :foreground "white" :background "red")) + (match '(:background "#FFFF99")) + (ol1 '(:height 1.3 :weight bold :overline "#A7A7A7" :foreground "#3C3C3C" :background "#F0F0F0")) + (ol2 '(:height 1.0 :weight bold :overline "#123555" :foreground "#123555" :background "#E5F4FB")) + (ol3 '(:height 1.0 :weight bold :overline "#005522" :foreground "#005522" :background "#EFFFEF")) + (ol4 '(:height 1.0 :weight bold :slant normal :foreground "#EA6300")) + (ol5 '(:height 1.0 :weight bold :slant normal :foreground "#E3258D")) + (ol6 '(:height 1.0 :weight bold :slant italic :foreground "#0077CC")) + (ol7 '(:height 1.0 :weight bold :slant italic :foreground "#2EAE2C")) + (ol8 '(:height 1.0 :weight bold :slant italic :foreground "#FD8008")) + (region '(:background "#D2D9E0")) + (shadow '(:foreground "#7F7F7F")) + (string '(:foreground "#008000")) + (subject '(:weight bold :foreground "#CF5D60")) + (symlink '(:foreground "deep sky blue")) + (vc-branch '(:box (:line-width 1 :color "#00CC33") :foreground "black" :background "#AAFFAA"))) + + (custom-theme-set-faces + 'leuven + `(default ((,class (:background "#ffffff" :foreground "#333333")))) + `(bold ((,class (:weight bold :foreground "black")))) + `(bold-italic ((,class (:weight bold :slant italic :foreground "black")))) + `(italic ((,class (:slant italic :foreground "#1A1A1A")))) + `(underline ((,class (:underline t)))) + `(cursor ((,class (:background "#15ff00")))) + ;; Highlighting faces + `(fringe ((,class (:foreground "#808080" :background "#DDEEFF")))) + `(highlight ((,class (:background "#FFFF00")))) + `(region ((t ,region))) + `(secondary-selection ((t ,match))) ;; used by Org-mode for highlighting matched entries and keywords + `(isearch ((,class (:weight bold :foreground "#00AA00" :background "#99FF99")))) + `(isearch-fail ((,class (:weight bold :foreground "black" :background "#FF9999")))) + `(lazy-highlight ((,class (:weight bold :foreground "#990099" :background "#FF66FF")))) + `(trailing-whitespace ((t (:background "#F6EBFE")))) + `(whitespace-line ((t (:foreground "#CC0000" :background "#FFFF88")))) + `(whitespace-tab ((t (:foreground "lightgray" :background "beige")))) + `(whitespace-indentation ((t (:foreground "firebrick" :background "yellow")))) + `(whitespace-trailing ((t (:weight bold :foreground "yellow" :background "red1")))) + `(whitespace-hspace ((t (:background "#CCE8F6")))) + ;; Mode line faces + `(mode-line ((,class (:box (:line-width 1 :color "#1A2F54") :foreground "#85CEEB" :background "#335EA8")))) + `(mode-line-inactive ((,class (:box (:line-width 1 :color "#4E4E4C") :foreground "#F0F0EF" :background "#9B9C97")))) + `(mode-line-buffer-id ((,class (:weight bold :foreground "white")))) + `(mode-line-emphasis ((,class (:weight bold :foreground "white")))) + `(mode-line-highlight ((,class (:foreground "yellow")))) + ;; Escape and prompt faces + `(minibuffer-prompt ((,class (:weight bold :foreground "black" :background "gold")))) + `(minibuffer-noticeable-prompt ((,class (:weight bold :foreground "black" :background "gold")))) + `(escape-glyph ((,class (:foreground "#008ED1")))) + `(error ((,class (:foreground "red")))) + `(warning ((,class (:foreground "orange")))) + `(success ((,class (:foreground "green")))) + ;; Font lock faces + `(font-lock-builtin-face ((,class (:foreground "#FF5803")))) + `(font-lock-comment-delimiter-face ((,class (:foreground "#EE0000")))) + `(font-lock-comment-face ((,class (:slant italic :foreground "#EE0000")))) + `(font-lock-constant-face ((,class (:foreground "#009944")))) + `(font-lock-doc-face ((,class (:foreground "#BA2121")))) + `(font-lock-doc-string-face ((,class (:foreground "#63639C")))) + `(font-lock-function-name-face ((,class (:foreground "#1A50B8")))) + `(font-lock-keyword-face ((,class (:bold t :foreground "#A535AE")))) + `(font-lock-preprocessor-face ((,class (:bold t :foreground "#A3A3A3")))) + `(font-lock-reference-face ((,class (:foreground "dark cyan")))) + `(font-lock-regexp-grouping-backslash ((,class (:bold t :weight bold)))) + `(font-lock-regexp-grouping-construct ((,class (:bold t :weight bold)))) + `(font-lock-string-face ((t ,string))) + `(font-lock-type-face ((,class (:foreground "#1B781F")))) + `(font-lock-variable-name-face ((,class (:foreground "#2E91AF")))) + `(font-lock-warning-face ((,class (:weight bold :foreground "red")))) + ;; Button and link faces + `(link ((,class (:foreground "#8ac6f2" :underline t)))) + `(link-visited ((,class (:foreground "#e5786d" :underline t)))) + `(button ((,class (:underline t :foreground "#006DAF")))) + `(header-line ((,class (:weight bold :underline "black" :overline "black" :foreground "black" :background "#FFFF88")))) + ;; Gnus faces + `(gnus-group-news-1-empty ((,class (:foreground "#5050B0")))) + `(gnus-group-news-1 ((,class (:weight bold :foreground "#FF50B0")))) + `(gnus-group-news-2-empty ((,class (:foreground "#660066")))) + `(gnus-group-news-2 ((,class (:weight bold :foreground "#FF0066")))) + `(gnus-group-news-3-empty ((,class (:foreground "#808080")))) + `(gnus-group-news-3 ((,class (:weight bold :foreground "black")))) + `(gnus-group-news-4-empty ((,class (:foreground "#990000")))) + `(gnus-group-news-4 ((,class (:weight bold :foreground "#FF0000")))) + `(gnus-group-news-5-empty ((,class (:foreground "#000099")))) + `(gnus-group-news-5 ((,class (:weight bold :foreground "#FF0099")))) + `(gnus-group-news-6-empty ((,class (:foreground "#808080")))) + `(gnus-group-news-6 ((,class (:weight bold :foreground "gray50")))) + `(gnus-group-mail-1-empty ((,class (:foreground "#5050B0")))) + `(gnus-group-mail-1 ((,class (:weight bold :foreground "#FF50B0")))) + `(gnus-group-mail-2-empty ((,class (:foreground "#660066")))) + `(gnus-group-mail-2 ((,class (:weight bold :foreground "#FF0066")))) + `(gnus-group-mail-3-empty ((,class (:foreground "#808080")))) + `(gnus-group-mail-3 ((,class (:weight bold :foreground "black")))) + `(gnus-group-mail-low-empty ((t ,cancel))) + `(gnus-group-mail-low ((t ,cancel))) + `(gnus-header-content ((,class (:family "Sans Serif" :foreground "#786FB4")))) + `(gnus-header-from ((,class (:family "Sans Serif" :foreground "blue")))) + `(gnus-header-subject ((t ,subject))) + `(gnus-header-name ((t ,mail-header-name))) + `(gnus-header-newsgroups ((,class (:family "Sans Serif" :foreground "#3399CC")))) + ;; Message faces + `(message-header-name ((t ,mail-header-name))) + `(message-header-cc ((,class (:family "Sans Serif" :foreground "blue")))) + `(message-header-other ((,class (:family "Sans Serif" :foreground "#3399CC")))) + `(message-header-subject ((t ,subject))) + `(message-header-to ((,class (:family "Sans Serif" :foreground "blue")))) + `(message-cited-text ((,class (:foreground "#5050B0")))) + `(message-separator ((,class (:family "Sans Serif" :weight bold :foreground "red")))) + `(message-header-newsgroups ((,class (:family "Sans Serif" :foreground "#3399CC")))) + `(message-header-xheader ((,class (:foreground "red")))) + `(message-mml ((,class (:foreground "forest green")))) + ;; Diff + `(diff-added ((t ,diff-added))) + `(diff-changed ((,class (:foreground "blue" :background "#DDDDFF")))) + `(diff-context ((t ,diff-none))) + `(diff-file-header ((,class (:foreground "#0000CC" :background "#EAF2F5")))) + `(diff-file1-hunk-header ((,class (:foreground "dark magenta" :background "#EAF2F5")))) + `(diff-file2-hunk-header ((,class (:foreground "#2B7E2A" :background "#EAF2F5")))) + `(diff-header ((,class (:foreground "#999999" :background "#EAF2F5")))) + `(diff-hunk-header ((t ,diff-hunk-header))) + `(diff-index ((,class (:family "Sans Serif" :height 1.1 :weight bold :foreground "#4183C4" :background "#EAF2F5")))) + `(diff-indicator-added ((,class (:background "#AAFFAA")))) + `(diff-indicator-changed ((,class (:background "#AAAAFF")))) + `(diff-indicator-removed ((,class (:background "#FFAAAA")))) + `(diff-refine-change ((,class (:background "#DDDDFF")))) + `(diff-removed ((t ,diff-removed))) + ;; SMerge + `(smerge-refined-change ((,class (:background "#AAAAFF")))) + ;; Ediff + `(ediff-current-diff-A ((,class (:foreground "gray33" :background "#FFDDDD")))) + `(ediff-current-diff-B ((,class (:foreground "gray33" :background "#DDFFDD")))) + `(ediff-current-diff-C ((,class (:foreground "black" :background "cyan")))) + `(ediff-even-diff-A ((,class (:foreground "black" :background "light grey")))) + `(ediff-even-diff-B ((,class (:foreground "black" :background "light grey")))) + `(ediff-fine-diff-A ((,class (:foreground "#A60000" :background "#FFAAAA")))) + `(ediff-fine-diff-B ((,class (:foreground "#008000" :background "#55FF55")))) + `(ediff-odd-diff-A ((,class (:foreground "black" :background "light grey")))) + `(ediff-odd-diff-B ((,class (:foreground "black" :background "light grey")))) + ;; Flyspell + `(flyspell-duplicate ((,class (:underline "#008000")))) + `(flyspell-incorrect ((,class (:underline "red")))) + ;; ;; Semantic faces + ;; `(semantic-decoration-on-includes ((,class (:underline ,cham-4)))) + ;; `(semantic-decoration-on-private-members-face ((,class (:background ,alum-2)))) + ;; `(semantic-decoration-on-protected-members-face ((,class (:background ,alum-2)))) + ;; `(semantic-decoration-on-unknown-includes ((,class (:background ,choc-3)))) + ;; `(semantic-decoration-on-unparsed-includes ((,class (:underline ,orange-3)))) + ;; `(semantic-tag-boundary-face ((,class (:overline ,blue-1)))) + ;; `(semantic-unmatched-syntax-face ((,class (:underline ,red-1)))) + + `(Info-title-1-face ((t ,ol1))) + `(Info-title-2-face ((t ,ol2))) + `(Info-title-3-face ((t ,ol3))) + `(Info-title-4-face ((t ,ol4))) + `(bbdb-company ((,class (:slant italic :foreground "steel blue")))) + `(bbdb-field-name ((,class (:weight bold :foreground "steel blue")))) + `(bbdb-field-value ((,class (:foreground "steel blue")))) + `(bbdb-name ((,class (:underline t :foreground "#FF6633")))) + `(browse-kill-ring-separator-face ((,class (:weight bold :foreground "slate gray")))) + `(calendar-today ((,class (:weight bold :background "#CCCCFF")))) + `(cfw:face-annotation ((,class (:foreground "RosyBrown" :inherit cfw:face-day-title)))) + `(cfw:face-day-title ((,class (:background "#F8F9FF")))) + `(cfw:face-default-content ((,class (:foreground "#2952A3")))) + `(cfw:face-default-day ((,class (:weight bold :inherit cfw:face-day-title)))) + `(cfw:face-disable ((,class (:foreground "DarkGray" :inherit cfw:face-day-title)))) + `(cfw:face-grid ((,class (:foreground "SlateBlue")))) + `(cfw:face-header ((,class (:foreground "blue" :background "#D4E5FF" :weight bold)))) + `(cfw:face-holiday ((,class (:background "#FFD5E5")))) + `(cfw:face-periods ((,class (:background "#668CD9" :foreground "white" :slant italic)))) + `(cfw:face-saturday ((,class (:foreground "SlateGray4" :background "gray90" :weight bold)))) + `(cfw:face-select ((,class (:background "#C3C9F8")))) + `(cfw:face-sunday ((,class (:foreground "red2" :background "#FFD5E5" :weight bold)))) + `(cfw:face-title ((,class (:foreground "DarkGrey" :weight bold :height 2.0 :inherit variable-pitch)))) + `(cfw:face-today ((,class (:background "#FFF7D7")))) + `(cfw:face-today-title ((,class (:background "#FAD163")))) + `(cfw:face-toolbar ((,class (:foreground "gray90" :background "gray90")))) + `(cfw:face-toolbar-button-off ((,class (:foreground "LightSkyBlue4" :background "white")))) + `(cfw:face-toolbar-button-on ((,class (:foreground "LightPink3" :background "gray94")))) + `(change-log-date-face ((,class (:foreground "purple")))) + `(change-log-file ((,class (:weight bold :foreground "#4183C4")))) + `(circe-highlight-all-nicks-face ((,class (:foreground "blue" :background "#F0F0F0")))) ;; other nick names + `(circe-highlight-nick-face ((,class (:foreground "#009300" :background "#F0F0F0")))) ;; messages with my nick cited + `(circe-my-message-face ((,class (:foreground "#8B8B8B" :background "#F0F0F0")))) + `(circe-originator-face ((,class (:foreground "blue")))) + `(circe-prompt-face ((,class (:foreground "red")))) + `(circe-server-face ((,class (:foreground "#99CAE5")))) + `(comint-highlight-input ((t ,code-block))) + `(comint-highlight-prompt ((,class (:foreground "#008ED1" :background "#EAEAFF")))) + `(compare-windows ((,class (:background "#FFFF00")))) + `(compilation-error ((,class (:weight bold :foreground "red")))) + `(compilation-info ((,class (:weight bold :foreground "#2A489E")))) ;; used for grep + `(compilation-line-number ((,class (:bold t :foreground "#A535AE")))) + `(compilation-warning ((,class (:weight bold :foreground "orange")))) + `(css-property ((,class (:foreground "#00AA00")))) + `(css-selector ((,class (:weight bold :foreground "blue")))) + `(custom-button ((,class (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) + `(custom-button-mouse ((,class (:background "grey90" :foreground "black" :box (:line-width 2 :style released-button))))) + `(custom-button-pressed ((,class (:foreground "black" :background "light grey" :box (:line-width 2 :style pressed-button))))) + `(custom-button-pressed-unraised ((,class (:underline t :foreground "magenta4")))) + `(custom-button-unraised ((,class (:underline t)))) + `(custom-changed ((,class (:foreground "white" :background "blue")))) + `(custom-comment ((,class (:background "gray85")))) + `(custom-comment-tag ((,class (:foreground "blue4")))) + `(custom-documentation ((,class (nil)))) + `(custom-face-tag ((,class (:family "Sans Serif" :weight bold :height 1.2)))) + `(custom-group-tag ((,class (:bold t :foreground "blue1" :weight bold :height 1.2)))) + `(custom-group-tag-1 ((,class (:bold t :family "Sans Serif" :foreground "red1" :weight bold :height 1.2)))) + `(custom-invalid ((,class (:foreground "yellow" :background "red")))) + `(custom-link ((,class (:underline t :foreground "blue1")))) + `(custom-modified ((,class (:foreground "white" :background "blue")))) + `(custom-rogue ((,class (:foreground "pink" :background "black")))) + `(custom-saved ((,class (:underline t)))) + `(custom-set ((,class (:foreground "blue" :background "white")))) + `(custom-state ((,class (:foreground "green4")))) + `(custom-themed ((,class (:background "blue1" :foreground "white")))) + `(custom-variable-button ((,class (:weight bold :underline t)))) + `(custom-variable-tag ((,class (:bold t :family "Sans Serif" :foreground "blue1" :weight bold :height 1.2)))) + `(diary-face ((,class (:foreground "#87C9FC")))) + `(dircolors-face-asm ((,class (:foreground "black")))) + `(dircolors-face-backup ((,class (:foreground "black")))) + `(dircolors-face-compress ((,class (:foreground "red")))) + `(dircolors-face-dir ((t ,directory))) + `(dircolors-face-doc ((,class (:foreground "black")))) + `(dircolors-face-dos ((,class (:foreground "green3")))) + `(dircolors-face-emacs ((,class (:foreground "black")))) + `(dircolors-face-exec ((,class (:foreground "green3")))) + `(dircolors-face-html ((,class (:foreground "black")))) + `(dircolors-face-img ((,class (:foreground "black")))) + `(dircolors-face-lang ((,class (:foreground "black")))) + `(dircolors-face-lang-interface ((,class (:foreground "black")))) + `(dircolors-face-make ((,class (:foreground "black")))) + `(dircolors-face-objet ((,class (:foreground "black")))) + `(dircolors-face-package ((,class (:foreground "red")))) + `(dircolors-face-paddb ((,class (:foreground "black")))) + `(dircolors-face-ps ((,class (:foreground "black")))) + `(dircolors-face-sound ((,class (:foreground "black")))) + `(dircolors-face-tar ((,class (:foreground "red")))) + `(dircolors-face-text ((,class (:foreground "black")))) + `(dircolors-face-yacc ((,class (:foreground "black")))) + `(dired-directory ((t ,directory))) + `(dired-header ((t ,directory))) + `(dired-ignored ((,class (:strike-through t :foreground "red")))) + `(dired-mark ((t ,marked-line))) + `(dired-marked ((t ,marked-line))) + `(dired-symlink ((t ,symlink))) + `(diredp-compressed-file-suffix ((,class (:foreground "red")))) + `(diredp-date-time ((,class (:foreground "purple")))) + `(diredp-dir-heading ((t ,directory))) + `(diredp-dir-priv ((t ,directory))) + `(diredp-exec-priv ((,class (:background "#03C03C")))) + `(diredp-executable-tag ((,class (:foreground "green3" :background "white")))) + `(diredp-file-name ((,class (:foreground "black")))) + `(diredp-file-suffix ((,class (:foreground "#008000")))) + `(diredp-flag-mark-line ((t ,marked-line))) + `(diredp-ignored-file-name ((,class (:strike-through t :foreground "red")))) + `(diredp-read-priv ((,class (:background "#0A99FF")))) + `(diredp-write-priv ((,class (:foreground "white" :background "#FF4040")))) + `(file-name-shadow ((t ,shadow))) + `(font-latex-bold-face ((,class (:weight bold :foreground "medium sea green")))) + `(font-latex-math-face ((,class (:foreground "blue")))) + `(font-latex-sectioning-1-face ((,class (:family "Sans Serif" :height 2.7 :weight bold :foreground "cornflower blue")))) + `(font-latex-sectioning-2-face ((t ,ol1))) + `(font-latex-sectioning-3-face ((t ,ol2))) + `(font-latex-sectioning-4-face ((t ,ol3))) + `(font-latex-sectioning-5-face ((t ,ol4))) + `(font-latex-sedate-face ((,class (:foreground "#FF5803")))) + `(font-latex-string-face ((,class (:bold t :foreground "#0066FF")))) + `(font-latex-verbatim-face ((,class (:foreground "tan1")))) + `(gnus-cite-attribution-face ((,class (:foreground "#5050B0")))) + `(gnus-cite-face-1 ((,class (:foreground "#5050B0")))) + `(gnus-cite-face-10 ((,class (:foreground "#990000")))) + `(gnus-cite-face-2 ((,class (:foreground "#660066")))) + `(gnus-cite-face-3 ((,class (:foreground "#007777")))) + `(gnus-cite-face-4 ((,class (:foreground "#990000")))) + `(gnus-cite-face-5 ((,class (:foreground "#000099")))) + `(gnus-cite-face-6 ((,class (:foreground "#BB6600")))) + `(gnus-cite-face-7 ((,class (:foreground "#5050B0")))) + `(gnus-cite-face-8 ((,class (:foreground "#660066")))) + `(gnus-cite-face-9 ((,class (:foreground "#007777")))) + `(gnus-emphasis-bold ((,class (:weight bold)))) + `(gnus-emphasis-highlight-words ((,class (:foreground "yellow" :background "black")))) + `(gnus-picon ((,class (:foreground "yellow" :background "white")))) + `(gnus-picon-xbm ((,class (:foreground "yellow" :background "white")))) + `(gnus-signature ((,class (:foreground "#7F7F7F")))) + `(gnus-splash ((,class (:foreground "#FF8C00")))) + `(gnus-summary-cancelled ((t ,cancel))) + `(gnus-summary-high-ancient ((,class (:weight normal :foreground "#808080" :background "#FFFFE6")))) + `(gnus-summary-high-read ((,class (:weight normal :foreground "#808080" :background "#FFFFE6")))) + `(gnus-summary-high-ticked ((,class (:weight normal :foreground "black" :background "#E7AEB0")))) + `(gnus-summary-high-unread ((,class (:weight normal :foreground "black" :background "#FFFFCC")))) + `(gnus-summary-low-ancient ((,class (:slant italic :foreground "gray55")))) + `(gnus-summary-low-read ((,class (:slant italic :foreground "gray55" :background "#E0E0E0")))) + `(gnus-summary-low-ticked ((,class (:slant italic :foreground "black" :background "#E7AEB0")))) + `(gnus-summary-low-unread ((,class (:slant italic :foreground "black")))) + `(gnus-summary-normal-ancient ((,class (:foreground "#808080")))) + `(gnus-summary-normal-read ((,class (:foreground "#808080")))) + `(gnus-summary-normal-ticked ((,class (:foreground "black" :background "#E7AEB0")))) + `(gnus-summary-normal-unread ((,class (:foreground "black")))) + `(gnus-summary-selected ((,class (:foreground "black" :background "#FFD0D0" :underline t)))) + `(gnus-x-face ((,class (:foreground "black" :background "white")))) + `(helm-action ((,class (:foreground "#335EA8")))) + `(helm-bookmarks-su-face ((,class (:foreground "red")))) + `(helm-candidate-number ((,class (:foreground "black" :background "#FFFF66")))) + `(helm-dir-heading ((,class (:foreground "blue" :background "pink")))) + `(helm-dir-priv ((,class (:foreground "dark red" :background "light grey")))) + `(helm-ff-directory ((t ,directory))) + `(helm-ff-executable ((,class (:foreground "green3" :background "white")))) + `(helm-ff-file ((,class (:foreground "black")))) + `(helm-ff-invalid-symlink ((,class (:foreground "yellow" :background "red")))) + `(helm-ff-symlink ((t ,symlink))) + `(helm-file-name ((,class (:foreground "blue")))) + `(helm-gentoo-match-face ((,class (:foreground "red")))) + `(helm-grep-running ((,class (:weight bold :foreground "white")))) + `(helm-isearch-match ((,class (:background "#CCFFCC")))) + `(helm-match ((t ,match))) + `(helm-overlay-line-face ((,class (:underline t :foreground "white" :background "IndianRed4")))) + `(helm-selection ((t ,highlight-line))) + `(helm-source-header ((,class (:family "Sans Serif" :height 1.3 :weight bold :foreground "white" :background "#666699")))) + `(helm-visible-mark ((t ,marked-line))) + `(helm-w3m-bookmarks-face ((,class (:underline t :foreground "cyan1")))) + `(highlight-symbol-face ((,class (:background "#FFFFA0")))) + `(hl-line ((t ,highlight-line))) + `(holiday-face ((,class (:background "#B6B2AE")))) + `(html-helper-bold-face ((,class (:weight bold :foreground "black")))) + `(html-helper-italic-face ((,class (:slant italic :foreground "black")))) + `(html-helper-underline-face ((,class (:underline t :foreground "black")))) + `(html-tag-face ((,class (:foreground "blue")))) + `(info-file ((,class (:family "Sans Serif" :height 1.8 :weight bold :box (:line-width 1 :color "#0000CC") :foreground "cornflower blue" :background "LightSteelBlue1")))) + `(info-header-node ((,class (:underline t :foreground "orange")))) ;; nodes in header + `(info-header-xref ((,class (:underline t :foreground "dodger blue")))) ;; cross references in header + `(info-menu-header ((,class (:family "Sans Serif" :height 1.6 :weight bold :underline t :foreground "#00CC00")))) ;; menu titles (headers) -- major topics + `(info-menu-star ((,class (:foreground "black")))) ;; every 3rd menu item + `(info-node ((,class (:underline t :foreground "blue")))) ;; node names + `(info-quoted-name ((t ,code-inline))) + `(info-string ((t ,string))) + `(info-title-1 ((t ,ol1))) + `(info-xref ((,class (:weight bold :underline t :foreground "blue")))) ;; unvisited cross-references + `(info-xref-visited ((,class (:weight bold :foreground "magenta4")))) ;; previously visited cross-references + `(light-symbol-face ((,class (:background "#FFFFA0")))) + `(linum ((,class (:foreground "#AFB7BA" :background "#DDEEFF")))) + `(log-view-file ((,class (:foreground "#0000CC" :background "#EAF2F5")))) + `(lui-button-face ((t ,link))) + `(lui-highlight-face ((,class (:box '(:line-width 1 :color "#CC0000") :foreground "#CC0000" :background "#FFFF88")))) ;; my nickname + `(lui-time-stamp-face ((,class (:foreground "purple")))) + `(magit-branch ((t ,vc-branch))) + `(magit-diff-add ((t ,diff-added))) + `(magit-diff-del ((t ,diff-removed))) + `(magit-diff-file-header ((,class (:family "Sans Serif" :height 1.1 :weight bold :foreground "#4183C4")))) + `(magit-diff-hunk-header ((t ,diff-hunk-header))) + `(magit-diff-none ((t ,diff-none))) + `(magit-header ((,class (:foreground "white" :background "#FF4040")))) + `(magit-item-highlight ((,class (:background "#EAF2F5")))) + `(magit-item-mark ((t ,marked-line))) + `(magit-log-head-label ((,class (:box (:line-width 1 :color "blue" :style nil))))) + `(magit-log-tag-label ((,class (:box (:line-width 1 :color "#00CC00" :style nil))))) + `(magit-section-title ((,class (:family "Sans Serif" :height 1.8 :weight bold :foreground "cornflower blue")))) + `(makefile-space-face ((,class (:background "hot pink")))) + `(makefile-targets ((,class (:weight bold :foreground "blue")))) + `(match ((t ,match))) + `(mm-uu-extract ((t ,code-block))) + `(moccur-current-line-face ((,class (:background "#FFFFCC" :foreground "black")))) + `(moccur-face ((,class (:background "#FFFF99" :foreground "black")))) + `(nobreak-space ((,class (:background "#CCE8F6")))) + `(nxml-attribute-local-name-face ((,class (:foreground "magenta")))) + `(nxml-attribute-value-delimiter-face ((,class (:foreground "green4")))) + `(nxml-attribute-value-face ((,class (:foreground "green4")))) + `(nxml-comment-content-face ((,class (:slant italic :foreground "red")))) + `(nxml-comment-delimiter-face ((,class (:foreground "red")))) + `(nxml-element-local-name ((,class (:box (:line-width 1 :color "#999999") :background "#DEDEDE" :foreground "#000088")))) + `(nxml-element-local-name-face ((,class (:foreground "blue")))) + `(nxml-processing-instruction-target-face ((,class (:foreground "purple1")))) + `(nxml-tag-delimiter-face ((,class (:foreground "blue")))) + `(nxml-tag-slash-face ((,class (:foreground "blue")))) + `(org-agenda-calendar-event ((,class (:weight bold :foreground "white" :background "#1662AF")))) + `(org-agenda-calendar-sexp ((,class (:foreground "black" :background "#80CBFF")))) + `(org-agenda-clocking ((t ,clock-line))) + `(org-agenda-column-dateline ((t ,column))) + `(org-agenda-current-time ((,class (:underline t :foreground "#1662AF")))) + `(org-agenda-date ((,class (:height 1.6 :weight normal :foreground "#0063F5")))) + `(org-agenda-date-today ((,class (:height 1.6 :weight bold :foreground "#1662AF")))) + `(org-agenda-date-weekend ((,class (:height 1.6 :weight normal :foreground "dim gray")))) + `(org-agenda-diary ((,class (:weight bold :foreground "green4" :background "light blue")))) + `(org-agenda-dimmed-todo-face ((,class (:foreground "gold2")))) + `(org-agenda-done ((,class (:foreground "#555555" :background "#EEEEEE")))) + `(org-agenda-filter-category ((,class (:weight bold :foreground "orange")))) + `(org-agenda-filter-tags ((,class (:weight bold :foreground "orange")))) + `(org-agenda-restriction-lock ((,class (:weight bold :foreground "white" :background "orange")))) + `(org-agenda-structure ((,class (:height 1.6 :weight bold :box (:line-width 1 :color "#999999") :foreground "#666666" :background "#CCCCCC")))) + `(org-archived ((,class (:foreground "gray70")))) + `(org-beamer-tag ((,class (:box (:line-width 1 :color "#FABC18") :foreground "#2C2C2C" :background "#FFF8D0")))) + `(org-block ((t ,code-block))) + `(org-block-background ((,class (:background "#FFFFE0")))) + `(org-block-begin-line ((,class (:underline "#A7A6AA" :foreground "#555555" :background "#E2E1D5")))) + `(org-block-end-line ((,class (:overline "#A7A6AA" :foreground "#555555" :background "#E2E1D5")))) + `(org-checkbox ((,class (:weight bold :foreground "white" :background "#777777" :box (:line-width 1 :style pressed-button))))) + `(org-clock-overlay ((,class (:foreground "white" :background "SkyBlue4")))) + `(org-code ((t ,code-inline))) + `(org-column ((t ,column))) + `(org-column-title ((t ,column))) + `(org-date ((,class (:underline t :foreground "#00459E")))) + `(org-default ((,class (:foreground "#333333")))) + `(org-dim ((,class (:foreground "#AAAAAA")))) + `(org-document-info ((,class (:foreground "#484848")))) + `(org-document-info-keyword ((,class (:foreground "#008ED1" :background "#EAEAFF")))) + `(org-document-title ((,class (:family "Sans Serif" :height 1.8 :weight bold :foreground "black")))) + `(org-done ((,class (:weight bold :box (:line-width 1 :color "#BBBBBB") :foreground "#BBBBBB" :background "#F0F0F0")))) + `(org-drawer ((,class (:foreground "light sky blue")))) + `(org-ellipsis ((,class (:underline "#B0EEB0" :foreground "#00BB00")))) + `(org-example ((,class (:foreground "blue" :background "#EAFFEA")))) + `(org-footnote ((,class (:underline t :foreground "#008ED1")))) + `(org-formula ((,class (:foreground "chocolate1")))) + `(org-headline-done ((,class (:height 1.0 :weight bold :strike-through "#BEBEBE" :foreground "#C5C5C5")))) + `(org-hide ((,class (:foreground "#E2E2E2")))) + `(org-inlinetask ((,class (:box (:line-width 1 :color "#EBEBEB") :foreground "#777777" :background "#FFFFD6")))) + `(org-latex-and-export-specials ((,class (:foreground "blue")))) + `(org-level-1 ((t ,ol1))) + `(org-level-2 ((t ,ol2))) + `(org-level-3 ((t ,ol3))) + `(org-level-4 ((t ,ol4))) + `(org-level-5 ((t ,ol5))) + `(org-level-6 ((t ,ol6))) + `(org-level-7 ((t ,ol7))) + `(org-level-8 ((t ,ol8))) + `(org-link ((t ,link))) + `(org-list-dt ((,class (:weight bold :foreground "#335EA8")))) + `(org-meta-line ((,class (:slant normal :foreground "#008ED1" :background "#EAEAFF")))) + `(org-mode-line-clock ((t ,clock-line))) + `(org-mode-line-clock-overrun ((,class (:weight bold :box (:line-width 1 :color "#335EA8") :foreground "white" :background "#FF4040")))) + `(org-number-of-items ((,class (:weight bold :foreground "white" :background "#79BA79")))) + `(org-property-value ((,class (:foreground "#00A000")))) + `(org-quote ((,class (:slant italic :foreground "dim gray" :background "#FFFFE0")))) + `(org-scheduled ((,class (:slant italic :foreground "#0063DC")))) + `(org-scheduled-previously ((,class (:weight bold :foreground "#373737")))) + `(org-scheduled-today ((,class (:foreground "black" :background "#FFFFCB")))) + `(org-sexp-date ((,class (:foreground "purple")))) + `(org-special-keyword ((,class (:weight bold :foreground "#00BB00" :background "#EAFFEA")))) + `(org-table ((,class (:foreground "dark green" :background "#EAFFEA")))) + `(org-tag ((,class (:height 1.0 :weight normal :slant italic :foreground "#3C424F" :background "#E5ECFA")))) + `(org-target ((,class (:underline t)))) + `(org-time-grid ((,class (:foreground "#6D6D6D")))) + `(org-todo ((,class (:weight bold :box (:line-width 1 :color "#D8ABA7") :foreground "#D8ABA7" :background "#FFE6E4")))) + `(org-upcoming-deadline ((,class (:foreground "#FF5555")))) + `(org-verbatim ((,class (:box (:line-width 1 :color "#DDDDDD") :foreground "#000088" :background "#E0FFE0")))) + `(org-verse ((,class (:slant italic :foreground "dim gray" :background "#EEEEEE")))) + `(org-warning ((,class (:weight bold :foreground "black" :background "#CCE7FF")))) + `(outline-1 ((t ,ol1))) + `(outline-2 ((t ,ol2))) + `(outline-3 ((t ,ol3))) + `(outline-4 ((t ,ol4))) + `(outline-5 ((t ,ol5))) + `(outline-6 ((t ,ol6))) + `(outline-7 ((t ,ol7))) + `(outline-8 ((t ,ol8))) + `(pabbrev-debug-display-label-face ((,class (:background "chartreuse")))) + `(pabbrev-suggestions-face ((,class (:weight bold :foreground "white" :background "red")))) + `(pabbrev-suggestions-label-face ((,class (:weight bold :foreground "white" :background "purple")))) + `(paren-face-match ((,class (:foreground "white" :background "#FF3F3F")))) + `(paren-face-mismatch ((,class (:weight bold :foreground "white" :background "purple")))) + `(paren-face-no-match ((,class (:weight bold :foreground "white" :background "purple")))) + `(pp^L-highlight ((,class (:strike-through t)))) + `(recover-this-file ((,class (:background "white" :background "#FF3F3F")))) + `(sh-heredoc ((,class (:foreground "blue" :background "#FBF9EA")))) + `(shadow ((t ,shadow))) + `(shell-option-face ((,class (:foreground "forest green")))) + `(shell-output-2-face ((,class (:foreground "blue")))) + `(shell-output-3-face ((,class (:foreground "purple")))) + `(shell-output-face ((,class (:foreground "black")))) + `(shell-prompt-face ((,class (:weight bold :foreground "yellow")))) + `(show-paren-match ((,class (:foreground "white" :background "#FF3F3F")))) + `(show-paren-mismatch ((,class (:weight bold :foreground "white" :background "purple")))) + `(speedbar-button-face ((,class (:foreground "green4")))) + `(speedbar-directory-face ((,class (:foreground "blue4")))) + `(speedbar-file-face ((,class (:foreground "cyan4")))) + `(speedbar-highlight-face ((,class (:background "green")))) + `(speedbar-selected-face ((,class (:underline t :foreground "red")))) + `(speedbar-tag-face ((,class (:foreground "brown")))) + `(svn-status-directory-face ((t ,directory))) + `(svn-status-filename-face ((,class (:weight bold :foreground "#4183C4")))) + `(svn-status-locked-face ((,class (:weight bold :foreground "red")))) + `(svn-status-marked-face ((t ,marked-line))) + `(svn-status-marked-popup-face ((,class (:weight bold :foreground "green3")))) + `(svn-status-switched-face ((,class (:slant italic :foreground "gray55")))) + `(svn-status-symlink-face ((t ,symlink))) + `(svn-status-update-available-face ((,class (:foreground "orange")))) + `(tex-verbatim ((,class (:foreground "blue")))) + `(tool-bar ((,class (:box (:line-width 1 :style released-button) :foreground "black" :background "gray75")))) + `(tooltip ((,class (:foreground "black" :background "light yellow")))) + `(trailing-whitespace ((,class (:background "#F6EBFE")))) + `(traverse-match-face ((,class (:weight bold :foreground "blue violet")))) + `(vc-annotate-face-3F3FFF ((,class (:foreground "#3F3FFF" :background "black")))) + `(vc-annotate-face-3F6CFF ((,class (:foreground "#3F3FFF" :background "black")))) + `(vc-annotate-face-3F99FF ((,class (:foreground "#3F99FF" :background "black")))) + `(vc-annotate-face-3FC6FF ((,class (:foreground "#3F99FF" :background "black")))) + `(vc-annotate-face-3FF3FF ((,class (:foreground "#3FF3FF" :background "black")))) + `(vc-annotate-face-3FFF56 ((,class (:foreground "#4BFF4B" :background "black")))) + `(vc-annotate-face-3FFF83 ((,class (:foreground "#3FFFB0" :background "black")))) + `(vc-annotate-face-3FFFB0 ((,class (:foreground "#3FFFB0" :background "black")))) + `(vc-annotate-face-3FFFDD ((,class (:foreground "#3FF3FF" :background "black")))) + `(vc-annotate-face-56FF3F ((,class (:foreground "#4BFF4B" :background "black")))) + `(vc-annotate-face-83FF3F ((,class (:foreground "#B0FF3F" :background "black")))) + `(vc-annotate-face-B0FF3F ((,class (:foreground "#B0FF3F" :background "black")))) + `(vc-annotate-face-DDFF3F ((,class (:foreground "#FFF33F" :background "black")))) + `(vc-annotate-face-FF3F3F ((,class (:foreground "#FF3F3F" :background "black")))) + `(vc-annotate-face-FF6C3F ((,class (:foreground "#FF3F3F" :background "black")))) + `(vc-annotate-face-FF993F ((,class (:foreground "#FF993F" :background "black")))) + `(vc-annotate-face-FFC63F ((,class (:foreground "#FF993F" :background "black")))) + `(vc-annotate-face-FFF33F ((,class (:foreground "#FFF33F" :background "black")))) + `(w3m-anchor ((t ,link))) + `(w3m-arrived-anchor ((,class (:foreground "purple1")))) + `(w3m-bitmap-image-face ((,class (:foreground "gray4" :background "green")))) + `(w3m-bold ((,class (:weight bold :foreground "medium sea green")))) + `(w3m-current-anchor ((,class (:weight bold :underline t :foreground "blue")))) + `(w3m-form ((,class (:underline t :foreground "tan1")))) + `(w3m-form-button-face ((,class (:weight bold :underline t :foreground "gray4" :background "light grey")))) + `(w3m-form-button-mouse-face ((,class (:underline t :foreground "light grey" :background "#2B7E2A")))) + `(w3m-form-button-pressed-face ((,class (:weight bold :underline t :foreground "gray4" :background "light grey")))) + `(w3m-header-line-location-content-face ((,class (:foreground "#7F7F7F":background "#F7F7F7")))) + `(w3m-header-line-location-title-face ((,class (:foreground "#2C55B1" :background "#F7F7F7")))) + `(w3m-history-current-url-face ((,class (:foreground "lemon chiffon")))) + `(w3m-image-face ((,class (:weight bold :foreground "DarkSeaGreen2")))) + `(w3m-link-numbering ((,class (:foreground "#B4C7EB")))) ;; mouseless browsing + `(w3m-strike-through-face ((,class (:strike-through t)))) + `(w3m-underline-face ((,class (:underline t)))) + `(which-func ((,class (:weight bold :foreground "white")))) + `(whitespace-hspace ((,class (:background "#CCE8F6")))) + `(whitespace-indentation ((,class (:foreground "firebrick" :background "yellow")))) + `(whitespace-line ((,class (:foreground "#CC0000" :background "#FFFF88")))) + `(whitespace-tab ((,class (:foreground "lightgray" :background "beige")))) + `(whitespace-trailing ((,class (:weight bold :foreground "yellow" :background "red1")))) + `(widget-button-face ((t ,link))) + `(widget-button-pressed-face ((,class (:foreground "red")))) + `(widget-documentation-face ((,class (:foreground "green4")))) + `(widget-field-face ((,class (:background "gray85")))) + `(widget-inactive-face ((,class (:foreground "dim gray")))) + `(widget-single-line-field-face ((,class (:background "gray85")))) + `(yas/field-debug-face ((,class (:background "ivory2")))) + `(yas/field-highlight-face ((,class (:background "DarkSeaGreen1")))) + )) + +(custom-theme-set-variables + 'leuven + '(ansi-color-names-vector ["#242424" "#e5786d" "#95e454" "#cae682" + "#8ac6f2" "#333366" "#ccaa8f" "#f6f3e8"])) + +(provide-theme 'leuven) + +;; Local Variables: +;; no-byte-compile: t +;; End: + +;;; leuven-theme.el ends here ------------------------------------------------------------ revno: 111135 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2012-12-06 16:29:29 -0500 message: Further cleanup of the "cl-" namespace. Fit CL in 80 columns. * lisp/emacs-lisp/cl-macs.el (cl--pop2, cl--optimize-safety) (cl--optimize-speed, cl--not-toplevel, cl--parse-loop-clause) (cl--expand-do-loop, cl--proclaim-history, cl--declare-stack) (cl--do-proclaim, cl--proclaims-deferred): Rename from the "cl-" prefix. (cl-progv): Don't rely on dynamic scoping to find the body. * lisp/emacs-lisp/cl-lib.el (cl--optimize-speed, cl--optimize-safety) (cl--proclaims-deferred): Rename from the "cl-" prefix. (cl-declaim): Use backquotes. * lisp/emacs-lisp/cl-extra.el (cl-make-random-state, cl-random-state-p): Use "cl--" prefix for the object's tag. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-12-06 20:16:38 +0000 +++ lisp/ChangeLog 2012-12-06 21:29:29 +0000 @@ -1,5 +1,17 @@ 2012-12-06 Stefan Monnier + Further cleanup of the "cl-" namespace. Fit CL in 80 columns. + * emacs-lisp/cl-macs.el (cl--pop2, cl--optimize-safety) + (cl--optimize-speed, cl--not-toplevel, cl--parse-loop-clause) + (cl--expand-do-loop, cl--proclaim-history, cl--declare-stack) + (cl--do-proclaim, cl--proclaims-deferred): Rename from the "cl-" prefix. + (cl-progv): Don't rely on dynamic scoping to find the body. + * emacs-lisp/cl-lib.el (cl--optimize-speed, cl--optimize-safety) + (cl--proclaims-deferred): Rename from the "cl-" prefix. + (cl-declaim): Use backquotes. + * emacs-lisp/cl-extra.el (cl-make-random-state, cl-random-state-p): + Use "cl--" prefix for the object's tag. + * ses.el: Use advice-add/remove. (ses--advice-copy-region-as-kill, ses--advice-yank): New functions. (copy-region-as-kill, yank): Use advice-add. === modified file 'lisp/emacs-lisp/cl-extra.el' --- lisp/emacs-lisp/cl-extra.el 2012-11-10 23:13:33 +0000 +++ lisp/emacs-lisp/cl-extra.el 2012-12-06 21:29:29 +0000 @@ -51,7 +51,8 @@ ((eq type 'string) (if (stringp x) x (concat x))) ((eq type 'array) (if (arrayp x) x (vconcat x))) ((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0)) - ((and (eq type 'character) (symbolp x)) (cl-coerce (symbol-name x) type)) + ((and (eq type 'character) (symbolp x)) + (cl-coerce (symbol-name x) type)) ((eq type 'float) (float x)) ((cl-typep x type) x) (t (error "Can't coerce %s to type %s" x type)))) @@ -69,7 +70,7 @@ ((stringp x) (and (stringp y) (= (length x) (length y)) (or (string-equal x y) - (string-equal (downcase x) (downcase y))))) ; lazy but simple! + (string-equal (downcase x) (downcase y))))) ;Lazy but simple! ((numberp x) (and (numberp y) (= x y))) ((consp x) @@ -439,14 +440,14 @@ If STATE is t, return a new state object seeded from the time of day." (cond ((null state) (cl-make-random-state cl--random-state)) ((vectorp state) (copy-tree state t)) - ((integerp state) (vector 'cl-random-state-tag -1 30 state)) + ((integerp state) (vector 'cl--random-state-tag -1 30 state)) (t (cl-make-random-state (cl--random-time))))) ;;;###autoload (defun cl-random-state-p (object) "Return t if OBJECT is a random-state object." (and (vectorp object) (= (length object) 4) - (eq (aref object 0) 'cl-random-state-tag))) + (eq (aref object 0) 'cl--random-state-tag))) ;; Implementation limits. === modified file 'lisp/emacs-lisp/cl-lib.el' --- lisp/emacs-lisp/cl-lib.el 2012-11-18 01:52:36 +0000 +++ lisp/emacs-lisp/cl-lib.el 2012-12-06 21:29:29 +0000 @@ -93,8 +93,8 @@ (require 'macroexp) -(defvar cl-optimize-speed 1) -(defvar cl-optimize-safety 1) +(defvar cl--optimize-speed 1) +(defvar cl--optimize-safety 1) ;;;###autoload (define-obsolete-variable-alias @@ -248,23 +248,21 @@ (equal (buffer-name (symbol-value 'byte-compile--outbuffer)) " *Compiler Output*")))) -(defvar cl-proclaims-deferred nil) +(defvar cl--proclaims-deferred nil) (defun cl-proclaim (spec) "Record a global declaration specified by SPEC." - (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t) - (push spec cl-proclaims-deferred)) + (if (fboundp 'cl--do-proclaim) (cl--do-proclaim spec t) + (push spec cl--proclaims-deferred)) nil) (defmacro cl-declaim (&rest specs) "Like `cl-proclaim', but takes any number of unevaluated, unquoted arguments. Puts `(cl-eval-when (compile load eval) ...)' around the declarations so that they are registered at compile-time as well as run-time." - (let ((body (mapcar (function (lambda (x) - (list 'cl-proclaim (list 'quote x)))) - specs))) - (if (cl--compiling-file) (cl-list* 'cl-eval-when '(compile load eval) body) - (cons 'progn body)))) ; avoid loading cl-macs.el for cl-eval-when + (let ((body (mapcar (lambda (x) `(cl-proclaim ',x) specs)))) + (if (cl--compiling-file) `(cl-eval-when (compile load eval) ,@body) + `(progn ,@body)))) ; Avoid loading cl-macs.el for cl-eval-when. ;;; Symbols. @@ -301,7 +299,8 @@ "Return t if INTEGER is even." (eq (logand integer 1) 0)) -(defvar cl--random-state (vector 'cl-random-state-tag -1 30 (cl--random-time))) +(defvar cl--random-state + (vector 'cl--random-state-tag -1 30 (cl--random-time))) (defconst cl-most-positive-float nil "The largest value that a Lisp float can hold. === modified file 'lisp/emacs-lisp/cl-loaddefs.el' --- lisp/emacs-lisp/cl-loaddefs.el 2012-11-27 11:18:12 +0000 +++ lisp/emacs-lisp/cl-loaddefs.el 2012-12-06 21:29:29 +0000 @@ -11,7 +11,7 @@ ;;;;;; 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-mapc cl-maplist cl-map cl--mapcar-many cl-equalp -;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "8e9fee941c465ac0fee9b92a92d64154") +;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "3ee58411735a01dd1e1d3964fdcfae70") ;;; Generated autoloads from cl-extra.el (autoload 'cl-coerce "cl-extra" "\ @@ -224,7 +224,7 @@ \(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil) -(put 'cl-get 'compiler-macro #'cl--compiler-macro-get) +(eval-and-compile (put 'cl-get 'compiler-macro #'cl--compiler-macro-get)) (autoload 'cl-getf "cl-extra" "\ Search PROPLIST for property PROPNAME; return its value or DEFAULT. @@ -267,7 +267,7 @@ ;;;;;; 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--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "3dd5e153133b2752fd52e45792c46dfe") +;;;;;; "cl-macs" "cl-macs.el" "5df0692d7c4bffb2cc353f802d94f796") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ @@ -759,7 +759,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" "4c1e1191e82dc8d5449a5ec4d59efc10") +;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "697d04e7ae0a9b9c15eea705b359b1bb") ;;; Generated autoloads from cl-seq.el (autoload 'cl-reduce "cl-seq" "\ @@ -1020,7 +1020,7 @@ \(fn ITEM LIST [KEYWORD VALUE]...)" nil nil) -(put 'cl-member 'compiler-macro #'cl--compiler-macro-member) +(eval-and-compile (put 'cl-member 'compiler-macro #'cl--compiler-macro-member)) (autoload 'cl-member-if "cl-seq" "\ Find the first item satisfying PREDICATE in LIST. @@ -1050,7 +1050,7 @@ \(fn ITEM LIST [KEYWORD VALUE]...)" nil nil) -(put 'cl-assoc 'compiler-macro #'cl--compiler-macro-assoc) +(eval-and-compile (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-11-27 03:10:32 +0000 +++ lisp/emacs-lisp/cl-macs.el 2012-12-06 21:29:29 +0000 @@ -48,13 +48,13 @@ ;; `gv' is required here because cl-macs can be loaded before loaddefs.el. (require 'gv) -(defmacro cl-pop2 (place) +(defmacro cl--pop2 (place) (declare (debug edebug-sexps)) `(prog1 (car (cdr ,place)) (setq ,place (cdr (cdr ,place))))) -(defvar cl-optimize-safety) -(defvar cl-optimize-speed) +(defvar cl--optimize-safety) +(defvar cl--optimize-speed) ;;; Initialization. @@ -431,7 +431,7 @@ (if (memq '&environment args) (error "&environment used incorrectly")) (let ((save-args args) (restarg (memq '&rest args)) - (safety (if (cl--compiling-file) cl-optimize-safety 3)) + (safety (if (cl--compiling-file) cl--optimize-safety 3)) (keys nil) (laterarg nil) (exactarg nil) minarg) (or num (setq num 0)) @@ -440,7 +440,7 @@ (setq restarg (cadr restarg))) (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))) @@ -476,7 +476,7 @@ (if def `(if ,restarg ,poparg ,def) poparg)) (setq num (1+ num)))))) (if (eq (car args) '&rest) - (let ((arg (cl-pop2 args))) + (let ((arg (cl--pop2 args))) (if (consp arg) (cl--do-arglist arg restarg))) (or (eq (car args) '&key) (= safety 0) exactarg (push `(if ,restarg @@ -574,7 +574,7 @@ ;;; The `cl-eval-when' form. -(defvar cl-not-toplevel nil) +(defvar cl--not-toplevel nil) ;;;###autoload (defmacro cl-eval-when (when &rest body) @@ -586,9 +586,9 @@ \(fn (WHEN...) BODY...)" (declare (indent 1) (debug ((&rest &or "compile" "load" "eval") body))) (if (and (fboundp 'cl--compiling-file) (cl--compiling-file) - (not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge + (not cl--not-toplevel) (not (boundp 'for-effect))) ;Horrible kludge. (let ((comp (or (memq 'compile when) (memq :compile-toplevel when))) - (cl-not-toplevel t)) + (cl--not-toplevel t)) (if (or (memq 'load when) (memq :load-toplevel when)) (if comp (cons 'progn (mapcar 'cl--compile-time-too body)) `(if nil nil ,@body)) @@ -759,7 +759,8 @@ (defvar cl--loop-first-flag) (defvar cl--loop-initially) (defvar cl--loop-map-form) (defvar cl--loop-name) (defvar cl--loop-result) (defvar cl--loop-result-explicit) -(defvar cl--loop-result-var) (defvar cl--loop-steps) (defvar cl--loop-symbol-macs) +(defvar cl--loop-result-var) (defvar cl--loop-steps) +(defvar cl--loop-symbol-macs) ;;;###autoload (defmacro cl-loop (&rest loop-args) @@ -792,7 +793,8 @@ "return"] form] ;; Simple default, which covers 99% of the cases. symbolp form))) - (if (not (memq t (mapcar 'symbolp (delq nil (delq t (cl-copy-list loop-args)))))) + (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) @@ -803,14 +805,16 @@ (cl--loop-map-form nil) (cl--loop-first-flag nil) (cl--loop-destr-temps nil) (cl--loop-symbol-macs nil)) (setq cl--loop-args (append cl--loop-args '(cl-end-loop))) - (while (not (eq (car cl--loop-args) 'cl-end-loop)) (cl-parse-loop-clause)) + (while (not (eq (car cl--loop-args) 'cl-end-loop)) + (cl--parse-loop-clause)) (if cl--loop-finish-flag (push `((,cl--loop-finish-flag t)) cl--loop-bindings)) (if cl--loop-first-flag (progn (push `((,cl--loop-first-flag t)) cl--loop-bindings) (push `(setq ,cl--loop-first-flag nil) cl--loop-steps))) (let* ((epilogue (nconc (nreverse cl--loop-finally) - (list (or cl--loop-result-explicit cl--loop-result)))) + (list (or cl--loop-result-explicit + cl--loop-result)))) (ands (cl--loop-build-ands (nreverse cl--loop-body))) (while-body (nconc (cadr ands) (nreverse cl--loop-steps))) (body (append @@ -830,7 +834,8 @@ `((if ,cl--loop-finish-flag (progn ,@epilogue) ,cl--loop-result-var))) epilogue)))) - (if cl--loop-result-var (push (list cl--loop-result-var) cl--loop-bindings)) + (if cl--loop-result-var + (push (list cl--loop-result-var) cl--loop-bindings)) (while cl--loop-bindings (if (cdar cl--loop-bindings) (setq body (list (cl--loop-let (pop cl--loop-bindings) body t))) @@ -840,7 +845,8 @@ (push (car (pop cl--loop-bindings)) lets)) (setq body (list (cl--loop-let lets body nil)))))) (if cl--loop-symbol-macs - (setq body (list `(cl-symbol-macrolet ,cl--loop-symbol-macs ,@body)))) + (setq body + (list `(cl-symbol-macrolet ,cl--loop-symbol-macs ,@body)))) `(cl-block ,cl--loop-name ,@body))))) ;; Below is a complete spec for cl-loop, in several parts that correspond @@ -995,7 +1001,7 @@ -(defun cl-parse-loop-clause () ; uses loop-* +(defun cl--parse-loop-clause () ; uses loop-* (let ((word (pop cl--loop-args)) (hash-types '(hash-key hash-keys hash-value hash-values)) (key-types '(key-code key-codes key-seq key-seqs @@ -1010,17 +1016,21 @@ ((eq word 'initially) (if (memq (car cl--loop-args) '(do doing)) (pop cl--loop-args)) - (or (consp (car cl--loop-args)) (error "Syntax error on `initially' clause")) + (or (consp (car cl--loop-args)) + (error "Syntax error on `initially' clause")) (while (consp (car cl--loop-args)) (push (pop cl--loop-args) cl--loop-initially))) ((eq word 'finally) (if (eq (car cl--loop-args) 'return) - (setq cl--loop-result-explicit (or (cl-pop2 cl--loop-args) '(quote nil))) + (setq cl--loop-result-explicit + (or (cl--pop2 cl--loop-args) '(quote nil))) (if (memq (car cl--loop-args) '(do doing)) (pop cl--loop-args)) - (or (consp (car cl--loop-args)) (error "Syntax error on `finally' clause")) + (or (consp (car cl--loop-args)) + (error "Syntax error on `finally' clause")) (if (and (eq (caar cl--loop-args) 'return) (null cl--loop-name)) - (setq cl--loop-result-explicit (or (nth 1 (pop cl--loop-args)) '(quote nil))) + (setq cl--loop-result-explicit + (or (nth 1 (pop cl--loop-args)) '(quote nil))) (while (consp (car cl--loop-args)) (push (pop cl--loop-args) cl--loop-finally))))) @@ -1036,7 +1046,8 @@ (if (eq word 'being) (setq word (pop cl--loop-args))) (if (memq word '(the each)) (setq word (pop cl--loop-args))) (if (memq word '(buffer buffers)) - (setq word 'in cl--loop-args (cons '(buffer-list) cl--loop-args))) + (setq word 'in + cl--loop-args (cons '(buffer-list) cl--loop-args))) (cond ((memq word '(from downfrom upfrom to downto upto @@ -1045,15 +1056,19 @@ (if (memq (car cl--loop-args) '(downto above)) (error "Must specify `from' value for downward cl-loop")) (let* ((down (or (eq (car cl--loop-args) 'downfrom) - (memq (cl-caddr cl--loop-args) '(downto above)))) + (memq (cl-caddr cl--loop-args) + '(downto above)))) (excl (or (memq (car cl--loop-args) '(above below)) - (memq (cl-caddr cl--loop-args) '(above below)))) - (start (and (memq (car cl--loop-args) '(from upfrom downfrom)) - (cl-pop2 cl--loop-args))) + (memq (cl-caddr cl--loop-args) + '(above below)))) + (start (and (memq (car cl--loop-args) + '(from upfrom downfrom)) + (cl--pop2 cl--loop-args))) (end (and (memq (car cl--loop-args) '(to upto downto above below)) - (cl-pop2 cl--loop-args))) - (step (and (eq (car cl--loop-args) 'by) (cl-pop2 cl--loop-args))) + (cl--pop2 cl--loop-args))) + (step (and (eq (car cl--loop-args) 'by) + (cl--pop2 cl--loop-args))) (end-var (and (not (macroexp-const-p end)) (make-symbol "--cl-var--"))) (step-var (and (not (macroexp-const-p step)) @@ -1087,7 +1102,7 @@ loop-for-sets)))) (push (list temp (if (eq (car cl--loop-args) 'by) - (let ((step (cl-pop2 cl--loop-args))) + (let ((step (cl--pop2 cl--loop-args))) (if (and (memq (car-safe step) '(quote function cl-function)) @@ -1099,7 +1114,8 @@ ((eq word '=) (let* ((start (pop cl--loop-args)) - (then (if (eq (car cl--loop-args) 'then) (cl-pop2 cl--loop-args) start))) + (then (if (eq (car cl--loop-args) 'then) + (cl--pop2 cl--loop-args) start))) (push (list var nil) loop-for-bindings) (if (or ands (eq (car cl--loop-args) 'and)) (progn @@ -1136,14 +1152,15 @@ (let ((ref (or (memq (car cl--loop-args) '(in-ref of-ref)) (and (not (memq (car cl--loop-args) '(in of))) (error "Expected `of'")))) - (seq (cl-pop2 cl--loop-args)) + (seq (cl--pop2 cl--loop-args)) (temp-seq (make-symbol "--cl-seq--")) - (temp-idx (if (eq (car cl--loop-args) 'using) - (if (and (= (length (cadr cl--loop-args)) 2) - (eq (cl-caadr cl--loop-args) 'index)) - (cadr (cl-pop2 cl--loop-args)) - (error "Bad `using' clause")) - (make-symbol "--cl-idx--")))) + (temp-idx + (if (eq (car cl--loop-args) 'using) + (if (and (= (length (cadr cl--loop-args)) 2) + (eq (cl-caadr cl--loop-args) 'index)) + (cadr (cl--pop2 cl--loop-args)) + (error "Bad `using' clause")) + (make-symbol "--cl-idx--")))) (push (list temp-seq seq) loop-for-bindings) (push (list temp-idx 0) loop-for-bindings) (if ref @@ -1166,15 +1183,17 @@ loop-for-steps))) ((memq word hash-types) - (or (memq (car cl--loop-args) '(in of)) (error "Expected `of'")) - (let* ((table (cl-pop2 cl--loop-args)) - (other (if (eq (car cl--loop-args) 'using) - (if (and (= (length (cadr cl--loop-args)) 2) - (memq (cl-caadr cl--loop-args) hash-types) - (not (eq (cl-caadr cl--loop-args) word))) - (cadr (cl-pop2 cl--loop-args)) - (error "Bad `using' clause")) - (make-symbol "--cl-var--")))) + (or (memq (car cl--loop-args) '(in of)) + (error "Expected `of'")) + (let* ((table (cl--pop2 cl--loop-args)) + (other + (if (eq (car cl--loop-args) 'using) + (if (and (= (length (cadr cl--loop-args)) 2) + (memq (cl-caadr cl--loop-args) hash-types) + (not (eq (cl-caadr cl--loop-args) word))) + (cadr (cl--pop2 cl--loop-args)) + (error "Bad `using' clause")) + (make-symbol "--cl-var--")))) (if (memq word '(hash-value hash-values)) (setq var (prog1 other (setq other var)))) (setq cl--loop-map-form @@ -1182,16 +1201,19 @@ ((memq word '(symbol present-symbol external-symbol symbols present-symbols external-symbols)) - (let ((ob (and (memq (car cl--loop-args) '(in of)) (cl-pop2 cl--loop-args)))) + (let ((ob (and (memq (car cl--loop-args) '(in of)) + (cl--pop2 cl--loop-args)))) (setq cl--loop-map-form `(mapatoms (lambda (,var) . --cl-map) ,ob)))) ((memq word '(overlay overlays extent extents)) (let ((buf nil) (from nil) (to nil)) (while (memq (car cl--loop-args) '(in of from to)) - (cond ((eq (car cl--loop-args) 'from) (setq from (cl-pop2 cl--loop-args))) - ((eq (car cl--loop-args) 'to) (setq to (cl-pop2 cl--loop-args))) - (t (setq buf (cl-pop2 cl--loop-args))))) + (cond ((eq (car cl--loop-args) 'from) + (setq from (cl--pop2 cl--loop-args))) + ((eq (car cl--loop-args) 'to) + (setq to (cl--pop2 cl--loop-args))) + (t (setq buf (cl--pop2 cl--loop-args))))) (setq cl--loop-map-form `(cl--map-overlays (lambda (,var ,(make-symbol "--cl-var--")) @@ -1203,11 +1225,13 @@ (var1 (make-symbol "--cl-var1--")) (var2 (make-symbol "--cl-var2--"))) (while (memq (car cl--loop-args) '(in of property from to)) - (cond ((eq (car cl--loop-args) 'from) (setq from (cl-pop2 cl--loop-args))) - ((eq (car cl--loop-args) 'to) (setq to (cl-pop2 cl--loop-args))) + (cond ((eq (car cl--loop-args) 'from) + (setq from (cl--pop2 cl--loop-args))) + ((eq (car cl--loop-args) 'to) + (setq to (cl--pop2 cl--loop-args))) ((eq (car cl--loop-args) 'property) - (setq prop (cl-pop2 cl--loop-args))) - (t (setq buf (cl-pop2 cl--loop-args))))) + (setq prop (cl--pop2 cl--loop-args))) + (t (setq buf (cl--pop2 cl--loop-args))))) (if (and (consp var) (symbolp (car var)) (symbolp (cdr var))) (setq var1 (car var) var2 (cdr var)) (push (list var `(cons ,var1 ,var2)) loop-for-sets)) @@ -1217,15 +1241,17 @@ ,buf ,prop ,from ,to)))) ((memq word key-types) - (or (memq (car cl--loop-args) '(in of)) (error "Expected `of'")) - (let ((cl-map (cl-pop2 cl--loop-args)) - (other (if (eq (car cl--loop-args) 'using) - (if (and (= (length (cadr cl--loop-args)) 2) - (memq (cl-caadr cl--loop-args) key-types) - (not (eq (cl-caadr cl--loop-args) word))) - (cadr (cl-pop2 cl--loop-args)) - (error "Bad `using' clause")) - (make-symbol "--cl-var--")))) + (or (memq (car cl--loop-args) '(in of)) + (error "Expected `of'")) + (let ((cl-map (cl--pop2 cl--loop-args)) + (other + (if (eq (car cl--loop-args) 'using) + (if (and (= (length (cadr cl--loop-args)) 2) + (memq (cl-caadr cl--loop-args) key-types) + (not (eq (cl-caadr cl--loop-args) word))) + (cadr (cl--pop2 cl--loop-args)) + (error "Bad `using' clause")) + (make-symbol "--cl-var--")))) (if (memq word '(key-binding key-bindings)) (setq var (prog1 other (setq other var)))) (setq cl--loop-map-form @@ -1245,7 +1271,8 @@ loop-for-steps))) ((memq word '(window windows)) - (let ((scr (and (memq (car cl--loop-args) '(in of)) (cl-pop2 cl--loop-args))) + (let ((scr (and (memq (car cl--loop-args) '(in of)) + (cl--pop2 cl--loop-args))) (temp (make-symbol "--cl-var--")) (minip (make-symbol "--cl-minip--"))) (push (list var (if scr @@ -1340,7 +1367,8 @@ ((memq word '(minimize minimizing maximize maximizing)) (let* ((what (pop cl--loop-args)) - (temp (if (cl--simple-expr-p what) what (make-symbol "--cl-var--"))) + (temp (if (cl--simple-expr-p what) what + (make-symbol "--cl-var--"))) (var (cl--loop-handle-accum nil)) (func (intern (substring (symbol-name word) 0 3))) (set `(setq ,var (if ,var (,func ,var ,temp) ,temp)))) @@ -1351,7 +1379,8 @@ ((eq word 'with) (let ((bindings nil)) (while (progn (push (list (pop cl--loop-args) - (and (eq (car cl--loop-args) '=) (cl-pop2 cl--loop-args))) + (and (eq (car cl--loop-args) '=) + (cl--pop2 cl--loop-args))) bindings) (eq (car cl--loop-args) 'and)) (pop cl--loop-args)) @@ -1364,19 +1393,23 @@ (push `(not ,(pop cl--loop-args)) cl--loop-body)) ((eq word 'always) - (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--"))) + (or cl--loop-finish-flag + (setq cl--loop-finish-flag (make-symbol "--cl-flag--"))) (push `(setq ,cl--loop-finish-flag ,(pop cl--loop-args)) cl--loop-body) (setq cl--loop-result t)) ((eq word 'never) - (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--"))) + (or cl--loop-finish-flag + (setq cl--loop-finish-flag (make-symbol "--cl-flag--"))) (push `(setq ,cl--loop-finish-flag (not ,(pop cl--loop-args))) cl--loop-body) (setq cl--loop-result t)) ((eq word 'thereis) - (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--"))) - (or cl--loop-result-var (setq cl--loop-result-var (make-symbol "--cl-var--"))) + (or cl--loop-finish-flag + (setq cl--loop-finish-flag (make-symbol "--cl-flag--"))) + (or cl--loop-result-var + (setq cl--loop-result-var (make-symbol "--cl-var--"))) (push `(setq ,cl--loop-finish-flag (not (setq ,cl--loop-result-var ,(pop cl--loop-args)))) cl--loop-body)) @@ -1384,11 +1417,11 @@ ((memq word '(if when unless)) (let* ((cond (pop cl--loop-args)) (then (let ((cl--loop-body nil)) - (cl-parse-loop-clause) + (cl--parse-loop-clause) (cl--loop-build-ands (nreverse cl--loop-body)))) (else (let ((cl--loop-body nil)) (if (eq (car cl--loop-args) 'else) - (progn (pop cl--loop-args) (cl-parse-loop-clause))) + (progn (pop cl--loop-args) (cl--parse-loop-clause))) (cl--loop-build-ands (nreverse cl--loop-body)))) (simple (and (eq (car then) t) (eq (car else) t)))) (if (eq (car cl--loop-args) 'end) (pop cl--loop-args)) @@ -1410,8 +1443,10 @@ (push (cons 'progn (nreverse (cons t body))) cl--loop-body))) ((eq word 'return) - (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-var--"))) - (or cl--loop-result-var (setq cl--loop-result-var (make-symbol "--cl-var--"))) + (or cl--loop-finish-flag + (setq cl--loop-finish-flag (make-symbol "--cl-var--"))) + (or cl--loop-result-var + (setq cl--loop-result-var (make-symbol "--cl-var--"))) (push `(setq ,cl--loop-result-var ,(pop cl--loop-args) ,cl--loop-finish-flag nil) cl--loop-body)) @@ -1421,7 +1456,7 @@ (or handler (error "Expected a cl-loop keyword, found %s" word)) (funcall handler)))) (if (eq (car cl--loop-args) 'and) - (progn (pop cl--loop-args) (cl-parse-loop-clause))))) + (progn (pop cl--loop-args) (cl--parse-loop-clause))))) (defun cl--loop-let (specs body par) ; uses loop-* (let ((p specs) (temps nil) (new nil)) @@ -1440,10 +1475,12 @@ (if (and (consp (car specs)) (listp (caar specs))) (let* ((spec (caar specs)) (nspecs nil) (expr (cadr (pop specs))) - (temp (cdr (or (assq spec cl--loop-destr-temps) - (car (push (cons spec (or (last spec 0) - (make-symbol "--cl-var--"))) - cl--loop-destr-temps)))))) + (temp + (cdr (or (assq spec cl--loop-destr-temps) + (car (push (cons spec + (or (last spec 0) + (make-symbol "--cl-var--"))) + cl--loop-destr-temps)))))) (push (list temp expr) new) (while (consp spec) (push (list (pop spec) @@ -1452,24 +1489,27 @@ (setq specs (nconc (nreverse nspecs) specs))) (push (pop specs) new))) (if (eq body 'setq) - (let ((set (cons (if par 'cl-psetq 'setq) (apply 'nconc (nreverse new))))) + (let ((set (cons (if par 'cl-psetq 'setq) + (apply 'nconc (nreverse new))))) (if temps `(let* ,(nreverse temps) ,set) set)) `(,(if par 'let 'let*) ,(nconc (nreverse temps) (nreverse new)) ,@body)))) -(defun cl--loop-handle-accum (def &optional func) ; uses loop-* +(defun cl--loop-handle-accum (def &optional func) ; uses loop-* (if (eq (car cl--loop-args) 'into) - (let ((var (cl-pop2 cl--loop-args))) + (let ((var (cl--pop2 cl--loop-args))) (or (memq var cl--loop-accum-vars) (progn (push (list (list var def)) cl--loop-bindings) (push var cl--loop-accum-vars))) var) (or cl--loop-accum-var (progn - (push (list (list (setq cl--loop-accum-var (make-symbol "--cl-var--")) def)) - cl--loop-bindings) + (push (list (list + (setq cl--loop-accum-var (make-symbol "--cl-var--")) + def)) + cl--loop-bindings) (setq cl--loop-result (if func (list func cl--loop-accum-var) - cl--loop-accum-var)) + cl--loop-accum-var)) cl--loop-accum-var)))) (defun cl--loop-build-ands (clauses) @@ -1516,7 +1556,7 @@ ((&rest &or symbolp (symbolp &optional form form)) (form body) cl-declarations body))) - (cl-expand-do-loop steps endtest body nil)) + (cl--expand-do-loop steps endtest body nil)) ;;;###autoload (defmacro cl-do* (steps endtest &rest body) @@ -1524,9 +1564,9 @@ \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (declare (indent 2) (debug cl-do)) - (cl-expand-do-loop steps endtest body t)) + (cl--expand-do-loop steps endtest body t)) -(defun cl-expand-do-loop (steps endtest body star) +(defun cl--expand-do-loop (steps endtest body star) `(cl-block nil (,(if star 'let* 'let) ,(mapcar (lambda (c) (if (consp c) (list (car c) (nth 1 c)) c)) @@ -1620,19 +1660,18 @@ BODY forms are executed and their result is returned. This is much like a `let' form, except that the list of symbols can be computed at run-time." (declare (indent 2) (debug (form form body))) - (let ((bodyfun (make-symbol "cl--progv-body")) + (let ((bodyfun (make-symbol "body")) (binds (make-symbol "binds")) (syms (make-symbol "syms")) (vals (make-symbol "vals"))) `(progn - (defvar ,bodyfun) (let* ((,syms ,symbols) (,vals ,values) (,bodyfun (lambda () ,@body)) (,binds ())) (while ,syms (push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds)) - (eval (list 'let ,binds '(funcall ,bodyfun))))))) + (eval (list 'let ,binds (list 'funcall (list 'quote ,bodyfun)))))))) (defvar cl--labels-convert-cache nil) @@ -1903,11 +1942,11 @@ (declare (indent 1) (debug (cl-type-spec form))) form) -(defvar cl-proclaim-history t) ; for future compilers -(defvar cl-declare-stack t) ; for future compilers +(defvar cl--proclaim-history t) ; for future compilers +(defvar cl--declare-stack t) ; for future compilers -(defun cl-do-proclaim (spec hist) - (and hist (listp cl-proclaim-history) (push spec cl-proclaim-history)) +(defun cl--do-proclaim (spec hist) + (and hist (listp cl--proclaim-history) (push spec cl--proclaim-history)) (cond ((eq (car-safe spec) 'special) (if (boundp 'byte-compile-bound-variables) (setq byte-compile-bound-variables @@ -1932,9 +1971,9 @@ '((0 nil) (1 t) (2 t) (3 t)))) (safety (assq (nth 1 (assq 'safety (cdr spec))) '((0 t) (1 t) (2 t) (3 nil))))) - (if speed (setq cl-optimize-speed (car speed) + (if speed (setq cl--optimize-speed (car speed) byte-optimize (nth 1 speed))) - (if safety (setq cl-optimize-safety (car safety) + (if safety (setq cl--optimize-safety (car safety) byte-compile-delete-errors (nth 1 safety))))) ((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings)) @@ -1946,10 +1985,10 @@ nil) ;;; Process any proclamations made before cl-macs was loaded. -(defvar cl-proclaims-deferred) -(let ((p (reverse cl-proclaims-deferred))) - (while p (cl-do-proclaim (pop p) t)) - (setq cl-proclaims-deferred nil)) +(defvar cl--proclaims-deferred) +(let ((p (reverse cl--proclaims-deferred))) + (while p (cl--do-proclaim (pop p) t)) + (setq cl--proclaims-deferred nil)) ;;;###autoload (defmacro cl-declare (&rest specs) @@ -1962,8 +2001,8 @@ See Info node `(cl)Declarations' for details." (if (cl--compiling-file) (while specs - (if (listp cl-declare-stack) (push (car specs) cl-declare-stack)) - (cl-do-proclaim (pop specs) nil))) + (if (listp cl--declare-stack) (push (car specs) cl--declare-stack)) + (cl--do-proclaim (pop specs) nil))) nil) ;;; The standard modify macros. @@ -2209,7 +2248,7 @@ (copier (intern (format "copy-%s" name))) (predicate (intern (format "%s-p" name))) (print-func nil) (print-auto nil) - (safety (if (cl--compiling-file) cl-optimize-safety 3)) + (safety (if (cl--compiling-file) cl--optimize-safety 3)) (include nil) (tag (intern (format "cl-struct-%s" name))) (tag-symbol (intern (format "cl-struct-%s-tags" name))) @@ -2454,7 +2493,8 @@ (if (consp (cadr type)) `(> ,val ,(cl-caadr type)) `(>= ,val ,(cadr type)))) ,(if (memq (cl-caddr type) '(* nil)) t - (if (consp (cl-caddr type)) `(< ,val ,(cl-caaddr type)) + (if (consp (cl-caddr type)) + `(< ,val ,(cl-caaddr type)) `(<= ,val ,(cl-caddr type))))))) ((memq (car type) '(and or not)) (cons (car type) @@ -2479,7 +2519,7 @@ STRING is an optional description of the desired type." (declare (debug (place cl-type-spec &optional stringp))) (and (or (not (cl--compiling-file)) - (< cl-optimize-speed 3) (= cl-optimize-safety 3)) + (< cl--optimize-speed 3) (= cl--optimize-safety 3)) (let* ((temp (if (cl--simple-expr-p form 3) form (make-symbol "--cl-var--"))) (body `(or ,(cl--make-type-test temp type) @@ -2499,7 +2539,7 @@ omitted, a default message listing FORM itself is used." (declare (debug (form &rest form))) (and (or (not (cl--compiling-file)) - (< cl-optimize-speed 3) (= cl-optimize-safety 3)) + (< cl--optimize-speed 3) (= cl--optimize-safety 3)) (let ((sargs (and show-args (delq nil (mapcar (lambda (x) (unless (macroexp-const-p x) @@ -2695,14 +2735,14 @@ ;;; Things that are side-effect-free. (mapc (lambda (x) (put x 'side-effect-free t)) - '(cl-oddp cl-evenp cl-signum last butlast cl-ldiff cl-pairlis cl-gcd cl-lcm - cl-isqrt cl-floor cl-ceiling cl-truncate cl-round cl-mod cl-rem cl-subseq - cl-list-length cl-get cl-getf)) + '(cl-oddp cl-evenp cl-signum last butlast cl-ldiff cl-pairlis cl-gcd + cl-lcm cl-isqrt cl-floor cl-ceiling cl-truncate cl-round cl-mod cl-rem + cl-subseq cl-list-length cl-get cl-getf)) ;;; Things that are side-effect-and-error-free. (mapc (lambda (x) (put x 'side-effect-free 'error-free)) - '(eql cl-floatp-safe cl-list* cl-subst cl-acons cl-equalp cl-random-state-p - copy-tree cl-sublis)) + '(eql cl-floatp-safe cl-list* cl-subst cl-acons cl-equalp + cl-random-state-p copy-tree cl-sublis)) (run-hooks 'cl-macs-load-hook) === modified file 'lisp/emacs-lisp/cl-seq.el' --- lisp/emacs-lisp/cl-seq.el 2012-09-28 23:30:52 +0000 +++ lisp/emacs-lisp/cl-seq.el 2012-12-06 21:29:29 +0000 @@ -105,6 +105,9 @@ (eq (not (funcall cl-test ,x ,y)) cl-test-not) (eql ,x ,y))) +;; Yuck! These vars are set/bound by cl--parsing-keywords to match :if :test +;; and :key keyword args, and they are also accessed (sometimes) via dynamic +;; scoping (and some of those accesses are from macro-expanded code). (defvar cl-test) (defvar cl-test-not) (defvar cl-if) (defvar cl-if-not) (defvar cl-key) @@ -333,7 +336,8 @@ (defun cl--delete-duplicates (cl-seq cl-keys cl-copy) (if (listp cl-seq) - (cl--parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if) + (cl--parsing-keywords + (:test :test-not :key (:start 0) :end :from-end :if) () (if cl-from-end (let ((cl-p (nthcdr cl-start cl-seq)) cl-i) @@ -776,7 +780,8 @@ (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) (while cl-list2 (if (or cl-keys (numberp (car cl-list2))) - (setq cl-list1 (apply 'cl-adjoin (car cl-list2) cl-list1 cl-keys)) + (setq cl-list1 + (apply 'cl-adjoin (car cl-list2) cl-list1 cl-keys)) (or (memq (car cl-list2) cl-list1) (push (car cl-list2) cl-list1))) (pop cl-list2)) ------------------------------------------------------------ revno: 111134 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2012-12-06 15:16:38 -0500 message: * lisp/ses.el: Use advice-add/remove. (ses--advice-copy-region-as-kill, ses--advice-yank): New functions. (copy-region-as-kill, yank): Use advice-add. (ses-unload-function): Use advice-remove. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-12-06 20:10:36 +0000 +++ lisp/ChangeLog 2012-12-06 20:16:38 +0000 @@ -1,3 +1,10 @@ +2012-12-06 Stefan Monnier + + * ses.el: Use advice-add/remove. + (ses--advice-copy-region-as-kill, ses--advice-yank): New functions. + (copy-region-as-kill, yank): Use advice-add. + (ses-unload-function): Use advice-remove. + 2012-12-06 Jonas Bernoulli * button.el: Make them work in header-lines (bug#12817). === modified file 'lisp/ses.el' --- lisp/ses.el 2012-11-24 17:44:29 +0000 +++ lisp/ses.el 2012-12-06 20:16:38 +0000 @@ -2718,8 +2718,9 @@ ;; Cut and paste, import and export ;;---------------------------------------------------------------------------- -(defadvice copy-region-as-kill (around ses-copy-region-as-kill - activate preactivate) +(defun ses--advice-copy-region-as-kill (crak-fun beg end &rest args) + ;; FIXME: Why doesn't it make sense to copy read-only or + ;; intangible attributes? They're removed upon yank! "It doesn't make sense to copy read-only or intangible attributes into the kill ring. It probably doesn't make sense to copy keymap properties. We'll assume copying front-sticky properties doesn't make sense, either. @@ -2730,14 +2731,15 @@ (let ((temp beg)) (setq beg end end temp))) - (if (not (and (eq major-mode 'ses-mode) + (if (not (and (derived-mode-p 'ses-mode) (eq (get-text-property beg 'read-only) 'ses) (eq (get-text-property (1- end) 'read-only) 'ses))) - ad-do-it ; Normal copy-region-as-kill. + (apply crak-fun beg end args) ; Normal copy-region-as-kill. (kill-new (ses-copy-region beg end)) (if transient-mark-mode (setq deactivate-mark t)) nil)) +(advice-add 'copy-region-as-kill :around #'ses--advice-copy-region-as-kill) (defun ses-copy-region (beg end) "Treat the region as rectangular. Convert the intangible attributes to @@ -2801,7 +2803,7 @@ (ses-clear-cell row col)) (ses-jump (car ses--curcell))) -(defadvice yank (around ses-yank activate preactivate) +(defun ses--advice-yank (yank-fun &optional arg &rest args) "In SES mode, the yanked text is inserted as cells. If the text contains 'ses attributes (meaning it went to the kill-ring from a @@ -2819,9 +2821,9 @@ make sense as a sexp or would otherwise be considered a symbol. Use 'sym to explicitly insert a symbol, or use the C-u prefix to treat all unmarked words as symbols." - (if (not (and (eq major-mode 'ses-mode) + (if (not (and (derived-mode-p 'ses-mode) (eq (get-text-property (point) 'keymap) 'ses-mode-print-map))) - ad-do-it ; Normal non-SES yank. + (apply yank-fun arg args) ; Normal non-SES yank. (ses-check-curcell 'end) (push-mark (point)) (let ((text (current-kill (cond @@ -2839,6 +2841,7 @@ arg))) (if (consp arg) (exchange-point-and-mark)))) +(advice-add 'yank :around #'ses--advice-yank) (defun ses-yank-pop (arg) "Replace just-yanked stretch of killed text with a different stretch. @@ -3586,10 +3589,9 @@ (defun ses-unload-function () "Unload the Simple Emacs Spreadsheet." - (dolist (fun '(copy-region-as-kill yank)) - (ad-remove-advice fun 'around (intern (concat "ses-" (symbol-name fun)))) - (ad-update fun)) - ;; continue standard unloading + (advice-remove 'yank #'ses--advice-yank) + (advice-remove 'copy-region-as-kill #'ses--advice-copy-region-as-kill) + ;; Continue standard unloading. nil) (provide 'ses) ------------------------------------------------------------ revno: 111133 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=12817 author: Jonas Bernoulli committer: Stefan Monnier branch nick: trunk timestamp: Thu 2012-12-06 15:10:36 -0500 message: * lisp/button.el: Make them work in header-lines. (button-map): Add bindings for header-line and mode-line use. (button-get, button-put, button-label): `button' may now be a string. (button-activate): Don't make it a defsubst. (button--area-button-p, button--area-button-string): New functions. (make-text-button): Fix the return value when `beg' was a string. (push-button): Handle the mode-line case. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-12-06 17:29:30 +0000 +++ lisp/ChangeLog 2012-12-06 20:10:36 +0000 @@ -1,3 +1,13 @@ +2012-12-06 Jonas Bernoulli + + * button.el: Make them work in header-lines (bug#12817). + (button-map): Add bindings for header-line and mode-line use. + (button-get, button-put, button-label): `button' may now be a string. + (button-activate): Don't make it a defsubst. + (button--area-button-p, button--area-button-string): New functions. + (make-text-button): Fix the return value when `beg' was a string. + (push-button): Handle the mode-line case. + 2012-12-06 Stefan Monnier * progmodes/sql.el: Use cl-lib and lexical-binding; various cleanup. === modified file 'lisp/button.el' --- lisp/button.el 2012-03-25 07:58:59 +0000 +++ lisp/button.el 2012-12-06 20:10:36 +0000 @@ -64,6 +64,11 @@ ;; might get converted to ^M when building loaddefs.el (define-key map [(control ?m)] 'push-button) (define-key map [mouse-2] 'push-button) + ;; FIXME: You'd think that for keymaps coming from text-properties on the + ;; mode-line or header-line, the `mode-line' or `header-line' prefix + ;; shouldn't be necessary! + (define-key map [mode-line mouse-2] 'push-button) + (define-key map [header-line mouse-2] 'push-button) map) "Keymap used by buttons.") @@ -184,10 +189,12 @@ (defun button-get (button prop) "Get the property of button BUTTON named PROP." - (if (overlayp button) - (overlay-get button prop) - ;; Must be a text-property button. - (get-text-property button prop))) + (cond ((overlayp button) + (overlay-get button prop)) + ((button--area-button-p button) + (get-text-property 0 prop (button--area-button-string button))) + (t ; Must be a text-property button. + (get-text-property button prop)))) (defun button-put (button prop val) "Set BUTTON's PROP property to VAL." @@ -202,21 +209,30 @@ ;; Disallow updating the `category' property directly. (error "Button `category' property may not be set directly"))) ;; Add the property. - (if (overlayp button) - (overlay-put button prop val) - ;; Must be a text-property button. - (put-text-property - (or (previous-single-property-change (1+ button) 'button) - (point-min)) - (or (next-single-property-change button 'button) - (point-max)) - prop val))) + (cond ((overlayp button) + (overlay-put button prop val)) + ((button--area-button-p button) + (setq button (button--area-button-string button)) + (put-text-property 0 (length button) prop val button)) + (t ; Must be a text-property button. + (put-text-property + (or (previous-single-property-change (1+ button) 'button) + (point-min)) + (or (next-single-property-change button 'button) + (point-max)) + prop val)))) -(defsubst button-activate (button &optional use-mouse-action) +(defun button-activate (button &optional use-mouse-action) "Call BUTTON's action property. If USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action instead of its normal action; if the button has no mouse-action, -the normal action is used instead." +the normal action is used instead. + +The action can either be a marker or a function. If it's a +marker then goto it. Otherwise it it is a function then it is +called with BUTTON as only argument. BUTTON is either an +overlay, a buffer position, or (for buttons in the mode-line or +header-line) a string." (let ((action (or (and use-mouse-action (button-get button 'mouse-action)) (button-get button 'action)))) (if (markerp action) @@ -228,7 +244,10 @@ (defun button-label (button) "Return BUTTON's text label." - (buffer-substring-no-properties (button-start button) (button-end button))) + (if (button--area-button-p button) + (substring-no-properties (button--area-button-string button)) + (buffer-substring-no-properties (button-start button) + (button-end button)))) (defsubst button-type (button) "Return BUTTON's button-type." @@ -238,6 +257,12 @@ "Return t if BUTTON has button-type TYPE, or one of TYPE's subtypes." (button-type-subtype-p (button-get button 'type) type)) +(defalias 'button--area-button-p 'stringp + "Return non-nil if BUTTON is an area button. +Such area buttons are used for buttons in the mode-line and header-line.") + +(defalias 'button--area-button-string 'identity + "Return area button BUTTON's button-string.") ;; Creating overlay buttons @@ -324,7 +349,7 @@ (cons 'button (cons (list t) properties)) object) ;; Return something that can be used to get at the button. - beg)) + (or object beg))) (defun insert-text-button (label &rest properties) "Insert a button with the label LABEL. @@ -405,7 +430,9 @@ USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action instead of its normal action; if the button has no mouse-action, the normal action is used instead. The action may be either a -function to call or a marker to display. +function to call or a marker to display and is invoked using +`button-activate' (which see). + POS defaults to point, except when `push-button' is invoked interactively as the result of a mouse-event, in which case, the mouse event is used. @@ -417,11 +444,13 @@ ;; POS is a mouse event; switch to the proper window/buffer (let ((posn (event-start pos))) (with-current-buffer (window-buffer (posn-window posn)) - (push-button (posn-point posn) t))) + (if (posn-area posn) + ;; mode-line or header-line event + (button-activate (car (posn-string posn)) t) + (push-button (posn-point posn)) t))) ;; POS is just normal position (let ((button (button-at (or pos (point))))) - (if (not button) - nil + (when button (button-activate button use-mouse-action) t)))) ------------------------------------------------------------ revno: 111132 fixes bug: http://debbugs.gnu.org/13086 committer: Eli Zaretskii branch nick: trunk timestamp: Thu 2012-12-06 20:36:22 +0200 message: Avoid busy-waiting for child processes on Windows. (Bug#13086) src/w32proc.c (waitpid): Avoid busy-waiting when called with WNOHANG if the child process is still running. Instead, exit the wait loop and return zero. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-12-06 13:48:11 +0000 +++ src/ChangeLog 2012-12-06 18:36:22 +0000 @@ -1,3 +1,9 @@ +2012-12-06 Eli Zaretskii + + * w32proc.c (waitpid): Avoid busy-waiting when called with WNOHANG + if the child process is still running. Instead, exit the wait + loop and return zero. (Bug#13086) + 2012-12-06 Dmitry Antipov * frame.h (x_char_width, x_char_height): Remove prototypes. === modified file 'src/w32proc.c' --- src/w32proc.c 2012-12-03 21:42:12 +0000 +++ src/w32proc.c 2012-12-06 18:36:22 +0000 @@ -1220,13 +1220,22 @@ { QUIT; active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms); - } while (active == WAIT_TIMEOUT); + } while (active == WAIT_TIMEOUT && !dont_wait); if (active == WAIT_FAILED) { errno = EBADF; return -1; } + else if (active == WAIT_TIMEOUT && dont_wait) + { + /* PID specifies our subprocess, but it didn't exit yet, so its + status is not yet available. */ +#ifdef FULL_DEBUG + DebPrint (("Wait: PID %d not reap yet\n", cp->pid)); +#endif + return 0; + } else if (active >= WAIT_OBJECT_0 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS) { ------------------------------------------------------------ revno: 111131 committer: Sam Steingold branch nick: trunk timestamp: Thu 2012-12-06 13:30:38 -0500 message: * lisp/gnus/gnus-start.el (gnus-before-resume-hook): Add. (gnus-1): Run it when Gnus is alive. diff: === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2012-12-06 06:17:10 +0000 +++ doc/misc/gnus.texi 2012-12-06 18:30:38 +0000 @@ -1580,6 +1580,10 @@ @vindex gnus-before-startup-hook A hook called as the first thing when Gnus is started. +@item gnus-before-resume-hook +@vindex gnus-before-resume-hook +A hook called as the first thing when Gnus is resumed after a suspend. + @item gnus-startup-hook @vindex gnus-startup-hook A hook run as the very last thing after starting up Gnus === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2012-12-06 04:28:00 +0000 +++ lisp/gnus/ChangeLog 2012-12-06 18:30:38 +0000 @@ -1,3 +1,8 @@ +2012-12-06 Sam Steingold + + * gnus-start.el (gnus-before-resume-hook): Add. + (gnus-1): Run it when Gnus is alive. + 2012-12-06 Katsumi Yamaoka * gmm-utils.el (gmm-called-interactively-p): Restore as a macro. === modified file 'lisp/gnus/gnus-start.el' --- lisp/gnus/gnus-start.el 2012-10-23 15:06:07 +0000 +++ lisp/gnus/gnus-start.el 2012-12-06 18:30:38 +0000 @@ -395,7 +395,15 @@ (defcustom gnus-before-startup-hook nil "A hook called before startup. -This hook is called as the first thing when Gnus is started." +This hook is called as the first thing when Gnus is started. +See also `gnus-before-resume-hook'." + :group 'gnus-start + :type 'hook) + +(defcustom gnus-before-resume-hook nil + "A hook called before resuming Gnus after suspend. +This hook is called as the first thing when Gnus is resumed after a suspend. +See also `gnus-before-startup-hook'." :group 'gnus-start :type 'hook) @@ -749,6 +757,7 @@ (if (gnus-alive-p) (progn + (gnus-run-hooks 'gnus-before-resume-hook) (switch-to-buffer gnus-group-buffer) (gnus-group-get-new-news (and (numberp arg) ------------------------------------------------------------ revno: 111130 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2012-12-06 12:29:30 -0500 message: * lisp/progmodes/sql.el: Use cl-lib and lexical-binding; various cleanup. (sql-signum): Remove. Use `cl-signum' instead. (sql-read-passwd): Remove; use read-passwd instread. (sql-get-login-ext): Use read-string. (sql-get-login): Use dolist and pcase. (sql--completion-table): Rename from sql-try-completion. Use complete-with-action. (sql-mode): Don't change abbrev-all-caps globally. (sql-connect): Don't rely on dynamic scoping for `new-name'. (sql-postgres-completion-object): Initialize vars in their `let'. (sql-comint-sybase, sql-comint-sqlite, sql-comint-mysql) (sql-comint-solid, sql-comint-ms, sql-comint-postgres) (sql-comint-interbase): Use a single append, without setq. (sql-comint-linter): Same, and unwind-protect the LINTER_MBX var. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-12-06 16:17:11 +0000 +++ lisp/ChangeLog 2012-12-06 17:29:30 +0000 @@ -1,5 +1,20 @@ 2012-12-06 Stefan Monnier + * progmodes/sql.el: Use cl-lib and lexical-binding; various cleanup. + (sql-signum): Remove. Use `cl-signum' instead. + (sql-read-passwd): Remove; use read-passwd instread. + (sql-get-login-ext): Use read-string. + (sql-get-login): Use dolist and pcase. + (sql--completion-table): Rename from sql-try-completion. + Use complete-with-action. + (sql-mode): Don't change abbrev-all-caps globally. + (sql-connect): Don't rely on dynamic scoping for `new-name'. + (sql-postgres-completion-object): Initialize vars in their `let'. + (sql-comint-sybase, sql-comint-sqlite, sql-comint-mysql) + (sql-comint-solid, sql-comint-ms, sql-comint-postgres) + (sql-comint-interbase): Use a single append, without setq. + (sql-comint-linter): Same, and unwind-protect the LINTER_MBX var. + * hi-lock.el: Rework the default face and the serialize regexp code. (hi-lock--auto-select-face-defaults): Remove. (hi-lock-string-serialize-serial): Remove. === modified file 'lisp/progmodes/sql.el' --- lisp/progmodes/sql.el 2012-11-21 21:47:10 +0000 +++ lisp/progmodes/sql.el 2012-12-06 17:29:30 +0000 @@ -1,4 +1,4 @@ -;;; sql.el --- specialized comint.el for SQL interpreters +;;; sql.el --- specialized comint.el for SQL interpreters -*- lexical-binding: t -*- ;; Copyright (C) 1998-2012 Free Software Foundation, Inc. @@ -80,14 +80,6 @@ ;; Hint for newbies: take a look at `dabbrev-expand', `abbrev-mode', and ;; `imenu-add-menubar-index'. -;;; Requirements for Emacs 19.34: - -;; If you are using Emacs 19.34, you will have to get and install -;; the file regexp-opt.el -;; -;; and the custom package -;; . - ;;; Bugs: ;; sql-ms now uses osql instead of isql. Osql flushes its error @@ -169,15 +161,17 @@ ;; ;; ;; Do something with `sql-user', `sql-password', ;; ;; `sql-database', and `sql-server'. -;; (let ((params options)) -;; (if (not (string= "" sql-server)) -;; (setq params (append (list "-S" sql-server) params))) -;; (if (not (string= "" sql-database)) -;; (setq params (append (list "-D" sql-database) params))) -;; (if (not (string= "" sql-password)) -;; (setq params (append (list "-P" sql-password) params))) +;; (let ((params +;; (append ;; (if (not (string= "" sql-user)) -;; (setq params (append (list "-U" sql-user) params))) +;; (list "-U" sql-user)) +;; (if (not (string= "" sql-password)) +;; (list "-P" sql-password)) +;; (if (not (string= "" sql-database)) +;; (list "-D" sql-database)) +;; (if (not (string= "" sql-server)) +;; (list "-S" sql-server)) +;; options))) ;; (sql-comint product params))) ;; ;; (sql-set-product-feature 'xyz @@ -229,22 +223,13 @@ ;;; Code: +(require 'cl-lib) (require 'comint) ;; Need the following to allow GNU Emacs 19 to compile the file. (eval-when-compile (require 'regexp-opt)) (require 'custom) (require 'thingatpt) -(eval-when-compile ;; needed in Emacs 19, 20 - (setq max-specpdl-size (max max-specpdl-size 2000))) - -(defun sql-signum (n) - "Return 1, 0, or -1 to identify the sign of N." - (cond - ((not (numberp n)) nil) - ((< n 0) -1) - ((> n 0) 1) - (t 0))) (defvar font-lock-keyword-face) (defvar font-lock-set-defaults) @@ -636,12 +621,14 @@ (set (group (const :tag "Product" sql-product) (choice - ,@(mapcar (lambda (prod-info) - `(const :tag - ,(or (plist-get (cdr prod-info) :name) - (capitalize (symbol-name (car prod-info)))) - (quote ,(car prod-info)))) - sql-product-alist))) + ,@(mapcar + (lambda (prod-info) + `(const :tag + ,(or (plist-get (cdr prod-info) :name) + (capitalize + (symbol-name (car prod-info)))) + (quote ,(car prod-info)))) + sql-product-alist))) (group (const :tag "Username" sql-user) string) (group (const :tag "Password" sql-password) string) (group (const :tag "Server" sql-server) string) @@ -655,8 +642,8 @@ :group 'SQL) (defcustom sql-product 'ansi - "Select the SQL database product used so that buffers can be -highlighted properly when you open them." + "Select the SQL database product used. +This allows highlighting buffers properly when you open them." :type `(choice ,@(mapcar (lambda (prod-info) `(const :tag @@ -818,12 +805,11 @@ ;; Customization for ANSI -(defcustom sql-ansi-statement-starters (regexp-opt '( - "create" "alter" "drop" - "select" "insert" "update" "delete" "merge" - "grant" "revoke" -)) - "Regexp of keywords that start SQL commands +(defcustom sql-ansi-statement-starters + (regexp-opt '("create" "alter" "drop" + "select" "insert" "update" "delete" "merge" + "grant" "revoke")) + "Regexp of keywords that start SQL commands. All products share this list; products should define a regexp to identify additional keywords in a variable defined by @@ -1167,10 +1153,10 @@ Used by `sql-rename-buffer'.") (defun sql-buffer-live-p (buffer &optional product connection) - "Returns non-nil if the process associated with buffer is live. + "Return non-nil if the process associated with buffer is live. BUFFER can be a buffer object or a buffer name. The buffer must -be a live buffer, have an running process attached to it, be in +be a live buffer, have a running process attached to it, be in `sql-interactive-mode', and, if PRODUCT or CONNECTION are specified, it's `sql-product' or `sql-connection' must match." @@ -1178,7 +1164,6 @@ (setq buffer (get-buffer buffer)) (and buffer (buffer-live-p buffer) - (get-buffer-process buffer) (comint-check-proc buffer) (with-current-buffer buffer (and (derived-mode-p 'sql-interactive-mode) @@ -1287,27 +1272,15 @@ ;; Abbreviations -- if you want more of them, define them in your init ;; file. Abbrevs have to be enabled in your init file, too. -(defvar sql-mode-abbrev-table nil +(define-abbrev-table 'sql-mode-abbrev-table + '(("ins" "insert" nil nil t) + ("upd" "update" nil nil t) + ("del" "delete" nil nil t) + ("sel" "select" nil nil t) + ("proc" "procedure" nil nil t) + ("func" "function" nil nil t) + ("cr" "create" nil nil t)) "Abbrev table used in `sql-mode' and `sql-interactive-mode'.") -(unless sql-mode-abbrev-table - (define-abbrev-table 'sql-mode-abbrev-table nil)) - -(mapc - ;; In Emacs 22+, provide SYSTEM-FLAG to define-abbrev. - (lambda (abbrev) - (let ((name (car abbrev)) - (expansion (cdr abbrev))) - (condition-case nil - (define-abbrev sql-mode-abbrev-table name expansion nil 0 t) - (error - (define-abbrev sql-mode-abbrev-table name expansion))))) - '(("ins" . "insert") - ("upd" . "update") - ("del" . "delete") - ("sel" . "select") - ("proc" . "procedure") - ("func" . "function") - ("cr" . "create"))) ;; Syntax Table @@ -1530,9 +1503,8 @@ you define your own `sql-mode-ansi-font-lock-keywords'. You may want to add functions and PL/SQL keywords.") -(defun sql-oracle-show-reserved-words () +(defun sql--oracle-show-reserved-words () ;; This function is for use by the maintainer of SQL.EL only. - (interactive) (if (or (and (not (derived-mode-p 'sql-mode)) (not (derived-mode-p 'sql-interactive-mode))) (not sql-buffer) @@ -2611,14 +2583,12 @@ (append keywords old-val)))))) (defun sql-for-each-login (login-params body) - "Iterates through login parameters and returns a list of results." - + "Iterate through login parameters and return a list of results." (delq nil (mapcar (lambda (param) - (let ((token (or (and (listp param) (car param)) param)) - (plist (or (and (listp param) (cdr param)) nil))) - + (let ((token (or (car-safe param) param)) + (plist (cdr-safe param))) (funcall body token plist))) login-params))) @@ -2682,6 +2652,34 @@ local variable." (save-excursion (comint-bol nil) (point)))) +;;; SMIE support + +;; Needs a lot more love than I can provide. --Stef + +;; (require 'smie) + +;; (defconst sql-smie-grammar +;; (smie-prec2->grammar +;; (smie-bnf->prec2 +;; ;; Partly based on http://www.h2database.com/html/grammar.html +;; '((cmd ("SELECT" select-exp "FROM" select-table-exp) +;; ) +;; (select-exp ("*") (exp) (exp "AS" column-alias)) +;; (column-alias) +;; (select-table-exp (table-exp "WHERE" exp) (table-exp)) +;; (table-exp) +;; (exp ("CASE" exp "WHEN" exp "THEN" exp "ELSE" exp "END") +;; ("CASE" exp "WHEN" exp "THEN" exp "END")) +;; ;; Random ad-hoc additions. +;; (foo (foo "," foo)) +;; ) +;; '((assoc ","))))) + +;; (defun sql-smie-rules (kind token) +;; (pcase (cons kind token) +;; (`(:list-intro . ,_) t) +;; (`(:before . "(") (smie-rule-parent)))) + ;;; Motion Functions (defun sql-statement-regexp (prod) @@ -2694,7 +2692,7 @@ "\\>"))) (defun sql-beginning-of-statement (arg) - "Moves the cursor to the beginning of the current SQL statement." + "Move to the beginning of the current SQL statement." (interactive "p") (let ((here (point)) @@ -2721,10 +2719,10 @@ (beginning-of-line) ;; If we didn't move, try again (when (= here (point)) - (sql-beginning-of-statement (* 2 (sql-signum arg)))))) + (sql-beginning-of-statement (* 2 (cl-signum arg)))))) (defun sql-end-of-statement (arg) - "Moves the cursor to the end of the current SQL statement." + "Move to the end of the current SQL statement." (interactive "p") (let ((term (sql-get-product-feature sql-product :terminator)) (re-search (if (> 0 arg) 're-search-backward 're-search-forward)) @@ -2733,7 +2731,7 @@ (when (consp term) (setq term (car term))) ;; Iterate until we've moved the desired number of stmt ends - (while (not (= (sql-signum arg) 0)) + (while (not (= (cl-signum arg) 0)) ;; if we're looking at the terminator, jump by 2 (if (or (and (> 0 arg) (looking-back term)) (and (< 0 arg) (looking-at term))) @@ -2744,7 +2742,7 @@ (setq arg 0) ;; count it if we're not in a comment (unless (nth 7 (syntax-ppss)) - (setq arg (- arg (sql-signum arg)))))) + (setq arg (- arg (cl-signum arg)))))) (goto-char (if (match-data) (match-end 0) here)))) @@ -2857,10 +2855,6 @@ t t doc 0))) doc) -(defun sql-read-passwd (prompt &optional default) - "Read a password using PROMPT. Optional DEFAULT is password to start with." - (read-passwd prompt nil default)) - (defun sql-get-login-ext (symbol prompt history-var plist) "Prompt user with extended login parameters. @@ -2912,8 +2906,7 @@ (read-number prompt (or default last-value 0))) (t - (let ((r (read-from-minibuffer prompt-def last-value nil nil history-var nil))) - (if (string= "" r) (or default "") r))))))) + (read-string prompt-def last-value history-var default)))))) (defun sql-get-login (&rest what) "Get username, password and database from the user. @@ -2943,32 +2936,29 @@ In order to ask the user for username, password and database, call the function like this: (sql-get-login 'user 'password 'database)." - (interactive) - (mapcar - (lambda (w) - (let ((token (or (and (consp w) (car w)) w)) - (plist (or (and (consp w) (cdr w)) nil))) - - (cond - ((eq token 'user) ; user - (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist)) - - ((eq token 'password) ; password - (setq-default sql-password - (sql-read-passwd "Password: " sql-password))) - - ((eq token 'server) ; server - (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist)) - - ((eq token 'database) ; database - (sql-get-login-ext 'sql-database "Database: " 'sql-database-history plist)) - - ((eq token 'port) ; port - (sql-get-login-ext 'sql-port "Port: " nil (append '(:number t) plist)))))) - what)) + (dolist (w what) + (let ((plist (cdr-safe w))) + (pcase (or (car-safe w) w) + (`user + (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist)) + + (`password + (setq-default sql-password + (read-passwd "Password: " nil sql-password))) + + (`server + (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist)) + + (`database + (sql-get-login-ext 'sql-database "Database: " + 'sql-database-history plist)) + + (`port + (sql-get-login-ext 'sql-port "Port: " + nil (append '(:number t) plist))))))) (defun sql-find-sqli-buffer (&optional product connection) - "Returns the name of the current default SQLi buffer or nil. + "Return the name of the current default SQLi buffer or nil. In order to qualify, the SQLi buffer must be alive, be in `sql-interactive-mode' and have a process." (let ((buf sql-buffer) @@ -3072,29 +3062,29 @@ (sql-for-each-login (sql-get-product-feature sql-product :sqli-login) (lambda (token plist) - (cond - ((eq token 'user) + (pcase token + (`user (unless (string= "" sql-user) (list "/" sql-user))) - ((eq token 'port) + (`port (unless (or (not (numberp sql-port)) (= 0 sql-port)) (list ":" (number-to-string sql-port)))) - ((eq token 'server) + (`server (unless (string= "" sql-server) (list "." (if (plist-member plist :file) (file-name-nondirectory sql-server) sql-server)))) - ((eq token 'database) + (`database (unless (string= "" sql-database) (list "@" (if (plist-member plist :file) (file-name-nondirectory sql-database) sql-database)))) - ((eq token 'password) nil) - (t nil)))))))) + ;; (`password nil) + (_ nil)))))))) ;; If there's a connection, use it and the name thus far (if sql-connection @@ -3527,7 +3517,7 @@ (nreverse results))) (defun sql-execute (sqlbuf outbuf command enhanced arg) - "Executes a command in a SQL interactive buffer and captures the output. + "Execute a command in a SQL interactive buffer and capture the output. The commands are run in SQLBUF and the output saved in OUTBUF. COMMAND must be a string, a function or a list of such elements. @@ -3535,7 +3525,7 @@ strings are formatted with ARG and executed. If the results are empty the OUTBUF is deleted, otherwise the -buffer is popped into a view window. " +buffer is popped into a view window." (mapc (lambda (c) (cond @@ -3600,43 +3590,35 @@ (defvar sql-completion-sqlbuf nil) -(defun sql-try-completion (string collection &optional predicate) +(defun sql--completion-table (string pred action) (when sql-completion-sqlbuf - (with-current-buffer sql-completion-sqlbuf - (let ((schema (and (string-match "\\`\\(\\sw\\(:?\\sw\\|\\s_\\)*\\)[.]" string) - (downcase (match-string 1 string))))) - - ;; If we haven't loaded any object name yet, load local schema - (unless sql-completion-object - (sql-build-completions nil)) - - ;; If they want another schema, load it if we haven't yet - (when schema - (let ((schema-dot (concat schema ".")) - (schema-len (1+ (length schema))) - (names sql-completion-object) - has-schema) - - (while (and (not has-schema) names) - (setq has-schema (and - (>= (length (car names)) schema-len) - (string= schema-dot - (downcase (substring (car names) - 0 schema-len)))) - names (cdr names))) - (unless has-schema - (sql-build-completions schema))))) - - ;; Try to find the completion - (cond - ((not predicate) - (try-completion string sql-completion-object)) - ((eq predicate t) - (all-completions string sql-completion-object)) - ((eq predicate 'lambda) - (test-completion string sql-completion-object)) - ((eq (car predicate) 'boundaries) - (completion-boundaries string sql-completion-object nil (cdr predicate))))))) + (with-current-buffer sql-completion-sqlbuf + (let ((schema (and (string-match "\\`\\(\\sw\\(:?\\sw\\|\\s_\\)*\\)[.]" string) + (downcase (match-string 1 string))))) + + ;; If we haven't loaded any object name yet, load local schema + (unless sql-completion-object + (sql-build-completions nil)) + + ;; If they want another schema, load it if we haven't yet + (when schema + (let ((schema-dot (concat schema ".")) + (schema-len (1+ (length schema))) + (names sql-completion-object) + has-schema) + + (while (and (not has-schema) names) + (setq has-schema (and + (>= (length (car names)) schema-len) + (string= schema-dot + (downcase (substring (car names) + 0 schema-len)))) + names (cdr names))) + (unless has-schema + (sql-build-completions schema))))) + + ;; Try to find the completion + (complete-with-action action sql-completion-object string pred)))) (defun sql-read-table-name (prompt) "Read the name of a database table." @@ -3652,7 +3634,7 @@ (completion-ignore-case t)) (if (sql-get-product-feature product :completion-object) - (completing-read prompt (function sql-try-completion) + (completing-read prompt #'sql--completion-table nil nil tname) (read-from-minibuffer prompt tname)))) @@ -3720,6 +3702,7 @@ (if sql-mode-menu (easy-menu-add sql-mode-menu)); XEmacs + ;; (smie-setup sql-smie-grammar #'sql-smie-rules) (set (make-local-variable 'comment-start) "--") ;; Make each buffer in sql-mode remember the "current" SQLi buffer. (make-local-variable 'sql-buffer) @@ -3733,7 +3716,7 @@ (set (make-local-variable 'paragraph-separate) "[\f]*$") (set (make-local-variable 'paragraph-start) "[\n\f]") ;; Abbrevs - (setq abbrev-all-caps 1) + (setq-local abbrev-all-caps 1) ;; Contains the name of database objects (set (make-local-variable 'sql-contains-names) t) ;; Catch changes to sql-product and highlight accordingly @@ -3959,13 +3942,13 @@ (setq set-params (mapcar (lambda (v) - (cond - ((eq (car v) 'sql-user) 'user) - ((eq (car v) 'sql-password) 'password) - ((eq (car v) 'sql-server) 'server) - ((eq (car v) 'sql-database) 'database) - ((eq (car v) 'sql-port) 'port) - (t (car v)))) + (pcase (car v) + (`sql-user 'user) + (`sql-password 'password) + (`sql-server 'server) + (`sql-database 'database) + (`sql-port 'port) + (s s))) (cdr connect-set))) ;; the remaining params (w/o the connection params) @@ -3984,7 +3967,7 @@ ;; Start the SQLi session with revised list of login parameters (eval `(let ((,param-var ',rem-params)) - (sql-product-interactive sql-product new-name)))) + (sql-product-interactive ',sql-product ',new-name)))) (message "SQL Connection <%s> does not exist" connection) nil))) @@ -4028,16 +4011,16 @@ (if (assoc name alist) (message "Connection <%s> already exists" name) (setq connect - (append (list name) - (sql-for-each-login - `(product ,@login) - (lambda (token _plist) - (cond - ((eq token 'product) `(sql-product ',product)) - ((eq token 'user) `(sql-user ,user)) - ((eq token 'database) `(sql-database ,database)) - ((eq token 'server) `(sql-server ,server)) - ((eq token 'port) `(sql-port ,port))))))) + (cons name + (sql-for-each-login + `(product ,@login) + (lambda (token _plist) + (pcase token + (`product `(sql-product ',product)) + (`user `(sql-user ,user)) + (`database `(sql-database ,database)) + (`server `(sql-server ,server)) + (`port `(sql-port ,port))))))) (setq alist (append alist (list connect))) @@ -4047,7 +4030,7 @@ (customize-set-variable 'sql-connection-alist alist))))))) (defun sql-connection-menu-filter (tail) - "Generates menu entries for using each connection." + "Generate menu entries for using each connection." (append (mapcar (lambda (conn) @@ -4114,7 +4097,8 @@ new-sqli-buffer) ;; Get credentials. - (apply 'sql-get-login (sql-get-product-feature product :sqli-login)) + (apply #'sql-get-login + (sql-get-product-feature product :sqli-login)) ;; Connect to database. (message "Login...") @@ -4225,7 +4209,7 @@ (sql-comint product parameter))) (defun sql-oracle-save-settings (sqlbuf) - "Saves most SQL*Plus settings so they may be reset by \\[sql-redirect]." + "Save most SQL*Plus settings so they may be reset by \\[sql-redirect]." ;; Note: does not capture the following settings: ;; ;; APPINFO @@ -4297,7 +4281,7 @@ ;; Restore the changed settings (sql-redirect sqlbuf saved-settings)) -(defun sql-oracle-list-all (sqlbuf outbuf enhanced table-name) +(defun sql-oracle-list-all (sqlbuf outbuf enhanced _table-name) ;; Query from USER_OBJECTS or ALL_OBJECTS (let ((settings (sql-oracle-save-settings sqlbuf)) (simple-sql @@ -4336,7 +4320,7 @@ (sql-oracle-restore-settings sqlbuf settings))) -(defun sql-oracle-list-table (sqlbuf outbuf enhanced table-name) +(defun sql-oracle-list-table (sqlbuf outbuf _enhanced table-name) "Implements :list-table under Oracle." (let ((settings (sql-oracle-save-settings sqlbuf))) @@ -4413,15 +4397,17 @@ "Create comint buffer and connect to Sybase." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options)) - (if (not (string= "" sql-server)) - (setq params (append (list "-S" sql-server) params))) - (if (not (string= "" sql-database)) - (setq params (append (list "-D" sql-database) params))) - (if (not (string= "" sql-password)) - (setq params (append (list "-P" sql-password) params))) - (if (not (string= "" sql-user)) - (setq params (append (list "-U" sql-user) params))) + (let ((params + (append + (if (not (string= "" sql-user)) + (list "-U" sql-user)) + (if (not (string= "" sql-password)) + (list "-P" sql-password)) + (if (not (string= "" sql-database)) + (list "-D" sql-database)) + (if (not (string= "" sql-server)) + (list "-S" sql-server)) + options))) (sql-comint product params))) @@ -4506,14 +4492,13 @@ "Create comint buffer and connect to SQLite." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params)) - (if (not (string= "" sql-database)) - (setq params (append (list (expand-file-name sql-database)) - params))) - (setq params (append options params)) + (let ((params + (append options + (if (not (string= "" sql-database)) + `(,(expand-file-name sql-database)))))) (sql-comint product params))) -(defun sql-sqlite-completion-object (sqlbuf schema) +(defun sql-sqlite-completion-object (sqlbuf _schema) (sql-redirect-value sqlbuf ".tables" "\\sw\\(?:\\sw\\|\\s_\\)*" 0)) @@ -4556,18 +4541,19 @@ "Create comint buffer and connect to MySQL." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params)) - (if (not (string= "" sql-database)) - (setq params (append (list sql-database) params))) - (if (not (string= "" sql-server)) - (setq params (append (list (concat "--host=" sql-server)) params))) - (if (not (= 0 sql-port)) - (setq params (append (list (concat "--port=" (number-to-string sql-port))) params))) - (if (not (string= "" sql-password)) - (setq params (append (list (concat "--password=" sql-password)) params))) - (if (not (string= "" sql-user)) - (setq params (append (list (concat "--user=" sql-user)) params))) - (setq params (append options params)) + (let ((params + (append + options + (if (not (string= "" sql-user)) + (list (concat "--user=" sql-user))) + (if (not (string= "" sql-password)) + (list (concat "--password=" sql-password))) + (if (not (= 0 sql-port)) + (list (concat "--port=" (number-to-string sql-port)))) + (if (not (string= "" sql-server)) + (list (concat "--host=" sql-server))) + (if (not (string= "" sql-database)) + (list sql-database))))) (sql-comint product params))) @@ -4607,13 +4593,15 @@ "Create comint buffer and connect to Solid." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options)) - ;; It only makes sense if both username and password are there. - (if (not (or (string= "" sql-user) - (string= "" sql-password))) - (setq params (append (list sql-user sql-password) params))) - (if (not (string= "" sql-server)) - (setq params (append (list sql-server) params))) + (let ((params + (append + (if (not (string= "" sql-server)) + (list sql-server)) + ;; It only makes sense if both username and password are there. + (if (not (or (string= "" sql-user) + (string= "" sql-password))) + (list sql-user sql-password)) + options))) (sql-comint product params))) @@ -4695,22 +4683,25 @@ "Create comint buffer and connect to Microsoft SQL Server." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options)) - (if (not (string= "" sql-server)) - (setq params (append (list "-S" sql-server) params))) - (if (not (string= "" sql-database)) - (setq params (append (list "-d" sql-database) params))) - (if (not (string= "" sql-user)) - (setq params (append (list "-U" sql-user) params))) - (if (not (string= "" sql-password)) - (setq params (append (list "-P" sql-password) params)) - (if (string= "" sql-user) - ;; if neither user nor password is provided, use system - ;; credentials. - (setq params (append (list "-E") params)) - ;; If -P is passed to ISQL as the last argument without a - ;; password, it's considered null. - (setq params (append params (list "-P"))))) + (let ((params + (append + (if (not (string= "" sql-user)) + (list "-U" sql-user)) + (if (not (string= "" sql-database)) + (list "-d" sql-database)) + (if (not (string= "" sql-server)) + (list "-S" sql-server)) + options))) + (setq params + (if (not (string= "" sql-password)) + `("-P" ,sql-password ,@params) + (if (string= "" sql-user) + ;; If neither user nor password is provided, use system + ;; credentials. + `("-E" ,@params) + ;; If -P is passed to ISQL as the last argument without a + ;; password, it's considered null. + `(,@params "-P")))) (sql-comint product params))) @@ -4754,48 +4745,58 @@ (defun sql-comint-postgres (product options) "Create comint buffer and connect to Postgres." - ;; username and password are ignored. Mark Stosberg suggest to add - ;; the database at the end. Jason Beegan suggest using --pset and + ;; username and password are ignored. Mark Stosberg suggests to add + ;; the database at the end. Jason Beegan suggests using --pset and ;; pager=off instead of \\o|cat. The later was the solution by ;; Gregor Zych. Jason's suggestion is the default value for ;; sql-postgres-options. - (let ((params options)) - (if (not (string= "" sql-database)) - (setq params (append params (list sql-database)))) - (if (not (string= "" sql-server)) - (setq params (append (list "-h" sql-server) params))) - (if (not (string= "" sql-user)) - (setq params (append (list "-U" sql-user) params))) - (if (not (= 0 sql-port)) - (setq params (append (list "-p" (number-to-string sql-port)) params))) + (let ((params + (append + (if (not (= 0 sql-port)) + (list "-p" (number-to-string sql-port))) + (if (not (string= "" sql-user)) + (list "-U" sql-user)) + (if (not (string= "" sql-server)) + (list "-h" sql-server)) + options + (if (not (string= "" sql-database)) + (list sql-database))))) (sql-comint product params))) (defun sql-postgres-completion-object (sqlbuf schema) - (let (cl re fs a r) - (sql-redirect sqlbuf "\\t on") - (setq a (car (sql-redirect-value sqlbuf "\\a" "Output format is \\(.*\\)[.]$" 1))) - (when (string= a "aligned") - (sql-redirect sqlbuf "\\a")) - (setq fs (or (car (sql-redirect-value sqlbuf "\\f" "Field separator is \"\\(.\\)[.]$" 1)) "|")) - - (setq re (concat "^\\([^" fs "]*\\)" fs "\\([^" fs "]*\\)" fs "[^" fs "]*" fs "[^" fs "]*$")) - (setq cl (if (not schema) - (sql-redirect-value sqlbuf "\\d" re '(1 2)) - (append (sql-redirect-value sqlbuf (format "\\dt %s.*" schema) re '(1 2)) - (sql-redirect-value sqlbuf (format "\\dv %s.*" schema) re '(1 2)) - (sql-redirect-value sqlbuf (format "\\ds %s.*" schema) re '(1 2))))) - - ;; Restore tuples and alignment to what they were - (sql-redirect sqlbuf "\\t off") - (when (not (string= a "aligned")) - (sql-redirect sqlbuf "\\a")) - - ;; Return the list of table names (public schema name can be omitted) - (mapcar (lambda (tbl) - (if (string= (car tbl) "public") - (cadr tbl) - (format "%s.%s" (car tbl) (cadr tbl)))) - cl))) + (sql-redirect sqlbuf "\\t on") + (let ((aligned + (string= "aligned" + (car (sql-redirect-value + sqlbuf "\\a" + "Output format is \\(.*\\)[.]$" 1))))) + (when aligned + (sql-redirect sqlbuf "\\a")) + (let* ((fs (or (car (sql-redirect-value + sqlbuf "\\f" "Field separator is \"\\(.\\)[.]$" 1)) + "|")) + (re (concat "^\\([^" fs "]*\\)" fs "\\([^" fs "]*\\)" + fs "[^" fs "]*" fs "[^" fs "]*$")) + (cl (if (not schema) + (sql-redirect-value sqlbuf "\\d" re '(1 2)) + (append (sql-redirect-value + sqlbuf (format "\\dt %s.*" schema) re '(1 2)) + (sql-redirect-value + sqlbuf (format "\\dv %s.*" schema) re '(1 2)) + (sql-redirect-value + sqlbuf (format "\\ds %s.*" schema) re '(1 2)))))) + + ;; Restore tuples and alignment to what they were. + (sql-redirect sqlbuf "\\t off") + (when (not aligned) + (sql-redirect sqlbuf "\\a")) + + ;; Return the list of table names (public schema name can be omitted) + (mapcar (lambda (tbl) + (if (string= (car tbl) "public") + (cadr tbl) + (format "%s.%s" (car tbl) (cadr tbl)))) + cl)))) @@ -4834,13 +4835,15 @@ "Create comint buffer and connect to Interbase." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options)) - (if (not (string= "" sql-user)) - (setq params (append (list "-u" sql-user) params))) - (if (not (string= "" sql-password)) - (setq params (append (list "-p" sql-password) params))) - (if (not (string= "" sql-database)) - (setq params (cons sql-database params))) ; add to the front! + (let ((params + (append + (if (not (string= "" sql-database)) + (list sql-database)) ; Add to the front! + (if (not (string= "" sql-password)) + (list "-p" sql-password)) + (if (not (string= "" sql-user)) + (list "-u" sql-user)) + options))) (sql-comint product params))) @@ -4922,19 +4925,18 @@ "Create comint buffer and connect to Linter." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options) - (login nil) - (old-mbx (getenv "LINTER_MBX"))) - (if (not (string= "" sql-user)) - (setq login (concat sql-user "/" sql-password))) - (setq params (append (list "-u" login) params)) - (if (not (string= "" sql-server)) - (setq params (append (list "-n" sql-server) params))) - (if (string= "" sql-database) - (setenv "LINTER_MBX" nil) - (setenv "LINTER_MBX" sql-database)) - (sql-comint product params) - (setenv "LINTER_MBX" old-mbx))) + (let* ((login + (if (not (string= "" sql-user)) + (concat sql-user "/" sql-password))) + (params + (append + (if (not (string= "" sql-server)) + (list "-n" sql-server)) + (list "-u" login) + options))) + (cl-letf (((getenv "LINTER_MBX") + (unless (string= "" sql-database) sql-database))) + (sql-comint product params)))) ------------------------------------------------------------ revno: 111129 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=11095 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2012-12-06 11:17:11 -0500 message: * lisp/hi-lock.el: Rework the default face and the serialize regexp code. (hi-lock--auto-select-face-defaults): Remove. (hi-lock-string-serialize-serial): Remove. (hi-lock--hashcons-hash): Rename from hi-lock-string-serialize-hash; make weak. (hi-lock--hashcons): Rename from hi-lock-string-serialize, return an equal string. (hi-lock-set-pattern): Adjust accordingly. (hi-lock--regexps-at-point): Simplify accordingly. (hi-lock--auto-select-face-defaults): Remove. (hi-lock--last-face): New var to replace it. (hi-lock-read-face-name): Rewrite. (hi-lock-unface-buffer): Arrange for the face to be the next default. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-12-06 09:15:27 +0000 +++ lisp/ChangeLog 2012-12-06 16:17:11 +0000 @@ -1,11 +1,27 @@ +2012-12-06 Stefan Monnier + + * hi-lock.el: Rework the default face and the serialize regexp code. + (hi-lock--auto-select-face-defaults): Remove. + (hi-lock-string-serialize-serial): Remove. + (hi-lock--hashcons-hash): Rename from hi-lock-string-serialize-hash; + make weak. + (hi-lock--hashcons): Rename from hi-lock-string-serialize, return an + equal string. + (hi-lock-set-pattern): Adjust accordingly. + (hi-lock--regexps-at-point): Simplify accordingly. + (hi-lock--auto-select-face-defaults): Remove. + (hi-lock--last-face): New var to replace it. + (hi-lock-read-face-name): Rewrite (bug#11095). + (hi-lock-unface-buffer): Arrange for the face to be the next default. + 2012-12-06 Michael Albinus - * net/tramp.el (tramp-replace-environment-variables): Hide - compiler warning. + * net/tramp.el (tramp-replace-environment-variables): + Hide compiler warning. (tramp-file-name-for-operation): Remove `executable-find', `start-process', `call-process' and `call-process-region'. - * net/tramp-compat.el (top): Don't require 'tramp-util and 'tramp-vc. + * net/tramp-compat.el (top): Don't require 'tramp-util and 'tramp-vc. * net/tramp-gvfs.el (tramp-gvfs-dbus-event-error): Ensure backward compatibility. @@ -54,8 +70,8 @@ * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Check return code of copy command. - * net/tramp-adb.el (tramp-adb-sdk-dir, tramp-adb-prompt): Use - group `tramp'. Add version. + * net/tramp-adb.el (tramp-adb-sdk-dir, tramp-adb-prompt): + Use group `tramp'. Add version. 2012-12-05 Chong Yidong @@ -207,8 +223,8 @@ * progmodes/perl-mode.el (perl-current-defun-name): New. (perl-mode): Use it. - * progmodes/scheme.el (scheme-mode-variables, dsssl-mode): Use - lisp-current-defun-name. + * progmodes/scheme.el (scheme-mode-variables, dsssl-mode): + Use lisp-current-defun-name. * textmodes/tex-mode.el (tex-current-defun-name): New. (tex-common-initialization): Use it. === modified file 'lisp/hi-lock.el' --- lisp/hi-lock.el 2012-12-04 21:13:47 +0000 +++ lisp/hi-lock.el 2012-12-06 16:17:11 +0000 @@ -1,4 +1,4 @@ -;;; hi-lock.el --- minor mode for interactive automatic highlighting +;;; hi-lock.el --- minor mode for interactive automatic highlighting -*- lexical-binding: t -*- ;; Copyright (C) 2000-2012 Free Software Foundation, Inc. @@ -138,7 +138,7 @@ (defcustom hi-lock-auto-select-face nil "Non-nil if highlighting commands should not prompt for face names. When non-nil, each hi-lock command will cycle through faces in -`hi-lock-face-defaults'." +`hi-lock-face-defaults' without prompting." :type 'boolean :version "24.4") @@ -218,14 +218,6 @@ "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb") "Default faces for hi-lock interactive functions.") -(defvar-local hi-lock--auto-select-face-defaults - (let ((l (copy-sequence hi-lock-face-defaults))) - (setcdr (last l) l)) - "Circular list of faces used for interactive highlighting. -When `hi-lock-auto-select-face' is non-nil, use the face at the -head of this list for next interactive highlighting. See also -`hi-lock-read-face-name'.") - (define-obsolete-variable-alias 'hi-lock-regexp-history 'regexp-history "23.1") @@ -479,15 +471,8 @@ (let ((regexps '())) ;; When using overlays, there is no ambiguity on the best ;; choice of regexp. - (let ((desired-serial (get-char-property - (point) 'hi-lock-overlay-regexp))) - (when desired-serial - (catch 'regexp - (maphash - (lambda (regexp serial) - (when (= serial desired-serial) - (push regexp regexps))) - hi-lock-string-serialize-hash)))) + (let ((regexp (get-char-property (point) 'hi-lock-overlay-regexp))) + (when regexp (push regexp regexps))) ;; With font-locking on, check if the cursor is on an highlighted text. ;; Checking for hi-lock face is a good heuristic. (and (string-match "\\`hi-lock-" (face-name (face-at-point))) @@ -503,6 +488,8 @@ (if (string-match regexp hi-text) (push regexp regexps)))))))) +(defvar-local hi-lock--last-face nil) + ;;;###autoload (defalias 'unhighlight-regexp 'hi-lock-unface-buffer) ;;;###autoload @@ -529,9 +516,7 @@ (list (car pattern) (format "%s (%s)" (car pattern) - (symbol-name - (car - (cdr (car (cdr (car (cdr pattern)))))))) + (cadr (cadr (cadr pattern)))) (cons nil nil) (car pattern))) hi-lock-interactive-patterns)))) @@ -557,11 +542,16 @@ (dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns (list (assoc regexp hi-lock-interactive-patterns)))) (when keyword + (let ((face (cadr (cadr (cadr keyword))))) + ;; Make `face' the next one to use by default. + (setq hi-lock--last-face + (cadr (member (symbol-name face) + (reverse hi-lock-face-defaults))))) (font-lock-remove-keywords nil (list keyword)) (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) (remove-overlays - nil nil 'hi-lock-overlay-regexp (hi-lock-string-serialize regexp)) + nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons regexp)) (when font-lock-fontified (font-lock-fontify-buffer))))) ;;;###autoload @@ -616,28 +606,28 @@ regexp)) (defun hi-lock-read-face-name () - "Return face name for interactive highlighting. + "Return face for interactive highlighting. When `hi-lock-auto-select-face' is non-nil, just return the next face. Otherwise, read face name from minibuffer with completion and history." - (if hi-lock-auto-select-face - ;; Return current head and rotate the face list. - (pop hi-lock--auto-select-face-defaults) - (intern (completing-read - "Highlight using face: " - obarray 'facep t - (cons (car hi-lock-face-defaults) - (let ((prefix - (try-completion - (substring (car hi-lock-face-defaults) 0 1) - hi-lock-face-defaults))) - (if (and (stringp prefix) - (not (equal prefix (car hi-lock-face-defaults)))) - (length prefix) 0))) - 'face-name-history - (cdr hi-lock-face-defaults))))) + (let ((default (or (cadr (member hi-lock--last-face hi-lock-face-defaults)) + (car hi-lock-face-defaults)))) + (setq hi-lock--last-face + (if (and hi-lock-auto-select-face (not current-prefix-arg)) + default + (completing-read + (format "Highlight using face (default %s): " default) + obarray 'facep t nil 'face-name-history + (append (member default hi-lock-face-defaults) + hi-lock-face-defaults)))) + (unless (member hi-lock--last-face hi-lock-face-defaults) + (setq hi-lock-face-defaults + (append hi-lock-face-defaults (list hi-lock--last-face)))) + (intern hi-lock--last-face))) (defun hi-lock-set-pattern (regexp face) "Highlight REGEXP with face FACE." + ;; Hashcons the regexp, so it can be passed to remove-overlays later. + (setq regexp (hi-lock--hashcons regexp)) (let ((pattern (list regexp (list 0 (list 'quote face) t)))) (unless (member pattern hi-lock-interactive-patterns) (push pattern hi-lock-interactive-patterns) @@ -645,8 +635,7 @@ (progn (font-lock-add-keywords nil (list pattern) t) (font-lock-fontify-buffer)) - (let* ((serial (hi-lock-string-serialize regexp)) - (range-min (- (point) (/ hi-lock-highlight-range 2))) + (let* ((range-min (- (point) (/ hi-lock-highlight-range 2))) (range-max (+ (point) (/ hi-lock-highlight-range 2))) (search-start (max (point-min) @@ -659,7 +648,7 @@ (while (re-search-forward regexp search-end t) (let ((overlay (make-overlay (match-beginning 0) (match-end 0)))) (overlay-put overlay 'hi-lock-overlay t) - (overlay-put overlay 'hi-lock-overlay-regexp serial) + (overlay-put overlay 'hi-lock-overlay-regexp regexp) (overlay-put overlay 'face face)) (goto-char (match-end 0))))))))) @@ -709,27 +698,14 @@ (font-lock-add-keywords nil hi-lock-file-patterns t) (font-lock-add-keywords nil hi-lock-interactive-patterns t))) -(defvar hi-lock-string-serialize-hash - ;; FIXME: don't map strings to numbers but to unique strings via - ;; hash-consing, with a weak hash-table. - (make-hash-table :test 'equal) - "Hash table used to assign unique numbers to strings.") - -(defvar hi-lock-string-serialize-serial 1 - "Number assigned to last new string in call to `hi-lock-string-serialize'. -A string is considered new if it had not previously been used in a call to -`hi-lock-string-serialize'.") - -(defun hi-lock-string-serialize (string) - "Return unique serial number for STRING." - (interactive) - (let ((val (gethash string hi-lock-string-serialize-hash))) - (if val val - (puthash string - (setq hi-lock-string-serialize-serial - (1+ hi-lock-string-serialize-serial)) - hi-lock-string-serialize-hash) - hi-lock-string-serialize-serial))) +(defvar hi-lock--hashcons-hash + (make-hash-table :test 'equal :weakness t) + "Hash table used to hash cons regexps.") + +(defun hi-lock--hashcons (string) + "Return unique object equal to STRING." + (or (gethash string hi-lock--hashcons-hash) + (puthash string string hi-lock--hashcons-hash))) (defun hi-lock-unload-function () "Unload the Hi-Lock library." ------------------------------------------------------------ revno: 111128 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2012-12-06 17:48:11 +0400 message: * frame.h (x_char_width, x_char_height): Remove prototypes. * w32term.h (x_char_width, x_char_height): Likewise. * xfns.c (x_char_width, x_char_height): Remove. * w32fns.c (x_char_width, x_char_height): Likewise. * nsfns.c (x_char_width, x_char_height): Likewise. * frame.c (Fframe_char_width): Use FRAME_COLUMN_WIDTH for all window frames. (Fframe_char_height): Likewise with FRAME_LINE_HEIGHT. * keyboard.c (command_loop_1): Remove prototype. (command_loop_2, top_level_1): Add static to match prototype. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-12-06 07:31:58 +0000 +++ src/ChangeLog 2012-12-06 13:48:11 +0000 @@ -1,3 +1,16 @@ +2012-12-06 Dmitry Antipov + + * frame.h (x_char_width, x_char_height): Remove prototypes. + * w32term.h (x_char_width, x_char_height): Likewise. + * xfns.c (x_char_width, x_char_height): Remove. + * w32fns.c (x_char_width, x_char_height): Likewise. + * nsfns.c (x_char_width, x_char_height): Likewise. + * frame.c (Fframe_char_width): Use FRAME_COLUMN_WIDTH for + all window frames. + (Fframe_char_height): Likewise with FRAME_LINE_HEIGHT. + * keyboard.c (command_loop_1): Remove prototype. + (command_loop_2, top_level_1): Add static to match prototype. + 2012-12-06 Paul Eggert Fix a recently-introduced delete-process race condition. === modified file 'src/frame.c' --- src/frame.c 2012-12-06 06:23:51 +0000 +++ src/frame.c 2012-12-06 13:48:11 +0000 @@ -2276,7 +2276,7 @@ struct frame *f = decode_any_frame (frame); if (FRAME_WINDOW_P (f)) - return make_number (x_char_height (f)); + return make_number (FRAME_LINE_HEIGHT (f)); else #endif return make_number (1); @@ -2295,7 +2295,7 @@ struct frame *f = decode_any_frame (frame); if (FRAME_WINDOW_P (f)) - return make_number (x_char_width (f)); + return make_number (FRAME_COLUMN_WIDTH (f)); else #endif return make_number (1); === modified file 'src/frame.h' --- src/frame.h 2012-12-04 15:15:30 +0000 +++ src/frame.h 2012-12-06 13:48:11 +0000 @@ -1255,8 +1255,6 @@ extern void x_make_frame_visible (struct frame *f); extern void x_make_frame_invisible (struct frame *f); extern void x_iconify_frame (struct frame *f); -extern int x_char_width (struct frame *f); -extern int x_char_height (struct frame *f); extern int x_pixel_width (struct frame *f); extern int x_pixel_height (struct frame *f); extern void x_set_frame_alpha (struct frame *f); === modified file 'src/keyboard.c' --- src/keyboard.c 2012-11-27 05:17:07 +0000 +++ src/keyboard.c 2012-12-06 13:48:11 +0000 @@ -1116,8 +1116,7 @@ Vsignaling_function = Qnil; } - -Lisp_Object command_loop_1 (void); + static Lisp_Object command_loop_2 (Lisp_Object); static Lisp_Object top_level_1 (Lisp_Object); @@ -1154,7 +1153,7 @@ value to us. A value of nil means that command_loop_1 itself returned due to end of file (or end of kbd macro). */ -Lisp_Object +static Lisp_Object command_loop_2 (Lisp_Object ignore) { register Lisp_Object val; @@ -1172,7 +1171,7 @@ return Feval (Vtop_level, Qnil); } -Lisp_Object +static Lisp_Object top_level_1 (Lisp_Object ignore) { /* On entry to the outer level, run the startup file */ === modified file 'src/nsfns.m' --- src/nsfns.m 2012-11-03 05:59:17 +0000 +++ src/nsfns.m 2012-12-06 13:48:11 +0000 @@ -2243,20 +2243,6 @@ int -x_char_width (struct frame *f) -{ - return FRAME_COLUMN_WIDTH (f); -} - - -int -x_char_height (struct frame *f) -{ - return FRAME_LINE_HEIGHT (f); -} - - -int x_screen_planes (struct frame *f) { return FRAME_NS_DISPLAY_INFO (f)->n_planes; === modified file 'src/w32fns.c' --- src/w32fns.c 2012-12-03 01:08:31 +0000 +++ src/w32fns.c 2012-12-06 13:48:11 +0000 @@ -4866,18 +4866,6 @@ } int -x_char_width (register struct frame *f) -{ - return FRAME_COLUMN_WIDTH (f); -} - -int -x_char_height (register struct frame *f) -{ - return FRAME_LINE_HEIGHT (f); -} - -int x_screen_planes (register struct frame *f) { return FRAME_W32_DISPLAY_INFO (f)->n_planes; === modified file 'src/w32term.h' --- src/w32term.h 2012-11-23 15:39:48 +0000 +++ src/w32term.h 2012-12-06 13:48:11 +0000 @@ -217,8 +217,6 @@ extern void x_make_frame_visible (struct frame *f); extern void x_make_frame_invisible (struct frame *f); extern void x_iconify_frame (struct frame *f); -extern int x_char_width (struct frame *f); -extern int x_char_height (struct frame *f); extern int x_pixel_width (struct frame *f); extern int x_pixel_height (struct frame *f); extern void x_set_frame_alpha (struct frame *f); === modified file 'src/xfns.c' --- src/xfns.c 2012-11-12 04:00:55 +0000 +++ src/xfns.c 2012-12-06 13:48:11 +0000 @@ -3848,20 +3848,6 @@ return FRAME_PIXEL_HEIGHT (f); } -int -x_char_width (register struct frame *f) -{ - return FRAME_COLUMN_WIDTH (f); -} - -int -x_char_height (register struct frame *f) -{ - return FRAME_LINE_HEIGHT (f); -} - - - /************************************************************************ X Displays ************************************************************************/ ------------------------------------------------------------ revno: 111127 committer: Glenn Morris branch nick: trunk timestamp: Thu 2012-12-06 06:21:08 -0500 message: Auto-commit of loaddefs files. diff: === modified file 'lisp/mail/rmail.el' --- lisp/mail/rmail.el 2012-12-06 06:17:10 +0000 +++ lisp/mail/rmail.el 2012-12-06 11:21:08 +0000 @@ -4707,7 +4707,7 @@ ;;;### (autoloads (rmail-summary-by-senders rmail-summary-by-topic ;;;;;; rmail-summary-by-regexp rmail-summary-by-recipients rmail-summary-by-labels -;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "6cafe6b03e187b5836e3c359322b5cbf") +;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "856fc6e337d5398b302c448ee7a2315e") ;;; Generated autoloads from rmailsum.el (autoload 'rmail-summary "rmailsum" "\ ------------------------------------------------------------ revno: 111126 committer: Glenn Morris branch nick: trunk timestamp: Thu 2012-12-06 06:17:45 -0500 message: Auto-commit of generated files. diff: === modified file 'autogen/configure' --- autogen/configure 2012-12-06 06:17:10 +0000 +++ autogen/configure 2012-12-06 11:17:45 +0000 @@ -8165,7 +8165,7 @@ MAKEINFO=makeinfo if test "x${with_makeinfo}" = "xno"; then HAVE_MAKEINFO=no - elif test ! -e $srcdir/info/emacs; then + elif test ! -e $srcdir/info/emacs && test ! -e $srcdir/info/emacs.info; then as_fn_error "You do not seem to have makeinfo >= 4.7, and your source tree does not seem to have pre-built manuals in the \`info' directory. Either install a suitable version of makeinfo, or re-run configure ------------------------------------------------------------ revno: 111125 committer: Michael Albinus + + * net/tramp.el (tramp-replace-environment-variables): Hide + compiler warning. + (tramp-file-name-for-operation): Remove `executable-find', + `start-process', `call-process' and `call-process-region'. + + * net/tramp-compat.el (top): Don't require 'tramp-util and 'tramp-vc. + + * net/tramp-gvfs.el (tramp-gvfs-dbus-event-error): Ensure backward + compatibility. + + * net/tramp-sh.el (top): Remove `tramp-sh-handle-call-process-region'. + 2012-12-06 Chong Yidong * ffap.el (ffap-replace-file-component): Fix typo. === modified file 'lisp/net/tramp-compat.el' --- lisp/net/tramp-compat.el 2012-07-05 06:57:57 +0000 +++ lisp/net/tramp-compat.el 2012-12-06 09:15:27 +0000 @@ -71,22 +71,6 @@ (require 'timer-funcs) (require 'timer)) - ;; We check whether `start-file-process' is bound. - ;; Note: we deactivate this. There are problems, at least in SXEmacs. - (unless t;(fboundp 'start-file-process) - - ;; tramp-util offers integration into other (X)Emacs packages like - ;; compile.el, gud.el etc. Not necessary in Emacs 23. - (eval-after-load "tramp" - '(require 'tramp-util)) - - ;; Make sure that we get integration with the VC package. When it - ;; is loaded, we need to pull in the integration module. Not - ;; necessary in Emacs 23. - (eval-after-load "vc" - (eval-after-load "tramp" - '(require 'tramp-vc)))) - ;; Avoid byte-compiler warnings if the byte-compiler supports this. ;; Currently, XEmacs supports this. (when (featurep 'xemacs) @@ -132,9 +116,7 @@ ;; mechanism. ;; `file-remote-p' has been introduced with Emacs 22. The version - ;; of XEmacs is not a magic file name function (yet); this is - ;; corrected in tramp-util.el. Here it is sufficient if the - ;; function exists. + ;; of XEmacs is not a magic file name function (yet). (unless (fboundp 'file-remote-p) (defalias 'file-remote-p (lambda (file &optional identification connected) === modified file 'lisp/net/tramp-gvfs.el' --- lisp/net/tramp-gvfs.el 2012-11-13 03:11:46 +0000 +++ lisp/net/tramp-gvfs.el 2012-12-06 09:15:27 +0000 @@ -526,7 +526,11 @@ (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event) (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err)))) -(add-hook 'dbus-event-error-functions 'tramp-gvfs-dbus-event-error) +;; `dbus-event-error-hooks' has been renamed to `dbus-event-error-functions'. +(add-hook + (if (boundp 'dbus-event-error-functions) + 'dbus-event-error-functions 'dbus-event-error-hooks) + 'tramp-gvfs-dbus-event-error) ;; File name primitives. === modified file 'lisp/net/tramp-sh.el' --- lisp/net/tramp-sh.el 2012-12-05 15:50:32 +0000 +++ lisp/net/tramp-sh.el 2012-12-06 09:15:27 +0000 @@ -2932,16 +2932,6 @@ (keyboard-quit) ret)))) -(defun tramp-sh-handle-call-process-region - (start end program &optional delete buffer display &rest args) - "Like `call-process-region' for Tramp files." - (let ((tmpfile (tramp-compat-make-temp-file ""))) - (write-region start end tmpfile) - (when delete (delete-region start end)) - (unwind-protect - (apply 'call-process program tmpfile buffer display args) - (delete-file tmpfile)))) - (defun tramp-sh-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil === modified file 'lisp/net/tramp.el' --- lisp/net/tramp.el 2012-11-21 04:47:55 +0000 +++ lisp/net/tramp.el 2012-12-06 09:15:27 +0000 @@ -1750,10 +1750,12 @@ (defalias 'tramp-replace-environment-variables (if (ignore-errors - (equal "${ tramp?}" (substitute-env-vars "${ tramp?}" 'only-defined))) + (equal "${ tramp?}" + (tramp-compat-funcall + 'substitute-env-vars "${ tramp?}" 'only-defined))) (lambda (filename) "Like `substitute-env-vars' with `only-defined' non-nil." - (substitute-env-vars filename 'only-defined)) + (tramp-compat-funcall 'substitute-env-vars filename 'only-defined)) (lambda (filename) "Replace environment variables in FILENAME. Return the string with the replaced variables." @@ -1928,10 +1930,7 @@ ;; Emacs 23+ only. 'start-file-process ;; XEmacs only. - 'dired-print-file 'dired-shell-call-process - ;; nowhere yet. - 'executable-find 'start-process - 'call-process 'call-process-region)) + 'dired-print-file 'dired-shell-call-process)) default-directory) ;; Unknown file primitive. (t (error "unknown file I/O primitive: %s" operation)))) ------------------------------------------------------------ revno: 111124 committer: Paul Eggert branch nick: trunk timestamp: Thu 2012-12-06 00:33:32 -0800 message: Update licenses to latest version from FSF. These are just minor editorial changes. diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2012-12-06 06:17:10 +0000 +++ doc/emacs/ChangeLog 2012-12-06 08:33:32 +0000 @@ -1,3 +1,8 @@ +2012-12-06 Paul Eggert + + * doclicense.texi, gpl.texi: Update to latest version from FSF. + These are just minor editorial changes. + 2012-12-06 Juanma Barranquero * vc1-xtra.texi (General VC Options): Remove obsolete reference === modified file 'doc/emacs/doclicense.texi' --- doc/emacs/doclicense.texi 2012-11-24 21:37:18 +0000 +++ doc/emacs/doclicense.texi 2012-12-06 08:33:32 +0000 @@ -97,7 +97,7 @@ DTD, and standard-conforming simple HTML, PostScript or PDF designed for human modification. Examples of transparent image formats include PNG, XCF and -JPG. Opaque formats include proprietary formats that can be +JPG@. Opaque formats include proprietary formats that can be read and edited only by proprietary word processors, SGML or XML for which the DTD and/or processing tools are not generally available, and the machine-generated HTML, === modified file 'doc/emacs/gpl.texi' --- doc/emacs/gpl.texi 2012-11-24 21:37:18 +0000 +++ doc/emacs/gpl.texi 2012-12-06 08:33:32 +0000 @@ -623,12 +623,12 @@ @item Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +APPLICABLE LAW@. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM ``AS IS'' WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND -PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE +A PARTICULAR PURPOSE@. THE ENTIRE RISK AS TO THE QUALITY AND +PERFORMANCE OF THE PROGRAM IS WITH YOU@. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. @@ -680,7 +680,7 @@ This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE@. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License === modified file 'doc/lispintro/ChangeLog' --- doc/lispintro/ChangeLog 2012-11-24 21:37:18 +0000 +++ doc/lispintro/ChangeLog 2012-12-06 08:33:32 +0000 @@ -1,3 +1,8 @@ +2012-12-06 Paul Eggert + + * doclicense.texi: Update to latest version from FSF. + These are just minor editorial changes. + 2012-11-24 Paul Eggert * doclicense.texi: Update to latest version from FSF. === modified file 'doc/lispintro/doclicense.texi' --- doc/lispintro/doclicense.texi 2012-11-24 21:37:18 +0000 +++ doc/lispintro/doclicense.texi 2012-12-06 08:33:32 +0000 @@ -97,7 +97,7 @@ DTD, and standard-conforming simple HTML, PostScript or PDF designed for human modification. Examples of transparent image formats include PNG, XCF and -JPG. Opaque formats include proprietary formats that can be +JPG@. Opaque formats include proprietary formats that can be read and edited only by proprietary word processors, SGML or XML for which the DTD and/or processing tools are not generally available, and the machine-generated HTML, === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-12-06 06:17:10 +0000 +++ doc/lispref/ChangeLog 2012-12-06 08:33:32 +0000 @@ -1,3 +1,8 @@ +2012-12-06 Paul Eggert + + * doclicense.texi, gpl.texi: Update to latest version from FSF. + These are just minor editorial changes. + 2012-12-06 Chong Yidong * lists.texi (Plist Access): Move put example to Symbol Plists. === modified file 'doc/lispref/doclicense.texi' --- doc/lispref/doclicense.texi 2012-11-24 21:37:18 +0000 +++ doc/lispref/doclicense.texi 2012-12-06 08:33:32 +0000 @@ -97,7 +97,7 @@ DTD, and standard-conforming simple HTML, PostScript or PDF designed for human modification. Examples of transparent image formats include PNG, XCF and -JPG. Opaque formats include proprietary formats that can be +JPG@. Opaque formats include proprietary formats that can be read and edited only by proprietary word processors, SGML or XML for which the DTD and/or processing tools are not generally available, and the machine-generated HTML, === modified file 'doc/lispref/gpl.texi' --- doc/lispref/gpl.texi 2012-11-24 21:37:18 +0000 +++ doc/lispref/gpl.texi 2012-12-06 08:33:32 +0000 @@ -623,12 +623,12 @@ @item Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +APPLICABLE LAW@. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM ``AS IS'' WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND -PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE +A PARTICULAR PURPOSE@. THE ENTIRE RISK AS TO THE QUALITY AND +PERFORMANCE OF THE PROGRAM IS WITH YOU@. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. @@ -680,7 +680,7 @@ This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE@. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2012-12-04 16:59:24 +0000 +++ doc/misc/ChangeLog 2012-12-06 08:33:32 +0000 @@ -1,3 +1,8 @@ +2012-12-06 Paul Eggert + + * doclicense.texi, gpl.texi: Update to latest version from FSF. + These are just minor editorial changes. + 2012-12-04 Michael Albinus * tramp.texi (History): Mention ADB. === modified file 'doc/misc/doclicense.texi' --- doc/misc/doclicense.texi 2012-11-24 21:37:18 +0000 +++ doc/misc/doclicense.texi 2012-12-06 08:33:32 +0000 @@ -97,7 +97,7 @@ DTD, and standard-conforming simple HTML, PostScript or PDF designed for human modification. Examples of transparent image formats include PNG, XCF and -JPG. Opaque formats include proprietary formats that can be +JPG@. Opaque formats include proprietary formats that can be read and edited only by proprietary word processors, SGML or XML for which the DTD and/or processing tools are not generally available, and the machine-generated HTML, === modified file 'doc/misc/gpl.texi' --- doc/misc/gpl.texi 2012-11-24 21:37:18 +0000 +++ doc/misc/gpl.texi 2012-12-06 08:33:32 +0000 @@ -623,12 +623,12 @@ @item Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +APPLICABLE LAW@. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM ``AS IS'' WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND -PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE +A PARTICULAR PURPOSE@. THE ENTIRE RISK AS TO THE QUALITY AND +PERFORMANCE OF THE PROGRAM IS WITH YOU@. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. @@ -680,7 +680,7 @@ This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE@. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License ------------------------------------------------------------ revno: 111123 committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-12-05 23:33:20 -0800 message: Convert consecutive copyright years to range diff: === modified file 'lisp/net/tramp-adb.el' --- lisp/net/tramp-adb.el 2012-12-05 10:09:54 +0000 +++ lisp/net/tramp-adb.el 2012-12-06 07:33:20 +0000 @@ -1,6 +1,6 @@ ;;; tramp-adb.el --- Functions for calling Android Debug Bridge from Tramp -;; Copyright (C) 2011, 2012 Free Software Foundation, Inc. +;; Copyright (C) 2011-2012 Free Software Foundation, Inc. ;; Author: Juergen Hoetzel ;; Keywords: comm, processes