X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mu-cite.el;h=38508bd244a5cece6f7b779cf273fe0ecb75dae2;hb=e40a8806c02a48a3e16b54e7b2f4de65363ca3f6;hp=d62ac8e73702cda27146facc49fb56f989eacf06;hpb=e7a11a25bd67c0d43366717454ece607be60a7bb;p=elisp%2Fmu-cite.git diff --git a/mu-cite.el b/mu-cite.el index d62ac8e..38508bd 100644 --- a/mu-cite.el +++ b/mu-cite.el @@ -1,6 +1,6 @@ ;;; mu-cite.el --- yet another citation tool for GNU Emacs - -;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2005, 2007 +;; Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Shuhei KOBAYASHI @@ -21,21 +21,21 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; - How to use -;; 1. bytecompile this file and copy it to the apropriate directory. -;; 2. put the following lines to your ~/.emacs: -;; for EMACS 19 or later and XEmacs +;; 1. Bytecompile this file and copy it to the apropriate directory. +;; 2. Put the following lines in your ~/.emacs file: +;; For EMACS 19 or later and XEmacs ;; (autoload 'mu-cite-original "mu-cite" nil t) ;; ;; for all but message-mode ;; (add-hook 'mail-citation-hook (function mu-cite-original)) ;; ;; for message-mode only ;; (setq message-cite-function (function mu-cite-original)) -;; for EMACS 18 +;; For EMACS 18 ;; ;; for all but mh-e ;; (add-hook 'mail-yank-hooks (function mu-cite-original)) ;; ;; for mh-e only @@ -43,8 +43,8 @@ ;;; Code: -;; Pickup some macros, e.g. `with-temp-buffer', for old Emacsen. -(require 'poe) +;; For picking up the macros `char-next-index', `with-temp-buffer', etc. +(require 'poem) (require 'pcustom) (require 'std11) @@ -62,38 +62,7 @@ ;;; @ version ;;; -(defconst mu-cite-version "8.0") - - -;;; @ obsoletes -;;; - -;; This part will be abolished in the future. - -(eval-when-compile - (require 'static) - (defmacro mu-cite-obsolete-variable-alist () - ''((mu-cite/cited-prefix-regexp mu-cite-cited-prefix-regexp) - (mu-cite/default-methods-alist mu-cite-default-methods-alist) - (mu-cite/get-field-value-method-alist - mu-cite-get-field-value-method-alist) - (mu-cite/instantiation-hook mu-cite-instantiation-hook) - (mu-cite/ml-count-field-list mu-cite-ml-count-field-list) - (mu-cite/post-cite-hook mu-cite-post-cite-hook) - (mu-cite/pre-cite-hook mu-cite-pre-cite-hook) - (mu-cite/prefix-format mu-cite-prefix-format) - (mu-cite/top-format mu-cite-top-format)))) - -(static-if (featurep 'xemacs) - (dolist (def (mu-cite-obsolete-variable-alist)) - (apply (function define-obsolete-variable-alias) def))) - -(define-obsolete-function-alias - (function mu-cite/cite-original) (function mu-cite-original)) -(define-obsolete-function-alias - (function mu-cite/get-field-value) (function mu-cite-get-field-value)) -(define-obsolete-function-alias - (function mu-cite/get-value) (function mu-cite-get-value)) +(defconst mu-cite-version "8.1") ;;; @ macro @@ -101,20 +70,26 @@ (defmacro mu-cite-remove-text-properties (string) "Remove text properties from STRING which is read from minibuffer." - (if (or (featurep 'xemacs) - (boundp 'minibuffer-allow-text-properties);; Emacs 20.1 or later. - (not (fboundp 'set-text-properties)));; under Emacs 19.7. - string - (` (let ((obj (copy-sequence (, string)))) - (set-text-properties 0 (length obj) nil obj) - obj)))) + (cond ((featurep 'xemacs) + `(let ((string (copy-sequence ,string))) + (map-extents (function (lambda (extent maparg) + (delete-extent extent)) + string 0 (length string))) + string)) + ((or (boundp 'minibuffer-allow-text-properties);; Emacs 20.1 or later. + (not (fboundp 'set-text-properties)));; under Emacs 19.7. + string) + (t + `(let ((string (copy-sequence ,string))) + (set-text-properties 0 (length string) nil string) + string)))) ;;; @ set up ;;; (defgroup mu-cite nil - "yet another citation tool for GNU Emacs." + "Yet another citation tool for GNU Emacs." :prefix "mu-cite-" :group 'mail :group 'news) @@ -159,12 +134,13 @@ (cons 'id (function (lambda () - (let ((ml-name (mu-cite-get-value 'ml-name))) + (let ((ml-name (mu-cite-get-value 'ml-name)) + (ml-count (mu-cite-get-value 'ml-count))) (if ml-name (concat "[" ml-name - " : No." - (mu-cite-get-value 'ml-count) + (if ml-count + (concat " : No." ml-count)) "]") (mu-cite-get-value 'message-id)))))) (cons 'in-id @@ -178,6 +154,10 @@ (function (lambda () (mu-cite-get-field-value "X-Attribution")))) + (cons 'x-cite-me + (function + (lambda () + (mu-cite-get-field-value "X-Cite-Me")))) ;; mu-register (cons 'prefix (function mu-cite-get-prefix-method)) (cons 'prefix-register @@ -206,7 +186,7 @@ If match, mu-cite doesn't insert citation prefix." (defcustom mu-cite-prefix-format '(prefix-register-verbose "> ") "List to represent citation prefix. -Each elements must be string or method name." +Each elements must be a string or a method name." :type (list 'repeat (list @@ -232,7 +212,7 @@ Each elements must be string or method name." (defcustom mu-cite-top-format '(in-id ">>>>>\t" from " wrote:\n") "List to represent top string of citation. -Each elements must be string or method name." +Each elements must be a string or a method name." :type (list 'repeat (list @@ -300,7 +280,7 @@ registered in variable `mu-cite-get-field-value-method-alist' is called." (defcustom mu-cite-ml-count-field-list '("X-Ml-Count" "X-Mail-Count" "X-Seqno" "X-Sequence" "Mailinglist-Id") - "List of header fields which contain sequence number of mailing list." + "List of header fields which contains a sequence number of the mailing list." :type '(repeat (choice :tag "Field Name" (choice-item "X-Ml-Count") (choice-item "X-Mail-Count") @@ -316,12 +296,12 @@ registered in variable `mu-cite-get-field-value-method-alist' is called." (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. +the 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." +instead of to call the function directly." (let ((field-list mu-cite-ml-count-field-list)) (catch 'tag (while field-list @@ -343,7 +323,7 @@ instead of call the function directly." (run-hooks 'mu-cite-instantiation-hook)) (defun mu-cite-get-value (item) - "Return current value of ITEM." + "Return a current value of ITEM." (let ((ret (cdr (assoc item mu-cite-methods-alist)))) (if (functionp ret) (prog1 @@ -384,7 +364,8 @@ function according to the agreed upon standard." (insert top) (setq last-point (point)) (while (< (point)(mark t)) - (or (looking-at mu-cite-cited-prefix-regexp) + (or (and mu-cite-cited-prefix-regexp + (looking-at mu-cite-cited-prefix-regexp)) (insert prefix)) (forward-line 1)) (goto-char last-point)) @@ -404,30 +385,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") - )) +(eval-and-compile + ;; Don't use the function `char-category' which may have been + ;; defined by emu.el. Anyway, the best way is not to use emu.el. + (if (and (fboundp 'char-category) + (subrp (symbol-function 'char-category))) + (defalias 'mu-cite-char-category 'char-category) + (defun-maybe-cond mu-cite-char-category (character &optional table) + "Return a string of category mnemonics for CHARACTER in TABLE. +CHARACTER can be any multilingual characters, +TABLE defaults to the current buffer's category table (it is currently +ignored)." + ((and (subr-fboundp 'char-category-set) + (subr-fboundp 'category-set-mnemonics)) + (category-set-mnemonics (char-category-set character))) + ((and (fboundp 'char-category-list) + ;; `char-category-list' returns a list of characters + ;; in XEmacs 21.2.25 and later, otherwise integers. + (characterp (car-safe (char-category-list ?a)))) + (concat (char-category-list 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 @@ -476,6 +465,15 @@ TABLE defaults to the current buffer's category table." (buffer-substring (line-beginning-position)(point))) (t ""))))) +(defcustom fill-column-for-fill-cited-region nil + "Integer to override `fill-column' while `fill-cited-region' is being +executed. If you wish people call you ****-san, you may set the value +of `fill-column' to 60 in the buffer for message sending and set this +to 70. :-)" + :type `(choice (const :tag "Off" nil) + (integer ,default-fill-column)) + :group 'mu-cite) + ;;;###autoload (defun fill-cited-region (beg end) "Fill each of the paragraphs in the region as a cited text." @@ -489,7 +487,8 @@ TABLE defaults to the current buffer's category table." (let* ((fill-prefix (detect-paragraph-cited-prefix)) (fill-column (max (+ 1 (current-left-margin) (string-width fill-prefix)) - (current-fill-column))) + (or fill-column-for-fill-cited-region + (current-fill-column)))) (pat (concat fill-prefix "\n")) filladapt-mode) (goto-char (point-min)) @@ -498,8 +497,7 @@ TABLE defaults to the current buffer's category table." (e (match-end 0))) (delete-region b e) (if (and (> b (point-min)) - (let ((cat (char-category - (char-before b)))) + (let ((cat (mu-cite-char-category (char-before b)))) (or (string-match "a" cat) (string-match "l" cat)))) (insert " ")))) @@ -574,23 +572,4 @@ TABLE defaults to the current buffer's category table." (run-hooks 'mu-cite-load-hook) -;; This part will be abolished in the future. - -(static-unless (featurep 'xemacs) - (let ((rest (mu-cite-obsolete-variable-alist)) - def new-sym old-sym) - (while rest - (setq def (car rest)) - (apply (function make-obsolete-variable) def) - (setq old-sym (car def) - new-sym (car (cdr def))) - (or (get new-sym 'saved-value) ; saved? - (not (eq (eval (car (get new-sym 'standard-value))) - (symbol-value new-sym))) ; set as new name? - (and (boundp old-sym) ; old name seems used - (or (eq (symbol-value new-sym) - (symbol-value old-sym)) - (set new-sym (symbol-value old-sym))))) - (setq rest (cdr rest))))) - ;;; mu-cite.el ends here