Modernize haskell-font-lock-symbols.

Author: gracjan

haskell-font-lock.el

@@ -93,70 +93,50 @@
 
 (defcustom haskell-font-lock-symbols nil
   "Display \\ and -> and such using symbols in fonts.
+
 This may sound like a neat trick, but be extra careful: it changes the
-alignment and can thus lead to nasty surprises w.r.t layout.
-If t, try to use whichever font is available.  Otherwise you can
-set it to a particular font of your preference among `japanese-jisx0208'
-and `unicode'."
+alignment and can thus lead to nasty surprises w.r.t layout."
   :group 'haskell
-  :type '(choice (const nil)
-                 (const t)
-                 (const unicode)
-                 (const japanese-jisx0208)))
+  :type 'boolean)
 
 (defconst haskell-font-lock-symbols-alist
-  (append
-   ;; Prefer single-width Unicode font for lambda.
-   (and (fboundp 'decode-char)
-        (memq haskell-font-lock-symbols '(t unicode))
-        (list (cons "\\" (decode-char 'ucs 955))))
-   ;; The symbols can come from a JIS0208 font.
-   (and (fboundp 'make-char) (fboundp 'charsetp) (charsetp 'japanese-jisx0208)
-        (memq haskell-font-lock-symbols '(t japanese-jisx0208))
-        (list (cons "not" (make-char 'japanese-jisx0208 34 76))
-              (cons "\\" (make-char 'japanese-jisx0208 38 75))
-              (cons "->" (make-char 'japanese-jisx0208 34 42))
-              (cons "<-" (make-char 'japanese-jisx0208 34 43))
-              (cons "=>" (make-char 'japanese-jisx0208 34 77))
-              ;; FIXME: I'd like to either use ∀ or ∃ depending on how the
-              ;; `forall' keyword is used, but currently the rest of the
-              ;; code assumes that such ambiguity doesn't happen :-(
-              (cons "forall" (make-char 'japanese-jisx0208 34 79))))
-   ;; Or a unicode font.
-   (and (fboundp 'decode-char)
-        (memq haskell-font-lock-symbols '(t unicode))
-        (list (cons "not" (decode-char 'ucs 172))
-              (cons "->" (decode-char 'ucs 8594))
-              (cons "<-" (decode-char 'ucs 8592))
-              (cons "=>" (decode-char 'ucs 8658))
-              (cons "()" (decode-char 'ucs #X2205))
-              (cons "==" (decode-char 'ucs #X2261))
-              (cons "/=" (decode-char 'ucs #X2262))
-              (cons ">=" (decode-char 'ucs #X2265))
-              (cons "<=" (decode-char 'ucs #X2264))
-              (cons "!!" (decode-char 'ucs #X203C))
-              (cons "&&" (decode-char 'ucs #X2227))
-              (cons "||" (decode-char 'ucs #X2228))
-              (cons "sqrt" (decode-char 'ucs #X221A))
-              (cons "undefined" (decode-char 'ucs #X22A5))
-              (cons "pi" (decode-char 'ucs #X3C0))
-              (cons "~>" (decode-char 'ucs 8669)) ;; Omega language
-              ;; (cons "~>" (decode-char 'ucs 8605)) ;; less desirable
-              (cons "-<" (decode-char 'ucs 8610)) ;; Paterson's arrow syntax
-              ;; (cons "-<" (decode-char 'ucs 10521)) ;; nicer but uncommon
-              (cons "::" (decode-char 'ucs 8759))
-              (list "." (decode-char 'ucs 8728) ; (decode-char 'ucs 9675)
-                    ;; Need a predicate here to distinguish the . used by
-                    ;; forall <foo> . <bar>.
-                    'haskell-font-lock-dot-is-not-composition)
-              (cons "forall" (decode-char 'ucs 8704)))))
+  '(("\\" . "λ")
+    ("not" . "¬")
+    ("->" . "→")
+    ("<-" . "←")
+    ("=>" . "⇒")
+    ("()" . "∅")
+    ("==" . "≡")
+    ("/=" . "≢")
+    (">=" . "≥")
+    ("<=" . "≤")
+    ("!!" . "‼")
+    ("&&" . "∧")
+    ("||" . "∨")
+    ("sqrt" . "√")
+    ("undefined" . "⊥")
+    ("pi" . "π")
+    ("~>" . "⇝") ;; Omega language
+    ;; ("~>" "↝") ;; less desirable
+    ("-<" . "↢") ;; Paterson's arrow syntax
+    ;; ("-<" "⤙") ;; nicer but uncommon
+    ("::" . "∷")
+    ("." "∘" ; "○"
+     ;; Need a predicate here to distinguish the . used by
+     ;; forall <foo> . <bar>.
+     haskell-font-lock-dot-is-not-composition)
+    ("forall" . "∀"))
   "Alist mapping Haskell symbols to chars.
-Each element has the form (STRING . CHAR) or (STRING CHAR PREDICATE).
+
+Each element has the form (STRING . COMPONENTS) or (STRING
+COMPONENTS PREDICATE).
+
 STRING is the Haskell symbol.
-CHAR is the character with which to represent this symbol.
+COMPONENTS is a representation specification suitable as an argument to
+`compose-region'.
 PREDICATE if present is a function of one argument (the start position
-of the symbol) which should return non-nil if this mapping should be disabled
-at that position.")
+of the symbol) which should return non-nil if this mapping should
+be disabled at that position.")
 
 (defun haskell-font-lock-dot-is-not-composition (start)
   "Return non-nil if the \".\" at START is not a composition operator.
@@ -246,25 +226,15 @@ Regexp match data 0 points to the chars."
   nil)
 
 (defun haskell-font-lock-symbols-keywords ()
-  (when (fboundp 'compose-region)
-    (let ((alist nil))
-      (dolist (x haskell-font-lock-symbols-alist)
-        (when (and (if (fboundp 'char-displayable-p)
-                       (char-displayable-p (if (consp (cdr x)) (cadr x) (cdr x)))
-                     (if (fboundp 'latin1-char-displayable-p)
-                         (latin1-char-displayable-p (if (consp (cdr x))
-                                                        (cadr x)
-                                                      (cdr x)))
-                       t))
-                   (not (assoc (car x) alist))) ; Not yet in alist.
-          (push x alist)))
-      (when alist
-        `((,(regexp-opt (mapcar 'car alist) t)
-           (0 (haskell-font-lock-compose-symbol ',alist)
-              ;; In Emacs-21, if the `override' field is nil, the face
-              ;; expressions is only evaluated if the text has currently
-              ;; no face.  So force evaluation by using `keep'.
-              keep)))))))
+  (when (and haskell-font-lock-symbols
+	     haskell-font-lock-symbols-alist
+	     (fboundp 'compose-region))
+    `((,(regexp-opt (mapcar 'car haskell-font-lock-symbols-alist) t)
+       (0 (haskell-font-lock-compose-symbol ',haskell-font-lock-symbols-alist)
+	  ;; In Emacs-21, if the `override' field is nil, the face
+	  ;; expressions is only evaluated if the text has currently
+	  ;; no face.  So force evaluation by using `keep'.
+	  keep)))))
 
 (defun haskell-font-lock-find-pragma (end)
   (catch 'haskell-font-lock-find-pragma