From 6541e2430dccab82f42245bcc59913bac0875300 Mon Sep 17 00:00:00 2001 From: Gracjan Polak Date: Fri, 13 Mar 2015 19:00:31 +0100 Subject: [PATCH] Modernize haskell-font-lock-symbols. --- haskell-font-lock.el | 122 ++++++++++++++++--------------------------- 1 file changed, 46 insertions(+), 76 deletions(-) diff --git a/haskell-font-lock.el b/haskell-font-lock.el index 932b8336f..fc9d3f593 100644 --- a/haskell-font-lock.el +++ b/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 . . - '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 . . + 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