apl.el -- APL input method

[Markus Triska]

Since some users reported trouble with the previously posted UTF-8
encoded file, I've created an ASCII-only version. Project page:

http://stud4.tuwien.ac.at/~e0225855/unicapl/unicapl.html


;;; apl.el --- APL input method for Emacs

;; Copyright (C) 2007  Markus Triska

;; Author: Markus Triska <address@hidden>
;; Keywords: languages

;; Public domain code.

;;; Commentary:

;; Copy apl.el to your load-path and add to your .emacs:

;;     (require 'apl)

;; Enable the APL input method with

;;     M-x set-input-method RET apl-ascii RET

;; Then enter {iota}, {times}, {execute} etc.

;;; Code:

(defconst apl-version "0.8-ascii")

(defvar apl-aplus-pairs
  '((254 . 8900) (126 . 8764) (161 . 168) (224 . 9014) (162 . 175)
    (230 . 9067) (231 . 9042) (164 . 8804) (232 . 9035) (166 . 8805)
    (244 . 9033) (225 . 8854) (168 . 8800) (240 . 9055) (169 . 8744)
    (185 . 9073) (94 . 8743) (176 . 9074) (171 . 215) (223 . 247)
    (247 . 9021) (173 . 9017) (215 . 9077) (197 . 8712) (229 . 9079)
    (210 . 9076) (217 . 8593) (213 . 8595) (201 . 9075) (233 . 9080)
    (207 . 9675) (239 . 9061) (42 . 8902) (179 . 9055) (251 . 8592)
    (253 . 8594) (220 . 9024) (252 . 9049) (193 . 9082) (225 . 8854)
    (211 . 8968) (196 . 8970) (189 . 8801) (199 . 8711) (231 . 9042)
    (200 . 8710) (202 . 8728) (234 . 9060) (167 . 9020) (204 . 9109)
    (236 . 9054) (45 . 8722) (219 . 8866) (188 . 9026) (221 . 8867)
    (187 . 9020) (218 . 8834) (216 . 8835) (195 . 8745) (227 . 9053)
    (214 . 8746) (194 . 8869) (226 . 9038) (206 . 8868) (238 . 9045)
    (124 . 8739) (175 . 9023) (205 . 8739))
    "ASCII <-> Unicode correspondence of A+ encoding.")

(defvar apl-others
  '(9032 9030 9018 9015 9016 9018 9019 9022 9025 9027 9028 9029
    9030 9031 9032 9034 9036 9039 9040 9041 9043 9044 9046 9047
    9048 9050 9051 9052 9056 9057 9058 9059 9068 9069 9070 9071
    9072 9078 9081 8757 9647 8892 8893 8802 9062 9063 9064 9066
    9065)
    "Unicode codepoints of other APL symbols.")


