[Emacspeak] Patch to enable Vertico support

[Krzysztof Drewniak <krzysdrewniak@xxxxxxxxxxx>]

From 8f4a9734eab42ec4319adf57d63f3710d5b37f95 Mon Sep 17 00:00:00 2001
From: Krzysztof Drewniak <krzysdrewniak@xxxxxxxxxxx>
Date: Mon, 31 May 2021 19:57:16 -0500
Subject: [PATCH] Add my Vertico interface to Emacspeak and update the
 documentation

---
 info/docs.texi            |   6 ++
 lisp/Makefile             |   1 +
 lisp/emacspeak-vertico.el | 114 ++++++++++++++++++++++++++++++++++++++
 lisp/emacspeak.el         |   1 +
 4 files changed, 122 insertions(+)
 create mode 100644 lisp/emacspeak-vertico.el

diff --git a/info/docs.texi b/info/docs.texi
index 07262cb73..ea7fbe04a 100644
--- a/info/docs.texi
+++ b/info/docs.texi
@@ -205,6 +205,7 @@ This chapter documents a total of 1142 commands and 151 options.
 * emacspeak-typo::Speech-enable TYPO.
 * emacspeak-url-template::Create library of URI templates.
 * emacspeak-vdiff::Speech-enable VDIFF.
+* emacspeak-vertico::Speech-enable Vertico
 * emacspeak-view::Speech enable View mode -- Efficient browsing of read-only content.
 * emacspeak-vm::Speech enable VMMail.
 * emacspeak-vterm::Speech-enable VTERM.
@@ -13875,6 +13876,11 @@ Speak VDiff hunk under point.
 @end format
 @end deffn
 
+@node emacspeak-vertico
+@section emacspeak-vertico
+
+This module speech-enables the Vertico completion UI.
+
 @node emacspeak-view
 @section emacspeak-view
 
diff --git a/lisp/Makefile b/lisp/Makefile
index 666ef7227..272336424 100755
--- a/lisp/Makefile
+++ b/lisp/Makefile
@@ -265,6 +265,7 @@ emacspeak-twittering.elc \
 emacspeak-typo.elc \
 emacspeak-url-template.elc \
 emacspeak-vdiff.elc \
+emacspeak-vertico.elc \
 emacspeak-view.elc \
 emacspeak-vm.elc \
 emacspeak-vterm.elc \
diff --git a/lisp/emacspeak-vertico.el b/lisp/emacspeak-vertico.el
new file mode 100644
index 000000000..9b33d8463
--- /dev/null
+++ b/lisp/emacspeak-vertico.el
@@ -0,0 +1,114 @@
+;;; emacspeak-vertico.el --- Speech-enable Vertico  -*- lexical-binding: t; -*-
+;;; Author: Krzysztof Drewniak <krzysdrewniak@xxxxxxxxxxx>
+;;; Description:  Speech-enable Vertico, a modern Emacs completion interface
+;;; Keywords: Emacspeak, Audio Desktop, Vertico, completion
+
+;;{{{  Copyright:
+;;; Copyright (C) 2021 Krzysztof Drewniak <krzysdrewniak@xxxxxxxxxxx>
+;;; All Rights Reserved.
+;;;
+;;; This file is not part of GNU Emacs, but the same permissions apply.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNMARKDOWN FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to
+;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;}}}
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+^L
+;;{{{  introduction
+
+;;; Commentary:
+;;; Vertico is a modern completion UI that uses Emacs's native completion engine
+;;; This module speech-enables Vertico's UI
+
+;;}}}
+;;; Code:
+;;{{{  Required modules
+
+(require 'cl-lib)
+(cl-declaim  (optimize  (safety 0) (speed 3)))
+(require 'emacspeak-preamble)
+
+;;}}}
+;;{{{ Map faces to voices:
+(voice-setup-add-map
+ '((vertico-group-title voice-smoothen)
+   (vertico-group-separator voice-overlay-0)))
+
+;;}}}
+;;{{{ Define bookkeeping variables for UI state
+(defvar-local vertico--emacspeak--prev-candidate nil
+  "Previously spoken candidate")
+
+(defvar-local vertico--emacspeak--prev-index nil
+  "Index of previously spoken candidate")
+
+;;}}}
+;;{{{ Advice interactive commands
+
+(defun vertico--emacspeak--insert-advice (orig-func &rest args)
+  "Read inserted text after tab completion."
+  (let* ((orig-point (point))
+         (ret (apply orig-func args)))
+    (emacspeak-auditory-icon 'complete)
+    (emacspeak-speak-region orig-point (point))
+    ret))
+
+(advice-add 'vertico-insert :around
+            #'vertico--emacspeak--insert-advice)
+
+(defun vertico--emacspeak--exhibit ()
+  "Provide audio display of current compeltion."
+  (let ((new-cand (substring (vertico--candidate)
+                             (if (>= vertico--index 0) vertico--base 0)))
+        (to-speak nil))
+    (unless (equal vertico--emacspeak--prev-candidate new-cand)
+      (push new-cand to-speak)
+      (when (or (equal vertico--index vertico--emacspeak--prev-index)
+                (and (not (equal vertico--index -1))
+                     (equal vertico--emacspeak--prev-index -1)))
+        (push "candidate" to-speak)))
+    (when (and (not (vertico--allow-prompt-selection-p))
+               (equal vertico--emacspeak--prev-candidate nil))
+      (push "first candidate" to-speak))
+    (when to-speak
+      (dtk-speak (mapconcat 'identity to-speak " ")))
+    (setq-local vertico--emacspeak--prev-candidate new-cand
+                vertico--emacspeak--prev-index vertico--index)))
+
+(advice-add 'vertico--exhibit :after #'vertico--emacspeak--exhibit)
+
+(cl-loop for (func icon) in
+         '((vertico-scroll-up scroll)
+           (vertico-scroll-down scroll)
+           (vertico-first large-movement)
+           (vertico-last large-movement)
+           (vertico-next select-object)
+           (vertico-previous select-object)
+           (vertico-exit close-object)
+           (vertico-kill delete-object))
+         do (advice-add
+             func :after
+             (lambda (&rest _args)
+               (emacspeak-auditory-icon icon))
+             '((name . "emacspeak"))))
+;;}}}
+(provide 'emacspeak-vertico)
+;;{{{ end of file
+
+;;; local variables:
+;;; folded-file: t
+;;; end:
+
+;;}}}
diff --git a/lisp/emacspeak.el b/lisp/emacspeak.el
index 2bb662eaf..601775447 100644
--- a/lisp/emacspeak.el
+++ b/lisp/emacspeak.el
@@ -267,6 +267,7 @@ the Emacspeak desktop.")
     ("twittering-mode" emacspeak-twittering)
     ("typo" emacspeak-typo)
     ("vdiff" emacspeak-vdiff)
+    ("vertico" emacspeak-vertico)
     ("view" emacspeak-view)
     ("vm" emacspeak-vm)
     ("vterm" emacspeak-vterm)
-- 
2.27.0

Attachment: OpenPGP_signature.sig
Description: PGP signature