Now on revision 112283. ------------------------------------------------------------ revno: 112283 fixes bug: http://debbugs.gnu.org/14200 committer: Eli Zaretskii branch nick: trunk timestamp: Sun 2013-04-14 09:51:15 +0300 message: Improve doc strings of left/right-margin/fringe-width. src/buffer.c (syms_of_buffer) : Mention in the doc string that setting these variables takes effect only after a call to set-window-buffer. (Bug#14200) diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-04-13 08:54:02 +0000 +++ src/ChangeLog 2013-04-14 06:51:15 +0000 @@ -1,3 +1,10 @@ +2013-04-14 Eli Zaretskii + + * buffer.c (syms_of_buffer) + : + Mention in the doc string that setting these variables takes + effect only after a call to set-window-buffer. (Bug#14200) + 2013-04-13 Eli Zaretskii * indent.c (Fvertical_motion): Don't consider display strings on === modified file 'src/buffer.c' --- src/buffer.c 2013-03-28 14:04:49 +0000 +++ src/buffer.c 2013-04-14 06:51:15 +0000 @@ -5883,29 +5883,44 @@ DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols), Qintegerp, doc: /* Width of left marginal area for display of a buffer. -A value of nil means no marginal area. */); +A value of nil means no marginal area. + +Setting this variable does not take effect until a new buffer is displayed +in a window. To make the change take effect, call `set-window-buffer'. */); DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols), Qintegerp, doc: /* Width of right marginal area for display of a buffer. -A value of nil means no marginal area. */); +A value of nil means no marginal area. + +Setting this variable does not take effect until a new buffer is displayed +in a window. To make the change take effect, call `set-window-buffer'. */); DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width), Qintegerp, doc: /* Width of this buffer's left fringe (in pixels). A value of 0 means no left fringe is shown in this buffer's window. -A value of nil means to use the left fringe width from the window's frame. */); +A value of nil means to use the left fringe width from the window's frame. + +Setting this variable does not take effect until a new buffer is displayed +in a window. To make the change take effect, call `set-window-buffer'. */); DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width), Qintegerp, doc: /* Width of this buffer's right fringe (in pixels). A value of 0 means no right fringe is shown in this buffer's window. -A value of nil means to use the right fringe width from the window's frame. */); +A value of nil means to use the right fringe width from the window's frame. + +Setting this variable does not take effect until a new buffer is displayed +in a window. To make the change take effect, call `set-window-buffer'. */); DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins), Qnil, doc: /* Non-nil means to display fringes outside display margins. -A value of nil means to display fringes between margins and buffer text. */); +A value of nil means to display fringes between margins and buffer text. + +Setting this variable does not take effect until a new buffer is displayed +in a window. To make the change take effect, call `set-window-buffer'. */); DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width), Qintegerp, ------------------------------------------------------------ revno: 112282 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=14089 committer: Stefan Monnier branch nick: trunk timestamp: Sat 2013-04-13 22:55:21 -0400 message: * lisp/files.el (normal-mode): Only use default major-mode if no other mode was specified. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-04-14 01:02:29 +0000 +++ lisp/ChangeLog 2013-04-14 02:55:21 +0000 @@ -1,5 +1,8 @@ 2013-04-14 Stefan Monnier + * files.el (normal-mode): Only use default major-mode if no other mode + was specified. + * emacs-lisp/trace.el (trace-values): New function. * files.el: Allow : in local variables (bug#14089). === modified file 'lisp/files.el' --- lisp/files.el 2013-04-14 00:59:48 +0000 +++ lisp/files.el 2013-04-14 02:55:21 +0000 @@ -1986,8 +1986,7 @@ (set-buffer-multibyte nil) (setq buffer-file-coding-system 'no-conversion) (set-buffer-major-mode buf) - (make-local-variable 'find-file-literally) - (setq find-file-literally t)) + (setq-local find-file-literally t)) (after-find-file error (not nowarn))) (current-buffer)))) @@ -2175,7 +2174,7 @@ or from Lisp without specifying the optional argument FIND-FILE; in that case, this function acts as if `enable-local-variables' were t." (interactive) - (funcall (or (default-value 'major-mode) 'fundamental-mode)) + (fundamental-mode) (let ((enable-local-variables (or (not find-file) enable-local-variables))) ;; FIXME this is less efficient than it could be, since both ;; s-a-m and h-l-v may parse the same regions, looking for "mode:". @@ -2759,7 +2758,9 @@ (if (functionp re) (funcall re) (looking-at re))))))) - (set-auto-mode-0 done keep-mode-if-same))))) + (set-auto-mode-0 done keep-mode-if-same))) + (unless done + (set-buffer-major-mode (current-buffer))))) ;; When `keep-mode-if-same' is set, we are working on behalf of ;; set-visited-file-name. In that case, if the major mode specified is the ------------------------------------------------------------ revno: 112281 committer: Stefan Monnier branch nick: trunk timestamp: Sat 2013-04-13 21:02:29 -0400 message: * lisp/emacs-lisp/trace.el (trace-values): New function. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-04-14 00:59:48 +0000 +++ lisp/ChangeLog 2013-04-14 01:02:29 +0000 @@ -1,5 +1,7 @@ 2013-04-14 Stefan Monnier + * emacs-lisp/trace.el (trace-values): New function. + * files.el: Allow : in local variables (bug#14089). (hack-local-variable-regexp): New var. (hack-local-variables-prop-line, hack-local-variables): Use it. === modified file 'lisp/emacs-lisp/trace.el' --- lisp/emacs-lisp/trace.el 2013-01-16 19:06:15 +0000 +++ lisp/emacs-lisp/trace.el 2013-04-14 01:02:29 +0000 @@ -157,6 +157,17 @@ (defvar inhibit-trace nil "If non-nil, all tracing is temporarily inhibited.") +;;;###autoload +(defun trace-values (&rest values) + "Helper function to get internal values. +You can call this function to add internal values in the trace buffer." + (unless inhibit-trace + (with-current-buffer trace-buffer + (goto-char (point-max)) + (insert + (trace-entry-message + 'trace-values trace-level values ""))))) + (defun trace-entry-message (function level args context) "Generate a string that describes that FUNCTION has been entered. LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION, ------------------------------------------------------------ revno: 112280 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=14089 committer: Stefan Monnier branch nick: trunk timestamp: Sat 2013-04-13 20:59:48 -0400 message: * lisp/files.el: Allow : in local variables. (hack-local-variable-regexp): New var. (hack-local-variables-prop-line, hack-local-variables): Use it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-04-13 20:45:03 +0000 +++ lisp/ChangeLog 2013-04-14 00:59:48 +0000 @@ -1,3 +1,9 @@ +2013-04-14 Stefan Monnier + + * files.el: Allow : in local variables (bug#14089). + (hack-local-variable-regexp): New var. + (hack-local-variables-prop-line, hack-local-variables): Use it. + 2013-04-13 Roland Winkler * textmodes/bibtex.el (bibtex-search-entries): Bug fix. Use match === modified file 'lisp/files.el' --- lisp/files.el 2013-04-06 07:41:09 +0000 +++ lisp/files.el 2013-04-14 00:59:48 +0000 @@ -3029,6 +3029,9 @@ (prog1 (memq char '(?! ?\s ?y)) (quit-window t))))))) +(defconst hack-local-variable-regexp + "[ \t]*\\([^][;\"'?()\\ \t\n]+\\)[ \t]*:[ \t]*") + (defun hack-local-variables-prop-line (&optional mode-only) "Return local variables specified in the -*- line. Returns an alist of elements (VAR . VAL), where VAR is a variable @@ -3055,11 +3058,11 @@ ;; (last ";" is optional). ;; If MODE-ONLY, just check for `mode'. ;; Otherwise, parse the -*- line into the RESULT alist. - (while (and (or (not mode-only) - (not result)) - (< (point) end)) - (unless (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*") - (message "Malformed mode-line") + (while (not (or (and mode-only result) + (>= (point) end))) + (unless (looking-at hack-local-variable-regexp) + (message "Malformed mode-line: %S" + (buffer-substring-no-properties (point) end)) (throw 'malformed-line nil)) (goto-char (match-end 0)) ;; There used to be a downcase here, @@ -3211,8 +3214,7 @@ (prefix (concat "^" (regexp-quote (buffer-substring (line-beginning-position) - (match-beginning 0))))) - beg) + (match-beginning 0)))))) (forward-line 1) (let ((startpos (point)) @@ -3247,18 +3249,16 @@ (forward-line 1)) (goto-char (point-min)) - (while (and (not (eobp)) - (or (not mode-only) - (not result))) - ;; Find the variable name; strip whitespace. - (skip-chars-forward " \t") - (setq beg (point)) - (skip-chars-forward "^:\n") - (if (eolp) (error "Missing colon in local variables entry")) - (skip-chars-backward " \t") - (let* ((str (buffer-substring beg (point))) - (var (let ((read-circle nil)) - (read str))) + (while (not (or (eobp) + (and mode-only result))) + ;; Find the variable name; + (unless (looking-at hack-local-variable-regexp) + (error "Malformed local variable line: %S" + (buffer-substring-no-properties + (point) (line-end-position)))) + (goto-char (match-end 1)) + (let* ((str (match-string 1)) + (var (intern str)) val val2) (and (equal (downcase (symbol-name var)) "mode") (setq var 'mode)) ------------------------------------------------------------ revno: 112279 committer: Roland Winkler branch nick: trunk timestamp: Sat 2013-04-13 15:45:03 -0500 message: lisp/textmodes/bibtex.el (bibtex-search-entries): Bug fix diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-04-13 20:41:52 +0000 +++ lisp/ChangeLog 2013-04-13 20:45:03 +0000 @@ -1,5 +1,10 @@ 2013-04-13 Roland Winkler + * textmodes/bibtex.el (bibtex-search-entries): Bug fix. Use match + data before it gets modified by bibtex-beginning-of-entry. + +2013-04-13 Roland Winkler + * textmodes/bibtex.el (bibtex-url): Doc fix. 2013-04-13 Roland Winkler === modified file 'lisp/textmodes/bibtex.el' --- lisp/textmodes/bibtex.el 2013-04-13 20:41:52 +0000 +++ lisp/textmodes/bibtex.el 2013-04-13 20:45:03 +0000 @@ -5241,19 +5241,22 @@ (if (string= "" field) ;; Unrestricted search. (while (re-search-forward regexp nil t) - (let ((beg (bibtex-beginning-of-entry)) - (end (bibtex-end-of-entry)) - key) - (if (and (<= beg (match-beginning 0)) - (<= (match-end 0) end) - (save-excursion - (goto-char beg) - (and (looking-at bibtex-entry-head) - (setq key (bibtex-key-in-head)))) - (not (assoc key entries))) - (push (list key file - (buffer-substring-no-properties beg end)) - entries)))) + (save-excursion + (let ((mbeg (match-beginning 0)) + (mend (match-end 0)) + (beg (bibtex-beginning-of-entry)) + (end (bibtex-end-of-entry)) + key) + (if (and (<= beg mbeg) + (<= mend end) + (progn + (goto-char beg) + (looking-at bibtex-entry-head)) + (setq key (bibtex-key-in-head)) + (not (assoc key entries))) + (push (list key file + (buffer-substring-no-properties beg end)) + entries))))) ;; The following is slow. But it works reliably even in more ;; complicated cases with BibTeX string constants and crossrefed ;; entries. If you prefer speed over reliability, perform an ------------------------------------------------------------ revno: 112278 committer: Roland Winkler branch nick: trunk timestamp: Sat 2013-04-13 15:41:52 -0500 message: lisp/textmodes/bibtex.el (bibtex-url): Doc fix diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-04-13 20:38:52 +0000 +++ lisp/ChangeLog 2013-04-13 20:41:52 +0000 @@ -1,4 +1,8 @@ -2012-09-23 Roland Winkler +2013-04-13 Roland Winkler + + * textmodes/bibtex.el (bibtex-url): Doc fix. + +2013-04-13 Roland Winkler * textmodes/bibtex.el (bibtex-initialize): If the current buffer does not visit a BibTeX file, exclude it from the list of buffers === modified file 'lisp/textmodes/bibtex.el' --- lisp/textmodes/bibtex.el 2013-04-13 20:38:52 +0000 +++ lisp/textmodes/bibtex.el 2013-04-13 20:41:52 +0000 @@ -5168,6 +5168,9 @@ (if (stringp (car scheme)) (setq fmt (pop scheme))) (dolist (step scheme) + ;; In the first STEP, if the field contains multiple + ;; matches, we want the match the closest to point. + ;; (if (eq step (car scheme)) (setq text (cdr (assoc-string (car step) fields-alist t))) (if (string-match (nth 1 step) text) (push (cond ((functionp (nth 2 step)) ------------------------------------------------------------ revno: 112277 committer: Roland Winkler branch nick: trunk timestamp: Sat 2013-04-13 15:38:52 -0500 message: lisp/textmodes/bibtex.el (bibtex-initialize): If the current buffer does not visit a BibTeX file, exclude it from the list of buffers returned by bibtex-initialize diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-04-13 14:37:20 +0000 +++ lisp/ChangeLog 2013-04-13 20:38:52 +0000 @@ -1,3 +1,9 @@ +2012-09-23 Roland Winkler + + * textmodes/bibtex.el (bibtex-initialize): If the current buffer + does not visit a BibTeX file, exclude it from the list of buffers + returned by bibtex-initialize. + 2013-04-13 Stephen Berman * window.el (split-window): Remove interactive form, since as a === modified file 'lisp/textmodes/bibtex.el' --- lisp/textmodes/bibtex.el 2013-01-01 09:11:05 +0000 +++ lisp/textmodes/bibtex.el 2013-04-13 20:38:52 +0000 @@ -3020,11 +3020,14 @@ Visit the BibTeX files defined by `bibtex-files' and return a list of corresponding buffers. Initialize in these buffers `bibtex-reference-keys' if not yet set. -List of BibTeX buffers includes current buffer if CURRENT is non-nil. +List of BibTeX buffers includes current buffer if CURRENT is non-nil +and the current buffer visits a file using `bibtex-mode'. If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if already set. If SELECT is non-nil interactively select a BibTeX buffer. -When called interactively, FORCE is t, CURRENT is t if current buffer uses -`bibtex-mode', and SELECT is t if current buffer does not use `bibtex-mode'," + +When called interactively, FORCE is t, CURRENT is t if current buffer +visits a file using `bibtex-mode', and SELECT is t if current buffer +does not use `bibtex-mode'," (interactive (list (eq major-mode 'bibtex-mode) t (not (eq major-mode 'bibtex-mode)))) (let ((file-path (split-string (or bibtex-file-path default-directory) ":+")) @@ -3062,10 +3065,12 @@ (if (file-readable-p file) (push (find-file-noselect file) buffer-list))) ;; Include current buffer iff we want it. - ;; Exclude current buffer if it doesn't use `bibtex-mode'. - ;; Thus calling `bibtex-initialize' gives meaningful results for - ;; any current buffer. - (unless (and current (eq major-mode 'bibtex-mode)) (setq current nil)) + ;; Exclude current buffer if it does not visit a file using `bibtex-mode'. + ;; This way we exclude BibTeX buffers such as `bibtex-search-buffer' + ;; that are not visiting a BibTeX file. Also, calling `bibtex-initialize' + ;; gives meaningful results for any current buffer. + (unless (and current (eq major-mode 'bibtex-mode) buffer-file-name) + (setq current nil)) (cond ((and current (not (memq (current-buffer) buffer-list))) (push (current-buffer) buffer-list)) ((and (not current) (memq (current-buffer) buffer-list)) ------------------------------------------------------------ revno: 112276 committer: Stephen Berman branch nick: trunk timestamp: Sat 2013-04-13 16:37:20 +0200 message: Make `split-window' a non-interactive function. * doc/lispref/windows.texi (Splitting Windows): Change category of split-window from a command to a function. * etc/NEWS: Mention fixing `split-window' to be non-interactive. * window.el (split-window): Remove interactive form, since as a command this function is a special case of split-window-below. Correct doc string. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2013-04-06 07:39:48 +0000 +++ doc/lispref/ChangeLog 2013-04-13 14:37:20 +0000 @@ -1,3 +1,8 @@ +2013-04-13 Stephen Berman + + * windows.texi (Splitting Windows): Change category of + split-window from a command to a function. + 2013-04-06 Chong Yidong * display.texi (Faces): Minor clarifications. === modified file 'doc/lispref/windows.texi' --- doc/lispref/windows.texi 2013-01-06 20:34:54 +0000 +++ doc/lispref/windows.texi 2013-04-13 14:37:20 +0000 @@ -717,7 +717,7 @@ This section describes functions for creating a new window by @dfn{splitting} an existing one. -@deffn Command split-window &optional window size side +@defun split-window &optional window size side This function creates a new live window next to the window @var{window}. If @var{window} is omitted or @code{nil}, it defaults to the selected window. That window is ``split'', and reduced in @@ -767,7 +767,7 @@ lieu of the usual action of @code{split-window}. Otherwise, this function obeys the @code{window-atom} or @code{window-side} window parameter, if any. @xref{Window Parameters}. -@end deffn +@end defun As an example, here is a sequence of @code{split-window} calls that yields the window configuration discussed in @ref{Windows and Frames}. === modified file 'etc/ChangeLog' --- etc/ChangeLog 2013-04-09 19:18:53 +0000 +++ etc/ChangeLog 2013-04-13 14:37:20 +0000 @@ -1,3 +1,7 @@ +2013-04-13 Stephen Berman + + * NEWS: Mention fixing `split-window' to be non-interactive. + 2013-04-09 Tassilo Horn * themes/tsdh-dark-theme.el (tsdh-dark): Add some more faces. === modified file 'etc/NEWS' --- etc/NEWS 2013-04-09 17:54:50 +0000 +++ etc/NEWS 2013-04-13 14:37:20 +0000 @@ -76,6 +76,11 @@ * Editing Changes in Emacs 24.4 +** `split-window' is no longer a command, just a non-interactive function. +As a command it was a special case of `split-window-below', and as such +superfluous. After being reimplemented in Lisp, its interactive form +was mistakenly retained. + ** New commands `toggle-frame-fullscreen' and `toggle-frame-maximized', bound to and M-, respectively. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-04-13 01:10:09 +0000 +++ lisp/ChangeLog 2013-04-13 14:37:20 +0000 @@ -1,3 +1,9 @@ +2013-04-13 Stephen Berman + + * window.el (split-window): Remove interactive form, since as a + command this function is a special case of split-window-below. + Correct doc string. + 2013-04-12 Roland Winkler * faces.el (read-face-name): Do not override value of arg default. === modified file 'lisp/window.el' --- lisp/window.el 2013-01-02 16:13:04 +0000 +++ lisp/window.el 2013-04-13 14:37:20 +0000 @@ -3686,7 +3686,7 @@ absolute value can be less than `window-min-height' or `window-min-width'; so this command can make a new window as small as one line or two columns. SIZE defaults to half of -WINDOW's size. Interactively, SIZE is the prefix argument. +WINDOW's size. Optional third argument SIDE nil (or `below') specifies that the new window shall be located below WINDOW. SIDE `above' means the @@ -3718,7 +3718,6 @@ window, these properties as well as the buffer displayed in the new window are inherited from the window selected on WINDOW's frame. The selected window is not changed by this function." - (interactive "i") (setq window (window-normalize-window window)) (let* ((side (cond ((not side) 'below) ------------------------------------------------------------ revno: 112275 committer: Glenn Morris branch nick: trunk timestamp: Sat 2013-04-13 06:17:45 -0400 message: Auto-commit of generated files. diff: === modified file 'autogen/configure' --- autogen/configure 2013-04-09 10:17:36 +0000 +++ autogen/configure 2013-04-13 10:17:45 +0000 @@ -4672,6 +4672,11 @@ ## fi ;; + ## Cygwin ports + *-*-cygwin ) + opsys=cygwin + ;; + ## HP 9000 series 700 and 800, running HP/UX hppa*-hp-hpux10.2* ) opsys=hpux10-20 @@ -4745,7 +4750,6 @@ ## Intel 386 machines where we don't care about the manufacturer. i[3456]86-*-* ) case "${canonical}" in - *-cygwin ) opsys=cygwin ;; *-darwin* ) opsys=darwin ;; *-sysv4.2uw* ) opsys=unixware ;; *-sysv5uw* ) opsys=unixware ;; ------------------------------------------------------------ revno: 112274 committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2013-04-13 11:54:02 +0300 message: Fix vertical cursor motion when there are overlay strings at EOL. src/indent.c (Fvertical_motion): Don't consider display strings on overlay strings as display strings on the buffer position we started from. This prevents vertical cursor motion from jumping more than one line when there's an overlay string with a display property at end of line. Reported by Karl Chen in http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00362.html. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-04-12 17:32:52 +0000 +++ src/ChangeLog 2013-04-13 08:54:02 +0000 @@ -1,3 +1,13 @@ +2013-04-13 Eli Zaretskii + + * indent.c (Fvertical_motion): Don't consider display strings on + overlay strings as display strings on the buffer position we + started from. This prevents vertical cursor motion from jumping + more than one line when there's an overlay string with a display + property at end of line. + Reported by Karl Chen in + http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00362.html. + 2013-04-12 Stefan Monnier * window.c (select_window): `record_buffer' even if window is === modified file 'src/indent.c' --- src/indent.c 2013-04-02 01:54:56 +0000 +++ src/indent.c 2013-04-13 08:54:02 +0000 @@ -2006,11 +2006,15 @@ const char *s = SSDATA (it.string); const char *e = s + SBYTES (it.string); + disp_string_at_start_p = /* If it.area is anything but TEXT_AREA, we need not bother about the display string, as it doesn't affect cursor positioning. */ - disp_string_at_start_p = - it.string_from_display_prop_p && it.area == TEXT_AREA; + it.area == TEXT_AREA + && it.string_from_display_prop_p + /* A display string on anything but buffer text (e.g., on + an overlay string) doesn't affect cursor positioning. */ + && (it.sp > 0 && it.stack[it.sp - 1].method == GET_FROM_BUFFER); while (s < e) { if (*s++ == '\n') ------------------------------------------------------------ revno: 112273 committer: Roland Winkler branch nick: trunk timestamp: Fri 2013-04-12 20:10:09 -0500 message: faces.el (read-face-name): Do not override value of arg default, call instead face-at-point diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-04-12 13:56:03 +0000 +++ lisp/ChangeLog 2013-04-13 01:10:09 +0000 @@ -1,3 +1,21 @@ +2013-04-12 Roland Winkler + + * faces.el (read-face-name): Do not override value of arg default. + Allow single faces and strings as default values. Remove those + elements from return value that are not faces. + (describe-face): Simplify. + (face-at-point): New optional args thing and multiple so that this + function can provide the same functionality previously provided by + read-face-name. + (make-face-bold, make-face-unbold, make-face-italic) + (make-face-unitalic, make-face-bold-italic, invert-face) + (modify-face, read-face-and-attribute): Use face-at-point. + + * cus-edit.el (customize-face, customize-face-other-window) + * cus-theme.el (custom-theme-add-face) + * face-remap.el (buffer-face-set) + * facemenu.el (facemenu-set-face): Use face-at-point. + 2013-04-12 Michael Albinus * info.el (Info-file-list-for-emacs): Add "tramp" and "dbus". === modified file 'lisp/cus-edit.el' --- lisp/cus-edit.el 2013-02-12 04:46:18 +0000 +++ lisp/cus-edit.el 2013-04-13 01:10:09 +0000 @@ -1319,7 +1319,8 @@ Interactively, when point is on text which has a face specified, suggest to customize that face, if it's customizable." - (interactive (list (read-face-name "Customize face" "all faces" t))) + (interactive (list (read-face-name "Customize face" + (or (face-at-point t t) "all faces") t))) (if (member face '(nil "")) (setq face (face-list))) (if (and (listp face) (null (cdr face))) @@ -1350,7 +1351,8 @@ Interactively, when point is on text which has a face specified, suggest to customize that face, if it's customizable." - (interactive (list (read-face-name "Customize face" "all faces" t))) + (interactive (list (read-face-name "Customize face" + (or (face-at-point t t) "all faces") t))) (customize-face face t)) (defalias 'customize-customized 'customize-unsaved) === modified file 'lisp/cus-theme.el' --- lisp/cus-theme.el 2013-01-01 09:11:05 +0000 +++ lisp/cus-theme.el 2013-04-13 01:10:09 +0000 @@ -263,7 +263,7 @@ (defun custom-theme-add-face (face &optional spec) "Add a widget for FACE (a symbol) to the *New Custom Theme* buffer. SPEC, if non-nil, should be a face spec to which to set the widget." - (interactive (list (read-face-name "Face name" nil nil) nil)) + (interactive (list (read-face-name "Face name" (face-at-point t)))) (unless (or (facep face) spec) (error "`%s' has no face definition" face)) (let ((entry (assq face custom-theme-faces))) === modified file 'lisp/face-remap.el' --- lisp/face-remap.el 2013-01-01 09:11:05 +0000 +++ lisp/face-remap.el 2013-04-13 01:10:09 +0000 @@ -378,7 +378,7 @@ This function makes the variable `buffer-face-mode-face' buffer local, and sets it to FACE." - (interactive (list (read-face-name "Set buffer face"))) + (interactive (list (read-face-name "Set buffer face" (face-at-point t)))) (while (and (consp specs) (null (cdr specs))) (setq specs (car specs))) (if (null specs) === modified file 'lisp/facemenu.el' --- lisp/facemenu.el 2013-03-27 16:03:15 +0000 +++ lisp/facemenu.el 2013-04-13 01:10:09 +0000 @@ -329,7 +329,7 @@ if `facemenu-listed-faces' says to do that." (interactive (list (progn (barf-if-buffer-read-only) - (read-face-name "Use face")) + (read-face-name "Use face" (face-at-point t))) (if (and mark-active (not current-prefix-arg)) (region-beginning)) (if (and mark-active (not current-prefix-arg)) === modified file 'lisp/faces.el' --- lisp/faces.el 2013-04-04 02:12:25 +0000 +++ lisp/faces.el 2013-04-13 01:10:09 +0000 @@ -757,7 +757,8 @@ FRAME nil or not specified means change face on all frames. Argument NOERROR is ignored and retained for compatibility. Use `set-face-attribute' for finer control of the font weight." - (interactive (list (read-face-name "Make which face bold"))) + (interactive (list (read-face-name "Make which face bold" + (face-at-point t)))) (set-face-attribute face frame :weight 'bold)) @@ -765,7 +766,8 @@ "Make the font of FACE be non-bold, if possible. FRAME nil or not specified means change face on all frames. Argument NOERROR is ignored and retained for compatibility." - (interactive (list (read-face-name "Make which face non-bold"))) + (interactive (list (read-face-name "Make which face non-bold" + (face-at-point t)))) (set-face-attribute face frame :weight 'normal)) @@ -774,7 +776,8 @@ FRAME nil or not specified means change face on all frames. Argument NOERROR is ignored and retained for compatibility. Use `set-face-attribute' for finer control of the font slant." - (interactive (list (read-face-name "Make which face italic"))) + (interactive (list (read-face-name "Make which face italic" + (face-at-point t)))) (set-face-attribute face frame :slant 'italic)) @@ -782,7 +785,8 @@ "Make the font of FACE be non-italic, if possible. FRAME nil or not specified means change face on all frames. Argument NOERROR is ignored and retained for compatibility." - (interactive (list (read-face-name "Make which face non-italic"))) + (interactive (list (read-face-name "Make which face non-italic" + (face-at-point t)))) (set-face-attribute face frame :slant 'normal)) @@ -791,7 +795,8 @@ FRAME nil or not specified means change face on all frames. Argument NOERROR is ignored and retained for compatibility. Use `set-face-attribute' for finer control of font weight and slant." - (interactive (list (read-face-name "Make which face bold-italic"))) + (interactive (list (read-face-name "Make which face bold-italic" + (face-at-point t)))) (set-face-attribute face frame :weight 'bold :slant 'italic)) @@ -911,7 +916,7 @@ If FACE specifies neither foreground nor background color, set its foreground and background to the background and foreground of the default face. Value is FACE." - (interactive (list (read-face-name "Invert face"))) + (interactive (list (read-face-name "Invert face" (face-at-point t)))) (let ((fg (face-attribute face :foreground frame)) (bg (face-attribute face :background frame))) (if (not (and (eq fg 'unspecified) (eq bg 'unspecified))) @@ -929,85 +934,54 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun read-face-name (prompt &optional default multiple) - "Read one or more face names, defaulting to the face(s) at point. -PROMPT should be a prompt string; it should not end in a space or -a colon. - -The optional argument DEFAULT specifies the default face name(s) -to return if the user just types RET. If its value is non-nil, -it should be a list of face names (symbols or strings); in that case, -the default return value is the `car' of DEFAULT (if the argument -MULTIPLE is non-nil), or DEFAULT (if MULTIPLE is nil). See below -for the meaning of MULTIPLE. - -If DEFAULT is nil, the list of default face names is taken from -the symbol at point and the `read-face-name' property of the text at point, -or, if that is nil, from the `face' property of the text at point. + "Read one or more face names, prompting with PROMPT. +PROMPT should not end in a space or a colon. + +Return DEFAULT if the user enters the empty string. +If DEFAULT is non-nil, it should be a list of face names (symbols or strings). +In that case, return the `car' of DEFAULT (if MULTIPLE is non-nil), +or DEFAULT (if MULTIPLE is nil). See below for the meaning of MULTIPLE. +DEFAULT can also be a single face. This function uses `completing-read-multiple' with \"[ \\t]*,[ \\t]*\" -as the separator regexp. Thus, the user may enter multiple face -names, separated by commas. The optional argument MULTIPLE -specifies the form of the return value. If MULTIPLE is non-nil, -return a list of face names; if the user entered just one face -name, the return value would be a list of one face name. -Otherwise, return a single face name; if the user entered more -than one face name, return only the first one." - ;; Should we better not generate automagically a value for DEFAULT - ;; when `read-face-name' was called with DEFAULT being nil? - ;; Such magic is somewhat unusual for a function `read-...'. - ;; Also, one cannot skip this magic by means of a suitable - ;; value of DEFAULT. It would be cleaner to use - ;; (read-face-name prompt (face-at-point)). - (unless default - ;; Try to get a default face name from the buffer. - (let ((thing (intern-soft (thing-at-point 'symbol)))) - (if (memq thing (face-list)) - (setq default (list thing)))) - ;; Add the named faces that the `read-face-name' or `face' property uses. - (let ((faceprop (or (get-char-property (point) 'read-face-name) - (get-char-property (point) 'face)))) - (if (and (listp faceprop) - ;; Don't treat an attribute spec as a list of faces. - (not (keywordp (car faceprop))) - (not (memq (car faceprop) '(foreground-color background-color)))) - (dolist (face faceprop) - (if (symbolp face) - (push face default))) - (if (symbolp faceprop) - (push faceprop default))) - (delete-dups default))) - - ;; If we only want one, and the default is more than one, - ;; discard the unwanted ones now. - (if (and default (not multiple)) - (setq default (list (car default)))) - - (if default - (setq default (mapconcat (lambda (f) - (if (symbolp f) (symbol-name f) f)) - default ", "))) - - ;; Build up the completion tables. - (let (aliasfaces nonaliasfaces) +as the separator regexp. Thus, the user may enter multiple face names, +separated by commas. + +MULTIPLE specifies the form of the return value. If MULTIPLE is non-nil, +return a list of face names; if the user entered just one face name, +return a list of one face name. Otherwise, return a single face name; +if the user entered more than one face name, return only the first one." + (if (and default (not (stringp default))) + (setq default + (cond ((symbolp default) + (symbol-name default)) + (multiple + (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f)) + default ", ")) + ;; If we only want one, and the default is more than one, + ;; discard the unwanted ones. + (t (symbol-name (car default)))))) + + (let (aliasfaces nonaliasfaces faces) + ;; Build up the completion tables. (mapatoms (lambda (s) - (if (custom-facep s) + (if (facep s) (if (get s 'face-alias) (push (symbol-name s) aliasfaces) (push (symbol-name s) nonaliasfaces))))) - - (let ((faces - ;; Read the faces. - (mapcar 'intern - (completing-read-multiple - (if default - (format "%s (default `%s'): " prompt default) - (format "%s: " prompt)) - (completion-table-in-turn nonaliasfaces aliasfaces) - nil t nil 'face-name-history default)))) - ;; Return either a list of faces or just one face. - (if multiple - faces - (car faces))))) + (dolist (face (completing-read-multiple + (if default + (format "%s (default `%s'): " prompt default) + (format "%s: " prompt)) + (completion-table-in-turn nonaliasfaces aliasfaces) + nil t nil 'face-name-history default)) + ;; Ignore elements that are not faces + ;; (for example, because DEFAULT was "all faces") + (if (facep face) (push (intern face) faces))) + ;; Return either a list of faces or just one face. + (if multiple + (nreverse faces) + (last faces)))) ;; Not defined without X, but behind window-system test. (defvar x-bitmap-file-path) @@ -1235,7 +1209,7 @@ :slant (if italic-p 'italic 'normal) :underline underline :inverse-video inverse-p) - (setq face (read-face-name "Modify face")) + (setq face (read-face-name "Modify face" (face-at-point t))) (apply #'set-face-attribute face frame (read-all-face-attributes face frame)))) @@ -1247,13 +1221,13 @@ \(a symbol), and NEW-VALUE is value read." (cond ((eq attribute :font) (let* ((prompt "Set font-related attributes of face") - (face (read-face-name prompt)) + (face (read-face-name prompt (face-at-point t))) (font (read-face-font face frame))) (list face font))) (t (let* ((attribute-name (face-descriptive-attribute-name attribute)) (prompt (format "Set %s of face" attribute-name)) - (face (read-face-name prompt)) + (face (read-face-name prompt (face-at-point t))) (new-value (read-face-attribute face attribute frame))) (list face new-value))))) @@ -1363,8 +1337,7 @@ If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." (interactive (list (read-face-name "Describe face" - (if (eq 'default (face-at-point)) - '(default)) + (or (face-at-point t) 'default) t))) (let* ((attrs '((:family . "Family") (:foundry . "Foundry") @@ -1879,23 +1852,33 @@ (when msg (message "Color: `%s'" color)) color)) - -(defun face-at-point () +(defun face-at-point (&optional thing multiple) "Return the face of the character after point. If it has more than one face, return the first one. -Return nil if it has no specified face." - (let* ((faceprop (or (get-char-property (point) 'read-face-name) - (get-char-property (point) 'face) - 'default)) - (face (cond ((symbolp faceprop) faceprop) - ;; List of faces (don't treat an attribute spec). - ;; Just use the first face. - ((and (consp faceprop) (not (keywordp (car faceprop))) - (not (memq (car faceprop) - '(foreground-color background-color)))) - (car faceprop)) - (t nil)))) ; Invalid face value. - (if (facep face) face nil))) +If THING is non-nil try first to get a face name from the buffer. +IF MULTIPLE is non-nil, return a list of all faces. +Return nil if there is no face." + (let (faces) + (if thing + ;; Try to get a face name from the buffer. + (let ((face (intern-soft (thing-at-point 'symbol)))) + (if (facep face) + (push face faces)))) + ;; Add the named faces that the `read-face-name' or `face' property uses. + (let ((faceprop (or (get-char-property (point) 'read-face-name) + (get-char-property (point) 'face)))) + (cond ((facep faceprop) + (push faceprop faces)) + ((and (listp faceprop) + ;; Don't treat an attribute spec as a list of faces. + (not (keywordp (car faceprop))) + (not (memq (car faceprop) + '(foreground-color background-color)))) + (dolist (face faceprop) + (if (facep face) + (push face faces)))))) + (setq faces (delete-dups (nreverse faces))) + (if multiple faces (car faces)))) (defun foreground-color-at-point () "Return the foreground color of the character after point."