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