Merge branch 'master' into guile-meta

4 files changed, 174 insertions, 11 deletions

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