install.el

   1 ;;; install.el --- Emacs Lisp package install utility
   2
   3 ;; Copyright (C) 1996,1997,1998,1999 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Created: 1996/08/18
   7 ;; Keywords: install, byte-compile, directory detection
   8
   9 ;; This file is part of APEL (A Portable Emacs Library).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Code:
  27
  28 (require 'emu)
  29 (require 'path-util)
  30
  31
  32 ;;; @ compile Emacs Lisp files
  33 ;;;
  34
  35 (defun compile-elisp-module (module &optional path every-time)
  36   (setq module (expand-file-name (symbol-name module) path))
  37   (let ((el-file (concat module ".el"))
  38         (elc-file (concat module ".elc"))
  39         )
  40     (if (or every-time
  41             (file-newer-than-file-p el-file elc-file))
  42         (byte-compile-file el-file)
  43       )
  44     ))
  45
  46 (defun compile-elisp-modules (modules &optional path every-time)
  47   (mapcar (function
  48            (lambda (module)
  49              (compile-elisp-module module path every-time)
  50              ))
  51           modules))
  52
  53
  54 ;;; @ install files
  55 ;;;
  56
  57 (defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4))
  58
  59 (defun install-file (file src dest &optional move overwrite just-print)
  60   (if just-print
  61       (princ (format "%s -> %s\n" file dest))
  62     (let ((src-file (expand-file-name file src)))
  63       (if (file-exists-p src-file)
  64           (let ((full-path (expand-file-name file dest)))
  65             (if (and (file-exists-p full-path) overwrite)
  66                 (delete-file full-path)
  67               )
  68             (copy-file src-file full-path t t)
  69             (if move
  70                 (catch 'tag
  71                   (while (and (file-exists-p src-file)
  72                               (file-writable-p src-file))
  73                     (condition-case err
  74                         (progn
  75                           (delete-file src-file)
  76                           (throw 'tag nil)
  77                           )
  78                       (error (princ (format "%s\n" (nth 1 err))))
  79                       ))))
  80             (princ (format "%s -> %s\n" file dest))
  81             ))
  82       )))
  83
  84 (defun install-files (files src dest &optional move overwrite just-print)
  85   (or (file-exists-p dest)
  86       (make-directory dest t)
  87       )
  88   (mapcar (function (lambda (file)
  89                       (install-file file src dest move overwrite just-print)
  90                       ))
  91           files))
  92
  93
  94 ;;; @@ install Emacs Lisp files
  95 ;;;
  96
  97 (defun install-elisp-module (module src dest &optional just-print)
  98   (let (el-file elc-file)
  99     (let ((name (symbol-name module)))
 100       (setq el-file (concat name ".el"))
 101       (setq elc-file (concat name ".elc"))
 102       )
 103     (let ((src-file (expand-file-name el-file src)))
 104       (if (not (file-exists-p src-file))
 105           nil
 106         (if just-print
 107             (princ (format "%s -> %s\n" el-file dest))
 108           (let ((full-path (expand-file-name el-file dest)))
 109             (if (file-exists-p full-path)
 110                 (delete-file full-path)
 111               )
 112             (copy-file src-file full-path t t)
 113             (princ (format "%s -> %s\n" el-file dest))
 114             )))
 115       (setq src-file (expand-file-name elc-file src))
 116       (if (not (file-exists-p src-file))
 117           nil
 118         (if just-print
 119             (princ (format "%s -> %s\n" elc-file dest))
 120           (let ((full-path (expand-file-name elc-file dest)))
 121             (if (file-exists-p full-path)
 122                 (delete-file full-path)
 123               )
 124             (copy-file src-file full-path t t)
 125             (catch 'tag
 126               (while (file-exists-p src-file)
 127                 (condition-case err
 128                     (progn
 129                       (delete-file src-file)
 130                       (throw 'tag nil)
 131                       )
 132                   (error (princ (format "%s\n" (nth 1 err))))
 133                   )))
 134             (princ (format "%s -> %s\n" elc-file dest))
 135             )))
 136       )))
 137
 138 (defun install-elisp-modules (modules src dest &optional just-print)
 139   (or (file-exists-p dest)
 140       (make-directory dest t)
 141       )
 142   (mapcar (function (lambda (module)
 143                       (install-elisp-module module src dest just-print)
 144                       ))
 145           modules))
 146
 147
 148 ;;; @ detect install path
 149 ;;;
 150
 151 ;; install to shared directory (maybe "/usr/local")
 152 (defvar install-prefix
 153   (if (or running-emacs-18 running-xemacs
 154           (and (boundp 'system-configuration-options) ; 19.29 or later
 155                (string= system-configuration-options "NT"))) ; for Meadow
 156       (expand-file-name "../../.." exec-directory)
 157     (expand-file-name "../../../.." data-directory)))
 158
 159 (defvar install-elisp-prefix
 160   (if (>= emacs-major-version 19)
 161       "site-lisp"
 162     "local.lisp"))
 163
 164 (defun install-detect-elisp-directory (&optional prefix elisp-prefix
 165                                                  allow-version-specific)
 166   (or prefix
 167       (setq prefix install-prefix)
 168       )
 169   (or elisp-prefix
 170       (setq elisp-prefix install-elisp-prefix)
 171       )
 172   (or
 173    (catch 'tag
 174      (let ((rest default-load-path)
 175            (pat (concat "^"
 176                         (expand-file-name (concat ".*/" elisp-prefix) prefix)
 177                         "/?$"))
 178            dir)
 179        (while (setq dir (car rest))
 180          (if (string-match pat dir)
 181              (if (or allow-version-specific
 182                      (not (string-match (format "/%d\\.%d"
 183                                                 emacs-major-version
 184                                                 emacs-minor-version) dir))
 185                      )
 186                  (throw 'tag dir)
 187                ))
 188          (setq rest (cdr rest))
 189          )))
 190    (expand-file-name (concat
 191                       (if running-emacs-19_29-or-later
 192                           "share/"
 193                         "lib/")
 194                       (cond ((boundp 'NEMACS) "nemacs/")
 195                             ((boundp 'MULE)   "mule/")
 196                             (running-xemacs
 197                              (if (featurep 'mule)
 198                                  "xmule/"
 199                                "xemacs/"))
 200                             (t "emacs/"))
 201                       elisp-prefix) prefix)
 202    ))
 203
 204 (defvar install-default-elisp-directory
 205   (install-detect-elisp-directory))
 206
 207
 208 ;;; @ end
 209 ;;;
 210
 211 (provide 'install)
 212
 213 ;;; install.el ends here