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

   1 ;;; -*- Mode: Emacs-Lisp -*-
   2
   3 ;;; ilisp-xfr.el --
   4 ;;; ILISP transfer commands Lisp <-> Emacs.
   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-xfr.el,v 1.5 2006-05-16 22:50:22 james Exp $
  13
  14 (require 'cl)
  15
  16 ;;; return-ilisp --
  17 ;;; It's too bad that this function copies so much code from comint-send-input.
  18 ;;; It ought to be a wrapper around it, instead.
  19
  20 (defun return-ilisp ()
  21   "Grab the current expression with comint-get-old-input.
  22 If we have a complete sexp, send it.  Otherwise, indent appropriately."
  23   (interactive)
  24   (let ((proc (get-buffer-process (current-buffer))))
  25     (if (not proc)
  26         (error "Current buffer has no process")
  27         (let* ((pmark (process-mark proc))
  28                (input (ilisp-get-old-input)))
  29           (if input
  30               (progn
  31                 (if (>= (point) pmark)
  32                     (goto-char (point-max))
  33                     (goto-char pmark)
  34                     (insert input))
  35                 (if (not ilisp-no-newline) (insert ?\n))
  36                 (if (and (funcall comint-input-filter input)
  37                          (or (ring-empty-p (ilisp-get-input-ring))
  38                              (not (string= (ring-ref (ilisp-get-input-ring) 0)
  39                                            input))))
  40                     (ilisp-ring-insert (ilisp-get-input-ring) input))
  41                 (run-hook-with-args 'comint-input-filter-functions input)
  42                 (setq comint-input-ring-index nil)
  43                 ;; Nuke symbol table
  44                 (setq ilisp-original nil)
  45                 (funcall comint-input-sender proc input)
  46                 (set-marker (process-mark proc) (point))
  47                 (set-marker comint-last-input-end (point))
  48                 (goto-char (point-max)))
  49               (if (= pmark (point-max))
  50                   (let ((comint-send-newline t))
  51                     (when (not ilisp-no-newline) (insert ?\n))
  52                     (set-marker (process-mark proc) (point))
  53                     (funcall comint-input-sender proc ""))
  54                   (insert ?\n)
  55                   (save-restriction
  56                     (narrow-to-region pmark (point-max))
  57                     (funcall indent-line-function))))))))
  58
  59 ;;;%%Keyboard mode
  60 (defun raw-keys-ilisp ()
  61   "Start using raw keyboard mode to characters to the inferior LISP.
  62 Each character typed is sent to the inferior LISP until a key bound to
  63 interactive-keys-ilisp is encountered.  See also io-bridge-ilisp."
  64   (interactive)
  65   (when (not ilisp-raw-map)
  66     (let ((map (make-keymap)))
  67       (fillarray map 'ilisp-send-char)
  68       (when (string-match "Lucid" emacs-version)
  69         ;; not necessary, but friendlier.
  70         (setq ilisp-completion-map (make-keymap))
  71         ;; (set-keymap-name ilisp-completion-map 'ilisp-completion-map)
  72         ;; (set-keymap-parent ilisp-completion-map lisp-mode-map)
  73         )
  74       (define-key map "\C-g" 'interactive-keys-ilisp)
  75       (setq ilisp-raw-map map)))
  76   (use-local-map ilisp-raw-map)
  77   (message ilisp-raw-message))
  78
  79 ;;;
  80 (defun interactive-keys-ilisp ()
  81   "Go back to interactive keyboard interactions in the inferior LISP."
  82   (interactive)
  83   (use-local-map ilisp-use-map)
  84   (message "Interactive keyboard mode"))
  85
  86 ;;;
  87 (defun ilisp-send-char ()
  88   "Send the last typed character to the current inferior LISP.
  89 If 'ilisp-raw-echo' is T then echo it."
  90   (interactive)
  91   (when (ilisp-value 'ilisp-raw-echo t)
  92     (goto-char (point-max))
  93     (insert last-input-char)
  94     (set-marker (process-mark (ilisp-process)) (point))
  95     (set-marker comint-last-input-end (point)))
  96   (process-send-string (ilisp-process)
  97                        (make-string 1 last-input-char))
  98   (message ilisp-raw-message))
  99
 100 ;;;
 101 (defun ilisp-raw-handler (process output)
 102   "Turn on raw keyboard mode."
 103   (raw-keys-ilisp))
 104
 105 (defun ilisp-interactive-handler (process output)
 106   "Turn on interactive keyboard mode."
 107   (interactive-keys-ilisp))
 108
 109 ;;;
 110 (defun io-bridge-ilisp ()
 111   "Make it possible for the inferior LISP to turn on EMACS raw mode.
 112 When this function is called, the inferior LISP can turn on EMACS raw mode by
 113 sending ^[1^], and turn it off by sending ^[0^]."
 114   (interactive)
 115   (require 'bridge)
 116   (install-bridge)
 117   (setq bridge-handlers (cons '("1" . ilisp-raw-handler)
 118                               (cons '("0" . ilisp-interactive-handler)
 119                                     bridge-handlers))))
 120
 121 ;;;%%Debugger interface
 122 (defun delete-char-or-pop-ilisp (arg &optional killflag)
 123   "Delete ARG characters, or pop break level if at end of buffer.
 124 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
 125 Interactively, ARG is the prefix arg, and KILLFLAG is set if
 126 ARG was explicitly specified."
 127   (interactive "p")
 128   (cond ((eobp)
 129          (message "Pop LISP one level")
 130          (comint-simple-send (ilisp-process) (ilisp-value 'comint-fix-error)))
 131         (t (call-interactively 'delete-char (list arg killflag)))))
 132
 133 ;; end of file -- ilisp-xfr.el --