1 ;;; initz-list.el --- File list mode.
3 ;; Copyright (C) 2002 OHASHI Akira <bg66@koka-in.org>
5 ;; Author: OHASHI Akira <bg66@koka-in.org>
6 ;; Keywords: startup, init
8 ;; This file is part of Initz.
10 ;; This program 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 program 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 the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
32 (require 'initz-globals)
35 (defvar initz-list-mode-map nil
36 "Local map for initz list buffers.")
37 (unless initz-list-mode-map
38 (let ((map (make-sparse-keymap)))
39 (define-key map mouse-button-2 'initz-list-find-file-mouse)
40 (define-key map "n" 'initz-list-next-line)
41 (define-key map "p" 'initz-list-previous-line)
42 (define-key map "h" 'backward-char)
43 (define-key map "j" 'initz-list-next-line)
44 (define-key map "k" 'initz-list-previous-line)
45 (define-key map "l" 'forward-char)
46 (define-key map " " 'initz-list-find-file)
47 (define-key map "\C-m" 'initz-list-find-file)
48 (define-key map "B" 'initz-list-byte-compile-file)
49 (define-key map "D" 'initz-list-delete-file)
50 (define-key map "L" 'initz-list-load-file)
51 (define-key map "N" 'initz-list-new-file)
52 (define-key map "S" 'initz-startup)
53 (define-key map "q" 'initz-list-quit)
54 (setq initz-list-mode-map map)))
56 (defvar initz-list-node-map nil)
57 (unless initz-list-node-map
58 (let ((map (make-sparse-keymap)))
59 (set-keymap-parent map initz-list-mode-map)
60 (define-key map mouse-button-2 'initz-list-node-click)
61 (define-key map " " 'initz-list-node-enter)
62 (define-key map "\C-m" 'initz-list-node-enter)
63 (setq initz-list-node-map map)))
65 (defvar initz-list-mode-hook nil
66 "Normal hook run when entering initz-list-mode.")
68 (defconst initz-list-mode-name "Initz List")
70 (defconst initz-list-buffer-name "*Initz List*")
72 (defconst initz-list-delete-file-ask-message-format
75 (defconst initz-list-input-dir-message-format
78 (defconst initz-list-input-module-message-format
81 (defconst initz-list-new-file-illegal-message
82 "Module name is illegal.")
84 (defconst initz-list-new-file-exists-message
85 "File already exists.")
87 (defconst initz-list-new-file-provided-message
88 "Module is already provided.")
90 (defconst initz-list-new-file-comment-message-format
91 ";;; %s --- init file for %s.\n\n\n\n")
93 (defconst initz-list-new-file-provide-message-format
96 (defconst initz-list-click-message-format
97 "Click %s on the module name to select it.\n")
99 (defconst initz-list-enter-message-format
100 "In this buffer, type %s to select the module name under point.\n")
102 (defconst initz-list-modeline-string
105 ;; Initz list mode is suitable only for specially formatted data.
106 (put 'initz-list-mode 'mode-class 'special)
108 (defadvice sort-build-lists (after sort-including-newline activate)
109 (when (or (eq major-mode 'initz-list-mode)
110 (eq major-mode 'initz-error-mode))
111 (setq ad-return-value
112 (mapcar #'(lambda (list)
113 (cons (cons (caar list) (1+ (cdar list)))
114 (cons (cadr list) (1+ (cddr list)))))
117 (defun initz-list-delete-whole-line ()
118 "Delete whole line at point."
119 (setq buffer-read-only nil)
120 (delete-region (progn (beginning-of-line) (point))
121 (progn (forward-line 1) (point)))
122 (set-buffer-modified-p nil)
123 (setq buffer-read-only t))
125 (defun initz-list-get-dir ()
126 "Return the dir at point."
129 (when (re-search-backward "^\\[[-+]\\] \\([^ :]+\\)" nil t)
132 (defun initz-list-input-dir (&optional default)
134 (let* ((completing-list (mapcar #'(lambda (list)
135 (symbol-name (car list)))
137 (default (if (stringp default) default "misc")))
139 (format initz-list-input-dir-message-format
140 initz-directory default)
141 (mapcar #'(lambda (name)
144 nil t nil nil default)))
146 (defun initz-list-input-module (dir)
148 (let ((init (initz-get-init-value (intern dir) 'prefix)))
149 (setq init (initz-trim-separator init))
150 (unless (string= init initz-null-string)
151 (setq init (concat init initz-separator-string)))
152 (if initz-list-input-module-completing
154 (format initz-list-input-module-message-format dir)
155 (mapcar #'(lambda (feature)
156 (let ((name (symbol-name feature)))
161 (format initz-list-input-module-message-format dir)
164 (defun initz-list-insert-file (dir startup-file)
165 "Insert the STARTUP-FILE at DIR section."
166 ;; FIXME: Delete `save-excursion' and fix the next `FIXME'.
168 (goto-char (point-min))
169 (when (re-search-forward (concat "^\\[[-+]\\] " dir "[ :]") nil t)
171 (let ((status (get-text-property (point) :status)))
172 (when (eq status 'expand)
175 (setq sort-start (point))
176 (if (re-search-forward "^\\[[-+]\\] " nil t)
178 (re-search-forward "\\'" nil t))
179 (setq buffer-read-only nil)
181 (let ((start (point)))
182 (insert (initz-get-module-name startup-file) "\n")
183 (add-text-properties start (1- (point))
184 `(face initz-list-module-face
186 start-open t rear-nonsticky t
187 help-echo ,startup-file))
188 (put-text-property start (point) :file startup-file))
189 (sort-lines nil sort-start (point)))
190 (set-buffer-modified-p nil)
191 (setq buffer-read-only t)
192 ;; FIXME: Move to the line inserted now
195 (defun initz-list-node-insert (node status)
196 (let ((prefix (initz-get-init-value node 'prefix))
198 (setq prefix (initz-trim-separator prefix))
199 ;; `prefix' will be broken.
200 (if (string= prefix initz-null-string)
201 (setq prefix initz-null-string)
202 (setq prefix (concat " (" prefix ")")))
203 (insert "[" (if (eq status 'expand) "-" "+") "] "
204 (symbol-name node) prefix ":\n")
205 (add-text-properties start (+ start 3)
206 `(face initz-list-node-face
208 local-map ,initz-list-node-map
209 keymap ,initz-list-node-map
210 start-open t rear-nonsticky t
214 (defun initz-list-node-collapse (node)
216 (setq buffer-read-only nil)
217 (goto-char (point-min))
218 (if (re-search-forward (concat "^\\[-\\] "
219 (symbol-name node) "[ :]") nil t)
220 (let ((start (progn (beginning-of-line) (point)))
223 (if (re-search-forward "^\\[[-+]\\] " nil t)
227 (setq end (point-max)))
228 (delete-region start end))
229 (goto-char (point-max)))
230 (initz-list-node-insert node 'collapse)
231 (set-buffer-modified-p nil)
232 (setq buffer-read-only t)))
234 (defun initz-list-node-expand (node)
236 (setq buffer-read-only nil)
237 (goto-char (point-min))
238 (if (re-search-forward (concat "^\\[\\+\\] "
239 (symbol-name node) "[ :]") nil t)
240 (delete-region (progn (beginning-of-line) (point))
241 (progn (forward-line 1) (point)))
242 (goto-char (point-max)))
243 (initz-list-node-insert node 'expand)
244 (let ((sort-start (point))
245 (initz-features (initz-features)))
248 (let* ((module (initz-get-module-name file))
249 (loaded (memq (intern module) initz-features))
254 (when loaded (insert initz-list-loaded-mark))
256 (add-text-properties start (1- (point))
258 'initz-list-module-face
259 'initz-list-unloaded-module-face)
261 start-open t rear-nonsticky t
263 (put-text-property start (point) :file file)))
264 (initz-get-files 'startup node))
265 (sort-lines nil sort-start (point)))
266 (set-buffer-modified-p nil)
267 (setq buffer-read-only t)))
269 (defun initz-list-node-enter ()
271 (let ((node (get-text-property (point) :node))
272 (status (get-text-property (point) :status)))
273 (when (and node status)
274 (if (eq status 'expand)
275 (initz-list-node-collapse node)
276 (initz-list-node-expand node))
279 (defun initz-list-node-click (e)
282 (initz-list-node-enter))
284 (defun initz-list-next-line (&optional arg)
290 (let ((start (re-search-forward "^\\( \\|\\[\\|\\)" nil t)))
291 (when (integer-or-marker-p start)
294 (defun initz-list-previous-line ()
296 (initz-list-next-line -1))
298 (defun initz-list-print-file ()
299 "Print the file name under point."
301 (let ((file (get-text-property (point) :file)))
303 (initz-message-no-log file))))
305 (defun initz-list-find-file ()
306 "View the file under point."
308 (let ((file (get-text-property (point) :file)))
310 (find-file-other-window file))))
312 (defun initz-list-find-file-mouse (e)
313 "View the file under clicked point."
317 (initz-list-find-file)))
319 (defun initz-list-byte-compile-file ()
320 "Byte-compile the file under point."
322 (let ((file (get-text-property (point) :file)))
324 (let ((compile-file (initz-get-correspondence-file file)))
325 (when (file-newer-than-file-p file compile-file)
327 (when (save-window-excursion
328 (byte-compile-file file))
329 (let ((startup-directory (file-name-directory file))
330 (flavor-directory (file-name-directory compile-file)))
331 (install-file (file-name-nondirectory compile-file)
332 startup-directory flavor-directory t t))
333 (setq initz-compile-error-files
334 (delete file initz-compile-error-files)))
337 (defun initz-list-delete-file ()
338 "Delete the file under point."
340 (let ((file (get-text-property (point) :file)))
343 (format initz-list-delete-file-ask-message-format
344 (initz-get-module-name file))))
346 (setq initz-compile-error-files
347 (delete file initz-compile-error-files))
348 (setq initz-load-error-files
349 (delete file initz-load-error-files))
350 (initz-list-delete-whole-line)
351 (initz-list-previous-line)
352 (initz-list-next-line))))
354 (defun initz-list-load-file ()
355 "Load the file under point."
357 (let* ((file (get-text-property (point) :file)))
358 (when (and (initz-list-byte-compile-file)
359 (initz-load-file (initz-get-correspondence-file file)))
360 (setq initz-load-error-files
361 (delete file initz-load-error-files)))))
364 (defun initz-list-new-file ()
365 "Make new init file."
367 (let* ((default (initz-list-get-dir))
368 (dir (initz-list-input-dir default))
369 (module (initz-list-input-module dir)))
370 (if (not (or (and (string= dir "misc") (string= module initz-null-string))
371 (string-match (concat "^" initz-module-regexp "$") module)))
372 (message initz-list-new-file-illegal-message)
373 (setq module (initz-trim-separator module))
374 (let* ((startup-file (expand-file-name
376 (if (string= module initz-null-string)
378 initz-separator-string)
380 (initz-startup-directory (intern dir)))))
381 (if (file-exists-p startup-file)
382 (message initz-list-new-file-exists-message)
383 (let ((base-name (initz-get-base-name startup-file)))
384 (if (memq (intern base-name) features)
385 (message initz-list-new-file-provided-message)
386 (initz-list-insert-file dir startup-file)
387 (find-file-other-window startup-file)
388 (insert (format initz-list-new-file-comment-message-format
389 (file-name-nondirectory startup-file)
390 (if (string= module initz-null-string)
393 (insert (format initz-list-new-file-provide-message-format
396 (goto-char (point-min))
397 (search-forward "\n\n"))))))))
399 (defun initz-list-quit ()
400 "Quit the initz list mode."
402 (when (or (eq major-mode 'initz-list-mode)
403 (eq major-mode 'initz-error-mode))
404 (remove-hook 'post-command-hook
406 (substring (symbol-name major-mode) 0
408 (symbol-name major-mode)))
410 (let ((buf (current-buffer)))
411 (unless (one-window-p)
415 (defun initz-list-mode ()
416 "\\<initz-list-mode-map>
417 Major mode for browsing initz list buffer.
419 \\[initz-list-next-line] Next line.
420 \\[initz-list-previous-line] Previous line.
421 \\[forward-char] Forward char.
422 \\[backward-char] Backward char.
424 \\[initz-list-find-file] View the file under point.
425 \\[initz-list-byte-compile-file] Byte-compile the file under point.
426 \\[initz-list-delete-file] Delete the file under point.
427 \\[initz-list-load-file] Load the file under point.
428 \\[initz-list-new-file] Make new init file.
429 \\[initz-startup] Initz startup.
430 \\[initz-list-quit] Quit the initz list mode."
432 (kill-all-local-variables)
433 (use-local-map initz-list-mode-map)
434 (setq mode-name initz-list-mode-name)
435 (setq major-mode 'initz-list-mode)
436 (when (or (featurep 'xemacs) (< emacs-major-version 21))
437 (make-local-hook 'post-command-hook))
438 (add-hook 'post-command-hook 'initz-list-print-file)
439 (setq mode-line-buffer-identification initz-list-modeline-string)
440 (run-hooks 'initz-list-mode-hook))
444 "Show initz list buffer."
447 (let ((buf (get-buffer initz-list-buffer-name)))
449 (unless (one-window-p)
452 (switch-to-buffer-other-window initz-list-buffer-name)
454 (goto-char (point-min))
456 (format initz-list-click-message-format
457 (substitute-command-keys "\\[initz-list-find-file-mouse]")))
459 (format initz-list-enter-message-format
460 (substitute-command-keys "\\[initz-list-find-file]")))
462 (mapc #'(lambda (alist)
463 (let ((sym (car alist)))
464 (funcall (intern (concat "initz-list-node-"
466 initz-list-default-node-status)))
469 (set-buffer-modified-p nil)
470 (setq buffer-read-only t)
471 (goto-char (point-min))
472 (search-forward "\n\n")
475 (provide 'initz-list)
477 ;;; initz-list.el ends here