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 ;; for historical reason, we do (require 'emu) in this file.
  29 ;; but you should do (require 'emu) explicitly if you use functions and/or
  30 ;; variables defined in emu module.
  31 ;;(require 'emu)
  32 (require 'path-util)                    ; default-load-path
  33
  34 (defvar emacs-major-version (string-to-int emacs-version)
  35   "Major version number of this version of Emacs.
  36 This variable first existed in version 19.23.")
  37
  38 (defvar emacs-minor-version
  39   (string-to-int
  40    (substring emacs-version
  41               (string-match (format "%d\\." emacs-major-version)
  42                             emacs-version)))
  43   "Minor version number of this version of Emacs.
  44 This variable first existed in version 19.23.")
  45
  46 ;; verbatim copy of `defun-maybe' from poe.el, and
  47 ;; `make-directory-internal' and `make-directory' from poe-18.el
  48 (defmacro defun-maybe (name &rest everything-else)
  49   "Define NAME as a function if NAME is not defined.
  50 See also the function `defun'."
  51   (or (and (fboundp name)
  52            (not (get name 'defun-maybe)))
  53       (` (or (fboundp (quote (, name)))
  54              (prog1
  55                  (defun (, name) (,@ everything-else))
  56                (put (quote (, name)) 'defun-maybe t))))))
  57
  58 (defun-maybe make-directory-internal (dirname)
  59   "Create a directory. One argument, a file name string."
  60   (let ((dir (expand-file-name dirname)))
  61     (if (file-exists-p dir)
  62         (error "Creating directory: %s is already exist" dir)
  63       (call-process "mkdir" nil nil nil dir))))
  64
  65 (defun-maybe make-directory (dir &optional parents)
  66   "Create the directory DIR and any nonexistent parent dirs.
  67 The second (optional) argument PARENTS says whether
  68 to create parent directories if they don't exist."
  69   (let ((len (length dir))
  70         (p 0) p1 path)
  71     (catch 'tag
  72       (while (and (< p len) (string-match "[^/]*/?" dir p))
  73         (setq p1 (match-end 0))
  74         (if (= p1 len)
  75             (throw 'tag nil))
  76         (setq path (substring dir 0 p1))
  77         (if (not (file-directory-p path))
  78             (cond ((file-exists-p path)
  79                    (error "Creating directory: %s is not directory" path))
  80                   ((null parents)
  81                    (error "Creating directory: %s is not exist" path))
  82                   (t
  83                    (make-directory-internal path))))
  84         (setq p p1)))
  85     (make-directory-internal dir)))
  86
  87
  88 ;;; @ compile Emacs Lisp files
  89 ;;;
  90
  91 (defun compile-elisp-module (module &optional path every-time)
  92   (setq module (expand-file-name (symbol-name module) path))
  93   (let ((el-file (concat module ".el"))
  94         (elc-file (concat module ".elc")))
  95     (if (or every-time
  96             (file-newer-than-file-p el-file elc-file))
  97         (byte-compile-file el-file))))
  98
  99 (defun compile-elisp-modules (modules &optional path every-time)
 100   (mapcar (function
 101            (lambda (module)
 102              (compile-elisp-module module path every-time)))
 103           modules))
 104
 105
 106 ;;; @ install files
 107 ;;;
 108
 109 (defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4))
 110
 111 (defun install-file (file src dest &optional move overwrite just-print)
 112   (if just-print
 113       (princ (format "%s -> %s\n" file dest))
 114     (let ((src-file (expand-file-name file src)))
 115       (if (file-exists-p src-file)
 116           (let ((full-path (expand-file-name file dest)))
 117             (if (and (file-exists-p full-path) overwrite)
 118                 (delete-file full-path))
 119             (copy-file src-file full-path t t)
 120             (if move
 121                 (catch 'tag
 122                   (while (and (file-exists-p src-file)
 123                               (file-writable-p src-file))
 124                     (condition-case err
 125                         (progn
 126                           (delete-file src-file)
 127                           (throw 'tag nil))
 128                       (error (princ (format "%s\n" (nth 1 err))))))))
 129             (princ (format "%s -> %s\n" file dest)))))))
 130
 131 (defun install-files (files src dest &optional move overwrite just-print)
 132   (or (file-exists-p dest)
 133       (make-directory dest t))
 134   (mapcar (function
 135            (lambda (file)
 136              (install-file file src dest move overwrite just-print)))
 137           files))
 138
 139
 140 ;;; @@ install Emacs Lisp files
 141 ;;;
 142
 143 (defun install-elisp-module (module src dest &optional just-print)
 144   (let (el-file elc-file)
 145     (let ((name (symbol-name module)))
 146       (setq el-file (concat name ".el"))
 147       (setq elc-file (concat name ".elc")))
 148     (let ((src-file (expand-file-name el-file src)))
 149       (if (not (file-exists-p src-file))
 150           nil
 151         (if just-print
 152             (princ (format "%s -> %s\n" el-file dest))
 153           (let ((full-path (expand-file-name el-file dest)))
 154             (if (file-exists-p full-path)
 155                 (delete-file full-path))
 156             (copy-file src-file full-path t t)
 157             (princ (format "%s -> %s\n" el-file dest)))))
 158       (setq src-file (expand-file-name elc-file src))
 159       (if (not (file-exists-p src-file))
 160           nil
 161         (if just-print
 162             (princ (format "%s -> %s\n" elc-file dest))
 163           (let ((full-path (expand-file-name elc-file dest)))
 164             (if (file-exists-p full-path)
 165                 (delete-file full-path))
 166             (copy-file src-file full-path t t)
 167             (catch 'tag
 168               (while (file-exists-p src-file)
 169                 (condition-case err
 170                     (progn
 171                       (delete-file src-file)
 172                       (throw 'tag nil))
 173                   (error (princ (format "%s\n" (nth 1 err)))))))
 174             (princ (format "%s -> %s\n" elc-file dest))))))))
 175
 176 (defun install-elisp-modules (modules src dest &optional just-print)
 177   (or (file-exists-p dest)
 178       (make-directory dest t))
 179   (mapcar (function
 180            (lambda (module)
 181              (install-elisp-module module src dest just-print)))
 182           modules))
 183
 184
 185 ;;; @ detect install path
 186 ;;;
 187
 188 ;; install to shared directory (maybe "/usr/local")
 189 (defvar install-prefix
 190   (if (or (<= emacs-major-version 18)   ; running-emacs-18
 191           (featurep 'xemacs)            ; running-xemacs
 192           (and (boundp 'system-configuration-options) ; 19.29 or later
 193                (string= system-configuration-options "NT"))) ; for Meadow
 194       (expand-file-name "../../.." exec-directory)
 195     (expand-file-name "../../../.." data-directory)))
 196
 197 (defvar install-elisp-prefix
 198   (if (>= emacs-major-version 19)
 199       "site-lisp"
 200     "local.lisp"))
 201
 202 (defun install-detect-elisp-directory (&optional prefix elisp-prefix
 203                                                  allow-version-specific)
 204   (or prefix
 205       (setq prefix install-prefix))
 206   (or elisp-prefix
 207       (setq elisp-prefix install-elisp-prefix))
 208   (or
 209    (catch 'tag
 210      (let ((rest default-load-path)
 211            (pat (concat "^"
 212                         (expand-file-name (concat ".*/" elisp-prefix) prefix)
 213                         "/?$")))
 214        (while rest
 215          (if (string-match pat (car rest))
 216              (if (or allow-version-specific
 217                      (not (string-match (format "/%d\\.%d"
 218                                                 emacs-major-version
 219                                                 emacs-minor-version)
 220                                         (car rest))))
 221                  (throw 'tag (car rest))))
 222          (setq rest (cdr rest)))))
 223    (expand-file-name (concat
 224                       (if (and          ; running-emacs-19_29-or-later
 225                            (not (featurep 'xemacs))
 226                            (or (>= emacs-major-version 20)
 227                                (and (= emacs-major-version 19)
 228                                     (>= emacs-minor-version 29))))
 229                           "share/"
 230                         "lib/")
 231                       (cond ((boundp 'NEMACS) "nemacs/")
 232                             ((boundp 'MULE)   "mule/")
 233                             ((featurep 'xemacs) ; running-xemacs
 234                              (if (featurep 'mule)
 235                                  "xmule/"
 236                                "xemacs/"))
 237                             (t "emacs/"))
 238                       elisp-prefix)
 239                      prefix)))
 240
 241 (defvar install-default-elisp-directory
 242   (install-detect-elisp-directory))
 243
 244
 245 ;;; @ end
 246 ;;;
 247
 248 (provide 'install)
 249
 250 ;;; install.el ends here