From d9e03e068d621cd8252ec15765d058be3ccd5f9d Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Wed, 24 Nov 2010 02:14:11 +0100
Subject: Guile: button for texinfo lookup in doc browser

---
 elisp/geiser-doc.el   | 13 +++++++++----
 elisp/geiser-guile.el | 28 +++++++++++++++++++++++++++-
 2 files changed, 36 insertions(+), 5 deletions(-)

diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el
index f1f0aa0..eec0577 100644
--- a/elisp/geiser-doc.el
+++ b/elisp/geiser-doc.el
@@ -170,9 +170,12 @@ help (e.g. browse an HTML page) implementing this method.")
   'follow-link t)
 
 (defun geiser-doc--insert-xbutton (&optional manual)
-  (insert-text-button (if manual "[manual]" "[source]")
+  (let ((label (if manual "[manual]" "[source]"))
+        (help (if manual "Look up in Scheme manual" "Go to definition")))
+  (insert-text-button label
                       :type 'geiser-doc--xbutton
-                      'x-kind (if manual 'manual 'source)))
+                      'help-echo help
+                      'x-kind (if manual 'manual 'source))))
 
 (defun geiser-doc--insert-xbuttons (impl)
   (when (geiser-impl--method 'external-help impl)
@@ -230,15 +233,17 @@ help (e.g. browse an HTML page) implementing this method.")
                         (or nxt 0)))))
     (when (or prev nxt)
       (insert (make-string len ?\ )))
-    (when (geiser-doc--history-previous-p)
+    (when prev
       (insert-text-button "[back]"
                           'action '(lambda (b) (geiser-doc-previous))
+                          'help-echo "Previous help item"
                           'face 'geiser-font-lock-doc-button
                           'follow-link t)
       (insert " "))
-    (when (geiser-doc--history-next-p)
+    (when nxt
       (insert-text-button "[forward]"
                           'action '(lambda (b) (geiser-doc-next))
+                          'help-echo "Next help item"
                           'face 'geiser-font-lock-doc-button
                           'follow-link t))))
 
diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el
index 35548f3..fe32acd 100644
--- a/elisp/geiser-guile.el
+++ b/elisp/geiser-guile.el
@@ -20,6 +20,7 @@
 (require 'geiser)
 
 (require 'compile)
+(require 'info-look)
 
 
 ;;; Customization:
@@ -92,6 +93,11 @@ effect on new REPLs. For existing ones, use the command
   :type '(repeat string)
   :group 'geiser-guile)
 
+(geiser-custom--defcustom geiser-guile-manual-lookup-other-window-p nil
+  "Non-nil means pop up the Info buffer in another window."
+  :type 'boolean
+  :group 'geiser-guile)
+
 
 ;;; REPL support:
 
@@ -278,6 +284,26 @@ it spawn a server thread."
   (geiser-repl--send-silent ",use (geiser emacs)")
   (geiser-guile-update-warning-level))
 
+
+;;; Manual lookup
+(info-lookup-add-help :topic 'symbol :mode 'geiser-guile-mode
+                      :ignore-case nil
+                      :regexp "[^()`',\" 	\n]+"
+                      :doc-spec
+                      '(("(r5rs)Index" nil "^[ 	]+-+ [^:]+:[ 	]*" "\\b")
+                        ("(Guile)R5RS Index" nil "^ - [^:]+: " "\\b")
+                        ("(Guile)Procedure Index" nil "^ - [^:]+: " "\\b")
+                        ("(Guile)Variable Index" nil "^ - [^:]+: " "\\b")))
+
+(defun guile--manual-look-up (id mod)
+  (let ((info-lookup-other-window-flag
+         geiser-guile-manual-lookup-other-window-p))
+    (info-lookup-symbol id 'geiser-guile-mode))
+  (when geiser-guile-manual-lookup-other-window-p
+    (switch-to-buffer-other-window "*info*"))
+  (search-forward (format "%s" id) nil t))
+
+
 
 ;;; Implementation definition:
 
@@ -295,7 +321,7 @@ it spawn a server thread."
   (import-command geiser-guile--import-command)
   (find-symbol-begin geiser-guile--symbol-begin)
   (display-error geiser-guile--display-error)
-  (display-help)
+  (external-help guile--manual-look-up)
   (check-buffer geiser-guile--guess)
   (keywords geiser-guile--keywords))
 
-- 
cgit v1.2.3