From: morioka Date: Tue, 10 Mar 1998 04:41:21 +0000 (+0000) Subject: tm 7.81. X-Git-Tag: tm7_81 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=6fb700d91224a6ccd25972337454b25d467bbb2a;p=elisp%2Fmu-cite.git tm 7.81. --- 6fb700d91224a6ccd25972337454b25d467bbb2a diff --git a/latex-math-symbol.el b/latex-math-symbol.el new file mode 100644 index 0000000..b8970ef --- /dev/null +++ b/latex-math-symbol.el @@ -0,0 +1,94 @@ +;;; latex-math-symbol.el --- LaTeX math symbol decoder + +;; Copyright (C) 1996 MORIOKA Tomohiko + +;; Author: MORIOKA Tomohiko +;; Created: 1996/7/1 +;; Version: +;; $Id: latex-math-symbol.el,v 1.2 1996/09/02 16:03:43 morioka Exp $ +;; Keywords: LaTeX, math, mule + +;; This file is part of MU (Message Utilities). + +;; This program 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 2, or (at +;; your option) any later version. + +;; This program 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 this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; - How to install +;; bytecompile this file and copy it to the apropriate directory. +;; - How to use +;; If you use tm, please put following to your ~/.emacs: +;; (autoload 'latex-math-decode-buffer "latex-math-symbol" nil t) +;; (add-hook 'mime-viewer/plain-text-preview-hook +;; 'latex-math-decode-buffer) +;; Of course, it may be available for other hooks to filter messages. + +;;; Code: + +(defvar latex-math-symbol-table-alist + '(("\\pi" . "$B&P(B") + + ("\\{" . "$B!P(B")("\\}" . "$B!Q(B") + + ("\\cdot" . "$B!&(B") + ("\\times" . "$B!_(B") + ("\\cap" . "$B"A(B")("\\cup" . "$B"@(B") + + ("\\leq" . "$(C!B(B")("\\geq" . "$(C!C(B") + ("\\le" . "$(C!B(B")("\\ge" . "$(C!C(B") + ("\\subseteq" . "$B"<(B")("\\supseteq" . "$B"=(B") + ("\\subset" . "$B">(B")("\\supset" . "$B"?(B") + ("\\in" . "$B":(B")("\\ni" . "$B";(B") + ("\\mid" . "$B!C(B") + ("\\neq" . "$B!b(B")("\\ne" . "$B!b(B") + + ("\\forall" . "$B"O(B") + + ("\\leftarrow" . "$B"+(B")("\\rightarrow" . "$B"*(B") + ("\\gets" . "$B"+(B")("\\to" . "$B"*(B") + + ("^1" . ",A9(B") + ("^2" . ",A2(B") + ("^3" . ",A3(B") + )) + +(defun latex-math-decode-region (beg end) + (interactive "r") + (save-restriction + (narrow-to-region beg end) + (let ((rest latex-math-symbol-table-alist) + cell) + (while rest + (setq cell (car rest)) + (goto-char beg) + (while (search-forward (car cell) nil t) + (replace-match (cdr cell)) + ) + (setq rest (cdr rest)) + )))) + +(defun latex-math-decode-buffer () + (interactive) + (latex-math-decode-region (point-min)(point-max)) + ) + + +;;; @ end +;;; + +(provide 'latex-math-symbol) + +;;; latex-math-symbol.el ends here diff --git a/mu-bbdb.el b/mu-bbdb.el new file mode 100644 index 0000000..197ee09 --- /dev/null +++ b/mu-bbdb.el @@ -0,0 +1,128 @@ +;;; mu-bbdb.el --- `attribution' function for mu-cite with BBDB. + +;; Copyright (C) 1996 Shuhei KOBAYASHI + +;; Author: Shuhei KOBAYASHI +;; Version: $Id: mu-bbdb.el,v 3.1 1996/08/18 07:19:53 morioka Exp $ + +;; This file is part of tl (Tiny Library). + +;; This program 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 2, or (at +;; your option) any later version. + +;; This program 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 this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; - How to use +;; 1. bytecompile this file and copy it to the apropriate directory. +;; 2. put the following lines to your ~/.emacs: +;; (require 'tl-misc) +;; (call-after-loaded 'mu-cite +;; (function +;; (lambda () +;; (require 'mu-bbdb) +;; ))) + + +;;; Code: + +(require 'mu-cite) +(require 'bbdb) + +(defvar mu-bbdb-load-hook nil + "*List of functions called after mu-bbdb is loaded.") + +;;; @@ prefix and registration using BBDB +;;; + +(defun mu-cite/get-bbdb-prefix-method () + (or (mu-cite/get-bbdb-attr (mu-cite/get-value 'address)) + ">") + ) + +(defun mu-cite/get-bbdb-attr (addr) + "Extract attribute information from BBDB." + (let ((record (bbdb-search-simple nil addr))) + (and record + (bbdb-record-getprop record 'attribution)) + )) + +(defun mu-cite/set-bbdb-attr (attr addr) + "Add attribute information to BBDB." + (let* ((bbdb-notice-hook nil) + (record (bbdb-annotate-message-sender + addr t + (bbdb-invoke-hook-for-value + bbdb/mail-auto-create-p) + t))) + (if record + (progn + (bbdb-record-putprop record 'attribution attr) + (bbdb-change-record record nil)) + ))) + +(defun mu-cite/get-bbdb-prefix-register-method () + (let ((addr (mu-cite/get-value 'address))) + (or (mu-cite/get-bbdb-attr addr) + (let ((return + (read-string "Citation name? " + (or (mu-cite/get-value 'x-attribution) + (mu-cite/get-value 'full-name)) + 'mu-cite/minibuffer-history) + )) + (if (and (not (string-equal return "")) + (y-or-n-p (format "Register \"%s\"? " return))) + (mu-cite/set-bbdb-attr return addr) + ) + return)))) + +(defun mu-cite/get-bbdb-prefix-register-verbose-method () + (let* ((addr (mu-cite/get-value 'address)) + (attr (mu-cite/get-bbdb-attr addr)) + (return (read-string "Citation name? " + (or attr + (mu-cite/get-value 'x-attribution) + (mu-cite/get-value 'full-name)) + 'mu-cite/minibuffer-history)) + ) + (if (and (not (string-equal return "")) + (not (string-equal return attr)) + (y-or-n-p (format "Register \"%s\"? " return)) + ) + (mu-cite/set-bbdb-attr return addr) + ) + return)) + +(or (assoc 'bbdb-prefix mu-cite/default-methods-alist) + (setq mu-cite/default-methods-alist + (append mu-cite/default-methods-alist + (list + (cons 'bbdb-prefix + (function mu-cite/get-bbdb-prefix-method)) + (cons 'bbdb-prefix-register + (function mu-cite/get-bbdb-prefix-register-method)) + (cons 'bbdb-prefix-register-verbose + (function + mu-cite/get-bbdb-prefix-register-verbose-method)) + )))) + + +;;; @ end +;;; + +(provide 'mu-bbdb) + +(run-hooks 'mu-bbdb-load-hook) + +;;; mu-bbdb.el ends here diff --git a/mu-cite.el b/mu-cite.el new file mode 100644 index 0000000..2d0b35e --- /dev/null +++ b/mu-cite.el @@ -0,0 +1,480 @@ +;;; mu-cite.el --- yet another citation tool for GNU Emacs + +;; Copyright (C) 1995,1996 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; MINOURA Makoto +;; Shuhei KOBAYASHI +;; Maintainer: Shuhei KOBAYASHI +;; Version: $Revision: 7.36 $ +;; Keywords: mail, news, citation + +;; This file is part of tl (Tiny Library). + +;; This program 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 2, or (at +;; your option) any later version. + +;; This program 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 this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, 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 +;; (autoload 'mu-cite/cite-original "mu-cite" nil t) +;; ;; for all but message-mode +;; (add-hook 'mail-citation-hook 'mu-cite/cite-original) +;; ;; for message-mode only +;; (setq message-cite-function (function mu-cite/cite-original)) +;; for EMACS 18 +;; ;; for all but mh-e +;; (add-hook 'mail-yank-hooks (function mu-cite/cite-original)) +;; ;; for mh-e only +;; (add-hook 'mh-yank-hooks (function mu-cite/cite-original)) + +;;; Code: + +(require 'std11) +(require 'tl-str) +(require 'tl-list) + + +;;; @ version +;;; + +(defconst mu-cite/RCS-ID + "$Id: mu-cite.el,v 7.36 1996/08/30 04:25:34 morioka Exp $") +(defconst mu-cite/version (get-version-string mu-cite/RCS-ID)) + + +;;; @ formats +;;; + +(defvar cited-prefix-regexp "^[^ \t>]*[>|]+[ \t#]*") +(defvar mu-cite/cited-prefix-regexp "\\(^[^ \t\n>]+>+[ \t]*\\|^[ \t]*$\\)") + +(defvar mu-cite/prefix-format '(prefix-register-verbose "> ") + "*List to represent citation prefix. +Each elements must be string or method name.") +(defvar mu-cite/top-format '(in-id + ">>>>> " from " wrote:\n") + "*List to represent top string of citation. +Each elements must be string or method name.") + + +;;; @ hooks +;;; + +(defvar mu-cite/pre-cite-hook nil + "*List of functions called before citing a region of text.") +(defvar mu-cite/post-cite-hook nil + "*List of functions called after citing a region of text.") + + +;;; @ field +;;; + +(defvar mu-cite/get-field-value-method-alist + (list (cons 'mh-letter-mode + (function + (lambda (name) + (if (and (stringp mh-sent-from-folder) + (numberp mh-sent-from-msg)) + (save-excursion + (set-buffer mh-sent-from-folder) + (set-buffer mh-show-buffer) + (and (boundp 'mime::preview/article-buffer) + (bufferp mime::preview/article-buffer) + (set-buffer mime::preview/article-buffer)) + (std11-field-body name) + )) + ))))) + +(defun mu-cite/get-field-value (name) + (or (std11-field-body name) + (let ((method (assq major-mode mu-cite/get-field-value-method-alist))) + (if method + (funcall (cdr method) name) + )))) + + +;;; @ prefix registration +;;; + +(defvar mu-cite/registration-file + (expand-file-name "~/.mu-cite.el") + "*The name of the user environment file for mu-cite.") + +(defvar mu-cite/allow-null-string-registration nil + "*If non-nil, null-string citation-name is registered.") + +(defvar mu-cite/registration-symbol 'mu-cite/citation-name-alist) + +(defvar mu-cite/citation-name-alist nil) +(load mu-cite/registration-file t t t) +(or (eq 'mu-cite/citation-name-alist mu-cite/registration-symbol) + (setq mu-cite/citation-name-alist + (symbol-value mu-cite/registration-symbol)) + ) +(defvar mu-cite/minibuffer-history nil) + +;; get citation-name from the database +(defun mu-cite/get-citation-name (from) + (assoc-value from mu-cite/citation-name-alist) + ) + +;; register citation-name to the database +(defun mu-cite/add-citation-name (name from) + (setq mu-cite/citation-name-alist + (put-alist from name mu-cite/citation-name-alist)) + (mu-cite/save-to-file) + ) + +;; save to file +(defun mu-cite/save-to-file () + (let* ((filename mu-cite/registration-file) + (buffer (get-buffer-create " *mu-register*"))) + (save-excursion + (set-buffer buffer) + (setq buffer-file-name filename) + (erase-buffer) + (insert + (format ";;; %s\n" (file-name-nondirectory filename))) + (insert + (format ";;; This file is generated automatically by mu-cite %s.\n\n" + mu-cite/version)) + (insert (format "(setq %s\n '(" mu-cite/registration-symbol)) + (insert (mapconcat + (function prin1-to-string) + mu-cite/citation-name-alist "\n ")) + (insert "\n ))\n\n") + (insert + (format ";;; %s ends here.\n" (file-name-nondirectory filename))) + (save-buffer)) + (kill-buffer buffer))) + + +;;; @ item methods +;;; + +;;; @@ ML count +;;; + +(defvar mu-cite/ml-count-field-list + '("X-Ml-Count" "X-Mail-Count" "X-Seqno" "X-Sequence" "Mailinglist-Id")) + +(defun mu-cite/get-ml-count-method () + (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))) + (if (and ml-count (string-match "[0-9]+" ml-count)) + (throw 'tag + (substring ml-count + (match-beginning 0)(match-end 0)) + )) + (setq field-list (cdr field-list)) + ))))) + + +;;; @@ prefix and registration +;;; + +(defun mu-cite/get-prefix-method () + (or (mu-cite/get-citation-name (mu-cite/get-value 'address)) + ">") + ) + +(defun mu-cite/get-prefix-register-method () + (let ((addr (mu-cite/get-value 'address))) + (or (mu-cite/get-citation-name addr) + (let ((return + (read-string "Citation name? " + (or (mu-cite/get-value 'x-attribution) + (mu-cite/get-value 'full-name)) + 'mu-cite/minibuffer-history) + )) + (if (and (or mu-cite/allow-null-string-registration + (not (string-equal return ""))) + (y-or-n-p (format "Register \"%s\"? " return))) + (mu-cite/add-citation-name return addr) + ) + return)))) + +(defun mu-cite/get-prefix-register-verbose-method () + (let* ((addr (mu-cite/get-value 'address)) + (return1 (mu-cite/get-citation-name addr)) + (return (read-string "Citation name? " + (or return1 + (mu-cite/get-value 'x-attribution) + (mu-cite/get-value 'full-name)) + 'mu-cite/minibuffer-history)) + ) + (if (and (or mu-cite/allow-null-string-registration + (not (string-equal return ""))) + (not (string-equal return return1)) + (y-or-n-p (format "Register \"%s\"? " return)) + ) + (mu-cite/add-citation-name return addr) + ) + return)) + + +;;; @@ set up +;;; + +(defvar mu-cite/default-methods-alist + (list (cons 'from + (function + (lambda () + (mu-cite/get-field-value "From") + ))) + (cons 'date + (function + (lambda () + (mu-cite/get-field-value "Date") + ))) + (cons 'message-id + (function + (lambda () + (mu-cite/get-field-value "Message-Id") + ))) + (cons 'subject + (function + (lambda () + (mu-cite/get-field-value "Subject") + ))) + (cons 'ml-name + (function + (lambda () + (mu-cite/get-field-value "X-Ml-Name") + ))) + (cons 'ml-count (function mu-cite/get-ml-count-method)) + (cons 'address-structure + (function + (lambda () + (car + (std11-parse-address-string (mu-cite/get-value 'from)) + )))) + (cons 'full-name + (function + (lambda () + (std11-full-name-string + (mu-cite/get-value 'address-structure)) + ))) + (cons 'address + (function + (lambda () + (std11-address-string + (mu-cite/get-value 'address-structure)) + ))) + (cons 'id + (function + (lambda () + (let ((ml-name (mu-cite/get-value 'ml-name))) + (if ml-name + (concat "[" + ml-name + " : No." + (mu-cite/get-value 'ml-count) + "]") + (mu-cite/get-value 'message-id) + ))))) + (cons 'in-id + (function + (lambda () + (let ((id (mu-cite/get-value 'id))) + (if id + (format ">>>>> In %s \n" id) + ""))))) + (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") + ))) + )) + + +;;; @ fundamentals +;;; + +(defvar mu-cite/methods-alist nil) + +(defun mu-cite/make-methods () + (setq mu-cite/methods-alist + (copy-alist mu-cite/default-methods-alist)) + (run-hooks 'mu-cite/instantiation-hook) + ) + +(defun mu-cite/get-value (item) + (let ((ret (assoc-value item mu-cite/methods-alist))) + (if (functionp ret) + (prog1 + (setq ret (funcall ret)) + (set-alist 'mu-cite/methods-alist item ret) + ) + ret))) + +(defun mu-cite/eval-format (list) + (mapconcat (function + (lambda (elt) + (cond ((stringp elt) elt) + ((symbolp elt) (mu-cite/get-value elt)) + ))) + list "") + ) + + +;;; @ main function +;;; + +(defun mu-cite/cite-original () + "Citing filter function. +This is callable from the various mail and news readers' reply +function according to the agreed upon standard." + (interactive) + (mu-cite/make-methods) + (save-restriction + (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)) + ) + (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)) + (or (looking-at mu-cite/cited-prefix-regexp) + (insert prefix)) + (forward-line 1)) + (goto-char last-point) + ) + (run-hooks 'mu-cite/post-cite-hook) + )) + + +;;; @ message editing utilities +;;; + +(defun fill-cited-region (beg end) + (interactive "*r") + (save-excursion + (save-restriction + (goto-char end) + (while (not (eolp)) + (backward-char) + ) + (setq end (point)) + (narrow-to-region beg end) + (goto-char (point-min)) + (let* ((fill-prefix + (let* ((str1 (buffer-substring + (progn (beginning-of-line)(point)) + (progn (end-of-line)(point)) + )) + (str2 (let ((p0 (point))) + (forward-line) + (if (> (count-lines p0 (point)) 0) + (buffer-substring + (progn (beginning-of-line)(point)) + (progn (end-of-line)(point)) + )))) + (ret (string-compare-from-top str1 str2)) + ) + (if ret + (nth 1 ret) + (goto-char (point-min)) + (if (re-search-forward cited-prefix-regexp nil t) + (buffer-substring (match-beginning 0) (match-end 0)) + )))) + (pat (concat "\n" fill-prefix)) + ) + (goto-char (point-min)) + (while (search-forward pat nil t) + (if (and (> (match-beginning 0) (point-min)) + (member (char-category + (char-before (match-beginning 0))) + '("a" "l")) + ) + (replace-match " ") + (replace-match "") + ) + ) + (goto-char (point-min)) + (fill-region (point-min) (point-max)) + )))) + +(defvar citation-mark-chars ">}|") + +(defun compress-cited-prefix () + (interactive) + (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") nil t) + (while (re-search-forward + (concat "^\\([ \t]*[^ \t\n" citation-mark-chars "]*[" + citation-mark-chars "]\\)+") nil t) + (let* ((b (match-beginning 0)) + (e (match-end 0)) + (prefix (buffer-substring b e)) + ps pe (s 0) + (nest (let ((i 0)) + (if (string-match "<[^<>]+>" prefix) + (setq prefix (substring prefix 0 (match-beginning 0))) + ) + (while (string-match + (concat "\\([" citation-mark-chars "]+\\)[ \t]*") + prefix s) + (setq i (+ i (- (match-end 1)(match-beginning 1))) + ps s + pe (match-beginning 1) + s (match-end 0) + )) + i))) + (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) + (interactive "*sOld string: \nsNew string: ") + (while (re-search-forward + (concat "^" (regexp-quote old)) nil t) + (replace-match new) + )) + + +;;; @ end +;;; + +(provide 'mu-cite) + +(run-hooks 'mu-cite-load-hook) + +;;; mu-cite.el ends here