+2004-02-21 Neil Jerram <neil@ossau.uklinux.net>
+
+ * gds.el: Add requirements: cl, comint, info.
+ (gds-guile-program): New.
+ (gds-start): When starting or restarting, kill captive if it
+ exists. Use gds-guile-program instead of just "guile".
+ (gds-mode): Use widget minor mode.
+ (gds-client-ref): New optional client arg.
+ (gds-update-buffers): Don't call widget-setup.
+ (gds-heading-face): New.
+ (gds-insert-interaction): Various prettifications.
+ (gds-heading-insert): New.
+ (gds-choose-client): Check that numbers in client and gds-client
+ are still valid.
+ (gds-eval-expression, gds-apropos): Remove text properties from
+ expression to evaluate.
+ (gds-mode-map): Don't set widget-mode-map as parent.
+ (gds-start-captive): Use gds-guile-program instead of just
+ "guile".
+
+ * gds-client.scm (install-breakpoints): Bugfix: avoid null lists
+ in traversal.
+ (eval-thread, gds-eval): Where expression has multiple parts,
+ modify output to say which part is being evaluated.
+
2004-02-08 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* Makefile.am (TAGS_FILES): Use this variable instead of
(define (install-breakpoints x bpinfo)
(define (install-recursive x)
- (if (list? x)
+ (if (and (list? x) (not (null? x)))
(begin
;; Check source properties of x itself.
(let* ((infokey (cons (source-property x 'line)
;; Do the evaluation(s).
(let loop2 ((m (cadr work))
(exprs (cddr work))
- (results '()))
+ (results '())
+ (n 1))
(if (null? exprs)
(write-form `(eval-results ,correlator ,@results))
(loop2 m
(cdr exprs)
- (append results (gds-eval (car exprs) m))))))
+ (append results (gds-eval (car exprs) m
+ (if (and (null? (cdr exprs))
+ (= n 1))
+ #f n)))
+ (+ n 1)))))
(trc 'eval-thread depth thread-number "work done")
;; Tell the subthread that it should now exit.
(set! subthread-needed? #f)
;; Tell the front end this thread is ready.
(write-form `(thread-status eval ,thread-number exiting)))))
-(define (gds-eval x m)
+(define (gds-eval x m part)
;; Consumer to accept possibly multiple values and present them for
;; Emacs as a list of strings.
(define (value-consumer . values)
(with-output-to-string (lambda () (write value))))
values)))
;; Now do evaluation.
- (let ((value #f))
+ (let ((intro (if part
+ (format #f ";;; Evaluating subexpression ~A" part)
+ ";;; Evaluating"))
+ (value #f))
(let* ((do-eval (if m
(lambda ()
- (display "Evaluating in module ")
+ (display intro)
+ (display " in module ")
(write (module-name m))
(newline)
(set! value
(eval x m)))
value-consumer)))
(lambda ()
- (display "Evaluating in current module ")
+ (display intro)
+ (display " in current module ")
(write (module-name (current-module)))
(newline)
(set! value
(require 'widget)
(require 'wid-edit)
(require 'scheme)
+(require 'cl)
+(require 'comint)
+(require 'info)
;;;; Customization group setup.
;; the buffer position of the start of the next unread form.
(defvar gds-read-cursor nil)
+;; The guile executable used by the GDS server and captive client
+;; processes.
+(defcustom gds-guile-program "guile"
+ "*The guile executable used by GDS, specifically by its server and
+captive client processes."
+ :type 'string
+ :group 'gds)
+
(defun gds-start ()
"Start (or restart, if already running) the GDS subprocess."
(interactive)
+ (gds-kill-captive)
(if gds-process (gds-shutdown))
(with-current-buffer (get-buffer-create "*GDS Process*")
(erase-buffer)
(let ((process-connection-type nil)) ; use a pipe
(start-process "gds"
(current-buffer)
- "guile"
+ gds-guile-program
"-q"
"--debug"
"-c"
(define-derived-mode gds-mode
scheme-mode
"Guile Interaction"
- "Major mode for interacting with a Guile client application.")
+ "Major mode for interacting with a Guile client application."
+ (widget-minor-mode 1))
(defvar gds-client nil
"GDS client's port number.")
(gds-client-buffer client 'name '("(GDS buffer killed)"))))))
;; Get the current buffer's associated client's value of SYM.
-(defun gds-client-ref (sym)
- (and gds-client
- (let ((buf (assq gds-client gds-buffers)))
+(defun gds-client-ref (sym &optional client)
+ (and (or client gds-client)
+ (let ((buf (assq (or client gds-client) gds-buffers)))
(and buf
(cdr buf)
(buffer-live-p (cdr buf))
(t
(error "Bad GDS view %S" view)))
;; Finish off.
- (widget-setup)
(force-mode-line-update t)))
(defun gds-update-buffers-in-a-while ()
"Last help or evaluation results.")
(make-variable-buffer-local 'gds-results)
+(defcustom gds-heading-face 'info-menu-header
+ "*Face used for headings in Guile Interaction buffers."
+ :type 'face
+ :group 'gds)
+
(defun gds-insert-interaction ()
(erase-buffer)
;; Insert stuff for interacting with a running (non-blocked) Guile
;; client.
- (widget-insert (buffer-name)
- ", "
+ (gds-heading-insert (buffer-name))
+ (widget-insert " "
(cdr (assq gds-status
'((running . "running (cannot accept input)")
(waiting-for-input . "waiting for input")
(closed . "closed"))))
", in "
gds-current-module
- "\n")
+ "\n\n")
(widget-create 'push-button
:notify (function gds-sigint)
"SIGINT")
(widget-create 'editable-field
:notify (function gds-set-exception-keys)
gds-exception-keys)
+ ;; Evaluation report area.
+ (widget-insert "\n")
+ (gds-heading-insert "Recent Evaluations")
+ (widget-insert " To run an evaluation, see the Guile->Evaluate menu.\n")
+ (if gds-results
+ (widget-insert "\n" (cdr gds-results)))
(let ((evals gds-evals-in-progress))
- (if evals
- (widget-insert "\nEvaluations in progress:\n"))
(while evals
+ (widget-insert "\n" (cddar evals) " - running ")
(let ((w (widget-create 'push-button
:notify (function gds-interrupt-eval)
"Interrupt")))
- (widget-put w :thread-number (caar evals))
- (widget-insert " " (cddar evals) "\n"))
- (setq evals (cdr evals))))
- (if gds-results
- (widget-insert "\n" (cdr gds-results))))
+ (widget-put w :thread-number (caar evals)))
+ (widget-insert "\n")
+ (setq evals (cdr evals)))))
+
+(defun gds-heading-insert (text)
+ (let ((start (point)))
+ (widget-insert text)
+ (let ((o (make-overlay start (point))))
+ (overlay-put o 'face gds-heading-face)
+ (overlay-put o 'evaporate t))))
(defun gds-sigint (w &rest ignore)
(interactive)
client)))
(defun gds-choose-client (client)
+ ;; Only keep the supplied client number if it is still valid.
+ (if (integerp client)
+ (setq client (gds-client-ref 'gds-client client)))
+ ;; Only keep the current buffer's setting of `gds-client' if it is
+ ;; still valid.
+ (if gds-client
+ (setq gds-client (gds-client-ref 'gds-client)))
+
(or ;; If client is an integer, it is the port number of the
;; intended client.
(if (integerp client)
"Evaluate the supplied EXPR (a string)."
(interactive "sEvaluate expression: \nP")
(setq client (gds-choose-client client))
+ (set-text-properties 0 (length expr) nil expr)
(gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 () %S"
(or correlator 'expression)
(gds-abbreviated expr)
"Guile apropos (regexp): ")))
(list (if (zerop (length val)) sym val)
current-prefix-arg)))
+ (set-text-properties 0 (length regex) nil regex)
(gds-eval-expression (format "(apropos %S)" regex) client 'help))
(defvar gds-completion-results nil)
(define-key scheme-mode-map "\C-x\e " 'gds-delete-source-breakpoint)
-;;;; GDS (Guile Interaction) mode keymap and menu items.
-
-(set-keymap-parent gds-mode-map widget-keymap)
+;;;; Guile Interaction mode keymap and menu items.
(define-key gds-mode-map "M" (function gds-query-modules))
:type 'boolean
:group 'gds)
-(if (and gds-autostart-server
- (not gds-process))
- (gds-start))
-
;;;; `Captive' Guile - a Guile process that is started when needed to
;;;; provide help, completion, evaluations etc.
nil
(let ((process-connection-type nil))
(setq gds-captive (make-comint "captive-guile"
- "guile"
+ gds-guile-program
nil
"-q")))
(let ((proc (get-buffer-process gds-captive)))
(error))))
+;;;; If requested, autostart the server after loading.
+
+(if (and gds-autostart-server
+ (not gds-process))
+ (gds-start))
+
+
;;;; The end!
(provide 'gds)
HCoop / bpt / guile.git / commitdiff