Function: bibtex-format-entry
bibtex-format-entry is a byte-compiled function defined in
bibtex.el.gz.
Signature
(bibtex-format-entry)
Documentation
Helper function for bibtex-clean-entry.
Formats current entry according to variable bibtex-entry-format.
Source Code
;; Defined in /usr/src/emacs/lisp/textmodes/bibtex.el.gz
(defun bibtex-format-entry ()
"Helper function for `bibtex-clean-entry'.
Formats current entry according to variable `bibtex-entry-format'."
;; initialize `bibtex-field-braces-opt' if necessary
(if (and bibtex-field-braces-alist (not bibtex-field-braces-opt))
(setq bibtex-field-braces-opt
(bibtex-field-re-init bibtex-field-braces-alist 'braces)))
;; initialize `bibtex-field-strings-opt' if necessary
(if (and bibtex-field-strings-alist (not bibtex-field-strings-opt))
(setq bibtex-field-strings-opt
(bibtex-field-re-init bibtex-field-strings-alist 'strings)))
(let ((case-fold-search t)
(format (if (eq bibtex-entry-format t)
'(realign opts-or-alts required-fields numerical-fields
page-dashes whitespace inherit-booktitle
last-comma delimiters unify-case braces
strings sort-fields)
bibtex-entry-format))
(left-delim-re (regexp-quote (bibtex-field-left-delimiter)))
bounds crossref-key req-field-list opt-field-list
default-field-list field-list
num-alt alt-fields idx error-field-name)
(unwind-protect
;; formatting (undone if error occurs)
(atomic-change-group
(save-excursion
(save-restriction
(bibtex-narrow-to-entry)
;; There are more elegant high-level functions for several tasks
;; done by `bibtex-format-entry'. However, they contain some
;; redundancy compared with what we need to do anyway.
;; So for speed-up we avoid using them.
;; (`bibtex-format-entry' is called often by `bibtex-reformat'.)
;; identify entry type
(goto-char (point-min))
(or (re-search-forward bibtex-entry-type nil t)
(user-error "Not inside a BibTeX entry"))
(let* ((beg-type (1+ (match-beginning 0)))
(end-type (match-end 0))
(entry-list (assoc-string (buffer-substring-no-properties
beg-type end-type)
bibtex-entry-alist t)))
;; unify case of entry type
(when (memq 'unify-case format)
(delete-region beg-type end-type)
(insert (funcall bibtex-unify-case-function (car entry-list))))
;; update left entry delimiter
(when (memq 'delimiters format)
(goto-char end-type)
(skip-chars-forward " \t\n")
(delete-char 1)
(insert (bibtex-entry-left-delimiter)))
;; Do we have a crossref key?
(goto-char (point-min))
(if (setq bounds (bibtex-search-forward-field
"\\(OPT\\)?crossref"))
(let ((text (bibtex-text-in-field-bounds bounds t)))
(unless (equal "" text)
(setq crossref-key text))))
;; list of required fields appropriate for an entry with
;; or without crossref key.
(setq req-field-list (append (nth 2 entry-list)
(unless crossref-key
(nth 3 entry-list)))
opt-field-list (append (if crossref-key
(nth 3 entry-list))
(nth 4 entry-list)
bibtex-user-optional-fields)
;; default list of fields that may appear in this entry
default-field-list (append req-field-list opt-field-list)
;; number of ALT fields we may find
num-alt (let ((n 0))
(mapc (lambda (x)
(if (nth 3 x)
(setq n (max n (abs (nth 3 x))))))
default-field-list)
(1+ n))
;; ALT fields of respective groups
alt-fields (make-vector num-alt nil))
(when (memq 'sort-fields format)
(goto-char (point-min))
(let ((beg-fields (save-excursion (bibtex-beginning-first-field)))
(fields-alist (bibtex-parse-entry
nil (not (memq 'opts-or-alts format))))
bibtex-help-message elt)
(delete-region beg-fields (point))
(dolist (field default-field-list)
(when (setq elt (assoc-string (car field) fields-alist t))
(setq fields-alist (delete elt fields-alist))
(bibtex-make-field (list (car elt) nil (cdr elt)) nil nil t)))
(dolist (field fields-alist)
(unless (member (car field) '("=key=" "=type="))
(bibtex-make-field (list (car field) nil (cdr field)) nil nil t))))))
;; process all fields
(bibtex-beginning-first-field (point-min))
(while (setq bounds (bibtex-parse-field))
(let* ((beg-field (copy-marker (bibtex-start-of-field bounds)))
(end-field (copy-marker (bibtex-end-of-field bounds) t))
(beg-name (copy-marker (bibtex-start-of-name-in-field bounds)))
(end-name (copy-marker (bibtex-end-of-name-in-field bounds)))
(beg-text (copy-marker (bibtex-start-of-text-in-field bounds)))
(end-text (copy-marker (bibtex-end-of-text-in-field bounds) t))
(empty-field (equal "" (bibtex-text-in-field-bounds bounds t)))
(field-name (buffer-substring-no-properties beg-name end-name))
(opt-alt (and (memq 'opts-or-alts format)
(string-match "\\`\\(OPT\\|ALT\\)" field-name)
(not (and bibtex-no-opt-remove-re
(string-match bibtex-no-opt-remove-re
field-name)))))
deleted)
(if opt-alt (setq field-name (substring field-name 3)))
;; keep track of alternatives
(if (and (not empty-field)
(setq idx (nth 3 (assoc-string field-name default-field-list t))))
(bibtex-vec-push alt-fields (abs idx) field-name))
(if (memq 'opts-or-alts format)
;; delete empty optional and alternative fields
;; (but keep empty required fields)
(cond ((and empty-field
(or opt-alt
(let ((field (assoc-string
field-name req-field-list t)))
(or (not field) ; OPT field
(nth 3 field))))) ; ALT field
(delete-region beg-field end-field)
(setq deleted t))
;; otherwise nonempty field: delete "OPT" or "ALT"
(opt-alt
(goto-char beg-name)
(delete-char 3))))
(unless deleted
(push field-name field-list)
;; Remove whitespace at beginning and end of field.
;; We do not look at individual parts of the field
;; as {foo } # bar # { baz} is a fine field.
(when (memq 'whitespace format)
(goto-char beg-text)
(if (looking-at "\\([{\"]\\)[ \t\n]+")
(replace-match "\\1"))
(goto-char end-text)
(if (looking-back "[ \t\n]+\\([}\"]\\)" beg-text t)
(replace-match "\\1")))
;; remove delimiters from purely numerical fields
(when (and (memq 'numerical-fields format)
(progn (goto-char beg-text)
(looking-at "\"[0-9]+\"\\|{[0-9]+}")))
(goto-char end-text)
(delete-char -1)
(goto-char beg-text)
(delete-char 1))
;; update delimiters
(when (memq 'delimiters format)
(goto-char beg-text)
;; simplified from `bibtex-parse-field-text', as we
;; already checked that the field format is correct
(while (< (point) end-text)
(if (looking-at bibtex-field-const)
(goto-char (match-end 0))
(let ((boundaries (bibtex-parse-field-string)))
(if (looking-at left-delim-re)
(goto-char (cdr boundaries))
(delete-char 1)
(insert (bibtex-field-left-delimiter))
(goto-char (1- (cdr boundaries)))
(delete-char 1)
(insert (bibtex-field-right-delimiter)))))
(if (looking-at "[ \t\n]*#[ \t\n]*")
(goto-char (match-end 0)))))
;; update page dashes
(if (and (memq 'page-dashes format)
(string-equal-ignore-case field-name "pages")
(progn (goto-char beg-text)
(looking-at
"\\([\"{][0-9]+\\)[ \t\n]*--?[ \t\n]*\\([0-9]+[\"}]\\)")))
(replace-match "\\1-\\2"))
;; enclose field text by braces according to
;; `bibtex-field-braces-alist'.
(let (case-fold-search temp) ; Case-sensitive search
(when (and (memq 'braces format)
(setq temp (cdr (assoc-string field-name
bibtex-field-braces-opt t))))
(goto-char beg-text)
(while (re-search-forward temp end-text t)
(let ((beg (match-beginning 0))
(bounds (bibtex-find-text-internal nil t)))
(unless (or (nth 4 bounds) ; string constant
;; match already surrounded by braces
;; (braces are inside field delimiters)
(and (< (point) (1- (nth 2 bounds)))
(< (1+ (nth 1 bounds)) beg)
(looking-at "}")
(save-excursion (goto-char (1- beg))
(looking-at "{"))))
(insert "}")
(goto-char beg)
(insert "{")))))
;; replace field text by BibTeX string constants
;; according to `bibtex-field-strings-alist'.
(when (and (memq 'strings format)
(setq temp (cdr (assoc-string field-name
bibtex-field-strings-opt t))))
(goto-char beg-text)
(dolist (re temp)
(while (re-search-forward (car re) end-text t)
(let ((bounds (save-match-data
(bibtex-find-text-internal nil t))))
(unless (nth 4 bounds)
;; if match not at right subfield boundary...
(if (< (match-end 0) (1- (nth 2 bounds)))
(insert " # " (bibtex-field-left-delimiter))
(delete-char 1))
(replace-match (cdr re))
(goto-char (match-beginning 0))
;; if match not at left subfield boundary...
(if (< (1+ (nth 1 bounds)) (match-beginning 0))
(insert (bibtex-field-right-delimiter) " # ")
(delete-char -1))))))))
;; use book title of crossref'd entry
(if (and (memq 'inherit-booktitle format)
empty-field
(string-equal-ignore-case field-name "booktitle")
crossref-key)
(let ((title (save-excursion
(save-restriction
(widen)
(if (bibtex-search-entry crossref-key t)
(bibtex-text-in-field "title"))))))
(when title
(setq empty-field nil)
(goto-char (1+ beg-text))
(insert title))))
;; if empty field is a required field, complain
(when (and empty-field
(memq 'required-fields format)
(assoc-string field-name req-field-list t))
(setq error-field-name field-name)
(user-error "Mandatory field `%s' is empty" field-name))
;; unify case of field name
(when (memq 'unify-case format)
(let ((fname (car (assoc-string field-name
default-field-list t)))
(curname (buffer-substring beg-name end-name)))
(delete-region beg-name end-name)
(goto-char beg-name)
(insert (funcall bibtex-unify-case-function
(or fname curname)))))
;; update point
(goto-char end-field))))
;; check whether all required fields are present
(when (memq 'required-fields format)
(let ((alt-expect (make-vector num-alt nil)))
(dolist (fname req-field-list)
(cond ((nth 3 fname)
;; t if required field has alternative flag
(setq idx (abs (nth 3 fname)))
(bibtex-vec-push alt-expect idx (car fname)))
((not (member-ignore-case (car fname) field-list))
(setq error-field-name (car fname))
(user-error "Mandatory field `%s' is missing"
(car fname)))))
(dotimes (idx num-alt)
(cond ((and (aref alt-expect idx)
(not (aref alt-fields idx)))
(setq error-field-name
(car (last (aref alt-fields idx))))
(user-error "Alternative mandatory fields `%s' are missing"
(mapconcat #'identity
(reverse
(aref alt-expect idx))
", ")))
((nth 1 (aref alt-fields idx))
(setq error-field-name
(car (last (aref alt-fields idx))))
(user-error "Fields `%s' are alternatives"
(mapconcat #'identity
(reverse
(aref alt-fields idx))
", ")))))))
;; update comma after last field
(if (memq 'last-comma format)
(cond ((and bibtex-comma-after-last-field
(not (looking-at ",")))
(insert ","))
((and (not bibtex-comma-after-last-field)
(looking-at ","))
(delete-char 1))))
;; update right entry delimiter
(if (looking-at ",")
(forward-char))
(when (memq 'delimiters format)
(skip-chars-forward " \t\n")
(delete-char 1)
(insert (bibtex-entry-right-delimiter)))
;; realign and fill entry
(if (memq 'realign format)
(bibtex-fill-entry)))))
;; Unwindform: move point to location where error occurred if possible
(if error-field-name
(let (bounds)
(when (save-excursion
(bibtex-beginning-of-entry)
(setq bounds
(bibtex-search-forward-field
;; If we use the crossref field, a required field
;; can have the OPT prefix
(concat "\\(OPT\\|ALT\\)?" error-field-name) t)))
(goto-char (bibtex-start-of-text-in-field bounds))
(bibtex-find-text)))))))