diff options
| author | Karoly Lorentey <lorentey@elte.hu> | 2006-01-03 02:15:28 +0000 |
|---|---|---|
| committer | Karoly Lorentey <lorentey@elte.hu> | 2006-01-03 02:15:28 +0000 |
| commit | b58cb6144c59dfa3a44b9b383cf354bc2c9bebdf (patch) | |
| tree | 87bc562249d9e597e12406e1d9b1c7dfb0f937e5 /lisp | |
| parent | b3e6f69c10973ff7b040ced07a3a084960619681 (diff) | |
| parent | 55262b16df717fe533ea4ad23dac3f02398c9055 (diff) | |
| download | emacs-b58cb6144c59dfa3a44b9b383cf354bc2c9bebdf.tar.gz | |
Merged from miles@gnu.org--gnu-2005 (patch 682)
Patches applied:
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-682
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-490
Diffstat (limited to 'lisp')
33 files changed, 1702 insertions, 1324 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 288e4d7ed44..1050d3deb84 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,171 @@ +2006-01-01 Richard M. Stallman <rms@gnu.org> + + * cus-edit.el (Custom-set, Custom-save): Ask for confirmation. + (Custom-reset-current, Custom-reset-saved): Likewise. + (Custom-reset-standard): Show message if aborted. + (custom-mode): Doc fix, describing those commands. + + * mouse.el (mouse-drag-region-1): When following link via mouse-2, + put on event-kind property. + +2005-12-31 Chong Yidong <cyd@stupidchicken.com> + + * custom.el (provide-theme): Ban `user' theme name. + (custom-enabling-themes): New variable. + (enable-theme): Don't enable user if custom-enabling-themes is t. + (custom-enabled-themes): Make it a defcustom. + (custom-theme-recalc-face): No-op if face is undefined. + + * cus-edit.el (custom-button-mouse): New variable. + (custom-button-mouse): New face. + (custom-raised-buttons, custom-mode): Use it. + + * cus-theme.el (custom-new-theme-mode): Use custom-button-mouse. + +2005-12-31 Eli Zaretskii <eliz@gnu.org> + + * progmodes/gud.el (gud-display-line): Support hl-line in the + source buffer. + +2005-12-31 Lennart Borgman <lennart.borgman.073@student.lu.se> (tiny change) + + * mouse.el (mouse-drag-window-above): Verify that the found window + overlaps with the given window in the horizontal dimension. + +2005-12-31 Eli Zaretskii <eliz@gnu.org> + + * Makefile.in (cvs-update): New target. + + * makefile.w32-in (cvs-update): Ditto. + +2005-12-30 Chong Yidong <cyd@stupidchicken.com> + + * cus-theme.el (custom-new-theme-mode): Use cus-edit faces. + (custom-new-theme-mode-map): New variable. + +2005-12-30 Richard M. Stallman <rms@gnu.org> + + * custom.el (custom-load-themes): Function deleted. + + * cus-edit.el (custom-save-loaded-themes): Function deleted. + (custom-save-variables): Don't delete or add custom-load-themes call. + +2005-12-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * cus-start.el: Add `visible-cursor'. + + * progmodes/flymake.el (flymake-copy-buffer-to-temp-buffer): Simplify. + (flymake-parse-output-and-residual): Remove `source-buffer' argument. + (flymake-process-filter): Switch to buffer before calling it instead. + (flymake-post-syntax-check, flymake-highlight-err-lines) + (flymake-delete-own-overlays, flymake-parse-err-lines) + (flymake-start-syntax-check, flymake-start-syntax-check-process) + (flymake-count-lines, flymake-parse-residual): + Remove constant buffer argument. + (flymake-start-syntax-check-for-current-buffer): Remove. + Update callers to use flymake-start-syntax-check instead. + (flymake-display-err-menu-for-current-line): + Remove unused var `mouse-pos'. + (flymake-restore-formatting): Comment out unused function. + (flymake-report-status, flymake-report-fatal-status): Remove buffer + argument, use current-buffer instead. Update callers. + +2005-12-30 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-mode): Make completion-ignore-case + buffer-local because choose-completion-delete-max-match requires + that we set completion-ignore-case (i.e., binding via let is not + sufficient). + (bibtex-complete): Always set completion-ignore-case and + choose-completion-string-functions. The latter is needed because + choose-completion-string-functions keeps its value if we quit the + *Completions* buffer without requesting a completion. + +2005-12-30 Andreas Schwab <schwab@suse.de> + + * progmodes/cc-defs.el: Ignore errors from font-lock-compile-keywords. + +2005-12-30 Eli Zaretskii <eliz@gnu.org> + + * jit-lock.el (jit-lock-chunk-size): Doc fix. + +2005-12-30 Juri Linkov <juri@jurta.org> + + * locate.el (locate-fcodes-file, locate-header-face) + * progmodes/delphi.el (delphi-other-face) + * progmodes/glasses.el (glasses-face): Add tag "None" to const nil. + + * paren.el (show-paren-match, show-paren-mismatch): Use existing + group `paren-showing-faces'. + + * net/goto-addr.el (goto-address-highlight-keymap): Fix docstring. + (goto-address): Fix docstring. + + * net/webjump.el (webjump-sample-sites): Update URLs. + + * textmodes/fill.el (fill-single-word-nobreak-p): Use `sentence-end'. + + * subr.el (cancel-change-group): Add listp around pending-undo-list. + +2005-12-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * font-lock.el (font-lock-compile-keywords): Signal an error when + font-lock-set-defaults hasn't been called. + +2005-12-29 Luc Teirlinck <teirllm@auburn.edu> + + * subr.el (noreturn, 1value): Doc fixes. + +2005-12-29 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-text-in-field-bounds): Handle case + that assoc-string returns nil. + +2005-12-29 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-entry-type-whitespace) + (bibtex-entry-type-str, bibtex-empty-field-re) + (bibtex-search-backward-string, bibtex-preamble-prefix) + (bibtex-search-entry, bibtex-enclosing-entry-maybe-empty-head): Remove. + (bibtex-any-valid-entry-type): New variable. + (bibtex-parse-field-name): Simplify. + (bibtex-parse-string, bibtex-search-forward-string): New arg empty-key. + (bibtex-preamble-prefix): Include left delimiter. + (bibtex-search-forward-field, bibtex-search-backward-field): + Allow unbounded search past entry boundaries (required by bibtex-pop). + (bibtex-text-in-field-bounds): Use push. + (bibtex-text-in-field): Do not use bibtex-narrow-to-entry. + (bibtex-parse-preamble, bibtex-valid-entry) + (bibtex-beginning-first-field): New functions. + (bibtex-skip-to-valid-entry): Use bibtex-valid-entry. Fix regexp. + (bibtex-map-entries): Fix docstring. + (bibtex-flash-head): New arg prompt. Simplify. + (bibtex-enclosing-field): Include code of bibtex-inside-field. + (bibtex-insert-kill): Simplify. Always insert text past the + current field or entry. + (bibtex-format-entry): Use bibtex-parse-field. + (bibtex-pop): Use bibtex-beginning-of-entry and + bibtex-end-of-entry to initiate the search. Insert empty field if + we found ourselves. + (bibtex-print-help-message): New args field and comma. + Handle entry keys. + (bibtex-make-field): Use bibtex-beginning-of-entry. + (bibtex-end-of-entry): Use bibtex-valid-entry. Recognize any + invalid entry. + (bibtex-validate): Use bibtex-valid-entry and bibtex-parse-string. + Handle preambles. Simplify code for thorough test. + (bibtex-next-field, bibtex-find-text, bibtex-find-text-internal): + New arg comma. Handle entry heads. + (bibtex-remove-OPT-or-ALT, bibtex-remove-delimiters) + (bibtex-kill-field, bibtex-copy-field-as-kil, bibtex-empty-field): + New arg comma. + (bibtex-kill-entry): Use bibtex-any-entry-maybe-empty-head. + (bibtex-fill-field): Simplify. + (bibtex-fill-entry): Use bibtex-beginning-first-field and + bibtex-parse-field. + (bibtex-convert-alien): Do not wait before calling bibtex-validate. + (bibtex-complete): Use bibtex-parse-preamble. + 2005-12-29 Nick Roberts <nickrob@snap.net.nz> * progmodes/gdb-ui.el (gdb-tooltip-print, gdb-tooltip-print-1): @@ -11,8 +179,7 @@ 2005-12-28 Bill Wohler <wohler@newt.com> - * simple.el (mh-e-user-agent): Move to mh-e/mh-comp.el and - autoload. + * simple.el (mh-e-user-agent): Move to mh-e/mh-comp.el and autoload. 2005-12-28 Stefan Monnier <monnier@iro.umontreal.ca> diff --git a/lisp/Makefile.in b/lisp/Makefile.in index eaac8d08324..9a4497679ef 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -119,6 +119,9 @@ update-subdirs: doit updates: update-subdirs autoloads mh-autoloads finder-data custom-deps +# This is useful after "cvs up". +cvs-update: recompile autoloads finder-data custom-deps + # Update the AUTHORS file. update-authors: diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 54d0fa23e52..4c92034eaad 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -746,22 +746,26 @@ groups after non-groups, if nil do not order groups at all." (defun Custom-set () "Set changes in all modified options." (interactive) - (let ((children custom-options)) - (mapc (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-set))) - children))) + (if (y-or-n-p "Set all values according to this buffer? ") + (let ((children custom-options)) + (mapc (lambda (child) + (when (eq (widget-get child :custom-state) 'modified) + (widget-apply child :custom-set))) + children)) + (message "Aborted"))) (defun Custom-save () "Set all modified group members and save them." (interactive) - (let ((children custom-options)) - (mapc (lambda (child) - (when (memq (widget-get child :custom-state) - '(modified set changed rogue)) - (widget-apply child :custom-save))) - children)) - (custom-save-all)) + (if (yes-or-no-p "Save all settings in this buffer? ") + (let ((children custom-options)) + (mapc (lambda (child) + (when (memq (widget-get child :custom-state) + '(modified set changed rogue)) + (widget-apply child :custom-save))) + children) + (custom-save-all)) + (message "Aborted"))) (defvar custom-reset-menu '(("Current" . Custom-reset-current) @@ -784,22 +788,26 @@ when the action is chosen.") (defun Custom-reset-current (&rest ignore) "Reset all modified group members to their current value." (interactive) - (let ((children custom-options)) - (mapc (lambda (widget) - (if (memq (widget-get widget :custom-state) - '(modified changed)) - (widget-apply widget :custom-reset-current))) - children))) + (if (y-or-n-p "Update buffer text to show all current settings? ") + (let ((children custom-options)) + (mapc (lambda (widget) + (if (memq (widget-get widget :custom-state) + '(modified changed)) + (widget-apply widget :custom-reset-current))) + children)) + (message "Aborted"))) (defun Custom-reset-saved (&rest ignore) "Reset all modified or set group members to their saved value." (interactive) - (let ((children custom-options)) - (mapc (lambda (widget) - (if (memq (widget-get widget :custom-state) - '(modified set changed rogue)) - (widget-apply widget :custom-reset-saved))) - children))) + (if (y-or-n-p "Update buffer text to show all saved settings? ") + (let ((children custom-options)) + (mapc (lambda (widget) + (if (memq (widget-get widget :custom-state) + '(modified set changed rogue)) + (widget-apply widget :custom-reset-saved))) + children)) + (message "Aborted"))) (defun Custom-reset-standard (&rest ignore) "Erase all customization (either current or saved) for the group members. @@ -808,18 +816,19 @@ This operation eliminates any saved values for the group members, making them as if they had never been customized at all." (interactive) (let ((children custom-options)) - (when (or (and (= 1 (length children)) - (memq (widget-type (car children)) - '(custom-variable custom-face))) - (yes-or-no-p "Really erase all customizations in this buffer? ")) - (mapc (lambda (widget) - (and (if (widget-get widget :custom-standard-value) - (widget-apply widget :custom-standard-value) - t) - (memq (widget-get widget :custom-state) - '(modified set changed saved rogue)) - (widget-apply widget :custom-reset-standard))) - children)))) + (if (or (and (= 1 (length children)) + (memq (widget-type (car children)) + '(custom-variable custom-face))) + (yes-or-no-p "Really erase all customizations in this buffer? ")) + (mapc (lambda (widget) + (and (if (widget-get widget :custom-standard-value) + (widget-apply widget :custom-standard-value) + t) + (memq (widget-get widget :custom-state) + '(modified set changed saved rogue)) + (widget-apply widget :custom-reset-standard))) + children) + (message "Aborted")))) ;;; The Customize Commands @@ -1405,6 +1414,9 @@ This button will have a menu with all three reset operations." (defvar custom-button nil "Face used for buttons in customization buffers.") +(defvar custom-button-mouse nil + "Mouse face used for buttons in customization buffers.") + (defvar custom-button-pressed nil "Face used for pressed buttons in customization buffers.") @@ -1419,6 +1431,8 @@ Otherwise use brackets." (custom-set-default variable value) (setq custom-button (if value 'custom-button 'custom-button-unraised)) + (setq custom-button-mouse + (if value 'custom-button-mouse 'highlight)) (setq custom-button-pressed (if value 'custom-button-pressed @@ -1960,6 +1974,16 @@ and `face'." ;; backward-compatibility alias (put 'custom-button-face 'face-alias 'custom-button) +(defface custom-button-mouse + '((((type x w32 mac) (class color)) + (:box (:line-width 2 :style released-button) + :background "grey90" :foreground "black")) + (t + nil)) + "Mouse face for custom buffer buttons if `custom-raised-buttons' is non-nil." + :version "22.1" + :group 'custom-faces) + (defface custom-button-unraised '((((min-colors 88) (class color) (background light)) :foreground "blue1" :underline t) @@ -1975,6 +1999,9 @@ and `face'." (setq custom-button (if custom-raised-buttons 'custom-button 'custom-button-unraised)) +(setq custom-button-mouse + (if custom-raised-buttons 'custom-button-mouse 'highlight)) + (defface custom-button-pressed '((((type x w32 mac) (class color)) (:box (:line-width 2 :style pressed-button) @@ -4024,6 +4051,33 @@ if only the first line of the docstring is shown.")) (save-buffer)) (unless old-buffer (kill-buffer (current-buffer)))))) + +;;;###autoload +(defun customize-save-customized () + "Save all user options which have been set in this session." + (interactive) + (mapatoms (lambda (symbol) + (let ((face (get symbol 'customized-face)) + (value (get symbol 'customized-value)) + (face-comment (get symbol 'customized-face-comment)) + (variable-comment + (get symbol 'customized-variable-comment))) + (when face + (put symbol 'saved-face face) + (custom-push-theme 'theme-face symbol 'user 'set value) + (put symbol 'customized-face nil)) + (when value + (put symbol 'saved-value value) + (custom-push-theme 'theme-value symbol 'user 'set value) + (put symbol 'customized-value nil)) + (when variable-comment + (put symbol 'saved-variable-comment variable-comment) + (put symbol 'customized-variable-comment nil)) + (when face-comment + (put symbol 'saved-face-comment face-comment) + (put symbol 'customized-face-comment nil))))) + ;; We really should update all custom buffers here. + (custom-save-all)) ;; Editing the custom file contents in a buffer. @@ -4069,10 +4123,8 @@ This function does not save the buffer." (defun custom-save-variables () "Save all customized variables in `custom-file'." (save-excursion - (custom-save-delete 'custom-load-themes) (custom-save-delete 'custom-reset-variables) (custom-save-delete 'custom-set-variables) - (custom-save-loaded-themes) (custom-save-resets 'theme-value 'custom-reset-variables nil) (let ((standard-output (current-buffer)) (saved-list (make-list 1 0)) @@ -4131,6 +4183,33 @@ This function does not save the buffer." (unless (looking-at "\n") (princ "\n"))))) +(defun custom-save-resets (property setter special) + (let (started-writing ignored-special) + ;; (custom-save-delete setter) Done by caller + (let ((standard-output (current-buffer)) + (mapper `(lambda (object) + (let ((spec (car-safe (get object (quote ,property))))) + (when (and (not (memq object ignored-special)) + (eq (nth 0 spec) 'user) + (eq (nth 1 spec) 'reset)) + ;; Do not write reset statements unless necessary. + (unless started-writing + (setq started-writing t) + (unless (bolp) + (princ "\n")) + (princ "(") + (princ (quote ,setter)) + (princ "\n '(") + (prin1 object) + (princ " ") + (prin1 (nth 3 spec)) + (princ ")"))))))) + (mapc mapper special) + (setq ignored-special special) + (mapatoms mapper) + (when started-writing + (princ ")\n"))))) + (defun custom-save-faces () "Save all customized faces in `custom-file'." (save-excursion @@ -4187,71 +4266,6 @@ This function does not save the buffer." (princ ")") (unless (looking-at "\n") (princ "\n"))))) - -(defun custom-save-resets (property setter special) - (let (started-writing ignored-special) - ;; (custom-save-delete setter) Done by caller - (let ((standard-output (current-buffer)) - (mapper `(lambda (object) - (let ((spec (car-safe (get object (quote ,property))))) - (when (and (not (memq object ignored-special)) - (eq (nth 0 spec) 'user) - (eq (nth 1 spec) 'reset)) - ;; Do not write reset statements unless necessary. - (unless started-writing - (setq started-writing t) - (unless (bolp) - (princ "\n")) - (princ "(") - (princ (quote ,setter)) - (princ "\n '(") - (prin1 object) - (princ " ") - (prin1 (nth 3 spec)) - (princ ")"))))))) - (mapc mapper special) - (setq ignored-special special) - (mapatoms mapper) - (when started-writing - (princ ")\n"))))) - -(defun custom-save-loaded-themes () - (let ((themes (reverse (get 'user 'theme-loads-themes))) - (standard-output (current-buffer))) - (when themes - (unless (bolp) (princ "\n")) - (princ "(custom-load-themes") - (mapc (lambda (theme) - (princ "\n '") - (prin1 theme)) themes) - (princ " )\n")))) - -;;;###autoload -(defun customize-save-customized () - "Save all user options which have been set in this session." - (interactive) - (mapatoms (lambda (symbol) - (let ((face (get symbol 'customized-face)) - (value (get symbol 'customized-value)) - (face-comment (get symbol 'customized-face-comment)) - (variable-comment - (get symbol 'customized-variable-comment))) - (when face - (put symbol 'saved-face face) - (custom-push-theme 'theme-face symbol 'user 'set value) - (put symbol 'customized-face nil)) - (when value - (put symbol 'saved-value value) - (custom-push-theme 'theme-value symbol 'user 'set value) - (put symbol 'customized-value nil)) - (when variable-comment - (put symbol 'saved-variable-comment variable-comment) - (put symbol 'customized-variable-comment nil)) - (when face-comment - (put symbol 'saved-face-comment face-comment) - (put symbol 'customized-face-comment nil))))) - ;; We really should update all custom buffers here. - (custom-save-all)) ;;; The Customize Menu. @@ -4400,11 +4414,12 @@ Complete content of editable text field. \\[widget-complete] \\<custom-mode-map>\ Invoke button under the mouse pointer. \\[Custom-move-and-invoke] Invoke button under point. \\[widget-button-press] -Set all modifications. \\[Custom-set] -Make all modifications default. \\[Custom-save] -Reset all modified options. \\[Custom-reset-current] -Reset all modified or set options. \\[Custom-reset-saved] -Reset all options. \\[Custom-reset-standard] +Set all options from current text. \\[Custom-set] +Make values in current text permanent. \\[Custom-save] +Make text match actual option values. \\[Custom-reset-current] +Reset options to permanent settings. \\[Custom-reset-saved] +Erase customizations; set options + and buffer text to the standard values. \\[Custom-reset-standard] Entry to this mode calls the value of `custom-mode-hook' if that value is non-nil." @@ -4420,8 +4435,7 @@ if that value is non-nil." (make-local-variable 'widget-button-face) (setq widget-button-face custom-button) (set (make-local-variable 'widget-button-pressed-face) custom-button-pressed) - (if custom-raised-buttons - (set (make-local-variable 'widget-mouse-face) custom-button)) + (set (make-local-variable 'widget-mouse-face) custom-button-mouse) ;; When possible, use relief for buttons, not bracketing. This test ;; may not be optimal. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index a851d32d296..30af30045f8 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -274,6 +274,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (words-include-escapes editing-basics boolean) (open-paren-in-column-0-is-defun-start editing-basics boolean "21.1") + ;; term.c + (visible-cursor cursor boolean "22.1") ;; undo.c (undo-limit undo integer) (undo-strong-limit undo integer) diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 43cf96e34fa..d7102fc11f7 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -31,11 +31,31 @@ (eval-when-compile (require 'wid-edit)) +(defvar custom-new-theme-mode-map + (let ((map (make-keymap))) + (set-keymap-parent map widget-keymap) + (suppress-keymap map) + (define-key map "n" 'widget-forward) + (define-key map "p" 'widget-backward) + (define-key map [mouse-1] 'widget-move-and-invoke) + map) + "Keymap for `custom-new-theme-mode'.") + (define-derived-mode custom-new-theme-mode nil "New-Theme" "Major mode for the buffer created by `customize-create-theme'. Do not call this mode function yourself. It is only meant for internal use by `customize-create-theme'." - (set-keymap-parent custom-new-theme-mode-map widget-keymap)) + (use-local-map custom-new-theme-mode-map) + (define-key custom-new-theme-mode-map [mouse-1] 'widget-move-and-invoke) + (set (make-local-variable 'widget-documentation-face) 'custom-documentation) + (set (make-local-variable 'widget-button-face) custom-button) + (set (make-local-variable 'widget-button-pressed-face) custom-button-pressed) + (set (make-local-variable 'widget-mouse-face) custom-button-mouse) + (when custom-raised-buttons + (set (make-local-variable 'widget-push-button-prefix) "") + (set (make-local-variable 'widget-push-button-suffix) "") + (set (make-local-variable 'widget-link-prefix) "") + (set (make-local-variable 'widget-link-suffix) ""))) (put 'custom-new-theme-mode 'mode-class 'special) (defvar custom-theme-name) diff --git a/lisp/custom.el b/lisp/custom.el index df2488bda40..18d79a6af23 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -648,8 +648,7 @@ The user has not customized the variable; had he done that, the list would contain an entry for the `user' theme, too. See `custom-known-themes' for a list of known themes." - (unless (or (eq prop 'theme-value) - (eq prop 'theme-face)) + (unless (memq prop '(theme-value theme-face)) (error "Unknown theme property")) (let* ((old (get symbol prop)) (setting (assq theme old)) @@ -1048,21 +1047,15 @@ into this directory." "Return non-nil if THEME has been loaded." (memq theme custom-loaded-themes)) -(defvar custom-enabled-themes '(user) - "Custom themes currently enabled, highest precedence first. -The first one is always `user'.") - -(defun custom-theme-enabled-p (theme) - "Return non-nil if THEME is enabled." - (memq theme custom-enabled-themes)) - (defun provide-theme (theme) - "Indicate that this file provides THEME. -Add THEME to `custom-loaded-themes', and `provide' whatever -feature name is stored in THEME's property `theme-feature'. + "Indicate that this file provides THEME, and mark it as enabled. +Add THEME to `custom-loaded-themes' and `custom-enabled-themes', +and `provide' the feature name stored in THEME's property `theme-feature'. Usually the `theme-feature' property contains a symbol created by `custom-make-theme-feature'." + (if (eq theme 'user) + (error "Custom theme cannot be named `user'")) (custom-check-theme theme) (provide (get theme 'theme-feature)) (push theme custom-loaded-themes) @@ -1120,15 +1113,11 @@ All the themes loaded for BY-THEME are recorded in BY-THEME's property (load-theme theme))) (push theme themes-loaded)) (put by-theme 'theme-loads-themes themes-loaded))) - -(defun custom-load-themes (&rest body) - "Load themes for the USER theme as specified by BODY. - -See `custom-theme-load-themes' for more information on BODY." - (apply 'custom-theme-load-themes 'user body)) ;;; Enabling and disabling loaded themes. +(defvar custom-enabling-themes nil) + (defun enable-theme (theme) "Reenable all variable and face settings defined by THEME. The newly enabled theme gets the highest precedence (after `user'). @@ -1137,9 +1126,9 @@ If it is already enabled, just give it highest precedence (after `user'). This signals an error if THEME does not specify any theme settings. Theme settings are set using `load-theme'." (interactive "SEnable Custom theme: ") + (unless (or (eq theme 'user) (memq theme custom-loaded-themes)) + (error "Theme %s not defined" (symbol-name theme))) (let ((settings (get theme 'theme-settings))) - (if (and (not (eq theme 'user)) (null settings)) - (error "No theme settings defined in %s." (symbol-name theme))) (dolist (s settings) (let* ((prop (car s)) (symbol (cadr s)) @@ -1147,29 +1136,58 @@ settings. Theme settings are set using `load-theme'." (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list))) (if (eq prop 'theme-value) (custom-theme-recalc-variable symbol) - (if (facep symbol) - (custom-theme-recalc-face symbol)))))) - (setq custom-enabled-themes - (cons theme (delq theme custom-enabled-themes))) - ;; `user' must always be the highest-precedence enabled theme. + (custom-theme-recalc-face symbol))))) (unless (eq theme 'user) - (enable-theme 'user))) + (setq custom-enabled-themes + (cons theme (delq theme custom-enabled-themes))) + (unless custom-enabling-themes + (enable-theme 'user)))) + +(defcustom custom-enabled-themes nil + "List of enabled Custom Themes, highest precedence first. + +This does not include the `user' theme, which is set by Customize, +and always takes precedence over other Custom Themes." + :group 'customize + :type '(repeat symbol) + :set (lambda (symbol themes) + ;; Avoid an infinite loop when custom-enabled-themes is + ;; defined in a theme (e.g. `user'). Enabling the theme sets + ;; custom-enabled-themes, which enables the theme... + (unless custom-enabling-themes + (let ((custom-enabling-themes t)) + (setq themes (delq 'user (delete-dups themes))) + (if (boundp symbol) + (dolist (theme (symbol-value symbol)) + (if (not (memq theme themes)) + (disable-theme theme)))) + (dolist (theme (reverse themes)) + (if (or (custom-theme-loaded-p theme) (eq theme 'user)) + (enable-theme theme) + (load-theme theme))) + (enable-theme 'user) + (custom-set-default symbol themes))))) + +(defun custom-theme-enabled-p (theme) + "Return non-nil if THEME is enabled." + (memq theme custom-enabled-themes)) (defun disable-theme (theme) "Disable all variable and face settings defined by THEME. -See `custom-known-themes' for a list of known themes." +See `custom-enabled-themes' for a list of enabled themes." (interactive "SDisable Custom theme: ") - (let ((settings (get theme 'theme-settings))) - (dolist (s settings) - (let* ((prop (car s)) - (symbol (cadr s)) - (spec-list (get symbol prop))) - (put symbol prop (assq-delete-all theme spec-list)) - (if (eq prop 'theme-value) - (custom-theme-recalc-variable symbol) - (custom-theme-recalc-face symbol))))) - (setq custom-enabled-themes - (delq theme custom-enabled-themes))) + (when (memq theme custom-enabled-themes) + (let ((settings (get theme 'theme-settings))) + (dolist (s settings) + (let* ((prop (car s)) + (symbol (cadr s)) + (spec-list (get symbol prop))) + (put symbol prop (assq-delete-all theme spec-list)) + (if (eq prop 'theme-value) + (custom-theme-recalc-variable symbol) + (custom-theme-recalc-face symbol))))) + (setq custom-enabled-themes + (delq theme custom-enabled-themes)))) (defun custom-theme-value (theme setting-list) "Determine the value specified for THEME according to SETTING-LIST. @@ -1217,9 +1235,10 @@ This function returns nil if no custom theme specifies a value for VARIABLE." (defun custom-theme-recalc-face (face) "Set FACE according to currently enabled custom themes." - (let ((theme-faces (reverse (get face 'theme-face)))) - (dolist (spec theme-faces) - (face-spec-set face (car (cddr spec)))))) + (if (facep face) + (let ((theme-faces (reverse (get face 'theme-face)))) + (dolist (spec theme-faces) + (face-spec-set face (car (cddr spec))))))) (defun custom-theme-reset-variables (theme &rest args) "Reset the specs in THEME of some variables to their values in other themes. diff --git a/lisp/font-lock.el b/lisp/font-lock.el index de366997a93..7819a0e81cc 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1507,6 +1507,13 @@ Here each COMPILED is of the form (MATCHER HIGHLIGHT ...) as shown in the `font-lock-keywords' doc string. If REGEXP is non-nil, it means these keywords are used for `font-lock-keywords' rather than for `font-lock-syntactic-keywords'." + (if (not font-lock-set-defaults) + ;; This should never happen. But some external packages sometimes + ;; call font-lock in unexpected and incorrect ways. It's important to + ;; stop processing at this point, otherwise we may end up changing the + ;; global value of font-lock-keywords and break highlighting in many + ;; other buffers. + (error "Font-lock trying to use keywords before setting them up")) (if (eq (car-safe keywords) t) keywords (setq keywords diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index eb5ace956eb..16db1e25a9a 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -65,7 +65,9 @@ Preserves the `buffer-modified-p' state of the current buffer." :group 'font-lock) (defcustom jit-lock-chunk-size 500 - "*Jit-lock chunks of this many characters, or smaller." + "*Jit-lock fontifies chunks of at most this many characters at a time. + +This variable controls both display-time and stealth fontification." :type 'integer :group 'jit-lock) diff --git a/lisp/locate.el b/lisp/locate.el index 563300f6c03..9676c84f80c 100644 --- a/lisp/locate.el +++ b/lisp/locate.el @@ -144,12 +144,12 @@ (defcustom locate-fcodes-file nil "*File name for the database of file names." - :type '(choice file (const nil)) + :type '(choice (const :tag "None" nil) file) :group 'locate) (defcustom locate-header-face nil "*Face used to highlight the locate header." - :type '(choice face (const nil)) + :type '(choice (const :tag "None" nil) face) :group 'locate) ;;;###autoload diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 24acf0009c4..f9c33dbed79 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -183,6 +183,9 @@ update-subdirs-SH: doit updates: update-subdirs autoloads mh-autoloads finder-data custom-deps +# This is useful after "cvs up". +cvs-update: recompile autoloads finder-data custom-deps + # Update the AUTHORS file. update-authors: diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index 74fd15a2c19..4f3d56f98c9 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,66 @@ +2006-01-01 Bill Wohler <wohler@newt.com> + + * mh-customize.el: Sync docstrings with manual for faces and sort + them alphabetically. + (mh-faces): Move below mh-hooks. + (mh-folder-faces, mh-index-faces, mh-letter-faces) + (mh-show-faces, mh-speed-faces): Delete. Organize faces like + hooks. + (mh-speed-update-interval): Fix group (mh-speedbar, not mh-speed). + (facemenu-unlisted-faces): Might as well ignore all MH-E faces. + (mh-folder-body-face, mh-folder-cur-msg-face) + (mh-folder-cur-msg-number-face, mh-folder-date-face) + (mh-folder-followup-face, mh-folder-msg-number-face) + (mh-folder-deleted-face, mh-folder-refiled-face) + (mh-folder-subject-face, mh-folder-address-face) + (mh-folder-scan-format-face, mh-folder-to-face) + (mh-index-folder-face, mh-show-cc-face, mh-show-date-face) + (mh-show-header-face, mh-show-pgg-good-face) + (mh-show-pgg-unknown-face, mh-show-pgg-bad-face) + (mh-show-to-face, mh-show-from-face, mh-show-subject-face): + Delete. + (mh-folder-cur-msg): Unused. Delete. + (mh-folder-address): Use defface; inherit from mh-folder-subject. + (mh-folder-body, mh-folder-cur-msg-number, mh-folder-date): + Inherit from mh-folder-msg-number. + (mh-folder-deleted): Use defface. Inherit from + mh-folder-msg-number. + (mh-folder-sent-to-me-hint): New face. Inherit from + mh-folder-date. + (mh-folder-sent-to-me-sender): Rename from mh-folder-scan-format. + Use defface. Inherit from mh-folder-followup. + (mh-show-xface): Inherit from mh-show-from and highlight. + (bw-face-generation, bw-toggle-faces) + (bw-new-face-to-old, bw-old-face-to-new): New (tempoarary) + variables, functions for toggling between old and new faces. + + * mh-e.el (font-lock-auto-fontify, font-lock-defaults): Hide in + eval-when-compile. We should probably do this throughout. + (mh-scan-good-msg-regexp, mh-scan-deleted-msg-regexp) + (mh-scan-refiled-msg-regexp, mh-scan-cur-msg-number-regexp) + (mh-scan-date-regexp, mh-scan-rcpt-regexp, mh-scan-body-regexp) + (mh-scan-subject-regexp): Sync docstrings with manual + (mh-scan-format-regexp): Rename to + mh-scan-sent-to-me-sender-regexp. Drop date parenthesized + expression. Make expression more like the others (anchored at the + beginning of line). Sync docstrings with manual. + (mh-folder-font-lock-keywords): Use faces directly rather than + -face variables. Use mh-scan-sent-to-me-sender-regexp instead of + mh-scan-format-regexp, and within that expression, use faces + mh-folder-sent-to-me-hint and mh-folder-sent-to-me-sender instead + of mh-folder-date-face and mh-folder-scan-format-face which were + misleading. + + * mh-mime.el (mh-mime-security-button-face): Use faces directly + rather than -face variables. + + * mh-utils.el (mh-show-font-lock-keywords): Use faces directly + rather than -face variables. + (mh-face-foreground-compat, mh-face-background-compat): New macros. + (mh-face-display-function): Use mh-face-foreground-compat and + mh-face-background-compat to use inherited attributes of + mh-show-xface on Emacs 22 while still working on Emacs 21. + 2005-12-28 Bill Wohler <wohler@newt.com> * mh-comp.el (mh-e-user-agent): Move here from simple.el. Use diff --git a/lisp/mh-e/mh-customize.el b/lisp/mh-e/mh-customize.el index f5556bda2ba..edd6ee41b01 100644 --- a/lisp/mh-e/mh-customize.el +++ b/lisp/mh-e/mh-customize.el @@ -204,57 +204,18 @@ and GNU mailutils." :prefix "mh-" :group 'mh-e) -(defgroup mh-faces nil - "Faces used in MH-E." - :link '(custom-manual "(mh-e)Top") - :prefix "mh-" - :group 'faces - :group 'mh-e) - (defgroup mh-hooks nil "MH-E hooks." :link '(custom-manual "(mh-e)Top") :prefix "mh-" :group 'mh-e) - - -;;; Faces - -(defgroup mh-folder-faces nil - "Faces used in scan listing." - :link '(custom-manual "(mh-e)Folders") - :prefix "mh-" - :group 'mh-faces - :group 'mh-folder) - -(defgroup mh-index-faces nil - "Faces used in searching." - :link '(custom-manual "(mh-e)Searching") - :prefix "mh-" - :group 'mh-faces - :group 'mh-index) - -(defgroup mh-letter-faces nil - "Faces used in message drafts." - :link '(custom-manual "(mh-e)Editing Drafts") - :prefix "mh-" - :group 'mh-faces - :group 'mh-letter) - -(defgroup mh-show-faces nil - "Faces used in message display." - :link '(custom-manual "(mh-e)Reading Mail") - :prefix "mh-" - :group 'mh-faces - :group 'mh-show) - -(defgroup mh-speed-faces nil - "Faces used in speedbar." - :link '(custom-manual "(mh-e)Speedbar") +(defgroup mh-faces nil + "Faces used in MH-E." + :link '(custom-manual "(mh-e)Top") :prefix "mh-" - :group 'mh-faces - :group 'mh-speed) + :group 'faces + :group 'mh-e) @@ -1883,13 +1844,13 @@ lines you'd like to see." -;;; The Speedbar (:group 'mh-speed) +;;; The Speedbar (:group 'mh-speedbar) (defcustom mh-speed-update-interval 60 "Time between speedbar updates in seconds. Set to 0 to disable automatic update." :type 'integer - :group 'mh-speed) + :group 'mh-speedbar) @@ -2526,81 +2487,42 @@ sequence." -;;; Faces (:group 'mh-*-faces + group where faces described) +;;; Faces (:group 'mh-faces + group where faces described) - +(if (boundp 'facemenu-unlisted-faces) + (add-to-list 'facemenu-unlisted-faces "^mh-")) -;;; Faces Used in Scan Listing (:group 'mh-folder-faces) +(defface mh-folder-address '((t (:inherit mh-folder-subject))) + "Recipient face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-body-face 'mh-folder-body - "Face used to highlight body text in MH-Folder buffers.") (defface mh-folder-body - (mh-defface-compat - '((((class color) (min-colors 88) (background light)) - (:foreground "RosyBrown")) - (((class color) (min-colors 88) (background dark)) - (:foreground "LightSalmon")) - (((class color)) - (:foreground "green")) - (((class grayscale) (background light)) - (:foreground "DimGray" :italic t)) - (((class grayscale) (background dark)) - (:foreground "LightGray" :italic t)) - (t - (:italic t)))) - "Face used to highlight body text in MH-Folder buffers." - :group 'mh-folder-faces) - -(defvar mh-folder-cur-msg-face 'mh-folder-cur-msg - "Face used for the current message line in MH-Folder buffers.") -(defface mh-folder-cur-msg - (mh-defface-compat - '((((class color) (min-colors 88) (background light)) - (:background "LightGreen") ;Use this for solid background colour - ;; (:underline t) ;Use this for underlining - ) - (((class color) (min-colors 88) (background dark)) - (:background "DarkOliveGreen4")) - (((class color)) - (:background "LightGreen")) - (t - (:underline t)))) - "Face used for the current message line in MH-Folder buffers." - :group 'mh-folder-faces) + '((((class color)) + (:inherit mh-folder-msg-number)) + (t + (:inherit mh-folder-msg-number :italic t))) + "Body text face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-cur-msg-number-face 'mh-folder-cur-msg-number - "Face used to highlight the current message in MH-Folder buffers.") (defface mh-folder-cur-msg-number - (mh-defface-compat - '((((class color) (min-colors 88) (background light)) - (:foreground "Purple")) - (((class color) (min-colors 88) (background dark)) - (:foreground "Cyan")) - (((class color)) - (:foreground "cyan" :weight bold)) - (((class grayscale) (background light)) - (:foreground "LightGray" :bold t)) - (((class grayscale) (background dark)) - (:foreground "DimGray" :bold t)) - (t - (:bold t)))) - "Face used to highlight the current message in MH-Folder buffers." - :group 'mh-folder-faces) + '((t + (:inherit mh-folder-msg-number :bold t))) + "Current message number face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-date-face 'mh-folder-date - "Face used to highlight the date in MH-Folder buffers.") -(defface mh-folder-date - '((((class color) (background light)) - (:foreground "snow4")) - (((class color) (background dark)) - (:foreground "snow3")) - (t - (:bold t))) - "Face used to highlight the date in MH-Folder buffers." - :group 'mh-folder-faces) +(defface mh-folder-date '((t (:inherit mh-folder-msg-number))) + "Date face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-deleted '((t (:inherit mh-folder-msg-number))) + "Deleted message face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-followup-face 'mh-folder-followup - "Face used to highlight Re: subject text in MH-Folder buffers.") (defface mh-folder-followup '((((class color) (background light)) (:foreground "blue3")) @@ -2608,27 +2530,19 @@ sequence." (:foreground "LightGoldenRod")) (t (:bold t))) - "Face used to highlight Re: subject text in MH-Folder buffers." - :group 'mh-folder-faces) + "\"Re:\" face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-msg-number-face 'mh-folder-msg-number - "Face used to highlight the message number in MH-Folder buffers.") (defface mh-folder-msg-number '((((class color) (background light)) (:foreground "snow4")) (((class color) (background dark)) - (:foreground "snow3")) - (t - (:bold t))) - "Face used to highlight the message number in MH-Folder buffers." - :group 'mh-folder-faces) - -(defvar mh-folder-deleted-face 'mh-folder-deleted - "Face used to highlight deleted messages in MH-Folder buffers.") -(copy-face 'mh-folder-msg-number 'mh-folder-deleted) + (:foreground "snow3"))) + "Message number face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-refiled-face 'mh-folder-refiled - "Face used to highlight refiled messages in MH-Folder buffers.") (defface mh-folder-refiled (mh-defface-compat '((((class color) (min-colors 88) (background light)) @@ -2643,13 +2557,26 @@ sequence." (:foreground "DimGray" :bold t :italic t)) (t (:bold t :italic t)))) - "Face used to highlight refiled messages in MH-Folder buffers." - :group 'mh-folder-faces) + "Refiled message face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-sent-to-me-hint '((t (:inherit mh-folder-date))) + "Fontification hint face in messages sent directly to us. +The detection of messages sent to us is governed by the scan +format `mh-scan-format-nmh' and the regular expression +`mh-scan-sent-to-me-sender-regexp'." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-sent-to-me-sender '((t (:inherit mh-folder-followup))) + "Sender face in messages sent directly to us. +The detection of messages sent to us is governed by the scan +format `mh-scan-format-nmh' and the regular expression +`mh-scan-sent-to-me-sender-regexp'." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-subject-face 'mh-folder-subject - "Face used to highlight subject text in MH-Folder buffers.") -(if (boundp 'facemenu-unlisted-faces) - (add-to-list 'facemenu-unlisted-faces "^mh-folder")) (defface mh-folder-subject '((((class color) (background light)) (:foreground "blue4")) @@ -2657,8 +2584,9 @@ sequence." (:foreground "yellow")) (t (:bold t))) - "Face used to highlight subject text in MH-Folder buffers." - :group 'mh-folder-faces) + "Subject face." + :group 'mh-faces + :group 'mh-folder) (defface mh-folder-tick '((((class color) (background dark)) @@ -2667,19 +2595,10 @@ sequence." (:background "#dddf7e")) (t (:underline t))) - "Face used to show ticked messages." - :group 'mh-folder-faces) - -(defvar mh-folder-address-face 'mh-folder-address - "Face used to highlight the address in MH-Folder buffers.") -(copy-face 'mh-folder-subject 'mh-folder-address) - -(defvar mh-folder-scan-format-face 'mh-folder-scan-format - "Face used to highlight `mh-scan-format-regexp' matches in MH-Folder buffers.") -(copy-face 'mh-folder-followup 'mh-folder-scan-format) + "Ticked message face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-to-face 'mh-folder-to - "Face used to highlight the To: string in MH-Folder buffers.") (defface mh-folder-to (mh-defface-compat '((((class color) (min-colors 88) (background light)) @@ -2694,15 +2613,10 @@ sequence." (:foreground "LightGray" :italic t)) (t (:italic t)))) - "Face used to highlight the To: string in MH-Folder buffers." - :group 'mh-folder-faces) - - - -;;; Faces Used in Searching (:group 'mh-index-faces) + "\"To:\" face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-index-folder-face 'mh-index-folder - "Face used to highlight folders in MH-Index buffers.") (defface mh-index-folder '((((class color) (background light)) (:foreground "dark green" :bold t)) @@ -2710,12 +2624,9 @@ sequence." (:foreground "indian red" :bold t)) (t (:bold t))) - "Face used to highlight folders in MH-Index buffers." - :group 'mh-index-faces) - - - -;;; Faces Used in Message Drafts (:group 'mh-letter-faces) + "Folder heading face in MH-Folder buffers created by searches." + :group 'mh-faces + :group 'mh-index) (defface mh-letter-header-field '((((class color) (background light)) @@ -2724,15 +2635,10 @@ sequence." (:background "gray10")) (t (:bold t))) - "Face used to display header fields in draft buffers." - :group 'mh-letter-faces) - - - -;;; Faces Used in Message Display (:group 'mh-show-faces) + "Editable header field value face in draft buffers." + :group 'mh-faces + :group 'mh-letter) -(defvar mh-show-cc-face 'mh-show-cc - "Face used to highlight cc: header fields.") (defface mh-show-cc (mh-defface-compat '((((class color) (min-colors 88) (background light)) @@ -2747,11 +2653,10 @@ sequence." (:foreground "DimGray" :bold t :italic t)) (t (:bold t :italic t)))) - "Face used to highlight cc: header fields." - :group 'mh-show-faces) + "Face used to highlight \"cc:\" header fields." + :group 'mh-faces + :group 'mh-show) -(defvar mh-show-date-face 'mh-show-date - "Face used to highlight the Date: header field.") (defface mh-show-date (mh-defface-compat '((((class color) (min-colors 88) (background light)) @@ -2766,11 +2671,21 @@ sequence." (:foreground "DimGray" :bold t)) (t (:bold t :underline t)))) - "Face used to highlight the Date: header field." - :group 'mh-show-faces) + "Face used to highlight \"Date:\" header fields." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-from + '((((class color) (background light)) + (:foreground "red3")) + (((class color) (background dark)) + (:foreground "cyan")) + (t + (:bold t))) + "Face used to highlight \"From:\" header fields." + :group 'mh-faces + :group 'mh-show) -(defvar mh-show-header-face 'mh-show-header - "Face used to deemphasize unspecified header fields.") (defface mh-show-header (mh-defface-compat '((((class color) (min-colors 88) (background light)) @@ -2785,46 +2700,35 @@ sequence." (:foreground "LightGray" :italic t)) (t (:italic t)))) - "Face used to deemphasize unspecified header fields." - :group 'mh-show-faces) + "Face used to deemphasize less interesting header fields." + :group 'mh-faces + :group 'mh-show) -(defvar mh-show-pgg-good-face 'mh-show-pgg-good - "Face used to highlight a good PGG signature.") -(defface mh-show-pgg-good - '((t - (:bold t :foreground "LimeGreen"))) - "Face used to highlight a good PGG signature." - :group 'mh-show-faces) - -(defvar mh-show-pgg-unknown-face 'mh-show-pgg-unknown - "Face used to highlight a PGG signature whose status is unknown. -This face is also used for a signature when the signer is -untrusted.") -(defface mh-show-pgg-unknown - '((t - (:bold t :foreground "DarkGoldenrod2"))) - "Face used to highlight a PGG signature whose status is unknown. -This face is also used for a signature when the signer is untrusted." - :group 'mh-show-faces) - -(defvar mh-show-pgg-bad-face 'mh-show-pgg-bad - "Face used to highlight a bad PGG signature.") -(defface mh-show-pgg-bad - '((t - (:bold t :foreground "DeepPink1"))) - "Face used to highlight a bad PGG signature." - :group 'mh-show-faces) +(defface mh-show-pgg-bad '((t (:bold t :foreground "DeepPink1"))) + "Bad PGG signature face." + :group 'mh-faces + :group 'mh-show) -(defface mh-show-signature - '((t - (:italic t))) - "Face used to highlight the message signature." - :group 'mh-show-faces) +(defface mh-show-pgg-good '((t (:bold t :foreground "LimeGreen"))) + "Good PGG signature face." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-pgg-unknown '((t (:bold t :foreground "DarkGoldenrod2"))) + "Unknown or untrusted PGG signature face." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-signature '((t (:italic t))) + "Signature face." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-subject '((t (:inherit mh-folder-subject))) + "Face used to highlight \"Subject:\" header fields." + :group 'mh-faces + :group 'mh-show) -(defvar mh-show-to-face 'mh-show-to - "Face used to highlight the To: header field.") -(if (boundp 'facemenu-unlisted-faces) - (add-to-list 'facemenu-unlisted-faces "^mh-show")) (defface mh-show-to '((((class color) (background light)) (:foreground "SaddleBrown")) @@ -2835,43 +2739,31 @@ This face is also used for a signature when the signer is untrusted." (((class grayscale) (background dark)) (:foreground "LightGray" :underline t)) (t (:underline t))) - "Face used to highlight the To: header field." - :group 'mh-show-faces) - -(defvar mh-show-from-face 'mh-show-from - "Face used to highlight the From: header field.") -(defface mh-show-from - '((((class color) (background light)) - (:foreground "red3")) - (((class color) (background dark)) - (:foreground "cyan")) - (t - (:bold t))) - "Face used to highlight the From: header field." - :group 'mh-show-faces) - -(defface mh-show-xface - '((t - (:foreground "black" :background "white"))) - "Face used to display the X-Face image. -The background and foreground is used in the image." - :group 'mh-show-faces) - -(defvar mh-show-subject-face 'mh-show-subject - "Face used to highlight the Subject: header field.") -(copy-face 'mh-folder-subject 'mh-show-subject) - - + "Face used to highlight \"To:\" header fields." + :group 'mh-faces + :group 'mh-show) -;;; Faces Used in Speedbar (:group 'mh-speed-faces) +(defface mh-show-xface '((t (:inherit (mh-show-from highlight)))) + "X-Face image face. +The background and foreground are used in the image." + :group 'mh-faces + :group 'mh-show) (defface mh-speedbar-folder '((((class color) (background light)) (:foreground "blue4")) (((class color) (background dark)) (:foreground "light blue"))) - "Face used for folders in the speedbar buffer." - :group 'mh-speed-faces) + "Basic folder face." + :group 'mh-faces + :group 'mh-speedbar) + +(defface mh-speedbar-folder-with-unseen-messages + '((t + (:inherit mh-speedbar-folder :bold t))) + "Folder face when folder contains unread messages." + :group 'mh-faces + :group 'mh-speedbar) (defface mh-speedbar-selected-folder '((((class color) (background light)) @@ -2880,20 +2772,111 @@ The background and foreground is used in the image." (:foreground "red1" :underline t)) (t (:underline t))) - "Face used for the current folder." - :group 'mh-speed-faces) - -(defface mh-speedbar-folder-with-unseen-messages - '((t - (:inherit mh-speedbar-folder :bold t))) - "Face used for folders in the speedbar buffer which have unread messages." - :group 'mh-speed-faces) + "Selected folder face." + :group 'mh-faces + :group 'mh-speedbar) (defface mh-speedbar-selected-folder-with-unseen-messages '((t (:inherit mh-speedbar-selected-folder :bold t))) - "Face used for the current folder when it has unread messages." - :group 'mh-speed-faces) + "Selected folder face when folder contains unread messages." + :group 'mh-faces + :group 'mh-speedbar) + +;;; XXX Temporary function for comparing old and new faces. Delete +;;; when everybody is happy. +(defvar bw-face-generation 'new) + +(defun bw-toggle-faces () + "Toggle between old and new faces." + (interactive) + (cond ((eq bw-face-generation 'new) + (message "Going from new to old...") + (bw-new-face-to-old) + (message "Going from new to old...done") + (setq bw-face-generation 'old)) + ((eq bw-face-generation 'old) + (message "Going from old to new...") + (bw-old-face-to-new) + (message "Going from old to new...done") + (setq bw-face-generation 'new)))) + +(defun bw-new-face-to-old () + "Sets old faces." + (face-spec-set 'mh-folder-body + (mh-defface-compat + '((((class color) (min-colors 88) (background light)) + (:foreground "RosyBrown")) + (((class color) (min-colors 88) (background dark)) + (:foreground "LightSalmon")) + (((class color)) + (:foreground "green")) + (((class grayscale) (background light)) + (:foreground "DimGray" :italic t)) + (((class grayscale) (background dark)) + (:foreground "LightGray" :italic t)) + (t + (:italic t))))) + + (face-spec-set 'mh-folder-msg-number + '((((class color) (background light)) + (:foreground "snow4")) + (((class color) (background dark)) + (:foreground "snow3")) + (t + (:bold t)))) + + (face-spec-set 'mh-folder-cur-msg-number + (mh-defface-compat + '((((class color) (min-colors 88) (background light)) + (:foreground "Purple")) + (((class color) (min-colors 88) (background dark)) + (:foreground "Cyan")) + (((class color)) + (:foreground "cyan" :weight bold)) + (((class grayscale) (background light)) + (:foreground "LightGray" :bold t)) + (((class grayscale) (background dark)) + (:foreground "DimGray" :bold t)) + (t + (:bold t))))) + + (face-spec-set 'mh-folder-date + '((((class color) (background light)) + (:foreground "snow4")) + (((class color) (background dark)) + (:foreground "snow3")) + (t + (:bold t)))) + + (face-spec-set 'mh-folder-msg-number + '((((class color) (background light)) + (:foreground "snow4")) + (((class color) (background dark)) + (:foreground "snow3")) + (t + (:bold t))))) + +(defun bw-old-face-to-new () + "Sets new faces." + (face-spec-set 'mh-folder-body + '((((class color)) + (:inherit mh-folder-msg-number)) + (t + (:inherit mh-folder-msg-number :italic t)))) + + (face-spec-set 'mh-folder-cur-msg-number + '((t + (:inherit mh-folder-msg-number :bold t)))) + + (face-spec-set 'mh-folder-date '((t (:inherit mh-folder-msg-number)))) + + (face-spec-set 'mh-folder-msg-number + '((((class color) (background light)) + (:foreground "snow4")) + (((class color) (background dark)) + (:foreground "snow3"))))) + ;; Local Variables: ;; indent-tabs-mode: nil diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 30034008cec..1deb465c1fe 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -95,8 +95,9 @@ (require 'easymenu) ;; Shush the byte-compiler -(defvar font-lock-auto-fontify) -(defvar font-lock-defaults) +(eval-when-compile + (defvar font-lock-auto-fontify) + (defvar font-lock-defaults)) (defconst mh-version "7.85+cvs" "Version number of MH-E.") @@ -194,7 +195,8 @@ matches the message number as in the default of \"^\\\\( *[0-9]+\\\\)[^D^0-9]\". This expression includes the leading space within the parenthesis -since it looks better to highlight it as well. This regular +since it looks better to highlight it as well. The highlighting +is done with the face `mh-folder-msg-number'. This regular expression should be correct as it is needed by non-fontification functions.") @@ -209,7 +211,8 @@ matches the message number as in the default of \"^\\\\( *[0-9]+\\\\)D\". This expression includes the leading space within the parenthesis -since it looks better to highlight it as well. This regular +since it looks better to highlight it as well. The highlighting +is done with the face `mh-folder-deleted'. This regular expression should be correct as it is needed by non-fontification functions. See also `mh-note-deleted'.") @@ -224,7 +227,8 @@ matches the message number as in the default of \"^\\\\( *[0-9]+\\\\)\\\\^\". This expression includes the leading space within the parenthesis -since it looks better to highlight it as well. This regular +since it looks better to highlight it as well. The highlighting +is done with the face `mh-folder-refiled'. This regular expression should be correct as it is needed by non-fontification functions. See also `mh-note-refiled'.") @@ -246,9 +250,10 @@ matches the message number as in the default of This expression includes the leading space and current message marker \"+\" within the parenthesis since it looks better to -highlight these items as well. This regular expression should be -correct as it is needed by non-fontification functions. See also -`mh-note-cur'.") +highlight these items as well. The highlighting is done with the +face `mh-folder-cur-msg-number'. This regular expression should +be correct as it is needed by non-fontification functions. See +also `mh-note-cur'.") (defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)" "This regular expression matches a valid date. @@ -258,8 +263,8 @@ Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain only one parenthesized expression which matches the date field as in the default of \"\\\\([0-9][0-9]/[0-9][0-9]\\\\)\"}. If this regular expression -is not correct, the date will not be highlighted. See also -`mh-scan-format-regexp'.") +is not correct, the date will not be highlighted with the face +`mh-folder-date'.") (defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)" "This regular expression specifies the recipient in messages you sent. @@ -270,8 +275,9 @@ The first is expected to match the \"To:\" that the default scan format file generates. The second is expected to match the recipient's name as in the default of \"\\\\(To:\\\\)\\\\(..............\\\\)\". If this regular -expression is not correct, the recipient will not be -highlighted.") +expression is not correct, the \"To:\" string will not be +highlighted with the face `mh-folder-to' and the recipient will +not be highlighted with the face `mh-folder-address'") (defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)" "This regular expression matches the message body fragment. @@ -280,7 +286,8 @@ Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain at least one parenthesized expression which matches the body text as in the default of \"\\\\(<<\\\\([^\\n]+\\\\)?\\\\)\". If this regular expression is -not correct, the body fragment will not be highlighted.") +not correct, the body fragment will not be highlighted with the +face `mh-folder-body'.") (defvar mh-scan-subject-regexp "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)" @@ -289,12 +296,13 @@ not correct, the body fragment will not be highlighted.") It must match from the beginning of the line. Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain at least three parenthesized expressions. -The first is expected to match the \"Re:\" string, if any. The -second matches an optional bracketed number after \"Re:\", such as -in \"Re[2]:\" (and is thus a sub-expression of the first -expression) and the third is expected to match the subject line -itself as in the default of (broken on multiple lines for -readability): +The first is expected to match the \"Re:\" string, if any, and is +highlighted with the face `mh-folder-followup'. The second +matches an optional bracketed number after \"Re:\", such as in +\"Re[2]:\" (and is thus a sub-expression of the first expression) +and the third is expected to match the subject line itself which +is highlighted with the face `mh-folder-subject'. For example, +the default (broken on multiple lines for readability) is ^ *[0-9]+........[ ]*................... \\\\([Rr][Ee]\\\\(\\\\\\=[[0-9]+\\\\]\\\\)?:\\\\s-*\\\\)* @@ -303,22 +311,22 @@ readability): This regular expression should be correct as it is needed by non-fontification functions.") -(defvar mh-scan-format-regexp - (concat "\\([bct]\\)" mh-scan-date-regexp " *\\(..................\\)") - "This regular expression matches the output of scan. +(defvar mh-scan-sent-to-me-sender-regexp + "^ *[0-9]+.\\([bct]\\).....[ ]*\\(..................\\)" + "This regular expression matches messages sent to us. Note that the default setting of `mh-folder-font-lock-keywords' -expects this expression to contain at least three parenthesized +expects this expression to contain at least two parenthesized expressions. The first should match the fontification hint (see -`mh-scan-format-nmh'), the second is found in -`mh-scan-date-regexp', and the third should match the user name +`mh-scan-format-nmh') and the second should match the user name as in the default of - \"(concat \"\\\\([bct]\\\\)\" mh-scan-date-regexp - \"*\\\\(..................\\\\)\")\". + ^ *[0-9]+.\\\\([bct]\\\\).....[ ]*\\\\(..................\\\\) -If this regular expression is not correct, the notation hints and -the sender will not be highlighted.") +If this regular expression is not correct, the notation hints +will not be highlighted with the face +`mh-mh-folder-sent-to-me-hint' and the sender will not be +highlighted with the face `mh-folder-sent-to-me-sender'.") @@ -326,31 +334,37 @@ the sender will not be highlighted.") (list ;; Folders when displaying index buffer (list "^\\+.*" - '(0 mh-index-folder-face)) + '(0 'mh-index-folder)) ;; Marked for deletion (list (concat mh-scan-deleted-msg-regexp ".*") - '(0 mh-folder-deleted-face)) + '(0 'mh-folder-deleted)) ;; Marked for refile (list (concat mh-scan-refiled-msg-regexp ".*") - '(0 mh-folder-refiled-face)) - ;;after subj - (list mh-scan-body-regexp '(1 mh-folder-body-face nil t)) + '(0 'mh-folder-refiled)) + ;; After subject + (list mh-scan-body-regexp + '(1 'mh-folder-body nil t)) + ;; Subject '(mh-folder-font-lock-subject - (1 mh-folder-followup-face append t) - (2 mh-folder-subject-face append t)) - ;;current msg + (1 'mh-folder-followup append t) + (2 'mh-folder-subject append t)) + ;; Current message number (list mh-scan-cur-msg-number-regexp - '(1 mh-folder-cur-msg-number-face)) + '(1 'mh-folder-cur-msg-number)) + ;; Message number (list mh-scan-good-msg-regexp - '(1 mh-folder-msg-number-face)) ;; Msg number - (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date + '(1 'mh-folder-msg-number)) + ;; Date + (list mh-scan-date-regexp + '(1 'mh-folder-date)) + ;; Messages from me (To:) (list mh-scan-rcpt-regexp - '(1 mh-folder-to-face) ;; To: - '(2 mh-folder-address-face)) ;; address - ;; scan font-lock name - (list mh-scan-format-regexp - '(1 mh-folder-date-face) - '(3 mh-folder-scan-format-face))) + '(1 'mh-folder-to) + '(2 'mh-folder-address)) + ;; Messages to me + (list mh-scan-sent-to-me-sender-regexp + '(1 'mh-folder-sent-to-me-hint) + '(2 'mh-folder-sent-to-me-sender))) "Keywords (regular expressions) used to fontify the MH-Folder buffer.") (defvar mh-scan-cmd-note-width 1 diff --git a/lisp/mh-e/mh-init.el b/lisp/mh-e/mh-init.el index 6b8feda8ccc..2818674afae 100644 --- a/lisp/mh-e/mh-init.el +++ b/lisp/mh-e/mh-init.el @@ -1,6 +1,6 @@ ;;; mh-init.el --- MH-E initialization -;; Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Peter S. Galbraith <psg@debian.org> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -334,7 +334,7 @@ there. Otherwise, the images directory is added to the (defun mh-defface-compat (spec) "Convert SPEC for defface if necessary to run on older platforms. -See `defface' for the spec definition. +Modifies SPEC in place and returns it. See `defface' for the spec definition. When `mh-min-colors-defined-flag' is nil, this function finds a display with a single \"class\" requirement with a \"color\" @@ -351,7 +351,8 @@ requirements." (loop for entry in spec do (when (not (eq (car entry) t)) (if (assoc 'min-colors (car entry)) - (delq (assoc 'min-colors (car entry)) (car entry))))))) + (delq (assoc 'min-colors (car entry)) (car entry)))))) + spec) (provide 'mh-init) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 4338a94381b..c028890f6a1 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -1407,14 +1407,15 @@ Parameter EL is unused." (defun mh-mime-security-button-face (info) "Return the button face to use for encrypted/signed mail based on INFO." (cond ((string-match "OK" info) ;Decrypted mail - mh-show-pgg-good-face) + 'mh-show-pgg-good) ((string-match "Failed" info) ;Decryption failed or signature invalid - mh-show-pgg-bad-face) + 'mh-show-pgg-bad) ((string-match "Undecided" info);Unprocessed mail - mh-show-pgg-unknown-face) + 'mh-show-pgg-unknown) ((string-match "Untrusted" info);Key not trusted - mh-show-pgg-unknown-face) - (t mh-show-pgg-good-face))) + 'mh-show-pgg-unknown) + (t + 'mh-show-pgg-good))) (defun mh-mime-security-press-button (handle) "Callback from security button for part HANDLE." diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index b5d97a2be05..e008c93916e 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -402,18 +402,30 @@ Argument LIMIT limits search." (eval-and-compile ;; Otherwise byte-compilation fails on `mh-show-font-lock-keywords-with-cite' (defvar mh-show-font-lock-keywords - '(("^\\(From:\\|Sender:\\)\\(.*\\)" (1 'default) (2 mh-show-from-face)) - (mh-header-to-font-lock (0 'default) (1 mh-show-to-face)) - (mh-header-cc-font-lock (0 'default) (1 mh-show-cc-face)) + '(("^\\(From:\\|Sender:\\)\\(.*\\)" + (1 'default) + (2 'mh-show-from)) + (mh-header-to-font-lock + (0 'default) + (1 'mh-show-to)) + (mh-header-cc-font-lock + (0 'default) + (1 'mh-show-cc)) ("^\\(Reply-To:\\|Return-Path:\\)\\(.*\\)$" - (1 'default) (2 mh-show-from-face)) - (mh-header-subject-font-lock (0 'default) (1 mh-show-subject-face)) + (1 'default) + (2 'mh-show-from)) + (mh-header-subject-font-lock + (0 'default) + (1 'mh-show-subject)) ("^\\(Apparently-To:\\|Newsgroups:\\)\\(.*\\)" - (1 'default) (2 mh-show-cc-face)) + (1 'default) + (2 'mh-show-cc)) ("^\\(In-reply-to\\|Date\\):\\(.*\\)$" - (1 'default) (2 mh-show-date-face)) - (mh-letter-header-font-lock (0 mh-show-header-face append t))) - "Additional expressions to highlight in MH-show mode.")) + (1 'default) + (2 'mh-show-date)) + (mh-letter-header-font-lock + (0 'mh-show-header append t))) + "Additional expressions to highlight in MH-Show buffers.")) (defvar mh-show-font-lock-keywords-with-cite (eval-when-compile @@ -432,11 +444,13 @@ Argument LIMIT limits search." (beginning-of-line) (end-of-line) (2 font-lock-constant-face nil t) (4 font-lock-comment-face nil t))))))) - "Additional expressions to highlight in MH-show mode.") + "Additional expressions to highlight in MH-Show buffers.") (defvar mh-letter-font-lock-keywords `(,@mh-show-font-lock-keywords-with-cite - (mh-font-lock-field-data (1 'mh-letter-header-field prepend t)))) + (mh-font-lock-field-data + (1 'mh-letter-header-field prepend t))) + "Additional expressions to highlight in MH-Letter buffers.") (defun mh-show-font-lock-fontify-region (beg end loudly) "Limit font-lock in `mh-show-mode' to the header. @@ -1229,6 +1243,32 @@ See also `mh-folder-mode'. (mh-do-in-xemacs (defvar default-enable-multibyte-characters)) +(defmacro mh-face-foreground-compat (face &optional frame inherit) + "Return the foreground color name of FACE, or nil if unspecified. +See documentation for `face-foreground' for a description of the +arguments FACE, FRAME, and INHERIT. + +Calls `face-foreground' correctly in older environments. Versions +of Emacs prior to version 22 lacked an INHERIT argument which +when t tells `face-foreground' to consider an inherited value for +the foreground if the face does not define one itself." + (if (>= emacs-major-version 22) + `(face-foreground ,face ,frame ,inherit) + `(face-foreground ,face ,frame))) + +(defmacro mh-face-background-compat (face &optional frame inherit) + "Return the background color name of face, or nil if unspecified. +See documentation for `back-foreground' for a description of the +arguments FACE, FRAME, and INHERIT. + +Calls `face-background' correctly in older environments. Versions +of Emacs prior to version 22 lacked an INHERIT argument which +when t tells `face-background' to consider an inherited value for +the background if the face does not define one itself." + (if (>= emacs-major-version 22) + `(face-background ,face ,frame ,inherit) + `(face-background ,face ,frame))) + (defun mh-face-display-function () "Display a Face, X-Face, or X-Image-URL header field. If more than one of these are present, then the first one found @@ -1259,9 +1299,11 @@ in this order is used." (mh-funcall-if-exists insert-image (create-image raw type t - :foreground (face-foreground 'mh-show-xface) - :background (face-background 'mh-show-xface)) - " "))) + :foreground + (mh-face-foreground-compat 'mh-show-xface nil t) + :background + (mh-face-background-compat 'mh-show-xface nil t)) + " "))) ;; XEmacs (mh-do-in-xemacs (cond diff --git a/lisp/mouse.el b/lisp/mouse.el index 186fa438b35..ef655ba836f 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -355,14 +355,21 @@ This command must be bound to a mouse click." (defun mouse-drag-window-above (window) "Return the (or a) window directly above WINDOW. That means one whose bottom edge is at the same height as WINDOW's top edge." - (let ((top (nth 1 (window-edges window))) + (let ((start-top (nth 1 (window-edges window))) + (start-left (nth 0 (window-edges window))) + (start-right (nth 2 (window-edges window))) (start-window window) above-window) (setq window (previous-window window 0)) (while (and (not above-window) (not (eq window start-window))) - (if (= (+ (window-height window) (nth 1 (window-edges window))) - top) - (setq above-window window)) + (let ((left (nth 0 (window-edges window))) + (right (nth 2 (window-edges window)))) + (when (and (= (+ (window-height window) (nth 1 (window-edges window))) + start-top) + (or (and (<= left start-left) (<= start-right right)) + (and (<= start-left left) (<= left start-right)) + (and (<= start-left right) (<= right start-right)))) + (setq above-window window))) (setq window (previous-window window))) above-window)) @@ -1025,7 +1032,11 @@ at the same position." (select-window original-window) (if (or (vectorp on-link) (stringp on-link)) (setq event (aref on-link 0)) - (setcar event 'mouse-2))) + (setcar event 'mouse-2) + ;; If this mouse click has never been done by + ;; the user, it doesn't have the necessary + ;; property to be interpreted correctly. + (put 'mouse-2 'event-kind 'mouse-click))) (push event unread-command-events)))) ;; Case where the end-event is not a cons cell (it's just a boring diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index 9925227619f..e1ae498923b 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -129,7 +129,7 @@ A value of t means there is no limit--fontify regardless of the size." 'goto-address-at-point) (define-key m (kbd "C-c RET") 'goto-address-at-point) m) - "keymap to hold goto-addr's mouse key defs under highlighted URLs.") + "Keymap to hold goto-addr's mouse key defs under highlighted URLs.") (defcustom goto-address-url-face 'bold "Face to use for URLs." @@ -242,7 +242,8 @@ address. If no e-mail address found, return nil." "Sets up goto-address functionality in the current buffer. Allows user to use mouse/keyboard command to click to go to a URL or to send e-mail. -By default, goto-address binds to mouse-2 and C-c RET. +By default, goto-address binds `goto-address-at-point' to mouse-2 and C-c RET +only on URLs and e-mail addresses. Also fontifies the buffer appropriately (see `goto-address-fontify-p' and `goto-address-highlight-p' for more information)." diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el index fc7b23ae1ba..4a3baea4f41 100644 --- a/lisp/net/webjump.el +++ b/lisp/net/webjump.el @@ -72,104 +72,184 @@ (defvar webjump-sample-sites '( - ;; FSF, not including Emacs-specific. ("GNU Project FTP Archive" . + ;; GNU FTP Mirror List from http://www.gnu.org/order/ftp.html [mirrors "ftp://ftp.gnu.org/pub/gnu/" - ;; ASIA: - "ftp://ftp.cs.titech.ac.jp" - "ftp://tron.um.u-tokyo.ac.jp/pub/GNU/prep" - "ftp://cair-archive.kaist.ac.kr/pub/gnu" - "ftp://ftp.nectec.or.th/pub/mirrors/gnu" - ;; AUSTRALIA: - "ftp://archie.au/gnu" - "ftp://archie.oz/gnu" - "ftp://archie.oz.au/gnu" - ;; AFRICA: - "ftp://ftp.sun.ac.za/pub/gnu" - ;; MIDDLE-EAST: - "ftp://ftp.technion.ac.il/pub/unsupported/gnu" - ;; EUROPE: - "ftp://irisa.irisa.fr/pub/gnu" - "ftp://ftp.univ-lyon1.fr/pub/gnu" - "ftp://ftp.mcc.ac.uk" - "ftp://unix.hensa.ac.uk/mirrors/uunet/systems/gnu" - "ftp://src.doc.ic.ac.uk/gnu" - "ftp://ftp.ieunet.ie/pub/gnu" - "ftp://ftp.eunet.ch" - "ftp://nic.switch.ch/mirror/gnu" - "ftp://ftp.informatik.rwth-aachen.de/pub/gnu" - "ftp://ftp.informatik.tu-muenchen.de" + ;; United States + "ftp://mirrors.kernel.org/gnu" + "ftp://gatekeeper.dec.com/pub/GNU/" + "ftp://ftp.keystealth.org/pub/gnu/" + "ftp://mirrors.usc.edu/pub/gnu/" + "ftp://cudlug.cudenver.edu/pub/mirrors/ftp.gnu.org/" + "ftp://ftp.cise.ufl.edu/pub/mirrors/GNU/" + "ftp://uiarchive.cso.uiuc.edu/pub/ftp/ftp.gnu.org/gnu/" + "ftp://gnu.cs.lewisu.edu/gnu/" + "ftp://ftp.in-span.net/pub/mirrors/ftp.gnu.org/" + "ftp://gnu.ms.uky.edu/pub/mirrors/gnu/" + "ftp://ftp.algx.net/pub/gnu/" + "ftp://aeneas.mit.edu/pub/gnu/" + "ftp://ftp.egr.msu.edu/pub/gnu/" + "ftp://ftp.wayne.edu/pub/gnu/" + "ftp://wuarchive.wustl.edu/mirrors/gnu/" + "ftp://gnu.teleglobe.net/ftp.gnu.org/" + "ftp://ftp.cs.columbia.edu/archives/gnu/prep/" + "ftp://ftp.ece.cornell.edu/pub/mirrors/gnu/" + "ftp://ftp.ibiblio.org/pub/mirrors/gnu/" + "ftp://ftp.cis.ohio-state.edu/mirror/gnu/" + "ftp://ftp.club.cc.cmu.edu/gnu/" + "ftp://ftp.sunsite.utk.edu/pub/gnu/ftp/" + "ftp://thales.memphis.edu/pub/gnu/" + "ftp://gnu.wwc.edu" + "ftp://ftp.twtelecom.net/pub/GNU/" + ;; Africa + "ftp://ftp.sun.ac.za/mirrorsites/ftp.gnu.org" + ;; The Americas + "ftp://ftp.unicamp.br/pub/gnu/" + "ftp://master.softaplic.com.br/pub/gnu/" + "ftp://ftp.matrix.com.br/pub/gnu/" + "ftp://ftp.pucpr.br/gnu" + "ftp://ftp.linorg.usp.br/gnu" + "ftp://ftp.cs.ubc.ca/mirror2/gnu/" + "ftp://cs.ubishops.ca/pub/ftp.gnu.org/" + "ftp://ftp.inf.utfsm.cl/pub/gnu/" + "ftp://sunsite.ulatina.ac.cr/Mirrors/GNU/" + "ftp://www.gnu.unam.mx/pub/gnu/software/" + "ftp://gnu.cem.itesm.mx/pub/mirrors/gnu.org/" + "ftp://ftp.azc.uam.mx/mirrors/gnu/" + ;; Australia + "ftp://mirror.aarnet.edu.au/pub/gnu/" + "ftp://gnu.mirror.pacific.net.au/gnu/" + ;; Asia + "ftp://ftp.cs.cuhk.edu.hk/pub/gnu/gnu/" + "ftp://sunsite.ust.hk/pub/gnu/" + "ftp://ftp.gnupilgrims.org/pub/gnu" + "ftp://www.imtech.res.in/mirror/gnuftp/" + "ftp://kambing.vlsm.org/gnu" + "ftp://ftp.cs.huji.ac.il/mirror/GNU/" + "ftp://tron.um.u-tokyo.ac.jp/pub/GNU/" + "ftp://core.ring.gr.jp/pub/GNU/" + "ftp://ftp.ring.gr.jp/pub/GNU/" + "ftp://mirrors.hbi.co.jp/gnu/" + "ftp://ftp.cs.titech.ac.jp/pub/gnu/" + "ftp://ftpmirror.hanyang.ac.kr/GNU/" + "ftp://ftp.linux.sarang.net/mirror/gnu/gnu/" + "ftp://ftp.xgate.co.kr/pub/mirror/gnu/" + "ftp://ftp://gnu.xinicks.com/" + "ftp://ftp.isu.net.sa/pub/gnu/" + "ftp://ftp.nctu.edu.tw/UNIX/gnu/" + "ftp://coda.nctu.edu.tw/UNIX/gnu/" + "ftp://ftp1.sinica.edu.tw/pub3/GNU/gnu/" + "ftp://gnu.cdpa.nsysu.edu.tw/gnu" + "ftp://ftp.nectec.or.th/pub/mirrors/gnu/" + ;; Europe + "ftp://ftp.gnu.vbs.at/" + "ftp://ftp.univie.ac.at/packages/gnu/" + "ftp://gd.tuwien.ac.at/gnu/gnusrc/" + "ftp://ftp.belnet.be/mirror/ftp.gnu.org/" + "ftp://gnu.blic.net/pub/gnu/" + "ftp://ftp.fi.muni.cz/pub/gnu/" + "ftp://ftp.dkuug.dk/pub/gnu/" + "ftp://sunsite.dk/mirrors/gnu" + "ftp://ftp.funet.fi/pub/gnu/prep/" + "ftp://ftp.irisa.fr/pub/gnu/" + "ftp://ftp.cs.univ-paris8.fr/mirrors/ftp.gnu.org/" + "ftp://ftp.cs.tu-berlin.de/pub/gnu/" + "ftp://ftp.leo.org/pub/comp/os/unix/gnu/" + "ftp://ftp.informatik.rwth-aachen.de/pub/gnu/" + "ftp://ftp.de.uu.net/pub/gnu/" + "ftp://ftp.freenet.de/pub/ftp.gnu.org/gnu/" + "ftp://ftp.cs.uni-bonn.de/pub/gnu/" + "ftp://ftp-stud.fht-esslingen.de/pub/Mirrors/ftp.gnu.org/" + "ftp://ftp.stw-bonn.de/pub/mirror/ftp.gnu.org/" + "ftp://ftp.math.uni-bremen.de/pub/gnu" + "ftp://ftp.forthnet.gr/pub/gnu/" + "ftp://ftp.ntua.gr/pub/gnu/" + "ftp://ftp.duth.gr/pub/gnu/" + "ftp://ftp.physics.auth.gr/pub/gnu/" + "ftp://ftp.esat.net/pub/gnu/" + "ftp://ftp.heanet.ie/mirrors/ftp.gnu.org" + "ftp://ftp.lugroma2.org/pub/gnu/" + "ftp://ftp.gnu.inetcosmos.org/pub/gnu/" + "ftp://ftp.digitaltrust.it/pub/gnu" + "ftp://ftp://rm.mirror.garr.it/mirrors/gnuftp" + "ftp://ftp.nluug.nl/pub/gnu/" + "ftp://ftp.mirror.nl/pub/mirror/gnu/" + "ftp://ftp.nl.uu.net/pub/gnu/" + "ftp://mirror.widexs.nl/pub/gnu/" + "ftp://ftp.easynet.nl/mirror/GNU/" "ftp://ftp.win.tue.nl/pub/gnu" - "ftp://ftp.nl.net" - "ftp://ftp.etsimo.uniovi.es/pub/gnu" - "ftp://ftp.funet.fi/pub/gnu" - "ftp://ftp.denet.dk" - "ftp://ftp.stacken.kth.se" - "ftp://isy.liu.se" - "ftp://ftp.luth.se/pub/unix/gnu" - "ftp://ftp.sunet.se/pub/gnu" - "ftp://archive.eu.net" - ;; SOUTH AMERICA: - "ftp://ftp.inf.utfsm.cl/pub/gnu" - "ftp://ftp.unicamp.br/pub/gnu" - ;; WESTERN CANADA: - "ftp://ftp.cs.ubc.ca/mirror2/gnu" - ;; USA: - "ftp://wuarchive.wustl.edu/systems/gnu" - "ftp://labrea.stanford.edu" - "ftp://ftp.digex.net/pub/gnu" - "ftp://ftp.kpc.com/pub/mirror/gnu" - "ftp://f.ms.uky.edu/pub3/gnu" - "ftp://jaguar.utah.edu/gnustuff" - "ftp://ftp.hawaii.edu/mirrors/gnu" - "ftp://uiarchive.cso.uiuc.edu/pub/gnu" - "ftp://ftp.cs.columbia.edu/archives/gnu/prep" - "ftp://gatekeeper.dec.com/pub/GNU" - "ftp://ftp.uu.net/systems/gnu"]) + "ftp://gnu.mirror.vuurwerk.net/pub/GNU/" + "ftp://gnu.kookel.org/pub/ftp.gnu.org/" + "ftp://ftp.uninett.no/pub/gnu/" + "ftp://ftp.task.gda.pl/pub/gnu/" + "ftp://sunsite.icm.edu.pl/pub/gnu/" + "ftp://ftp.man.poznan.pl/pub/gnu" + "ftp://ftp.ist.utl.pt/pub/GNU/gnu/" + "ftp://ftp.telepac.pt/pub/gnu/" + "ftp://ftp.timisoara.roedu.net/mirrors/ftp.gnu.org/pub/gnu" + "ftp://ftp.chg.ru/pub/gnu/" + "ftp://gnuftp.axitel.ru/" + "ftp://ftp.arnes.si/software/gnu/" + "ftp://ftp.etsimo.uniovi.es/pub/gnu/" + "ftp://ftp.rediris.es/pub/gnu/" + "ftp://ftp.chl.chalmers.se/pub/gnu/" + "ftp://ftp.isy.liu.se/pub/gnu/" + "ftp://ftp.luth.se/pub/unix/gnu/" + "ftp://ftp.stacken.kth.se/pub/gnu/" + "ftp://ftp.sunet.se/pub/gnu/" + "ftp://sunsite.cnlab-switch.ch/mirror/gnu/" + "ftp://ftp.ulak.net.tr/gnu/" + "ftp://ftp.gnu.org.ua" + "ftp://ftp.mcc.ac.uk/pub/gnu/" + "ftp://ftp.mirror.ac.uk/sites/ftp.gnu.org/gnu/" + "ftp://ftp.warwick.ac.uk/pub/gnu/" + "ftp://ftp.hands.com/ftp.gnu.org/" + "ftp://gnu.teleglobe.net/ftp.gnu.org/"]) ("GNU Project Home Page" . "www.gnu.org") ;; Emacs. - ("Emacs Lisp Archive" . - "ftp://ftp.emacs.org/pub/") + ("Emacs Home Page" . + "www.gnu.org/software/emacs/emacs.html") + ("Savannah Emacs page" . + "savannah.gnu.org/projects/emacs") + ("Emacs Lisp List" . + "www.damtp.cam.ac.uk/user/eglen/emacs/ell.html") + ("Emacs Wiki" . + [simple-query "www.emacswiki.org" + "www.emacswiki.org/cgi-bin/wiki/" ""]) ;; Internet search engines. - ("AltaVista" . - [simple-query - "www.altavista.digital.com" - "www.altavista.digital.com/cgi-bin/query?pg=aq&what=web&fmt=.&q=" - "&r=&d0=&d1="]) - ("Archie" . - [simple-query "hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl" - "hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl?query=" ""]) - ("Lycos" . - [simple-query "www.lycos.com" - "www.lycos.com/cgi-bin/pursuit?cat=lycos&query=" ""]) + ("Google" . + [simple-query "www.google.com" + "www.google.com/search?q=" ""]) + ("Google Groups" . + [simple-query "groups.google.com" + "groups.google.com/groups?q=" ""]) ("Yahoo" . - [simple-query "www.yahoo.com" "search.yahoo.com/bin/search?p=" ""]) + [simple-query "www.yahoo.com" "search.yahoo.com/search?p=" ""]) + ("Yahoo: Reference" . "www.yahoo.com/Reference/") ;; Misc. general interest. ("Interactive Weather Information Network" . webjump-to-iwin) ("Usenet FAQs" . - [simple-query "www.cis.ohio-state.edu/hypertext/faq/usenet/FAQ-List.html" - "www.cis.ohio-state.edu/htbin/search-usenet-faqs/form?find=" - ""]) + "www.faqs.org/faqs/") ("RTFM Usenet FAQs by Group" . "ftp://rtfm.mit.edu/pub/usenet-by-group/") ("RTFM Usenet FAQs by Hierachy" . "ftp://rtfm.mit.edu/pub/usenet-by-hierarchy/") ("X Consortium Archive" . "ftp.x.org") - ("Yahoo: Reference" . "www.yahoo.com/Reference/") ;; Computer social issues, privacy, professionalism. ("Association for Computing Machinery" . "www.acm.org") - ("Computer Professionals for Social Responsibility" . "www.cpsr.org/dox/") + ("Computer Professionals for Social Responsibility" . "www.cpsr.org") ("Electronic Frontier Foundation" . "www.eff.org") ("IEEE Computer Society" . "www.computer.org") ("Risks Digest" . webjump-to-risks) - ;; Fun. - ("Bastard Operator from Hell" . "www.replay.com/bofh/") + ;; More. + ("Supplemental Web site list for webjump" . + "www.neilvandyke.org/webjump/") ) "Sample hotlist for WebJump. See the documentation for the `webjump' diff --git a/lisp/paren.el b/lisp/paren.el index f5327c3b344..8b5a134d2d4 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -72,8 +72,8 @@ otherwise)." :group 'paren-showing :version "20.3") -(defgroup paren-showing-faces () - "Group for faces of Show Paren mode" +(defgroup paren-showing-faces nil + "Group for faces of Show Paren mode." :group 'paren-showing :group 'faces :version "22.1") @@ -88,7 +88,7 @@ otherwise)." (t :background "gray")) "Show Paren mode face used for a matching paren." - :group 'show-paren-faces) + :group 'paren-showing-faces) ;; backward-compatibility alias (put 'show-paren-match-face 'face-alias 'show-paren-match) @@ -96,7 +96,7 @@ otherwise)." '((((class color)) (:foreground "white" :background "purple")) (t (:inverse-video t))) "Show Paren mode face used for a mismatching paren." - :group 'show-paren-faces) + :group 'paren-showing-faces) ;; backward-compatibility alias (put 'show-paren-mismatch-face 'face-alias 'show-paren-mismatch) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index b237dd9a598..9de0a24f09e 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -72,7 +72,9 @@ (eval-after-load "font-lock" '(if (and (not (featurep 'cc-fix)) ; only load the file once. (let (font-lock-keywords) - (font-lock-compile-keywords '("\\<\\>")) + (condition-case nil + (font-lock-compile-keywords '("\\<\\>")) + (error nil)) font-lock-keywords)) ; did the previous call foul this up? (load "cc-fix"))) @@ -83,7 +85,9 @@ (progn (require 'font-lock) (let (font-lock-keywords) - (font-lock-compile-keywords '("\\<\\>")) + (condition-case nil + (font-lock-compile-keywords '("\\<\\>")) + (error nil)) font-lock-keywords))) (cc-load "cc-fix"))) diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el index cdc557c7274..4c271113b72 100644 --- a/lisp/progmodes/delphi.el +++ b/lisp/progmodes/delphi.el @@ -177,7 +177,7 @@ differs from the default." (defcustom delphi-other-face nil "*Face used to color everything else." - :type '(choice face (const nil)) + :type '(choice (const :tag "None" nil) face) :group 'delphi) (defconst delphi-directives diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 9ceee6f6920..6f5d0855e19 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -516,15 +516,11 @@ instead of reading master file from disk." (defun flymake-copy-buffer-to-temp-buffer (buffer) "Copy contents of BUFFER into newly created temp buffer." - (let ((contents nil) - (temp-buffer nil)) - (with-current-buffer buffer - (setq contents (buffer-string)) - - (setq temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (buffer-name buffer))))) - (set-buffer temp-buffer) - (insert contents)) - temp-buffer)) + (with-current-buffer + (get-buffer-create (generate-new-buffer-name + (concat "flymake:" (buffer-name buffer)))) + (insert-buffer-substring buffer) + (current-buffer))) (defun flymake-check-include (source-file-name inc-path inc-name include-dirs) "Check if SOURCE-FILE-NAME can be found in include path. @@ -613,7 +609,8 @@ It's flymake process filter." (flymake-log 3 "received %d byte(s) of output from process %d" (length output) pid) (when source-buffer - (flymake-parse-output-and-residual source-buffer output)))) + (with-current-buffer source-buffer + (flymake-parse-output-and-residual output))))) (defun flymake-process-sentinel (process event) "Sentinel for syntax check buffers." @@ -636,8 +633,8 @@ It's flymake process filter." (when source-buffer (with-current-buffer source-buffer - (flymake-parse-residual source-buffer) - (flymake-post-syntax-check source-buffer exit-status command) + (flymake-parse-residual) + (flymake-post-syntax-check exit-status command) (setq flymake-is-running nil)))) (error (let ((err-str (format "Error in process sentinel for buffer %s: %s" @@ -646,60 +643,51 @@ It's flymake process filter." (with-current-buffer source-buffer (setq flymake-is-running nil)))))))) -(defun flymake-post-syntax-check (source-buffer exit-status command) - (with-current-buffer source-buffer - (setq flymake-err-info flymake-new-err-info) - (setq flymake-new-err-info nil) - (setq flymake-err-info - (flymake-fix-line-numbers - flymake-err-info 1 (flymake-count-lines source-buffer)))) - (flymake-delete-own-overlays source-buffer) - (flymake-highlight-err-lines - source-buffer (with-current-buffer source-buffer flymake-err-info)) +(defun flymake-post-syntax-check (exit-status command) + (setq flymake-err-info flymake-new-err-info) + (setq flymake-new-err-info nil) + (setq flymake-err-info + (flymake-fix-line-numbers + flymake-err-info 1 (flymake-count-lines))) + (flymake-delete-own-overlays) + (flymake-highlight-err-lines flymake-err-info) (let (err-count warn-count) - (with-current-buffer source-buffer - (setq err-count (flymake-get-err-count flymake-err-info "e")) - (setq warn-count (flymake-get-err-count flymake-err-info "w")) - (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)" - (buffer-name source-buffer) err-count warn-count + (setq err-count (flymake-get-err-count flymake-err-info "e")) + (setq warn-count (flymake-get-err-count flymake-err-info "w")) + (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)" + (buffer-name) err-count warn-count (- (flymake-float-time) flymake-check-start-time)) - (setq flymake-check-start-time nil)) + (setq flymake-check-start-time nil) (if (and (equal 0 err-count) (equal 0 warn-count)) (if (equal 0 exit-status) - (flymake-report-status source-buffer "" "") ; PASSED - (if (not (with-current-buffer source-buffer - flymake-check-was-interrupted)) - (flymake-report-fatal-status (current-buffer) "CFGERR" + (flymake-report-status "" "") ; PASSED + (if (not flymake-check-was-interrupted) + (flymake-report-fatal-status "CFGERR" (format "Configuration error has occured while running %s" command)) - (flymake-report-status source-buffer nil ""))) ; "STOPPED" - (flymake-report-status source-buffer (format "%d/%d" err-count warn-count) "")))) + (flymake-report-status nil ""))) ; "STOPPED" + (flymake-report-status (format "%d/%d" err-count warn-count) "")))) -(defun flymake-parse-output-and-residual (source-buffer output) +(defun flymake-parse-output-and-residual (output) "Split OUTPUT into lines, merge in residual if necessary." - (with-current-buffer source-buffer - (let* ((buffer-residual flymake-output-residual) - (total-output (if buffer-residual (concat buffer-residual output) output)) - (lines-and-residual (flymake-split-output total-output)) - (lines (nth 0 lines-and-residual)) - (new-residual (nth 1 lines-and-residual))) - (with-current-buffer source-buffer - (setq flymake-output-residual new-residual) - (setq flymake-new-err-info - (flymake-parse-err-lines - flymake-new-err-info - source-buffer lines)))))) - -(defun flymake-parse-residual (source-buffer) + (let* ((buffer-residual flymake-output-residual) + (total-output (if buffer-residual (concat buffer-residual output) output)) + (lines-and-residual (flymake-split-output total-output)) + (lines (nth 0 lines-and-residual)) + (new-residual (nth 1 lines-and-residual))) + (setq flymake-output-residual new-residual) + (setq flymake-new-err-info + (flymake-parse-err-lines + flymake-new-err-info lines)))) + +(defun flymake-parse-residual () "Parse residual if it's non empty." - (with-current-buffer source-buffer - (when flymake-output-residual - (setq flymake-new-err-info - (flymake-parse-err-lines - flymake-new-err-info - source-buffer - (list flymake-output-residual))) - (setq flymake-output-residual nil)))) + (when flymake-output-residual + (setq flymake-new-err-info + (flymake-parse-err-lines + flymake-new-err-info + (list flymake-output-residual))) + (setq flymake-output-residual nil))) (defvar flymake-err-info nil "Sorted list of line numbers and lists of err info in the form (file, err-text).") @@ -803,16 +791,11 @@ line number outside the file being compiled." (setq count (1- count)))) err-info-list) -(defun flymake-highlight-err-lines (buffer err-info-list) +(defun flymake-highlight-err-lines (err-info-list) "Highlight error lines in BUFFER using info from ERR-INFO-LIST." - (with-current-buffer buffer - (save-excursion - (let* ((idx 0) - (count (length err-info-list))) - (while (< idx count) - (flymake-highlight-line (car (nth idx err-info-list)) - (nth 1 (nth idx err-info-list))) - (setq idx (1+ idx))))))) + (save-excursion + (dolist (err err-info-list) + (flymake-highlight-line (car err) (nth 1 err))))) (defun flymake-overlay-p (ov) "Determine whether overlay OV was created by flymake." @@ -831,16 +814,13 @@ line number outside the file being compiled." ov) (flymake-log 3 "created an overlay at (%d-%d)" beg end))) -(defun flymake-delete-own-overlays (buffer) +(defun flymake-delete-own-overlays () "Delete all flymake overlays in BUFFER." - (with-current-buffer buffer - (let ((ov (overlays-in (point-min) (point-max)))) - (while (consp ov) - (when (flymake-overlay-p (car ov)) - (delete-overlay (car ov)) - ;;+(flymake-log 3 "deleted overlay %s" ov) - ) - (setq ov (cdr ov)))))) + (dolist (ol (overlays-in (point-min) (point-max))) + (when (flymake-overlay-p ol) + (delete-overlay ol) + ;;+(flymake-log 3 "deleted overlay %s" ol) + ))) (defun flymake-region-has-flymake-overlays (beg end) "Check if region specified by BEG and END has overlay. @@ -905,19 +885,19 @@ Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." (flymake-make-overlay beg end tooltip-text face nil))) -(defun flymake-parse-err-lines (err-info-list source-buffer lines) +(defun flymake-parse-err-lines (err-info-list lines) "Parse err LINES, store info in ERR-INFO-LIST." (let* ((count (length lines)) (idx 0) (line-err-info nil) (real-file-name nil) - (source-file-name (buffer-file-name source-buffer)) + (source-file-name buffer-file-name) (get-real-file-name-f (flymake-get-real-file-name-function source-file-name))) (while (< idx count) (setq line-err-info (flymake-parse-line (nth idx lines))) (when line-err-info - (setq real-file-name (funcall get-real-file-name-f source-buffer (flymake-ler-get-file line-err-info))) + (setq real-file-name (funcall get-real-file-name-f (current-buffer) (flymake-ler-get-file line-err-info))) (setq line-err-info (flymake-ler-set-full-file line-err-info real-file-name)) (if (flymake-same-files real-file-name source-file-name) @@ -1147,9 +1127,9 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (let* ((include-dirs (append '(".") (flymake-get-project-include-dirs base-dir) (flymake-get-system-include-dirs)))) include-dirs)) -(defun flymake-restore-formatting (source-buffer) - "Remove any formatting made by flymake." - ) +;; (defun flymake-restore-formatting () +;; "Remove any formatting made by flymake." +;; ) (defun flymake-get-program-dir (buffer) "Get dir to start program in." @@ -1176,38 +1156,36 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." :group 'flymake :type 'boolean) -(defun flymake-start-syntax-check (buffer) - "Start syntax checking for buffer BUFFER." - (unless (bufferp buffer) - (error "Expected a buffer")) - (with-current-buffer buffer - (flymake-log 3 "flymake is running: %s" flymake-is-running) - (when (and (not flymake-is-running) - (flymake-can-syntax-check-file (buffer-file-name buffer))) - (when (or (not flymake-compilation-prevents-syntax-check) - (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP") - (flymake-clear-buildfile-cache) - (flymake-clear-project-include-dirs-cache) - - (setq flymake-check-was-interrupted nil) - (setq flymake-buffer-data (flymake-makehash 'equal)) - - (let* ((source-file-name (buffer-file-name buffer)) - (init-f (flymake-get-init-function source-file-name)) - (cleanup-f (flymake-get-cleanup-function source-file-name)) - (cmd-and-args (funcall init-f buffer)) - (cmd (nth 0 cmd-and-args)) - (args (nth 1 cmd-and-args)) - (dir (nth 2 cmd-and-args))) - (if (not cmd-and-args) - (progn - (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name) - (funcall cleanup-f buffer)) - (progn - (setq flymake-last-change-time nil) - (flymake-start-syntax-check-process buffer cmd args dir)))))))) - -(defun flymake-start-syntax-check-process (buffer cmd args dir) +(defun flymake-start-syntax-check () + "Start syntax checking for current buffer." + (interactive) + (flymake-log 3 "flymake is running: %s" flymake-is-running) + (when (and (not flymake-is-running) + (flymake-can-syntax-check-file buffer-file-name)) + (when (or (not flymake-compilation-prevents-syntax-check) + (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP") + (flymake-clear-buildfile-cache) + (flymake-clear-project-include-dirs-cache) + + (setq flymake-check-was-interrupted nil) + (setq flymake-buffer-data (flymake-makehash 'equal)) + + (let* ((source-file-name buffer-file-name) + (init-f (flymake-get-init-function source-file-name)) + (cleanup-f (flymake-get-cleanup-function source-file-name)) + (cmd-and-args (funcall init-f (current-buffer))) + (cmd (nth 0 cmd-and-args)) + (args (nth 1 cmd-and-args)) + (dir (nth 2 cmd-and-args))) + (if (not cmd-and-args) + (progn + (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name) + (funcall cleanup-f (current-buffer))) + (progn + (setq flymake-last-change-time nil) + (flymake-start-syntax-check-process cmd args dir))))))) + +(defun flymake-start-syntax-check-process (cmd args dir) "Start syntax check process." (let* ((process nil)) (condition-case err @@ -1219,25 +1197,24 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (set-process-sentinel process 'flymake-process-sentinel) (set-process-filter process 'flymake-process-filter) - (flymake-reg-names (process-id process) (buffer-name buffer)) + (flymake-reg-names (process-id process) (buffer-name)) - (with-current-buffer buffer - (setq flymake-is-running t) - (setq flymake-last-change-time nil) - (setq flymake-check-start-time (flymake-float-time))) + (setq flymake-is-running t) + (setq flymake-last-change-time nil) + (setq flymake-check-start-time (flymake-float-time)) - (flymake-report-status buffer nil "*") + (flymake-report-status nil "*") (flymake-log 2 "started process %d, command=%s, dir=%s" (process-id process) (process-command process) default-directory) process) (error (let* ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s" cmd args (error-message-string err))) - (source-file-name (buffer-file-name buffer)) + (source-file-name buffer-file-name) (cleanup-f (flymake-get-cleanup-function source-file-name))) (flymake-log 0 err-str) - (funcall cleanup-f buffer) - (flymake-report-fatal-status buffer "PROCERR" err-str)))))) + (funcall cleanup-f (current-buffer)) + (flymake-report-fatal-status "PROCERR" err-str)))))) (defun flymake-kill-process (pid &optional rest) "Kill process PID." @@ -1304,12 +1281,7 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (setq flymake-last-change-time nil) (flymake-log 3 "starting syntax check as more than 1 second passed since last change") - (flymake-start-syntax-check buffer))))) - -(defun flymake-start-syntax-check-for-current-buffer () - "Run `flymake-start-syntax-check' for current buffer if it isn't already running." - (interactive) - (flymake-start-syntax-check (current-buffer))) + (flymake-start-syntax-check))))) (defun flymake-current-line-no () "Return number of current line in current buffer." @@ -1318,10 +1290,9 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (end (if (= (point) (point-max)) (point) (1+ (point))))) (count-lines beg end))) -(defun flymake-count-lines (buffer) +(defun flymake-count-lines () "Return number of lines in buffer BUFFER." - (with-current-buffer buffer - (count-lines (point-min) (point-max)))) + (count-lines (point-min) (point-max))) (defun flymake-get-point-pixel-pos () "Return point position in pixels: (x, y)." @@ -1346,7 +1317,6 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (line-err-info-list (nth 0 (flymake-find-err-info flymake-err-info line-no))) (menu-data (flymake-make-err-menu-data line-no line-err-info-list)) (choice nil) - (mouse-pos (flymake-get-point-pixel-pos)) (menu-pos (list (flymake-get-point-pixel-pos) (selected-window)))) (if menu-data (progn @@ -1402,20 +1372,18 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (make-variable-buffer-local 'flymake-mode-line-status) -(defun flymake-report-status (buffer e-w &optional status) +(defun flymake-report-status (e-w &optional status) "Show status in mode line." - (when (bufferp buffer) - (with-current-buffer buffer - (when e-w - (setq flymake-mode-line-e-w e-w)) - (when status - (setq flymake-mode-line-status status)) - (let* ((mode-line " Flymake")) - (when (> (length flymake-mode-line-e-w) 0) - (setq mode-line (concat mode-line ":" flymake-mode-line-e-w))) - (setq mode-line (concat mode-line flymake-mode-line-status)) - (setq flymake-mode-line mode-line) - (force-mode-line-update))))) + (when e-w + (setq flymake-mode-line-e-w e-w)) + (when status + (setq flymake-mode-line-status status)) + (let* ((mode-line " Flymake")) + (when (> (length flymake-mode-line-e-w) 0) + (setq mode-line (concat mode-line ":" flymake-mode-line-e-w))) + (setq mode-line (concat mode-line flymake-mode-line-status)) + (setq flymake-mode-line mode-line) + (force-mode-line-update))) (defun flymake-display-warning (warning) "Display a warning to user." @@ -1426,15 +1394,14 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." :group 'flymake :type 'boolean) -(defun flymake-report-fatal-status (buffer status warning) +(defun flymake-report-fatal-status (status warning) "Display a warning and switch flymake mode off." (when flymake-gui-warnings-enabled (flymake-display-warning (format "Flymake: %s. Flymake will be switched OFF" warning)) ) - (with-current-buffer buffer - (flymake-mode 0) - (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" - (buffer-name buffer) status warning))) + (flymake-mode 0) + (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" + (buffer-name) status warning)) (defcustom flymake-start-syntax-check-on-find-file t "Start syntax check on find file." @@ -1458,13 +1425,13 @@ With arg, turn Flymake mode on if and only if arg is positive." (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) ;;+(add-hook 'find-file-hook 'flymake-find-file-hook) - (flymake-report-status (current-buffer) "" "") + (flymake-report-status "" "") (setq flymake-timer (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) (when flymake-start-syntax-check-on-find-file - (flymake-start-syntax-check-for-current-buffer)))) + (flymake-start-syntax-check)))) ;; Turning the mode OFF. (t @@ -1473,7 +1440,7 @@ With arg, turn Flymake mode on if and only if arg is positive." (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t) ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t) - (flymake-delete-own-overlays (current-buffer)) + (flymake-delete-own-overlays) (when flymake-timer (cancel-timer flymake-timer) @@ -1504,14 +1471,14 @@ With arg, turn Flymake mode on if and only if arg is positive." (let((new-text (buffer-substring start stop))) (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) (flymake-log 3 "starting syntax check as new-line has been seen") - (flymake-start-syntax-check-for-current-buffer)) + (flymake-start-syntax-check)) (setq flymake-last-change-time (flymake-float-time)))) (defun flymake-after-save-hook () (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved? (progn (flymake-log 3 "starting syntax check as buffer was saved") - (flymake-start-syntax-check-for-current-buffer)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) + (flymake-start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) (defun flymake-kill-buffer-hook () (when flymake-timer @@ -1521,7 +1488,7 @@ With arg, turn Flymake mode on if and only if arg is positive." (defun flymake-find-file-hook () ;;+(when flymake-start-syntax-check-on-find-file ;;+ (flymake-log 3 "starting syntax check on file open") - ;;+ (flymake-start-syntax-check-for-current-buffer) + ;;+ (flymake-start-syntax-check) ;;+) (when (and (not (local-variable-p 'flymake-mode (current-buffer))) (flymake-can-syntax-check-file buffer-file-name)) @@ -1728,7 +1695,8 @@ Return full-name. Names are real, not patched." (if (not buildfile-dir) (progn (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name) - (flymake-report-fatal-status buffer "NOMK" (format "No buildfile (%s) found for %s" buildfile-name source-file-name)) + (with-current-buffer buffer + (flymake-report-fatal-status "NOMK" (format "No buildfile (%s) found for %s" buildfile-name source-file-name))) ) (progn (flymake-set-buffer-value buffer "base-dir" buildfile-dir))) @@ -1748,7 +1716,9 @@ Return full-name. Names are real, not patched." (if (not master-and-temp-master) (progn (flymake-log 1 "cannot find master file for %s" source-file-name) - (flymake-report-status buffer "!" "") ; NOMASTER + (when (bufferp buffer) + (with-current-buffer buffer + (flymake-report-status "!" ""))) ; NOMASTER ) (progn (setq master-file-name (nth 0 master-and-temp-master)) diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index 18f744e81c8..d19f636ff93 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -82,7 +82,7 @@ For example, you can set `glasses-separator' to an empty string and `glasses-face' to `bold'. Then unreadable identifiers will have no separators, but will have their capitals in bold." :group 'glasses - :type '(choice face (const nil)) + :type '(choice (const :tag "None" nil) face) :set 'glasses-custom-set :initialize 'custom-initialize-default) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index a9ccdf38442..e99262dd670 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -2735,6 +2735,7 @@ Obeying it means displaying in another window the specified file and line." (window (and buffer (or (get-buffer-window buffer) (display-buffer buffer)))) (pos)) + (message "%s %s" (current-buffer) buffer) (if buffer (progn (with-current-buffer buffer @@ -2750,7 +2751,15 @@ Obeying it means displaying in another window the specified file and line." (setq pos (point)) (or gud-overlay-arrow-position (setq gud-overlay-arrow-position (make-marker))) - (set-marker gud-overlay-arrow-position (point) (current-buffer))) + (set-marker gud-overlay-arrow-position (point) (current-buffer)) + ;; If they turned on hl-line, move the hl-line highlight to + ;; the arrow's line. + (when (featurep 'hl-line) + (cond + (global-hl-line-mode + (global-hl-line-highlight)) + ((and hl-line-mode hl-line-sticky-flag) + (hl-line-highlight))))) (cond ((or (< pos (point-min)) (> pos (point-max))) (widen) (goto-char pos)))) diff --git a/lisp/subr.el b/lisp/subr.el index c03fa3be5a0..a3e696d0e95 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -42,17 +42,15 @@ Each element of this list holds the arguments to one call to `defcustom'.") (defalias 'not 'null) (defmacro noreturn (form) - "Evaluates FORM, with the expectation that the evaluation will signal an error -instead of returning to its caller. If FORM does return, an error is -signaled." + "Evaluate FORM, expecting it not to return. +If FORM does return, signal an error." `(prog1 ,form (error "Form marked with `noreturn' did return"))) (defmacro 1value (form) - "Evaluates FORM, with the expectation that the same value will be returned -from all evaluations of FORM. This is the global do-nothing -version of `1value'. There is also `testcover-1value' that -complains if FORM ever does return differing values." + "Evaluate FORM, expecting a constant return value. +This is the global do-nothing version. There is also `testcover-1value' +that complains if FORM ever does return differing values." form) (defmacro lambda (&rest cdr) @@ -1686,7 +1684,7 @@ This finishes the change group by reverting all of its changes." (when (and (consp elt) (not (eq elt (last pending-undo-list)))) (error "Undoing to some unrelated state")) ;; Undo it all. - (while pending-undo-list (undo-more 1)) + (while (listp pending-undo-list) (undo-more 1)) ;; Reset the modified cons cell ELT to its original content. (when (consp elt) (setcar elt old-car) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 161b5fbc126..10b2ca206e9 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -853,7 +853,7 @@ The following is a complex example, see http://link.aps.org/linkfaq.html. :group 'bibtex :type 'boolean) -;; `bibtex-font-lock-keywords' is a user option as well, but since the +;; `bibtex-font-lock-keywords' is a user option, too. But since the ;; patterns used to define this variable are defined in a later ;; section of this file, it is defined later. @@ -1091,7 +1091,7 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") "Regexp matching the name of a BibTeX field.") (defconst bibtex-name-part - (concat ",[ \t\n]*\\(" bibtex-field-name "\\)[ \t\n]*=") + (concat ",[ \t\n]*\\(" bibtex-field-name "\\)") "Regexp matching the name part of a BibTeX field.") (defconst bibtex-reference-key "[][[:alnum:].:;?!`'/*@+|()<>&_^$-]+" @@ -1105,16 +1105,6 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") (regexp-opt (mapcar 'car bibtex-entry-field-alist)) "\\)") "Regexp matching the name of a BibTeX entry.") -(defvar bibtex-entry-type-whitespace - (concat "[ \t]*" bibtex-entry-type) - "Regexp matching the name of a BibTeX entry preceded by whitespace.") - -(defvar bibtex-entry-type-str - (concat "@[ \t]*\\(?:" - (regexp-opt (append '("String") - (mapcar 'car bibtex-entry-field-alist))) "\\)") - "Regexp matching the name of a BibTeX entry (including @String).") - (defvar bibtex-entry-head (concat "^[ \t]*\\(" bibtex-entry-type @@ -1132,15 +1122,18 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") bibtex-reference-key "\\)?") "Regexp matching the header line of any BibTeX entry (possibly without key).") +(defvar bibtex-any-valid-entry-type + (concat "^[ \t]*@[ \t]*\\(?:" + (regexp-opt (append '("String" "Preamble") + (mapcar 'car bibtex-entry-field-alist))) "\\)") + "Regexp matching any valid BibTeX entry (including String and Preamble).") + (defconst bibtex-type-in-head 1 "Regexp subexpression number of the type part in `bibtex-entry-head'.") (defconst bibtex-key-in-head 2 "Regexp subexpression number of the key part in `bibtex-entry-head'.") -(defconst bibtex-empty-field-re "\\`\\(\"\"\\|{}\\)\\'" - "Regexp matching the text part (as a string) of an empty field.") - (defconst bibtex-string-type "^[ \t]*\\(@[ \t]*String\\)[ \t]*[({][ \t\n]*" "Regexp matching the name of a BibTeX String entry.") @@ -1148,8 +1141,9 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") (concat bibtex-string-type "\\(" bibtex-reference-key "\\)?") "Regexp matching the header line of a BibTeX String entry.") -(defconst bibtex-preamble-prefix "[ \t]*@[ \t]*Preamble[ \t]*" - "Regexp matching the prefix part of a preamble.") +(defconst bibtex-preamble-prefix + "[ \t]*\\(@[ \t]*Preamble\\)[ \t]*[({][ \t\n]*" + "Regexp matching the prefix part of a BibTeX Preamble entry.") (defconst bibtex-font-lock-syntactic-keywords `((,(concat "^[ \t]*\\(" (substring bibtex-comment-start 0 1) "\\)" @@ -1229,12 +1223,9 @@ very first character of the match, the actual starting position of the name part and end position of the match. Move point to end of field name. If `bibtex-autoadd-commas' is non-nil add missing comma at end of preceding BibTeX field as necessary." - (cond ((looking-at ",[ \t\n]*") - (let ((start (point))) - (goto-char (match-end 0)) - (when (looking-at bibtex-field-name) - (goto-char (match-end 0)) - (list start (match-beginning 0) (match-end 0))))) + (cond ((looking-at bibtex-name-part) + (goto-char (match-end 0)) + (list (match-beginning 0) (match-beginning 1) (match-end 0))) ;; Maybe add a missing comma. ((and bibtex-autoadd-commas (looking-at (concat "[ \t\n]*\\(?:" bibtex-field-name @@ -1334,60 +1325,71 @@ the boundaries of the name and text parts of the field. Do not move point." "Search forward to find a BibTeX field of name NAME. If a syntactically correct field is found, return a pair containing the boundaries of the name and text parts of the field. The search -is limited by optional arg BOUND or if nil by the end of the current -entry. Do not move point." +is limited by optional arg BOUND. If BOUND is t the search is limited +by the end of the current entry. Do not move point." (save-match-data (save-excursion - (if bound - ;; If the search is bounded we need not worry we could overshoot. - ;; This is indeed the case when `bibtex-search-forward-field' is - ;; called many times. So we optimize this part of this function. - (let ((name-part (concat ",[ \t\n]*\\(" name "\\)[ \t\n]*=[ \t\n]*")) - (case-fold-search t) left right) - (while (and (not right) - (re-search-forward name-part bound t)) - (setq left (list (match-beginning 0) (match-beginning 1) - (match-end 1)) - ;; Don't worry that the field text could be past bound. - right (bibtex-parse-field-text))) - (if right (cons left right))) - (let ((regexp (concat bibtex-name-part "\\|" - bibtex-any-entry-maybe-empty-head)) - (case-fold-search t) bounds) - (catch 'done - (if (looking-at "[ \t]*@") (goto-char (match-end 0))) - (while (and (not bounds) - (re-search-forward regexp nil t)) - (if (match-beginning 2) - ;; We found a new entry - (throw 'done nil) - ;; We found a field - (goto-char (match-beginning 0)) - (setq bounds (bibtex-parse-field)))) - ;; Step through all fields so that we cannot overshoot. - (while bounds - (goto-char (bibtex-start-of-name-in-field bounds)) - (if (looking-at name) (throw 'done bounds)) - (goto-char (bibtex-end-of-field bounds)) - (setq bounds (bibtex-parse-field))))))))) + (if (eq bound t) + (let ((regexp (concat bibtex-name-part "[ \t\n]*=\\|" + bibtex-any-entry-maybe-empty-head)) + (case-fold-search t) bounds) + (catch 'done + (if (looking-at "[ \t]*@") (goto-char (match-end 0))) + (while (and (not bounds) + (re-search-forward regexp nil t)) + (if (match-beginning 2) + ;; We found a new entry + (throw 'done nil) + ;; We found a field + (goto-char (match-beginning 0)) + (setq bounds (bibtex-parse-field)))) + ;; Step through all fields so that we cannot overshoot. + (while bounds + (goto-char (bibtex-start-of-name-in-field bounds)) + (if (looking-at name) (throw 'done bounds)) + (goto-char (bibtex-end-of-field bounds)) + (setq bounds (bibtex-parse-field))))) + ;; Bounded search or bound is nil (i.e. we cannot overshoot). + ;; Indeed, the search is bounded when `bibtex-search-forward-field' + ;; is called many times. So we optimize this part of this function. + (let ((name-part (concat ",[ \t\n]*\\(" name "\\)[ \t\n]*=[ \t\n]*")) + (case-fold-search t) left right) + (while (and (not right) + (re-search-forward name-part bound t)) + (setq left (list (match-beginning 0) (match-beginning 1) + (match-end 1)) + ;; Don't worry that the field text could be past bound. + right (bibtex-parse-field-text))) + (if right (cons left right))))))) (defun bibtex-search-backward-field (name &optional bound) "Search backward to find a BibTeX field of name NAME. If a syntactically correct field is found, return a pair containing the boundaries of the name and text parts of the field. The search -is limited by the optional arg BOUND. If BOUND is nil the search is +is limited by the optional arg BOUND. If BOUND is t the search is limited by the beginning of the current entry. Do not move point." (save-match-data - (save-excursion - (let ((name-part (concat ",[ \t\n]*\\(?:" name "\\)[ \t\n]*=")) - (case-fold-search t) - bounds) - (unless bound (setq bound (save-excursion (bibtex-beginning-of-entry)))) - (while (and (not bounds) - (search-backward "," bound t) - (looking-at name-part)) - (setq bounds (bibtex-parse-field))) - bounds)))) + (if (eq bound t) + (setq bound (save-excursion (bibtex-beginning-of-entry)))) + (let ((name-part (concat ",[ \t\n]*\\(" name "\\)[ \t\n]*=[ \t\n]*")) + (case-fold-search t) left right) + (save-excursion + ;; the parsing functions are not designed for parsing backwards :-( + (when (search-backward "," bound t) + (or (save-excursion + (when (looking-at name-part) + (setq left (list (match-beginning 0) (match-beginning 1) + (match-end 1))) + (goto-char (match-end 0)) + (setq right (bibtex-parse-field-text)))) + (while (and (not right) + (re-search-backward name-part bound t)) + (setq left (list (match-beginning 0) (match-beginning 1) + (match-end 1))) + (save-excursion + (goto-char (match-end 0)) + (setq right (bibtex-parse-field-text))))) + (if right (cons left right))))))) (defun bibtex-name-in-field (bounds &optional remove-opt-alt) "Get content of name in BibTeX field defined via BOUNDS. @@ -1407,25 +1409,22 @@ by removing field delimiters and concatenating the resulting string. If `bibtex-expand-strings' is non-nil, also expand BibTeX strings." (if content (save-excursion + (goto-char (bibtex-start-of-text-in-field bounds)) (let ((epoint (bibtex-end-of-text-in-field bounds)) - content opoint temp) - (goto-char (bibtex-start-of-text-in-field bounds)) + content opoint) (while (< (setq opoint (point)) epoint) - (cond ((looking-at bibtex-field-const) - (let ((mtch (match-string-no-properties 0))) - (goto-char (match-end 0)) - (setq temp (if bibtex-expand-strings - (cdr (assoc-string mtch (bibtex-strings) t))) - content (concat content (or temp mtch))))) - - ((setq temp (bibtex-parse-field-string)) - (setq content (concat content (buffer-substring-no-properties - (1+ (car temp)) - (1- (cdr temp))))) - (goto-char (cdr temp))) - (t (error "Malformed text field"))) + (if (looking-at bibtex-field-const) + (let ((mtch (match-string-no-properties 0))) + (push (or (if bibtex-expand-strings + (cdr (assoc-string mtch (bibtex-strings) t))) + mtch) content) + (goto-char (match-end 0))) + (let ((bounds (bibtex-parse-field-string))) + (push (buffer-substring-no-properties + (1+ (car bounds)) (1- (cdr bounds))) content) + (goto-char (cdr bounds)))) (re-search-forward "\\=[ \t\n]*#[ \t\n]*" nil t)) - content)) + (apply 'concat (nreverse content)))) (buffer-substring-no-properties (bibtex-start-of-text-in-field bounds) (bibtex-end-of-text-in-field bounds)))) @@ -1434,19 +1433,15 @@ If `bibtex-expand-strings' is non-nil, also expand BibTeX strings." Return nil if not found. If optional arg FOLLOW-CROSSREF is non-nil, follow crossref." (save-excursion - (save-restriction - ;; We want to jump back and forth while searching FIELD - (bibtex-narrow-to-entry) - (goto-char (point-min)) - (let ((bounds (bibtex-search-forward-field field (point-max))) - crossref-field) - (cond (bounds (bibtex-text-in-field-bounds bounds t)) - ((and follow-crossref - (progn (goto-char (point-min)) - (setq bounds (bibtex-search-forward-field - "\\(OPT\\)?crossref" (point-max))))) - (setq crossref-field (bibtex-text-in-field-bounds bounds t)) - (widen) + (let* ((end (if follow-crossref (bibtex-end-of-entry) t)) + (beg (bibtex-beginning-of-entry)) ; move point + (bounds (bibtex-search-forward-field field end))) + (cond (bounds (bibtex-text-in-field-bounds bounds t)) + ((and follow-crossref + (progn (goto-char beg) + (setq bounds (bibtex-search-forward-field + "\\(OPT\\)?crossref" end)))) + (let ((crossref-field (bibtex-text-in-field-bounds bounds t))) (if (bibtex-find-crossref crossref-field) ;; Do not pass FOLLOW-CROSSREF because we want ;; to follow crossrefs only one level of recursion. @@ -1487,42 +1482,28 @@ character of the string entry. Move point past BibTeX string entry." (nth 1 bounds) (match-end 0)))))) -(defun bibtex-parse-string () +(defun bibtex-parse-string (&optional empty-key) "Parse a BibTeX string entry beginning at the position of point. If a syntactically correct entry is found, return a cons pair containing the boundaries of the reference key and text parts of the entry. -Do not move point." - (bibtex-parse-association 'bibtex-parse-string-prefix - 'bibtex-parse-string-postfix)) +If EMPTY-KEY is non-nil, key may be empty. Do not move point." + (let ((bibtex-string-empty-key empty-key)) + (bibtex-parse-association 'bibtex-parse-string-prefix + 'bibtex-parse-string-postfix))) -(defun bibtex-search-forward-string () +(defun bibtex-search-forward-string (&optional empty-key) "Search forward to find a BibTeX string entry. If a syntactically correct entry is found, a pair containing the boundaries of -the reference key and text parts of the string is returned. Do not move point." +the reference key and text parts of the string is returned. +If EMPTY-KEY is non-nil, key may be empty. Do not move point." (save-excursion (save-match-data - (let ((case-fold-search t) - boundaries) - (while (and (not boundaries) + (let ((case-fold-search t) bounds) + (while (and (not bounds) (search-forward-regexp bibtex-string-type nil t)) - (goto-char (match-beginning 0)) - (unless (setq boundaries (bibtex-parse-string)) - (forward-char 1))) - boundaries)))) - -(defun bibtex-search-backward-string () - "Search backward to find a BibTeX string entry. -If a syntactically correct entry is found, a pair containing the boundaries of -the reference key and text parts of the field is returned. Do not move point." - (save-excursion - (save-match-data - (let ((case-fold-search t) - boundaries) - (while (and (not boundaries) - (search-backward-regexp bibtex-string-type nil t)) - (goto-char (match-beginning 0)) - (setq boundaries (bibtex-parse-string))) - boundaries)))) + (save-excursion (goto-char (match-beginning 0)) + (setq bounds (bibtex-parse-string empty-key)))) + bounds)))) (defun bibtex-reference-key-in-string (bounds) "Return the key part of a BibTeX string defined via BOUNDS" @@ -1554,14 +1535,15 @@ If `bibtex-expand-strings' is non-nil, also expand BibTeX strings." (or (match-string-no-properties bibtex-key-in-head) empty)) -(defun bibtex-preamble-prefix (&optional delim) - "Parse the prefix part of a BibTeX Preamble. -Point must be at beginning of prefix part. If prefix is found move point -to its end and return position of point. If optional arg DELIM is non-nil, -move past the opening delimiter. If no preamble is found return nil." +(defun bibtex-parse-preamble () + "Parse BibTeX preamble. +Point must be at beginning of preamble. Do not move point." (let ((case-fold-search t)) - (re-search-forward (concat "\\=" bibtex-preamble-prefix - (if delim "[({][ \t\n]*")) nil t))) + (when (looking-at bibtex-preamble-prefix) + (let ((start (match-beginning 0)) (pref-start (match-beginning 1)) + (bounds (save-excursion (goto-char (match-end 0)) + (bibtex-parse-string-postfix)))) + (if bounds (cons (list start pref-start) bounds)))))) ;; Helper Functions @@ -1579,6 +1561,35 @@ move past the opening delimiter. If no preamble is found return nil." (+ (count-lines 1 (point)) (if (bolp) 1 0))) +(defun bibtex-valid-entry (&optional empty-key) + "Parse a valid BibTeX entry (maybe without key if EMPTY-KEY is t). +A valid entry is a syntactical correct one with type contained in +`bibtex-entry-field-alist'. Ignore @String and @Preamble entries. +Return a cons pair with buffer positions of beginning and end of entry +if a valid entry is found, nil otherwise. Do not move point. +After a call to this function `match-data' corresponds to the header +of the entry, see regexp `bibtex-entry-head'." + (let ((case-fold-search t) end) + (if (looking-at (if empty-key bibtex-entry-maybe-empty-head + bibtex-entry-head)) + (save-excursion + (save-match-data + (goto-char (match-end 0)) + (let ((entry-closer + (if (save-excursion + (goto-char (match-end bibtex-type-in-head)) + (looking-at "[ \t]*(")) + ",?[ \t\n]*)" ;; entry opened with `(' + ",?[ \t\n]*}")) ;; entry opened with `{' + bounds) + (skip-chars-forward " \t\n") + ;; loop over all BibTeX fields + (while (setq bounds (bibtex-parse-field)) + (goto-char (bibtex-end-of-field bounds))) + ;; This matches the infix* part. + (if (looking-at entry-closer) (setq end (match-end 0))))) + (if end (cons (match-beginning 0) end)))))) + (defun bibtex-skip-to-valid-entry (&optional backward) "Move point to beginning of the next valid BibTeX entry. Do not move if we are already at beginning of a valid BibTeX entry. @@ -1590,32 +1601,27 @@ entry. Return buffer position of beginning and end of entry if a valid entry is found, nil otherwise." (interactive "P") (let ((case-fold-search t) - found) + found bounds) (beginning-of-line) ;; Loop till we look at a valid entry. (while (not (or found (if backward (bobp) (eobp)))) - (let ((pnt (point)) - bounds) - (cond ((or (and (looking-at bibtex-entry-type-whitespace) - (setq found (bibtex-search-entry nil nil t)) - (equal (match-beginning 0) pnt)) - (and (not bibtex-sort-ignore-string-entries) - (setq bounds (bibtex-parse-string)) - (setq found (cons (bibtex-start-of-field bounds) - (bibtex-end-of-string bounds))))) - (goto-char pnt)) - (backward (re-search-backward "^[ \t]*@" nil 'move)) - (t (re-search-forward "\\=[ \t]*@" nil t) ;; don't be stuck - (if (re-search-forward "^[ \t]*@" nil 'move) - (goto-char (match-beginning 0))))))) + (cond ((setq found (or (bibtex-valid-entry) + (and (not bibtex-sort-ignore-string-entries) + (setq bounds (bibtex-parse-string)) + (cons (bibtex-start-of-field bounds) + (bibtex-end-of-string bounds)))))) + (backward (re-search-backward "^[ \t]*@" nil 'move)) + (t (if (re-search-forward "\n\\([ \t]*@\\)" nil 'move) + (goto-char (match-beginning 1)))))) found)) (defun bibtex-map-entries (fun) "Call FUN for each BibTeX entry in buffer (possibly narrowed). FUN is called with three arguments, the key of the entry and the buffer -positions (marker) of beginning and end of entry. Point is inside the entry. -If `bibtex-sort-ignore-string-entries' is non-nil, FUN is not called for -@String entries." +positions of beginning and end of entry. Also, point is at beginning of +entry and `match-data' corresponds to the header of the entry, +see regexp `bibtex-entry-head'. If `bibtex-sort-ignore-string-entries' +is non-nil, FUN is not called for @String entries." (let ((case-fold-search t) found) (save-excursion @@ -1673,75 +1679,19 @@ If FLAG is nil, a message is echoed if point was incremented at least "}" ")")) -(defun bibtex-search-entry (empty-head &optional bound noerror backward) - "Search for a BibTeX entry (maybe without reference key if EMPTY-HEAD is t). -BOUND and NOERROR are exactly as in `re-search-forward'. If BACKWARD -is non-nil, search in reverse direction. Move point past the closing -delimiter (at the beginning of entry if BACKWARD is non-nil). -Return a cons pair with buffer positions of beginning and end of entry. -After a call to this function `match-data' corresponds to the head part -of the entry, see regexp `bibtex-entry-head'. -Ignore @String and @Preamble entries." - (let ((pnt (point)) - (entry-head-re (if empty-head - bibtex-entry-maybe-empty-head - bibtex-entry-head))) - (if backward - (let (found) - (while (and (not found) - (re-search-backward entry-head-re bound noerror)) - (setq found (bibtex-search-entry empty-head pnt t))) - (cond (found - (goto-char (match-beginning 0)) - found) - ((not noerror) ;; yell - (error "Backward search of BibTeX entry failed")) - (t (if (eq noerror t) (goto-char pnt)) ;; don't move - nil))) - (let (found) - (unless bound (setq bound (point-max))) - (while (and (not found) - (re-search-forward entry-head-re bound noerror)) - (save-match-data - (let ((entry-closer - (if (save-excursion - (goto-char (match-end bibtex-type-in-head)) - (looking-at "[ \t]*(")) - ",?[ \t\n]*)" ;; entry opened with `(' - ",?[ \t\n]*}")) ;; entry opened with `{' - bounds) - (skip-chars-forward " \t\n" bound) - ;; loop over all BibTeX fields - (while (and (setq bounds (bibtex-parse-field)) - (<= (bibtex-end-of-field bounds) bound)) - (goto-char (bibtex-end-of-field bounds))) - ;; This matches the infix* part. - (when (and (looking-at entry-closer) - (<= (match-end 0) bound)) - (goto-char (match-end 0)) - (setq found t))))) - (cond (found - (cons (match-beginning 0) (point))) - ((not noerror) ;; yell - (error "Search of BibTeX entry failed")) - (t (if (eq noerror t) (goto-char pnt)) ;; don't move - nil)))))) - -(defun bibtex-flash-head () +(defun bibtex-flash-head (prompt) "Flash at BibTeX entry head before point, if exists." (let ((case-fold-search t) - (pnt (point)) - flash) + (pnt (point))) (save-excursion (bibtex-beginning-of-entry) (when (and (looking-at bibtex-any-entry-maybe-empty-head) (< (point) pnt)) (goto-char (match-beginning bibtex-type-in-head)) - (setq flash (match-end bibtex-key-in-head)) (if (pos-visible-in-window-p (point)) (sit-for 1) - (message "From: %s" - (buffer-substring (point) flash))))))) + (message "%s%s" prompt (buffer-substring-no-properties + (point) (match-end bibtex-key-in-head)))))))) (defun bibtex-make-optional-field (field) "Make an optional field named FIELD in current BibTeX entry." @@ -1772,66 +1722,55 @@ are ignored. Return point" (bibtex-skip-to-valid-entry) (point)) -(defun bibtex-inside-field () - "Try to avoid point being at end of a BibTeX field." - (end-of-line) - (skip-chars-backward " \t") - (if (= (preceding-char) ?,) - (forward-char -2)) - (if (or (= (preceding-char) ?}) - (= (preceding-char) ?\")) - (forward-char -1))) - -(defun bibtex-enclosing-field (&optional noerr) +(defun bibtex-enclosing-field (&optional comma noerr) "Search for BibTeX field enclosing point. +For `bibtex-mode''s internal algorithms, a field begins at the comma +following the preceding field. Usually, this is not what the user expects. +Thus if COMMA is non-nil, the \"current field\" includes the terminating comma. Unless NOERR is non-nil, signal an error if no enclosing field is found. On success return bounds, nil otherwise. Do not move point." - (let ((bounds (bibtex-search-backward-field bibtex-field-name))) - (if (and bounds - (<= (bibtex-start-of-field bounds) (point)) - (>= (bibtex-end-of-field bounds) (point))) - bounds - (unless noerr - (error "Can't find enclosing BibTeX field"))))) - -(defun bibtex-enclosing-entry-maybe-empty-head () - "Search for BibTeX entry enclosing point. Move point to end of entry. -Beginning (but not end) of entry is given by (`match-beginning' 0)." - (let ((case-fold-search t) - (old-point (point))) - (unless (re-search-backward bibtex-entry-maybe-empty-head nil t) - (goto-char old-point) - (error "Can't find beginning of enclosing BibTeX entry")) - (goto-char (match-beginning bibtex-type-in-head)) - (unless (bibtex-search-entry t nil t) - (goto-char old-point) - (error "Can't find end of enclosing BibTeX entry")))) - -(defun bibtex-insert-kill (n) - "Reinsert the Nth stretch of killed BibTeX text." - (if (not bibtex-last-kill-command) - (error "BibTeX kill ring is empty") - (let* ((kr (if (eq bibtex-last-kill-command 'field) - 'bibtex-field-kill-ring - 'bibtex-entry-kill-ring)) - (kryp (if (eq bibtex-last-kill-command 'field) - 'bibtex-field-kill-ring-yank-pointer - 'bibtex-entry-kill-ring-yank-pointer)) - (current (car (set kryp (nthcdr (mod (- n (length (eval kryp))) - (length (eval kr))) - (eval kr)))))) - (if (eq bibtex-last-kill-command 'field) - (progn - (bibtex-find-text) - (if (looking-at "[}\"]") - (forward-char)) - (set-mark (point)) - (message "Mark set") - (bibtex-make-field current t)) - (unless (eobp) (bibtex-beginning-of-entry)) - (set-mark (point)) - (message "Mark set") - (insert current))))) + (save-excursion + (when comma + (end-of-line) + (skip-chars-backward " \t") + (if (= (preceding-char) ?,) (forward-char -1))) + + (let ((bounds (bibtex-search-backward-field bibtex-field-name t))) + (cond ((and bounds + (<= (bibtex-start-of-field bounds) (point)) + (>= (bibtex-end-of-field bounds) (point))) + bounds) + ((not noerr) + (error "Can't find enclosing BibTeX field")))))) + +(defun bibtex-beginning-first-field (&optional beg) + "Move point to beginning of first field. +Optional arg BEG is beginning of entry." + (if beg (goto-char beg) (bibtex-beginning-of-entry)) + (looking-at bibtex-any-entry-maybe-empty-head) + (goto-char (match-end 0))) + +(defun bibtex-insert-kill (n &optional comma) + "Reinsert the Nth stretch of killed BibTeX text (field or entry). +Optional arg COMMA is as in `bibtex-enclosing-field'." + (unless bibtex-last-kill-command (error "BibTeX kill ring is empty")) + (let ((fun (lambda (kryp kr) ;; adapted from `current-kill' + (car (set kryp (nthcdr (mod (- n (length (eval kryp))) + (length kr)) kr)))))) + (if (eq bibtex-last-kill-command 'field) + (progn + ;; insert past the current field + (goto-char (bibtex-end-of-field (bibtex-enclosing-field comma))) + (set-mark (point)) + (message "Mark set") + (bibtex-make-field (funcall fun 'bibtex-field-kill-ring-yank-pointer + bibtex-field-kill-ring) t)) + ;; insert past the current entry + (bibtex-skip-to-valid-entry) + (set-mark (point)) + (message "Mark set") + (insert (funcall fun 'bibtex-entry-kill-ring-yank-pointer + bibtex-entry-kill-ring))))) (defun bibtex-format-entry () "Helper function for `bibtex-clean-entry'. @@ -1900,9 +1839,8 @@ Formats current entry according to variable `bibtex-entry-format'." (error "All alternatives are empty")) ;; process all fields - (goto-char (point-min)) - (while (setq bounds (bibtex-search-forward-field - bibtex-field-name (point-max))) + (bibtex-beginning-first-field (point-min)) + (while (setq bounds (bibtex-parse-field)) (let* ((beg-field (copy-marker (bibtex-start-of-field bounds))) (end-field (copy-marker (bibtex-end-of-field bounds) t)) (beg-name (copy-marker (bibtex-start-of-name-in-field bounds))) @@ -2040,10 +1978,6 @@ Formats current entry according to variable `bibtex-entry-format'." (error "Alternative fields `%s' are defined %s times" altlist found)))))) - ;; update point - (if (looking-at (bibtex-field-right-delimiter)) - (forward-char)) - ;; update comma after last field (if (memq 'last-comma format) (cond ((and bibtex-comma-after-last-field @@ -2536,6 +2470,7 @@ already set." "Complete word fragment before point to longest prefix of COMPLETIONS. COMPLETIONS is an alist of strings. If point is not after the part of a word, all strings are listed. Return completion." + ;; Return value is used by cleanup functions. (let* ((case-fold-search t) (beg (save-excursion (re-search-backward "[ \t{\"]") @@ -2558,13 +2493,13 @@ of a word, all strings are listed. Return completion." (display-completion-list (all-completions part-of-word completions) part-of-word)) (message "Making completion list...done") - ;; return value is handled by choose-completion-string-functions nil)))) (defun bibtex-complete-string-cleanup (str compl) "Cleanup after inserting string STR. Remove enclosing field delimiters for STR. Display message with expansion of STR using expansion list COMPL." + ;; point is at position inside field where completion was requested (save-excursion (let ((abbr (cdr (if (stringp str) (assoc-string str compl t))))) @@ -2624,50 +2559,52 @@ Used as default value of `bibtex-summary-function'." (defun bibtex-pop (arg direction) "Fill current field from the ARGth same field's text in DIRECTION. Generic function used by `bibtex-pop-previous' and `bibtex-pop-next'." - (bibtex-find-text) - (save-excursion - ;; parse current field - (bibtex-inside-field) - (let* ((case-fold-search t) - (bounds (bibtex-enclosing-field)) - (start-old-text (bibtex-start-of-text-in-field bounds)) - (stop-old-text (bibtex-end-of-text-in-field bounds)) - (field-name (bibtex-name-in-field bounds t))) + ;; parse current field + (let* ((bounds (bibtex-enclosing-field t)) + (start-old-field (bibtex-start-of-field bounds)) + (start-old-text (bibtex-start-of-text-in-field bounds)) + (end-old-text (bibtex-end-of-text-in-field bounds)) + (field-name (bibtex-name-in-field bounds t)) + failure) + (save-excursion ;; if executed several times in a row, start each search where ;; the last one was finished - (unless (eq last-command 'bibtex-pop) - (bibtex-enclosing-entry-maybe-empty-head) - (setq bibtex-pop-previous-search-point (match-beginning 0) - bibtex-pop-next-search-point (point))) - (if (eq direction 'previous) - (goto-char bibtex-pop-previous-search-point) - (goto-char bibtex-pop-next-search-point)) - ;; Now search for arg'th previous/next similar field - (let (bounds failure new-text) - (while (and (not failure) - (> arg 0)) - (cond ((eq direction 'previous) - (if (setq bounds (bibtex-search-backward-field field-name)) - (goto-char (bibtex-start-of-field bounds)) - (setq failure t))) - ((eq direction 'next) - (if (setq bounds (bibtex-search-forward-field field-name)) - (goto-char (bibtex-end-of-field bounds)) - (setq failure t)))) - (setq arg (- arg 1))) - (if failure - (error "No %s matching BibTeX field" - (if (eq direction 'previous) "previous" "next")) - ;; Found a matching field. Remember boundaries. - (setq bibtex-pop-previous-search-point (bibtex-start-of-field bounds) - bibtex-pop-next-search-point (bibtex-end-of-field bounds) - new-text (bibtex-text-in-field-bounds bounds)) - (bibtex-flash-head) + (cond ((eq last-command 'bibtex-pop) + (goto-char (if (eq direction 'previous) + bibtex-pop-previous-search-point + bibtex-pop-next-search-point))) + ((eq direction 'previous) + (bibtex-beginning-of-entry)) + (t (bibtex-end-of-entry))) + ;; Search for arg'th previous/next similar field + (while (and (not failure) + (>= (setq arg (1- arg)) 0)) + ;; The search of BibTeX fields is not bounded by entry boundaries + (if (eq direction 'previous) + (if (setq bounds (bibtex-search-backward-field field-name)) + (goto-char (bibtex-start-of-field bounds)) + (setq failure t)) + (if (setq bounds (bibtex-search-forward-field field-name)) + (goto-char (bibtex-end-of-field bounds)) + (setq failure t)))) + (if failure + (error "No %s matching BibTeX field" + (if (eq direction 'previous) "previous" "next")) + ;; Found a matching field. Remember boundaries. + (let ((new-text (bibtex-text-in-field-bounds bounds)) + (nbeg (copy-marker (bibtex-start-of-field bounds))) + (nend (copy-marker (bibtex-end-of-field bounds)))) + (bibtex-flash-head "From: ") ;; Go back to where we started, delete old text, and pop new. - (goto-char stop-old-text) - (delete-region start-old-text stop-old-text) - (insert new-text))))) - (bibtex-find-text) + (goto-char end-old-text) + (delete-region start-old-text end-old-text) + (if (= nbeg start-old-field) + (insert (bibtex-field-left-delimiter) + (bibtex-field-right-delimiter)) + (insert new-text)) + (setq bibtex-pop-previous-search-point (marker-position nbeg) + bibtex-pop-next-search-point (marker-position nend)))))) + (bibtex-find-text nil nil nil t) (setq this-command 'bibtex-pop)) (defun bibtex-beginning-of-field () @@ -2846,6 +2783,7 @@ if that value is non-nil. (list (list nil bibtex-entry-head bibtex-key-in-head)) imenu-case-fold-search t) (make-local-variable 'choose-completion-string-functions) + (make-local-variable 'completion-ignore-case) ;; XEmacs needs easy-menu-add, Emacs does not care (easy-menu-add bibtex-edit-menu) (easy-menu-add bibtex-entry-menu) @@ -2861,7 +2799,7 @@ and `bibtex-user-optional-fields'." (let ((e (assoc-string entry-type bibtex-entry-field-alist t)) required optional) (unless e - (error "BibTeX entry type %s not defined" entry-type)) + (error "Fields for BibTeX entry type %s not defined" entry-type)) (if (and (member-ignore-case entry-type bibtex-include-OPTcrossref) (nth 2 e)) (setq required (nth 0 (nth 2 e)) @@ -2918,10 +2856,11 @@ according to `bibtex-field-list', but are not yet present." (save-excursion (bibtex-beginning-of-entry) ;; For inserting new fields, we use the fact that - ;; bibtex-parse-entry moves point to the end of the last field. + ;; `bibtex-parse-entry' moves point to the end of the last field. (let* ((fields-alist (bibtex-parse-entry)) (field-list (bibtex-field-list (cdr (assoc "=type=" fields-alist))))) + (skip-chars-backward " \t\n") (dolist (field (car field-list)) (unless (assoc-string (car field) fields-alist t) (bibtex-make-field field))) @@ -2964,6 +2903,7 @@ entry (for example, the year parts of the keys)." (key (bibtex-key-in-head)) (key-end (match-end bibtex-key-in-head)) (case-fold-search t) + (bibtex-sort-ignore-string-entries t) tmp other-key other bounds) ;; The fields we want to change start right after the key. (goto-char key-end) @@ -3016,28 +2956,28 @@ entry (for example, the year parts of the keys)." (while (re-search-backward (regexp-quote other-suffix) key-end 'move) (replace-match suffix))))))) -(defun bibtex-print-help-message () - "Print helpful information about current field in current BibTeX entry." - (interactive) - (let* ((case-fold-search t) - (type (save-excursion - (bibtex-beginning-of-entry) - (looking-at bibtex-any-entry-maybe-empty-head) - (bibtex-type-in-head))) - comment field-list) - (cond ((bibtex-string= type "string") - (message "String definition")) - ((bibtex-string= type "preamble") - (message "Preamble definition")) - (t - (setq field-list (bibtex-field-list type) - comment - (assoc-string (bibtex-name-in-field (bibtex-enclosing-field) t) - (append (car field-list) (cdr field-list)) - t)) - (if comment - (message "%s" (nth 1 comment)) - (message "No comment available")))))) +(defun bibtex-print-help-message (&optional field comma) + "Print helpful information about current FIELD in current BibTeX entry. +Optional arg COMMA is as in `bibtex-enclosing-field'. It is t for +interactive calls." + (interactive (list nil t)) + (unless field (setq field (car (bibtex-find-text-internal nil nil comma)))) + (if (string-match "@" field) + (cond ((bibtex-string= field "@string") + (message "String definition")) + ((bibtex-string= field "@preamble") + (message "Preamble definition")) + (t (message "Entry key"))) + (let* ((case-fold-search t) + (type (save-excursion + (bibtex-beginning-of-entry) + (looking-at bibtex-entry-maybe-empty-head) + (bibtex-type-in-head))) + (field-list (bibtex-field-list type)) + (comment (assoc-string field (append (car field-list) + (cdr field-list)) t))) + (if comment (message "%s" (nth 1 comment)) + (message "No comment available"))))) (defun bibtex-make-field (field &optional move interactive) "Make a field named FIELD in current BibTeX entry. @@ -3052,7 +2992,8 @@ MOVE and INTERACTIVE are t when called interactively." (list (let ((completion-ignore-case t) (field-list (bibtex-field-list (save-excursion - (bibtex-enclosing-entry-maybe-empty-head) + (bibtex-beginning-of-entry) + (looking-at bibtex-any-entry-maybe-empty-head) (bibtex-type-in-head))))) (completing-read "BibTeX field name: " (append (car field-list) (cdr field-list)) @@ -3081,8 +3022,9 @@ MOVE and INTERACTIVE are t when called interactively." (t (concat (bibtex-field-left-delimiter) (bibtex-field-right-delimiter)))))) (when interactive - (forward-char -1) - (bibtex-print-help-message))) + ;; (bibtex-find-text nil nil bibtex-help-message) + (if (memq (preceding-char) '(?} ?\")) (forward-char -1)) + (if bibtex-help-message (bibtex-print-help-message (car field))))) (defun bibtex-beginning-of-entry () "Move to beginning of BibTeX entry (beginning of line). @@ -3103,28 +3045,19 @@ of the previous entry. Do not move if ahead of first entry. Return the new location of point." (interactive) (let ((case-fold-search t) - (org (point)) - (pnt (bibtex-beginning-of-entry)) - err bounds) - (cond ((looking-at bibtex-entry-type-whitespace) - (bibtex-search-entry t nil t) - (unless (equal (match-beginning 0) pnt) - (setq err t))) - ;; @String - ((setq bounds (bibtex-parse-string)) + (pnt (point)) + (_ (bibtex-beginning-of-entry)) + (bounds (bibtex-valid-entry t))) + (cond (bounds (goto-char (cdr bounds))) ; regular entry + ;; @String or @Preamble + ((setq bounds (or (bibtex-parse-string t) (bibtex-parse-preamble))) (goto-char (bibtex-end-of-string bounds))) - ;; @Preamble - ((bibtex-preamble-prefix t) - (unless (bibtex-parse-string-postfix) ;; @String postfix OK - (setq err t))) - (t - (if (interactive-p) - (message "Not on a known BibTeX entry.")) - (goto-char org))) - (when err - (goto-char pnt) - (error "Syntactically incorrect BibTeX entry starts here"))) - (point)) + ((looking-at bibtex-any-valid-entry-type) + ;; Parsing of entry failed + (error "Syntactically incorrect BibTeX entry starts here.")) + (t (if (interactive-p) (message "Not on a known BibTeX entry.")) + (goto-char pnt))) + (point))) (defun bibtex-goto-line (arg) "Goto line ARG, counting from beginning of (narrowed) buffer." @@ -3188,7 +3121,7 @@ If mark is active count entries in region, if not in whole buffer." (interactive) (let ((bounds (save-excursion (bibtex-beginning-of-entry) - (bibtex-search-forward-field "abstract")))) + (bibtex-search-forward-field "abstract" t)))) (if bounds (ispell-region (bibtex-start-of-text-in-field bounds) (bibtex-end-of-text-in-field bounds)) @@ -3216,7 +3149,7 @@ of the head of the entry found. Return nil if no entry found." ;; Don't search CROSSREF-KEY if we don't need it. (if (eq bibtex-maintain-sorted-entries 'crossref) (let ((bounds (bibtex-search-forward-field - "\\(OPT\\)?crossref"))) + "\\(OPT\\)?crossref" t))) (list key (if bounds (bibtex-text-in-field-bounds bounds t)) entry-name)) @@ -3283,7 +3216,7 @@ entry and SPLIT is t." (let ((crossref-key (save-excursion (bibtex-beginning-of-entry) - (let ((bounds (bibtex-search-forward-field "crossref"))) + (let ((bounds (bibtex-search-forward-field "crossref" t))) (if bounds (bibtex-text-in-field-bounds bounds t)))))) (list (bibtex-read-key "Find crossref key: " crossref-key t) @@ -3429,40 +3362,38 @@ Return t if test was successful, nil otherwise." error-list syntax-error) (save-excursion (save-restriction - (if mark-active - (narrow-to-region (region-beginning) (region-end))) + (if mark-active (narrow-to-region (region-beginning) (region-end))) - ;; looking if entries fit syntactical structure + ;; Check syntactical structure of entries (goto-char (point-min)) (bibtex-progress-message "Checking syntactical structure") - (let (bibtex-sort-ignore-string-entries) - (while (re-search-forward "^[ \t]*@" nil t) + (let (bounds end) + (while (setq end (re-search-forward "^[ \t]*@" nil t)) (bibtex-progress-message) - (forward-char -1) - (let ((pnt (point))) - (if (not (looking-at bibtex-entry-type-str)) - (forward-char) - (bibtex-skip-to-valid-entry) - (if (equal (point) pnt) - (forward-char) - (goto-char pnt) - (push (cons (bibtex-current-line) - "Syntax error (check esp. commas, braces, and quotes)") - error-list) - (forward-char)))))) + (goto-char (match-beginning 0)) + (cond ((setq bounds (bibtex-valid-entry)) + (goto-char (cdr bounds))) + ((setq bounds (or (bibtex-parse-string) + (bibtex-parse-preamble))) + (goto-char (bibtex-end-of-string bounds))) + ((looking-at bibtex-any-valid-entry-type) + (push (cons (bibtex-current-line) + "Syntax error (check esp. commas, braces, and quotes)") + error-list) + (goto-char (match-end 0))) + (t (goto-char end))))) (bibtex-progress-message 'done) (if error-list - ;; proceed only if there were no syntax errors. + ;; Continue only if there were no syntax errors. (setq syntax-error t) - ;; looking for duplicate keys and correct sort order + ;; Check for duplicate keys and correct sort order (let (previous current key-list) (bibtex-progress-message "Checking for duplicate keys") (bibtex-map-entries (lambda (key beg end) (bibtex-progress-message) - (goto-char beg) (setq current (bibtex-entry-index)) (cond ((not previous)) ((member key key-list) @@ -3498,18 +3429,13 @@ Return t if test was successful, nil otherwise." (bibtex-map-entries (lambda (key beg end) (bibtex-progress-message) - (let* ((entry-list (progn - (goto-char beg) - (bibtex-search-entry nil end) - (assoc-string (bibtex-type-in-head) - bibtex-entry-field-alist t))) + (let* ((entry-list (assoc-string (bibtex-type-in-head) + bibtex-entry-field-alist t)) (req (copy-sequence (elt (elt entry-list 1) 0))) (creq (copy-sequence (elt (elt entry-list 2) 0))) crossref-there bounds alt-there field) - (goto-char beg) - (while (setq bounds (bibtex-search-forward-field - bibtex-field-name end)) - (goto-char (bibtex-start-of-text-in-field bounds)) + (bibtex-beginning-first-field beg) + (while (setq bounds (bibtex-parse-field)) (let ((field-name (bibtex-name-in-field bounds))) (if (and (bibtex-string= field-name "month") ;; Check only abbreviated month fields. @@ -3521,18 +3447,19 @@ Return t if test was successful, nil otherwise." (push (cons (bibtex-current-line) "Questionable month field") error-list)) - (setq field (assoc-string field-name req t)) + (setq field (assoc-string field-name req t) + req (delete field req) + creq (delete (assoc-string field-name creq t) creq)) (if (nth 3 field) - (if alt-there (push (cons (bibtex-current-line) - "More than one non-empty alternative") - error-list) + (if alt-there + (push (cons (bibtex-current-line) + "More than one non-empty alternative") + error-list) (setq alt-there t))) - (setq req (delete field req) - creq (delete (assoc-string field-name creq t) creq)) (if (bibtex-string= field-name "crossref") - (setq crossref-there t)))) - (if crossref-there - (setq req creq)) + (setq crossref-there t))) + (goto-char (bibtex-end-of-field bounds))) + (if crossref-there (setq req creq)) (let (alt) (dolist (field req) (if (nth 3 field) @@ -3573,11 +3500,10 @@ Return t if test was successful, nil otherwise." (toggle-read-only 1) (goto-line 3)) ; first error message (display-buffer err-buf) - ;; return nil - nil) + nil) ; return `nil' (i.e., buffer is invalid) (message "%s is syntactically correct" (if mark-active "Region" "Buffer")) - t))) + t))) ; return `t' (i.e., buffer is valid) (defun bibtex-validate-globally (&optional strings) "Check for duplicate keys in `bibtex-files'. @@ -3631,37 +3557,41 @@ Return t if test was successful, nil otherwise." (toggle-read-only 1) (goto-line 3)) ; first error message (display-buffer err-buf) - ;; return nil - nil) + nil) ; return `nil' (i.e., buffer is invalid) (message "No duplicate keys.") - t))) - -(defun bibtex-next-field (begin) - "Move point to end of text of next BibTeX field. -With prefix BEGIN non-nil, move point to its beginning." - (interactive "P") - (bibtex-inside-field) - (let ((start (point))) - (condition-case () - (let ((bounds (bibtex-enclosing-field))) - (goto-char (bibtex-end-of-field bounds)) - (forward-char 2)) - (error - (goto-char start) - (end-of-line) - (forward-char)))) - (bibtex-find-text begin nil bibtex-help-message)) - -(defun bibtex-find-text (&optional begin noerror help) - "Move point to end of text of current BibTeX field. + t))) ; return `t' (i.e., buffer is valid) + +(defun bibtex-next-field (begin &optional comma) + "Move point to end of text of next BibTeX field or entry head. +With prefix BEGIN non-nil, move point to its beginning. Optional arg COMMA +is as in `bibtex-enclosing-field'. It is t for interactive calls." + (interactive (list current-prefix-arg t)) + (let ((bounds (bibtex-find-text-internal t nil comma)) + end-of-entry) + (if (not bounds) + (setq end-of-entry t) + (goto-char (nth 3 bounds)) + (if (assoc-string (car bounds) '("@String" "@Preamble") t) + (setq end-of-entry t) + ;; BibTeX key or field + (if (looking-at ",[ \t\n]*") (goto-char (match-end 0))) + ;; end of entry + (if (looking-at "[)}][ \t\n]*") (setq end-of-entry t)))) + (if (and end-of-entry + (re-search-forward bibtex-any-entry-maybe-empty-head nil t)) + (goto-char (match-beginning 0))) + (bibtex-find-text begin nil bibtex-help-message))) + +(defun bibtex-find-text (&optional begin noerror help comma) + "Move point to end of text of current BibTeX field or entry head. With optional prefix BEGIN non-nil, move point to its beginning. Unless NOERROR is non-nil, an error is signaled if point is not on a BibTeX field. If optional arg HELP is non-nil print help message. -When called interactively, the value of HELP is `bibtex-help-message'." - (interactive (list current-prefix-arg nil bibtex-help-message)) - (let ((pnt (point)) - (bounds (bibtex-find-text-internal))) - (beginning-of-line) +When called interactively, the value of HELP is `bibtex-help-message'. +Optional arg COMMA is as in `bibtex-enclosing-field'. It is t for +interactive calls." + (interactive (list current-prefix-arg nil bibtex-help-message t)) + (let ((bounds (bibtex-find-text-internal t nil comma))) (cond (bounds (if begin (progn (goto-char (nth 1 bounds)) @@ -3670,72 +3600,88 @@ When called interactively, the value of HELP is `bibtex-help-message'." (goto-char (nth 2 bounds)) (if (memq (preceding-char) '(?} ?\")) (forward-char -1))) - (if help (bibtex-print-help-message))) - ((looking-at bibtex-entry-maybe-empty-head) - (goto-char (if begin - (match-beginning bibtex-key-in-head) - (match-end 0)))) - (t - (goto-char pnt) - (unless noerror (error "Not on BibTeX field")))))) + (if help (bibtex-print-help-message (car bounds)))) + ((not noerror) (error "Not on BibTeX field"))))) -(defun bibtex-find-text-internal (&optional noerror subfield) - "Find text part of current BibTeX field, @String or @Preamble. -Return list (NAME START END) with field name, start and end of text -or nil if not found. +(defun bibtex-find-text-internal (&optional noerror subfield comma) + "Find text part of current BibTeX field or entry head. +Return list (NAME START-TEXT END-TEXT END) with field or entry name, +start and end of text and end of field or entry head, or nil if not found. If optional arg NOERROR is non-nil, an error message is suppressed if text -is not found. If optional arg SUBFIELD is non-nil START and END correspond -to the current subfield delimited by #." +is not found. If optional arg SUBFIELD is non-nil START-TEXT and END-TEXT +correspond to the current subfield delimited by #. +Optional arg COMMA is as in `bibtex-enclosing-field'." (save-excursion (let ((pnt (point)) - (_ (bibtex-inside-field)) - (bounds (bibtex-enclosing-field t)) + (bounds (bibtex-enclosing-field comma t)) (case-fold-search t) - (bibtex-string-empty-key t) - name start end) + name start-text end-text end failure done no-sub) (bibtex-beginning-of-entry) (cond (bounds (setq name (bibtex-name-in-field bounds t) - start (bibtex-start-of-text-in-field bounds) - end (bibtex-end-of-text-in-field bounds))) + start-text (bibtex-start-of-text-in-field bounds) + end-text (bibtex-end-of-text-in-field bounds) + end (bibtex-end-of-field bounds))) ;; @String - ((setq bounds (bibtex-parse-string)) - (setq name "@String" ;; not a field name! - start (bibtex-start-of-text-in-string bounds) - end (bibtex-end-of-text-in-string bounds))) + ((setq bounds (bibtex-parse-string t)) + (if (<= pnt (bibtex-end-of-string bounds)) + (setq name "@String" ;; not a field name! + start-text (bibtex-start-of-text-in-string bounds) + end-text (bibtex-end-of-text-in-string bounds) + end (bibtex-end-of-string bounds)) + (setq failure t))) ;; @Preamble - ((and (bibtex-preamble-prefix t) - (setq bounds (bibtex-parse-field-text))) - (setq name "@Preamble" ;; not a field name! - start (car bounds) - end (nth 1 bounds))) - (t (unless noerror (error "Not on BibTeX field")))) - (when (and start end subfield) - (goto-char start) - (let (done) + ((setq bounds (bibtex-parse-preamble)) + (if (<= pnt (bibtex-end-of-string bounds)) + (setq name "@Preamble" ;; not a field name! + start-text (bibtex-start-of-text-in-string bounds) + end-text (bibtex-end-of-text-in-string bounds) + end (bibtex-end-of-string bounds)) + (setq failure t))) + ;; BibTeX head + ((looking-at bibtex-entry-maybe-empty-head) + (goto-char (match-end 0)) + (if comma (save-match-data + (re-search-forward "\\=[ \t\n]*," nil t))) + (if (<= pnt (point)) + (setq name (match-string-no-properties bibtex-type-in-head) + start-text (or (match-beginning bibtex-key-in-head) + (match-end 0)) + end-text (or (match-end bibtex-key-in-head) + (match-end 0)) + end end-text + no-sub t) ;; subfields do not make sense + (setq failure t))) + (t (setq failure t))) + (when (and subfield (not failure)) + (setq failure no-sub) + (unless failure + (goto-char start-text) (while (not done) (if (or (prog1 (looking-at bibtex-field-const) - (setq end (match-end 0))) + (setq end-text (match-end 0))) (prog1 (setq bounds (bibtex-parse-field-string)) - (setq end (cdr bounds)))) + (setq end-text (cdr bounds)))) (progn - (if (and (<= start pnt) (<= pnt end)) + (if (and (<= start-text pnt) (<= pnt end-text)) (setq done t) - (goto-char end)) + (goto-char end-text)) (if (looking-at "[ \t\n]*#[ \t\n]*") - (setq start (goto-char (match-end 0))))) - (unless noerror (error "Not on text part of BibTeX field")) - (setq done t start nil end nil))))) - (if (and start end) - (list name start end))))) - -(defun bibtex-remove-OPT-or-ALT () + (setq start-text (goto-char (match-end 0))))) + (setq done t failure t))))) + (cond ((not failure) + (list name start-text end-text end)) + ((and no-sub (not noerror)) + (error "Not on text part of BibTeX field")) + ((not noerror) (error "Not on BibTeX field")))))) + +(defun bibtex-remove-OPT-or-ALT (&optional comma) "Remove the string starting optional/alternative fields. -Align text and go thereafter to end of text." - (interactive) - (bibtex-inside-field) +Align text and go thereafter to end of text. Optional arg COMMA +is as in `bibtex-enclosing-field'. It is t for interactive calls." + (interactive (list t)) (let ((case-fold-search t) - (bounds (bibtex-enclosing-field))) + (bounds (bibtex-enclosing-field comma))) (save-excursion (goto-char (bibtex-start-of-name-in-field bounds)) (when (looking-at "OPT\\|ALT") @@ -3751,14 +3697,14 @@ Align text and go thereafter to end of text." (delete-horizontal-space) (if bibtex-align-at-equal-sign (insert " ") - (indent-to-column bibtex-text-indentation)))) - (bibtex-inside-field))) - -(defun bibtex-remove-delimiters () - "Remove \"\" or {} around current BibTeX field text." - (interactive) - ;; `bibtex-find-text-internal' issues an error message if bounds is nil. - (let* ((bounds (bibtex-find-text-internal nil t)) + (indent-to-column bibtex-text-indentation)))))) + +(defun bibtex-remove-delimiters (&optional comma) + "Remove \"\" or {} around current BibTeX field text. +Optional arg COMMA is as in `bibtex-enclosing-field'. It is t for +interactive calls." + (interactive (list t)) + (let* ((bounds (bibtex-find-text-internal nil t comma)) (start (nth 1 bounds)) (end (nth 2 bounds))) (if (memq (char-before end) '(?\} ?\")) @@ -3766,15 +3712,15 @@ Align text and go thereafter to end of text." (if (memq (char-after start) '(?\{ ?\")) (delete-region start (1+ start))))) -(defun bibtex-kill-field (&optional copy-only) +(defun bibtex-kill-field (&optional copy-only comma) "Kill the entire enclosing BibTeX field. With prefix arg COPY-ONLY, copy the current field to `bibtex-field-kill-ring', -but do not actually kill it." - (interactive "P") +but do not actually kill it. Optional arg COMMA is as in +`bibtex-enclosing-field'. It is t for interactive calls." + (interactive (list current-prefix-arg t)) (save-excursion - (bibtex-inside-field) (let* ((case-fold-search t) - (bounds (bibtex-enclosing-field)) + (bounds (bibtex-enclosing-field comma)) (end (bibtex-end-of-field bounds)) (beg (bibtex-start-of-field bounds))) (goto-char end) @@ -3791,10 +3737,12 @@ but do not actually kill it." (delete-region beg end)))) (setq bibtex-last-kill-command 'field)) -(defun bibtex-copy-field-as-kill () - "Copy the BibTeX field at point to the kill ring." - (interactive) - (bibtex-kill-field t)) +(defun bibtex-copy-field-as-kill (&optional comma) + "Copy the BibTeX field at point to the kill ring. +Optional arg COMMA is as in `bibtex-enclosing-field'. It is t for +interactive calls." + (interactive (list t)) + (bibtex-kill-field t comma)) (defun bibtex-kill-entry (&optional copy-only) "Kill the entire enclosing BibTeX entry. @@ -3806,7 +3754,7 @@ but do not actually kill it." (beg (bibtex-beginning-of-entry)) (end (progn (bibtex-end-of-entry) (if (re-search-forward - bibtex-entry-maybe-empty-head nil 'move) + bibtex-any-entry-maybe-empty-head nil 'move) (goto-char (match-beginning 0))) (point)))) (push (buffer-substring-no-properties beg end) @@ -3831,13 +3779,13 @@ More precisely, reinsert the field or entry killed or yanked most recently. With argument N, reinsert the Nth most recently killed BibTeX item. See also the command \\[bibtex-yank-pop]." (interactive "*p") - (bibtex-insert-kill (1- n)) + (bibtex-insert-kill (1- n) t) (setq this-command 'bibtex-yank)) (defun bibtex-yank-pop (n) "Replace just-yanked killed BibTeX item with a different item. This command is allowed only immediately after a `bibtex-yank' or a -`bibtex-yank-pop'. At such a time, the region contains a reinserted +`bibtex-yank-pop'. In this case, the region contains a reinserted previously killed BibTeX item. `bibtex-yank-pop' deletes that item and inserts in its place a different killed BibTeX item. @@ -3853,13 +3801,14 @@ comes the newest one." (setq this-command 'bibtex-yank) (let ((inhibit-read-only t)) (delete-region (point) (mark t)) - (bibtex-insert-kill n))) - -(defun bibtex-empty-field () - "Delete the text part of the current field, replace with empty text." - (interactive) - (bibtex-inside-field) - (let ((bounds (bibtex-enclosing-field))) + (bibtex-insert-kill n t))) + +(defun bibtex-empty-field (&optional comma) + "Delete the text part of the current field, replace with empty text. +Optional arg COMMA is as in `bibtex-enclosing-field'. It is t for +interactive calls." + (interactive (list t)) + (let ((bounds (bibtex-enclosing-field comma))) (goto-char (bibtex-start-of-text-in-field bounds)) (delete-region (point) (bibtex-end-of-text-in-field bounds)) (insert (bibtex-field-left-delimiter) @@ -3960,7 +3909,7 @@ At end of the cleaning process, the functions in (if (and (listp bibtex-strings) (not (assoc key bibtex-strings))) (push (cons key (bibtex-text-in-string - (save-excursion (bibtex-parse-string)) t)) + (bibtex-parse-string) t)) bibtex-strings))) ;; We have a normal entry. ((listp bibtex-reference-keys) @@ -3988,28 +3937,27 @@ At end of the cleaning process, the functions in If JUSTIFY is non-nil justify as well. If optional arg MOVE is non-nil move point to end of field." (let ((end-field (copy-marker (bibtex-end-of-field bounds)))) - (goto-char (bibtex-start-of-field bounds)) - (if justify - (progn - (forward-char) - (bibtex-delete-whitespace) - (open-line 1) - (forward-char) - (indent-to-column (+ bibtex-entry-offset - bibtex-field-indentation)) - (re-search-forward "[ \t\n]*=" end-field) - (replace-match "=") - (forward-char -1) - (if bibtex-align-at-equal-sign - (indent-to-column - (+ bibtex-entry-offset (- bibtex-text-indentation 2))) - (insert " ")) - (forward-char) - (bibtex-delete-whitespace) - (if bibtex-align-at-equal-sign - (insert " ") - (indent-to-column bibtex-text-indentation))) - (re-search-forward "[ \t\n]*=[ \t\n]*" end-field)) + (if (not justify) + (goto-char (bibtex-start-of-text-in-field bounds)) + (goto-char (bibtex-start-of-field bounds)) + (forward-char) ;; leading comma + (bibtex-delete-whitespace) + (open-line 1) + (forward-char) + (indent-to-column (+ bibtex-entry-offset + bibtex-field-indentation)) + (re-search-forward "[ \t\n]*=" end-field) + (replace-match "=") + (forward-char -1) + (if bibtex-align-at-equal-sign + (indent-to-column + (+ bibtex-entry-offset (- bibtex-text-indentation 2))) + (insert " ")) + (forward-char) + (bibtex-delete-whitespace) + (if bibtex-align-at-equal-sign + (insert " ") + (indent-to-column bibtex-text-indentation))) ;; Paragraphs within fields are not preserved. Bother? (fill-region-as-paragraph (line-beginning-position) end-field default-justification nil (point)) @@ -4017,14 +3965,13 @@ If optional arg MOVE is non-nil move point to end of field." (defun bibtex-fill-field (&optional justify) "Like \\[fill-paragraph], but fill current BibTeX field. -Optional prefix arg JUSTIFY non-nil means justify as well. +If optional prefix JUSTIFY is non-nil justify as well. In BibTeX mode this function is bound to `fill-paragraph-function'." (interactive "*P") (let ((pnt (copy-marker (point))) - (bounds (bibtex-enclosing-field))) - (when bounds - (bibtex-fill-field-bounds bounds justify) - (goto-char pnt)))) + (bounds (bibtex-enclosing-field t))) + (bibtex-fill-field-bounds bounds justify) + (goto-char pnt))) (defun bibtex-fill-entry () "Fill current BibTeX entry. @@ -4035,14 +3982,16 @@ If `bibtex-align-at-equal-sign' is non-nil, align equal signs, too." (interactive "*") (let ((pnt (copy-marker (point))) (end (copy-marker (bibtex-end-of-entry))) + (beg (bibtex-beginning-of-entry)) ; move point bounds) - (bibtex-beginning-of-entry) (bibtex-delete-whitespace) (indent-to-column bibtex-entry-offset) - (while (setq bounds (bibtex-search-forward-field bibtex-field-name end)) + (bibtex-beginning-first-field beg) + (while (setq bounds (bibtex-parse-field)) (bibtex-fill-field-bounds bounds t t)) (if (looking-at ",") (forward-char)) + (skip-chars-backward " \t\n") (bibtex-delete-whitespace) (open-line 1) (forward-char) @@ -4115,8 +4064,7 @@ If mark is active reformat entries in region, if not in whole buffer." bibtex-autokey-edit-before-use) (save-restriction - (narrow-to-region (if mark-active (region-beginning) (point-min)) - (if mark-active (region-end) (point-max))) + (if mark-active (narrow-to-region (region-beginning) (region-end))) (if (memq 'realign bibtex-entry-format) (bibtex-realign)) (bibtex-progress-message "Formatting" 1) @@ -4143,12 +4091,10 @@ entries from minibuffer." (message "Starting to validate buffer...") (sit-for 1 nil t) (bibtex-realign) - (message - "If errors occur, correct them and call `bibtex-convert-alien' again") - (sit-for 5 nil t) (deactivate-mark) ; So bibtex-validate works on the whole buffer. - (when (let (bibtex-maintain-sorted-entries) - (bibtex-validate)) + (if (not (let (bibtex-maintain-sorted-entries) + (bibtex-validate))) + (message "Correct errors and call `bibtex-convert-alien' again") (message "Starting to reformat entries...") (sit-for 2 nil t) (bibtex-reformat read-options) @@ -4166,10 +4112,9 @@ An error is signaled if point is outside key or BibTeX field." (interactive) (let ((pnt (point)) (case-fold-search t) - (bibtex-string-empty-key t) bounds name compl) (save-excursion - (if (and (setq bounds (bibtex-enclosing-field t)) + (if (and (setq bounds (bibtex-enclosing-field nil t)) (>= pnt (bibtex-start-of-text-in-field bounds)) (<= pnt (bibtex-end-of-text-in-field bounds))) (setq name (bibtex-name-in-field bounds t) @@ -4182,7 +4127,7 @@ An error is signaled if point is outside key or BibTeX field." ;; point is in other field (t (bibtex-strings)))) (bibtex-beginning-of-entry) - (cond ((setq bounds (bibtex-parse-string)) + (cond ((setq bounds (bibtex-parse-string t)) ;; point is inside a @String key (cond ((and (>= pnt (nth 1 (car bounds))) (<= pnt (nth 2 (car bounds)))) @@ -4192,11 +4137,10 @@ An error is signaled if point is outside key or BibTeX field." (<= pnt (bibtex-end-of-text-in-string bounds))) (setq compl (bibtex-strings))))) ;; point is inside a @Preamble field - ((and (bibtex-preamble-prefix t) - (setq bounds (bibtex-parse-field-text)) - (>= pnt (car bounds)) - (<= pnt (nth 1 bounds))) - (setq compl (bibtex-strings))) + ((setq bounds (bibtex-parse-preamble)) + (if (and (>= pnt (bibtex-start-of-text-in-string bounds)) + (<= pnt (bibtex-end-of-text-in-string bounds))) + (setq compl (bibtex-strings)))) ((and (looking-at bibtex-entry-maybe-empty-head) ;; point is inside a key (or (and (match-beginning bibtex-key-in-head) @@ -4209,41 +4153,53 @@ An error is signaled if point is outside key or BibTeX field." (cond ((eq compl 'key) ;; key completion: no cleanup needed - (let (completion-ignore-case) - (bibtex-complete-internal (bibtex-global-key-alist)))) + (setq choose-completion-string-functions nil + completion-ignore-case nil) + (bibtex-complete-internal (bibtex-global-key-alist))) ((eq compl 'crossref-key) ;; crossref key completion - (let (completion-ignore-case) - (setq choose-completion-string-functions - (lambda (choice buffer mini-p base-size) - (let ((choose-completion-string-functions nil)) - (choose-completion-string choice buffer base-size)) - (bibtex-complete-crossref-cleanup choice) - ;; return t (needed by choose-completion-string-functions) - t)) - (bibtex-complete-crossref-cleanup (bibtex-complete-internal - (bibtex-global-key-alist))))) + ;; + ;; If we quit the *Completions* buffer without requesting + ;; a completion, `choose-completion-string-functions' is still + ;; non-nil. Therefore, `choose-completion-string-functions' is + ;; always set (either to non-nil or nil) when a new completion + ;; is requested. + ;; Also, `choose-completion-delete-max-match' requires + ;; that we set `completion-ignore-case' (i.e., binding via `let' + ;; is not sufficient). + (setq completion-ignore-case nil + choose-completion-string-functions + (lambda (choice buffer mini-p base-size) + (setq choose-completion-string-functions nil) + (choose-completion-string choice buffer base-size) + (bibtex-complete-crossref-cleanup choice) + t)) ; needed by choose-completion-string-functions + + (bibtex-complete-crossref-cleanup (bibtex-complete-internal + (bibtex-global-key-alist)))) ((eq compl 'string) ;; string key completion: no cleanup needed - (let ((completion-ignore-case t)) - (bibtex-complete-internal bibtex-strings))) + (setq choose-completion-string-functions nil + completion-ignore-case t) + (bibtex-complete-internal bibtex-strings)) (compl ;; string completion - (let ((completion-ignore-case t)) - (setq choose-completion-string-functions - `(lambda (choice buffer mini-p base-size) - (let ((choose-completion-string-functions nil)) - (choose-completion-string choice buffer base-size)) - (bibtex-complete-string-cleanup choice ',compl) - ;; return t (needed by choose-completion-string-functions) - t)) - (bibtex-complete-string-cleanup (bibtex-complete-internal compl) - compl))) - - (t (error "Point outside key or BibTeX field"))))) + (setq completion-ignore-case t + choose-completion-string-functions + `(lambda (choice buffer mini-p base-size) + (setq choose-completion-string-functions nil) + (choose-completion-string choice buffer base-size) + (bibtex-complete-string-cleanup choice ',compl) + t)) ; needed by choose-completion-string-functions + (bibtex-complete-string-cleanup (bibtex-complete-internal compl) + compl)) + + (t (setq choose-completion-string-functions nil + completion-ignore-case nil) ; default + (error "Point outside key or BibTeX field"))))) (defun bibtex-Article () "Insert a new BibTeX @Article entry; see also `bibtex-entry'." diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index ce95c6f026f..48defb7d786 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -291,12 +291,13 @@ act as a paragraph-separator." (defun fill-single-word-nobreak-p () "Don't break a line after the first or before the last word of a sentence." - (or (looking-at "[ \t]*\\sw+[ \t]*[.?!:][ \t]*$") + (or (looking-at (concat "[ \t]*\\sw+" "\\(?:" (sentence-end) "\\)")) (save-excursion (skip-chars-backward " \t") (and (/= (skip-syntax-backward "w") 0) (/= (skip-chars-backward " \t") 0) - (/= (skip-chars-backward ".?!:") 0))))) + (/= (skip-chars-backward ".?!:") 0) + (looking-at (sentence-end)))))) (defun fill-french-nobreak-p () "Return nil if French style allows breaking the line at point. diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index ac6afe45608..cc2d1eace59 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,11 @@ +2006-01-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-handlers.el (url-retrieve-synchronously): Don't autoload. + + * url.el (url-retrieve, url-retrieve-synchronously): Autoload. + + * url-cache.el: Require `url'. + 2005-12-27 Stefan Monnier <monnier@iro.umontreal.ca> * url-cache.el (url-store-in-cache): Use save-current-buffer. diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index b8c2b063adc..5113ad0d7d9 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -1,7 +1,7 @@ ;;; url-cache.el --- Uniform Resource Locator retrieval tool ;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -26,6 +26,7 @@ (require 'url-parse) (require 'url-util) +(require 'url) ;E.g. for url-configuration-directory. (defcustom url-cache-directory (expand-file-name "cache" url-configuration-directory) diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 1c9d1d9c0b1..0338eefd268 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -1,7 +1,7 @@ ;;; url-handlers.el --- file-name-handler stuff for URL loading ;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -37,7 +37,6 @@ ;; after mm-dissect-buffer and defined in the same file. ;; The following are autoloaded instead of `require'd to avoid eagerly ;; loading all of URL when turning on url-handler-mode in the .emacs. -(autoload 'url-retrieve-synchronously "url" "Retrieve url synchronously.") (autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified url, and canonicalize it.") (autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.") (autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.") diff --git a/lisp/url/url.el b/lisp/url/url.el index 6d6540ac82a..f9d06010171 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -1,7 +1,7 @@ ;;; url.el --- Uniform Resource Locator retrieval tool ;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Bill Perry <wmperry@gnu.org> ;; Keywords: comm, data, processes, hypermedia @@ -114,6 +114,7 @@ Emacs." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Retrieval functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload (defun url-retrieve (url callback &optional cbargs) "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished. URL is either a string or a parsed URL. @@ -155,6 +156,7 @@ already completed." (url-history-update-url url (current-time))) buffer)) +;;;###autoload (defun url-retrieve-synchronously (url) "Retrieve URL synchronously. Return the buffer containing the data, or nil if there are no data diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 075ea879270..0036712fec4 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -39,9 +39,6 @@ ;;; Todo: -;; The xterm mouse escape codes are supposedly also supported by the -;; Linux console, but I have not been able to verify this. - ;; Support multi-click -- somehow. ;;; Code: |