Mercurial > emacs

changeset 23636:3246160c5469

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(x-get-selection-value): Alias to x-cut-buffer-or-selection-value. (w32-standard-fontset-spec): New variable. (w32-create-initial-fontsets, mouse-set-font): Check whether new-fontset is available. (w32-use-w32-font-dialog): Enable use of set-variable.
author Geoff Voelker <voelker@cs.washington.edu>
date Wed, 04 Nov 1998 23:23:57 +0000
parents 9717d57c40c1
children 54b22e0a1f7b
files lisp/term/w32-win.el
diffstat 1 files changed, 101 insertions(+), 78 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/term/w32-win.el	Wed Nov 04 15:09:38 1998 +0000
+++ b/lisp/term/w32-win.el	Wed Nov 04 23:23:57 1998 +0000
@@ -579,6 +579,9 @@
 	 (t
 	  (setq x-last-selected-text text))))))
 
+(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value)
+
+
 ;;; Do the actual Windows setup here; the above code just defines
 ;;; functions and variables that we use now.
 
@@ -614,6 +617,101 @@
 ;; This has ,? to match both on Sunos and on Solaris.
 (menu-bar-enable-clipboard)
 
+;; W32 systems have different fonts than commonly found on X, so
+;; we define our own standard fontset here.
+(defvar w32-standard-fontset-spec
+ "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-fontset-standard,
+ latin-iso8859-2:-*-Courier New CE-normal-r-*-*-13-*-*-*-c-*-iso8859-2,
+ latin-iso8859-3:-*-Courier New Tur-normal-r-*-*-13-*-*-*-c-*-iso8859-3,
+ latin-iso8859-4:-*-Courier New Baltic-normal-r-*-*-13-*-*-*-c-*-iso8859-4,
+ cyrillic-iso8859-5:-*-Courier New Cyr-normal-r-*-*-13-*-*-*-c-*-iso8859-5,
+ greek-iso8859-7:-*-Courier New Greek-normal-r-*-*-13-*-*-*-c-*-iso8859-7"
+ "String of fontset spec of the standard fontset. This defines a
+fontset consisting of the Courier New variations for European
+languages which are distributed with Windows as \"Multilanguage Support\".
+
+See the documentation of `create-fontset-from-fontset-spec for the format.")
+
+(if (fboundp 'new-fontset)
+    (progn
+      (defun w32-create-initial-fontsets ()
+        "Create fontset-startup, fontset-standard and any fontsets
+specified in X resources."
+        ;; Create the standard fontset.
+        (create-fontset-from-fontset-spec w32-standard-fontset-spec t)
+
+        ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...).
+        (create-fontset-from-x-resource)
+
+        ;; Try to create a fontset from a font specification which comes
+        ;; from initial-frame-alist, default-frame-alist, or X resource.
+        ;; A font specification in command line argument (i.e. -fn XXXX)
+        ;; should be already in default-frame-alist as a `font'
+        ;; parameter.  However, any font specifications in site-start
+        ;; library, user's init file (.emacs), and default.el are not
+        ;; yet handled here.
+
+        (let ((font (or (cdr (assq 'font initial-frame-alist))
+                        (cdr (assq 'font default-frame-alist))
+                        (x-get-resource "font" "Font")))
+              xlfd-fields resolved-name)
+          (if (and font
+                   (not (query-fontset font))
+                   (setq resolved-name (x-resolve-font-name font))
+                   (setq xlfd-fields (x-decompose-font-name font)))
+              (if (string= "fontset"
+                           (aref xlfd-fields xlfd-regexp-registry-subnum))
+                  (new-fontset font
+                               (x-complement-fontset-spec xlfd-fields nil))
+                ;; Create a fontset from FONT.  The fontset name is
+                ;; generated from FONT.  Create style variants of the
+                ;; fontset too.  Font names in the variants are
+                ;; generated automatially unless X resources
+                ;; XXX.attribyteFont explicitly specify them.
+                (let ((styles (mapcar 'car x-style-funcs-alist))
+                      (faces '(bold italic bold-italic))
+                      face face-font fontset fontset-spec)
+                  (while faces
+                    (setq face (car faces))
+                    (setq face-font (x-get-resource (concat (symbol-name face)
+                                                            ".attributeFont")
+                                                    "Face.AttributeFont"))
+                    (if face-font
+                        (setq styles (cons (cons face face-font)
+                                           (delq face styles))))
+                    (setq faces (cdr faces)))
+                  (aset xlfd-fields xlfd-regexp-foundry-subnum nil)
+                  (aset xlfd-fields xlfd-regexp-family-subnum nil)
+                  (aset xlfd-fields xlfd-regexp-registry-subnum "fontset")
+                  (aset xlfd-fields xlfd-regexp-encoding-subnum "startup")
+                  ;; The fontset name should have concrete values in
+                  ;; weight and slant field.
+                  (let ((weight (aref xlfd-fields xlfd-regexp-weight-subnum))
+                        (slant (aref xlfd-fields xlfd-regexp-slant-subnum))
+                        xlfd-temp)
+                    (if (or (not weight) (string-match "[*?]*" weight))
+                        (progn
+                          (setq xlfd-temp
+                                (x-decompose-font-name resolved-name))
+                          (aset xlfd-fields xlfd-regexp-weight-subnum
+                                (aref xlfd-temp xlfd-regexp-weight-subnum))))
+                    (if (or (not slant) (string-match "[*?]*" slant))
+                        (progn
+                          (or xlfd-temp
+                              (setq xlfd-temp
+                                    (x-decompose-font-name resolved-name)))
+                          (aset xlfd-fields xlfd-regexp-slant-subnum
+                                (aref xlfd-temp xlfd-regexp-slant-subnum)))))
+                  (setq fontset (x-compose-font-name xlfd-fields))
+                  (create-fontset-from-fontset-spec
+                   (concat fontset ", ascii:" font) styles)
+                  )))))
+      ;; This cannot be run yet, as creating fontsets requires a
+      ;; Window to be initialised so the fonts can be listed.
+      ;; Add it to a hook so it gets run later.
+      (add-hook 'before-init-hook 'w32-create-initial-fontsets)
+      ))
+
 ;; Apply a geometry resource to the initial frame.  Put it at the end
 ;; of the alist, so that anything specified on the command line takes
 ;; precedence.
@@ -702,7 +800,7 @@
 
 ;; Redefine the font selection to use the standard W32 dialog
 (defvar w32-use-w32-font-dialog t
-  "Use the standard font dialog if 't' - otherwise pop up a menu of
+  "*Use the standard font dialog if 't' - otherwise pop up a menu of
 some standard fonts like X does - including fontsets")
 
 (defvar w32-fixed-font-alist
@@ -790,7 +888,8 @@
      (x-popup-menu
       last-nonmenu-event
     ;; Append list of fontsets currently defined.
-    (append w32-fixed-font-alist (list (generate-fontset-menu))))))
+      (if (fboundp 'new-fontset)
+      (append w32-fixed-font-alist (list (generate-fontset-menu)))))))
   (if fonts
       (let (font)
 	(while fonts
@@ -805,79 +904,3 @@
 	    (error "Font not found")))))
 
 ;;; w32-win.el ends here
-;;; The code in w32-init-fontsets requires a w32 frame to have been created,
-;;; which is not the case when this file is loaded during startup.
-(add-hook 'before-init-hook 'w32-init-fontsets)
-
-(defun w32-init-fontsets ()
-  "Initialize standard fontsets for w32."
-  (if (fboundp 'new-fontset)
-      (progn
-	;; Create the standard fontset.
-	(create-fontset-from-fontset-spec standard-fontset-spec t)
-
-	;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
-	(create-fontset-from-x-resource)
-
-	;; Try to create a fontset from a font specification which comes
-	;; from initial-frame-alist, default-frame-alist, or X resource.
-	;; A font specification in command line argument (i.e. -fn XXXX)
-	;; should be already in default-frame-alist as a `font'
-	;; parameter.  However, any font specifications in site-start
-	;; library, user's init file (.emacs), and default.el are not
-	;; yet handled here.
-
-	(let ((font (or (cdr (assq 'font initial-frame-alist))
-			(cdr (assq 'font default-frame-alist))
-			(x-get-resource "font" "Font")))
-	      xlfd-fields resolved-name)
-	  (if (and font
-		   (not (query-fontset font))
-		   (setq resolved-name (x-resolve-font-name font))
-		   (setq xlfd-fields (x-decompose-font-name font)))
-	      (if (string= "fontset"
-			   (aref xlfd-fields xlfd-regexp-registry-subnum))
-		  (new-fontset font (x-complement-fontset-spec xlfd-fields nil))
-		;; Create a fontset from FONT.  The fontset name is
-		;; generated from FONT.  Create style variants of the
-		;; fontset too.  Font names in the variants are
-		;; generated automatially unless X resources
-		;; XXX.attribyteFont explicitly specify them.
-		(let ((styles (mapcar 'car x-style-funcs-alist))
-		      (faces '(bold italic bold-italic))
-		      face face-font fontset fontset-spec)
-		  (while faces
-		    (setq face (car faces))
-		    (setq face-font (x-get-resource (concat (symbol-name face)
-							    ".attributeFont")
-						    "Face.AttributeFont"))
-		    (if face-font
-			(setq styles (cons (cons face face-font)
-					   (delq face styles))))
-		    (setq faces (cdr faces)))
-		  (aset xlfd-fields xlfd-regexp-foundry-subnum nil)
-		  (aset xlfd-fields xlfd-regexp-family-subnum nil)
-		  (aset xlfd-fields xlfd-regexp-registry-subnum "fontset")
-		  (aset xlfd-fields xlfd-regexp-encoding-subnum "startup")
-		  ;; The fontset name should have concrete values in
-		  ;; weight and slant field.
-		  (let ((weight (aref xlfd-fields xlfd-regexp-weight-subnum))
-			(slant (aref xlfd-fields xlfd-regexp-slant-subnum))
-			xlfd-temp)
-		    (if (or (not weight) (string-match "[*?]*" weight))
-			(progn
-			  (setq xlfd-temp (x-decompose-font-name resolved-name))
-			  (aset xlfd-fields xlfd-regexp-weight-subnum
-				(aref xlfd-temp xlfd-regexp-weight-subnum))))
-		    (if (or (not slant) (string-match "[*?]*" slant))
-			(progn
-			  (or xlfd-temp
-			      (setq xlfd-temp
-				    (x-decompose-font-name resolved-name)))
-			  (aset xlfd-fields xlfd-regexp-slant-subnum
-				(aref xlfd-temp xlfd-regexp-slant-subnum)))))
-		  (setq fontset (x-compose-font-name xlfd-fields))
-		  (create-fontset-from-fontset-spec
-		   (concat fontset ", ascii:" font) styles)
-		  )))))))
-