Added field to add-file-autoloads
[elinstall.git] / elinstall.el
blob8afd19cc99b2cb76c5c3023b7e28bf8ee7d1b78c
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-link-on-emacs-start - Use this for non-autogenerated
31 ;; files that need to be linked in.
33 ;;;_ , Requires
35 (require 'autoload)
36 (require 'pp)
37 (require 'cus-edit) ;;Because we save "installedness" manually
40 ;;;_. Body
41 ;;;_ , Customizations
42 (defgroup elinstall
43 '()
44 "Customizations for elinstall"
45 :group 'elinstall)
47 (defcustom elinstall-default-priority
49 "Default priority for site-start"
50 :group 'elinstall
51 :type 'integer)
53 (defcustom elinstall-default-preload-target
54 "~/.emacs.d/site-start.d/"
55 "Default preload-target for registering autoloads"
56 :group 'elinstall
57 :type
58 '(choice
59 (const "~/.emacs.d/site-start.d/")
60 (const "/etc/emacs/site-start.d/")
61 (directory "" )
62 (const 'dot-emacs)))
65 (defcustom elinstall-already-installed
66 '()
67 "Things that have already been installed.
68 This exists for recording what has been installed. User interaction is not
69 contemplated at this time." )
71 ;;;_ , Data
72 ;;;_ . Regular expressions
73 ;;;_ , elinstall-elisp-regexp
74 (defconst elinstall-elisp-regexp
75 (let ((tmp nil))
76 (dolist
77 (suf (get-load-suffixes))
78 (unless (string-match "\\.elc" suf) (push suf tmp)))
79 (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))
80 "Regular expression that matches elisp files" )
82 ;;;_ , Utilities
83 ;;;_ . elinstall-directory-true-name
84 (defun elinstall-directory-true-name ()
85 "Get the true name of the directory the calling code lives in.
86 CAUTION: This is sensitive to where it's called. That's the point of it."
87 (file-name-directory
88 (if load-file-name
89 (file-truename load-file-name)
90 (file-truename buffer-file-name))))
91 ;;;_ . Checking installedness
92 ;;;_ , elinstall-already-installed
93 (defun elinstall-already-installed (project-name)
94 "Return non-nil if PROJECT-NAME has been installed."
95 (member project-name elinstall-already-installed))
97 ;;;_ , elinstall-record-installed
98 (defun elinstall-record-installed (project-name)
99 "Record that PROJECT-NAME has been installed."
101 (add-to-list 'elinstall-already-installed project-name)
102 (customize-save-variable
103 'elinstall-already-installed
104 elinstall-already-installed
105 "Set by elinstall-record-installed"))
106 ;;;_ , Work
107 ;;;_ . Doing actions
109 ;;;_ , Doing autoload actions (All adapted from autoload.el)
110 ;;;_ . Utilities about the action list
111 ;;;_ , elinstall-remove-autogen-action
112 (defun elinstall-remove-autogen-action (file actions)
113 "Return ACTIONS minus any add-file-autoloads on FILE removed."
115 (delq nil
116 (mapcar
117 #'(lambda (act)
118 (case (car act)
119 (add-file-autoloads
120 (if (equal file (third act))
122 act))))
123 actions)))
124 ;;;_ , elinstall-get-autogen-action
125 (defun elinstall-get-autogen-action (file actions)
127 (let
128 ((the-act))
129 (dolist (act actions)
130 (case (car act)
131 (add-file-autoloads
132 (when (equal file (third act))
133 (setq the-act act)))))
134 the-act))
137 ;;;_ . elinstall-generate-file-autoloads
138 ;;override to allow slashed load-paths
139 ;;Quick and dirty: We just adapt `generate-file-autoloads' and add
140 ;;a new arg.
141 ;;`relative-to' can be:
142 ;; * nil: act as at present. Assume that FILE's immediate directory
143 ;;is in load-path.
144 ;; * t :: use default-directory
145 ;; * a string :: relative to it, as a filename
147 (defun elinstall-generate-file-autoloads (relative-name full-name)
148 "Insert at point a loaddefs autoload section for FILE.
149 Autoloads are generated for defuns and defmacros in FILE
150 marked by `generate-autoload-cookie' (which see).
151 If FILE is being visited in a buffer, the contents of the buffer
152 are used.
153 Return non-nil in the case where no autoloads were added at point.
155 FULL-NAME is the absolute name of the file.
156 RELATIVE-NAME is its name respective to some component of load-path."
157 (let ((outbuf (current-buffer))
158 (autoloads-done '())
159 (print-length nil)
160 (print-readably t) ; This does something in Lucid Emacs.
161 (float-output-format nil)
162 (done-any nil)
163 (visited (get-file-buffer full-name))
164 output-start)
166 ;;Older code massaged `file' but we take both `relative-name' and
167 ;;`full-name', so we don't.
169 (with-current-buffer (or visited
170 ;; It is faster to avoid visiting the file.
171 (autoload-find-file full-name))
172 ;;$$MOVE ME - this should be checked in action-finding.
173 ;; Obey the no-update-autoloads file local variable.
174 (unless no-update-autoloads
175 (message "Generating autoloads for %s..." relative-name)
176 (setq output-start (with-current-buffer outbuf (point)))
177 (save-excursion
178 (save-restriction
179 (widen)
180 (goto-char (point-min))
181 (while (not (eobp))
182 (skip-chars-forward " \t\n\f")
183 (cond
184 ((looking-at (regexp-quote generate-autoload-cookie))
185 (search-forward generate-autoload-cookie)
186 (skip-chars-forward " \t")
187 (setq done-any t)
188 (if (eolp)
189 ;; Read the next form and make an autoload.
190 (let* ((form (prog1 (read (current-buffer))
191 (or (bolp) (forward-line 1))))
192 (autoload (make-autoload form load-name)))
193 (if autoload
194 (push (nth 1 form) autoloads-done)
195 (setq autoload form))
196 (let ((autoload-print-form-outbuf outbuf))
197 (autoload-print-form autoload)))
199 ;; Copy the rest of the line to the output.
200 (princ (buffer-substring
201 (progn
202 ;; Back up over whitespace, to preserve it.
203 (skip-chars-backward " \f\t")
204 (if (= (char-after (1+ (point))) ? )
205 ;; Eat one space.
206 (forward-char 1))
207 (point))
208 (progn (forward-line 1) (point)))
209 outbuf)))
210 ((looking-at ";")
211 ;; Don't read the comment.
212 (forward-line 1))
214 (forward-sexp 1)
215 (forward-line 1))))))
217 (when done-any
218 (with-current-buffer outbuf
219 (save-excursion
220 ;; Insert the section-header line which lists the file name
221 ;; and which functions are in it, etc.
222 (goto-char output-start)
223 (autoload-insert-section-header
224 outbuf autoloads-done relative-name full-name
225 (nth 5 (file-attributes full-name)))
226 (insert ";;; Generated autoloads from "
227 (autoload-trim-file-name full-name) "\n"))
228 (insert generate-autoload-section-trailer)))
229 (message "Generating autoloads for %s...done" relative-name))
230 (or visited
231 ;; We created this buffer, so we should kill it.
232 (kill-buffer (current-buffer))))
233 (not done-any)))
236 ;;;_ . elinstall-deffile-insert-x
237 ;;This now operates in the current buffer. We already did most of
238 ;;this checking on setup.
239 ;; Removed
240 ;; * buffer optional save,
241 ;; * converting file to load-name
242 ;; * checking for timestamp
243 (defun elinstall-deffile-insert-x (file load-name)
244 "Update the autoloads for FILE in `generated-autoload-file'
245 \(which FILE might bind in its local variables).
247 LOAD-NAME is the full name of the file
250 Return FILE if there was no autoload cookie in it, else nil."
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 ((string= (nth 2 form) file)
265 ;; We found the section for this file.
266 ;; Check if it is up to date.
267 (let ((begin (match-beginning 0)))
268 (progn
269 (search-forward generate-autoload-section-trailer)
270 (delete-region begin (point))
271 (setq found t))))
272 ((string< file (nth 2 form))
273 ;; We've come to a section alphabetically later than
274 ;; FILE. We assume the file is in order and so
275 ;; there must be no section for FILE. We will
276 ;; insert one before the section here.
277 (goto-char (match-beginning 0))
278 (setq found 'new)))))
279 (unless found
280 (progn
281 (setq found 'new)
282 ;; No later sections in the file. Put before the last page.
283 (goto-char (point-max))
284 (search-backward "\f" nil t)))
285 (setq no-autoloads
286 (elinstall-generate-file-autoloads file load-name))))
288 (if no-autoloads file nil)))
290 ;;;_ . elinstall-deffile-insert
292 (defun elinstall-deffile-insert (action)
293 "Insert autoloads etc into current file according to ACTION.
294 The format of ACTION is described in the design docs.
296 Return filename if this action belongs in the no-autoload section."
298 (when action
299 (case (car action)
300 (add-file-autoloads
301 (elinstall-deffile-insert-x
302 (third action)
303 (fifth action)))
305 (add-to-load-path
306 ;;Go to the right position, then call:
307 '(elinstall-insert-add-to-load-path)
308 nil)
310 ;;Similar, but for info-path.
311 (add-to-info-path
312 'elinstall-insert-add-to-info-path
313 nil)
315 (preload-file
316 (error "This case should not come here.")))))
318 ;;;_ . elinstall-prepare-deffile
319 (defun elinstall-prepare-deffile (deffile)
320 "Try to ensure that DEFFILE is available for receiving autoloads"
322 (autoload-ensure-default-file deffile)
323 (with-current-buffer (find-file-noselect deffile)
326 ;; We must read/write the file without any code conversion,
327 ;; but still decode EOLs.
328 (let ((coding-system-for-read 'raw-text))
330 ;; This is to make generated-autoload-file have Unix EOLs, so
331 ;; that it is portable to all platforms.
332 (setq buffer-file-coding-system 'raw-text-unix))
333 (or (> (buffer-size) 0)
334 (error "Autoloads file %s does not exist" buffer-file-name))
335 (or (file-writable-p buffer-file-name)
336 (error "Autoloads file %s is not writable"
337 buffer-file-name))))
339 ;;;_ . elinstall-update-deffile
341 ;;Adapted from autoload.el `update-directory-autoloads'.
342 ;;Still being adapted:
344 ;; * Still need to treat add-to-info-path and
345 ;;add-to-load-path. Both recognize them and insert them.
346 ;; * Adapt `elinstall-update-file-autoloads' to understand actions.
348 ;; * Finding "file" among actions is rickety. Maybe knowing the
349 ;; respective load-path element would help.
351 (defun elinstall-update-deffile (target actions &optional
352 use-load-path force)
354 Update file TARGET with current autoloads as specified by ACTIONS.
355 Also remove any old definitions pointing to libraries that can no
356 longer be found.
358 ACTIONS must be a list of actions (See the format doc). Each one's
359 filename must be relative to some element of load-path.
361 USE-LOAD-PATH is a list to use as load-path. It should include
362 any new load-path that we are arranging to create. If it's not given,
363 load-path itself is used.
365 If FORCE is `t', do it regardless of timestamps etc. (Not implemented)
366 Other non-nil cases of FORCE are reserved for future development.
368 This uses `update-file-autoloads' (which see) to do its work.
369 In an interactive call, you must give one argument, the name
370 of a single directory."
371 (let
373 (use-load-path (or use-load-path load-path))
374 (this-time (current-time))
375 ;;files with no autoload cookies.
376 (no-autoloads nil))
378 (elinstall-prepare-deffile target)
379 (with-current-buffer
380 (find-file-noselect target)
381 (save-excursion
382 (setq actions
383 (elinstall-remove-autogen-action
384 (autoload-trim-file-name target)
385 actions))
387 (goto-char (point-min))
388 (while (search-forward generate-autoload-section-header nil t)
389 (let* ((form (autoload-read-section-header))
390 (file (nth 3 form)))
391 (cond ((and (consp file) (stringp (car file)))
392 ;; This is a list of files that have no
393 ;; autoload cookies.
394 ;; There shouldn't be more than one such entry.
395 ;; Remove the obsolete section.
396 (autoload-remove-section (match-beginning 0))
397 (let ((last-time (nth 4 form)))
398 (dolist (file file)
399 (let ((file-time (nth 5 (file-attributes file))))
400 (when (and file-time
401 (not (time-less-p last-time file-time)))
402 ;; file unchanged
403 (push file no-autoloads)
404 (setq actions
405 (elinstall-remove-autogen-action
406 file actions)))))))
407 ((not (stringp file)))
409 (let
410 ((file-path
411 (locate-library file nil use-load-path)))
412 (cond
413 ;;File doesn't exist, so remove its
414 ;;section.
415 ((not file-path)
416 (autoload-remove-section
417 (match-beginning 0)))
419 ;; File hasn't changed, so do nothing.
420 ((equal
421 (nth 4 form)
422 (nth 5 (file-attributes file-path)))
423 nil)
425 (elinstall-deffile-insert
426 (elinstall-get-autogen-action file))))
428 (setq actions
429 (elinstall-remove-autogen-action
430 file actions))))))))
432 ;; Remaining actions have no existing autoload sections yet.
433 (setq no-autoloads
434 (append no-autoloads
435 (delq nil (mapcar #'elinstall-deffile-insert actions))))
436 (when no-autoloads
437 ;; Sort them for better readability.
438 (setq no-autoloads (sort no-autoloads 'string<))
439 ;; Add the `no-autoloads' section.
440 (goto-char (point-max))
441 (search-backward "\f" nil t)
442 (autoload-insert-section-header
443 (current-buffer) nil nil no-autoloads this-time)
444 (insert generate-autoload-section-trailer))
445 (save-buffer))))
448 ;;;_ , Doing actions to arrange preloads
449 ;;;_ . elinstall-insert-add-to-path
450 (defun elinstall-insert-add-to-path (new path-sym)
451 "Insert code to add NEW to PATH-SYM.
452 Insert this at point in current buffer."
453 (insert "\n")
455 `(add-to-list ',path-sym
456 (expand-file-name ,new
457 (if load-file-name
458 (file-name-directory
459 (file-truename load-file-name)))))
460 (current-buffer)))
462 ;;;_ . elinstall-insert-add-to-load-path
463 (defun elinstall-insert-add-to-load-path (new)
464 "Insert code to add NEW to load-path.
465 Insert this at point in current buffer."
466 (elinstall-insert-add-to-path new 'load-path))
468 ;;;_ . elinstall-insert-add-to-info-path
469 (defun elinstall-insert-add-to-info-path (new)
470 "Insert code to add NEW to info-path.
471 Insert this at point in current buffer."
472 (elinstall-insert-add-to-path new 'Info-default-directory-list))
474 ;;;_ . elinstall-symlink-on-emacs-start
475 (defun elinstall-symlink-on-emacs-start
476 (filename target-basename target-dir &optional priority force)
477 "Symlink to TARGET-BASENAME.el in TARGET-DIR
479 If PRIORITY is given, it will be used as the priority prefix,
480 otherwise elinstall-default-priority will be.
481 PRIORITY must be an integer or nil.
482 If FORCE is `t', do it regardless of timestamps etc.
483 Other non-nil cases of FORCE are reserved for future development."
484 (let*
486 (priority (or priority elinstall-default-priority))
487 (target-name-nodir
488 (format
489 "%d%s.el"
490 priority
491 target-basename))
492 (target
493 (expand-file-name target-name-nodir target-dir)))
496 (cond
497 ;;Path should already exist.
498 ((not
499 (file-exists-p target-dir))
500 (message "The target directory doesn't exist."))
501 ;;Target shouldn't already exist, but if force is given, let
502 ;;user override.
503 ((and
504 (file-exists-p target)
506 (not force)
507 (not
508 (yes-or-no-p
509 (format "Really overwrite %s? " project-name))))
510 (message "No symlink made to %s" target)))
513 (make-symbolic-link
514 filename
515 target
516 nil)))))
518 ;;;_ . elinstall-add-to-dot-emacs
519 (defun elinstall-add-to-dot-emacs (dot-emacs-name filename force &rest r)
520 "Add code to load FILENAME to .emacs.
521 FILENAME should not have an extension"
523 ;;Visit .emacs
524 (with-current-buffer (find-file-noselect dot-emacs-name)
525 (save-excursion
526 ;;add at end of file
527 (goto-char (point-max))
528 (insert "\n;;Added by elinstall")
529 (insert "\n;;Consider using my-site-start to manage .emacs\n")
530 (pp `(load ,filename) (current-buffer))
531 (save-buffer))))
534 ;;;_ . elinstall-link-on-emacs-start
535 ;;;###autoload
536 (defun elinstall-link-on-emacs-start (filename force basename priority)
539 ;;Figure out parameters, using defaults when needed.
540 (let*
541 ( (preload-target elinstall-default-preload-target))
543 ;;Dispatch the possibilities.
544 (cond
545 ((eq preload-target 'dot-emacs)
546 (elinstall-add-to-dot-emacs "~/.emacs" filename))
547 ((stringp preload-target)
548 (elinstall-symlink-on-emacs-start
549 filename basename preload-target priority force))
552 (message "I don't recognize that")))))
554 ;;;_ , Cleanup actions
555 ;;Nothing yet. This will be another type of action.
557 ;;;_ . Segregating actions
558 ;;;_ , elinstall-segregate-actions
559 (defun elinstall-segregate-actions (actions)
560 "Return actions segregated by deffile.
562 Returns a list whose elements are each a cons of:
563 * deffile filename or nil
564 * A list of actions to be done for that deffile."
566 (let
567 ((segment-list '()))
568 (dolist (act actions)
569 (when act
570 (let*
571 ( (deffile-name
572 (case (car act)
573 ((add-file-autoloads
574 add-to-info-path
575 add-to-load-path)
576 (second act))
577 (preload-file nil)))
579 (cell (assoc deffile-name segment-list)))
580 (if cell
581 (setcdr cell (cons act (cdr cell)))
582 (setq segment-list
583 (cons
584 (cons
585 deffile-name
586 (list act))
587 segment-list))))))
588 segment-list))
592 ;;;_ . Finding actions
593 ;;;_ , Treating the parameter list
594 ;;;_ . elinstall-add-parameter
595 (defun elinstall-add-parameter (alist key new-value)
596 "Add a new value for KEY to ALIST"
598 (cons
599 (cons key new-value)
600 (assq-delete-all key (copy-list alist))))
602 ;;;_ . elinstall-get-parameter
603 (defun elinstall-get-parameter (alist key)
604 "Get the value of KEY from ALIST"
606 (cdr (assq key alist)))
607 ;;;_ . elinstall-expand-filename
608 ;;$$OBSOLETE
610 (defun elinstall-expand-filename (filename alist)
611 "Expand FILENAME by the value of `path' in ALIST"
612 (expand-file-name
613 filename
614 (elinstall-get-parameter alist 'path)))
615 ;;;_ , Finding deffiles
616 ;;;_ . elinstall-expand-deffile-name
617 (defun elinstall-expand-deffile-name (deffile)
618 "Expand DEFFILE autoload.el's way."
620 (expand-file-name (or deffile "loaddefs.el")
621 (expand-file-name "lisp"
622 source-directory)))
624 ;;;_ . elinstall-maybe-get-deffile
625 (defun elinstall-maybe-get-deffile (file)
626 "If FILE defined `generated-autoload-file', return it.
627 Otherwise return nil.
628 Return it as an absolute filename."
630 (save-excursion
631 ;;$$FIXME load buffer if it's not already loaded
632 (let*
633 ((existing-buffer (get-file-buffer file)))
635 ;; We want to get a value for generated-autoload-file from
636 ;; the local variables section if it's there.
637 ;;But if it's not loaded, we don't? Maybe should use
638 ;; `autoload-find-file' and load it.
639 (if existing-buffer
640 (set-buffer existing-buffer))
641 (if (local-variable-p 'generated-autoload-file)
642 (elinstall-expand-deffile-name
643 generated-autoload-file)
644 nil))))
648 ;;;_ , elinstall-find-actions-by-spec
650 (defun elinstall-find-actions-by-spec (spec load-path-element path parameters)
651 "Return a list of actions to do, controlled by SPEC and PARAMETERS.
653 LOAD-PATH-ELEMENT is the conceptual element of load-path that
654 surrounds PATH. It may not yet have been added to load-path."
655 (if (consp spec)
656 ;;$$IMPROVE ME by adding the other cases in the design.
657 (case (car spec)
659 (let
660 ((new-path
661 (expand-filename
662 (second spec)
663 path)))
665 (elinstall-find-actions-by-spec
666 (third spec)
667 load-path-element
668 new-path
669 parameters)))
671 (all
672 (apply #'append
673 (mapcar
674 #'(lambda (sub-spec)
675 (elinstall-find-actions-by-spec
676 sub-spec
677 load-path-element
678 path
679 parameters))
680 (cdr spec))))
682 (dir
683 (let
684 ((dirname
685 (expand-filename
686 (second spec)
687 path))
688 (load-path-here
689 (not
690 (elinstall-get-parameter
691 parameters 'block-add-to-load-path))))
692 (cons
693 (if load-path-here
694 `(add-to-load-path
695 ,(elinstall-get-parameter
696 parameters 'def-file)
697 ,dirname)
698 '())
699 ;;$$IMPROVE ME
700 ;; We want to get a value for generated-autoload-file
701 ;; from the local variables section if it's there.
702 ;;Use `elinstall-maybe-get-deffile'
703 ;; Otherwise we'll use `def-file' in parameters.
705 ;;$$FIXME This isn't quite right. If directory
706 ;;itself is not in load-path, this will be wrong.
707 ;;Gotta know where our encompassing part of
708 ;;load-path is.
710 ;;$$ENCAP ME This should be shared with the
711 ;;treatment of (file FN)
713 ;;$$FIXME Don't do directories, but maybe recurse on
714 ;;them, if a flag is set. And since we definitely
715 ;;have a load-path element here,
716 ;;'block-add-to-load-path according to a parameter.
717 ;;Maybe could follow/not symlinks similarly.
718 (mapcar
719 #'(lambda (filename)
720 (let
721 ((full-path
722 (expand-filename filename path)))
723 `(add-file-autoloads
724 ,(elinstall-get-parameter
725 parameters 'def-file)
726 (file-name-sans-extension
727 (file-relative-name
728 full-path
729 load-path-element))
730 load-path-element ;;Is this still used?
731 full-path)))
733 (directory-files
734 dirname
735 nil ;;Relative filenames
736 elinstall-elisp-regexp)))))
738 (def-file
739 (let
740 ((new-def-file
741 (expand-filename
742 (second spec)
743 path)))
744 (elinstall-find-actions-by-spec
745 (third spec)
746 load-path-element
747 path
748 (elinstall-add-parameter parameters
749 'def-file new-def-file)))))
751 ;;$$IMPROVE ME by adding the other cases in the design.
752 (case spec
753 (t))))
754 ;;;_ . high-level work
755 ;;;_ , elinstall-get-relevant-load-path
756 (defun elinstall-get-relevant-load-path (actions)
758 ;;$$WRITE ME - mapcar, everything but add-to-load-path gives nil,
759 ;;delq the nils.
760 (let*
762 ;;$$PUNT
763 load-path))
765 ;;;_ , elinstall-do-segment
766 (defun elinstall-do-segment (segment force use-load-path)
767 "Do all the actions in SEGMENT.
768 FORCE has its usual meaning.
769 USE-LOAD-PATH is the effective load-path."
771 ;;$$IMPROVE ME - this will have to know the additions to load-path.
772 (let*
773 ((deffile (car segment)))
774 (if (stringp deffile)
775 (elinstall-update-deffile deffile (cdr segment) force
776 use-load-path)
777 ;;Do other actions: link-in actions and cleanups.
778 (mapcar
779 #'(lambda (act)
780 ;;$$FIXME Distinguish link-in and cleanup actions.
781 (apply
782 #'elinstall-link-on-emacs-start
783 force
784 (cdr act)))
785 (cdr segment)))))
788 ;;;_ . Overall work
789 ;;;_ , elinstall-x
790 (defun elinstall-x (dir spec &optional preload-target force)
792 (let*
793 ((actions
794 (elinstall-find-actions-by-spec
795 spec
799 ;;$$RETHINK ME - maybe hand this work off to autoload?
800 ;;This is just the default loaddefs file, spec actually
801 ;;controls it.
802 (def-file . ,(elinstall-expand-deffile-name nil) ))))
803 (segment-list (elinstall-segregate-actions actions))
804 (use-load-path
805 (elinstall-get-relevant-load-path)))
807 (mapcar
808 #'(lambda (segment)
809 (elinstall-do-segment segment force use-load-path))
810 segment-list)))
812 ;;;_ . Entry points
813 ;;;_ , elinstall
814 (defun elinstall (project-name dir spec &optional preload-target force)
815 "Install elisp files.
817 They need not be presented as a package.
819 Parameters:
820 PROJECT-NAME - the name of the project
821 DIR - the root directory of the project.
822 Suggestion: (elinstall-directory-true-name)
824 SPEC - a spec for the autoloads etc to make. It can be as simple as
825 `(in DIRECTORY t).
826 Suggestion: `(in ,(elinstall-directory-true-name) t)
827 PRELOAD-TARGET is where the autoload files are to be symlinked in. If
828 `nil' `elinstall-default-preload-target' is used instead.
830 If FORCE is t, install a package even if it has already been
831 installed.
832 Other non-nil cases of FORCE are reserved for future development."
834 (when
835 (and
836 (or
837 force
838 (not (elinstall-already-installed project-name)))
839 ;;$$RE-ADD ME - I commented it out just for development.
840 '(yes-or-no-p (format "Install %s " project-name)))
841 (elinstall-x dir spec preload-target force)
843 ;;$$RE-ADD ME - I commented it out just for development.
844 '(elinstall-record-installed project-name)))
848 ;;;_ , elinstall-update-directory-autoloads
849 ;;$$TEST ME
850 (defun elinstall-update-directory-autoloads (dir)
853 (interactive "DInstall all elisp files from directory: ")
855 (elinstall-x
857 '(dir ".")
858 (elinstall-expand-deffile-name
859 generated-autoload-file)))
862 ;;;_ , elinstall-update-file-autoloads
863 ;;$$TEST ME
864 (defun elinstall-update-file-autoloads (file &optional save-after)
867 (interactive "fInstall elisp file: \np")
868 (elinstall
869 file
870 `(file ,file)
872 (elinstall-maybe-get-deffile file)
873 (elinstall-expand-deffile-name
874 generated-autoload-file))))
881 ;;;_. Footers
882 ;;;_ , Provides
884 (provide 'elinstall)
886 ;;;_ * Local emacs vars.
887 ;;;_ + Local variables:
888 ;;;_ + mode: allout
889 ;;;_ + End:
891 ;;;_ , End
892 ;;; elinstall.el ends here