;;; hack-help.scm
;;;
;;; TeXmacs procedures to help me learn how to use TeXmacs procedures ;)
;;; 
;;; C-h a - apropos
;;;         Search the current TeXmacs name space for the given
;;;         symbol. Regular expressions may be given.
;;;
;;; S. Edward Dolan <address@hidden>
;;; Wednesday, August 12 2009

(texmacs-module (hack-help)
  (:use (ice-9 format) (ice-9 ls) (ice-9 regex)))

;; I can not figure out how to display a message box informing the user
;; when she gives a malformed regex.
;; It seems the catch code is working correctly.
(tm-define (bad-re-handler . args)
  (:synopsis "Handle malformed regexps obtained from the user.")
   (format #t "~A~%" args))

;; Given a regex, search the active name space (that includes TeXmacs, Guile,
;; and any other lib loaded). All symbols are retrieved with (ls). Matches are
;; collected in a list, then sorted. Enumerated list items are created from
;; this list. Finally, the results are displayed in a new buffer.
;;
;; This is an exercise for me as I'm learning Scheme and TeXmacs at the same
;; time. It's an interesting problem to solve, imo.
;;
;; Emacs `apropos-command' takes a few arguments that could be added. At
;; present a symbol is a symbol is a symbol; No filter for funcs, vars, or
;; even the ability to search only those symbols TeXmacs has defined.
;;
;; I'm currently using the current svn checkout 1.0.72.
;; `.+' return 4351 symbols. TeXmacs handles it with grace. Just a bit of a
;; wait while searching.
(tm-define (apropos-command)
  (:synopsis "Grep all symbols in active name space. Results in Help Buffer.")
  (:mode prevail?)
  (dialogue
   (let ((what (dialogue-ask "Search for Symbol:"))
          (symre #f))
     ;; catch a malformed regex
     (catch
      'regular-expression-syntax
      (lambda ()
        (when (not (string=? what ""))
              (let* ((symre (make-regexp what))
                     (matched-symbol-list
                      (sort (filter (lambda (sym)
                                      (regexp-exec symre
                                                   (symbol->string sym)))
                                    (ls))
                            #'symbol<=?))
                     (list-items
                      (map (lambda (found-sym)
                             `(concat (item) ,(symbol->string found-sym)))
                           matched-symbol-list)))
                (set-help-buffer
                 "Apropos Results"
                 `(document
                   (style "tmdoc")
                   (body
                    (document
                     (tmdoc-title
                      (concat
                      ,(format #f "~D result~:p for: "
                               (length matched-symbol-list))
                      (strong ,what)))
                     (enumerate
                      (document
                       ,@list-items)))) ;(concat (item) "foo")
                   (initial
                    (collection
                     (associate "language" ,(get-output-language)))))))))
      bad-re-handler))))

;; I'm not sure if this is how to bind `C-h a'. It seems to work, though :)
(kbd-wildcards pre
               ("emacs" "C-")               
               ("emacs:prefix-help" "emacs h"))

(kbd-map
 (:mode prevail?)                       ; supersede any other binding?
 ("emacs:prefix-help" "" "Emacs Help prefix command.")
 ("emacs:prefix-help a" (apropos-command)))