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 'poe)                          ; make-directory (for v18)
  29 (require 'path-util)                    ; default-load-path
  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     (if (or every-time
  40             (file-newer-than-file-p el-file elc-file))
  41         (byte-compile-file el-file))))
  42
  43 (defun compile-elisp-modules (modules &optional path every-time)
  44   (mapcar (function
  45            (lambda (module)
  46              (compile-elisp-module module path every-time)))
  47           modules))
  48
  49
  50 ;;; @ install files
  51 ;;;
  52
  53 (defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4))
  54
  55 (defun install-file (file src dest &optional move overwrite just-print)
  56   (if just-print
  57       (princ (format "%s -> %s\n" file dest))
  58     (let ((src-file (expand-file-name file src)))
  59       (if (file-exists-p src-file)
  60           (let ((full-path (expand-file-name file dest)))
  61             (if (and (file-exists-p full-path) overwrite)
  62                 (delete-file full-path))
  63             (copy-file src-file full-path t t)
  64             (if move
  65                 (catch 'tag
  66                   (while (and (file-exists-p src-file)
  67                               (file-writable-p src-file))
  68                     (condition-case err
  69                         (progn
  70                           (delete-file src-file)
  71                           (throw 'tag nil))
  72                       (error (princ (format "%s\n" (nth 1 err))))))))
  73             (princ (format "%s -> %s\n" file dest)))))))
  74
  75 (defun install-files (files src dest &optional move overwrite just-print)
  76   (or (file-exists-p dest)
  77       (make-directory dest t))
  78   (mapcar (function
  79            (lambda (file)
  80              (install-file file src dest move overwrite just-print)))
  81           files))
  82
  83
  84 ;;; @@ install Emacs Lisp files
  85 ;;;
  86
  87 (defun install-elisp-module (module src dest &optional just-print)
  88   (let (el-file elc-file)
  89     (let ((name (symbol-name module)))
  90       (setq el-file (concat name ".el"))
  91       (setq elc-file (concat name ".elc")))
  92     (let ((src-file (expand-file-name el-file src)))
  93       (if (not (file-exists-p src-file))
  94           nil
  95         (if just-print
  96             (princ (format "%s -> %s\n" el-file dest))
  97           (let ((full-path (expand-file-name el-file dest)))
  98             (if (file-exists-p full-path)
  99                 (delete-file full-path))
 100             (copy-file src-file full-path t t)
 101             (princ (format "%s -> %s\n" el-file dest)))))
 102       (setq src-file (expand-file-name elc-file src))
 103       (if (not (file-exists-p src-file))
 104           nil
 105         (if just-print
 106             (princ (format "%s -> %s\n" elc-file dest))
 107           (let ((full-path (expand-file-name elc-file dest)))
 108             (if (file-exists-p full-path)
 109                 (delete-file full-path))
 110             (copy-file src-file full-path t t)
 111             (catch 'tag
 112               (while (file-exists-p src-file)
 113                 (condition-case err
 114                     (progn
 115                       (delete-file src-file)
 116                       (throw 'tag nil))
 117                   (error (princ (format "%s\n" (nth 1 err)))))))
 118             (princ (format "%s -> %s\n" elc-file dest))))))))
 119
 120 (defun install-elisp-modules (modules src dest &optional just-print)
 121   (or (file-exists-p dest)
 122       (make-directory dest t))
 123   (mapcar (function
 124            (lambda (module)
 125              (install-elisp-module module src dest just-print)))
 126           modules))
 127
 128
 129 ;;; @ detect install path
 130 ;;;
 131
 132 ;; install to shared directory (maybe "/usr/local")
 133 (defvar install-prefix
 134   (if (or (<= emacs-major-version 18)   ; running-emacs-18
 135           (featurep 'xemacs)            ; running-xemacs
 136           (and (boundp 'system-configuration-options) ; 19.29 or later
 137                (string= system-configuration-options "NT"))) ; for Meadow
 138       (expand-file-name "../../.." exec-directory)
 139     (expand-file-name "../../../.." data-directory)))
 140
 141 (defvar install-elisp-prefix
 142   (if (>= emacs-major-version 19)
 143       "site-lisp"
 144     "local.lisp"))
 145
 146 (defun install-detect-elisp-directory (&optional prefix elisp-prefix
 147                                                  allow-version-specific)
 148   (or prefix
 149       (setq prefix install-prefix))
 150   (or elisp-prefix
 151       (setq elisp-prefix install-elisp-prefix))
 152   (or
 153    (catch 'tag
 154      (let ((rest default-load-path)
 155            (pat (concat "^"
 156                         (expand-file-name (concat ".*/" elisp-prefix) prefix)
 157                         "/?$")))
 158        (while rest
 159          (if (string-match pat (car rest))
 160              (if (or allow-version-specific
 161                      (not (string-match (format "/%d\\.%d"
 162                                                 emacs-major-version
 163                                                 emacs-minor-version)
 164                                         (car rest))))
 165                  (throw 'tag (car rest))))
 166          (setq rest (cdr rest)))))
 167    (expand-file-name (concat
 168                       (if (and          ; running-emacs-19_29-or-later
 169                            (not (featurep 'xemacs))
 170                            (or (>= emacs-major-version 20)
 171                                (and (= emacs-major-version 19)
 172                                     (>= emacs-minor-version 29))))
 173                           "share/"
 174                         "lib/")
 175                       (cond ((boundp 'NEMACS) "nemacs/")
 176                             ((boundp 'MULE)   "mule/")
 177                             ((featurep 'xemacs) ; running-xemacs
 178                              (if (featurep 'mule)
 179                                  "xmule/"
 180                                "xemacs/"))
 181                             (t "emacs/"))
 182                       elisp-prefix)
 183                      prefix)))
 184
 185 (defvar install-default-elisp-directory
 186   (install-detect-elisp-directory))
 187
 188
 189 ;;; @ end
 190 ;;;
 191
 192 (provide 'install)
 193
 194 ;;; install.el ends here