lisp/initz-list.el

   1 ;;; initz-list.el --- File list mode.
   2
   3 ;; Copyright (C) 2002 OHASHI Akira <bg66@koka-in.org>
   4
   5 ;; Author: OHASHI Akira <bg66@koka-in.org>
   6 ;; Keywords: startup, init
   7
   8 ;; This file is part of Initz.
   9
  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)
  13 ;; any later version.
  14
  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.
  19
  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.
  24
  25
  26 ;;; Commentary:
  27 ;;
  28
  29 ;;; Code:
  30
  31 (require 'emu)
  32 (require 'initz-globals)
  33 (require 'initz)
  34
  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)))
  55
  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)))
  64
  65 (defvar initz-list-mode-hook nil
  66   "Normal hook run when entering initz-list-mode.")
  67
  68 (defconst initz-list-mode-name "Initz List")
  69
  70 (defconst initz-list-buffer-name "*Initz List*")
  71
  72 (defconst initz-list-delete-file-ask-message-format
  73   "Delete %s? ")
  74
  75 (defconst initz-list-input-dir-message-format
  76   "Dir[%s] (%s): ")
  77
  78 (defconst initz-list-input-module-message-format
  79   "Module[%s]: ")
  80
  81 (defconst initz-list-new-file-illegal-message
  82   "Module name is illegal.")
  83
  84 (defconst initz-list-new-file-exists-message
  85   "File already exists.")
  86
  87 (defconst initz-list-new-file-provided-message
  88   "Module is already provided.")
  89
  90 (defconst initz-list-new-file-comment-message-format
  91   ";;; %s --- init file for %s.\n\n\n\n")
  92
  93 (defconst initz-list-new-file-provide-message-format
  94   "(provide '%s)\n")
  95
  96 (defconst initz-list-click-message-format
  97   "Click %s on the module name to select it.\n")
  98
  99 (defconst initz-list-enter-message-format
 100   "In this buffer, type %s to select the module name under point.\n")
 101
 102 (defconst initz-list-modeline-string
 103   "Initz")
 104
 105 ;; Initz list mode is suitable only for specially formatted data.
 106 (put 'initz-list-mode 'mode-class 'special)
 107
 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
 113            (function (lambda (list)
 114                        (cons (cons (caar list) (1+ (cdar list)))
 115                              (cons (cadr list) (1+ (cddr list))))))
 116            ad-return-value))))
 117
 118 (defun initz-list-delete-whole-line ()
 119   "Delete whole line at point."
 120   (setq buffer-read-only nil)
 121   (delete-region (progn (beginning-of-line) (point))
 122                  (progn (forward-line 1) (point)))
 123   (set-buffer-modified-p nil)
 124   (setq buffer-read-only t))
 125
 126 (defun initz-list-get-dir ()
 127   "Return the dir at point."
 128   (save-excursion
 129     (end-of-line)
 130     (when (re-search-backward "^\\[[-+]\\] \\([^ :]+\\)" nil t)
 131         (match-string 1))))
 132
 133 (defun initz-list-input-dir (&optional default)
 134   "Input the dir."
 135   (let* ((completing-list (mapcar
 136                            (function (lambda (list)
 137                                        (symbol-name (car list))))
 138                            initz-init-alist))
 139          (default (if (stringp default) default "misc")))
 140     (completing-read
 141      (format initz-list-input-dir-message-format
 142              initz-directory default)
 143      (mapcar
 144       (function (lambda (name)
 145                   (cons name name)))
 146       completing-list)
 147      nil t nil nil default)))
 148
 149 (defun initz-list-input-module (dir)
 150   "Input the module."
 151   (let ((init (initz-get-init-value (intern dir) 'prefix)))
 152     (setq init (initz-trim-separator init))
 153     (unless (string= init initz-null-string)
 154       (setq init (concat init initz-separator-string)))
 155     (if initz-list-input-module-completing
 156         (completing-read
 157          (format initz-list-input-module-message-format dir)
 158          (mapcar
 159           (function (lambda (feature)
 160                       (let ((name (symbol-name feature)))
 161                         (cons name name))))
 162           features)
 163          nil nil init)
 164       (read-string
 165          (format initz-list-input-module-message-format dir)
 166          init))))
 167
 168 (defun initz-list-insert-file (dir startup-file)
 169   "Insert the STARTUP-FILE at DIR section."
 170   ;; FIXME: Delete `save-excursion' and fix the next `FIXME'.
 171   (save-excursion
 172     (goto-char (point-min))
 173     (when (re-search-forward (concat "^\\[[-+]\\] " dir "[ :]") nil t)
 174       (beginning-of-line)
 175       (let ((status (get-text-property (point) :status)))
 176         (when (eq status 'expand)
 177           (let (sort-start)
 178             (forward-line 1)
 179             (setq sort-start (point))
 180             (if (re-search-forward "^\\[[-+]\\] " nil t)
 181                 (beginning-of-line)
 182               (re-search-forward "\\'" nil t))
 183             (setq buffer-read-only nil)
 184             (insert-char ?\  4)
 185             (let ((start (point)))
 186               (insert (initz-get-module-name startup-file) "\n")
 187               (add-text-properties start (1- (point))
 188                                    `(face initz-list-module-face
 189                                           mouse-face highlight
 190                                           start-open t rear-nonsticky t
 191                                           help-echo ,startup-file))
 192               (put-text-property start (point) :file startup-file))
 193             (sort-lines nil sort-start (point)))
 194           (set-buffer-modified-p nil)
 195           (setq buffer-read-only t)
 196           ;; FIXME: Move to the line inserted now
 197           )))))
 198
 199 (defun initz-list-node-insert (node status)
 200   (let ((prefix (initz-get-init-value node 'prefix))
 201         (start (point)))
 202     (setq prefix (initz-trim-separator prefix))
 203     ;; `prefix' will be broken.
 204     (if (string= prefix initz-null-string)
 205         (setq prefix initz-null-string)
 206       (setq prefix (concat " (" prefix ")")))
 207     (insert "[" (if (eq status 'expand) "-" "+") "] "
 208             (symbol-name node) prefix ":\n")
 209     (add-text-properties start (+ start 3)
 210                          `(face initz-list-node-face
 211                            mouse-face highlight
 212                            local-map ,initz-list-node-map
 213                            keymap ,initz-list-node-map
 214                            start-open t rear-nonsticky t
 215                            :node ,node
 216                            :status ,status))))
 217
 218 (defun initz-list-node-collapse (node)
 219   (save-excursion
 220     (setq buffer-read-only nil)
 221     (goto-char (point-min))
 222     (if (re-search-forward (concat "^\\[-\\] "
 223                                    (symbol-name node) "[ :]") nil t)
 224         (let ((start (progn (beginning-of-line) (point)))
 225               end)
 226           (forward-line 1)
 227           (if (re-search-forward "^\\[[-+]\\] " nil t)
 228               (progn
 229                 (beginning-of-line)
 230                 (setq end (point)))
 231             (setq end (point-max)))
 232           (delete-region start end))
 233       (goto-char (point-max)))
 234     (initz-list-node-insert node 'collapse)
 235     (set-buffer-modified-p nil)
 236     (setq buffer-read-only t)))
 237
 238 (defun initz-list-node-expand (node)
 239   (save-excursion
 240     (setq buffer-read-only nil)
 241     (goto-char (point-min))
 242     (if (re-search-forward (concat "^\\[\\+\\] "
 243                                    (symbol-name node) "[ :]") nil t)
 244         (delete-region (progn (beginning-of-line) (point))
 245                        (progn (forward-line 1) (point)))
 246       (goto-char (point-max)))
 247     (initz-list-node-insert node 'expand)
 248     (let ((sort-start (point))
 249           (initz-features (initz-features)))
 250       (mapc
 251        (function (lambda (file)
 252                    (let* ((module (initz-get-module-name file))
 253                           (loaded (memq (intern module) initz-features))
 254                           start)
 255                      (insert-char ?\  4)
 256                      (setq start (point))
 257                      (insert module)
 258                      (when loaded (insert initz-list-loaded-mark))
 259                      (insert "\n")
 260                      (add-text-properties
 261                       start (1- (point))
 262                       `(face ,(if loaded
 263                                   'initz-list-module-face
 264                                 'initz-list-unloaded-module-face)
 265                         mouse-face highlight
 266                         start-open t rear-nonsticky t
 267                         help-echo ,file))
 268                      (put-text-property start (point) :file file))))
 269        (initz-get-files 'startup node))
 270       (sort-lines nil sort-start (point)))
 271     (set-buffer-modified-p nil)
 272     (setq buffer-read-only t)))
 273
 274 (defun initz-list-node-enter ()
 275   (interactive)
 276   (let ((node (get-text-property (point) :node))
 277         (status (get-text-property (point) :status)))
 278     (when (and node status)
 279       (if (eq status 'expand)
 280           (initz-list-node-collapse node)
 281         (initz-list-node-expand node))
 282       (forward-char 1))))
 283
 284 (defun initz-list-node-click (e)
 285   (interactive "e")
 286   (mouse-set-point e)
 287   (initz-list-node-enter))
 288
 289 (defun initz-list-next-line (&optional arg)
 290   (interactive)
 291   (if (integerp arg)
 292       (next-line arg)
 293     (next-line 1))
 294   (beginning-of-line)
 295   (let ((start (re-search-forward "^\\(    \\|\\[\\|\\)" nil t)))
 296     (when (integer-or-marker-p start)
 297         (goto-char start))))
 298
 299 (defun initz-list-previous-line ()
 300   (interactive)
 301   (initz-list-next-line -1))
 302
 303 (defun initz-list-print-file ()
 304   "Print the file name under point."
 305   (interactive)
 306   (let ((file (get-text-property (point) :file)))
 307     (and file
 308          (initz-message-no-log file))))
 309
 310 (defun initz-list-find-file ()
 311   "View the file under point."
 312   (interactive)
 313   (let ((file (get-text-property (point) :file)))
 314     (and file
 315          (find-file-other-window file))))
 316
 317 (defun initz-list-find-file-mouse (e)
 318   "View the file under clicked point."
 319   (interactive "e")
 320   (mouse-set-point e)
 321   (unless (eolp)
 322     (initz-list-find-file)))
 323
 324 (defun initz-list-byte-compile-file ()
 325   "Byte-compile the file under point."
 326   (interactive)
 327   (let ((file (get-text-property (point) :file)))
 328     (when file
 329       (condition-case nil
 330           (when (save-window-excursion
 331                   (byte-compile-file file))
 332             (let* ((compile-file (initz-get-correspondence-file file))
 333                    (startup-directory (file-name-directory file))
 334                    (flavor-directory (file-name-directory compile-file)))
 335               (install-file (file-name-nondirectory compile-file)
 336                             startup-directory flavor-directory t t))
 337             (setq initz-compile-error-files
 338                   (delete file initz-compile-error-files)))
 339         (error)))))
 340
 341 (defun initz-list-delete-file ()
 342   "Delete the file under point."
 343   (interactive)
 344   (let ((file (get-text-property (point) :file)))
 345     (when (and file
 346                (y-or-n-p
 347                 (format initz-list-delete-file-ask-message-format
 348                         (initz-get-module-name file))))
 349       (delete-file file)
 350       (setq initz-compile-error-files
 351             (delete file initz-compile-error-files))
 352       (setq initz-load-error-files
 353             (delete file initz-load-error-files))
 354       (initz-list-delete-whole-line)
 355       (initz-list-previous-line)
 356       (initz-list-next-line))))
 357
 358 (defun initz-list-load-file ()
 359   "Load the file under point."
 360   (interactive)
 361   (let* ((file (get-text-property (point) :file)))
 362     (initz-list-byte-compile-file)
 363     (when (initz-load-file (initz-get-correspondence-file file))
 364       (setq initz-load-error-files
 365             (delete file initz-load-error-files)))))
 366
 367 ;;;###autoload
 368 (defun initz-list-new-file ()
 369   "Make new init file."
 370   (interactive)
 371   (let* ((default (initz-list-get-dir))
 372          (dir (initz-list-input-dir default))
 373          (module (initz-list-input-module dir)))
 374     (if (not (or (and (string= dir "misc") (string= module initz-null-string))
 375                  (string-match (concat "^" initz-module-regexp "$") module)))
 376         (message initz-list-new-file-illegal-message)
 377       (setq module (initz-trim-separator module))
 378       (let* ((startup-file (expand-file-name
 379                             (concat initz-prefix
 380                                     (if (string= module initz-null-string)
 381                                         initz-null-string
 382                                       initz-separator-string)
 383                                     module ".el")
 384                             (initz-startup-directory (intern dir)))))
 385         (if (file-exists-p startup-file)
 386             (message initz-list-new-file-exists-message)
 387           (let ((base-name (initz-get-base-name startup-file)))
 388             (if (memq (intern base-name) features)
 389                 (message initz-list-new-file-provided-message)
 390               (initz-list-insert-file dir startup-file)
 391               (find-file-other-window startup-file)
 392               (insert (format initz-list-new-file-comment-message-format
 393                               (file-name-nondirectory startup-file)
 394                               (if (string= module initz-null-string)
 395                                   initz-prefix
 396                                 module)))
 397               (insert (format initz-list-new-file-provide-message-format
 398                               base-name))
 399               (save-buffer)
 400               (goto-char (point-min))
 401               (search-forward "\n\n"))))))))
 402
 403 (defun initz-list-quit ()
 404   "Quit the initz list mode."
 405   (interactive)
 406   (when (or (eq major-mode 'initz-list-mode)
 407             (eq major-mode 'initz-error-mode))
 408     (remove-hook 'post-command-hook
 409                  (intern (concat
 410                           (substring (symbol-name major-mode) 0
 411                                      (string-match "mode"
 412                                                    (symbol-name major-mode)))
 413                           "print-file")))
 414     (let ((buf (current-buffer)))
 415       (unless (one-window-p)
 416         (delete-window))
 417       (kill-buffer buf))))
 418
 419 (defun initz-list-mode ()
 420   "\\<initz-list-mode-map>
 421    Major mode for browsing initz list buffer.
 422
 423 \\[initz-list-next-line]        Next line.
 424 \\[initz-list-previous-line]    Previous line.
 425 \\[forward-char]        Forward char.
 426 \\[backward-char]       Backward char.
 427
 428 \\[initz-list-find-file]        View the file under point.
 429 \\[initz-list-byte-compile-file]        Byte-compile the file under point.
 430 \\[initz-list-delete-file]      Delete the file under point.
 431 \\[initz-list-load-file]        Load the file under point.
 432 \\[initz-list-new-file] Make new init file.
 433 \\[initz-startup]       Initz startup.
 434 \\[initz-list-quit]     Quit the initz list mode."
 435   (interactive)
 436   (kill-all-local-variables)
 437   (use-local-map initz-list-mode-map)
 438   (setq mode-name initz-list-mode-name)
 439   (setq major-mode 'initz-list-mode)
 440   (when (or (featurep 'xemacs) (< emacs-major-version 21))
 441     (make-local-hook 'post-command-hook))
 442   (add-hook 'post-command-hook 'initz-list-print-file)
 443   (setq mode-line-buffer-identification initz-list-modeline-string)
 444   (run-hooks 'initz-list-mode-hook))
 445
 446 ;;;###autoload
 447 (defun initz-list ()
 448   "Show initz list buffer."
 449   (interactive)
 450   ;; FIXME: ad-hoc
 451   (let ((buf (get-buffer initz-list-buffer-name)))
 452     (when buf
 453       (unless (one-window-p)
 454         (delete-window))
 455       (kill-buffer buf)))
 456   (switch-to-buffer-other-window initz-list-buffer-name)
 457   (initz-list-mode)
 458   (goto-char (point-min))
 459   (insert
 460    (format initz-list-click-message-format
 461            (substitute-command-keys "\\[initz-list-find-file-mouse]")))
 462   (insert
 463    (format initz-list-enter-message-format
 464            (substitute-command-keys "\\[initz-list-find-file]")))
 465   (insert "\n")
 466   (mapc
 467    (function (lambda (alist)
 468                (let ((sym (car alist)))
 469                  (funcall
 470                   (intern (concat "initz-list-node-"
 471                                   (symbol-name
 472                                    initz-list-default-node-status)))
 473                   sym))))
 474    initz-init-alist)
 475   (set-buffer-modified-p nil)
 476   (setq buffer-read-only t)
 477   (goto-char (point-min))
 478   (search-forward "\n\n")
 479   (forward-char 1))
 480
 481 (provide 'initz-list)
 482
 483 ;;; initz-list.el ends here