diff --git a/extensions/emacs-help-mode/lem-emacs-help-mode.asd b/extensions/emacs-help-mode/lem-emacs-help-mode.asd new file mode 100644 index 000000000..662fb153a --- /dev/null +++ b/extensions/emacs-help-mode/lem-emacs-help-mode.asd @@ -0,0 +1,10 @@ +(in-package #:asdf-user) + +(defsystem "lem-emacs-help-mode" + :description "Emacs Style Help Keybindings for Lem" + :author "Robert Wess Burnett" + :license "MIT" + :depends-on ("lem/core") + :serial t + :components ((:file "main"))) + diff --git a/extensions/emacs-help-mode/main.lisp b/extensions/emacs-help-mode/main.lisp new file mode 100644 index 000000000..5555fc5c4 --- /dev/null +++ b/extensions/emacs-help-mode/main.lisp @@ -0,0 +1,39 @@ +(defpackage #:lem-emacs-help-mode + (:use #:cl #:lem)) +(in-package #:lem-emacs-help-mode) + +(defvar *emacs-help-mode-keymap* (make-keymap)) +(defvar *ctrl-h-keymap* (make-keymap)) +(defvar *previous-describe-output-override* nil) + +(define-key *ctrl-h-keymap* "k" 'describe-key) +(define-key *ctrl-h-keymap* "b" 'describe-bindings) +(define-key *ctrl-h-keymap* "m" 'describe-mode) +(define-key *ctrl-h-keymap* "a" 'apropos-command) +(define-key *ctrl-h-keymap* "v" 'apropos-variable) +;; TODO add describe-function command for "f" + +(define-key *emacs-help-mode-keymap* "C-h" *ctrl-h-keymap*) + +(defun enable () + "Enables emacs help mode" + + ;; TODO, figure out a more functional way to overwrite this + ;; variable which does not cause mutable global state + (setf *previous-describe-output-override* + lem-core/commands/help:*describe-output-type-override*) + (setf lem-core/commands/help:*describe-output-type-override* :buffer)) + +(defun disable () + "Disables emacs help mode" + (setf lem-core/commands/help:*describe-output-type-override* + *previous-describe-output-override*) + (setf *previous-describe-output-override* nil)) + +(define-minor-mode emacs-help-mode + (:name "EHelp" + :description "Adds Emacs Style C-h Bindings." + :global t + :keymap *emacs-help-mode-keymap* + :enable-hook 'enable + :disable-hook 'disable)) diff --git a/lem.asd b/lem.asd index a5193742d..f42bb5fcb 100644 --- a/lem.asd +++ b/lem.asd @@ -304,6 +304,7 @@ "lem-tree-sitter" "lem-git-gutter" "lem-skk-mode" + "lem-emacs-help-mode" "lem-display-time-mode")) (defsystem "lem" diff --git a/src/commands/help.lisp b/src/commands/help.lisp index e67b41cad..d44cd482f 100644 --- a/src/commands/help.lisp +++ b/src/commands/help.lisp @@ -4,23 +4,70 @@ :describe-bindings :describe-mode :apropos-command + :describe-command + :describe-variable :lem-version - :list-modes) + :list-modes + :describe-all-modes + :*describe-output-type-override*) #+sbcl (:lock t)) (in-package :lem-core/commands/help) (define-key *global-keymap* "C-x ?" 'describe-key) +(declaim (type (member nil :buffer :popup :message) + *describe-output-type-override*)) +(defvar *describe-output-type-override* nil + "When non nil, describe commands will always + send their information to this type of output. + Acceptable values: (nil :buffer :popup :message) ") + +(defun call-with-describe-output-stream (requested-output-type buffer-name function) + (let ((chosen-output-type (or *describe-output-type-override* requested-output-type))) + (case chosen-output-type + ((:message) + (let ((stream (make-string-output-stream))) + (unwind-protect + (funcall function stream) + (show-message (get-output-stream-string stream))))) + ((:popup) + (with-pop-up-typeout-window (stream (make-buffer buffer-name) :erase t) + (funcall function stream))) + ((:buffer) + (let ((stream (make-string-output-stream))) + (unwind-protect + (funcall function stream) + (let ((output-buffer (make-buffer buffer-name))) + (erase-buffer output-buffer) + (insert-string (buffer-point output-buffer) (get-output-stream-string stream)) + (pop-to-buffer output-buffer))))) + (otherwise + (editor-error "Invalid describe-output-type: ~a" chosen-output-type))))) + +(defmacro with-describe-output-stream + ((var requested-output-type &optional (buffer-name "*Description*")) + &body body) + "Executes body in a lexical context where a documentation output stream called + 'var' has been established. The documentation output stream type will be either + a :message, a :popup, or a :buffer. If *describe-output-type-override* is set, + then its value will override the requested-output-type, allowing the user to, + for example, always output documentation descriptions to a full buffer, rather + then just a temporary message or popup" + `(call-with-describe-output-stream ,requested-output-type ,buffer-name + (lambda (,var) + ,@body))) + (define-command describe-key () () "Tell what is the command associated to a keybinding." (show-message "describe-key: ") (redraw-display) (let* ((kseq (read-key-sequence)) (cmd (find-keybind kseq))) - (show-message (format nil "describe-key: ~a ~(~a~)" - (keyseq-to-string kseq) - cmd)))) + (with-describe-output-stream (s :message) + (format s "describe-key: ~a ~(~a~)" + (keyseq-to-string kseq) + cmd)))) (defun describe-bindings-internal (s name keymap &optional first-p) (unless first-p @@ -45,7 +92,7 @@ "Describe the bindings of the buffer's current major mode." (let ((buffer (current-buffer)) (firstp t)) - (with-pop-up-typeout-window (s (make-buffer "*bindings*") :erase t) + (with-describe-output-stream (s :popup "*bindings*") (describe-bindings-internal s (mode-name (buffer-major-mode buffer)) (setf firstp (mode-keymap (buffer-major-mode buffer))) @@ -65,7 +112,7 @@ (define-command list-modes () () "Output all available major and minor modes." - (with-pop-up-typeout-window (s (make-buffer "*all-modes*") :erase t) + (with-describe-output-stream (s :popup "*all-modes*") (let ((major-modes (major-modes)) (minor-modes (minor-modes))) (labels ((is-technical-mode (mode) @@ -84,6 +131,10 @@ (print-modes "Major modes" major-modes) (print-modes "Minor modes" minor-modes))))) +(define-command describe-all-modes () () + "Alias for list-modes" + (call-command 'list-modes nil)) + (define-command describe-mode () () "Show information about current major mode and enabled minor modes." (let* ((buffer (current-buffer)) @@ -93,7 +144,7 @@ :when (and (mode-active-p buffer mode) (not (find mode minor-modes))) :collect mode))) - (with-pop-up-typeout-window (s (make-buffer "*modes*") :erase t) + (with-describe-output-stream (s :popup "*modes*") (format s "Major mode is: ~A~@[ – ~A~]~%" (mode-name major-mode) (mode-description major-mode)) @@ -111,24 +162,80 @@ (mode-description mode))))))) (define-command apropos-command () () - "Find all symbols in the running Lisp image whose names match a given string." + "Find all commands in the running Lisp image whose names match a given string." (let ((str (prompt-for-string "Apropos: " :completion-function (lambda (str) (completion str (all-command-names)))))) - (with-pop-up-typeout-window (out (make-buffer "*Apropos*") :erase t) + (with-describe-output-stream (out :popup "*Apropos*") (dolist (name (all-command-names)) (when (search str name) (describe (command-name (find-command name)) out)))))) +(define-command describe-command () () + "Alias for apropos-command" + (call-command 'apropos-command nil)) + +(defun lem-symbol-p (symbol) + (let* ((pkg (symbol-package symbol)) + (name (package-name pkg))) + (string-equal "LEM" (subseq name 0 3)))) + +(defun lem-variable-p (symbol) + "Returns true if the symbol is a lem variable or an editor variable" + (or (lem/common/var:editor-variable-p (get symbol 'editor-variable)) + (and (lem-symbol-p symbol) + (boundp symbol) + (not (constantp symbol))))) + +(defun list-all-lem-variables () + "Returns a list of all strings that represent lem variables" + (loop + :for pkg :in (list-all-packages) + :appending + (loop + :for sym :being :the external-symbols :of (find-package pkg) + :when (lem-variable-p sym) + :collect (string-downcase + (format nil "~a:~a" + (package-name (find-package pkg)) + (symbol-name sym)))) + :into syms + :finally (return syms))) + + + +(define-command describe-variable () () + "Describe a lem variable who's name matches a given string." + (let* ((all-lem-variables (list-all-lem-variables)) + (str (prompt-for-string + "Enter Variable: " + :completion-function + (lambda (str) (completion str all-lem-variables))))) + (with-describe-output-stream (out :popup "*variable-description*") + ;; TODO get a better description than just describe + (let* ((sym (read-from-string str)) + (editor-variable (get sym 'editor-variable))) + (cond + ((lem/common/var:editor-variable-p editor-variable) + (format + out + "~a is an EDITOR VARIABLE bound to the following value: ~%~%" sym) + (describe editor-variable out)) + ((lem-variable-p sym) + (describe sym out)) + (t + (format out "~a does not describe any variable" sym))))))) + (define-command lem-version () () "Display Lem's version." (let ((version (get-version-string))) - (show-message (princ-to-string version)))) + (with-describe-output-stream (s :message "*Version*") + (format s "~a" version)))) (define-command help () () "Show some help." - (with-pop-up-typeout-window (s (make-buffer "*Help*") :erase t) + (with-describe-output-stream (s :popup "*Help*") (format s "Welcome to Lem.~&") (format s "You are running ~a.~&" (get-version-string)) (format s "~%") diff --git a/src/common/var.lisp b/src/common/var.lisp index a237f3a3c..e9a0932fe 100644 --- a/src/common/var.lisp +++ b/src/common/var.lisp @@ -11,6 +11,7 @@ :variable-documentation :find-editor-variable :editor-variables + :editor-variable-p :with-global-variable-value)) (in-package :lem/common/var) diff --git a/src/keymap.lisp b/src/keymap.lisp index 0e16e2706..647712e54 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -639,4 +639,5 @@ for KEYMAP, populating and reusing the keymap's binding-cache slot." (defmacro with-special-keymap ((keymap) &body body) `(let ((*special-keymap* (or ,keymap *special-keymap*))) - ,@body)) \ No newline at end of file + ,@body)) +