1 ;; lisp-initd.el - rc.d inspired configuration management for
4 ;; Copyright (C) 2007, Nelson Ferreira
5 ;; Maintainer: Nelson Ferreira
7 ;; This file is part of SXEmacs
9 ;; All rights reserved.
11 ;; Redistribution and use in source and binary forms, with or without
12 ;; modification, are permitted provided that the following conditions
15 ;; Redistributions of source code must retain the above copyright
16 ;; notice, this list of conditions and the following disclaimer.
18 ;; Redistributions in binary form must reproduce the above copyright
19 ;; notice, this list of conditions and the following disclaimer in the
20 ;; documentation and/or other materials provided with the
23 ;; Neither the name of the <ORGANIZATION> nor the names of its
24 ;; contributors may be used to endorse or promote products derived
25 ;; from this software without specific prior written permission.
27 ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
28 ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
29 ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
30 ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
31 ;; COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
32 ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
33 ;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
34 ;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
35 ;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
36 ;; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
37 ;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
38 ;; OF THE POSSIBILITY OF SUCH DAMAGE.
40 ;; This file is dumped with SXEmacs
44 ;(require 'byte-optimize)
45 ;(require 'bytecomp-runtime)
47 (defvar lisp-initd-dir (file-name-as-directory
48 (expand-file-name "init.d" user-init-directory))
49 "The default directory for the init files.")
51 (defvar lisp-initd-prefix ""
52 "The default prefix for the compiled init file.")
54 (defvar lisp-initd-keep-elisp t
55 "If TRUE the initd resulting lisp file is kept.
56 Only takes effect when `lisp-initd-byte-compile-elisp' is non-nil.")
58 (defvar lisp-initd-byte-compile-elisp t
59 "If TRUE the initd lisp is byte-compiled.")
61 (defvar lisp-initd-kill-compile-log nil
62 "Kill the byte-compile Compile Log buffers")
65 (defvar lisp-initd-gather-func #'directory-files
66 "Function used to gather the files used in init. For acceptable
67 arguments see `directory-files'. The function is expected to return a
68 sorted list of absolute pathnames, accept and honor the MATCH argument
69 and return files only.")
71 (defun lisp-initd-compile (&optional dir prefix do-init)
72 "Compile the lisp files in DIR into a file named {DIR}/{PREFIX}init.d.el.
73 If DIR is nil `lisp-initd-dir' is used.
74 If PREFIX is nil `lisp-initd-prefix' is used.
75 If DO-INIT is non-nil the file is loaded."
76 (let* ((initd-dir (or dir lisp-initd-dir))
77 (initd-file (concat (or prefix lisp-initd-prefix)
79 (initd-el (expand-file-name (concat initd-file ".el")
81 (list initd-dir ".."))))
82 (initd-elc (concat initd-el "c"))
83 (initd-files (funcall lisp-initd-gather-func initd-dir
85 (init-file (if lisp-initd-byte-compile-elisp initd-elc initd-el))
88 ;; No use in keeping an outdate byte-compiled file...
89 (when (and (file-exists-p initd-el)
90 (file-exists-p initd-elc)
91 (file-newer-than-file-p initd-el initd-elc))
92 (delete-file initd-elc))
94 ;; If a file (or the directory itself) is newer than the existing
96 (when (some #'(lambda (file) (file-newer-than-file-p file init-file))
97 (cons initd-dir initd-files))
98 ;; No matter what the elc is outdated now..
99 (when (file-exists-p initd-elc) (delete-file initd-elc))
100 (when (file-exists-p initd-elc) (delete-file initd-el))
101 (message "Recompiling init files....")
102 (setq init-buffer (generate-new-buffer (concat "*" initd-el "*")))
103 (with-current-buffer init-buffer
104 (set-visited-file-name initd-el)
105 (insert ";; This is an automatically generated file.\n"
108 (insert "(message \"Compiled " initd-dir " loading started\")\n")
112 (insert "(condition-case err (progn\n"
113 ";; ------------------------------------\n"
118 (insert-file-contents current)
120 (buffer-substring))))
122 ";; ----------------------------------\n"
124 "(error (message \"Error loading " current
125 ": \\\"%S\\\" (signal:\'%S\' . data:\'%S\')\" "
126 "err (car err) (cdr err))))\n"
127 ";; ----------------------------------\n\n")
130 (insert "(message \"\\\"" current
132 (replace-regexp-in-string
134 (format (concat "due to syntax error: %S"
135 " (signal:%S . data:%S)")
136 err (car err) (cdr err)))
139 "\"%S\" not inserted due to syntax error: %S (signal:%S . data:%S)"
140 current err (car err) (cdr err))))))
142 (insert "(message \"Compiled " initd-dir " loading finished\")\n")
143 (save-buffer init-buffer)))
144 (when (and lisp-initd-byte-compile-elisp
145 (file-newer-than-file-p initd-el initd-elc))
148 (byte-compile-file initd-el)
149 (when lisp-initd-kill-compile-log
150 (kill-buffer (get-buffer "*Compile-Log*"))
151 (kill-buffer (get-buffer "*Compile-Log-Show*")))
152 (delete-other-windows)
153 (unless lisp-initd-keep-elisp
154 (delete-file initd-el)))))
155 (when (and do-init (null init-buffer))
156 (load init-file nil nil t))))
159 (defun lisp-initd-compile-and-load (&optional dir prefix)
160 "Compile and load the lisp files in DIR into a file named {DIR}/{PREFIX}init.d.el.
162 If DIR, a string, is omitted `lisp-initd-dir' is used. DIR can be
163 either a complete path, or the last element of a path. If the latter,
164 DIR is expanded against the _parent_ directory of `lisp-initd-dir'.
166 Optional prefix arg, PREFIX is a string that is prepended to the generated
167 filename to be loaded. If it is omitted, `lisp-initd-prefix' is used.
169 See `lisp-initd-compile'."
170 (interactive (list (expand-file-name (read-directory-name
171 "initd directory: " user-init-directory
174 (unless (string-match "/" dir)
175 (setq dir (file-name-as-directory
176 (expand-file-name dir (paths-construct-path
177 (list lisp-initd-dir "..")))))))
178 (when current-prefix-arg
179 (setq prefix (read-string "Prefix: ")))
181 (lisp-initd-compile dir prefix t))
183 (provide 'lisp-initd)