Cleaned up examples, but no functional change
[elinstall.git] / elinstall.el
blob4b44b8c7498bb1a5a3a9767c853b5392856a2151
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 ;; 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 actions)))
127 ;;;_ , elinstall-get-autogen-action
128 (defun elinstall-get-autogen-action (file actions)
130 (let
131 ((the-act))
132 (dolist (act actions)
133 (case (car act)
134 (add-file-autoloads
135 (when (equal file (third act))
136 (setq the-act act)))))
137 the-act))
139 ;;;_ . Making autoloads
140 ;;;_ , elinstall-generate-file-autoloads
141 ;;override to allow slashed load-paths
142 ;;Quick and dirty: We just adapt `generate-file-autoloads' and add
143 ;;a new arg.
144 ;;`relative-to' can be:
145 ;; * nil: act as at present. Assume that FILE's immediate directory
146 ;;is in load-path.
147 ;; * t :: use default-directory
148 ;; * a string :: relative to it, as a filename
150 (defun elinstall-generate-file-autoloads (relative-name full-name)
151 "Insert at point a loaddefs autoload section for FILE.
152 Autoloads are generated for defuns and defmacros in FILE
153 marked by `generate-autoload-cookie' (which see).
154 If FILE is being visited in a buffer, the contents of the buffer
155 are used.
156 Return non-nil in the case where no autoloads were added at point.
158 FULL-NAME is the absolute name of the file.
159 RELATIVE-NAME is its name respective to some component of load-path."
160 (let ((outbuf (current-buffer))
161 (autoloads-done '())
162 (print-length nil)
163 (print-readably t) ; This does something in Lucid Emacs.
164 (float-output-format nil)
165 (done-any nil)
166 (visited (get-file-buffer full-name))
167 output-start)
169 ;;Older code massaged `file' but we take both `relative-name' and
170 ;;`full-name', so we don't.
172 (with-current-buffer (or visited
173 ;; It is faster to avoid visiting the file.
174 (autoload-find-file full-name))
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))
233 ;;$$OBSOLETE
234 (unless visited
235 ;; We created this buffer, so we should kill it.
236 (kill-buffer (current-buffer))))
237 (not done-any)))
240 ;;;_ , elinstall-deffile-insert-autoloads
241 (defun elinstall-deffile-insert-autoloads (file load-name)
242 "Update the autoloads for FILE in current buffer.
243 Return FILE if there was no autoload cookie in it, else nil.
245 Current buffer must be a loaddef-style file.
247 LOAD-NAME is the absolute name of the file.
248 RELATIVE-NAME is its name respective to some component of load-path."
249 (let (
250 (found nil)
251 (no-autoloads nil))
253 (save-excursion
254 (save-restriction
255 (widen)
256 (goto-char (point-min))
257 ;; Look for the section for FILE
258 (while (and (not found)
259 (search-forward generate-autoload-section-header nil t))
260 (let ((form (autoload-read-section-header)))
261 (cond
262 ((equal (nth 2 form) file)
263 ;; We found the section for this file.
264 (let ((begin (match-beginning 0)))
265 (progn
266 (search-forward generate-autoload-section-trailer)
267 (delete-region begin (point))
268 (setq found t))))
269 ((string< file (nth 2 form))
270 ;; We've come to a section alphabetically later than
271 ;; FILE. We assume the file is in order and so
272 ;; there must be no section for FILE. We will
273 ;; insert one before the section here.
274 (goto-char (match-beginning 0))
275 (setq found 'new)))))
276 (unless found
277 (progn
278 (setq found 'new)
279 ;; No later sections in the file. Put before the last page.
280 (goto-char (point-max))
281 (search-backward "\f" nil t)))
282 (setq no-autoloads
283 (elinstall-generate-file-autoloads file load-name))))
285 (if no-autoloads file nil)))
286 ;;;_ . Arranging to add to info-path and load-path
287 ;;;_ , elinstall-generate-add-to-path
288 (defun elinstall-generate-add-to-path (path-element type)
289 "Insert code at point to add PATH-ELEMENT to a path.
290 If TYPE is:
291 * `add-to-load-path', add to load-path
292 * `add-to-info-path', add to Info-default-directory-list
294 Current buffer must be a loaddef-style file."
295 (let ( (path-symbol
296 (case type
297 (add-to-load-path 'load-path)
298 (add-to-info-path 'Info-default-directory-list)))
299 (description
300 (case type
301 (add-to-load-path "load-path")
302 (add-to-info-path "info-path")))
303 (autoloads-done '())
304 (print-length nil)
305 (print-readably t) ; This does something in Lucid Emacs.
306 (float-output-format nil))
308 (message "Generating %s additions..." description)
310 (autoload-insert-section-header
311 (current-buffer) (list path-element) nil nil
312 nil)
313 (insert ";;; Generated path addition\n")
315 `(add-to-list ',path-symbol
316 (expand-file-name
317 ,(file-relative-name path-element)
318 (if load-file-name
319 (file-name-directory
320 (file-truename load-file-name)))))
321 (current-buffer))
323 (insert generate-autoload-section-trailer)
324 (message "Generating %s additions...done" description)))
327 ;;;_ , elinstall-deffile-insert-add-to-path
328 (defun elinstall-deffile-insert-add-to-path (path-element type)
329 "Insert code in current buffer to add PATH-ELEMENT to a path.
330 If TYPE is:
331 * `add-to-load-path', add to load-path
332 * `add-to-info-path', add to Info-default-directory-list
334 Current buffer must be a loaddef-style file."
335 (let (
336 (found nil)
337 (no-autoloads nil))
339 (save-excursion
340 (save-restriction
341 (widen)
342 (goto-char (point-min))
343 ;; Look for the section for PATH-ELEMENT
344 (while (and (not found)
345 (search-forward generate-autoload-section-header nil t))
346 (let ((form (autoload-read-section-header)))
347 (cond
348 ((and
349 (equal (nth 0 form) type)
350 (member (nth 1 form) path-element))
352 ;; We found the section for this add.
353 (let ((begin (match-beginning 0)))
354 (progn
355 (search-forward generate-autoload-section-trailer)
356 (delete-region begin (point))
357 (setq found t)))))))
359 (unless found
360 (progn
361 (setq found 'new)
362 ;; No later sections in the file. Put before the last page.
363 (goto-char (point-max))
364 (search-backward "\f" nil t)))
366 (elinstall-generate-add-to-path file load-name)))
368 ;;This never belongs in the no-autoloads section.
369 nil))
371 ;;;_ . elinstall-deffile-insert
373 (defun elinstall-deffile-insert (action)
374 "Insert autoloads etc into current file according to ACTION.
375 The format of ACTION is described in the design docs.
377 Return filename if this action belongs in the no-autoload section."
379 (when action
380 (case (car action)
381 (add-file-autoloads
382 (elinstall-deffile-insert-autoloads
383 (third action)
384 (fifth action)))
386 (add-to-load-path
387 (elinstall-deffile-insert-add-to-path
388 (second action)
389 'add-to-load-path)
390 nil)
392 ;;Similar, but for info-path.
393 (add-to-info-path
394 (elinstall-deffile-insert-add-to-path
395 (second action)
396 'add-to-info-path)
397 nil)
399 (preload-file
400 (error "This case should not come here.")))))
402 ;;;_ . elinstall-prepare-deffile
403 (defun elinstall-prepare-deffile (deffile)
404 "Try to ensure that DEFFILE is available for receiving autoloads"
406 (autoload-ensure-default-file deffile)
407 (with-current-buffer (find-file-noselect deffile)
410 ;; We must read/write the file without any code conversion,
411 ;; but still decode EOLs.
412 (let ((coding-system-for-read 'raw-text))
414 ;; This is to make generated-autoload-file have Unix EOLs, so
415 ;; that it is portable to all platforms.
416 (setq buffer-file-coding-system 'raw-text-unix))
417 (or (> (buffer-size) 0)
418 (error "Autoloads file %s does not exist" buffer-file-name))
419 (or (file-writable-p buffer-file-name)
420 (error "Autoloads file %s is not writable"
421 buffer-file-name))))
423 ;;;_ . elinstall-update-deffile
425 ;;Adapted from autoload.el `update-directory-autoloads'.
426 ;;Still being adapted:
428 ;; * Still need to treat add-to-info-path and
429 ;;add-to-load-path. Both recognize them and insert them.
430 ;; * Adapt `elinstall-update-file-autoloads' to understand actions.
432 ;; * Finding "file" among actions is rickety. Maybe knowing the
433 ;; respective load-path element would help.
435 (defun elinstall-update-deffile (target actions &optional
436 use-load-path force)
438 Update file TARGET with current autoloads as specified by ACTIONS.
439 Also remove any old definitions pointing to libraries that can no
440 longer be found.
442 ACTIONS must be a list of actions (See the format doc). Each one's
443 filename must be relative to some element of load-path.
445 USE-LOAD-PATH is a list to use as load-path. It should include
446 any new load-path that we are arranging to create. If it's not given,
447 load-path itself is used.
449 If FORCE is `t', do it regardless of timestamps etc. (Not implemented)
450 Other non-nil cases of FORCE are reserved for future development.
452 This uses `update-file-autoloads' (which see) to do its work.
453 In an interactive call, you must give one argument, the name
454 of a single directory."
455 (let
457 (use-load-path (or use-load-path load-path))
458 (this-time (current-time))
459 ;;files with no autoload cookies.
460 (no-autoloads nil))
462 (elinstall-prepare-deffile target)
463 (with-current-buffer
464 (find-file-noselect target)
465 (save-excursion
466 (setq actions
467 (elinstall-remove-autogen-action
468 (autoload-trim-file-name target)
469 actions))
471 (goto-char (point-min))
472 (while (search-forward generate-autoload-section-header nil t)
473 (let* ((form (autoload-read-section-header))
474 (file (nth 3 form)))
475 (cond ((and (consp file) (stringp (car file)))
476 ;; This is a list of files that have no
477 ;; autoload cookies.
478 ;; There shouldn't be more than one such entry.
479 ;; Remove the obsolete section.
480 (autoload-remove-section (match-beginning 0))
481 (let ((last-time (nth 4 form)))
482 (dolist (file file)
483 (let ((file-time (nth 5 (file-attributes file))))
484 (when (and file-time
485 (not (time-less-p last-time file-time)))
486 ;; file unchanged
487 (push file no-autoloads)
488 (setq actions
489 (elinstall-remove-autogen-action
490 file actions)))))))
491 ((not (stringp file)))
493 (let
494 ((file-path
495 (locate-library file nil use-load-path)))
496 (cond
497 ;;File doesn't exist, so remove its
498 ;;section.
499 ((not file-path)
500 (autoload-remove-section
501 (match-beginning 0)))
503 ;; File hasn't changed, so do nothing.
504 ((equal
505 (nth 4 form)
506 (nth 5 (file-attributes file-path)))
507 nil)
509 (elinstall-deffile-insert
510 (elinstall-get-autogen-action
511 file actions))))
513 (setq actions
514 (elinstall-remove-autogen-action
515 file actions))))))))
517 ;; Remaining actions have no existing autoload sections yet.
518 (setq no-autoloads
519 (append no-autoloads
520 (delq nil (mapcar #'elinstall-deffile-insert actions))))
521 (when no-autoloads
522 ;; Sort them for better readability.
523 (setq no-autoloads (sort no-autoloads 'string<))
524 ;; Add the `no-autoloads' section.
525 (goto-char (point-max))
526 (search-backward "\f" nil t)
527 (autoload-insert-section-header
528 (current-buffer) nil nil no-autoloads this-time)
529 (insert generate-autoload-section-trailer))
530 (save-buffer))))
533 ;;;_ , Doing actions to arrange preloads
534 ;;;_ . elinstall-insert-add-to-path
535 (defun elinstall-insert-add-to-path (new path-sym)
536 "Insert code to add NEW to PATH-SYM.
537 Insert this at point in current buffer."
538 (insert "\n")
540 `(add-to-list ',path-sym
541 (expand-file-name ,new
542 (if load-file-name
543 (file-name-directory
544 (file-truename load-file-name)))))
545 (current-buffer)))
547 ;;;_ . elinstall-insert-add-to-load-path
548 (defun elinstall-insert-add-to-load-path (new)
549 "Insert code to add NEW to load-path.
550 Insert this at point in current buffer."
551 (elinstall-insert-add-to-path new 'load-path))
553 ;;;_ . elinstall-insert-add-to-info-path
554 (defun elinstall-insert-add-to-info-path (new)
555 "Insert code to add NEW to info-path.
556 Insert this at point in current buffer."
557 (elinstall-insert-add-to-path new 'Info-default-directory-list))
559 ;;;_ . elinstall-symlink-on-emacs-start
560 (defun elinstall-symlink-on-emacs-start
561 (filename target-basename target-dir &optional priority force)
562 "Symlink to TARGET-BASENAME.el in TARGET-DIR
564 If PRIORITY is given, it will be used as the priority prefix,
565 otherwise elinstall-default-priority will be.
566 PRIORITY must be an integer or nil.
567 If FORCE is `t', do it regardless of timestamps etc.
568 Other non-nil cases of FORCE are reserved for future development."
569 (let*
571 (priority (or priority elinstall-default-priority))
572 (target-name-nodir
573 (format
574 "%d%s.el"
575 priority
576 target-basename))
577 (target
578 (expand-file-name target-name-nodir target-dir)))
581 (cond
582 ;;Path should already exist.
583 ((not
584 (file-exists-p target-dir))
585 (message "The target directory doesn't exist."))
586 ;;Target shouldn't already exist, but if force is given, let
587 ;;user override.
588 ((and
589 (file-exists-p target)
591 (not force)
592 (not
593 (yes-or-no-p
594 (format "Really overwrite %s? " project-name))))
595 (message "No symlink made to %s" target)))
598 (make-symbolic-link
599 filename
600 target
601 nil)))))
603 ;;;_ . elinstall-add-to-dot-emacs
604 (defun elinstall-add-to-dot-emacs (dot-emacs-name filename force &rest r)
605 "Add code to load FILENAME to .emacs.
606 FILENAME should not have an extension"
608 ;;Visit .emacs
609 (with-current-buffer (find-file-noselect dot-emacs-name)
610 (save-excursion
611 ;;add at end of file
612 (goto-char (point-max))
613 (insert "\n;;Added by elinstall")
614 (insert "\n;;Consider using my-site-start to manage .emacs\n")
615 (pp `(load ,filename) (current-buffer))
616 (save-buffer))))
619 ;;;_ . elinstall-link-on-emacs-start
620 ;;;###autoload
621 (defun elinstall-link-on-emacs-start (filename force basename priority)
624 ;;Figure out parameters, using defaults when needed.
625 (let*
626 ( (preload-target elinstall-default-preload-target))
628 ;;Dispatch the possibilities.
629 (cond
630 ((eq preload-target 'dot-emacs)
631 (elinstall-add-to-dot-emacs "~/.emacs" filename))
632 ((stringp preload-target)
633 (elinstall-symlink-on-emacs-start
634 filename basename preload-target priority force))
637 (message "I don't recognize that")))))
639 ;;;_ , Cleanup actions
640 ;;Nothing yet. This will be another type of action.
642 ;;;_ . Segregating actions
643 ;;;_ , elinstall-segregate-actions
644 (defun elinstall-segregate-actions (actions)
645 "Return actions segregated by deffile.
647 Returns a list whose elements are each a cons of:
648 * deffile filename or nil
649 * A list of actions to be done for that deffile."
651 (let
652 ((segment-list '()))
653 (dolist (act actions)
654 (when act
655 (let*
656 ( (deffile-name
657 (case (car act)
658 ((add-file-autoloads
659 add-to-info-path
660 add-to-load-path)
661 (second act))
662 (preload-file nil)))
664 (cell (assoc deffile-name segment-list)))
665 (if cell
666 (setcdr cell (cons act (cdr cell)))
667 (setq segment-list
668 (cons
669 (cons
670 deffile-name
671 (list act))
672 segment-list))))))
673 segment-list))
677 ;;;_ . Finding actions
678 ;;;_ , Treating the parameter list
679 ;;;_ . elinstall-add-parameter
680 (defun elinstall-add-parameter (alist key new-value)
681 "Add a new value for KEY to ALIST"
683 (cons
684 (cons key new-value)
685 (assq-delete-all key (copy-list alist))))
687 ;;;_ . elinstall-get-parameter
688 (defun elinstall-get-parameter (alist key)
689 "Get the value of KEY from ALIST"
691 (cdr (assq key alist)))
692 ;;;_ . elinstall-expand-file-name
693 ;;$$OBSOLETE
695 (defun elinstall-expand-file-name (filename alist)
696 "Expand FILENAME by the value of `path' in ALIST"
697 (expand-file-name
698 filename
699 (elinstall-get-parameter alist 'path)))
700 ;;;_ , Finding deffiles
701 ;;;_ . elinstall-expand-deffile-name
702 (defun elinstall-expand-deffile-name (deffile)
703 "Expand DEFFILE autoload.el's way."
705 (expand-file-name (or deffile "loaddefs.el")
706 (expand-file-name "lisp"
707 source-directory)))
709 ;;;_ . elinstall-maybe-get-deffile
710 (defun elinstall-maybe-get-deffile (file)
711 "If FILE defined `generated-autoload-file', return it.
712 Otherwise return nil.
713 Return it as an absolute filename."
715 (save-excursion
716 ;;$$FIXME load buffer if it's not already loaded
717 (let*
718 ((existing-buffer (get-file-buffer file)))
720 ;; We want to get a value for generated-autoload-file from
721 ;; the local variables section if it's there.
722 ;;But if it's not loaded, we don't? Maybe should use
723 ;; `autoload-find-file' and load it.
724 (if existing-buffer
725 (set-buffer existing-buffer))
726 (if (local-variable-p 'generated-autoload-file)
727 (elinstall-expand-deffile-name
728 generated-autoload-file)
729 nil))))
733 ;;;_ , elinstall-find-actions-by-spec
735 (defun elinstall-find-actions-by-spec (spec load-path-element path parameters)
736 "Return a list of actions to do, controlled by SPEC and PARAMETERS.
738 LOAD-PATH-ELEMENT is the conceptual element of load-path that
739 surrounds PATH. It may not yet have been added to load-path."
740 (if (consp spec)
741 ;;$$IMPROVE ME by adding the other cases in the design.
742 (case (car spec)
744 (let
745 ((new-path
746 (expand-file-name
747 (second spec)
748 path)))
750 (elinstall-find-actions-by-spec
751 (third spec)
752 load-path-element
753 new-path
754 parameters)))
756 (all
757 (apply #'append
758 (mapcar
759 #'(lambda (sub-spec)
760 (elinstall-find-actions-by-spec
761 sub-spec
762 load-path-element
763 path
764 parameters))
765 (cdr spec))))
766 ;;$$WRITEME
767 (file
770 (dir
771 (let
772 ((dirname
773 (expand-file-name
774 (second spec)
775 path))
776 (load-path-here
777 (not
778 (elinstall-get-parameter
779 parameters 'block-add-to-load-path))))
780 (cons
781 ;;$$IMPROVE ME
782 ;;Do this only if there are loadable files.
783 (if load-path-here
784 `(add-to-load-path
785 ,(elinstall-get-parameter
786 parameters 'def-file)
787 ,dirname)
788 '())
789 ;;$$IMPROVE ME
790 ;;Do add-to-info-path too. But test if there are
791 ;;any info files present.
793 ;;$$IMPROVE ME
794 ;; We want to get a value for generated-autoload-file
795 ;; from the local variables section if it's there.
796 ;;Use `elinstall-maybe-get-deffile'
797 ;; Otherwise we'll use `def-file' in parameters.
799 ;;$$FIXME This isn't quite right. If directory
800 ;;itself is not in load-path, this will be wrong.
801 ;;Gotta know where our encompassing part of
802 ;;load-path is.
804 ;;$$ENCAP ME This should be shared with the
805 ;;treatment of (file FN)
807 ;;$$FIXME Don't do directories, but maybe recurse on
808 ;;them, if a flag is set. And since we definitely
809 ;;have a load-path element here,
810 ;;'block-add-to-load-path according to a parameter.
811 ;;Maybe could follow/not symlinks similarly.
812 (mapcar
813 #'(lambda (filename)
814 (let
815 ((full-path
816 (expand-file-name filename dirname)))
817 `(add-file-autoloads
818 ,(elinstall-get-parameter
819 parameters 'def-file)
820 ,(file-name-sans-extension
821 (file-relative-name
822 full-path
823 load-path-element))
824 ,load-path-element ;;Is this still used?
825 ,full-path)))
827 (directory-files
828 dirname
829 nil ;;Relative filenames
830 elinstall-elisp-regexp)))))
832 (def-file
833 (let
834 ((new-def-file
835 (expand-file-name
836 (second spec)
837 path)))
838 (elinstall-find-actions-by-spec
839 (third spec)
840 load-path-element
841 path
842 (elinstall-add-parameter parameters
843 'def-file new-def-file)))))
845 ;;$$IMPROVE ME by adding the other cases in the design.
846 (case spec
847 (t))))
848 ;;;_ . high-level work
849 ;;;_ , elinstall-get-relevant-load-path
850 (defun elinstall-get-relevant-load-path (actions)
852 (delq nil
853 (mapcar
854 #'(lambda (act)
855 (case (car act)
856 (add-to-load-path
857 (second act))
858 (t nil)))
859 actions)))
861 ;;;_ , elinstall-do-segment
862 (defun elinstall-do-segment (segment force use-load-path)
863 "Do all the actions in SEGMENT.
864 FORCE has its usual meaning.
865 USE-LOAD-PATH is the effective load-path."
867 ;;$$IMPROVE ME - this will have to know the additions to load-path.
868 (let*
869 ((deffile (car segment)))
870 (if (stringp deffile)
871 (elinstall-update-deffile deffile (cdr segment) force
872 use-load-path)
873 ;;Do other actions: link-in actions and cleanups.
874 (mapcar
875 #'(lambda (act)
876 ;;$$FIXME Distinguish link-in and cleanup actions.
877 (apply
878 #'elinstall-link-on-emacs-start
879 force
880 (cdr act)))
881 (cdr segment)))))
884 ;;;_ . Overall work
885 ;;;_ , elinstall-x
886 (defun elinstall-x (dir spec &optional preload-target force)
888 (let*
889 ((actions
890 (elinstall-find-actions-by-spec
891 spec
895 ;;$$RETHINK ME - maybe hand this work off to autoload?
896 ;;This is just the default loaddefs file, spec actually
897 ;;controls it.
898 (def-file . ,(elinstall-expand-deffile-name nil) ))))
899 (segment-list (elinstall-segregate-actions actions))
900 (use-load-path
901 (elinstall-get-relevant-load-path
902 actions)))
904 (mapcar
905 #'(lambda (segment)
906 (elinstall-do-segment segment force use-load-path))
907 segment-list)))
909 ;;;_ . Entry points
910 ;;;_ , elinstall
911 (defun elinstall (project-name dir spec &optional preload-target force)
912 "Install elisp files.
914 They need not be presented as a package.
916 Parameters:
917 PROJECT-NAME - the name of the project
918 DIR - the root directory of the project.
919 Suggestion: (elinstall-directory-true-name)
921 SPEC - a spec for the autoloads etc to make. It can be as simple as
922 `(in DIRECTORY t).
923 Suggestion: `(in ,(elinstall-directory-true-name) t)
924 PRELOAD-TARGET is where the autoload files are to be symlinked in. If
925 `nil' `elinstall-default-preload-target' is used instead.
927 If FORCE is t, install a package even if it has already been
928 installed.
929 Other non-nil cases of FORCE are reserved for future development."
931 (when
932 (and
933 (or
934 force
935 (not (elinstall-already-installed project-name)))
936 ;;$$RE-ADD ME - I commented it out just for development.
937 '(yes-or-no-p (format "Install %s " project-name)))
938 (elinstall-x dir spec preload-target force)
940 ;;$$RE-ADD ME - I commented it out just for development.
941 '(elinstall-record-installed project-name)))
945 ;;;_ , elinstall-update-directory-autoloads
946 ;;$$TEST ME
947 (defun elinstall-update-directory-autoloads (dir)
950 (interactive "DInstall all elisp files from directory: ")
952 (elinstall-x
954 '(dir ".")
955 (elinstall-expand-deffile-name
956 generated-autoload-file)))
959 ;;;_ , elinstall-update-file-autoloads
960 ;;$$TEST ME
961 (defun elinstall-update-file-autoloads (file)
964 (interactive "fInstall elisp file: ")
965 (elinstall
966 file
967 `(file ,file)
969 (elinstall-maybe-get-deffile file)
970 (elinstall-expand-deffile-name
971 generated-autoload-file))))
978 ;;;_. Footers
979 ;;;_ , Provides
981 (provide 'elinstall)
983 ;;;_ * Local emacs vars.
984 ;;;_ + Local variables:
985 ;;;_ + mode: allout
986 ;;;_ + End:
988 ;;;_ , End
989 ;;; elinstall.el ends here