summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-10-31 15:53:12 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-10-31 15:53:12 +0100
commitffd0a91a136909c4ed481184073e868ae886e230 (patch)
tree23dcbe372eaeee9c3029315254e41882a8026d42
parent449a5c9a05feed4f743d98172f78b250c6258d7a (diff)
parent9325189d4b3cfa2207c015b4f60cf397089edc9f (diff)
downloadgeiser-chez-ffd0a91a136909c4ed481184073e868ae886e230.tar.gz
geiser-chez-ffd0a91a136909c4ed481184073e868ae886e230.tar.bz2
Merge branch 'master' into guile-meta
-rw-r--r--THANKS9
-rw-r--r--doc/Makefile.am1
-rw-r--r--doc/cheat.texi2
-rw-r--r--doc/geiser.texi11
-rw-r--r--doc/index.texi2
-rw-r--r--doc/thanks.texi35
-rw-r--r--doc/web.texi2
-rw-r--r--elisp/geiser-completion.el5
-rw-r--r--elisp/geiser-edit.el16
-rw-r--r--elisp/geiser-log.el27
-rw-r--r--elisp/geiser-table.el137
-rw-r--r--scheme/guile/geiser/doc.scm13
12 files changed, 230 insertions, 30 deletions
diff --git a/THANKS b/THANKS
index 1f3aa85..1cfd08b 100644
--- a/THANKS
+++ b/THANKS
@@ -2,6 +2,10 @@ Andy Wingo, Geiser's first user, has been a continuous source of
encouragement and suggestions, and keeps improving Guile and heeding
my feature requests.
+The nice thing about collaborating with Andreas Rottmann over all
+these years is that he will not only make your project better with
+insightful comments and prodding: he'll send you patches galore too.
+
Ludovic Courtès, #geiser's citizen no. 1, joined the fun after a
while, and has since then been a continuous source of encouragement,
ideas and bug reports.
@@ -9,7 +13,7 @@ ideas and bug reports.
Eduardo Cavazos' contagious enthusiasm has helped in many ways to keep
Geiser alive, and he's become its best evangelist in R6RS circles.
-Eli Barzilay took the time to play with an early beta and make many
+Eli Barzilay took the time to play with an early alpha and made many
valuable suggestions, besides answering all my 'how do you in PLT'
questions.
@@ -18,4 +22,5 @@ answer my inquiries, but provided almost instant fixes to the few
issues i found.
Thanks also to the PLT and Guile communities, for showing me that
-Geiser was not only possible, but a pleasure to hack on.
+Geiser was not only possible, but a pleasure to hack on. And to the
+Slime hackers, who led the way.
diff --git a/doc/Makefile.am b/doc/Makefile.am
index 26d2a3f..247b03d 100644
--- a/doc/Makefile.am
+++ b/doc/Makefile.am
@@ -21,6 +21,7 @@ geiser_TEXINFOS = \
repl.texi \
fun.texi \
cheat.texi \
+ thanks.texi \
index.texi
output_dir=$(top_builddir)/doc/html
diff --git a/doc/cheat.texi b/doc/cheat.texi
index 92e9136..6087949 100644
--- a/doc/cheat.texi
+++ b/doc/cheat.texi
@@ -1,4 +1,4 @@
-@node Cheat sheet, Index, Fun between the parens, Top
+@node Cheat sheet, No hacker is an island, Fun between the parens, Top
@chapter Cheat sheet
@menu
diff --git a/doc/geiser.texi b/doc/geiser.texi
index d958a01..2e7ef93 100644
--- a/doc/geiser.texi
+++ b/doc/geiser.texi
@@ -52,20 +52,12 @@ The document was typeset with
* The REPL::
* Fun between the parens::
* Cheat sheet::
+* No hacker is an island::
* Index::
@detailmenu
--- The Detailed Node Listing ---
-Geiser
-
-* Introduction::
-* Installation::
-* The REPL::
-* Fun between the parens::
-* Index::
-
-
Introduction
* Modus operandi::
@@ -116,6 +108,7 @@ Cheat sheet
@include repl.texi
@include fun.texi
@include cheat.texi
+@include thanks.texi
@include index.texi
@bye
diff --git a/doc/index.texi b/doc/index.texi
index 68a3040..d1bf9eb 100644
--- a/doc/index.texi
+++ b/doc/index.texi
@@ -1,4 +1,4 @@
-@c This is part of Geiser's user manual., , Cheat sheet, Top
+@c This is part of Geiser's user manual., , No hacker is an island, Top
@c Copyright (C) 2010 Jose Antonio Ortega Ruiz
@c See the file geiser.texi for copying conditions.
diff --git a/doc/thanks.texi b/doc/thanks.texi
new file mode 100644
index 0000000..e6f0203
--- /dev/null
+++ b/doc/thanks.texi
@@ -0,0 +1,35 @@
+@node No hacker is an island, Index, Cheat sheet, Top
+@chapter No hacker is an island
+
+Andy Wingo, Geiser's first user, has been a continuous source of
+encouragement and suggestions, and keeps improving Guile and heeding
+my feature requests.
+
+The nice thing about collaborating with Andreas Rottmann over all
+these years is that he will not only make your project better with
+insightful comments and prodding: he'll send you patches galore too.
+
+Ludovic Courtès, #geiser's citizen no. 1, joined the fun after a
+while, and has since then been a continuous source of encouragement,
+ideas and bug reports.
+
+Eduardo Cavazos' contagious enthusiasm has helped in many ways to keep
+Geiser alive, and he's become its best evangelist in R6RS circles.
+
+Eli Barzilay took the time to play with an early alpha and made many
+valuable suggestions, besides answering all my 'how do you in PLT'
+questions.
+
+Matthew Flatt, Robby Findler and the rest of the PLT team did not only
+answer my inquiries, but provided almost instant fixes to the few
+issues i found.
+
+Thanks also to the PLT and Guile communities, for showing me that
+Geiser was not only possible, but a pleasure to hack on. And to the
+Slime hackers, who led the way.
+
+
+@c Local Variables:
+@c mode: texinfo
+@c TeX-master: "geiser"
+@c End:
diff --git a/doc/web.texi b/doc/web.texi
index b921347..99f5165 100644
--- a/doc/web.texi
+++ b/doc/web.texi
@@ -14,6 +14,7 @@
* The REPL::
* Fun between the parens::
* Cheat sheet::
+* No hacker is an island::
* Index::
@end menu
@@ -35,6 +36,7 @@ list</a>&nbsp;
@include repl.texi
@include fun.texi
@include cheat.texi
+@include thanks.texi
@include index.texi
@bye
diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el
index 5c2f604..d346190 100644
--- a/elisp/geiser-completion.el
+++ b/elisp/geiser-completion.el
@@ -214,6 +214,11 @@ we're looking for a module name.")
(defsubst geiser-completion--symbol-begin (module)
(funcall geiser-completion--symbol-begin-function module))
+(defun geiser-completion--module-at-point ()
+ (save-excursion
+ (goto-char (geiser-completion--symbol-begin t))
+ (ignore-errors (thing-at-point 'sexp))))
+
(defsubst geiser-completion--prefix (module)
(buffer-substring-no-properties (geiser-completion--symbol-begin module)
(point)))
diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el
index e8e439c..4d61edc 100644
--- a/elisp/geiser-edit.el
+++ b/elisp/geiser-edit.el
@@ -205,8 +205,10 @@ With prefix, asks for the symbol to edit."
(geiser-completion--read-symbol "Edit symbol: ")))
(cmd `(:eval (:ge symbol-location ',symbol)))
(marker (point-marker)))
- (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd))
- (when marker (ring-insert find-tag-marker-ring marker))))
+ (condition-case nil
+ (progn (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd))
+ (when marker (ring-insert find-tag-marker-ring marker)))
+ (error (geiser-edit-module-at-point)))))
(defun geiser-pop-symbol-stack ()
"Pop back to where \\[geiser-edit-symbol-at-point] was last invoked."
@@ -221,6 +223,16 @@ With prefix, asks for the symbol to edit."
(let ((cmd `(:eval (:ge module-location '(:module ,module)))))
(geiser-edit--try-edit module (geiser-eval--send/wait cmd) method)))
+
+(defun geiser-edit-module-at-point ()
+ "Opens a new window visiting the module at point."
+ (interactive)
+ (let ((marker (point-marker)))
+ (geiser-edit-module (or (geiser-completion--module-at-point)
+ (geiser-completion--read-module)))
+ (when marker (ring-insert find-tag-marker-ring marker))))
+
+
(provide 'geiser-edit)
;;; geiser-edit.el ends here
diff --git a/elisp/geiser-log.el b/elisp/geiser-log.el
index 150e6f3..d078b19 100644
--- a/elisp/geiser-log.el
+++ b/elisp/geiser-log.el
@@ -1,6 +1,6 @@
;; geiser-log.el -- logging utilities
-;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the Modified BSD License. You should
@@ -28,11 +28,11 @@
(defvar geiser-log--max-buffer-size 32000
"Maximum size of the Geiser messages log.")
-(defvar geiser-log--max-message-size 512
+(defvar geiser-log--max-message-size 2048
"Maximum size of individual Geiser log messages.")
-(defvar geiser-log--verbose-p t
- "Log level for Geiser messages")
+(defvar geiser-log-verbose-p nil
+ "Log purely informational messages. Useful for debugging.")
(defvar geiser-log--inhibit-p nil
"Set this to t to inhibit all log messages")
@@ -61,7 +61,9 @@
(defun geiser-log--msg (type &rest args)
(unless geiser-log--inhibit-p
(geiser-log--with-buffer
- (insert (geiser--shorten-str (format "\n%s: %s\n" type (apply 'format args))
+ (goto-char (point-max))
+ (insert (geiser--shorten-str (format "\n%s: %s\n" type
+ (apply 'format args))
geiser-log--max-message-size)))))
(defsubst geiser-log--warn (&rest args)
@@ -71,17 +73,24 @@
(apply 'geiser-log--msg 'ERROR args))
(defsubst geiser-log--info (&rest args)
- (when geiser-log--verbose-p
+ (when geiser-log-verbose-p
(apply 'geiser-log--msg 'INFO args) ""))
;;; User commands:
-(defun geiser-show-logs ()
- "Show Geiser log messages."
- (interactive)
+(defun geiser-show-logs (&optional arg)
+ "Show Geiser log messages.
+With prefix, activates all logging levels."
+ (interactive "P")
+ (when arg (setq geiser-log-verbose-p t))
(geiser-log--pop-to-buffer))
+(defun geiser-log-clear ()
+ "Clean all logs."
+ (interactive)
+ (geiser-log--with-buffer (delete-region (point-min) (point-max))))
+
(provide 'geiser-log)
;;; geiser-log.el ends here
diff --git a/elisp/geiser-table.el b/elisp/geiser-table.el
new file mode 100644
index 0000000..e4d4f43
--- /dev/null
+++ b/elisp/geiser-table.el
@@ -0,0 +1,137 @@
+;;; geiser-table.el -- table creation
+
+;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Tue Jan 06, 2009 13:44
+
+
+
+(defun geiser-table--col-widths (rows)
+ (let* ((col-no (length (car rows)))
+ (available (- (window-width) 2 (* 2 col-no)))
+ (widths)
+ (c 0))
+ (while (< c col-no)
+ (let ((width 0)
+ (av-width (- available (* 5 (- col-no c)))))
+ (dolist (row rows)
+ (setq width
+ (min av-width
+ (max width (length (nth c row))))))
+ (push width widths)
+ (setq available (- available width)))
+ (setq c (1+ c)))
+ (reverse widths)))
+
+(defun geiser-table--pad-str (str width)
+ (let ((len (length str)))
+ (cond ((= len width) str)
+ ((> len width) (concat (substring str 0 (- width 3)) "..."))
+ (t (concat str (make-string (- width (length str)) ?\ ))))))
+
+(defun geiser-table--str-lines (str width)
+ (if (<= (length str) width)
+ (list (geiser-table--pad-str str width))
+ (with-temp-buffer
+ (let ((fill-column width))
+ (insert str)
+ (fill-region (point-min) (point-max))
+ (mapcar '(lambda (s) (geiser-table--pad-str s width))
+ (split-string (buffer-string) "\n"))))))
+
+(defun geiser-table--pad-row (row)
+ (let* ((max-ln (apply 'max (mapcar 'length row)))
+ (result))
+ (dolist (lines row)
+ (let ((ln (length lines)))
+ (if (= ln max-ln) (push lines result)
+ (let ((lines (reverse lines))
+ (l 0)
+ (blank (make-string (length (car lines)) ?\ )))
+ (while (< l ln)
+ (push blank lines)
+ (setq l (1+ l)))
+ (push (reverse lines) result)))))
+ (reverse result)))
+
+(defun geiser-table--format-rows (rows widths)
+ (let ((col-no (length (car rows)))
+ (frows))
+ (dolist (row rows)
+ (let ((c 0) (frow))
+ (while (< c col-no)
+ (push (geiser-table--str-lines (nth c row) (nth c widths)) frow)
+ (setq c (1+ c)))
+ (push (geiser-table--pad-row (reverse frow)) frows)))
+ (reverse frows)))
+
+(defvar geiser-table-corner-lt "┌")
+(defvar geiser-table-corner-lb "└")
+(defvar geiser-table-corner-rt "┐")
+(defvar geiser-table-corner-rb "┘")
+(defvar geiser-table-line "─")
+(defvar geiser-table-tee-t "┬")
+(defvar geiser-table-tee-b "┴")
+(defvar geiser-table-tee-l "├")
+(defvar geiser-table-tee-r "┤")
+(defvar geiser-table-crux "┼")
+(defvar geiser-table-sep "│")
+
+(defun geiser-table--insert-line (widths first last sep)
+ (insert first geiser-table-line)
+ (dolist (w widths)
+ (while (> w 0)
+ (insert geiser-table-line)
+ (setq w (1- w)))
+ (insert geiser-table-line sep geiser-table-line))
+ (delete-char -2)
+ (insert geiser-table-line last)
+ (newline))
+
+(defun geiser-table--insert-first-line (widths)
+ (geiser-table--insert-line widths
+ geiser-table-corner-lt
+ geiser-table-corner-rt
+ geiser-table-tee-t))
+
+(defun geiser-table--insert-middle-line (widths)
+ (geiser-table--insert-line widths
+ geiser-table-tee-l
+ geiser-table-tee-r
+ geiser-table-crux))
+
+(defun geiser-table--insert-last-line (widths)
+ (geiser-table--insert-line widths
+ geiser-table-corner-lb
+ geiser-table-corner-rb
+ geiser-table-tee-b))
+
+(defun geiser-table--insert-row (r)
+ (let ((ln (length (car r)))
+ (l 0))
+ (while (< l ln)
+ (insert (concat geiser-table-sep " "
+ (mapconcat 'identity
+ (mapcar `(lambda (x) (nth ,l x)) r)
+ (concat " " geiser-table-sep " "))
+ " " geiser-table-sep "\n"))
+ (setq l (1+ l)))))
+
+(defun geiser-table--insert (rows)
+ (let* ((widths (geiser-table--col-widths rows))
+ (rows (geiser-table--format-rows rows widths)))
+ (geiser-table--insert-first-line widths)
+ (dolist (r rows)
+ (geiser-table--insert-row r)
+ (geiser-table--insert-middle-line widths))
+ (kill-line -1)
+ (geiser-table--insert-last-line widths)))
+
+
+(provide 'geiser-table)
+;;; geiser-table.el ends here
diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm
index f5471b5..902f2a3 100644
--- a/scheme/guile/geiser/doc.scm
+++ b/scheme/guile/geiser/doc.scm
@@ -66,16 +66,17 @@
(else 'variable)))
(define (arguments proc)
- (define (p-arguments prog)
- (map (lambda (a) ((@@ (system vm program) arity->arguments-alist) prog a))
- (or (program-arities prog) '())))
+ (define (p-args prog)
+ (let ((as (map (lambda (a)
+ ((@@ (system vm program) arity->arguments-alist) prog a))
+ (or (program-arities prog) '()))))
+ (and (not (null? as)) as)))
(define (clist f) (lambda (x) (let ((y (f x))) (and y (list y)))))
(cond ((is-a? proc <generic>) (generic-args proc))
+ ((doc->args proc) => list)
((procedure-property proc 'arglist) => (clist arglist->args))
((procedure-source proc) => (clist source->args))
- ((doc->args proc) => list)
- ((program? proc) (let ((a (p-arguments proc)))
- (and (not (null? a)) a)))
+ ((and (program? proc) (p-args proc)))
((procedure-property proc 'arity) => (clist arity->args))
(else #f)))