X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mu-cite.el;h=6fafddb68c7b1630320ed26aab47f223a4ae77d0;hb=aadb68a1605bcdae7589c5057e5505885b52a320;hp=ca8350c9f841d285054f52b14d393a5dba904ddf;hpb=87b5f88f0f341e0482c38eceaa374b425ba4044a;p=elisp%2Fmu-cite.git diff --git a/mu-cite.el b/mu-cite.el index ca8350c..6fafddb 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 +;; Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Shuhei KOBAYASHI @@ -27,15 +27,15 @@ ;;; 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,11 +43,12 @@ ;;; Code: -;; Pickup some macros, e.g. `with-temp-buffer', for old Emacsen. -(require 'poe) +;; We have need to pickup the function `char-category' for XEmacs which +;; is defined in `emu'. It requires `poem' recursively for picking up +;; the macros `char-next-index', `with-temp-buffer', etc. +(require 'emu) (require 'pcustom) -(require 'widget) (require 'std11) (require 'alist) @@ -63,45 +64,28 @@ ;;; @ version ;;; -(defconst mu-cite-version "8.0") +(defconst mu-cite-version "8.1") -;;; @ obsoletes +;;; @ macro ;;; -;; 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)) +(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)))) ;;; @ 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) @@ -146,12 +130,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 @@ -193,7 +178,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 @@ -219,7 +204,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 @@ -287,7 +272,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") @@ -303,12 +288,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 @@ -330,7 +315,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 @@ -392,8 +377,8 @@ function according to the agreed upon standard." :group 'mu-cite) (defun-maybe-cond char-category (character) - "Return string of category mnemonics for CHAR in TABLE. -CHAR can be any multilingual character + "Return a 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)) @@ -422,18 +407,20 @@ TABLE defaults to the current buffer's category table." (let ((i 0) (prefix (buffer-substring (line-beginning-position) - (line-end-position))) - str ret) - (while (and (= (forward-line) 0) - (setq str (buffer-substring - (progn (beginning-of-line)(point)) - (progn (end-of-line)(point)))) - (setq ret (string-compare-from-top prefix str))) - (setq prefix - (if (stringp ret) - ret - (cadr ret))) - (setq i (1+ i))) + (line-end-position)))) + (let ((init prefix) + str ret) + (while (and (= (forward-line) 0) + (setq str (buffer-substring + (progn (beginning-of-line)(point)) + (progn (end-of-line)(point)))) + (setq ret (string-compare-from-top prefix str))) + (setq prefix + (if (stringp ret) + ret + (car (cdr ret)))) + (or (string-equal init prefix) + (setq i (1+ i))))) (cond ((> i 1) prefix) ((> i 0) (goto-char (point-min)) @@ -458,7 +445,7 @@ TABLE defaults to the current buffer's category table." (goto-char (match-end 0)) (if (looking-at "[ \t]+") (goto-char (match-end 0))) - (buffer-substring (point-min)(point))) + (buffer-substring (line-beginning-position)(point))) (t ""))))) ;;;###autoload @@ -472,7 +459,11 @@ TABLE defaults to the current buffer's category table." (setq end (match-end 0))) (narrow-to-region beg end) (let* ((fill-prefix (detect-paragraph-cited-prefix)) - (pat (concat fill-prefix "\n"))) + (fill-column (max (+ 1 (current-left-margin) + (string-width fill-prefix)) + (current-fill-column))) + (pat (concat fill-prefix "\n")) + filladapt-mode) (goto-char (point-min)) (while (search-forward pat nil t) (let ((b (match-beginning 0)) @@ -514,9 +505,11 @@ TABLE defaults to the current buffer's category table." pe (match-beginning 1) s (match-end 0))) i))) - (when (and ps (< ps pe)) - (delete-region b e) - (insert (concat (substring prefix ps pe) (make-string nest ?>)))) + (if (and ps (< ps pe)) + (progn + (delete-region b e) + (insert (concat (substring prefix ps pe) + (make-string nest ?>))))) )))) (defun replace-top-string (old new) @@ -553,23 +546,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