|
0
|
1 ;;; lispm-fonts.el --- quick hack to parse LISPM-style font-shift codes
|
|
|
2
|
|
|
3 ;; Keywords: faces
|
|
|
4
|
|
|
5 ;; Copyright (C) 1992-1993 Free Software Foundation, Inc.
|
|
|
6
|
|
|
7 ;; This file is part of XEmacs.
|
|
|
8
|
|
|
9 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
10 ;; under the terms of the GNU General Public License as published by
|
|
|
11 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
12 ;; any later version.
|
|
|
13
|
|
|
14 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
17 ;; General Public License for more details.
|
|
|
18
|
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
16
|
20 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
22 ;; Boston, MA 02111-1307, USA.
|
|
0
|
23
|
|
|
24 ;;; Synched up with: Not in FSF.
|
|
|
25
|
|
|
26 ;; This only copes with MIT/LMI/TI style font shifts, not Symbolics.
|
|
|
27 ;; It doesn't do diagram lines (ha ha). It doesn't do output. That
|
|
|
28 ;; has to wait until it is possible to attach faces to characters
|
|
|
29 ;; instead of just intervals, since this code is really talking about
|
|
|
30 ;; attributes of the text instead of attributes of regions of the
|
|
|
31 ;; buffer. We could do it by mapping over the extents and hacking
|
|
|
32 ;; the overlaps by hand, but that would be hard.
|
|
|
33
|
|
|
34 (make-face 'variable)
|
|
|
35 (or (face-differs-from-default-p 'variable)
|
|
|
36 (set-face-font 'variable
|
|
|
37 "-*-helvetica-medium-r-*-*-*-120-*-*-*-*-*-*"))
|
|
|
38
|
|
|
39 (make-face 'variable-bold)
|
|
|
40 (or (face-differs-from-default-p 'variable-bold)
|
|
|
41 (progn
|
|
|
42 ;; This is no good because helvetica-12-bold is a LOT larger than
|
|
|
43 ;; helvetica-12-medium. Someone really blew it there.
|
|
|
44 ;; (copy-face 'variable 'variable-bold)
|
|
|
45 ;; (make-face-bold 'variable-bold)
|
|
|
46 (set-face-font 'variable-bold
|
|
|
47 "-*-helvetica-bold-r-*-*-*-100-*-*-*-*-*-*")))
|
|
|
48
|
|
|
49 (make-face 'variable-italic)
|
|
|
50 (or (face-differs-from-default-p 'variable-italic)
|
|
|
51 (progn
|
|
|
52 (copy-face 'variable-bold 'variable-italic) ; see above
|
|
|
53 (make-face-unbold 'variable-italic)
|
|
|
54 (make-face-italic 'variable-italic)))
|
|
|
55
|
|
|
56 (make-face 'variable-bold-italic)
|
|
|
57 (or (face-differs-from-default-p 'variable-bold-italic)
|
|
|
58 (progn
|
|
|
59 (copy-face 'variable-bold 'variable-bold-italic)
|
|
|
60 (make-face-italic 'variable-bold-italic)))
|
|
|
61
|
|
|
62 (defconst lispm-font-to-face
|
|
|
63 '(("tvfont" . default)
|
|
|
64 ("cptfont" . default)
|
|
|
65 ("cptfontb" . bold)
|
|
|
66 ("cptfonti" . italic)
|
|
|
67 ("cptfontbi" . bold-italic)
|
|
|
68 ("base-font" . default)
|
|
|
69 ("bigfnt" . bold)
|
|
|
70 ("cmb8" . variable-bold)
|
|
|
71 ("higher-medfnb" . bold)
|
|
|
72 ("higher-tr8" . default)
|
|
|
73 ("medfnb" . bold)
|
|
|
74 ("medfnt" . normal)
|
|
|
75 ("medfntb" . bold)
|
|
|
76 ("wider-font" . bold)
|
|
|
77 ("wider-medfnt" . bold)
|
|
|
78 ("mets" . variable-large)
|
|
|
79 ("metsb" . variable-large-bold)
|
|
|
80 ("metsbi" . variable-large-bold-italic)
|
|
|
81 ("metsi" . variable-large-italic)
|
|
|
82 ("cmr5" . variable)
|
|
|
83 ("cmr10" . variable)
|
|
|
84 ("cmr18" . variable)
|
|
|
85 ("cmold" . variable)
|
|
|
86 ("cmdunh" . variable)
|
|
|
87 ("hl10" . variable)
|
|
|
88 ("hl10b" . variable-bold)
|
|
|
89 ("hl12" . variable)
|
|
|
90 ("hl12b" . variable-bold)
|
|
|
91 ("hl12bi" . variable-bold-italic)
|
|
|
92 ("hl12i" . variable-italic)
|
|
|
93 ("hl6" . variable)
|
|
|
94 ("hl7" . variable)
|
|
|
95 ("tr10" . variable)
|
|
|
96 ("tr10b" . variable-bold)
|
|
|
97 ("tr10bi" . variable-bold-italic)
|
|
|
98 ("tr10i" . variable-italic)
|
|
|
99 ("tr12" . variable)
|
|
|
100 ("tr12b" . variable-bold)
|
|
|
101 ("tr12bi" . variable-bold-italic)
|
|
|
102 ("tr12i" . variable-italic)
|
|
|
103 ("tr18" . variable-large)
|
|
|
104 ("tr18b" . variable-large-bold)
|
|
|
105 ("tr8" . variable)
|
|
|
106 ("tr8b" . variable-bold)
|
|
|
107 ("tr8i" . variable-italic)
|
|
|
108 ("5x5" . small)
|
|
|
109 ("tiny" . small)
|
|
|
110 ("43vxms" . variable-large)
|
|
|
111 ("courier" . bold)
|
|
|
112 ("adobe-courier10" . default)
|
|
|
113 ("adobe-courier14" . bold)
|
|
|
114 ("adobe-courier10b" . bold)
|
|
|
115 ("adobe-courier14b" . bold)
|
|
|
116 ("adobe-hl12" . variable)
|
|
|
117 ("adobe-hl14" . variable)
|
|
|
118 ("adobe-hl14b" . variable-bold)
|
|
|
119 )
|
|
|
120 "Alist of LISPM font names to Emacs face names.")
|
|
|
121
|
|
|
122
|
|
|
123 (defun lispm-font-to-face (lispm-font)
|
|
|
124 (if (symbolp lispm-font)
|
|
|
125 (setq lispm-font (symbol-name lispm-font)))
|
|
|
126 (let ((case-fold-search t)
|
|
|
127 face)
|
|
|
128 (setq lispm-font (downcase lispm-font))
|
|
|
129 (if (string-match "^fonts:+" lispm-font)
|
|
|
130 (setq lispm-font (substring lispm-font (match-end 0))))
|
|
|
131 (if (setq face (cdr (assoc lispm-font lispm-font-to-face)))
|
|
|
132 (if (find-face face)
|
|
|
133 face
|
|
|
134 (message "warning: unknown face %s" face)
|
|
|
135 'default)
|
|
|
136 (message "warning: unknown Lispm font %s" (upcase lispm-font))
|
|
|
137 'default)))
|
|
|
138
|
|
|
139 (defvar fonts) ; the -*- line of the file will set this.
|
|
|
140
|
|
|
141 (defun lispm-fontify-hack-local-variables ()
|
|
|
142 ;; Sometimes code has font-shifts in the -*- line, which means that the
|
|
|
143 ;; local variables will have been read incorrectly by the emacs-lisp reader.
|
|
|
144 ;; In particular, the `fonts' variable might be corrupted. So if there
|
|
|
145 ;; are font-shifts in the prop line, re-parse it.
|
|
|
146 (if (or (not (boundp 'fonts))
|
|
|
147 (null 'fonts)
|
|
|
148 (let ((case-fold-search t))
|
|
|
149 (and (looking-at "[ \t]*;.*-\\*-.*fonts[ \t]*:.*-\\*-")
|
|
|
150 (looking-at ".*\^F"))))
|
|
|
151 (save-excursion
|
|
|
152 (save-restriction
|
|
|
153 (end-of-line)
|
|
|
154 (narrow-to-region (point-min) (point))
|
|
|
155 (goto-char (point-min))
|
|
|
156 (while (re-search-forward "\^F[0-9a-zA-Z*]" nil t)
|
|
|
157 (delete-region (match-beginning 0) (match-end 0)))
|
|
|
158 (let ((enable-local-variables 'query))
|
|
|
159 (hack-local-variables))))))
|
|
|
160
|
|
|
161 (defun lispm-fontify-buffer ()
|
|
|
162 (save-excursion
|
|
|
163 (goto-char (point-min))
|
|
|
164 (if (fboundp 'font-lock-mode) (font-lock-mode 0))
|
|
|
165 (lispm-fontify-hack-local-variables)
|
|
|
166 (let ((font-stack nil)
|
|
|
167 (p (point))
|
|
|
168 c)
|
|
|
169 (while (search-forward "\^F" nil t)
|
|
|
170 (delete-char -1)
|
|
|
171 (setq c (following-char))
|
|
|
172 (delete-char 1)
|
|
|
173 (cond ((= c ?\^F)
|
|
|
174 (insert "\^F"))
|
|
|
175 ((= c ?*)
|
|
|
176 (if (and font-stack (/= p (point)))
|
|
|
177 (set-extent-face (make-extent p (point)) (car font-stack)))
|
|
|
178 (setq p (point))
|
|
|
179 (setq font-stack (cdr font-stack)))
|
|
|
180 ((or (< c ?0) (> c ?Z)) ; error...
|
|
|
181 nil)
|
|
|
182 ((>= (setq c (- c ?0)) (length fonts)) ; error...
|
|
|
183 nil)
|
|
|
184 (t
|
|
|
185 (if (and font-stack (/= p (point)))
|
|
|
186 (set-extent-face (make-extent p (point)) (car font-stack)))
|
|
|
187 (setq font-stack (cons (lispm-font-to-face (nth c fonts))
|
|
|
188 font-stack))
|
|
|
189 (setq p (point)))))
|
|
|
190 (if (and font-stack (/= p (point)))
|
|
|
191 (set-extent-face (make-extent p (point)) (car font-stack))))))
|
