Говорящий SXEmacs

Баловался тут давеча с разными способами более тесной интеграции SXEmacs с Mac OS. Сделал (а точнее стащил из GNU Emacs) интересную функцию, с помощью которой можно запускать различные сценарии AppleScript:

(defun do-applescript (&rest script-lines)
  (let ((script (mapconcat 'identity script-lines "\n"))
        start cmd return)
    (while (string-match "\n" script)
      (setq script (replace-match "\r" t t script)))
    (while (string-match "\"" script start)
      (setq start (+ 2 (match-beginning 0))
            script (replace-match "\\\"" t t script)))
    (setq cmd (concat "osascript -e \"\"\"" script "\"\"\""))
    (setq return (shell-command-to-string cmd))
    (concat "\"" return "\"")))

Применения этой процедуры очевидны. Например можно заставить Growl отображать сообщения SXEmacs:

(defun growl (title message)
  (do-applescript
   "tell application \"GrowlHelperApp\""
   (format "notify with name \"SXEmacs Notification\" title %S description %S application name \"SXEmacs\" image from location \"file:///opt/local/share/sxemacs-22.1.10/etc/sxemacs-icon.png\"" title message)
   "end tell"))

Но, что более интересно, можно научить SXEmacs разговаривать, используя VoiceOver!

(defvar lg-say-voices
  '((agnes . "Agnes") (albert . "Albert") (alex . "Alex")
    (badnews . "BadNews") (bahh . "Bahh") (bells . "Bells")
    (boing . "Boing") (bruce . "Bruce") (bubbles . "Bubbles")
    (cellos . "Cellos") (deranged . "Deranged") (fred . "Fred")
    (goodnews . "GoodNews") (hysterical . "Hysterical") (junior . "Junior")
    (kathy . "Kathy") (organ . "Organ") (princess . "Princess")
    (ralph . "Ralph") (trinoids . "Trinoids") (vicki . "Vicki")
    (victoria . "Victoria") (whisper . "Whisper") (zarvox . "Zarvox")))

(defun lg-say-the-text (text &optional voice)
  (let* ((sv (cdr (assq voice lg-say-voices)))
         (svoice (if sv (format " using %S" sv) ""))
         ;; " -> ' in order to avoid osascript confusion
         (nt (replace-in-string text "\"" "'")))
    (do-applescript (format "say %S%s" nt svoice))
    (growl "Text via VoiceOver" "Done!")))

(defun lg-say-region-or-buffer (arg)
  "Say contents of the buffer or region.
If prefix ARG is specified then use custom voice."
  (interactive "P")
  (let ((voice (and current-prefix-arg
                    (intern
                     (completing-read "Voice: "
                      (mapcar #'(lambda (v)
                                  (list (symbol-name (car v))))
                              lg-say-voices)
                      nil t))))
        (text (if (region-active-p)
                  (buffer-substring (region-beginning) (region-end))
                (buffer-substring))))
    (lg-say-the-text text voice)))

(define-key global-map (kbd "C-c s") 'lg-say-region-or-buffer)

Далее, можно например реализовать процедуру, которая будет читать тело письма в gnus:

(defun lg-gnus-say-article-body ()
  "Say body of the current gnus article."
  (interactive)
  (let ((atxt (with-current-buffer gnus-article-buffer
                (save-restriction
                  (article-goto-body)
                  (buffer-substring (point) (point-max))))))
    (lg-say-the-text atxt)))

Единственная проблема с данной реализацией это то, что SXEmacs блокирует во время выполнения сценария AppleScript. Нужно расширить процедуру do-applescript, чтобы она поддерживала параметр IN-BACKGROUND.

Скачать оригинал