/[emacs]/emacs/lisp/textmodes/bibtex.el
ViewVC logotype

Diff of /emacs/lisp/textmodes/bibtex.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.77.2.3 by miles, Wed Sep 15 08:59:53 2004 UTC revision 1.77.2.4 by miles, Thu Nov 4 08:55:40 2004 UTC
# Line 42  Line 42 
42    
43  ;;; Code:  ;;; Code:
44    
45    (require 'button)
46    
47    
48  ;; User Options:  ;; User Options:
49    
# Line 496  Each element is a pair of strings (ABBRE Line 498  Each element is a pair of strings (ABBRE
498    
499  (defcustom bibtex-string-files nil  (defcustom bibtex-string-files nil
500    "*List of BibTeX files containing string definitions.    "*List of BibTeX files containing string definitions.
501  Those files must be specified using pathnames relative to the  List elements can be absolute file names or file names relative to the
502  directories specified in `bibtex-string-file-path'."  directories specified in `bibtex-string-file-path'."
503    :group 'bibtex    :group 'bibtex
504    :type '(repeat file))    :type '(repeat file))
# Line 504  directories specified in `bibtex-string- Line 506  directories specified in `bibtex-string-
506  (defvar bibtex-string-file-path (getenv "BIBINPUTS")  (defvar bibtex-string-file-path (getenv "BIBINPUTS")
507    "*Colon separated list of paths to search for `bibtex-string-files'.")    "*Colon separated list of paths to search for `bibtex-string-files'.")
508    
509    (defcustom bibtex-files nil
510      "*List of BibTeX files checked for duplicate keys.
511    List elements can be absolute file names or file names relative to the
512    directories specified in `bibtex-file-path'.  If an element is a directory,
513    check all BibTeX files in this directory.  If an element is the symbol
514    `bibtex-file-path', check all BibTeX files in `bibtex-file-path'."
515      :group 'bibtex
516      :type '(repeat file))
517    
518    (defvar bibtex-file-path (getenv "BIBINPUTS")
519      "*Colon separated list of paths to search for `bibtex-files'.")
520    
521  (defcustom bibtex-help-message t  (defcustom bibtex-help-message t
522    "*If non-nil print help messages in the echo area on entering a new field."    "*If non-nil print help messages in the echo area on entering a new field."
523    :group 'bibtex    :group 'bibtex
# Line 557  See `bibtex-generate-autokey' for detail Line 571  See `bibtex-generate-autokey' for detail
571      ;; braces, quotes, concatenation.      ;; braces, quotes, concatenation.
572      ("[`'\"{}#]" . "")      ("[`'\"{}#]" . "")
573      ;; spaces      ;; spaces
574      ("[ \t\n]+" . " "))      ("\\\\?[ \t\n]+\\|~" . " "))
575    "Alist of (OLD-REGEXP . NEW-STRING) pairs.    "Alist of (OLD-REGEXP . NEW-STRING) pairs.
576  Used by the default values of `bibtex-autokey-name-change-strings' and  Used by the default values of `bibtex-autokey-name-change-strings' and
577  `bibtex-autokey-titleword-change-strings'.  Defaults to translating some  `bibtex-autokey-titleword-change-strings'.  Defaults to translating some
# Line 756  If non-nil, the column for the equal sig Line 770  If non-nil, the column for the equal sig
770    
771  (defcustom bibtex-autoadd-commas t  (defcustom bibtex-autoadd-commas t
772    "If non-nil automatically add missing commas at end of BibTeX fields."    "If non-nil automatically add missing commas at end of BibTeX fields."
773      :group 'bibtex
774    :type 'boolean)    :type 'boolean)
775    
776  (defcustom bibtex-autofill-types '("Proceedings")  (defcustom bibtex-autofill-types '("Proceedings")
777    "Automatically fill fields if possible for those BibTeX entry types."    "Automatically fill fields if possible for those BibTeX entry types."
778      :group 'bibtex
779    :type '(repeat string))    :type '(repeat string))
780    
781    (defcustom bibtex-summary-function 'bibtex-summary
782      "Function to call for generating a one-line summary of a BibTeX entry.
783    It takes one argument, the key of the entry.
784    Used by `bibtex-complete-key-cleanup' and `bibtex-copy-summary-as-kill'."
785      :group 'bibtex
786      :type '(choice (const :tag "Default" bibtex-summary)
787                     (function :tag "Personalized function")))
788    
789  (defcustom bibtex-generate-url-list  (defcustom bibtex-generate-url-list
790    '((("url" . ".*:.*"))    '((("url" . ".*:.*"))
791      ;; Example of a complex setup.      ;; Example of a complex setup.
# Line 778  These schemes are used by `bibtex-url'. Line 802  These schemes are used by `bibtex-url'.
802  Each scheme is of the form ((FIELD . REGEXP) STEP...).  Each scheme is of the form ((FIELD . REGEXP) STEP...).
803    
804  FIELD is a field name as returned by `bibtex-parse-entry'.  FIELD is a field name as returned by `bibtex-parse-entry'.
805  REGEXP is matched against the text of FIELD.  If the match succeed, then  REGEXP is matched against the text of FIELD.  If the match succeeds, then
806  this scheme will be used.  If no STEPS are specified the matched text is used  this scheme will be used.  If no STEPS are specified the matched text is used
807  as the URL, otherwise the URL is built by concatenating the STEPS.  as the URL, otherwise the URL is built by concatenating the STEPS.
808    
# Line 838  Case is always ignored.  Always remove t Line 862  Case is always ignored.  Always remove t
862      (define-key km "\C-c\C-c" 'bibtex-clean-entry)      (define-key km "\C-c\C-c" 'bibtex-clean-entry)
863      (define-key km "\C-c\C-q" 'bibtex-fill-entry)      (define-key km "\C-c\C-q" 'bibtex-fill-entry)
864      (define-key km "\C-c\C-s" 'bibtex-find-entry)      (define-key km "\C-c\C-s" 'bibtex-find-entry)
865        (define-key km "\C-c\C-t" 'bibtex-copy-summary-as-kill)
866      (define-key km "\C-c?" 'bibtex-print-help-message)      (define-key km "\C-c?" 'bibtex-print-help-message)
867      (define-key km "\C-c\C-p" 'bibtex-pop-previous)      (define-key km "\C-c\C-p" 'bibtex-pop-previous)
868      (define-key km "\C-c\C-n" 'bibtex-pop-next)      (define-key km "\C-c\C-n" 'bibtex-pop-next)
# Line 892  Case is always ignored.  Always remove t Line 917  Case is always ignored.  Always remove t
917      ("Moving in BibTeX Buffer"      ("Moving in BibTeX Buffer"
918       ["Find Entry" bibtex-find-entry t]       ["Find Entry" bibtex-find-entry t]
919       ["Find Crossref Entry" bibtex-find-crossref t])       ["Find Crossref Entry" bibtex-find-crossref t])
920       "--"      ("Moving between BibTeX Buffers"
921         ["Find Entry Globally" bibtex-find-entry-globally t])
922        "--"
923      ("Operating on Current Field"      ("Operating on Current Field"
924       ["Fill Field" fill-paragraph t]       ["Fill Field" fill-paragraph t]
925       ["Remove Delimiters" bibtex-remove-delimiters t]       ["Remove Delimiters" bibtex-remove-delimiters t]
# Line 922  Case is always ignored.  Always remove t Line 949  Case is always ignored.  Always remove t
949       ["Paste Most Recently Killed Entry" bibtex-yank t]       ["Paste Most Recently Killed Entry" bibtex-yank t]
950       ["Paste Previously Killed Entry" bibtex-yank-pop t]       ["Paste Previously Killed Entry" bibtex-yank-pop t]
951       "--"       "--"
952         ["Copy Summary to Kill Ring" bibtex-copy-summary-as-kill t]
953         "--"
954       ["Ispell Entry" bibtex-ispell-entry t]       ["Ispell Entry" bibtex-ispell-entry t]
955       ["Ispell Entry Abstract" bibtex-ispell-abstract t]       ["Ispell Entry Abstract" bibtex-ispell-abstract t]
956       ["Narrow to Entry" bibtex-narrow-to-entry t]       ["Narrow to Entry" bibtex-narrow-to-entry t]
# Line 934  Case is always ignored.  Always remove t Line 963  Case is always ignored.  Always remove t
963       ["Reformat Entries" bibtex-reformat t]       ["Reformat Entries" bibtex-reformat t]
964       ["Count Entries" bibtex-count-entries t]       ["Count Entries" bibtex-count-entries t]
965       "--"       "--"
966       ["Convert Alien Buffer" bibtex-convert-alien t])))       ["Convert Alien Buffer" bibtex-convert-alien t])
967        ("Operating on Multiple Buffers"
968         ["Validate Entries" bibtex-validate-globally t])))
969    
970  (easy-menu-define  (easy-menu-define
971    bibtex-entry-menu bibtex-mode-map "Entry-Types Menu in BibTeX mode"    bibtex-entry-menu bibtex-mode-map "Entry-Types Menu in BibTeX mode"
# Line 955  Case is always ignored.  Always remove t Line 986  Case is always ignored.  Always remove t
986          ["String" bibtex-String t]          ["String" bibtex-String t]
987          ["Preamble" bibtex-Preamble t]))          ["Preamble" bibtex-Preamble t]))
988    
 (defvar bibtex-url-map  
   (let ((km (make-sparse-keymap)))  
     (define-key km [(mouse-2)] 'bibtex-url)  
     km)  
   "Local keymap for clickable URLs.")  
 (fset 'bibtex-url-map bibtex-url-map)  
       
989    
990  ;; Internal Variables  ;; Internal Variables
991    
# Line 996  Initialized from `bibtex-predefined-stri Line 1020  Initialized from `bibtex-predefined-stri
1020  (make-variable-buffer-local 'bibtex-strings)  (make-variable-buffer-local 'bibtex-strings)
1021    
1022  (defvar bibtex-reference-keys  (defvar bibtex-reference-keys
1023    (lazy-completion-table bibtex-reference-keys bibtex-parse-keys nil nil t)    (lazy-completion-table bibtex-reference-keys bibtex-parse-keys nil t)
1024    "Completion table for BibTeX reference keys.")    "Completion table for BibTeX reference keys.
1025    The CDRs of the elements are t for header keys and nil for crossref keys.")
1026  (make-variable-buffer-local 'bibtex-reference-keys)  (make-variable-buffer-local 'bibtex-reference-keys)
1027    
1028  (defvar bibtex-buffer-last-parsed-tick nil  (defvar bibtex-buffer-last-parsed-tick nil
# Line 1103  Initialized from `bibtex-predefined-stri Line 1128  Initialized from `bibtex-predefined-stri
1128      (,(concat "^[ \t]*\\(" bibtex-field-name "\\)[ \t]*=")      (,(concat "^[ \t]*\\(" bibtex-field-name "\\)[ \t]*=")
1129       1 font-lock-variable-name-face)       1 font-lock-variable-name-face)
1130      ;; url      ;; url
1131      (bibtex-font-lock-url 0 '(face nil mouse-face highlight      bibtex-font-lock-url bibtex-font-lock-crossref)
                                    keymap bibtex-url-map)))  
1132    "*Default expressions to highlight in BibTeX mode.")    "*Default expressions to highlight in BibTeX mode.")
1133    
1134  (defvar bibtex-font-lock-url-regexp  (defvar bibtex-font-lock-url-regexp
1135    (concat "\\<" (regexp-opt (mapcar 'caar bibtex-generate-url-list) t)    ;; Assume that field names begin at the beginning of a line.
1136            "\\>[ \t]*=[ \t]*")    (concat "^[ \t]*" (regexp-opt (mapcar 'caar bibtex-generate-url-list) t)
1137              "[ \t]*=[ \t]*")
1138    "Regexp for `bibtex-font-lock-url'.")    "Regexp for `bibtex-font-lock-url'.")
1139    
1140  (defvar bibtex-field-name-for-parsing nil  (defvar bibtex-field-name-for-parsing nil
# Line 1128  Auto-generated from `bibtex-sort-entry-c Line 1153  Auto-generated from `bibtex-sort-entry-c
1153  Used when `bibtex-maintain-sorted-entries' is `entry-class'.")  Used when `bibtex-maintain-sorted-entries' is `entry-class'.")
1154    
1155    
 ;; Special support taking care of variants  
 (defvar zmacs-regions)  
 (defalias 'bibtex-mark-active  
   (if (boundp 'mark-active)  
       ;; In Emacs mark-active indicates if mark is active.  
       (lambda () mark-active)  
     ;; In XEmacs (mark) returns nil when not active.  
     (lambda () (if zmacs-regions (mark) (mark t)))))  
   
 (defalias 'bibtex-run-with-idle-timer  
   (if (fboundp 'run-with-idle-timer)  
       ;; timer.el is distributed with Emacs  
       'run-with-idle-timer  
     ;; timer.el is not distributed with XEmacs  
     ;; Notice that this does not (yet) pass the arguments, but they  
     ;; are not used (yet) in bibtex.el. Fix if needed.  
     (lambda (secs repeat function &rest args)  
       (start-itimer "bibtex" function secs (if repeat secs nil) t))))  
   
   
1156  ;; Support for hideshow minor mode  ;; Support for hideshow minor mode
1157  (defun bibtex-hs-forward-sexp (arg)  (defun bibtex-hs-forward-sexp (arg)
1158    "Replacement for `forward-sexp' to be used by `hs-minor-mode'.    "Replacement for `forward-sexp' to be used by `hs-minor-mode'.
1159  ARG is ignored."  ARG is ignored."
1160    (if (looking-at "@\\S(*\\s(")    (if (looking-at "@\\S(*\\s(")
1161      (goto-char (1- (match-end 0))))        (goto-char (1- (match-end 0))))
1162    (forward-sexp 1))    (forward-sexp 1))
1163    
1164  (add-to-list  (add-to-list
# Line 1471  delimiters if present." Line 1476  delimiters if present."
1476    (buffer-substring-no-properties (1+ (match-beginning bibtex-type-in-head))    (buffer-substring-no-properties (1+ (match-beginning bibtex-type-in-head))
1477                                    (match-end bibtex-type-in-head)))                                    (match-end bibtex-type-in-head)))
1478    
1479  (defun bibtex-key-in-head (&optional empty)  (defsubst bibtex-key-in-head (&optional empty)
1480    "Extract BibTeX key in head.  Return optional arg EMPTY if key is empty."    "Extract BibTeX key in head.  Return optional arg EMPTY if key is empty."
1481    (if (match-beginning bibtex-key-in-head)    (or (match-string-no-properties bibtex-key-in-head)
1482        (buffer-substring-no-properties (match-beginning bibtex-key-in-head)        empty))
                                       (match-end bibtex-key-in-head))  
     empty))  
1483    
1484  ;; Helper Functions  ;; Helper Functions
1485    
# Line 1492  delimiters if present." Line 1495  delimiters if present."
1495  (defun bibtex-current-line ()  (defun bibtex-current-line ()
1496    "Compute line number of point regardless whether the buffer is narrowed."    "Compute line number of point regardless whether the buffer is narrowed."
1497    (+ (count-lines 1 (point))    (+ (count-lines 1 (point))
1498       (if (equal (current-column) 0) 1 0)))       (if (bolp) 1 0)))
1499    
1500  (defun bibtex-skip-to-valid-entry (&optional backward)  (defun bibtex-skip-to-valid-entry (&optional backward)
1501    "Move point to beginning of the next valid BibTeX entry.    "Move point to beginning of the next valid BibTeX entry.
# Line 1525  entry is found, nil otherwise." Line 1528  entry is found, nil otherwise."
1528      found))      found))
1529    
1530  (defun bibtex-map-entries (fun)  (defun bibtex-map-entries (fun)
1531    "Call FUN for each BibTeX entry starting with the current.    "Call FUN for each BibTeX entry in buffer (possibly narrowed).
1532  Do this to the end of the file.  FUN is called with three arguments, the key of  FUN is called with three arguments, the key of the entry and the buffer
1533  the entry and the buffer positions (marker) of beginning and end of entry.  positions (marker) of beginning and end of entry.  Point is inside the entry.
1534  Point is inside the entry.  If `bibtex-sort-ignore-string-entries' is non-nil,  If `bibtex-sort-ignore-string-entries' is non-nil, FUN will not be called for
1535  FUN will not be called for @String entries."  @String entries."
1536    (let ((case-fold-search t))    (let ((case-fold-search t))
1537      (bibtex-beginning-of-entry)      (save-excursion
1538      (while (re-search-forward bibtex-entry-head nil t)        (goto-char (point-min))
1539        (let ((entry-type (bibtex-type-in-head))        (while (re-search-forward bibtex-entry-head nil t)
1540              (key (bibtex-key-in-head ""))          (let ((entry-type (bibtex-type-in-head))
1541              (beg (copy-marker (match-beginning 0)))                (key (bibtex-key-in-head ""))
1542              (end (copy-marker (save-excursion (bibtex-end-of-entry)))))                (beg (copy-marker (match-beginning 0)))
1543          (save-excursion                (end (copy-marker (save-excursion (bibtex-end-of-entry)))))
1544            (if (or (and (not bibtex-sort-ignore-string-entries)            (save-excursion
1545                         (bibtex-string= entry-type "string"))              (if (or (and (not bibtex-sort-ignore-string-entries)
1546                    (assoc-string entry-type bibtex-entry-field-alist t))                           (bibtex-string= entry-type "string"))
1547                (funcall fun key beg end)))                      (assoc-string entry-type bibtex-entry-field-alist t))
1548          (goto-char end)))))                  (funcall fun key beg end)))
1549              (goto-char end))))))
1550    
1551  (defun bibtex-progress-message (&optional flag interval)  (defun bibtex-progress-message (&optional flag interval)
1552    "Echo a message about progress of current buffer.    "Echo a message about progress of current buffer.
# Line 1581  If FLAG is nil, a message is echoed if p Line 1585  If FLAG is nil, a message is echoed if p
1585      "\""))      "\""))
1586    
1587  (defun bibtex-entry-left-delimiter ()  (defun bibtex-entry-left-delimiter ()
1588    "Return a string dependent on `bibtex-field-delimiters'."    "Return a string dependent on `bibtex-entry-delimiters'."
1589    (if (equal bibtex-entry-delimiters 'braces)    (if (equal bibtex-entry-delimiters 'braces)
1590        "{"        "{"
1591      "("))      "("))
1592    
1593  (defun bibtex-entry-right-delimiter ()  (defun bibtex-entry-right-delimiter ()
1594    "Return a string dependent on `bibtex-field-delimiters'."    "Return a string dependent on `bibtex-entry-delimiters'."
1595    (if (equal bibtex-entry-delimiters 'braces)    (if (equal bibtex-entry-delimiters 'braces)
1596        "}"        "}"
1597      ")"))      ")"))
# Line 1641  are defined, but only for the head part Line 1645  are defined, but only for the head part
1645                      (setq infix-start (bibtex-end-of-field bounds))                      (setq infix-start (bibtex-end-of-field bounds))
1646                    (setq finished t))                    (setq finished t))
1647                  (goto-char infix-start))                  (goto-char infix-start))
1648                ;; This matches the infix* part. The AND construction assures                ;; This matches the infix* part.  The AND construction assures
1649                ;; that BOUND is respected.                ;; that BOUND is respected.
1650                (when (and (looking-at bibtex-entry-postfix)                (when (and (looking-at bibtex-entry-postfix)
1651                           (eq (char-before (match-end 0)) entry-closer)                           (eq (char-before (match-end 0)) entry-closer)
# Line 1826  Formats current entry according to varia Line 1830  Formats current entry according to varia
1830                                                       (cdr field)))                                                       (cdr field)))
1831                                    (cdr field))                                    (cdr field))
1832                  req-field-list (if crossref-key                  req-field-list (if crossref-key
1833                                     (nth 0 (nth 2 entry-list))  ; crossref part                                     (nth 0 (nth 2 entry-list)) ; crossref part
1834                                   (nth 0 (nth 1 entry-list))))  ; required part                                   (nth 0 (nth 1 entry-list)))) ; required part
1835    
1836            (dolist (rfield req-field-list)            (dolist (rfield req-field-list)
1837              (when (nth 3 rfield) ; we should have an alternative              (when (nth 3 rfield) ; we should have an alternative
# Line 1864  Formats current entry according to varia Line 1868  Formats current entry according to varia
1868                   deleted)                   deleted)
1869    
1870              ;; We have more elegant high-level functions for several              ;; We have more elegant high-level functions for several
1871              ;; tasks done by bibtex-format-entry. However, they contain              ;; tasks done by bibtex-format-entry.  However, they contain
1872              ;; quite some redundancy compared with what we need to do              ;; quite some redundancy compared with what we need to do
1873              ;; anyway. So for speed-up we avoid using them.              ;; anyway.  So for speed-up we avoid using them.
1874    
1875              (if (memq 'opts-or-alts format)              (if (memq 'opts-or-alts format)
1876                  (cond ((and empty-field                  (cond ((and empty-field
# Line 1875  Formats current entry according to varia Line 1879  Formats current entry according to varia
1879                                                field-name req-field-list t)))                                                field-name req-field-list t)))
1880                                    (or (not field)       ; OPT field                                    (or (not field)       ; OPT field
1881                                        (nth 3 field))))) ; ALT field                                        (nth 3 field))))) ; ALT field
1882                         ;; Either it is an empty ALT field. Then we have checked                         ;; Either it is an empty ALT field.  Then we have checked
1883                         ;; already that we have one non-empty alternative. Or it                         ;; already that we have one non-empty alternative.  Or it
1884                         ;; is an empty OPT field that we do not miss anyway.                         ;; is an empty OPT field that we do not miss anyway.
1885                         ;; So we can safely delete this field.                         ;; So we can safely delete this field.
1886                         (delete-region beg-field end-field)                         (delete-region beg-field end-field)
# Line 2041  applied to the content of FIELD.  It is Line 2045  applied to the content of FIELD.  It is
2045      (dolist (pattern change-list content)      (dolist (pattern change-list content)
2046        (setq content (replace-regexp-in-string (car pattern)        (setq content (replace-regexp-in-string (car pattern)
2047                                                (cdr pattern)                                                (cdr pattern)
2048                                                content)))))                                                content t)))))
2049    
2050  (defun bibtex-autokey-get-names ()  (defun bibtex-autokey-get-names ()
2051    "Get contents of the name field of the current entry.    "Get contents of the name field of the current entry.
2052  Do some modifications based on `bibtex-autokey-name-change-strings'  Do some modifications based on `bibtex-autokey-name-change-strings'.
2053  and return results as a list."  Return the names as a concatenated string obeying `bibtex-autokey-names'
2054    (let ((case-fold-search t)  and `bibtex-autokey-names-stretch'."
2055          (names (bibtex-autokey-get-field "author\\|editor"    (let ((names (bibtex-autokey-get-field "author\\|editor"
2056                                           bibtex-autokey-name-change-strings)))                                           bibtex-autokey-name-change-strings)))
2057      ;; Some entries do not have a name field.      ;; Some entries do not have a name field.
2058      (unless (string= "" names)      (unless (string= "" names)
2059        (mapcar 'bibtex-autokey-demangle-name        (let* ((case-fold-search t)
2060                (split-string names "[ \t\n]+and[ \t\n]+")))))               (name-list (mapcar 'bibtex-autokey-demangle-name
2061                                    (split-string names "[ \t\n]+and[ \t\n]+")))
2062                 additional-names)
2063            (unless (or (not (numberp bibtex-autokey-names))
2064                        (<= (length name-list)
2065                            (+ bibtex-autokey-names
2066                               bibtex-autokey-names-stretch)))
2067              ;; Take bibtex-autokey-names elements from beginning of name-list
2068              (setq name-list (nreverse (nthcdr (- (length name-list)
2069                                                   bibtex-autokey-names)
2070                                                (nreverse name-list)))
2071                    additional-names bibtex-autokey-additional-names))
2072            (concat (mapconcat 'identity name-list
2073                               bibtex-autokey-name-separator)
2074                    additional-names)))))
2075    
2076  (defun bibtex-autokey-demangle-name (fullname)  (defun bibtex-autokey-demangle-name (fullname)
2077    "Get the last part from a well-formed FULLNAME and perform abbreviations."    "Get the last part from a well-formed FULLNAME and perform abbreviations."
# Line 2082  and return results as a list." Line 2100  and return results as a list."
2100       (funcall bibtex-autokey-name-case-convert name)       (funcall bibtex-autokey-name-case-convert name)
2101       bibtex-autokey-name-length)))       bibtex-autokey-name-length)))
2102    
2103    (defun bibtex-autokey-get-year ()
2104      "Return year field contents as a string obeying `bibtex-autokey-year-length'."
2105      (let ((yearfield (bibtex-autokey-get-field "year")))
2106        (substring yearfield (max 0 (- (length yearfield)
2107                                       bibtex-autokey-year-length)))))
2108    
2109  (defun bibtex-autokey-get-title ()  (defun bibtex-autokey-get-title ()
2110    "Get title field contents up to a terminator."    "Get title field contents up to a terminator.
2111    Return the result as a string"
2112    (let ((case-fold-search t)    (let ((case-fold-search t)
2113          (titlestring          (titlestring
2114           (bibtex-autokey-get-field "title"           (bibtex-autokey-get-field "title"
# Line 2092  and return results as a list." Line 2117  and return results as a list."
2117      (dolist (terminator bibtex-autokey-title-terminators)      (dolist (terminator bibtex-autokey-title-terminators)
2118        (if (string-match terminator titlestring)        (if (string-match terminator titlestring)
2119            (setq titlestring (substring titlestring 0 (match-beginning 0)))))            (setq titlestring (substring titlestring 0 (match-beginning 0)))))
2120      ;; gather words from titlestring into a list. Ignore      ;; gather words from titlestring into a list.  Ignore
2121      ;; specific words and use only a specific amount of words.      ;; specific words and use only a specific amount of words.
2122      (let ((counter 0)      (let ((counter 0)
2123            titlewords titlewords-extra titleword end-match)            titlewords titlewords-extra word)
2124        (while (and (or (not (numberp bibtex-autokey-titlewords))        (while (and (or (not (numberp bibtex-autokey-titlewords))
2125                        (< counter (+ bibtex-autokey-titlewords                        (< counter (+ bibtex-autokey-titlewords
2126                                      bibtex-autokey-titlewords-stretch)))                                      bibtex-autokey-titlewords-stretch)))
2127                    (string-match "\\b\\w+" titlestring))                    (string-match "\\b\\w+" titlestring))
2128          (setq end-match (match-end 0)          (setq word (match-string 0 titlestring)
2129                titleword (substring titlestring                titlestring (substring titlestring (match-end 0)))
2130                                     (match-beginning 0) end-match))          ;; Ignore words matched by one of the elements of
2131            ;; bibtex-autokey-titleword-ignore
2132          (unless (let ((lst bibtex-autokey-titleword-ignore))          (unless (let ((lst bibtex-autokey-titleword-ignore))
2133                    (while (and lst                    (while (and lst
2134                                (not (string-match (concat "\\`\\(?:" (car lst)                                (not (string-match (concat "\\`\\(?:" (car lst)
2135                                                           "\\)\\'") titleword)))                                                           "\\)\\'") word)))
2136                      (setq lst (cdr lst)))                      (setq lst (cdr lst)))
2137                    lst)                    lst)
2138            (setq titleword            (setq word (funcall bibtex-autokey-titleword-case-convert word)
2139                  (funcall bibtex-autokey-titleword-case-convert titleword))                  counter (1+ counter))
2140            (if (or (not (numberp bibtex-autokey-titlewords))            (if (or (not (numberp bibtex-autokey-titlewords))
2141                    (< counter bibtex-autokey-titlewords))                    (< counter bibtex-autokey-titlewords))
2142                (setq titlewords (append titlewords (list titleword)))                (push word titlewords)
2143              (setq titlewords-extra              (push word titlewords-extra))))
2144                    (append titlewords-extra (list titleword))))        ;; Obey bibtex-autokey-titlewords-stretch:
2145            (setq counter (1+ counter)))        ;; If by now we have processed all words in titlestring, we include
2146          (setq titlestring (substring titlestring end-match)))        ;; titlewords-extra in titlewords. Otherwise, we ignore titlewords-extra.
2147        (unless (string-match "\\b\\w+" titlestring)        (unless (string-match "\\b\\w+" titlestring)
2148          (setq titlewords (append titlewords titlewords-extra)))          (setq titlewords (append titlewords-extra titlewords)))
2149        (mapcar 'bibtex-autokey-demangle-title titlewords))))        (mapconcat 'bibtex-autokey-demangle-title (nreverse titlewords)
2150                     bibtex-autokey-titleword-separator))))
2151    
2152  (defun bibtex-autokey-demangle-title (titleword)  (defun bibtex-autokey-demangle-title (titleword)
2153    "Do some abbreviations on TITLEWORD.    "Do some abbreviations on TITLEWORD.
# Line 2211  The generation algorithm works as follow Line 2238  The generation algorithm works as follow
2238      the key is then presented in the minibuffer to the user,      the key is then presented in the minibuffer to the user,
2239      where it can be edited.  The key given by the user is then      where it can be edited.  The key given by the user is then
2240      used."      used."
2241    (let* ((name-etal "")    (let* ((names (bibtex-autokey-get-names))
2242           (namelist           (year (bibtex-autokey-get-year))
2243            (let ((nl (bibtex-autokey-get-names))           (title (bibtex-autokey-get-title))
                 nnl)  
             (if (or (not (numberp bibtex-autokey-names))  
                     (<= (length nl)  
                         (+ bibtex-autokey-names  
                            bibtex-autokey-names-stretch)))  
                 nl  
               (setq name-etal bibtex-autokey-additional-names)  
               (while (< (length nnl) bibtex-autokey-names)  
                 (setq nnl (append nnl (list (car nl)))  
                       nl (cdr nl)))  
               nnl)))  
          (namepart (concat (mapconcat 'identity  
                                       namelist  
                                       bibtex-autokey-name-separator)  
                            name-etal))  
          (yearfield (bibtex-autokey-get-field "year"))  
          (yearpart (if (equal yearfield "")  
                        ""  
                      (substring yearfield  
                                 (- (length yearfield)  
                                    bibtex-autokey-year-length))))  
          (titlepart (mapconcat 'identity  
                                (bibtex-autokey-get-title)  
                                bibtex-autokey-titleword-separator))  
2244           (autokey (concat bibtex-autokey-prefix-string           (autokey (concat bibtex-autokey-prefix-string
2245                            namepart                            names
2246                            (unless (or (equal namepart "")                            (unless (or (equal names "")
2247                                        (equal yearpart ""))                                        (equal year ""))
2248                              bibtex-autokey-name-year-separator)                              bibtex-autokey-name-year-separator)
2249                            yearpart                            year
2250                            (unless (or (and (equal namepart "")                            (unless (or (and (equal names "")
2251                                             (equal yearpart ""))                                             (equal year ""))
2252                                        (equal titlepart ""))                                        (equal title ""))
2253                              bibtex-autokey-year-title-separator)                              bibtex-autokey-year-title-separator)
2254                            titlepart)))                            title)))
2255      (if bibtex-autokey-before-presentation-function      (if bibtex-autokey-before-presentation-function
2256          (funcall bibtex-autokey-before-presentation-function autokey)          (funcall bibtex-autokey-before-presentation-function autokey)
2257        autokey)))        autokey)))
2258    
2259    
2260  (defun bibtex-parse-keys (&optional add abortable verbose)  (defun bibtex-read-key (prompt &optional key)
2261      "Read BibTeX key from minibuffer using PROMPT and default KEY."
2262      (completing-read prompt bibtex-reference-keys
2263                       nil nil key 'bibtex-key-history))
2264    
2265    (defun bibtex-parse-keys (&optional abortable verbose)
2266    "Set `bibtex-reference-keys' to the keys used in the whole buffer.    "Set `bibtex-reference-keys' to the keys used in the whole buffer.
2267  The buffer might possibly be restricted.  Find both entry keys and crossref entries.  If ABORTABLE is non-nil abort on
2268  Find both entry keys and crossref entries.  user input.  If VERBOSE is non-nil gives messages about progress.  Return alist
2269  If ADD is non-nil add the new keys to `bibtex-reference-keys' instead of  of keys if parsing was completed, `aborted' otherwise."
2270  simply resetting it.  If ADD is an alist of keys, also add ADD to    (let (ref-keys crossref-keys)
 `bibtex-reference-keys'.  If ABORTABLE is non-nil abort on user  
 input.  If VERBOSE is non-nil gives messages about progress.  
 Return alist of keys if parsing was completed, `aborted' otherwise."  
   (let ((reference-keys (if (and add  
                                  (listp bibtex-reference-keys))  
                             bibtex-reference-keys)))  
     (if (listp add)  
         (dolist (key add)  
           (unless (assoc (car key) reference-keys)  
                       (push key reference-keys))))  
2271      (save-excursion      (save-excursion
2272        (save-match-data        (save-match-data
2273          (if verbose          (if verbose
# Line 2286  Return alist of keys if parsing was comp Line 2284  Return alist of keys if parsing was comp
2284                    (if (and abortable (input-pending-p))                    (if (and abortable (input-pending-p))
2285                        ;; user has aborted by typing a key --> return `aborted'                        ;; user has aborted by typing a key --> return `aborted'
2286                        (throw 'userkey 'aborted))                        (throw 'userkey 'aborted))
2287                    (let ((key (cond ((match-end 3)                    (cond ((match-end 3)
2288                                      ;; This is a crossref.                           ;; This is a crossref.
2289                                      (buffer-substring-no-properties                           (let ((key (buffer-substring-no-properties
2290                                       (1+ (match-beginning 3)) (1- (match-end 3))))                                       (1+ (match-beginning 3)) (1- (match-end 3)))))
2291                                     ((assoc-string (bibtex-type-in-head)                                 (unless (assoc key crossref-keys)
2292                                                    bibtex-entry-field-alist t)                                   (push (list key) crossref-keys))))
2293                                      ;; This is an entry.                          ;; only keys of known entries
2294                                      (match-string-no-properties bibtex-key-in-head)))))                          ((assoc-string (bibtex-type-in-head)
2295                      (if (and (stringp key)                                         bibtex-entry-field-alist t)
2296                               (not (assoc key reference-keys)))                           ;; This is an entry.
2297                        (push (list key) reference-keys)))))                           (let ((key (bibtex-key-in-head)))
2298                               (unless (assoc key ref-keys)
2299                                 (push (cons key t) ref-keys)))))))
2300    
2301              (let (;; ignore @String entries because they are handled              (let (;; ignore @String entries because they are handled
2302                    ;; separately by bibtex-parse-strings                    ;; separately by bibtex-parse-strings
2303                    (bibtex-sort-ignore-string-entries t)                    (bibtex-sort-ignore-string-entries t)
2304                    crossref-key bounds)                    bounds)
2305                (bibtex-map-entries                (bibtex-map-entries
2306                 (lambda (key beg end)                 (lambda (key beg end)
2307                   (if (and abortable                   (if (and abortable
# Line 2309  Return alist of keys if parsing was comp Line 2309  Return alist of keys if parsing was comp
2309                       ;; user has aborted by typing a key --> return `aborted'                       ;; user has aborted by typing a key --> return `aborted'
2310                       (throw 'userkey 'aborted))                       (throw 'userkey 'aborted))
2311                   (if verbose (bibtex-progress-message))                   (if verbose (bibtex-progress-message))
2312                   (unless (assoc key reference-keys)                   (unless (assoc key ref-keys)
2313                     (push (list key) reference-keys))                     (push (cons key t) ref-keys))
2314                   (if (and (setq bounds (bibtex-search-forward-field "crossref" end))                   (if (and (setq bounds (bibtex-search-forward-field "crossref" end))
2315                            (setq crossref-key (bibtex-text-in-field-bounds bounds t))                            (setq key (bibtex-text-in-field-bounds bounds t))
2316                            (not (assoc crossref-key reference-keys)))                            (not (assoc key crossref-keys)))
2317                       (push (list crossref-key) reference-keys))))))                       (push (list key) crossref-keys))))))
2318    
2319              (dolist (key crossref-keys)
2320                (unless (assoc (car key) ref-keys) (push key ref-keys)))
2321            (if verbose            (if verbose
2322                (bibtex-progress-message 'done))                (bibtex-progress-message 'done))
2323            ;; successful operation --> return `bibtex-reference-keys'            ;; successful operation --> return `bibtex-reference-keys'
2324            (setq bibtex-reference-keys reference-keys))))))            (setq bibtex-reference-keys ref-keys))))))
2325    
2326  (defun bibtex-parse-strings (&optional add abortable)  (defun bibtex-parse-strings (&optional add abortable)
2327    "Set `bibtex-strings' to the string definitions in the whole buffer.    "Set `bibtex-strings' to the string definitions in the whole buffer.
# Line 2355  Return alist of strings if parsing was c Line 2357  Return alist of strings if parsing was c
2357    
2358  (defun bibtex-string-files-init ()  (defun bibtex-string-files-init ()
2359    "Return initialization for `bibtex-strings'.    "Return initialization for `bibtex-strings'.
2360  Use `bibtex-predefined-strings' and bib files `bibtex-string-files'."  Use `bibtex-predefined-strings' and BibTeX files `bibtex-string-files'."
2361    (save-match-data    (save-match-data
2362      ;; collect pathnames      (let ((dirlist (split-string (or bibtex-string-file-path default-directory)
     (let ((dirlist (split-string (or bibtex-string-file-path ".")  
2363                                   ":+"))                                   ":+"))
2364            (case-fold-search)            (case-fold-search)
2365            compl)            string-files fullfilename compl bounds found)
2366          ;; collect absolute file names of valid string files
2367        (dolist (filename bibtex-string-files)        (dolist (filename bibtex-string-files)
2368          (unless (string-match "\\.bib\\'" filename)          (unless (string-match "\\.bib\\'" filename)
2369            (setq filename (concat filename ".bib")))            (setq filename (concat filename ".bib")))
2370          ;; test filenames          ;; test filenames
2371          (let (fullfilename bounds found)          (if (file-name-absolute-p filename)
2372                (if (file-readable-p filename)
2373                    (push filename string-files)
2374                  (error "BibTeX strings file %s not found" filename))
2375            (dolist (dir dirlist)            (dolist (dir dirlist)
2376              (when (file-readable-p              (when (file-readable-p
2377                     (setq fullfilename (expand-file-name filename dir)))                     (setq fullfilename (expand-file-name filename dir)))
2378                ;; file was found                (push fullfilename string-files)
               (with-temp-buffer  
                 (insert-file-contents fullfilename)  
                 (goto-char (point-min))  
                 (while (setq bounds (bibtex-search-forward-string))  
                   (push (cons (bibtex-reference-key-in-string bounds)  
                               (bibtex-text-in-string bounds t))  
                         compl)  
                   (goto-char (bibtex-end-of-string bounds))))  
2379                (setq found t)))                (setq found t)))
2380            (unless found            (unless found
2381              (error "File %s not in paths defined via bibtex-string-file-path"              (error "File %s not in paths defined via bibtex-string-file-path"
2382                     filename))))                     filename))))
2383          ;; parse string files
2384          (dolist (filename string-files)
2385            (with-temp-buffer
2386              (insert-file-contents filename)
2387              (goto-char (point-min))
2388              (while (setq bounds (bibtex-search-forward-string))
2389                (push (cons (bibtex-reference-key-in-string bounds)
2390                            (bibtex-text-in-string bounds t))
2391                      compl)
2392                (goto-char (bibtex-end-of-string bounds)))))
2393        (append bibtex-predefined-strings (nreverse compl)))))        (append bibtex-predefined-strings (nreverse compl)))))
2394    
2395  (defun bibtex-parse-buffers-stealthily ()  (defun bibtex-parse-buffers-stealthily ()
2396    "Parse buffer in the background during idle time.    "Parse buffer in the background during idle time.
2397  Called by `bibtex-run-with-idle-timer'.  Whenever Emacs has been idle  Called by `run-with-idle-timer'.  Whenever Emacs has been idle
2398  for `bibtex-parse-keys-timeout' seconds, all BibTeX buffers (starting  for `bibtex-parse-keys-timeout' seconds, all BibTeX buffers (starting
2399  with the current) are parsed."  with the current) are parsed."
2400    (save-excursion    (save-excursion
# Line 2402  with the current) are parsed." Line 2409  with the current) are parsed."
2409                (widen)                (widen)
2410                ;; Output no progress messages in bibtex-parse-keys                ;; Output no progress messages in bibtex-parse-keys
2411                ;; because when in y-or-n-p that can hide the question.                ;; because when in y-or-n-p that can hide the question.
2412                (if (and (listp (bibtex-parse-keys nil t))                (if (and (listp (bibtex-parse-keys t))
2413                         ;; update bibtex-strings                         ;; update bibtex-strings
2414                         (listp (bibtex-parse-strings strings-init t)))                         (listp (bibtex-parse-strings strings-init t)))
2415    
# Line 2410  with the current) are parsed." Line 2417  with the current) are parsed."
2417                    (setq bibtex-buffer-last-parsed-tick (buffer-modified-tick)))))                    (setq bibtex-buffer-last-parsed-tick (buffer-modified-tick)))))
2418          (setq buffers (cdr buffers))))))          (setq buffers (cdr buffers))))))
2419    
2420    (defun bibtex-files-expand (&optional current)
2421      "Return an expanded list of BibTeX buffers based on `bibtex-files'.
2422    Initialize in these buffers `bibtex-reference-keys' if not yet set.
2423    List includes current buffer if CURRENT is non-nil."
2424      (let ((file-path (split-string (or bibtex-file-path default-directory) ":+"))
2425            file-list dir-list buffer-list)
2426        (dolist (file bibtex-files)
2427          (cond ((eq file 'bibtex-file-path)
2428                 (setq dir-list (append dir-list file-path)))
2429                ((file-accessible-directory-p file)
2430                 (push file dir-list))
2431                ((progn (unless (string-match "\\.bib\\'" file)
2432                          (setq file (concat file ".bib")))
2433                        (file-name-absolute-p file))
2434                 (push file file-list))
2435                (t
2436                 (let (fullfilename found)
2437                   (dolist (dir file-path)
2438                     (when (file-readable-p
2439                            (setq fullfilename (expand-file-name file dir)))
2440                       (push fullfilename file-list)
2441                       (setq found t)))
2442                   (unless found
2443                     (error "File %s not in paths defined via bibtex-file-path"
2444                            file))))))
2445        (dolist (file file-list)
2446          (unless (file-readable-p file)
2447            (error "BibTeX file %s not found" file)))
2448        ;; expand dir-list
2449        (dolist (dir dir-list)
2450          (setq file-list
2451                (append file-list (directory-files dir t "\\.bib\\'" t))))
2452        (delete-dups file-list)
2453        (dolist (file file-list)
2454          (when (file-readable-p file)
2455            (push (find-file-noselect file) buffer-list)
2456            (with-current-buffer (car buffer-list)
2457              (unless (listp bibtex-reference-keys)
2458                (bibtex-parse-keys)))))
2459        (cond ((and current (not (memq (current-buffer) buffer-list)))
2460               (push (current-buffer) buffer-list))
2461              ((and (not current) (memq (current-buffer) buffer-list))
2462               (setq buffer-list (delq (current-buffer) buffer-list))))
2463        buffer-list))
2464    
2465  (defun bibtex-complete-internal (completions)  (defun bibtex-complete-internal (completions)
2466    "Complete word fragment before point to longest prefix of COMPLETIONS.    "Complete word fragment before point to longest prefix of COMPLETIONS.
2467  COMPLETIONS should be a list of strings.  If point is not after the part  COMPLETIONS should be a list of strings.  If point is not after the part
# Line 2459  expansion of STR using expansion list ST Line 2511  expansion of STR using expansion list ST
2511                  (bibtex-remove-delimiters))))))))                  (bibtex-remove-delimiters))))))))
2512    
2513  (defun bibtex-complete-key-cleanup (key)  (defun bibtex-complete-key-cleanup (key)
2514    "Display message on entry KEY after completion of a crossref key."    "Display summary message on entry KEY after completion of a crossref key.
2515    Use `bibtex-summary-function' to generate summary."
2516    (save-excursion    (save-excursion
2517      ;; Don't do anything if we completed the key of an entry.      ;; Don't do anything if we completed the key of an entry.
2518      (let ((pnt (bibtex-beginning-of-entry)))      (let ((pnt (bibtex-beginning-of-entry)))
2519        (if (and (stringp key)        (if (and (stringp key)
2520                 (bibtex-find-entry key)                 (bibtex-find-entry key)
2521                 (/= pnt (point)))                 (/= pnt (point)))
2522            (let* ((bibtex-autokey-name-case-convert 'identity)            (message "Ref: %s" (funcall bibtex-summary-function key))))))
2523                   (bibtex-autokey-name-length 'infty)  
2524                   (nl (bibtex-autokey-get-names))  (defun bibtex-copy-summary-as-kill (key)
2525                   (name (concat (nth 0 nl) (if (nth 1 nl) " etal")))    "Push summery of BibTeX entry KEY to kill ring.
2526                   (year (bibtex-autokey-get-field "year"))  Use `bibtex-summary-function' to generate summary."
2527                   (bibtex-autokey-titlewords 5)    (interactive
2528                   (bibtex-autokey-titlewords-stretch 2)     (list (bibtex-read-key
2529                   (bibtex-autokey-titleword-case-convert 'identity)            "Key: " (save-excursion
2530                   (bibtex-autokey-titleword-length 5)                      (bibtex-beginning-of-entry)
2531                   (title (mapconcat 'identity                      (when (re-search-forward bibtex-entry-head nil t)
2532                                     (bibtex-autokey-get-title) " "))                        (bibtex-key-in-head))))))
2533                   (journal (bibtex-autokey-get-field    (kill-new (message "%s" (funcall bibtex-summary-function key))))
2534                             "journal" bibtex-autokey-transcriptions))  
2535                   (volume (bibtex-autokey-get-field "volume"))  (defun bibtex-summary (key)
2536                   (pages (bibtex-autokey-get-field "pages" '(("-.*\\'" . "")))))    "Return summary of BibTeX entry KEY.
2537              (message "Ref:%s"  Used as default value of `bibtex-summary-function'."
2538                       (mapconcat (lambda (arg)    ;; It would be neat to customize this function.  How?
2539                                    (if (not (string= "" (cdr arg)))    (save-excursion
2540                                        (concat (car arg) (cdr arg))))      (if (bibtex-find-entry key)
2541                                  `((" " . ,name) (" " . ,year)          (let* ((bibtex-autokey-name-case-convert 'identity)
2542                                    (": " . ,title) (", " . ,journal)                 (bibtex-autokey-name-length 'infty)
2543                                    (" " . ,volume) (":" . ,pages))                 (bibtex-autokey-names 1)
2544                                  "")))))))                 (bibtex-autokey-names-stretch 0)
2545                   (bibtex-autokey-name-separator " ")
2546  (defun bibtex-choose-completion-string (choice buffer mini-p base-size)                 (bibtex-autokey-additional-names " etal")
2547    ;; Code borrowed from choose-completion-string:                 (names (bibtex-autokey-get-names))
2548    ;; We must duplicate the code from choose-completion-string                 (bibtex-autokey-year-length 4)
2549    ;; because it runs the hook choose-completion-string-functions                 (year (bibtex-autokey-get-year))
2550    ;; before it inserts the completion. But we want to do something                 (bibtex-autokey-titlewords 5)
2551    ;; after the completion has been inserted.                 (bibtex-autokey-titlewords-stretch 2)
2552    ;;                 (bibtex-autokey-titleword-case-convert 'identity)
2553    ;; Insert the completion into the buffer where it was requested.                 (bibtex-autokey-titleword-length 5)
2554    (set-buffer buffer)                 (bibtex-autokey-titleword-separator " ")
2555    (if base-size                 (title (bibtex-autokey-get-title))
2556        (delete-region (+ base-size (point-min))                 (journal (bibtex-autokey-get-field
2557                       (point))                           "journal" bibtex-autokey-transcriptions))
2558      ;; Delete the longest partial match for CHOICE                 (volume (bibtex-autokey-get-field "volume"))
2559      ;; that can be found before point.                 (pages (bibtex-autokey-get-field "pages" '(("-.*\\'" . "")))))
2560     (choose-completion-delete-max-match choice))            (mapconcat (lambda (arg)
2561    (insert choice)                         (if (not (string= "" (cdr arg)))
2562    (remove-text-properties (- (point) (length choice)) (point)                             (concat (car arg) (cdr arg))))
2563                            '(mouse-face nil))                       `((" " . ,names) (" " . ,year) (": " . ,title)
2564    ;; Update point in the window that BUFFER is showing in.                         (", " . ,journal) (" " . ,volume) (":" . ,pages))
2565    (let ((window (get-buffer-window buffer t)))                       ""))
2566      (set-window-point window (point))))        (error "Key `%s' not found." key))))
2567    
2568  (defun bibtex-pop (arg direction)  (defun bibtex-pop (arg direction)
2569    "Fill current field from the ARG'th same field's text in DIRECTION.    "Fill current field from the ARG'th same field's text in DIRECTION.
# Line 2550  Generic function used by `bibtex-pop-pre Line 2603  Generic function used by `bibtex-pop-pre
2603          (if failure          (if failure
2604              (error "No %s matching BibTeX field"              (error "No %s matching BibTeX field"
2605                     (if (eq direction 'previous) "previous" "next"))                     (if (eq direction 'previous) "previous" "next"))
2606            ;; Found a matching field. Remember boundaries.            ;; Found a matching field.  Remember boundaries.
2607            (setq bibtex-pop-previous-search-point (bibtex-start-of-field bounds)            (setq bibtex-pop-previous-search-point (bibtex-start-of-field bounds)
2608                  bibtex-pop-next-search-point (bibtex-end-of-field bounds)                  bibtex-pop-next-search-point (bibtex-end-of-field bounds)
2609                  new-text (bibtex-text-in-field-bounds bounds))                  new-text (bibtex-text-in-field-bounds bounds))
# Line 2563  Generic function used by `bibtex-pop-pre Line 2616  Generic function used by `bibtex-pop-pre
2616      (bibtex-find-text nil))      (bibtex-find-text nil))
2617    (setq this-command 'bibtex-pop))    (setq this-command 'bibtex-pop))
2618    
2619  (defsubst bibtex-read-key (prompt &optional key)  (defun bibtex-beginning-of-field ()
2620    "Read BibTeX key from minibuffer using PROMPT and default KEY."    "Move point backward to beginning of field.
2621    (completing-read prompt bibtex-reference-keys  This function uses a simple, fast algorithm assuming that the field
2622                     nil nil key 'bibtex-key-history))  begins at the beginning of a line.  We use this function for font-locking."
2623      (let ((field-reg (concat "^[ \t]*" bibtex-field-name "[ \t]*=")))
2624        (beginning-of-line)
2625        (unless (looking-at field-reg)
2626          (re-search-backward field-reg nil t))))
2627    
2628    (defun bibtex-font-lock-url (bound)
2629      "Font-lock for URLs."
2630      (let ((case-fold-search t)
2631            (pnt (point))
2632            field bounds start end found)
2633        (bibtex-beginning-of-field)
2634        (while (and (not found)
2635                    (prog1 (re-search-forward bibtex-font-lock-url-regexp bound t)
2636                      (setq field (match-string-no-properties 1)))
2637                    (setq bounds (bibtex-parse-field-text))
2638                    (progn
2639                      (setq start (car bounds) end (cdr bounds))
2640                      ;; Always ignore field delimiters
2641                      (if (memq (char-before end) '(?\} ?\"))
2642                          (setq end (1- end)))
2643                      (if (memq (char-after start) '(?\{ ?\"))
2644                          (setq start (1+ start)))
2645                      (>= bound start)))
2646          (let ((lst bibtex-generate-url-list) url)
2647            (goto-char start)
2648            (while (and (not found)
2649                        (setq url (caar lst)))
2650              (setq found (and (bibtex-string= field (car url))
2651                               (re-search-forward (cdr url) end t)
2652                               (>= (match-beginning 0) pnt))
2653                    lst (cdr lst))))
2654          (goto-char end))
2655        (if found (bibtex-button (match-beginning 0) (match-end 0)
2656                                 'bibtex-url (match-beginning 0)))
2657        found))
2658    
2659    (defun bibtex-font-lock-crossref (bound)
2660      "Font-lock for crossref fields."
2661      (let ((case-fold-search t)
2662            (pnt (point))
2663            (crossref-reg (concat "^[ \t]*crossref[ \t]*=[ \t\n]*"
2664                                  "\\(\"[^\"]*\"\\|{[^}]*}\\)[ \t\n]*[,})]"))
2665            start end found)
2666        (bibtex-beginning-of-field)
2667        (while (and (not found)
2668                    (re-search-forward crossref-reg bound t))
2669          (setq start (1+ (match-beginning 1))
2670                end (1- (match-end 1))
2671                found (>= start pnt)))
2672        (if found (bibtex-button start end 'bibtex-find-crossref
2673                                 (buffer-substring-no-properties start end)
2674                                 start t))
2675        found))
2676    
2677    (defun bibtex-button-action (button)
2678      "Call BUTTON's BibTeX function."
2679      (apply (button-get button 'bibtex-function)
2680             (button-get button 'bibtex-args)))
2681    
2682    (define-button-type 'bibtex-url
2683      'action 'bibtex-button-action
2684      'bibtex-function 'bibtex-url
2685      'help-echo (purecopy "mouse-2, RET: follow URL"))
2686    
2687    (define-button-type 'bibtex-find-crossref
2688      'action 'bibtex-button-action
2689      'bibtex-function 'bibtex-find-crossref
2690      'help-echo (purecopy "mouse-2, RET: follow crossref"))
2691    
2692    (defun bibtex-button (beg end type &rest args)
2693      (make-text-button beg end 'type type 'bibtex-args args))
2694    
2695    
2696  ;; Interactive Functions:  ;; Interactive Functions:
2697    
# Line 2668  non-nil. Line 2793  non-nil.
2793    (make-local-variable 'bibtex-buffer-last-parsed-tick)    (make-local-variable 'bibtex-buffer-last-parsed-tick)
2794    ;; Install stealthy parse function if not already installed    ;; Install stealthy parse function if not already installed
2795    (unless bibtex-parse-idle-timer    (unless bibtex-parse-idle-timer
2796      (setq bibtex-parse-idle-timer (bibtex-run-with-idle-timer      (setq bibtex-parse-idle-timer (run-with-idle-timer
2797                                     bibtex-parse-keys-timeout t                                     bibtex-parse-keys-timeout t
2798                                     'bibtex-parse-buffers-stealthily)))                                     'bibtex-parse-buffers-stealthily)))
2799    (set (make-local-variable 'paragraph-start) "[ \f\n\t]*$")    (set (make-local-variable 'paragraph-start) "[ \f\n\t]*$")
# Line 2680  non-nil. Line 2805  non-nil.
2805    (set (make-local-variable 'outline-regexp) "[ \t]*@")    (set (make-local-variable 'outline-regexp) "[ \t]*@")
2806    (set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field)    (set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field)
2807    (set (make-local-variable 'fill-prefix) (make-string (+ bibtex-entry-offset    (set (make-local-variable 'fill-prefix) (make-string (+ bibtex-entry-offset
2808                                                           bibtex-contline-indentation)                                                            bibtex-contline-indentation)
2809                                                        ? ))                                                         ? ))
2810    (set (make-local-variable 'font-lock-defaults)    (set (make-local-variable 'font-lock-defaults)
2811         '(bibtex-font-lock-keywords         '(bibtex-font-lock-keywords
2812           nil t ((?$ . "\"")           nil t ((?$ . "\"")
# Line 2693  non-nil. Line 2818  non-nil.
2818                  )                  )
2819           nil           nil
2820           (font-lock-syntactic-keywords . bibtex-font-lock-syntactic-keywords)           (font-lock-syntactic-keywords . bibtex-font-lock-syntactic-keywords)
2821           (font-lock-extra-managed-props . (mouse-face keymap))           (font-lock-extra-managed-props . (category))
2822           (font-lock-mark-block-function           (font-lock-mark-block-function
2823            . (lambda ()            . (lambda ()
2824                (set-mark (bibtex-end-of-entry))                (set-mark (bibtex-end-of-entry))
# Line 2776  according to `bibtex-entry-field-alist', Line 2901  according to `bibtex-entry-field-alist',
2901      ;; bibtex-parse-entry moves point to the end of the last field.      ;; bibtex-parse-entry moves point to the end of the last field.
2902      (let* ((fields-alist (bibtex-parse-entry))      (let* ((fields-alist (bibtex-parse-entry))
2903             (field-list (bibtex-field-list             (field-list (bibtex-field-list
2904                          (substring (cdr (assoc "=type=" fields-alist))                          (cdr (assoc "=type=" fields-alist)))))
                                    1)))) ; don't want @  
2905        (dolist (field (car field-list))        (dolist (field (car field-list))
2906          (unless (assoc-string (car field) fields-alist t)          (unless (assoc-string (car field) fields-alist t)
2907            (bibtex-make-field field)))            (bibtex-make-field field)))
# Line 2793  TEXT may be nil.  Remove \"OPT\" and \"A Line 2917  TEXT may be nil.  Remove \"OPT\" and \"A
2917  Move point to the end of the last field."  Move point to the end of the last field."
2918    (let (alist bounds)    (let (alist bounds)
2919      (when (looking-at bibtex-entry-maybe-empty-head)      (when (looking-at bibtex-entry-maybe-empty-head)
2920        (push (cons "=type=" (match-string bibtex-type-in-head)) alist)        (push (cons "=type=" (bibtex-type-in-head)) alist)
2921        (push (cons "=key=" (match-string bibtex-key-in-head)) alist)        (push (cons "=key=" (bibtex-key-in-head)) alist)
2922        (goto-char (match-end 0))        (goto-char (match-end 0))
2923        (while (setq bounds (bibtex-parse-field bibtex-field-name))        (while (setq bounds (bibtex-parse-field bibtex-field-name))
2924          (push (cons (bibtex-name-in-field bounds t)          (push (cons (bibtex-name-in-field bounds t)
# Line 2809  Move point to the end of the last field. Line 2933  Move point to the end of the last field.
2933    (undo-boundary)       ;So you can easily undo it, if it didn't work right.    (undo-boundary)       ;So you can easily undo it, if it didn't work right.
2934    (bibtex-beginning-of-entry)    (bibtex-beginning-of-entry)
2935    (when (looking-at bibtex-entry-head)    (when (looking-at bibtex-entry-head)
2936      (let ((type (match-string bibtex-type-in-head))      (let ((type (bibtex-type-in-head))
2937            (key (match-string bibtex-key-in-head))            (key (bibtex-key-in-head))
2938            (key-end (match-end bibtex-key-in-head))            (key-end (match-end bibtex-key-in-head))
2939            (case-fold-search t)            (case-fold-search t)
2940            tmp other-key other bounds)            tmp other-key other bounds)
# Line 2823  Move point to the end of the last field. Line 2947  Move point to the end of the last field.
2947          (bibtex-beginning-of-entry)          (bibtex-beginning-of-entry)
2948          (when (and          (when (and
2949                 (looking-at bibtex-entry-head)                 (looking-at bibtex-entry-head)
2950                 (bibtex-string= type (match-string bibtex-type-in-head))                 (bibtex-string= type (bibtex-type-in-head))
2951                 ;; In case we found ourselves :-(                 ;; In case we found ourselves :-(
2952                 (not (equal key (setq tmp (match-string bibtex-key-in-head)))))                 (not (equal key (setq tmp (bibtex-key-in-head)))))
2953            (setq other-key tmp)            (setq other-key tmp)
2954            (setq other (point))))            (setq other (point))))
2955        (save-excursion        (save-excursion
# Line 2833  Move point to the end of the last field. Line 2957  Move point to the end of the last field.
2957          (bibtex-skip-to-valid-entry)          (bibtex-skip-to-valid-entry)
2958          (when (and          (when (and
2959                 (looking-at bibtex-entry-head)                 (looking-at bibtex-entry-head)
2960                 (bibtex-string= type (match-string bibtex-type-in-head))                 (bibtex-string= type (bibtex-type-in-head))
2961                 ;; In case we found ourselves :-(                 ;; In case we found ourselves :-(
2962                 (not (equal key (setq tmp (match-string bibtex-key-in-head))))                 (not (equal key (setq tmp (bibtex-key-in-head))))
2963                 (or (not other-key)                 (or (not other-key)
2964                     ;; Check which is the best match.                     ;; Check which is the best match.
2965                     (< (length (try-completion "" (list key other-key)))                     (< (length (try-completion "" (list key other-key)))
# Line 2883  Move point to the end of the last field. Line 3007  Move point to the end of the last field.
3007            (message (nth 1 comment))            (message (nth 1 comment))
3008          (message "No comment available")))))          (message "No comment available")))))
3009    
3010  (defun bibtex-make-field (field &optional called-by-yank)  (defun bibtex-make-field (field &optional called-by-yank interactive)
3011    "Make a field named FIELD in current BibTeX entry.    "Make a field named FIELD in current BibTeX entry.
3012  FIELD is either a string or a list of the form  FIELD is either a string or a list of the form
3013  \(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG) as in  \(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG) as in
3014  `bibtex-entry-field-alist'.  `bibtex-entry-field-alist'.
3015  If CALLED-BY-YANK is non-nil, don't insert delimiters."  If CALLED-BY-YANK is non-nil, don't insert delimiters.
3016    In that case, or when called interactively, also don't do (WHAT?)."
3017    (interactive    (interactive
3018     (list (let ((completion-ignore-case t)     (list (let ((completion-ignore-case t)
3019                 (field-list (bibtex-field-list                 (field-list (bibtex-field-list
3020                               (save-excursion                              (save-excursion
3021                                 (bibtex-enclosing-entry-maybe-empty-head)                                (bibtex-enclosing-entry-maybe-empty-head)
3022                                 (bibtex-type-in-head)))))                                (bibtex-type-in-head)))))
3023             (completing-read "BibTeX field name: "             (completing-read "BibTeX field name: "
3024                              (append (car field-list) (cdr field-list))                              (append (car field-list) (cdr field-list))
3025                              nil nil nil bibtex-field-history))))                              nil nil nil bibtex-field-history))
3026             t))
3027    (unless (consp field)    (unless (consp field)
3028      (setq field (list field)))      (setq field (list field)))
3029    (if (or (interactive-p) called-by-yank)    (if (or interactive called-by-yank)
3030        (let (bibtex-help-message)        (let (bibtex-help-message)
3031          (bibtex-find-text nil t t)          (bibtex-find-text nil t t)
3032          (if (looking-at "[}\"]")          (if (looking-at "[}\"]")
# Line 2923  If CALLED-BY-YANK is non-nil, don't inse Line 3049  If CALLED-BY-YANK is non-nil, don't inse
3049            ((fboundp init)            ((fboundp init)
3050             (insert (funcall init)))))             (insert (funcall init)))))
3051    (unless called-by-yank (insert (bibtex-field-right-delimiter)))    (unless called-by-yank (insert (bibtex-field-right-delimiter)))
3052    (when (interactive-p)    (when interactive
3053      (forward-char -1)      (forward-char -1)
3054      (bibtex-print-help-message)))      (bibtex-print-help-message)))
3055    
# Line 3003  If mark is active it counts entries in r Line 3129  If mark is active it counts entries in r
3129           (not count-string-entries)))           (not count-string-entries)))
3130      (save-excursion      (save-excursion
3131        (save-restriction        (save-restriction
3132          (narrow-to-region (if (bibtex-mark-active)          (narrow-to-region (if mark-active (region-beginning)
                               (region-beginning)  
3133                              (bibtex-beginning-of-first-entry))                              (bibtex-beginning-of-first-entry))
3134                            (if (bibtex-mark-active)                            (if mark-active (region-end) (point-max)))
                               (region-end)  
                             (point-max)))  
         (goto-char (point-min))  
3135          (bibtex-map-entries (lambda (key beg end)          (bibtex-map-entries (lambda (key beg end)
3136                                (setq number (1+ number))))))                                (setq number (1+ number))))))
3137      (message "%s contains %d entries."      (message "%s contains %d entries."
3138               (if (bibtex-mark-active) "Region" "Buffer")               (if mark-active "Region" "Buffer")
3139               number)))               number)))
3140    
3141  (defun bibtex-ispell-entry ()  (defun bibtex-ispell-entry ()
# Line 3110  will be ignored." Line 3232  will be ignored."
3232                 nil                         ; ENDKEY function                 nil                         ; ENDKEY function
3233                 'bibtex-lessp)))            ; PREDICATE                 'bibtex-lessp)))            ; PREDICATE
3234    
3235  (defun bibtex-find-crossref (crossref-key)  (defun bibtex-find-entry-globally (key)
3236      "Move point to the beginning of BibTeX entry named KEY in `bibtex-files'."
3237      (interactive
3238       (list (let (key-alist)
3239               (dolist (buffer (bibtex-files-expand t))
3240                 (with-current-buffer buffer
3241                   (setq key-alist (append bibtex-reference-keys key-alist))))
3242               (completing-read "Find key: " key-alist
3243                                nil nil nil 'bibtex-key-history))))
3244      (let ((buffer-list (bibtex-files-expand t))
3245            buffer found)
3246        (while (and (not found)
3247                    (setq buffer (pop buffer-list)))
3248          (with-current-buffer buffer
3249            (if (cdr (assoc-string key bibtex-reference-keys))
3250                (setq found t))))
3251        (if found
3252            (progn
3253              (let ((same-window-buffer-names
3254                     (cons (buffer-name buffer) same-window-buffer-names)))
3255                (pop-to-buffer buffer))
3256              (bibtex-find-entry key))
3257          (message "Key `%s' not found" key))))
3258    
3259    (defun bibtex-find-crossref (crossref-key &optional pnt split)
3260    "Move point to the beginning of BibTeX entry CROSSREF-KEY.    "Move point to the beginning of BibTeX entry CROSSREF-KEY.
3261  Return position of entry if CROSSREF-KEY is found and nil otherwise.  Return position of entry if CROSSREF-KEY is found and nil otherwise.
3262  If position of current entry is after CROSSREF-KEY an error is signaled.  If position of current entry is after CROSSREF-KEY an error is signaled.
3263    Optional arg PNT is the position of the referencing entry.
3264    If optional arg SPLIT is non-nil, split window so that both the referencing
3265    and the crossrefed entry are displayed.
3266  If called interactively, CROSSREF-KEY defaults to crossref key of current  If called interactively, CROSSREF-KEY defaults to crossref key of current
3267  entry."  entry and SPLIT is t."
3268    (interactive    (interactive
3269     (let ((crossref-key     (let ((crossref-key
3270            (save-excursion            (save-excursion
# Line 3123  entry." Line 3272  entry."
3272              (let ((bounds (bibtex-search-forward-field "crossref" t)))              (let ((bounds (bibtex-search-forward-field "crossref" t)))
3273                (if bounds                (if bounds
3274                    (bibtex-text-in-field-bounds bounds t))))))                    (bibtex-text-in-field-bounds bounds t))))))
3275       (list (bibtex-read-key "Find crossref key: " crossref-key))))       (list (bibtex-read-key "Find crossref key: " crossref-key) (point) t)))
3276    (let ((pos (save-excursion (bibtex-find-entry crossref-key))))    (let ((pos (save-excursion (bibtex-find-entry crossref-key))))
3277      (if (and pos (> (point) pos))      (unless pnt (setq pnt (point)))
3278          (error "This entry must not follow the crossrefed entry!"))      (cond ((not pos)
3279      (goto-char pos)))             (message "Crossref key `%s' not found" crossref-key))
3280              (split
3281               (goto-char pnt)
3282               (select-window (split-window))
3283               (goto-char pos)
3284               (beginning-of-line)
3285               (set-window-start (selected-window) (point))
3286               (if (> pnt pos)
3287                   (error "The referencing entry must preceed the crossrefed entry!")))
3288              ((> pnt pos)
3289                   (error "The referencing entry must preceed the crossrefed entry!"))
3290              (t (goto-char pos)))
3291        pos))
3292    
3293  (defun bibtex-find-entry (key &optional start)  (defun bibtex-find-entry (key &optional start)
3294    "Move point to the beginning of BibTeX entry named KEY.    "Move point to the beginning of BibTeX entry named KEY.
# Line 3212  Return t if preparation was successful o Line 3373  Return t if preparation was successful o
3373    
3374  (defun bibtex-validate (&optional test-thoroughly)  (defun bibtex-validate (&optional test-thoroughly)
3375    "Validate if buffer or region is syntactically correct.    "Validate if buffer or region is syntactically correct.
3376  Only known entry types are checked, so you can put comments  Check also for duplicate keys and correct sort order provided
3377  outside of entries.  `bibtex-maintain-sorted-entries' is non-nil.
3378  With optional argument TEST-THOROUGHLY non-nil it checks for absence of  With optional argument TEST-THOROUGHLY non-nil check also for
3379  required fields and questionable month fields as well.  the absence of required fields and for questionable month fields.
3380  If mark is active, validate current region, if not the whole buffer.  If mark is active, validate current region, if not the whole buffer.
3381  Returns t if test was successful, nil otherwise."  Only check known entry types, so you can put comments outside of entries.
3382    Return t if test was successful, nil otherwise."
3383    (interactive "P")    (interactive "P")
3384    (let* ((case-fold-search t)    (let* ((case-fold-search t)
3385           error-list syntax-error)           error-list syntax-error)
3386      (save-excursion      (save-excursion
3387        (save-restriction        (save-restriction
3388          (narrow-to-region (if (bibtex-mark-active)          (narrow-to-region (if mark-active (region-beginning)
                               (region-beginning)  
3389                              (bibtex-beginning-of-first-entry))                              (bibtex-beginning-of-first-entry))
3390                            (if (bibtex-mark-active)                            (if mark-active (region-end) (point-max)))
                               (region-end)  
                             (point-max)))  
3391    
3392          ;; looking if entries fit syntactical structure          ;; looking if entries fit syntactical structure
3393          (goto-char (point-min))          (goto-char (point-min))
# Line 3244  Returns t if test was successful, nil ot Line 3403  Returns t if test was successful, nil ot
3403                  (if (equal (point) pnt)                  (if (equal (point) pnt)
3404                      (forward-char)                      (forward-char)
3405                    (goto-char pnt)                    (goto-char pnt)
3406                    (push (list (bibtex-current-line)                    (push (cons (bibtex-current-line)
3407                                "Syntax error (check esp. commas, braces, and quotes)")                                "Syntax error (check esp. commas, braces, and quotes)")
3408                          error-list)                          error-list)
3409                    (forward-char))))))                    (forward-char))))))
3410          (bibtex-progress-message 'done)          (bibtex-progress-message 'done)
3411    
3412          (if error-list          (if error-list
3413                ;; proceed only if there were no syntax errors.
3414              (setq syntax-error t)              (setq syntax-error t)
3415            ;; looking for correct sort order and duplicates (only if  
3416            ;; there were no syntax errors)            ;; looking for duplicate keys and correct sort order
3417            (if bibtex-maintain-sorted-entries            (let (previous current key-list)
3418                (let (previous current)              (bibtex-progress-message "Checking for duplicate keys")
3419                  (goto-char (point-min))              (bibtex-map-entries
3420                  (bibtex-progress-message "Checking correct sort order")               (lambda (key beg end)
3421                  (bibtex-map-entries                 (bibtex-progress-message)
3422                   (lambda (key beg end)                 (goto-char beg)
3423                     (bibtex-progress-message)                 (setq current (bibtex-entry-index))
3424                     (goto-char beg)                 (cond ((not previous))
3425                     (setq current (bibtex-entry-index))                       ((member key key-list)
3426                     (cond ((or (not previous)                        (push (cons (bibtex-current-line)
3427                                (bibtex-lessp previous current))                                    (format "Duplicate key `%s'" key))
3428                            (setq previous current))                              error-list))
3429                           ((string-equal (car previous) (car current))                       ((and bibtex-maintain-sorted-entries
3430                            (push (list (bibtex-current-line)                             (not (bibtex-lessp previous current)))
3431                                        "Duplicate key with previous")                        (push (cons (bibtex-current-line)
3432                                  error-list))                                    "Entries out of order")
3433                           (t                              error-list)))
3434                            (setq previous current)                 (push key key-list)
3435                            (push (list (bibtex-current-line)                 (setq previous current)))
3436                                        "Entries out of order")              (bibtex-progress-message 'done))
3437                                  error-list)))))  
3438                  (bibtex-progress-message 'done)))            ;; Check for duplicate keys in `bibtex-files'.
3439              (bibtex-parse-keys)
3440              (dolist (buffer (bibtex-files-expand))
3441                (dolist (key (with-current-buffer buffer
3442                               ;; We don't want to be fooled by outdated
3443                               ;; bibtex-reference-keys.
3444                               (bibtex-parse-keys) bibtex-reference-keys))
3445                  (when (and (cdr key)
3446                             (cdr (assoc-string (car key) bibtex-reference-keys)))
3447                    (bibtex-find-entry (car key))
3448                    (push (cons (bibtex-current-line)
3449                                (format "Duplicate key `%s' in %s" (car key)
3450                                        (abbreviate-file-name (buffer-file-name buffer))))
3451                          error-list))))
3452    
3453            (when test-thoroughly            (when test-thoroughly
             (goto-char (point-min))  
3454              (bibtex-progress-message              (bibtex-progress-message
3455               "Checking required fields and month fields")               "Checking required fields and month fields")
3456              (let ((bibtex-sort-ignore-string-entries t))              (let ((bibtex-sort-ignore-string-entries t))
# Line 3292  Returns t if test was successful, nil ot Line 3464  Returns t if test was successful, nil ot
3464                                                      bibtex-entry-field-alist t)))                                                      bibtex-entry-field-alist t)))
3465                          (req (copy-sequence (elt (elt entry-list 1) 0)))                          (req (copy-sequence (elt (elt entry-list 1) 0)))
3466                          (creq (copy-sequence (elt (elt entry-list 2) 0)))                          (creq (copy-sequence (elt (elt entry-list 2) 0)))
3467                          crossref-there bounds)                          crossref-there bounds alt-there field)
3468                     (goto-char beg)                     (goto-char beg)
3469                     (while (setq bounds (bibtex-search-forward-field                     (while (setq bounds (bibtex-search-forward-field
3470                                          bibtex-field-name end))                                          bibtex-field-name end))
3471                       (goto-char (bibtex-start-of-text-in-field bounds))                       (goto-char (bibtex-start-of-text-in-field bounds))
3472                       (let ((field-name (bibtex-name-in-field bounds)))                       (let ((field-name (bibtex-name-in-field bounds)))
3473                         (if (and (bibtex-string= field-name "month")                         (if (and (bibtex-string= field-name "month")
3474                                  (not (assoc-string (bibtex-text-in-field-bounds bounds)                                  ;; Check only abbreviated month fields.
3475                                                     bibtex-predefined-month-strings t)))                                  (let ((month (bibtex-text-in-field-bounds bounds)))
3476                             (push (list (bibtex-current-line)                                    (not (or (string-match "\\`[\"{].+[\"}]\\'" month)
3477                                               (assoc-string
3478                                                month
3479                                                bibtex-predefined-month-strings t)))))
3480                               (push (cons (bibtex-current-line)
3481                                         "Questionable month field")                                         "Questionable month field")
3482                                   error-list))                                   error-list))
3483                         (setq req (delete (assoc-string field-name req t) req)                         (setq field (assoc-string field-name req t))
3484                           (if (nth 3 field)
3485                               (if alt-there (push (cons (bibtex-current-line)
3486                                                         "More than one non-empty alternative")
3487                                                   error-list)
3488                                 (setq alt-there t)))
3489                           (setq req (delete field req)
3490                               creq (delete (assoc-string field-name creq t) creq))                               creq (delete (assoc-string field-name creq t) creq))
3491                         (if (bibtex-string= field-name "crossref")                         (if (bibtex-string= field-name "crossref")
3492                             (setq crossref-there t))))                             (setq crossref-there t))))
3493                     (if crossref-there                     (if crossref-there
3494                         (setq req creq))                         (setq req creq))
3495                     (if (or (> (length req) 1)                     (let (alt)
3496                             (and (= (length req) 1)                       (dolist (field req)
3497                                  (not (elt (car req) 3))))                         (if (nth 3 field)
3498                         ;; two (or more) fields missed or one field                             (push (car field) alt)
3499                         ;; missed and this isn't flagged alternative                           (push (cons (save-excursion (goto-char beg)
3500                         ;; (notice that this fails if there are more                                                       (bibtex-current-line))
3501                         ;; than two alternatives in a BibTeX entry,                                       (format "Required field `%s' missing"
3502                         ;; which isn't the case momentarily)                                               (car field)))
3503                         (push (list (save-excursion                                 error-list)))
3504                                       (bibtex-beginning-of-entry)                       ;; The following fails if there are more than two
3505                                       (bibtex-current-line))                       ;; alternatives in a BibTeX entry, which isn't
3506                                     (concat "Required field `" (caar req) "' missing"))                       ;; the case momentarily.
3507                               error-list))))))                       (if (cdr alt)
3508                             (push (cons (save-excursion (goto-char beg)
3509                                                         (bibtex-current-line))
3510                                         (format "Alternative fields `%s'/`%s' missing"
3511                                                 (car alt) (cadr alt)))
3512                                   error-list)))))))
3513              (bibtex-progress-message 'done)))))              (bibtex-progress-message 'done)))))
3514    
3515      (if error-list      (if error-list
3516          (let ((bufnam (buffer-name))          (let ((file (file-name-nondirectory (buffer-file-name)))
3517                (dir default-directory))                (dir default-directory)
3518            (setq error-list                (err-buf "*BibTeX validation errors*"))
3519                  (sort error-list            (setq error-list (sort error-list 'car-less-than-car))
3520                        (lambda (a b)            (with-current-buffer (get-buffer-create err-buf)
3521                          (< (car a) (car b)))))              (setq default-directory dir)
3522            (let ((pop-up-windows t))              (unless (eq major-mode 'compilation-mode) (compilation-mode))
3523              (pop-to-buffer nil t))              (toggle-read-only -1)
3524            (switch-to-buffer              (delete-region (point-min) (point-max))
3525             (get-buffer-create "*BibTeX validation errors*") t)              (insert "BibTeX mode command `bibtex-validate'\n"
3526            ;; don't use switch-to-buffer-other-window, since this                      (if syntax-error
3527            ;; doesn't allow the second parameter NORECORD                          "Maybe undetected errors due to syntax errors. Correct and validate again.\n"
3528            (setq default-directory dir)                        "\n"))
3529            (toggle-read-only -1)              (dolist (err error-list)
3530            (compilation-mode)                (insert (format "%s:%d: %s\n" file (car err) (cdr err))))
3531            (delete-region (point-min) (point-max))              (set-buffer-modified-p nil)
3532            (goto-char (point-min))              (toggle-read-only 1)
3533            (insert "BibTeX mode command `bibtex-validate'\n"              (goto-line 3)) ; first error message
3534                    (if syntax-error            (display-buffer err-buf)
3535                        "Maybe undetected errors due to syntax errors. Correct and validate again."            ;; return nil
3536                      "")            nil)
3537                    "\n")        (message "%s is syntactically correct"
3538            (dolist (err error-list)                 (if mark-active "Region" "Buffer"))
3539              (insert bufnam ":" (number-to-string (elt err 0))        t)))
3540                      ": " (elt err 1) "\n"))  
3541            (set-buffer-modified-p nil)  (defun bibtex-validate-globally (&optional strings)
3542            (toggle-read-only 1)    "Check for duplicate keys in `bibtex-files'.
3543    With prefix arg STRINGS, check for duplicate strings, too.
3544    Return t if test was successful, nil otherwise."
3545      (interactive "P")
3546      (let ((buffer-list (bibtex-files-expand t))
3547            buffer-key-list current-buf current-keys error-list)
3548        ;; Check for duplicate keys within BibTeX buffer
3549        (dolist (buffer buffer-list)
3550          (save-excursion
3551            (set-buffer buffer)
3552            (let (entry-type key key-list)
3553            (goto-char (point-min))            (goto-char (point-min))
3554            (other-window -1)            (while (re-search-forward bibtex-entry-head nil t)
3555                (setq entry-type (bibtex-type-in-head)
3556                      key (bibtex-key-in-head))
3557                (if (or (and strings (bibtex-string= entry-type "string"))
3558                        (assoc-string entry-type bibtex-entry-field-alist t))
3559                    (if (member key key-list)
3560                        (push (format "%s:%d: Duplicate key `%s'\n"
3561                                      (buffer-file-name)
3562                                      (bibtex-current-line) key)
3563                              error-list)
3564                      (push key key-list))))
3565              (push (cons buffer key-list) buffer-key-list))))
3566    
3567        ;; Check for duplicate keys among BibTeX buffers
3568        (while (setq current-buf (pop buffer-list))
3569          (setq current-keys (cdr (assq current-buf buffer-key-list)))
3570          (with-current-buffer current-buf
3571            (dolist (buffer buffer-list)
3572              (dolist (key (cdr (assq buffer buffer-key-list)))
3573                (when (assoc-string key current-keys)
3574                  (bibtex-find-entry key)
3575                  (push (format "%s:%d: Duplicat key `%s' in %s\n"
3576                                (buffer-file-name) (bibtex-current-line) key
3577                                (abbreviate-file-name (buffer-file-name buffer)))
3578                        error-list))))))
3579    
3580        ;; Process error list
3581        (if error-list
3582            (let ((err-buf "*BibTeX validation errors*"))
3583              (with-current-buffer (get-buffer-create err-buf)
3584                (unless (eq major-mode 'compilation-mode) (compilation-mode))
3585                (toggle-read-only -1)
3586                (delete-region (point-min) (point-max))
3587                (insert "BibTeX mode command `bibtex-validate-globally'\n\n")
3588                (dolist (err (sort error-list 'string-lessp)) (insert err))
3589                (set-buffer-modified-p nil)
3590                (toggle-read-only 1)
3591                (goto-line 3)) ; first error message
3592              (display-buffer err-buf)
3593            ;; return nil            ;; return nil
3594            nil)            nil)
3595        (if (bibtex-mark-active)        (message "No duplicate keys.")
           (message "Region is syntactically correct")  
         (message "Buffer is syntactically correct"))  
3596        t)))        t)))
3597    
3598  (defun bibtex-next-field (arg)  (defun bibtex-next-field (arg)
# Line 3378  Returns t if test was successful, nil ot Line 3612  Returns t if test was successful, nil ot
3612    
3613  (defun bibtex-find-text (arg &optional as-if-interactive no-error)  (defun bibtex-find-text (arg &optional as-if-interactive no-error)
3614    "Go to end of text of current field; with ARG, go to beginning."    "Go to end of text of current field; with ARG, go to beginning."
3615    (interactive "P")    (interactive "P\np")
3616    (bibtex-inside-field)    (bibtex-inside-field)
3617    (let ((bounds (bibtex-enclosing-field (or (interactive-p)    (let ((bounds (bibtex-enclosing-field as-if-interactive)))
                                             as-if-interactive))))  
3618      (if bounds      (if bounds
3619          (progn (if arg          (progn (if arg
3620                     (progn (goto-char (bibtex-start-of-text-in-field bounds))                     (progn (goto-char (bibtex-start-of-text-in-field bounds))
# Line 3404  Returns t if test was successful, nil ot Line 3637  Returns t if test was successful, nil ot
3637                            (match-end 0))))                            (match-end 0))))
3638              (t              (t
3639               (unless no-error               (unless no-error
3640                   (error "Not on BibTeX field")))))))                 (error "Not on BibTeX field")))))))
3641    
3642  (defun bibtex-remove-OPT-or-ALT ()  (defun bibtex-remove-OPT-or-ALT ()
3643    "Remove the string starting optional/alternative fields.    "Remove the string starting optional/alternative fields.
# Line 3470  but do not actually kill it." Line 3703  but do not actually kill it."
3703    (setq bibtex-last-kill-command 'field))    (setq bibtex-last-kill-command 'field))
3704    
3705  (defun bibtex-copy-field-as-kill ()  (defun bibtex-copy-field-as-kill ()
3706      "Copy the field at point to the kill ring."
3707    (interactive)    (interactive)
3708    (bibtex-kill-field t))    (bibtex-kill-field t))
3709    
# Line 3492  With prefix arg COPY-ONLY the current en Line 3726  With prefix arg COPY-ONLY the current en
3726            (setcdr (nthcdr (1- bibtex-entry-kill-ring-max)            (setcdr (nthcdr (1- bibtex-entry-kill-ring-max)
3727                            bibtex-entry-kill-ring)                            bibtex-entry-kill-ring)
3728                    nil))                    nil))
3729      (setq bibtex-entry-kill-ring-yank-pointer bibtex-entry-kill-ring)        (setq bibtex-entry-kill-ring-yank-pointer bibtex-entry-kill-ring)
3730      (unless copy-only        (unless copy-only
3731        (delete-region beg end))))          (delete-region beg end))))
3732    (setq bibtex-last-kill-command 'entry))    (setq bibtex-last-kill-command 'entry))
3733    
3734  (defun bibtex-copy-entry-as-kill ()  (defun bibtex-copy-entry-as-kill ()
# Line 3584  At end of the cleaning process, the func Line 3818  At end of the cleaning process, the func
3818             ;; (bibtex-format-preamble)             ;; (bibtex-format-preamble)
3819             (error "No clean up of @Preamble entries"))             (error "No clean up of @Preamble entries"))
3820            ((bibtex-string= entry-type "string"))            ((bibtex-string= entry-type "string"))
3821             ;; (bibtex-format-string)            ;; (bibtex-format-string)
3822            (t (bibtex-format-entry)))            (t (bibtex-format-entry)))
3823      ;; set key      ;; set key
3824      (when (or new-key (not key))      (when (or new-key (not key))
# Line 3597  At end of the cleaning process, the func Line 3831  At end of the cleaning process, the func
3831            (delete-region (match-beginning bibtex-key-in-head)            (delete-region (match-beginning bibtex-key-in-head)
3832                           (match-end bibtex-key-in-head)))                           (match-end bibtex-key-in-head)))
3833        (insert key))        (insert key))
3834      ;; sorting  
3835      (unless called-by-reformat      (unless called-by-reformat
3836        (let* ((start (bibtex-beginning-of-entry))        (let* ((start (bibtex-beginning-of-entry))
3837               (end (progn (bibtex-end-of-entry)               (end (progn (bibtex-end-of-entry)
# Line 3606  At end of the cleaning process, the func Line 3840  At end of the cleaning process, the func
3840                               (goto-char (match-beginning 0)))                               (goto-char (match-beginning 0)))
3841                           (point)))                           (point)))
3842               (entry (buffer-substring start end))               (entry (buffer-substring start end))
3843               (index (progn (goto-char start)               ;; include the crossref key in index
3844                             (bibtex-entry-index)))               (index (let ((bibtex-maintain-sorted-entries 'crossref))
3845                          (goto-char start)
3846                          (bibtex-entry-index)))
3847               error)               error)
3848            ;; sorting
3849          (if (and bibtex-maintain-sorted-entries          (if (and bibtex-maintain-sorted-entries
3850                   (not (and bibtex-sort-ignore-string-entries                   (not (and bibtex-sort-ignore-string-entries
3851                             (bibtex-string= entry-type "string"))))                             (bibtex-string= entry-type "string"))))
# Line 3623  At end of the cleaning process, the func Line 3860  At end of the cleaning process, the func
3860            (setq error (or (/= (point) start)            (setq error (or (/= (point) start)
3861                            (bibtex-find-entry key end))))                            (bibtex-find-entry key end))))
3862          (if error          (if error
3863            (error "New inserted entry yields duplicate key"))))              (error "New inserted entry yields duplicate key"))
3864      ;; final clean up          (dolist (buffer (bibtex-files-expand))
3865      (unless called-by-reformat            (with-current-buffer buffer
3866        (save-excursion              (if (cdr (assoc-string key bibtex-reference-keys))
3867          (save-restriction                  (error "Duplicate key in %s" (buffer-file-name)))))
3868            (bibtex-narrow-to-entry)  
3869            ;; Only update the list of keys if it has been built already.          ;; Only update the list of keys if it has been built already.
3870            (cond ((bibtex-string= entry-type "string")          (cond ((bibtex-string= entry-type "string")
3871                   (if (listp bibtex-strings) (bibtex-parse-strings t)))                 (if (and (listp bibtex-strings)
3872                  ((listp bibtex-reference-keys) (bibtex-parse-keys t)))                          (not (assoc key bibtex-strings)))
3873            (run-hooks 'bibtex-clean-entry-hook))))))                     (push (list key) bibtex-strings)))
3874                  ;; We have a normal entry.
3875                  ((listp bibtex-reference-keys)
3876                   (cond ((not (assoc key bibtex-reference-keys))
3877                          (push (cons key t) bibtex-reference-keys))
3878                         ((not (cdr (assoc key bibtex-reference-keys)))
3879                          ;; Turn a crossref key into a header key
3880                          (setq bibtex-reference-keys
3881                                (cons (cons key t)
3882                                      (delete (list key) bibtex-reference-keys)))))
3883                   ;; Handle crossref key.
3884                   (if (and (nth 1 index)
3885                            (not (assoc (nth 1 index) bibtex-reference-keys)))
3886                       (push (list (nth 1 index)) bibtex-reference-keys)))))
3887    
3888          ;; final clean up
3889          (if bibtex-clean-entry-hook
3890              (save-excursion
3891                (save-restriction
3892                  (bibtex-narrow-to-entry)
3893                  (run-hooks 'bibtex-clean-entry-hook)))))))
3894    
3895  (defun bibtex-fill-field-bounds (bounds justify &optional move)  (defun bibtex-fill-field-bounds (bounds justify &optional move)
3896    "Fill BibTeX field delimited by BOUNDS.    "Fill BibTeX field delimited by BOUNDS.
# Line 3705  If `bibtex-align-at-equal-sign' is non-n Line 3962  If `bibtex-align-at-equal-sign' is non-n
3962    "Realign BibTeX entries such that they are separated by one blank line."    "Realign BibTeX entries such that they are separated by one blank line."
3963    (goto-char (point-min))    (goto-char (point-min))
3964    (let ((case-fold-search t))    (let ((case-fold-search t))
3965        ;; No blank lines prior to the first valid entry if there no
3966        ;; non-white characters in front of it.
3967      (when (looking-at bibtex-valid-entry-whitespace-re)      (when (looking-at bibtex-valid-entry-whitespace-re)
3968        (replace-match "\\1"))        (replace-match "\\1"))
3969        ;; Valid entries are separated by one blank line.
3970      (while (re-search-forward bibtex-valid-entry-whitespace-re nil t)      (while (re-search-forward bibtex-valid-entry-whitespace-re nil t)
3971        (replace-match "\n\n\\1"))))        (replace-match "\n\n\\1"))
3972        ;; One blank line past the last valid entry if it is followed by
3973        ;; non-white characters, no blank line otherwise.
3974        (beginning-of-line)
3975        (when (re-search-forward bibtex-valid-entry-re nil t)
3976          (bibtex-end-of-entry)
3977          (bibtex-delete-whitespace)
3978          (open-line (if (eobp) 1 2)))))
3979    
3980  (defun bibtex-reformat (&optional read-options)  (defun bibtex-reformat (&optional read-options)
3981    "Reformat all BibTeX entries in buffer or region.    "Reformat all BibTeX entries in buffer or region.
3982    Without prefix argument, reformatting is based on `bibtex-entry-format'.
3983  With prefix argument, read options for reformatting from minibuffer.  With prefix argument, read options for reformatting from minibuffer.
3984  With \\[universal-argument] \\[universal-argument] prefix argument, reuse previous answers (if any) again.  With \\[universal-argument] \\[universal-argument] prefix argument, reuse previous answers (if any) again.
3985  If mark is active reformat entries in region, if not in whole buffer."  If mark is active reformat entries in region, if not in whole buffer."
# Line 3722  If mark is active reformat entries in re Line 3990  If mark is active reformat entries in re
3990                 (or bibtex-reformat-previous-options                 (or bibtex-reformat-previous-options
3991                     bibtex-reformat-previous-reference-keys)))                     bibtex-reformat-previous-reference-keys)))
3992           (bibtex-entry-format           (bibtex-entry-format
3993            (if read-options            (cond (read-options
3994                (if use-previous-options                   (if use-previous-options
3995                    bibtex-reformat-previous-options                       bibtex-reformat-previous-options
3996                  (setq bibtex-reformat-previous-options                     (setq bibtex-reformat-previous-options
3997                        (mapcar (lambda (option)                           (mapcar (lambda (option)
3998                                  (if (y-or-n-p (car option)) (cdr option)))                                     (if (y-or-n-p (car option)) (cdr option)))
3999                                `(("Realign entries (recommended)? " . 'realign)                                   `(("Realign entries (recommended)? " . 'realign)
4000                                  ("Remove empty optional and alternative fields? " . 'opts-or-alts)                                     ("Remove empty optional and alternative fields? " . 'opts-or-alts)
4001                                  ("Remove delimiters around pure numerical fields? " . 'numerical-fields)                                     ("Remove delimiters around pure numerical fields? " . 'numerical-fields)
4002                                  (,(concat (if bibtex-comma-after-last-field "Insert" "Remove")                                     (,(concat (if bibtex-comma-after-last-field "Insert" "Remove")
4003                                           " comma at end of entry? ") . 'last-comma)                                               " comma at end of entry? ") . 'last-comma)
4004                                  ("Replace double page dashes by single ones? " . 'page-dashes)                                     ("Replace double page dashes by single ones? " . 'page-dashes)
4005                                  ("Force delimiters? " . 'delimiters)                                     ("Inherit booktitle? " . 'inherit-booktitle)
4006                                  ("Unify case of entry types and field names? " . 'unify-case)))))                                     ("Force delimiters? " . 'delimiters)
4007              '(realign)))                                     ("Unify case of entry types and field names? " . 'unify-case))))))
4008                    ;; Do not include required-fields because `bibtex-reformat'
4009                    ;; cannot handle the error messages of `bibtex-format-entry'.
4010                    ;; Use `bibtex-validate' to check for required fields.
4011                    ((eq t bibtex-entry-format)
4012                     '(realign opts-or-alts numerical-fields delimiters
4013                               last-comma page-dashes unify-case inherit-booktitle))
4014                    (t
4015                     (remove 'required-fields (push 'realign bibtex-entry-format)))))
4016           (reformat-reference-keys           (reformat-reference-keys
4017            (if read-options            (if read-options
4018                (if use-previous-options                (if use-previous-options
4019                    bibtex-reformat-previous-reference-keys                    bibtex-reformat-previous-reference-keys
4020                  (setq bibtex-reformat-previous-reference-keys                  (setq bibtex-reformat-previous-reference-keys
4021                        (y-or-n-p "Generate new reference keys automatically? ")))))                        (y-or-n-p "Generate new reference keys automatically? ")))))
          (start-point (if (bibtex-mark-active)  
                           (region-beginning)  
                         (point-min)))  
          (end-point (if (bibtex-mark-active)  
                         (region-end)  
                       (point-max)))  
4022           (bibtex-sort-ignore-string-entries t)           (bibtex-sort-ignore-string-entries t)
4023           bibtex-autokey-edit-before-use)           bibtex-autokey-edit-before-use)
4024    
4025      (save-restriction      (save-restriction
4026        (narrow-to-region start-point end-point)        (narrow-to-region (if mark-active (region-beginning) (point-min))
4027                            (if mark-active (region-end) (point-max)))
4028        (if (memq 'realign bibtex-entry-format)        (if (memq 'realign bibtex-entry-format)
4029          (bibtex-realign))            (bibtex-realign))
       (goto-char start-point)  
4030        (bibtex-progress-message "Formatting" 1)        (bibtex-progress-message "Formatting" 1)
4031        (bibtex-map-entries (lambda (key beg end)        (bibtex-map-entries (lambda (key beg end)
4032                              (bibtex-progress-message)                              (bibtex-progress-message)
4033                              (bibtex-clean-entry reformat-reference-keys t)))                              (bibtex-clean-entry reformat-reference-keys t)))
       (when (memq 'realign bibtex-entry-format)  
         (bibtex-delete-whitespace)  
         (open-line (if (eobp) 1 2)))  
4034        (bibtex-progress-message 'done))        (bibtex-progress-message 'done))
4035      (when (and reformat-reference-keys      (when reformat-reference-keys
                bibtex-maintain-sorted-entries)  
       (bibtex-progress-message "Sorting" 1)  
       (bibtex-sort-buffer)  
4036        (kill-local-variable 'bibtex-reference-keys)        (kill-local-variable 'bibtex-reference-keys)
4037        (bibtex-progress-message 'done))        (when bibtex-maintain-sorted-entries
4038            (bibtex-progress-message "Sorting" 1)
4039            (bibtex-sort-buffer)
4040            (bibtex-progress-message 'done)))
4041      (goto-char pnt)))      (goto-char pnt)))
4042    
4043  (defun bibtex-convert-alien (&optional read-options)  (defun bibtex-convert-alien (&optional read-options)
# Line 3837  signaled if point is outside key or BibT Line 4104  signaled if point is outside key or BibT
4104             ;; key completion             ;; key completion
4105             (setq choose-completion-string-functions             (setq choose-completion-string-functions
4106                   (lambda (choice buffer mini-p base-size)                   (lambda (choice buffer mini-p base-size)
4107                      (bibtex-choose-completion-string choice buffer mini-p base-size)                     (let ((choose-completion-string-functions nil))
4108                         (choose-completion-string choice buffer base-size))
4109                     (bibtex-complete-key-cleanup choice)                     (bibtex-complete-key-cleanup choice)
4110                     ;; return t (required by choose-completion-string-functions)                     ;; return t (required by choose-completion-string-functions)
4111                     t))                     t))
4112             (bibtex-complete-key-cleanup (bibtex-complete-internal             (bibtex-complete-key-cleanup (bibtex-complete-internal
4113                                           bibtex-reference-keys)))                                           bibtex-reference-keys)))
4114    
4115            (compl            (compl
4116             ;; string completion             ;; string completion
4117             (setq choose-completion-string-functions             (setq choose-completion-string-functions
4118                   `(lambda (choice buffer mini-p base-size)                   `(lambda (choice buffer mini-p base-size)
4119                     (bibtex-choose-completion-string choice buffer mini-p base-size)                      (let ((choose-completion-string-functions nil))
4120                     (bibtex-complete-string-cleanup choice ',compl)                        (choose-completion-string choice buffer base-size))
4121                     ;; return t (required by choose-completion-string-functions)                      (bibtex-complete-string-cleanup choice ',compl)
4122                     t))                      ;; return t (required by choose-completion-string-functions)
4123                        t))
4124             (bibtex-complete-string-cleanup (bibtex-complete-internal compl)             (bibtex-complete-string-cleanup (bibtex-complete-internal compl)
4125                                             compl))                                             compl))
4126    
# Line 3960  signaled if point is outside key or BibT Line 4229  signaled if point is outside key or BibT
4229              "\n")              "\n")
4230      (goto-char endpos)))      (goto-char endpos)))
4231    
4232  (defun bibtex-url (&optional event)  (defun bibtex-url (&optional pos)
4233    "Browse a URL for the BibTeX entry at position PNT.    "Browse a URL for the BibTeX entry at point.
4234    Optional POS is the location of the BibTeX entry.
4235  The URL is generated using the schemes defined in `bibtex-generate-url-list'  The URL is generated using the schemes defined in `bibtex-generate-url-list'
4236  \(see there\).  Then the URL is passed to `browse-url'."  \(see there\).  Then the URL is passed to `browse-url'."
4237    (interactive (list last-input-event))    (interactive)
4238    (save-excursion    (save-excursion
4239      (if event (posn-set-point (event-end event)))      (if pos (goto-char pos))
4240      (bibtex-beginning-of-entry)      (bibtex-beginning-of-entry)
4241      (let ((fields-alist (bibtex-parse-entry))      (let ((fields-alist (bibtex-parse-entry))
4242              ;; Always ignore case,
4243            (case-fold-search t)            (case-fold-search t)
4244            (lst bibtex-generate-url-list)            (lst bibtex-generate-url-list)
4245              (delim-regexp "\\`[{\"]\\(.*\\)[}\"]\\'")
4246            field url scheme)            field url scheme)
4247        (while (setq scheme (car lst))        (while (setq scheme (pop lst))
4248          (when (and (setq field (cdr (assoc-string (caar scheme)          (when (and (setq field (cdr (assoc-string (caar scheme)
4249                                                    fields-alist t)))                                                    fields-alist t)))
4250                     (progn                     ;; Always remove field delimiters
4251                       (if (string-match "\\`[{\"]\\(.*\\)[}\"]\\'" field)                     (progn (if (string-match delim-regexp field)
4252                           (setq field (match-string 1 field)))                                (setq field (match-string 1 field)))
4253                       (string-match (cdar scheme) field)))                            (string-match (cdar scheme) field)))
4254            (setq lst nil)            (setq lst nil)
4255            (if (null (cdr scheme))            (if (null (cdr scheme))
4256                (setq url (match-string 0 field)))                (setq url (match-string 0 field)))
4257            (dolist (step (cdr scheme))            (dolist (step (cdr scheme))
4258              (cond ((stringp step)              (cond ((stringp step)
4259                     (setq url (concat url step)))                     (setq url (concat url step)))
4260                    ((setq field (assoc-string (car step) fields-alist t))                    ((setq field (cdr (assoc-string (car step) fields-alist t)))
4261                     ;; always remove field delimiters                     ;; Always remove field delimiters
4262                     (let* ((text (if (string-match "\\`[{\"]\\(.*\\)[}\"]\\'"                     (if (string-match delim-regexp field)
4263                                                    (cdr field))                         (setq field (match-string 1 field)))
4264                                      (match-string 1 (cdr field))                     (if (string-match (nth 1 step) field)
4265                                    (cdr field)))                         (setq field (cond
4266                            (str (if (string-match (nth 1 step) text)                                      ((functionp (nth 2 step))
4267                                     (cond                                       (funcall (nth 2 step) field))
4268                                      ((functionp (nth 2 step))                                      ((numberp (nth 2 step))
4269                                       (funcall (nth 2 step) text))                                       (match-string (nth 2 step) field))
4270                                      ((numberp (nth 2 step))                                      (t
4271                                       (match-string (nth 2 step) text))                                       (replace-match (nth 2 step) nil nil field))))
4272                                      (t                       ;; If the scheme is set up correctly,
4273                                       (replace-match (nth 2 step) nil nil text)))                       ;; we should never reach this point
4274                                   ;; If the scheme is set up correctly,                       (error "Match failed: %s" field))
4275                                   ;; we should never reach this point                     (setq url (concat url field)))
4276                                   (error "Match failed: %s" text))))                    ;; If the scheme is set up correctly,
4277                       (setq url (concat url str))))                    ;; we should never reach this point
4278                    ;; If the scheme is set up correctly,                    (t (error "Step failed: %s" step))))
4279                    ;; we should never reach this point            (message "%s" url)
4280                    (t (error "Step failed: %s" step))))            (browse-url url)))
4281            (message "%s" url)        (unless url (message "No URL known.")))))
           (browse-url url))  
         (setq lst (cdr lst)))  
     (unless url (message "No URL known.")))))  
   
 (defun bibtex-font-lock-url (bound)  
   "Font-lock for URLs."  
   (let ((case-fold-search t)  
         (bounds (bibtex-enclosing-field t))  
         (pnt (point))  
         found field)  
     ;; We use start-of-field as syntax-begin  
     (goto-char (if bounds (bibtex-start-of-field bounds) pnt))  
     (while (and (not found)  
                 (prog1 (re-search-forward bibtex-font-lock-url-regexp bound t)  
                   (setq field (match-string-no-properties 1)))  
                 (setq bounds (bibtex-parse-field-text))  
                 (>= bound (car bounds))  
                 (>= (car bounds) pnt))  
       (let ((lst bibtex-generate-url-list) url)  
         (goto-char (car bounds))  
         (while (and (not found)  
                     (setq url (caar lst)))  
           (when (bibtex-string= field (car url))  
             (setq found (re-search-forward (cdr url) (cdr bounds) t)))  
           (setq lst (cdr lst))))  
       (goto-char (cdr bounds)))  
     found))  
4282    
4283    
4284  ;; Make BibTeX a Feature  ;; Make BibTeX a Feature

Legend:
Removed from v.1.77.2.3  
changed lines
  Added in v.1.77.2.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26