home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Multimed / Multimed.zip / fest-141.zip / festival / lib / festival.el < prev    next >
Lisp/Scheme  |  1999-03-08  |  11KB  |  279 lines
  1. ;;;
  2. ;;;  File: festival.el
  3. ;;;  Emacs Lisp
  4. ;;;
  5. ;;;  Alan W Black  CSTR (awb@cstr.ed.ac.uk) June 1996
  6. ;;;
  7. ;;;  Provide an emacs mode for interfacing to the festival speech
  8. ;;;  synthesizer system
  9. ;;;
  10. ;;;  I've looked at many examples from the emacs Lisp directory
  11. ;;;  copying relevant bits from here and there, so this can only
  12. ;;;  reasonably inherit the GNU licence (GPL)
  13. ;;;
  14. ;;;  Setup:
  15. ;;;  In your .emacs add the following 2 lines to get a Say menu:
  16. ;;;
  17. ;;;  (autoload 'say-minor-mode "festival" "Menu for using Festival." t)
  18. ;;;  (say-minor-mode t)
  19. ;;;  (setq auto-mode-alist 
  20. ;;;     (append '(("\\.festivalrc$" . scheme-mode)) auto-mode-alist))
  21. ;;;
  22. ;;;  The following gives you pretty colors in emacs-19 if you are into
  23. ;;;  such things 
  24. ;;;  ;;;  Some colors for scheme mode
  25. ;;;  (hilit-set-mode-patterns
  26. ;;;   '(scheme-mode)
  27. ;;;   '(
  28. ;;;     (";.*" nil comment)
  29. ;;;     (hilit-string-find ?\\ string)
  30. ;;;     ("^\\s *(def\\s +" "\\()\\|nil\\)" defun)
  31. ;;;     ("^\\s *(defvar\\s +\\S +" nil decl)
  32. ;;;     ("^\\s *(set\\s +\\S +" nil decl)
  33. ;;;     ("^\\s *(defconst\\s +\\S +" nil define)
  34. ;;;     ("^\\s *(\\(provide\\|require\\).*$" nil include)
  35. ;;;     ("(\\(let\\*?\\|cond\\|if\\|or\\|and\\|map\\(car\\|concat\\)\\|prog[n1*]?\\|while\\|lambda\\|function\\|Parameter\\|set\\([qf]\\|car\\|cdr\\)?\\|nconc\\|eval-when-compile\\|condition-case\\|unwind-protect\\|catch\\|throw\\|error\\)[ \t\n]" 1 keyword)))
  36. ;;;  
  37. ;;;
  38. ;;;--------------------------------------------------------------------
  39. ;;;               Copyright (C) Alan W Black 1996
  40. ;;; This code is distributed in the hope that it will be useful,
  41. ;;; but WITHOUT ANY WARRANTY. No author or distributor accepts
  42. ;;; responsibility to anyone for the consequences of using this code
  43. ;;; or for whether it serves any particular purpose or works at all,
  44. ;;; unless explicitly stated in a written agreement.
  45. ;;;
  46. ;;; Everyone is granted permission to copy, modify and redistribute
  47. ;;; this code, but only under the conditions described in the GNU
  48. ;;; Emacs General Public License.  A copy of this license is
  49. ;;; distrubuted with GNU Emacs so you can know your rights and
  50. ;;; responsibilities.  It should be in a file named COPYING.  Among
  51. ;;; other things, the copyright notice and this notice must be
  52. ;;; preserved on all copies.
  53. ;;;--------------------------------------------------------------------
  54. ;;;  
  55.  
  56. (defvar festival-program-name "festival")
  57.  
  58. (defvar festival-process nil)
  59.  
  60. (defvar festival-tmp-file
  61.   (format "/tmp/festival-emacs-tmp-%s" (user-real-login-name))
  62.  "Filename to save input for Festivial.")
  63.  
  64. (defun festival-fast () 
  65.   (interactive)
  66.   (festival-send-command '(Parameter.set 'Duration.Stretch 0.8)))
  67. (defun festival-slow () 
  68.   (interactive)
  69.   (festival-send-command '(Parameter.set 'Duration.Stretch 1.2)))
  70. (defun festival-ndur () 
  71.   (interactive)
  72.   (festival-send-command '(Parameter.set 'Duration.Stretch 1.0)))
  73. (defun festival-intro () 
  74.   (interactive)
  75.   (festival-send-command '(intro)))
  76.  
  77. (defun festival-gsw () 
  78.   (interactive)
  79.   (festival-send-command '(voice_gsw_diphone)))
  80. (defun festival-rab () 
  81.   (interactive)
  82.   (festival-send-command '(voice_rab_diphone)))
  83. (defun festival-ked () 
  84.   (interactive)
  85.   (festival-send-command '(voice_ked_diphone)))
  86. (defun festival-don () 
  87.   (interactive)
  88.   (festival-send-command '(voice_don_diphone)))
  89. (defun festival-welsh () 
  90.   (interactive)
  91.   (festival-send-command '(voice_welsh_hl)))
  92. (defun festival-spanish () 
  93.   (interactive)
  94.   (festival-send-command '(voice_spanish_el)))
  95.  
  96. (defun festival-say-string (string)
  97.    "Send string to festival and have it said"
  98.    (interactive)
  99.    (festival-start-process)
  100.    (process-send-string festival-process 
  101.             (concat "(SayText " (format "%S" string) ")
  102. ")))
  103.  
  104. (defun festival-send-command (cmd)
  105.    "Send command to festival"
  106.    (interactive "px")
  107.    (festival-start-process)
  108.    (process-send-string festival-process (format "%S
  109. " cmd)))
  110.  
  111. (defun festival-process-status ()
  112.   (interactive)
  113.   (if festival-process
  114.       (message (format "Festival process status: %s" 
  115.                (process-status festival-process)))
  116.     (message (format "Festival process status: NONE"))))
  117.  
  118. (defun festival-start-process ()
  119.   "Check status of process and start it if necessary"
  120.   (interactive )
  121.   (let ((process-connection-type t))
  122.     (if (and festival-process
  123.          (eq (process-status festival-process) 'run))
  124.     't
  125.       ;;(festival-kill-festival t)
  126.       (message "Starting new synthesizer process...")
  127.       (sit-for 0)
  128.       (setq festival-process
  129.         (start-process "festival" (get-buffer-create "*festival*")
  130.                festival-program-name)))
  131.     ))
  132.  
  133. (defun festival-kill-process ()
  134.   "Kill festival sub-process"
  135.   (interactive)
  136.   (if festival-process
  137.       (kill-process festival-process))
  138.   (setq festival-process nil)
  139.   (message "Festival process killed"))
  140.  
  141. (defun festival-send-string (string)
  142.   "Send given string to fesitval process."
  143.   (interactive)
  144.   (festival-start-process)
  145.   (process-send-string festival-process string))
  146.  
  147. (defun festival-say-region (reg-start reg-end)
  148.   "Send given region to festival for saying.  This saves the region
  149. as a file in /tmp and then tells festival to say that file.  The
  150. major mode is *not* passed as text mode name to Festival."
  151.   (interactive "r")
  152.   (write-region reg-start reg-end festival-tmp-file)
  153.   (festival-send-command (list 'tts festival-tmp-file nil)))
  154.  
  155. (defun festival-say-buffer ()
  156.   "Send given region to festival for saying.  This saves the region
  157. as a file in /tmp and then tells festival to say that file.  The
  158. major-mode is passed as a text mode to Festival."
  159.   (interactive)
  160.   (write-region (point-min) (point-max) festival-tmp-file)
  161.   ;; Because there may by sgml-like sub-files mentioned 
  162.   ;; ensure festival tracks the buffer's default-directory
  163.   (festival-send-command (list 'cd (expand-file-name default-directory)))
  164.   (if (equal "-mode" (substring (format "%S" major-mode) -5 nil))
  165.       (if (equal "sgml" (substring (format "%S" major-mode) 0 -5))
  166.       (festival-send-command 
  167.        (list 'tts festival-tmp-file "sable"))
  168.     (festival-send-command 
  169.      (list 'tts festival-tmp-file 
  170.            (substring (format "%S" major-mode) 0 -5))))
  171.     (festival-send-command (list 'tts festival-tmp-file nil))))
  172.  
  173. ;;
  174. ;; say-minor-mode provides a menu offering various speech synthesis commands
  175. ;;
  176. (defvar say-minor-mode nil)
  177.  
  178. (defun say-minor-mode (arg)
  179.   "Toggle say minor mode.
  180. With arg, turn say-minor-mode on iff arg is positive."
  181.   (interactive "P")
  182.   (setq say-minor-mode
  183.     (if (if (null arg) (not say-minor-mode)
  184.           (> (prefix-numeric-value arg) 0))
  185.         t))
  186.   (force-mode-line-update))
  187.  
  188. (setq say-params-menu (make-sparse-keymap "Pitch/Duration"))
  189. (fset 'say-params-menu (symbol-value 'say-params-menu))
  190. (define-key say-params-menu [say-fast] '("Fast" . festival-fast))
  191. (define-key say-params-menu [say-slow] '("Slow" . festival-slow))
  192. (define-key say-params-menu [say-ndur] '("Normal Dur" . festival-ndur))
  193.  
  194. (setq say-lang-menu (make-sparse-keymap "Select language"))
  195. (fset 'say-lang-menu (symbol-value 'say-lang-menu))
  196. (define-key say-lang-menu [say-lang-spain1] '("Spanish el" . festival-spanish))
  197. (define-key say-lang-menu [say-lang-welsh1] '("Welsh hl" . festival-welsh))
  198. (define-key say-lang-menu [say-lang-eng3] '("English gsw" . festival-gsw))
  199. (define-key say-lang-menu [say-lang-eng2] '("English don" . festival-don))
  200. (define-key say-lang-menu [say-lang-eng1] '("English rab" . festival-rab))
  201. (define-key say-lang-menu [say-lang-eng1] '("English ked" . festival-ked))
  202. ;(define-key say-params-menu [say-set-dur-stretch] 
  203. ;  '("Set Duration Stretch" . festival-set-dur-stretch))
  204. ;(define-key say-params-menu [say-high] '("High" . festival-high))
  205. ;(define-key say-params-menu [say-low] '("Low" . festival-low))
  206. ;(define-key say-params-menu [say-npit] '("Normal Pitch" . festival-npit))
  207. ;(define-key say-params-menu [say-set-pitch-stretch] 
  208. ;  '("Set Pitch Stretch" . festival-set-pitch-stretch))
  209.  
  210. (setq say-minor-mode-map (make-sparse-keymap))
  211. (setq say-menu (make-sparse-keymap "SAY"))
  212. (define-key say-minor-mode-map [menu-bar SAY] (cons "Say" say-menu))
  213. (define-key say-minor-mode-map [menu-bar SAY festival-intro] '("Festival Intro" . festival-intro))
  214. (define-key say-minor-mode-map [menu-bar SAY festival-process-status] '("Festival status" . festival-process-status))
  215. (define-key say-minor-mode-map [menu-bar SAY festival-kill-process] '("Kill Festival" . festival-kill-process))
  216. (define-key say-minor-mode-map [menu-bar SAY festival-start-process] '("(Re)start Festival" . festival-start-process))
  217. ;;(define-key say-menu [separator-process] '("--"))
  218. ;;(define-key say-menu [params] '("Pitch/Durations" . say-params-menu))
  219. (define-key say-menu [separator-buffers] '("--"))
  220. (define-key say-menu [festival-send-command] '("Festival eval command" . festival-send-command))
  221. (define-key say-menu [say-lang-menu] '("Select language" . say-lang-menu))
  222. (define-key say-menu [festival-say-buffer] '("Say buffer" . festival-say-buffer))
  223. (define-key say-menu [festival-say-region] '("Say region" . festival-say-region))
  224.  
  225.  
  226. (setq minor-mode-map-alist
  227.       (cons
  228.        (cons 'say-minor-mode say-minor-mode-map)
  229.        minor-mode-map-alist))
  230.  
  231. (or (assq 'say-minor-mode minor-mode-alist)
  232.               (setq minor-mode-alist
  233.                     (cons '(say-minor-mode "") minor-mode-alist)))
  234.  
  235. ;;;
  236. ;;;  A FESTIVAL inferior mode  (copied from prolog.el)
  237. ;;;
  238. (defvar inferior-festival-mode-map nil)
  239.  
  240. (defun inferior-festival-mode ()
  241.   "Major mode for interacting with an inferior FESTIVAL process.
  242.  
  243. The following commands are available:
  244. \\{inferior-festival-mode-map}
  245.  
  246. Entry to this mode calls the value of `festival-mode-hook' with no arguments,
  247. if that value is non-nil.  Likewise with the value of `comint-mode-hook'.
  248. `festival-mode-hook' is called after `comint-mode-hook'.
  249.  
  250. You can send text to the inferior FESTIVAL from other buffers
  251. using the commands `send-region', `send-string'
  252.  
  253. Return at end of buffer sends line as input.
  254. Return not at end copies rest of line to end and sends it.
  255. \\[comint-kill-input] and \\[backward-kill-word] are kill commands, imitating normal Unix input editing.
  256. \\[comint-interrupt-subjob] interrupts the shell or its current subjob if any.
  257. \\[comint-stop-subjob] stops. \\[comint-quit-subjob] sends quit signal."
  258.   (interactive)
  259.   (require 'comint)
  260.   (comint-mode)
  261.   (setq major-mode 'inferior-festival-mode
  262.     mode-name "Inferior FESTIVAL"
  263.     comint-prompt-regexp "^festival> ")
  264.   (if inferior-festival-mode-map nil
  265.     (setq inferior-festival-mode-map (copy-keymap comint-mode-map))
  266.     (festival-mode-commands inferior-festival-mode-map))
  267.   (use-local-map inferior-festivalr-mode-map)
  268.   (run-hooks 'festival-mode-hook))
  269.  
  270. ;;;###autoload
  271. (defun run-festival ()
  272.   "Run an inferior FESTIVAL process, input and output via buffer *festival*."
  273.   (interactive)
  274.   (require 'comint)
  275.   (switch-to-buffer (make-comint "festival" festival-program-name))
  276.   (inferior-festival-mode))
  277.  
  278. (provide 'festival)
  279.