mu-register.el

   1 ;;; mu-register.el --- registration feature of mu-cite
   2 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
   3 ;;        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., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, 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-write
  49   (static-if (boundp 'MULE)
  50       '*iso-2022-jp*
  51     'iso-2022-7bit)
  52   "Coding-system used when writing a registration file.  If you set this
  53 to nil, the value of `mu-registration-file-coding-system' will be used
  54 for writing a file."
  55   :group 'mu-cite)
  56
  57 (defcustom mu-cite-allow-null-string-registration nil
  58   "If non-nil, null-string citation-name can be registered."
  59   :type 'boolean
  60   :group 'mu-cite)
  61
  62 (defvar mu-registration-symbol 'mu-citation-name-alist
  63   "*Name of the variable to register citation prefix strings.")
  64
  65 (defvar mu-registration-file-coding-system-for-read nil
  66   "*Coding-system used when reading a registration file.  Normally, you
  67 have no need to set this option.  If you have many friends in various
  68 countries and the file contains their names in various languages, you
  69 may avoid mis-decoding them by setting this option to `iso-2022-7bit'
  70 or the other universal coding-system.  Note that when you change this
  71 value, you should save the file manually using the same coding-system
  72 in advance.")
  73
  74 (defvar mu-registration-file-coding-system nil
  75   "Internal variable used to keep a default coding-system for writing
  76 a current registration file.  The value will be renewed whenever a
  77 registration file is read.")
  78
  79 (defvar mu-register-history nil)
  80
  81
  82 ;;; @ load / save registration file
  83 ;;;
  84
  85 (defun mu-cite-load-registration-file ()
  86   (if (file-readable-p mu-registration-file)
  87       (with-temp-buffer
  88         (set-buffer-multibyte t)
  89         (if mu-registration-file-coding-system-for-read
  90             (insert-file-contents-as-coding-system
  91              mu-registration-file-coding-system-for-read
  92              mu-registration-file)
  93           (insert-file-contents mu-registration-file))
  94         (setq mu-registration-file-coding-system
  95               (static-cond
  96                ((boundp 'buffer-file-coding-system)
  97                 (symbol-value 'buffer-file-coding-system))
  98                ((boundp 'file-coding-system)
  99                 (symbol-value 'file-coding-system))
 100                (t
 101                 nil)))
 102         (let ((exp (read (current-buffer))))
 103           (or (eq (car (cdr exp)) mu-registration-symbol)
 104               (setcar (cdr exp) mu-registration-symbol))
 105           (eval exp))))
 106   (or (boundp mu-registration-symbol)
 107       (set mu-registration-symbol nil)))
 108
 109 (defun mu-cite-save-registration-file ()
 110   (with-temp-buffer
 111     (set-buffer-multibyte t)
 112     (let ((name (file-name-nondirectory mu-registration-file))
 113           (coding-system (or mu-registration-file-coding-system-for-write
 114                              mu-registration-file-coding-system)))
 115       (insert (format "\
 116 ;;; %s  -*- mode: emacs-lisp; coding: %s -*-
 117 ;; This file is generated automatically by MU-CITE v%s.
 118
 119 "
 120                       name coding-system mu-cite-version))
 121       (insert "(setq "
 122               (symbol-name mu-registration-symbol)
 123               "\n      '(")
 124       (insert (mapconcat
 125                (function
 126                 (lambda (elem)
 127                   (format "(%s . %s)"
 128                           (prin1-to-string
 129                            (mu-cite-remove-text-properties (car elem)))
 130                           (prin1-to-string
 131                            (mu-cite-remove-text-properties (cdr elem))))))
 132                (symbol-value mu-registration-symbol) "\n\t"))
 133       (insert "))\n\n")
 134       (insert ";;; " name " ends here\n")
 135       (write-region-as-coding-system coding-system
 136                                      (point-min) (point-max)
 137                                      mu-registration-file nil 'nomsg)
 138       (condition-case nil
 139           (set-file-modes mu-registration-file mu-registration-file-modes)
 140         (error nil)))))
 141
 142
 143 ;;; @ database accessors
 144 ;;;
 145
 146 ;; get citation-name from the database
 147 (defun mu-register-get-citation-name (from)
 148   (cdr (assoc from (symbol-value mu-registration-symbol))))
 149
 150 ;; register citation-name to the database
 151 (defun mu-register-add-citation-name (name from)
 152   (set-alist mu-registration-symbol from name)
 153   (mu-cite-save-registration-file))
 154
 155
 156 ;;; @ methods
 157 ;;;
 158
 159 ;;;###autoload
 160 (defun mu-cite-get-prefix-method ()
 161   (or (mu-register-get-citation-name (mu-cite-get-value 'address))
 162       ">"))
 163
 164 ;;;###autoload
 165 (defun mu-cite-get-prefix-register-method ()
 166   (let ((addr (mu-cite-get-value 'address)))
 167     (or (mu-register-get-citation-name addr)
 168         (let* ((minibuffer-allow-text-properties nil)
 169                (return
 170                 (mu-cite-remove-text-properties
 171                  (read-string "Citation name? "
 172                               (or (mu-cite-get-value 'x-attribution)
 173                                   (mu-cite-get-value 'x-cite-me)
 174                                   (mu-cite-get-value 'full-name))
 175                               'mu-register-history))))
 176
 177           (if (and (or mu-cite-allow-null-string-registration
 178                        (not (string-equal return "")))
 179                    (y-or-n-p (format "Register \"%s\"? " return)))
 180               (mu-register-add-citation-name return addr))
 181           return))))
 182
 183 ;;;###autoload
 184 (defun mu-cite-get-prefix-register-verbose-method ()
 185   (let* ((addr (mu-cite-get-value 'address))
 186          (return1 (mu-register-get-citation-name addr))
 187          (minibuffer-allow-text-properties nil)
 188          (return (mu-cite-remove-text-properties
 189                   (read-string "Citation name? "
 190                                (or return1
 191                                    (mu-cite-get-value 'x-attribution)
 192                                    (mu-cite-get-value 'x-cite-me)
 193                                    (mu-cite-get-value 'full-name))
 194                                'mu-register-history))))
 195     (if (and (or mu-cite-allow-null-string-registration
 196                  (not (string-equal return "")))
 197              (not (string-equal return return1))
 198              (y-or-n-p (format "Register \"%s\"? " return)))
 199         (mu-register-add-citation-name return addr))
 200     return))
 201
 202
 203 ;;; @ end
 204 ;;;
 205
 206 (provide 'mu-register)
 207
 208 (mu-cite-load-registration-file)
 209
 210 ;;; mu-register.el ends here