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 (defconst initz-error-modeline-string
  88   "Initz")
  89
  90 ;; Initz error mode is suitable only for specially formatted data.
  91 (put 'initz-error-mode 'mode-class 'special)
  92
  93 (defalias 'initz-error-delete-whole-line 'initz-list-delete-whole-line)
  94 (defalias 'initz-error-next-line 'initz-list-next-line)
  95 (defalias 'initz-error-previous-line 'initz-list-previous-line)
  96 (defalias 'initz-error-print-file 'initz-list-print-file)
  97 (defalias 'initz-error-find-file 'initz-list-find-file)
  98 (defalias 'initz-error-find-file-mouse 'initz-list-find-file-mouse)
  99 (defalias 'initz-error-quit 'initz-list-quit)
 100
 101 (defun initz-error-node-insert (node status)
 102   (let ((start (point)))
 103     (insert "[" (if (eq status 'expand) "-" "+") "] "
 104             (eval (intern (concat "initz-error-"
 105                                   node "-message-header"))) "\n")
 106     (add-text-properties start (+ start 3)
 107                          `(face initz-list-node-face
 108                            mouse-face highlight
 109                            local-map ,initz-error-node-map
 110                            keymap ,initz-error-node-map
 111                            start-open t rear-nonsticky t
 112                            :node ,node
 113                            :status ,status))))
 114
 115 (defun initz-error-node-collapse (node)
 116   (save-excursion
 117     (setq buffer-read-only nil)
 118     (goto-char (point-min))
 119     (if (re-search-forward
 120          (concat "^\\[-\\] "
 121                  (eval (intern (concat "initz-error-"
 122                                        node "-message-header")))
 123                  "$") nil t)
 124         (let ((start (progn (beginning-of-line) (point)))
 125               end)
 126           (forward-line 1)
 127           (if (re-search-forward "^\\[[-+]\\] .+:$" nil t)
 128               (progn
 129                 (beginning-of-line)
 130                 (setq end (point)))
 131             (setq end (point-max)))
 132           (delete-region start end))
 133       (goto-char (point-max)))
 134     (initz-error-node-insert node 'collapse)
 135     (set-buffer-modified-p nil)
 136     (setq buffer-read-only t)))
 137
 138 (defun initz-error-node-expand (node)
 139   (save-excursion
 140     (setq buffer-read-only nil)
 141     (goto-char (point-min))
 142     (if (re-search-forward
 143          (concat "^\\[\\+\\] "
 144                  (eval (intern (concat "initz-error-"
 145                                        node "-message-header")))
 146                  "$") nil t)
 147         (delete-region (progn (beginning-of-line) (point))
 148                        (progn (forward-line 1) (point)))
 149       (goto-char (point-max)))
 150     (initz-error-node-insert node 'expand)
 151     (let ((sort-start (point)))
 152       (mapc
 153        #'(lambda (file)
 154            (let (start)
 155              (insert-char ?\  4)
 156              (setq start (point))
 157              (insert (initz-get-module-name file) "\n")
 158              (add-text-properties start (1- (point))
 159                                   `(face initz-list-module-face
 160                                     mouse-face highlight
 161                                     start-open t rear-nonsticky t
 162                                     help-echo ,file))
 163              (put-text-property start (point) :file file)))
 164        (eval (intern (concat "initz-" node "-error-files"))))
 165       (sort-lines nil sort-start (point)))
 166     (set-buffer-modified-p nil)
 167     (setq buffer-read-only t)))
 168
 169 (defun initz-error-node-enter ()
 170   (interactive)
 171   (let ((node (get-text-property (point) :node))
 172         (status (get-text-property (point) :status)))
 173     (when (and node status)
 174       (if (eq status 'expand)
 175           (initz-error-node-collapse node)
 176         (initz-error-node-expand node))
 177       (forward-char 1))))
 178
 179 (defun initz-error-node-click (e)
 180   (interactive "e")
 181   (mouse-set-point e)
 182   (initz-error-node-enter))
 183
 184 (defun initz-error-byte-compile-file ()
 185   "Byte-compile the file under point."
 186   (interactive)
 187   (let ((file (get-text-property (point) :file)))
 188     (when file
 189       (condition-case nil
 190           (when (save-window-excursion
 191                   (byte-compile-file file))
 192             (let* ((compile-file (initz-get-correspondence-file file))
 193                    (startup-directory (file-name-directory file))
 194                    (flavor-directory (file-name-directory compile-file)))
 195               (install-file (file-name-nondirectory compile-file)
 196                             startup-directory flavor-directory t t))
 197             (when (member file initz-compile-error-files)
 198               (setq initz-compile-error-files
 199                     (delete file initz-compile-error-files))
 200               (initz-error-delete-whole-line)))
 201         (error)))))
 202
 203 (defun initz-error-delete-file ()
 204   "Delete the file under point."
 205   (interactive)
 206   (let ((file (get-text-property (point) :file)))
 207     (when (and file
 208                (y-or-n-p
 209                 (format initz-error-delete-file-ask-message-format
 210                         (initz-get-module-name file))))
 211       (delete-file file)
 212       (setq initz-compile-error-files
 213             (delete file initz-compile-error-files))
 214       (setq initz-load-error-files
 215             (delete file initz-load-error-files))
 216       (initz-error-delete-whole-line)
 217       (initz-error-previous-line)
 218       (initz-error-next-line))))
 219
 220 (defun initz-error-load-file ()
 221   "Load the file under point."
 222   (interactive)
 223   (let* ((file (get-text-property (point) :file)))
 224     (initz-error-byte-compile-file)
 225     (when (initz-load-file (initz-get-correspondence-file file))
 226       (setq initz-load-error-files
 227             (delete file initz-load-error-files))
 228       (initz-error-delete-whole-line))))
 229
 230 (defun initz-error-mode ()
 231   "\\<initz-error-mode-map>
 232    Major mode for browsing initz error buffer.
 233
 234 \\[initz-error-next-line]       Next line.
 235 \\[initz-error-previous-line]   Previous line.
 236 \\[forward-char]        Forward char.
 237 \\[backward-char]       Backward char.
 238
 239 \\[initz-error-find-file]       View the file under point.
 240 \\[initz-error-byte-compile-file]       Byte-compile the file under point.
 241 \\[initz-error-delete-file]     Delete the file under point.
 242 \\[initz-error-load-file]       Load the file under point.
 243 \\[initz-startup]       Initz startup.
 244 \\[initz-error-quit]    Quit the initz error mode."
 245   (interactive)
 246   (kill-all-local-variables)
 247   (use-local-map initz-error-mode-map)
 248   (setq mode-name initz-error-mode-name)
 249   (setq major-mode 'initz-error-mode)
 250   (when (or (featurep 'xemacs) (< emacs-major-version 21))
 251     (make-local-hook 'post-command-hook))
 252   (add-hook 'post-command-hook 'initz-error-print-file)
 253   (setq mode-line-buffer-identification initz-error-modeline-string)
 254   (run-hooks 'initz-error-mode-hook))
 255
 256 (defun initz-error ()
 257   "Show initz error messages."
 258   (interactive)
 259   (when (or initz-compile-error-files
 260             initz-load-error-files)
 261     ;; FIXME: ad-hoc
 262     (let ((buf (get-buffer initz-error-buffer-name)))
 263       (when buf
 264         (unless (one-window-p)
 265           (delete-window))
 266         (kill-buffer buf)))
 267     (switch-to-buffer-other-window initz-error-buffer-name)
 268     (initz-error-mode)
 269     (goto-char (point-min))
 270     (insert
 271      (format initz-error-click-message-format
 272              (substitute-command-keys "\\[initz-error-find-file-mouse]")))
 273     (insert
 274      (format initz-error-enter-message-format
 275              (substitute-command-keys "\\[initz-error-find-file]")))
 276     (insert "\n")
 277     (mapc #'(lambda (node)
 278               (initz-error-node-expand node))
 279           '("compile" "load"))
 280     (set-buffer-modified-p nil)
 281     (setq buffer-read-only t)
 282     (goto-char (point-min))
 283     (search-forward "\n\n")
 284     (forward-char 1)
 285     ;; FIXME: ad-hoc
 286     (other-window 1)))
 287
 288 (provide 'initz-error)
 289
 290 ;;; initz-error.el ends here