cgit.sxemacs.org Git - packages/blob - mule-packages/edict/edict-update.el

   1 ;; edict-update.el --- Dictionary update functions for edict.el
   2
   3 ;; Copyright (C) 2002 Free Software Foundation, Inc.
   4
   5 ;; Author:      Stephen J. Turnbull <stephen@xemacs.org>
   6 ;; Keywords:    mule, edict, dictionary
   7 ;; Version:     0.5
   8 ;; Created:     27 January 2002
   9 ;; Last Update: 27 January 2002
  10 ;; Maintainer:  Stephen J. Turnbull <stephen@xemacs.org>
  11
  12 ;;   This file is part of XEmacs.
  13
  14 ;;   XEmacs is free software; you can redistribute it and/or modify it
  15 ;;   under the terms of the GNU General Public License as published by
  16 ;;   the Free Software Foundation; either version 2, or (at your
  17 ;;   option) any later version.
  18
  19 ;;   XEmacs is distributed in the hope that it will be useful, but
  20 ;;   WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;;   General Public License for more details.
  23 ;;
  24 ;;   You should have received a copy of the GNU General Public License
  25 ;;   along with XEmacs; if not, write to the Free Software Foundation,
  26 ;;   Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; Functions to update EDICT dictionaries and to report private dictionary
  31 ;; words upstream.
  32
  33 ;; Usage:
  34
  35 ;; Customize `edict-dictionary-path', `edict-dictionaries',
  36 ;; `edict-update-file-list', `edict-update-staging',
  37 ;; `edict-update-local-mirror', and `edict-update-archive-url'
  38 ;; appropriately.  Then "M-x edict-update RET" and if you're lucky,
  39 ;; you're done.
  40
  41 ;; TODO:
  42
  43 ;; 1. Use the package transport stuff I wrote; test it here.
  44 ;; 2. Think carefully about the process of updating packages.  The
  45 ;;    problem is that there should be a difference between updates
  46 ;;    done by administrators and updates done by ordinary users.  The
  47 ;;    administrators should update the main hierarchies, while the
  48 ;;    users should update their personal packages.  This probably
  49 ;;    involves checking for write permission and/or ownership on the
  50 ;;    package hierarchy and possibly some kind of "su.el"
  51 ;;    functionality.
  52
  53 ;;; Code
  54
  55 (require 'edict)                        ; for dictionary list and path
  56
  57 ;;; User customization
  58
  59 (defgroup edict-update nil
  60   "Customization of functions used to keep your EDICT current."
  61   :group 'edict)
  62
  63 (defcustom edict-update-file-list nil
  64   "List of files to update.
  65
  66 If nil, default to the value of `edict-dictionaries'."
  67   ;; #### should default to something else for package administrators,
  68   ;; like all known edict dictionaries.
  69   :type '(repeat file)
  70   :group 'edict-update)
  71
  72 (defcustom edict-update-staging "/tmp/edict"
  73   "Basename of temporary directory for staging EDICT dictionary archives.
  74
  75 Should not end in a slash, because it will be used to generate a unique
  76 name for a directory to be created.  The directory is deleted after use.
  77
  78 If `edict-update-local-mirror' is non-nil, this variable is ignored."
  79   :type 'file                           ; not directory
  80   :group 'edict-update)
  81
  82 (defcustom edict-update-local-mirror nil
  83   "Path to a local mirror of the EDICT dictionary archives.
  84
  85 Files downloaded here are persistent.  This location takes precedence
  86 over `edict-update-staging'."
  87   :type '(choice directory
  88                  (const :tag "none" nil))
  89   :group 'edict-update)
  90
  91 (defcustom edict-update-archive-url
  92   "ftp://ftp.cc.monash.edu.au/pub/nihongo/"
  93   "URL pointing to a host and directory serving EDICT dictionaries.
  94
  95 Should end with a slash.
  96
  97 Default is Jim Breen's Nihongo Archive at Monash University,
  98 ftp://ftp.cc.monash.edu.au/pub/nihongo/."
  99   ;; WE DEMAND AN URL WIDGET!!
 100   :type 'string
 101   :group 'edict-update)
 102
 103 (defcustom edict-update-sources-alist
 104   '(("edict" "edict.gz")
 105     ("kanjidic" "kanjidic.gz")
 106     ("enamdict" "enamdict.gz"))
 107   "Map dictionaries to archive name to download.
 108
 109 This isn't really a user customization (should be constant over time and
 110 for different mirrors), but made customizable for convenience."
 111   :type '(repeat (list string string))
 112   :group 'edict-update)
 113
 114 ;; #### Evile temporary hack
 115 (defvar edict-update-wget-options "-N")
 116
 117 ;;; Implementation
 118
 119 ;;;###autoload
 120 (defun edict-update ()
 121   "Update edict dictionaries from archives on the 'Net.
 122
 123 Customize `edict-dictionary-path', `edict-dictionaries',
 124 `edict-update-file-list', `edict-update-staging',
 125 `edict-update-local-mirror', and `edict-update-archive-url' to
 126 determine how and where to download and install.
 127
 128 #### Currently not at all robust, requires wget on the path."
 129
 130   (interactive)
 131
 132   (let ((stage (edict-update-setup-stage))
 133         ;; #### walk down the path looking for writables, confirm
 134         (destination (file-name-as-directory (car edict-dictionary-path)))
 135         (sources edict-update-sources-alist)
 136         (files (or edict-update-file-list edict-dictionaries)))
 137     ;; #### provide for alternative transports
 138     (mapc (lambda (source)
 139             (when (member (first source) files)
 140               ;; #### this is very fragile
 141               (shell-command
 142                (concat "cd " stage "; "
 143                        "wget " edict-update-wget-options " "
 144                        edict-update-archive-url (second source)))
 145               (shell-command
 146                (concat "cd " stage "; "
 147                        (if edict-update-local-mirror "cp " "mv ")
 148                        (second source) " " destination))
 149               (when (string-match "\\.gz$" (second source))
 150                 (shell-command
 151                  (concat "cd " destination "; " "gunzip " (second source))))))
 152           sources)
 153     (edict-update-cleanup-stage)))
 154
 155 ;; staging area utilities
 156
 157 (defun edict-update-setup-stage ()
 158   "Determine staging directory, and create it if needed."
 159
 160   ;; #### do proper temporary creation
 161   (if edict-update-local-mirror
 162       (cond ((not (file-exists-p edict-update-local-mirror))
 163              (make-directory edict-update-local-mirror t))
 164             ((and (file-directory-p edict-update-local-mirror)
 165                   (not (file-writable-p edict-update-local-mirror)))
 166              (error 'file-error "not writable by you"
 167                     edict-update-local-mirror))
 168             ((not (file-directory-p edict-update-local-mirror))
 169              (error 'file-already-exists "is not a directory"
 170                     edict-update-local-mirror)))
 171     (if (file-exists-p edict-update-staging)
 172         (error "%s exists, move it out of the way, please"
 173                edict-update-staging)
 174       (make-directory edict-update-staging t)
 175       edict-update-staging)))
 176
 177 (defun edict-update-cleanup-stage ()
 178   "Remove temporary staging area.
 179
 180 Files should already have been removed."
 181
 182   (unless edict-update-local-mirror
 183     (remove-directory edict-update-staging)))
 184
 185 (provide 'edict-update)
 186
 187 ;;; edict-update.el ends here