* nsterm.m (EmacsScroller-mouseDown:): Use SCROLL_BAR_FIRST_DELAY.
[bpt/emacs.git] / lisp / term / ns-win.el
CommitLineData
c0642f6d
GM
1;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system
2
ae940284 3;; Copyright (C) 1993, 1994, 2005, 2006, 2007, 2008, 2009
a5e1066d 4;; Free Software Foundation, Inc.
c0642f6d 5
c5220417
GM
6;; Authors: Carl Edman
7;; Christian Limpach
8;; Scott Bender
9;; Christophe de Dinechin
10;; Adrian Robert
c0642f6d
GM
11;; Keywords: terminals
12
13;; This file is part of GNU Emacs.
14
15;; GNU Emacs is free software: you can redistribute it and/or modify
16;; it under the terms of the GNU General Public License as published by
17;; the Free Software Foundation, either version 3 of the License, or
18;; (at your option) any later version.
19
20;; GNU Emacs is distributed in the hope that it will be useful,
21;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23;; GNU General Public License for more details.
24
25;; You should have received a copy of the GNU General Public License
26;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
edfda783
AR
27
28;;; Commentary:
29
a5a1b464
CY
30;; ns-win.el: this file is loaded from ../lisp/startup.el when it
31;; recognizes that Nextstep windows are to be used. Command line
32;; switches are parsed and those pertaining to Nextstep are processed
33;; and removed from the command line. The Nextstep display is opened
34;; and hooks are set for popping up the initial window.
edfda783
AR
35
36;; startup.el will then examine startup files, and eventually call the hooks
37;; which create the first window (s).
38
a5a1b464
CY
39;; A number of other Nextstep convenience functions are defined in
40;; this file, which works in close coordination with src/nsfns.m.
edfda783
AR
41
42;;; Code:
43
44
601fb9b8 45(if (not (featurep 'ns))
3dcdb6ea 46 (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS"
edfda783
AR
47 (invocation-name)))
48
ebe68042
SM
49(eval-when-compile (require 'cl))
50
edfda783
AR
51;; Documentation-purposes only: actually loaded in loadup.el
52(require 'frame)
53(require 'mouse)
54(require 'faces)
55(require 'easymenu)
56(require 'menu-bar)
57(require 'fontset)
58
ebe68042
SM
59;; Not needed?
60;;(require 'ispell)
edfda783 61
20bc68dd
GM
62(defgroup ns nil
63 "GNUstep/Mac OS X specific features."
64 :group 'environment)
65
c0642f6d
GM
66;; nsterm.m
67(defvar ns-version-string)
c0642f6d
GM
68(defvar ns-alternate-modifier)
69
edfda783
AR
70;;;; Command line argument handling.
71
72(defvar ns-invocation-args nil)
73(defvar ns-command-line-resources nil)
74
75;; Handler for switches of the form "-switch value" or "-switch".
d377ef4a 76(defun ns-handle-switch (switch &optional numeric)
edfda783
AR
77 (let ((aelt (assoc switch command-line-ns-option-alist)))
78 (if aelt
d377ef4a
GM
79 (setq default-frame-alist
80 (cons (cons (nth 3 aelt)
81 (if numeric
82 (string-to-number (pop ns-invocation-args))
83 (or (nth 4 aelt) (pop ns-invocation-args))))
84 default-frame-alist)))))
edfda783
AR
85
86;; Handler for switches of the form "-switch n"
87(defun ns-handle-numeric-switch (switch)
d377ef4a 88 (ns-handle-switch switch t))
edfda783
AR
89
90;; Make -iconic apply only to the initial frame!
91(defun ns-handle-iconic (switch)
92 (setq initial-frame-alist
93 (cons '(visibility . icon) initial-frame-alist)))
94
82a330df 95;; Handle the -name option, set the name of the initial frame.
edfda783
AR
96(defun ns-handle-name-switch (switch)
97 (or (consp ns-invocation-args)
98 (error "%s: missing argument to `%s' option" (invocation-name) switch))
d377ef4a
GM
99 (setq initial-frame-alist (cons (cons 'name (pop ns-invocation-args))
100 initial-frame-alist)))
101
102;; Set (but not used?) in frame.el.
9e50ff0c 103(defvar x-display-name nil
5cc443fe
GM
104 "The name of the window display on which Emacs was started.
105On X, the display name of individual X frames is recorded in the
106`display' frame parameter.")
edfda783 107
c0642f6d
GM
108;; nsterm.m.
109(defvar ns-input-file)
110
edfda783
AR
111(defun ns-handle-nxopen (switch)
112 (setq unread-command-events (append unread-command-events '(ns-open-file))
d377ef4a 113 ns-input-file (append ns-input-file (list (pop ns-invocation-args)))))
edfda783
AR
114
115(defun ns-handle-nxopentemp (switch)
d377ef4a
GM
116 (setq unread-command-events (append unread-command-events
117 '(ns-open-temp-file))
118 ns-input-file (append ns-input-file (list (pop ns-invocation-args)))))
edfda783 119
edfda783
AR
120(defun ns-ignore-1-arg (switch)
121 (setq ns-invocation-args (cdr ns-invocation-args)))
122(defun ns-ignore-2-arg (switch)
123 (setq ns-invocation-args (cddr ns-invocation-args)))
124
125(defun ns-handle-args (args)
a5a1b464 126 "Process Nextstep-related command line options.
82a330df 127This is run before the user's startup file is loaded.
a5a1b464
CY
128The options in ARGS are copied to `ns-invocation-args'.
129The Nextstep-related settings are then applied using the handlers
82a330df 130defined in `command-line-ns-option-alist'.
a5a1b464 131The return value is ARGS minus the number of arguments processed."
edfda783
AR
132 ;; We use ARGS to accumulate the args that we don't handle here, to return.
133 (setq ns-invocation-args args
134 args nil)
135 (while ns-invocation-args
d377ef4a 136 (let* ((this-switch (pop ns-invocation-args))
edfda783
AR
137 (orig-this-switch this-switch)
138 completion argval aelt handler)
edfda783
AR
139 ;; Check for long options with attached arguments
140 ;; and separate out the attached option argument into argval.
141 (if (string-match "^--[^=]*=" this-switch)
142 (setq argval (substring this-switch (match-end 0))
143 this-switch (substring this-switch 0 (1- (match-end 0)))))
144 ;; Complete names of long options.
145 (if (string-match "^--" this-switch)
146 (progn
147 (setq completion (try-completion this-switch
148 command-line-ns-option-alist))
149 (if (eq completion t)
150 ;; Exact match for long option.
151 nil
152 (if (stringp completion)
153 (let ((elt (assoc completion command-line-ns-option-alist)))
154 ;; Check for abbreviated long option.
155 (or elt
156 (error "Option `%s' is ambiguous" this-switch))
157 (setq this-switch completion))))))
158 (setq aelt (assoc this-switch command-line-ns-option-alist))
159 (if aelt (setq handler (nth 2 aelt)))
160 (if handler
161 (if argval
162 (let ((ns-invocation-args
163 (cons argval ns-invocation-args)))
164 (funcall handler this-switch))
165 (funcall handler this-switch))
166 (setq args (cons orig-this-switch args)))))
167 (nreverse args))
168
489382c5 169(defun ns-parse-geometry (geom)
ba0c843d 170 "Parse a Nextstep-style geometry string GEOM.
edfda783
AR
171Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
172The properties returned may include `top', `left', `height', and `width'."
a5a1b464
CY
173 (when (string-match "\\([0-9]+\\)\\( \\([0-9]+\\)\\( \\([0-9]+\\)\
174\\( \\([0-9]+\\) ?\\)?\\)?\\)?"
175 geom)
176 (apply
177 'append
178 (list
179 (list (cons 'top (string-to-number (match-string 1 geom))))
180 (if (match-string 3 geom)
181 (list (cons 'left (string-to-number (match-string 3 geom)))))
182 (if (match-string 5 geom)
183 (list (cons 'height (string-to-number (match-string 5 geom)))))
184 (if (match-string 7 geom)
185 (list (cons 'width (string-to-number (match-string 7 geom)))))))))
edfda783
AR
186
187;;;; Keyboard mapping.
188
6742a9d2 189;; These tell read-char how to convert these special chars to ASCII.
6742a9d2 190(put 'S-tab 'ascii-character (logior 16 ?\t))
55e8d9a5
AR
191
192(defvar ns-alternatives-map
193 (let ((map (make-sparse-keymap)))
194 ;; Map certain keypad keys into ASCII characters
195 ;; that people usually expect.
55e8d9a5 196 (define-key map [S-tab] [25])
55e8d9a5
AR
197 (define-key map [M-backspace] [?\M-\d])
198 (define-key map [M-delete] [?\M-\d])
199 (define-key map [M-tab] [?\M-\t])
200 (define-key map [M-linefeed] [?\M-\n])
201 (define-key map [M-clear] [?\M-\C-l])
202 (define-key map [M-return] [?\M-\C-m])
203 (define-key map [M-escape] [?\M-\e])
204 map)
2b4e72e1 205 "Keymap of alternative meanings for some keys under Nextstep.")
edfda783 206
a5a1b464 207;; Here are some Nextstep-like bindings for command key sequences.
4c785fa7 208(define-key global-map [?\s-,] 'customize)
edfda783
AR
209(define-key global-map [?\s-'] 'next-multiframe-window)
210(define-key global-map [?\s-`] 'other-frame)
211(define-key global-map [?\s--] 'center-line)
212(define-key global-map [?\s-:] 'ispell)
213(define-key global-map [?\s-\;] 'ispell-next)
214(define-key global-map [?\s-?] 'info)
215(define-key global-map [?\s-^] 'kill-some-buffers)
216(define-key global-map [?\s-&] 'kill-this-buffer)
217(define-key global-map [?\s-C] 'ns-popup-color-panel)
218(define-key global-map [?\s-D] 'dired)
219(define-key global-map [?\s-E] 'edit-abbrevs)
220(define-key global-map [?\s-L] 'shell-command)
221(define-key global-map [?\s-M] 'manual-entry)
222(define-key global-map [?\s-S] 'ns-write-file-using-panel)
223(define-key global-map [?\s-a] 'mark-whole-buffer)
224(define-key global-map [?\s-c] 'ns-copy-including-secondary)
225(define-key global-map [?\s-d] 'isearch-repeat-backward)
226(define-key global-map [?\s-e] 'isearch-yank-kill)
227(define-key global-map [?\s-f] 'isearch-forward)
228(define-key global-map [?\s-g] 'isearch-repeat-forward)
229(define-key global-map [?\s-h] 'ns-do-hide-emacs)
230(define-key global-map [?\s-H] 'ns-do-hide-others)
231(define-key global-map [?\s-j] 'exchange-point-and-mark)
232(define-key global-map [?\s-k] 'kill-this-buffer)
233(define-key global-map [?\s-l] 'goto-line)
234(define-key global-map [?\s-m] 'iconify-frame)
235(define-key global-map [?\s-n] 'make-frame)
236(define-key global-map [?\s-o] 'ns-open-file-using-panel)
237(define-key global-map [?\s-p] 'ns-print-buffer)
238(define-key global-map [?\s-q] 'save-buffers-kill-emacs)
239(define-key global-map [?\s-s] 'save-buffer)
240(define-key global-map [?\s-t] 'ns-popup-font-panel)
241(define-key global-map [?\s-u] 'revert-buffer)
242(define-key global-map [?\s-v] 'yank)
243(define-key global-map [?\s-w] 'delete-frame)
244(define-key global-map [?\s-x] 'kill-region)
245(define-key global-map [?\s-y] 'ns-paste-secondary)
246(define-key global-map [?\s-z] 'undo)
247(define-key global-map [?\s-|] 'shell-command-on-region)
248(define-key global-map [s-kp-bar] 'shell-command-on-region)
ebe68042 249;; (as in Terminal.app)
edfda783
AR
250(define-key global-map [s-right] 'ns-next-frame)
251(define-key global-map [s-left] 'ns-prev-frame)
252
253(define-key global-map [home] 'beginning-of-buffer)
254(define-key global-map [end] 'end-of-buffer)
255(define-key global-map [kp-home] 'beginning-of-buffer)
256(define-key global-map [kp-end] 'end-of-buffer)
257(define-key global-map [kp-prior] 'scroll-down)
258(define-key global-map [kp-next] 'scroll-up)
259
55e8d9a5
AR
260;;; Allow shift-clicks to work similarly to under Nextstep
261(define-key global-map [S-mouse-1] 'mouse-save-then-kill)
262(global-unset-key [S-down-mouse-1])
263
edfda783 264
a5a1b464 265;; Special Nextstep-generated events are converted to function keys. Here
edfda783 266;; are the bindings for them.
c6c62e78 267(define-key global-map [ns-power-off] 'save-buffers-kill-emacs)
edfda783
AR
268(define-key global-map [ns-open-file] 'ns-find-file)
269(define-key global-map [ns-open-temp-file] [ns-open-file])
270(define-key global-map [ns-drag-file] 'ns-insert-file)
271(define-key global-map [ns-drag-color] 'ns-set-foreground-at-mouse)
272(define-key global-map [S-ns-drag-color] 'ns-set-background-at-mouse)
273(define-key global-map [ns-drag-text] 'ns-insert-text)
274(define-key global-map [ns-change-font] 'ns-respond-to-change-font)
275(define-key global-map [ns-open-file-line] 'ns-open-file-select-line)
edfda783 276(define-key global-map [ns-spi-service-call] 'ns-spi-service-call)
4e622592 277(define-key global-map [ns-new-frame] 'make-frame)
33b35792 278(define-key global-map [ns-toggle-toolbar] 'ns-toggle-toolbar)
c6c62e78 279(define-key global-map [ns-show-prefs] 'customize)
edfda783
AR
280
281
2f93961f
CY
282;; Set up a number of aliases and other layers to pretend we're using
283;; the Choi/Mitsuharu Carbon port.
284
285(defvaralias 'mac-allow-anti-aliasing 'ns-antialias-text)
286(defvaralias 'mac-command-modifier 'ns-command-modifier)
287(defvaralias 'mac-control-modifier 'ns-control-modifier)
288(defvaralias 'mac-option-modifier 'ns-option-modifier)
289(defvaralias 'mac-function-modifier 'ns-function-modifier)
406aaa6f 290(declare-function ns-do-applescript "nsfns.m" (script))
583ff3c3
AR
291(defalias 'do-applescript 'ns-do-applescript)
292
edfda783 293(defun x-setup-function-keys (frame)
5cc443fe 294 "Set up `function-key-map' on the graphical frame FRAME."
edfda783
AR
295 (unless (terminal-parameter frame 'x-setup-function-keys)
296 (with-selected-frame frame
9e50ff0c
DN
297 (setq interprogram-cut-function 'x-select-text
298 interprogram-paste-function 'x-cut-buffer-or-selection-value)
55e8d9a5
AR
299 (let ((map (copy-keymap ns-alternatives-map)))
300 (set-keymap-parent map (keymap-parent local-function-key-map))
301 (set-keymap-parent local-function-key-map map))
ebe68042
SM
302 (setq system-key-alist
303 (list
304 (cons (logior (lsh 0 16) 1) 'ns-power-off)
305 (cons (logior (lsh 0 16) 2) 'ns-open-file)
306 (cons (logior (lsh 0 16) 3) 'ns-open-temp-file)
307 (cons (logior (lsh 0 16) 4) 'ns-drag-file)
308 (cons (logior (lsh 0 16) 5) 'ns-drag-color)
309 (cons (logior (lsh 0 16) 6) 'ns-drag-text)
310 (cons (logior (lsh 0 16) 7) 'ns-change-font)
311 (cons (logior (lsh 0 16) 8) 'ns-open-file-line)
33b35792
AR
312; (cons (logior (lsh 0 16) 9) 'ns-insert-working-text)
313; (cons (logior (lsh 0 16) 10) 'ns-delete-working-text)
ebe68042 314 (cons (logior (lsh 0 16) 11) 'ns-spi-service-call)
4c785fa7
DR
315 (cons (logior (lsh 0 16) 12) 'ns-new-frame)
316 (cons (logior (lsh 0 16) 13) 'ns-toggle-toolbar)
317 (cons (logior (lsh 0 16) 14) 'ns-show-prefs)
318 (cons (logior (lsh 1 16) 32) 'f1)
ebe68042
SM
319 (cons (logior (lsh 1 16) 33) 'f2)
320 (cons (logior (lsh 1 16) 34) 'f3)
321 (cons (logior (lsh 1 16) 35) 'f4)
322 (cons (logior (lsh 1 16) 36) 'f5)
323 (cons (logior (lsh 1 16) 37) 'f6)
324 (cons (logior (lsh 1 16) 38) 'f7)
325 (cons (logior (lsh 1 16) 39) 'f8)
326 (cons (logior (lsh 1 16) 40) 'f9)
327 (cons (logior (lsh 1 16) 41) 'f10)
328 (cons (logior (lsh 1 16) 42) 'f11)
329 (cons (logior (lsh 1 16) 43) 'f12)
330 (cons (logior (lsh 1 16) 44) 'kp-insert)
331 (cons (logior (lsh 1 16) 45) 'kp-delete)
332 (cons (logior (lsh 1 16) 46) 'kp-home)
333 (cons (logior (lsh 1 16) 47) 'kp-end)
334 (cons (logior (lsh 1 16) 48) 'kp-prior)
335 (cons (logior (lsh 1 16) 49) 'kp-next)
336 (cons (logior (lsh 1 16) 50) 'print-screen)
337 (cons (logior (lsh 1 16) 51) 'scroll-lock)
338 (cons (logior (lsh 1 16) 52) 'pause)
339 (cons (logior (lsh 1 16) 53) 'system)
340 (cons (logior (lsh 1 16) 54) 'break)
341 (cons (logior (lsh 1 16) 56) 'please-tell-carl-what-this-key-is-called-56)
342 (cons (logior (lsh 1 16) 61) 'please-tell-carl-what-this-key-is-called-61)
343 (cons (logior (lsh 1 16) 62) 'please-tell-carl-what-this-key-is-called-62)
344 (cons (logior (lsh 1 16) 63) 'please-tell-carl-what-this-key-is-called-63)
345 (cons (logior (lsh 1 16) 64) 'please-tell-carl-what-this-key-is-called-64)
346 (cons (logior (lsh 1 16) 69) 'please-tell-carl-what-this-key-is-called-69)
347 (cons (logior (lsh 1 16) 70) 'please-tell-carl-what-this-key-is-called-70)
348 (cons (logior (lsh 1 16) 71) 'please-tell-carl-what-this-key-is-called-71)
349 (cons (logior (lsh 1 16) 72) 'please-tell-carl-what-this-key-is-called-72)
350 (cons (logior (lsh 1 16) 73) 'please-tell-carl-what-this-key-is-called-73)
351 (cons (logior (lsh 2 16) 3) 'kp-enter)
352 (cons (logior (lsh 2 16) 9) 'kp-tab)
353 (cons (logior (lsh 2 16) 28) 'kp-quit)
354 (cons (logior (lsh 2 16) 35) 'kp-hash)
355 (cons (logior (lsh 2 16) 42) 'kp-multiply)
356 (cons (logior (lsh 2 16) 43) 'kp-add)
357 (cons (logior (lsh 2 16) 44) 'kp-separator)
358 (cons (logior (lsh 2 16) 45) 'kp-subtract)
359 (cons (logior (lsh 2 16) 46) 'kp-decimal)
360 (cons (logior (lsh 2 16) 47) 'kp-divide)
361 (cons (logior (lsh 2 16) 48) 'kp-0)
362 (cons (logior (lsh 2 16) 49) 'kp-1)
363 (cons (logior (lsh 2 16) 50) 'kp-2)
364 (cons (logior (lsh 2 16) 51) 'kp-3)
365 (cons (logior (lsh 2 16) 52) 'kp-4)
366 (cons (logior (lsh 2 16) 53) 'kp-5)
367 (cons (logior (lsh 2 16) 54) 'kp-6)
368 (cons (logior (lsh 2 16) 55) 'kp-7)
369 (cons (logior (lsh 2 16) 56) 'kp-8)
370 (cons (logior (lsh 2 16) 57) 'kp-9)
371 (cons (logior (lsh 2 16) 60) 'kp-less)
372 (cons (logior (lsh 2 16) 61) 'kp-equal)
373 (cons (logior (lsh 2 16) 62) 'kp-more)
374 (cons (logior (lsh 2 16) 64) 'kp-at)
375 (cons (logior (lsh 2 16) 92) 'kp-backslash)
376 (cons (logior (lsh 2 16) 96) 'kp-backtick)
377 (cons (logior (lsh 2 16) 124) 'kp-bar)
378 (cons (logior (lsh 2 16) 126) 'kp-tilde)
379 (cons (logior (lsh 2 16) 157) 'kp-mu)
380 (cons (logior (lsh 2 16) 165) 'kp-yen)
381 (cons (logior (lsh 2 16) 167) 'kp-paragraph)
382 (cons (logior (lsh 2 16) 172) 'left)
383 (cons (logior (lsh 2 16) 173) 'up)
384 (cons (logior (lsh 2 16) 174) 'right)
385 (cons (logior (lsh 2 16) 175) 'down)
386 (cons (logior (lsh 2 16) 176) 'kp-ring)
387 (cons (logior (lsh 2 16) 201) 'kp-square)
388 (cons (logior (lsh 2 16) 204) 'kp-cube)
389 (cons (logior (lsh 3 16) 8) 'backspace)
390 (cons (logior (lsh 3 16) 9) 'tab)
391 (cons (logior (lsh 3 16) 10) 'linefeed)
392 (cons (logior (lsh 3 16) 11) 'clear)
393 (cons (logior (lsh 3 16) 13) 'return)
394 (cons (logior (lsh 3 16) 18) 'pause)
395 (cons (logior (lsh 3 16) 25) 'S-tab)
396 (cons (logior (lsh 3 16) 27) 'escape)
397 (cons (logior (lsh 3 16) 127) 'delete)
55e8d9a5
AR
398 )))
399 (set-terminal-parameter frame 'x-setup-function-keys t)))
edfda783
AR
400
401
402
ebe68042 403;; Must come after keybindings.
edfda783 404
c6c62e78
DR
405;; (fmakunbound 'clipboard-yank)
406;; (fmakunbound 'clipboard-kill-ring-save)
407;; (fmakunbound 'clipboard-kill-region)
408;; (fmakunbound 'menu-bar-enable-clipboard)
edfda783
AR
409
410;; Add a couple of menus and rearrange some others; easiest just to redo toplvl
411;; Note keymap defns must be given last-to-first
412(define-key global-map [menu-bar] (make-sparse-keymap "menu-bar"))
413
ebe68042
SM
414(setq menu-bar-final-items
415 (cond ((eq system-type 'darwin)
416 '(buffer windows services help-menu))
417 ;; Otherwise, GNUstep.
418 (t
419 '(buffer windows services hide-app quit))))
edfda783 420
ebe68042
SM
421;; Add standard top-level items to GNUstep menu.
422(unless (eq system-type 'darwin)
423 (define-key global-map [menu-bar quit] '("Quit" . save-buffers-kill-emacs))
424 (define-key global-map [menu-bar hide-app] '("Hide" . ns-do-hide-emacs)))
edfda783
AR
425
426(define-key global-map [menu-bar services]
427 (cons "Services" (make-sparse-keymap "Services")))
edfda783
AR
428(define-key global-map [menu-bar buffer]
429 (cons "Buffers" global-buffers-menu-map))
430;; (cons "Buffers" (make-sparse-keymap "Buffers")))
431(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
432(define-key global-map [menu-bar options] (cons "Options" menu-bar-options-menu))
433(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
434(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu))
435
436;; If running under GNUstep, rename "Help" to "Info"
437(cond ((eq system-type 'darwin)
438 (define-key global-map [menu-bar help-menu]
439 (cons "Help" menu-bar-help-menu)))
440 (t
441 (let ((contents (reverse (cdr menu-bar-help-menu))))
442 (setq menu-bar-help-menu
443 (append (list 'keymap) (cdr contents) (list "Info"))))
444 (define-key global-map [menu-bar help-menu]
445 (cons "Info" menu-bar-help-menu))))
446
edfda783
AR
447(if (not (eq system-type 'darwin))
448 ;; in OS X it's in the app menu already
449 (define-key menu-bar-help-menu [info-panel]
450 '("About Emacs..." . ns-do-emacs-info-panel)))
451
edfda783
AR
452;;;; Edit menu: Modify slightly
453
ebe68042 454;; Substitute a Copy function that works better under X (for GNUstep).
edfda783
AR
455(easy-menu-remove-item global-map '("menu-bar" "edit") 'copy)
456(define-key-after menu-bar-edit-menu [copy]
457 '(menu-item "Copy" ns-copy-including-secondary
ebe68042
SM
458 :enable mark-active
459 :help "Copy text in region between mark and current position")
edfda783
AR
460 'cut)
461
ebe68042
SM
462;; Change to same precondition as select-and-paste, as we don't have
463;; `x-selection-exists-p'.
edfda783
AR
464(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste)
465(define-key-after menu-bar-edit-menu [paste]
466 '(menu-item "Paste" yank
ebe68042
SM
467 :enable (and (cdr yank-menu) (not buffer-read-only))
468 :help "Paste (yank) text most recently cut/copied")
edfda783
AR
469 'copy)
470
ebe68042 471;; Change text to be more consistent with surrounding menu items `paste', etc.
edfda783
AR
472(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste-from-menu)
473(define-key-after menu-bar-edit-menu [select-paste]
474 '(menu-item "Select and Paste" yank-menu
ebe68042
SM
475 :enable (and (cdr yank-menu) (not buffer-read-only))
476 :help "Choose a string from the kill ring and paste it")
edfda783
AR
477 'paste)
478
ebe68042 479;; Separate undo from cut/paste section, add spell for platform consistency.
edfda783
AR
480(define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo)
481(define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill)
482
edfda783
AR
483
484;;;; Services
d377ef4a
GM
485(declare-function ns-perform-service "nsfns.m" (service send))
486
edfda783
AR
487(defun ns-define-service (path)
488 (let ((mapping [menu-bar services])
489 (service (mapconcat 'identity path "/"))
490 (name (intern
ebe68042
SM
491 (subst-char-in-string
492 ?\s ?-
493 (mapconcat 'identity (cons "ns-service" path) "-")))))
494 ;; This defines the function.
495 (defalias name
496 (lexical-let ((service service))
497 (lambda (arg)
498 (interactive "p")
499 (let* ((in-string
500 (cond ((stringp arg) arg)
501 (mark-active
502 (buffer-substring (region-beginning) (region-end)))))
503 (out-string (ns-perform-service service in-string)))
504 (cond
505 ((stringp arg) out-string)
506 ((and out-string (or (not in-string)
507 (not (string= in-string out-string))))
508 (if mark-active (delete-region (region-beginning) (region-end)))
509 (insert out-string)
510 (setq deactivate-mark nil)))))))
edfda783
AR
511 (cond
512 ((lookup-key global-map mapping)
513 (while (cdr path)
514 (setq mapping (vconcat mapping (list (intern (car path)))))
515 (if (not (keymapp (lookup-key global-map mapping)))
516 (define-key global-map mapping
517 (cons (car path) (make-sparse-keymap (car path)))))
518 (setq path (cdr path)))
519 (setq mapping (vconcat mapping (list (intern (car path)))))
520 (define-key global-map mapping (cons (car path) name))))
521 name))
522
c0642f6d
GM
523;; nsterm.m
524(defvar ns-input-spi-name)
525(defvar ns-input-spi-arg)
526
f2d9c15f
GM
527(declare-function dnd-open-file "dnd" (uri action))
528
edfda783 529(defun ns-spi-service-call ()
82a330df 530 "Respond to a service request."
edfda783
AR
531 (interactive)
532 (cond ((string-equal ns-input-spi-name "open-selection")
533 (switch-to-buffer (generate-new-buffer "*untitled*"))
534 (insert ns-input-spi-arg))
535 ((string-equal ns-input-spi-name "open-file")
536 (dnd-open-file ns-input-spi-arg nil))
537 ((string-equal ns-input-spi-name "mail-selection")
538 (compose-mail)
539 (rfc822-goto-eoh)
540 (forward-line 1)
541 (insert ns-input-spi-arg))
542 ((string-equal ns-input-spi-name "mail-to")
543 (compose-mail ns-input-spi-arg))
544 (t (error (concat "Service " ns-input-spi-name " not recognized")))))
545
546
547;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
548
549
550
43c660bc
SM
551;; Composed key sequence handling for Nextstep system input methods.
552;; (On Nextstep systems, input methods are provided for CJK
553;; characters, etc. which require multiple keystrokes, and during
554;; entry a partial ("working") result is typically shown in the
555;; editing window.)
edfda783
AR
556
557(defface ns-working-text-face
558 '((t :underline t))
559 "Face used to highlight working text during compose sequence insert."
560 :group 'ns)
561
562(defvar ns-working-overlay nil
43c660bc
SM
563 "Overlay used to highlight working text during compose sequence insert.
564When text is in th echo area, this just stores the length of the working text.")
edfda783 565
33b35792
AR
566(defvar ns-working-text) ; nsterm.m
567
568;; Test if in echo area, based on mac-win.el 2007/08/26 unicode-2.
569;; This will fail if called from a NONASCII_KEYSTROKE event on the global map.
edfda783
AR
570(defun ns-in-echo-area ()
571 "Whether, for purposes of inserting working composition text, the minibuffer
572is currently being used."
573 (or isearch-mode
574 (and cursor-in-echo-area (current-message))
575 ;; Overlay strings are not shown in some cases.
576 (get-char-property (point) 'invisible)
577 (and (not (bobp))
578 (or (and (get-char-property (point) 'display)
579 (eq (get-char-property (1- (point)) 'display)
580 (get-char-property (point) 'display)))
581 (and (get-char-property (point) 'composition)
582 (eq (get-char-property (1- (point)) 'composition)
583 (get-char-property (point) 'composition)))))))
584
9d8f6d31
AR
585;; The 'interactive' here stays for subinvocations, so the ns-in-echo-area
586;; always returns nil for some reason. If this WASN'T the case, we could
587;; map this to [ns-insert-working-text] and eliminate Fevals in nsterm.m.
33b35792 588;; These functions test whether in echo area and delegate accordingly.
9d8f6d31 589(defun ns-put-working-text ()
edfda783 590 (interactive)
9d8f6d31 591 (if (ns-in-echo-area) (ns-echo-working-text) (ns-insert-working-text)))
33b35792
AR
592(defun ns-unput-working-text ()
593 (interactive)
43c660bc 594 (ns-delete-working-text))
c0642f6d 595
9d8f6d31 596(defun ns-insert-working-text ()
2b4e72e1 597 "Insert contents of `ns-working-text' as UTF-8 string and mark with
43c660bc
SM
598`ns-working-overlay'. Any previously existing working text is cleared first.
599The overlay is assigned the face `ns-working-text-face'."
600 ;; FIXME: if buffer is read-only, don't try to insert anything
601 ;; and if text is bound to a command, execute that instead (Bug#1453)
edfda783 602 (interactive)
43c660bc 603 (ns-delete-working-text)
edfda783
AR
604 (let ((start (point)))
605 (insert ns-working-text)
606 (overlay-put (setq ns-working-overlay (make-overlay start (point)
607 (current-buffer) nil t))
43c660bc 608 'face 'ns-working-text-face)))
edfda783
AR
609
610(defun ns-echo-working-text ()
2b4e72e1 611 "Echo contents of `ns-working-text' in message display area.
43c660bc
SM
612See `ns-insert-working-text'."
613 (ns-delete-working-text)
edfda783
AR
614 (let* ((msg (current-message))
615 (msglen (length msg))
616 message-log-max)
43c660bc 617 (setq ns-working-overlay (length ns-working-text))
edfda783 618 (setq msg (concat msg ns-working-text))
43c660bc 619 (put-text-property msglen (+ msglen ns-working-overlay)
08324aaa 620 'face 'ns-working-text-face msg)
43c660bc 621 (message "%s" msg)))
edfda783
AR
622
623(defun ns-delete-working-text()
43c660bc 624 "Delete working text and clear `ns-working-overlay'."
edfda783 625 (interactive)
43c660bc
SM
626 (cond
627 ((and (overlayp ns-working-overlay)
628 ;; Still alive?
629 (overlay-buffer ns-working-overlay))
630 (with-current-buffer (overlay-buffer ns-working-overlay)
631 (delete-region (overlay-start ns-working-overlay)
632 (overlay-end ns-working-overlay))
633 (delete-overlay ns-working-overlay)))
634 ((integerp ns-working-overlay)
635 (let ((msg (current-message))
636 message-log-max)
637 (setq msg (substring msg 0 (- (length msg) ns-working-overlay)))
638 (message "%s" msg))))
639 (setq ns-working-overlay nil))
edfda783
AR
640
641
c0642f6d
GM
642(declare-function ns-convert-utf8-nfd-to-nfc "nsfns.m" (str))
643
edfda783
AR
644;;;; OS X file system Unicode UTF-8 NFD (decomposed form) support
645;; Lisp code based on utf-8m.el, by Seiji Zenitani, Eiji Honjoh, and
646;; Carsten Bormann.
647(if (eq system-type 'darwin)
648 (progn
649
650 (defun ns-utf8-nfd-post-read-conversion (length)
2b4e72e1 651 "Calls `ns-convert-utf8-nfd-to-nfc' to compose char sequences."
edfda783
AR
652 (save-excursion
653 (save-restriction
654 (narrow-to-region (point) (+ (point) length))
655 (let ((str (buffer-string)))
656 (delete-region (point-min) (point-max))
657 (insert (ns-convert-utf8-nfd-to-nfc str))
658 (- (point-max) (point-min))
659 ))))
660
661 (define-coding-system 'utf-8-nfd
662 "UTF-8 NFD (decomposed) encoding."
663 :coding-type 'utf-8
664 :mnemonic ?U
665 :charset-list '(unicode)
666 :post-read-conversion 'ns-utf8-nfd-post-read-conversion)
667 (set-file-name-coding-system 'utf-8-nfd)))
668
edfda783
AR
669
670
671;;;; Inter-app communications support.
672
c0642f6d
GM
673(defvar ns-input-text) ; nsterm.m
674
edfda783 675(defun ns-insert-text ()
2b4e72e1 676 "Insert contents of `ns-input-text' at point."
edfda783
AR
677 (interactive)
678 (insert ns-input-text)
679 (setq ns-input-text nil))
c0642f6d 680
edfda783 681(defun ns-insert-file ()
2b4e72e1
JB
682 "Insert contents of file `ns-input-file' like insert-file but with less
683prompting. If file is a directory perform a `find-file' on it."
edfda783
AR
684 (interactive)
685 (let ((f))
686 (setq f (car ns-input-file))
687 (setq ns-input-file (cdr ns-input-file))
688 (if (file-directory-p f)
689 (find-file f)
690 (push-mark (+ (point) (car (cdr (insert-file-contents f))))))))
691
692(defvar ns-select-overlay nil
a5a1b464 693 "Overlay used to highlight areas in files requested by Nextstep apps.")
edfda783
AR
694(make-variable-buffer-local 'ns-select-overlay)
695
c0642f6d
GM
696(defvar ns-input-line) ; nsterm.m
697
edfda783 698(defun ns-open-file-select-line ()
b90cc058
CY
699 "Open a buffer containing the file `ns-input-file'.
700Lines are highlighted according to `ns-input-line'."
edfda783
AR
701 (interactive)
702 (ns-find-file)
703 (cond
704 ((and ns-input-line (buffer-modified-p))
705 (if ns-select-overlay
706 (setq ns-select-overlay (delete-overlay ns-select-overlay)))
707 (deactivate-mark)
5f68c1b7
GM
708 (goto-char (point-min))
709 (forward-line (1- (if (consp ns-input-line)
710 (min (car ns-input-line) (cdr ns-input-line))
711 ns-input-line))))
edfda783
AR
712 (ns-input-line
713 (if (not ns-select-overlay)
d93e053b
GM
714 (overlay-put (setq ns-select-overlay (make-overlay (point-min)
715 (point-min)))
edfda783
AR
716 'face 'highlight))
717 (let ((beg (save-excursion
d93e053b
GM
718 (goto-char (point-min))
719 (line-beginning-position
720 (if (consp ns-input-line)
721 (min (car ns-input-line) (cdr ns-input-line))
722 ns-input-line))))
edfda783 723 (end (save-excursion
d93e053b
GM
724 (goto-char (point-min))
725 (line-beginning-position
726 (1+ (if (consp ns-input-line)
727 (max (car ns-input-line) (cdr ns-input-line))
728 ns-input-line))))))
edfda783
AR
729 (move-overlay ns-select-overlay beg end)
730 (deactivate-mark)
731 (goto-char beg)))
732 (t
733 (if ns-select-overlay
734 (setq ns-select-overlay (delete-overlay ns-select-overlay))))))
735
736(defun ns-unselect-line ()
a5a1b464 737 "Removes any Nextstep highlight a buffer may contain."
edfda783
AR
738 (if ns-select-overlay
739 (setq ns-select-overlay (delete-overlay ns-select-overlay))))
740
741(add-hook 'first-change-hook 'ns-unselect-line)
742
743
744
745;;;; Preferences handling.
c0642f6d 746(declare-function ns-get-resource "nsfns.m" (owner name))
edfda783
AR
747
748(defun get-lisp-resource (arg1 arg2)
749 (let ((res (ns-get-resource arg1 arg2)))
750 (cond
751 ((not res) 'unbound)
752 ((string-equal (upcase res) "YES") t)
753 ((string-equal (upcase res) "NO") nil)
754 (t (read res)))))
755
c0642f6d 756;; nsterm.m
c6c62e78 757
c0642f6d
GM
758(declare-function ns-read-file-name "nsfns.m"
759 (prompt &optional dir isLoad init))
760
edfda783
AR
761;;;; File handling.
762
763(defun ns-open-file-using-panel ()
764 "Pop up open-file panel, and load the result in a buffer."
765 (interactive)
ebe68042 766 ;; Prompt dir defaultName isLoad initial.
edfda783
AR
767 (setq ns-input-file (ns-read-file-name "Select File to Load" nil t nil))
768 (if ns-input-file
769 (and (setq ns-input-file (list ns-input-file)) (ns-find-file))))
770
771(defun ns-write-file-using-panel ()
772 "Pop up save-file panel, and save buffer in resulting name."
773 (interactive)
774 (let (ns-output-file)
ebe68042 775 ;; Prompt dir defaultName isLoad initial.
edfda783
AR
776 (setq ns-output-file (ns-read-file-name "Save As" nil nil nil))
777 (message ns-output-file)
778 (if ns-output-file (write-file ns-output-file))))
779
73f6360c
GM
780(defcustom ns-pop-up-frames 'fresh
781 "Non-nil means open files upon request from the Workspace in a new frame.
c0642f6d 782If t, always do so. Any other non-nil value means open a new frame
73f6360c
GM
783unless the current buffer is a scratch buffer."
784 :type '(choice (const :tag "Never" nil)
785 (const :tag "Always" t)
786 (other :tag "Except for scratch buffer" fresh))
787 :version "23.1"
788 :group 'ns)
c0642f6d
GM
789
790(declare-function ns-hide-emacs "nsfns.m" (on))
791
edfda783 792(defun ns-find-file ()
2b4e72e1 793 "Do a `find-file' with the `ns-input-file' as argument."
edfda783
AR
794 (interactive)
795 (let ((f) (file) (bufwin1) (bufwin2))
796 (setq f (file-truename (car ns-input-file)))
797 (setq ns-input-file (cdr ns-input-file))
798 (setq file (find-file-noselect f))
799 (setq bufwin1 (get-buffer-window file 'visible))
800 (setq bufwin2 (get-buffer-window "*scratch*" 'visibile))
801 (cond
802 (bufwin1
803 (select-frame (window-frame bufwin1))
804 (raise-frame (window-frame bufwin1))
805 (select-window bufwin1))
806 ((and (eq ns-pop-up-frames 'fresh) bufwin2)
807 (ns-hide-emacs 'activate)
808 (select-frame (window-frame bufwin2))
809 (raise-frame (window-frame bufwin2))
810 (select-window bufwin2)
811 (find-file f))
812 (ns-pop-up-frames
813 (ns-hide-emacs 'activate)
814 (let ((pop-up-frames t)) (pop-to-buffer file nil)))
815 (t
816 (ns-hide-emacs 'activate)
817 (find-file f)))))
818
819
820
821;;;; Frame-related functions.
822
a5a1b464 823;; Don't show the frame name; that's redundant with Nextstep.
edfda783
AR
824(setq-default mode-line-frame-identification '(" "))
825
edfda783
AR
826;; You say tomAYto, I say tomAHto..
827(defvaralias 'ns-option-modifier 'ns-alternate-modifier)
828
829(defun ns-do-hide-emacs ()
830 (interactive)
831 (ns-hide-emacs t))
832
c0642f6d
GM
833(declare-function ns-hide-others "nsfns.m" ())
834
edfda783
AR
835(defun ns-do-hide-others ()
836 (interactive)
837 (ns-hide-others))
838
c0642f6d
GM
839(declare-function ns-emacs-info-panel "nsfns.m" ())
840
edfda783
AR
841(defun ns-do-emacs-info-panel ()
842 (interactive)
843 (ns-emacs-info-panel))
844
845(defun ns-next-frame ()
846 "Switch to next visible frame."
847 (interactive)
848 (other-frame 1))
2b4e72e1 849
edfda783
AR
850(defun ns-prev-frame ()
851 "Switch to previous visible frame."
852 (interactive)
853 (other-frame -1))
854
ebe68042 855;; If no position specified, make new frame offset by 25 from current.
e5744c66 856(defvar parameters) ; dynamically bound in make-frame
edfda783 857(add-hook 'before-make-frame-hook
ebe68042
SM
858 (lambda ()
859 (let ((left (cdr (assq 'left (frame-parameters))))
860 (top (cdr (assq 'top (frame-parameters)))))
861 (if (consp left) (setq left (cadr left)))
862 (if (consp top) (setq top (cadr top)))
863 (cond
864 ((or (assq 'top parameters) (assq 'left parameters)))
865 ((or (not left) (not top)))
866 (t
867 (setq parameters (cons (cons 'left (+ left 25))
868 (cons (cons 'top (+ top 25))
869 parameters))))))))
870
871;; frame will be focused anyway, so select it
55e8d9a5 872;; (if this is not done, modeline is dimmed until first interaction)
edfda783
AR
873(add-hook 'after-make-frame-functions 'select-frame)
874
f2d9c15f
GM
875(defvar tool-bar-mode)
876(declare-function tool-bar-mode "tool-bar" (&optional arg))
877
edfda783
AR
878;; Based on a function by David Reitter <dreitter@inf.ed.ac.uk> ;
879;; see http://lists.gnu.org/archive/html/emacs-devel/2005-09/msg00681.html .
880(defun ns-toggle-toolbar (&optional frame)
881 "Switches the tool bar on and off in frame FRAME.
882 If FRAME is nil, the change applies to the selected frame."
883 (interactive)
ebe68042
SM
884 (modify-frame-parameters
885 frame (list (cons 'tool-bar-lines
edfda783
AR
886 (if (> (or (frame-parameter frame 'tool-bar-lines) 0) 0)
887 0 1)) ))
888 (if (not tool-bar-mode) (tool-bar-mode t)))
889
edfda783
AR
890
891
892;;;; Dialog-related functions.
893
33b35792 894
edfda783
AR
895;; Ask user for confirm before printing. Due to Kevin Rodgers.
896(defun ns-print-buffer ()
897 "Interactive front-end to `print-buffer': asks for user confirmation first."
898 (interactive)
899 (if (and (interactive-p)
ebe68042
SM
900 (or (listp last-nonmenu-event)
901 (and (char-or-string-p (event-basic-type last-command-event))
902 (memq 'super (event-modifiers last-command-event)))))
903 (let ((last-nonmenu-event (if (listp last-nonmenu-event)
904 last-nonmenu-event
905 ;; Fake it:
906 `(mouse-1 POSITION 1))))
907 (if (y-or-n-p (format "Print buffer %s? " (buffer-name)))
908 (print-buffer)
edfda783
AR
909 (error "Cancelled")))
910 (print-buffer)))
911
edfda783
AR
912
913;;;; Font support.
914
edfda783
AR
915;; Needed for font listing functions under both backend and normal
916(setq scalable-fonts-allowed t)
917
918;; Set to use font panel instead
406aaa6f 919(declare-function ns-popup-font-panel "nsfns.m" (&optional frame))
28571246 920(defalias 'x-select-font 'ns-popup-font-panel "Pop up the font panel.
2b4e72e1 921This function has been overloaded in Nextstep.")
4c785fa7 922(defalias 'mouse-set-font 'ns-popup-font-panel "Pop up the font panel.
2b4e72e1 923This function has been overloaded in Nextstep.")
edfda783 924
c0642f6d
GM
925;; nsterm.m
926(defvar ns-input-font)
927(defvar ns-input-fontsize)
928
edfda783 929(defun ns-respond-to-change-font ()
2b4e72e1
JB
930 "Respond to changeFont: event, expecting `ns-input-font' and\n\
931`ns-input-fontsize' of new font."
edfda783
AR
932 (interactive)
933 (modify-frame-parameters (selected-frame)
934 (list (cons 'font ns-input-font)
935 (cons 'fontsize ns-input-fontsize)))
936 (set-frame-font ns-input-font))
937
938
939;; Default fontset for Mac OS X. This is mainly here to show how a fontset
940;; can be set up manually. Ordinarily, fontsets are auto-created whenever
2b4e72e1 941;; a font is chosen by
edfda783 942(defvar ns-standard-fontset-spec
ebe68042
SM
943 ;; Only some code supports this so far, so use uglier XLFD version
944 ;; "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard,latin:Courier,han:Kai"
945 (mapconcat 'identity
946 '("-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard"
947 "latin:-*-Courier-*-*-*-*-10-*-*-*-*-*-iso10646-1"
948 "han:-*-Kai-*-*-*-*-10-*-*-*-*-*-iso10646-1"
949 "cyrillic:-*-Trebuchet$MS-*-*-*-*-10-*-*-*-*-*-iso10646-1")
950 ",")
951 "String of fontset spec of the standard fontset.
edfda783 952This defines a fontset consisting of the Courier and other fonts that
2b4e72e1
JB
953come with OS X.
954See the documentation of `create-fontset-from-fontset-spec' for the format.")
edfda783 955
ebe68042 956;; Conditional on new-fontset so bootstrapping works on non-GUI compiles.
edfda783
AR
957(if (fboundp 'new-fontset)
958 (progn
959 ;; Setup the default fontset.
2c035993 960 (create-default-fontset)
edfda783 961 ;; Create the standard fontset.
2c035993
KH
962 (condition-case err
963 (create-fontset-from-fontset-spec ns-standard-fontset-spec t)
2b4e72e1 964 (error (display-warning
2c035993
KH
965 'initialization
966 (format "Creation of the standard fontset failed: %s" err)
967 :error)))))
edfda783 968
edfda783
AR
969
970;;;; Pasteboard support.
971
c0642f6d
GM
972(declare-function ns-get-cut-buffer-internal "nsselect.m" (buffer))
973
edfda783
AR
974(defun ns-get-pasteboard ()
975 "Returns the value of the pasteboard."
976 (ns-get-cut-buffer-internal 'PRIMARY))
977
c0642f6d
GM
978(declare-function ns-store-cut-buffer-internal "nsselect.m" (buffer string))
979
edfda783 980(defun ns-set-pasteboard (string)
a5a1b464 981 "Store STRING into the pasteboard of the Nextstep display server."
edfda783
AR
982 ;; Check the data type of STRING.
983 (if (not (stringp string)) (error "Nonstring given to pasteboard"))
984 (ns-store-cut-buffer-internal 'PRIMARY string))
985
ebe68042
SM
986;; We keep track of the last text selected here, so we can check the
987;; current selection against it, and avoid passing back our own text
9e50ff0c 988;; from x-cut-buffer-or-selection-value.
edfda783
AR
989(defvar ns-last-selected-text nil)
990
9e50ff0c 991(defun x-select-text (text &optional push)
3077d1f6
EZ
992 "Select TEXT, a string, according to the window system.
993
994On X, put TEXT in the primary X selection. For backward
995compatibility with older X applications, set the value of X cut
996buffer 0 as well, and if the optional argument PUSH is non-nil,
997rotate the cut buffers. If `x-select-enable-clipboard' is
998non-nil, copy the text to the X clipboard as well.
999
1000On Windows, make TEXT the current selection. If
1001`x-select-enable-clipboard' is non-nil, copy the text to the
1002clipboard as well. The argument PUSH is ignored.
1003
1004On Nextstep, put TEXT in the pasteboard; PUSH is ignored."
edfda783
AR
1005 ;; Don't send the pasteboard too much text.
1006 ;; It becomes slow, and if really big it causes errors.
1007 (ns-set-pasteboard text)
1008 (setq ns-last-selected-text text))
1009
a5a1b464
CY
1010;; Return the value of the current Nextstep selection. For
1011;; compatibility with older Nextstep applications, this checks cut
1012;; buffer 0 before retrieving the value of the primary selection.
9e50ff0c 1013(defun x-cut-buffer-or-selection-value ()
edfda783 1014 (let (text)
d377ef4a 1015
edfda783
AR
1016 ;; Consult the selection, then the cut buffer. Treat empty strings
1017 ;; as if they were unset.
1018 (or text (setq text (ns-get-pasteboard)))
1019 (if (string= text "") (setq text nil))
d377ef4a 1020
edfda783
AR
1021 (cond
1022 ((not text) nil)
1023 ((eq text ns-last-selected-text) nil)
1024 ((string= text ns-last-selected-text)
1025 ;; Record the newer string, so subsequent calls can use the `eq' test.
1026 (setq ns-last-selected-text text)
1027 nil)
1028 (t
1029 (setq ns-last-selected-text text)))))
1030
1031(defun ns-copy-including-secondary ()
1032 (interactive)
1033 (call-interactively 'kill-ring-save)
1034 (ns-store-cut-buffer-internal 'SECONDARY
1035 (buffer-substring (point) (mark t))))
1036(defun ns-paste-secondary ()
1037 (interactive)
1038 (insert (ns-get-cut-buffer-internal 'SECONDARY)))
1039
1040;; PENDING: not sure what to do here.. for now interprog- are set in
ebe68042 1041;; init-fn-keys, and unsure whether these x- settings have an effect.
9e50ff0c
DN
1042;;(setq interprogram-cut-function 'x-select-text
1043;; interprogram-paste-function 'x-cut-buffer-or-selection-value)
ebe68042 1044;; These only needed if above not working.
edfda783
AR
1045
1046(set-face-background 'region "ns_selection_color")
1047
1048
1049
1050;;;; Scrollbar handling.
1051
1052(global-set-key [vertical-scroll-bar down-mouse-1] 'ns-handle-scroll-bar-event)
1053(global-unset-key [vertical-scroll-bar mouse-1])
1054(global-unset-key [vertical-scroll-bar drag-mouse-1])
1055
f2d9c15f
GM
1056(declare-function scroll-bar-scale "scroll-bar" (num-denom whole))
1057
edfda783 1058(defun ns-scroll-bar-move (event)
55e8d9a5 1059 "Scroll the frame according to a Nextstep scroller event."
edfda783
AR
1060 (interactive "e")
1061 (let* ((pos (event-end event))
1062 (window (nth 0 pos))
1063 (scale (nth 2 pos)))
1064 (save-excursion
1065 (set-buffer (window-buffer window))
1066 (cond
1067 ((eq (car scale) (cdr scale))
1068 (goto-char (point-max)))
1069 ((= (car scale) 0)
1070 (goto-char (point-min)))
1071 (t
1072 (goto-char (+ (point-min) 1
1073 (scroll-bar-scale scale (- (point-max) (point-min)))))))
1074 (beginning-of-line)
1075 (set-window-start window (point))
1076 (vertical-motion (/ (window-height window) 2) window))))
1077
1078(defun ns-handle-scroll-bar-event (event)
55e8d9a5 1079 "Handle scroll bar EVENT to emulate Nextstep style scrolling."
edfda783
AR
1080 (interactive "e")
1081 (let* ((position (event-start event))
1082 (bar-part (nth 4 position))
1083 (window (nth 0 position))
1084 (old-window (selected-window)))
1085 (cond
1086 ((eq bar-part 'ratio)
1087 (ns-scroll-bar-move event))
1088 ((eq bar-part 'handle)
1089 (if (eq window (selected-window))
1090 (track-mouse (ns-scroll-bar-move event))
ebe68042 1091 ;; track-mouse faster for selected window, slower for unselected.
edfda783
AR
1092 (ns-scroll-bar-move event)))
1093 (t
1094 (select-window window)
1095 (cond
1096 ((eq bar-part 'up)
1097 (goto-char (window-start window))
1098 (scroll-down 1))
1099 ((eq bar-part 'above-handle)
1100 (scroll-down))
1101 ((eq bar-part 'below-handle)
1102 (scroll-up))
1103 ((eq bar-part 'down)
1104 (goto-char (window-start window))
1105 (scroll-up 1)))
1106 (select-window old-window)))))
1107
1108
1109;;;; Color support.
1110
c0642f6d
GM
1111(declare-function ns-list-colors "nsfns.m" (&optional frame))
1112
edfda783 1113(defvar x-colors (ns-list-colors)
3077d1f6
EZ
1114 "List of basic colors available on color displays.
1115For X, the list comes from the `rgb.txt' file,v 10.41 94/02/20.
1116For Nextstep, this is a list of non-PANTONE colors returned by
1117the operating system.")
edfda783 1118
9e50ff0c 1119(defun xw-defined-colors (&optional frame)
3077d1f6 1120 "Internal function called by `defined-colors'."
edfda783
AR
1121 (or frame (setq frame (selected-frame)))
1122 (let ((all-colors x-colors)
1123 (this-color nil)
1124 (defined-colors nil))
1125 (while all-colors
1126 (setq this-color (car all-colors)
1127 all-colors (cdr all-colors))
ebe68042
SM
1128 ;; (and (face-color-supported-p frame this-color t)
1129 (setq defined-colors (cons this-color defined-colors))) ;;)
edfda783 1130 defined-colors))
edfda783 1131
edfda783
AR
1132;; Functions for color panel + drag
1133(defun ns-face-at-pos (pos)
1134 (let* ((frame (car pos))
1135 (frame-pos (cons (cadr pos) (cddr pos)))
1136 (window (window-at (car frame-pos) (cdr frame-pos) frame))
1137 (window-pos (coordinates-in-window-p frame-pos window))
1138 (buffer (window-buffer window))
1139 (edges (window-edges window)))
1140 (cond
1141 ((not window-pos)
1142 nil)
1143 ((eq window-pos 'mode-line)
1144 'modeline)
1145 ((eq window-pos 'vertical-line)
1146 'default)
1147 ((consp window-pos)
1148 (save-excursion
1149 (set-buffer buffer)
1150 (let ((p (car (compute-motion (window-start window)
1151 (cons (nth 0 edges) (nth 1 edges))
1152 (window-end window)
1153 frame-pos
1154 (- (window-width window) 1)
1155 nil
1156 window))))
1157 (cond
1158 ((eq p (window-point window))
1159 'cursor)
1160 ((and mark-active (< (region-beginning) p) (< p (region-end)))
1161 'region)
1162 (t
1163 (let ((faces (get-char-property p 'face window)))
1164 (if (consp faces) (car faces) faces)))))))
1165 (t
1166 nil))))
1167
c0642f6d
GM
1168(defvar ns-input-color) ; nsterm.m
1169
edfda783 1170(defun ns-set-foreground-at-mouse ()
2b4e72e1 1171 "Set the foreground color at the mouse location to `ns-input-color'."
edfda783
AR
1172 (interactive)
1173 (let* ((pos (mouse-position))
1174 (frame (car pos))
1175 (face (ns-face-at-pos pos)))
1176 (cond
1177 ((eq face 'cursor)
c0642f6d 1178 (modify-frame-parameters frame (list (cons 'cursor-color
edfda783
AR
1179 ns-input-color))))
1180 ((not face)
1181 (modify-frame-parameters frame (list (cons 'foreground-color
1182 ns-input-color))))
1183 (t
1184 (set-face-foreground face ns-input-color frame)))))
1185
1186(defun ns-set-background-at-mouse ()
2b4e72e1 1187 "Set the background color at the mouse location to `ns-input-color'."
edfda783
AR
1188 (interactive)
1189 (let* ((pos (mouse-position))
1190 (frame (car pos))
1191 (face (ns-face-at-pos pos)))
1192 (cond
1193 ((eq face 'cursor)
1194 (modify-frame-parameters frame (list (cons 'cursor-color
1195 ns-input-color))))
1196 ((not face)
1197 (modify-frame-parameters frame (list (cons 'background-color
1198 ns-input-color))))
1199 (t
1200 (set-face-background face ns-input-color frame)))))
1201
a5a1b464 1202;; Set some options to be as Nextstep-like as possible.
edfda783
AR
1203(setq frame-title-format t
1204 icon-title-format t)
1205
edfda783
AR
1206
1207(defvar ns-initialized nil
a5a1b464 1208 "Non-nil if Nextstep windowing has been initialized.")
edfda783 1209
c0642f6d 1210(declare-function ns-list-services "nsfns.m" ())
b51a3365 1211(declare-function x-open-connection "nsfns.m"
f2d9c15f 1212 (display &optional xrm-string must-succeed))
c0642f6d 1213
a5a1b464
CY
1214;; Do the actual Nextstep Windows setup here; the above code just
1215;; defines functions and variables that we use now.
edfda783 1216(defun ns-initialize-window-system ()
a5a1b464 1217 "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing."
edfda783 1218
ebe68042 1219 ;; PENDING: not needed?
edfda783
AR
1220 (setq command-line-args (ns-handle-args command-line-args))
1221
9e50ff0c 1222 (x-open-connection (system-name) nil t)
edfda783 1223
ebe68042
SM
1224 (dolist (service (ns-list-services))
1225 (if (eq (car service) 'undefined)
1226 (ns-define-service (cdr service))
1227 (define-key global-map (vector (car service))
1228 (ns-define-service (cdr service)))))
edfda783
AR
1229
1230 (if (and (eq (get-lisp-resource nil "NXAutoLaunch") t)
1231 (eq (get-lisp-resource nil "HideOnAutoLaunch") t))
1232 (add-hook 'after-init-hook 'ns-do-hide-emacs))
1233
ebe68042 1234 ;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings.
edfda783 1235 (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1))
edfda783
AR
1236
1237 (setq ns-initialized t))
1238
1239(add-to-list 'handle-args-function-alist '(ns . ns-handle-args))
1240(add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces))
1241(add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system))
1242
1243
1244(provide 'ns-win)
1245
0ae1e5e5 1246;; arch-tag: eb138a45-4e2e-4d68-b1c9-a39665731644
edfda783 1247;;; ns-win.el ends here