[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: pretty fonts in sources


   Electric Font Lock Mode doesn't work in Release 7 anymore. Seems that
Symbolics hadn't had any time to convert this to Release 7. Or is it,
because it should really be named Electric Style Lock Mode :-)...

To figure out translations from 'old' fonts to 'new' character styles,
see the section on character styles  in Vol 2A of the Doc, which should
tell you what you need to know. Esp. the part on 1Character Styles for TV

0As a fix for Electric Fonts you (and maybe others) may want to use the
code I'll append to this message. It will provide you with an Electric
Style Lock Mode, which has some more nice features, just try it...

But be warned: there are some subtle bugs due to character styles in
source code. Those two lines look the same to you
	(chaos:connect net:*local-host* "FOO")
	(chaos:connect net:*local-host* 2"FOO"0)
but not to the machine, because they are written in different styles
(namely NIL.NIL.NIL vs. FIX.ROMAN.NIL) and those strings "FOO" are
passed *with* style information into the lisp environment - I'd call
this brain-damaged!

So, here's the code, enjoy:
;1;; -*- Syntax: Zetalisp; Package: ZWEI -*-

0;1;; This is a replacement for the Electric Font Lock Mode, which used to
0;1;; keep comments in font B before Release 7.x Now it's only available
0;1;; under c-m-X (any extended command) and is non-functional.

0;1;; In order to make this patch work, load this file into your world and
0;1;; put the following form into your init file:
;  (setq *font-lock-styles* t)			;1if you'd like this (I do)
0;  (setq *font-display-style-name* t)
;  (setq lisp-mode-hook #'(lambda () (turn-on-mode 'electric-font-lock-mode)))
;  )

(defmacro 3char-style0 (char) `(si:char-style-index ,char))

;1;; Works left associate, deriving style to use from char left of point
0(defvar 3*font-lock-styles*0 t 1"If true, try to keep styles as they are."0)

(defvar 3*font-display-style-name*0 t 1"If true, display current style's name in minibuffer"0)

(defconst 3*plain-style*0 (si:style-index (si:parse-character-style '(nil nil nil)))
	     1"Style index for the style normally used for any program text.
A roman style should be best suited for this purpose.")

;; For the meaning of the term 'definition' see the ZMACS manual,
;; e.g. the documentation for Edit Definition.
0(defconst 3*spec-style*0 (si:style-index (si:parse-character-style '(nil :bold nil)))
  1"Style index for the style used for any definition.")

0(defconst 3*doc-style*0 (si:style-index (si:parse-character-style '(nil :italic nil)))
  1"Style index for the style normally used for any documentation string in the code.
An italic style should be best suited for this purpose.")

0(defconst 3*comment-style*0 (si:style-index (si:parse-character-style '(nil :italic nil)))
  1"This is the style used for Electric Style Lock Mode.
By default this is the same style as for documentation strings.")

0;1;; Original from SYS:ZWEI;STYLES this looses on cursor movement:
0;1;; because it's being called everytime *after* a char has been typed,
0;1;; it'll fail to tell the correct font for the first char after a move.
0;1;; This needed to be called after a move (click etc.) too...
0(defsubst 3update-style-name0 ()
  (let ((style-id *style*))
    (setq *style-name*
	  (unless (zerop style-id)
	    (let ((style (aref si:*character-style-index-table* style-id)))
	      (when style
		(in-current-style (string-append
				      (si:cs-face style)) " "))))))))

(defprop 3font-lock-hook 010 command-hook-priority)

1;;; This function will get bound to *COMMAND-HOOK*. It does nearly the
;;; same stuff done by0 1the original font-lock-hook, but is more flexible
;;; in style selection (i.e. not hooked to font B)
0(defun 3font-lock-hook 0(char)
  1"A replacement for #'FONT-LOCK-HOOK"
0  (declare (ignore char))
  (when (neq *interval* (window-interval *mini-buffer-window*))
    1;; this is better than electric font lock
0    (let ((new-style (multiple-value-bind (string slash comment)
		       (declare (ignore slash))
		       (cond (comment *comment-style*)
			     ((and string
				   (= (char-style (bp-char-before (point)))
			      1;; makes it easy to update docstrings
0			      *doc-style*)
			      (char-style (bp-char-before (point))))
			     (t *plain-style*)))))
      (unless (= *style* new-style)
	(setq *style* new-style)
	(and *font-display-style-name*

(defminor 3com-electric-font-lock-mode0 electric-font-lock-mode
	  "E-Styles" 5
          1"Provide Automatic handling of character style switching"0 ()
  (command-hook 'font-lock-hook *command-hook*))