Fully switched over to record-based staging

[elinstall.git] / elinstall.el

;;;_ elinstall.el --- Automatically and flexibly install elisp files

;;;_. Headers
;;;_ , License
;; Copyright (C) 2010  Tom Breton (Tehom)

;; Author: Tom Breton (Tehom) <tehom@panix.com>
;; Keywords: maint, tools, internal

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;;_ , Commentary:

;; Entry points:
;; elinstall  Use this for overall loading
;;
;; elinstall-arrange-preload - Use this for non-autogenerated
;; files that need to be linked in.

;; elinstall-update-directory-autoloads 
;; elinstall-update-file-autoloads

;;;_ , Requires

(require 'autoload)
(require 'pp)
(require 'cus-edit)  ;;Because we save "installedness" manually


;;;_. Body
;;;_ , Customizations
(defgroup elinstall
   '()
   "Customizations for elinstall"
   :group 'elinstall)

(defcustom elinstall-default-priority 
   50
   "Default priority for site-start" 
   :group 'elinstall
   :type 'integer)

(defcustom elinstall-default-preload-target
   "~/.emacs.d/site-start.d/"
   "Default preload-target for registering autoloads" 
   :group 'elinstall
   :type
   '(choice 
       (const  "~/.emacs.d/site-start.d/")
       (const  "/etc/emacs/site-start.d/")
       (directory "" )
       (const nil)
       (const 'dot-emacs)))


(defcustom elinstall-already-installed
   '()
   "Things that have already been installed.
This exists for recording what has been installed.  User interaction is not
contemplated at this time." )
;;;_ , Types
;;;_  . elinstall-stages
(defstruct (elinstall-stages
              (:constructor elinstall-make-stages)
              (:conc-name elinstall-stages->)
              (:copier nil))
   "The elinstall stages"
   build-deffiles
   run-tests
   byte-compile
   arrange-preloads)

;;;_ , Data
;;;_  . Regular expressions
;;;_   , elinstall-elisp-regexp
(defconst elinstall-elisp-regexp
   (let ((tmp nil))
      (dolist 
         (suf (get-load-suffixes))
         (unless (string-match "\\.elc" suf) (push suf tmp)))
      (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))
   "Regular expression that matches elisp files" )

;;;_ , Utilities
;;;_  . elinstall-directory-true-name
(defun elinstall-directory-true-name ()
   "Get the true name of the directory the calling code lives in.
CAUTION:  This is sensitive to where it's called.  That's the point of it."
   (file-name-directory
      (if load-file-name
         (file-truename load-file-name)
         (file-truename buffer-file-name))))
;;;_  . Checking installedness
;;;_   , elinstall-already-installed
(defun elinstall-already-installed (project-name)
   "Return non-nil if PROJECT-NAME has been installed."
   (member project-name elinstall-already-installed))

;;;_   , elinstall-record-installed
(defun elinstall-record-installed (project-name)
   "Record that PROJECT-NAME has been installed."

   (add-to-list 'elinstall-already-installed project-name)
   (customize-save-variable 
      'elinstall-already-installed 
      elinstall-already-installed
      "Set by elinstall-record-installed"))
;;;_ , Work
;;;_  . Doing actions

;;;_   , Doing autoload actions (All adapted from autoload.el)
;;;_    . Utilities about the action list
;;;_     , elinstall-remove-autogen-action
(defun elinstall-remove-autogen-action (file actions)
   "Return ACTIONS minus any add-file-autoloads on FILE removed."

   (delq nil
      (mapcar
         #'(lambda (act)
              (case (car act)
                 (add-file-autoloads
                    (if (equal file (third act))
                       nil
                       act))
                 (t act)))
         actions)))
;;;_     , elinstall-get-autogen-action
(defun elinstall-get-autogen-action (file actions)
   ""
   (let
      ((the-act))
      (dolist (act actions)
         (case (car act)
            (add-file-autoloads
               (when (equal file (third act))
                  (setq the-act act)))))
      the-act))

;;;_    . Making autoloads
;;;_     , elinstall-generate-file-autoloads 
;;override to allow slashed load-paths
;;Quick and dirty: We just adapt `generate-file-autoloads' and add
;;a new arg. 
;;`relative-to' can be:
;; * nil: act as at present.  Assume that FILE's immediate directory
;;is in load-path. 
;; * t :: use default-directory
;; * a string :: relative to it, as a filename

(defun elinstall-generate-file-autoloads (relative-name full-name)
  "Insert at point a loaddefs autoload section for FILE.
Autoloads are generated for defuns and defmacros in FILE
marked by `generate-autoload-cookie' (which see).
If FILE is being visited in a buffer, the contents of the buffer
are used.
Return non-nil in the case where no autoloads were added at point.

FULL-NAME is the absolute name of the file.
RELATIVE-NAME is its name respective to some component of load-path."
  (let* ((outbuf (current-buffer))
          (autoloads-done '())
          (print-length nil)
          (print-readably t)     ; This does something in Lucid Emacs.
          (float-output-format nil)
          (done-any nil)
          (visited (get-file-buffer full-name))
          (source-buf 
             (or visited
                ;; It is faster to avoid visiting the file.
                (ignore-errors (autoload-find-file full-name))))
          output-start)
     (if source-buf
        (with-current-buffer source-buf
           ;;$$MOVE ME - this should be checked in action-finding.
           ;; Obey the no-update-autoloads file local variable.
           (unless no-update-autoloads
              (message "Generating autoloads for %s..." relative-name)
              (setq output-start (with-current-buffer outbuf (point)))
              (save-excursion
                 (save-restriction
                    (widen)
                    (goto-char (point-min))
                    (while (not (eobp))
                       (skip-chars-forward " \t\n\f")
                       (cond
                          ((looking-at (regexp-quote generate-autoload-cookie))
                             (search-forward generate-autoload-cookie)
                             (skip-chars-forward " \t")
                             (setq done-any t)
                             (if (eolp)
                                ;; Read the next form and make an autoload.
                                (let* ((form (prog1 (read (current-buffer))
                                                (or (bolp) (forward-line 1))))
                                         (autoload 
                                            (make-autoload form relative-name)))
                                   (if autoload
                                      (push (nth 1 form) autoloads-done)
                                      (setq autoload form))
                                   (let ((autoload-print-form-outbuf outbuf))
                                      (autoload-print-form autoload)))

                                ;; Copy the rest of the line to the output.
                                (princ (buffer-substring
                                          (progn
                                             ;; Back up over whitespace, to preserve it.
                                             (skip-chars-backward " \f\t")
                                             (if (= (char-after (1+ (point))) ? )
                                                ;; Eat one space.
                                                (forward-char 1))
                                             (point))
                                          (progn (forward-line 1) (point)))
                                   outbuf)))
                          ((looking-at ";")
                             ;; Don't read the comment.
                             (forward-line 1))
                          (t
                             (forward-sexp 1)
                             (forward-line 1))))))

              (when done-any
                 (with-current-buffer outbuf
                    (save-excursion
                       ;; Insert the section-header line which lists the file name
                       ;; and which functions are in it, etc.
                       (goto-char output-start)
                       (autoload-insert-section-header
                          outbuf autoloads-done relative-name full-name
                          (nth 5 (file-attributes full-name)))
                       (insert ";;; Generated autoloads from "
                          (autoload-trim-file-name full-name) "\n"))
                    (insert generate-autoload-section-trailer)))
              (message "Generating autoloads for %s...done" relative-name))

           (unless visited
              ;; We created this buffer, so we should kill it.
              (kill-buffer (current-buffer))))
        (message "Could not load %s" relative-name))
     
     (not done-any)))
;;

;;;_     , elinstall-deffile-insert-autoloads
(defun elinstall-deffile-insert-autoloads (file load-name)
   "Update the autoloads for FILE in current buffer.
Return FILE if there was no autoload cookie in it, else nil.

Current buffer must be a loaddef-style file.

LOAD-NAME is the absolute name of the file.
RELATIVE-NAME is its name respective to some component of load-path."
   (let (
           (found nil)
           (no-autoloads nil))

      (save-excursion
         (save-restriction
            (widen)
            (goto-char (point-min))
            ;; Look for the section for FILE
            (while (and (not found)
                      (search-forward generate-autoload-section-header nil t))
               (let ((form (autoload-read-section-header)))
                  (cond 
                     ((equal (nth 2 form) file)
                        ;; We found the section for this file.
                        (let ((begin (match-beginning 0)))
                           (progn
                              (search-forward generate-autoload-section-trailer)
                              (delete-region begin (point))
                              (setq found t))))
                     ((string< file (nth 2 form))
                        ;; We've come to a section alphabetically later than
                        ;; FILE.  We assume the file is in order and so
                        ;; there must be no section for FILE.  We will
                        ;; insert one before the section here.
                        (goto-char (match-beginning 0))
                        (setq found 'new)))))
            (unless found
               (progn
                  (setq found 'new)
                  ;; No later sections in the file.  Put before the last page.
                  (goto-char (point-max))
                  (search-backward "\f" nil t)))
            (setq no-autoloads 
               (elinstall-generate-file-autoloads file load-name))))

      (if no-autoloads file nil)))
;;;_    . Arranging to add to info-path and load-path
;;;_     , elinstall-generate-add-to-path
(defun elinstall-generate-add-to-path (path-element type)
  "Insert code at point  to add PATH-ELEMENT to a path.
If TYPE is:
 * `add-to-load-path', add to load-path
 * `add-to-info-path', add to Info-default-directory-list

Current buffer must be a loaddef-style file."
  (let (  (path-symbol
             (case type
                (add-to-load-path 'load-path)
                (add-to-info-path 'Info-default-directory-list)))
          (description
             (case type
                (add-to-load-path "load-path")
                (add-to-info-path "info-path")))
          (autoloads-done '())
          (print-length nil)
          (print-readably t)     ; This does something in Lucid Emacs.
          (float-output-format nil))

     (message "Generating %s additions..." description)
     
     (autoload-insert-section-header
        (current-buffer) (list path-element) nil nil
        nil)
     (insert ";;; Generated path addition\n")
     (pp
        `(add-to-list ',path-symbol
            (expand-file-name 
               ,(file-relative-name path-element)
               (if load-file-name
                  (file-name-directory
                     (file-truename load-file-name)))))
        (current-buffer))
     
     (insert generate-autoload-section-trailer)
     (message "Generating %s additions...done" description)))


;;;_     , elinstall-deffile-insert-add-to-path
(defun elinstall-deffile-insert-add-to-path (path-element type)
   "Insert code in current buffer to add PATH-ELEMENT to a path.
If TYPE is:
 * `add-to-load-path', add to load-path
 * `add-to-info-path', add to Info-default-directory-list

Current buffer must be a loaddef-style file."
   (let (
           (found nil)
           (no-autoloads nil))

      (save-excursion
         (save-restriction
            (widen)
            (goto-char (point-min))
            ;; Look for the section for PATH-ELEMENT
            (while (and (not found)
                      (search-forward generate-autoload-section-header nil t))
               (let ((form (autoload-read-section-header)))
                  (cond 
                     ((and
                         (equal (nth 0 form) type)
                         (member (nth 1 form) path-element))
                        
                        ;; We found the section for this add.
                        (let ((begin (match-beginning 0)))
                           (progn
                              (search-forward generate-autoload-section-trailer)
                              (delete-region begin (point))
                              (setq found t)))))))
            
            (unless found
               (progn
                  (setq found 'new)
                  ;; No later sections in the file.  Put before the last page.
                  (goto-char (point-max))
                  (search-backward "\f" nil t)))

            (elinstall-generate-add-to-path path-element type)))

      ;;This never belongs in the no-autoloads section.
      nil))

;;;_    . elinstall-deffile-insert

(defun elinstall-deffile-insert (action)
   "Insert autoloads etc into current file according to ACTION.
The format of ACTION is described in the design docs.

Return filename if this action belongs in the no-autoload section."

   (when action
      (case (car action)
         (add-file-autoloads
            (elinstall-deffile-insert-autoloads
               (third action)
               (fifth action)))
      
         (add-to-load-path
            (elinstall-deffile-insert-add-to-path
               (third action)
               'add-to-load-path)
            nil)

         (add-to-info-path
            (elinstall-deffile-insert-add-to-path
               (third action)
               'add-to-info-path)
            nil)
         
         ((preload-file run-tests byte-compile)
            (error "This case should not come here.")))))

;;;_    . elinstall-prepare-deffile
(defun elinstall-prepare-deffile (deffile)
   "Try to ensure that DEFFILE is available for receiving autoloads"
   
   (autoload-ensure-default-file deffile)
   (with-current-buffer (find-file-noselect deffile)

         
      ;; We must read/write the file without any code conversion,
      ;; but still decode EOLs.
      (let ((coding-system-for-read 'raw-text))

         ;; This is to make generated-autoload-file have Unix EOLs, so
         ;; that it is portable to all platforms.
         (setq buffer-file-coding-system 'raw-text-unix))
      (or (> (buffer-size) 0)
         (error "Autoloads file %s does not exist" buffer-file-name))
      (or (file-writable-p buffer-file-name)
         (error "Autoloads file %s is not writable"
            buffer-file-name))))

;;;_    . elinstall-update-deffile

;;Adapted from autoload.el `update-directory-autoloads'.

(defun elinstall-update-deffile (target actions &optional
                                   use-load-path force)
  "\
Update file TARGET with current autoloads as specified by ACTIONS.
Also remove any old definitions pointing to libraries that can no
longer be found.

ACTIONS must be a list of actions (See the format doc).  Each one's
filename must be relative to some element of load-path.

USE-LOAD-PATH is a list to use as load-path.  It should include
any new load-path that we are arranging to create.  If it's not given,
load-path itself is used.

If FORCE is `t', do it regardless of timestamps etc. (Not implemented)
Other non-nil cases of FORCE are reserved for future development.

This uses `update-file-autoloads' (which see) to do its work.
In an interactive call, you must give one argument, the name
of a single directory."
  (let
     (
        (use-load-path (or use-load-path load-path))
        (this-time (current-time))
        ;;files with no autoload cookies.
        (no-autoloads nil))
     
     (elinstall-prepare-deffile target)
     (with-current-buffer
        (find-file-noselect target)
        (save-excursion
           (setq actions
              (elinstall-remove-autogen-action
                 (autoload-trim-file-name target) 
                 actions))

           (goto-char (point-min))
           (while (search-forward generate-autoload-section-header nil t)
              (let* ((form (autoload-read-section-header))
                       (file (nth 3 form)))
                 (cond ((and (consp file) (stringp (car file)))
                          ;; This is a list of files that have no
                          ;; autoload cookies.
                          ;; There shouldn't be more than one such entry.
                          ;; Remove the obsolete section.
                          (autoload-remove-section (match-beginning 0))
                          (let ((last-time (nth 4 form)))
                             (dolist (file file)
                                (let ((file-time (nth 5 (file-attributes file))))
                                   (when (and file-time
                                            (not (time-less-p last-time file-time)))
                                      ;; file unchanged
                                      (push file no-autoloads)
                                      (setq actions
                                         (elinstall-remove-autogen-action
                                            file actions)))))))
                    ((not (stringp file)))
                    (t
                       (let
                          ((file-path
                              (locate-library file nil use-load-path)))
                          (cond
                             ;;File doesn't exist, so remove its
                             ;;section.
                             ((not file-path)
                                (autoload-remove-section 
                                   (match-beginning 0)))

                             ;; File hasn't changed, so do nothing.
                             ((equal 
                                 (nth 4 form) 
                                 (nth 5 (file-attributes file-path)))
                                nil)
                             (t
                                (elinstall-deffile-insert
                                   (elinstall-get-autogen-action 
                                      file actions))))

                          (setq actions
                             (elinstall-remove-autogen-action
                                file actions))))))))

        ;; Remaining actions have no existing autoload sections yet.
        (setq no-autoloads
           (append no-autoloads
              (delq nil (mapcar #'elinstall-deffile-insert actions))))
        (when no-autoloads
           ;; Sort them for better readability.
           (setq no-autoloads (sort no-autoloads 'string<))
           ;; Add the `no-autoloads' section.
           (goto-char (point-max))
           (search-backward "\f" nil t)
           (autoload-insert-section-header
              (current-buffer) nil nil no-autoloads this-time)
           (insert generate-autoload-section-trailer))
        (save-buffer))))


;;;_   , Doing actions to arrange preloads
;;;_    . elinstall-insert-add-to-path
(defun elinstall-insert-add-to-path (new path-sym)
   "Insert code to add NEW to PATH-SYM.
Insert this at point in current buffer."
   (insert "\n")
   (pp
      `(add-to-list ',path-sym
          (expand-file-name ,new
             (if load-file-name
                (file-name-directory
                   (file-truename load-file-name)))))
      (current-buffer)))

;;;_    . elinstall-insert-add-to-load-path
(defun elinstall-insert-add-to-load-path (new)
   "Insert code to add NEW to load-path.
Insert this at point in current buffer."
   (elinstall-insert-add-to-path new 'load-path))

;;;_    . elinstall-insert-add-to-info-path
(defun elinstall-insert-add-to-info-path (new)
   "Insert code to add NEW to info-path.
Insert this at point in current buffer."
   (elinstall-insert-add-to-path new 'Info-default-directory-list))

;;;_    . elinstall-symlink-on-emacs-start
(defun elinstall-symlink-on-emacs-start 
   (filename target-basename target-dir &optional priority force)
   "Symlink to TARGET-BASENAME.el in TARGET-DIR

If PRIORITY is given, it will be used as the priority prefix,
otherwise elinstall-default-priority will be.
PRIORITY must be an integer or nil.
If FORCE is `t', do it regardless of timestamps etc.
Other non-nil cases of FORCE are reserved for future development."
   (let*
      (  
         (priority   (or priority elinstall-default-priority))
         (target-name-nodir
            (format
               "%d%s.el"
               priority
               target-basename))
         (target 
            (expand-file-name target-name-nodir target-dir)))
      
      
      (cond
         ;;Path should already exist.
         ((not
             (file-exists-p target-dir))
            (message "The target directory doesn't exist."))
         ;;Target shouldn't already exist, but if force is given, let
         ;;user override.
         ;;$$IMPROVE ME If it is a symlink pointing to the same place,
         ;;do nothing even on force.
         ((and
             (file-exists-p target)
             (or
                (not force)
                (not
                   (yes-or-no-p 
                      (format "Really overwrite %s? " project-name))))
             (message "File %s already exists" target)))
         
         (t
            (make-symbolic-link 
               filename
               target
               nil)))))

;;;_    . elinstall-add-to-dot-emacs
(defun elinstall-add-to-dot-emacs (dot-emacs-name filename force &rest r)
   "Add code to load FILENAME to .emacs.
FILENAME should not have an extension"

   ;;Visit .emacs
   (with-current-buffer (find-file-noselect dot-emacs-name)
      (save-excursion
         ;;add at end of file
         (goto-char (point-max))
         (insert "\n;;Added by elinstall")
         (insert "\n;;Consider using my-site-start to manage .emacs\n")
         (pp `(load ,filename) (current-buffer))
         (save-buffer))))


;;;_    . elinstall-arrange-preload
;;;###autoload
(defun elinstall-arrange-preload (force filename basename &optional priority) 
   "Arrange for FILENAME to be loaded on emacs start.
FORCE has its usual meaning.
BASENAME and PRIORITY are used as arguments to
`elinstall-symlink-on-emacs-start'.
"

   (let
      ((preload-target elinstall-default-preload-target))
      
      ;;Dispatch the possibilities.
      (cond
         ((eq preload-target 'dot-emacs)
            (elinstall-add-to-dot-emacs "~/.emacs" filename))
         ((stringp preload-target)
            (elinstall-symlink-on-emacs-start 
               filename basename preload-target priority force))
         (null preload-target
            (message "Not arranging for preloads"))
         (t
            (message "I don't recognize that")))))

;;;_   , Cleanup actions
;;Nothing yet.  This will be another type of action.

;;;_  . Segregating actions
;;;_   , elinstall-remove-empty-segs
(defun elinstall-remove-empty-segs (segment-list)
   "Return SEGMENT-LIST minus any segments that have no actions.
Intended only for the deffile stage data."
   (delq nil
      (mapcar
         #'(lambda (segment)
              (if (cdr segment)
                 segment
                 nil))
         segment-list)))

;;;_   , elinstall-segregate-actions
(defun elinstall-segregate-actions (actions)
   "Return actions segregated by deffile.

Returns a list whose elements are each a cons of:
 * deffile filename or nil
 * A list of actions to be done for that deffile."

   (let
      (
         (build-deffiles   '())
         (run-tests         '())
         (byte-compile     '())
         (arrange-preloads '()))
      
      (dolist (act actions)
         (when act
            (case (car act)
               ((add-file-autoloads 
                   add-to-info-path
                   add-to-load-path)
                  (let*
                     ((deffile-name (second act))
                        (cell-already
                           (assoc deffile-name build-deffiles)))
                     (if cell-already
                        ;;There are already actions on this deffile.
                        ;;Splice this action in.
                        (setcdr cell-already 
                           (cons act (cdr cell-already)))
                        ;;There are no actions on this deffile.  Add a
                        ;;place for them and include this action.
                        (push (list deffile-name act) build-deffiles))))
               (preload-file
                  (push act arrange-preloads))
               (run-tests
                  (push act run-tests))
               (byte-compile
                  (push act byte-compile)))))

      (elinstall-make-stages
         :build-deffiles
         (elinstall-remove-empty-segs build-deffiles)
         :run-tests
         run-tests
         :byte-compile
         byte-compile
         :arrange-preloads
         arrange-preloads)))





;;;_  . Finding actions
;;;_   , Treating the parameter list
;;;_    . elinstall-add-parameter
(defun elinstall-add-parameter (alist key new-value)
   "Add a new value for KEY to ALIST"

   (cons
      (cons key new-value)
      (assq-delete-all key (copy-list alist))))

;;;_    . elinstall-get-parameter
(defun elinstall-get-parameter (alist key)
   "Get the value of KEY from ALIST"
   
   (cdr (assq key alist)))
;;;_    . elinstall-expand-file-name
;;$$OBSOLETE
'
(defun elinstall-expand-file-name (filename alist)
   "Expand FILENAME by the value of `path' in ALIST"
   (expand-file-name 
      filename
      (elinstall-get-parameter alist 'path)))
;;;_   , Finding deffiles
;;;_    . elinstall-expand-deffile-name
(defun elinstall-expand-deffile-name (deffile)
   "Expand DEFFILE autoload.el's way."
   
   (expand-file-name (or deffile "loaddefs.el")
      (expand-file-name "lisp"
         source-directory)))

;;;_    . elinstall-maybe-get-deffile
(defun elinstall-maybe-get-deffile (file)
   "If FILE defined `generated-autoload-file', return it.
Otherwise return nil.
Return it as an absolute filename."

   (save-excursion
      ;;$$FIXME load buffer if it's not already loaded
      (let* 
         ((existing-buffer (get-file-buffer file)))

         ;; We want to get a value for generated-autoload-file from
         ;; the local variables section if it's there.
         ;;But if it's not loaded, we don't?  Maybe should use
         ;; `autoload-find-file' and load it.
         (if existing-buffer
            (set-buffer existing-buffer))
         (if (local-variable-p 'generated-autoload-file)
            (elinstall-expand-deffile-name
               generated-autoload-file)
            nil))))


;;;_   , Workers
;;;_    . elinstall-find-actions-for-file
(defun elinstall-find-actions-for-file 
   (filename load-path-element dir parameters)
   "Return a list of actions to do for FILENAME.
LOAD-PATH-ELEMENT, DIR, and PARAMETERS are interpreted as in
`elinstall-find-actions-by-spec' "
                          
   (let
      ((full-path
          (expand-file-name filename dir)))
      (list
         `(add-file-autoloads
             ,(elinstall-get-parameter 
                 parameters 'def-file)
             ;;load-name relative to a member of load-path
             ,(file-name-sans-extension
                 (file-relative-name
                    full-path
                    load-path-element))
             ,load-path-element ;;Is this still used?
             ,full-path))))

;;;_    . elinstall-find-actions-by-spec

(defun elinstall-find-actions-by-spec (spec load-path-element path parameters)
   "Return a list of actions to do, controlled by SPEC and PARAMETERS.

LOAD-PATH-ELEMENT is the conceptual element of load-path that
surrounds DIR.  It may not yet have been added to load-path."
   (if (consp spec)
      ;;$$IMPROVE ME by adding the other cases in the design.
      (case (car spec)
         (in
            (let
               ((new-path
                   (expand-file-name
                      (second spec)
                      dir)))
               
               (elinstall-find-actions-by-spec
                  (third spec)
                  load-path-element
                  new-path
                  parameters)))
         
         (all
            (apply #'nconc
               (mapcar
                  #'(lambda (sub-spec)
                       (elinstall-find-actions-by-spec 
                          sub-spec
                          load-path-element 
                          dir
                          parameters))
                  (cdr spec))))

         (file
            (elinstall-find-actions-for-file
               filename load-path-element dir parameters))
         
         (dir
            (let*
               ((dirname 
                   (expand-file-name
                      (second spec) 
                      dir))
                  (load-path-here
                     (not
                        (elinstall-get-parameter 
                           parameters 'block-add-to-load-path)))
                  (load-path-element
                     (if load-path-here
                        dirname
                        load-path-element)))
               
               (cons
                  ;;$$IMPROVE ME
                  ;;Do this only if there are loadable files.
                  (if load-path-here
                     `(add-to-load-path
                         ,(elinstall-get-parameter 
                             parameters 'def-file)
                         ,load-path-element)
                     '())
                  ;;$$IMPROVE ME
                  ;;Do add-to-info-path too.  But test if there are
                  ;;any info files present.

                  ;;$$IMPROVE ME
                  ;; We want to get a value for generated-autoload-file
                  ;; from the local variables section if it's there.
                  ;;Use `elinstall-maybe-get-deffile'
                  ;; Otherwise we'll use `def-file' in parameters.

                  ;;$$FIXME This isn't quite right.  If directory
                  ;;itself is not in load-path, this will be wrong.
                  ;;Gotta know where our encompassing part of
                  ;;load-path is.

                  ;;$$ENCAP ME  This should be shared with the
                  ;;treatment of (file FN)

                  ;;$$FIXME Don't do directories, but maybe recurse on
                  ;;them, if a flag is set.  And since we definitely
                  ;;have a load-path element here,
                  ;;'block-add-to-load-path according to a parameter.
                  ;;Maybe could follow/not symlinks similarly.
                  (apply #'nconc
                     (mapcar
                        #'(lambda (filename)
                             (elinstall-find-actions-for-file
                                filename 
                                load-path-element 
                                dirname
                                parameters))
                     
                        (directory-files
                           dirname 
                           nil ;;Relative filenames
                           elinstall-elisp-regexp))))))
         
         (def-file
            (let
               ((new-def-file
                   (expand-file-name
                      (second spec)
                      dir))
                  (for-preload (third spec)))
               (assert (listp for-preload))
               (append
                  (list
                     (if
                        (and for-preload (car for-preload))
                        `(preload-file
                            ,(car for-preload)
                            ,new-def-file
                            ,@(cdr for-preload))
                        '()))
                  
                  (elinstall-find-actions-by-spec
                     (fourth spec)
                     load-path-element 
                     dir
                     (elinstall-add-parameter parameters 
                        'def-file new-def-file))))))
      
      ;;$$IMPROVE ME by adding the other cases in the design.
      (case spec
         (t))))
;;;_  . high-level work
;;;_   , elinstall-get-relevant-load-path
(defun elinstall-get-relevant-load-path (actions)
   ""
   (delq nil
      (mapcar
         #'(lambda (act)
              (case (car act)
                 (add-to-load-path
                    (second act))
                 (t nil)))
         actions)))
;;;_   , elinstall-stage-update-deffiles
(defun elinstall-stage-update-deffiles (segment-list force use-load-path)
   "Update any deffiles mentioned in SEGMENT-LIST.
FORCE and USE-LOAD-PATH have the same meaning as in
`elinstall-update-deffile'.
"
   (mapcar
      #'(lambda (segment)
           (let*
              ((deffile (car segment)))
              (if (stringp deffile)
                 (elinstall-update-deffile deffile (cdr segment) force
                    use-load-path))))
      segment-list))
;;;_   , elinstall-stage-arrange-preloads
(defun elinstall-stage-arrange-preloads (actions deffiles-used)
   "Arrange any preloads mentioned in ACTIONS."
   
   (mapcar
      #'(lambda (act)
           (case (car act)
              (preload-file
                 (let
                    ((proceed (car act)))
                    ;;$$TEST whether to proceed
                    (apply
                       #'elinstall-arrange-preload
                       force
                       (cddr act))))
              (t
                 (error
                    "elinstall-stage-arrange-preloads: Action not
           recognized.")))  )
      actions))

;;;_   , elinstall-stage-run-tests
(defun elinstall-stage-run-tests (actions)
   "Run any tests mentioned in ACTIONS."

   (mapcar
      #'(lambda (act)
           (case (car act)
              (run-tests
                 ;;$$WRITE ME - not a high priority right now.
                 nil)
              (t
                 (error
                    "elinstall-stage-arrange-preloads: Action not
           recognized.")))  )
      actions))

;;;_   , elinstall-stage-byte-compile
(defun elinstall-stage-byte-compile (actions)
   "Do any byte-compilation mentioned in ACTIONS."

   (mapcar
      #'(lambda (act)
           (case (car act)
              ;;$$IMPROVE ME Understand flags to control second
              ;;argument (whether to load file after
              ;;compilation)
              (byte-compile
                 (byte-compile-file (second act)))
              (t
                 (error
                    "elinstall-stage-arrange-preloads: Action not
           recognized.")))  )
      actions))
;;;_   , elinstall-do-segment
;;$$OBSOLETE
'
(defun elinstall-do-segment (segment force use-load-path)
   "Do all the actions in SEGMENT.
FORCE has its usual meaning.
USE-LOAD-PATH is the effective load-path."

   (let*
      ((deffile (car segment)))
      (if (stringp deffile)
         (elinstall-update-deffile deffile (cdr segment) force
            use-load-path) 
         ;;Do other actions: link-in actions and cleanups.
         (mapcar
            #'(lambda (act)
                 
                 (case (car act)
                    (preload-file
                       (let
                          ((proceed (car act)))
                          (apply
                             #'elinstall-arrange-preload
                             force
                             (cddr act))))
                    (run-tests
                       ;;$$WRITE ME - not a high priority right now.
                       nil)
                    
                    ;;$$IMPROVE ME Understand flags to control second
                    ;;argument (whether to load file after
                    ;;compilation)
                    (byte-compile
                       (byte-compile-file (second act)))))
            
            (cdr segment)))))


;;;_  . Overall work
;;;_   , elinstall-x
(defun elinstall-x (dir spec &optional force)
   ""
   (let*
      (  
         ;;This is just the default deffile, spec can override it.
         (def-file
            (elinstall-expand-deffile-name nil))
         (actions
            (elinstall-find-actions-by-spec
               spec
               nil
               dir
               `(
                   (def-file . ,def-file ))))
         (stages (elinstall-segregate-actions actions))
         (use-load-path
            (elinstall-get-relevant-load-path
               actions)))

      (elinstall-stage-update-deffiles
         (elinstall-stages->build-deffiles stages)
         force 
         use-load-path)
      (elinstall-stage-arrange-preloads
         (elinstall-stages->arrange-preloads stages)
         (mapcar 
            #'car
            (elinstall-stages->build-deffiles stages)))
      t))

;;;_  . Entry points
;;;_   , elinstall
;;;###autoload
(defun elinstall (project-name path spec &optional force)
   "Install elisp files.
They need not be a formal package.

Parameters:

PROJECT-NAME - the name of the project

PATH - Path to the project.
  Suggestion: (elinstall-directory-true-name)

SPEC - a spec for the autoloads etc to make.  It can be as simple as
\(dir \"\.\") for installing one directory.

If FORCE is t, install a package even if it has already been
installed.  Other non-nil cases of FORCE are reserved for future
development."
   
   (when
      (and
         (or 
            force
            (not (elinstall-already-installed project-name)))
         (yes-or-no-p (format "Re-install %s? " project-name)))
      (elinstall-x 
         path 
         `(def-file "loaddefs.el" (t ,project-name) ,spec) 
         force)
      (elinstall-record-installed project-name)))



;;;_   , elinstall-update-directory-autoloads
;;$$TEST ME
;;;###autoload
(defun elinstall-update-directory-autoloads (dir)
   ""
   
   (interactive "DInstall all elisp files from directory: ")


   (let
      ((def-file-name
          (elinstall-expand-deffile-name 
             generated-autoload-file)))
      
      (elinstall-x
         dir
         `(def-file ,def-file-name (nil) (dir "."))
      
         )))


;;;_   , elinstall-update-file-autoloads
;;$$TEST ME
;;;###autoload
(defun elinstall-update-file-autoloads (file)
   ""
   
   (interactive "fInstall elisp file: ")
   (let
      ((def-file-name
          (or
            (elinstall-maybe-get-deffile file)
            (elinstall-expand-deffile-name 
               generated-autoload-file))))
      (elinstall 
         file
         `(def-file ,def-file-name (nil) (file ,file)))))

;;;_. Footers
;;;_ , Provides

(provide 'elinstall)

;;;_ * Local emacs vars.
;;;_  + Local variables:
;;;_  + mode: allout
;;;_  + End:

;;;_ , End
;;; elinstall.el ends here