From e9bab9df3dd725085bb603de21a5d105a532bfe3 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Fri, 26 Jan 2001 16:58:48 +0000 Subject: [PATCH] * Make readline run-time options accessible. --- guile-readline/ChangeLog | 12 +++ guile-readline/readline.scm | 25 ++++++ ice-9/ChangeLog | 11 +++ ice-9/boot-9.scm | 165 ++++++++++++++++++------------------ 4 files changed, 130 insertions(+), 83 deletions(-) diff --git a/guile-readline/ChangeLog b/guile-readline/ChangeLog index 9bd1bf61c..546d3637a 100644 --- a/guile-readline/ChangeLog +++ b/guile-readline/ChangeLog @@ -1,3 +1,15 @@ +2001-01-26 Dirk Herrmann + + This patch fixes a problem reported by Martin Grabmueller about + the impossibility to access readline's run-time options. + + * readline.scm: Added a comment about guile's behaviour if one of + the ports used by readline are closed. + + (readline-options readline-enable readline-disable, + readline-set!): These are now defined here instead of in + boot-9.scm. + 2001-01-25 Dirk Herrmann * readline.scm (set-readline-input-port!, diff --git a/guile-readline/readline.scm b/guile-readline/readline.scm index 16adca408..8d499d5aa 100644 --- a/guile-readline/readline.scm +++ b/guile-readline/readline.scm @@ -21,11 +21,15 @@ ;;;; Extensions based upon code by ;;;; Andrew Archibald . + + (define-module (ice-9 readline) :use-module (ice-9 session) :use-module (ice-9 regex) :no-backtrace) + + ;;; Dynamically link the glue code for accessing the readline library, ;;; but only when it isn't already present. @@ -39,9 +43,30 @@ '() '())) + + +;;; Run-time options + +(export + readline-options + readline-enable + readline-disable) +(export-syntax + readline-set!) + +(define-option-interface + (readline-options-interface + (readline-options readline-enable readline-disable) + (readline-set!))) + + + ;;; MDJ 980513 : ;;; There should probably be low-level support instead of this code. +;;; Dirk:FIXME:: If the-readline-port, input-port or output-port are closed, +;;; guile will enter an endless loop or crash. + (define prompt "") (define prompt2 "") (define input-port (current-input-port)) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index e4da0a6b0..6ac39d8f7 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,14 @@ +2001-01-26 Dirk Herrmann + + This patch fixes a problem reported by Martin Grabmueller about + the impossibility to access readline's run-time options. + + * boot-9.scm (define-option-interface): New macro. Allows to + conveniently define a group of option interface functions. + + (readline-options readline-enable readline-disable, + readline-set!): Moved to guile-readline/readline.scm. + 2001-01-24 Gary Houston * boot-9.scm: don't import (ice-9 rdelim) here. it's done diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index c929c0617..fc13ebc39 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -2015,97 +2015,96 @@ ;;; {Run-time options} -((let* ((names '((eval-options-interface - (eval-options eval-enable eval-disable) - (eval-set!)) - - (debug-options-interface - (debug-options debug-enable debug-disable) - (debug-set!)) - - (evaluator-traps-interface - (traps trap-enable trap-disable) - (trap-set!)) - - (read-options-interface - (read-options read-enable read-disable) - (read-set!)) - - (print-options-interface - (print-options print-enable print-disable) - (print-set!)) +(define define-option-interface + (let* ((option-name car) + (option-value cadr) + (option-documentation caddr) - (readline-options-interface - (readline-options readline-enable readline-disable) - (readline-set!)) - )) - (option-name car) - (option-value cadr) - (option-documentation caddr) + (print-option (lambda (option) + (display (option-name option)) + (if (< (string-length + (symbol->string (option-name option))) + 8) + (display #\tab)) + (display #\tab) + (display (option-value option)) + (display #\tab) + (display (option-documentation option)) + (newline))) - (print-option (lambda (option) - (display (option-name option)) - (if (< (string-length - (symbol->string (option-name option))) - 8) - (display #\tab)) - (display #\tab) - (display (option-value option)) - (display #\tab) - (display (option-documentation option)) - (newline))) + ;; Below follow the macros defining the run-time option interfaces. - ;; Below follows the macros defining the run-time option interfaces. + (make-options (lambda (interface) + `(lambda args + (cond ((null? args) (,interface)) + ((list? (car args)) + (,interface (car args)) (,interface)) + (else (for-each ,print-option + (,interface #t))))))) - (make-options (lambda (interface) - `(lambda args - (cond ((null? args) (,interface)) - ((list? (car args)) - (,interface (car args)) (,interface)) - (else (for-each ,print-option - (,interface #t))))))) - - (make-enable (lambda (interface) - `(lambda flags - (,interface (append flags (,interface))) - (,interface)))) - - (make-disable (lambda (interface) + (make-enable (lambda (interface) `(lambda flags - (let ((options (,interface))) - (for-each (lambda (flag) - (set! options (delq! flag options))) - flags) - (,interface options) - (,interface))))) + (,interface (append flags (,interface))) + (,interface)))) - (make-set! (lambda (interface) - `((name exp) - (,'quasiquote - (begin (,interface (append (,interface) - (list '(,'unquote name) - (,'unquote exp)))) - (,interface)))))) - ) - (procedure->macro + (make-disable (lambda (interface) + `(lambda flags + (let ((options (,interface))) + (for-each (lambda (flag) + (set! options (delq! flag options))) + flags) + (,interface options) + (,interface))))) + + (make-set! (lambda (interface) + `((name exp) + (,'quasiquote + (begin (,interface (append (,interface) + (list '(,'unquote name) + (,'unquote exp)))) + (,interface))))))) + (procedure->macro (lambda (exp env) (cons 'begin - (apply append - (map (lambda (group) - (let ((interface (car group))) - (append (map (lambda (name constructor) - `(define ,name - ,(constructor interface))) - (cadr group) - (list make-options - make-enable - make-disable)) - (map (lambda (name constructor) - `(defmacro ,name - ,@(constructor interface))) - (caddr group) - (list make-set!))))) - names))))))) + (let* ((option-group (cadr exp)) + (interface (car option-group))) + (append (map (lambda (name constructor) + `(define ,name + ,(constructor interface))) + (cadr option-group) + (list make-options + make-enable + make-disable)) + (map (lambda (name constructor) + `(defmacro ,name + ,@(constructor interface))) + (caddr option-group) + (list make-set!))))))))) + +(define-option-interface + (eval-options-interface + (eval-options eval-enable eval-disable) + (eval-set!))) + +(define-option-interface + (debug-options-interface + (debug-options debug-enable debug-disable) + (debug-set!))) + +(define-option-interface + (evaluator-traps-interface + (traps trap-enable trap-disable) + (trap-set!))) + +(define-option-interface + (read-options-interface + (read-options read-enable read-disable) + (read-set!))) + +(define-option-interface + (print-options-interface + (print-options print-enable print-disable) + (print-set!)))