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