aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/term
diff options
context:
space:
mode:
authorJason Rumney2000-05-30 22:34:26 +0000
committerJason Rumney2000-05-30 22:34:26 +0000
commitde0c7b5d2cc48c9066ea4a2936ba34a85662a01d (patch)
tree082bc1a58198a8c318740892453832000d44a3b3 /lisp/term
parent9ef2e2cf037d33efa11c9c9157318496a86bb74d (diff)
downloademacs-de0c7b5d2cc48c9066ea4a2936ba34a85662a01d.tar.gz
emacs-de0c7b5d2cc48c9066ea4a2936ba34a85662a01d.zip
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.
Diffstat (limited to 'lisp/term')
-rw-r--r--lisp/term/w32-win.el193
1 files changed, 77 insertions, 116 deletions
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index 07d35c63b19..081c8d1ff85 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -84,7 +84,7 @@
84;; scroll bar routines. 84;; scroll bar routines.
85 85
86(defun w32-handle-scroll-bar-event (event) 86(defun w32-handle-scroll-bar-event (event)
87 "Handle W32 scroll bar events to do normal Window style scrolling." 87 "Handle W32 scroll bar EVENT to do normal Window style scrolling."
88 (interactive "e") 88 (interactive "e")
89 (let ((old-window (selected-window))) 89 (let ((old-window (selected-window)))
90 (unwind-protect 90 (unwind-protect
@@ -121,7 +121,7 @@
121 "*Number of lines to scroll per click of the mouse wheel.") 121 "*Number of lines to scroll per click of the mouse wheel.")
122 122
123(defun mouse-wheel-scroll-line (event) 123(defun mouse-wheel-scroll-line (event)
124 "Scroll the current buffer by `mouse-wheel-scroll-amount'." 124 "Scroll the window in which EVENT occurred by `mouse-wheel-scroll-amount'."
125 (interactive "e") 125 (interactive "e")
126 (condition-case nil 126 (condition-case nil
127 (if (< (car (cdr (cdr event))) 0) 127 (if (< (car (cdr (cdr event))) 0)
@@ -134,7 +134,7 @@
134(setq scroll-command-groups (list '(mouse-wheel-scroll-line))) 134(setq scroll-command-groups (list '(mouse-wheel-scroll-line)))
135 135
136(defun mouse-wheel-scroll-screen (event) 136(defun mouse-wheel-scroll-screen (event)
137 "Scroll the current buffer by `mouse-wheel-scroll-amount'." 137 "Scroll the window in which EVENT occurred by `mouse-wheel-scroll-amount'."
138 (interactive "e") 138 (interactive "e")
139 (condition-case nil 139 (condition-case nil
140 (if (< (car (cdr (cdr event))) 0) 140 (if (< (car (cdr (cdr event))) 0)
@@ -146,13 +146,13 @@
146(global-set-key [mouse-wheel] 'mouse-wheel-scroll-line) 146(global-set-key [mouse-wheel] 'mouse-wheel-scroll-line)
147(global-set-key [C-mouse-wheel] 'mouse-wheel-scroll-screen) 147(global-set-key [C-mouse-wheel] 'mouse-wheel-scroll-screen)
148 148
149(defun w32-drag-n-drop-debug (event) 149(defun w32-drag-n-drop-debug (event)
150 "Print the drag-n-drop event in a readable form." 150 "Print the drag-n-drop EVENT in a readable form."
151 (interactive "e") 151 (interactive "e")
152 (princ event)) 152 (princ event))
153 153
154(defun w32-drag-n-drop (event) 154(defun w32-drag-n-drop (event)
155 "Edit the files listed in the drag-n-drop event. 155 "Edit the files listed in the drag-n-drop EVENT.
156Switch to a buffer editing the last file dropped." 156Switch to a buffer editing the last file dropped."
157 (interactive "e") 157 (interactive "e")
158 (save-excursion 158 (save-excursion
@@ -169,7 +169,7 @@ Switch to a buffer editing the last file dropped."
169 (raise-frame))) 169 (raise-frame)))
170 170
171(defun w32-drag-n-drop-other-frame (event) 171(defun w32-drag-n-drop-other-frame (event)
172 "Edit the files listed in the drag-n-drop event, in other frames. 172 "Edit the files listed in the drag-n-drop EVENT, in other frames.
173May create new frames, or reuse existing ones. The frame editing 173May create new frames, or reuse existing ones. The frame editing
174the last file dropped is selected." 174the last file dropped is selected."
175 (interactive "e") 175 (interactive "e")
@@ -259,8 +259,9 @@ the last file dropped is selected."
259 ("-bd" border-color) 259 ("-bd" border-color)
260 ("-bw" border-width))) 260 ("-bw" border-width)))
261 261
262;; Handler for switches of the form "-switch value" or "-switch". 262
263(defun x-handle-switch (switch) 263(defun x-handle-switch (switch)
264 "Handle SWITCH of the form \"-switch value\" or \"-switch\"."
264 (let ((aelt (assoc switch x-switch-definitions))) 265 (let ((aelt (assoc switch x-switch-definitions)))
265 (if aelt 266 (if aelt
266 (if (nth 2 aelt) 267 (if (nth 2 aelt)
@@ -273,13 +274,14 @@ the last file dropped is selected."
273 default-frame-alist) 274 default-frame-alist)
274 x-invocation-args (cdr x-invocation-args)))))) 275 x-invocation-args (cdr x-invocation-args))))))
275 276
276;; Make -iconic apply only to the initial frame!
277(defun x-handle-iconic (switch) 277(defun x-handle-iconic (switch)
278 "Make \"-iconic\" SWITCH apply only to the initial frame."
278 (setq initial-frame-alist 279 (setq initial-frame-alist
279 (cons '(visibility . icon) initial-frame-alist))) 280 (cons '(visibility . icon) initial-frame-alist)))
280 281
281;; Handler for switches of the form "-switch n" 282
282(defun x-handle-numeric-switch (switch) 283(defun x-handle-numeric-switch (switch)
284 "Handle SWITCH of the form \"-switch n\"."
283 (let ((aelt (assoc switch x-switch-definitions))) 285 (let ((aelt (assoc switch x-switch-definitions)))
284 (if aelt 286 (if aelt
285 (setq default-frame-alist 287 (setq default-frame-alist
@@ -289,15 +291,15 @@ the last file dropped is selected."
289 x-invocation-args 291 x-invocation-args
290 (cdr x-invocation-args))))) 292 (cdr x-invocation-args)))))
291 293
292;; Handle the -xrm option.
293(defun x-handle-xrm-switch (switch) 294(defun x-handle-xrm-switch (switch)
295 "Handle the \"-xrm\" SWITCH."
294 (or (consp x-invocation-args) 296 (or (consp x-invocation-args)
295 (error "%s: missing argument to `%s' option" (invocation-name) switch)) 297 (error "%s: missing argument to `%s' option" (invocation-name) switch))
296 (setq x-command-line-resources (car x-invocation-args)) 298 (setq x-command-line-resources (car x-invocation-args))
297 (setq x-invocation-args (cdr x-invocation-args))) 299 (setq x-invocation-args (cdr x-invocation-args)))
298 300
299;; Handle the geometry option
300(defun x-handle-geometry (switch) 301(defun x-handle-geometry (switch)
302 "Handle the \"-geometry\" SWITCH."
301 (let ((geo (x-parse-geometry (car x-invocation-args)))) 303 (let ((geo (x-parse-geometry (car x-invocation-args))))
302 (setq initial-frame-alist 304 (setq initial-frame-alist
303 (append initial-frame-alist 305 (append initial-frame-alist
@@ -308,10 +310,11 @@ the last file dropped is selected."
308 geo) 310 geo)
309 x-invocation-args (cdr x-invocation-args)))) 311 x-invocation-args (cdr x-invocation-args))))
310 312
313(defun x-handle-name-rn-switch (switch)
314 "Handle a \"-name\" or \"-rn\" SWITCH."
311;; Handle the -name and -rn options. Set the variable x-resource-name 315;; Handle the -name and -rn options. Set the variable x-resource-name
312;; to the option's operand; if the switch was `-name', set the name of 316;; to the option's operand; if the switch was `-name', set the name of
313;; the initial frame, too. 317;; the initial frame, too.
314(defun x-handle-name-rn-switch (switch)
315 (or (consp x-invocation-args) 318 (or (consp x-invocation-args)
316 (error "%s: missing argument to `%s' option" (invocation-name) switch)) 319 (error "%s: missing argument to `%s' option" (invocation-name) switch))
317 (setq x-resource-name (car x-invocation-args) 320 (setq x-resource-name (car x-invocation-args)
@@ -324,6 +327,7 @@ the last file dropped is selected."
324 "The display name specifying server and frame.") 327 "The display name specifying server and frame.")
325 328
326(defun x-handle-display (switch) 329(defun x-handle-display (switch)
330 "Handle the \"-display\" SWITCH."
327 (setq x-display-name (car x-invocation-args) 331 (setq x-display-name (car x-invocation-args)
328 x-invocation-args (cdr x-invocation-args))) 332 x-invocation-args (cdr x-invocation-args)))
329 333
@@ -567,15 +571,18 @@ This returns ARGS with the arguments that have been processed removed."
567This is in addition to the primary selection.") 571This is in addition to the primary selection.")
568 572
569(defun x-select-text (text &optional push) 573(defun x-select-text (text &optional push)
570 (if x-select-enable-clipboard 574 "Make TEXT the last selected text.
575If `x-select-enable-clipboard' is non-nil, copy the text to the system
576clipboard as well. Optional PUSH is ignored on Windows."
577 (if x-select-enable-clipboard
571 (w32-set-clipboard-data text)) 578 (w32-set-clipboard-data text))
572 (setq x-last-selected-text text)) 579 (setq x-last-selected-text text))
573 580
574;;; Return the value of the current selection.
575;;; Consult the selection, then the cut buffer. Treat empty strings
576;;; as if they were unset.
577(defun x-get-selection-value () 581(defun x-get-selection-value ()
578 (if x-select-enable-clipboard 582 "Return the value of the current selection.
583Consult the selection, then the cut buffer. Treat empty strings as if
584they were unset."
585 (if x-select-enable-clipboard
579 (let (text) 586 (let (text)
580 ;; Don't die if x-get-selection signals an error. 587 ;; Don't die if x-get-selection signals an error.
581 (condition-case c 588 (condition-case c
@@ -634,91 +641,43 @@ This is in addition to the primary selection.")
634;; we define our own standard fontset here. 641;; we define our own standard fontset here.
635(defvar w32-standard-fontset-spec 642(defvar w32-standard-fontset-spec
636 "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-fontset-standard" 643 "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-fontset-standard"
637 "String of fontset spec of the standard fontset. This defines a 644 "String of fontset spec of the standard fontset.
638fontset consisting of the Courier New variations for European 645This defines a fontset consisting of the Courier New variations for
639languages which are distributed with Windows as \"Multilanguage Support\". 646European languages which are distributed with Windows as
647\"Multilanguage Support\".
640 648
641See the documentation of `create-fontset-from-fontset-spec for the format.") 649See the documentation of `create-fontset-from-fontset-spec for the format.")
642 650
643; (if (fboundp 'new-fontset) 651(if (fboundp 'new-fontset)
644; (progn 652 (progn
645; (defun w32-create-initial-fontsets () 653 ;; Create the standard fontset.
646; "Create fontset-startup, fontset-standard and any fontsets 654 (create-fontset-from-fontset-spec w32-standard-fontset-spec t)
647; specified in X resources." 655 ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...).
648; ;; Create the standard fontset. 656 (create-fontset-from-x-resource)
649; (create-fontset-from-fontset-spec w32-standard-fontset-spec t) 657 ;; Try to create a fontset from a font specification which comes
650 658 ;; from initial-frame-alist, default-frame-alist, or X resource.
651; ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...). 659 ;; A font specification in command line argument (i.e. -fn XXXX)
652; (create-fontset-from-x-resource) 660 ;; should be already in default-frame-alist as a `font'
653 661 ;; parameter. However, any font specifications in site-start
654; ;; Try to create a fontset from a font specification which comes 662 ;; library, user's init file (.emacs), and default.el are not
655; ;; from initial-frame-alist, default-frame-alist, or X resource. 663 ;; yet handled here.
656; ;; A font specification in command line argument (i.e. -fn XXXX) 664
657; ;; should be already in default-frame-alist as a `font' 665 (let ((font (or (cdr (assq 'font initial-frame-alist))
658; ;; parameter. However, any font specifications in site-start 666 (cdr (assq 'font default-frame-alist))
659; ;; library, user's init file (.emacs), and default.el are not 667 (x-get-resource "font" "Font")))
660; ;; yet handled here. 668 xlfd-fields resolved-name)
661 669 (if (and font
662; (let ((font (or (cdr (assq 'font initial-frame-alist)) 670 (not (query-fontset font))
663; (cdr (assq 'font default-frame-alist)) 671 (setq resolved-name (x-resolve-font-name font))
664; (x-get-resource "font" "Font"))) 672 (setq xlfd-fields (x-decompose-font-name font)))
665; xlfd-fields resolved-name) 673 (if (string= "fontset"
666; (if (and font 674 (aref xlfd-fields xlfd-regexp-registry-subnum))
667; (not (query-fontset font)) 675 (new-fontset font
668; (setq resolved-name (x-resolve-font-name font)) 676 (x-complement-fontset-spec xlfd-fields nil))
669; (setq xlfd-fields (x-decompose-font-name font))) 677 ;; Create a fontset from FONT. The fontset name is
670; (if (string= "fontset" 678 ;; generated from FONT.
671; (aref xlfd-fields xlfd-regexp-registry-subnum)) 679 (create-fontset-from-ascii-font font
672; (new-fontset font 680 resolved-name "startup"))))))
673; (x-complement-fontset-spec xlfd-fields nil))
674; ;; Create a fontset from FONT. The fontset name is
675; ;; generated from FONT. Create style variants of the
676; ;; fontset too. Font names in the variants are
677; ;; generated automatially unless X resources
678; ;; XXX.attribyteFont explicitly specify them.
679; (let ((styles (mapcar 'car x-style-funcs-alist))
680; (faces '(bold italic bold-italic))
681; face face-font fontset fontset-spec)
682; (while faces
683; (setq face (car faces))
684; (setq face-font (x-get-resource (concat (symbol-name face)
685; ".attributeFont")
686; "Face.AttributeFont"))
687; (if face-font
688; (setq styles (cons (cons face face-font)
689; (delq face styles))))
690; (setq faces (cdr faces)))
691; (aset xlfd-fields xlfd-regexp-foundry-subnum nil)
692; (aset xlfd-fields xlfd-regexp-family-subnum nil)
693; (aset xlfd-fields xlfd-regexp-registry-subnum "fontset")
694; (aset xlfd-fields xlfd-regexp-encoding-subnum "startup")
695; ;; The fontset name should have concrete values in
696; ;; weight and slant field.
697; (let ((weight (aref xlfd-fields xlfd-regexp-weight-subnum))
698; (slant (aref xlfd-fields xlfd-regexp-slant-subnum))
699; xlfd-temp)
700; (if (or (not weight) (string-match "[*?]*" weight))
701; (progn
702; (setq xlfd-temp
703; (x-decompose-font-name resolved-name))
704; (aset xlfd-fields xlfd-regexp-weight-subnum
705; (aref xlfd-temp xlfd-regexp-weight-subnum))))
706; (if (or (not slant) (string-match "[*?]*" slant))
707; (progn
708; (or xlfd-temp
709; (setq xlfd-temp
710; (x-decompose-font-name resolved-name)))
711; (aset xlfd-fields xlfd-regexp-slant-subnum
712; (aref xlfd-temp xlfd-regexp-slant-subnum)))))
713; (setq fontset (x-compose-font-name xlfd-fields))
714; (create-fontset-from-fontset-spec
715; (concat fontset ", ascii:" font) styles)
716; )))))
717; ;; This cannot be run yet, as creating fontsets requires a
718; ;; Window to be initialised so the fonts can be listed.
719; ;; Add it to a hook so it gets run later.
720; (add-hook 'before-init-hook 'w32-create-initial-fontsets)
721; ))
722 681
723;; Apply a geometry resource to the initial frame. Put it at the end 682;; Apply a geometry resource to the initial frame. Put it at the end
724;; of the alist, so that anything specified on the command line takes 683;; of the alist, so that anything specified on the command line takes
@@ -761,7 +720,8 @@ See the documentation of `create-fontset-from-fontset-spec for the format.")
761 (setq x-selection-timeout (string-to-number res-selection-timeout)))) 720 (setq x-selection-timeout (string-to-number res-selection-timeout))))
762 721
763(defun x-win-suspend-error () 722(defun x-win-suspend-error ()
764 (error "Suspending an emacs running under W32 makes no sense")) 723 "Report an error when a suspend is attempted."
724 (error "Suspending an Emacs running under W32 makes no sense"))
765(add-hook 'suspend-hook 'x-win-suspend-error) 725(add-hook 'suspend-hook 'x-win-suspend-error)
766 726
767;;; Arrange for the kill and yank functions to set and check the clipboard. 727;;; Arrange for the kill and yank functions to set and check the clipboard.
@@ -808,8 +768,9 @@ See the documentation of `create-fontset-from-fontset-spec for the format.")
808 768
809;; Redefine the font selection to use the standard W32 dialog 769;; Redefine the font selection to use the standard W32 dialog
810(defvar w32-use-w32-font-dialog t 770(defvar w32-use-w32-font-dialog t
811 "*Use the standard font dialog if 't' - otherwise pop up a menu of 771 "*Use the standard font dialog if 't'.
812some standard fonts like X does - including fontsets") 772Otherwise pop up a menu of some standard fonts like X does - including
773fontsets.")
813 774
814(defvar w32-fixed-font-alist 775(defvar w32-fixed-font-alist
815 '("Font menu" 776 '("Font menu"
@@ -884,22 +845,22 @@ some standard fonts like X does - including fontsets")
884 ("11 bold italic" "-*-Courier New-bold-i-*-*-15-*-*-*-c-*-iso8859-1") 845 ("11 bold italic" "-*-Courier New-bold-i-*-*-15-*-*-*-c-*-iso8859-1")
885 ("12 bold italic" "-*-Courier New-bold-i-*-*-16-*-*-*-c-*-iso8859-1") 846 ("12 bold italic" "-*-Courier New-bold-i-*-*-16-*-*-*-c-*-iso8859-1")
886 )) 847 ))
887 "Fonts suitable for use in Emacs. Initially this is a list of some 848 "Fonts suitable for use in Emacs.
888fixed width fonts that most people will have like Terminal and 849Initially this is a list of some fixed width fonts that most people
889Courier. These fonts are used in the font menu if the variable 850will have like Terminal and Courier. These fonts are used in the font
890`w32-use-w32-font-dialog' is nil.") 851menu if the variable `w32-use-w32-font-dialog' is nil.")
891 852
892;;; Enable Japanese fonts on Windows to be used by default. 853;;; Enable Japanese fonts on Windows to be used by default.
893(put-charset-property 'katakana-jisx0201 'x-charset-registry "JISX0208-SJIS") 854(set-fontset-font t (make-char 'katakana-jisx0201) "JISX0208-SJIS")
894(put-charset-property 'latin-jisx0201 'x-charset-registry "JISX0208-SJIS") 855(set-fontset-font t (make-char 'latin-jisx0201) "JISX0208-SJIS")
895(put-charset-property 'japanese-jisx0208 'x-charset-registry "JISX0208-SJIS") 856(set-fontset-font t (make-char 'japanese-jisx0208) "JISX0208-SJIS")
896(put-charset-property 'japanese-jisx0208-1978 'x-charset-registry 857(set-fontset-font t (make-char 'japanese-jisx0208-1978) "JISX0208-SJIS")
897 "JISX0208-SJIS")
898 858
899(defun mouse-set-font (&rest fonts) 859(defun mouse-set-font (&rest fonts)
900 "Select a font. If `w32-use-w32-font-dialog' is non-nil (the default), 860 "Select a font.
901use the Windows font dialog. Otherwise use a pop-up menu (like Emacs 861If `w32-use-w32-font-dialog' is non-nil (the default), use the Windows
902on other platforms) initialized with the fonts in 862font dialog to get the matching FONTS. Otherwise use a pop-up menu
863(like Emacs on other platforms) initialized with the fonts in
903`w32-fixed-font-alist'." 864`w32-fixed-font-alist'."
904 (interactive 865 (interactive
905 (if w32-use-w32-font-dialog 866 (if w32-use-w32-font-dialog