mu-register.el

   1 ;;; mu-register.el --- registration feature of mu-cite
   2
   3 ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
   4
   5 ;; Author: MINOURA Makoto <minoura@netlaputa.or.jp>
   6 ;;         MORIOKA Tomohiko <tomo@m17n.org>
   7 ;; Maintainer: Katsumi Yamaoka <yamaoka@jpl.org>
   8 ;; Keywords: registration, citation, mail, news
   9
  10 ;; This file is part of MU (Message Utilities).
  11
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 2, or (at
  15 ;; your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; ChangeLog.
  30
  31 ;;   Wed Dec 27 14:28:17 1995  MINOURA Makoto <minoura@leo.bekkoame.or.jp>
  32 ;;
  33 ;;      * Written.
  34
  35 ;;; Code:
  36
  37 (require 'mu-cite)
  38
  39 (defcustom mu-registration-file (expand-file-name "~/.mu-cite.el")
  40   "The name of the user environment file for mu-cite."
  41   :type 'file
  42   :group 'mu-cite)
  43
  44 (defcustom mu-registration-file-modes 384
  45   "Mode bits of `mu-registration-file', as an integer."
  46   :type 'integer
  47   :group 'mu-cite)
  48
  49 (defcustom mu-registration-file-coding-system-for-read nil
  50   "Coding system used when reading a registration file."
  51   :group 'mu-cite)
  52
  53 (defcustom mu-cite-allow-null-string-registration nil
  54   "If non-nil, null-string citation-name is registered."
  55   :type 'boolean
  56   :group 'mu-cite)
  57
  58 (defvar mu-registration-symbol 'mu-citation-name-alist
  59   "*Name of the variable to register citation prefix strings.")
  60
  61 (defvar mu-registration-file-coding-system nil
  62   "Coding system used when writing a current registration file.")
  63
  64 (defvar mu-citation-name-alist nil)
  65
  66 (defvar mu-register-history nil)
  67
  68 (eval-when-compile (require 'static))
  69
  70 (static-when (featurep 'xemacs)
  71   (define-obsolete-variable-alias
  72     'mu-cite/registration-file 'mu-registration-file)
  73
  74   (define-obsolete-variable-alias
  75     'mu-cite/allow-null-string-registration
  76     'mu-cite-allow-null-string-registration)
  77
  78   (define-obsolete-variable-alias
  79     'mu-cite/registration-symbol 'mu-registration-symbol)
  80   )
  81
  82
  83 ;;; @ load / save registration file
  84 ;;;
  85
  86 (defun mu-cite-load-registration-file ()
  87   (if (file-readable-p mu-registration-file)
  88       (with-temp-buffer
  89         (insert-file-contents-as-coding-system
  90          mu-registration-file-coding-system-for-read
  91          mu-registration-file)
  92         (setq mu-registration-file-coding-system
  93               buffer-file-coding-system)
  94         (let ((exp (read (current-buffer))))
  95           (or (eq (car (cdr exp)) mu-registration-symbol)
  96               (setcar (cdr exp) mu-registration-symbol))
  97           (eval exp)))))
  98
  99 (defun mu-cite-save-registration-file ()
 100   (with-temp-buffer
 101     (insert ";;; " (file-name-nondirectory mu-registration-file) "\n")
 102     (insert ";;; This file is generated automatically by mu-cite "
 103             mu-cite-version "\n\n")
 104     (insert "(setq "
 105             (symbol-name mu-registration-symbol)
 106             "\n      '(")
 107     (insert (mapconcat
 108              (function prin1-to-string)
 109              mu-citation-name-alist "\n        "))
 110     (insert "\n        ))\n\n")
 111     (insert ";;; "
 112             (file-name-nondirectory mu-registration-file)
 113             " ends here.\n")
 114     (write-region-as-coding-system mu-registration-file-coding-system
 115                                    (point-min)(point-max)
 116                                    mu-registration-file nil 'nomsg)
 117     (condition-case nil
 118         (set-file-modes mu-registration-file mu-registration-file-modes)
 119       (error nil))))
 120
 121
 122 ;;; @ accessors
 123 ;;;
 124
 125 ;; get citation-name from the database
 126 (defun mu-register-get-citation-name (from)
 127   (cdr (assoc from mu-citation-name-alist)))
 128
 129 ;; register citation-name to the database
 130 (defun mu-register-add-citation-name (name from)
 131   (setq mu-citation-name-alist
 132         (put-alist from name mu-citation-name-alist))
 133   (mu-cite-save-registration-file))
 134
 135
 136 ;;; @ methods
 137 ;;;
 138
 139 ;;;###autoload
 140 (defun mu-cite-get-prefix-method ()
 141   (or (mu-register-get-citation-name (mu-cite-get-value 'address))
 142       ">"))
 143
 144 ;;;###autoload
 145 (defun mu-cite-get-prefix-register-method ()
 146   (let ((addr (mu-cite-get-value 'address)))
 147     (or (mu-register-get-citation-name addr)
 148         (let ((return
 149                (read-string "Citation name? "
 150                             (or (mu-cite-get-value 'x-attribution)
 151                                 (mu-cite-get-value 'full-name))
 152                             'mu-register-history)))
 153           (when (and (or mu-cite-allow-null-string-registration
 154                          (not (string-equal return "")))
 155                      (y-or-n-p (format "Register \"%s\"? " return)))
 156             (mu-register-add-citation-name return addr))
 157           return))))
 158
 159 ;;;###autoload
 160 (defun mu-cite-get-prefix-register-verbose-method ()
 161   (let* ((addr (mu-cite-get-value 'address))
 162          (return1 (mu-register-get-citation-name addr))
 163          (return (read-string "Citation name? "
 164                               (or return1
 165                                   (mu-cite-get-value 'x-attribution)
 166                                   (mu-cite-get-value 'full-name))
 167                               'mu-register-history)))
 168     (when (and (or mu-cite-allow-null-string-registration
 169                    (not (string-equal return "")))
 170                (not (string-equal return return1))
 171                (y-or-n-p (format "Register \"%s\"? " return)))
 172       (mu-register-add-citation-name return addr))
 173     return))
 174
 175
 176 ;;; @ end
 177 ;;;
 178
 179 (provide 'mu-register)
 180
 181 (mu-cite-load-registration-file)
 182
 183 ;;; mu-register.el ends here