module-pretty.el (4421B)
1 ;;; module-pretty.el 2 3 ;; Author: Mark Feller <mark.feller@member.fsf.org> 4 5 ;; This file is not part of GNU Emacs. 6 7 ;; This file is free software; you can redistribute it and/or modify 8 ;; it under the terms of the GNU General Public License as published by 9 ;; the Free Software Foundation; either version 3, or (at your option) 10 ;; any later version. 11 12 ;; This file is distributed in the hope that it will be useful, 13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;; GNU General Public License for more details. 16 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with this file. If not, see <http://www.gnu.org/licenses/>. 19 20 ;;; Commentary: 21 22 ;;; Code: 23 24 (defun unicode-symbol (name) 25 "Translate a symbolic name for a Unicode character -- e.g., LEFT-ARROW 26 or GREATER-THAN into an actual Unicode character code. " 27 (decode-char 'ucs (case name 28 ;; arrows 29 ('left-arrow 8592) 30 ('up-arrow 8593) 31 ('right-arrow 8594) 32 ('down-arrow 8595) 33 ('double-left-arrow 8658) 34 ;; boxes 35 ('double-vertical-bar #X2551) 36 ;; relational operators 37 ('equal #X003d) 38 ('not-equal #X2260) 39 ('identical #X2261) 40 ('not-identical 2262) 41 ('not-equal 2260) 42 ('less-than #X003c) 43 ('greater-than #X003e) 44 ('less-than-or-equal-to #X2264) 45 ('greater-than-or-equal-to #X2265) 46 ;; logical operators 47 ('logical-and #X2227) 48 ('logical-or #X2228) 49 ('logical-neg #X00AC) 50 ;; misc 51 ('nil #X2205) 52 ('horizontal-ellipsis #X2026) 53 ('double-exclamation #X203C) 54 ('prime #X2032) 55 ('double-prime #X2033) 56 ('for-all #X2200) 57 ('there-exists #X2203) 58 ('element-of #X2208) 59 ;; mathematical operators 60 ('square-root #X221A) 61 ('squared #X00B2) 62 ('cubed #X00B3) 63 ;; letters 64 ('lambda #x03BB) 65 ('alpha #x03B1) 66 ('beta #x03B2) 67 ('gamma #x03B3) 68 ('delta #x03B4)))) 69 70 (defun substitute-pattern-with-unicode (pattern symbol) 71 "Add a font lock hook to replace the matched part of PATTERN with the 72 Unicode symbol SYMBOL looked up with UNICODE-SYMBOL." 73 (interactive) 74 (font-lock-add-keywords 75 nil `((,pattern (0 (progn (compose-region (match-beginning 1) (match-end 1) 76 ,(unicode-symbol symbol)) 77 nil)))))) 78 79 (defun substitute-patterns-with-unicode (patterns) 80 "Call SUBSTITUTE-PATTERN-WITH-UNICODE repeatedly." 81 (mapcar #'(lambda (x) 82 (substitute-pattern-with-unicode (car x) 83 (cdr x))) 84 patterns)) 85 86 (defun haskell-unicode () 87 (interactive) 88 (substitute-patterns-with-unicode 89 (list (cons "\\(<-\\)" 'left-arrow) 90 (cons "\\(->\\)" 'right-arrow) 91 (cons "\\(=>\\)" 'double-left-arrow) 92 (cons "\\(==\\)" 'identical) 93 (cons "\\(/=\\)" 'not-equal) 94 (cons "\\<\\(sqrt\\)\\>" 'square-root) 95 (cons "\\<\\(not\\)\\>" 'logical-neg) 96 (cons "\\(>\\)\\[^=\\]" 'greater-than) 97 (cons "\\(<\\)\\[^=\\]" 'less-than) 98 (cons "\\(>=\\)" 'greater-than-or-equal-to) 99 (cons "\\(<=\\)" 'less-than-or-equal-to) 100 (cons "\\<\\(alpha\\)\\>" 'alpha) 101 (cons "\\<\\(beta\\)\\>" 'beta) 102 (cons "\\<\\(gamma\\)\\>" 'gamma) 103 (cons "\\<\\(delta\\)\\>" 'delta) 104 (cons "\\(''\\)" 'double-prime) 105 (cons "\\('\\)" 'prime) 106 (cons "\\s (?\\(\\\\\\)\\s *\\(\\w\\|_\\).*?\\s *->" 'lambda) 107 (cons "\\(!!\\)" 'double-exclamation) 108 (cons "\\(\\.\\.\\)" 'horizontal-ellipsis)))) 109 110 (add-hook 'haskell-mode 'haskell-unicode) 111 112 ;;; module-pretty.el ends here