Mercurial > hg > xemacs-beta
diff lisp/msw-faces.el @ 215:1f0dabaa0855 r20-4b6
Import from CVS: tag r20-4b6
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:07:35 +0200 |
parents | 78f53ef88e17 |
children | 6c0ae1f9357f |
line wrap: on
line diff
--- a/lisp/msw-faces.el Mon Aug 13 10:06:48 2007 +0200 +++ b/lisp/msw-faces.el Mon Aug 13 10:07:35 2007 +0200 @@ -54,52 +54,116 @@ ;;; Fill in missing parts of a font spec. This is primarily intended as a ;;; helper function for the functions below. ;;; mswindows fonts look like: -;;; fontname[:[weight ][style][:pointsize[:effects[:charset]]]] +;;; fontname[:[weight][ style][:pointsize[:effects[:charset]]]] ;;; A minimal mswindows font spec looks like: ;;; Courier New ;;; A maximal mswindows font spec looks like: ;;; Courier New:Bold Italic:10:underline strikeout:ansi ;;; Missing parts of the font spec should be filled in with these values: ;;; Courier New:Normal:10::ansi -(defun mswindows-canicolize-font (font &optional device) - "Given a mswindows font specification, this converts it to canonical form." - nil) +(defun mswindows-font-canicolize-name (font) + "Given a mswindows font specification, this returns its name in canonical +form." + (cond ((font-instance-p font) + (let ((name (font-instance-name font))) + (cond ((string-match + "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*:[a-zA-Z 0-9]*$" + name) name) + ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*$" + name) (concat name ":ansi")) + ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+$" name) + (concat name "::ansi")) + ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*$" name) + (concat name "10::ansi")) + ((string-match "^[a-zA-Z ]+$" name) + (concat name ":Normal:10::ansi")) + (t "Courier New:Normal:10::ansi")))) + (t "Courier New:Normal:10::ansi"))) (defun mswindows-make-font-bold (font &optional device) "Given a mswindows font specification, this attempts to make a bold font. If it fails, it returns nil." - nil) + (if (font-instance-p font) + (let ((name (mswindows-font-canicolize-name font))) + (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) + (make-font-instance (concat + (substring name 0 (match-beginning 1)) + "Bold" (substring name (match-end 1))) + device t)))) (defun mswindows-make-font-unbold (font &optional device) "Given a mswindows font specification, this attempts to make a non-bold font. If it fails, it returns nil." - nil) + (if (font-instance-p font) + (let ((name (mswindows-font-canicolize-name font))) + (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) + (make-font-instance (concat + (substring name 0 (match-beginning 1)) + "Normal" (substring name (match-end 1))) + device t)))) (defun mswindows-make-font-italic (font &optional device) - "Given a mswindows font specification, this attempts to make an `italic' font. -If it fails, it returns nil." - nil) + "Given a mswindows font specification, this attempts to make an `italic' +font. If it fails, it returns nil." + (if (font-instance-p font) + (let ((name (mswindows-font-canicolize-name font))) + (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) + (make-font-instance (concat + (substring name 0 (match-beginning 1)) + "Italic" (substring name (match-end 1))) + device t)))) (defun mswindows-make-font-unitalic (font &optional device) - "Given a mswindows font specification, this attempts to make a non-italic font. -If it fails, it returns nil." - nil) + "Given a mswindows font specification, this attempts to make a non-italic +font. If it fails, it returns nil." + (if (font-instance-p font) + (let ((name (mswindows-font-canicolize-name font))) + (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) + (make-font-instance (concat + (substring name 0 (match-beginning 1)) + "Normal" (substring name (match-end 1))) + device t)))) (defun mswindows-make-font-bold-italic (font &optional device) "Given a mswindows font specification, this attempts to make a `bold-italic' font. If it fails, it returns nil." - nil) + (if (font-instance-p font) + (let ((name (mswindows-font-canicolize-name font))) + (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) + (make-font-instance (concat + (substring name 0 (match-beginning 1)) + "Bold Italic" (substring name (match-end 1))) + device t)))) (defun mswindows-find-smaller-font (font &optional device) "Loads a new, version of the given font (or font name). Returns the font if it succeeds, nil otherwise. If scalable fonts are available, this returns a font which is 1 point smaller. Otherwise, it returns the next smaller version of this font that is defined." - nil) + (if (font-instance-p font) + (let (old-size (name (mswindows-font-canicolize-name font))) + (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name) + (setq old-size (string-to-int + (substring name (match-beginning 1) (match-end 1)))) + (if (> old-size 0) + (make-font-instance (concat + (substring name 0 (match-beginning 1)) + (int-to-string (- old-size 1)) + (substring name (match-end 1))) + device t))))) (defun mswindows-find-larger-font (font &optional device) "Loads a new, slightly larger version of the given font (or font name). Returns the font if it succeeds, nil otherwise. If scalable fonts are available, this returns a font which is 1 point larger. Otherwise, it returns the next larger version of this font that is defined." - nil) + (if (font-instance-p font) + (let (old-size (name (mswindows-font-canicolize-name font))) + (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name) + (setq old-size (string-to-int + (substring name (match-beginning 1) (match-end 1)))) + (make-font-instance (concat + (substring name 0 (match-beginning 1)) + (int-to-string (+ old-size 1)) + (substring name (match-end 1))) + device t))))