Re: using glyphs by default in perl-mode

[Ted Zlatanov]

On Mon, 03 Jun 2013 03:04:41 -0400 Stefan Monnier <address@hidden> wrote: 

SM> Please use prog-mode.el rather than prog.el.
>> +(defconst perl--prettify-symbols-alist-basic
>> +  '(("->"  . ?→)
>> +    ("=>"  . ?⇒)
>> +    ("::" . ?∷)))

SM> I don't think "basic" and "extended" make much sense currently, so the
SM> basic user setting should be a boolean.  Major modes should simply
SM> provide *the* alist that makes sense for them.

OK.

>> +(defconst perl--prettify-symbols-alist-extended
>> +  `(,@perl--prettify-symbols-alist-basic
>> +    ("andalso" . ?∧) ("orelse"  . ?∨) ("as" . ?≡)("not" . ?¬)
>> +    ("div" . ?÷) ("*"   . ?×) ("o"   . ?○)
>> +    ("<-"  . ?←) ("<>"  . ?≠) (">="  . ?≥) ("<="  . ?≤) ("..." . ?⋯)))

SM> E.g. this makes very little sense for Perl, since these mapping all come
SM> from sml-mode.el ;-)

Yeah, I didn't pay attention.  OK.

>> +;; 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)

SM> This smells internal, so please use "--" in their name.

OK.

>> +  (set (make-local-variable 'prog-prettify-symbols-alist) nil)

SM> Just make the default value be nil instead.

OK.

>> +(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)

SM> Make it into a boolean.

SM> Other than that, looks good, please install.

Please take a final look.  I added this to emacs-lisp-mode (just
lambda), perl-mode, and cfengine3-mode.  It's easy to do this once you
start doing it but it still feels like an annoying amount of work.

It also feels like it should support arbitrary strings (to compose
Unicode) and even images.  WDYT?  Too much?

I couldn't move the code to prog-mode.el.  The emacs-lisp-mode include
needs the prog-mode map and barfed all over.  Sorry.  But it should be
OK otherwise.

Ted

=== modified file 'lisp/emacs-lisp/lisp-mode.el'
--- lisp/emacs-lisp/lisp-mode.el        2013-05-29 14:14:16 +0000
+++ lisp/emacs-lisp/lisp-mode.el        2013-06-04 01:11:36 +0000
@@ -187,6 +187,11 @@
               font-lock-string-face))))
     font-lock-comment-face))
 
+;; used to add font-lock keywords dynamically
+(defvar lisp--augmented-font-lock-keywords)
+(defvar lisp--augmented-font-lock-keywords-1)
+(defvar lisp--augmented-font-lock-keywords-2)
+
 (defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive)
   "Common initialization routine for lisp modes.
 The LISP-SYNTAX argument is used by code in inf-lisp.el and is
@@ -223,9 +228,20 @@
   (setq-local imenu-generic-expression lisp-imenu-generic-expression)
   (setq-local multibyte-syntax-as-symbol t)
   (setq-local syntax-begin-function 'beginning-of-defun)
+  (setq-local prog-prettify-symbols-alist lisp--prettify-symbols-alist)
+  (setq lisp--augmented-font-lock-keywords
+        (append lisp-font-lock-keywords
+                (prog-prettify-font-lock-symbols-keywords)))
+  (setq lisp--augmented-font-lock-keywords-1
+        (append lisp-font-lock-keywords-1
+                (prog-prettify-font-lock-symbols-keywords)))
+  (setq lisp--augmented-font-lock-keywords-2
+        (append lisp-font-lock-keywords-2
+                (prog-prettify-font-lock-symbols-keywords)))
   (setq font-lock-defaults
-       `((lisp-font-lock-keywords
-          lisp-font-lock-keywords-1 lisp-font-lock-keywords-2)
+       `((lisp--augmented-font-lock-keywords
+          lisp--augmented-font-lock-keywords-1
+           lisp--augmented-font-lock-keywords-2)
          nil ,keywords-case-insensitive nil nil
          (font-lock-mark-block-function . mark-defun)
          (font-lock-syntactic-face-function
@@ -448,6 +464,9 @@
   :type 'hook
   :group 'lisp)
 
+(defconst lisp--prettify-symbols-alist
+  `(("lambda"  . ,(make-char 'greek-iso8859-7 107))))
+
 (define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
   "Major mode for editing Lisp code to run in Emacs.
 Commands:

=== modified file 'lisp/progmodes/cfengine.el'
--- lisp/progmodes/cfengine.el  2013-03-22 19:06:53 +0000
+++ lisp/progmodes/cfengine.el  2013-06-04 01:43:47 +0000
@@ -527,6 +527,17 @@
   ;; Doze path separators.
   (modify-syntax-entry ?\\ "." table))
 
+(defconst cfengine3--prettify-symbols-alist
+  '(("->"  . ?→)
+    ("=>"  . ?⇒)
+    ("::" . ?∷)
+    ("bundle agent" . ?⊕)
+    ("bundle server" . ?∑)
+    ("body" . ?⊙)
+    ("bundle" . ?𝛽)))
+
+(defvar cfengine3--augmented-font-lock-keywords)
+
 ;;;###autoload
 (define-derived-mode cfengine3-mode prog-mode "CFE3"
   "Major mode for editing CFEngine3 input.
@@ -538,8 +549,18 @@
   (cfengine-common-syntax cfengine3-mode-syntax-table)
 
   (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line)
+
+  ;; Define the symbols to be prettified
+  (setq-local prog-prettify-symbols-alist cfengine3--prettify-symbols-alist)
+
+  ;; Tell font-lock.el how to handle Perl.
+  (setq cfengine3--augmented-font-lock-keywords
+        (append cfengine3-font-lock-keywords
+                (prog-prettify-font-lock-symbols-keywords)))
+
   (setq font-lock-defaults
-        '(cfengine3-font-lock-keywords nil nil nil beginning-of-defun))
+        '(cfengine3--augmented-font-lock-keywords
+          nil nil nil beginning-of-defun))
 
   ;; Use defuns as the essential syntax block.
   (set (make-local-variable 'beginning-of-defun-function)

=== 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-04 00:44:35 +0000
@@ -158,44 +158,10 @@
 ;; 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
-  '(;;("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))))))
+    ("::" . ?∷)))
 
 (defconst perl-font-lock-keywords-1
   '(;; What is this for?
@@ -243,13 +209,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 +655,25 @@
   (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-04 00:59:14 +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)
+  (make-local-variable 'prog-prettify-symbols-alist)
   ;; Any programming language is always written left to right.
   (setq bidi-paragraph-direction 'left-to-right))
 
+(defvar prog-prettify-symbols-alist nil)
+
+(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 "Mode defaults" t)
+          (alist :tag "Mode defaults augmented with 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 (append prog-prettify-symbols-alist
+                         (if (listp prog-prettify-symbols)
+                             prog-prettify-symbols
+                           nil))))
+      `((,(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))