/[emacs]/emacs/lisp/cus-dep.el
ViewVC logotype

Diff of /emacs/lisp/cus-dep.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.17 by pj, Mon Jul 16 12:22:58 2001 UTC revision 1.17.8.1 by miles, Fri Apr 4 06:20:01 2003 UTC
# Line 29  Line 29 
29  (eval-when-compile (require 'cl))  (eval-when-compile (require 'cl))
30  (require 'widget)  (require 'widget)
31  (require 'cus-face)  (require 'cus-face)
32  (require 'autoload)  
33    (defvar generated-custom-dependencies-file "cus-load.el"
34      "File \\[cusom-make-dependencies] puts custom dependencies into.")
35    
36  (defun custom-make-dependencies ()  (defun custom-make-dependencies ()
37    "Batch function to extract custom dependencies from .el files.    "Batch function to extract custom dependencies from .el files.
38  Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"  Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
39    (let ((enable-local-eval nil)    (let ((enable-local-eval nil))
40          (all-subdirs command-line-args-left)      (set-buffer (get-buffer-create " cus-dep temp"))
41          (start-directory default-directory))      (dolist (subdir command-line-args-left)
42      (get-buffer-create " cus-dep temp")        (message "Directory %s" subdir)
43      (set-buffer " cus-dep temp")        (let ((files (directory-files subdir nil "\\`[^=].*\\.el\\'"))
44      (while all-subdirs              (default-directory (expand-file-name subdir))
45        (message "Directory %s" (car all-subdirs))              (preloaded (concat "\\`"
46        (let ((files (directory-files (car all-subdirs) nil "\\`[^=].*\\.el\\'"))                                 (regexp-opt (mapcar
47              (default-directory default-directory)                                              (lambda (f)
48              file                                                (file-name-sans-extension
49              is-autoloaded)                                                 (file-name-nondirectory f)))
50          (cd (car all-subdirs))                                              preloaded-file-list) t)
51          (while files                                 "\\.el\\'")))
52            (setq file (car files)          (dolist (file files)
53                  files (cdr files))            (when (and (file-exists-p file)
54            (when (file-exists-p file)                       ;; Ignore files that are preloaded.
55                         (not (string-match preloaded file)))
56              (erase-buffer)              (erase-buffer)
57              (insert-file-contents file)              (insert-file-contents file)
58              (goto-char (point-min))              (goto-char (point-min))
59              (string-match "\\`\\(.*\\)\\.el\\'" file)              (string-match "\\`\\(.*\\)\\.el\\'" file)
60              (let ((name (file-name-nondirectory (match-string 1 file))))              (let ((name (file-name-nondirectory (match-string 1 file)))
61                      (load-file-name file))
62                  (if (save-excursion
63                        (re-search-forward
64                         (concat "(provide[ \t\n]+\\('\\|(quote[ \t\n]\\)[ \t\n]*"
65                                 (regexp-quote name) "[ \t\n)]")
66                         nil t))
67                      (setq name (intern name)))
68                (condition-case nil                (condition-case nil
69                    (while (re-search-forward "^(defcustom\\|^(defface\\|^(defgroup"                    (while (re-search-forward
70                                              nil t)                            "^(def\\(custom\\|face\\|group\\)" nil t)
                     (setq is-autoloaded nil)  
71                      (beginning-of-line)                      (beginning-of-line)
                     (save-excursion  
                       (forward-line -1)  
                       (if (looking-at generate-autoload-cookie)  
                           (setq is-autoloaded t)))  
72                      (let ((expr (read (current-buffer))))                      (let ((expr (read (current-buffer))))
73                        (condition-case nil                        (condition-case nil
74                            (progn                            (let ((custom-dont-initialize t))
75                              (eval expr)                              (eval expr)
                             (put (nth 1 expr) 'custom-autoloaded is-autoloaded)  
76                              (put (nth 1 expr) 'custom-where name))                              (put (nth 1 expr) 'custom-where name))
77                          (error nil))))                          (error nil))))
78                  (error nil)))))                  (error nil))))))))
79          (setq all-subdirs (cdr all-subdirs)))))    (message "Generating %s..." generated-custom-dependencies-file)
80    (message "Generating cus-load.el...")    (set-buffer (find-file-noselect generated-custom-dependencies-file))
   (find-file "cus-load.el")  
81    (erase-buffer)    (erase-buffer)
82    (insert "\    (insert "\
83  ;;; cus-load.el --- automatically extracted custom dependencies  ;;; " (file-name-nondirectory generated-custom-dependencies-file)
84          " --- automatically extracted custom dependencies
85  ;;  ;;
86  ;;; Code:  ;;; Code:
87    
# Line 86  Usage: emacs -batch -l ./cus-dep.el -f c Line 90  Usage: emacs -batch -l ./cus-dep.el -f c
90                (let ((members (get symbol 'custom-group))                (let ((members (get symbol 'custom-group))
91                      item where found)                      item where found)
92                  (when members                  (when members
93                      ;; So x and no-x builds won't differ.
94                      (setq members
95                            (sort (copy-sequence members)
96                                  (lambda (x y) (string< (car x) (car y)))))
97                    (while members                    (while members
98                      (setq item (car (car members))                      (setq item (car (car members))
99                            members (cdr members)                            members (cdr members)
# Line 94  Usage: emacs -batch -l ./cus-dep.el -f c Line 102  Usage: emacs -batch -l ./cus-dep.el -f c
102                                  (member where found))                                  (member where found))
103                        (if found                        (if found
104                            (insert " ")                            (insert " ")
105                          (insert "(put '" (symbol-name symbol)                          (insert "(put '" (symbol-name symbol)
106                                  " 'custom-loads '("))                                  " 'custom-loads '("))
107                        (prin1 where (current-buffer))                        (prin1 where (current-buffer))
108                        (push where found)))                        (push where found)))
# Line 102  Usage: emacs -batch -l ./cus-dep.el -f c Line 110  Usage: emacs -batch -l ./cus-dep.el -f c
110                      (insert "))\n"))))))                      (insert "))\n"))))))
111    (insert "\    (insert "\
112  ;;; These are for handling :version.  We need to have a minimum of  ;;; These are for handling :version.  We need to have a minimum of
113  ;;; information so `custom-changed-variables' could do its job.    ;;; information so `customize-changed-options' could do its job.
 ;;; For both groups and variables we have to set `custom-version'.  
 ;;; For variables we also set the `standard-value' and for groups  
 ;;; `group-documentation' (which is shown in the customize buffer), so  
 ;;; we don't have to load the file containing the group.  
114    
115  ;;; `custom-versions-load-alist' is an alist that has as car a version  ;;; For groups we set `custom-version', `group-documentation' and
116  ;;; number and as elts the files that have variables that contain that  ;;; `custom-tag' (which are shown in the customize buffer), so we
117  ;;; version. These files should be loaded before showing the  ;;; don't have to load the file containing the group.
 ;;; customization buffer that `customize-changed-options' generates.  
118    
119    ;;; `custom-versions-load-alist' is an alist that has as car a version
120    ;;; number and as elts the files that have variables or faces that
121    ;;; contain that version. These files should be loaded before showing
122    ;;; the customization buffer that `customize-changed-options'
123    ;;; generates.
124    
125  ;;; This macro is used so we don't modify the information about  ;;; This macro is used so we don't modify the information about
126  ;;; variables and groups if it's already set. (We don't know when  ;;; variables and groups if it's already set. (We don't know when
127  ;;; cus-load.el is going to be loaded and at that time some of the  ;;; " (file-name-nondirectory generated-custom-dependencies-file)
128          " is going to be loaded and at that time some of the
129  ;;; files might be loaded and some others might not).  ;;; files might be loaded and some others might not).
130  \(defmacro custom-put-if-not (symbol propname value)  \(defmacro custom-put-if-not (symbol propname value)
131    `(unless (get ,symbol ,propname)    `(unless (get ,symbol ,propname)
# Line 127  Usage: emacs -batch -l ./cus-dep.el -f c Line 136  Usage: emacs -batch -l ./cus-dep.el -f c
136      (mapatoms (lambda (symbol)      (mapatoms (lambda (symbol)
137                  (let ((version (get symbol 'custom-version))                  (let ((version (get symbol 'custom-version))
138                        where)                        where)
139                    (when version                    (when version
140                      (setq where (get symbol 'custom-where))                      (setq where (get symbol 'custom-where))
141                      (when (and where                      (when where
142                                 ;; Don't bother to do anything if it's                        (if (or (custom-variable-p symbol)
143                                 ;; autoloaded because we will have all                                (custom-facep symbol))
144                                 ;; this info when emacs is running                            ;; This means it's a variable or a face.
                                ;; anyway.  
                                (not (get symbol 'custom-autoloaded)))  
                       (insert "(custom-put-if-not '" (symbol-name symbol)  
                               " 'custom-version ")  
                       (prin1 version (current-buffer))  
                       (insert ")\n")  
                       (insert "(custom-put-if-not '" (symbol-name symbol))  
                       (if (get symbol 'standard-value)  
                           ;; This means it's a variable  
145                            (progn                            (progn
                             (insert " 'standard-value t)\n")  
146                              (if (assoc version version-alist)                              (if (assoc version version-alist)
147                                  (unless                                  (unless
148                                      (member where                                      (member where
149                                              (cdr (assoc version version-alist)))                                              (cdr (assoc version version-alist)))
150                                    (push where (cdr (assoc version version-alist))))                                    (push where (cdr (assoc version version-alist))))
151                                (push (cons version (list where)) version-alist)))                                (push (cons version (list where)) version-alist)))
152                          ;; This is a group                          ;; This is a group
153                            (insert "(custom-put-if-not '" (symbol-name symbol)
154                                    " 'custom-version ")
155                            (prin1 version (current-buffer))
156                            (insert ")\n")
157                            (insert "(custom-put-if-not '" (symbol-name symbol))
158                          (insert " 'group-documentation ")                          (insert " 'group-documentation ")
159                          (prin1 (get symbol 'group-documentation) (current-buffer))                          (prin1 (get symbol 'group-documentation) (current-buffer))
160                          (insert ")\n")))))))                          (insert ")\n")
161                            (when (get symbol 'custom-tag)
162                              (insert "(custom-put-if-not '" (symbol-name symbol))
163                              (insert " 'custom-tag ")
164                              (prin1 (get symbol 'custom-tag) (current-buffer))
165                              (insert ")\n"))
166                            ))))))
167    
168      (insert "\n(defvar custom-versions-load-alist "      (insert "\n(defvar custom-versions-load-alist "
169              (if version-alist "'" ""))              (if version-alist "'" ""))
170      (prin1 version-alist (current-buffer))      (prin1 version-alist (current-buffer))
171      (insert "\n \"For internal use by custom.\")\n"))      (insert "\n \"For internal use by custom.\")\n"))
172        
173    (insert "\    (insert "\
174    
175  \(provide 'cus-load)  \(provide '" (file-name-sans-extension
176                  (file-name-nondirectory generated-custom-dependencies-file)) ")
177    
178  ;;; Local Variables:  ;;; Local Variables:
179  ;;; version-control: never  ;;; version-control: never
180  ;;; no-byte-compile: t  ;;; no-byte-compile: t
181  ;;; no-update-autoloads: t  ;;; no-update-autoloads: t
182  ;;; End:  ;;; End:
183  ;;; cus-load.el ends here\n")  ;;; " (file-name-nondirectory generated-custom-dependencies-file) " ends here\n")
184    (let ((kept-new-versions 10000000))    (let ((kept-new-versions 10000000))
185      (save-buffer))      (save-buffer))
186    (message "Generating cus-load.el...done")    (message "Generating %s...done" generated-custom-dependencies-file)
187    (kill-emacs))    (kill-emacs))
188    
189    

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.17.8.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26