;;; dtk-speak.el --- Provides Emacs Lisp interface to speech server
;;;$Id: dtk-speak.el 5960 2008-10-01 14:01:38Z tv.raman.tv $
;;; $Author: tv.raman.tv $
;;; Description:  Emacs interface to TTS
;;; Keywords: Dectalk Emacs Elisp
;;{{{  LCD Archive entry:

;;; LCD Archive Entry:
;;; emacspeak| T. V. Raman |raman@cs.cornell.edu
;;; A speech interface to Emacs |
;;; $Date: 2008-07-06 10:18:30 -0700 (Sun, 06 Jul 2008) $ |
;;;  $Revision: 4670 $ |
;;; Location undetermined
;;;

;;}}}
;;{{{  Copyright:
;;;Copyright (C) 1995 -- 2007, T. V. Raman
;;; 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.

;;}}}
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;{{{ introduction:

;;; Commentary:
;;;Defines the TTS interface.

;;; Code:
;;

;;}}}
;;{{{ required modules

;;;Code:

(require 'cl)
(declaim  (optimize  (safety 0) (speed 3)))
(require 'backquote)
(require 'custom)
(require 'dtk-interp)
(require 'dtk-unicode)
(require 'dectalk-voices)
(require 'outloud-voices)
(require 'multispeech-voices)
(require 'espeak-voices)
(require 'flite-voices)

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

(defgroup tts nil
  "Text To Speech (TTS) customizations for the Emacspeak audio desktop."
  :group 'emacspeak
  :prefix "dtk-")
;;;###autoload
(defcustom tts-strip-octals nil
  "Set to T to strip all octal chars before speaking.
Particularly useful for web browsing."
  :type 'boolean
  :group  'dtk
  :group  'tts)
(make-variable-buffer-local 'tts-strip-octals)
;;;###autoload
(defcustom dtk-stop-immediately-while-typing t
  "*Set it to nil if you dont want speech to flush as you
type.  You can use command
`dtk-toggle-stop-immediately-while-typing' bound to
\\[dtk-toggle-stop-immediately-while-typing] to toggle this setting."
  :group 'tts
  :type 'boolean)
(make-variable-buffer-local 'dtk-stop-immediately-while-typing)
;;;###autoload
(defcustom dtk-speech-rate-base 50
  "*Value of lowest tolerable speech rate."
  :type 'integer
  :group 'tts)
;;;###autoload
(defcustom dtk-speech-rate-step 50
  "*Value of speech rate increment.
This determines step size used when setting speech rate via command
`dtk-set-predefined-speech-rate'.  Formula used is
dtk-speech-rate-base  +  dtk-speech-rate-step*level."
  :type 'integer
  :group 'tts)
;;;###autoload
(defcustom dtk-startup-hook nil
  "List of hooks to be run after starting up the speech server.
Set things like speech rate, punctuation mode etc in this
hook."
  :type 'hook
  :group 'tts)

(defvar dtk-program
  (or  (getenv "DTK_PROGRAM" ) "dtk-exp")
  "The program to use to talk to the speech engine.
Possible choices at present:
dtk-exp     For the Dectalk Express.
dtk-mv      for the Multivoice and older Dectalks.
outloud     For IBM ViaVoice Outloud
multispeech For Multilingual speech server
espeak      For eSpeak
The default is dtk-exp.")

(defvar dtk-quiet nil
  "Switch indicating if the speech synthesizer is to keep quiet.
Do not set this variable by hand.
See command `dtk-toggle-quiet' bound to \\[dtk-toggle-quiet].")
(make-variable-buffer-local 'dtk-quiet)

(defvar dtk-split-caps t
  "Flag indicating whether to use split caps when speaking.
Do not set this variable by hand, use command  `dtk-toggle-split-caps'
 bound to \\[dtk-toggle-split-caps].")
(make-variable-buffer-local 'dtk-split-caps)
;;;###autoload
(defcustom dtk-cleanup-patterns
  (list
   "." "_" "-"  "=" "/"  "+" "*" ":" ";" "%"
   "{" "}" "~" "$" ")" "#" "/\\" "<>" )
  "List of repeating patterns to clean up.
You can use  command  `dtk-add-cleanup-pattern'
 bound to \\[dtk-add-cleanup-pattern]  to add more patterns.
Specify patterns that people use to decorate their ASCII files, and cause
untold pain to the speech synthesizer.

If more than 3 consecutive occurrences
of a specified pattern is found, the TTS engine replaces it
with a repeat count. "
  :type '(repeat  (string :tag "pattern"))
  :group 'tts)

;;}}}
;;{{{  internal variables

(defvar dtk-character-scale 1.25
  "Factor by which speech rate is scaled when characters are spoken.
Do not set this variable by hand, use command
`dtk-set-character-scale' bound to \\[dtk-set-character-scale].")

(defvar dtk-capitalize nil
  "Non-nil means produce a beep to indicate  capitalization.
Do not set this variable by hand, use command dtk-toggle-capitalization
bound to \\[dtk-toggle-capitalization].")
(make-variable-buffer-local 'dtk-capitalize)

(defvar dtk-allcaps-beep nil
  "Option to indicate capitalization.
Non-nil means produce a beep to indicate upper case words in conjunction with
split caps Do not set this variable by hand, use command
`dtk-toggle-allcaps-beep' bound to \\[dtk-toggle-allcaps-beep].")

(defconst dtk-punctuation-mode-alist
  '("some" "all" "none")
  "Alist of valid punctuation modes.")

(defvar dtk-last-output nil
  "Variable holding last output.")

(defvar dtk-speech-rate 225
  "Rate at which tts talks.
Do not modify this variable directly; use command  `dtk-set-rate'
 bound to \\[dtk-set-rate].")

(make-variable-buffer-local 'dtk-speech-rate)

;;;declared here to help compilation
(defvar voice-lock-mode nil)

;;}}}
;;{{{ helper: apply pronunciations
;;; moved here from the emacspeak-pronounce module for efficient
;;compilation

(defsubst tts-apply-pronunciations (pronunciation-table )
  "Applies pronunciations specified in pronunciation table to current buffer.
Modifies text and point in buffer."
  (declare (special emacspeak-pronounce-pronunciation-personality))
  (let ((words
         (sort
          (loop for  key  being the hash-keys  of pronunciation-table collect key)
          #'(lambda (a b )
              (> (length  a) (length  b))))))
    (loop for key in words
          do
          (let ((word  key)
                (pronunciation (gethash  key pronunciation-table))
                (pp nil)
                (personality nil))
            (when word
              (goto-char (point-min))
              (cond
               ((stringp pronunciation)
                (while (search-forward  word nil t)
                  (setq pp (get-text-property (point) 'personality))
                  (replace-match  pronunciation t t  )
                  (when (or pp emacspeak-pronounce-pronunciation-personality)
                    (put-text-property
                     (match-beginning 0)
                     (+ (match-beginning 0) (length pronunciation))
                     'personality
                     (cond
                      ((and emacspeak-pronounce-pronunciation-personality
                            (listp pp))
                       (nconc pp (list emacspeak-pronounce-pronunciation-personality)))
                      (t pp))))))
               ((consp pronunciation )
                (let ((matcher (car pronunciation))
                      (pronouncer (cdr pronunciation))
                      (pronunciation ""))
                  (while (funcall matcher   word nil t)
                    (setq pp (get-text-property (point) 'personality))
                    (setq pronunciation
                          (save-match-data
                            (funcall pronouncer
                                     (buffer-substring
                                      (match-beginning 0)
                                      (match-end 0)))))
                    (replace-match pronunciation t t  )
                    (when (or pp emacspeak-pronounce-pronunciation-personality)
                      (put-text-property
                       (match-beginning 0)
                       (+ (match-beginning 0) (length pronunciation))
                       'personality
                       (cond
                        ((and emacspeak-pronounce-pronunciation-personality
                              (listp pp))
                         (nconc pp (list emacspeak-pronounce-pronunciation-personality)))
                        (t pp)))))))
               (t nil)))))))

;;}}}
;;{{{  Helpers to handle invisible text:

(defsubst text-visible-p (position)
  (not (invisible-p position)))
(unless (fboundp 'invisible-p)
;;; defined in simple.el in Emacs 23.
  (defsubst invisible-p (pos)
    "Check if text is invisible. Emacspeak helper."
    (declare (special buffer-invisibility-spec))
    (let ((prop (get-char-property pos 'invisible)))
      (if (eq buffer-invisibility-spec t)
          prop
        (or (memq prop buffer-invisibility-spec)
            (assq prop buffer-invisibility-spec)))))
  ) ;;; needed before Emacs 23.

(defsubst skip-invisible-forward  ()
  (while (and(not (eobp))
             (invisible-p (point)))
    (goto-char
     (next-single-char-property-change (point) 'invisible
                                       (current-buffer) (point-max)))))

(defsubst skip-invisible-backward  ()
  "Move backwards over invisible text."
  (while (and(not (bobp))
             (invisible-p (point)))
    (goto-char
     (previous-single-char-property-change (point) 'invisible
                                           (current-buffer) (point-min)))))

(defsubst delete-invisible-text ()
  "Delete invisible text."
  (goto-char (point-min))
  (let ((start  (point )))
    (while (not (eobp))
      (cond
       ((invisible-p (point ))
        (skip-invisible-forward)
        (delete-region  start (point ))
        (setq start (point )))
       (t (goto-char
           (or (next-single-property-change (point) 'invisible )
               (point-max )))
          (setq start (point)))))))

;;}}}
;;{{{  define inline functions first

(defsubst dtk-silence (duration &optional force)
  "Produce silence.
Argument DURATION  specifies number of milliseconds to pause.
Optional argument FORCE  flushes the command to the speech server."
  (declare (special dtk-quiet dtk-speaker-process
                    dtk-speak-server-initialized))
  (unless dtk-quiet
    (when dtk-speak-server-initialized
      (dtk-interp-silence duration
                          (if force "\nd" "")))))

;;;###autoload
(defcustom dtk-use-tones t
  "Allow tones to be turned off."
  :type 'boolean
  :group 'tts)

(defsubst dtk-tone (pitch duration &optional force)
  "Produce a tone.
Argument PITCH   is specified in hertz.
Argument DURATION  is specified in milliseconds.
Optional argument FORCE  flushes the command to the speech server."
  (declare (special dtk-quiet dtk-speaker-process
                    dtk-use-tones
                    dtk-speak-server-initialized))
  (unless dtk-quiet
    (when (and dtk-use-tones
               dtk-speak-server-initialized)
      (dtk-interp-tone pitch duration force))))

(defun dtk-set-language (lang)
  "Set language according to the argument lang."
  (interactive "sEnter new language: \n")
  (declare (special dtk-quiet dtk-speaker-process
                    dtk-speak-server-initialized))
  ;;  (unless dtk-quiet
  (when dtk-speak-server-initialized
    (dtk-interp-language lang (interactive-p))))
;;)

(defun dtk-set-next-language ()
  "Switch to the next available language"
  (interactive)
  (declare (special dtk-speak-server-initialized))
  (when dtk-speak-server-initialized
    (dtk-interp-next-language (interactive-p))))
;;)

(defun dtk-set-previous-language ()
  "Switch to the previous available language"
  (interactive)
  (declare (special dtk-quiet dtk-speaker-process
                    dtk-speak-server-initialized))
  ;;  (unless dtk-quiet
  (when dtk-speak-server-initialized
    (dtk-interp-previous-language (interactive-p))))
;;)

(defun dtk-set-preferred-language (alias lang)
  "Set the alias of the preferred language:
For example if alias=\"en\" lang=\"en_GB\",
then the following call:
 dtk-set-language(\"en\")
will set \"en_GB\".
"
  (interactive "s")
  (declare (special dtk-quiet dtk-speaker-process
                    dtk-speak-server-initialized))
  ;;  (unless dtk-quiet
  (when dtk-speak-server-initialized
    (dtk-interp-preferred-language alias lang)))
;;)

(defun dtk-list-language ()
  "Say the available languages."
  (declare (special dtk-quiet dtk-speaker-process
                    dtk-speak-server-initialized))
  (unless dtk-quiet
    (when dtk-speak-server-initialized
      (dtk-interp-list-language)))
  )

;;; helper function:

;;; Quote the string in current buffer so tcl does not barf.
;;; Fix brackets by changing to text.
;;; This is necessary because
;;;  [] marks dtk commands; {} is special to tcl
;;; Optionally post-process the text with cleanup function if one is specified.
(defconst dtk-bracket-regexp
  "[][{}<>\\|`#]"
  "Brackets and other chars  that are special to dtk and tcl.
{} is special to tcl.
[] is special to both dtk and tcl.
<> and | are fixed to improve pronunciation.
\\ is fixed because it tends to be a metacharacter")

(defsubst dtk-strip-octals ()
  "Remove all octal chars."
  (let ((inhibit-read-only t))
    (goto-char (point-min))
    (while (re-search-forward "[\177-\377]+"  nil t )
      (replace-match " "))))

(defsubst  dtk-fix-brackets (mode)
  "Quote any delimiters that need special treatment.
Argument MODE  specifies the current pronunciation mode."
  (declare  (special dtk-bracket-regexp ))
  (let ((inhibit-read-only t))
    (goto-char (point-min))
    (cond
     ((eq 'all mode)
      (let ((start nil)
            (personality nil))
        (while (re-search-forward dtk-bracket-regexp  nil t )
          (setq start (1- (point)))
          (setq personality
                (get-text-property
                 start 'personality))
          (cond
           ((= ?| (char-after (match-beginning 0 )))
            (replace-match " pipe "))
           ((= ?< (char-after (match-beginning 0 )))
            (replace-match " less than "))
           ((= ?> (char-after (match-beginning 0 )))
            (replace-match " greater than "))
           ((= ?{ (char-after (match-beginning 0 )))
            (replace-match " left brace "))
           ((= ?} (char-after (match-beginning 0 )))
            (replace-match " right brace "))
           ((=  ?\] (char-after (match-beginning 0)))
            (replace-match " right bracket "))
           ((= ?\[ (char-after  (match-beginning 0)))
            (replace-match " left bracket "))
           ((= ?\\ (char-after (match-beginning 0 )))
            (replace-match " backslash "))
           ((= ?# (char-after (match-beginning 0 )))
            (replace-match " pound "))
           ((= ?` (char-after (match-beginning 0 )))
            (replace-match " backquote ")))
          (when personality
            (put-text-property start (point)
                               'personality personality)))))
     (t
      (while (re-search-forward dtk-bracket-regexp   nil t )
        (replace-match " " nil t ))))))
;;;###autoload
(defcustom dtk-speak-nonprinting-chars nil
  "*Option that specifies handling of non-printing chars.
Non nil value means non printing characters  should be
spoken as their octal value.
Set this to t to avoid a dectalk bug that makes the speech box die if
it seems some accented characters in certain contexts."
  :type 'boolean
  :group 'dtk)

(make-variable-buffer-local 'dtk-speak-nonprinting-chars)

(defvar dtk-octal-chars
  (if
      (and (boundp 'default-enable-multibyte-characters)
           default-enable-multibyte-characters)
      "[\000-\010\013\014\016-\037\177-\377]"
    "[\000-\010\013\014\016-\037]")
  "Regular expression matching control chars.
Set this once per emacspeak session for efficiency.")

(defsubst dtk-fix-control-chars ()
  "Handle control characters in speech stream."
  (declare (special dtk-character-to-speech-table
                    dtk-octal-chars
                    dtk-speak-nonprinting-chars))
  (let ((char nil))
    (goto-char (point-min ))
    (cond
     (tts-strip-octals ;;;Strip octals if asked to
      (dtk-strip-octals))
     (dtk-speak-nonprinting-chars
      (while (re-search-forward dtk-octal-chars nil t )
        (setq char (char-after (match-beginning 0)))
        (replace-match
         (format " %s " (aref  dtk-character-to-speech-table
                               char))))))))

;;; Takes a string, and replaces occurences of this pattern
;;; that are longer than 3 by a string of the form \"count
;;; string\". Second argument, mode, is the pronunciation
;;; mode being used to speak.  Removing repeated chars, and
;;; replacing them by a count:

(defsubst dtk-replace-duplicates (string mode)
  "Replace repeating patterns.
Argument STRING  specifies the repeating string to replace.
Argument MODE  specifies the current pronunciation mode."
  (let* ((inhibit-read-only t)
         (len (length string))
         (pattern (regexp-quote string))
         (reg (concat
               pattern pattern
               "\\(" pattern  "\\)+"))
         (start nil)
         (personality nil)
         (replacement nil))
    (while (re-search-forward reg nil t)
      (setq personality
            (get-text-property (point) 'personality))
      (setq replacement
            (if  (eq 'all  mode)
                (format " aw %s %s"
                        (/ (- (match-end 0 ) (match-beginning 0))
                           len)
                        (if (string-equal " " pattern)
                            " space " string))
              ""))
      (replace-match replacement)
      (setq start (- (point) (length replacement)))
      (when personality
        (put-text-property start (point)
                           'personality personality)))
    (goto-char (point-min))))
(defsubst dtk-handle-repeating-patterns (mode)
  (declare (special dtk-cleanup-patterns))
  (goto-char (point-min))
  (mapc
   #'(lambda (str)
       (dtk-replace-duplicates str mode ))
   dtk-cleanup-patterns ))

(defsubst  dtk-quote(mode )
;;; dtk will think it's processing a command otherwise:
  (dtk-fix-brackets mode)
;;; fix control chars
  (dtk-fix-control-chars))

(defsubst dtk-fix-backslash ()
  "Quote backslash characters as appropriate."
  (goto-char (point-min))
  (while (search-forward "\\" nil t)
    (replace-match " backslash ")))

;;; efficient quoting function for use in dtk-say
(defsubst  dtk-quick-quote(string )
  (let ((dtk-scratch-buffer (get-buffer-create " *dtk-scratch-buffer* "))
        (inhibit-read-only t))
    (save-current-buffer
      (set-buffer dtk-scratch-buffer)
      (setq buffer-undo-list t)
      (erase-buffer)
      (insert string)
      (goto-char (point-min))
;;; dtk will think it's processing a command otherwise:
      (dtk-fix-brackets 'all)
      (dtk-fix-backslash)
;;; fix control chars
      (dtk-fix-control-chars))))

;;; Moving  across a chunk of text.
;;; A chunk  is specified by a punctuation followed by whitespace
;;; or  multiple blank lines
;;; or a comment start or end
;;; or a parenthesis grouping start or end
;;; leaves point at the end of the chunk.
;;; returns  distance moved; nil if stationery
(defvar dtk-chunk-separator-syntax ".>)$\""
  "Syntax string to identify chunks when splitting text.")
                                        ; make it buffer local:
(make-variable-buffer-local 'dtk-chunk-separator-syntax)
(defsubst dtk-complement-chunk-separator-syntax ()
  "Return complement of syntactic class that splits clauses."
  (declare (special dtk-chunk-separator-syntax ))
  (concat "^" dtk-chunk-separator-syntax ))

;;; set chunk separator to match both whitespace and punctuations:
(defsubst dtk-chunk-on-white-space-and-punctuations()
  (declare (special dtk-chunk-separator-syntax))
  (setq dtk-chunk-separator-syntax
        (concat  dtk-chunk-separator-syntax " " )))

(defsubst dtk-chunk-only-on-punctuations()
  (declare (special dtk-chunk-separator-syntax))
  (setq dtk-chunk-separator-syntax
        (delete-if
         #'(lambda (x) (= x 32 ))
         dtk-chunk-separator-syntax)))

;;; invariance: looking at complement
;;; move across the complement and the following separator
;;; return value is a boolean indicating if we moved.
;;; side-effect is to move across a chunk
(defsubst  dtk-move-across-a-chunk (separator complement )
  "Move over a chunk of text.
Chunks are defined  based on major modes.
Argument SEPARATOR  is the syntax class of chunk separators.
Argument COMPLEMENT  is the complement of separator."
  (> (+ (skip-syntax-forward complement)
        (skip-syntax-forward separator))
     0))

;;; efficient way of voice changing

(defsubst dtk-speak-using-voice (voice text)
  "Use voice VOICE to speak text TEXT."
  (declare (special tts-voice-reset-code))
  (unless (or (eq 'inaudible voice )
              (and (listp voice)
                   (member 'inaudible voice)))
    (dtk-interp-queue
     (format "%s%s %s \n"
             (cond
              ((symbolp voice)
               (tts-get-voice-command
                (if (boundp  voice )
                    (symbol-value voice )
                  voice)))
              ((listp voice)
               (mapconcat  #'(lambda (v)
                               (tts-get-voice-command
                                (if (boundp  v )
                                    (symbol-value v )
                                  v)))
                           voice
                           " "))
              (t       ""))
             text
             tts-voice-reset-code))))

;;;Internal function used by dtk-speak to send text out.
;;;Handles voice locking etc.
;;; assumes in dtk-scratch-buffer
;;;start and end give the extent of the
;;;text to be spoken.
;;; note that property auditory-icon at the start  of a clause
;;; causes the sound
;;; to be queued.

(defsubst tts-get-overlay-personality (position)
  "Return personality at the front of the overlay list at position."
  (car
   (delete nil
           (mapcar
            #'(lambda (o)
                (overlay-get o 'personality))
            (overlays-at position)))))

(defsubst tts-get-overlay-auditory-icon (position)
  "Return auditory icon  at the front of the overlay list at position."
  (car
   (delete nil
           (mapcar
            #'(lambda (o)
                (overlay-get o 'auditory-icon))
            (overlays-at position)))))

(defsubst next-true-single-property-change (start  prop object  limit)
  "Similar to next-single-property-change, but compares property values with equal if they are not atoms."
  (let ((initial-value (get-text-property start  prop object)))
    (if (atom initial-value)
	(next-single-property-change start prop object limit)
      (let ((pos start))
	(while  (and (< pos limit)
		     (equal initial-value (get-text-property pos prop object)))
	  (setq pos (next-single-property-change pos prop object limit)))
	pos))))

(defsubst dtk-format-text-and-speak (start end )
  "Format and speak text.
Arguments START and END specify region to speak."
  (declare (special voice-lock-mode dtk-speaker-process
                    tts-voice-reset-code
                    emacspeak-use-auditory-icons))
  (when (and emacspeak-use-auditory-icons
             (get-text-property start 'auditory-icon))
    (emacspeak-queue-auditory-icon
     (get-text-property start 'auditory-icon)))
  (dtk-interp-queue (format "%s\n" tts-voice-reset-code))
  (cond
   (voice-lock-mode
    (let ((last  nil)
          (personality (get-text-property start 'personality )))
      (while (and (< start end )
                  (setq last
                        (next-true-single-property-change start 'personality
                                                      (current-buffer) end)))
        (if personality
            (dtk-speak-using-voice personality
                                   (buffer-substring start last ))
          (dtk-interp-queue (buffer-substring  start last)))
        (setq start  last
              personality
              (get-text-property last  'personality))) ; end while
      ))                                               ; end clause
   (t (dtk-interp-queue (buffer-substring start end  )))))

                                        ;Force the speech.
(defsubst dtk-force ()
  "Cause server to process all queued requests."
  (declare (special dtk-speaker-process))
  (dtk-interp-speak))

                                        ;Write out the string to the tts via TCLSH.
                                        ;No quoting is done, if want to quote the text, see dtk-speak
(defsubst dtk-dispatch (string)
  "Send request STRING to speech server."
  (declare (special dtk-speaker-process
                    dtk-speak-server-initialized
                    dtk-quiet))
  (unless dtk-quiet
    (when dtk-speak-server-initialized
      (dtk-interp-dispatch string ))))

;;;###autoload
(defsubst dtk-stop ()
  "Stop speech now."
  (interactive)
  (declare (special dtk-speaker-process))
  (dtk-interp-stop))

(defsubst dtk-reset-default-voice()
  (declare (special tts-default-voice))
  (dtk-dispatch (tts-get-voice-command tts-default-voice )))

;;}}}
;;{{{  adding cleanup patterns:

;;;###autoload
(defun dtk-add-cleanup-pattern (&optional delete )
  "Add this pattern to the list of repeating patterns that
are cleaned up.  Optional interactive prefix arg deletes
this pattern if previously added.  Cleaning up repeated
patterns results in emacspeak speaking the pattern followed
by a repeat count instead of speaking all the characters
making up the pattern.  Thus, by adding the repeating
pattern `.' (this is already added by default) emacspeak
will say ``aw fifteen dot'' when speaking the string
``...............'' instead of ``period period period period
''"
  (interactive "P")
  (declare (special dtk-cleanup-patterns ))
  (cond
   (delete
    (setq dtk-cleanup-patterns
          (delete
           (read-from-minibuffer "Specify repeating pattern to delete: ")
           dtk-cleanup-patterns)))
   (t (setq dtk-cleanup-patterns
            (cons
             (read-from-minibuffer "Specify repeating pattern: ")
             dtk-cleanup-patterns )))))

;;}}}
;;{{{  producing output

;;; Filter function to record last output from tcl

(defsubst dtk-filter-function (proc output)
  "Filter function for speech server.
Argument PROC is the server process.
Argument OUTPUT is the newly arrived output."
  (declare (special dtk-last-output))
  (setq dtk-last-output output))
;;; Uses the syntax table belonging to the buffer that owns the text
;;; to parse and speak the text intelligently.

(defvar dtk-speak-treat-embedded-punctuations-specially t
  "*If T then speech not split at embedded punctuations.")

(defvar dtk-speak-skim-scale 1.2
  "*Scale factor applied to speech rate when skimming.")

;;}}}
;;{{{ helper --generate state switcher:
;;;###autoload
(defun ems-generate-switcher (command switch documentation )
  "Generate desired command to switch the specified state."
  (eval
   `(defun ,command  (&optional prefix)
      ,documentation
      (interactive "P")
      (declare (special dtk-speaker-process ,switch ))
      (cond
       (prefix
        (setq-default  ,switch
                       (not  (default-value  ',switch)))
        (setq ,switch (default-value ',switch )))
       (t  (make-local-variable ',switch)
           (setq ,switch (not ,switch ))))
      (when (interactive-p)
        (emacspeak-auditory-icon (if ,switch 'on 'off))
        (message "Turned %s %s  %s."
                 (if ,switch "on" "off" )
                 ',switch
                 (if prefix "" " locally"))))))

;;}}}
;;{{{  sending commands

;;;###autoload
(defun dtk-set-rate (rate    &optional prefix)
  "Set speaking RATE for the tts.
Interactive PREFIX arg means set   the global default value, and then set the
current local  value to the result."
  (interactive
   (list
    (read-from-minibuffer "Enter new rate: ")
    current-prefix-arg))
  (declare (special dtk-speech-rate dtk-speaker-process
                    tts-default-speech-rate
                    dtk-program dtk-speak-server-initialized))
  (when dtk-speak-server-initialized
    (cond
     (prefix
      (setq tts-default-speech-rate rate)
      (setq-default dtk-speech-rate rate )
      (setq dtk-speech-rate rate))
     (t (setq dtk-speech-rate rate)))
    (dtk-interp-set-rate rate)
    (when prefix
      (tts-configure-synthesis-setup dtk-program))
    (when (interactive-p)
      (message "Set speech rate to %s %s"
               rate
               (if prefix "" "locally")))))

;;;###autoload
(defun dtk-set-predefined-speech-rate (&optional prefix)
  "Set speech rate to one of nine predefined levels.
Interactive PREFIX arg says to set the rate globally.
Formula used is:
rate = dtk-speech-rate-base + dtk-speech-rate-step * level."
  (interactive "P")
  (declare (special dtk-speech-rate-step
                    dtk-speech-rate-base
                    last-input-char))
  (let ((level
         (condition-case nil
             (read (format "%c" last-input-char ))
           (error nil ))))
    (or (numberp level)
        (setq level
              (read-minibuffer "Enter level between 1 and 9 to set
speech rate:")))
    (cond
     ((or (not (numberp level))
          (< level 0)
          (> level  9))
      (error "Invalid level %s" level ))
     (t (dtk-set-rate
         (+ dtk-speech-rate-base
            (* dtk-speech-rate-step  level ))
         prefix )
        (when (interactive-p)
          (message "Set speech rate to level %s %s"
                   level
                   (if prefix " globaly " " locally ")))))))

;;;###autoload
(defun dtk-set-character-scale (factor &optional prefix)
  "Set scale FACTOR for   speech rate.
Speech rate is scaled by this factor
when speaking characters.
Interactive PREFIX arg means set   the global default value, and then set the
current local  value to the result."
  (interactive "nEnter new factor:\nP")
  (declare (special dtk-character-scale dtk-speaker-process
                    dtk-speak-server-initialized))
  (when dtk-speak-server-initialized
    (cond
     (prefix
      (setq-default dtk-character-scale factor)
      (setq dtk-character-scale factor))
     (t (make-local-variable 'dtk-character-scale)
        (setq dtk-character-scale factor)))
    (dtk-interp-set-character-scale dtk-character-scale)
    (when (interactive-p)
      (message "Set character scale factor to %s %s"
               dtk-character-scale
               (if  prefix ""  "locally")))))

(ems-generate-switcher 'dtk-toggle-quiet
                       'dtk-quiet
                       "Toggles state of  dtk-quiet.
Turning on this switch silences speech.
Optional interactive prefix arg causes this setting to become global.")

(ems-generate-switcher 'dtk-toggle-stop-immediately-while-typing
                       'dtk-stop-immediately-while-typing
                       "Toggle state of variable `dtk-stop-immediately-while-typing'.
As the name implies, if T then speech flushes immediately as you
type.  Optional argument PREFIX specifies if the setting applies
to all buffers.")

(ems-generate-switcher 'dtk-toggle-split-caps
                       'dtk-split-caps
                       "Toggle split caps mode.
Split caps mode is useful when reading
Hungarian notation in program source code.  Interactive PREFIX arg
means toggle the global default value, and then set the current local
value to the result.")

(ems-generate-switcher 'dtk-toggle-strip-octals
                       'tts-strip-octals
                       "Toggle stripping of octals.
Interactive prefix arg means
 toggle the global default value, and then set the current local
value to the result.")

(ems-generate-switcher' dtk-toggle-capitalization
                        'dtk-capitalize
                        "Toggle capitalization.
when set, capitalization is indicated by a
short beep.  Interactive PREFIX arg means toggle the global default
value, and then set the current local value to the result.")

(ems-generate-switcher' dtk-toggle-speak-nonprinting-chars
                        'dtk-speak-nonprinting-chars
                        "Toggle speak-nonprinting-chars.
Switches behavior of how characters with the high bit set are handled.
Interactive PREFIX arg means toggle the global default
value, and then set the current local value to the result.")

(ems-generate-switcher'dtk-toggle-allcaps-beep
 'dtk-allcaps-beep
 "Toggle allcaps-beep.
when set, allcaps words  are  indicated by a
short beep.  Interactive PREFIX arg means toggle the global default
value, and then set the current local value to the result.
Note that allcaps-beep is a very useful thing when programming.
However it is irritating to have it on when reading documents.")

(ems-generate-switcher 'dtk-toggle-debug
                       'dtk-debug
                       "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 by using command \\[tts-show-debug-buffer].
Note: *speaker* is a hidden buffer, ie it has a leading space in its name.")

;;;###autoload
(defun dtk-set-punctuations  (mode &optional prefix )
  "Set punctuation mode to MODE.
Possible values are `some', `all', or `none'.
Interactive PREFIX arg means set   the global default value, and then set the
current local  value to the result."
  (interactive
   (list
    (intern
     (completing-read  "Enter punctuation mode: "
                       dtk-punctuation-mode-alist
                       nil
                       t))
    current-prefix-arg))
  (declare (special dtk-punctuation-mode dtk-speaker-process
                    dtk-speak-server-initialized
                    dtk-punctuation-mode-alist))
  (when dtk-speak-server-initialized
    (cond
     (prefix
      (setq dtk-punctuation-mode mode )
      (setq-default dtk-punctuation-mode mode))
     (t (make-local-variable 'dtk-punctuation-mode)
        (setq dtk-punctuation-mode mode )))
    (dtk-interp-set-punctuations mode)
    (when (interactive-p)
      (message "set punctuation mode to %s %s"
               mode
               (if prefix "" "locally")))))

;;;###autoload
(defun dtk-set-punctuations-to-all (&optional prefix )
  "Set punctuation  mode to all.
Interactive PREFIX arg sets punctuation mode globally."
  (interactive "P")
  (dtk-set-punctuations 'all prefix))

;;;###autoload
(defun dtk-set-punctuations-to-some (&optional prefix )
  "Set punctuation  mode to some.
Interactive PREFIX arg sets punctuation mode globally."
  (interactive "P")
  (dtk-set-punctuations 'some prefix))

;;;###autoload
(defun dtk-toggle-punctuation-mode (&optional prefix)
  "Toggle punctuation mode between \"some\" and \"all\".
Interactive PREFIX arg makes the new setting global."
  (interactive "P")
  (declare (special dtk-punctuation-mode))
  (cond
   ((eq 'all  dtk-punctuation-mode)
    (dtk-set-punctuations-to-some prefix ))
   ((eq 'some  dtk-punctuation-mode )
    (dtk-set-punctuations-to-all prefix )))
  (when (interactive-p)
    (message "set punctuation mode to %s %s"
             dtk-punctuation-mode
             (if prefix "" "locally"))))

;;;###autoload
(defun dtk-reset-state ()
  "Restore sanity to the Dectalk.
Typically used after the Dectalk has been power   cycled."
  (interactive)
  (declare (special  dtk-speaker-process
                     dtk-speak-server-initialized))
  (when dtk-speak-server-initialized
    (dtk-interp-reset-state)))

;;;###autoload
(defun tts-speak-version ()
  "Speak version."
  (interactive)
  (dtk-interp-say-version))

;;}}}
;;{{{  pause and resume
(defvar dtk-paused nil
  "Records if speech has been paused.")

;;;###autoload
(defun dtk-pause (&optional prefix)
  "Pause ongoing speech.
The speech can be resumed with command `dtk-resume'
normally bound to \\[dtk-resume].  Pausing speech is useful when one needs to
perform a few actions before continuing to read a large document.  Emacspeak
gives you speech feedback as usual once speech has been paused.  `dtk-resume'
continues the interrupted speech irrespective of the buffer
in which it is executed.
Optional PREFIX arg flushes any previously paused speech."
  (interactive "P")
  (declare (special dtk-paused))
  (cond
   ((not dtk-paused)
    (dtk-interp-pause)
    (setq dtk-paused t)
    (emacspeak-auditory-icon 'button))
   ((and (interactive-p)
         prefix
         dtk-paused)
    (dtk-interp-pause)
    (dtk-speak "Flushed previously paused speech ")
    (setq dtk-paused t))
   ((and dtk-paused
         (interactive-p))
    (emacspeak-auditory-icon 'warn-user))))
;;;###autoload
(defcustom dtk-resume-should-toggle t
  "*T means `dtk-resume' acts as a toggle."
  :type 'boolean
  :group 'tts)

;;;###autoload
(defun dtk-resume ()
  "Resume paused speech.
This command resumes  speech that has been suspended by executing
command `dtk-pause' bound to \\[dtk-pause].
If speech has not been paused,
and option `dtk-resume-should-toggle' is set,
 then this command will pause ongoing speech."
  (interactive)
  (declare (special dtk-speaker-process
                    dtk-resume-should-toggle
                    dtk-paused))
  (cond
   ((and dtk-resume-should-toggle
         (not dtk-paused))
    (dtk-pause))
   ((and (not dtk-paused)
         (not dtk-resume-should-toggle))
    (dtk-speak "No speech to resume."))

   (t (dtk-interp-resume)
      (emacspeak-auditory-icon 'button)
      (setq dtk-paused nil))))

;;}}}
;;{{{  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  'all
  "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].  .")


(make-variable-buffer-local 'dtk-punctuation-mode)
;;; forward declaration
(defvar emacspeak-servers-directory
  (expand-file-name
   "servers/"
   emacspeak-directory))

(defun tts-setup-servers-alist ()
  "Sets up tts servers alist from file servers/.servers.
File .servers is expected to contain name of one server per
no line --with no white space."
  (declare (special emacspeak-servers-directory
                    dtk-servers-alist))
  (let ((result nil)
        (start nil)
        (scratch (get-buffer-create " *servers*"))
        (this nil))
    (save-current-buffer
      (set-buffer scratch)
      (setq buffer-undo-list t)
      (erase-buffer)
      (insert-file-contents
       (expand-file-name ".servers"
                         emacspeak-servers-directory))
      (goto-char (point-min))
      (while (not (eobp))
        (setq start (point))
        (unless
            (looking-at  "^#")
          (end-of-line)
          (setq this (buffer-substring-no-properties start (point)))
          (push this result))
        (forward-line 1)))
    (setq dtk-servers-alist result)))

(defvar dtk-servers-alist nil
  "Used for completion when prompting for TTS server.
This variable is automatically setup to reflect the
available TTS servers.")

;;}}}
;;{{{  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 "")
  "Maps characters to pronunciation strings.")
(declaim (special dtk-character-to-speech-table ))

;;;  Assign entries in the table:
(defun dtk-speak-setup-character-table ()
  "Setup pronunciations in the character table for the Dectalk."
  (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  " ")              ;shows up on WWW pages
    (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 ")))

(dtk-speak-setup-character-table)
;;}}}
;;{{{  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)
  "Translate CHAR to speech string."
  (declare (special dtk-character-to-speech-table))
  (if  (eq (char-charset char) 'ascii)
	  (aref dtk-character-to-speech-table char )
	(or (dtk-unicode-short-name-for-char char)
		 (format "octal %o"  char ))))

;;}}}
;;{{{  interactively selecting the server:

(defvar tts-voice-reset-code nil
  "Code sent to reset the voice to its default.
This is setup on a per engine basis.")

;;; will be reset on a per TTS engine basis.
(defalias 'tts-get-voice-command 'dectalk-get-voice-command)

(defun tts-configure-synthesis-setup (&optional tts-name)
  "Setup synthesis environment. "
  (declare (special dtk-program emacspeak-auditory-icon-function
                    tts-voice-reset-code))
  (unless tts-name (setq tts-name dtk-program))
  (cond
   ((string-match "outloud" tts-name)
    (outloud-configure-tts))
   ((string-match "multispeech" tts-name)
    (multispeech-configure-tts))
   ((string-match "espeak" tts-name)
    (espeak-configure-tts))
   ((string-match "dtk-" tts-name)      ;all dectalks
    (dectalk-configure-tts))
   ((string-match "eflite" tts-name)
	(flite-configure-tts))
   (t (dectalk-configure-tts)           ; will become
                                        ; generic-configure)))
      ))
  (when (string-match "^ssh" tts-name)  ;remote server
    (setq emacspeak-auditory-icon-function 'emacspeak-serve-auditory-icon))
  (load-library "voice-setup")
  (setq tts-voice-reset-code (tts-get-voice-command tts-default-voice)))

;;; forward declaration.
;;;###autoload
(defun dtk-select-server (program )
  "Select a speech server interactively.
Argument PROGRAM specifies the speech server program.
When called  interactively, The selected server is started immediately. "
  (interactive
   (list
    (completing-read
     "Select speech server:"
     (or dtk-servers-alist
         (tts-setup-servers-alist))
     nil
     t  )))
  (declare (special   dtk-program dtk-servers-alist
                      emacspeak-servers-directory emacspeak-ssh-tts-server))
  (let ((ssh-server (format "ssh-%s" dtk-program)))
    (setq dtk-program program)
    (tts-configure-synthesis-setup dtk-program)
    (when (file-exists-p (expand-file-name ssh-server emacspeak-servers-directory))
      (setq emacspeak-ssh-tts-server ssh-server)
      (setq-default emacspeak-ssh-tts-server ssh-server))
    (when (interactive-p)
      (dtk-initialize))))

;;}}}
;;{{{  initialize the speech process

(defvar dtk-debug nil
  "Set this to t if you want to debug the synthesizer server.")
(make-variable-buffer-local 'dtk-debug)

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

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

(defvar tts-debug-buffer " *speaker*"
  "Buffer holding speech server debug output.")

(defun  dtk-initialize ()
  "Initialize speech system."
  (declare (special dtk-program tts-debug-buffer dtk-speak-process-connection-type
                    dtk-speaker-process  dtk-debug
                    dtk-speak-server-initialized
                    dtk-startup-hook emacspeak-servers-directory))
  (let ((new-process nil)
        (process-connection-type  dtk-speak-process-connection-type)
        (dtk-program (expand-file-name dtk-program
                                       emacspeak-servers-directory)))
    (setq new-process
          (start-process
           "speaker"
           (and dtk-debug tts-debug-buffer)
           (expand-file-name dtk-program
                             emacspeak-servers-directory)))
    (setq dtk-speak-server-initialized
          (or (eq 'run (process-status new-process ))
              (eq 'open (process-status new-process))))
    (cond
     (dtk-speak-server-initialized
      ;; nuke old server
      (when (and dtk-speaker-process
                 (or (eq 'run (process-status dtk-speaker-process ))
                     (eq 'open (process-status dtk-speaker-process ))
                     (eq 'stop (process-status dtk-speaker-process ))))
        (delete-process dtk-speaker-process ))
      (setq dtk-speaker-process new-process)
	  (set-process-coding-system dtk-speaker-process 'utf-8 'utf-8)
      (tts-configure-synthesis-setup dtk-program)
      (run-hooks 'dtk-startup-hook ))
     (t
      (when (interactive-p)
        (message "The speech server is not running."))))))
;;;###autoload
(defun tts-restart ()
  "Use this to nuke the currently running TTS server and restart it."
  (interactive)
  (dtk-initialize ))

;;;###autoload
(defun tts-show-debug-buffer ()
  "Select TTS debugging buffer."
  (interactive)
  (declare (special tts-debug-buffer))
  (switch-to-buffer tts-debug-buffer))

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

;;;###autoload
(defun dtk-toggle-splitting-on-white-space ()
  "Toggle splitting of speech on white space.
This affects the internal 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)
    (when (interactive-p)
      (message "Text will be split at punctuations and white space when speaking") ))
   (t (dtk-chunk-only-on-punctuations)
      (when (interactive-p)
        (message "Text split  at clause boundaries")))))

;;;###autoload
(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.
Argument S specifies the syntax class."

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

;;}}}
;;{{{ speak text

(defun dtk-speak (text &optional ignore-skim)
  "Speak the TEXT string on the  tts.
This is achieved by sending the text to the speech server.
No-op if variable `dtk-quiet' is set to t.
If option `outline-minor-mode' is on and selective display is in effect,
only speak upto the first ctrl-m."
  (declare (special dtk-speaker-process dtk-stop-immediately
                    tts-strip-octals
                    inhibit-point-motion-hooks
                    dtk-speak-server-initialized emacspeak-use-auditory-icons
                    dtk-speech-rate
                    dtk-speak-nonprinting-chars
                    dtk-speak-treat-embedded-punctuations-specially
                    dtk-quiet  dtk-chunk-separator-syntax
                    voice-lock-mode   dtk-punctuation-mode
                    dtk-split-caps
                    emacspeak-pronounce-pronunciation-table
                    selective-display ))
                                        ; ensure  the process  is live
  (unless (or (eq 'run (process-status dtk-speaker-process ))
              (eq 'open (process-status dtk-speaker-process )))
    (dtk-initialize))
                                        ; If you dont want me to talk,
                                        ;or my server is not
                                        ;running, I will remain silent.
  (unless
      (or dtk-quiet
          (not dtk-speak-server-initialized))
                                        ; flush previous speech if asked to
    (when dtk-stop-immediately (dtk-stop ))
    (dtk-interp-sync)
    (or (stringp text) (setq text (format "%s" text )))
    (when selective-display
      (let ((ctrl-m (string-match "\015" text )))
        (and ctrl-m
             (setq text (substring  text 0 ctrl-m ))
             (emacspeak-auditory-icon 'ellipses))))
    (let ((inhibit-point-motion-hooks t)
          (invisibility-spec buffer-invisibility-spec)
          (syntax-table (syntax-table ))
          (inherit-speaker-process dtk-speaker-process)
          (pronunciation-table emacspeak-pronounce-pronunciation-table)
          (use-auditory-icons emacspeak-use-auditory-icons)
          (inherit-chunk-separator-syntax dtk-chunk-separator-syntax )
          (inherit-speak-nonprinting-chars
           dtk-speak-nonprinting-chars)
          (inherit-strip-octals tts-strip-octals)
          (complement-separator(dtk-complement-chunk-separator-syntax ))
          (speech-rate dtk-speech-rate)
		  (inherit-enable-multibyte-characters enable-multibyte-characters)
          (dtk-scratch-buffer (get-buffer-create " *dtk-scratch-buffer* "))
          (start 1)
          (end nil )
          (mode dtk-punctuation-mode)
          (split-caps dtk-split-caps)
          (voice-lock voice-lock-mode ))
      (save-current-buffer
        (set-buffer dtk-scratch-buffer )
        (setq buffer-undo-list t)
        (let ((inhibit-read-only t))
          (erase-buffer)
                                        ; inherit environment
          (setq buffer-invisibility-spec invisibility-spec
                dtk-chunk-separator-syntax inherit-chunk-separator-syntax
                dtk-speaker-process inherit-speaker-process
                dtk-speech-rate speech-rate
                emacspeak-use-auditory-icons use-auditory-icons
                dtk-punctuation-mode mode
                dtk-split-caps split-caps
                dtk-speak-nonprinting-chars
                inherit-speak-nonprinting-chars
                tts-strip-octals inherit-strip-octals
                voice-lock-mode voice-lock)
          (set-syntax-table syntax-table )
		  (set-buffer-multibyte inherit-enable-multibyte-characters)
          (insert  text)
          (delete-invisible-text)
          (when pronunciation-table
            (tts-apply-pronunciations
             pronunciation-table))
		  (dtk-unicode-replace-chars mode)
          (dtk-handle-repeating-patterns mode)
          (dtk-quote mode))
        (goto-char (point-min))
        (skip-syntax-forward inherit-chunk-separator-syntax)
        (while (and (not (eobp))
                    (dtk-move-across-a-chunk
                     inherit-chunk-separator-syntax
                     complement-separator))
                                        ;if we matched a punctuation,
                                        ;treat this as a chunk only if the punctuation is followed
                                        ;by white space
                                        ;dtk-speak-treat-embedded-punctuations-specially
                                        ;has been T for a long time
          (unless
              (and (char-after  (point))
                   (= (char-syntax (preceding-char )) ?.)
                   (not (= 32 (char-syntax (following-char )))))
            (setq end (point ))
            (dtk-format-text-and-speak  start end )
            (setq start  end)))         ; end while
                                        ; process trailing text
        (or  (= start (point-max))
             (dtk-format-text-and-speak start (point-max)))))
    (dtk-force)))

(defun dtk-speak-list (text &optional group-count)
  "Speak a  list of strings.
Argument TEXT  is the list of strings to speak.
Optional argument group-count specifies grouping for intonation."
  (declare (special dtk-speaker-process))
  (let ((dtk-scratch-buffer (get-buffer-create " *dtk-scratch-buffer* "))
        (contents nil)
        (counter 1)
        (len (length text))
        (inhibit-read-only t))
    (save-current-buffer
      (set-buffer dtk-scratch-buffer )
      (setq buffer-undo-list t)
      (erase-buffer)
      (loop  for element in text
             do
             (insert
              (format "%s%s "
                      element
                      (cond
                       ((null group-count) "")
                       ((= len counter) ". ")
                       ((and group-count
                             (zerop (% counter group-count)))
                        ", ")
                       (t ""))))
             (incf counter))
      (setq contents (buffer-string)))
    (dtk-speak contents)))

(defsubst dtk-letter (letter)
  "Speak a LETTER."
  (declare (special dtk-speaker-process
                    dtk-speak-server-initialized
                    dtk-quiet ))
  (unless dtk-quiet
    (when dtk-speak-server-initialized
      (dtk-interp-letter  letter ))))
(defun dtk-say (words)
  "Say these WORDS."
  (declare (special dtk-speaker-process dtk-stop-immediately
                    dtk-speak-server-initialized dtk-quiet))
  ;; I wont talk if you dont want me to
  (unless dtk-quiet
    (or (eq 'run (process-status dtk-speaker-process ))
        (eq 'open (process-status dtk-speaker-process ))
        (dtk-initialize))
    (when dtk-speak-server-initialized
      (and dtk-stop-immediately (dtk-stop ))
      (dtk-interp-say words))))

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

;;{{{  emacs local variables

;;; local variables:
;;; folded-file: t
;;; byte-compile-dynamic: t
;;; end:

;;}}}