Skip to content

Modernize haskell-font-lock-symbols. #510

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Mar 13, 2015
Merged

Modernize haskell-font-lock-symbols. #510

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
122 changes: 46 additions & 76 deletions haskell-font-lock.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down