X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mu-register.el;h=008108835613d795f7c034f6308ac64ba3c80aff;hb=e40a8806c02a48a3e16b54e7b2f4de65363ca3f6;hp=676a54d26646134b4c46bbd73ec4929ce795c5d9;hpb=b7baf6df823af33aa4fbe54f8288899ecfc22671;p=elisp%2Fmu-cite.git diff --git a/mu-register.el b/mu-register.el index 676a54d..0081088 100644 --- a/mu-register.el +++ b/mu-register.el @@ -1,195 +1,210 @@ -;;; -;;; mu-register.el --- `register' function for mu-cite. -;;; -;;; Copyright (C) 1995 MINOURA Makoto -;;; -;;; Author: MINOURA Makoto -;;; modified by MORIOKA Tomohiko -;;; Created: 1995/12/27 by MINOURA Makoto -;;; Version: -;;; $Id: mu-register.el,v 1.11 1996-01-16 21:54:27 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. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; mu-register.el --- registration feature of mu-cite +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Free Software Foundation, Inc. -;;; Commentary: -;;; -;;; - How to install. -;;; 1. bytecompile this file and copy it to the apropriate directory. -;;; 2. put the following lines to your .emacs. -;;; (add-hook 'mu-cite-load-hook -;;; (function -;;; (lambda () -;;; (require 'mu-register)))) -;;; 3. you can use the keyword `registered' in your -;;; mu-cite/top-form and mu-cite/prefix-form, for example: -;;; (setq mu-cite/prefix-format (list 'registered "> ")) -;;; -;;; - ChangeLog. -;;; Wed Dec 27 14:28:17 1995 MINOURA Makoto -;;; -;;; * Written. -;;; - -;;; Code: +;; Author: MINOURA Makoto +;; MORIOKA Tomohiko +;;; Created: 1995-12-27 by MINOURA Makoto +;; Maintainer: Katsumi Yamaoka +;; Keywords: registration, citation, mail, news -(require 'mu-cite) +;; 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. -;;; @ variables -;;; +;; 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. -(defvar mu-register/registration-file - (expand-file-name "~/.mu-register") - "*The name of the user environment file for mu-register.") +;;; Code: -(defvar mu-register/registration-symbol 'mu-register/citation-name-alist) +(require 'mu-cite) -(defvar mu-register/citation-name-alist nil) -(load mu-register/registration-file t t t) -(or (eq 'mu-register/citation-name-alist mu-register/registration-symbol) - (setq mu-register/citation-name-alist - (symbol-value mu-register/registration-symbol)) - ) -(defvar mu-register/minibuffer-history nil) +(eval-when-compile (require 'static)) -;;; @ database accessers +;;; @ variables ;;; -;; get citation-name from the database -(defmacro mu-register/get-citation-name (from) - (` (cdr (assoc (, from) mu-register/citation-name-alist)))) - -;; register citation-name to the database -(defun mu-register/add-citation-name (name from) - (let* ((elt (assoc from mu-register/citation-name-alist))) - (if elt - (setq mu-register/citation-name-alist - (delq elt mu-register/citation-name-alist))) - (setq elt (cons from name)) - (setq mu-register/citation-name-alist - (cons elt - mu-register/citation-name-alist)) - (mu-register/save-to-file) - )) - -;; save to file -(defun mu-register/save-to-file () - (let* ((filename mu-register/registration-file) - (buffer (get-buffer-create " *mu-register*"))) - (save-excursion - (set-buffer buffer) - (setq buffer-file-name filename) - (erase-buffer) - (insert ";; generated automatically by mu-register.\n") - (insert (format "(setq %s - '(" mu-register/registration-symbol)) +(defcustom mu-registration-file (expand-file-name "~/.mu-cite.el") + "The name of the user environment file for mu-cite." + :type 'file + :group 'mu-cite) + +(defcustom mu-registration-file-modes 384 + "Mode bits of `mu-registration-file', as an integer." + :type 'integer + :group 'mu-cite) + +(defcustom mu-registration-file-coding-system-for-write + (static-if (boundp 'MULE) + '*iso-2022-jp* + 'iso-2022-7bit) + "Coding-system used when writing a registration file. If you set this +to nil, the value of `mu-registration-file-coding-system' will be used +for writing a file." + :group 'mu-cite) + +(defcustom mu-cite-allow-null-string-registration nil + "If non-nil, null-string citation-name can be registered." + :type 'boolean + :group 'mu-cite) + +(defvar mu-registration-symbol 'mu-citation-name-alist + "*Name of the variable to register citation prefix strings.") + +(defvar mu-registration-file-coding-system-for-read nil + "*Coding-system used when reading a registration file. Normally, you +have no need to set this option. If you have many friends in various +countries and the file contains their names in various languages, you +may avoid mis-decoding them by setting this option to `iso-2022-7bit' +or the other universal coding-system. Note that when you change this +value, you should save the file manually using the same coding-system +in advance.") + +(defvar mu-registration-file-coding-system nil + "Internal variable used to keep a default coding-system for writing +a current registration file. The value will be renewed whenever a +registration file is read.") + +(defvar mu-register-history nil) + + +;;; @ load / save registration file +;;; + +(defun mu-cite-load-registration-file () + (if (file-readable-p mu-registration-file) + (with-temp-buffer + (set-buffer-multibyte t) + (if mu-registration-file-coding-system-for-read + (insert-file-contents-as-coding-system + mu-registration-file-coding-system-for-read + mu-registration-file) + (insert-file-contents mu-registration-file)) + (setq mu-registration-file-coding-system + (static-cond + ((boundp 'buffer-file-coding-system) + (symbol-value 'buffer-file-coding-system)) + ((boundp 'file-coding-system) + (symbol-value 'file-coding-system)) + (t + nil))) + (let ((exp (read (current-buffer)))) + (or (eq (car (cdr exp)) mu-registration-symbol) + (setcar (cdr exp) mu-registration-symbol)) + (eval exp)))) + (or (boundp mu-registration-symbol) + (set mu-registration-symbol nil))) + +(defun mu-cite-save-registration-file () + (with-temp-buffer + (set-buffer-multibyte t) + (let ((name (file-name-nondirectory mu-registration-file)) + (coding-system (or mu-registration-file-coding-system-for-write + mu-registration-file-coding-system))) + (insert (format "\ +;;; %s -*- mode: emacs-lisp; coding: %s -*- +;; This file is generated automatically by MU-CITE v%s. + +" + name coding-system mu-cite-version)) + (insert "(setq " + (symbol-name mu-registration-symbol) + "\n '(") (insert (mapconcat - (function prin1-to-string) - mu-register/citation-name-alist "\n ")) - (insert "\n ))\n") - (save-buffer)) - (kill-buffer buffer))) - - -;;; @ main functions + (function + (lambda (elem) + (format "(%s . %s)" + (prin1-to-string + (mu-cite-remove-text-properties (car elem))) + (prin1-to-string + (mu-cite-remove-text-properties (cdr elem)))))) + (symbol-value mu-registration-symbol) "\n\t")) + (insert "))\n\n") + (insert ";;; " name " ends here\n") + (write-region-as-coding-system coding-system + (point-min) (point-max) + mu-registration-file nil 'nomsg) + (condition-case nil + (set-file-modes mu-registration-file mu-registration-file-modes) + (error nil))))) + + +;;; @ database accessors ;;; -(defun mu-register/citation-name () - (let* ((from - (rfc822/address-string - (car (rfc822/parse-address - (rfc822/lexical-analyze - (mu-cite/get-value 'from)))))) - (fullname (mu-cite/get-value 'full-name)) - (return1 - (mu-register/get-citation-name from)) - (return)) - (if (null return1) - (setq return1 fullname)) - (setq return - (tl:read-string "Citation name? " - return1 - 'mu-register/minibuffer-history)) - (if (not (string-equal return return1)) - (let ((ans) - (cursor-in-echo-area t)) - (while (null ans) - (message (format "Register \"%s\" (y/n)? " return)) - (setq ans (read-event)) - (if (not (or (eq ans ?y) - (eq ans ?n))) - (setq ans nil))) - (message "") - (if (eq ans ?y) - (mu-register/add-citation-name return from)))) - return)) +;; get citation-name from the database +(defun mu-register-get-citation-name (from) + (cdr (assoc from (symbol-value mu-registration-symbol)))) -(defun mu-register/citation-name-quietly () - (let* ((from - (rfc822/address-string - (car (rfc822/parse-address - (rfc822/lexical-analyze - (mu-cite/get-value 'from)))))) - (fullname (mu-cite/get-value 'full-name)) - (return1 - (mu-register/get-citation-name from)) - return) - (if (null return1) - (progn - (setq return - (tl:read-string "Citation name? " - fullname - 'mu-register/minibuffer-history)) - (if (not (string-equal return return1)) - (let ((ans) - (cursor-in-echo-area t)) - (while (null ans) - (message (format "Register \"%s\" (y/n)? " return)) - (setq ans (read-event)) - (if (not (or (eq ans ?y) - (eq ans ?n))) - (setq ans nil))) - (message "") - (if (eq ans ?y) - (mu-register/add-citation-name return from) - ) - )) - ) - (setq return return1) - ) +;; register citation-name to the database +(defun mu-register-add-citation-name (name from) + (set-alist mu-registration-symbol from name) + (mu-cite-save-registration-file)) + + +;;; @ methods +;;; + +;;;###autoload +(defun mu-cite-get-prefix-method () + (or (mu-register-get-citation-name (mu-cite-get-value 'address)) + ">")) + +;;;###autoload +(defun mu-cite-get-prefix-register-method () + (let ((addr (mu-cite-get-value 'address))) + (or (mu-register-get-citation-name addr) + (let* ((minibuffer-allow-text-properties nil) + (return + (mu-cite-remove-text-properties + (read-string "Citation name? " + (or (mu-cite-get-value 'x-attribution) + (mu-cite-get-value 'x-cite-me) + (mu-cite-get-value 'full-name)) + 'mu-register-history)))) + + (if (and (or mu-cite-allow-null-string-registration + (not (string-equal return ""))) + (y-or-n-p (format "Register \"%s\"? " return))) + (mu-register-add-citation-name return addr)) + return)))) + +;;;###autoload +(defun mu-cite-get-prefix-register-verbose-method () + (let* ((addr (mu-cite-get-value 'address)) + (return1 (mu-register-get-citation-name addr)) + (minibuffer-allow-text-properties nil) + (return (mu-cite-remove-text-properties + (read-string "Citation name? " + (or return1 + (mu-cite-get-value 'x-attribution) + (mu-cite-get-value 'x-cite-me) + (mu-cite-get-value 'full-name)) + 'mu-register-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-register-add-citation-name return addr)) return)) - - -;;; @ Installation -;;; - -(set-alist 'mu-cite/default-methods-alist - 'prefix-register - (function mu-register/citation-name-quietly)) -(set-alist 'mu-cite/default-methods-alist - 'prefix-register-verbose - (function mu-register/citation-name)) - ;;; @ end ;;; (provide 'mu-register) +(mu-cite-load-registration-file) + ;;; mu-register.el ends here