lisp/initz.el

   1 ;;; initz.el --- Handles the switching of various startup initialization files
   2
   3 ;; Copyright (C) 2001-2002 OHASHI Akira <bg66@koka-in.org>
   4
   5 ;; Author: OHASHI Akira <bg66@koka-in.org>
   6 ;; Keywords: startup, init
   7
   8 ;; This file is part of Initz.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25
  26 ;;; Commentary:
  27 ;;
  28
  29 ;;; Code:
  30
  31 (require 'install)
  32 (require 'product)
  33 (require 'initz-vars)
  34 (require 'initz-globals)
  35 (require 'initz-util)
  36 (eval-when-compile (require 'cl))
  37 (eval-and-compile
  38   (autoload 'initz-error "initz-error" nil t)
  39   (autoload 'initz-list "initz-list" nil t)
  40   (autoload 'initz-list-new-file "initz-list" nil t))
  41
  42 (product-provide 'initz
  43   (product-define "Initz" nil '(0 0 11)))
  44
  45 (defun initz-version (&optional arg)
  46   "Return Initz version.
  47 If it is called interactively, version string is appeared on minibuffer.
  48 If ARG is specified, don't display code name."
  49   (interactive "P")
  50   (let ((product-info (product-string-1 'initz (not arg))))
  51     (if (interactive-p)
  52         (message "%s" product-info)
  53       product-info)))
  54
  55 (defconst initz-done-message-format
  56   "Loading %s init files for %s...done")
  57
  58 (defun initz-message (mesg)
  59   "If `initz-verbose' is non-nil, print MESG."
  60   (when initz-verbose (message mesg)))
  61
  62 (defmacro initz-message-no-log (string &rest args)
  63   "Like `message', except that message logging is disabled."
  64   (if (featurep 'xemacs)
  65       (if args
  66           `(display-message 'no-log (format ,string ,@args))
  67         `(display-message 'no-log ,string))
  68     `(let (message-log-max)
  69        (message ,string ,@args))))
  70
  71 (defun initz-trim-separator (string)
  72   "Trim `initz-separator-string' from STRING."
  73   (let ((temp string))
  74     (when (string-match (concat "^" initz-separator-string "+") temp)
  75       (setq temp (substring temp (match-end 0))))
  76     (when (string-match (concat initz-separator-string "+$") temp)
  77       (setq temp (substring temp 0 (match-beginning 0))))
  78     temp))
  79
  80 (defconst initz-init-alist
  81   `((argument . ("argument"
  82                  ,(mapconcat #'(lambda (arg)
  83                                  (initz-trim-separator arg))
  84                              (cdr command-line-args)
  85                              initz-separator-string)))
  86     ( flavor . ("flavor" ,initz-flavor))
  87     (host . ("host" ,(system-name)))
  88     (system . ("system" ,(symbol-name system-type)))
  89     (misc . (,initz-null-string ,initz-null-string))))
  90
  91 (defun initz-get-init-value (sym type)
  92   "Return the TYPE's value of SYM from `initz-init-alist'."
  93   (let ((list (cdr (assq sym initz-init-alist)))
  94         (count 0))
  95     (unless (null list)
  96       (catch 'found
  97         (mapc #'(lambda (temp)
  98                   (if (eq type temp)
  99                       (let ((elem (nth count list)))
 100                         (when (and (eq type 'prefix)
 101                                    (not (string= elem initz-null-string)))
 102                           (setq elem (concat initz-separator-string elem)))
 103                         (throw 'found elem))
 104                     (setq count (incf count))))
 105          '(dir prefix))
 106         nil))))
 107
 108 (defun initz-directory (kind)
 109   "Return the directory of KIND."
 110   (let ((dir (cond
 111               ((eq kind 'startup) "startup")
 112               ((eq kind 'flavor) initz-flavor)
 113               (t initz-null-string))))
 114     (expand-file-name dir initz-directory)))
 115
 116 (defun initz-startup-directory (sym)
 117   "Return the startup directory of SYM."
 118   (expand-file-name
 119    (initz-get-init-value sym 'dir)
 120    (initz-directory 'startup)))
 121
 122 (defun initz-flavor-directory (sym)
 123   "Return the flavor directory of SYM."
 124   (expand-file-name
 125    (initz-get-init-value sym 'dir)
 126    (initz-directory 'flavor)))
 127
 128 (defun initz-get-kind (file)
 129   "Return the kind of FILE."
 130   (catch 'found
 131     (mapc #'(lambda (kind)
 132               (when (string-match (initz-directory kind) file)
 133                 (throw 'found kind)))
 134           '(startup flavor))
 135     nil))
 136
 137 (defun initz-get-dir (file)
 138   "Return dir of the FILE."
 139   (let ((file (file-name-directory file))
 140         (directory (initz-directory (initz-get-kind file))))
 141     (when (string-match "/$" file)
 142       (setq file (substring file 0 (1- (length file)))))
 143     (catch 'found
 144       (if (string= file directory)
 145           (throw 'found 'misc)
 146         (when (string-match (concat directory "\\(.+\\)") file)
 147           (let ((dir (substring (match-string 1 file) 1)))
 148             (mapc #'(lambda (alist)
 149                       (when (string= (nth 0 (cdr alist)) dir)
 150                         (throw 'found (car alist))))
 151                   initz-init-alist))))
 152       nil)))
 153
 154 (defun initz-get-correspondence-file (init-file)
 155   "Return correspondence file of the INIT-FILE."
 156   (let* ((file (file-name-nondirectory init-file))
 157          (kind (if (eq (initz-get-kind init-file) 'startup)
 158                    'flavor
 159                  'startup))
 160          (directory (expand-file-name
 161                      (initz-get-init-value (initz-get-dir init-file) 'dir)
 162                      (initz-directory kind))))
 163     (expand-file-name (if (eq kind 'startup)
 164                           (substring file 0 (1- (length file)))
 165                         (concat file "c"))
 166                       directory)))
 167
 168 (defun initz-get-files (kind dir)
 169   "Return files of the directory made by KIND and DIR."
 170   (let ((directory (expand-file-name
 171                     (initz-get-init-value dir 'dir)
 172                     (initz-directory kind)))
 173         (prefix (regexp-quote
 174                  (concat initz-prefix
 175                          (initz-get-init-value dir 'prefix))))
 176         (ext (if (eq kind 'startup) "\\.el$" "\\.elc$")))
 177     (unless (and (not (eq dir 'misc))
 178                  (string= prefix initz-prefix))
 179       (directory-files
 180        directory t (concat "^\\(" prefix "\\|"
 181                            prefix initz-separator-string
 182                            initz-module-regexp "\\)" ext)))))
 183
 184 (defun initz-make-directory (sym)
 185   "Make SYM's directory."
 186   (mapc #'(lambda (kind)
 187             (let ((directory (expand-file-name
 188                               (initz-get-init-value sym 'dir)
 189                               (initz-directory kind))))
 190               (unless (file-directory-p directory)
 191                 (make-directory directory t))))
 192         '(startup flavor)))
 193
 194 (defun initz-make-directories ()
 195   "Make initz directories."
 196   (interactive)
 197   (mapc #'(lambda (alist)
 198             (let ((sym (car alist)))
 199               (initz-make-directory sym)))
 200         initz-init-alist))
 201
 202 (defun initz-delete-file (flavor-file)
 203   "Delete the FLAVOR-FILE when startup-file was deleted."
 204   (let ((startup-file (initz-get-correspondence-file flavor-file)))
 205     (unless (file-exists-p startup-file)
 206       (delete-file flavor-file))))
 207
 208 (defun initz-delete-files (sym)
 209   "Delete files in the SYM's directory when startup-file was deleted."
 210   (let ((flavor-files (initz-get-files 'flavor sym)))
 211     (mapc #'(lambda (flavor-file)
 212               (initz-delete-file flavor-file))
 213           flavor-files)))
 214
 215 (defun initz-delete ()
 216   "Delete the initz startup files."
 217   (interactive)
 218   (initz-make-directories)
 219   (mapc #'(lambda (alist)
 220             (let ((sym (car alist)))
 221               (initz-delete-files sym)))
 222         initz-init-alist))
 223
 224 (defun initz-compile-file (startup-file)
 225   "Compile the STARTUP-FILE."
 226   (let ((flavor-file (initz-get-correspondence-file startup-file)))
 227     (when (file-newer-than-file-p startup-file flavor-file)
 228       (condition-case nil
 229           (unless (save-window-excursion
 230                     (byte-compile-file startup-file))
 231             (error nil))
 232         (error
 233          ;; Use `initz-ignore-list' instead of `initz-ignore-list-internal'
 234          ;; purposely.
 235          (unless (member (initz-get-module-name startup-file)
 236                          initz-ignore-list)
 237            (add-to-list 'initz-compile-error-files startup-file))
 238          nil)))))
 239
 240 (defun initz-compile-files (sym)
 241   "Compile files in the SYM's directory."
 242   (let ((startup-files (initz-get-files 'startup sym))
 243         compiled-files)
 244     (mapc #'(lambda (startup-file)
 245               (initz-compile-file startup-file))
 246           startup-files)
 247     (setq compiled-files (directory-files
 248                           (initz-startup-directory sym) nil "\\.elc$"))
 249     (install-files compiled-files (initz-startup-directory sym)
 250                    (initz-flavor-directory sym) t t)))
 251
 252 (defun initz-compile ()
 253   "Compile the initz startup files."
 254   (interactive)
 255   (initz-delete)
 256   (setq initz-compile-error-files nil)
 257   (mapc #'(lambda (alist)
 258             (let ((sym (car alist)))
 259               (initz-compile-files sym)))
 260         initz-init-alist)
 261   (and initz-compile-error-files (eq initz-verbose 'errors)
 262        (initz-error)))
 263
 264 (defun initz-load-file (flavor-file &optional unload)
 265   "Load the FLAVOR-FILE."
 266   (let* ((module (initz-get-module-name flavor-file))
 267          (mesg (format (if unload
 268                            initz-unload-module-message-format
 269                          initz-load-module-message-format)
 270                        module)))
 271     (if (or (member module initz-ignore-list-internal)
 272             (and initz-load-list-internal
 273                  (not (member module initz-load-list-internal))))
 274         (initz-message (concat mesg "ignored"))
 275       (unless (and initz-interactively
 276                    (not (y-or-n-p
 277                          (format initz-load-module-ask-message-format
 278                                  module))))
 279         (initz-message mesg)
 280         (condition-case nil
 281             (let*((base-name (initz-get-base-name flavor-file))
 282                   (feature (intern base-name)))
 283               (if unload
 284                   (unload-feature feature t)
 285                 (when (memq feature features)
 286                   (unload-feature feature t))
 287                 (require feature))
 288               (initz-message (concat mesg "done")))
 289           (error (add-to-list 'initz-load-error-files
 290                               (initz-get-correspondence-file flavor-file))
 291                  (initz-message (concat mesg "failed"))
 292                  nil))))))
 293
 294 (defun initz-load-files (sym)
 295   "Load files in the SYM's directory."
 296   (let ((flavor-files (initz-get-files 'flavor sym)))
 297     (mapc #'(lambda (flavor-file)
 298               (initz-load-file flavor-file))
 299           flavor-files)))
 300
 301 (defun initz-load ()
 302   "Load the initz startup files."
 303   (interactive)
 304   (initz-compile)
 305   (setq initz-load-error-files nil)
 306   (initz-add-to-load-path (initz-directory 'flavor))
 307   ;; tricky
 308   (setq initz-load-list-internal initz-load-list)
 309   (setq initz-ignore-list-internal initz-ignore-list)
 310   (mapc #'(lambda (alist)
 311             (let ((sym (car alist)))
 312               (initz-load-files sym)))
 313         initz-init-alist)
 314   (and initz-load-error-files (eq initz-verbose 'errors)
 315        (initz-error)))
 316
 317 (defun initz-done ()
 318   "Initz done."
 319   (when initz-delete-compile-log-buffer
 320     (mapc #'(lambda (buffer)
 321               (when (string-match "^\\*Compile-Log\\*$" (buffer-name buffer))
 322                 (kill-buffer buffer)))
 323           (buffer-list)))
 324   (initz-message (format initz-done-message-format
 325                          (initz-version) initz-flavor)))
 326
 327 ;;;###autoload
 328 (defun initz-startup ()
 329   "Initz startup."
 330   (interactive)
 331   (unless noninteractive
 332     (initz-load)
 333     (initz-done)))
 334
 335 (provide 'initz)
 336
 337 ;;; initz.el ends here