mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
* 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.
This commit is contained in:
Neil Jerram
parent
2c0334eccd
commit
580987cf4b
3 changed files with 104 additions and 31 deletions
|
|
@ -1,3 +1,28 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -523,7 +523,7 @@ decimal IP address where the UI server is running; default is
|
|||
|
||||
(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)
|
||||
|
|
@ -619,12 +619,17 @@ decimal IP address where the UI server is running; default is
|
|||
;; 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)
|
||||
|
|
@ -643,7 +648,7 @@ decimal IP address where the UI server is running; default is
|
|||
;; 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)
|
||||
|
|
@ -653,10 +658,14 @@ decimal IP address where the UI server is running; default is
|
|||
(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
|
||||
|
|
@ -665,7 +674,8 @@ decimal IP address where the UI server is running; default is
|
|||
(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
|
||||
|
|
|
|||
86
emacs/gds.el
86
emacs/gds.el
|
|
@ -24,6 +24,9 @@
|
|||
(require 'widget)
|
||||
(require 'wid-edit)
|
||||
(require 'scheme)
|
||||
(require 'cl)
|
||||
(require 'comint)
|
||||
(require 'info)
|
||||
|
||||
|
||||
;;;; Customization group setup.
|
||||
|
|
@ -43,9 +46,18 @@
|
|||
;; 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)
|
||||
|
|
@ -53,7 +65,7 @@
|
|||
(let ((process-connection-type nil)) ; use a pipe
|
||||
(start-process "gds"
|
||||
(current-buffer)
|
||||
"guile"
|
||||
gds-guile-program
|
||||
"-q"
|
||||
"--debug"
|
||||
"-c"
|
||||
|
|
@ -364,7 +376,8 @@ The function is called with one argument, the CLIENT in question."
|
|||
(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.")
|
||||
|
|
@ -409,9 +422,9 @@ The function is called with one argument, the CLIENT in question."
|
|||
(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))
|
||||
|
|
@ -449,7 +462,6 @@ The function is called with one argument, the CLIENT in question."
|
|||
(t
|
||||
(error "Bad GDS view %S" view)))
|
||||
;; Finish off.
|
||||
(widget-setup)
|
||||
(force-mode-line-update t)))
|
||||
|
||||
(defun gds-update-buffers-in-a-while ()
|
||||
|
|
@ -549,12 +561,17 @@ the following symbols.
|
|||
"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")
|
||||
|
|
@ -562,7 +579,7 @@ the following symbols.
|
|||
(closed . "closed"))))
|
||||
", in "
|
||||
gds-current-module
|
||||
"\n")
|
||||
"\n\n")
|
||||
(widget-create 'push-button
|
||||
:notify (function gds-sigint)
|
||||
"SIGINT")
|
||||
|
|
@ -578,18 +595,28 @@ the following symbols.
|
|||
(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)
|
||||
|
|
@ -1113,6 +1140,14 @@ isn't yet known to Guile."
|
|||
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)
|
||||
|
|
@ -1196,6 +1231,7 @@ region's code."
|
|||
"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)
|
||||
|
|
@ -1264,6 +1300,7 @@ region's code."
|
|||
"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)
|
||||
|
|
@ -1386,9 +1423,7 @@ Used for determining the default for the next `gds-load-file'.")
|
|||
(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))
|
||||
|
||||
|
|
@ -1541,10 +1576,6 @@ Used for determining the default for the next `gds-load-file'.")
|
|||
: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.
|
||||
|
|
@ -1566,7 +1597,7 @@ Used for determining the default for the next `gds-load-file'.")
|
|||
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)))
|
||||
|
|
@ -1585,6 +1616,13 @@ Used for determining the default for the next `gds-load-file'.")
|
|||
(error))))
|
||||
|
||||
|
||||
;;;; If requested, autostart the server after loading.
|
||||
|
||||
(if (and gds-autostart-server
|
||||
(not gds-process))
|
||||
(gds-start))
|
||||
|
||||
|
||||
;;;; The end!
|
||||
|
||||
(provide 'gds)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue