Rename elinstall-link-on-emacs-start -> elinstall-arrange-preload
[elinstall.git] / elinstall.el
blob59635a42dbded6057a06ce9a44d4e72cf1c5e889
1 ;;;_ elinstall.el --- Automatically and flexibly install elisp files
3 ;;;_. Headers
4 ;;;_ , License
5 ;; Copyright (C) 2010 Tom Breton (Tehom)
7 ;; Author: Tom Breton (Tehom) <tehom@panix.com>
8 ;; Keywords: maint, tools, internal
10 ;; This file 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.
15 ;; This file 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.
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
22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
25 ;;;_ , Commentary:
27 ;; Entry points:
28 ;; elinstall Use this for overall loading
30 ;; elinstall-arrange-preload - Use this for non-autogenerated
31 ;; files that need to be linked in.
33 ;; elinstall-update-directory-autoloads
34 ;; elinstall-update-file-autoloads
36 ;;;_ , Requires
38 (require 'autoload)
39 (require 'pp)
40 (require 'cus-edit) ;;Because we save "installedness" manually
43 ;;;_. Body
44 ;;;_ , Customizations
45 (defgroup elinstall
46 '()
47 "Customizations for elinstall"
48 :group 'elinstall)
50 (defcustom elinstall-default-priority
52 "Default priority for site-start"
53 :group 'elinstall
54 :type 'integer)
56 (defcustom elinstall-default-preload-target
57 "~/.emacs.d/site-start.d/"
58 "Default preload-target for registering autoloads"
59 :group 'elinstall
60 :type
61 '(choice
62 (const "~/.emacs.d/site-start.d/")
63 (const "/etc/emacs/site-start.d/")
64 (directory "" )
65 (const 'dot-emacs)))
68 (defcustom elinstall-already-installed
69 '()
70 "Things that have already been installed.
71 This exists for recording what has been installed. User interaction is not
72 contemplated at this time." )
74 ;;;_ , Data
75 ;;;_ . Regular expressions
76 ;;;_ , elinstall-elisp-regexp
77 (defconst elinstall-elisp-regexp
78 (let ((tmp nil))
79 (dolist
80 (suf (get-load-suffixes))
81 (unless (string-match "\\.elc" suf) (push suf tmp)))
82 (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))
83 "Regular expression that matches elisp files" )
85 ;;;_ , Utilities
86 ;;;_ . elinstall-directory-true-name
87 (defun elinstall-directory-true-name ()
88 "Get the true name of the directory the calling code lives in.
89 CAUTION: This is sensitive to where it's called. That's the point of it."
90 (file-name-directory
91 (if load-file-name
92 (file-truename load-file-name)
93 (file-truename buffer-file-name))))
94 ;;;_ . Checking installedness
95 ;;;_ , elinstall-already-installed
96 (defun elinstall-already-installed (project-name)
97 "Return non-nil if PROJECT-NAME has been installed."
98 (member project-name elinstall-already-installed))
100 ;;;_ , elinstall-record-installed
101 (defun elinstall-record-installed (project-name)
102 "Record that PROJECT-NAME has been installed."
104 (add-to-list 'elinstall-already-installed project-name)
105 (customize-save-variable
106 'elinstall-already-installed
107 elinstall-already-installed
108 "Set by elinstall-record-installed"))
109 ;;;_ , Work
110 ;;;_ . Doing actions
112 ;;;_ , Doing autoload actions (All adapted from autoload.el)
113 ;;;_ . Utilities about the action list
114 ;;;_ , elinstall-remove-autogen-action
115 (defun elinstall-remove-autogen-action (file actions)
116 "Return ACTIONS minus any add-file-autoloads on FILE removed."
118 (delq nil
119 (mapcar
120 #'(lambda (act)
121 (case (car act)
122 (add-file-autoloads
123 (if (equal file (third act))
125 act))
126 (t act)))
127 actions)))
128 ;;;_ , elinstall-get-autogen-action
129 (defun elinstall-get-autogen-action (file actions)
131 (let
132 ((the-act))
133 (dolist (act actions)
134 (case (car act)
135 (add-file-autoloads
136 (when (equal file (third act))
137 (setq the-act act)))))
138 the-act))
140 ;;;_ . Making autoloads
141 ;;;_ , elinstall-generate-file-autoloads
142 ;;override to allow slashed load-paths
143 ;;Quick and dirty: We just adapt `generate-file-autoloads' and add
144 ;;a new arg.
145 ;;`relative-to' can be:
146 ;; * nil: act as at present. Assume that FILE's immediate directory
147 ;;is in load-path.
148 ;; * t :: use default-directory
149 ;; * a string :: relative to it, as a filename
151 (defun elinstall-generate-file-autoloads (relative-name full-name)
152 "Insert at point a loaddefs autoload section for FILE.
153 Autoloads are generated for defuns and defmacros in FILE
154 marked by `generate-autoload-cookie' (which see).
155 If FILE is being visited in a buffer, the contents of the buffer
156 are used.
157 Return non-nil in the case where no autoloads were added at point.
159 FULL-NAME is the absolute name of the file.
160 RELATIVE-NAME is its name respective to some component of load-path."
161 (let* ((outbuf (current-buffer))
162 (autoloads-done '())
163 (print-length nil)
164 (print-readably t) ; This does something in Lucid Emacs.
165 (float-output-format nil)
166 (done-any nil)
167 (visited (get-file-buffer full-name))
168 (source-buf
169 (or visited
170 ;; It is faster to avoid visiting the file.
171 (ignore-errors (autoload-find-file full-name))))
172 output-start)
173 (if source-buf
174 (with-current-buffer source-buf
175 ;;$$MOVE ME - this should be checked in action-finding.
176 ;; Obey the no-update-autoloads file local variable.
177 (unless no-update-autoloads
178 (message "Generating autoloads for %s..." relative-name)
179 (setq output-start (with-current-buffer outbuf (point)))
180 (save-excursion
181 (save-restriction
182 (widen)
183 (goto-char (point-min))
184 (while (not (eobp))
185 (skip-chars-forward " \t\n\f")
186 (cond
187 ((looking-at (regexp-quote generate-autoload-cookie))
188 (search-forward generate-autoload-cookie)
189 (skip-chars-forward " \t")
190 (setq done-any t)
191 (if (eolp)
192 ;; Read the next form and make an autoload.
193 (let* ((form (prog1 (read (current-buffer))
194 (or (bolp) (forward-line 1))))
195 (autoload (make-autoload form load-name)))
196 (if autoload
197 (push (nth 1 form) autoloads-done)
198 (setq autoload form))
199 (let ((autoload-print-form-outbuf outbuf))
200 (autoload-print-form autoload)))
202 ;; Copy the rest of the line to the output.
203 (princ (buffer-substring
204 (progn
205 ;; Back up over whitespace, to preserve it.
206 (skip-chars-backward " \f\t")
207 (if (= (char-after (1+ (point))) ? )
208 ;; Eat one space.
209 (forward-char 1))
210 (point))
211 (progn (forward-line 1) (point)))
212 outbuf)))
213 ((looking-at ";")
214 ;; Don't read the comment.
215 (forward-line 1))
217 (forward-sexp 1)
218 (forward-line 1))))))
220 (when done-any
221 (with-current-buffer outbuf
222 (save-excursion
223 ;; Insert the section-header line which lists the file name
224 ;; and which functions are in it, etc.
225 (goto-char output-start)
226 (autoload-insert-section-header
227 outbuf autoloads-done relative-name full-name
228 (nth 5 (file-attributes full-name)))
229 (insert ";;; Generated autoloads from "
230 (autoload-trim-file-name full-name) "\n"))
231 (insert generate-autoload-section-trailer)))
232 (message "Generating autoloads for %s...done" relative-name))
234 (unless visited
235 ;; We created this buffer, so we should kill it.
236 (kill-buffer (current-buffer))))
237 (message "Could not load %s" relative-name))
239 (not done-any)))
242 ;;;_ , elinstall-deffile-insert-autoloads
243 (defun elinstall-deffile-insert-autoloads (file load-name)
244 "Update the autoloads for FILE in current buffer.
245 Return FILE if there was no autoload cookie in it, else nil.
247 Current buffer must be a loaddef-style file.
249 LOAD-NAME is the absolute name of the file.
250 RELATIVE-NAME is its name respective to some component of load-path."
251 (let (
252 (found nil)
253 (no-autoloads nil))
255 (save-excursion
256 (save-restriction
257 (widen)
258 (goto-char (point-min))
259 ;; Look for the section for FILE
260 (while (and (not found)
261 (search-forward generate-autoload-section-header nil t))
262 (let ((form (autoload-read-section-header)))
263 (cond
264 ((equal (nth 2 form) file)
265 ;; We found the section for this file.
266 (let ((begin (match-beginning 0)))
267 (progn
268 (search-forward generate-autoload-section-trailer)
269 (delete-region begin (point))
270 (setq found t))))
271 ((string< file (nth 2 form))
272 ;; We've come to a section alphabetically later than
273 ;; FILE. We assume the file is in order and so
274 ;; there must be no section for FILE. We will
275 ;; insert one before the section here.
276 (goto-char (match-beginning 0))
277 (setq found 'new)))))
278 (unless found
279 (progn
280 (setq found 'new)
281 ;; No later sections in the file. Put before the last page.
282 (goto-char (point-max))
283 (search-backward "\f" nil t)))
284 (setq no-autoloads
285 (elinstall-generate-file-autoloads file load-name))))
287 (if no-autoloads file nil)))
288 ;;;_ . Arranging to add to info-path and load-path
289 ;;;_ , elinstall-generate-add-to-path
290 (defun elinstall-generate-add-to-path (path-element type)
291 "Insert code at point to add PATH-ELEMENT to a path.
292 If TYPE is:
293 * `add-to-load-path', add to load-path
294 * `add-to-info-path', add to Info-default-directory-list
296 Current buffer must be a loaddef-style file."
297 (let ( (path-symbol
298 (case type
299 (add-to-load-path 'load-path)
300 (add-to-info-path 'Info-default-directory-list)))
301 (description
302 (case type
303 (add-to-load-path "load-path")
304 (add-to-info-path "info-path")))
305 (autoloads-done '())
306 (print-length nil)
307 (print-readably t) ; This does something in Lucid Emacs.
308 (float-output-format nil))
310 (message "Generating %s additions..." description)
312 (autoload-insert-section-header
313 (current-buffer) (list path-element) nil nil
314 nil)
315 (insert ";;; Generated path addition\n")
317 `(add-to-list ',path-symbol
318 (expand-file-name
319 ,(file-relative-name path-element)
320 (if load-file-name
321 (file-name-directory
322 (file-truename load-file-name)))))
323 (current-buffer))
325 (insert generate-autoload-section-trailer)
326 (message "Generating %s additions...done" description)))
329 ;;;_ , elinstall-deffile-insert-add-to-path
330 (defun elinstall-deffile-insert-add-to-path (path-element type)
331 "Insert code in current buffer to add PATH-ELEMENT to a path.
332 If TYPE is:
333 * `add-to-load-path', add to load-path
334 * `add-to-info-path', add to Info-default-directory-list
336 Current buffer must be a loaddef-style file."
337 (let (
338 (found nil)
339 (no-autoloads nil))
341 (save-excursion
342 (save-restriction
343 (widen)
344 (goto-char (point-min))
345 ;; Look for the section for PATH-ELEMENT
346 (while (and (not found)
347 (search-forward generate-autoload-section-header nil t))
348 (let ((form (autoload-read-section-header)))
349 (cond
350 ((and
351 (equal (nth 0 form) type)
352 (member (nth 1 form) path-element))
354 ;; We found the section for this add.
355 (let ((begin (match-beginning 0)))
356 (progn
357 (search-forward generate-autoload-section-trailer)
358 (delete-region begin (point))
359 (setq found t)))))))
361 (unless found
362 (progn
363 (setq found 'new)
364 ;; No later sections in the file. Put before the last page.
365 (goto-char (point-max))
366 (search-backward "\f" nil t)))
368 (elinstall-generate-add-to-path path-element type)))
370 ;;This never belongs in the no-autoloads section.
371 nil))
373 ;;;_ . elinstall-deffile-insert
375 (defun elinstall-deffile-insert (action)
376 "Insert autoloads etc into current file according to ACTION.
377 The format of ACTION is described in the design docs.
379 Return filename if this action belongs in the no-autoload section."
381 (when action
382 (case (car action)
383 (add-file-autoloads
384 (elinstall-deffile-insert-autoloads
385 (third action)
386 (fifth action)))
388 (add-to-load-path
389 (elinstall-deffile-insert-add-to-path
390 (third action)
391 'add-to-load-path)
392 nil)
394 (add-to-info-path
395 (elinstall-deffile-insert-add-to-path
396 (third action)
397 'add-to-info-path)
398 nil)
400 ((preload-file run-tests byte-compile)
401 (error "This case should not come here.")))))
403 ;;;_ . elinstall-prepare-deffile
404 (defun elinstall-prepare-deffile (deffile)
405 "Try to ensure that DEFFILE is available for receiving autoloads"
407 (autoload-ensure-default-file deffile)
408 (with-current-buffer (find-file-noselect deffile)
411 ;; We must read/write the file without any code conversion,
412 ;; but still decode EOLs.
413 (let ((coding-system-for-read 'raw-text))
415 ;; This is to make generated-autoload-file have Unix EOLs, so
416 ;; that it is portable to all platforms.
417 (setq buffer-file-coding-system 'raw-text-unix))
418 (or (> (buffer-size) 0)
419 (error "Autoloads file %s does not exist" buffer-file-name))
420 (or (file-writable-p buffer-file-name)
421 (error "Autoloads file %s is not writable"
422 buffer-file-name))))
424 ;;;_ . elinstall-update-deffile
426 ;;Adapted from autoload.el `update-directory-autoloads'.
427 ;;Still being adapted:
429 ;; * Still need to treat add-to-info-path and
430 ;;add-to-load-path. Both recognize them and insert them.
431 ;; * Adapt `elinstall-update-file-autoloads' to understand actions.
433 ;; * Finding "file" among actions is rickety. Maybe knowing the
434 ;; respective load-path element would help.
436 (defun elinstall-update-deffile (target actions &optional
437 use-load-path force)
439 Update file TARGET with current autoloads as specified by ACTIONS.
440 Also remove any old definitions pointing to libraries that can no
441 longer be found.
443 ACTIONS must be a list of actions (See the format doc). Each one's
444 filename must be relative to some element of load-path.
446 USE-LOAD-PATH is a list to use as load-path. It should include
447 any new load-path that we are arranging to create. If it's not given,
448 load-path itself is used.
450 If FORCE is `t', do it regardless of timestamps etc. (Not implemented)
451 Other non-nil cases of FORCE are reserved for future development.
453 This uses `update-file-autoloads' (which see) to do its work.
454 In an interactive call, you must give one argument, the name
455 of a single directory."
456 (let
458 (use-load-path (or use-load-path load-path))
459 (this-time (current-time))
460 ;;files with no autoload cookies.
461 (no-autoloads nil))
463 (elinstall-prepare-deffile target)
464 (with-current-buffer
465 (find-file-noselect target)
466 (save-excursion
467 (setq actions
468 (elinstall-remove-autogen-action
469 (autoload-trim-file-name target)
470 actions))
472 (goto-char (point-min))
473 (while (search-forward generate-autoload-section-header nil t)
474 (let* ((form (autoload-read-section-header))
475 (file (nth 3 form)))
476 (cond ((and (consp file) (stringp (car file)))
477 ;; This is a list of files that have no
478 ;; autoload cookies.
479 ;; There shouldn't be more than one such entry.
480 ;; Remove the obsolete section.
481 (autoload-remove-section (match-beginning 0))
482 (let ((last-time (nth 4 form)))
483 (dolist (file file)
484 (let ((file-time (nth 5 (file-attributes file))))
485 (when (and file-time
486 (not (time-less-p last-time file-time)))
487 ;; file unchanged
488 (push file no-autoloads)
489 (setq actions
490 (elinstall-remove-autogen-action
491 file actions)))))))
492 ((not (stringp file)))
494 (let
495 ((file-path
496 (locate-library file nil use-load-path)))
497 (cond
498 ;;File doesn't exist, so remove its
499 ;;section.
500 ((not file-path)
501 (autoload-remove-section
502 (match-beginning 0)))
504 ;; File hasn't changed, so do nothing.
505 ((equal
506 (nth 4 form)
507 (nth 5 (file-attributes file-path)))
508 nil)
510 (elinstall-deffile-insert
511 (elinstall-get-autogen-action
512 file actions))))
514 (setq actions
515 (elinstall-remove-autogen-action
516 file actions))))))))
518 ;; Remaining actions have no existing autoload sections yet.
519 (setq no-autoloads
520 (append no-autoloads
521 (delq nil (mapcar #'elinstall-deffile-insert actions))))
522 (when no-autoloads
523 ;; Sort them for better readability.
524 (setq no-autoloads (sort no-autoloads 'string<))
525 ;; Add the `no-autoloads' section.
526 (goto-char (point-max))
527 (search-backward "\f" nil t)
528 (autoload-insert-section-header
529 (current-buffer) nil nil no-autoloads this-time)
530 (insert generate-autoload-section-trailer))
531 (save-buffer))))
534 ;;;_ , Doing actions to arrange preloads
535 ;;;_ . elinstall-insert-add-to-path
536 (defun elinstall-insert-add-to-path (new path-sym)
537 "Insert code to add NEW to PATH-SYM.
538 Insert this at point in current buffer."
539 (insert "\n")
541 `(add-to-list ',path-sym
542 (expand-file-name ,new
543 (if load-file-name
544 (file-name-directory
545 (file-truename load-file-name)))))
546 (current-buffer)))
548 ;;;_ . elinstall-insert-add-to-load-path
549 (defun elinstall-insert-add-to-load-path (new)
550 "Insert code to add NEW to load-path.
551 Insert this at point in current buffer."
552 (elinstall-insert-add-to-path new 'load-path))
554 ;;;_ . elinstall-insert-add-to-info-path
555 (defun elinstall-insert-add-to-info-path (new)
556 "Insert code to add NEW to info-path.
557 Insert this at point in current buffer."
558 (elinstall-insert-add-to-path new 'Info-default-directory-list))
560 ;;;_ . elinstall-symlink-on-emacs-start
561 (defun elinstall-symlink-on-emacs-start
562 (filename target-basename target-dir &optional priority force)
563 "Symlink to TARGET-BASENAME.el in TARGET-DIR
565 If PRIORITY is given, it will be used as the priority prefix,
566 otherwise elinstall-default-priority will be.
567 PRIORITY must be an integer or nil.
568 If FORCE is `t', do it regardless of timestamps etc.
569 Other non-nil cases of FORCE are reserved for future development."
570 (let*
572 (priority (or priority elinstall-default-priority))
573 (target-name-nodir
574 (format
575 "%d%s.el"
576 priority
577 target-basename))
578 (target
579 (expand-file-name target-name-nodir target-dir)))
582 (cond
583 ;;Path should already exist.
584 ((not
585 (file-exists-p target-dir))
586 (message "The target directory doesn't exist."))
587 ;;Target shouldn't already exist, but if force is given, let
588 ;;user override.
589 ;;$$IMPROVE ME If it is a symlink pointing to the same place,
590 ;;do nothing.
591 ((and
592 (file-exists-p target)
594 (not force)
595 (not
596 (yes-or-no-p
597 (format "Really overwrite %s? " project-name))))
598 (message "No symlink made to %s" target)))
601 (make-symbolic-link
602 filename
603 target
604 nil)))))
606 ;;;_ . elinstall-add-to-dot-emacs
607 (defun elinstall-add-to-dot-emacs (dot-emacs-name filename force &rest r)
608 "Add code to load FILENAME to .emacs.
609 FILENAME should not have an extension"
611 ;;Visit .emacs
612 (with-current-buffer (find-file-noselect dot-emacs-name)
613 (save-excursion
614 ;;add at end of file
615 (goto-char (point-max))
616 (insert "\n;;Added by elinstall")
617 (insert "\n;;Consider using my-site-start to manage .emacs\n")
618 (pp `(load ,filename) (current-buffer))
619 (save-buffer))))
622 ;;;_ . elinstall-arrange-preload
623 ;;;###autoload
624 (defun elinstall-arrange-preload (filename force basename priority)
627 ;;Figure out parameters, using defaults when needed.
628 (let*
629 ( (preload-target elinstall-default-preload-target))
631 ;;Dispatch the possibilities.
632 (cond
633 ((eq preload-target 'dot-emacs)
634 (elinstall-add-to-dot-emacs "~/.emacs" filename))
635 ((stringp preload-target)
636 (elinstall-symlink-on-emacs-start
637 filename basename preload-target priority force))
640 (message "I don't recognize that")))))
642 ;;;_ , Cleanup actions
643 ;;Nothing yet. This will be another type of action.
645 ;;;_ . Segregating actions
646 ;;;_ , elinstall-segregate-actions
647 (defun elinstall-segregate-actions (actions)
648 "Return actions segregated by deffile.
650 Returns a list whose elements are each a cons of:
651 * deffile filename or nil
652 * A list of actions to be done for that deffile."
654 ;;$$IMPROVE ME - put tests in a separate segment, and byte-compile
655 ;;in yet another one.
656 (let
657 ((segment-list '())
658 (last-segment (list nil)))
660 (dolist (act actions)
661 (when act
662 (let*
663 ( (deffile-name
664 (case (car act)
665 ((add-file-autoloads
666 add-to-info-path
667 add-to-load-path)
668 (second act))
669 ((preload-file run-tests byte-compile)
670 nil)))
672 (cell
673 (if deffile-name
674 (assoc deffile-name segment-list)
675 last-segment)))
676 (if cell
677 (setcdr cell (cons act (cdr cell)))
678 (setq segment-list
679 (cons
680 (cons
681 deffile-name
682 (list act))
683 segment-list))))))
685 (append
686 segment-list
687 (if (cdr last-segment)
688 (list last-segment)
689 '()))))
694 ;;;_ . Finding actions
695 ;;;_ , Treating the parameter list
696 ;;;_ . elinstall-add-parameter
697 (defun elinstall-add-parameter (alist key new-value)
698 "Add a new value for KEY to ALIST"
700 (cons
701 (cons key new-value)
702 (assq-delete-all key (copy-list alist))))
704 ;;;_ . elinstall-get-parameter
705 (defun elinstall-get-parameter (alist key)
706 "Get the value of KEY from ALIST"
708 (cdr (assq key alist)))
709 ;;;_ . elinstall-expand-file-name
710 ;;$$OBSOLETE
712 (defun elinstall-expand-file-name (filename alist)
713 "Expand FILENAME by the value of `path' in ALIST"
714 (expand-file-name
715 filename
716 (elinstall-get-parameter alist 'path)))
717 ;;;_ , Finding deffiles
718 ;;;_ . elinstall-expand-deffile-name
719 (defun elinstall-expand-deffile-name (deffile)
720 "Expand DEFFILE autoload.el's way."
722 (expand-file-name (or deffile "loaddefs.el")
723 (expand-file-name "lisp"
724 source-directory)))
726 ;;;_ . elinstall-maybe-get-deffile
727 (defun elinstall-maybe-get-deffile (file)
728 "If FILE defined `generated-autoload-file', return it.
729 Otherwise return nil.
730 Return it as an absolute filename."
732 (save-excursion
733 ;;$$FIXME load buffer if it's not already loaded
734 (let*
735 ((existing-buffer (get-file-buffer file)))
737 ;; We want to get a value for generated-autoload-file from
738 ;; the local variables section if it's there.
739 ;;But if it's not loaded, we don't? Maybe should use
740 ;; `autoload-find-file' and load it.
741 (if existing-buffer
742 (set-buffer existing-buffer))
743 (if (local-variable-p 'generated-autoload-file)
744 (elinstall-expand-deffile-name
745 generated-autoload-file)
746 nil))))
750 ;;;_ , elinstall-find-actions-by-spec
752 (defun elinstall-find-actions-by-spec (spec load-path-element path parameters)
753 "Return a list of actions to do, controlled by SPEC and PARAMETERS.
755 LOAD-PATH-ELEMENT is the conceptual element of load-path that
756 surrounds PATH. It may not yet have been added to load-path."
757 (if (consp spec)
758 ;;$$IMPROVE ME by adding the other cases in the design.
759 (case (car spec)
761 (let
762 ((new-path
763 (expand-file-name
764 (second spec)
765 path)))
767 (elinstall-find-actions-by-spec
768 (third spec)
769 load-path-element
770 new-path
771 parameters)))
773 (all
774 (apply #'append
775 (mapcar
776 #'(lambda (sub-spec)
777 (elinstall-find-actions-by-spec
778 sub-spec
779 load-path-element
780 path
781 parameters))
782 (cdr spec))))
783 ;;$$WRITEME
784 (file
787 (dir
788 (let
789 ((dirname
790 (expand-file-name
791 (second spec)
792 path))
793 (load-path-here
794 (not
795 (elinstall-get-parameter
796 parameters 'block-add-to-load-path))))
797 (cons
798 ;;$$IMPROVE ME
799 ;;Do this only if there are loadable files.
800 (if load-path-here
801 `(add-to-load-path
802 ,(elinstall-get-parameter
803 parameters 'def-file)
804 ,dirname)
805 '())
806 ;;$$IMPROVE ME
807 ;;Do add-to-info-path too. But test if there are
808 ;;any info files present.
810 ;;$$IMPROVE ME
811 ;; We want to get a value for generated-autoload-file
812 ;; from the local variables section if it's there.
813 ;;Use `elinstall-maybe-get-deffile'
814 ;; Otherwise we'll use `def-file' in parameters.
816 ;;$$FIXME This isn't quite right. If directory
817 ;;itself is not in load-path, this will be wrong.
818 ;;Gotta know where our encompassing part of
819 ;;load-path is.
821 ;;$$ENCAP ME This should be shared with the
822 ;;treatment of (file FN)
824 ;;$$FIXME Don't do directories, but maybe recurse on
825 ;;them, if a flag is set. And since we definitely
826 ;;have a load-path element here,
827 ;;'block-add-to-load-path according to a parameter.
828 ;;Maybe could follow/not symlinks similarly.
829 (mapcar
830 #'(lambda (filename)
831 (let
832 ((full-path
833 (expand-file-name filename dirname)))
834 `(add-file-autoloads
835 ,(elinstall-get-parameter
836 parameters 'def-file)
837 ,(file-name-sans-extension
838 (file-relative-name
839 full-path
840 load-path-element))
841 ,load-path-element ;;Is this still used?
842 ,full-path)))
844 (directory-files
845 dirname
846 nil ;;Relative filenames
847 elinstall-elisp-regexp)))))
849 (def-file
850 (let
851 ((new-def-file
852 (expand-file-name
853 (second spec)
854 path)))
855 (elinstall-find-actions-by-spec
856 (third spec)
857 load-path-element
858 path
859 (elinstall-add-parameter parameters
860 'def-file new-def-file)))))
862 ;;$$IMPROVE ME by adding the other cases in the design.
863 (case spec
864 (t))))
865 ;;;_ . high-level work
866 ;;;_ , elinstall-get-relevant-load-path
867 (defun elinstall-get-relevant-load-path (actions)
869 (delq nil
870 (mapcar
871 #'(lambda (act)
872 (case (car act)
873 (add-to-load-path
874 (second act))
875 (t nil)))
876 actions)))
878 ;;;_ , elinstall-do-segment
879 (defun elinstall-do-segment (segment force use-load-path)
880 "Do all the actions in SEGMENT.
881 FORCE has its usual meaning.
882 USE-LOAD-PATH is the effective load-path."
884 ;;$$IMPROVE ME - this will have to know the additions to load-path.
885 (let*
886 ((deffile (car segment)))
887 (if (stringp deffile)
888 (elinstall-update-deffile deffile (cdr segment) force
889 use-load-path)
890 ;;Do other actions: link-in actions and cleanups.
891 (mapcar
892 #'(lambda (act)
894 (case (car act)
895 (preload-file
896 (apply
897 #'elinstall-arrange-preload
898 force
899 (cdr act)))
900 (run-tests
901 ;;$$WRITE ME - not a high priority right now.
902 nil)
904 ;;$$IMPROVE ME Understand flags to control second
905 ;;argument (whether to load file after
906 ;;compilation)
907 (byte-compile
908 (byte-compile-file (second act)))))
910 (cdr segment)))))
913 ;;;_ . Overall work
914 ;;;_ , elinstall-x
915 (defun elinstall-x (dir spec &optional preload-target force)
917 (let*
918 ((actions
919 (elinstall-find-actions-by-spec
920 spec
924 ;;$$RETHINK ME - maybe hand this work off to autoload?
925 ;;This is just the default loaddefs file, spec actually
926 ;;controls it.
927 (def-file . ,(elinstall-expand-deffile-name nil) ))))
928 (segment-list (elinstall-segregate-actions actions))
929 (use-load-path
930 (elinstall-get-relevant-load-path
931 actions)))
933 (mapcar
934 #'(lambda (segment)
935 (elinstall-do-segment segment force use-load-path))
936 segment-list)))
938 ;;;_ . Entry points
939 ;;;_ , elinstall
940 (defun elinstall (project-name dir spec &optional preload-target force)
941 "Install elisp files.
943 They need not be presented as a package.
945 Parameters:
946 PROJECT-NAME - the name of the project
947 DIR - the root directory of the project.
948 Suggestion: (elinstall-directory-true-name)
950 SPEC - a spec for the autoloads etc to make. It can be as simple as
951 `(in DIRECTORY t).
952 Suggestion: `(in ,(elinstall-directory-true-name) t)
953 PRELOAD-TARGET is where the autoload files are to be symlinked in. If
954 `nil' `elinstall-default-preload-target' is used instead.
956 If FORCE is t, install a package even if it has already been
957 installed.
958 Other non-nil cases of FORCE are reserved for future development."
960 (when
961 (and
962 (or
963 force
964 (not (elinstall-already-installed project-name)))
965 ;;$$RE-ADD ME - I commented it out just for development.
966 '(yes-or-no-p (format "Install %s " project-name)))
967 (elinstall-x dir spec preload-target force)
969 ;;$$RE-ADD ME - I commented it out just for development.
970 '(elinstall-record-installed project-name)))
974 ;;;_ , elinstall-update-directory-autoloads
975 ;;$$TEST ME
976 (defun elinstall-update-directory-autoloads (dir)
979 (interactive "DInstall all elisp files from directory: ")
981 (elinstall-x
983 '(dir ".")
984 (elinstall-expand-deffile-name
985 generated-autoload-file)))
988 ;;;_ , elinstall-update-file-autoloads
989 ;;$$TEST ME
990 (defun elinstall-update-file-autoloads (file)
993 (interactive "fInstall elisp file: ")
994 (elinstall
995 file
996 `(file ,file)
998 (elinstall-maybe-get-deffile file)
999 (elinstall-expand-deffile-name
1000 generated-autoload-file))))
1007 ;;;_. Footers
1008 ;;;_ , Provides
1010 (provide 'elinstall)
1012 ;;;_ * Local emacs vars.
1013 ;;;_ + Local variables:
1014 ;;;_ + mode: allout
1015 ;;;_ + End:
1017 ;;;_ , End
1018 ;;; elinstall.el ends here