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 'easymenu)
  33 (eval-when-compile (require 'cl))
  34 (require 'initz-globals)
  35 (require 'initz)
  36
  37 (defvar initz-list-mode-menu
  38   '("Initz"
  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]
  44     "----"
  45     ["Startup" initz-startup t]
  46     "----"
  47     ["Quit" initz-list-quit t]))
  48
  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'."
  70                         initz-list-mode-menu)
  71       (setq initz-list-mode-map map)))
  72
  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)))
  81
  82 (defvar initz-list-mode-hook nil
  83   "Normal hook run when entering initz-list-mode.")
  84
  85 (defconst initz-list-mode-name "Initz List")
  86
  87 (defconst initz-list-buffer-name "*Initz List*")
  88
  89 (defconst initz-list-delete-file-ask-message-format
  90   "Delete %s? ")
  91
  92 (defconst initz-list-input-dir-message-format
  93   "Dir[%s] (%s): ")
  94
  95 (defconst initz-list-input-module-message-format
  96   "Module[%s]: ")
  97
  98 (defconst initz-list-new-file-illegal-message
  99   "Module name is illegal.")
 100
 101 (defconst initz-list-new-file-exists-message
 102   "File already exists.")
 103
 104 (defconst initz-list-new-file-provided-message
 105   "Module is already provided.")
 106
 107 (defconst initz-list-new-file-header-message-format
 108   ";;; %s --- init file for %s.\n\n\n\n")
 109
 110 (defconst initz-list-new-file-footer-message-format
 111   "(provide '%s)\n\n;;; %s ends here\n")
 112
 113 (defconst initz-list-click-message-format
 114   "Click %s on the module name to select it.\n")
 115
 116 (defconst initz-list-enter-message-format
 117   "In this buffer, type %s to select the module name under point.\n")
 118
 119 (defconst initz-list-modeline-string
 120   "Initz")
 121
 122 ;; Initz list mode is suitable only for specially formatted data.
 123 (put 'initz-list-mode 'mode-class 'special)
 124
 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)))))
 132                   ad-return-value))))
 133
 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))
 141
 142 (defun initz-list-get-dir ()
 143   "Return the dir at point."
 144   (save-excursion
 145     (end-of-line)
 146     (when (re-search-backward "^\\[[-+]\\] \\([^ :]+\\)" nil t)
 147         (match-string 1))))
 148
 149 (defun initz-list-input-dir (&optional default)
 150   "Input the dir."
 151   (let ((completing-list (mapcar #'(lambda (list)
 152                                      (symbol-name (car list)))
 153                                  initz-init-alist))
 154         (default (if (stringp default) default "misc")))
 155     (completing-read
 156      (format initz-list-input-dir-message-format
 157              initz-directory default)
 158      (mapcar #'(lambda (name)
 159                  (cons name name))
 160              completing-list)
 161      nil t nil nil default)))
 162
 163 (defun initz-list-input-module (dir)
 164   "Input the module."
 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
 170         (completing-read
 171          (format initz-list-input-module-message-format dir)
 172          (mapcar #'(lambda (feature)
 173                      (let ((name (symbol-name feature)))
 174                        (cons name name)))
 175                  features)
 176          nil nil init)
 177       (read-string
 178        (format initz-list-input-module-message-format dir)
 179        init))))
 180
 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'.
 184   (save-excursion
 185     (goto-char (point-min))
 186     (when (re-search-forward (concat "^\\[[-+]\\] " dir "[ :]") nil t)
 187       (beginning-of-line)
 188       (let ((status (get-text-property (point) :status)))
 189         (when (eq status 'expand)
 190           (let (sort-start)
 191             (forward-line 1)
 192             (setq sort-start (point))
 193             (if (re-search-forward "^\\[[-+]\\] " nil t)
 194                 (beginning-of-line)
 195               (re-search-forward "\\'" nil t))
 196             (setq buffer-read-only nil)
 197             (insert-char ?\  4)
 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
 202                                           mouse-face highlight
 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
 210           )))))
 211
 212 (defun initz-list-node-insert (node status)
 213   (let ((prefix (initz-get-init-value node 'prefix))
 214         (start (point)))
 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
 224                            mouse-face highlight
 225                            local-map ,initz-list-node-map
 226                            keymap ,initz-list-node-map
 227                            start-open t rear-nonsticky t
 228                            :node ,node
 229                            :status ,status))))
 230
 231 (defun initz-list-node-collapse (node)
 232   (save-excursion
 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)))
 238               end)
 239           (forward-line 1)
 240           (if (re-search-forward "^\\[[-+]\\] " nil t)
 241               (progn
 242                 (beginning-of-line)
 243                 (setq end (point)))
 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)))
 250
 251 (defun initz-list-node-expand (node)
 252   (save-excursion
 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)))
 263       (mapc
 264        #'(lambda (file)
 265            (let* ((module (initz-get-module-name file))
 266                   (loaded (memq (intern module) initz-features))
 267                   start)
 268              (insert-char ?\  4)
 269              (setq start (point))
 270              (insert module)
 271              (when loaded (insert initz-list-loaded-mark))
 272              (insert "\n")
 273              (add-text-properties start (1- (point))
 274                                   `(face ,(if loaded
 275                                               'initz-list-module-face
 276                                             'initz-list-unloaded-module-face)
 277                                     mouse-face highlight
 278                                     start-open t rear-nonsticky t
 279                                     help-echo ,file))
 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)))
 285
 286 (defun initz-list-node-enter ()
 287   (interactive)
 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))
 294       (forward-char 1))))
 295
 296 (defun initz-list-node-click (e)
 297   (interactive "e")
 298   (mouse-set-point e)
 299   (initz-list-node-enter))
 300
 301 (defun initz-list-next-line (&optional arg)
 302   (interactive)
 303   (if (integerp arg)
 304       (next-line arg)
 305     (next-line 1))
 306   (beginning-of-line)
 307   (let ((start (re-search-forward "^\\(    \\|\\[\\|\\)" nil t)))
 308     (when (integer-or-marker-p start)
 309         (goto-char start))))
 310
 311 (defun initz-list-previous-line (&optional arg)
 312   (interactive)
 313   (if (integerp arg)
 314       (initz-list-next-line (- 0 arg))
 315     (initz-list-next-line -1)))
 316
 317 (defun initz-list-print-file ()
 318   "Print the file name under point."
 319   (interactive)
 320   (let ((file (get-text-property (point) :file)))
 321     (and file
 322          (initz-message-no-log file))))
 323
 324 (defun initz-list-find-file ()
 325   "View the file under point."
 326   (interactive)
 327   (let ((file (get-text-property (point) :file)))
 328     (and file
 329          (find-file-other-window file))))
 330
 331 (defun initz-list-find-file-mouse (e)
 332   "View the file under clicked point."
 333   (interactive "e")
 334   (mouse-set-point e)
 335   (unless (eolp)
 336     (initz-list-find-file)))
 337
 338 (defun initz-list-byte-compile-file ()
 339   "Byte-compile the file under point."
 340   (interactive)
 341   (let ((file (get-text-property (point) :file)))
 342     (when file
 343       (let ((compile-file (initz-get-correspondence-file file)))
 344         (when (file-newer-than-file-p file compile-file)
 345           (condition-case nil
 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)))
 354             (error)))))))
 355
 356 (defun initz-list-delete-file ()
 357   "Delete the file under point."
 358   (interactive)
 359   (let ((file (get-text-property (point) :file)))
 360     (when (and file
 361                (y-or-n-p
 362                 (format initz-list-delete-file-ask-message-format
 363                         (initz-get-module-name file))))
 364       (delete-file 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))))
 372
 373 (defun initz-list-load-file ()
 374   "Load the file under point."
 375   (interactive)
 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)))))
 381
 382 ;;;###autoload
 383 (defun initz-list-new-file ()
 384   "Make new init file."
 385   (interactive)
 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
 394                            (concat initz-prefix
 395                                    (if (string= module initz-null-string)
 396                                        initz-null-string
 397                                      initz-separator-string)
 398                                    module ".el")
 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
 409                                 file-name
 410                                 (if (string= module initz-null-string)
 411                                     initz-prefix
 412                                   module)))
 413                 (insert (format initz-list-new-file-footer-message-format
 414                                 base-name file-name)))
 415               (save-buffer)
 416               (goto-char (point-min))
 417               (search-forward "\n\n"))))))))
 418
 419 (defun initz-list-quit ()
 420   "Quit the initz list mode."
 421   (interactive)
 422   (when (or (eq major-mode 'initz-list-mode)
 423             (eq major-mode 'initz-error-mode))
 424     (remove-hook 'post-command-hook
 425                  (intern (concat
 426                           (substring (symbol-name major-mode) 0
 427                                      (string-match "mode"
 428                                                    (symbol-name major-mode)))
 429                           "print-file")))
 430     (let ((buf (current-buffer)))
 431       (unless (one-window-p)
 432         (delete-window))
 433       (kill-buffer buf))))
 434
 435 (defun initz-list-mode ()
 436   "\\<initz-list-mode-map>
 437    Major mode for browsing initz list buffer.
 438
 439 \\[initz-list-next-line]        Next line.
 440 \\[initz-list-previous-line]    Previous line.
 441 \\[forward-char]        Forward char.
 442 \\[backward-char]       Backward char.
 443
 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.
 450
 451 \\[initz-list-quit]     Quit the initz list mode."
 452   (interactive)
 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))
 463
 464 ;;;###autoload
 465 (defun initz-list ()
 466   "Show initz list buffer."
 467   (interactive)
 468   ;; FIXME: ad-hoc
 469   (let ((buf (get-buffer initz-list-buffer-name)))
 470     (when buf
 471       (unless (one-window-p)
 472         (delete-window))
 473       (kill-buffer buf)))
 474   (switch-to-buffer-other-window initz-list-buffer-name)
 475   (initz-list-mode)
 476   (goto-char (point-min))
 477   (insert
 478    (format initz-list-click-message-format
 479            (substitute-command-keys "\\[initz-list-find-file-mouse]")))
 480   (insert
 481    (format initz-list-enter-message-format
 482            (substitute-command-keys "\\[initz-list-find-file]")))
 483   (insert "\n")
 484   (mapc #'(lambda (alist)
 485             (let ((sym (car alist)))
 486               (funcall (intern (concat "initz-list-node-"
 487                                        (symbol-name
 488                                         initz-list-default-node-status)))
 489                        sym)))
 490         initz-init-alist)
 491   (set-buffer-modified-p nil)
 492   (setq buffer-read-only t)
 493   (goto-char (point-min))
 494   (search-forward "\n\n")
 495   (forward-char 1))
 496
 497 (provide 'initz-list)
 498
 499 ;;; initz-list.el ends here