(rfc822-addresses): Prevent rfc822-bad-address from raising a

[bpt/emacs.git] / lisp / mail / footnote.el

;;; footnote.el --- footnote support for message mode  -*- coding: iso-latin-1;-*-

;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004,
;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.

;; Author: Steven L Baur <steve@xemacs.org>
;; Keywords: mail, news
;; Version: 0.19

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file provides footnote[1] support for message-mode in emacsen.
;; footnote-mode is implemented as a minor mode.

;; [1] Footnotes look something like this.  Along with some decorative
;; stuff.

;; TODO:
;; Reasonable Undo support.
;; more language styles.

;;; Code:

(eval-when-compile
  (require 'cl)
  (defvar filladapt-token-table))

(defgroup footnote nil
  "Support for footnotes in mail and news messages."
  :version "21.1"
  :group 'message)

(defcustom footnote-mode-line-string " FN"
  "*String to display in modes section of the mode-line."
  :group 'footnote)

(defcustom footnote-mode-hook nil
  "*Hook functions run when footnote-mode is activated."
  :type 'hook
  :group 'footnote)

(defcustom footnote-narrow-to-footnotes-when-editing nil
  "*If set, narrow to footnote text body while editing a footnote."
  :type 'boolean
  :group 'footnote)

(defcustom footnote-prompt-before-deletion t
  "*If set, prompt before deleting a footnote.
There is currently no way to undo deletions."
  :type 'boolean
  :group 'footnote)

(defcustom footnote-spaced-footnotes t
  "If set true it will put a blank line between each footnote.
If nil, no blank line will be inserted."
  :type 'boolean
  :group 'footnote)

(defcustom footnote-use-message-mode t
  "*If non-nil assume Footnoting will be done in message-mode."
  :type 'boolean
  :group 'footnote)

(defcustom footnote-body-tag-spacing 2
  "*Number of blanks separating a footnote body tag and its text."
  :type 'integer
  :group 'footnote)

(defvar footnote-prefix [(control ?c) ?!]
  "*When not using message mode, the prefix to bind in `mode-specific-map'")

;;; Interface variables that probably shouldn't be changed

(defcustom footnote-section-tag "Footnotes: "
  "*Tag inserted at beginning of footnote section."
  :version "22.1"
  :type 'string
  :group 'footnote)

(defcustom footnote-section-tag-regexp "Footnotes\\(\\[.\\]\\)?: "
  "*Regexp which indicates the start of a footnote section.
See also `footnote-section-tag'."
  :type 'regexp
  :group 'footnote)

;; The following three should be consumed by footnote styles.
(defcustom footnote-start-tag "["
  "*String used to denote start of numbered footnote."
  :type 'string
  :group 'footnote)

(defcustom footnote-end-tag "]"
  "*String used to denote end of numbered footnote."
  :type 'string
  :group 'footnote)

(defvar footnote-signature-separator (if (boundp 'message-signature-separator)
					 message-signature-separator
				       "^-- $")
  "*String used to recognize .signatures.")

;;; Private variables

(defvar footnote-style-number nil
  "Footnote style represented as an index into footnote-style-alist.")
(make-variable-buffer-local 'footnote-style-number)

(defvar footnote-text-marker-alist nil
  "List of markers pointing to text of footnotes in message buffer.")
(make-variable-buffer-local 'footnote-text-marker-alist)

(defvar footnote-pointer-marker-alist nil
  "List of markers pointing to footnote pointers in message buffer.")
(make-variable-buffer-local 'footnote-pointer-marker-alist)

(defvar footnote-mouse-highlight 'highlight
  "Text property name to enable mouse over highlight.")

(defvar footnote-mode nil
  "Variable indicating whether footnote minor mode is active.")
(make-variable-buffer-local 'footnote-mode)

;;; Default styles
;;; NUMERIC
(defconst footnote-numeric-regexp "[0-9]+"
  "Regexp for digits.")

(defun Footnote-numeric (n)
  "Numeric footnote style.
Use Arabic numerals for footnoting."
  (int-to-string n))

;;; ENGLISH UPPER
(defconst footnote-english-upper "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  "Upper case English alphabet.")

(defconst footnote-english-upper-regexp "[A-Z]+"
  "Regexp for upper case English alphabet.")

(defun Footnote-english-upper (n)
  "Upper case English footnoting.
Wrapping around the alphabet implies successive repetitions of letters."
  (let* ((ltr (mod (1- n) (length footnote-english-upper)))
	 (rep (/ (1- n) (length footnote-english-upper)))
	 (chr (char-to-string (aref footnote-english-upper ltr)))
	 rc)
    (while (>= rep 0)
      (setq rc (concat rc chr))
      (setq rep (1- rep)))
    rc))

;;; ENGLISH LOWER
(defconst footnote-english-lower "abcdefghijklmnopqrstuvwxyz"
  "Lower case English alphabet.")

(defconst footnote-english-lower-regexp "[a-z]+"
  "Regexp of lower case English alphabet.")

(defun Footnote-english-lower (n)
  "Lower case English footnoting.
Wrapping around the alphabet implies successive repetitions of letters."
  (let* ((ltr (mod (1- n) (length footnote-english-lower)))
	 (rep (/ (1- n) (length footnote-english-lower)))
	 (chr (char-to-string (aref footnote-english-lower ltr)))
	 rc)
    (while (>= rep 0)
      (setq rc (concat rc chr))
      (setq rep (1- rep)))
    rc))

;;; ROMAN LOWER
(defconst footnote-roman-lower-list
  '((1 . "i") (5 . "v") (10 . "x")
    (50 . "l") (100 . "c") (500 . "d") (1000 . "m"))
  "List of roman numerals with their values.")

(defconst footnote-roman-lower-regexp "[ivxlcdm]+"
  "Regexp of roman numerals.")

(defun Footnote-roman-lower (n)
  "Generic Roman number footnoting."
  (Footnote-roman-common n footnote-roman-lower-list))

;;; ROMAN UPPER
(defconst footnote-roman-upper-list
  '((1 . "I") (5 . "V") (10 . "X")
    (50 . "L") (100 . "C") (500 . "D") (1000 . "M"))
  "List of roman numerals with their values.")

(defconst footnote-roman-upper-regexp "[IVXLCDM]+"
  "Regexp of roman numerals.  Not complete")

(defun Footnote-roman-upper (n)
  "Generic Roman number footnoting."
  (Footnote-roman-common n footnote-roman-upper-list))

(defun Footnote-roman-common (n footnote-roman-list)
  "Lower case Roman footnoting."
  (let* ((our-list footnote-roman-list)
	 (rom-lngth (length our-list))
	 (rom-high 0)
	 (rom-low 0)
	 (rom-div -1)
	 (count-high 0)
	 (count-low 0))
    ;; find surrounding numbers
    (while (and (<= count-high (1- rom-lngth))
		(>= n (car (nth count-high our-list))))
      ;; (message "Checking %d" (car (nth count-high our-list)))
      (setq count-high (1+ count-high)))
    (setq rom-high count-high)
    (setq rom-low (1- count-high))
    ;; find the appropriate divisor (if it exists)
    (while (and (= rom-div -1)
		(< count-low rom-high))
      (when (or (> n (- (car (nth rom-high our-list))
			(/ (car (nth count-low our-list))
			   2)))
		(= n (- (car (nth rom-high our-list))
			(car (nth count-low our-list)))))
	(setq rom-div count-low))
      ;; (message "Checking %d and %d in div loop" rom-high count-low)
      (setq count-low (1+ count-low)))
    ;;(message "We now have high: %d, low: %d, div: %d, n: %d"
    ;;	       rom-high rom-low (if rom-div rom-div -1) n)
    (let ((rom-low-pair (nth rom-low our-list))
	  (rom-high-pair (nth rom-high our-list))
	  (rom-div-pair (if (not (= rom-div -1)) (nth rom-div our-list) nil)))
      ;; (message "pairs are: rom-low: %S, rom-high: %S, rom-div: %S"
      ;;	  rom-low-pair rom-high-pair rom-div-pair)
      (cond
       ((< n 0) (error "Footnote-roman-common called with n < 0"))
       ((= n 0) "")
       ((= n (car rom-low-pair)) (cdr rom-low-pair))
       ((= n (car rom-high-pair)) (cdr rom-high-pair))
       ((= (car rom-low-pair) (car rom-high-pair))
	(concat (cdr rom-low-pair)
		(Footnote-roman-common
		 (- n (car rom-low-pair))
		 footnote-roman-list)))
       ((>= rom-div 0) (concat (cdr rom-div-pair) (cdr rom-high-pair)
			       (Footnote-roman-common
				(- n (- (car rom-high-pair)
					(car rom-div-pair)))
				footnote-roman-list)))
       (t (concat (cdr rom-low-pair)
		  (Footnote-roman-common
		   (- n (car rom-low-pair))
		   footnote-roman-list)))))))

;; Latin-1