Mercurial > emacs
diff lisp/textmodes/bibtex.el @ 89943:4c90ffeb71c5
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-15
Merge from emacs--cvs-trunk--0
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-218
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-220
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-221
Restore deleted tagline in etc/TUTORIAL.ru
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-222
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-228
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-229
Remove TeX output files from the archive
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-230
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-247
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-248
src/lisp.h (CYCLE_CHECK): Macro moved from xfaces.c
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-249
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-256
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-258
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-263
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-264
Update from CVS: lispref/display.texi: emacs -> Emacs.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-265
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-274
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-275
Update from CVS: man/makefile.w32-in: Revert last change
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-276
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-295
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-296
Allow restarting an existing debugger session that's exited
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-297
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-299
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-300
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-327
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-328
Update from CVS: src/.gdbinit (xsymbol): Fix last change.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-329
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-344
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-345
Tweak source regexps so that building in place won't cause problems
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-346
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-351
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-352
Update from CVS: lisp/flymake.el: New file.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-353
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-361
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-362
Support " [...]" style defaults in minibuffer-electric-default-mode
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-363
(read-number): Use canonical format for default in prompt.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-364
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-367
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-368
Improve display-supports-face-attributes-p on non-ttys
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-369
Rewrite face-differs-from-default-p
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-370
Move `display-supports-face-attributes-p' entirely into C code
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-371
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Simplify face-differs-from-default-p; don't consider :stipple.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-373
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-374
(tty_supports_face_attributes_p): Ensure attributes differ from default
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-375
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-376
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-377
(Fdisplay_supports_face_attributes_p): Work around bootstrapping problem
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-378
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-380
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-381
Face merging cleanups
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-382
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-384
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-385
src/xfaces.c (push_named_merge_point): Return 0 if a cycle is detected
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-386
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-395
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-396
Tweak arch tagging to make build/install-in-place less annoying
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-397
Work around vc-arch problems when building eshell
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-398
Tweak permissions
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-399
Tweak directory permissions
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-400
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-401
More build-in-place tweaking of arch tagging
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-402
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-403
Yet more build-in-place tweaking of arch tagging
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-404
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-409
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-410
Make sure image types are initialized for lookup too
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-411
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-416
Update from CVS
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Mon, 28 Jun 2004 07:56:49 +0000 |
| parents | 68c22ea6027c 1b2cb608f18e |
| children | 566253900690 |
line wrap: on
line diff
--- a/lisp/textmodes/bibtex.el Sat May 29 02:17:09 2004 +0000 +++ b/lisp/textmodes/bibtex.el Mon Jun 28 07:56:49 2004 +0000 @@ -1,6 +1,7 @@ ;;; bibtex.el --- BibTeX mode for GNU Emacs -;; Copyright (C) 1992,94,95,96,97,98,1999,2003 Free Software Foundation, Inc. +;; Copyright (C) 1992,94,95,96,97,98,1999,2003,2004 +;; Free Software Foundation, Inc. ;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de> ;; Bengt Martensson <bengt@mathematik.uni-Bremen.de> @@ -811,6 +812,7 @@ (define-key km "\C-c\M-y" 'bibtex-yank-pop) (define-key km "\C-c\C-d" 'bibtex-empty-field) (define-key km "\C-c\C-f" 'bibtex-make-field) + (define-key km "\C-c\C-u" 'bibtex-entry-update) (define-key km "\C-c$" 'bibtex-ispell-abstract) (define-key km "\M-\C-a" 'bibtex-beginning-of-entry) (define-key km "\M-\C-e" 'bibtex-end-of-entry) @@ -1122,44 +1124,6 @@ '(bibtex-mode "@\\S(*\\s(" "\\s)" nil bibtex-hs-forward-sexp nil)) -(defconst bibtex-braced-string-syntax-table - (let ((st (make-syntax-table))) - (modify-syntax-entry ?\{ "(}" st) - (modify-syntax-entry ?\} "){" st) - (modify-syntax-entry ?\[ "." st) - (modify-syntax-entry ?\] "." st) - (modify-syntax-entry ?\( "." st) - (modify-syntax-entry ?\) "." st) - (modify-syntax-entry ?\\ "." st) - (modify-syntax-entry ?\" "." st) - st) - "Syntax-table to parse matched braces.") - -(defconst bibtex-quoted-string-syntax-table - (let ((st (make-syntax-table))) - (modify-syntax-entry ?\\ "\\" st) - (modify-syntax-entry ?\" "\"" st) - st) - "Syntax-table to parse matched quotes.") - -(defun bibtex-parse-field-string () - "Parse a field string enclosed by braces or quotes. -If a syntactically correct string is found, a pair containing the start and -end position of the field string is returned, nil otherwise." - (let ((end-point - (or (and (eq (following-char) ?\") - (save-excursion - (with-syntax-table bibtex-quoted-string-syntax-table - (forward-sexp 1)) - (point))) - (and (eq (following-char) ?\{) - (save-excursion - (with-syntax-table bibtex-braced-string-syntax-table - (forward-sexp 1)) - (point)))))) - (if end-point - (cons (point) end-point)))) - (defun bibtex-parse-association (parse-lhs parse-rhs) "Parse a string of the format <left-hand-side = right-hand-side>. The functions PARSE-LHS and PARSE-RHS are used to parse the corresponding @@ -1199,6 +1163,44 @@ ;; Now try again. (bibtex-parse-field-name)))) +(defconst bibtex-braced-string-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?\{ "(}" st) + (modify-syntax-entry ?\} "){" st) + (modify-syntax-entry ?\[ "." st) + (modify-syntax-entry ?\] "." st) + (modify-syntax-entry ?\( "." st) + (modify-syntax-entry ?\) "." st) + (modify-syntax-entry ?\\ "." st) + (modify-syntax-entry ?\" "." st) + st) + "Syntax-table to parse matched braces.") + +(defconst bibtex-quoted-string-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?\\ "\\" st) + (modify-syntax-entry ?\" "\"" st) + st) + "Syntax-table to parse matched quotes.") + +(defun bibtex-parse-field-string () + "Parse a field string enclosed by braces or quotes. +If a syntactically correct string is found, a pair containing the start and +end position of the field string is returned, nil otherwise." + (let ((end-point + (or (and (eq (following-char) ?\") + (save-excursion + (with-syntax-table bibtex-quoted-string-syntax-table + (forward-sexp 1)) + (point))) + (and (eq (following-char) ?\{) + (save-excursion + (with-syntax-table bibtex-braced-string-syntax-table + (forward-sexp 1)) + (point)))))) + (if end-point + (cons (point) end-point)))) + (defun bibtex-parse-field-text () "Parse the text part of a BibTeX field. The text part is either a string, or an empty string, or a constant followed @@ -1410,7 +1412,7 @@ (let ((content (buffer-substring-no-properties (nth 0 (cdr bounds)) (nth 1 (cdr bounds))))) (if (and remove-delim - (string-match "\\`{\\(.*\\)}\\'" content)) + (string-match "\\`[{\"]\\(.*\\)[}\"]\\'" content)) (substring content (match-beginning 1) (match-end 1)) content))) @@ -1455,16 +1457,6 @@ (setq list (cdr list))) list)) -(defun bibtex-assoc-of-regexp (string alist) - "Return non-nil if STRING is exactly matched by the car of an -element of ALIST (case ignored). The value is actually the element -of LIST whose car matches STRING." - (let ((case-fold-search t)) - (while (and alist - (not (string-match (concat "\\`\\(?:" (caar alist) "\\)\\'") string))) - (setq alist (cdr alist))) - (car alist))) - (defun bibtex-skip-to-valid-entry (&optional backward) "Unless at beginning of a valid BibTeX entry, move point to beginning of the next valid one. With optional argument BACKWARD non-nil, move backward to @@ -1510,7 +1502,7 @@ (save-excursion (if (or (and (not bibtex-sort-ignore-string-entries) (string-equal "string" (downcase entry-type))) - (assoc-ignore-case entry-type bibtex-entry-field-alist)) + (assoc-string entry-type bibtex-entry-field-alist t)) (funcall fun key beg end))) (goto-char end))))) @@ -1519,8 +1511,8 @@ If FLAG is a string, the message is initialized (in this case a value for INTERVAL may be given as well (if not this is set to 5)). If FLAG is done, the message is deinitialized. -If FLAG is absent, a message is echoed if point was incremented -at least INTERVAL percent since last message was echoed." +If FLAG is nil, a message is echoed if point was incremented at least +`bibtex-progress-interval' percent since last message was echoed." (cond ((stringp flag) (setq bibtex-progress-lastmes flag) (setq bibtex-progress-interval (or interval 5) @@ -1685,11 +1677,11 @@ "Try to avoid point being at end of a BibTeX field." (end-of-line) (skip-chars-backward " \t") - (cond ((= (preceding-char) ?,) - (forward-char -2))) - (cond ((or (= (preceding-char) ?}) - (= (preceding-char) ?\")) - (forward-char -1)))) + (if (= (preceding-char) ?,) + (forward-char -2)) + (if (or (= (preceding-char) ?}) + (= (preceding-char) ?\")) + (forward-char -1))) (defun bibtex-enclosing-field (&optional noerr) "Search for BibTeX field enclosing point. Point moves to end of field. @@ -1749,6 +1741,15 @@ (error "Unknown tag field: %s. Please submit a bug report" bibtex-last-kill-command)))))) +(defun bibtex-assoc-regexp (regexp alist) + "Return non-nil if REGEXP matches the car of an element of ALIST. +The value is actually the element of ALIST matched by REGEXP. +Case is ignored if `case-fold-search' is non-nil in the current buffer." + (while (and alist + (not (string-match regexp (caar alist)))) + (setq alist (cdr alist))) + (car alist)) + (defun bibtex-format-entry () "Helper function for `bibtex-clean-entry'. Formats current entry according to variable `bibtex-entry-format'." @@ -1763,18 +1764,17 @@ unify-case inherit-booktitle) bibtex-entry-format)) crossref-key bounds alternatives-there non-empty-alternative - entry-list req creq field-done field-list) + entry-list req-field-list field-done field-list) ;; identify entry type (goto-char (point-min)) (re-search-forward bibtex-entry-type) (let ((beg-type (1+ (match-beginning 0))) (end-type (match-end 0))) - (setq entry-list (assoc-ignore-case (buffer-substring-no-properties - beg-type end-type) - bibtex-entry-field-alist) - req (nth 0 (nth 1 entry-list)) ; required part - creq (nth 0 (nth 2 entry-list))) ; crossref part + (setq entry-list (assoc-string (buffer-substring-no-properties + beg-type end-type) + bibtex-entry-field-alist + t)) ;; unify case of entry name (when (memq 'unify-case format) @@ -1791,20 +1791,32 @@ ;; determine if entry has crossref field and if at least ;; one alternative is non-empty (goto-char (point-min)) - (while (setq bounds (bibtex-search-forward-field - bibtex-field-name)) - (goto-char (bibtex-start-of-name-in-field bounds)) - (cond ((looking-at "ALT") - (setq alternatives-there t) - (goto-char (bibtex-start-of-text-in-field bounds)) - (if (not (looking-at bibtex-empty-field-re)) - (setq non-empty-alternative t))) - ((and (looking-at "\\(OPT\\)?crossref\\>") - (progn (goto-char (bibtex-start-of-text-in-field bounds)) - (not (looking-at bibtex-empty-field-re)))) - (setq crossref-key - (bibtex-text-in-field-bounds bounds t)))) - (goto-char (bibtex-end-of-field bounds))) + (let* ((fields-alist (bibtex-parse-entry)) + (case-fold-search t) + (field (bibtex-assoc-regexp "\\`\\(OPT\\)?crossref\\'" + fields-alist))) + (setq crossref-key (and field + (not (string-match bibtex-empty-field-re + (cdr field))) + (cdr field)) + req-field-list (if crossref-key + (nth 0 (nth 2 entry-list)) ; crossref part + (nth 0 (nth 1 entry-list)))) ; required part + + (dolist (rfield req-field-list) + (when (nth 3 rfield) ; we should have an alternative + (setq alternatives-there t + field (bibtex-assoc-regexp + (concat "\\`\\(ALT\\)?" (car rfield) "\\'") + fields-alist)) + (if (and field + (not (string-match bibtex-empty-field-re + (cdr field)))) + (cond ((not non-empty-alternative) + (setq non-empty-alternative t)) + ((memq 'required-fields format) + (error "More than one non-empty alternative."))))))) + (if (and alternatives-there (not non-empty-alternative) (memq 'required-fields format)) @@ -1832,18 +1844,23 @@ ;; quite some redundancy compared with what we need to do ;; anyway. So for speed-up we avoid using them. - (when (and opt-alt - (memq 'opts-or-alts format)) - (if empty-field - ;; Either it is an empty ALT field. Then we have checked - ;; already that we have one non-empty alternative. - ;; Or it is an empty OPT field that we do not miss anyway. - ;; So we can safely delete this field. - (progn (delete-region beg-field end-field) - (setq deleted t)) - ;; otherwise: not empty, delete "OPT" or "ALT" - (goto-char beg-name) - (delete-char 3))) + (if (memq 'opts-or-alts format) + (cond ((and empty-field + (or opt-alt + (let ((field (assoc-string + field-name req-field-list t))) + (or (not field) ; OPT field + (nth 3 field))))) ; ALT field + ;; Either it is an empty ALT field. Then we have checked + ;; already that we have one non-empty alternative. Or it + ;; is an empty OPT field that we do not miss anyway. + ;; So we can safely delete this field. + (delete-region beg-field end-field) + (setq deleted t)) + ;; otherwise: not empty, delete "OPT" or "ALT" + (opt-alt + (goto-char beg-name) + (delete-char 3)))) (unless deleted (push field-name field-list) @@ -1902,16 +1919,17 @@ ;; if empty field, complain (if (and empty-field (memq 'required-fields format) - (assoc-ignore-case field-name - (if crossref-key creq req))) + (assoc-string field-name req-field-list t)) (error "Mandatory field `%s' is empty" field-name)) ;; unify case of field name (if (memq 'unify-case format) - (let ((fname (car (assoc-ignore-case - field-name (append (nth 0 (nth 1 entry-list)) - (nth 1 (nth 1 entry-list)) - bibtex-user-optional-fields))))) + (let ((fname (car (assoc-string + field-name + (append (nth 0 (nth 1 entry-list)) + (nth 1 (nth 1 entry-list)) + bibtex-user-optional-fields) + t)))) (if fname (progn (delete-region beg-name end-name) @@ -1925,8 +1943,8 @@ ;; check whether all required fields are present (if (memq 'required-fields format) - (let (altlist (found 0)) - (dolist (fname (if crossref-key creq req)) + (let ((found 0) altlist) + (dolist (fname req-field-list) (if (nth 3 fname) (push (car fname) altlist)) (unless (or (member (car fname) field-list) @@ -1940,7 +1958,7 @@ (error "Alternative mandatory field `%s' is missing" altlist)) ((> found 1) - (error "Alternative fields `%s' is defined %s times" + (error "Alternative fields `%s' are defined %s times" altlist found)))))) ;; update point @@ -2051,8 +2069,8 @@ (setq titlestring (substring titlestring 0 (match-beginning 0)))))) ;; gather words from titlestring into a list. Ignore ;; specific words and use only a specific amount of words. - (let (case-fold-search titlewords titlewords-extra titleword end-match - (counter 0)) + (let ((counter 0) + case-fold-search titlewords titlewords-extra titleword end-match) (while (and (or (not (numberp bibtex-autokey-titlewords)) (< counter (+ bibtex-autokey-titlewords bibtex-autokey-titlewords-stretch))) @@ -2079,10 +2097,14 @@ "Do some abbreviations on TITLEWORD. The rules are defined in `bibtex-autokey-titleword-abbrevs' and `bibtex-autokey-titleword-length'." - (let ((abbrev (bibtex-assoc-of-regexp - titleword bibtex-autokey-titleword-abbrevs))) - (if abbrev - (cdr abbrev) + (let ((case-folde-search t) + (alist bibtex-autokey-titleword-abbrevs)) + (while (and alist + (not (string-match (concat "\\`\\(?:" (caar alist) "\\)\\'") + titleword))) + (setq alist (cdr alist))) + (if alist + (cdar alist) (bibtex-autokey-abbrev titleword bibtex-autokey-titleword-length)))) @@ -2239,8 +2261,8 @@ ;; This is a crossref. (buffer-substring-no-properties (1+ (match-beginning 3)) (1- (match-end 3)))) - ((assoc-ignore-case (bibtex-type-in-head) - bibtex-entry-field-alist) + ((assoc-string (bibtex-type-in-head) + bibtex-entry-field-alist t) ;; This is an entry. (match-string-no-properties bibtex-key-in-head))))) (if (and (stringp key) @@ -2295,7 +2317,7 @@ ;; user has aborted by typing a key --> return `aborted' (throw 'userkey 'aborted)) (setq key (bibtex-reference-key-in-string bounds)) - (if (not (assoc-ignore-case key strings)) + (if (not (assoc key strings)) (push (cons key (bibtex-text-in-string bounds t)) strings)) (goto-char (bibtex-end-of-text-in-string bounds))) @@ -2384,6 +2406,7 @@ (display-completion-list (all-completions part-of-word completions))) (message "Making completion list...done") + ;; return value is handled by choose-completion-string-functions nil)))) (defun bibtex-complete-string-cleanup (str) @@ -2629,6 +2652,34 @@ (easy-menu-add bibtex-entry-menu) (run-hooks 'bibtex-mode-hook)) +(defun bibtex-field-list (entry-type) + "Return list of allowed fields for entry ENTRY-TYPE. +More specifically, the return value is a cons pair (REQUIRED . OPTIONAL), +where REQUIRED and OPTIONAL are lists of the required and optional field +names for ENTRY-TYPE according to `bibtex-entry-field-alist'." + (let ((e (assoc-string entry-type bibtex-entry-field-alist t)) + required optional) + (unless e + (error "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)) + optional (nth 1 (nth 2 e))) + (setq required (nth 0 (nth 1 e)) + optional (nth 1 (nth 1 e)))) + (if bibtex-include-OPTkey + (push (list "key" + "Used for reference key creation if author and editor fields are missing" + (if (or (stringp bibtex-include-OPTkey) + (fboundp bibtex-include-OPTkey)) + bibtex-include-OPTkey)) + optional)) + (if (member-ignore-case entry-type bibtex-include-OPTcrossref) + (push '("crossref" "Reference key of the cross-referenced entry") + optional)) + (setq optional (append optional bibtex-user-optional-fields)) + (cons required optional))) + (defun bibtex-entry (entry-type) "Insert a new BibTeX entry. After insertion it calls the functions in `bibtex-add-entry-hook'." @@ -2638,38 +2689,17 @@ bibtex-entry-field-alist nil t nil 'bibtex-entry-type-history))) (list e-t))) - (let* (required optional - (key (if bibtex-maintain-sorted-entries - (bibtex-read-key (format "%s key: " entry-type)))) - (e (assoc-ignore-case entry-type bibtex-entry-field-alist)) - (r-n-o (elt e 1)) - (c-ref (elt e 2))) - (if (not e) - (error "Bibtex entry type %s not defined" entry-type)) - (if (and (member entry-type bibtex-include-OPTcrossref) - c-ref) - (setq required (elt c-ref 0) - optional (elt c-ref 1)) - (setq required (elt r-n-o 0) - optional (elt r-n-o 1))) + (let ((key (if bibtex-maintain-sorted-entries + (bibtex-read-key (format "%s key: " entry-type)))) + (field-list (bibtex-field-list entry-type))) (unless (bibtex-prepare-new-entry (list key nil entry-type)) (error "Entry with key `%s' already exists" key)) (indent-to-column bibtex-entry-offset) (insert "@" entry-type (bibtex-entry-left-delimiter)) - (if key - (insert key)) + (if key (insert key)) (save-excursion - (mapcar 'bibtex-make-field required) - (if (member entry-type bibtex-include-OPTcrossref) - (bibtex-make-optional-field '("crossref"))) - (if bibtex-include-OPTkey - (if (or (stringp bibtex-include-OPTkey) - (fboundp bibtex-include-OPTkey)) - (bibtex-make-optional-field - (list "key" nil bibtex-include-OPTkey)) - (bibtex-make-optional-field '("key")))) - (mapcar 'bibtex-make-optional-field optional) - (mapcar 'bibtex-make-optional-field bibtex-user-optional-fields) + (mapcar 'bibtex-make-field (car field-list)) + (mapcar 'bibtex-make-optional-field (cdr field-list)) (if bibtex-comma-after-last-field (insert ",")) (insert "\n") @@ -2680,15 +2710,39 @@ (bibtex-autofill-entry)) (run-hooks 'bibtex-add-entry-hook))) +(defun bibtex-entry-update () + "Update an existing BibTeX entry. +In the BibTeX entry at point, make new fields for those items that may occur +according to `bibtex-entry-field-alist', but are not yet present." + (interactive) + (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. + (let* ((fields-alist (bibtex-parse-entry)) + (field-list (bibtex-field-list + (substring (cdr (assoc "=type=" fields-alist)) + 1))) ; don't want @ + (case-fold-search t)) + (dolist (field (car field-list)) + (unless (bibtex-assoc-regexp (concat "\\`\\(ALT\\)?" (car field) "\\'") + fields-alist) + (bibtex-make-field field))) + (dolist (field (cdr field-list)) + (unless (bibtex-assoc-regexp (concat "\\`\\(OPT\\)?" (car field) "\\'") + fields-alist) + (bibtex-make-optional-field field)))))) + (defun bibtex-parse-entry () "Parse entry at point, return an alist. The alist elements have the form (FIELD . TEXT), where FIELD can also be -the special strings \"=type=\" and \"=key=\"." +the special strings \"=type=\" and \"=key=\". For the FIELD \"=key=\" +TEXT may be nil. Move point to the end of the last field." (let (alist bounds) - (when (looking-at bibtex-entry-head) + (when (looking-at bibtex-entry-maybe-empty-head) (push (cons "=type=" (match-string bibtex-type-in-head)) alist) (push (cons "=key=" (match-string bibtex-key-in-head)) alist) - (goto-char (match-end bibtex-key-in-head)) + (goto-char (match-end 0)) (while (setq bounds (bibtex-parse-field bibtex-field-name)) (push (cons (bibtex-name-in-field bounds) (bibtex-text-in-field-bounds bounds)) @@ -2744,7 +2798,7 @@ (let* ((name (buffer-substring (if (looking-at "ALT\\|OPT") (match-end 0) (point)) (bibtex-end-of-name-in-field bounds))) - (text (assoc-ignore-case name other))) + (text (assoc-string name other t))) (goto-char (bibtex-start-of-text-in-field bounds)) (if (not (and (looking-at bibtex-empty-field-re) text)) (goto-char (bibtex-end-of-field bounds)) @@ -2774,28 +2828,15 @@ (looking-at "OPT\\|ALT")) (match-end 0) mb) (bibtex-end-of-name-in-field bounds))) - (entry-type (progn (re-search-backward - bibtex-entry-maybe-empty-head nil t) - (bibtex-type-in-head))) - (entry-list (assoc-ignore-case entry-type - bibtex-entry-field-alist)) - (c-r-list (elt entry-list 2)) - (req-opt-list (if (and (member entry-type - bibtex-include-OPTcrossref) - c-r-list) - c-r-list - (elt entry-list 1))) - (list-of-entries (append (elt req-opt-list 0) - (elt req-opt-list 1) - bibtex-user-optional-fields - (if (member entry-type - bibtex-include-OPTcrossref) - '(("crossref" "Reference key of the cross-referenced entry"))) - (if bibtex-include-OPTkey - '(("key" "Used for reference key creation if author and editor fields are missing"))))) - (comment (assoc-ignore-case field-name list-of-entries))) + (field-list (bibtex-field-list (progn (re-search-backward + bibtex-entry-maybe-empty-head nil t) + (bibtex-type-in-head)))) + (comment (assoc-string field-name + (append (car field-list) + (cdr field-list)) + t))) (if comment - (message (elt comment 1)) + (message (nth 1 comment)) (message "No comment available"))))) (defun bibtex-make-field (field &optional called-by-yank) @@ -2804,24 +2845,13 @@ \(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG) as in `bibtex-entry-field-alist'." (interactive - (list (let* ((entry-type - (save-excursion - (bibtex-enclosing-entry-maybe-empty-head) - (bibtex-type-in-head))) - ;; "preliminary" completion list - (fl (nth 1 (assoc-ignore-case - entry-type bibtex-entry-field-alist))) - ;; "full" completion list - (field-list (append (nth 0 fl) - (nth 1 fl) - bibtex-user-optional-fields - (if (member entry-type - bibtex-include-OPTcrossref) - '(("crossref"))) - (if bibtex-include-OPTkey - '(("key"))))) - (completion-ignore-case t)) - (completing-read "BibTeX field name: " field-list + (list (let ((completion-ignore-case t) + (field-list (bibtex-field-list + (save-excursion + (bibtex-enclosing-entry-maybe-empty-head) + (bibtex-type-in-head))))) + (completing-read "BibTeX field name: " + (append (car field-list) (cdr field-list)) nil nil nil bibtex-field-history)))) (unless (consp field) (setq field (list field))) @@ -2848,8 +2878,9 @@ ((fboundp init) (insert (funcall init))))) (if (not called-by-yank) (insert (bibtex-field-right-delimiter))) - (if (interactive-p) - (forward-char -1))) + (when (interactive-p) + (forward-char -1) + (bibtex-print-help-message))) (defun bibtex-beginning-of-entry () "Move to beginning of BibTeX entry (beginning of line). @@ -2982,13 +3013,14 @@ "\\(OPT\\)?crossref" t))) (list key (if bounds (bibtex-text-in-field-bounds bounds t)) - entry-name)))) - (list key nil entry-name))))) + entry-name))) + (list key nil entry-name)))))) (defun bibtex-lessp (index1 index2) "Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2. Each index is a list (KEY CROSSREF-KEY ENTRY-NAME). -The predicate depends on the variable `bibtex-maintain-sorted-entries'." +The predicate depends on the variable `bibtex-maintain-sorted-entries'. +If its value is nil use plain sorting." (cond ((not index1) (not index2)) ; indices can be nil ((not index2) nil) ((equal bibtex-maintain-sorted-entries 'crossref) @@ -3017,12 +3049,10 @@ (defun bibtex-sort-buffer () "Sort BibTeX buffer alphabetically by key. The predicate for sorting is defined via `bibtex-maintain-sorted-entries'. -Text outside of BibTeX entries is not affected. If -`bibtex-sort-ignore-string-entries' is non-nil, @String entries will be -ignored." +If its value is nil use plain sorting. Text outside of BibTeX entries is not +affected. If `bibtex-sort-ignore-string-entries' is non-nil, @String entries +will be ignored." (interactive) - (unless bibtex-maintain-sorted-entries - (error "You must choose a sorting scheme")) (save-restriction (narrow-to-region (bibtex-beginning-of-first-entry) (save-excursion (goto-char (point-max)) @@ -3212,8 +3242,8 @@ (let* ((entry-list (progn (goto-char beg) (bibtex-search-entry nil end) - (assoc-ignore-case (bibtex-type-in-head) - bibtex-entry-field-alist))) + (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) @@ -3229,8 +3259,8 @@ (push (list (bibtex-current-line) "Questionable month field") error-list)) - (setq req (delete (assoc-ignore-case field-name req) req) - creq (delete (assoc-ignore-case field-name creq) creq)) + (setq req (delete (assoc-string field-name req t) req) + creq (delete (assoc-string field-name creq t) creq)) (if (equal field-name "crossref") (setq crossref-there t)))) (if crossref-there @@ -3523,27 +3553,30 @@ (match-end bibtex-key-in-head))) (insert key)) ;; sorting - (let* ((start (bibtex-beginning-of-entry)) - (end (progn (bibtex-end-of-entry) - (if (re-search-forward - bibtex-entry-maybe-empty-head nil 'move) - (goto-char (match-beginning 0))) - (point))) - (entry (buffer-substring start end)) - (index (progn (goto-char start) - (bibtex-entry-index)))) - (delete-region start end) - (unless (prog1 (or called-by-reformat - (if (and bibtex-maintain-sorted-entries - (not (and bibtex-sort-ignore-string-entries - (equal entry-type "string")))) - (bibtex-prepare-new-entry index) - (not (bibtex-find-entry (car index))))) - (insert entry) - (forward-char -1) - (bibtex-beginning-of-entry) ; moves backward - (re-search-forward bibtex-entry-head)) - (error "New inserted entry yields duplicate key"))) + (unless called-by-reformat + (let* ((start (bibtex-beginning-of-entry)) + (end (progn (bibtex-end-of-entry) + (if (re-search-forward + bibtex-entry-maybe-empty-head nil 'move) + (goto-char (match-beginning 0))) + (point))) + (entry (buffer-substring start end)) + (index (progn (goto-char start) + (bibtex-entry-index))) + no-error) + (if (and bibtex-maintain-sorted-entries + (not (and bibtex-sort-ignore-string-entries + (equal entry-type "string")))) + (progn + (delete-region start end) + (setq no-error (bibtex-prepare-new-entry index)) + (insert entry) + (forward-char -1) + (bibtex-beginning-of-entry) ; moves backward + (re-search-forward bibtex-entry-head)) + (setq no-error (bibtex-find-entry (car index)))) + (unless no-error + (error "New inserted entry yields duplicate key")))) ;; final clean up (unless called-by-reformat (save-excursion @@ -3621,91 +3654,89 @@ (indent-to-column bibtex-entry-offset) (goto-char pnt))) -(defun bibtex-reformat (&optional additional-options called-by-convert-alien) +(defun bibtex-realign () + "Realign BibTeX entries such that they are separated by one blank line." + (goto-char (point-min)) + (let ((case-fold-search t)) + (when (looking-at bibtex-valid-entry-whitespace-re) + (replace-match "\\1")) + (while (re-search-forward bibtex-valid-entry-whitespace-re nil t) + (replace-match "\n\n\\1")))) + +(defun bibtex-reformat (&optional read-options) "Reformat all BibTeX entries in buffer or region. With prefix argument, read options for reformatting from minibuffer. With \\[universal-argument] \\[universal-argument] prefix argument, reuse previous answers (if any) again. -If mark is active it reformats entries in region, if not in whole buffer." +If mark is active reformat entries in region, if not in whole buffer." (interactive "*P") (let* ((pnt (point)) (use-previous-options - (and (equal (prefix-numeric-value additional-options) 16) + (and (equal (prefix-numeric-value read-options) 16) (or bibtex-reformat-previous-options bibtex-reformat-previous-reference-keys))) (bibtex-entry-format - (if additional-options + (if read-options (if use-previous-options bibtex-reformat-previous-options (setq bibtex-reformat-previous-options - (delq nil (list - (if (or called-by-convert-alien - (y-or-n-p "Realign entries (recommended)? ")) - 'realign) - (if (y-or-n-p "Remove empty optional and alternative fields? ") - 'opts-or-alts) - (if (y-or-n-p "Remove delimiters around pure numerical fields? ") - 'numerical-fields) - (if (y-or-n-p (concat (if bibtex-comma-after-last-field "Insert" "Remove") - " comma at end of entry? ")) - 'last-comma) - (if (y-or-n-p "Replace double page dashes by single ones? ") - 'page-dashes) - (if (y-or-n-p "Force delimiters? ") - 'delimiters) - (if (y-or-n-p "Unify case of entry types and field names? ") - 'unify-case))))) + (mapcar (lambda (option) + (if (y-or-n-p (car option)) (cdr option))) + `(("Realign entries (recommended)? " . 'realign) + ("Remove empty optional and alternative fields? " . 'opts-or-alts) + ("Remove delimiters around pure numerical fields? " . 'numerical-fields) + (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") + " comma at end of entry? ") . 'last-comma) + ("Replace double page dashes by single ones? " . 'page-dashes) + ("Force delimiters? " . 'delimiters) + ("Unify case of entry types and field names? " . 'unify-case))))) '(realign))) - (reformat-reference-keys (if additional-options - (if use-previous-options - bibtex-reformat-previous-reference-keys - (setq bibtex-reformat-previous-reference-keys - (y-or-n-p "Generate new reference keys automatically? "))))) - bibtex-autokey-edit-before-use - (bibtex-sort-ignore-string-entries t) + (reformat-reference-keys + (if read-options + (if use-previous-options + bibtex-reformat-previous-reference-keys + (setq bibtex-reformat-previous-reference-keys + (y-or-n-p "Generate new reference keys automatically? "))))) (start-point (if (bibtex-mark-active) (region-beginning) - (bibtex-beginning-of-first-entry) - (bibtex-skip-to-valid-entry) - (point))) + (point-min))) (end-point (if (bibtex-mark-active) (region-end) - (point-max)))) + (point-max))) + (bibtex-sort-ignore-string-entries t) + bibtex-autokey-edit-before-use) + (save-restriction (narrow-to-region start-point end-point) - (when (memq 'realign bibtex-entry-format) - (goto-char (point-min)) - (while (re-search-forward bibtex-valid-entry-whitespace-re nil t) - (replace-match "\n\\1"))) + (if (memq 'realign bibtex-entry-format) + (bibtex-realign)) (goto-char start-point) (bibtex-progress-message "Formatting" 1) (bibtex-map-entries (lambda (key beg end) (bibtex-progress-message) - (bibtex-clean-entry reformat-reference-keys t) - (when (memq 'realign bibtex-entry-format) - (goto-char end) - (bibtex-delete-whitespace) - (open-line 2)))) + (bibtex-clean-entry reformat-reference-keys t))) + (when (memq 'realign bibtex-entry-format) + (bibtex-delete-whitespace) + (open-line (if (eobp) 1 2))) (bibtex-progress-message 'done)) (when (and reformat-reference-keys - bibtex-maintain-sorted-entries - (not called-by-convert-alien)) + bibtex-maintain-sorted-entries) + (bibtex-progress-message "Sorting" 1) (bibtex-sort-buffer) - (kill-local-variable 'bibtex-reference-keys)) + (kill-local-variable 'bibtex-reference-keys) + (bibtex-progress-message 'done)) (goto-char pnt))) -(defun bibtex-convert-alien (&optional do-additional-reformatting) +(defun bibtex-convert-alien (&optional read-options) "Convert an alien BibTeX buffer to be fully usable by BibTeX mode. -If a file does not conform with some standards used by BibTeX mode, +If a file does not conform with all standards used by BibTeX mode, some of the high-level features of BibTeX mode will not be available. This function tries to convert current buffer to conform with these standards. -With prefix argument DO-ADDITIONAL-REFORMATTING -non-nil, read options for reformatting entries from minibuffer." +With prefix argument READ-OPTIONS non-nil, read options for reformatting +entries from minibuffer." (interactive "*P") (message "Starting to validate buffer...") (sit-for 1 nil t) - (goto-char (point-min)) - (while (re-search-forward "[ \t\n]+@" nil t) - (replace-match "\n@")) + (bibtex-realign) (message "If errors occur, correct them and call `bibtex-convert-alien' again") (sit-for 5 nil t) @@ -3714,10 +3745,7 @@ (bibtex-validate)) (message "Starting to reformat entries...") (sit-for 2 nil t) - (bibtex-reformat do-additional-reformatting t) - (when bibtex-maintain-sorted-entries - (message "Starting to sort buffer...") - (bibtex-sort-buffer)) + (bibtex-reformat read-options) (goto-char (point-max)) (message "Buffer is now parsable. Please save it."))) @@ -3890,5 +3918,5 @@ (provide 'bibtex) -;;; arch-tag: ee2be3af-caad-427f-b42a-d20fad630d04 +;; arch-tag: ee2be3af-caad-427f-b42a-d20fad630d04 ;;; bibtex.el ends here