lisp/initz-error.el

   1 ;;; initz-error.el --- Error list mode.
   2
   3 ;; Copyright (C) 2001-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 (require 'initz-list)
  37
  38 (defvar initz-error-mode-menu
  39   '("Initz"
  40     ["View" initz-error-find-file t]
  41     ["Byte-compile" initz-error-byte-compile-file t]
  42     ["Delete" initz-error-delete-file t]
  43     ["Load" initz-error-load-file t]
  44     "----"
  45     ["Startup" initz-startup t]
  46     "----"
  47     ["Quit" initz-error-quit t]))
  48
  49 (defvar initz-error-mode-map nil
  50   "Local map for initz error buffers.")
  51 (unless initz-error-mode-map
  52     (let ((map (make-sparse-keymap)))
  53       (define-key map mouse-button-2 'initz-error-find-file-mouse)
  54       (define-key map "n" 'initz-error-next-line)
  55       (define-key map "p" 'initz-error-previous-line)
  56       (define-key map "h" 'backward-char)
  57       (define-key map "j" 'initz-error-next-line)
  58       (define-key map "k" 'initz-error-previous-line)
  59       (define-key map "l" 'forward-char)
  60       (define-key map " " 'initz-error-find-file)
  61       (define-key map "\C-m" 'initz-error-find-file)
  62       (define-key map "B" 'initz-error-byte-compile-file)
  63       (define-key map "D" 'initz-error-delete-file)
  64       (define-key map "L" 'initz-error-load-file)
  65       (define-key map "S" 'initz-startup)
  66       (define-key map "q" 'initz-error-quit)
  67       (easy-menu-define initz-error-mode-nemu map
  68                         "Menu Used in 'initz-error-mode'."
  69                         initz-error-mode-menu)
  70       (setq initz-error-mode-map map)))
  71
  72 (defvar initz-error-node-map nil)
  73 (unless initz-error-node-map
  74   (let ((map (make-sparse-keymap)))
  75     (set-keymap-parent map initz-error-mode-map)
  76     (define-key map mouse-button-2 'initz-error-node-click)
  77     (define-key map " " 'initz-error-node-enter)
  78     (define-key map "\C-m" 'initz-error-node-enter)
  79     (setq initz-error-node-map map)))
  80
  81 (defvar initz-error-mode-hook nil
  82   "Normal hook run when entering initz-error-mode.")
  83
  84 (defconst initz-error-mode-name "Initz Error")
  85
  86 (defconst initz-error-buffer-name "*Initz Error*")
  87
  88 (defconst initz-error-delete-file-ask-message-format
  89   "Delete %s? ")
  90
  91 (defconst initz-error-click-message-format
  92   "Click %s on the module name to select it.\n")
  93
  94 (defconst initz-error-enter-message-format
  95   "In this buffer, type %s to select the module name under point.\n")
  96
  97 (defconst initz-error-compile-message-header
  98   "Compile error:")
  99
 100 (defconst initz-error-load-message-header
 101   "Load error:")
 102
 103 (defconst initz-error-modeline-string
 104   "Initz")
 105
 106 ;; Initz error mode is suitable only for specially formatted data.
 107 (put 'initz-error-mode 'mode-class 'special)
 108
 109 (defalias 'initz-error-delete-whole-line 'initz-list-delete-whole-line)
 110 (defalias 'initz-error-next-line 'initz-list-next-line)
 111 (defalias 'initz-error-previous-line 'initz-list-previous-line)
 112 (defalias 'initz-error-print-file 'initz-list-print-file)
 113 (defalias 'initz-error-find-file 'initz-list-find-file)
 114 (defalias 'initz-error-find-file-mouse 'initz-list-find-file-mouse)
 115 (defalias 'initz-error-quit 'initz-list-quit)
 116
 117 (defun initz-error-node-insert (node status)
 118   (let ((start (point)))
 119     (insert "[" (if (eq status 'expand) "-" "+") "] "
 120             (eval (intern (concat "initz-error-"
 121                                   node "-message-header"))) "\n")
 122     (add-text-properties start (+ start 3)
 123                          `(face initz-list-node-face
 124                            mouse-face highlight
 125                            local-map ,initz-error-node-map
 126                            keymap ,initz-error-node-map
 127                            start-open t rear-nonsticky t
 128                            :node ,node
 129                            :status ,status))))
 130
 131 (defun initz-error-node-collapse (node)
 132   (save-excursion
 133     (setq buffer-read-only nil)
 134     (goto-char (point-min))
 135     (if (re-search-forward
 136          (concat "^\\[-\\] "
 137                  (eval (intern (concat "initz-error-"
 138                                        node "-message-header")))
 139                  "$") nil t)
 140         (let ((start (progn (beginning-of-line) (point)))
 141               end)
 142           (forward-line 1)
 143           (if (re-search-forward "^\\[[-+]\\] .+:$" nil t)
 144               (progn
 145                 (beginning-of-line)
 146                 (setq end (point)))
 147             (setq end (point-max)))
 148           (delete-region start end))
 149       (goto-char (point-max)))
 150     (initz-error-node-insert node 'collapse)
 151     (set-buffer-modified-p nil)
 152     (setq buffer-read-only t)))
 153
 154 (defun initz-error-node-expand (node)
 155   (save-excursion
 156     (setq buffer-read-only nil)
 157     (goto-char (point-min))
 158     (if (re-search-forward
 159          (concat "^\\[\\+\\] "
 160                  (eval (intern (concat "initz-error-"
 161                                        node "-message-header")))
 162                  "$") nil t)
 163         (delete-region (progn (beginning-of-line) (point))
 164                        (progn (forward-line 1) (point)))
 165       (goto-char (point-max)))
 166     (initz-error-node-insert node 'expand)
 167     (let ((sort-start (point)))
 168       (mapc
 169        #'(lambda (file)
 170            (let (start)
 171              (insert-char ?\  4)
 172              (setq start (point))
 173              (insert (initz-get-module-name file) "\n")
 174              (add-text-properties start (1- (point))
 175                                   `(face initz-list-module-face
 176                                     mouse-face highlight
 177                                     start-open t rear-nonsticky t
 178                                     help-echo ,file))
 179              (put-text-property start (point) :file file)))
 180        (eval (intern (concat "initz-" node "-error-files"))))
 181       (sort-lines nil sort-start (point)))
 182     (set-buffer-modified-p nil)
 183     (setq buffer-read-only t)))
 184
 185 (defun initz-error-node-enter ()
 186   (interactive)
 187   (let ((node (get-text-property (point) :node))
 188         (status (get-text-property (point) :status)))
 189     (when (and node status)
 190       (if (eq status 'expand)
 191           (initz-error-node-collapse node)
 192         (initz-error-node-expand node))
 193       (forward-char 1))))
 194
 195 (defun initz-error-node-click (e)
 196   (interactive "e")
 197   (mouse-set-point e)
 198   (initz-error-node-enter))
 199
 200 (defun initz-error-byte-compile-file ()
 201   "Byte-compile the file under point."
 202   (interactive)
 203   (let ((file (get-text-property (point) :file)))
 204     (when file
 205       (condition-case nil
 206           (when (save-window-excursion
 207                   (byte-compile-file file))
 208             (let* ((compile-file (initz-get-correspondence-file file))
 209                    (startup-directory (file-name-directory file))
 210                    (flavor-directory (file-name-directory compile-file)))
 211               (install-file (file-name-nondirectory compile-file)
 212                             startup-directory flavor-directory t t))
 213             (when (member file initz-compile-error-files)
 214               (setq initz-compile-error-files
 215                     (delete file initz-compile-error-files))
 216               (initz-error-delete-whole-line)))
 217         (error)))))
 218
 219 (defun initz-error-delete-file ()
 220   "Delete the file under point."
 221   (interactive)
 222   (let ((file (get-text-property (point) :file)))
 223     (when (and file
 224                (y-or-n-p
 225                 (format initz-error-delete-file-ask-message-format
 226                         (initz-get-module-name file))))
 227       (delete-file file)
 228       (setq initz-compile-error-files
 229             (delete file initz-compile-error-files))
 230       (setq initz-load-error-files
 231             (delete file initz-load-error-files))
 232       (initz-error-delete-whole-line)
 233       (initz-error-previous-line)
 234       (initz-error-next-line))))
 235
 236 (defun initz-error-load-file ()
 237   "Load the file under point."
 238   (interactive)
 239   (let* ((file (get-text-property (point) :file)))
 240     (initz-error-byte-compile-file)
 241     (when (initz-load-file (initz-get-correspondence-file file))
 242       (setq initz-load-error-files
 243             (delete file initz-load-error-files))
 244       (initz-error-delete-whole-line))))
 245
 246 (defun initz-error-mode ()
 247   "\\<initz-error-mode-map>
 248    Major mode for browsing initz error buffer.
 249
 250 \\[initz-error-next-line]       Next line.
 251 \\[initz-error-previous-line]   Previous line.
 252 \\[forward-char]        Forward char.
 253 \\[backward-char]       Backward char.
 254
 255 \\[initz-error-find-file]       View the file under point.
 256 \\[initz-error-byte-compile-file]       Byte-compile the file under point.
 257 \\[initz-error-delete-file]     Delete the file under point.
 258 \\[initz-error-load-file]       Load the file under point.
 259 \\[initz-startup]       Initz startup.
 260
 261 \\[initz-error-quit]    Quit the initz error mode."
 262   (interactive)
 263   (kill-all-local-variables)
 264   (use-local-map initz-error-mode-map)
 265   (setq mode-name initz-error-mode-name)
 266   (setq major-mode 'initz-error-mode)
 267   (easy-menu-add initz-error-mode-menu)
 268   (when (or (featurep 'xemacs) (< emacs-major-version 21))
 269     (make-local-hook 'post-command-hook))
 270   (add-hook 'post-command-hook 'initz-error-print-file)
 271   (setq mode-line-buffer-identification initz-error-modeline-string)
 272   (run-hooks 'initz-error-mode-hook))
 273
 274 (defun initz-error ()
 275   "Show initz error messages."
 276   (interactive)
 277   (when (or initz-compile-error-files
 278             initz-load-error-files)
 279     ;; FIXME: ad-hoc
 280     (let ((buf (get-buffer initz-error-buffer-name)))
 281       (when buf
 282         (unless (one-window-p)
 283           (delete-window))
 284         (kill-buffer buf)))
 285     (switch-to-buffer-other-window initz-error-buffer-name)
 286     (initz-error-mode)
 287     (goto-char (point-min))
 288     (insert
 289      (format initz-error-click-message-format
 290              (substitute-command-keys "\\[initz-error-find-file-mouse]")))
 291     (insert
 292      (format initz-error-enter-message-format
 293              (substitute-command-keys "\\[initz-error-find-file]")))
 294     (insert "\n")
 295     (mapc #'(lambda (node)
 296               (initz-error-node-expand node))
 297           '("compile" "load"))
 298     (set-buffer-modified-p nil)
 299     (setq buffer-read-only t)
 300     (goto-char (point-min))
 301     (search-forward "\n\n")
 302     (forward-char 1)
 303     ;; FIXME: ad-hoc
 304     (other-window 1)))
 305
 306 (provide 'initz-error)
 307
 308 ;;; initz-error.el ends here