1 ;;;_ elinstall.el --- Automatically and flexibly install elisp files
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)
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.
30 ;; elinstall Use this for overall loading
32 ;; elinstall-update-directory-autoloads
33 ;; elinstall-update-file-autoloads
34 ;; elinstall-update-directory
35 ;; elinstall-update-file
42 (require 'cus-edit
) ;;Because we save "installedness" manually
43 (require 'byte-compile nil t
) ;;
51 "Customizations for elinstall"
53 ;;;_ . elinstall-default-priority
54 (defcustom elinstall-default-priority
56 "Default priority for site-start"
59 ;;;_ . elinstall-default-preload-target
60 (defcustom elinstall-default-preload-target
61 "~/.emacs.d/site-start.d/"
62 "Default preload-target for registering autoloads"
66 (const "~/.emacs.d/site-start.d/")
67 (const "/etc/emacs/site-start.d/")
71 ;;;_ . elinstall-restrain-install
72 (defcustom elinstall-restrain-install
'()
73 "Restrain elinstall for specific packages"
78 (choice :format
"%[%t%]: %v"
79 (string :tag
"Package name")
80 (const :tag
"All packages" t
))
81 (repeat :tag
"Actions to restrain:"
90 (const customizations
)
92 (const :tag
"Use as default" t
))
95 :tag
"Do this unless it's up to date"
98 :tag
"Use the package spec for this"
101 :tag
"Don't do this at all"
107 :tag
"Ask only when it's up-to-date."
110 :tag
"Do everything even if it's up to date."
114 ;;;_ . elinstall-already-installed
116 (defcustom elinstall-already-installed
118 "(AUTOMATIC) Things that have already been installed.
119 This exists for recording what has been installed.
121 Though it's saved as customizable, user interaction is not
123 ;;Tell the byte-compiler it's a variable.
124 (defvar elinstall-already-installed
)
126 ;;;_ . elinstall-stages
127 (defstruct (elinstall-stages
128 (:constructor elinstall-make-stages
)
129 (:conc-name elinstall-stages-
>)
131 "The elinstall stages"
137 ;;;_ . Regular expressions
138 ;;;_ , elinstall-elisp-regexp
139 (defconst elinstall-elisp-regexp
142 (suf (get-load-suffixes))
143 (unless (string-match "\\.elc" suf
) (push suf tmp
)))
144 (concat "^[^=.].*" (regexp-opt tmp t
) "\\'"))
145 "Regular expression that matches elisp files" )
147 ;;;_ . elinstall-file-mod-time
148 (defsubst elinstall-file-mod-time
(file)
149 "Return the modification time of FILE"
150 (nth 5 (file-attributes file
)))
152 ;;;_ . elinstall-directory-true-name
153 (defun elinstall-directory-true-name ()
154 "Get the true name of the directory the calling code lives in.
155 CAUTION: This is sensitive to where it's called. That's the point of it."
158 (file-truename load-file-name
)
159 (file-truename buffer-file-name
))))
160 ;;;_ . Checking installedness
161 ;;;_ , elinstall-get-installation-record
162 (defun elinstall-get-installation-record (project-name)
163 "Return the installation record for PROJECT-NAME."
165 (assoc project-name elinstall-already-installed
))
167 ;;;_ , elinstall-already-installed
168 (defun elinstall-already-installed (project-name)
169 "Return non-nil if PROJECT-NAME has been installed."
170 (elinstall-get-installation-record project-name
))
172 ;;;_ , elinstall-record-installed
173 (defun elinstall-record-installed (project-name &optional version
)
174 "Record that PROJECT-NAME has been installed."
183 (elinstall-get-installation-record project-name
))
187 (setq elinstall-already-installed
188 (delete old-item elinstall-already-installed
)))
189 (push new-item elinstall-already-installed
)
190 (customize-save-variable
191 'elinstall-already-installed
192 elinstall-already-installed
193 "Set by elinstall-record-installed")))
194 ;;;_ . Finding deffiles
195 ;;;_ , elinstall-expand-deffile-name
196 (defun elinstall-expand-deffile-name (deffile)
197 "Expand DEFFILE autoload.el's way."
199 (expand-file-name (or deffile
"loaddefs.el")
200 (expand-file-name "lisp"
202 ;;;_ . Checking restraint specs
203 ;;;_ , elinstall-call-with-restraints
204 (defun elinstall-call-with-restraints (restraints package func
&rest args
)
205 "Call FUNC with ARGS, in scope of RESTRAINTS.
206 RESTRAINTS is a list of package restraints. User restraints for the
207 given package will also be applied in scope.
209 PACKAGE can be `t' or a string naming a package."
212 ((elinstall:*pkg-restraints
* restraints
)
213 (elinstall:*user-restraints
*
217 (assoc package elinstall-restrain-install
)
218 (assoc t elinstall-restrain-install
))))
223 elinstall
:*pkg-restraints
*
224 elinstall
:*user-restraints
*))
226 ;;;_ , elinstall-get-restraint
227 (defun elinstall-get-restraint (topic)
228 "Get the applicable restraint symbol for TOPIC.
229 Call this transitively only thru `elinstall-call-with-restraints'."
230 (check-type topic symbol
)
232 elinstall
:*pkg-restraints
*
233 elinstall
:*user-restraints
*))
235 (boundp 'elinstall
:*pkg-restraints
*)
236 (boundp 'elinstall
:*user-restraints
*))
237 (error "elinstall-proceed-p called out of scope"))
242 (assq topic elinstall
:*user-restraints
*)
243 (assq t elinstall
:*user-restraints
*)))
245 ;;`t' means use the pkg-restraints value instead.
247 (or (not cell
) (eq (second cell
) t
))
249 (assq topic elinstall
:*pkg-restraints
*)
250 (assq t elinstall
:*pkg-restraints
*))
252 ;;Default is to just update.
253 (if cell
(second cell
) 'update
)))
255 ;;;_ , elinstall-proceed-p
256 (defun elinstall-proceed-p
257 (topic message-params
&optional already-p
)
258 "Return non-nil if actions on TOPIC should proceed.
259 Call this transitively only thru `elinstall-call-with-restraints'.
260 TOPIC is a symbol indicating the topic, such as `byte-compile'.
261 MESSAGE-PARAMS is a cons of:
262 * A list of format strings:
263 * To ask whether to do this action
264 * To ask whether to redo this action, for `ask-for-old'
265 * To report that this action was skipped because already done.
266 * The arguments to the formatter.
267 ALREADY-P is an extended boolean whether the task has been done
268 before, if caller can tell."
272 ((ask-prompt &optional redo-prompt noredo-msg
) &rest message-args
)
274 (case (elinstall-get-restraint topic
)
282 (apply #'message noredo-msg message-args
)
287 (y-or-n-p (apply #'format redo-prompt message-args
))
291 (apply #'format ask-prompt message-args
))))))
292 ;;;_ , elinstall-proceed-at-all-p
293 (defsubst elinstall-proceed-at-all-p
(topic)
294 "Return non-nil if there's any possibility that actions on TOPIC should proceed."
295 ;;It just so happens that `nil' treatment corresponds to `nil'
297 (elinstall-get-restraint topic
))
302 ;;;_ , Doing autoload actions (adapted from autoload.el)
303 ;;;_ . Utilities about the action list
304 ;;;_ , elinstall-remove-autogen-action
305 (defun elinstall-remove-autogen-action (file actions
)
306 "Return ACTIONS minus any add-file-autoloads on FILE removed."
313 (if (equal file
(third act
))
318 ;;;_ , elinstall-get-autogen-action
319 (defun elinstall-get-autogen-action (file actions
)
323 (dolist (act actions
)
326 (when (equal file
(third act
))
327 (setq the-act act
)))))
329 ;;;_ . About printing to autoload file
330 ;;;_ , elinstall-insert-section-header
331 (defun elinstall-insert-section-header (outbuf form
)
332 "Insert the section-header line,
333 which lists the file name and which functions are in it, etc."
334 (insert generate-autoload-section-header
)
337 ;; Break that line at spaces, to avoid very long lines.
338 ;; Make each sub-line into a comment.
339 (with-current-buffer outbuf
344 (skip-chars-forward "^ \n")
346 (insert "\n" generate-autoload-section-continuation
))))))
348 ;;;_ , elinstall-insert-autoload-section
349 (defun elinstall-insert-autoload-section (text form
&optional comment-string
)
350 "Insert TEXT into current buffer as an autoload section"
355 ;; This does something in Lucid Emacs.
357 (float-output-format nil
))
359 (elinstall-insert-section-header (current-buffer) form
)
361 (insert ";;; " comment-string
"\n"))
363 (insert generate-autoload-section-trailer
)))
365 ;;;_ . Making autoloads
366 ;;;_ , elinstall-make-autoload-action
367 (defun elinstall-make-autoload-action (buf def-file load-path-element full-path
)
368 "Return the autoloads for current buffer as a string"
370 ;;We put all the text into a temp buffer, then get that buffer's
374 (generate-new-buffer " *temp*"))
377 (file-name-nondirectory full-path
))
381 ;; Apparently this does something in Lucid Emacs.
383 (float-output-format nil
)
385 ;;load-name relative to a member of load-path.
387 (file-name-sans-extension
390 load-path-element
))))
392 (with-current-buffer buf
397 (goto-char (point-min))
398 (message "Finding autoloads for %s..." short-name
)
400 (skip-chars-forward " \t\n\f")
402 ((looking-at (regexp-quote generate-autoload-cookie
))
403 (search-forward generate-autoload-cookie
)
404 (skip-chars-forward " \t")
406 ;; Read the next form and make an autoload.
407 (let* ((form (prog1 (read (current-buffer))
408 (or (bolp) (forward-line 1))))
410 (make-autoload form relative-name
)))
412 (push (nth 1 form
) autoloads-done
)
413 (setq autoload form
))
414 (let ((autoload-print-form-outbuf outbuf
))
415 (autoload-print-form autoload
)))
417 ;; Copy the rest of the line to the output.
418 (princ (buffer-substring
420 ;; Back up over whitespace,
422 (skip-chars-backward " \f\t")
423 (if (= (char-after (1+ (point))) ?
)
427 (progn (forward-line 1) (point)))
430 ;; Don't read the comment.
435 (message "Finding autoloads for %s...done" short-name
))
437 ;;Return this action. The temp buffer's contents is
443 ,(with-current-buffer outbuf
(buffer-string))
446 ;;This in unwind-protected
447 (when (buffer-live-p outbuf
) (kill-buffer outbuf
))))))
450 ;;;_ , elinstall-generate-file-autoloads
452 (defun elinstall-generate-file-autoloads
453 (relative-name full-name text autoloads-done
)
454 "Insert at point a loaddefs autoload section for FILE.
455 Autoloads are generated for defuns and defmacros in FILE
456 marked by `generate-autoload-cookie' (which see).
457 If FILE is being visited in a buffer, the contents of the buffer
459 Return non-nil in the case where no autoloads were added at point.
461 FULL-NAME is the absolute name of the file.
462 RELATIVE-NAME is its name respective to some component of load-path."
463 (if (not (equal text
""))
464 ;; Insert the section-header line which lists the file name and
465 ;; which functions are in it, etc.
466 (elinstall-insert-autoload-section
471 (autoload-trim-file-name full-name
)
472 (elinstall-file-mod-time full-name
))
474 "Generated autoloads from "
475 (autoload-trim-file-name full-name
)))
478 ;;;_ , elinstall-deffile-insert-autoloads
479 (defun elinstall-deffile-insert-autoloads (file args
)
480 "Update the autoloads for FILE in current buffer.
481 Return FILE if there was no autoload cookie in it, else nil.
483 Current buffer must be a loaddef-style file.
485 LOAD-NAME is the absolute name of the file.
486 RELATIVE-NAME is its name respective to some component of load-path."
494 (goto-char (point-min))
495 ;; Look for the section for FILE
496 (while (and (not found
)
497 (search-forward generate-autoload-section-header nil t
))
498 (let ((form (autoload-read-section-header)))
500 ((equal (nth 2 form
) file
)
501 ;; We found the section for this file.
502 (let ((begin (match-beginning 0)))
504 (search-forward generate-autoload-section-trailer
)
505 (delete-region begin
(point))
507 ((string< file
(nth 2 form
))
508 ;; We've come to a section alphabetically later than
509 ;; FILE. We assume the file is in order and so
510 ;; there must be no section for FILE. We will
511 ;; insert one before the section here.
512 (goto-char (match-beginning 0))
513 (setq found
'new
)))))
517 ;; No later sections in the file. Put before the last page.
518 (goto-char (point-max))
519 (search-backward "\f" nil t
)))
521 (apply #'elinstall-generate-file-autoloads
524 (if no-autoloads file nil
)))
525 ;;;_ . Arranging to add to info-path and load-path
526 ;;;_ , elinstall-generate-add-to-path
527 (defun elinstall-generate-add-to-path (path-element type
)
528 "Insert code at point to add PATH-ELEMENT to a path.
530 * `add-to-load-path', add to load-path
531 * `add-to-info-path', add to Info-additional-directory-list
533 Current buffer must be a loaddef-style file."
536 (add-to-load-path 'load-path
)
537 (add-to-info-path 'Info-additional-directory-list
)
538 (t (error "Type not recognized"))))
541 (add-to-load-path "load-path")
542 (add-to-info-path "info-path")))
546 ;; This does something in Lucid Emacs.
548 (float-output-format nil
))
550 (message "Generating %s additions..." description
)
552 (elinstall-insert-autoload-section
554 `(add-to-list ',path-symbol
556 ,(file-relative-name path-element
)
559 (file-truename load-file-name
))))))
560 (list type
(list path-element
) nil nil nil
)
562 (message "Generating %s additions...done" description
)))
565 ;;;_ , elinstall-deffile-insert-add-to-path
566 (defun elinstall-deffile-insert-add-to-path (path-element type
)
567 "Insert code in current buffer to add PATH-ELEMENT to a path.
569 * `add-to-load-path', add to load-path
570 * `add-to-info-path', add to Info-default-directory-list
572 Current buffer must be a loaddef-style file."
580 (goto-char (point-min))
581 ;; Look for the section for PATH-ELEMENT
582 (while (and (not found
)
583 (search-forward generate-autoload-section-header nil t
))
584 (let ((form (autoload-read-section-header)))
587 (equal (nth 0 form
) type
)
588 (member path-element
(nth 1 form
)))
590 ;; We found the section for this add.
591 (let ((begin (match-beginning 0)))
593 (search-forward generate-autoload-section-trailer
)
594 (delete-region begin
(point))
600 ;; No later sections in the file. Put first in file.
601 (goto-char (point-min))
603 (search-forward "\f" nil t
)
604 (goto-char (match-beginning 0)))))
606 (elinstall-generate-add-to-path path-element type
)))
608 ;;This never belongs in the no-autoloads section.
610 ;;;_ . elinstall-deffile-insert
612 (defun elinstall-deffile-insert (action)
613 "Insert autoloads etc into current file according to ACTION.
614 The format of ACTION is described in the design docs.
616 Return filename if this action belongs in the no-autoload section."
621 (elinstall-deffile-insert-autoloads
626 (elinstall-deffile-insert-add-to-path
632 (elinstall-deffile-insert-add-to-path
637 ((preload-file run-tests byte-compile
)
638 (error "This case should not come here.")))))
640 ;;;_ . elinstall-prepare-deffile
641 (defun elinstall-prepare-deffile (deffile)
642 "Try to ensure that DEFFILE is available for receiving autoloads"
644 (autoload-ensure-default-file deffile
)
645 (with-current-buffer (find-file-noselect deffile
)
648 ;; We must read/write the file without any code conversion,
649 ;; but still decode EOLs.
650 (let ((coding-system-for-read 'raw-text
))
652 ;; This is to make generated-autoload-file have Unix EOLs, so
653 ;; that it is portable to all platforms.
654 (setq buffer-file-coding-system
'raw-text-unix
))
655 (or (> (buffer-size) 0)
656 (error "Autoloads file %s does not exist" buffer-file-name
))
657 (or (file-writable-p buffer-file-name
)
658 (error "Autoloads file %s is not writable"
661 ;;;_ . elinstall-update-deffile
663 ;;Adapted from autoload.el `update-directory-autoloads'.
665 (defun elinstall-update-deffile (target actions
&optional use-load-path
)
667 Update file TARGET with current autoloads as specified by ACTIONS.
668 Also remove any old definitions pointing to libraries that can no
671 ACTIONS must be a list of actions (See the format doc). Each one's
672 filename must be relative to some element of load-path.
674 USE-LOAD-PATH is a list to use as load-path. It should include
675 any new load-path that we are arranging to create. If it's not given,
676 load-path itself is used.
678 This uses `update-file-autoloads' (which see) to do its work.
679 In an interactive call, you must give one argument, the name
680 of a single directory."
683 (use-load-path (or use-load-path load-path
))
684 (this-time (current-time))
685 ;;files with no autoload cookies.
688 (elinstall-prepare-deffile target
)
690 (find-file-noselect target
)
693 (elinstall-remove-autogen-action
694 (autoload-trim-file-name target
)
697 (goto-char (point-min))
698 (while (search-forward generate-autoload-section-header nil t
)
699 (let* ((form (autoload-read-section-header))
701 (cond ((and (consp file
) (stringp (car file
)))
702 ;; This is a list of files that have no
704 ;; There shouldn't be more than one such entry.
705 ;; Remove the obsolete section.
706 (autoload-remove-section (match-beginning 0))
707 (let ((last-time (nth 4 form
)))
709 (let ((file-time (elinstall-file-mod-time file
)))
711 (not (time-less-p last-time file-time
)))
713 (push file no-autoloads
)
715 (elinstall-remove-autogen-action
717 ((not (stringp file
)))
721 (locate-library file nil use-load-path
)))
723 ;;$$MAKE ME SAFER Also check normal
724 ;;load-path in case `use-load-path' is
726 ;;$$MAKE ME SAFER Don't do this for a
727 ;;file we are inserting. Need a boolean
728 ;;return for checking that.
729 ;;File doesn't exist, so remove its
732 (autoload-remove-section
733 (match-beginning 0)))
734 ;;$$IMPROVE ME Consult elinstall-proceed-p.
735 ;; File hasn't changed, so do nothing.
738 (elinstall-file-mod-time file-path
))
741 (elinstall-deffile-insert
742 (elinstall-get-autogen-action
746 (elinstall-remove-autogen-action
749 ;; Remaining actions have no existing autoload sections yet.
752 (delq nil
(mapcar #'elinstall-deffile-insert actions
))))
754 ;; Sort them for better readability.
755 (setq no-autoloads
(sort no-autoloads
'string
<))
756 ;; Add the `no-autoloads' section.
757 (goto-char (point-max))
758 (search-backward "\f" nil t
)
759 (elinstall-insert-autoload-section
761 (list 'autoloads nil nil no-autoloads this-time
)))
764 ;;;_ . elinstall-stage-update-deffiles
765 (defun elinstall-stage-update-deffiles (segment-list use-load-path
)
766 "Update any deffiles mentioned in SEGMENT-LIST.
767 FORCE and USE-LOAD-PATH have the same meaning as in
768 `elinstall-update-deffile'.
773 ((deffile (car segment
)))
774 (if (stringp deffile
)
775 (elinstall-update-deffile
781 ;;;_ , Doing actions to arrange preloads
782 ;;;_ . elinstall-symlink-on-emacs-start
783 (defun elinstall-symlink-on-emacs-start
784 (filename target-basename target-dir
&optional priority
)
785 "Symlink to TARGET-BASENAME.el in TARGET-DIR
787 If PRIORITY is given, it will be used as the priority prefix,
788 otherwise elinstall-default-priority will be.
789 PRIORITY must be an integer or nil."
792 (priority (or priority elinstall-default-priority
))
793 ;;We join and re-split in case TARGET-BASENAME includes a
796 (expand-file-name target-basename target-dir
))
798 (file-name-directory full-path
))
803 (file-name-nondirectory full-path
)))
805 (expand-file-name target-name-nodir target-dir
)))
807 ;;$$IMPROVE ME If it is a symlink pointing to the same place,
810 ;;$$IMPROVE ME The condition here is really not updating but
811 ;;bulldozing a possibly different symlink. Add another
812 ;;treatment symbol meaning to bulldoze what's in the way.
814 (elinstall-proceed-p 'preloads
817 "Really overwrite %s? "
818 "File %s already exists")
820 (file-exists-p target
))
821 ;;Does nothing if file already exists.
822 (make-directory (file-name-directory target
) t
)
826 ;;We already checked file-existence wrt user
827 ;;preferences, so force creation.
830 ;;;_ . elinstall-add-to-dot-emacs
831 (defun elinstall-add-to-dot-emacs (dot-emacs-name filename
&rest r
)
832 "Add code to load FILENAME to .emacs.
833 FILENAME should not have an extension"
836 (with-current-buffer (find-file-noselect dot-emacs-name
)
839 (goto-char (point-max))
840 (insert "\n;;Added by elinstall")
841 (insert "\n;;Consider using my-site-start to manage .emacs\n")
842 (pp `(load ,filename
) (current-buffer))
846 ;;;_ . elinstall-arrange-preload
847 (defun elinstall-arrange-preload (filename basename
&optional priority
)
848 "Arrange for FILENAME to be loaded on emacs start.
849 BASENAME and PRIORITY are used as arguments to
850 `elinstall-symlink-on-emacs-start'.
852 For non-autogenerated files that need to be linked in.
854 Calling this explicitly is deprecated. Instead, write a spec
855 containing \(preload Filename nil Basename Priority)."
858 ((preload-target elinstall-default-preload-target
))
860 ;;Dispatch the possibilities.
862 ((eq preload-target
'dot-emacs
)
863 (elinstall-add-to-dot-emacs "~/.emacs" filename
))
864 ((stringp preload-target
)
865 (elinstall-symlink-on-emacs-start
866 filename basename preload-target priority
))
867 ((null preload-target
)
868 (message "Not arranging for preloads"))
870 (message "I don't recognize that")))))
871 ;;;_ . elinstall-stage-arrange-preloads
872 (defun elinstall-stage-arrange-preloads (actions deffiles-used
)
873 "Arrange any preloads mentioned in ACTIONS."
887 (member filename deffiles-used
)))))
891 #'elinstall-arrange-preload
895 "elinstall-stage-arrange-preloads: Action not
901 ;;;_ . elinstall-stage-run-tests
902 (defun elinstall-stage-run-tests (actions)
903 "Run any tests mentioned in ACTIONS."
909 ;;$$WRITE ME - not a high priority right now.
913 "elinstall-stage-run-tests: Action not
919 ;;;_ . elinstall-stage-byte-compile
920 (defun elinstall-stage-byte-compile (actions)
921 "Do any byte-compilation mentioned in ACTIONS."
926 ;;$$IMPROVE ME Understand flags to control second
927 ;;argument (whether to load file after
930 (byte-compile-file (second act
)))
933 "elinstall-stage-byte-compile: Action not
936 ;;;_ . Segregating actions
937 ;;;_ , elinstall-remove-empty-segs
938 (defun elinstall-remove-empty-segs (segment-list)
939 "Return SEGMENT-LIST minus any segments that have no actions.
940 Intended only for the deffile stage data."
949 ;;;_ , elinstall-segregate-actions
950 (defun elinstall-segregate-actions (actions)
951 "Return actions segregated by deffile.
953 Returns a list whose elements are each a cons of:
954 * deffile filename or nil
955 * A list of actions to be done for that deffile."
962 (arrange-preloads '()))
964 (dolist (act actions
)
971 ((deffile-name (second act
))
973 (assoc deffile-name build-deffiles
)))
975 ;;There are already actions on this deffile.
976 ;;Splice this action in.
978 (cons act
(cdr cell-already
)))
979 ;;There are no actions on this deffile. Add a
980 ;;place for them and include this action.
981 (push (list deffile-name act
) build-deffiles
))))
983 (push act arrange-preloads
))
985 (push act run-tests
))
987 (push act byte-compile
)))))
989 (elinstall-make-stages
991 (elinstall-remove-empty-segs build-deffiles
)
998 ;;;_ . Finding actions
1000 ;;;_ . elinstall-dir-has-info
1002 ;;$$IMPROVE ME - Can this test be made more precise?
1003 (defun elinstall-dir-has-info (dir)
1004 "Return non-nil if DIR has info files in it.
1005 DIR should be an absolute path."
1007 (string-match "/info/" dir
)
1008 (directory-files dir nil
"\\.info\\(-[0-9]+\\)?\\(\\.gz\\)?$")))
1009 ;;;_ . elinstall-directory-files
1010 (defun elinstall-directory-files (dirname)
1011 "Return a list of files in directory DIRNAME, minus certain files.
1012 The following files are omitted:
1014 * Files that match an entry in `block-in-subtree'.
1015 Filenames are relative."
1017 def-file block-in-dir block-in-subtree
))
1020 ;;Relative filenames of this directory's files.
1022 ;; Don't include dot files. If user really wants to
1023 ;;explore one he can use (dir ".NAME") or (file ".NAME")
1024 (directory-files dirname nil
"[^\\.]"))
1025 ;;We know our def-file isn't really source so remove it.
1026 ;;We'd have removed it anyways after seeing file local vars.
1028 (remove def-file all-files
))
1033 #'(lambda (filename)
1039 (string-match blocked filename
))
1048 ;;;_ . List of special variables used in this section
1049 ;;load-path-element - The relevant element of load-path
1050 ;;def-file - The file the autoload definitions etc will go into.
1051 ;;add-to-load-path-p - Controls whether to add to load-path.
1052 ;;recurse-dirs-p - Whether to recurse into subdirectories.
1054 ;;block-in-dir - (NOT IMPLEMENTED) List of filenames to reject. They
1055 ;;may include wildcards. They apply wrt the original directory.
1057 ;;block-in-subtree - (NOT IMPLEMENTED) List of filenames to reject.
1058 ;;They may include wildcards. They apply wrt any directory in the
1059 ;;tree. Specifically, in the spec tree, which may differ from the
1061 ;;byte-compile - whether to byte-compile at all, t by default.
1062 ;;autoloads - boolean whether to make autoloads, t by default.
1063 ;;preloads - boolean whether to set up preloads, t by default.
1064 (defconst elinstall-find-actions-control-vars
1065 '(add-to-load-path-p recurse-dirs-p byte-compile
1067 "Control special variables that the find-actions tree recognizes" )
1068 ;;;_ . elinstall-actions-for-source-file
1069 (defun elinstall-actions-for-source-file (filename dir
)
1070 "Return a list of actions to do for FILENAME in DIR.
1071 Special variables are as noted in \"List of special variables\"."
1073 load-path-element def-file byte-compile
))
1076 (expand-file-name filename dir
)))
1079 (file-readable-p full-path
)
1080 (not (auto-save-file-name-p full-path
))
1081 (string-match emacs-lisp-file-regexp filename
))
1084 (visited (get-file-buffer full-path
))
1088 ;;Visit the file cheaply.
1089 ;;hack-local-variables can give errors.
1090 (ignore-errors (autoload-find-file full-path
))))
1094 (with-current-buffer buf
1095 (if (local-variable-p 'generated-autoload-file
)
1096 (elinstall-expand-deffile-name
1097 generated-autoload-file
)
1100 ;;Figure out whether to run some actions, by file local vars.
1104 (with-current-buffer buf
1105 (not no-update-autoloads
)))
1106 (elinstall-proceed-p 'autoloads
1108 '( "Do autoloads for %s? ")
1114 (featurep 'byte-compile
)
1116 (with-current-buffer buf
1117 (not no-byte-compile
)))
1118 (elinstall-proceed-p 'byte-compile
1122 "Already compiled %s.")
1125 (file-newer-than-file-p
1127 (byte-compile-dest-file full-path
)))))))
1132 `(byte-compile ,full-path
)
1135 (elinstall-make-autoload-action
1136 buf def-file load-path-element full-path
)
1138 (unless visited
(kill-buffer-if-not-modified buf
)))))))
1139 ;;;_ . elinstall-actions-for-dir
1140 (defun elinstall-actions-for-dir (dirname &optional recurse-dirs-p
)
1141 "Make actions for DIR.
1142 Recurse just if RECURSE-DIRS-P"
1144 load-path-element def-file add-to-load-path-p
))
1145 ;;This does not treat symlinks specially. $$IMPROVE ME it could
1146 ;;treat/not treat them conditional on control variables.
1149 (files (elinstall-directory-files dirname
))
1151 ;;Relative filenames of elisp source
1155 #'(lambda (filename)
1157 (string-match elinstall-elisp-regexp filename
)
1162 ;;Absolute filenames of subdirectories.
1167 #'(lambda (filename)
1169 ((fn (expand-file-name filename dirname
)))
1171 (file-directory-p fn
)
1179 elisp-source-files
;;If list is not empty.
1180 add-to-load-path-p
))
1182 (if load-path-here-p
1184 load-path-element
)))
1187 ;;$$IMPROVE ME - check `elinstall-proceed-p'. But even if
1188 ;;that says no, we still must use it as our load-path
1189 ;;element, we just don't add it to def-file.
1191 ;;Sometimes arrange to add this directory to load-path.
1192 (if load-path-here-p
1195 ,load-path-element
))
1198 ;;$$IMPROVE ME - check a control variable and
1199 ;;`elinstall-proceed-p'.
1200 ;;Sometimes add this directory to info path.
1202 (elinstall-dir-has-info dirname
)
1210 #'(lambda (filename)
1211 (elinstall-actions-for-source-file
1214 elisp-source-files
))
1219 #'(lambda (filename)
1220 (elinstall-find-actions-by-spec-x
1228 ;;;_ . elinstall-find-actions-by-spec-x
1230 (defun elinstall-find-actions-by-spec-x (spec dir
)
1231 "Return a list of actions to do, controlled by SPEC."
1233 load-path-element def-file add-to-load-path-p
1234 recurse-dirs-p block-in-dir block-in-subtree
))
1242 #'(lambda (sub-spec)
1243 (elinstall-find-actions-by-spec-x
1248 ;;(block-in-subtree (* FN) SPEC)
1250 ((block-in-subtree (second spec
)))
1251 (elinstall-find-actions-by-spec-x
1255 ;;Rather than trying to bind all control variables each time
1256 ;;thru, we use `set' and `unwind-protect'.
1258 ;;control TYPE DISPOSITION SPEC
1260 ((key (second spec
))
1262 (if (memq key elinstall-find-actions-control-vars
)
1265 (setq old-value
(symbol-value key
))
1266 (set key
(third spec
))
1267 (elinstall-find-actions-by-spec-x
1270 (set key old-value
))
1271 (error "Unrecognized control variable %s" key
))))
1275 ;;(def-file FN ARGS SPEC)
1281 (for-preload (third spec
)))
1282 (assert (listp for-preload
))
1286 (and for-preload
(car for-preload
))
1290 ,@(cdr for-preload
))
1293 (elinstall-find-actions-by-spec-x
1294 (fourth spec
) dir
))))
1298 (elinstall-actions-for-dir
1306 (elinstall-actions-for-source-file
1317 (elinstall-find-actions-by-spec-x
1324 `((add-to-load-path ,def-file
,dir
))
1326 ((load-path-element dir
)
1327 (add-to-load-path-p nil
))
1328 (elinstall-find-actions-by-spec-x
1333 ;;(matching PATTERN SPEC)
1337 ;;$$PUNT Assume that `block-in-subtree' and
1338 ;;`block-in-dir' aren't matched.
1339 (elinstall-find-actions-by-spec-x
1343 dir t
(second spec
)))))
1345 ;;(preload FN SYM &rest ARGS)
1347 ((key (third spec
)))
1349 (and (symbolp key
) (symbol-value key
))
1352 ,(expand-file-name (second spec
) dir
)
1359 (elinstall-actions-for-dir dir nil
))
1361 (elinstall-actions-for-dir dir t
)))))
1363 ;;;_ . elinstall-find-actions-by-spec
1364 (defun elinstall-find-actions-by-spec
1365 (spec load-path-element dir def-file
)
1366 "Find the list of actions to do according to SPEC."
1370 (def-file-time (elinstall-file-mod-time def-file
))
1371 (add-to-load-path-p t
)
1377 (block-in-subtree '(".git" "RCS" "CVS" "SVN" "^tests\.el")))
1380 load-path-element def-file add-to-load-path-p
1381 recurse-dirs-p byte-compile
1382 block-in-dir block-in-subtree
))
1384 (elinstall-find-actions-by-spec-x spec dir
)))
1386 ;;;_ . high-level work
1387 ;;;_ , elinstall-get-relevant-load-path
1388 (defun elinstall-get-relevant-load-path (actions)
1398 ;;;_ , elinstall-get-deffile-list
1399 (defun elinstall-get-deffile-list (stages)
1400 "Get a list of deffile names"
1404 (elinstall-stages->build-deffiles stages
)))
1406 (defun elinstall-x (dir spec
)
1407 "High-level worker function to install elisp files."
1410 ;;This is just the default deffile, spec can override it.
1412 (elinstall-expand-deffile-name nil
))
1414 (elinstall-find-actions-by-spec
1419 (stages (elinstall-segregate-actions actions
))
1421 (elinstall-get-relevant-load-path
1424 (elinstall-stage-update-deffiles
1425 (elinstall-stages->build-deffiles stages
)
1427 (when (elinstall-proceed-at-all-p 'preloads
)
1428 (elinstall-stage-arrange-preloads
1429 (elinstall-stages->arrange-preloads stages
)
1430 (elinstall-get-deffile-list stages
)))
1431 (when (elinstall-proceed-at-all-p 'byte-compile
)
1432 (elinstall-stage-byte-compile
1433 (elinstall-stages->byte-compile stages
)))
1435 ;;;_ , elinstall-package
1436 (defun elinstall-package (project-name path spec version-string
)
1437 "Install elisp files. See doc for `elinstall'."
1439 (elinstall-proceed-p 'install
1443 "Already installed %s.")
1445 (elinstall-already-installed project-name
))
1448 `(def-file "loaddefs.el" (if-used ,project-name
) ,spec
))
1449 (elinstall-record-installed project-name version-string
)))
1454 (defun elinstall (project-name path spec
&optional force version-string
)
1455 "Install elisp files.
1456 They need not be a formal package.
1460 PROJECT-NAME - the name of the project
1462 PATH - Path to the project.
1463 Suggestion: Use (elinstall-directory-true-name) to get the real
1464 current directoery name even from loaded files.
1466 SPEC - a spec for the autoloads etc to make. It can be as simple
1469 If FORCE is `t', install a package even if it has already been
1470 installed. If it's a list or `nil', it's treated as a list of
1471 installation restraints. User customizations override this
1474 VERSION-STRING, if given, must be a string of the version for this package."
1476 (elinstall-call-with-restraints
1482 project-name path spec version-string
))
1484 ;;;_ . elinstall-update-directory-autoloads
1487 (defun elinstall-update-directory-autoloads (dir)
1488 "Update autoloads for directory DIR"
1490 (interactive "DUpdate autoloads for all elisp files from directory: ")
1491 (elinstall-call-with-restraints
1499 ;;;_ . elinstall-update-directory
1501 (defun elinstall-update-directory (dir)
1502 "Update autoloads for directory DIR"
1504 (interactive "DInstall all elisp files from directory: ")
1505 (elinstall-call-with-restraints
1512 ;;;_ . elinstall-update-file-autoloads
1514 (defun elinstall-update-file-autoloads (file)
1515 "Update autoloads for elisp file FILE"
1517 (interactive "fUpdate autoloads for elisp file: ")
1518 (elinstall-call-with-restraints
1522 (file-name-directory file
)
1523 `(file ,(file-name-nondirectory file
))))
1525 ;;;_ . elinstall-update-file
1527 (defun elinstall-update-file (file)
1528 "Install elisp file FILE"
1530 (interactive "fInstall elisp file: ")
1531 (elinstall-call-with-restraints
1536 (file-name-directory file
)
1537 `(file ,(file-name-nondirectory file
))))
1542 (provide 'elinstall
)
1544 ;;;_ * Local emacs vars.
1545 ;;;_ + Local variables:
1550 ;;; elinstall.el ends here