(defvar apl-aplus-table
  (mapcar (lambda (pair)
            (cons (decode-char 'ucs (car pair))
                  (decode-char 'ucs (cdr pair))))
          apl-aplus-pairs)
  "Translation table mapping A+ characters to Unicode symbols.")

(defvar apl-other-symbols
  (mapcar (lambda (a)
            (decode-char 'ucs a)) apl-others)
    "List of symbols used in some APL dialects.")

(defun apl-symbols ()
  "List of all APL special symbols."
  (append apl-other-symbols (mapcar #'cdr apl-aplus-table)))

(defun apl-set-font (font)
  "Set font for APL characters. FONT is a font as passed to
set-fontset-font and should provide glyphs for all APL characters
that you want to use. An example is GNU unifont. Try
-gnu-unifont-*-r-*--*-*-*-*-*-*-ISO10646-1.  Emacs is becoming
increasingly better at handling Unicode and may choose the right
glyphs for all characters out of the box, sometimes drawing from
various fonts. You can use this function to enforce a uniform
font for all APL characters in that case."
  (dolist (s (apl-symbols))
    (set-fontset-font "fontset-default" s font)))

(defvar apl-aplus-keyboard nil)

(defun apl-toggle-aplus-keyboard ()
  "Toogle translation of A+ keyboard input to Unicode
characters."
  (interactive)
  (setq apl-aplus-keyboard (not apl-aplus-keyboard))
  (dolist (pair apl-aplus-table)
    (keyboard-translate (car pair)
                        (if apl-aplus-keyboard
                            (cdr pair)
                          (car pair)))))

(defun apl-aplus-to-unicode (begin end)
  "Convert A+ symbols in region to Unicode characters."
  (interactive "r")
  (translate-region begin end (make-translation-table apl-aplus-table)))

(defun apl-flip (f) (cons (cdr f) (car f)))

(defun apl-unicode-to-aplus (begin end)
  "Convert APL Unicode characters in region to A+."
  (interactive "r")
  (translate-region begin end
                    (make-translation-table (mapcar #'apl-flip
                                                    apl-aplus-table))))


(when (require 'quail nil t)
  (quail-define-package
   "apl-ascii" "APL" "apl" t
   "APL ASCII input method. Use {rho}, {iota} etc."
   nil t nil nil nil nil nil nil nil nil t)
  (dolist (pair
           '(("{leftbrace}" . 123)
             ("{rightbrace}" . 125)
             ("{scan}" . 92)
             ("{expand}" . 92)
             ("{reduce}" . 47)
             ("{compress}" . 47)
             ("{replicate}" . 47)
             ("{ravel}" . 44)
             ("{catenate}" . 44)
             ("{laminate}" . 44)
             ("{roll}" . 63)
             ("{deal}" . 63)
             ("{diaeresis}" . 168)
             ("{each}" . 168)
             ("{\"}" . 168)
             ("{times}" . 215)
             ("{signum}" . 215)
             ("{x}" . 215)
             ("{reciprocal}" . 247)
             ("{divide}" . 247)
             ("{%}" . 247)
             ("{left-arrow}" . 8592)
             ("{gets}" . 8592)
             ("{assign}" . 8592)
             ("{up-arrow}" . 8593)
             ("{first}" . 8593)
             ("{take}" . 8593)
             ("{right-arrow}" . 8594)
             ("{branch}" . 8594)
             ("{goto}" . 8594)
             ("{down-arrow}" . 8595)
             ("{diamond}" . 8900)
             ("{drop}" . 8595)
             ("{delta}" . 8710)
             ("{/\\}" . 8710)
             ("{del}" . 8711)
             ("{nabla}" . 8711)
             ("{epsilon}" . 8712)
             ("{member-of}" . 8712)
             ("{member}" . 8712)
             ("{enlist}" . 8712)
             ("{type}" . 8712)
             ("{negative}" . 8722)
             ("{minus}" . 8722)
             ("{-}" . 8722)
             ("{jot}" . 8728)
             ("{ring}" . 8728)
             ("{o}" . 8728)
             ("{nazg}" . 8728)
             ("{stile}" . 8739)
             ("{abs}" . 8739)
             ("{residue}" . 8739)
             ("{up-caret}" . 8743)
             ("{and}" . 8743)
             ("{caret}" . 8743)
             ("{down-caret}" . 8744)
             ("{or}" . 8744)
             ("{inverted-caret}" . 8744)
             ("{intersection}" . 8745)
             ("{intersect}" . 8745)
             ("{up-shoe}" . 8745)
             ("{union}" . 8746)
             ("{down-shoe}" . 8746)
             ("{diaresis-dot}" . 8757)
             ("{paw}" . 8757)
             ("{not-equal}" . 8800)
             ("{/=}" . 8800)
             ("{match}" . 8801)
             ("{depth}" . 8801)
             ("{=_}" . 8801)
             ("{not-match}" . 8802)
             ("{/match}" . 8802)
             ("{/=_}" . 8802)
             ("{<=}" . 8804)
             ("{less-than-equal}" . 8804)
             ("{>=}" . 8805)
             ("{greater-than-equal}" . 8805)
             ("{left-shoe}" . 8834)
             ("{enclose}" . 8834)
             ("{partition}" . 8834)
             ("{right-shoe}" . 8835)
             ("{disclose}" . 8835)
             ("{pick}" . 8835)
             ("{circle-dash}" . 8854)
             ("{rotate}" . 8854)
             ("{O-}" . 8854)
             ("{right-tack}" . 8866)
             ("{lev}" . 8866)
             ("{|-}" . 8866)
             ("{left-tack}" . 8867)
             ("{dex}" . 8867)
             ("{-|}" . 8867)
             ("{down-tack}" . 8868)
             ("{represent}" . 8868)
             ("{T}" . 8868)
             ("{encode}" . 8868)
             ("{up-tack}" . 8869)
             ("{base}" . 8869)
             ("{decode}" . 8869)
             ("{and-overbar}" . 8892)
             ("{nand}" . 9074)
             ("{~^}" . 9074)
             ("{or-overbar}" . 8893)
             ("{nor}" . 9073)
             ("{~v}" . 9073)
             ("{star}" . 8902)
             ("{pow}" . 8902)
             ("{exp}" . 8902)
             ("{ceiling}" . 8968)
             ("{greater-of}" . 8968)
             ("{max}" . 8968)
             ("{floor}" . 8970)
             ("{lesser-of}" . 8970)
             ("{min}" . 8970)
             ("{I-beam}" . 9014)
             ("{I}" . 9014)
             ("{squish-quad}" . 9015)
             ("{squad}" . 9015)
             ("{index}" . 9015)
             ("{quad-equal}" . 9016)
             ("{#=}" . 9016)
             ("{quad-divide}" . 9017)
             ("{#%}" . 9017)
             ("{mat-inverse}" . 9017)
             ("{mat-divide}" . 9017)
             ("{domino}" . 9017)
             ("{quad-diamond}" . 9018)
             ("{#&}" . 9018)
             ("{quad-jot}" . 9019)
             ("{#o}" . 9019)
             ("{quad-circle}" . 9020)
             ("{#O}" . 9020)
             ("{circle-stile}" . 9021)
             ("{reverse}" . 9021)
             ("{rotate}" . 9021)
             ("{circle-jot}" . 9022)
             ("{slash-bar}" . 9023)
             ("{compress1}" . 9023)
             ("{reduce1}" . 9023)
             ("{replicate1}" . 9023)
             ("{slope-bar}" . 9024)
             ("{expand1}" . 9024)
             ("{scan1}" . 9024)
             ("{backslash-bar}" . 9024)
             ("{quad-slash}" . 9025)
             ("{#/}" . 9025)
             ("{quad-backslash}" . 9026)
             ("{#\}" . 9026)
             ("{quad-less-than}" . 9027)
             ("{#<}" . 9027)
             ("{quad<}" . 9027)
             ("{quad-greater-than}" . 9028)
             ("{#>}" . 9028)
             ("{quad>}" . 9028)
             ("{leftwards-vane}" . 9029)
             ("{left-vane}" . 9029)
             ("{rightwards-vane}" . 9030)
             ("{right-vane}" . 9030)
             ("{quad<-}" . 9031)
             ("{quad-left-arrow}" . 9031)
             ("{quad->}" . 9032)
             ("{quad-right-arrow}" . 9032)
             ("{circle-backslash}" . 9033)
             ("{transpose}" . 9033)
             ("{O\\}" . 9033)
             ("{uptack-underbar}" . 9034)
             ("{delta-stile}" . 9035)
             ("{/\\|}" . 9035)
             ("{grade-up}" . 9035)
             ("{#v}" . 9036)
             ("{quad-downcaret}" . 9036)
             ("{#/\\}" . 9037)
             ("{quad-delta}" . 9037)
             ("{uptack-jot}" . 9038)
             ("{execute}" . 9038)
             ("{upwards-vane}" . 9039)
             ("{up-vane}" . 9039)
             ("{quad-up-arrow}" . 9040)
             ("{downtack-overbar}" . 9041)
             ("{del-stile}" . 9042)
             ("{grade-down}" . 9042)
             ("{#^}" . 9043)
             ("{quad-up-caret}" . 9043)
             ("{#\\/}" . 9044)
             ("{quad-del}" . 9044)
             ("{quad-nabla}" . 9044)
             ("{format}" . 9045)
             ("{downtack-jot}" . 9045)
             ("{downwards-vane}" . 9046)
             ("{down-vane}" . 9046)
             ("{quad-down-arrow}" . 9047)
             ("{quote_}" . 9048)
             ("{quote-underbar}" . 9048)
             ("{'_}" . 9048)
             ("{delta_}" . 9049)
             ("{delta-underbar}" . 9049)
             ("{/\\_}" . 9049)
             ("{diamond_}" . 9050)
             ("{diamond-underbar}" . 9050)
             ("{&_}" . 9050)
             ("{jot_}" . 9051)
             ("{jot-underbar}" . 9051)
             ("{o_}" . 9051)
             ("{circle_}" . 9052)
             ("{circle-underbar}" . 9052)
             ("{O_}" . 9052)
             ("{upshoe-jot}" . 9053)
             ("{lamp}" . 9053)
             ("{comment}" . 9053)
             ("{quote-quad}" . 9054)
             ("{circle-star}" . 9055)
             ("{log}" . 9055)
             ("{ln}" . 9055)
             ("{O*}" . 9055)
             ("{quad-colon}" . 9056)
             ("{#:}" . 9056)
             ("{snout}" . 9057)
             ("{downtack-diaeresis}" . 9057)
             ("{frog}" . 9058)
             ("{del-diaeresis}" . 9058)
             ("{sourpuss}" . 9059)
             ("{star-diaeresis}" . 9059)
             ("{hoot}" . 9060)
             ("{jot-diaeresis}" . 9060)
             ("{rank}" . 9060)
             ("{o\"}" . 9060)
             ("{holler}" . 9061)
             ("{circle-diaeresis}" . 9061)
             ("{O\"}" . 9061)
             ("{downshoe-stile}" . 9062)
             ("{leftshoe-stile}" . 9063)
             ("{smirk}" . 9064)
             ("{tilde-diaeresis}" . 9064)
             ("{~\"}" . 9064)
             ("{>\"}" . 9065)
             ("{greater-than-diaeresis}" . 9065)
             ("{comma-bar}" . 9066)
             ("{cat-bar}" . 9066)
             ("{catenate1}" . 9066)
             ("{laminate1}" . 9066)
             ("{,-}" . 9066)
             ("{del-tilde}" . 9067)
             ("{\\/~}" . 9067)
             ("{zilde}" . 9068)
             ("{0~}" . 9068)
             ("{stile-tilde}" . 9069)
             ("{|~}" . 9069)
             ("{semicolon-underbar}" . 9070)
             ("{;_}" . 9070)
             ("{#/=}" . 9071)
             ("{quad-not-equal}" . 9071)
             ("{#?}" . 9072)
             ("{quad-question}" . 9072)
             ("{downcaret-tilde}" . 9073)
             ("{upcaret-tilde}" . 9074)
             ("{iota}" . 9075)
             ("{index}" . 9075)
             ("{index-of}" . 9075)
             ("{rho}" . 9076)
             ("{shape}" . 9076)
             ("{reshape}" . 9076)
             ("{omega}" . 9077)
             ("{w}" . 9077)
             ("{alpha-underbar}" . 9078)
             ("{alpha_}" . 9078)
             ("{epsilon-underbar}" . 9079)
             ("{epsilon_}" . 9079)
             ("{find}" . 9079)
             ("{iota_}" . 9080)
             ("{iota-underbar}" . 9080)
             ("{omega_}" . 9081)
             ("{omega-underbar}" . 9081)
             ("{alpha}" . 9082)
             ("{quad}" . 9109)
             ("{box}" . 9109)
             ("{circle}" . 9675)
             ("{pi-times}" . 9675)
             ("{O}" . 9675)
             ("{tilde}" . 8764)
             ("{not}" . 8764)))
    (quail-defrule (car pair) (decode-char 'ucs (cdr pair)))))


(defun apl-version ()
  (interactive)
  (message "Using version %s of apl.el" apl-version))

(provide 'apl)
;;; apl.el ends here