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.
33 (eval-when-compile (require 'cl))
34 (require 'initz-globals)
37 (defvar initz-list-mode-menu
39 ["View" initz-list-find-file t]
40 ["Byte-compile" initz-list-byte-compile-file t]
41 ["Delete" initz-list-delete-file t]
42 ["Load" initz-list-load-file t]
43 ["Make new file" initz-list-new-file t]
45 ["Startup" initz-startup t]
47 ["Quit" initz-list-quit t]))
49 (defvar initz-list-mode-map nil
50 "Local map for initz list buffers.")
51 (unless initz-list-mode-map
52 (let ((map (make-sparse-keymap)))
53 (define-key map mouse-button-2 'initz-list-find-file-mouse)
54 (define-key map "n" 'initz-list-next-line)
55 (define-key map "p" 'initz-list-previous-line)
56 (define-key map "h" 'backward-char)
57 (define-key map "j" 'initz-list-next-line)
58 (define-key map "k" 'initz-list-previous-line)
59 (define-key map "l" 'forward-char)
60 (define-key map " " 'initz-list-find-file)
61 (define-key map "\C-m" 'initz-list-find-file)
62 (define-key map "B" 'initz-list-byte-compile-file)
63 (define-key map "D" 'initz-list-delete-file)
64 (define-key map "L" 'initz-list-load-file)
65 (define-key map "N" 'initz-list-new-file)
66 (define-key map "S" 'initz-startup)
67 (define-key map "q" 'initz-list-quit)
68 (easy-menu-define initz-list-mode-nemu map
69 "Menu Used in 'initz-list-mode'."
71 (setq initz-list-mode-map map)))
73 (defvar initz-list-node-map nil)
74 (unless initz-list-node-map
75 (let ((map (make-sparse-keymap)))
76 (set-keymap-parent map initz-list-mode-map)
77 (define-key map mouse-button-2 'initz-list-node-click)
78 (define-key map " " 'initz-list-node-enter)
79 (define-key map "\C-m" 'initz-list-node-enter)
80 (setq initz-list-node-map map)))
82 (defvar initz-list-mode-hook nil
83 "Normal hook run when entering initz-list-mode.")
85 (defconst initz-list-mode-name "Initz List")
87 (defconst initz-list-buffer-name "*Initz List*")
89 (defconst initz-list-delete-file-ask-message-format
92 (defconst initz-list-input-dir-message-format
95 (defconst initz-list-input-module-message-format
98 (defconst initz-list-new-file-illegal-message
99 "Module name is illegal.")
101 (defconst initz-list-new-file-exists-message
102 "File already exists.")
104 (defconst initz-list-new-file-provided-message
105 "Module is already provided.")
107 (defconst initz-list-new-file-header-message-format
108 ";;; %s --- init file for %s.\n\n\n\n")
110 (defconst initz-list-new-file-footer-message-format
111 "(provide '%s)\n\n;;; %s ends here\n")
113 (defconst initz-list-click-message-format
114 "Click %s on the module name to select it.\n")
116 (defconst initz-list-enter-message-format
117 "In this buffer, type %s to select the module name under point.\n")
119 (defconst initz-list-modeline-string
122 ;; Initz list mode is suitable only for specially formatted data.
123 (put 'initz-list-mode 'mode-class 'special)
125 (defadvice sort-build-lists (after sort-including-newline activate)
126 (when (or (eq major-mode 'initz-list-mode)
127 (eq major-mode 'initz-error-mode))
128 (setq ad-return-value
129 (mapcar #'(lambda (list)
130 (cons (cons (caar list) (1+ (cdar list)))
131 (cons (cadr list) (1+ (cddr list)))))
134 (defun initz-list-delete-whole-line ()
135 "Delete whole line at point."
136 (setq buffer-read-only nil)
137 (delete-region (progn (beginning-of-line) (point))
138 (progn (forward-line 1) (point)))
139 (set-buffer-modified-p nil)
140 (setq buffer-read-only t))
142 (defun initz-list-get-dir ()
143 "Return the dir at point."
146 (when (re-search-backward "^\\[[-+]\\] \\([^ :]+\\)" nil t)
149 (defun initz-list-input-dir (&optional default)
151 (let ((completing-list (mapcar #'(lambda (list)
152 (symbol-name (car list)))
154 (default (if (stringp default) default "misc")))
156 (format initz-list-input-dir-message-format
157 initz-directory default)
158 (mapcar #'(lambda (name)
161 nil t nil nil default)))
163 (defun initz-list-input-module (dir)
165 (let ((init (initz-get-init-value (intern dir) 'prefix)))
166 (setq init (initz-trim-separator init))
167 (unless (string= init initz-null-string)
168 (setq init (concat init initz-separator-string)))
169 (if initz-list-input-module-completing
171 (format initz-list-input-module-message-format dir)
172 (mapcar #'(lambda (feature)
173 (let ((name (symbol-name feature)))
178 (format initz-list-input-module-message-format dir)
181 (defun initz-list-insert-file (dir startup-file)
182 "Insert the STARTUP-FILE at DIR section."
183 ;; FIXME: Delete `save-excursion' and fix the next `FIXME'.
185 (goto-char (point-min))
186 (when (re-search-forward (concat "^\\[[-+]\\] " dir "[ :]") nil t)
188 (let ((status (get-text-property (point) :status)))
189 (when (eq status 'expand)
192 (setq sort-start (point))
193 (if (re-search-forward "^\\[[-+]\\] " nil t)
195 (re-search-forward "\\'" nil t))
196 (setq buffer-read-only nil)
198 (let ((start (point)))
199 (insert (initz-get-module-name startup-file) "\n")
200 (add-text-properties start (1- (point))
201 `(face initz-list-module-face
203 start-open t rear-nonsticky t
204 help-echo ,startup-file))
205 (put-text-property start (point) :file startup-file))
206 (sort-lines nil sort-start (point)))
207 (set-buffer-modified-p nil)
208 (setq buffer-read-only t)
209 ;; FIXME: Move to the line inserted now
212 (defun initz-list-node-insert (node status)
213 (let ((prefix (initz-get-init-value node 'prefix))
215 (setq prefix (initz-trim-separator prefix))
216 ;; `prefix' will be broken.
217 (if (string= prefix initz-null-string)
218 (setq prefix initz-null-string)
219 (setq prefix (concat " (" prefix ")")))
220 (insert "[" (if (eq status 'expand) "-" "+") "] "
221 (symbol-name node) prefix ":\n")
222 (add-text-properties start (+ start 3)
223 `(face initz-list-node-face
225 local-map ,initz-list-node-map
226 keymap ,initz-list-node-map
227 start-open t rear-nonsticky t
231 (defun initz-list-node-collapse (node)
233 (setq buffer-read-only nil)
234 (goto-char (point-min))
235 (if (re-search-forward (concat "^\\[-\\] "
236 (symbol-name node) "[ :]") nil t)
237 (let ((start (progn (beginning-of-line) (point)))
240 (if (re-search-forward "^\\[[-+]\\] " nil t)
244 (setq end (point-max)))
245 (delete-region start end))
246 (goto-char (point-max)))
247 (initz-list-node-insert node 'collapse)
248 (set-buffer-modified-p nil)
249 (setq buffer-read-only t)))
251 (defun initz-list-node-expand (node)
253 (setq buffer-read-only nil)
254 (goto-char (point-min))
255 (if (re-search-forward (concat "^\\[\\+\\] "
256 (symbol-name node) "[ :]") nil t)
257 (delete-region (progn (beginning-of-line) (point))
258 (progn (forward-line 1) (point)))
259 (goto-char (point-max)))
260 (initz-list-node-insert node 'expand)
261 (let ((sort-start (point))
262 (initz-features (initz-features)))
265 (let* ((module (initz-get-module-name file))
266 (loaded (memq (intern module) initz-features))
271 (when loaded (insert initz-list-loaded-mark))
273 (add-text-properties start (1- (point))
275 'initz-list-module-face
276 'initz-list-unloaded-module-face)
278 start-open t rear-nonsticky t
280 (put-text-property start (point) :file file)))
281 (initz-get-files 'startup node initz-list-all-modules))
282 (sort-lines nil sort-start (point)))
283 (set-buffer-modified-p nil)
284 (setq buffer-read-only t)))
286 (defun initz-list-node-enter ()
288 (let ((node (get-text-property (point) :node))
289 (status (get-text-property (point) :status)))
290 (when (and node status)
291 (if (eq status 'expand)
292 (initz-list-node-collapse node)
293 (initz-list-node-expand node))
296 (defun initz-list-node-click (e)
299 (initz-list-node-enter))
301 (defun initz-list-next-line (&optional arg)
307 (let ((start (re-search-forward "^\\( \\|\\[\\|\\)" nil t)))
308 (when (integer-or-marker-p start)
311 (defun initz-list-previous-line (&optional arg)
314 (initz-list-next-line (- 0 arg))
315 (initz-list-next-line -1)))
317 (defun initz-list-print-file ()
318 "Print the file name under point."
320 (let ((file (get-text-property (point) :file)))
322 (initz-message-no-log file))))
324 (defun initz-list-find-file ()
325 "View the file under point."
327 (let ((file (get-text-property (point) :file)))
329 (find-file-other-window file))))
331 (defun initz-list-find-file-mouse (e)
332 "View the file under clicked point."
336 (initz-list-find-file)))
338 (defun initz-list-byte-compile-file ()
339 "Byte-compile the file under point."
341 (let ((file (get-text-property (point) :file)))
343 (let ((compile-file (initz-get-correspondence-file file)))
344 (when (file-newer-than-file-p file compile-file)
346 (when (save-window-excursion
347 (byte-compile-file file))
348 (let ((startup-directory (file-name-directory file))
349 (flavor-directory (file-name-directory compile-file)))
350 (install-file (file-name-nondirectory compile-file)
351 startup-directory flavor-directory t t))
352 (setq initz-compile-error-files
353 (delete file initz-compile-error-files)))
356 (defun initz-list-delete-file ()
357 "Delete the file under point."
359 (let ((file (get-text-property (point) :file)))
362 (format initz-list-delete-file-ask-message-format
363 (initz-get-module-name file))))
365 (setq initz-compile-error-files
366 (delete file initz-compile-error-files))
367 (setq initz-load-error-files
368 (delete file initz-load-error-files))
369 (initz-list-delete-whole-line)
370 (initz-list-previous-line)
371 (initz-list-next-line))))
373 (defun initz-list-load-file ()
374 "Load the file under point."
376 (let ((file (get-text-property (point) :file)))
377 (when (and (initz-list-byte-compile-file)
378 (initz-load-file (initz-get-correspondence-file file)))
379 (setq initz-load-error-files
380 (delete file initz-load-error-files)))))
383 (defun initz-list-new-file ()
384 "Make new init file."
386 (let* ((default (initz-list-get-dir))
387 (dir (initz-list-input-dir default))
388 (module (initz-list-input-module dir)))
389 (if (not (or (and (string= dir "misc") (string= module initz-null-string))
390 (string-match (concat "^" initz-module-regexp "$") module)))
391 (message initz-list-new-file-illegal-message)
392 (setq module (initz-trim-separator module))
393 (let ((startup-file (expand-file-name
395 (if (string= module initz-null-string)
397 initz-separator-string)
399 (initz-startup-directory (intern dir)))))
400 (if (file-exists-p startup-file)
401 (message initz-list-new-file-exists-message)
402 (let ((base-name (initz-get-base-name startup-file)))
403 (if (memq (intern base-name) features)
404 (message initz-list-new-file-provided-message)
405 (initz-list-insert-file dir startup-file)
406 (find-file-other-window startup-file)
407 (let ((file-name (file-name-nondirectory startup-file)))
408 (insert (format initz-list-new-file-header-message-format
410 (if (string= module initz-null-string)
413 (insert (format initz-list-new-file-footer-message-format
414 base-name file-name)))
416 (goto-char (point-min))
417 (search-forward "\n\n"))))))))
419 (defun initz-list-quit ()
420 "Quit the initz list mode."
422 (when (or (eq major-mode 'initz-list-mode)
423 (eq major-mode 'initz-error-mode))
424 (remove-hook 'post-command-hook
426 (substring (symbol-name major-mode) 0
428 (symbol-name major-mode)))
430 (let ((buf (current-buffer)))
431 (unless (one-window-p)
435 (defun initz-list-mode ()
436 "\\<initz-list-mode-map>
437 Major mode for browsing initz list buffer.
439 \\[initz-list-next-line] Next line.
440 \\[initz-list-previous-line] Previous line.
441 \\[forward-char] Forward char.
442 \\[backward-char] Backward char.
444 \\[initz-list-find-file] View the file under point.
445 \\[initz-list-byte-compile-file] Byte-compile the file under point.
446 \\[initz-list-delete-file] Delete the file under point.
447 \\[initz-list-load-file] Load the file under point.
448 \\[initz-list-new-file] Make new init file.
449 \\[initz-startup] Initz startup.
451 \\[initz-list-quit] Quit the initz list mode."
453 (kill-all-local-variables)
454 (use-local-map initz-list-mode-map)
455 (setq mode-name initz-list-mode-name)
456 (setq major-mode 'initz-list-mode)
457 (easy-menu-add initz-list-mode-menu)
458 (when (or (featurep 'xemacs) (< emacs-major-version 21))
459 (make-local-hook 'post-command-hook))
460 (add-hook 'post-command-hook 'initz-list-print-file)
461 (setq mode-line-buffer-identification initz-list-modeline-string)
462 (run-hooks 'initz-list-mode-hook))
466 "Show initz list buffer."
469 (let ((buf (get-buffer initz-list-buffer-name)))
471 (unless (one-window-p)
474 (switch-to-buffer-other-window initz-list-buffer-name)
476 (goto-char (point-min))
478 (format initz-list-click-message-format
479 (substitute-command-keys "\\[initz-list-find-file-mouse]")))
481 (format initz-list-enter-message-format
482 (substitute-command-keys "\\[initz-list-find-file]")))
484 (mapc #'(lambda (alist)
485 (let ((sym (car alist)))
486 (funcall (intern (concat "initz-list-node-"
488 initz-list-default-node-status)))
491 (set-buffer-modified-p nil)
492 (setq buffer-read-only t)
493 (goto-char (point-min))
494 (search-forward "\n\n")
497 (provide 'initz-list)
499 ;;; initz-list.el ends here