Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Adapt gambdoc to use the new TSV index #698

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Adapt gambdoc to use the new TSV index #698

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
dc2e4f2
Adapt gambdoc to use TSV index
lassik Oct 11, 2021
dda51ac
Start _doc module
lassik Oct 22, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
54 changes: 38 additions & 16 deletions bin/gambdoc.unix.in
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,12 +2,17 @@

# Script parameters are passed in the following environment variables:
# GAMBITDIR_DOC
# GAMBDOC_ARG1_PARAM
# GAMBDOC_ARG2_PARAM
# GAMBDOC_ARG3_PARAM
# GAMBDOC_ARG4_PARAM
# GAMBDOC_ARG1_PARAM -- must be "help"
# GAMBDOC_ARG2_PARAM -- entry
# GAMBDOC_ARG3_PARAM -- index
# GAMBDOC_ARG4_PARAM -- prefer this web browser over the default choices
# ...

# Exit code:
# 0 - entry found and displayed
# 1 - entry not found in index
# >1 - error

# echo GAMBITDIR_DOC = "${GAMBITDIR_DOC}"
# echo GAMBDOC_ARG1_PARAM = "${GAMBDOC_ARG1_PARAM}"
# echo GAMBDOC_ARG2_PARAM = "${GAMBDOC_ARG2_PARAM}"
Expand All @@ -33,39 +38,56 @@ find_browser() # sets `$exe'
browser_list="lynx firefox mozilla netscape osascript chrome chromium chromium-browser"
fi

browser_list="${GAMBDOC_ARG3_PARAM} $browser_list"
browser_list="${GAMBDOC_ARG4_PARAM} $browser_list"

for b in $browser_list; do
if find_in_path $b; then
if find_in_path "$b"; then
browser=$b
return 0
fi
done
return 1
}

operation_help() # sets `$exe'
open_url_osascript()
{
if find_browser; then
url="file://${GAMBITDIR_DOC}/gambit.html#${GAMBDOC_ARG4_PARAM}"
case "$browser" in
osascript ) $exe <<EOF ;;
$exe <<EOF
tell application "Safari"
open location "$url"
end tell
EOF
* ) $exe $url ;;
esac
else
}

open_url()
{
url="$1"
if ! find_browser; then
echo "*** WARNING -- none of these browsers can be found to view the documentation:"
echo "*** $browser_list"
exit 2
fi
case "$browser" in
osascript) open_url_osascript "$url";;
*) $exe "$url";;
esac
}

operation_help() # sets `$exe'
{
entry="$GAMBDOC_ARG2_PARAM"
index="$GAMBDOC_ARG3_PARAM"
pattern="$(echo ";$index;$entry" | tr ';' '\t' | tr -d '\n')"
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't like that this depends on so many things... tr, grep, head, cut... It will be hard to port to another OS (e.g. Windows).

Here's a wild idea (which I think you've had previously)... how about doing that processing in Scheme using the Gambit interpreter, which we know is installed? The only part of the script that is difficult is launching the browser (because the Gambit runtime system may not have a working implementation of open-process).

