Mercurial > hg > xemacs-beta

comparison lisp/energize/energize-font-size.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 0293115a14e9
children
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;; General Public License for more details. 14 ;; General Public License for more details.
15 15
16 ;; You should have received a copy of the GNU General Public License 16 ;; You should have received a copy of the GNU General Public License
17 ;; along with XEmacs; see the file COPYING. If not, write to the 17 ;; along with XEmacs; see the file COPYING. If not, write to the Free
18 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 18 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19 ;; Boston, MA 02111-1307, USA.
20 19
21 (defconst energize-x-modify-font-regexp 20 (defconst energize-x-modify-font-regexp
22 "-\\([^-]+-[^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)" 21 "-\\([^-]+-[^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)"
23 "Regexpr to extract or modify font entries") 22 "Regexpr to extract or modify font entries")
24 23
51 (let* ((font (face-font face)) 50 (let* ((font (face-font face))
52 (new-font (energize-x-set-font-entry font entry value))) 51 (new-font (energize-x-set-font-entry font entry value)))
53 (and new-font 52 (and new-font
54 (condition-case a 53 (condition-case a
55 (set-face-font face new-font) 54 (set-face-font face new-font)
56 (error (message (format "%S" a)) (sit-for 0)))))) 55 (error (message "%S" a) (sit-for 0))))))
57 56
58 (defun energize-set-font-size (size) 57 (defun energize-set-font-size (size)
59 (interactive "sSet new font size to: ") 58 (interactive "sSet new font size to: ")
60 (mapcar '(lambda (face) (energize-x-set-face-font-entry face 7 size)) 59 (mapcar '(lambda (face) (energize-x-set-face-font-entry face 7 size))
61 (list-faces))) 60 (list-faces)))
90 (defun energize-set-font-family (family) 89 (defun energize-set-font-family (family)
91 (interactive "sSet new font family to: ") 90 (interactive "sSet new font family to: ")
92 (let ((font-desc (cdr (assoc family energize-font-families-parameters))) 91 (let ((font-desc (cdr (assoc family energize-font-families-parameters)))
93 (faces (list-faces))) 92 (faces (list-faces)))
94 (if (null font-desc) 93 (if (null font-desc)
95 (error (format "Unknown font family %s, use one of %s" family 94 (error "Unknown font family %s, use one of %s" family
96 (mapcar 'car energize-font-families-parameters)))) 95 (mapcar 'car energize-font-families-parameters)))
97 (while faces 96 (while faces
98 (let* ((face (car faces)) 97 (let* ((face (car faces))
99 (font (face-font face)) 98 (font (face-font face))
100 (f-name (and font (font-name font)))) 99 (f-name (and font (font-name font))))
101 (if f-name 100 (if f-name