install.el

   1 ;;; install.el --- Emacs Lisp package install utility
   2
   3 ;; Copyright (C) 1996,1997,1998,1999,2001 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., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, 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
  45    (function
  46     (lambda (module)
  47       (compile-elisp-module module path every-time)))
  48    modules))
  49
  50
  51 ;;; @ install files
  52 ;;;
  53
  54 (defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4)) ; 0644
  55
  56 (defun install-file (file src dest &optional move overwrite just-print)
  57   (if just-print
  58       (princ (format "%s -> %s\n" file dest))
  59     (let ((src-file (expand-file-name file src)))
  60       (if (file-exists-p src-file)
  61           (let ((full-path (expand-file-name file dest)))
  62             (if (and (file-exists-p full-path) overwrite)
  63                 (delete-file full-path))
  64             (copy-file src-file full-path t t)
  65             (set-file-modes full-path install-overwritten-file-modes)
  66             (if move
  67                 (catch 'tag
  68                   (while (and (file-exists-p src-file)
  69                               (file-writable-p src-file))
  70                     (condition-case err
  71                         (progn
  72                           (delete-file src-file)
  73                           (throw 'tag nil))
  74                       (error (princ (format "%s\n" (nth 1 err))))))))
  75             (princ (format "%s -> %s\n" file dest)))))))
  76
  77 (defun install-files (files src dest &optional move overwrite just-print)
  78   (or just-print
  79       (file-exists-p dest)
  80       (make-directory dest t))
  81   (mapcar
  82    (function
  83     (lambda (file)
  84       (install-file file src dest move overwrite just-print)))
  85    files))
  86
  87
  88 ;;; @@ install Emacs Lisp files
  89 ;;;
  90
  91 (defun install-elisp-module (module src dest &optional just-print del-elc)
  92   (let (el-file elc-file)
  93     (let ((name (symbol-name module)))
  94       (setq el-file (concat name ".el"))
  95       (setq elc-file (concat name ".elc")))
  96     (let ((src-file (expand-file-name el-file src)))
  97       (if (not (file-exists-p src-file))
  98           nil
  99         (if just-print
 100             (princ (format "%s -> %s\n" el-file dest))
 101           (let ((full-path (expand-file-name el-file dest)))
 102             (if (file-exists-p full-path)
 103                 (delete-file full-path))
 104             (copy-file src-file full-path t t)
 105             (set-file-modes full-path install-overwritten-file-modes)
 106             (princ (format "%s -> %s\n" el-file dest)))))
 107       (setq src-file (expand-file-name elc-file src))
 108       (if (not (file-exists-p src-file))
 109           (let ((full-path (expand-file-name elc-file dest)))
 110             (if (and del-elc (file-exists-p full-path))
 111                 (if just-print
 112                     (princ (format "%s -> to be deleted\n" full-path))
 113                   (delete-file full-path)
 114                   (princ (format "%s -> deleted\n" full-path)))))
 115         (if just-print
 116             (princ (format "%s -> %s\n" elc-file dest))
 117           (let ((full-path (expand-file-name elc-file dest)))
 118             (if (file-exists-p full-path)
 119                 (delete-file full-path))
 120             (copy-file src-file full-path t t)
 121             (set-file-modes full-path install-overwritten-file-modes)
 122             (catch 'tag
 123               (while (file-exists-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" elc-file dest))))))))
 130
 131 (defun install-elisp-modules (modules src dest &optional just-print del-elc)
 132   (or just-print
 133       (file-exists-p dest)
 134       (make-directory dest t))
 135   (mapcar
 136    (function
 137     (lambda (module)
 138       (install-elisp-module module src dest just-print del-elc)))
 139    modules))
 140
 141
 142 ;;; @ detect install path
 143 ;;;
 144
 145 ;; install to shared directory (maybe "/usr/local")
 146 (defvar install-prefix
 147   (if (or (<= emacs-major-version 18)
 148           (featurep 'xemacs)
 149           (featurep 'meadow) ; for Meadow
 150           (and (eq system-type 'windows-nt) ; for NTEmacs
 151                (>= emacs-major-version 20)))
 152       (expand-file-name "../../.." exec-directory)
 153     (expand-file-name "../../../.." data-directory)))
 154
 155 (defvar install-elisp-prefix
 156   (if (>= emacs-major-version 19)
 157       "site-lisp"
 158     ;; v18 does not have standard site directory.
 159     "local.lisp"))
 160
 161 ;; Avoid compile warning.
 162 (eval-when-compile (autoload 'replace-in-string "subr"))
 163
 164 (defun install-detect-elisp-directory (&optional prefix elisp-prefix
 165                                                  allow-version-specific)
 166   (or prefix
 167       (setq prefix install-prefix))
 168   (or elisp-prefix
 169       (setq elisp-prefix install-elisp-prefix))
 170   (or (catch 'tag
 171         (let ((rest (delq nil (copy-sequence default-load-path)))
 172               (regexp
 173                (concat "^"
 174                        (regexp-quote (if (featurep 'xemacs)
 175                                          ;; Handle backslashes (Windows)
 176                                          (replace-in-string
 177                                           (file-name-as-directory
 178                                            (expand-file-name prefix))
 179                                           "\\\\" "/")
 180                                        (file-name-as-directory
 181                                         (expand-file-name prefix))))
 182                        ".*/"
 183                        (regexp-quote
 184                         (if (featurep 'xemacs)
 185                             ;; Handle backslashes (Windows)
 186                             (replace-in-string elisp-prefix "\\\\" "/")
 187                           elisp-prefix))
 188                        "/?$"))
 189               dir)
 190           (while rest
 191             (setq dir (if (featurep 'xemacs)
 192                           ;; Handle backslashes (Windows)
 193                           (replace-in-string (car rest) "\\\\" "/")
 194                         (car rest)))
 195             (if (string-match regexp dir)
 196                 (if (or allow-version-specific
 197                         (not (string-match (format "/%d\\.%d"
 198                                                    emacs-major-version
 199                                                    emacs-minor-version)
 200                                            dir)))
 201                     (throw 'tag (car rest))))
 202             (setq rest (cdr rest)))))
 203       (expand-file-name (concat (if (and (not (featurep 'xemacs))
 204                                          (or (>= emacs-major-version 20)
 205                                              (and (= emacs-major-version 19)
 206                                                   (> emacs-minor-version 28))))
 207                                     "share/"
 208                                   "lib/")
 209                                 (cond
 210                                  ((featurep 'xemacs)
 211                                   (if (featurep 'mule)
 212                                       "xmule/"
 213                                     "xemacs/"))
 214                                  ;; unfortunately, unofficial mule based on
 215                                  ;; 19.29 and later use "emacs/" by default.
 216                                  ((boundp 'MULE) "mule/")
 217                                  ((boundp 'NEMACS) "nemacs/")
 218                                  (t "emacs/"))
 219                                 elisp-prefix)
 220                         prefix)))
 221
 222 (defvar install-default-elisp-directory
 223   (install-detect-elisp-directory))
 224
 225
 226 ;;; @ for XEmacs package system
 227 ;;;
 228
 229 (defun install-update-package-files (package dir &optional just-print)
 230   (cond
 231    (just-print
 232     (princ (format "Updating autoloads in directory %s..\n\n" dir))
 233
 234     (princ (format "Processing %s\n" dir))
 235     (princ "Generating custom-load.el...\n\n")
 236
 237     (princ (format "Compiling %s...\n"
 238                    (expand-file-name "auto-autoloads.el" dir)))
 239     (princ (format "Wrote %s\n"
 240                    (expand-file-name "auto-autoloads.elc" dir)))
 241
 242     (princ (format "Compiling %s...\n"
 243                    (expand-file-name "custom-load.el" dir)))
 244     (princ (format "Wrote %s\n"
 245                    (expand-file-name "custom-load.elc" dir))))
 246    (t
 247     (if (fboundp 'batch-update-directory-autoloads)
 248         ;; XEmacs 21.5.19 and newer.
 249         (let ((command-line-args-left (list package dir)))
 250           (batch-update-directory-autoloads))
 251       (setq autoload-package-name package)
 252       (let ((command-line-args-left (list dir)))
 253         (batch-update-directory)))
 254
 255     (let ((command-line-args-left (list dir)))
 256       (Custom-make-dependencies))
 257
 258     (byte-compile-file (expand-file-name "auto-autoloads.el" dir))
 259     (byte-compile-file (expand-file-name "custom-load.el" dir)))))
 260
 261
 262 ;;; @ Other Utilities
 263 ;;;
 264
 265 (defun install-just-print-p ()
 266   (let ((flag (getenv "MAKEFLAGS"))
 267         (case-fold-search nil))
 268     (princ (format "%s\n" flag))
 269     (if flag
 270         (string-match "^\\(\\(--[^ ]+ \\)+-\\|[^ =-]\\)*n" flag))))
 271
 272
 273 ;;; @ end
 274 ;;;
 275
 276 (require 'product)
 277 (product-provide (provide 'install) (require 'apel-ver))
 278
 279 ;;; install.el ends here