changeset 29322:16e1a87707b5

Doc changes to reduce diffs with x-win.el. Reenable code to create initial fontsets. Use set-fontset-font in place of put-charset-property.
author Jason Rumney <jasonr@gnu.org>
date Tue, 30 May 2000 22:34:26 +0000
parents 8e2be36bb1c6
children d1176f1c776e
files lisp/term/w32-win.el
diffstat 1 files changed, 76 insertions(+), 115 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/term/w32-win.el	Tue May 30 21:59:27 2000 +0000
+++ b/lisp/term/w32-win.el	Tue May 30 22:34:26 2000 +0000
@@ -84,7 +84,7 @@
 ;; scroll bar routines.
 
 (defun w32-handle-scroll-bar-event (event)
-  "Handle W32 scroll bar events to do normal Window style scrolling."
+  "Handle W32 scroll bar EVENT to do normal Window style scrolling."
   (interactive "e")
   (let ((old-window (selected-window)))
     (unwind-protect
@@ -121,7 +121,7 @@
   "*Number of lines to scroll per click of the mouse wheel.")
 
 (defun mouse-wheel-scroll-line (event)
-  "Scroll the current buffer by `mouse-wheel-scroll-amount'."
+  "Scroll the window in which EVENT occurred by `mouse-wheel-scroll-amount'."
   (interactive "e")
   (condition-case nil
       (if (< (car (cdr (cdr event))) 0)
@@ -134,7 +134,7 @@
 (setq scroll-command-groups (list '(mouse-wheel-scroll-line)))
 
 (defun mouse-wheel-scroll-screen (event)
-  "Scroll the current buffer by `mouse-wheel-scroll-amount'."
+  "Scroll the window in which EVENT occurred by `mouse-wheel-scroll-amount'."
   (interactive "e")
   (condition-case nil
       (if (< (car (cdr (cdr event))) 0)
@@ -146,13 +146,13 @@
 (global-set-key [mouse-wheel] 'mouse-wheel-scroll-line)
 (global-set-key [C-mouse-wheel] 'mouse-wheel-scroll-screen)
 
-(defun w32-drag-n-drop-debug (event) 
-  "Print the drag-n-drop event in a readable form."
-  (interactive "e") 
+(defun w32-drag-n-drop-debug (event)
+  "Print the drag-n-drop EVENT in a readable form."
+  (interactive "e")
   (princ event))
 
 (defun w32-drag-n-drop (event)
-  "Edit the files listed in the drag-n-drop event.
+  "Edit the files listed in the drag-n-drop EVENT.
 Switch to a buffer editing the last file dropped."
   (interactive "e")
   (save-excursion
@@ -169,7 +169,7 @@
   (raise-frame)))
 
 (defun w32-drag-n-drop-other-frame (event)
-  "Edit the files listed in the drag-n-drop event, in other frames.
+  "Edit the files listed in the drag-n-drop EVENT, in other frames.
 May create new frames, or reuse existing ones.  The frame editing
 the last file dropped is selected."
   (interactive "e")
@@ -259,8 +259,9 @@
     ("-bd" border-color)
     ("-bw" border-width)))
 
-;; Handler for switches of the form "-switch value" or "-switch".
+
 (defun x-handle-switch (switch)
+  "Handle SWITCH of the form \"-switch value\" or \"-switch\"."
   (let ((aelt (assoc switch x-switch-definitions)))
     (if aelt
 	(if (nth 2 aelt)
@@ -273,13 +274,14 @@
 		      default-frame-alist)
 		x-invocation-args (cdr x-invocation-args))))))
 
-;; Make -iconic apply only to the initial frame!
 (defun x-handle-iconic (switch)
+  "Make \"-iconic\" SWITCH apply only to the initial frame."
   (setq initial-frame-alist
 	(cons '(visibility . icon) initial-frame-alist)))
 
-;; Handler for switches of the form "-switch n"
+
 (defun x-handle-numeric-switch (switch)
+  "Handle SWITCH of the form \"-switch n\"."
   (let ((aelt (assoc switch x-switch-definitions)))
     (if aelt
 	(setq default-frame-alist
@@ -289,15 +291,15 @@
 	      x-invocation-args
 	      (cdr x-invocation-args)))))
 
-;; Handle the -xrm option.
 (defun x-handle-xrm-switch (switch)
+  "Handle the \"-xrm\" SWITCH."
   (or (consp x-invocation-args)
       (error "%s: missing argument to `%s' option" (invocation-name) switch))
   (setq x-command-line-resources (car x-invocation-args))
   (setq x-invocation-args (cdr x-invocation-args)))
 
-;; Handle the geometry option
 (defun x-handle-geometry (switch)
+  "Handle the \"-geometry\" SWITCH."
   (let ((geo (x-parse-geometry (car x-invocation-args))))
     (setq initial-frame-alist
 	  (append initial-frame-alist
@@ -308,10 +310,11 @@
 		  geo)
 	  x-invocation-args (cdr x-invocation-args))))
 
+(defun x-handle-name-rn-switch (switch)
+  "Handle a \"-name\" or \"-rn\" SWITCH."
 ;; Handle the -name and -rn options.  Set the variable x-resource-name
 ;; to the option's operand; if the switch was `-name', set the name of
 ;; the initial frame, too.
-(defun x-handle-name-rn-switch (switch)
   (or (consp x-invocation-args)
       (error "%s: missing argument to `%s' option" (invocation-name) switch))
   (setq x-resource-name (car x-invocation-args)
@@ -324,6 +327,7 @@
   "The display name specifying server and frame.")
 
 (defun x-handle-display (switch)
+  "Handle the \"-display\" SWITCH."
   (setq x-display-name (car x-invocation-args)
 	x-invocation-args (cdr x-invocation-args)))
 
@@ -567,15 +571,18 @@
 This is in addition to the primary selection.")
 
 (defun x-select-text (text &optional push)
-  (if x-select-enable-clipboard 
+  "Make TEXT the last selected text.
+If `x-select-enable-clipboard' is non-nil, copy the text to the system
+clipboard as well. Optional PUSH is ignored on Windows."
+  (if x-select-enable-clipboard
       (w32-set-clipboard-data text))
   (setq x-last-selected-text text))
     
-;;; Return the value of the current selection.
-;;; Consult the selection, then the cut buffer.  Treat empty strings
-;;; as if they were unset.
 (defun x-get-selection-value ()
-  (if x-select-enable-clipboard 
+  "Return the value of the current selection.
+Consult the selection, then the cut buffer.  Treat empty strings as if
+they were unset."
+  (if x-select-enable-clipboard
       (let (text)
 	;; Don't die if x-get-selection signals an error.
 	(condition-case c
@@ -634,91 +641,43 @@
 ;; we define our own standard fontset here.
 (defvar w32-standard-fontset-spec
  "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-fontset-standard"
- "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\".
+ "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.
+(if (fboundp 'new-fontset)
+    (progn
+      ;; 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)
-;       ))
+      (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-fontset-from-ascii-font font
+					      resolved-name "startup"))))))
 
 ;; 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
@@ -761,7 +720,8 @@
       (setq x-selection-timeout (string-to-number res-selection-timeout))))
 
 (defun x-win-suspend-error ()
-  (error "Suspending an emacs running under W32 makes no sense"))
+  "Report an error when a suspend is attempted."
+  (error "Suspending an Emacs running under W32 makes no sense"))
 (add-hook 'suspend-hook 'x-win-suspend-error)
 
 ;;; Arrange for the kill and yank functions to set and check the clipboard.
@@ -808,8 +768,9 @@
 
 ;; 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
-some standard fonts like X does - including fontsets")
+  "*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
   '("Font menu"
@@ -884,22 +845,22 @@
      ("11 bold italic" "-*-Courier New-bold-i-*-*-15-*-*-*-c-*-iso8859-1")
      ("12 bold italic" "-*-Courier New-bold-i-*-*-16-*-*-*-c-*-iso8859-1")
      ))
-    "Fonts suitable for use in Emacs. Initially this is a list of some
-fixed width fonts that most people will have like Terminal and
-Courier. These fonts are used in the font menu if the variable
-`w32-use-w32-font-dialog' is nil.")
+    "Fonts suitable for use in Emacs.
+Initially this is a list of some fixed width fonts that most people
+will have like Terminal and Courier. These fonts are used in the font
+menu if the variable `w32-use-w32-font-dialog' is nil.")
 
 ;;; Enable Japanese fonts on Windows to be used by default.
-(put-charset-property 'katakana-jisx0201 'x-charset-registry "JISX0208-SJIS")
-(put-charset-property 'latin-jisx0201 'x-charset-registry "JISX0208-SJIS")
-(put-charset-property 'japanese-jisx0208 'x-charset-registry "JISX0208-SJIS")
-(put-charset-property 'japanese-jisx0208-1978 'x-charset-registry
-                      "JISX0208-SJIS")
+(set-fontset-font t (make-char 'katakana-jisx0201) "JISX0208-SJIS")
+(set-fontset-font t (make-char 'latin-jisx0201) "JISX0208-SJIS")
+(set-fontset-font t (make-char 'japanese-jisx0208) "JISX0208-SJIS")
+(set-fontset-font t (make-char 'japanese-jisx0208-1978) "JISX0208-SJIS")
 
 (defun mouse-set-font (&rest fonts)
-  "Select a font. If `w32-use-w32-font-dialog' is non-nil (the default),
-use the Windows font dialog. Otherwise use a pop-up menu (like Emacs
-on other platforms) initialized with the fonts in
+  "Select a font.
+If `w32-use-w32-font-dialog' is non-nil (the default), use the Windows
+font dialog to get the matching FONTS. Otherwise use a pop-up menu
+(like Emacs on other platforms) initialized with the fonts in
 `w32-fixed-font-alist'."
   (interactive
    (if w32-use-w32-font-dialog