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 &optional all)
 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     ;; List all files.
 178     (if all
 179         (directory-files
 180          directory t (concat "^\\(" initz-prefix "\\|"
 181                              initz-prefix initz-separator-string
 182                              initz-module-regexp "\\)" ext))
 183       (unless (and (not (eq dir 'misc))
 184                    (string= prefix initz-prefix))
 185         (directory-files
 186          directory t (concat "^\\(" prefix "\\|"
 187                              prefix initz-separator-string
 188                              initz-module-regexp "\\)" ext))))))
 189
 190 (defun initz-make-directory (sym)
 191   "Make SYM's directory."
 192   (mapc #'(lambda (kind)
 193             (let ((directory (expand-file-name
 194                               (initz-get-init-value sym 'dir)
 195                               (initz-directory kind))))
 196               (unless (file-directory-p directory)
 197                 (make-directory directory t))))
 198         '(startup flavor)))
 199
 200 (defun initz-make-directories ()
 201   "Make initz directories."
 202   (interactive)
 203   (mapc #'(lambda (alist)
 204             (let ((sym (car alist)))
 205               (initz-make-directory sym)))
 206         initz-init-alist))
 207
 208 (defun initz-delete-file (flavor-file)
 209   "Delete the FLAVOR-FILE when startup-file was deleted."
 210   (let ((startup-file (initz-get-correspondence-file flavor-file)))
 211     (unless (file-exists-p startup-file)
 212       (delete-file flavor-file))))
 213
 214 (defun initz-delete-files (sym)
 215   "Delete files in the SYM's directory when startup-file was deleted."
 216   (let ((flavor-files (initz-get-files 'flavor sym)))
 217     (mapc #'(lambda (flavor-file)
 218               (initz-delete-file flavor-file))
 219           flavor-files)))
 220
 221 (defun initz-delete ()
 222   "Delete the initz startup files."
 223   (interactive)
 224   (initz-make-directories)
 225   (mapc #'(lambda (alist)
 226             (let ((sym (car alist)))
 227               (initz-delete-files sym)))
 228         initz-init-alist))
 229
 230 (defun initz-compile-file (startup-file)
 231   "Compile the STARTUP-FILE."
 232   (let ((flavor-file (initz-get-correspondence-file startup-file)))
 233     (when (file-newer-than-file-p startup-file flavor-file)
 234       (condition-case nil
 235           (unless (save-window-excursion
 236                     (byte-compile-file startup-file))
 237             (error nil))
 238         (error
 239          ;; Use `initz-ignore-list' instead of `initz-ignore-list-internal'
 240          ;; purposely.
 241          (unless (member (initz-get-module-name startup-file)
 242                          initz-ignore-list)
 243            (add-to-list 'initz-compile-error-files startup-file))
 244          nil)))))
 245
 246 (defun initz-compile-files (sym)
 247   "Compile files in the SYM's directory."
 248   (let ((startup-files (initz-get-files 'startup sym))
 249         compiled-files)
 250     (mapc #'(lambda (startup-file)
 251               (initz-compile-file startup-file))
 252           startup-files)
 253     (setq compiled-files (directory-files
 254                           (initz-startup-directory sym) nil "\\.elc$"))
 255     (install-files compiled-files (initz-startup-directory sym)
 256                    (initz-flavor-directory sym) t t)))
 257
 258 (defun initz-compile ()
 259   "Compile the initz startup files."
 260   (interactive)
 261   (initz-delete)
 262   (setq initz-compile-error-files nil)
 263   (mapc #'(lambda (alist)
 264             (let ((sym (car alist)))
 265               (initz-compile-files sym)))
 266         initz-init-alist)
 267   (and initz-compile-error-files (eq initz-verbose 'errors)
 268        (initz-error)))
 269
 270 (defun initz-load-file (flavor-file &optional unload)
 271   "Load the FLAVOR-FILE."
 272   (let* ((module (initz-get-module-name flavor-file))
 273          (mesg (format (if unload
 274                            initz-unload-module-message-format
 275                          initz-load-module-message-format)
 276                        module)))
 277     (if (or (member module initz-ignore-list-internal)
 278             (and initz-load-list-internal
 279                  (not (member module initz-load-list-internal))))
 280         (initz-message (concat mesg "ignored"))
 281       (unless (and initz-interactively
 282                    (not (y-or-n-p
 283                          (format initz-load-module-ask-message-format
 284                                  module))))
 285         (initz-message mesg)
 286         (condition-case nil
 287             (let*((base-name (initz-get-base-name flavor-file))
 288                   (feature (intern base-name)))
 289               (if unload
 290                   (unload-feature feature t)
 291                 (when (memq feature features)
 292                   (unload-feature feature t))
 293                 (require feature))
 294               (initz-message (concat mesg "done")))
 295           (error (add-to-list 'initz-load-error-files
 296                               (initz-get-correspondence-file flavor-file))
 297                  (initz-message (concat mesg "failed"))
 298                  nil))))))
 299
 300 (defun initz-load-files (sym)
 301   "Load files in the SYM's directory."
 302   (let ((flavor-files (initz-get-files 'flavor sym)))
 303     (mapc #'(lambda (flavor-file)
 304               (initz-load-file flavor-file))
 305           flavor-files)))
 306
 307 (defun initz-load ()
 308   "Load the initz startup files."
 309   (interactive)
 310   (initz-compile)
 311   (setq initz-load-error-files nil)
 312   (initz-add-to-load-path (initz-directory 'flavor))
 313   ;; tricky
 314   (setq initz-load-list-internal initz-load-list)
 315   (setq initz-ignore-list-internal initz-ignore-list)
 316   (mapc #'(lambda (alist)
 317             (let ((sym (car alist)))
 318               (initz-load-files sym)))
 319         initz-init-alist)
 320   (and initz-load-error-files (eq initz-verbose 'errors)
 321        (initz-error)))
 322
 323 (defun initz-done ()
 324   "Initz done."
 325   (when initz-delete-compile-log-buffer
 326     (mapc #'(lambda (buffer)
 327               (when (string-match "^\\*Compile-Log\\*$" (buffer-name buffer))
 328                 (kill-buffer buffer)))
 329           (buffer-list)))
 330   (initz-message (format initz-done-message-format
 331                          (initz-version) initz-flavor)))
 332
 333 ;;;###autoload
 334 (defun initz-startup ()
 335   "Initz startup."
 336   (interactive)
 337   (unless noninteractive
 338     (initz-load)
 339     (initz-done)))
 340
 341 (provide 'initz)
 342
 343 ;;; initz.el ends here