Mercurial > hg > xemacs-beta

comparison lisp/msw-faces.el @ 215:1f0dabaa0855 r20-4b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b6
author cvs
date Mon, 13 Aug 2007 10:07:35 +0200
parents 78f53ef88e17
children 6c0ae1f9357f
comparison
equal deleted inserted replaced
214:c5d88c05e1e9 215:1f0dabaa0855
52 52
53 53
54 ;;; Fill in missing parts of a font spec. This is primarily intended as a 54 ;;; Fill in missing parts of a font spec. This is primarily intended as a
55 ;;; helper function for the functions below. 55 ;;; helper function for the functions below.
56 ;;; mswindows fonts look like: 56 ;;; mswindows fonts look like:
57 ;;; fontname[:[weight ][style][:pointsize[:effects[:charset]]]] 57 ;;; fontname[:[weight][ style][:pointsize[:effects[:charset]]]]
58 ;;; A minimal mswindows font spec looks like: 58 ;;; A minimal mswindows font spec looks like:
59 ;;; Courier New 59 ;;; Courier New
60 ;;; A maximal mswindows font spec looks like: 60 ;;; A maximal mswindows font spec looks like:
61 ;;; Courier New:Bold Italic:10:underline strikeout:ansi 61 ;;; Courier New:Bold Italic:10:underline strikeout:ansi
62 ;;; Missing parts of the font spec should be filled in with these values: 62 ;;; Missing parts of the font spec should be filled in with these values:
63 ;;; Courier New:Normal:10::ansi 63 ;;; Courier New:Normal:10::ansi
64 (defun mswindows-canicolize-font (font &optional device) 64 (defun mswindows-font-canicolize-name (font)
65 "Given a mswindows font specification, this converts it to canonical form." 65 "Given a mswindows font specification, this returns its name in canonical
66 nil) 66 form."
67 (cond ((font-instance-p font)
68 (let ((name (font-instance-name font)))
69 (cond ((string-match
70 "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*:[a-zA-Z 0-9]*$"
71 name) name)
72 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*$"
73 name) (concat name ":ansi"))
74 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+$" name)
75 (concat name "::ansi"))
76 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*$" name)
77 (concat name "10::ansi"))
78 ((string-match "^[a-zA-Z ]+$" name)
79 (concat name ":Normal:10::ansi"))
80 (t "Courier New:Normal:10::ansi"))))
81 (t "Courier New:Normal:10::ansi")))
67 82
68 (defun mswindows-make-font-bold (font &optional device) 83 (defun mswindows-make-font-bold (font &optional device)
69 "Given a mswindows font specification, this attempts to make a bold font. 84 "Given a mswindows font specification, this attempts to make a bold font.
70 If it fails, it returns nil." 85 If it fails, it returns nil."
71 nil) 86 (if (font-instance-p font)
87 (let ((name (mswindows-font-canicolize-name font)))
88 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
89 (make-font-instance (concat
90 (substring name 0 (match-beginning 1))
91 "Bold" (substring name (match-end 1)))
92 device t))))
72 93
73 (defun mswindows-make-font-unbold (font &optional device) 94 (defun mswindows-make-font-unbold (font &optional device)
74 "Given a mswindows font specification, this attempts to make a non-bold font. 95 "Given a mswindows font specification, this attempts to make a non-bold font.
75 If it fails, it returns nil." 96 If it fails, it returns nil."
76 nil) 97 (if (font-instance-p font)
98 (let ((name (mswindows-font-canicolize-name font)))
99 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
100 (make-font-instance (concat
101 (substring name 0 (match-beginning 1))
102 "Normal" (substring name (match-end 1)))
103 device t))))
77 104
78 (defun mswindows-make-font-italic (font &optional device) 105 (defun mswindows-make-font-italic (font &optional device)
79 "Given a mswindows font specification, this attempts to make an `italic' font. 106 "Given a mswindows font specification, this attempts to make an `italic'
80 If it fails, it returns nil." 107 font. If it fails, it returns nil."
81 nil) 108 (if (font-instance-p font)
109 (let ((name (mswindows-font-canicolize-name font)))
110 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
111 (make-font-instance (concat
112 (substring name 0 (match-beginning 1))
113 "Italic" (substring name (match-end 1)))
114 device t))))
82 115
83 (defun mswindows-make-font-unitalic (font &optional device) 116 (defun mswindows-make-font-unitalic (font &optional device)
84 "Given a mswindows font specification, this attempts to make a non-italic font. 117 "Given a mswindows font specification, this attempts to make a non-italic
85 If it fails, it returns nil." 118 font. If it fails, it returns nil."
86 nil) 119 (if (font-instance-p font)
120 (let ((name (mswindows-font-canicolize-name font)))
121 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
122 (make-font-instance (concat
123 (substring name 0 (match-beginning 1))
124 "Normal" (substring name (match-end 1)))
125 device t))))
87 126
88 (defun mswindows-make-font-bold-italic (font &optional device) 127 (defun mswindows-make-font-bold-italic (font &optional device)
89 "Given a mswindows font specification, this attempts to make a `bold-italic' 128 "Given a mswindows font specification, this attempts to make a `bold-italic'
90 font. If it fails, it returns nil." 129 font. If it fails, it returns nil."
91 nil) 130 (if (font-instance-p font)
131 (let ((name (mswindows-font-canicolize-name font)))
132 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
133 (make-font-instance (concat
134 (substring name 0 (match-beginning 1))
135 "Bold Italic" (substring name (match-end 1)))
136 device t))))
92 137
93 (defun mswindows-find-smaller-font (font &optional device) 138 (defun mswindows-find-smaller-font (font &optional device)
94 "Loads a new, version of the given font (or font name). 139 "Loads a new, version of the given font (or font name).
95 Returns the font if it succeeds, nil otherwise. 140 Returns the font if it succeeds, nil otherwise.
96 If scalable fonts are available, this returns a font which is 1 point smaller. 141 If scalable fonts are available, this returns a font which is 1 point smaller.
97 Otherwise, it returns the next smaller version of this font that is defined." 142 Otherwise, it returns the next smaller version of this font that is defined."
98 nil) 143 (if (font-instance-p font)
144 (let (old-size (name (mswindows-font-canicolize-name font)))
145 (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name)
146 (setq old-size (string-to-int
147 (substring name (match-beginning 1) (match-end 1))))
148 (if (> old-size 0)
149 (make-font-instance (concat
150 (substring name 0 (match-beginning 1))
151 (int-to-string (- old-size 1))
152 (substring name (match-end 1)))
153 device t)))))
99 154
100 (defun mswindows-find-larger-font (font &optional device) 155 (defun mswindows-find-larger-font (font &optional device)
101 "Loads a new, slightly larger version of the given font (or font name). 156 "Loads a new, slightly larger version of the given font (or font name).
102 Returns the font if it succeeds, nil otherwise. 157 Returns the font if it succeeds, nil otherwise.
103 If scalable fonts are available, this returns a font which is 1 point larger. 158 If scalable fonts are available, this returns a font which is 1 point larger.
104 Otherwise, it returns the next larger version of this font that is defined." 159 Otherwise, it returns the next larger version of this font that is defined."
105 nil) 160 (if (font-instance-p font)
161 (let (old-size (name (mswindows-font-canicolize-name font)))
162 (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name)
163 (setq old-size (string-to-int
164 (substring name (match-beginning 1) (match-end 1))))
165 (make-font-instance (concat
166 (substring name 0 (match-beginning 1))
167 (int-to-string (+ old-size 1))
168 (substring name (match-end 1)))
169 device t))))