mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00
Code Activity

remove (ice-9 emacs)

Browse source 
* module/ice-9/emacs.scm: Remove.
* module/ice-9/deprecated.scm (load-emacs-interface): Remove wrapper
  with no callers.
* module/Makefile.am: update.
This commit is contained in:
Andy Wingo 2010-07-16 13:14:23 +02:00
parent cd8e32c5cd
commit ca9300a255
3 changed files with 0 additions and 287 deletions
Download patch file Download diff file Expand all files Collapse all files

1
module/Makefile.am
View file

@ -187,7 +187,6 @@ ICE_9_SOURCES = \
ice-9/debug.scm \ ice-9/debug.scm \
ice-9/debugger.scm \ ice-9/debugger.scm \
ice-9/documentation.scm \ ice-9/documentation.scm \
ice-9/emacs.scm \
ice-9/expect.scm \ ice-9/expect.scm \
ice-9/format.scm \ ice-9/format.scm \
ice-9/getopt-long.scm \ ice-9/getopt-long.scm \

9
module/ice-9/deprecated.scm
View file

@ -64,7 +64,6 @@
the-last-stack the-last-stack
save-stack save-stack
named-module-use! named-module-use!
load-emacs-interface
top-repl) top-repl)
#:replace (module-ref-submodule module-define-submodule!)) #:replace (module-ref-submodule module-define-submodule!))
@ -684,14 +683,6 @@ it.")
"`named-module-use!' is deprecated. Define it yourself if you need it.") "`named-module-use!' is deprecated. Define it yourself if you need it.")
(module-use! (resolve-module user) (resolve-interface usee))) (module-use! (resolve-module user) (resolve-interface usee)))
(define (load-emacs-interface)
(issue-deprecation-warning
"`load-emacs-interface' and the old emacs interface itself are deprecated.
Use Geiser.")
(and (provided? 'debug-extensions)
(debug-enable 'backtrace))
(named-module-use! '(guile-user) '(ice-9 emacs)))
(define (top-repl) (define (top-repl)
(issue-deprecation-warning (issue-deprecation-warning
"`top-repl' has moved to the `(ice-9 top-repl)' module.") "`top-repl' has moved to the `(ice-9 top-repl)' module.")

277
module/ice-9/emacs.scm
View file

@ -1,277 +0,0 @@
;;;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2006, 2009, 2010 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; This library 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
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;;
;;;; The author can be reached at djurfeldt@nada.kth.se
;;;; Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN
;;;; (I didn't write this!)
;;;;
;;; *********************************************************************
;;; * This is the Guile side of the Emacs interface *
;;; * Experimental hACK---the real version will be coming soon (almost) *
;;; *********************************************************************
;;; {Session support for Emacs}
;;;
(define-module (ice-9 emacs)
:use-module (ice-9 threads)
:use-module (ice-9 session)
:use-module (ice-9 save-stack)
:no-backtrace)
(define emacs-escape-character #\sub)
(define emacs-output-port (current-output-port))
(define (make-emacs-command char)
(let ((cmd (list->string (list emacs-escape-character char))))
(lambda ()
(display cmd emacs-output-port))))
(define enter-input-wait (make-emacs-command #\s))
(define exit-input-wait (make-emacs-command #\f))
(define enter-read-character #\r)
(define sending-error (make-emacs-command #\F))
(define sending-backtrace (make-emacs-command #\B))
(define sending-result (make-emacs-command #\x))
(define end-of-text (make-emacs-command #\.))
(define no-stack (make-emacs-command #\S))
(define no-source (make-emacs-command #\R))
;; {Error handling}
;;
(add-hook! before-backtrace-hook sending-backtrace)
(add-hook! after-backtrace-hook end-of-text)
(add-hook! before-error-hook sending-error)
(add-hook! after-error-hook end-of-text)
;; {Repl}
;;
(set-current-error-port emacs-output-port)
(add-hook! before-read-hook
(lambda ()
(enter-input-wait)
(force-output emacs-output-port)))
(add-hook! after-read-hook
(lambda ()
(exit-input-wait)
(force-output emacs-output-port)))
;;; {Misc.}
(define (make-emacs-load-port orig-port)
(letrec ((read-char-fn (lambda args
(let ((c (read-char orig-port)))
(if (eq? c #\soh)
(throw 'end-of-chunk)
c)))))
(make-soft-port
(vector #f #f #f
read-char-fn
(lambda () (close-port orig-port)))
"r")))
(set-current-input-port (make-emacs-load-port (current-input-port)))
(define (result-to-emacs exp)
(sending-result)
(write exp emacs-output-port)
(end-of-text)
(force-output emacs-output-port))
(define load-acknowledge (make-emacs-command #\l))
(define load-port (current-input-port))
(define (flush-line port)
(let loop ((c (read-char port)))
(if (not (eq? c #\nl))
(loop (read-char port)))))
(define whitespace-chars (list #\space #\tab #\nl #\np))
(define (flush-whitespace port)
(catch 'end-of-chunk
(lambda ()
(let loop ((c (read-char port)))
(cond ((eq? c the-eof-object)
(error "End of file while receiving Emacs data"))
((memq c whitespace-chars) (loop (read-char port)))
((eq? c #\;) (flush-line port) (loop (read-char port)))
(else (unread-char c port))))
#f)
(lambda args
(read-char port) ; Read final newline
#t)))
(define (emacs-load filename linum colnum module interactivep)
(define (read-and-eval! port)
(let ((x (read port)))
(if (eof-object? x)
(throw 'end-of-file)
(primitive-eval x))))
(set-port-filename! %%load-port filename)
(set-port-line! %%load-port linum)
(set-port-column! %%load-port colnum)
(lazy-catch #t
(lambda ()
(let loop ((endp (flush-whitespace %%load-port)))
(if (not endp)
(begin
(save-module-excursion
(lambda ()
(if module
(set-current-module (resolve-module module #f)))
(let ((result
(start-stack read-and-eval!
(read-and-eval! %%load-port))))
(if interactivep
(result-to-emacs result)))))
(loop (flush-whitespace %%load-port)))
(begin
(load-acknowledge)))
(set-port-filename! %%load-port #f))) ;reset port filename
(lambda (key . args)
(set-port-filename! %%load-port #f)
(cond ((eq? key 'end-of-chunk)
(fluid-set! the-last-stack #f)
(set! stack-saved? #t)
(scm-error 'misc-error
#f
"Incomplete expression"
'()
'()))
((eq? key 'exit))
(else
(save-stack 2)
(catch 'end-of-chunk
(lambda ()
(let loop ()
(read-char %%load-port)
(loop)))
(lambda args
#f))
(apply throw key args))))))
(define (emacs-eval-request form)
(result-to-emacs (eval form (interaction-environment))))
;;*fixme* Not necessary to use flags no-stack and no-source
(define (get-frame-source frame)
(if (or (not (fluid-ref the-last-stack))
(>= frame (stack-length (fluid-ref the-last-stack))))
(begin
(no-stack)
#f)
(let* ((frame (stack-ref (fluid-ref the-last-stack)
(frame-number->index frame)))
(source (frame-source frame)))
(or source
(begin (no-source)
#f)))))
(define (emacs-select-frame frame)
(let ((source (get-frame-source frame)))
(if source
(let ((fname (source-property source 'filename))
(line (source-property source 'line))
(column (source-property source 'column)))
(if (and fname line column)
(list fname line column)
(begin (no-source)
'())))
'())))
(define (object->string x . method)
(with-output-to-string
(lambda ()
((if (null? method)
write
(car method))
x))))
(define (format template . rest)
(let loop ((chars (string->list template))
(result '())
(rest rest))
(cond ((null? chars) (list->string (reverse result)))
((char=? (car chars) #\%)
(loop (cddr chars)
(append (reverse
(string->list
(case (cadr chars)
((#\S) (object->string (car rest)))
((#\s) (object->string (car rest) display)))))
result)
(cdr rest)))
(else (loop (cdr chars) (cons (car chars) result) rest)))))
(define (error-args->string args)
(let ((msg (apply format (caddr args) (cadddr args))))
(if (symbol? (cadr args))
(string-append (symbol->string (cadr args))
": "
msg)
msg)))
;; FIXME: no longer working due to removal of local-eval
(define (emacs-frame-eval frame form)
(let ((source (get-frame-source frame)))
(if source
(catch #t
(lambda ()
(list 'result
(object->string
(local-eval (with-input-from-string form read)
(memoized-environment source)))))
(lambda args
(list (car args)
(error-args->string args))))
(begin
(no-source)
'()))))
(define (emacs-symdoc symbol)
(if (or (not (module-bound? (current-module) symbol))
(not (procedure? (eval symbol (interaction-environment)))))
'nil
(procedure-documentation (eval symbol (interaction-environment)))))
;;; A fix to get the emacs interface to work together with the module system.
;;;
(for-each (lambda (name value)
(module-define! the-root-module name value))
'(%%load-port
%%emacs-load
%%emacs-eval-request
%%emacs-select-frame
%%emacs-frame-eval
%%emacs-symdoc
%%apropos-internal)
(list load-port
emacs-load
emacs-eval-request
emacs-select-frame
emacs-frame-eval
emacs-symdoc
apropos-internal))