path: root/x-symbol/lisp/x-symbol-unicode.el

;;; x-symbol-unicode.el --- provide some Unicode tables for X-Symbol.
;;
;; Author: David Aspinall
;;
;; X-Symbol is really a bit of a dinosaur and will be replaced
;; by something else sooner or later.  In the meantime it's handy
;; to support Unicode character sets using the same interface
;; as the existing X-Symbol.

(require 'x-symbol-unichars)		;; Unicode names & positions

(defconst x-symbol-xsym-unicode-map	;; X-symbol names -> Unicode names
					;; [ FIXME: please complete/extend! ]
  '((visiblespace "SYMBOL FOR SPACE")
    (Gamma "GREEK CAPITAL LETTER GAMMA")
    (Delta "GREEK CAPITAL LETTER DELTA")
    (Theta "GREEK CAPITAL LETTER THETA")
    (Lambda "GREEK CAPITAL LETTER LAMDA")
    (Pi "GREEK CAPITAL LETTER PI")
    (Sigma "GREEK CAPITAL LETTER SIGMA")
    (Phi "GREEK CAPITAL LETTER PHI")
    (Psi "GREEK CAPITAL LETTER PSI")
    (Omega "GREEK CAPITAL LETTER OMEGA")
    (alpha "GREEK SMALL LETTER ALPHA")
    (beta "GREEK SMALL LETTER BETA")
    (gamma "GREEK SMALL LETTER GAMMA")
    (delta "GREEK SMALL LETTER DELTA")
    (epsilon1 "GREEK SMALL LETTER EPSILON")
    (zeta "GREEK SMALL LETTER ZETA")
    (eta "GREEK SMALL LETTER ETA")
    (theta "GREEK SMALL LETTER THETA")
    (kappa1 "GREEK SMALL LETTER KAPPA")
    (lambda "GREEK SMALL LETTER LAMDA")
    (mu "GREEK SMALL LETTER MU")
    (nu "GREEK SMALL LETTER NU")
    (xi "GREEK SMALL LETTER XI")
    (pi "GREEK SMALL LETTER PI")
    (rho1 "GREEK SMALL LETTER RHO")
    (sigma "GREEK SMALL LETTER SIGMA")
    (tau "GREEK SMALL LETTER TAU")
    (phi1 "GREEK SMALL LETTER PHI")
    (chi "GREEK SMALL LETTER CHI")
    (psi "GREEK SMALL LETTER PSI")
    (omega "GREEK SMALL LETTER OMEGA")
    (notsign "NOT SIGN")
    (logicaland "LOGICAL AND")
    (logicalor "LOGICAL OR")
    (universal1 "FOR ALL")
    (existential1 "THERE EXISTS")
    (epsilon "GREEK SMALL LETTER EPSILON")
    (biglogicaland "N-ARY LOGICAL AND")
    (ceilingleft "LEFT CEILING")
    (ceilingright "RIGHT CEILING")
    (floorleft "LEFT FLOOR")
    (floorright "RIGHT FLOOR")
    (bardash "RIGHT TACK")
    (bardashdbl "TRUE")
    (semanticsleft "LEFT WHITE SQUARE BRACKET")
    (semanticsright "RIGHT WHITE SQUARE BRACKET")
    (periodcentered "MIDDLE DOT")
    (element "ELEMENT OF")
    (reflexsubset "SUBSET OF OR EQUAL TO")
    (intersection "INTERSECTION")
    (union "UNION")
    (bigintersection "N-ARY INTERSECTION")
    (bigunion "N-ARY UNION")
    (sqintersection "SQUARE CAP")
    (squnion "SQUARE CUP")
    (bigsqintersection "N-ARY SQUARE INTERSECTION OPERATOR")
    (bigsqunion "N-ARY SQUARE UNION OPERATOR")
    (perpendicular "UP TACK")
    (dotequal "IDENTICAL WITH DOT ABOVE")
    (wrong "WREATH PRODUCT")
    (equivalence "IDENTICAL TO")
    (notequal "NOT EQUAL TO")
    (propersqsubset "SQUARE IMAGE OF")
    (reflexsqsubset "SQUARE IMAGE OF OR EQUAL TO")
    (properprec "PRECEDES")
    (reflexprec "PRECEDES OR EQUAL TO")
    (propersucc "SUCCEEDS")
    (approxequal "APPROXIMATELY EQUAL TO")
    (similar "TILDE OPERATOR") ;; FIXME: check
    (simequal "ASYMPTOTICALLY EQUAL TO")
    (lessequal "LESS-THAN OR EQUAL TO")
    (coloncolon "\\<Colon>")
    (arrowleft "LEFTWARDS ARROW")
    (endash "EN DASH")
    (arrowright "RIGHTWARDS ARROW")
    (arrowdblleft "LEFTWARDS DOUBLE ARROW")
;   (nil "\\<Midarrow>")
    (arrowdblright "RIGHTWARDS DOUBLE ARROW")
    (frown "FROWN")
    (mapsto "RIGHTWARDS ARROW FROM BAR")
    (leadsto "RIGHTWARDS SQUIGGLE ARROW")
    (arrowup "UPWARDS ARROW")
    (arrowdown "DOWNWARDS ARROW")
    (notelement "NOT AN ELEMENT OF")
    (multiply "MULTIPLICATION SIGN")
    (circleplus "CIRCLED PLUS")
    (circleminus "CIRCLED MINUS")
    (circlemultiply "CIRCLED TIMES")
    (circleslash "CIRCLED DIVISION SLASH")
    (propersubset "SUBSET OF")
    (infinity "INFINITY")
    (box "OPEN BOX")
    (lozenge1 "DIAMOND OPERATOR")
    (circ "RING OPERATOR")
    (bullet "BULLET")
    (bardbl "DOUBLE VERTICAL LINE")
    (radical "RADICAL SYMBOL BOTTOM")
    (copyright "COPYRIGHT SIGN")
    (Xi "GREEK CAPITAL LETTER XI")
    (Upsilon1 "GREEK CAPITAL LETTER UPSILON")
    (iota "GREEK SMALL LETTER IOTA")
    (upsilon "GREEK SMALL LETTER UPSILON")
    (plusminus "PLUS-MINUS SIGN")
    (division "DIVISION SIGN")
    (longarrowright "LONG RIGHTWARDS ARROW")
    (longarrowleft "HEAVY TRIANGLE-HEADED LEFTWARDS ARROW")
    (longarrowboth "LONG LEFT RIGHT ARROW")
    (longarrowdblright "LONG RIGHTWARDS DOUBLE ARROW")
    (longarrowdblleft "LONG LEFTWARDS DOUBLE ARROW")
    (longarrowdblboth "LONG LEFT RIGHT DOUBLE ARROW")
    (brokenbar "BROKEN BAR")
    (hyphen "HYPHEN")
    (macron "MACRON>")
    (exclamdown "INVERTED EXCLAMATION MARK")
    (questiondown "INVERTED QUESTION MARK")
    (guillemotleft "LEFT-POINTING DOUBLE ANGLE QUOTATION MARK")
    (guillemotright "RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK")
    (degree "DEGREE SIGN")
    (onesuperior "SUPERSCRIPT ONE")
    (onequarter "VULGAR FRACTION ONE QUARTER")
    (twosuperior "SUPERSCRIPT TWO")
    (onehalf "VULGAR FRACTION ONE HALF")
    (threesuperior "SUPERSCRIPT THREE")
    (threequarters "VULGAR FRACTION THREE QUARTERS")
    (paragraph "PILCROW SIGN")
    (registered "REGISTERED SIGN")
    (ordfeminine "FEMALE SIGN")
    (masculine "MALE SIGN")
    (section "SECTION SIGN")
    (sterling "POUND SIGN")
    (yen "YEN SIGN")
    (cent "CENT SIGN")
    (currency "CURRENCY SIGN")
    (braceleft2 "LEFT CURLY BRACKET")
    (braceright2 "RIGHT CURLY BRACKET")
    (top "DOWN TACK")
    (congruent "IDENTICAL TO")
    (club "BLACK CLUB SUIT")
    (diamond "BLACK DIAMOND SUIT")
    (heart "BLACK HEART SUIT")
    (spade "BLACK SPADE SUIT")
    (arrowboth "LEFT RIGHT ARROW")
    (greaterequal "GREATER-THAN OR EQUAL TO")
    (proportional "PROPORTIONAL TO")
    (partialdiff "PARTIAL DIFFERENTIAL")
    (ellipsis "HORIZONTAL ELLIPSIS")
    (aleph "ALEF SYMBOL")
    (Ifraktur "BLACK-LETTER CAPITAL I")
    (Rfraktur "BLACK-LETTER CAPITAL R")
    (weierstrass "SCRIPT CAPITAL P") ;; ??
    (emptyset "EMPTY SET")
    (angle "ANGLE")
    (gradient "NABLA")
    (product "N-ARY PRODUCT")
    (arrowdblboth "LEFT RIGHT DOUBLE ARROW")
    (arrowdblup "UPWARDS DOUBLE ARROW") ;; not on my mac
    (arrowdbldown "DOWNWARDS DOUBLE ARROW") ;; not on my mac
    (angleleft "LEFT ANGLE BRACKET")
    (angleright "RIGHT ANGLE BRACKET")
    (summation "N-ARY SUMMATION")
    (integral "INTEGRAL")
    (circleintegral "CONTOUR INTEGRAL")
    (dagger "DAGGER")
    (sharp "MUSIC SHARP SIGN")
    (star "STAR OPERATOR")
    (smltriangleright "WHITE RIGHT-POINTING SMALL TRIANGLE")
    (triangleleft "NORMAL SUBGROUP OF")
    (triangle "RIGHT TRIANGLE") ;; ???
    (triangleright "CONTAINS AS NORMAL SUBGROUP")
    (trianglelefteq "NORMAL SUBGROUP OF OR EQUAL TO")
    (trianglerighteq "CONTAINS AS NORMAL SUBGROUP OR EQUAL TO")
    (smltriangleleft "WHITE LEFT-POINTING SMALL TRIANGLE")
    (natural "MUSIC NATURAL SIGN")
    (flat "MUSIC FLAT SIGN")
    (amalg "\\<amalg>")
    (Mho "INVERTED OHM SIGN")
    (arrowupdown "UP DOWN ARROW")
    (longmapsto "LONG RIGHTWARDS SQUIGGLE ARROW") ;; not on my mac
    (arrowdblupdown "UP DOWN DOUBLE ARROW")
    (hookleftarrow "LEFTWARDS HARPOON WITH BARB UPWARDS")
    (hookrightarrow "RIGHTWARDS HARPOON WITH BARB UPWARDS")
    (arrownortheast "NORTH EAST ARROW")
    (arrowsoutheast "SOUTH EAST ARROW")
    (arrownorthwest "NORTH WEST ARROW")
    (arrowsouthwest "SOUTH WEST ARROW")
    (rightleftharpoons "RIGHTWARDS HARPOON OVER LEFTWARDS HARPOON")
    (leftharpoondown "DOWNWARDS HARPOON WITH BARB LEFTWARDS")
    (rightharpoondown "DOWNWARDS HARPOON WITH BARB RIGHTWARDS")
    (leftharpoonup "UPWARDS HARPOON WITH BARB LEFTWARDS")
    (rightharpoonup "UPWARDS HARPOON WITH BARB RIGHTWARDS")
    (asym "ASYMPTOTICALLY EQUAL TO") ;; FIXME: check
    (minusplus "MINUS-OR-PLUS SIGN")
    (bowtie "BOWTIE")
    (centraldots "MIDLINE HORIZONTAL ELLIPSIS")
    (circledot "CIRCLED DOT OPERATOR")
    (propersuperset "SUPERSET OF")
    (reflexsuperset "SUPERSET OF OR EQUAL TO")
    (propersqsuperset "SQUARE ORIGINAL OF")
    (reflexsqsuperset "SQUARE ORIGINAL OF OR EQUAL TO")
    (lessless "MUCH LESS-THAN")
    (greatergreater "MUCH GREATER-THAN")
    (unionplus "MULTISET")
    (backslash3 "SET MINUS")
    (smile "SMILE")
    (reflexsucc "EQUAL TO OR SUCCEEDS")
    (dashbar "LEFT TACK")
    (biglogicalor "N-ARY LOGICAL OR")
    (bigunionplus "MULTISET UNION")
    (daggerdbl "DOUBLE DAGGER")
    (bigbowtie "\\<Join>")
    (booleans "SCRIPT CAPITAL B") ;; no double-struck capital b !
    (complexnums "DOUBLE-STRUCK CAPITAL C")
    (natnums "DOUBLE-STRUCK CAPITAL N")
    (rationalnums "DOUBLE-STRUCK CAPITAL Q")
    (realnums "DOUBLE-STRUCK CAPITAL R")
    (integers "DOUBLE-STRUCK CAPITAL Z")
    (lesssim "LESS-THAN OR EQUIVALENT TO")
    (greatersim "GREATER-THAN OR EQUIVALENT TO")
    (lessapprox "PRECEDES OR EQUIVALENT TO") ;; FIXME check these four!
    (greaterapprox "SUCCEEDS OR EQUIVALENT TO")
    (definedas "EQUAL TO BY DEFINITION") ;; FIXME: should be triangleeq 
    (cataleft "LEFT WHITE PARENTHESIS")
    (cataright "RIGHT WHITE PARENTHESIS")
    (bigcircledot "CIRCLED DOT OPERATOR")
    (bigcirclemultiply "CIRCLED TIMES")
    (bigcircleplus "CIRCLED PLUS")
    (coproduct "N-ARY COPRODUCT")
    (cedilla "CEDILLA")
    (diaeresis "COMBINING DIAERESIS")
    (acute "ACUTE ACCENT")
    (hungarumlaut "DOUBLE ACUTE ACCENT")
    (lozenge "LOZENGE")
    (smllozenge "DIAMOND OPERATOR")
    (dotlessi "TURNED GREEK SMALL LETTER IOTA") ;; ??
    (euro "EURO SIGN")
    (zero1 "SUBSCRIPT ZERO") ;; FIXME: are these supposed to be subs?
    (one1 "SUBSCRIPT ONE")
    (two1 "SUBSCRIPT TWO")
    (three1 "SUBSCRIPT THREE")
    (four1 "SUBSCRIPT FOUR")
    (five1 "SUBSCRIPT FIVE")
    (six1 "SUBSCRIPT SIX")
    (seven1 "SUBSCRIPT SEVEN")
    (eight1 "SUBSCRIPT EIGHT")
    (nine1 "SUBSCRIPT NINE")))

