+;; Support for hideshow minor mode
+(defun bibtex-hs-forward-sexp (arg)
+ "Replacement for `forward-sexp' to be used by `hs-minor-mode'.
+ARG is ignored."
+ (if (looking-at "@\\S(*\\s(")
+ (goto-char (1- (match-end 0))))
+ (forward-sexp 1))
+
+(add-to-list
+ 'hs-special-modes-alist
+ '(bibtex-mode "@\\S(*\\s(" "\\s)" nil bibtex-hs-forward-sexp nil))
+
+\f
+(defun bibtex-parse-association (parse-lhs parse-rhs)
+ "Parse a string of the format <left-hand-side = right-hand-side>.
+The functions PARSE-LHS and PARSE-RHS are used to parse the corresponding
+substrings. These functions are expected to return nil if parsing is not
+successful. If the returned values of both functions are non-nil,
+return a cons pair of these values. Do not move point."
+ (save-match-data
+ (save-excursion
+ (let ((left (funcall parse-lhs))
+ right)
+ (if (and left
+ (looking-at "[ \t\n]*=[ \t\n]*")
+ (goto-char (match-end 0))
+ (setq right (funcall parse-rhs)))
+ (cons left right))))))
+
+(defun bibtex-parse-field-name ()
+ "Parse the name part of a BibTeX field.
+If the field name is found, return a triple consisting of the position of the
+very first character of the match, the actual starting position of the name
+part and end position of the match. Move point to end of field name.
+If `bibtex-autoadd-commas' is non-nil add missing comma at end of preceding
+BibTeX field as necessary."
+ (cond ((looking-at bibtex-name-part)
+ (goto-char (match-end 0))
+ (list (match-beginning 0) (match-beginning 1) (match-end 0)))
+ ;; Maybe add a missing comma.
+ ((and bibtex-autoadd-commas
+ (looking-at (concat "[ \t\n]*\\(?:" bibtex-field-name
+ "\\)[ \t\n]*=")))
+ (skip-chars-backward " \t\n")
+ ;; It can be confusing if non-editing commands try to
+ ;; modify the buffer.
+ (if buffer-read-only
+ (error "Comma missing at buffer position %s" (point)))
+ (insert ",")
+ (forward-char -1)
+ ;; Now try again.
+ (bibtex-parse-field-name))))
+
+(defconst bibtex-braced-string-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?\{ "(}" st)
+ (modify-syntax-entry ?\} "){" st)
+ (modify-syntax-entry ?\[ "." st)
+ (modify-syntax-entry ?\] "." st)
+ (modify-syntax-entry ?\( "." st)
+ (modify-syntax-entry ?\) "." st)
+ (modify-syntax-entry ?\\ "." st)
+ (modify-syntax-entry ?\" "." st)
+ st)
+ "Syntax-table to parse matched braces.")
+
+(defconst bibtex-quoted-string-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?\\ "\\" st)
+ (modify-syntax-entry ?\" "\"" st)
+ st)
+ "Syntax-table to parse matched quotes.")
+
+(defun bibtex-parse-field-string ()
+ "Parse a BibTeX field string enclosed by braces or quotes.
+If a syntactically correct string is found, a pair containing the start and
+end position of the field string is returned, nil otherwise.
+Do not move point."
+ (let ((end-point
+ (or (and (eq (following-char) ?\")
+ (save-excursion
+ (with-syntax-table bibtex-quoted-string-syntax-table
+ (forward-sexp 1))
+ (point)))
+ (and (eq (following-char) ?\{)
+ (save-excursion
+ (with-syntax-table bibtex-braced-string-syntax-table
+ (forward-sexp 1))
+ (point))))))
+ (if end-point
+ (cons (point) end-point))))
+
+(defun bibtex-parse-field-text ()
+ "Parse the text part of a BibTeX field.
+The text part is either a string, or an empty string, or a constant followed
+by one or more <# (string|constant)> pairs. If a syntactically correct text
+is found, a pair containing the start and end position of the text is
+returned, nil otherwise. Move point to end of field text."
+ (let ((starting-point (point))
+ end-point failure boundaries)
+ (while (not (or end-point failure))
+ (cond ((looking-at bibtex-field-const)
+ (goto-char (match-end 0)))
+ ((setq boundaries (bibtex-parse-field-string))
+ (goto-char (cdr boundaries)))
+ ((setq failure t)))
+ (if (looking-at "[ \t\n]*#[ \t\n]*")
+ (goto-char (match-end 0))
+ (setq end-point (point))))
+ (skip-chars-forward " \t\n")
+ (if (and (not failure)
+ end-point)
+ (list starting-point end-point (point)))))
+
+(defun bibtex-parse-field ()
+ "Parse the BibTeX field beginning at the position of point.
+If a syntactically correct field is found, return a cons pair containing
+the boundaries of the name and text parts of the field. Do not move point."
+ (bibtex-parse-association 'bibtex-parse-field-name
+ 'bibtex-parse-field-text))
+
+(defsubst bibtex-start-of-field (bounds)
+ (nth 0 (car bounds)))
+(defsubst bibtex-start-of-name-in-field (bounds)
+ (nth 1 (car bounds)))
+(defsubst bibtex-end-of-name-in-field (bounds)
+ (nth 2 (car bounds)))
+(defsubst bibtex-start-of-text-in-field (bounds)
+ (nth 1 bounds))
+(defsubst bibtex-end-of-text-in-field (bounds)
+ (nth 2 bounds))
+(defsubst bibtex-end-of-field (bounds)
+ (nth 3 bounds))
+
+(defun bibtex-search-forward-field (name &optional bound)
+ "Search forward to find a BibTeX field of name NAME.
+If a syntactically correct field is found, return a pair containing
+the boundaries of the name and text parts of the field. The search
+is limited by optional arg BOUND. If BOUND is t the search is limited
+by the end of the current entry. Do not move point."
+ (save-match-data
+ (save-excursion
+ (if (eq bound t)
+ (let ((regexp (concat bibtex-name-part "[ \t\n]*=\\|"
+ bibtex-any-entry-maybe-empty-head))
+ (case-fold-search t) bounds)
+ (catch 'done
+ (if (looking-at "[ \t]*@") (goto-char (match-end 0)))
+ (while (and (not bounds)
+ (re-search-forward regexp nil t))
+ (if (match-beginning 2)
+ ;; We found a new entry
+ (throw 'done nil)
+ ;; We found a field
+ (goto-char (match-beginning 0))
+ (setq bounds (bibtex-parse-field))))
+ ;; Step through all fields so that we cannot overshoot.
+ (while bounds
+ (goto-char (bibtex-start-of-name-in-field bounds))
+ (if (looking-at name) (throw 'done bounds))
+ (goto-char (bibtex-end-of-field bounds))
+ (setq bounds (bibtex-parse-field)))))
+ ;; Bounded search or bound is nil (i.e. we cannot overshoot).
+ ;; Indeed, the search is bounded when `bibtex-search-forward-field'
+ ;; is called many times. So we optimize this part of this function.
+ (let ((name-part (concat ",[ \t\n]*\\(" name "\\)[ \t\n]*=[ \t\n]*"))
+ (case-fold-search t) left right)
+ (while (and (not right)
+ (re-search-forward name-part bound t))
+ (setq left (list (match-beginning 0) (match-beginning 1)
+ (match-end 1))
+ ;; Don't worry that the field text could be past bound.
+ right (bibtex-parse-field-text)))
+ (if right (cons left right)))))))
+
+(defun bibtex-search-backward-field (name &optional bound)
+ "Search backward to find a BibTeX field of name NAME.
+If a syntactically correct field is found, return a pair containing
+the boundaries of the name and text parts of the field. The search
+is limited by the optional arg BOUND. If BOUND is t the search is
+limited by the beginning of the current entry. Do not move point."
+ (save-match-data
+ (if (eq bound t)
+ (setq bound (save-excursion (bibtex-beginning-of-entry))))
+ (let ((name-part (concat ",[ \t\n]*\\(" name "\\)[ \t\n]*=[ \t\n]*"))
+ (case-fold-search t) left right)
+ (save-excursion
+ ;; the parsing functions are not designed for parsing backwards :-(
+ (when (search-backward "," bound t)
+ (or (save-excursion
+ (when (looking-at name-part)
+ (setq left (list (match-beginning 0) (match-beginning 1)
+ (match-end 1)))
+ (goto-char (match-end 0))
+ (setq right (bibtex-parse-field-text))))
+ (while (and (not right)
+ (re-search-backward name-part bound t))
+ (setq left (list (match-beginning 0) (match-beginning 1)
+ (match-end 1)))
+ (save-excursion
+ (goto-char (match-end 0))
+ (setq right (bibtex-parse-field-text)))))
+ (if right (cons left right)))))))
+
+(defun bibtex-name-in-field (bounds &optional remove-opt-alt)
+ "Get content of name in BibTeX field defined via BOUNDS.
+If optional arg REMOVE-OPT-ALT is non-nil remove \"OPT\" and \"ALT\"."
+ (let ((name (buffer-substring-no-properties
+ (bibtex-start-of-name-in-field bounds)
+ (bibtex-end-of-name-in-field bounds))))
+ (if (and remove-opt-alt
+ (string-match "\\`\\(OPT\\|ALT\\)" name))
+ (substring name 3)
+ name)))
+
+(defun bibtex-text-in-field-bounds (bounds &optional content)
+ "Get text in BibTeX field defined via BOUNDS.
+If optional arg CONTENT is non-nil extract content of field
+by removing field delimiters and concatenating the resulting string.
+If `bibtex-expand-strings' is non-nil, also expand BibTeX strings."
+ (if content
+ (save-excursion
+ (goto-char (bibtex-start-of-text-in-field bounds))
+ (let ((epoint (bibtex-end-of-text-in-field bounds))
+ content opoint)
+ (while (< (setq opoint (point)) epoint)
+ (if (looking-at bibtex-field-const)
+ (let ((mtch (match-string-no-properties 0)))
+ (push (or (if bibtex-expand-strings
+ (cdr (assoc-string mtch (bibtex-strings) t)))
+ mtch) content)
+ (goto-char (match-end 0)))
+ (let ((bounds (bibtex-parse-field-string)))
+ (push (buffer-substring-no-properties
+ (1+ (car bounds)) (1- (cdr bounds))) content)
+ (goto-char (cdr bounds))))
+ (re-search-forward "\\=[ \t\n]*#[ \t\n]*" nil t))
+ (apply 'concat (nreverse content))))
+ (buffer-substring-no-properties (bibtex-start-of-text-in-field bounds)
+ (bibtex-end-of-text-in-field bounds))))
+
+(defun bibtex-text-in-field (field &optional follow-crossref)
+ "Get content of field FIELD of current BibTeX entry.
+Return nil if not found.
+If optional arg FOLLOW-CROSSREF is non-nil, follow crossref."
+ (save-excursion
+ (let* ((end (if follow-crossref (bibtex-end-of-entry) t))
+ (beg (bibtex-beginning-of-entry)) ; move point
+ (bounds (bibtex-search-forward-field field end)))
+ (cond (bounds (bibtex-text-in-field-bounds bounds t))
+ ((and follow-crossref
+ (progn (goto-char beg)
+ (setq bounds (bibtex-search-forward-field
+ "\\(OPT\\)?crossref" end))))
+ (let ((crossref-field (bibtex-text-in-field-bounds bounds t)))
+ (if (bibtex-find-crossref crossref-field)
+ ;; Do not pass FOLLOW-CROSSREF because we want
+ ;; to follow crossrefs only one level of recursion.
+ (bibtex-text-in-field field))))))))
+
+(defun bibtex-parse-string-prefix ()
+ "Parse the prefix part of a BibTeX string entry, including reference key.
+If the string prefix is found, return a triple consisting of the position of
+the very first character of the match, the actual starting position of the
+reference key and the end position of the match.
+If `bibtex-string-empty-key' is non-nil accept empty string key."
+ (let ((case-fold-search t))
+ (if (looking-at bibtex-string-type)
+ (let ((start (point)))
+ (goto-char (match-end 0))
+ (cond ((looking-at bibtex-reference-key)
+ (goto-char (match-end 0))
+ (list start
+ (match-beginning 0)
+ (match-end 0)))
+ ((and bibtex-string-empty-key
+ (looking-at "="))
+ (skip-chars-backward " \t\n")
+ (list start (point) (point))))))))
+
+(defun bibtex-parse-string-postfix ()
+ "Parse the postfix part of a BibTeX string entry, including the text.
+If the string postfix is found, return a triple consisting of the position of
+the actual starting and ending position of the text and the very last
+character of the string entry. Move point past BibTeX string entry."
+ (let* ((case-fold-search t)
+ (bounds (bibtex-parse-field-text)))
+ (when bounds
+ (goto-char (nth 1 bounds))
+ (when (looking-at "[ \t\n]*[})]")
+ (goto-char (match-end 0))
+ (list (car bounds)
+ (nth 1 bounds)
+ (match-end 0))))))
+
+(defun bibtex-parse-string (&optional empty-key)
+ "Parse a BibTeX string entry beginning at the position of point.
+If a syntactically correct entry is found, return a cons pair containing
+the boundaries of the reference key and text parts of the entry.
+If EMPTY-KEY is non-nil, key may be empty. Do not move point."
+ (let ((bibtex-string-empty-key empty-key))
+ (bibtex-parse-association 'bibtex-parse-string-prefix
+ 'bibtex-parse-string-postfix)))
+
+(defun bibtex-search-forward-string (&optional empty-key)
+ "Search forward to find a BibTeX string entry.
+If a syntactically correct entry is found, a pair containing the boundaries of
+the reference key and text parts of the string is returned.
+If EMPTY-KEY is non-nil, key may be empty. Do not move point."
+ (save-excursion
+ (save-match-data
+ (let ((case-fold-search t) bounds)
+ (while (and (not bounds)
+ (search-forward-regexp bibtex-string-type nil t))
+ (save-excursion (goto-char (match-beginning 0))
+ (setq bounds (bibtex-parse-string empty-key))))
+ bounds))))
+
+(defun bibtex-reference-key-in-string (bounds)
+ "Return the key part of a BibTeX string defined via BOUNDS"
+ (buffer-substring-no-properties (nth 1 (car bounds))
+ (nth 2 (car bounds))))
+
+(defun bibtex-text-in-string (bounds &optional content)
+ "Get text in BibTeX string field defined via BOUNDS.
+If optional arg CONTENT is non-nil extract content
+by removing field delimiters and concatenating the resulting string.
+If `bibtex-expand-strings' is non-nil, also expand BibTeX strings."
+ (bibtex-text-in-field-bounds bounds content))
+
+(defsubst bibtex-start-of-text-in-string (bounds)
+ (nth 0 (cdr bounds)))
+(defsubst bibtex-end-of-text-in-string (bounds)
+ (nth 1 (cdr bounds)))
+(defsubst bibtex-end-of-string (bounds)
+ (nth 2 (cdr bounds)))
+
+(defsubst bibtex-type-in-head ()
+ "Extract BibTeX type in head."
+ ;; ignore @
+ (buffer-substring-no-properties (1+ (match-beginning bibtex-type-in-head))
+ (match-end bibtex-type-in-head)))
+
+(defsubst bibtex-key-in-head (&optional empty)
+ "Extract BibTeX key in head. Return optional arg EMPTY if key is empty."
+ (or (match-string-no-properties bibtex-key-in-head)
+ empty))
+
+(defun bibtex-parse-preamble ()
+ "Parse BibTeX preamble.
+Point must be at beginning of preamble. Do not move point."
+ (let ((case-fold-search t))
+ (when (looking-at bibtex-preamble-prefix)
+ (let ((start (match-beginning 0)) (pref-start (match-beginning 1))
+ (bounds (save-excursion (goto-char (match-end 0))
+ (bibtex-parse-string-postfix))))
+ (if bounds (cons (list start pref-start) bounds))))))
+
+;; Helper Functions
+
+(defsubst bibtex-string= (str1 str2)
+ "Return t if STR1 and STR2 are equal, ignoring case."
+ (eq t (compare-strings str1 0 nil str2 0 nil t)))
+
+(defun bibtex-delete-whitespace ()
+ "Delete all whitespace starting at point."
+ (if (looking-at "[ \t\n]+")
+ (delete-region (point) (match-end 0))))
+
+(defun bibtex-current-line ()
+ "Compute line number of point regardless whether the buffer is narrowed."
+ (+ (count-lines 1 (point))
+ (if (bolp) 1 0)))
+
+(defun bibtex-valid-entry (&optional empty-key)
+ "Parse a valid BibTeX entry (maybe without key if EMPTY-KEY is t).
+A valid entry is a syntactical correct one with type contained in
+`bibtex-entry-field-alist'. Ignore @String and @Preamble entries.
+Return a cons pair with buffer positions of beginning and end of entry
+if a valid entry is found, nil otherwise. Do not move point.
+After a call to this function `match-data' corresponds to the header
+of the entry, see regexp `bibtex-entry-head'."
+ (let ((case-fold-search t) end)
+ (if (looking-at (if empty-key bibtex-entry-maybe-empty-head
+ bibtex-entry-head))
+ (save-excursion
+ (save-match-data
+ (goto-char (match-end 0))
+ (let ((entry-closer
+ (if (save-excursion
+ (goto-char (match-end bibtex-type-in-head))
+ (looking-at "[ \t]*("))
+ ",?[ \t\n]*)" ;; entry opened with `('
+ ",?[ \t\n]*}")) ;; entry opened with `{'
+ bounds)
+ (skip-chars-forward " \t\n")
+ ;; loop over all BibTeX fields
+ (while (setq bounds (bibtex-parse-field))
+ (goto-char (bibtex-end-of-field bounds)))
+ ;; This matches the infix* part.
+ (if (looking-at entry-closer) (setq end (match-end 0)))))
+ (if end (cons (match-beginning 0) end))))))
+
+(defun bibtex-skip-to-valid-entry (&optional backward)
+ "Move point to beginning of the next valid BibTeX entry.
+Do not move if we are already at beginning of a valid BibTeX entry.
+With optional argument BACKWARD non-nil, move backward to
+beginning of previous valid one. A valid entry is a syntactical correct one
+with type contained in `bibtex-entry-field-alist' or, if
+`bibtex-sort-ignore-string-entries' is nil, a syntactical correct string
+entry. Return buffer position of beginning and end of entry if a valid
+entry is found, nil otherwise."
+ (interactive "P")
+ (let ((case-fold-search t)
+ found bounds)
+ (beginning-of-line)
+ ;; Loop till we look at a valid entry.
+ (while (not (or found (if backward (bobp) (eobp))))
+ (cond ((setq found (or (bibtex-valid-entry)
+ (and (not bibtex-sort-ignore-string-entries)
+ (setq bounds (bibtex-parse-string))
+ (cons (bibtex-start-of-field bounds)
+ (bibtex-end-of-string bounds))))))
+ (backward (re-search-backward "^[ \t]*@" nil 'move))
+ (t (if (re-search-forward "\n\\([ \t]*@\\)" nil 'move)
+ (goto-char (match-beginning 1))))))
+ found))
+
+(defun bibtex-map-entries (fun)
+ "Call FUN for each BibTeX entry in buffer (possibly narrowed).
+FUN is called with three arguments, the key of the entry and the buffer
+positions of beginning and end of entry. Also, point is at beginning of
+entry and `match-data' corresponds to the header of the entry,
+see regexp `bibtex-entry-head'. If `bibtex-sort-ignore-string-entries'
+is non-nil, FUN is not called for @String entries."
+ (let ((case-fold-search t)
+ found)
+ (save-excursion
+ (goto-char (point-min))
+ (while (setq found (bibtex-skip-to-valid-entry))
+ (looking-at bibtex-any-entry-maybe-empty-head)
+ (funcall fun (bibtex-key-in-head "") (car found) (cdr found))
+ (goto-char (cdr found))))))
+
+(defun bibtex-progress-message (&optional flag interval)
+ "Echo a message about progress of current buffer.
+If FLAG is a string, the message is initialized (in this case a
+value for INTERVAL may be given as well (if not this is set to 5)).
+If FLAG is `done', the message is deinitialized.
+If FLAG is nil, a message is echoed if point was incremented at least
+`bibtex-progress-interval' percent since last message was echoed."
+ (cond ((stringp flag)
+ (setq bibtex-progress-lastmes flag
+ bibtex-progress-interval (or interval 5)
+ bibtex-progress-lastperc 0))
+ ((eq flag 'done)
+ (message "%s (done)" bibtex-progress-lastmes)
+ (setq bibtex-progress-lastmes nil))
+ (t
+ (let* ((size (- (point-max) (point-min)))
+ (perc (if (= size 0)
+ 100
+ (/ (* 100 (- (point) (point-min))) size))))
+ (when (>= perc (+ bibtex-progress-lastperc
+ bibtex-progress-interval))
+ (setq bibtex-progress-lastperc perc)
+ (message "%s (%d%%)" bibtex-progress-lastmes perc))))))
+
+(defun bibtex-field-left-delimiter ()
+ "Return a string dependent on `bibtex-field-delimiters'."
+ (if (eq bibtex-field-delimiters 'braces)
+ "{"
+ "\""))
+
+(defun bibtex-field-right-delimiter ()
+ "Return a string dependent on `bibtex-field-delimiters'."
+ (if (eq bibtex-field-delimiters 'braces)
+ "}"
+ "\""))
+
+(defun bibtex-entry-left-delimiter ()
+ "Return a string dependent on `bibtex-entry-delimiters'."
+ (if (eq bibtex-entry-delimiters 'braces)
+ "{"
+ "("))
+
+(defun bibtex-entry-right-delimiter ()
+ "Return a string dependent on `bibtex-entry-delimiters'."
+ (if (eq bibtex-entry-delimiters 'braces)
+ "}"
+ ")"))
+
+(defun bibtex-flash-head (prompt)
+ "Flash at BibTeX entry head before point, if exists."
+ (let ((case-fold-search t)
+ (pnt (point)))
+ (save-excursion
+ (bibtex-beginning-of-entry)
+ (when (and (looking-at bibtex-any-entry-maybe-empty-head)
+ (< (point) pnt))
+ (goto-char (match-beginning bibtex-type-in-head))
+ (if (pos-visible-in-window-p (point))
+ (sit-for 1)
+ (message "%s%s" prompt (buffer-substring-no-properties
+ (point) (match-end bibtex-key-in-head))))))))
+
+(defun bibtex-make-optional-field (field)
+ "Make an optional field named FIELD in current BibTeX entry."
+ (if (consp field)
+ (bibtex-make-field (cons (concat "OPT" (car field)) (cdr field)))
+ (bibtex-make-field (concat "OPT" field))))