Mercurial > emacs

comparison lisp/term/ns-win.el @ 96757:18b856a0216f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(ns-handle-switch): Simplify. Handle the numeric case. (ns-handle-numeric-switch): Just call ns-handle-switch. (ns-handle-name-switch, ns-handle-nxopen, ns-handle-nxopentemp) (ns-handle-args): Simplify using `pop'. (ns-display-name): Define (used in frame.el). (menu-bar-select-frame): Add (ignored) arg to more closely match the original definition. (ns-perform-service): Declare. (ns-save-preferences): Use fewer `let's.
author Glenn Morris <rgm@gnu.org>
date Thu, 17 Jul 2008 02:35:52 +0000
parents 92f7bbffcb45
children 970848353475
comparison
equal deleted inserted replaced
96756:6bce8c5e3365 96757:18b856a0216f
84 84
85 (defvar ns-invocation-args nil) 85 (defvar ns-invocation-args nil)
86 (defvar ns-command-line-resources nil) 86 (defvar ns-command-line-resources nil)
87 87
88 ;; Handler for switches of the form "-switch value" or "-switch". 88 ;; Handler for switches of the form "-switch value" or "-switch".
89 (defun ns-handle-switch (switch) 89 (defun ns-handle-switch (switch &optional numeric)
90 (let ((aelt (assoc switch command-line-ns-option-alist))) 90 (let ((aelt (assoc switch command-line-ns-option-alist)))
91 (if aelt 91 (if aelt
92 (let ((param (nth 3 aelt)) 92 (setq default-frame-alist
93 (value (nth 4 aelt))) 93 (cons (cons (nth 3 aelt)
94 (if value 94 (if numeric
95 (setq default-frame-alist 95 (string-to-number (pop ns-invocation-args))
96 (cons (cons param value) 96 (or (nth 4 aelt) (pop ns-invocation-args))))
97 default-frame-alist)) 97 default-frame-alist)))))
98 (setq default-frame-alist
99 (cons (cons param
100 (car ns-invocation-args))
101 default-frame-alist)
102 ns-invocation-args (cdr ns-invocation-args)))))))
103 98
104 ;; Handler for switches of the form "-switch n" 99 ;; Handler for switches of the form "-switch n"
105 (defun ns-handle-numeric-switch (switch) 100 (defun ns-handle-numeric-switch (switch)
106 (let ((aelt (assoc switch command-line-ns-option-alist))) 101 (ns-handle-switch switch t))
107 (if aelt
108 (let ((param (nth 3 aelt)))
109 (setq default-frame-alist
110 (cons (cons param
111 (string-to-number (car ns-invocation-args)))
112 default-frame-alist)
113 ns-invocation-args
114 (cdr ns-invocation-args))))))
115 102
116 ;; Make -iconic apply only to the initial frame! 103 ;; Make -iconic apply only to the initial frame!
117 (defun ns-handle-iconic (switch) 104 (defun ns-handle-iconic (switch)
118 (setq initial-frame-alist 105 (setq initial-frame-alist
119 (cons '(visibility . icon) initial-frame-alist))) 106 (cons '(visibility . icon) initial-frame-alist)))
121 ;; Handle the -name option, set the name of 108 ;; Handle the -name option, set the name of
122 ;; the initial frame. 109 ;; the initial frame.
123 (defun ns-handle-name-switch (switch) 110 (defun ns-handle-name-switch (switch)
124 (or (consp ns-invocation-args) 111 (or (consp ns-invocation-args)
125 (error "%s: missing argument to `%s' option" (invocation-name) switch)) 112 (error "%s: missing argument to `%s' option" (invocation-name) switch))
126 (setq initial-frame-alist (cons (cons 'name (car ns-invocation-args)) 113 (setq initial-frame-alist (cons (cons 'name (pop ns-invocation-args))
127 initial-frame-alist) 114 initial-frame-alist)))
128 ns-invocation-args (cdr ns-invocation-args))) 115
116 ;; Set (but not used?) in frame.el.
117 (defvar ns-display-name nil
118 "The name of the NS display on which Emacs was started.")
129 119
130 ;; nsterm.m. 120 ;; nsterm.m.
131 (defvar ns-input-file) 121 (defvar ns-input-file)
132 122
133 (defun ns-handle-nxopen (switch) 123 (defun ns-handle-nxopen (switch)
134 (setq unread-command-events (append unread-command-events '(ns-open-file)) 124 (setq unread-command-events (append unread-command-events '(ns-open-file))
135 ns-input-file (append ns-input-file (list (car ns-invocation-args))) 125 ns-input-file (append ns-input-file (list (pop ns-invocation-args)))))
136 ns-invocation-args (cdr ns-invocation-args)))
137 126
138 (defun ns-handle-nxopentemp (switch) 127 (defun ns-handle-nxopentemp (switch)
139 (setq unread-command-events (append unread-command-events '(ns-open-temp-file)) 128 (setq unread-command-events (append unread-command-events
140 ns-input-file (append ns-input-file (list (car ns-invocation-args))) 129 '(ns-open-temp-file))
141 ns-invocation-args (cdr ns-invocation-args))) 130 ns-input-file (append ns-input-file (list (pop ns-invocation-args)))))
142 131
143 (defun ns-ignore-0-arg (switch) 132 (defun ns-ignore-0-arg (switch)
144 ) 133 )
145 (defun ns-ignore-1-arg (switch) 134 (defun ns-ignore-1-arg (switch)
146 (setq ns-invocation-args (cdr ns-invocation-args))) 135 (setq ns-invocation-args (cdr ns-invocation-args)))
156 This function returns ARGS minus the arguments that have been processed." 145 This function returns ARGS minus the arguments that have been processed."
157 ;; We use ARGS to accumulate the args that we don't handle here, to return. 146 ;; We use ARGS to accumulate the args that we don't handle here, to return.
158 (setq ns-invocation-args args 147 (setq ns-invocation-args args
159 args nil) 148 args nil)
160 (while ns-invocation-args 149 (while ns-invocation-args
161 (let* ((this-switch (car ns-invocation-args)) 150 (let* ((this-switch (pop ns-invocation-args))
162 (orig-this-switch this-switch) 151 (orig-this-switch this-switch)
163 completion argval aelt handler) 152 completion argval aelt handler)
164 (setq ns-invocation-args (cdr ns-invocation-args))
165 ;; Check for long options with attached arguments 153 ;; Check for long options with attached arguments
166 ;; and separate out the attached option argument into argval. 154 ;; and separate out the attached option argument into argval.
167 (if (string-match "^--[^=]*=" this-switch) 155 (if (string-match "^--[^=]*=" this-switch)
168 (setq argval (substring this-switch (match-end 0)) 156 (setq argval (substring this-switch (match-end 0))
169 this-switch (substring this-switch 0 (1- (match-end 0))))) 157 this-switch (substring this-switch 0 (1- (match-end 0)))))
653 (define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo) 641 (define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo)
654 (define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill) 642 (define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill)
655 643
656 644
657 ;;;; Windows menu 645 ;;;; Windows menu
658 (defun menu-bar-select-frame () 646 (defun menu-bar-select-frame (&optional frame)
659 (interactive) 647 (interactive)
660 (make-frame-visible last-command-event) 648 (make-frame-visible last-command-event)
661 (raise-frame last-command-event) 649 (raise-frame last-command-event)
662 (select-frame last-command-event)) 650 (select-frame last-command-event))
663 651
743 (raise-frame frame) 731 (raise-frame frame)
744 (select-frame frame))) 732 (select-frame frame)))
745 733
746 734
747 ;;;; Services 735 ;;;; Services
736 (declare-function ns-perform-service "nsfns.m" (service send))
737
748 (defun ns-define-service (path) 738 (defun ns-define-service (path)
749 (let ((mapping [menu-bar services]) 739 (let ((mapping [menu-bar services])
750 (service (mapconcat 'identity path "/")) 740 (service (mapconcat 'identity path "/"))
751 (name (intern 741 (name (intern
752 (subst-char-in-string 742 (subst-char-in-string
919 :charset-list '(unicode) 909 :charset-list '(unicode)
920 :post-read-conversion 'ns-utf8-nfd-post-read-conversion) 910 :post-read-conversion 'ns-utf8-nfd-post-read-conversion)
921 (set-file-name-coding-system 'utf-8-nfd))) 911 (set-file-name-coding-system 'utf-8-nfd)))
922 912
923 ;; PENDING: disable composition-based display for Indic scripts as it 913 ;; PENDING: disable composition-based display for Indic scripts as it
924 ;; is not working well under NS for some reason 914 ;; is not working well under NS for some reason
925 (set-char-table-range composition-function-table 915 (set-char-table-range composition-function-table
926 '(#x0900 . #x0DFF) nil) 916 '(#x0900 . #x0DFF) nil)
927 917
928 918
929 ;;;; Inter-app communications support. 919 ;;;; Inter-app communications support.
1040 (ns-set-resource nil "UseQuickdrawSmoothing" 1030 (ns-set-resource nil "UseQuickdrawSmoothing"
1041 (if ns-use-qd-smoothing "YES" "NO")) 1031 (if ns-use-qd-smoothing "YES" "NO"))
1042 (ns-set-resource nil "UseSystemHighlightColor" 1032 (ns-set-resource nil "UseSystemHighlightColor"
1043 (if ns-use-system-highlight-color "YES" "NO")) 1033 (if ns-use-system-highlight-color "YES" "NO"))
1044 ;; Default frame parameters 1034 ;; Default frame parameters
1045 (let ((p (frame-parameters))) 1035 (let ((p (frame-parameters))
1046 (let ((f (assq 'font p))) 1036 v)
1047 (if f (ns-set-resource nil "Font" (ns-font-name (cdr f))))) 1037 (if (setq v (assq 'font p))
1048 (let ((fs (assq 'fontsize p))) 1038 (ns-set-resource nil "Font" (ns-font-name (cdr v))))
1049 (if fs (ns-set-resource nil "FontSize" (number-to-string (cdr fs))))) 1039 (if (setq v (assq 'fontsize p))
1050 (let ((fgc (assq 'foreground-color p))) 1040 (ns-set-resource nil "FontSize" (number-to-string (cdr v))))
1051 (if fgc (ns-set-resource nil "Foreground" (cdr fgc)))) 1041 (if (setq v (assq 'foreground-color p))
1052 (let ((bgc (assq 'background-color p))) 1042 (ns-set-resource nil "Foreground" (cdr v)))
1053 (if bgc (ns-set-resource nil "Background" (cdr bgc)))) 1043 (if (setq v (assq 'background-color p))
1054 (let ((cc (assq 'cursor-color p))) 1044 (ns-set-resource nil "Background" (cdr v)))
1055 (if cc (ns-set-resource nil "CursorColor" (cdr cc)))) 1045 (if (setq v (assq 'cursor-color p))
1056 (let ((ct (assq 'cursor-type p))) 1046 (ns-set-resource nil "CursorColor" (cdr v)))
1057 (if ct (ns-set-resource nil "CursorType" 1047 (if (setq v (assq 'cursor-type p))
1058 (if (symbolp (cdr ct)) 1048 (ns-set-resource nil "CursorType" (if (symbolp (cdr v))
1059 (symbol-name (cdr ct)) (cdr ct))))) 1049 (symbol-name (cdr v))
1060 (let ((under (assq 'underline p))) 1050 (cdr v))))
1061 (if under (ns-set-resource nil "Underline" 1051 (if (setq v (assq 'underline p))
1062 (cond ((eq (cdr under) t) "YES") 1052 (ns-set-resource nil "Underline"
1063 ((eq (cdr under) nil) "NO") 1053 (case (cdr v)
1064 (t (cdr under)))))) 1054 ((t) "YES")
1065 (let ((ibw (assq 'internal-border-width p))) 1055 ((nil) "NO")
1066 (if ibw (ns-set-resource nil "InternalBorderWidth" 1056 (t (cdr v)))))
1067 (number-to-string (cdr ibw))))) 1057 (if (setq v (assq 'internal-border-width p))
1068 (let ((vsb (assq 'vertical-scroll-bars p))) 1058 (ns-set-resource nil "InternalBorderWidth"
1069 (if vsb (ns-set-resource nil "VerticalScrollBars" 1059 (number-to-string v)))
1070 (case (cdr vsb) 1060 (if (setq v (assq 'vertical-scroll-bars p))
1071 ((t) "YES") 1061 (ns-set-resource nil "VerticalScrollBars"
1072 ((nil) "NO") 1062 (case (cdr v)
1073 ((left) "left") 1063 ((t) "YES")
1074 ((right) "right") 1064 ((nil) "NO")
1075 (t nil))))) 1065 ((left) "left")
1076 (let ((height (assq 'height p))) 1066 ((right) "right")
1077 (if height (ns-set-resource nil "Height" 1067 (t nil))))
1078 (number-to-string (cdr height))))) 1068 (if (setq v (assq 'height p))
1079 (let ((width (assq 'width p))) 1069 (ns-set-resource nil "Height" (number-to-string (cdr v))))
1080 (if width (ns-set-resource nil "Width" 1070 (if (setq v (assq 'width p))
1081 (number-to-string (cdr width))))) 1071 (ns-set-resource nil "Width" (number-to-string (cdr v))))
1082 (let ((top (assq 'top p))) 1072 (if (setq v (assq 'top p))
1083 (if top (ns-set-resource nil "Top" 1073 (ns-set-resource nil "Top" (number-to-string (cdr v))))
1084 (number-to-string (cdr top))))) 1074 (if (setq v (assq 'left p))
1085 (let ((left (assq 'left p))) 1075 (ns-set-resource nil "Left" (number-to-string (cdr v))))
1086 (if left (ns-set-resource nil "Left"
1087 (number-to-string (cdr left)))))
1088 ;; These not fully supported 1076 ;; These not fully supported
1089 (let ((ar (assq 'auto-raise p))) 1077 (if (setq v (assq 'auto-raise p))
1090 (if ar (ns-set-resource nil "AutoRaise" 1078 (ns-set-resource nil "AutoRaise" (if (cdr v) "YES" "NO")))
1091 (if (cdr ar) "YES" "NO")))) 1079 (if (setq v (assq 'auto-lower p))
1092 (let ((al (assq 'auto-lower p))) 1080 (ns-set-resource nil "AutoLower" (if (cdr v) "YES" "NO")))
1093 (if al (ns-set-resource nil "AutoLower" 1081 (if (setq v (assq 'menu-bar-lines p))
1094 (if (cdr al) "YES" "NO")))) 1082 (ns-set-resource nil "Menus" (if (cdr v) "YES" "NO")))
1095 (let ((mbl (assq 'menu-bar-lines p)))
1096 (if mbl (ns-set-resource nil "Menus"
1097 (if (cdr mbl) "YES" "NO"))))
1098 ) 1083 )
1099 (let ((fl (face-list))) 1084 (let ((fl (face-list)))
1100 (while (consp fl) 1085 (while (consp fl)
1101 (or (eq 'default (car fl)) 1086 (or (eq 'default (car fl))
1102 ;; dont save Default* since it causes all created faces to 1087 ;; dont save Default* since it causes all created faces to
1407 ;; Return the value of the current NS selection. For compatibility 1392 ;; Return the value of the current NS selection. For compatibility
1408 ;; with older NS applications, this checks cut buffer 0 before 1393 ;; with older NS applications, this checks cut buffer 0 before
1409 ;; retrieving the value of the primary selection. 1394 ;; retrieving the value of the primary selection.
1410 (defun ns-pasteboard-value () 1395 (defun ns-pasteboard-value ()
1411 (let (text) 1396 (let (text)
1412 1397
1413 ;; Consult the selection, then the cut buffer. Treat empty strings 1398 ;; Consult the selection, then the cut buffer. Treat empty strings
1414 ;; as if they were unset. 1399 ;; as if they were unset.
1415 (or text (setq text (ns-get-pasteboard))) 1400 (or text (setq text (ns-get-pasteboard)))
1416 (if (string= text "") (setq text nil)) 1401 (if (string= text "") (setq text nil))
1417 1402
1418 (cond 1403 (cond
1419 ((not text) nil) 1404 ((not text) nil)
1420 ((eq text ns-last-selected-text) nil) 1405 ((eq text ns-last-selected-text) nil)
1421 ((string= text ns-last-selected-text) 1406 ((string= text ns-last-selected-text)
1422 ;; Record the newer string, so subsequent calls can use the `eq' test. 1407 ;; Record the newer string, so subsequent calls can use the `eq' test.