;;; $Id: dtk-speak.el,v 7.0 1997/11/13 15:32:30 raman Exp $
;;; $Author: raman $ 
;;; Description:  Emacs interface to the dectalk
;;; Keywords: Dectalk Emacs Elisp
;;{{{  LCD Archive entry: 

;;; LCD Archive Entry:
;;; emacspeak| T. V. Raman |raman@adobe.com 
;;; A speech interface to Emacs |
;;; $Date: 1997/11/13 15:32:30 $ |
;;;  $Revision: 7.0 $ | 
;;; Location undetermined
;;;

;;}}}
;;{{{  Copyright:
;;;Copyright (C) 1995, 1996, 1997  T. V. Raman  Adobe Systems Incorporated
;;; Copyright (c) 1994, 1995 by Digital Equipment Corporation.
;;; 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 FITNESS 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.

;;}}}
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require 'cl)
(declaim  (optimize  (safety 0) (speed 3)))
(require 'dtk-macros)
(require 'dtk-tcl)
(eval-when (compile) (require 'emacspeak-keymap))

;;{{{  Introduction:

;;; This module defines the interface to the speech device.
;;; It relies on the module dtk-tcl to communicate with the speech driver.
;;; The code in this module is Dectalk specific. 

;;}}}
;;{{{  user customizations: 

(defvar dtk-startup-hook nil
  "List of hooks to be run after starting up the Dectalk. .
Set things like speech rate, punctuation mode etc in this hook. ")

(defvar dtk-tcl (or (getenv "DTK_TCL" )
                    "tcl")
  "TCL used to run the Dectalk driver.
 Extended tcl --tcl-- for hardware Dectalks.
dtk-tclsh for the software Dectalk. ")

(defvar dtk-program
  (or  (getenv "DTK_PROGRAM" ) "dtk-exp")
  "The program to use to talk to the Dectalk.
At present: dtk-exp for the Dectalk Express.
dtk-mv  for the Multivoice and older Dectalks. 
dtk-soft (not yet released)  for the software Dectalk.
 The default is dtk-exp. ")

;;}}}
;;{{{  Internal variables:  

(defvar dtk-stop-immediately t
  "If t, speech stopped immediately when new speech received.
 Emacspeak sets this to nil if the current message being spoken is too
important to be interrupted.  ")

(defvar dtk-speaker-process nil "speaker process handle")

(defvar dtk-punctuation-mode  "some" 
  "Current setting of punctuation state.
 Possible values are some, all or none.
You should not modify this variable;
Use command  dtk-set-punctuations bound to \\[dtk-set-punctuations]. . ")

(defconst dtk-drivers-alist
  '(("dtk-exp" . "dtk-exp")
    ("dtk-mv" . "dtk-mv")
    ("dtk-face" . "dtk-face")
    ("dtk-soft" . "dtk-soft")
    )
  "Used by completing-read when prompting for the dtk driver to use. ")

(defconst dtk-driver-prefix "dtk-"
  "Used by completing-read when prompting for the driver name. ")

;;}}}
;;{{{  Mapping characters to speech:
;;{{{ variable to hold buffer specific speech table

(defvar dtk-display-table nil
  "Variable holding display information for special characters.")

(make-variable-buffer-local 'dtk-display-table)

;;}}}
;;{{{  default speech table

(defvar dtk-character-to-speech-table
  (make-vector 256 "")
  "Holds the mapping of characters to the string that should be spoken for
pronouncing that character.")

(declaim (special dtk-character-to-speech-table ))
;;;  Assign entries in the table:
(let ((table dtk-character-to-speech-table))
(aset  table 0 "control at")
 (aset  table 1 "control a")
(aset  table 2 "control b")
(aset  table 3  "control c")
  (aset  table 4 "control d")
  (aset  table 5 "control e")
  (aset  table 6 "control f")
  (aset  table 7 "control g")
  (aset  table 8 "control h")
  (aset  table 9 "tab")
  (aset  table 10 "newline")
  (aset  table 11 "control k")
  (aset  table 12 "control l")
  (aset  table 13 "control m")
  (aset  table 14 "control n")
  (aset  table 15 "control o")
  (aset  table 16"control p")
  (aset  table 17 "control q")
  (aset  table 18 "control r")
  (aset  table 19 "control s")
  (aset  table 20 "control t")
  (aset  table 21 "control u")
  (aset  table 22 "control v")
  (aset  table 23 "control w")
  (aset  table 24 "control x")
  (aset  table 25 "control y")
  (aset  table 26 "control z")
(aset  table 27 "escape")
(aset table 28 "control[*]backslash")
(aset table 29 "control[*]right bracket")
(aset table 30 "control[*]caret" )
(aset table 31 "control[*]underscore")
(aset table 32 "space")
(aset table 33 "exclamation")
(aset table 34 "quotes")
(aset table 35  "pound")
(aset table  36  "dollar")
(aset table 37  "percent" )
(aset table 38  "ampersand")
(aset table 39  "apostrophe" )
(aset table 40  "left[*]paren" )
(aset table 41 "right[*]paren" )
(aset table  42   "star")
(aset table 43  "plus")
(aset   table 44 "comma")
(aset table  45  "dash")
(aset table 46  "dot")
(aset table 47  "slash")
(aset table 48  "zero")
(aset table 49 "one")
(aset table 50 "two")
(aset table 51 "three")
(aset  table 52  "four")
(aset  table 53 "five")
(aset  table 54 "six")
(aset  table 55 "seven")
(aset  table 56 "eight")
(aset  table 57 "nine")
(aset table 58 "colon" )
(aset table 59 "semi")
1(aset table 60 "less[*]than")
(aset  table 61 "equals")
(aset  table 62  "greater[*]than")
(aset  table 63 "question[*]mark")
(aset  table 64 "at")
(aset  table 65  " cap[*]a")
(aset  table 66 " cap[*]b")
(aset  table 67 "cap[*]c")
(aset  table 68 "cap[*]d")
(aset  table 69 "cap[*]e")
(aset  table 70 "cap[*]f")
(aset  table 71 "cap[*]g")
(aset  table 72 "cap[*]h")
(aset  table 73 "cap[*]i")
(aset  table 74 "cap[*]j")
(aset  table 75 "cap[*]k")
(aset  table 76 "cap[*]l")
(aset  table 77 "cap[*]m")
(aset  table 78 "cap[*]m")
(aset  table 79 "cap[*]o")
(aset  table 80 "cap[*]p")
(aset  table 81 "cap[*]q")
(aset  table 82 "cap[*]r")
(aset  table 83 "cap[*]s")
(aset  table 84 "cap[*]t")
(aset  table 85 "cap[*]u")
(aset  table 86 "cap[*]v")
(aset  table 87 "cap[*]w")
(aset  table 88 "cap[*]x")
(aset  table 89 "cap[*]y")
(aset  table 90 "cap[*]z")
(aset  table 91 "left[*]bracket")
(aset  table 92  "backslash")
(aset  table 93 "right[*]bracket")
(aset  table 94  "caret")
(aset  table 95  "underscore")
(aset  table 96 "backquote")
(aset  table 97  "a")
(aset  table 98 "b")
(aset  table 99 "c")
(aset  table 100 "d")
(aset  table 101 "e")
(aset  table 102 "f")
(aset  table 103 "g")
(aset  table 104 "h")
(aset  table 105 "i")
(aset  table 106 "j")
(aset  table 107 "k")
(aset  table 108 "l")
(aset  table 109 "m")
(aset  table 110 "n")
(aset  table 111 "o")
(aset  table 112 "p")
(aset  table 113 "q")
(aset  table 114 "r")
(aset  table 115 "s")
(aset  table 116 "t")
(aset  table 117 "u")
(aset  table 118 "v")
(aset  table 119 "w")
(aset  table 120  "x")
(aset  table 121 "y")
(aset  table 122 "z")
(aset  table 123 "left[*]brace")
(aset  table 124 "pipe")
(aset  table 125 "right[*]brace ")
(aset  table 126 "tilde")
(aset  table 127  "backspace")
;;; Characters with the 8th bit set:
(aset  table 128  " octal 200 ")
(aset  table 129  " octal 201 ")
(aset  table 130  " octal 202 ")
(aset  table 131  " octal 203 ")
(aset  table 132  " octal 204 ")
(aset  table 133  " octal 205 ")
(aset  table 134  " octal 206 ")
(aset  table 135  " octal 207 ")
(aset  table 136  " octal 210 ")
(aset  table 137  " octal 211 ")
(aset  table 138  " octal 212 ")
(aset  table 139  " octal 213 ")
(aset  table 140  " octal 214 ")
(aset  table 141  " octal 215 ")
(aset  table 142  " octal 216 ")
(aset  table 143  " octal 217 ")
(aset  table 144  " octal 220 ")
(aset  table 145  " octal 221 ")
(aset  table 146  " '  ")
(aset  table 147  " quote  ")
(aset  table 148  " octal 224 ")
(aset  table 149  " octal 225 ")
(aset  table 150  " octal 226 ")
(aset  table 151  " octal 227 ")
(aset  table 152  " octal 230 ")
(aset  table 153  " octal 231 ")
(aset  table 154  " octal 232 ")
(aset  table 155  " octal 233 ")
(aset  table 156  " octal 234 ")
(aset  table 157  " octal 235 ")
(aset  table 158  " octal 236 ")
(aset  table 159  " octal 237 ")
(aset  table 160  "  ") ;non breaking space
(aset  table 161  " octal 241 ")
(aset  table 162  " octal 242 ")
(aset  table 163  " octal 243 ")
(aset  table 164  " octal 244 ")
(aset  table 165  " octal 245 ")
(aset  table 166  " octal 246 ")
(aset  table 167  " octal 247 ")
(aset  table 168  " octal 250 ")
(aset  table 169  " copyright ") ;copyright sign
(aset  table 170  " octal 252 ")
(aset  table 171  " octal 253 ")
(aset  table 172  " octal 254 ")
(aset  table 173  "-") ;soft hyphen
(aset  table 174  " (R) ") ;registered sign
(aset  table 175  " octal 257 ")
(aset  table 176  " octal 260 ")
(aset  table 177  " octal 261 ")
(aset  table 178  " octal 262 ")
(aset  table 179  " octal 263 ")
(aset  table 180  " octal 264 ")
(aset  table 181  " octal 265 ")
(aset  table 182  " octal 266 ")
(aset  table 183  " octal 267 ")
(aset  table 184  " octal 270 ")
(aset  table 185  " octal 271 ")
(aset  table 186  " octal 272 ")
(aset  table 187  " octal 273 ")
(aset  table 188  " octal 274 ")
(aset  table 189  " octal 275 ")
(aset  table 190  " octal 276 ")
(aset  table 191  " octal 277 ")
(aset  table 192  " octal 300 ")
(aset  table 193  " octal 301 ")
(aset  table 194  " octal 302 ")
(aset  table 195  " octal 303 ")
(aset  table 196  " octal 304 ")
(aset  table 197  " octal 305 ")
(aset  table 198  " octal 306 ")
(aset  table 199  " octal 307 ")
(aset  table 200  " octal 310 ")
(aset  table 201  " octal 311 ")
(aset  table 202  " octal 312 ")
(aset  table 203  " octal 313 ")
(aset  table 204  " octal 314 ")
(aset  table 205  " octal 315 ")
(aset  table 206  " octal 316 ")
(aset  table 207  " octal 317 ")
(aset  table 208  " octal 320 ")
(aset  table 209  " octal 321 ")
(aset  table 210  " octal 322 ")
(aset  table 211  " octal 323 ")
(aset  table 212  " octal 324 ")
(aset  table 213  " octal 325 ")
(aset  table 214  " octal 326 ")
(aset  table 215  " octal 327 ")
(aset  table 216  " octal 330 ")
(aset  table 217  " octal 331 ")
(aset  table 218  " octal 332 ")
(aset  table 219  " octal 333 ")
(aset  table 220  " octal 334 ")
(aset  table 221  " octal 335 ")
(aset  table 222  " octal 336 ")
(aset  table 223  " octal 337 ")
(aset  table 224  " octal 340 ")
(aset  table 225  " octal 341 ")
(aset  table 226  " octal 342 ")
(aset  table 227  " octal 343 ")
(aset  table 228  " octal 344 ")
(aset  table 229  " octal 345 ")
(aset  table 230  " octal 346 ")
(aset  table 231  " octal 347 ")
(aset  table 232  " octal 350 ")
(aset  table 233  " octal 351 ")
(aset  table 234  " octal 352 ")
(aset  table 235  " octal 353 ")
(aset  table 236  " octal 354 ")
(aset  table 237  " octal 355 ")
(aset  table 238  " octal 356 ")
(aset  table 239  " octal 357 ")
(aset  table 240  " octal 360 ")
(aset  table 241  " octal 361 ")
(aset  table 242  " octal 362 ")
(aset  table 243  " octal 363 ")
(aset  table 244  " octal 364 ")
(aset  table 245  " octal 365 ")
(aset  table 246  " octal 366 ")
(aset  table 247  " octal 367 ")
(aset  table 248  " octal 370 ")
(aset  table 249  " octal 371 ")
(aset  table 250  " octal 372 ")
(aset  table 251  " octal 373 ")
(aset  table 252  " octal 374 ")
(aset  table 253  " octal 375 ")
(aset  table 254  " octal 376 ")
(aset  table 255  " octal 377 "))

;;}}}
;;{{{  iso ascii table:

(defvar dtk-iso-ascii-character-to-speech-table
  (and (boundp 'dtk-character-to-speech-table)
       (vectorp dtk-character-to-speech-table)
        (copy-sequence dtk-character-to-speech-table))
  "Table that records how ISO ascii characters are spoken.")

(let ((table dtk-iso-ascii-character-to-speech-table))
(aset table 160 " no-break space ")
(aset table 161 " inverted exclamation mark ")
(aset table 162 " cent sign ")
(aset table 163 " sterling ")
(aset table 164 " general currency sign ")
(aset table 165 " yen sign ")
(aset table 166 " broken vertical line ")
(aset table 167 " section sign ")
(aset table 168 " diaeresis ")
(aset table 169 " copyright sign ")
(aset table 170 " ordinal indicator, feminine ")
(aset table 171 " left angle quotation mark ")
(aset table 172 " not sign ")
(aset table 173 " soft hyphen ")
(aset table 174 " registered sign ")
(aset table 175 " macron ")
(aset table 176 " degree sign ")
(aset table 177 " plus or minus sign ")
(aset table 178 " superscript two ")
(aset table 179 " superscript three ")
(aset table 180 " acute ")
(aset table 181 " mu ")
(aset table 182 " pilcrow ")
(aset table 183 " middle dot ")
(aset table 184 " cedilla ")
(aset table 185 " superscript one ")
(aset table 186 " ordinal indicator, masculine ")
(aset table 187 " right angle quotation mark ")
(aset table 188 " fraction one-quarter ")
(aset table 189 " fraction one-half ")
(aset table 190 " fraction three-quarters ")
(aset table 191 " inverted question mark ")
(aset table 192 " A graav ")
(aset table 193 " A acute ")
(aset table 194 " A circumflex ")
(aset table 195 " A tilde ")
(aset table 196 " A diaeresis ")
(aset table 197 " A ring ")
(aset table 198 " AE diphthong ")
(aset table 199 " C cedilla ")
(aset table 200 " E graav ")
(aset table 201 " E acute ")
(aset table 202 " E circumflex ")
(aset table 203 " E diaeresis ")
(aset table 204 " I graav ")
(aset table 205 " I acute ")
(aset table 206 " I circumflex ")
(aset table 207 " I diaeresis ")
(aset table 208 " D stroke, Icelandic eth ")
(aset table 209 " N tilde ")
(aset table 210 " O graav ")
(aset table 211 " O acute ")
(aset table 212 " O circumflex ")
(aset table 213 " O tilde ")
(aset table 214 " O diaeresis ")
(aset table 215 " multiplication sign ")
(aset table 216 " O slash ")
(aset table 217 " U graav ")
(aset table 218 " U acute ")
(aset table 219 " U circumflex ")
(aset table 220 " U diaeresis ")
(aset table 221 " Y acute ")
(aset table 222 " capital thorn, Icelandic ")
(aset table 223 " small sharp s, German ")
(aset table 224 " a graav ")
(aset table 225 " a acute ")
(aset table 226 " a circumflex ")
(aset table 227 " a tilde ")
(aset table 228 " a diaeresis ")
(aset table 229 " a ring ")
(aset table 230 " ae diphthong ")
(aset table 231 " c cedilla ")
(aset table 232 " e graav ")
(aset table 233 " e acute ")
(aset table 234 " e circumflex ")
(aset table 235 " e diaeresis ")
(aset table 236 " i graav ")
(aset table 237 " i acute ")
(aset table 238 " i circumflex ")
(aset table 239 " i diaeresis ")
(aset table 240 " d stroke, Icelandic eth ")
(aset table 241 " n tilde ")
(aset table 242 " o graav ")
(aset table 243 " o acute ")
(aset table 244 " o circumflex ")
(aset table 245 " o tilde ")
(aset table 246 " o diaeresis ")
(aset table 247 " division sign ")
(aset table 248 " o slash ")
(aset table 249 " u graav ")
(aset table 250 " u acute ")
(aset table 251 " u circumflex ")
(aset table 252 " u diaeresis ")
(aset table 253 " y acute ")
(aset table 254 " small thorn, Icelandic ")
(aset table 255 " small y diaeresis ")
)



;;}}}
(defsubst dtk-char-to-speech (char)
  (declare (special dtk-character-to-speech-table))
(if (> char 127 )
(format "octal %o"  char )
  (aref dtk-character-to-speech-table char )))

;;}}}
;;{{{  interactively selecting the driver:

(defun dtk-select-driver ()
  "Select a dectalk driver interactively.
This will be the driver that is used when you next call either
\\[dtk-initialize] or \\[dtk-emergency-restart]. "
  (interactive)
  (declare (special  dtk-tcl dtk-program dtk-drivers-alist dtk-driver-prefix ))
  (setq dtk-program
        (completing-read "Select Dectalk driver:"
                         dtk-drivers-alist  nil
                         t dtk-driver-prefix ))
  (cond
   ((string= dtk-program "dtk-soft")
      (setq dtk-tcl "dtk-tclsh"))
   ((string= dtk-program "dtk-face")
      (setq dtk-tcl "DECface"))
    (t (setq dtk-tcl "tcl")))
  (message "Selected %s Use %s to start using it "
           dtk-program
           (substitute-command-keys "\\[dtk-emergency-restart]")))

;;}}}
;;{{{  initialize the speech process
(defvar dtk-debug nil
  "Set this to t if you want to debug the synthesizer driver. ")

(defvar dtk-speak-driver-initialized nil
  "Records if the driver is initialized.")

(defvar dtk-speak-process-connection-type nil
  "*Specifies if we use ptys or pipes to connect to the speech driver process.
Has the same semantics as the builtin process-connection-type.
Default is to use pipes.")

(defun  dtk-initialize ()
  "Initialize speech system. "
  (declare (special dtk-program dtk-tcl
                    dtk-speak-process-connection-type
                    dtk-speaker-process  dtk-debug
                    dtk-speak-driver-initialized
                    dtk-startup-hook emacspeak-dir))
    ;;; first load the appropriate interface library:
  (require 'dtk-tcl)
  (when (and dtk-speaker-process
             (or (eq 'run (process-status dtk-speaker-process ))
                 (eq 'stop (process-status dtk-speaker-process ))))
    (kill-process dtk-speaker-process ))
  (let ((process-connection-type  dtk-speak-process-connection-type))  
    (setq dtk-speaker-process
          (start-process "speaker"
                         (and dtk-debug " *speaker*")
                         dtk-tcl
                         (concat emacspeak-dir "/"
                                 dtk-program  )))
(process-kill-without-query dtk-speaker-process)
    (setq dtk-speak-driver-initialized
          (eq 'run (process-status dtk-speaker-process ))))
  (unless dtk-debug 
    (set-process-filter dtk-speaker-process 'dtk-filter-function ))
  (run-hooks 'dtk-startup-hook )
  (unless dtk-speak-driver-initialized
    (message "The speech driver is not running")))

(defun dtk-emergency-restart ()
  "Use this to nuke the currently running dtk driver and restart it.
Useful if you want to switch to another synthesizer while emacspeak is
running.  Also useful for emergency stopping of speech. "
  (interactive)
  (dtk-initialize ))


(defun dtk-toggle-debug (&optional flag )
  "Toggle state of the debug flag.
When debugging is on, you can switch to the buffer
*speaker* to examine the output from the process
that talks to the speech device.
Note: *speaker* is a hidden buffer, ie it has a leading space in its name."
  (interactive "P")
  (declare (special dtk-debug ))
  (cond
   (flag (setq dtk-debug t ))
   (t (setq dtk-debug (not dtk-debug ))))
  (message "Turned %s debugging of the synthesizer driver %s"
           (if dtk-debug "on" "off")
           (if dtk-debug
               (substitute-command-keys
                "Restart the synthesizer driver  by pressing
\\[dtk-emergency-restart] to start debugging")
             (substitute-command-keys
              "Restart the synthesizer driver  by pressing
\\[dtk-emergency-restart] to stop  debugging"))))

;;}}}
;;{{{  interactively select how text is split:

(defun dtk-toggle-splitting-on-white-space ()
  "Toggle state of emacspeak that decides if we split text purely by
clause boundaries, or also include whitespace.  By default, emacspeak
sends a clause at a time to the speech device.  This produces fluent
speech for normal use. However in modes such as shell-mode and some
programming language modes, clause markers appear infrequently, and
this can result in large amounts of text being sent to the speech
device at once, making the system unresponsive when asked to stop
talking. Splitting on white space makes emacspeak's stop command
responsive. However, when splitting on white space, the speech sounds
choppy since the synthesizer is getting a word at a time."
  (interactive)
  (declare (special dtk-chunk-separator-syntax))
  (cond
   ((not (string-match " " dtk-chunk-separator-syntax))
    (dtk-chunk-on-white-space-and-punctuations)
    (message "Text will be split at punctuations and white space when speaking") )
   (t (dtk-chunk-only-on-punctuations)
      (message "Text split only at clause boundaries when
speaking"))))

(defun dtk-set-chunk-separator-syntax (s)
  "Interactively set how text is split in chunks.  See the emacs
documentation on syntax tables for details on how characters are
classified into various syntactic classes."

  (interactive
   (list
    (read-from-minibuffer "Specify separator syntax string: ")))
  (declare (special dtk-chunk-separator-syntax))
  (setq dtk-chunk-separator-syntax s)
  (message "Set  separator to %s" s))

;;}}}
(provide 'dtk-speak)

;;{{{  emacs local variables 

;;; local variables:
;;; folded-file: t
;;; end: 

;;}}}