(defconst x-symbol-old-tables 
  ;; combine tables from old style fonts 
  (append
   x-symbol-latin1-table
   x-symbol-latin2-table
   x-symbol-latin3-table
   x-symbol-latin5-table
   x-symbol-latin9-table
   x-symbol-xsymb0-table
   x-symbol-xsymb1-table))


;; Now build a unicode table by grabbing key sequences/shorthands from
;; old tables.  Could easily add extras here, but leave out for now
;; for backward compatibility.

(defconst x-symbol-unicode-table 
  ;; Oh dear, need to split this between tables
  (apply 'append
   (mapcar (lambda (xsymuni)
	     (let ((unicode (assoc-string (cadr xsymuni) 
					  x-symbol-unicode-character-list))
		   (tableinfo (assoc (car xsymuni)
				     x-symbol-old-tables)))
	       (if (and unicode tableinfo ;; need both bits
			(< (cadr unicode) #x3400))
		   (list (cons (car xsymuni)
			       (cons (cadr unicode)
				     (nthcdr 2 tableinfo)))))))
	   x-symbol-xsym-unicode-map)))


(defconst x-symbol-unicode-cset
  '((("mule-unicode-0100-33ff" . mule-unicode-0100-33ff) ?\227 #x33ff)
    (mule-unicode-0100-24ff) .
    (mule-unicode-2500-33ff))
  "Cset with for unicode, see `x-symbol-init-cset'.")




(provide 'x-symbol-unicode)