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

   1 ;;; -*- Mode: Emacs-Lisp -*-
   2
   3 ;;; ilisp-openmcl
   4
   5 ;;; This file is part of ILISP.
   6 ;;; Please refer to the file COPYING for copyrights and licensing
   7 ;;; information.
   8 ;;; Please refer to the file ACKNOWLEGDEMENTS for an (incomplete) list
   9 ;;; of present and past contributors.
  10
  11 ;;;
  12 ;;; ILISP OpenMCL Common Lisp dialect definition
  13 ;;;
  14 ;;;
  15
  16
  17 ;;;%%%OpenMCL
  18 (defvar ilisp-openmcl-init-file "openmcl.lisp")
  19
  20 (defun openmcl-check-prompt (old new)
  21   "Compare the break level printed at the beginning of the prompt."
  22   (let* ((old-level (if (and old (eq 1 (string-match "[0-9]+" old)))
  23                         (string-to-int (substring old 1))
  24                         0))
  25          (new-level (if (eq 1 (string-match "[0-9]+" new))
  26                         (string-to-int (substring new 1))
  27                         0)))
  28     (<= new-level old-level)))
  29
  30 ;;;
  31 (defdialect openmcl "OpenMCL"
  32   common-lisp
  33   (ilisp-load-init 'openmcl ilisp-openmcl-init-file)
  34
  35   (setq comint-prompt-regexp "^\\([0-9]+ >\\|\\?\\|Step>\\|Inspect.*>\\) "
  36         ilisp-trace-command "(ILISP::openmcl-trace \"%s\" \"%s\" \"%s\")"
  37         comint-prompt-status
  38         (function (lambda (old line)
  39           (comint-prompt-status old line 'openmcl-check-prompt)))
  40
  41         ilisp-error-regexp "ILISP:[^\"]*\\|Error [^\n]*\n\n"
  42
  43
  44         ilisp-arglist-command "(ILISP::arglist \"%s\" \"%s\")"
  45
  46         ilisp-find-source-command "(ILISP::source-file \"%s\" \"%s\" \"%s\")"
  47
  48         comint-fix-error ":pop"
  49
  50         comint-continue ":go"
  51
  52         ilisp-reset ":q"
  53
  54         comint-interrupt-regexp "Break .*:"
  55
  56
  57         ilisp-directory-command  "(ccl::current-directory-name)"
  58         ilisp-set-directory-command "(ccl:cwd \"%s\")"
  59
  60         ))
  61
  62
  63 (if (not openmcl-program) (setq openmcl-program "openmcl"))