diff options
Diffstat (limited to 'elisp')
| -rw-r--r-- | elisp/geiser-doc.el | 209 |
1 files changed, 185 insertions, 24 deletions
diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el index a7d6eae..4e65b67 100644 --- a/elisp/geiser-doc.el +++ b/elisp/geiser-doc.el @@ -31,6 +31,8 @@ (require 'geiser-custom) (require 'geiser-base) +(require 'button) + ;;; Customization: @@ -45,18 +47,78 @@ 'link geiser-doc "links in documentation buffers") -;;; Documentation buffer: +;;; Documentation browser history: + +(defvar geiser-doc-history-size 50) + +(defun geiser-doc--make-history () + (list nil ; current + (make-ring geiser-doc-history-size) ; previous + (make-ring geiser-doc-history-size))) ; next + +(defsubst geiser-doc--history-current () + (car geiser-doc--history)) + +(defun geiser-doc--history-push (link) + (unless (equal link (car geiser-doc--history)) + (let ((next (geiser-doc--history-next))) + (unless (equal link next) + (when next (geiser-doc--history-previous)) + (ring-insert (nth 1 geiser-doc--history) (car geiser-doc--history)) + (setcar geiser-doc--history link)))) + link) -(geiser-popup--define doc "*Geiser documentation*" fundamental-mode) +(defun geiser-doc--history-next (&optional forget-current) + (when (not (ring-empty-p (nth 2 geiser-doc--history))) + (when (and (car geiser-doc--history) (not forget-current)) + (ring-insert (nth 1 geiser-doc--history) (car geiser-doc--history))) + (setcar geiser-doc--history (ring-remove (nth 2 geiser-doc--history) 0)))) + +(defun geiser-doc--history-previous (&optional forget-current) + (when (not (ring-empty-p (nth 1 geiser-doc--history))) + (when (and (car geiser-doc--history) (not forget-current)) + (ring-insert (nth 2 geiser-doc--history) (car geiser-doc--history))) + (setcar geiser-doc--history (ring-remove (nth 1 geiser-doc--history) 0)))) + +(defvar geiser-doc--history (geiser-doc--make-history)) -;;; Docstrings: +;;; Links -(defun geiser-doc--get-docstring (symbol) - (geiser-eval--send/result `(:eval ((:ge symbol-documentation) ',symbol)))) +(defsubst geiser-doc--make-link (target module) + (list target module)) -(defun geiser-doc--get-module-children (module) - (geiser-eval--send/result `(:eval ((:ge module-children) (quote (:scm ,module)))))) +(defsubst geiser-doc--link-target (link) + (nth 0 link)) + +(defsubst geiser-doc--link-module (link) + (nth 1 link)) + +(defun geiser-doc--follow-link (link) + (let ((target (geiser-doc--link-target link)) + (module (geiser-doc--link-module link))) + (when target + (if (symbolp target) + (geiser-doc-symbol target module) + (geiser-doc-module (format "%s" target)))))) + +(defun geiser-doc--button-action (button) + (let ((link (button-get button 'geiser-link))) + (when link (geiser-doc--follow-link link)))) + +(define-button-type 'geiser-doc--button + 'action 'geiser-doc--button-action + 'face 'geiser-font-lock-doc-link + 'follow-link t) + +(defun geiser-doc--insert-button (target module) + (let ((link (geiser-doc--make-link target module)) + (text (format "%s" target)) + (help (if module (format "%s in module %s" target module) ""))) + (insert-text-button text + :type 'geiser-doc--button + 'geiser-link link + 'help-echo help))) ;;; Auxiliary functions: @@ -67,51 +129,150 @@ (put-text-property p (point) 'face 'geiser-font-lock-doc-title)) (newline)) -(defun geiser-doc--insert-list (title lst) +(defun geiser-doc--insert-list (title lst module) (when lst (geiser-doc--insert-title title) (newline) (dolist (w lst) - (insert (format "\t- %s\n" w))) + (insert (format "\t- ")) + (geiser-doc--insert-button w module) + (newline)) (newline))) +(make-local-variable + (defvar geiser-doc--buffer-link nil)) + ;;; Commands: +(defun geiser-doc--get-docstring (symbol module) + (geiser-eval--send/result `(:eval ((:ge symbol-documentation) ',symbol) ,module))) + +(defun geiser-doc--get-module-children (module) + (geiser-eval--send/result `(:eval ((:ge module-children) (quote (:scm ,module)))))) + +(defun geiser-doc-symbol (symbol &optional module) + (let* ((module (or module + (geiser-syntax--buffer-module))) + (ds (geiser-doc--get-docstring symbol module))) + (if (or (not ds) (not (listp ds))) + (message "No documentation available for '%s'" symbol) + (geiser-doc--with-buffer + (erase-buffer) + (geiser-doc--insert-title (cdr (assoc 'signature ds))) + (newline) + (insert (or (cdr (assoc 'docstring ds)) "")) + (goto-line (point-min))) + (setq geiser-doc--buffer-link + (geiser-doc--history-push (geiser-doc--make-link symbol module))) + (geiser-doc--pop-to-buffer)))) + (defun geiser-doc-symbol-at-point (&optional arg) "Get docstring for symbol at point. With prefix argument, ask for symbol (with completion)." (interactive "P") (let ((symbol (or (and (not arg) (symbol-at-point)) (geiser-completion--read-symbol "Symbol: " (symbol-at-point))))) - (when symbol - (let ((ds (geiser-doc--get-docstring symbol))) - (if (or (not ds) (not (listp ds))) - (message "No documentation available for '%s'" symbol) - (geiser-doc--with-buffer - (erase-buffer) - (geiser-doc--insert-title (cdr (assoc 'signature ds))) - (newline) - (insert (or (cdr (assoc 'docstring ds)) "")) - (goto-line (point-min))) - (geiser-doc--pop-to-buffer)))))) + (when symbol (geiser-doc-symbol symbol)))) + (defun geiser-doc-module (module) "Display information about a given module." (interactive (list (geiser-completion--read-module))) - (let ((children (geiser-doc--get-module-children module))) + (let ((children (geiser-doc--get-module-children module)) + (mod-sym (car (read-from-string module)))) (if (not children) (message "No info available for %s" module) (geiser-doc--with-buffer (erase-buffer) (geiser-doc--insert-title (format "%s" module)) (newline) - (geiser-doc--insert-list "Procedures:" (cdr (assoc 'procs children))) - (geiser-doc--insert-list "Variables:" (cdr (assoc 'vars children))) - (geiser-doc--insert-list "Submodules:" (cdr (assoc 'modules children))) + (geiser-doc--insert-list "Procedures:" + (cdr (assoc 'procs children)) + mod-sym) + (geiser-doc--insert-list "Variables:" + (cdr (assoc 'vars children)) + mod-sym) + (geiser-doc--insert-list "Submodules:" + (cdr (assoc 'modules children)) + mod-sym) (goto-char (point-min))) + (setq geiser-doc--buffer-link + (geiser-doc--history-push (geiser-doc--make-link (car (read-from-string module)) + nil))) (geiser-doc--pop-to-buffer)))) +(defun geiser-doc-next (&optional forget-current) + "Go to next page in documentation browser. +With prefix, the current page is deleted from history." + (interactive "P") + (let ((link (geiser-doc--history-next forget-current))) + (unless link (error "No next page")) + (geiser-doc--follow-link link))) + +(defun geiser-doc-previous (&optional forget-current) + "Go to previous page in documentation browser. +With prefix, the current page is deleted from history." + (interactive "P") + (let ((link (geiser-doc--history-previous forget-current))) + (unless link (error "No previous page")) + (geiser-doc--follow-link link))) + +(defun geiser-doc-kill-page () + "Kill current page if a previous or next one exists." + (interactive) + (condition-case nil + (geiser-doc-previous t) + (error (geiser-doc-next t)))) + +(defun geiser-doc-refresh () + "Refresh the contents of current page." + (interactive) + (when geiser-doc--buffer-link + (geiser-doc--follow-link geiser-doc--buffer-link))) + +(defun geiser-doc-clean-history () + "Clean up the document browser history." + (interactive) + (when (y-or-n-p "Clean browsing history? ") + (setq geiser-doc--history (geiser-doc--make-history)) + (geiser-doc-refresh)) + (message "")) + + +;;; Documentation browser and mode: + +(defvar geiser-doc-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (set-keymap-parent map button-buffer-map) + (define-key map "a" 'geiser-apropos) + (define-key map "c" 'geiser-doc-clean-history) + (define-key map "k" 'geiser-doc-kill-page) + (define-key map "n" 'geiser-doc-next) + (define-key map "l" 'geiser-doc-previous) + (define-key map "p" 'geiser-doc-previous) + (define-key map "r" 'geiser-doc-refresh) + (define-key map (kbd "SPC") 'scroll-up) + (define-key map (kbd "S-SPC") 'scroll-down) + (define-key map "\M-." 'geiser-edit-symbol-at-point) + (define-key map "\C-cz" 'run-guile) + (define-key map "\C-c\C-z" 'run-guile) + map)) + +(defun geiser-doc-mode () + "Major mode for browsing scheme documentation. +\\{geiser-doc-mode-map}" + (interactive) + (kill-all-local-variables) + (buffer-disable-undo) + (use-local-map geiser-doc-mode-map) + (set-syntax-table scheme-mode-syntax-table) + (setq mode-name "Geiser Doc") + (setq major-mode 'geiser-doc-mode) + (setq buffer-read-only t)) + +(geiser-popup--define doc "*Geiser documentation*" geiser-doc-mode) (provide 'geiser-doc) |