5 files changed, 133 insertions, 45 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 14ac40dee5b..b82b07fa303 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,29 @@
+2013-06-05  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        Generalize symbol prettify support to prog-mode and implement it
+        for perl-mode, cfengine3-mode, and emacs-lisp-mode.
+        * simple.el (prog-prettify-symbols-alist, prog-prettify-symbols)
+        (prog--prettify-font-lock-compose-symbol)
+        (prog-prettify-font-lock-symbols-keywords): New variables and
+        functions to support symbol prettification.
+        * emacs-lisp/lisp-mode.el (lisp--augmented-font-lock-keywords)
+        (lisp--augmented-font-lock-keywords-1)
+        (lisp--augmented-font-lock-keywords-2, lisp-mode-variables)
+        (lisp--prettify-symbols-alist): Implement prettify of lambda.
+        * progmodes/cfengine.el (cfengine3--augmented-font-lock-keywords)
+        (cfengine3--prettify-symbols-alist, cfengine3-mode): Implement
+        prettify of -> => :: strings.
+        * progmodes/perl-mode.el (perl-prettify-symbols)
+        (perl--font-lock-compose-symbol)
+        (perl--font-lock-symbols-keywords): Move to prog-mode.
+        (perl--prettify-symbols-alist): Prettify -> => :: strings.
+        (perl-font-lock-keywords-1)
+        (perl-font-lock-keywords-2): Remove explicit prettify support.
+        (perl--augmented-font-lock-keywords)
+        (perl--augmented-font-lock-keywords-1)
+        (perl--augmented-font-lock-keywords-2, perl-mode): Implement
+        prettify support.
+
 2013-06-05  Leo Liu  <sdl.web@gmail.com>
 
         Re-implement smie matching block highlight using
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 02b020fa241..6e1f8291771 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -187,6 +187,11 @@ It has `lisp-mode-abbrev-table' as its parent."
               font-lock-string-face))))
     font-lock-comment-face))
 
+;; Temporary variables 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 @@ font-lock keywords will not be case sensitive."
   (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 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
   :type 'hook
   :group 'lisp)
 
+(defconst lisp--prettify-symbols-alist
+  '(("lambda"  . ?λ)))
+
 (define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
   "Major mode for editing Lisp code to run in Emacs.
 Commands:
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index 11eb0eeaf49..88177a8db10 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -527,6 +527,13 @@ Intended as the value of `indent-line-function'."
   ;; Doze path separators.
   (modify-syntax-entry ?\\ "." table))
 
+(defconst cfengine3--prettify-symbols-alist
+  '(("->"  . ?→)
+    ("=>"  . ?⇒)
+    ("::" . ?∷)))
+
+(defvar cfengine3--augmented-font-lock-keywords)
+
 ;;;###autoload
 (define-derived-mode cfengine3-mode prog-mode "CFE3"
   "Major mode for editing CFEngine3 input.
@@ -538,8 +545,18 @@ to the action header."
   (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 cfengine3 keywords..
+  (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)
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 01ac8584e19..fb3839a5fbc 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -158,44 +158,10 @@
 ;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and
 ;; Jim Campbell <jec@murzim.ca.boeing.com>.
 
-(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 @@ Regexp match data 0 points to the chars."
      ;; 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.")
 
+;; Temporary variables 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 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
   (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)
diff --git a/lisp/simple.el b/lisp/simple.el
index 18a360faa61..2564645e42c 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -397,9 +397,51 @@ instead."
   "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
+  "Whether symbols should be prettified.
+When set to an alist in the form `(STRING . CHARACTER)' it will
+augment the mode's native prettify alist."
+  :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))