cgit.sxemacs.org Git - packages/blob - xemacs-packages/ilisp/ilisp-hnd.el

   1 ;;; -*- Mode: Emacs-Lisp -*-
   2
   3 ;;; ilisp-hnd.el --
   4 ;;; ILISP Error handler
   5 ;;;
   6 ;;; This file is part of ILISP.
   7 ;;; Please refer to the file COPYING for copyrights and licensing
   8 ;;; information.
   9 ;;; Please refer to the file ACKNOWLEGDEMENTS for an (incomplete) list
  10 ;;; of present and past contributors.
  11 ;;;
  12 ;;; $Id: ilisp-hnd.el,v 1.3 2001-07-02 09:40:46 youngs Exp $
  13
  14
  15 ;; Do not handle errors by default.
  16 (defvar ilisp-handle-errors nil)
  17
  18 ;;;
  19 (defun ilisp-handler (error-p wait-p message output prompt)
  20   "Given ERROR-P, WAIT-P, MESSAGE, OUTPUT and PROMPT, show the message
  21 and output if there is an error or the output is multiple lines and
  22 let the user decide what to do."
  23   (if (not ilisp-handle-errors)
  24       (progn
  25         (if message
  26             (progn
  27               (setq ilisp-last-message message
  28                     ilisp-last-prompt prompt)
  29               (if (not wait-p) (lisp-display-output output))))
  30         nil)
  31     (if (and (not wait-p)
  32              (setq output (comint-remove-whitespace output))
  33              (or error-p (string-match "\n" output)))
  34         (let* ((buffer (ilisp-output-buffer ilisp-output t))
  35                (out (if error-p
  36                         (funcall ilisp-error-filter output)
  37                       output))
  38                (key
  39                 (if (and error-p (not (comint-interrupted)))
  40                     (comint-handle-error
  41                      out
  42      "SPC-scroll, I-ignore, K-keep, A-abort sends and keep or B-break: "
  43                      '(?i ?k ?a ?b))
  44                   (comint-handle-error
  45                    out
  46            "SPC-scroll, I-ignore, K-keep or A-abort sends and keep: "
  47                    '(?i ?k ?a))))
  48                (clear comint-queue-emptied))
  49           (if (= key ?i)
  50               (progn
  51                 (message "Ignore message")
  52                 (if buffer
  53                     (funcall
  54                      (ilisp-temp-buffer-show-function)
  55                      buffer)
  56                   (ilisp-bury-output))
  57                 t)
  58             (save-excursion
  59               (set-buffer (get-buffer-create "*Errors*"))
  60               (if clear (delete-region (point-min) (point-max)))
  61               (goto-char (point-max))
  62               (insert message)
  63               (insert ?\n)
  64               (insert out)
  65               (insert "\n\n"))
  66             (if clear (setq comint-queue-emptied nil))
  67             (if (= key ?a)
  68                 (progn
  69                   (message "Abort pending commands and keep in *Errors*")
  70                   (comint-abort-sends)
  71                   t)
  72               (if (= key ?b)
  73                   (progn
  74                     (comint-insert
  75                      (concat comment-start comment-start comment-start
  76                              message "\n"
  77                              output "\n" prompt))
  78                     (message "Preserve break") nil)
  79                 (message "Keep error in *Errors* and continue")
  80                 t))))
  81       t)))
  82
  83 ;;;
  84 (defun ilisp-abort-handler ()
  85   "Handle when the user aborts commands."
  86   (setq ilisp-initializing nil
  87         ilisp-load-files nil)
  88   (let ((add nil))
  89     (while ilisp-pending-changes
  90       (if (not (memq (car ilisp-pending-changes) lisp-changes))
  91           (setq add (cons (car ilisp-pending-changes) add)))
  92       (setq ilisp-pending-changes (cdr ilisp-pending-changes)))
  93     (setq lisp-changes (nconc lisp-changes add))))