Баловался тут давеча с разными способами более тесной интеграции 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.
Скачать оригинал