However there is (##os-shell-command cmd) which uses the C system function in the usual C-based runtime system. See lib/gambit/process/process.scm for details. This can be relied on to work on all operating systems with a shell (even Gambit compiled to Python and JavaScript, but only on top of nodejs, have an implementation of ##os-shell-command).

Come to think of it I may be overly paranoid because gambdoc.bat is itself launched using open-process.

And at that point maybe the whole logic should be encapsulated in a Scheme module. I'm not sure how the "find browser" part would be implemented (and portably). There's still an argument to be made to launch a subprocess so that it doesn't interfere with the running Scheme process too much. On the other hand I think it is more valuable to do everything "in process" to minimize external dependencies (in particular it would be easy to get working with the web REPL that runs in an environment where subprocesses are not available, but opening a new web page is easy).

Would you like to prototype this? Perhaps a Scheme module called _doc or _help that is builtin. The .tsv file could have been preprocessed to be an s-expression. It is best to read the file every time help is called (i.e. not cache the database) so that the heap doesn't bloat permanently.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Would you like to prototype this?

Yes.

Perhaps a Scheme module called _doc or _help that is builtin.

How about (gambit help)?

The .tsv file could have been preprocessed to be an s-expression.

I chose the .tsv format because it's standard (emitted by makeinfo) while still being very simple. All you need to get the data as Scheme vectors is read-line and then string-split on tabs, 5-10 lines of code altogether.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Note: string-split is in SRFI 13 which we'll be implementing anyway, and read-line is in R7RS.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Wait, string-split is not actually in SRFI 13. It's in two of the newer string SRFIs. Might be good to add to (gambit string) in any case.

Here's a complete parser:

(define (string-split string char)
  (let loop ((a 0) (b 0) (fields '()))
    (cond ((= b (string-length string))
           (reverse (cons (substring string a b) fields)))
          ((char=? char (string-ref string b))
           (loop (+ b 1) (+ b 1) (cons (substring string a b) fields)))
          (else
           (loop a (+ b 1) fields)))))

(define (parse-tsv)
  (let loop ((entries '()))
    (let ((line (read-line)))
      (if (eof-object? line)
          (reverse entries)
          (let ((fields (string-split line #\tab)))
            (loop (cons (list->vector fields) entries)))))))

(define (writeln x) (write x) (newline))
(for-each writeln (with-input-from-file "gambit.tsv" parse-tsv))

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The standard way of doing this in Gambit is

(define (string-split str ch)
  (call-with-input-string
    str
    (lambda (port)
      (read-all port (lambda (port) (read-line port ch))))))

With SRFI 13 it is probably faster to do (untested code):

(define (string-split str ch)
  (let loop ((i (string-length str)) (fields '()))
    (let ((j (string-index-right str ch 0 i)))
      (if j
          (loop j (cons (substring str (+ j 1) i) fields))
          (cons (substring str 0 i) fields)))))

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I can work on adding an implementation of string-split.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks. The following each define string-split, seemingly with mutually compatible signatures:

  • SRFI 130: Cursor-based string library
  • SRFI 140: Immutable Strings
  • SRFI 152: String Library (reduced)

tsv_file="${GAMBITDIR_DOC}/gambit.tsv"
where="$(grep -F -- "$pattern" <"$tsv_file" | head -n 1 | cut -f 1)"
if test -z "$where"; then
exit 1
fi
open_url "file://${GAMBITDIR_DOC}/${where}"
}

if [ "${GAMBDOC_ARG1_PARAM}" = "help" ]; then
operation_help
else
echo "*** WARNING -- unsupported operation: ${GAMBDOC_ARG1_PARAM}"
exit 1
echo "*** WARNING -- unsupported operation: \"${GAMBDOC_ARG1_PARAM}\""
exit 2
fi
Empty file added lib/_doc#.scm
View file
Open in desktop
Empty file.
144 changes: 144 additions & 0 deletions lib/_doc.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,144 @@
(define (make-browser name available? open)
(vector name available? open))

(define (browser-name b) (vector-ref b 0))
(define (browser-available? b) ((vector-ref b 1)))
(define (browser-open b url) ((vector-ref b 2) url))

(define (check-exit exit-status)
(or (##fx= exit-status 0)
(##raise-error-exception "failed to start web browser")))

(define (text-browser command)
(make-browser
command
(lambda () (executable? command))
(lambda (url)
(##tty-mode-reset) ;; reset tty (in case subprocess needs to read tty)
(check-exit
(##run-subprocess
command
'() ;; no arguments
#f ;; don't capture output
#f ;; don't redirect stdin
#f ;; run in current directory
(list url))))))

(define (gui-browser command)
(make-browser
command
(lambda () (executable? command))
(lambda (url)
(check-exit
(##run-subprocess
command
'() ;; no arguments
#f ;; don't capture output
#f ;; don't redirect stdin
#f ;; run in current directory
(list url))))))

(define (gui-browser-osascript url)
(let ((command "osascript"))
(make-browser
command
(lambda () (executable? command))
(lambda (url)
(let ((stdin (string-append "tell application \"Safari\"\n"
" open location \"" url "\"\n"
"end tell\n")))
(check-exit
(##run-subprocess
command
'() ;; no arguments
#f ;; don't capture output
stdin ;; don't redirect stdin
#f ;; run in current directory
'())))))))

(define (gui-browser-js url)
(##inline-host-statement "window.open(@scm2host@(@1@));" url))

;;;

(define ##help-browsers
(##make-parameter
(append
(if (equal? "" "@HELP_BROWSER@")
'()
(list (text-browser "@HELP_BROWSER@")))
(list gui-browser-js
(text-browser "lynx")
(gui-browser "firefox")
(gui-browser "mozilla")
(gui-browser "netscape")
gui-browser-osascript
(gui-browser "chrome")
(gui-browser "chromium")
(gui-browser "chromium-browser")))
(lambda (val)
val)))

(define help-browsers
##help-browsers)

(define (help-browse-url url)
(let ((browsers (help-browsers)))
(let loop ((tail browsers))
(if (null? tail)
(begin (display "*** WARNING -- none of these browsers")
(display " can be found to view the documentation:")
(display "*** " (string-join browsers " ")))
(let ((browser (car tail)))
(if (browser-available? browser)
(browser-open browser url)
(loop (cdr tail))))))))

;;;

(define help-root "~~doc/")
(define help-index "gambit.tsv")

(define (tsv-lookup path subject index)
(let ((suffix (string-append "\t" index "\t" subject)))
(call-with-input-file path
(lambda (port)
(let loop ()
(let ((line (read-line port)))
(if (string? line)
(if (##string-suffix=? line suffix)
(let ((fields (##string-split-at-char line #\tab)))
(url-join help-root (car fields)))
(loop))
#f)))))))

(define-prim (##show-help subject index)
(define path-append string-append)
(let* ((tsv-file (path-append help-root help-index))
(relative-url (tsv-lookup tsv-file subject index)))
(if (not relative-url)
(##raise-error-exception "no help found for" (##list subject))
(help-browse-url (path-append help-root relative-url)))))

(define-prim (##show-documentation-of object)
(##show-help (if (##string? object)
object
(##object->string (if (##procedure? object)
(##procedure-name object)
object)))
"fn"))

(define-prim (##default-help object)
(##show-documentation-of object))

(define ##help-hook ##default-help)

(define-prim (##help-hook-set! x)
(set! ##help-hook x))

(define-prim (##help subject)
(##help-hook subject))

(define-prim (help #!optional (subject (macro-absent-obj)))
(macro-force-vars (subject)
(##help (if (##eq? subject (macro-absent-obj)) help subject))))
94 changes: 0 additions & 94 deletions lib/_repl.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4512,100 +4512,6 @@

;;;----------------------------------------------------------------------------

(define ##gambdoc
(lambda args

(define prefix "GAMBDOC_")

(let* ((path
(##path-expand
(##string-append "gambdoc"
##os-bat-extension-string-saved)
(##path-normalize-directory-existing "~~bin")))
(add-vars ;; pass arguments in shell environment variables
(##append
(##shell-var-bindings
(##shell-args-numbered args)
prefix)
(##shell-var-bindings
(##shell-install-dirs '("doc"))
""
""))))

(##tty-mode-reset) ;; reset tty (in case subprocess needs to read tty)

(let ((exit-status
(##run-subprocess
path
'() ;; no arguments
#f ;; don't capture output
#f ;; don't redirect stdin
#f ;; run in current directory
add-vars)))

(if (##fx= exit-status 0)
(##void)
(##raise-error-exception
"failed to display the document"
args))))))

(define (##gambdoc-set! x)
(set! ##gambdoc x))

(define-prim (##escape-link str)
(##apply ##string-append
(##map (lambda (c)
(cond ((##char=? c #\space) "_")
((##char=? c #\#) "%E2%99%AF")
((##char=? c #\%) "%25")
((##char=? c #\*) "%2A")
((##char=? c #\+) "%2B")
((##char=? c #\<) "%3C")
((##char=? c #\>) "%3E")
(else (##string c))))
(##string->list str))))

(define-prim (##show-help prefix subject)
(##gambdoc "help"
subject
(##help-browser)
(##escape-link (##string-append prefix subject))))

(define ##help-browser
(##make-parameter
""
(lambda (val)
(macro-check-string val 1 (##help-browser val)
val))))

(define help-browser
##help-browser)

(define-prim (##show-definition-of subject)
(let ((s
(cond ((##procedure? subject)
(##object->string (##procedure-name subject)))
(else
(##object->string subject)))))
(##show-help "Definition of " s)))

(define-prim (##default-help subject)
(##show-definition-of subject))

(define ##help-hook ##default-help)

(define-prim (##help-hook-set! x)
(set! ##help-hook x))

(define-prim (##help subject)
(##help-hook subject))

(define-prim (help #!optional (subject (macro-absent-obj)))
(macro-force-vars (subject)
(##help (if (##eq? subject (macro-absent-obj)) help subject))))

;;;----------------------------------------------------------------------------

(define-prim (##apropos
#!optional
(substring (macro-absent-obj))
Expand Down