Rename elinstall-deffile-insert-x -> elinstall-deffile-insert-autoloads
[elinstall.git] / elinstall.el
blob20fede9287d434149febe8bf45edeaa3db9f91a2
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 (or visited
234 ;; We created this buffer, so we should kill it.
235 (kill-buffer (current-buffer))))
236 (not done-any)))
239 ;;;_ , elinstall-deffile-insert-autoloads
240 (defun elinstall-deffile-insert-autoloads (file load-name)
241 "Update the autoloads for FILE in current buffer.
242 Return FILE if there was no autoload cookie in it, else nil.
244 Current buffer must be a loaddef-style file.
246 LOAD-NAME is the absolute name of the file.
247 RELATIVE-NAME is its name respective to some component of load-path."
248 (let (
249 (found nil)
250 (no-autoloads nil))
252 (save-excursion
253 (save-restriction
254 (widen)
255 (goto-char (point-min))
256 ;; Look for the section for FILE
257 (while (and (not found)
258 (search-forward generate-autoload-section-header nil t))
259 (let ((form (autoload-read-section-header)))
260 (cond
261 ((equal (nth 2 form) file)
262 ;; We found the section for this file.
263 (let ((begin (match-beginning 0)))
264 (progn
265 (search-forward generate-autoload-section-trailer)
266 (delete-region begin (point))
267 (setq found t))))
268 ((string< file (nth 2 form))
269 ;; We've come to a section alphabetically later than
270 ;; FILE. We assume the file is in order and so
271 ;; there must be no section for FILE. We will
272 ;; insert one before the section here.
273 (goto-char (match-beginning 0))
274 (setq found 'new)))))
275 (unless found
276 (progn
277 (setq found 'new)
278 ;; No later sections in the file. Put before the last page.
279 (goto-char (point-max))
280 (search-backward "\f" nil t)))
281 (setq no-autoloads
282 (elinstall-generate-file-autoloads file load-name))))
284 (if no-autoloads file nil)))
285 ;;;_ . Arranging to add to info-path and load-path
286 ;;;_ , elinstall-generate-add-to-path
287 (defun elinstall-generate-add-to-path (path-element type)
289 ;;$$WRITEME
290 (let*
294 ;;;_ , elinstall-deffile-insert-add-to-path
295 (defun elinstall-deffile-insert-add-to-path (path-element type)
296 "Insert code in current buffer to add PATH-ELEMENT to load-path.
298 Current buffer must be a loaddef-style file.
300 LOAD-NAME is the full name of the file."
301 (let (
302 (found nil)
303 (no-autoloads nil))
305 (save-excursion
306 (save-restriction
307 (widen)
308 (goto-char (point-min))
309 ;; Look for the section for PATH-ELEMENT
310 (while (and (not found)
311 (search-forward generate-autoload-section-header nil t))
312 (let ((form (autoload-read-section-header)))
313 (cond
314 ((and
315 (equal (nth 0 form) type)
316 (member (nth 1 form) path-element))
318 ;; We found the section for this add.
319 (let ((begin (match-beginning 0)))
320 (progn
321 (search-forward generate-autoload-section-trailer)
322 (delete-region begin (point))
323 (setq found t)))))))
325 (unless found
326 (progn
327 (setq found 'new)
328 ;; No later sections in the file. Put before the last page.
329 (goto-char (point-max))
330 (search-backward "\f" nil t)))
332 (elinstall-generate-file-autoloads file load-name)))
334 ;;This never belongs in the no-autoloads section.
335 nil))
337 ;;;_ . elinstall-deffile-insert
339 (defun elinstall-deffile-insert (action)
340 "Insert autoloads etc into current file according to ACTION.
341 The format of ACTION is described in the design docs.
343 Return filename if this action belongs in the no-autoload section."
345 (when action
346 (case (car action)
347 (add-file-autoloads
348 (elinstall-deffile-insert-autoloads
349 (third action)
350 (fifth action)))
352 (add-to-load-path
353 (elinstall-deffile-insert-add-to-path
354 (second action)
355 'add-to-load-path)
356 nil)
358 ;;Similar, but for info-path.
359 (add-to-info-path
360 (elinstall-deffile-insert-add-to-path
361 (second action)
362 'add-to-info-path)
363 nil)
365 (preload-file
366 (error "This case should not come here.")))))
368 ;;;_ . elinstall-prepare-deffile
369 (defun elinstall-prepare-deffile (deffile)
370 "Try to ensure that DEFFILE is available for receiving autoloads"
372 (autoload-ensure-default-file deffile)
373 (with-current-buffer (find-file-noselect deffile)
376 ;; We must read/write the file without any code conversion,
377 ;; but still decode EOLs.
378 (let ((coding-system-for-read 'raw-text))
380 ;; This is to make generated-autoload-file have Unix EOLs, so
381 ;; that it is portable to all platforms.
382 (setq buffer-file-coding-system 'raw-text-unix))
383 (or (> (buffer-size) 0)
384 (error "Autoloads file %s does not exist" buffer-file-name))
385 (or (file-writable-p buffer-file-name)
386 (error "Autoloads file %s is not writable"
387 buffer-file-name))))
389 ;;;_ . elinstall-update-deffile
391 ;;Adapted from autoload.el `update-directory-autoloads'.
392 ;;Still being adapted:
394 ;; * Still need to treat add-to-info-path and
395 ;;add-to-load-path. Both recognize them and insert them.
396 ;; * Adapt `elinstall-update-file-autoloads' to understand actions.
398 ;; * Finding "file" among actions is rickety. Maybe knowing the
399 ;; respective load-path element would help.
401 (defun elinstall-update-deffile (target actions &optional
402 use-load-path force)
404 Update file TARGET with current autoloads as specified by ACTIONS.
405 Also remove any old definitions pointing to libraries that can no
406 longer be found.
408 ACTIONS must be a list of actions (See the format doc). Each one's
409 filename must be relative to some element of load-path.
411 USE-LOAD-PATH is a list to use as load-path. It should include
412 any new load-path that we are arranging to create. If it's not given,
413 load-path itself is used.
415 If FORCE is `t', do it regardless of timestamps etc. (Not implemented)
416 Other non-nil cases of FORCE are reserved for future development.
418 This uses `update-file-autoloads' (which see) to do its work.
419 In an interactive call, you must give one argument, the name
420 of a single directory."
421 (let
423 (use-load-path (or use-load-path load-path))
424 (this-time (current-time))
425 ;;files with no autoload cookies.
426 (no-autoloads nil))
428 (elinstall-prepare-deffile target)
429 (with-current-buffer
430 (find-file-noselect target)
431 (save-excursion
432 (setq actions
433 (elinstall-remove-autogen-action
434 (autoload-trim-file-name target)
435 actions))
437 (goto-char (point-min))
438 (while (search-forward generate-autoload-section-header nil t)
439 (let* ((form (autoload-read-section-header))
440 (file (nth 3 form)))
441 (cond ((and (consp file) (stringp (car file)))
442 ;; This is a list of files that have no
443 ;; autoload cookies.
444 ;; There shouldn't be more than one such entry.
445 ;; Remove the obsolete section.
446 (autoload-remove-section (match-beginning 0))
447 (let ((last-time (nth 4 form)))
448 (dolist (file file)
449 (let ((file-time (nth 5 (file-attributes file))))
450 (when (and file-time
451 (not (time-less-p last-time file-time)))
452 ;; file unchanged
453 (push file no-autoloads)
454 (setq actions
455 (elinstall-remove-autogen-action
456 file actions)))))))
457 ((not (stringp file)))
459 (let
460 ((file-path
461 (locate-library file nil use-load-path)))
462 (cond
463 ;;File doesn't exist, so remove its
464 ;;section.
465 ((not file-path)
466 (autoload-remove-section
467 (match-beginning 0)))
469 ;; File hasn't changed, so do nothing.
470 ((equal
471 (nth 4 form)
472 (nth 5 (file-attributes file-path)))
473 nil)
475 (elinstall-deffile-insert
476 (elinstall-get-autogen-action
477 file actions))))
479 (setq actions
480 (elinstall-remove-autogen-action
481 file actions))))))))
483 ;; Remaining actions have no existing autoload sections yet.
484 (setq no-autoloads
485 (append no-autoloads
486 (delq nil (mapcar #'elinstall-deffile-insert actions))))
487 (when no-autoloads
488 ;; Sort them for better readability.
489 (setq no-autoloads (sort no-autoloads 'string<))
490 ;; Add the `no-autoloads' section.
491 (goto-char (point-max))
492 (search-backward "\f" nil t)
493 (autoload-insert-section-header
494 (current-buffer) nil nil no-autoloads this-time)
495 (insert generate-autoload-section-trailer))
496 (save-buffer))))
499 ;;;_ , Doing actions to arrange preloads
500 ;;;_ . elinstall-insert-add-to-path
501 (defun elinstall-insert-add-to-path (new path-sym)
502 "Insert code to add NEW to PATH-SYM.
503 Insert this at point in current buffer."
504 (insert "\n")
506 `(add-to-list ',path-sym
507 (expand-file-name ,new
508 (if load-file-name
509 (file-name-directory
510 (file-truename load-file-name)))))
511 (current-buffer)))
513 ;;;_ . elinstall-insert-add-to-load-path
514 (defun elinstall-insert-add-to-load-path (new)
515 "Insert code to add NEW to load-path.
516 Insert this at point in current buffer."
517 (elinstall-insert-add-to-path new 'load-path))
519 ;;;_ . elinstall-insert-add-to-info-path
520 (defun elinstall-insert-add-to-info-path (new)
521 "Insert code to add NEW to info-path.
522 Insert this at point in current buffer."
523 (elinstall-insert-add-to-path new 'Info-default-directory-list))
525 ;;;_ . elinstall-symlink-on-emacs-start
526 (defun elinstall-symlink-on-emacs-start
527 (filename target-basename target-dir &optional priority force)
528 "Symlink to TARGET-BASENAME.el in TARGET-DIR
530 If PRIORITY is given, it will be used as the priority prefix,
531 otherwise elinstall-default-priority will be.
532 PRIORITY must be an integer or nil.
533 If FORCE is `t', do it regardless of timestamps etc.
534 Other non-nil cases of FORCE are reserved for future development."
535 (let*
537 (priority (or priority elinstall-default-priority))
538 (target-name-nodir
539 (format
540 "%d%s.el"
541 priority
542 target-basename))
543 (target
544 (expand-file-name target-name-nodir target-dir)))
547 (cond
548 ;;Path should already exist.
549 ((not
550 (file-exists-p target-dir))
551 (message "The target directory doesn't exist."))
552 ;;Target shouldn't already exist, but if force is given, let
553 ;;user override.
554 ((and
555 (file-exists-p target)
557 (not force)
558 (not
559 (yes-or-no-p
560 (format "Really overwrite %s? " project-name))))
561 (message "No symlink made to %s" target)))
564 (make-symbolic-link
565 filename
566 target
567 nil)))))
569 ;;;_ . elinstall-add-to-dot-emacs
570 (defun elinstall-add-to-dot-emacs (dot-emacs-name filename force &rest r)
571 "Add code to load FILENAME to .emacs.
572 FILENAME should not have an extension"
574 ;;Visit .emacs
575 (with-current-buffer (find-file-noselect dot-emacs-name)
576 (save-excursion
577 ;;add at end of file
578 (goto-char (point-max))
579 (insert "\n;;Added by elinstall")
580 (insert "\n;;Consider using my-site-start to manage .emacs\n")
581 (pp `(load ,filename) (current-buffer))
582 (save-buffer))))
585 ;;;_ . elinstall-link-on-emacs-start
586 ;;;###autoload
587 (defun elinstall-link-on-emacs-start (filename force basename priority)
590 ;;Figure out parameters, using defaults when needed.
591 (let*
592 ( (preload-target elinstall-default-preload-target))
594 ;;Dispatch the possibilities.
595 (cond
596 ((eq preload-target 'dot-emacs)
597 (elinstall-add-to-dot-emacs "~/.emacs" filename))
598 ((stringp preload-target)
599 (elinstall-symlink-on-emacs-start
600 filename basename preload-target priority force))
603 (message "I don't recognize that")))))
605 ;;;_ , Cleanup actions
606 ;;Nothing yet. This will be another type of action.
608 ;;;_ . Segregating actions
609 ;;;_ , elinstall-segregate-actions
610 (defun elinstall-segregate-actions (actions)
611 "Return actions segregated by deffile.
613 Returns a list whose elements are each a cons of:
614 * deffile filename or nil
615 * A list of actions to be done for that deffile."
617 (let
618 ((segment-list '()))
619 (dolist (act actions)
620 (when act
621 (let*
622 ( (deffile-name
623 (case (car act)
624 ((add-file-autoloads
625 add-to-info-path
626 add-to-load-path)
627 (second act))
628 (preload-file nil)))
630 (cell (assoc deffile-name segment-list)))
631 (if cell
632 (setcdr cell (cons act (cdr cell)))
633 (setq segment-list
634 (cons
635 (cons
636 deffile-name
637 (list act))
638 segment-list))))))
639 segment-list))
643 ;;;_ . Finding actions
644 ;;;_ , Treating the parameter list
645 ;;;_ . elinstall-add-parameter
646 (defun elinstall-add-parameter (alist key new-value)
647 "Add a new value for KEY to ALIST"
649 (cons
650 (cons key new-value)
651 (assq-delete-all key (copy-list alist))))
653 ;;;_ . elinstall-get-parameter
654 (defun elinstall-get-parameter (alist key)
655 "Get the value of KEY from ALIST"
657 (cdr (assq key alist)))
658 ;;;_ . elinstall-expand-file-name
659 ;;$$OBSOLETE
661 (defun elinstall-expand-file-name (filename alist)
662 "Expand FILENAME by the value of `path' in ALIST"
663 (expand-file-name
664 filename
665 (elinstall-get-parameter alist 'path)))
666 ;;;_ , Finding deffiles
667 ;;;_ . elinstall-expand-deffile-name
668 (defun elinstall-expand-deffile-name (deffile)
669 "Expand DEFFILE autoload.el's way."
671 (expand-file-name (or deffile "loaddefs.el")
672 (expand-file-name "lisp"
673 source-directory)))
675 ;;;_ . elinstall-maybe-get-deffile
676 (defun elinstall-maybe-get-deffile (file)
677 "If FILE defined `generated-autoload-file', return it.
678 Otherwise return nil.
679 Return it as an absolute filename."
681 (save-excursion
682 ;;$$FIXME load buffer if it's not already loaded
683 (let*
684 ((existing-buffer (get-file-buffer file)))
686 ;; We want to get a value for generated-autoload-file from
687 ;; the local variables section if it's there.
688 ;;But if it's not loaded, we don't? Maybe should use
689 ;; `autoload-find-file' and load it.
690 (if existing-buffer
691 (set-buffer existing-buffer))
692 (if (local-variable-p 'generated-autoload-file)
693 (elinstall-expand-deffile-name
694 generated-autoload-file)
695 nil))))
699 ;;;_ , elinstall-find-actions-by-spec
701 (defun elinstall-find-actions-by-spec (spec load-path-element path parameters)
702 "Return a list of actions to do, controlled by SPEC and PARAMETERS.
704 LOAD-PATH-ELEMENT is the conceptual element of load-path that
705 surrounds PATH. It may not yet have been added to load-path."
706 (if (consp spec)
707 ;;$$IMPROVE ME by adding the other cases in the design.
708 (case (car spec)
710 (let
711 ((new-path
712 (expand-file-name
713 (second spec)
714 path)))
716 (elinstall-find-actions-by-spec
717 (third spec)
718 load-path-element
719 new-path
720 parameters)))
722 (all
723 (apply #'append
724 (mapcar
725 #'(lambda (sub-spec)
726 (elinstall-find-actions-by-spec
727 sub-spec
728 load-path-element
729 path
730 parameters))
731 (cdr spec))))
732 ;;$$WRITEME
733 (file
736 (dir
737 (let
738 ((dirname
739 (expand-file-name
740 (second spec)
741 path))
742 (load-path-here
743 (not
744 (elinstall-get-parameter
745 parameters 'block-add-to-load-path))))
746 (cons
747 ;;$$IMPROVE ME
748 ;;Do this only if there are loadable files.
749 (if load-path-here
750 `(add-to-load-path
751 ,(elinstall-get-parameter
752 parameters 'def-file)
753 ,dirname)
754 '())
755 ;;$$IMPROVE ME
756 ;;Do add-to-info-path too. But test if there are
757 ;;any info files present.
759 ;;$$IMPROVE ME
760 ;; We want to get a value for generated-autoload-file
761 ;; from the local variables section if it's there.
762 ;;Use `elinstall-maybe-get-deffile'
763 ;; Otherwise we'll use `def-file' in parameters.
765 ;;$$FIXME This isn't quite right. If directory
766 ;;itself is not in load-path, this will be wrong.
767 ;;Gotta know where our encompassing part of
768 ;;load-path is.
770 ;;$$ENCAP ME This should be shared with the
771 ;;treatment of (file FN)
773 ;;$$FIXME Don't do directories, but maybe recurse on
774 ;;them, if a flag is set. And since we definitely
775 ;;have a load-path element here,
776 ;;'block-add-to-load-path according to a parameter.
777 ;;Maybe could follow/not symlinks similarly.
778 (mapcar
779 #'(lambda (filename)
780 (let
781 ((full-path
782 (expand-file-name filename dirname)))
783 `(add-file-autoloads
784 ,(elinstall-get-parameter
785 parameters 'def-file)
786 ,(file-name-sans-extension
787 (file-relative-name
788 full-path
789 load-path-element))
790 ,load-path-element ;;Is this still used?
791 ,full-path)))
793 (directory-files
794 dirname
795 nil ;;Relative filenames
796 elinstall-elisp-regexp)))))
798 (def-file
799 (let
800 ((new-def-file
801 (expand-file-name
802 (second spec)
803 path)))
804 (elinstall-find-actions-by-spec
805 (third spec)
806 load-path-element
807 path
808 (elinstall-add-parameter parameters
809 'def-file new-def-file)))))
811 ;;$$IMPROVE ME by adding the other cases in the design.
812 (case spec
813 (t))))
814 ;;;_ . high-level work
815 ;;;_ , elinstall-get-relevant-load-path
816 (defun elinstall-get-relevant-load-path (actions)
818 (delq nil
819 (mapcar
820 #'(lambda (act)
821 (case (car act)
822 (add-to-load-path
823 (second act))
824 (t nil)))
825 actions)))
827 ;;;_ , elinstall-do-segment
828 (defun elinstall-do-segment (segment force use-load-path)
829 "Do all the actions in SEGMENT.
830 FORCE has its usual meaning.
831 USE-LOAD-PATH is the effective load-path."
833 ;;$$IMPROVE ME - this will have to know the additions to load-path.
834 (let*
835 ((deffile (car segment)))
836 (if (stringp deffile)
837 (elinstall-update-deffile deffile (cdr segment) force
838 use-load-path)
839 ;;Do other actions: link-in actions and cleanups.
840 (mapcar
841 #'(lambda (act)
842 ;;$$FIXME Distinguish link-in and cleanup actions.
843 (apply
844 #'elinstall-link-on-emacs-start
845 force
846 (cdr act)))
847 (cdr segment)))))
850 ;;;_ . Overall work
851 ;;;_ , elinstall-x
852 (defun elinstall-x (dir spec &optional preload-target force)
854 (let*
855 ((actions
856 (elinstall-find-actions-by-spec
857 spec
861 ;;$$RETHINK ME - maybe hand this work off to autoload?
862 ;;This is just the default loaddefs file, spec actually
863 ;;controls it.
864 (def-file . ,(elinstall-expand-deffile-name nil) ))))
865 (segment-list (elinstall-segregate-actions actions))
866 (use-load-path
867 (elinstall-get-relevant-load-path
868 actions)))
870 (mapcar
871 #'(lambda (segment)
872 (elinstall-do-segment segment force use-load-path))
873 segment-list)))
875 ;;;_ . Entry points
876 ;;;_ , elinstall
877 (defun elinstall (project-name dir spec &optional preload-target force)
878 "Install elisp files.
880 They need not be presented as a package.
882 Parameters:
883 PROJECT-NAME - the name of the project
884 DIR - the root directory of the project.
885 Suggestion: (elinstall-directory-true-name)
887 SPEC - a spec for the autoloads etc to make. It can be as simple as
888 `(in DIRECTORY t).
889 Suggestion: `(in ,(elinstall-directory-true-name) t)
890 PRELOAD-TARGET is where the autoload files are to be symlinked in. If
891 `nil' `elinstall-default-preload-target' is used instead.
893 If FORCE is t, install a package even if it has already been
894 installed.
895 Other non-nil cases of FORCE are reserved for future development."
897 (when
898 (and
899 (or
900 force
901 (not (elinstall-already-installed project-name)))
902 ;;$$RE-ADD ME - I commented it out just for development.
903 '(yes-or-no-p (format "Install %s " project-name)))
904 (elinstall-x dir spec preload-target force)
906 ;;$$RE-ADD ME - I commented it out just for development.
907 '(elinstall-record-installed project-name)))
911 ;;;_ , elinstall-update-directory-autoloads
912 ;;$$TEST ME
913 (defun elinstall-update-directory-autoloads (dir)
916 (interactive "DInstall all elisp files from directory: ")
918 (elinstall-x
920 '(dir ".")
921 (elinstall-expand-deffile-name
922 generated-autoload-file)))
925 ;;;_ , elinstall-update-file-autoloads
926 ;;$$TEST ME
927 (defun elinstall-update-file-autoloads (file)
930 (interactive "fInstall elisp file: ")
931 (elinstall
932 file
933 `(file ,file)
935 (elinstall-maybe-get-deffile file)
936 (elinstall-expand-deffile-name
937 generated-autoload-file))))
944 ;;;_. Footers
945 ;;;_ , Provides
947 (provide 'elinstall)
949 ;;;_ * Local emacs vars.
950 ;;;_ + Local variables:
951 ;;;_ + mode: allout
952 ;;;_ + End:
954 ;;;_ , End
955 ;;; elinstall.el ends here