Implement Qt editor context menu mode
ober
a721a18c2ae62e560f4094f9c81a5b199c472d8f
--- a/src/jerboa-emacs/qt/app.ss +++ b/src/jerboa-emacs/qt/app.ss @@ -3,7 +3,8 @@ (export qt-main qt-open-file! qt-do-init! qt-call-with-key-handler-errors - qt-drop-payload-file-paths qt-handle-drop-text!) + qt-drop-payload-file-paths qt-handle-drop-text! + qt-show-context-menu!) (import :std/sugar :std/misc/string @@ -83,6 +84,10 @@ :jerboa-emacs/qt/commands :jerboa-emacs/qt/lsp-client :jerboa-emacs/qt/commands-lsp + (only-in :jerboa-emacs/qt/commands-parity5 + qt-context-menu-action-labels + qt-context-menu-mode-enabled? + qt-run-context-menu-action!) :jerboa-emacs/qt/menubar :jerboa-emacs/ipc :jerboa-emacs/vtscreen @@ -873,6 +878,16 @@ (def *qt-buffer-edit-versions* (make-hash-table)) (def *qt-text-change-listener-editors* (make-hash-table)) (def *qt-mouse-listener-editors* (make-hash-table)) +(def QT_MOUSE_RIGHT 2) + +(def (qt-show-context-menu! app) + "Show the editor context action selector and execute the selected action." + (if (qt-context-menu-mode-enabled?) + (let ((choice (qt-echo-read-with-narrowing + app "Context: " (qt-context-menu-action-labels)))) + (when choice + (qt-run-context-menu-action! app choice))) + (echo-message! (app-state-echo app) "Context menu mode disabled"))) (def (qt-buffer-edit-version buf) "Return BUF's monotonic edit version for debounce checks." @@ -901,7 +916,9 @@ (lambda () (with-key-handler-errors app (let ((button (qt-last-mouse-button))) - (when (or (= button QT_MOUSE_LEFT) (= button QT_MOUSE_MIDDLE)) + (when (or (= button QT_MOUSE_LEFT) + (= button QT_MOUSE_MIDDLE) + (= button QT_MOUSE_RIGHT)) (let* ((fr (app-state-frame app)) (widget (qt-last-mouse-widget)) (x (qt-last-mouse-x)) @@ -916,8 +933,11 @@ (when (and (eq? widget editor) (>= pos 0)) (qt-plain-text-edit-set-cursor-position! editor pos)) (qt-widget-set-focus! editor) - (when (= button QT_MOUSE_MIDDLE) - (execute-command! app 'mouse-yank-primary)) + (cond + ((= button QT_MOUSE_MIDDLE) + (execute-command! app 'mouse-yank-primary)) + ((= button QT_MOUSE_RIGHT) + (qt-show-context-menu! app))) (qt-refresh-after-key! app (app-state-echo app) "mouse-press"))))))))) (def (qt-refresh-after-key! app echo-label origin) (let* ((fr (app-state-frame app)) --- a/src/jerboa-emacs/qt/commands-parity5.ss +++ b/src/jerboa-emacs/qt/commands-parity5.ss @@ -56,6 +56,56 @@ *enriched-mode* *picture-mode*)) ;;;============================================================================ +;;; Editor context menu +;;;============================================================================ + +(def *context-menu-mode* #t) + +(def *context-menu-actions* + '(("Undo" . undo) + ("Redo" . redo) + ("Cut" . kill-region) + ("Copy" . kill-ring-save) + ("Paste" . yank) + ("LSP: Code actions" . lsp-code-actions) + ("LSP: Hover" . lsp-hover) + ("LSP: Go to definition" . lsp-goto-definition) + ("Spell: Check word" . ispell-word) + ("Spell: Correct word" . flyspell-correct-word))) + +(def (qt-context-menu-action-labels) + "Return the labels shown in the editor right-click context menu." + (map car *context-menu-actions*)) + +(def (qt-context-menu-command-for-label label) + "Return the command symbol for LABEL, or #f if LABEL is not a context action." + (let ((pair (find (lambda (item) (string=? (car item) label)) + *context-menu-actions*))) + (and pair (cdr pair)))) + +(def (qt-run-context-menu-action! app label) + "Execute the context-menu action identified by LABEL." + (let ((cmd (qt-context-menu-command-for-label label))) + (if cmd + (execute-command! app cmd) + (echo-message! (app-state-echo app) + (string-append "No context action for: " label))))) + +(def (qt-context-menu-mode-enabled?) + *context-menu-mode*) + +(def (qt-context-menu-mode-set! enabled?) + (set! *context-menu-mode* (if enabled? #t #f))) + +(def (cmd-context-menu-mode app) + "Toggle editor right-click context menu support." + (set! *context-menu-mode* (not *context-menu-mode*)) + (echo-message! (app-state-echo app) + (if *context-menu-mode* + "Context menu mode enabled" + "Context menu mode disabled"))) + +;;;============================================================================ ;;; Menu bar item table ;;;============================================================================ @@ -119,7 +169,6 @@ blink-cursor-mode company-mode compilation-mode - context-menu-mode corfu-mode cursor-intangible-mode display-fill-column-indicator-mode @@ -1499,6 +1548,8 @@ (cons 'dired-delete-marked cmd-dired-delete-marked) (cons 'dirvish cmd-dirvish) (cons 'ediff-show-registry cmd-ediff-show-registry) + (cons 'context-menu-mode cmd-context-menu-mode) + (cons 'toggle-context-menu-mode cmd-context-menu-mode) (cons 'menu-bar-open cmd-menu-bar-open) (cons 'notifications-list cmd-notifications-list)))) --- a/tests/test-qt-part2.ss +++ b/tests/test-qt-part2.ss @@ -32,7 +32,11 @@ (only (jerboa-emacs qt commands-shell) *auto-indent*) (only (jerboa-emacs persist) *recentf-mode* *recent-files* recent-files-add!) - (only (jerboa-emacs qt commands-parity5) schedule-user-timer!) + (only (jerboa-emacs qt commands-parity5) + schedule-user-timer! + qt-context-menu-action-labels + qt-context-menu-mode-enabled? + qt-context-menu-mode-set!) (only (jerboa-emacs async) master-timer-tick!) (jerboa-emacs qt keymap) (jerboa-scintilla constants)) @@ -160,6 +164,19 @@ (qt-handle-drop-text! app "DROP") (check (qt-plain-text-edit-text ed) => "aDROPb"))) +(test-case "group46e context menu mode exposes real actions" + (let-values (((ed w app) (make-qt-test-app "part2-46e"))) + (qt-context-menu-mode-set! #t) + (check (qt-context-menu-mode-enabled?) => #t) + (check (find-command 'context-menu-mode) ? procedure?) + (check (find-command 'toggle-context-menu-mode) ? procedure?) + (check (member "Paste" (qt-context-menu-action-labels)) ? pair?) + (check (member "LSP: Code actions" (qt-context-menu-action-labels)) ? pair?) + (execute-command! app 'context-menu-mode) + (check (qt-context-menu-mode-enabled?) => #f) + (execute-command! app 'toggle-context-menu-mode) + (check (qt-context-menu-mode-enabled?) => #t))) + (test-case "group47 scroll commands page the Scintilla viewport" (let-values (((ed w app) (make-qt-test-app "part2-47"))) (qt-plain-text-edit-set-text! ed (qt-test-lines 80))