Mercurial > hg > xemacs-beta

comparison lisp/mu/mu-cite.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 7e54bd776075
children c0c698873ce1
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; mu-cite.el --- yet another citation tool for GNU Emacs 1 ;;; mu-cite.el --- yet another citation tool for GNU Emacs
2 2
3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
4 4
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> 5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; MINOURA Makoto <minoura@netlaputa.or.jp> 6 ;; MINOURA Makoto <minoura@netlaputa.or.jp>
7 ;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> 7 ;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
8 ;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> 8 ;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
9 ;; Version: $Revision: 1.7 $ 9 ;; Version: $Revision: 1.1.1.1 $
10 ;; Keywords: mail, news, citation 10 ;; Keywords: mail, news, citation
11 11
12 ;; This file is part of MU (Message Utilities). 12 ;; This file is part of tl (Tiny Library).
13 13
14 ;; This program is free software; you can redistribute it and/or 14 ;; This program is free software; you can redistribute it and/or
15 ;; modify it under the terms of the GNU General Public License as 15 ;; modify it under the terms of the GNU General Public License as
16 ;; published by the Free Software Foundation; either version 2, or (at 16 ;; published by the Free Software Foundation; either version 2, or (at
17 ;; your option) any later version. 17 ;; your option) any later version.
52 52
53 ;;; @ version 53 ;;; @ version
54 ;;; 54 ;;;
55 55
56 (defconst mu-cite/RCS-ID 56 (defconst mu-cite/RCS-ID
57 "$Id: mu-cite.el,v 1.7 1997/03/22 05:29:11 steve Exp $") 57 "$Id: mu-cite.el,v 1.1.1.1 1996/12/18 22:43:39 steve Exp $")
58 (defconst mu-cite/version (get-version-string mu-cite/RCS-ID)) 58 (defconst mu-cite/version (get-version-string mu-cite/RCS-ID))
59 59
60 60
61 ;;; @ formats 61 ;;; @ formats
62 ;;; 62 ;;;
63 63
64 (defvar mu-cite/cited-prefix-regexp "\\(^[^ \t\n<>]+>+[ \t]*\\|^[ \t]*$\\)" 64 (defvar mu-cite/cited-prefix-regexp "\\(^[^ \t\n>]+>+[ \t]*\\|^[ \t]*$\\)"
65 "*Regexp to match the citation prefix. 65 "*Regexp to match the citation prefix.
66 If match, mu-cite doesn't insert citation prefix.") 66 If match, mu-cite doesn't insert citation prefix.")
67 67
68 (defvar mu-cite/prefix-format '(prefix-register-verbose "> ") 68 (defvar mu-cite/prefix-format '(prefix-register-verbose "> ")
69 "*List to represent citation prefix. 69 "*List to represent citation prefix.
93 93
94 94
95 ;;; @ field 95 ;;; @ field
96 ;;; 96 ;;;
97 97
98 (defvar mu-cite/get-field-value-method-alist nil 98 (defvar mu-cite/get-field-value-method-alist
99 "Alist major-mode vs. function to get field-body of header.") 99 (list (cons 'mh-letter-mode
100 (function
101 (lambda (name)
102 (if (and (stringp mh-sent-from-folder)
103 (numberp mh-sent-from-msg))
104 (save-excursion
105 (set-buffer mh-sent-from-folder)
106 (set-buffer mh-show-buffer)
107 (and (boundp 'mime::preview/article-buffer)
108 (bufferp mime::preview/article-buffer)
109 (set-buffer mime::preview/article-buffer))
110 (std11-field-body name)
111 ))
112 )))))
100 113
101 (defun mu-cite/get-field-value (name) 114 (defun mu-cite/get-field-value (name)
102 (or (std11-field-body name) 115 (or (std11-field-body name)
103 (let ((method (assq major-mode mu-cite/get-field-value-method-alist))) 116 (let ((method (assq major-mode mu-cite/get-field-value-method-alist)))
104 (if method 117 (if method
107 120
108 121
109 ;;; @ prefix registration 122 ;;; @ prefix registration
110 ;;; 123 ;;;
111 124
112 (defvar mu-cite/registration-file (expand-file-name "~/.mu-cite.el") 125 (defvar mu-cite/registration-file
126 (expand-file-name "~/.mu-cite.el")
113 "*The name of the user environment file for mu-cite.") 127 "*The name of the user environment file for mu-cite.")
114 128
115 (defvar mu-cite/allow-null-string-registration nil 129 (defvar mu-cite/allow-null-string-registration nil
116 "*If non-nil, null-string citation-name is registered.") 130 "*If non-nil, null-string citation-name is registered.")
117 131
118 (defvar mu-cite/registration-symbol 'mu-cite/citation-name-alist) 132 (defvar mu-cite/registration-symbol 'mu-cite/citation-name-alist)
119 133
120 (defvar mu-cite/citation-name-alist nil) 134 (defvar mu-cite/citation-name-alist nil)
135 (load mu-cite/registration-file t t t)
121 (or (eq 'mu-cite/citation-name-alist mu-cite/registration-symbol) 136 (or (eq 'mu-cite/citation-name-alist mu-cite/registration-symbol)
122 (setq mu-cite/citation-name-alist 137 (setq mu-cite/citation-name-alist
123 (symbol-value mu-cite/registration-symbol)) 138 (symbol-value mu-cite/registration-symbol))
124 ) 139 )
125 (defvar mu-cite/minibuffer-history nil) 140 (defvar mu-cite/minibuffer-history nil)
131 146
132 ;; register citation-name to the database 147 ;; register citation-name to the database
133 (defun mu-cite/add-citation-name (name from) 148 (defun mu-cite/add-citation-name (name from)
134 (setq mu-cite/citation-name-alist 149 (setq mu-cite/citation-name-alist
135 (put-alist from name mu-cite/citation-name-alist)) 150 (put-alist from name mu-cite/citation-name-alist))
136 (mu-cite/save-registration-file) 151 (mu-cite/save-to-file)
137 ) 152 )
138 153
139 ;; load/save registration file 154 ;; save to file
140 (defun mu-cite/load-registration-file () 155 (defun mu-cite/save-to-file ()
141 (let* ((file mu-cite/registration-file) 156 (let* ((filename mu-cite/registration-file)
142 (buffer (get-buffer-create " *mu-register*"))) 157 (buffer (get-buffer-create " *mu-register*")))
143 (if (file-readable-p file) 158 (save-excursion
144 (unwind-protect 159 (set-buffer buffer)
145 (save-excursion 160 (setq buffer-file-name filename)
146 (set-buffer buffer) 161 (erase-buffer)
147 (erase-buffer) 162 (insert
148 (insert-file-contents file) 163 (format ";;; %s\n" (file-name-nondirectory filename)))
149 ;; (eval-buffer) 164 (insert
150 (eval-current-buffer)) 165 (format ";;; This file is generated automatically by mu-cite %s.\n\n"
151 (kill-buffer buffer)) 166 mu-cite/version))
152 ))) 167 (insert (format "(setq %s\n '(" mu-cite/registration-symbol))
153 (add-hook 'mu-cite-load-hook (function mu-cite/load-registration-file)) 168 (insert (mapconcat
154 169 (function prin1-to-string)
155 (defun mu-cite/save-registration-file () 170 mu-cite/citation-name-alist "\n "))
156 (let* ((file mu-cite/registration-file) 171 (insert "\n ))\n\n")
157 (buffer (get-buffer-create " *mu-register*"))) 172 (insert
158 (unwind-protect 173 (format ";;; %s ends here.\n" (file-name-nondirectory filename)))
159 (save-excursion 174 (save-buffer))
160 (set-buffer buffer) 175 (kill-buffer buffer)))
161 (setq buffer-file-name file)
162 (erase-buffer)
163 (insert ";;; " (file-name-nondirectory file) "\n")
164 (insert ";;; This file is generated automatically by mu-cite "
165 mu-cite/version "\n\n")
166 (insert "(setq "
167 (symbol-name mu-cite/registration-symbol)
168 "\n '(")
169 (insert (mapconcat
170 (function prin1-to-string)
171 mu-cite/citation-name-alist "\n "))
172 (insert "\n ))\n\n")
173 (insert ";;; "
174 (file-name-nondirectory file)
175 " ends here.\n")
176 (save-buffer))
177 (kill-buffer buffer))))
178 176
179 177
180 ;;; @ item methods 178 ;;; @ item methods
181 ;;; 179 ;;;
182 180
391 389
392 390
393 ;;; @ message editing utilities 391 ;;; @ message editing utilities
394 ;;; 392 ;;;
395 393
396 (defvar citation-mark-chars ">}|" 394 (defvar cited-prefix-regexp "^[^ \t>]*[>|]+[ \t#]*"
397 "*String of characters for citation delimiter. [mu-cite.el]") 395 "*Regexp to match the citation prefix.")
398
399 (defvar citation-disable-chars "<{"
400 "*String of characters not allowed as citation-prefix.")
401
402 (defun detect-paragraph-cited-prefix ()
403 (save-excursion
404 (goto-char (point-min))
405 (let ((i 0)
406 (prefix
407 (buffer-substring
408 (progn (beginning-of-line)(point))
409 (progn (end-of-line)(point))
410 ))
411 str ret)
412 (while (and (= (forward-line) 0)
413 (setq str (buffer-substring
414 (progn (beginning-of-line)(point))
415 (progn (end-of-line)(point))))
416 (setq ret (string-compare-from-top prefix str))
417 )
418 (setq prefix
419 (if (stringp ret)
420 ret
421 (second ret)))
422 (setq i (1+ i))
423 )
424 (cond ((> i 1) prefix)
425 ((> i 0)
426 (goto-char (point-min))
427 (save-restriction
428 (narrow-to-region (point)
429 (+ (point)(length prefix)))
430 (goto-char (point-max))
431 (if (re-search-backward
432 (concat "[" citation-mark-chars "]") nil t)
433 (progn
434 (goto-char (match-end 0))
435 (if (looking-at "[ \t]+")
436 (goto-char (match-end 0))
437 )
438 (buffer-substring (point-min)(point))
439 )
440 prefix)))
441 ((progn
442 (goto-char (point-max))
443 (re-search-backward
444 (concat "[" citation-disable-chars "]") nil t)
445 (re-search-backward
446 (concat "[" citation-mark-chars "]") nil t)
447 )
448 (goto-char (match-end 0))
449 (if (looking-at "[ \t]+")
450 (goto-char (match-end 0))
451 )
452 (buffer-substring (point-min)(point))
453 )
454 (t ""))
455 )))
456 396
457 (defun fill-cited-region (beg end) 397 (defun fill-cited-region (beg end)
458 (interactive "*r") 398 (interactive "*r")
459 (save-excursion 399 (save-excursion
460 (save-restriction 400 (save-restriction
461 (goto-char end) 401 (goto-char end)
462 (and (search-backward "\n" nil t) 402 (while (not (eolp))
463 (setq end (match-end 0)) 403 (backward-char)
464 ) 404 )
405 (setq end (point))
465 (narrow-to-region beg end) 406 (narrow-to-region beg end)
466 (let* ((fill-prefix (detect-paragraph-cited-prefix)) 407 (goto-char (point-min))
467 (pat (concat fill-prefix "\n")) 408 (let* ((fill-prefix
409 (let* ((str1 (buffer-substring
410 (progn (beginning-of-line)(point))
411 (progn (end-of-line)(point))
412 ))
413 (str2 (let ((p0 (point)))
414 (forward-line)
415 (if (> (count-lines p0 (point)) 0)
416 (buffer-substring
417 (progn (beginning-of-line)(point))
418 (progn (end-of-line)(point))
419 ))))
420 (ret (string-compare-from-top str1 str2))
421 )
422 (if ret
423 (let ((prefix (nth 1 ret)))
424 (if (string-match cited-prefix-regexp prefix)
425 (substring prefix 0 (match-end 0))
426 prefix))
427 (goto-char (point-min))
428 (if (re-search-forward cited-prefix-regexp nil t)
429 (buffer-substring (match-beginning 0) (match-end 0))
430 ))))
431 (pat (concat "\n" fill-prefix))
468 ) 432 )
469 (goto-char (point-min)) 433 (goto-char (point-min))
470 (while (search-forward pat nil t) 434 (while (search-forward pat nil t)
471 (let ((b (match-beginning 0)) 435 (let ((b (match-beginning 0))
472 (e (match-end 0)) 436 (e (match-end 0))
483 )) 447 ))
484 ) 448 )
485 (goto-char (point-min)) 449 (goto-char (point-min))
486 (fill-region (point-min) (point-max)) 450 (fill-region (point-min) (point-max))
487 )))) 451 ))))
452
453 (defvar citation-mark-chars ">}|")
488 454
489 (defun compress-cited-prefix () 455 (defun compress-cited-prefix ()
490 (interactive) 456 (interactive)
491 (save-excursion 457 (save-excursion
492 (goto-char (point-min)) 458 (goto-char (point-min))