;;; biff-mode.el --- multi-lingual biff bark support ;; ;; Author: Franklin Lee ;; Created: 12/1997 ;; Keywords: dogs bark i18n biff fun ;; Version: 0.7.9 ;; ;; Copyright (C) 1997, 1998 Franklin Lee ;; ;; This program 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. ;; ;; biff-mail.el is distributed in the hope that it will be amusing, 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. ;; ;;; Commentary: ;;; {{{ ;; ;; Usage ;; ----- ;; Put this in your .emacs and have fun! ;; ;; (autoload 'speak-biff! "biff-mode" "make biff speak" t) ;; ;; This has been tested on: ;; - FSF Emacs 19.34 on Solaris 2.5.1 and Windows 95 ;; ;; Bug reports and suggestions are welcome -- send them to Franklin Lee ;; . ;; ;; Also: if you know how dogs "bark" in other languages, please let me ;; know! ;; ;; THANKS TO: ;; ---------- ;; ;; i18n of dog barks: ;; ;; Professor Catherine Ball and her great ;; "Sounds of the World's Animals" page at ;; ;; http://www.georgetown.edu/cball/animals/animals.html ;; ;; and also her linguistic informants: ;; ;; dmm@stp.co.za; enremok@esumail.emporia.edu; Cristina Sanz, Alfons ;; Morales, Joaquim Camps (Spanish, Georgetown); Roxanne Hsu Feldman, ;; Fairrosa Cyber Library http://www.users.interport.net/~fairrosa/; ;; Kees.Huyser@nikhefk.nikhef.nl; gjhsmith@easynet.co.uk; ;; taylork@gusun.acc.georgetown.edu; akuosa@cc.helsinki.fi; Patrick Laude, ;; Madeleine Soudée (French, Georgetown), Florence Quist (DEFL, ;; Georgetown); Dominique_Estival@muwayf.unimelb.edu.au; ;; diane.dibiasio@sympatico.ca; Peter Pfeiffer, Stefan Fink (German, ;; Georgetown); Deborah Tannen (Linguistics, Georgetown); ;; akonstan@acm.org; urihores@zoot.tau.ac.il; nachmag@ashur.cc.biu.ac.il; ;; bercese@gusun.acc.georgetown.edu; Muhamad Ichsan Misbah (DEFL, ;; Georgetown); Waruno Mahdi (Berlin); Anna de Fina (Linguistics, ;; Georgetown); boma@mc.village.it; Kanako Ohara, Yuji Nakazato, Mitsuko ;; Yamura (Linguistics, Georgetown); Maiko Chiba, Megumi Taguchi, Takumi ;; Koyama, Kay; Ichihara (DEFL, Georgetown), Junko Saruwatari Sungwon Joo ;; (DEFL, Georgetown); Hyouk-Keun Kim (Linguistics, Georgetown); Francisco ;; Espada, Dpt. Linguistica, Universidade de Evora ; ;; J. P. Prates Ramalho, Dpt. Quimica, Universidade de Evora; Brazil: ;; Maria Louzada (Georgetown); sklyanin@kurims.kyoto-u.ac.jp; Spain: Maria ;; Eugenia de Frutos (DEFL, Georgetown); Cristina Sanz (Spanish, ;; Georgetown); Argentina: JoAnne Negrin-Cristiani and Adrian Cristiani ;; (Linguistics, Georgetown); Colombia: Eduardo Merheg (DEFL, Georgetown); ;; Costa Rica: Ariel Miremberg (Georgetown); Paraguay: Santiago Jure ;; (DEFL, Georgetown); Peru: Juan Carlos Cabrejos (Georgetown); Venezuela: ;; Diana Oyarzabal (Georgetown); Jussi Karlgren (Swedish Institute of ;; Computer Science, Stockholm); Jesper Olsson (Lund University); indaporn ;; Sangganjanavanish, Sirintip Seubsunk, Wirote Aroonmanakun (Linguistics, ;; Georgetown), Walaipan Viriyabusaya, Thirayuth Chotipatoomwan (DEFL, ;; Georgetown); eraerol@kieras90a.ericsson.se; aksud@gusun.georgetown.edu; ;; Larissa Zakletska (Linguistics, Georgetown); ;; protopap@bekas.cog.brown.edu; Lauinger_staff@guvax.acc.georgetown.edu; ;; loehrd@gusun.acc.georgetown.edu; epod@iol.ie; s2177689@cse.unsw.edu.au; ;; s2177689@cse.unsw.edu.au; TINE@MMF.ruc.dk; dinavahi@owlnet.rice.edu; ;; vuvo@acslink.aone.net.au; Janusz@mcc.ac.uk; marx@bworld.com.ph; ;; hardray1@crct.vic.edu.au; shed@gusun.georgetown.edu; ;; almejiah@gusun.georgetown.edu; MART@abs.ee ;; ;; ;; also: ;; ;; Maria Eklund && Sara Gustavsson ;; at Uppsala University, Sweden for their ;; multilingual codex of sounds found in Asterix' comics at ;; ;; http://strindberg.ling.uu.se/~mariae/Asterix/asterixsa.html ;; ;; ;; also: ;; ;; The discussion participants at the ESL Discussion Center at ;; ;; http://www.eslcafe.com/discussion/wwwboard11/message/123.html ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; also for i18n of dog barks: ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; and a continually *growing* list of i18n barkers (to be credited in ;; subsequent versions of biff-mode (!) just as soon as I collate my ;; mail). ;; ;;; History: ;; -------- ;; ;; 11/??/1997 versions 0.0000001 through 0.5: initial versions ;; ;; 12/21/1997 version 0.6: added dohash macro ;; ;; 12/28/1997 version 0.7: started i18n of biff messages. ;; ;; 01/02/1998 version 0.7.5: even more i18n. ;; ;; 01/11/1998 version 0.7.8: first incarnation of biff-mode as a separate ;; lisp source file. this makes loading epop3mail faster for those who ;; have epop3-biff-show-barks as nil. also, adding new languages won't ;; munge epop3mail's source code. separated dohash macro to its own ;; file. ;; ;; 01/23/1998 version 0.7.9: more dog barks gleaned from the web. ;; ;; 01/31/1998 version 0.8: minor change to biff-european-displayed-p. ;; added another couple of barks. ;; ;; 04/19/1998 version 0.800000000001: added speak-biff!-change-region ;; macro to practice writing macros. ;; ;; 05/22/1998 version 0.800000000002: another bark: estonian! ;;; }}} ;;; Code: (eval-when-compile (or (featurep 'cl) (load "cl"))) (require 'epop3hash) ;; ;; for FULL display of biff-barks, we need standard-display-european). ;; if standard-display-european is disabled, we have the ascii ;; approximation ;; (defvar biff-barks '(;; each entry is in the form ("intl-bark" "ascii-bark" "lang" ["lang"...]) ;; try to keep these in ascii sort order... ("Auh Auh!" "Auh Auh!" "estonian") ("Bjeff Bjeff!" "Bjeff Bjeff!" "norwegian") ("Haff Haff!" "Haff! Haff!" "czech") ("Arf!" "Arf!" "english (usa)") ("Asu!" "Asu!" "javanese") ("Au Au!" "Au Au!" "portuguese") ("Aw-Aw!" "Aw-Aw!" "tagalog") ("Bau Bau!" "Bau Bau!" "italian") ("Bhauji!" "Bhauji!" "punjabi") ("Bhav!" "Bhav!" "hindi" "kashmiri") ("Bhavchee!" "Bhavchee!" "bangladeshi") ("Bog Bog!" "Bog Bog!" "thai") ("Boh Boh!" "Boh Boh!" "telegu") ("Boj' Boj'!" "Boj' Boj'!" "esperanto") ("Bow-wow!" "Bow-wow!" "english (usa)") ("Bup Bup!" "Bup Bup!" "catalan") ("Byrcð!" "Byrcth!" "english (old)") ("Cham Cham!" "Cham Cham!" "romanian") ("Gaf Gaf!" "Gaf Gaf!" "ukrainian") ("Gav Gav!" "Gav Gav!" "greek" "russian") ("Gaw Gaw!" "Gaw Gaw!" "vietnamese") ("Gläfs!" "Glaefs!" "swedish") ("Gong Gong!" "Gong Gong!" "indonesian") ("Guv Guv!" "Guv Guv!" "russian") ("Hau Hau!" "Hau Hau!" "finnish" "polish" "hebrew" "holo (taiwan)") ("Haup Haup!" "Haup Haup!" "farsi") ("Hav Hav!" "Hav Hav!" "hebrew" "turkish") ("Haw Haw!" "Haw Haw!" "arabic (algerian)") ("How How!" "How How!" "arabic (kuwaiti)") ("Hoàng Hoàng!" "Hoang Hoang!" "thai") ("Huk Huk Huk!" "Huk Huk Huk!" "indonesian") ("Kef Kef!" "Kef Kef!" "afrikaans") ("Mung Mung!" "Mung Mung!" "korean") ("Myung Myung!" "Mung Mung!" "korean") ("Ouaf Ouaf!" "Ouaf Ouaf!" "french");; (Idefix's bark) ("Ouah Ouah!" "Ouah Ouah!" "french") ("Ouap Ouap!" "Ouap Ouap!" "french");; (Idefix's bark) ("Rowf!" "Rowf!" "english (usa)") ("Ruff!" "Ruff!" "english (usa)") ("Uah Uah!" "Uah Uah!" "italian") ("Vaff!" "Vaff!" "norwegian") ("Vag Vag!" "Vag Vag!" "farsi") ("Vaoo!" "Vaoo!" "swedish") ("Vau Vau!" "Vau Vau!" "hungarian" "croatian" "serbian") ("Vo Vo!" "Vo Vo!" "madagascar") ("Voff!" "Voff!" "swedish" "norwegian") ("Voo Voo!" "Voo Voo!" "swedish") ("Vov Vov!" "Vov Vov!" "swedish" "norwegian" "danish") ("Vovr Vovr!" "Vovr Vovr!" "norse (old)" "icelandic (old)") ("Vuf!" "Vuf!" "finnish" "danish") ("Waf!" "Waf!" "flemish" "french (canadian)") ("Wan Wan!" "Wan Wan!" "japanese") ("Wau!" "Wau!" "german") ("Woef!" "Woef!" "afrikaans" "dutch" "flemish") ("Woo Woo!" "Woo Woo!" "swahili") ("Woof!" "Woof!" "english (usa)") ("Wouah!" "Wouah!" "french");; (Milou's bark) ("Wouf!" "Wouf!" "french (canadian)") ("Wroef!" "Wroef!" "dutch") ("Wu Wu!" "Wu Wu!" "swahili") ("Wuff!" "Wuff!" "german" "irish") ("Wàh Wàh!" "Wah Wah!" "chinese (taiwan)") ("Wòh Wòh!" "Woh Woh!" "chinese (cantonese)") ("Wóng Wóng!" "Wong Wong!" "chinese (mandarin)") ("Yap!" "Yap!" "english (usa)") ("Yip!" "Yip!" "english (usa)") ("¡Guau Guau!" "Guau Guau!" "spanish") ("¡Guof Guof!" "Guof Guof!" "spanish") ("¡Woof!" "Woof!" "spanish") ("Öff Öff!" "Oeff Oeff!" "swedish") ) "I18n of dog barks for 'biff' -- more languages are needed!. Note: the disproportionate number of american-english barks is due only to the author's excessive familiarity with the subtleties of this dialect and is not meant to be an imperialist cultural statement. ;-). Please see the code preamble comments for the sources of these transliterations.") (defvar biff-barks-by-language nil "An alist of barks, indexed by language.") (defvar speak-biff!-mode-map nil "Map for Speak, Biff! mode.") (defvar speak-biff!-buffer nil "Buffer object for Speak, Biff! mode.") (defconst speak-biff!-string "Speak, Biff!") (defconst speak-biff!-field-regexp (concat "\\(" "[a-zA-Z-]+ " ;;; exactly one word "\\(" ;;; with an optional grouping of... "\\(([^)]*) \\)?" ;;; something in parens and a space (optional) "\\(\[[0-9]*\] \\)?" ;;; followed maybe by "[digits] " "\\W+" ;;; followed by necessary whitespace "\\)?" ;;; "\\)" )) (defun biff-get-bark () "Generate a (random) bark string." (let ((barklist (biff-random-elt biff-barks))) ;; make nice to people who don't have standard-display-european enabled (if (biff-european-displayed-p) (car barklist) (cadr barklist)))) (defun biff-get-languages-for (bark) "Given a BARK, return the list of languages for that bark." (interactive "sBark? ") (let ((result)) (dolist (barklist biff-barks result) (when (string= bark (if (biff-european-displayed-p) (car barklist) (cadr barklist))) (setq result (cddr barklist)))))) (defun biff-european-displayed-p () "Return t if `standard-display-european' is enabled." (interactive) ;; this test comes from disp-table.el (let ((result (and (char-table-p standard-display-table) ;; Test 161, because 160 displays as a space. (equal (aref standard-display-table 161) [161])))) (prog1 result (when (interactive-p) (message (format "%s" (if result "t" "nil"))))))) (defun biff-random-elt (seq) "Pick a random element from sequence SEQ. This works on both vectors and lists." (elt seq (random (length seq)))) (defun biff-car-string< (i j) "Predicate to sort a list of lists of strings by the first element. I and J are the two strings compared." (string< (car i) (car j))) (defun biff-invert-barks (barks &optional asciify) "Inverts the bark list BARKS to create an index by language. If ASCIIFY is non-nil, use the ascii bark instead of the international bark." (let ((reference nil) (result nil) (tab (make-hash-table :test 'equal))) (dolist (elem barks tab) (setq reference (if asciify (cadr elem) (car elem))) (dolist (referent (cddr elem)) (if (gethash referent tab) (push reference (gethash referent tab)) (puthash referent (list reference) tab)))) (epop3-dohash (key dat tab result) (setf result (acons key (reverse dat) result))))) (defun biff-add-number-of-barks-to (alist) "Add length string \" [N]\" to the cars of ALISTs members." (mapc '(lambda (lst) (when (> (length (cdr lst)) 1) (setf (car lst) (concat (car lst) (format " [%d]" (length (cdr lst))))))) alist)) (defun biff-index-by-language (barklist) "Return an alist of barks indexed by language, given BARKLIST. If `standard-display-european' is set, use the internationalized barks, otherwise use the ascii approximation barks." (biff-add-number-of-barks-to (sort (biff-invert-barks barklist (not (biff-european-displayed-p))) 'biff-car-string<))) (defun biff-longest-car-of (alist) "Find the longest car of the elements of ALIST." (apply 'max (mapcar (lambda (lst) (length (car lst))) alist))) (defun biff-insert-languages (language-list) "Format and insert LANGUAGE-LIST strings into current buffer at point." (let* ((column-width (+ 2 (biff-longest-car-of language-list))) (ncolumns (/ (1- (window-width)) column-width)) (fmt (format "%s-%ds" "%" column-width))) (forward-line 1);; temporary (dotimes (i (length language-list)) (let ((p (point)) (ext nil)) (insert (format fmt (car (nth i language-list)))) (setq ext (make-overlay p (point))) (overlay-put ext 'mouse-face 'highlight) (overlay-put ext 'language-num i)) (when (zerop (mod (1+ i) ncolumns)) (insert "\n"))))) (defun speak-biff!-language-index-at-pos (pos) "Return the language index corresponding to point POS, or nil." (interactive "d") (get-char-property pos 'language-num)) (defun speak-biff!-region (on) "Turn ON or off 'region' highlighting on the current language overlay." (overlay-put (car (overlays-at (point))) 'face (if on 'region 'default))) (defmacro speak-biff!-change-region (&rest body) "Turns off biff-region before executing BODY, then re-enables it after. Used to bracket operations which move point in the biff-buffer." `(progn (speak-biff!-region nil) ,@body (speak-biff!-region t))) ;; make nice on the indentations! (put 'speak-biff!-change-region 'lisp-indent-function 0) (defun speak-biff!-mouse-set-point (event) "Set point via mouse in Speak, Biff! buffer based on EVENT. Don't set the point unless the mouse click is on a language. Return t if the point was set, nil otherwise." (interactive "e") (let ((posn (event-end event))) (when (and (string= mode-name speak-biff!-string) (windowp (posn-window posn)) (numberp (posn-point posn)) (speak-biff!-language-index-at-pos (posn-point posn))) (speak-biff!-change-region (mouse-set-point event) (goto-char (speak-biff!-beginning-of-field)))))) (defun speak-biff!-mouse-bark! (event) "Mouse version of the `speak-biff!-bark!' function, using EVENT." (interactive "e") (when (speak-biff!-mouse-set-point event) (speak-biff!-bark!))) (defun speak-biff!-mouse-all-bark! (event) "Show all barks for the language at `mouse-set-point' EVENT." (interactive "e") (when (speak-biff!-mouse-set-point event) (message (mapconcat 'identity (cdr (nth (speak-biff!-language-index-at-pos (point)) biff-barks-by-language)) " ")))) (defun speak-biff!-bark! () "Displays a bark for a given language in the Speak, Biff! buffer." (interactive) (when (string= mode-name speak-biff!-string) (let ((i (get-char-property (point) 'language-num))) (when i (message (biff-random-elt (cdr (nth i biff-barks-by-language)))))))) (defun speak-biff!-up () "Action taken when the 'up' key is pressed." (interactive) (when (save-excursion (previous-line 1) (speak-biff!-language-index-at-pos (point))) (speak-biff!-change-region (previous-line 1)))) (defun speak-biff!-down () "Action taken when the 'down' key is pressed." (interactive) (when (save-excursion (next-line 1) (speak-biff!-language-index-at-pos (point))) (speak-biff!-change-region (next-line 1)))) (defun speak-biff!-beginning-of-field () "Return the beginning of the current language overlay, or nil." (if (speak-biff!-language-index-at-pos (point)) (overlay-start (car (overlays-at (point)))) nil)) (defun speak-biff!-prev-field () "Action taken when M-TAB or 'left' key is pressed." (interactive) (unless (= 0 (or (speak-biff!-language-index-at-pos (point)) 0)) (speak-biff!-change-region (if (re-search-backward speak-biff!-field-regexp nil t) (forward-word -1))))) (defun speak-biff!-next-field () "Action taken when the TAB or 'right' key is pressed." (interactive) (let ((max-idx (1- (length biff-barks-by-language)))) (unless (= max-idx (or (speak-biff!-language-index-at-pos (point)) max-idx)) (speak-biff!-change-region (re-search-forward speak-biff!-field-regexp nil t))))) (defun speak-biff!-quit () "Exit and delete the Speak, Biff! buffer." (interactive) (when (string= mode-name speak-biff!-string) (kill-this-buffer) (setq speak-biff!-buffer nil))) (defun biff-make-speak-biff!-mode-map () "Initialize `speak-biff!-mode-map'." (setq speak-biff!-mode-map (make-sparse-keymap "Speak, Biff!")) (define-key speak-biff!-mode-map "\C-p" 'speak-biff!-up) (define-key speak-biff!-mode-map [up] 'speak-biff!-up) (define-key speak-biff!-mode-map "\C-n" 'speak-biff!-down) (define-key speak-biff!-mode-map [down] 'speak-biff!-down) (define-key speak-biff!-mode-map [return] 'speak-biff!-bark!) (define-key speak-biff!-mode-map "q" 'speak-biff!-quit) (define-key speak-biff!-mode-map "Q" 'speak-biff!-quit) (define-key speak-biff!-mode-map [linefeed] 'ignore) (define-key speak-biff!-mode-map [tab] 'speak-biff!-next-field) (define-key speak-biff!-mode-map [right] 'speak-biff!-next-field) (define-key speak-biff!-mode-map "\C-a" 'ignore) (define-key speak-biff!-mode-map "\C-e" 'ignore) (define-key speak-biff!-mode-map "\M->" 'ignore) (define-key speak-biff!-mode-map "\M-<" 'ignore) (define-key speak-biff!-mode-map "\M-\t" 'speak-biff!-prev-field) (define-key speak-biff!-mode-map "[shift-tab]" 'speak-biff!-prev-field) (define-key speak-biff!-mode-map [left] 'speak-biff!-prev-field) (define-key speak-biff!-mode-map [drag-mouse-1] 'ignore) (define-key speak-biff!-mode-map [down-mouse-1] 'ignore) (define-key speak-biff!-mode-map [mouse-1] 'speak-biff!-mouse-set-point) (define-key speak-biff!-mode-map [double-mouse-1] 'speak-biff!-mouse-bark!) (define-key speak-biff!-mode-map [down-mouse-2] 'ignore) (define-key speak-biff!-mode-map [mouse-2] 'speak-biff!-mouse-bark!) (define-key speak-biff!-mode-map [down-mouse-3] 'ignore) (define-key speak-biff!-mode-map [mouse-3] 'speak-biff!-mouse-all-bark!) t) (defconst speak-biff!-text-1 "Double-click mouse-1 or click mouse-2 on a language to cause Biff to bark in that language.\n") (defconst speak-biff!-text-2 "Clicking mouse-3 on a language will cause Biff to show you his entire vocabulary in that language.\n") (defconst speak-biff!-text-3 "In this buffer, type RET to make Biff bark in the language near point.\n") (defconst speak-biff!-text-4 "Pressing 'q' will quit this buffer.\n\n") (defun speak-biff!-insert-buffer-text () "Set up the text for the Speak, Biff! buffer. This assumes it is already the current buffer." (let ((p nil)) (goto-char (point-min)) (insert speak-biff!-text-1) (insert speak-biff!-text-2) (insert speak-biff!-text-3) (insert speak-biff!-text-4) (setq p (point)) (biff-insert-languages biff-barks-by-language) (goto-char p) (speak-biff!-region t))) (defun speak-biff!-mode () "Mode to make Biff sit up and speak by language. \\[speak-biff!-up] Move up \\[speak-biff!-down] Move down \\[speak-biff!-bark!] Bark in the selected language. \\[speak-biff!-quit] Quit Speak, Biff! mode." (interactive) (kill-all-local-variables) (biff-make-speak-biff!-mode-map) (use-local-map speak-biff!-mode-map) (setq mode-name speak-biff!-string) (setq major-mode 'speak-biff!-mode) (setq buffer-read-only t)) (defun speak-biff! () "Enter Speak, Biff! mode." (interactive) (when (null speak-biff!-buffer) (setq speak-biff!-buffer (generate-new-buffer speak-biff!-string) biff-barks-by-language (biff-index-by-language biff-barks)) (save-excursion (set-buffer speak-biff!-buffer) (speak-biff!-insert-buffer-text) (speak-biff!-mode))) (switch-to-buffer speak-biff!-buffer)) (provide 'biff-mode) ;;; biff-mode.el ends here