telnet question

[Helmut Eller <e9626484 at stud3 dot tuwien dot ac dot at>]

Hello

I have written a kawa-mode for Emacs (see below) which uses a socket to
communicate with Kawa.  Most things work as I like it, but
unfortunately Kawa seems to print some (warning-) messages to stderr
rather than to stdout and I can't see them from within Emacs, e.g.,
when I type the following in a telnet session:

     (lambda () (set! foo '()) (invoke foo 'bar))

I get 
      
     #<procedure <unnamed>> 

but 

     <stdin>:1:28: warning - no method `bar' in java.lang.Object 

is printed in the other window.  (I'm using Kawa 1.6.70, jdk 1.1.7)

Is there an easy way to get both messages on stdout ?

Thanks,
	Helmut. 



------------------------------[cut here]------------------------------
;;; kawa.el -- Kawa editing and interaction mode for GNU Emacs.
;; $Id: kawa.el,v 0.1 2000/07/25 16:30:50 helmut Exp $

;; Copyright (C) 2000  Helmut Eller <e9626484@stud3.tuwien.ac.at>

;; kawa.el is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; kawa.el is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary
;;
;; kawa.el is a major mode for writing Kawa code similar to Emacs Lisp
;; mode.  Some commands for interacting with the Kawa interpreter are
;; provided.  kawa.el uses a socket to communicate with the Kawa
;; interpreter rather than a subprocess.
;;
;; This mode is heavily inspired by Dave Pearsons <davep@davep.org>
;; sawfish-mode.

;;; Installation
;; 
;; 1. Put the following function into your ~/.kawarc.scm
;; 
;;  (define (kawa-el-prompter port)
;;    (let ((state (input-port-read-state port)))
;;  	(cond ((char=? state #\Newline) "")
;;  	       ((< kawa-el-newline-counter kawa-el-newline-count) 
;;  		(set! kawa-el-newline-counter (+ 1 kawa-el-newline-counter))
;;  		"")
;;  	       ((char=? state #\Space) (string-append kawa-el-prompt))
;;  	       (else 
;;  		(string-append "#|"
;;  			       (make-string 1 state) "---:"
;;  			       (number->string (input-port-line-number port))
;;  			       "|# ")))))
;;  
;; 2. Drop kawa.el somewhere into your `load-path'.
;;
;; 3. Add the following to your ~/.emacs:
;;
;;	(autoload 'kawa-mode "kawa" "Kawa Mode" t)
;;
;;    If you want to use kawa-mode for all files ending with `.scm'
;;    add the following:
;;
;;      (setq auto-mode-alist (cons '("\\.scm$" . kawa-mode) auto-mode-alist))
;;

;;; Usage 
;;
;; First you have to start Kawa in "server mode" (in the shell):
;;
;;    kawa -f ~/.kawarc.scm --server 23456
;;
;; Now open an Emacs buffer and type `M-x kawa-mode'.  The must useful
;; command in kawa-mode is `C-x C-e' and works similar as in
;; Emacs-Lisp-mode.  Type `C-h m' to see the other commands.
;;




(defvar kawa-mode-map)

(defvar kawa-result-buffer "*kawa*"
  "Long messages are displayed in this buffer.")
(defvar kawa-socket-buffer "*kawa-socket*")
(defvar kawa-error-buffer "*kawa-error*")

(defconst kawa-server-port 23456)

(defvar kawa-socket nil)

(defvar kawa-error-positions nil
  "The list of errors.  Elements are pairs (ERROR-LINE
. MESSAGE-LINE); the last element is `t'.  ERROR-LINE is the position
in the source file and MESSAGE-LINE is the position of the error
message in `kawa-error-buffer.")
(defvar kawa-next-error-position nil
  "The next error to display.")


(defun kawa-start-server ()
  "Start kawa as server listening on port `kawa-server-port'."
  (interactive)
  (defvar kawa-server nil)
  (when (and kawa-server (eq (process-status kawa-server) 'run))
    (delete-process kawa-server))
  (setq kawa-server 
	(start-process-shell-command 
	 "kawa-server" "*kawa-server*" 
	 "kawa" "-f" (concat (getenv "HOME") "/.kawarc.scm")
	 "--server" kawa-server-port)))

(defun kawa-socket-sentinel (process event)
  (error "Server has closed connection"))

(defun kawa-socket ()
  "Return the socket; open it if needed."
  (when (or (null kawa-socket)
	    (eq (process-status kawa-socket) 'closed))
    (kawa-connect))
  kawa-socket)

(defun kawa-connect ()
  "Open a connection to the kawa server."
  (when (and kawa-socket (equal (process-status kawa-socket) 'open))
    (delete-process kawa-socket))
  (setq kawa-socket (open-network-stream "kawa-socket" kawa-socket-buffer
					 "localhost" kawa-server-port))
  (set-process-sentinel kawa-socket 'kawa-socket-sentinel) 
  (kawa-connect-init-prompt))

(defun kawa-connect-init-prompt ()
  ;; install a prompter which prompts with a custom string and ignores
  ;; the first KAWA-EL-NEWLINE-COUNT newlines.  

  (defun kawa-xxxx-seen-p ()
    (goto-char (point-min))
    (re-search-forward "XXXXXX$" nil t))
  
  (defun kawa-poll-until-xxxx-seen ()
    (with-current-buffer kawa-socket-buffer
      (while (not (kawa-xxxx-seen-p))
	(accept-process-output kawa-socket 0 250))
      (erase-buffer)))

  (process-send-string 
   kawa-socket
   "(set! kawa-el-newline-counter 0)  (set! kawa-el-newline-count 0)  (set! kawa-el-prompt \"XXXXXXXX\") (set-input-port-prompter! (current-input-port) kawa-el-prompter)\n")
  (kawa-poll-until-xxxx-seen))

(defun kawa-count-newlines (string)
  "Count the number of lines in STRING."
  (with-temp-buffer
    (insert string)
    (count-lines (point-min) (point-max))))

(defun kawa-ends-with-newline-p (string)
  "Return non-nil if STRING ends with ?\\n"
  (eq (aref string (1- (length string))) ?\n))

(defun kawa-send (string start-line output-fun)
  "Send STRING to the kawa server and call OUTPUT-FUN with the answer.
START-LINE is used to synchronise line numbers in error messages."
  ;; first reset the variables controlling the prompter: a random
  ;; prompt prompt and the number of newlines to ignore; pass the
  ;; string for evaluation.  Then wait until the prompt is returned.
  ;; Output the result using OUTPUT-FUN.  If the prompt indicated a
  ;; missing `)' reconnect. 
  ;; Note: helper functions use dynamic scoping!

  (defun kawa-random-prompt ()
    (concat "#|kawa:" (random) "|#"))
  
  (defun kawa-cut-prompt (string prompt) 
    (if (string-match (concat "[^\0]*" prompt "$") string)
	(substring string 0 (- (length prompt)))
      string))

  (let ((prompt (kawa-random-prompt))
	(send-string (if (kawa-ends-with-newline-p string)
			 string 
		       (concat string "\n")))
	(newline-count (kawa-count-newlines string))
	(orig-buffer (current-buffer))
	(socket (kawa-socket))
	(line  (- start-line 1)))

    (defun kawa-prompt-seen-p ()
      (goto-char (point-min))
      (re-search-forward (concat 
			  "\\(" prompt "\\|#|[)\"]---:[0-9]+|# \\)")
			 nil t))

    (defun kawa-prepare-output ()
      (kawa-cut-prompt (buffer-substring-no-properties (point-min) (point))
		       prompt))

    (defun kawa-copy-output-to-error-buffer (output)
      (with-current-buffer (get-buffer-create kawa-error-buffer)
	(erase-buffer)
	(insert output)))

    (defun kawa-handle-output (output)
      (with-current-buffer orig-buffer
	(funcall output-fun output))
      (kawa-copy-output-to-error-buffer output)
      (when (string-match "#|[)\"]---:[0-9]+|# " output)
	(kawa-connect)))  
      
    (defun kawa-poll ()
      (with-current-buffer kawa-socket-buffer
	(erase-buffer)
	(while (and (eq (process-status socket) 'open)
		    (not (kawa-prompt-seen-p)))
	  (accept-process-output socket 0 250))
	(when (kawa-prompt-seen-p)
	  (kawa-handle-output (kawa-prepare-output)))))


    (setq kawa-error-positions nil)
    (process-send-string 
     socket 
     (concat 
					; set prompter variables ...
      "(set! kawa-el-newline-counter 0) (set! kawa-el-newline-count " 
      newline-count ") (set! kawa-el-prompt \"" prompt "\")"
      "(set-port-line! (current-input-port) " line ")\n"
      send-string)			; ... and eval string
     )
    (kawa-poll)))




(define-derived-mode kawa-mode scheme-mode "kawa"
  "Major mode for editing kawa files and for interacting with kawa.

\\{kawa-mode-map}"
  ;; Add support for #| ... |# style comments (call it style b) see GNU
  ;; Emacs Lisp Reference Manual (Rev. 2.5), p. 673-675
  (modify-syntax-entry ?# "' 14b")      ; quote or comment (style b)
  (modify-syntax-entry ?| "_ 23b")      ; symbol or comment (style b)
  )

(define-key kawa-mode-map [(control x) (control e)] 'kawa-eval-last-sexp)
(define-key kawa-mode-map [(control j)] 'kawa-eval-print-last-sexp)
(define-key kawa-mode-map [(control c) (?\`)] 'kawa-next-error)
(define-key kawa-mode-map [(control c) (control r)] 'kawa-eval-region)
(define-key kawa-mode-map [(control c) (control b)] 'kawa-eval-buffer)


(defun kawa-eval (sexp &optional start-line output-fun)
  "Pass SEXP to kawa for evaluation.  SEXP can either be a list or a
string.  If passed the result of the evaluation is passed to
OUTPUT-FUN.  START-LINE can be used to synchronise line numbers."
  (kawa-send (if (stringp sexp) sexp (format "%S" sexp)) 
	     (if start-line start-line 0)
	     (if output-fun output-fun 'kawa-output)))

(defun kawa-eval-region (start end &optional output-fun)
  "Evaluate the region bounded by START and END."
  (interactive "r")
  (kawa-eval (buffer-substring-no-properties start end) 
	     (count-lines 1 (save-excursion (goto-char start)
					    (end-of-line) 
					    (point)))
	     output-fun))


(defun kawa-eval-buffer ()
  "Evaluate the whole buffer."
  (interactive)
  (kawa-eval-region (point-min) (point-max)))


(defun kawa-output (output)
  "Display output either in mini-buffer or a seperate buffer.

If the output is empty then the string \"No output\" is displayed.

If the output is one line long and the length of the line is less than the
`frame-width' then it is displayed using `message'.

If the output has multiple lines or is longer than `frame-width' then a new
buffer is opened and the text is displayed there. The name of the buffer is
set by the variable `kawa-result-buffer'"

  (defun kawa-delete-old-result-buffer ()
    (when (get-buffer-window kawa-result-buffer)
      ;; The long result buffer is visible, delete it.
      (delete-window (get-buffer-window kawa-result-buffer))))

  (defun kawa-output-single-line (output)
    (message "%s" (if (kawa-ends-with-newline-p output) 
		      (substring output 0 -1)
		    output)))

  (defun kawa-output-multi-line (output)
    (with-current-buffer (get-buffer-create kawa-result-buffer)
      (erase-buffer)
      (insert (format "%s" output))
      (goto-char (point-min))
      (shrink-window-if-larger-than-buffer (display-buffer (current-buffer)))))



  (kawa-delete-old-result-buffer)
  (let ((lines (kawa-count-newlines output)))
    (cond
     ((zerop lines)			; Nothing to display.
      (message "No output"))
     ((and (= 1 lines)			; If there is only one line
	   (< (length output)		; and it isn't too wide for
	      (frame-width)))		; the display.
      (kawa-output-single-line output))
     (t					; Too large for message area
      (kawa-output-multi-line output)))))

(defun kawa-eval-last-sexp (&optional output-fun)
  "Similar to `eval-last-sexp'."
  (interactive)
  (kawa-eval-region (save-excursion (backward-sexp) (point)) (point)
		    output-fun))

(defun kawa-eval-print-last-sexp ()
  "Similar to `eval-print-last-sexp'."
  (interactive)
  (kawa-eval-last-sexp 'insert))

 
(defun kawa-parse-errors ()
  "Build `kawa-error-positions'"

  (defun kawa-parse-search-errors (regex)
    (when (re-search-forward regex nil t)
      (let ((line (string-to-int (match-string 1)))
	    (msg (match-beginning 0)))
	(kawa-parse-search-errors regex)
	(setq kawa-error-positions (cons (cons line msg) 
					 kawa-error-positions)))))
  
  (with-current-buffer kawa-error-buffer
    (setq kawa-error-positions t)
    (goto-char (point-min))
    (kawa-parse-search-errors "#|[)\"]---:\\([0-9]+\\)|#")
    (goto-char (point-min))
    (kawa-parse-search-errors "<stdin>:\\([0-9]+\\):")
    (setq kawa-next-error-position kawa-error-positions)))

(defun kawa-display-error (line msg-pos)
  "Move to LINE and display the error-message at MSG-POS in the other
buffer."
  (goto-line line)
  (shrink-window-if-larger-than-buffer (display-buffer kawa-error-buffer))
  (set-window-start (get-buffer-window kawa-error-buffer) msg-pos))

(defun kawa-next-error ()
  "Visit next error message. (Like `next-error')"
  (interactive)
  (cond ((eq kawa-error-positions t) 
	 (message "No errors"))
	((eq kawa-error-positions nil) 
	 (kawa-parse-errors) (kawa-next-error))
	((eq kawa-next-error-position t)
	 (message "No more errors") (kawa-parse-errors))
	(t
	 (kawa-display-error (caar kawa-next-error-position)
			     (cdar kawa-next-error-position))
	 (setq kawa-next-error-position (cdr kawa-next-error-position)))))

(provide 'kawa)