Re: using glyphs by default in perl-mode

[Ted Zlatanov]

+patch

=== modified file 'lisp/progmodes/perl-mode.el'
--- lisp/progmodes/perl-mode.el 2013-05-07 18:06:13 +0000
+++ lisp/progmodes/perl-mode.el 2013-06-03 01:48:28 +0000
@@ -158,44 +158,21 @@
 ;; Regexps updated with help from Tom Tromey <address@hidden> and
 ;; Jim Campbell <address@hidden>.
 
-(defcustom perl-prettify-symbols t
-  "If non-nil, some symbols will be displayed using Unicode chars."
-  :version "24.4"
-  :type 'boolean)
+(defconst perl--prettify-symbols-alist-basic
+  '(("->"  . ?→)
+    ("=>"  . ?⇒)
+    ("::" . ?∷)))
+
+(defconst perl--prettify-symbols-alist-extended
+  `(,@perl--prettify-symbols-alist-basic
+    ("andalso" . ?∧) ("orelse"  . ?∨) ("as" . ?≡)("not" . ?¬)
+    ("div" . ?÷) ("*"   . ?×) ("o"   . ?○)
+    ("<-"  . ?←) ("<>"  . ?≠) (">="  . ?≥) ("<="  . ?≤) ("..." . ?⋯)))
 
 (defconst perl--prettify-symbols-alist
-  '(;;("andalso" . ?∧) ("orelse"  . ?∨) ("as" . ?≡)("not" . ?¬)
-    ;;("div" . ?÷) ("*"   . ?×) ("o"   . ?○)
-    ("->"  . ?→)
-    ("=>"  . ?⇒)
-    ;;("<-"  . ?←) ("<>"  . ?≠) (">="  . ?≥) ("<="  . ?≤) ("..." . ?⋯)
-    ("::" . ?∷)
-    ))
-
-(defun perl--font-lock-compose-symbol ()
-  "Compose a sequence of ascii chars into a symbol.
-Regexp match data 0 points to the chars."
-  ;; Check that the chars should really be composed into a symbol.
-  (let* ((start (match-beginning 0))
-        (end (match-end 0))
-        (syntaxes (if (eq (char-syntax (char-after start)) ?w)
-                      '(?w) '(?. ?\\))))
-    (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes)
-           (memq (char-syntax (or (char-after end) ?\ )) syntaxes)
-            (nth 8 (syntax-ppss)))
-       ;; No composition for you.  Let's actually remove any composition
-       ;; we may have added earlier and which is now incorrect.
-       (remove-text-properties start end '(composition))
-      ;; That's a symbol alright, so add the composition.
-      (compose-region start end (cdr (assoc (match-string 0)
-                                            perl--prettify-symbols-alist)))))
-  ;; Return nil because we're not adding any face property.
-  nil)
-
-(defun perl--font-lock-symbols-keywords ()
-  (when perl-prettify-symbols
-    `((,(regexp-opt (mapcar 'car perl--prettify-symbols-alist) t)
-       (0 (perl--font-lock-compose-symbol))))))
+  `((basic ,@perl--prettify-symbols-alist-basic)
+    (extended ,@perl--prettify-symbols-alist-extended)
+    (all ,@perl--prettify-symbols-alist-extended)))
 
 (defconst perl-font-lock-keywords-1
   '(;; What is this for?
@@ -243,13 +220,17 @@
      ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
      ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?"
       (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
-     ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face)
-     ,@(perl--font-lock-symbols-keywords)))
+     ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face)))
   "Gaudy level highlighting for Perl mode.")
 
 (defvar perl-font-lock-keywords perl-font-lock-keywords-1
   "Default expressions to highlight in Perl mode.")
 
+;; used to add font-lock keywords dynamically
+(defvar perl-augmented-font-lock-keywords)
+(defvar perl-augmented-font-lock-keywords-1)
+(defvar perl-augmented-font-lock-keywords-2)
+
 (defvar perl-quote-like-pairs
   '((?\( . ?\)) (?\[ . ?\]) (?\{ . ?\}) (?\< . ?\>)))
 
@@ -685,11 +666,22 @@
   (setq-local comment-start-skip "\\(^\\|\\s-\\);?#+ *")
   (setq-local comment-indent-function #'perl-comment-indent)
   (setq-local parse-sexp-ignore-comments t)
+
+  ;; Define the symbols to be prettified
+  (setq-local prog-prettify-symbols-alist perl--prettify-symbols-alist)
+
   ;; Tell font-lock.el how to handle Perl.
-  (setq font-lock-defaults '((perl-font-lock-keywords
-                             perl-font-lock-keywords-1
-                             perl-font-lock-keywords-2)
-                            nil nil ((?\_ . "w")) nil
+  (setq perl-augmented-font-lock-keywords (append perl-font-lock-keywords
+                                         
(prog-prettify-font-lock-symbols-keywords)))
+  (setq perl-augmented-font-lock-keywords-1 (append perl-font-lock-keywords-1
+                                         
(prog-prettify-font-lock-symbols-keywords)))
+  (setq perl-augmented-font-lock-keywords-2 (append perl-font-lock-keywords-2
+                                         
(prog-prettify-font-lock-symbols-keywords)))
+
+  (setq font-lock-defaults '((perl-augmented-font-lock-keywords
+                              perl-augmented-font-lock-keywords-1
+                              perl-augmented-font-lock-keywords-2)
+                             nil nil ((?\_ . "w")) nil
                              (font-lock-syntactic-face-function
                               . perl-font-lock-syntactic-face-function)))
   (setq-local syntax-propertize-function #'perl-syntax-propertize-function)

=== modified file 'lisp/simple.el'
--- lisp/simple.el      2013-05-25 02:21:49 +0000
+++ lisp/simple.el      2013-06-03 01:11:54 +0000
@@ -393,13 +393,56 @@
          (end (progn (forward-sexp 1) (point))))
       (indent-region start end nil))))
 
+;; TODO: move to prog-mode.el
 (define-derived-mode prog-mode fundamental-mode "Prog"
   "Major mode for editing programming language source code."
   (set (make-local-variable 'require-final-newline) mode-require-final-newline)
   (set (make-local-variable 'parse-sexp-ignore-comments) t)
+  (set (make-local-variable 'prog-prettify-symbols-alist) nil)
   ;; Any programming language is always written left to right.
   (setq bidi-paragraph-direction 'left-to-right))
 
+(defcustom prog-prettify-symbols nil
+  "Which symbols should be prettified.
+When set to `basic' or `extended' or `all', the actual choices
+are made by the mode that derives from `prog-mode'."
+  :type '(choice
+          (const :tag "No thanks" nil)
+          (const :tag "Basic list" basic)
+          (const :tag "Extended list: basic plus much more" extended)
+          (const :tag "Everything: because you can!" all)
+          (alist :tag "Define your own list" :key-type string :value-type 
character))
+  :group 'languages)
+
+(defun prog--prettify-font-lock-compose-symbol (alist)
+  "Compose a sequence of ascii chars into a symbol.
+Regexp match data 0 points to the chars."
+  ;; Check that the chars should really be composed into a symbol.
+  (let* ((start (match-beginning 0))
+        (end (match-end 0))
+        (syntaxes (if (eq (char-syntax (char-after start)) ?w)
+                      '(?w) '(?. ?\\))))
+    (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes)
+           (memq (char-syntax (or (char-after end) ?\ )) syntaxes)
+            (nth 8 (syntax-ppss)))
+       ;; No composition for you.  Let's actually remove any composition
+       ;; we may have added earlier and which is now incorrect.
+       (remove-text-properties start end '(composition))
+      ;; That's a symbol alright, so add the composition.
+      (compose-region start end (cdr (assoc (match-string 0) alist)))))
+  ;; Return nil because we're not adding any face property.
+  nil)
+
+(defun prog-prettify-font-lock-symbols-keywords ()
+  (when prog-prettify-symbols
+    (let ((alist (if (symbolp prog-prettify-symbols)
+                     ;; the cdr of the cons cell has all we need
+                     (cdr (assoc prog-prettify-symbols
+                                 prog-prettify-symbols-alist))
+                   prog-prettify-symbols)))
+    `((,(regexp-opt (mapcar 'car alist) t)
+       (0 (prog--prettify-font-lock-compose-symbol ',alist)))))))
+
 ;; Making and deleting lines.
 
 (defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))