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