Command Map's

eloud-command-map.el

@@ -0,0 +1,186 @@
+;; ;; NOTE: Before eloud-command-map can manage function advice and hook functions,
+;; it is best for the advised functions and hook definitions to be loaded.
+;; Therefore eloud.el should probably be loaded toward the end of the user's .emacs file so that
+;; yet to be made definitions for advised functions do not cause warnings at eloud
+;; ;; load time and so that typos in hook/advice maps can be reported..
+
+;; Managment of hooks and adviced functions.  Provides definition and
+;; undefinition of groups of hook functions and/or advise functions
+;; that can be dynamically activated and deactivated.  For instance a
+;; set of hook and advice functions may be defined as a global group
+;; which cand be activated at emacs start-up time when eloud is
+;; loaded.  Other groups can be defined and activated via e.g., hook
+;; functions (standard or eloud managed), by advice added by the
+;; globals or through user-defined functions bound to keys, etc..
+
+(defvar eloud-command-map-warning-type '(eloud command-map))
+
+(defun eloud-cm-make-q-map-name (map-name qualifier)
+  ;;(assert (or (eq qualifier :hook) (eq qualifier :advice)))
+  (intern (format "$eloud-%s-%s-map"
+                  (symbol-name map-name)
+                  (intern (substring (symbol-name qualifier) 1)))))
+
+;; NB: ADVICE-TYPE is not a parameter, since emacs doesn't allow the
+;; same function to advise a function in multiple ways.
+;; This is sensible :)
+(defun eloud-cm-find-advice (map advisee advisor)
+  (let (ret)
+    (dolist (ent map)
+      (let ((visee (car ent))
+            (visor (cadr ent)))
+        (when (and (eq advisee visee) (eq advisor visor))
+         (push ent ret))))
+    ret))
+
+(defun eloud-cm-find-hook (map hook function)
+  (let ((foundp nil)
+        (p map))
+    (while (and p (not foundp))
+      (let* ((ent (car p))
+             (h-nm (car ent))
+             (f-nm (cadr ent)))
+        (cond
+         ((and (eq h-nm hook)
+           (eq f-nm function))
+          (setq foundp t))
+         (t
+          (setq p (cdr map))))))
+    (when foundp
+      (car p))))
+
+(defun eloud-cm-validate-hook (hook)
+  (when (not (symbolp hook))
+    (display-warning eloud-command-map-warning-type "eloud can not use non-symbol %S as hook, ignoring." hook)))
+
+(defun eloud-cm-validate-function (fxn)
+  (when (not (functionp fxn))
+    (display-warning eloud-command-map-warning-type "eloud can not advise non-existant function, %S, ignoring." fxn)))
+
+(defun eloud-cm-activate-hook (hook hook-function depth local)
+  (add-hook hook hook-function depth local))
+
+(defun eloud-cm-deactivate-hook (hook hook-function local)
+  (remove-hook hook hook-function local))
+
+(defun eloud-cm-activate-advice (advisee advisor advice-type)
+  (advice-add advisee advice-type advisor))
+
+(defun eloud-cm-deactivate-advice (advisee advisor advice-type)
+  (advice-remove advisee advisor))
+
+(defvar eloud-command-map-map-names '()
+  "List of currently defined map names (symbols).")
+;;(setq eloud-command-map-map-names '())
+
+(defmacro define-eloud-command-map (map-name)
+  "Initialize a new, empty, 'command map', referenced by
+MAP-NAME, an unevaluated symbol.
+
+A command map abstracts both hook definitions and advice
+definitions and manages hook and advice 'activation'.  It
+provides a store for hook and advice definitions, a namespace and
+dynamic scoping for installing and removing hook functions as well as
+for adding and removing function advice."
+  `(cond
+    ((member ',map-name eloud-command-map-map-names)
+     (error "eloud command map %S is already defined." ',map-name))
+    (t
+     (message "Defining new eloud command map '%S', existing command maps are: %S ." ',map-name eloud-command-map-map-names)
+     (push ',map-name eloud-command-map-map-names)
+     ;; Internally, we maintain separate maps for hooks and advice, while the API
+     ;; does it's best to keep from exposing that to the user.
+     (defvar ,(eloud-cm-make-q-map-name map-name :hook) '())
+     (defvar ,(eloud-cm-make-q-map-name map-name :advice) '()))))
+
+(defmacro undefine-eloud-command-map (map-name)
+  "Remove all side effects resulting from definition of MAP-NAME."
+  `(cond
+    ((not (member ',map-name eloud-command-map-map-names))
+     (error "eloud map name %S is not defined, so can not undefine it." ',map-name))
+    (t
+     ;; FIXME: some kind of expansion problme with this!
+     ;;(eloud-command-map-deactivate ',map-name)
+     (setq eloud-command-map-map-names
+           (delete ',map-name eloud-command-map-map-names))
+     (makunbound ',(eloud-cm-make-q-map-name map-name :hook))
+     (makunbound ',(eloud-cm-make-q-map-name map-name :advice)))))
+
+(defmacro eloud-command-map-length (map-name)
+  `(+ (length ,(eloud-cm-make-q-map-name map-name :advice))
+      (length ,(eloud-cm-make-q-map-name map-name :hook))))
+
+(defmacro define-eloud-command-map-advice (map-name advisee advisor advice-type)
+  ;; NB: We wait to error check until runtime, but we can almost certainly do this at read time.
+  `(progn
+     ;;(eloud-cm-validate-function ,advisee)
+     ;;(eloud-cm-validate-function ,advisor")
+     (eloud-cm-activate-advice ,advisee ,advisor ,advice-type)
+     (setq ,(eloud-cm-make-q-map-name map-name :advice)
+           (push (list ,advisee ,advisor ,advice-type) ,(eloud-cm-make-q-map-name map-name :advice)))))
+
+(defmacro undefine-eloud-command-map-advice (map-name advisee advisor &optional advice-type)
+  `(progn
+     (eloud-cm-validate-function ',advisee)
+     (eloud-cm-validate-function ',advisor)
+     (let ((ents (eloud-cm-find-advice ,(eloud-cm-make-q-map-name map-name :advice) ,advisee ,advisor)))
+       (cond
+        (ents
+         (unwind-protect
+             (dolist (ent ents)
+               (setq ,(eloud-cm-make-q-map-name map-name :advice)
+                     (delete ent ,(eloud-cm-make-q-map-name map-name :advice)))
+               (eloud-cm-deactivate-advice ,advisee ,advisor (or ,advice-type :around)))))
+        (t (display-warning eloud-command-map-warning-type "eloud did not find advice in map %S, ignoring." ',map-name))))))
+
+(defmacro define-eloud-command-map-hook (map-name hook hook-function &optional depth local)
+  `(progn
+     ;;(eloud-cm-validate-hook ',hook)
+     ;;(eloud-cm-validate-function ',hook-function)
+     ;; NB:  We don't check for hook-function already on hook (using EQ), because
+     ;; ADD-HOOK silently ignores adding duplicates and we already check our own map anyway.
+     (push (list ,hook ,hook-function ,depth ,local) ,(eloud-cm-make-q-map-name map-name :hook))
+     (eloud-cm-activate-hook ,hook ,hook-function ,depth ,local)))
+
+(defmacro undefine-eloud-command-map-hook (map-name hook-var hook-function &optional local)
+  `(progn
+     (eloud-cm-validate-hook ',hook-var)
+     (eloud-cm-validate-function ',hook-function)
+     (let ((ent (eloud-cm-find-hook ,(eloud-cm-make-q-map-name map-name :hook) ,hook-var ,hook-function)))
+       (cond
+        (ent
+         (unwind-protect
+             (setq ,(eloud-cm-make-q-map-name map-name :hook)
+                   (delete ent ,(eloud-cm-make-q-map-name map-name :hook)))
+             (eloud-cm-deactivate-hook ,hook-var ,hook-function ,local)))
+        (t
+         (warn "eloud: not found in ,map-name %S." ',map-name))))))
+
+(defmacro eloud-command-map-activate (map-name)
+  `(progn
+     (message "eloud activating command map '%S'" ',map-name)
+     (mapcar #'(lambda (x)
+                 (eloud-cm-activate-hook (car x) (cdr x) nil nil))
+             ,(eloud-cm-make-q-map-name map-name :hook))
+     (mapcar #'(lambda (x)
+                 (eloud-cm-activate-advice (car x) (cadr x) :around))
+             ,(eloud-cm-make-q-map-name map-name :advice))))
+
+(defmacro eloud-command-map-deactivate (map-name)
+  `(progn
+     (message "eloud deactivating command map '%S'" ',map-name)
+     (mapcar (lambda (x)
+               (cond
+                  ((= (length x) 3)
+                   (eloud-cm-deactivate-advice (car x) (cadr x) (caddr x)))
+                  (t
+                   (error "BUG:  Assertion that advice map entry is of length 3 failed, got %S" x))))
+             ,(eloud-cm-make-q-map-name map-name :advice))
+     (mapcar #'(lambda (x)
+                 (eloud-cm-deactivate-hook (car x) (cdr x) nil))
+             ,(eloud-cm-make-q-map-name map-name :hook))))
+
+(provide 'eloud-command-map)
+
+;; eloud-command-map.el ends here
+

eloud.el

@@ -66,6 +66,9 @@
 ;;; Code:
 
 
+(require 'eloud-command-map)
+
+
 (defgroup eloud nil
   "Customization group for the Eloud screen reader package."
   :group 'multimedia)
@@ -121,14 +124,22 @@
 
 ;;; Main speech function
 
-(defun eloud-speak (string &optional speed no-kill &rest args)
-  "Pass STRING to the espeak asynchronous process.  Use the `eloud-speech-rate' variable if no optional integer SPEED is specified.  If NO-KILL argument non-nil, running speech processes are killed before starting new speech process.  Pass additional arguments to espeak as rest ARGS."
+(defun eloud-speak (string &optional speed no-kill allow-idle &rest args)
+  "Pass STRING to a new espeak asynchronous process.  Use the
+`eloud-speech-rate' variable if no optional integer SPEED is
+specified.  If the NO-KILL argument is non-nil, running speech
+processes are killed before starting a new speech process.  If
+ALLOW-IDLE is non-nil, bypass idle time check so that a new
+speech process is attempted regardless of current emacs idle
+time.  Pass additional command line arguments to the new espeak
+process as rest ARGS."
   ;; Defines a function that runs process on list of arguments.
   ;; Defines sensible defaults.
   ;; Run with defaults if no additional args specified in function call, else append additional arguments and run
   (let* ((string (if (equal string "") " " string))
-	 (default-args `("eloud-speaking" nil ,eloud-espeak-path ,(if (eloud-hyphen-start-p string) (concat " " string) string) "-v" ,eloud-voice "-s" ,(if speed (number-to-string speed) (number-to-string eloud-speech-rate)))))
-    (if (not (current-idle-time))
+	 (default-args `("eloud-speaking" nil ,eloud-espeak-path ,(if (eloud-hyphen-start-p string) (concat " " string) string) "-v" ,eloud-voice "-s" ,(if speed (number-to-string speed) (number-to-string eloud-speech-rate))))
+         (c-i-t (current-idle-time)))
+    (if (or allow-idle (not c-i-t))
 	(progn
 	  (if (not no-kill)
 	      (progn
@@ -278,7 +289,7 @@
       (funcall old-func n)
       (eloud-speak
        (buffer-substring (point) (1+ (point)))
-       nil t "--punct"))))
+       nil t nil "--punct"))))
 
 
 (defun eloud-character-before-point (&rest r)
@@ -294,7 +305,7 @@
       (progn
         (eloud-speak
          (eloud-get-char-at-point -1)
-         nil t "--punct")
+         nil t nil "--punct")
         (apply old-func other-args)))))
 
 
@@ -312,7 +323,7 @@
           (progn
             (eloud-speak
              (eloud-get-char-at-point)
-             nil t "--punct")
+             nil t nil "--punct")
             (apply old-func other-args))))
     (apply old-func other-args)))
 
@@ -327,7 +338,7 @@
       (progn
         (eloud-speak
          (eloud-get-char-at-point)
-         nil t "--punct")
+         nil t nil "--punct")
         (funcall old-func n)))))
 
 
@@ -350,7 +361,7 @@
          (if (> n 1)
              (concat (number-to-string n) " times " last-char-cmd)
            last-char-cmd)
-         eloud-speech-rate t "--punct")
+         eloud-speech-rate t nil "--punct")
 	out-char))))
 
 
@@ -459,7 +470,7 @@
 			   (minibuffer-complete . eloud-completion)
 			   (backward-delete-char-untabify . eloud-character-before-point))
   "Holds a list of cons cells used to map advice onto functions.")
-
+ 
 
 ;;; add functions to hooks
 
@@ -471,25 +482,25 @@
 (defun eloud-map-commands-to-speech-functions (advice-map advice-type &optional unmap)
   "Map native Emacs functions to Eloud advice defined as list of cons cells in ADVICE-MAP.  ADVICE-TYPE determines whether advice is :around, :override, :after, etc., in the form of a keyword symbol.  If optional UNMAP parameter is non-nil, remove all bound advice functions instead."
   (mapcar (lambda (x)
-            (let ((target-function (car x))
-                  (speech-function (cdr x)))
-              (if (not unmap)
-                  (advice-add target-function advice-type speech-function)
-                (advice-remove target-function speech-function))))
+              (let ((target-function (car x))
+                    (speech-function (cdr x)))
+                (if (not unmap)
+                    (define-eloud-command-map-advice globals target-function speech-function advice-type)
+                  (undefine-eloud-command-map-advice globals target-function speech-function))))
           advice-map))
 
 
 (defun eloud-map-commands-to-hooks (hook-map &optional unmap)
   "Map speech functions to hooks as defined in list of cons cells HOOK-MAP.  If UNMAP is non-nil, remove the added functions."
   (mapcar (lambda (x)
-            (progn
-              (if (not (boundp (car x)))
-                  (set (car x)  nil))
+              ;; FIXME: I have no idea what the semantics of the hook
+              ;; variable being unbound means here, nor why we'd set the hook variable to nil.
+              ;;(if (not (boundp (car x))) (set (car x) nil))
               (let ((hook-variable (car x))
                     (function-to-add (cdr x)))
                 (if (not unmap)
-                    (push function-to-add (symbol-value hook-variable))
-                  (set hook-variable (remove function-to-add (symbol-value hook-variable)))))))
+                    (define-eloud-command-map-hook globals hook-variable function-to-add)
+                  (undefine-eloud-command-map-hook globals hook-variable function-to-add))))
           hook-map))
 
 
@@ -508,19 +519,26 @@
 ;;; Define mode
 
 (define-minor-mode eloud-mode "Minor mode for reading text aloud." nil " eloud" :global t
-  (if eloud-mode
-      (progn
-        (eloud-map-commands-to-speech-functions eloud-around-map :around)
-        (eloud-map-commands-to-hooks eloud-hook-map)
-        (eloud-speak "eloud on"))
-    (progn
-      (eloud-map-commands-to-speech-functions eloud-around-map nil t)
-      (eloud-map-commands-to-hooks eloud-hook-map t)
-      (eloud-speak "eloud off"))))
+  (cond
+   (eloud-mode
+    (eloud-command-map-activate globals)
+    (message "eloud now ON")
+    (eloud-speak "eloud on"))
+   (t
+    (eloud-command-map-deactivate globals)
+    (message "eloud now OFF")
+    (eloud-speak "eloud off"))))
 
 
 (provide 'eloud)
 
+;; SIC:  Needs to have eloud fully defined, hence this needs to come after PROVIDE.
+(define-eloud-command-map globals)
+(eloud-map-commands-to-speech-functions eloud-around-map :around)
+(eloud-map-commands-to-hooks eloud-hook-map)
+(eloud-command-map-deactivate globals)
+(message "eloud is now loaded.")
+
 
 ;;; eloud.el ends here