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                  ,(let ((args initz-null-string))
  83                     (mapc
  84                      (function (lambda (arg)
  85                                  (unless (string= args initz-null-string)
  86                                    (setq args (concat args
  87                                                       initz-separator-string)))
  88                                  (setq arg (initz-trim-separator arg))
  89                                  (setq args (concat args arg))))
  90                      (cdr command-line-args))
  91                     args)))
  92     (flavor . ("flavor" ,initz-flavor))
  93     (host . ("host" ,(system-name)))
  94     (system . ("system" ,(symbol-name system-type)))
  95     (misc . (,initz-null-string ,initz-null-string))))
  96
  97 (defun initz-get-init-value (sym type)
  98   "Return the TYPE's value of SYM from `initz-init-alist'."
  99   (let ((list (cdr (assq sym initz-init-alist)))
 100         (count 0))
 101     (unless (null list)
 102       (catch 'found
 103         (mapc
 104          (function (lambda (temp)
 105                      (if (eq type temp)
 106                          (let ((elem (nth count list)))
 107                            (when (and (eq type 'prefix)
 108                                     (not (string= elem initz-null-string)))
 109                                (setq elem (concat initz-separator-string
 110                                                   elem)))
 111                            (throw 'found elem))
 112                        (setq count (incf count)))))
 113          '(dir prefix))
 114         nil))))
 115
 116 (defun initz-directory (kind)
 117   "Return the directory of KIND."
 118   (let ((dir (cond
 119               ((eq kind 'startup) "startup")
 120               ((eq kind 'flavor) initz-flavor)
 121               (t initz-null-string))))
 122     (expand-file-name dir initz-directory)))
 123
 124 (defun initz-startup-directory (sym)
 125   "Return the startup directory of SYM."
 126   (expand-file-name
 127    (initz-get-init-value sym 'dir)
 128    (initz-directory 'startup)))
 129
 130 (defun initz-flavor-directory (sym)
 131   "Return the flavor directory of SYM."
 132   (expand-file-name
 133    (initz-get-init-value sym 'dir)
 134    (initz-directory 'flavor)))
 135
 136 (defun initz-get-kind (file)
 137   "Return the kind of FILE."
 138   (catch 'found
 139     (mapc
 140      (function (lambda (kind)
 141                  (when (string-match (initz-directory kind) file)
 142                    (throw 'found kind))))
 143      '(startup flavor))
 144     nil))
 145
 146 (defun initz-get-dir (file)
 147   "Return dir of the FILE."
 148   (let ((file (file-name-directory file))
 149         (directory (initz-directory (initz-get-kind file))))
 150     (when (string-match "/$" file)
 151       (setq file (substring file 0 (1- (length file)))))
 152     (catch 'found
 153       (if (string= file directory)
 154           (throw 'found 'misc)
 155         (when (string-match (concat directory "\\(.+\\)") file)
 156           (let ((dir (substring (match-string 1 file) 1)))
 157             (mapc
 158              (function (lambda (alist)
 159                          (when (string= (nth 0 (cdr alist)) dir)
 160                            (throw 'found (car alist)))))
 161              initz-init-alist))))
 162       nil)))
 163
 164 (defun initz-get-correspondence-file (init-file)
 165   "Return correspondence file of the INIT-FILE."
 166   (let* ((file (file-name-nondirectory init-file))
 167          (kind (if (eq (initz-get-kind init-file) 'startup)
 168                    'flavor
 169                  'startup))
 170          (directory (expand-file-name
 171                      (initz-get-init-value (initz-get-dir init-file) 'dir)
 172                      (initz-directory kind))))
 173     (expand-file-name (if (eq kind 'startup)
 174                           (substring file 0 (1- (length file)))
 175                         (concat file "c"))
 176                       directory)))
 177
 178 (defun initz-get-files (kind dir)
 179   "Return files of the directory made by KIND and DIR."
 180   (let ((directory (expand-file-name
 181                     (initz-get-init-value dir 'dir)
 182                     (initz-directory kind)))
 183         (prefix (regexp-quote
 184                  (concat initz-prefix
 185                          (initz-get-init-value dir 'prefix))))
 186         (ext (if (eq kind 'startup) "\\.el$" "\\.elc$")))
 187     (unless (and (not (eq dir 'misc))
 188                  (string= prefix initz-prefix))
 189       (directory-files
 190        directory t (concat "^\\(" prefix "\\|"
 191                            prefix initz-separator-string
 192                            initz-module-regexp "\\)" ext)))))
 193
 194 (defun initz-make-directory (sym)
 195   "Make SYM's directory."
 196   (mapc
 197    (function (lambda (kind)
 198                (let ((directory (expand-file-name
 199                                  (initz-get-init-value sym 'dir)
 200                                  (initz-directory kind))))
 201                  (unless (file-directory-p directory)
 202                    (make-directory directory t)))))
 203    '(startup flavor)))
 204
 205 (defun initz-make-directories ()
 206   "Make initz directories."
 207   (interactive)
 208   (mapc
 209    (function (lambda (alist)
 210                (let ((sym (car alist)))
 211                  (initz-make-directory sym))))
 212    initz-init-alist))
 213
 214 (defun initz-delete-file (flavor-file)
 215   "Delete the FLAVOR-FILE when startup-file was deleted."
 216   (let ((startup-file (initz-get-correspondence-file flavor-file)))
 217     (unless (file-exists-p startup-file)
 218       (delete-file flavor-file))))
 219
 220 (defun initz-delete-files (sym)
 221   "Delete files in the SYM's directory when startup-file was deleted."
 222   (let ((flavor-files (initz-get-files 'flavor sym)))
 223     (mapc
 224      (function (lambda (flavor-file)
 225                  (initz-delete-file flavor-file)))
 226      flavor-files)))
 227
 228 (defun initz-delete ()
 229   "Delete the initz startup files."
 230   (interactive)
 231   (initz-make-directories)
 232   (mapc
 233    (function (lambda (alist)
 234                (let ((sym (car alist)))
 235                  (initz-delete-files sym))))
 236    initz-init-alist))
 237
 238 (defun initz-compile-file (startup-file)
 239   "Compile the STARTUP-FILE."
 240   (let ((flavor-file (initz-get-correspondence-file startup-file)))
 241     (when (file-newer-than-file-p startup-file flavor-file)
 242       (condition-case nil
 243           (unless (save-window-excursion
 244                     (byte-compile-file startup-file))
 245             (error nil))
 246         (error
 247          ;; Use `initz-ignore-list' instead of `initz-ignore-list-internal'
 248          ;; purposely.
 249          (unless (member (initz-get-module-name startup-file)
 250                          initz-ignore-list)
 251            (add-to-list 'initz-compile-error-files startup-file))
 252          nil)))))
 253
 254 (defun initz-compile-files (sym)
 255   "Compile files in the SYM's directory."
 256   (let ((startup-files (initz-get-files 'startup sym))
 257         compiled-files)
 258     (mapc
 259      (function (lambda (startup-file)
 260                  (initz-compile-file startup-file)))
 261      startup-files)
 262     (setq compiled-files (directory-files
 263                           (initz-startup-directory sym) nil "\\.elc$"))
 264     (install-files compiled-files (initz-startup-directory sym)
 265                    (initz-flavor-directory sym) t t)))
 266
 267 (defun initz-compile ()
 268   "Compile the initz startup files."
 269   (interactive)
 270   (initz-delete)
 271   (setq initz-compile-error-files nil)
 272   (mapc
 273    (function (lambda (alist)
 274                (let ((sym (car alist)))
 275                  (initz-compile-files sym))))
 276    initz-init-alist)
 277   (and initz-compile-error-files (eq initz-verbose 'errors)
 278        (initz-error)))
 279
 280 (defun initz-load-file (flavor-file &optional unload)
 281   "Load the FLAVOR-FILE."
 282   (let* ((module (initz-get-module-name flavor-file))
 283          (mesg (format (if unload
 284                            initz-unload-module-message-format
 285                          initz-load-module-message-format)
 286                        module)))
 287     (if (or (member module initz-ignore-list-internal)
 288             (and initz-load-list-internal
 289                  (not (member module initz-load-list-internal))))
 290         (initz-message (concat mesg "ignored"))
 291       (unless (and initz-interactively
 292                    (not (y-or-n-p
 293                          (format initz-load-module-ask-message-format
 294                                  module))))
 295         (initz-message mesg)
 296         (condition-case nil
 297             (let*((base-name (initz-get-base-name flavor-file))
 298                   (feature (intern base-name)))
 299               (if unload
 300                   (unload-feature feature t)
 301                 (when (memq feature features)
 302                   (unload-feature feature t))
 303                 (require feature))
 304               (initz-message (concat mesg "done")))
 305           (error (add-to-list 'initz-load-error-files
 306                               (initz-get-correspondence-file flavor-file))
 307                  (initz-message (concat mesg "failed"))
 308                  nil))))))
 309
 310 (defun initz-load-files (sym)
 311   "Load files in the SYM's directory."
 312   (let ((flavor-files (initz-get-files 'flavor sym)))
 313     (mapc
 314      (function (lambda (flavor-file)
 315                  (initz-load-file flavor-file)))
 316      flavor-files)))
 317
 318 (defun initz-load ()
 319   "Load the initz startup files."
 320   (interactive)
 321   (initz-compile)
 322   (setq initz-load-error-files nil)
 323   (initz-add-to-load-path (initz-directory 'flavor))
 324   ;; tricky
 325   (setq initz-load-list-internal initz-load-list)
 326   (setq initz-ignore-list-internal initz-ignore-list)
 327   (mapc
 328    (function (lambda (alist)
 329                (let ((sym (car alist)))
 330                  (initz-load-files sym))))
 331    initz-init-alist)
 332   (and initz-load-error-files (eq initz-verbose 'errors)
 333        (initz-error)))
 334
 335 (defun initz-done ()
 336   "Initz done."
 337   (initz-message (format initz-done-message-format
 338                          (initz-version) initz-flavor)))
 339
 340 ;;;###autoload
 341 (defun initz-startup ()
 342   "Initz startup."
 343   (interactive)
 344   (unless noninteractive
 345     (initz-load)
 346     (initz-done)))
 347
 348 (provide 'initz)
 349
 350 ;;; initz.el ends here