(string-compare-from-top): Use `sref' instead of `aref'; use
[elisp/mu-cite.git] / mu-cite.el
index 8d66b9c..83dbb09 100644 (file)
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
-;;         Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+;;         Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
 ;; Maintainer: Katsumi Yamaoka <yamaoka@jpl.org>
 ;; Keywords: mail, news, citation
 
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
-
 ;; Pickup some macros, e.g. `with-temp-buffer', for old Emacsen.
 (require 'poe)
-
-;; Pickup `char-category' for XEmacs.
-(require 'emu)
-
-(require 'custom)
+(require 'pcustom)
 (require 'std11)
 (require 'alist)
 
 (autoload 'mu-cite-get-prefix-register-method "mu-register")
 (autoload 'mu-cite-get-prefix-register-verbose-method "mu-register")
 
+(autoload 'mu-bbdb-get-prefix-method "mu-bbdb")
+(autoload 'mu-bbdb-get-prefix-register-method "mu-bbdb")
+(autoload 'mu-bbdb-get-prefix-register-verbose-method "mu-bbdb")
+
 
 ;;; @ version
 ;;;
 (defconst mu-cite-version "8.0")
 
 
-;;; @ obsoletes
-;;;
-
-;; This part will be abolished in the future.
-
-;; variables
-
-
-
 ;;; @ set up
 ;;;
 
                   (if id
                       (format ">>>>> In %s \n" id)
                     "")))))
+       (cons 'x-attribution
+             (function
+              (lambda ()
+                (mu-cite-get-field-value "X-Attribution"))))
+       ;; mu-register
        (cons 'prefix (function mu-cite-get-prefix-method))
        (cons 'prefix-register
              (function mu-cite-get-prefix-register-method))
        (cons 'prefix-register-verbose
              (function mu-cite-get-prefix-register-verbose-method))
-       (cons 'x-attribution
-             (function
-              (lambda ()
-                (mu-cite-get-field-value "X-Attribution"))))
+       ;; mu-bbdb
+       (cons 'bbdb-prefix
+             (function mu-bbdb-get-prefix-method))
+       (cons 'bbdb-prefix-register
+             (function mu-bbdb-get-prefix-register-method))
+       (cons 'bbdb-prefix-register-verbose
+             (function mu-bbdb-get-prefix-register-verbose-method))
        ))
 
 
@@ -226,10 +223,13 @@ Use this hook to add your own methods to `mu-cite-default-methods-alist'."
   "Alist major-mode vs. function to get field-body of header.")
 
 (defun mu-cite-get-field-value (name)
+  "Return the value of the header field NAME.
+If the field is not found in the header, a method function which is
+registered in variable `mu-cite-get-field-value-method-alist' is called."
   (or (std11-field-body name)
       (let ((method (assq major-mode mu-cite-get-field-value-method-alist)))
-       (when method
-         (funcall (cdr method) name)))))
+       (if method
+           (funcall (cdr method) name)))))
 
 
 ;;; @ item methods
@@ -251,15 +251,21 @@ Use this hook to add your own methods to `mu-cite-default-methods-alist'."
   :group 'mu-cite)
 
 (defun mu-cite-get-ml-count-method ()
+  "A mu-cite method to return a ML-count.
+This function searches a field about ML-count, which is specified by
+variable `mu-cite-ml-count-field-list', in a header.
+If the field is found, the function returns a number part of the
+field.
+
+Notice that please use (mu-cite-get-value 'ml-count)
+instead of call the function directly."
   (let ((field-list mu-cite-ml-count-field-list))
     (catch 'tag
       (while field-list
        (let* ((field (car field-list))
               (ml-count (mu-cite-get-field-value field)))
-         (when (and ml-count (string-match "[0-9]+" ml-count))
-           (throw 'tag
-                  (substring ml-count
-                             (match-beginning 0)(match-end 0))))
+         (if (and ml-count (string-match "[0-9]+" ml-count))
+             (throw 'tag (match-string 0 ml-count)))
          (setq field-list (cdr field-list)))))))
 
 
@@ -274,6 +280,7 @@ Use this hook to add your own methods to `mu-cite-default-methods-alist'."
   (run-hooks 'mu-cite-instantiation-hook))
 
 (defun mu-cite-get-value (item)
+  "Return current value of ITEM."
   (let ((ret (cdr (assoc item mu-cite-methods-alist))))
     (if (functionp ret)
        (prog1
@@ -300,22 +307,22 @@ function according to the agreed upon standard."
   (interactive)
   (mu-cite-make-methods)
   (save-restriction
-    (when (< (mark t) (point))
-      (exchange-point-and-mark))
+    (if (< (mark t) (point))
+       (exchange-point-and-mark))
     (narrow-to-region (point)(point-max))
     (run-hooks 'mu-cite-pre-cite-hook)
     (let ((last-point (point))
          (top (mu-cite-eval-format mu-cite-top-format))
          (prefix (mu-cite-eval-format mu-cite-prefix-format)))
-      (when (re-search-forward "^-*$" nil nil)
-       (forward-line 1))
+      (if (re-search-forward "^-*$" nil nil)
+         (forward-line 1))
       (widen)
       (delete-region last-point (point))
       (insert top)
       (setq last-point (point))
       (while (< (point)(mark t))
-       (unless (looking-at mu-cite-cited-prefix-regexp)
-         (insert prefix))
+       (or (looking-at mu-cite-cited-prefix-regexp)
+           (insert prefix))
        (forward-line 1))
       (goto-char last-point))
     (run-hooks 'mu-cite-post-cite-hook)))
@@ -334,14 +341,38 @@ function according to the agreed upon standard."
   :type 'string
   :group 'mu-cite)
 
+(defun-maybe-cond char-category (character)
+  "Return string of category mnemonics for CHAR in TABLE.
+CHAR can be any multilingual character
+TABLE defaults to the current buffer's category table."
+  ((and (subr-fboundp 'char-category-set)
+       (subr-fboundp 'category-set-mnemonics))
+   (category-set-mnemonics (char-category-set character))
+   )
+  ((fboundp 'char-category-list)
+   (mapconcat (lambda (chr)
+               (char-to-string (int-char chr)))
+             (char-category-list character)
+             "")
+   )
+  ((boundp 'NEMACS)
+   (if (< (char-int character) 128)
+       "al"
+     "j")
+   )
+  (t
+   (if (< (char-int character) 128)
+       "al"
+     "l")
+   ))
+
 (defun detect-paragraph-cited-prefix ()
   (save-excursion
     (goto-char (point-min))
     (let ((i 0)
          (prefix
-          (buffer-substring
-           (progn (beginning-of-line)(point))
-           (progn (end-of-line)(point))))
+          (buffer-substring (line-beginning-position)
+                            (line-end-position)))
          str ret)
       (while (and (= (forward-line) 0)
                  (setq str (buffer-substring
@@ -352,7 +383,7 @@ function according to the agreed upon standard."
              (if (stringp ret)
                  ret
                (cadr ret)))
-       (incf i))
+       (setq i (1+ i)))
       (cond ((> i 1) prefix)
            ((> i 0)
             (goto-char (point-min))
@@ -364,8 +395,8 @@ function according to the agreed upon standard."
                    (concat "[" citation-mark-chars "]") nil t)
                   (progn
                     (goto-char (match-end 0))
-                    (when (looking-at "[ \t]+")
-                      (goto-char (match-end 0)))
+                    (if (looking-at "[ \t]+")
+                        (goto-char (match-end 0)))
                     (buffer-substring (point-min)(point)))
                 prefix)))
            ((progn
@@ -375,12 +406,14 @@ function according to the agreed upon standard."
               (re-search-backward
                (concat "[" citation-mark-chars "]") nil t))
             (goto-char (match-end 0))
-            (when (looking-at "[ \t]+")
-              (goto-char (match-end 0)))
+            (if (looking-at "[ \t]+")
+                (goto-char (match-end 0)))
             (buffer-substring (point-min)(point)))
            (t "")))))
 
+;;;###autoload
 (defun fill-cited-region (beg end)
+  "Fill each of the paragraphs in the region as a cited text."
   (interactive "*r")
   (save-excursion
     (save-restriction
@@ -395,16 +428,18 @@ function according to the agreed upon standard."
          (let ((b (match-beginning 0))
                (e (match-end 0)))
            (delete-region b e)
-           (when (and (> b (point-min))
-                      (let ((cat (char-category
-                                  (char-before b))))
-                        (or (string-match "a" cat)
-                            (string-match "l" cat))))
-             (insert " "))))
+           (if (and (> b (point-min))
+                    (let ((cat (char-category
+                                (char-before b))))
+                      (or (string-match "a" cat)
+                          (string-match "l" cat))))
+               (insert " "))))
        (goto-char (point-min))
        (fill-region (point-min) (point-max))))))
 
+;;;###autoload
 (defun compress-cited-prefix ()
+  "Compress nested cited prefixes."
   (interactive)
   (save-excursion
     (goto-char (point-min))
@@ -418,8 +453,9 @@ function according to the agreed upon standard."
             (prefix (buffer-substring b e))
             ps pe (s 0)
             (nest (let ((i 0))
-                    (when (string-match "<[^<>]+>" prefix)
-                      (setq prefix (substring prefix 0 (match-beginning 0))))
+                    (if (string-match "<[^<>]+>" prefix)
+                        (setq prefix
+                              (substring prefix 0 (match-beginning 0))))
                     (while (string-match
                             (concat "\\([" citation-mark-chars "]+\\)[ \t]*")
                             prefix s)
@@ -447,10 +483,10 @@ function according to the agreed upon standard."
         c1 c2)
     (while (and (< p len)
                (progn
-                 (setq c1 (aref str1 p)
-                       c2 (aref str2 p))
+                 (setq c1 (sref str1 p)
+                       c2 (sref str2 p))
                  (eq c1 c2)))
-      (setq p (+ p (char-length c1))))
+      (setq p (char-next-index c1 p)))
     (and (> p 0)
         (let ((matched (substring str1 0 p))
               (r1 (and (< p len1)(substring str1 p)))