From a4228d97938a1428191611d26755382edaaaa791 Mon Sep 17 00:00:00 2001 From: "Tom Breton (Tehom)" Date: Wed, 10 Nov 2010 13:24:53 -0500 Subject: [PATCH] Reorganize file layout --- elinstall.el | 583 +++++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 365 insertions(+), 218 deletions(-) diff --git a/elinstall.el b/elinstall.el index e7566f2..c70c9d2 100644 --- a/elinstall.el +++ b/elinstall.el @@ -32,6 +32,9 @@ ;;;_ , Requires +(require 'autoload) +(require 'pp) +(require 'cus-edit) ;;Because we save "installedness" manually ;;;_. Body @@ -66,7 +69,7 @@ This exists for recording what has been installed. User interaction is not contemplated at this time." ) ;;;_ , 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." @@ -74,8 +77,24 @@ CAUTION: This is sensitive to where it's called. That's the point of it." (if load-file-name (file-truename load-file-name) (file-truename buffer-file-name)))) -;;;_ . Regular expressions -;;;_ , elinstall-elisp-regexp +;;;_ . 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")) + +;;;_ , Regular expressions +;;;_ . elinstall-elisp-regexp (defconst elinstall-elisp-regexp (let ((tmp nil)) (dolist @@ -85,7 +104,7 @@ CAUTION: This is sensitive to where it's called. That's the point of it." "Regular expression that matches elisp files" ) ;;;_ , Work -;;;_ . Actions +;;;_ . Doing actions ;;;_ , elinstall-insert-add-to-path (defun elinstall-insert-add-to-path (new path-sym) "Insert code to add NEW to PATH-SYM. @@ -199,21 +218,38 @@ FILENAME should not have an extension" (let ((generated-autoload-file autoloads-file)) (elinstall-update-directory-autoloads directory))) -;;;_ , elinstall-actions-by-deffile -(defun elinstall-actions-by-deffile (actions) +;;;_ , elinstall-segregate-actions +(defun elinstall-segregate-actions (actions) "Return actions segregated by deffile. -Returns a list whose elements are each: +Returns a list whose elements are each a cons of: * deffile filename or nil * A list of actions to be done for that deffile." - - ;;$$Test me - (let* - (()) + + (let + ((segment-list '())) (dolist (act actions) - - ) - )) + (when act + (let* + ( (deffile-name + (case (car act) + ((add-file-autoloads + add-to-info-path + add-to-load-path) + (second act)) + (preload-file nil))) + + (cell (assoc deffile-name segment-list))) + (if cell + (setcdr cell (cons act (cdr cell))) + (setq segment-list + (cons + (cons + deffile-name + (list act)) + segment-list)))))) + segment-list)) + ;;;_ , elinstall-do-segment (defun elinstall-do-segment (segment force) @@ -223,37 +259,19 @@ Returns a list whose elements are each: ((deffile (car segment))) (if deffile nil ;; - nil ;;Do other actions, which will be all link-in actions. - ))) - -;;;_ , elinstall-do-actions -;;$$OBSOLESCENT already. Will mostly -(defun elinstall-do-action (action force) - "Do a single installating action ACTION. + ;;Do other actions, which will be all link-in actions. + (mapcar + #'(lambda (act) + (apply #'elinstall-link-on-emacs-start force (cdr action)) + ) + (cdr segment))))) -If FORCE is `t', do it regardless of timestamps etc. -Other non-nil cases of FORCE are reserved for future development." - (when action - (case (car action) - - (add-dir-autoloads - (apply #'elinstall-insert-dir-autoloads (cdr action))) - - (add-to-load-path - ;;Go to the right buffer, right position, then call: - '(elinstall-insert-add-to-load-path)) - - ;;Similar, but for info-path. - (add-to-info-path - 'elinstall-insert-add-to-info-path) - - (preload-file - (apply #'elinstall-link-on-emacs-start force (cdr action)))))) ;;;_ . Overrides (All adapted from autoload.el) -;;;_ , generate-file-autoloads override to allow slashed load-paths -;;Quick and dirty: We just override `generate-file-autoloads' and add +;;;_ , 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 @@ -261,7 +279,7 @@ Other non-nil cases of FORCE are reserved for future development." ;; * t :: use default-directory ;; * a string :: relative to it, as a filename -(defun generate-file-autoloads (file &optional relative-to) +(defun elinstall-generate-file-autoloads (file load-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). @@ -271,17 +289,6 @@ Return non-nil in the case where no autoloads were added at point." (interactive "fGenerate autoloads for file: ") (let ((outbuf (current-buffer)) (autoloads-done '()) - (load-name (let ((name - (cond - ((not relative-to) - (file-name-nondirectory file)) - ((eq relative-to t) - (file-relative-name file)) - (t - (file-relative-name relative-to))))) - (if (string-match "\\.elc?\\(\\.\\|$\\)" name) - (substring name 0 (match-beginning 0)) - name))) (print-length nil) (print-readably t) ; This does something in Lucid Emacs. (float-output-format nil) @@ -369,142 +376,213 @@ Return non-nil in the case where no autoloads were added at point." ;; We created this buffer, so we should kill it. (kill-buffer (current-buffer)))) (not done-any))) -;;;_ , elinstall-update-file-autoloads -(defun elinstall-update-file-autoloads (file &optional save-after) - "Update the autoloads for FILE in `generated-autoload-file' -\(which FILE might bind in its local variables). -If SAVE-AFTER is non-nil (which is always, when called interactively), -save the buffer too. +;; +;;;_ , elinstall-old-prepare-deffile +;;Old code from autoload. +(defun elinstall-old-prepare-deffile (deffile) + "" + + (autoload-ensure-default-file deffile) + (with-current-buffer (find-file-noselect deffile) -Return FILE if there was no autoload cookie in it, else nil." - (interactive "fUpdate autoloads for file: \np") - (let ((load-name (let ((name (file-name-nondirectory file))) - (if (string-match "\\.elc?\\(\\.\\|$\\)" name) - (substring name 0 (match-beginning 0)) - name))) - (found nil) - (existing-buffer (get-file-buffer file)) - (no-autoloads nil)) - (save-excursion - ;; We want to get a value for generated-autoload-file from - ;; the local variables section if it's there. - (if existing-buffer - (set-buffer existing-buffer)) + ;; We must read/write the file without any code conversion, ;; but still decode EOLs. (let ((coding-system-for-read 'raw-text)) - (set-buffer (find-file-noselect - (autoload-ensure-default-file - (expand-file-name generated-autoload-file - (expand-file-name "lisp" - source-directory))))) - ;; 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)) + + ;; 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)) + (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)) + (error "Autoloads file %s is not writable" + buffer-file-name)))) + +;;;_ , elinstall-old-get-deffile +;;Old code from autoload. + +(defun elinstall-old-get-deffile (file) + "Return the appropriate loaddefs file for FILE." + + (save-excursion + (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)) + ;;No, we only want it if a local variable forces it to this + ;; value. + (expand-file-name generated-autoload-file + (expand-file-name "lisp" + source-directory))))) + + + +;;;_ , elinstall-deffile-insert +;;This now operates in the current buffer. We already did most of +;;this checking on setup. +;; Removed +;; * buffer optional save, +;; * converting file to load-name +;; * checking for timestamp +(defun elinstall-deffile-insert-x (file load-name) + "Update the autoloads for FILE in `generated-autoload-file' +\(which FILE might bind in its local variables). + +LOAD-NAME is the full name of the file + + +Return FILE if there was no autoload cookie in it, else nil." + (let ( + (found nil) + (no-autoloads nil)) + (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - ;; Look for the section for LOAD-NAME. - (while (and (not found) + (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 ((string= (nth 2 form) load-name) - ;; We found the section for this file. - ;; Check if it is up to date. - (let ((begin (match-beginning 0)) - (last-time (nth 4 form)) - (file-time (nth 5 (file-attributes file)))) - (if (and (or (null existing-buffer) - (not (buffer-modified-p existing-buffer))) - (listp last-time) (= (length last-time) 2) - (not (time-less-p last-time file-time))) + (let ((form (autoload-read-section-header))) + (cond + ((string= (nth 2 form) file) + ;; We found the section for this file. + ;; Check if it is up to date. + (let ((begin (match-beginning 0))) (progn - (if (interactive-p) - (message "\ -Autoload section for %s is up to date." - file)) - (setq found 'up-to-date)) - (search-forward generate-autoload-section-trailer) - (delete-region begin (point)) - (setq found t)))) - ((string< load-name (nth 2 form)) - ;; We've come to a section alphabetically later than - ;; LOAD-NAME. We assume the file is in order and so - ;; there must be no section for LOAD-NAME. We will - ;; insert one before the section here. - (goto-char (match-beginning 0)) - (setq found 'new))))) - (or 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))) - (or (eq found 'up-to-date) - (setq no-autoloads (generate-file-autoloads file))))) - (and save-after - (buffer-modified-p) - (save-buffer)) - - (if no-autoloads file)))) -;;;_ , elinstall-update-directory-autoloads -(defun elinstall-update-directory-autoloads (dir) - "" - - (interactive "DUpdate autoloads from directory: ") - - ;;deffile will be. - '(autoload-ensure-default-file autoloads-file) - (elinstall "" + (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))) + +;;;_ , elinstall-deffile-insert + +(defun elinstall-deffile-insert (action) + "Insert autoloads or similar 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) + (let + ((filename + (third action))) + (add-file-autoloads + (elinstall-deffile-insert-x + filename + (expand-file-name + filename + (fourth action))))) - )) + (add-to-load-path + ;;Go to the right position, then call: + '(elinstall-insert-add-to-load-path) + nil) + + ;;Similar, but for info-path. + (add-to-info-path + 'elinstall-insert-add-to-info-path + nil) + + (preload-file + (error "This case should not come here."))))) + + +;;;_ , 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)))) + 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)) ;;;_ , elinstall-update-deffile ;;Adapted from autoload.el `update-directory-autoloads'. -(defun elinstall-update-deffile (target actions load-path) +;;Still being adapted: + +;; * Still need to treat add-to-info-path and +;;add-to-load-path. Both recognize them and insert them. +;; * Adapt `elinstall-update-file-autoloads' to understand actions. + +;; * Finding "file" among actions is rickety. Maybe knowing the +;; respective load-path element would help. + +(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) +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. -LOAD-PATH is the value of load-path to use, including any new -load-path that we are arranging to create. +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* + (let ( - ;;This is to be gotten from actions. - (files (apply 'nconc - (mapcar (lambda (dir) - (directory-files (expand-file-name dir) - t files-re)) - dirs))) + (use-load-path (or use-load-path load-path)) (this-time (current-time)) - (no-autoloads nil) ;files with no autoload cookies. - ;;We'll know this directly. - (autoloads-file - (expand-file-name generated-autoload-file - (expand-file-name "lisp" source-directory))) - (top-dir (file-name-directory autoloads-file))) + ;;files with no autoload cookies. + (no-autoloads nil)) + (with-current-buffer (find-file-noselect target) (save-excursion - - ;; Canonicalize file names and remove the autoload file itself. - (setq files (delete (autoload-trim-file-name buffer-file-name) - (mapcar 'autoload-trim-file-name files))) + (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) @@ -523,21 +601,38 @@ of a single directory." (not (time-less-p last-time file-time))) ;; file unchanged (push file no-autoloads) - (setq files (delete file files))))))) + (setq actions + (elinstall-remove-autogen-action + file actions))))))) ((not (stringp file))) - ((not (file-exists-p (expand-file-name file top-dir))) - ;; Remove the obsolete section. - (autoload-remove-section (match-beginning 0))) - ((equal (nth 4 form) (nth 5 (file-attributes file))) - ;; File hasn't changed. - nil) (t - (elinstall-update-file-autoloads file))) - (setq files (delete file files))))) - ;; Elements remaining in FILES have no existing autoload sections yet. + (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)))) + + (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-update-file-autoloads files)))) + (delq nil (mapcar #'elinstall-deffile-insert actions)))) (when no-autoloads ;; Sort them for better readability. (setq no-autoloads (sort no-autoloads 'string<)) @@ -549,8 +644,7 @@ of a single directory." (insert generate-autoload-section-trailer)) (save-buffer)))) - -;;;_ . Generating autoloads etc by spec +;;;_ . Finding actions ;;;_ , Treating the parameter list ;;;_ . elinstall-add-parameter (defun elinstall-add-parameter (alist key new-value) @@ -575,22 +669,26 @@ of a single directory." ;;;_ , elinstall-find-actions-by-spec -(defun elinstall-find-actions-by-spec (spec parameters) - "Return a list of actions to do, controlled by SPEC and PARAMETERS." +(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 PATH. 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 - (elinstall-expand-filename - (second spec) - parameters))) + (expand-filename + (second spec) + path))) (elinstall-find-actions-by-spec (third spec) - (elinstall-add-parameter parameters - 'path new-path)))) + load-path-element + new-path + parameters))) (all (apply #'append @@ -598,34 +696,51 @@ of a single directory." #'(lambda (sub-spec) (elinstall-find-actions-by-spec sub-spec + load-path-element + path parameters)) (cdr spec)))) (dir - - (cons - (unless - (elinstall-get-parameter - parameters 'block-add-to-load-path) - `(add-to-load-path - ,(elinstall-get-parameter - parameters 'def-file) - ,(elinstall-expand-filename - (second spec) - parameters))) - (mapcar - #'(lambda (filename) - `(add-file-autoloads - ,(elinstall-get-parameter - parameters 'def-file) - ,(elinstall-expand-filename - filename - parameters))) + (let + ((dirname + (expand-filename + (second spec) + path)) + (load-path-here + (not + (elinstall-get-parameter + parameters 'block-add-to-load-path)))) + (cons + (if load-path-here + `(add-to-load-path + ,(elinstall-get-parameter + parameters 'def-file) + ,dirname) + '()) + ;;$$IMPROVE ME + ;; We want to get a value for generated-autoload-file + ;; from the local variables section if it's there. + ;; 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. + (mapcar + #'(lambda (filename) + `(add-file-autoloads + ,(elinstall-get-parameter + parameters 'def-file) + (file-relative-name + (expand-filename filename path) + load-path-element) + load-path-element)) - (directory-files - (expand-file-name (second spec)) - nil ;;Relative filenames - elinstall-elisp-regexp)))) + (directory-files + dirname + nil ;;Relative filenames + elinstall-elisp-regexp))))) (def-file (let @@ -635,6 +750,8 @@ of a single directory." parameters))) (elinstall-find-actions-by-spec (third spec) + load-path-element + path (elinstall-add-parameter parameters 'def-file new-def-file))))) @@ -642,22 +759,16 @@ of a single directory." (case spec (t)))) -;;;_ , 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")) +;;;_ . Cleaning up +;;Nothing yet +;;;_ . elinstall-x +(defun elinstall-x (dir spec &optional target force) + "" + (let* + () + + )) ;;;_ , Entry points (defun elinstall (project-name dir spec &optional target force) "Install elisp files. @@ -690,12 +801,14 @@ Other non-nil cases of FORCE are reserved for future development." ((actions (elinstall-find-actions-by-spec spec + nil + dir `( - (path . ,dir) + ;;$$RETHINK ME - maybe hand this work off to autoload? ;;This is just the default loaddefs file, spec actually ;;controls it. (def-file . "elinstall-loaddefs.el" )))) - (segment-list (elinstall-actions-by-deffile actions))) + (segment-list (elinstall-segregate-actions actions))) (mapcar #'(lambda (segment) @@ -705,6 +818,40 @@ Other non-nil cases of FORCE are reserved for future development." '(elinstall-record-installed project-name)))) +;;;_ , elinstall-update-directory-autoloads +;;$$PUNT +(defun elinstall-update-directory-autoloads (dir) + "" + + (interactive "DUpdate autoloads from directory: ") + + (elinstall + ;;$$IMPROVE ME make DIR absolute + (format "Elisp files of %s" dir) + dir + '(dir ".") + (autoload-ensure-default-file + (expand-file-name generated-autoload-file + (expand-file-name "lisp" source-directory))))) + + +;;;_ , elinstall-update-file-autoloads +;;$$PUNT +(defun elinstall-update-file-autoloads (file &optional save-after) + "" + + (interactive "fUpdate autoloads for file: \np") + (elinstall + (format "Elisp file %s" file) + dir + `(file ,file) + (autoload-ensure-default-file + (expand-file-name generated-autoload-file + (expand-file-name "lisp" source-directory)))) + ) + + + ;;;_. Footers ;;;_ , Provides -- 2.11.4.GIT