Re: Tex output mode

[Stefan Monnier]

> etc. In this way, I would like to open a file containing tokens like \lambda
> into an Emacs buffer that should shows the lambda symbol instead of the
> expression \lambda.
[...]
> I sucessfully used emacs 22 and x-symbol package as an interface for this
> program.  The problem is that x-symbol no longer works with emacs 23.

One approach is to use actual λ chars with the inputenc package.
But if you really want to have \lambda in the buffer and λ in the
display, then I think your best bet is to use font-lock to find \lambda
and then apply a composition property to it to make it display as a λ.
A simple example would be along the lines of:

  (font-lock-add-keywords nil
    '(("\\\\lambda\\>"
      (0 (progn (compose-region (match-beginning 1) (match-end 1) ?λ) nil))))))

I've written code to do that kind of thing (in a slightly more reliable
way, and for several chars) for SML, Haskell, and Coq code.
The relevant part of the code for SML is appended below.
Nowadays, you don't need to use those `make-char' calls any more and can
just include the relevant char as a literal char (noted ?<char> as in
the example code above).


        Stefan


(defcustom sml-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'."
  :type '(choice (const nil)
                 (const t)
                 (const unicode)
                 (const japanese-jisx0208)))

(defconst sml-font-lock-symbols-alist
  (append
   ;; The symbols can come from a JIS0208 font.
   (and (fboundp 'make-char) (charsetp 'japanese-jisx0208)
        (memq sml-font-lock-symbols '(t japanese-jisx0208))
        (list (cons "fn" (make-char 'japanese-jisx0208 38 75))
              (cons "andalso" (make-char 'japanese-jisx0208 34 74))
              (cons "orelse" (make-char 'japanese-jisx0208 34 75))
              ;; (cons "as" (make-char 'japanese-jisx0208 34 97))
              (cons "not" (make-char 'japanese-jisx0208 34 76))
              (cons "div" (make-char 'japanese-jisx0208 33 96))
              ;; (cons "*" (make-char 'japanese-jisx0208 33 95))
              (cons "->" (make-char 'japanese-jisx0208 34 42))
              (cons "=>" (make-char 'japanese-jisx0208 34 77))
              (cons "<-" (make-char 'japanese-jisx0208 34 43))
              (cons "<>" (make-char 'japanese-jisx0208 33 98))
              (cons ">=" (make-char 'japanese-jisx0208 33 102))
              (cons "<=" (make-char 'japanese-jisx0208 33 101))
              (cons "..." (make-char 'japanese-jisx0208 33 68))
              ;; Some greek letters for type parameters.
              (cons "'a" (make-char 'japanese-jisx0208 38 65))
              (cons "'b" (make-char 'japanese-jisx0208 38 66))
              (cons "'c" (make-char 'japanese-jisx0208 38 67))
              (cons "'d" (make-char 'japanese-jisx0208 38 68))
              ))
   ;; Or a unicode font.
   (and (fboundp 'decode-char)
        (memq sml-font-lock-symbols '(t unicode))
        (list (cons "fn" (decode-char 'ucs 955))
              (cons "andalso" (decode-char 'ucs 8896))
              (cons "orelse" (decode-char 'ucs 8897))
              ;; (cons "as" (decode-char 'ucs 8801))
              (cons "not" (decode-char 'ucs 172))
              (cons "div" (decode-char 'ucs 247))
              (cons "*" (decode-char 'ucs 215))
              (cons "o"  (decode-char 'ucs 9675))
              (cons "->" (decode-char 'ucs 8594))
              (cons "=>" (decode-char 'ucs 8658))
              (cons "<-" (decode-char 'ucs 8592))
              (cons "<>" (decode-char 'ucs 8800))
              (cons ">=" (decode-char 'ucs 8805))
              (cons "<=" (decode-char 'ucs 8804))
              (cons "..." (decode-char 'ucs 8943))
              ;; (cons "::" (decode-char 'ucs 8759))
              ;; Some greek letters for type parameters.
              (cons "'a" (decode-char 'ucs 945))
              (cons "'b" (decode-char 'ucs 946))
              (cons "'c" (decode-char 'ucs 947))
              (cons "'d" (decode-char 'ucs 948))
              ))))

(defun sml-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)
            (memq (get-text-property start 'face)
                  '(font-lock-doc-face font-lock-string-face
                    font-lock-comment-face)))
        ;; 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 sml-font-lock-symbols-keywords ()
  (when (fboundp 'compose-region)
    (let ((alist nil))
      (dolist (x sml-font-lock-symbols-alist)
        (when (and (if (fboundp 'char-displayable-p)
                       (char-displayable-p (cdr x))
                     t)
                   (not (assoc (car x) alist))) ;Not yet in alist.
          (push x alist)))
      (when alist
        `((,(regexp-opt (mapcar 'car alist) t)
           (0 (sml-font-lock-compose-symbol ',alist))))))))

(defconst sml-font-lock-keywords
  `(...<various font-lock thingies for SML>...
    ,@(sml-font-lock-symbols-keywords))
  "Regexps matching standard SML keywords.")