aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2008-07-16 20:06:14 +0000
committerStefan Monnier2008-07-16 20:06:14 +0000
commitebe680424766ed6a27f1e4b98515c5e52187fe5f (patch)
tree20c68edc1978b4c3d213b9cb949cd113b4e2dfb1
parent0bcfd7d7798f089b5754ce188a33da2610620a3c (diff)
downloademacs-ebe680424766ed6a27f1e4b98515c5e52187fe5f.tar.gz
emacs-ebe680424766ed6a27f1e4b98515c5e52187fe5f.zip
Require CL; fix up comment style; reindent.
(ns-define-service): Use subst-char-in-string. Avoid `eval'. (ns-save-preferences): Use `case'. (ns-initialize-window-system): Use `dolist'.
-rw-r--r--lisp/ChangeLog9
-rw-r--r--lisp/term/ns-win.el662
2 files changed, 342 insertions, 329 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index cf8f223db38..2aca5853ac8 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,9 +1,16 @@
12008-07-16 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * term/ns-win.el: Require CL; fix up comment style; reindent.
4 (ns-define-service): Use subst-char-in-string. Avoid `eval'.
5 (ns-save-preferences): Use `case'.
6 (ns-initialize-window-system): Use `dolist'.
7
12008-07-16 Adrian Robert <Adrian.B.Robert@gmail.com> 82008-07-16 Adrian Robert <Adrian.B.Robert@gmail.com>
2 9
3 * loadup.el: Remove load of easy-mmode prior to ns-win when NS 10 * loadup.el: Remove load of easy-mmode prior to ns-win when NS
4 windowing is used. 11 windowing is used.
5 * term/ns-win.el (ns-extended-platform-support-mode): 12 * term/ns-win.el (ns-extended-platform-support-mode):
6 Corrected/improved documentation. 13 Correct/improve documentation.
7 14
82008-07-16 Glenn Morris <rgm@gnu.org> 152008-07-16 Glenn Morris <rgm@gnu.org>
9 16
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index ed1037bbdd5..ff74636ddd2 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -40,6 +40,8 @@
40 (error "%s: Loading ns-win.el but not compiled for *Step/OS X" 40 (error "%s: Loading ns-win.el but not compiled for *Step/OS X"
41 (invocation-name))) 41 (invocation-name)))
42 42
43(eval-when-compile (require 'cl))
44
43;; Documentation-purposes only: actually loaded in loadup.el 45;; Documentation-purposes only: actually loaded in loadup.el
44(require 'frame) 46(require 'frame)
45(require 'mouse) 47(require 'mouse)
@@ -48,8 +50,8 @@
48(require 'menu-bar) 50(require 'menu-bar)
49(require 'fontset) 51(require 'fontset)
50 52
51; Not needed? 53;; Not needed?
52;(require 'ispell) 54;;(require 'ispell)
53 55
54;; nsterm.m 56;; nsterm.m
55(defvar ns-version-string) 57(defvar ns-version-string)
@@ -61,21 +63,21 @@
61(declare-function ns-server-version "nsfns.m" (&optional display)) 63(declare-function ns-server-version "nsfns.m" (&optional display))
62 64
63(defun ns-submit-bug-report () 65(defun ns-submit-bug-report ()
64 "Submit via mail a bug report on Emacs 23.0.0 for GNUstep / OS X." 66 "Submit via mail a bug report on Emacs 23.0.0 for GNUstep / OS X."
65 (interactive) 67 (interactive)
66 (let ((frame-parameters (frame-parameters)) 68 (let ((frame-parameters (frame-parameters))
67 (server-vendor (ns-server-vendor)) 69 (server-vendor (ns-server-vendor))
68 (server-version (ns-server-version))) 70 (server-version (ns-server-version)))
69 (reporter-submit-bug-report 71 (reporter-submit-bug-report
70 "Adrian Robert <Adrian.B.Robert@gmail.com>" 72 "Adrian Robert <Adrian.B.Robert@gmail.com>"
71 ;;"Christophe de Dinechin <descubes@earthlink.net>" 73 ;;"Christophe de Dinechin <descubes@earthlink.net>"
72 ;;"Scott Bender <emacs@harmony-ds.com>" 74 ;;"Scott Bender <emacs@harmony-ds.com>"
73 ;;"Christian Limpach <chris@nice.ch>" 75 ;;"Christian Limpach <chris@nice.ch>"
74 ;;"Carl Edman <cedman@princeton.edu>" 76 ;;"Carl Edman <cedman@princeton.edu>"
75 (concat "Emacs for GNUstep / OS X " ns-version-string) 77 (concat "Emacs for GNUstep / OS X " ns-version-string)
76 '(ns-expand-space ns-cursor-blink-rate ns-alternate-modifier 78 '(ns-expand-space ns-cursor-blink-rate ns-alternate-modifier
77 data-directory frame-parameters window-system window-system-version 79 data-directory frame-parameters window-system window-system-version
78 server-vendor server-version system-configuration-options)))) 80 server-vendor server-version system-configuration-options))))
79 81
80 82
81;;;; Command line argument handling. 83;;;; Command line argument handling.
@@ -197,14 +199,14 @@ The properties returned may include `top', `left', `height', and `width'."
197 (if (string-match "\\([0-9]+\\)\\( \\([0-9]+\\)\\( \\([0-9]+\\)\\( \\([0-9]+\\) ?\\)?\\)?\\)?" 199 (if (string-match "\\([0-9]+\\)\\( \\([0-9]+\\)\\( \\([0-9]+\\)\\( \\([0-9]+\\) ?\\)?\\)?\\)?"
198 geom) 200 geom)
199 (apply 'append 201 (apply 'append
200 (list 202 (list
201 (list (cons 'top (string-to-number (match-string 1 geom)))) 203 (list (cons 'top (string-to-number (match-string 1 geom))))
202 (if (match-string 3 geom) 204 (if (match-string 3 geom)
203 (list (cons 'left (string-to-number (match-string 3 geom))))) 205 (list (cons 'left (string-to-number (match-string 3 geom)))))
204 (if (match-string 5 geom) 206 (if (match-string 5 geom)
205 (list (cons 'height (string-to-number (match-string 5 geom))))) 207 (list (cons 'height (string-to-number (match-string 5 geom)))))
206 (if (match-string 7 geom) 208 (if (match-string 7 geom)
207 (list (cons 'width (string-to-number (match-string 7 geom))))))) 209 (list (cons 'width (string-to-number (match-string 7 geom)))))))
208 '())) 210 '()))
209 211
210 212
@@ -283,7 +285,7 @@ The properties returned may include `top', `left', `height', and `width'."
283(define-key global-map [?\s-z] 'undo) 285(define-key global-map [?\s-z] 'undo)
284(define-key global-map [?\s-|] 'shell-command-on-region) 286(define-key global-map [?\s-|] 'shell-command-on-region)
285(define-key global-map [s-kp-bar] 'shell-command-on-region) 287(define-key global-map [s-kp-bar] 'shell-command-on-region)
286; (as in Terminal.app) 288;; (as in Terminal.app)
287(define-key global-map [s-right] 'ns-next-frame) 289(define-key global-map [s-right] 'ns-next-frame)
288(define-key global-map [s-left] 'ns-prev-frame) 290(define-key global-map [s-left] 'ns-prev-frame)
289 291
@@ -298,7 +300,7 @@ The properties returned may include `top', `left', `height', and `width'."
298;; Special NeXTSTEP generated events are converted to function keys. Here 300;; Special NeXTSTEP generated events are converted to function keys. Here
299;; are the bindings for them. 301;; are the bindings for them.
300(define-key global-map [ns-power-off] 302(define-key global-map [ns-power-off]
301 '(lambda () (interactive) (save-buffers-kill-emacs t))) 303 (lambda () (interactive) (save-buffers-kill-emacs t)))
302(define-key global-map [ns-open-file] 'ns-find-file) 304(define-key global-map [ns-open-file] 'ns-find-file)
303(define-key global-map [ns-open-temp-file] [ns-open-file]) 305(define-key global-map [ns-open-temp-file] [ns-open-file])
304(define-key global-map [ns-drag-file] 'ns-insert-file) 306(define-key global-map [ns-drag-file] 'ns-insert-file)
@@ -342,28 +344,28 @@ The properties returned may include `top', `left', `height', and `width'."
342 :group 'ns 344 :group 'ns
343 (if ns-extended-platform-support-mode 345 (if ns-extended-platform-support-mode
344 (progn 346 (progn
345 (global-set-key [M-up] 'down-one) 347 (global-set-key [M-up] 'down-one)
346 (global-set-key [M-down] 'up-one) 348 (global-set-key [M-down] 'up-one)
347 ; These conflict w/word-left, word-right 349 ;; These conflict w/word-left, word-right.
348 ;;(global-set-key [M-left] 'left-one) 350 ;;(global-set-key [M-left] 'left-one)
349 ;;(global-set-key [M-right] 'right-one) 351 ;;(global-set-key [M-right] 'right-one)
350 352
351 (setq scroll-preserve-screen-position t) 353 (setq scroll-preserve-screen-position t)
352 (transient-mark-mode 1) 354 (transient-mark-mode 1)
353 355
354 ;; Change file menu to simplify and add a couple of NS-specific items 356 ;; Change file menu to simplify and add a couple of NS-specific items
355 (easy-menu-remove-item global-map '("menu-bar") 'file) 357 (easy-menu-remove-item global-map '("menu-bar") 'file)
356 (easy-menu-add-item global-map '(menu-bar) 358 (easy-menu-add-item global-map '(menu-bar)
357 (cons "File" menu-bar-ns-file-menu) 'edit)) 359 (cons "File" menu-bar-ns-file-menu) 'edit))
358 (progn 360 (progn
359 ; undo everything above 361 ;; Undo everything above.
360 (global-unset-key [M-up]) 362 (global-unset-key [M-up])
361 (global-unset-key [M-down]) 363 (global-unset-key [M-down])
362 (setq scroll-preserve-screen-position nil) 364 (setq scroll-preserve-screen-position nil)
363 (transient-mark-mode 0) 365 (transient-mark-mode 0)
364 (easy-menu-remove-item global-map '("menu-bar") 'file) 366 (easy-menu-remove-item global-map '("menu-bar") 'file)
365 (easy-menu-add-item global-map '(menu-bar) 367 (easy-menu-add-item global-map '(menu-bar)
366 (cons "File" menu-bar-file-menu) 'edit)))) 368 (cons "File" menu-bar-file-menu) 'edit))))
367 369
368 370
369(defun x-setup-function-keys (frame) 371(defun x-setup-function-keys (frame)
@@ -372,104 +374,104 @@ The properties returned may include `top', `left', `height', and `width'."
372 (with-selected-frame frame 374 (with-selected-frame frame
373 (setq interprogram-cut-function 'ns-select-text 375 (setq interprogram-cut-function 'ns-select-text
374 interprogram-paste-function 'ns-pasteboard-value) 376 interprogram-paste-function 'ns-pasteboard-value)
375;;; (let ((map (copy-keymap x-alternatives-map))) 377 ;; (let ((map (copy-keymap x-alternatives-map)))
376;;; (set-keymap-parent map (keymap-parent local-function-key-map)) 378 ;; (set-keymap-parent map (keymap-parent local-function-key-map))
377;;; (set-keymap-parent local-function-key-map map)) 379 ;; (set-keymap-parent local-function-key-map map))
378 (setq system-key-alist 380 (setq system-key-alist
379 (list 381 (list
380 (cons (logior (lsh 0 16) 1) 'ns-power-off) 382 (cons (logior (lsh 0 16) 1) 'ns-power-off)
381 (cons (logior (lsh 0 16) 2) 'ns-open-file) 383 (cons (logior (lsh 0 16) 2) 'ns-open-file)
382 (cons (logior (lsh 0 16) 3) 'ns-open-temp-file) 384 (cons (logior (lsh 0 16) 3) 'ns-open-temp-file)
383 (cons (logior (lsh 0 16) 4) 'ns-drag-file) 385 (cons (logior (lsh 0 16) 4) 'ns-drag-file)
384 (cons (logior (lsh 0 16) 5) 'ns-drag-color) 386 (cons (logior (lsh 0 16) 5) 'ns-drag-color)
385 (cons (logior (lsh 0 16) 6) 'ns-drag-text) 387 (cons (logior (lsh 0 16) 6) 'ns-drag-text)
386 (cons (logior (lsh 0 16) 7) 'ns-change-font) 388 (cons (logior (lsh 0 16) 7) 'ns-change-font)
387 (cons (logior (lsh 0 16) 8) 'ns-open-file-line) 389 (cons (logior (lsh 0 16) 8) 'ns-open-file-line)
388 (cons (logior (lsh 0 16) 9) 'ns-insert-working-text) 390 (cons (logior (lsh 0 16) 9) 'ns-insert-working-text)
389 (cons (logior (lsh 0 16) 10) 'ns-delete-working-text) 391 (cons (logior (lsh 0 16) 10) 'ns-delete-working-text)
390 (cons (logior (lsh 0 16) 11) 'ns-spi-service-call) 392 (cons (logior (lsh 0 16) 11) 'ns-spi-service-call)
391 (cons (logior (lsh 1 16) 32) 'f1) 393 (cons (logior (lsh 1 16) 32) 'f1)
392 (cons (logior (lsh 1 16) 33) 'f2) 394 (cons (logior (lsh 1 16) 33) 'f2)
393 (cons (logior (lsh 1 16) 34) 'f3) 395 (cons (logior (lsh 1 16) 34) 'f3)
394 (cons (logior (lsh 1 16) 35) 'f4) 396 (cons (logior (lsh 1 16) 35) 'f4)
395 (cons (logior (lsh 1 16) 36) 'f5) 397 (cons (logior (lsh 1 16) 36) 'f5)
396 (cons (logior (lsh 1 16) 37) 'f6) 398 (cons (logior (lsh 1 16) 37) 'f6)
397 (cons (logior (lsh 1 16) 38) 'f7) 399 (cons (logior (lsh 1 16) 38) 'f7)
398 (cons (logior (lsh 1 16) 39) 'f8) 400 (cons (logior (lsh 1 16) 39) 'f8)
399 (cons (logior (lsh 1 16) 40) 'f9) 401 (cons (logior (lsh 1 16) 40) 'f9)
400 (cons (logior (lsh 1 16) 41) 'f10) 402 (cons (logior (lsh 1 16) 41) 'f10)
401 (cons (logior (lsh 1 16) 42) 'f11) 403 (cons (logior (lsh 1 16) 42) 'f11)
402 (cons (logior (lsh 1 16) 43) 'f12) 404 (cons (logior (lsh 1 16) 43) 'f12)
403 (cons (logior (lsh 1 16) 44) 'kp-insert) 405 (cons (logior (lsh 1 16) 44) 'kp-insert)
404 (cons (logior (lsh 1 16) 45) 'kp-delete) 406 (cons (logior (lsh 1 16) 45) 'kp-delete)
405 (cons (logior (lsh 1 16) 46) 'kp-home) 407 (cons (logior (lsh 1 16) 46) 'kp-home)
406 (cons (logior (lsh 1 16) 47) 'kp-end) 408 (cons (logior (lsh 1 16) 47) 'kp-end)
407 (cons (logior (lsh 1 16) 48) 'kp-prior) 409 (cons (logior (lsh 1 16) 48) 'kp-prior)
408 (cons (logior (lsh 1 16) 49) 'kp-next) 410 (cons (logior (lsh 1 16) 49) 'kp-next)
409 (cons (logior (lsh 1 16) 50) 'print-screen) 411 (cons (logior (lsh 1 16) 50) 'print-screen)
410 (cons (logior (lsh 1 16) 51) 'scroll-lock) 412 (cons (logior (lsh 1 16) 51) 'scroll-lock)
411 (cons (logior (lsh 1 16) 52) 'pause) 413 (cons (logior (lsh 1 16) 52) 'pause)
412 (cons (logior (lsh 1 16) 53) 'system) 414 (cons (logior (lsh 1 16) 53) 'system)
413 (cons (logior (lsh 1 16) 54) 'break) 415 (cons (logior (lsh 1 16) 54) 'break)
414 (cons (logior (lsh 1 16) 56) 'please-tell-carl-what-this-key-is-called-56) 416 (cons (logior (lsh 1 16) 56) 'please-tell-carl-what-this-key-is-called-56)
415 (cons (logior (lsh 1 16) 61) 'please-tell-carl-what-this-key-is-called-61) 417 (cons (logior (lsh 1 16) 61) 'please-tell-carl-what-this-key-is-called-61)
416 (cons (logior (lsh 1 16) 62) 'please-tell-carl-what-this-key-is-called-62) 418 (cons (logior (lsh 1 16) 62) 'please-tell-carl-what-this-key-is-called-62)
417 (cons (logior (lsh 1 16) 63) 'please-tell-carl-what-this-key-is-called-63) 419 (cons (logior (lsh 1 16) 63) 'please-tell-carl-what-this-key-is-called-63)
418 (cons (logior (lsh 1 16) 64) 'please-tell-carl-what-this-key-is-called-64) 420 (cons (logior (lsh 1 16) 64) 'please-tell-carl-what-this-key-is-called-64)
419 (cons (logior (lsh 1 16) 69) 'please-tell-carl-what-this-key-is-called-69) 421 (cons (logior (lsh 1 16) 69) 'please-tell-carl-what-this-key-is-called-69)
420 (cons (logior (lsh 1 16) 70) 'please-tell-carl-what-this-key-is-called-70) 422 (cons (logior (lsh 1 16) 70) 'please-tell-carl-what-this-key-is-called-70)
421 (cons (logior (lsh 1 16) 71) 'please-tell-carl-what-this-key-is-called-71) 423 (cons (logior (lsh 1 16) 71) 'please-tell-carl-what-this-key-is-called-71)
422 (cons (logior (lsh 1 16) 72) 'please-tell-carl-what-this-key-is-called-72) 424 (cons (logior (lsh 1 16) 72) 'please-tell-carl-what-this-key-is-called-72)
423 (cons (logior (lsh 1 16) 73) 'please-tell-carl-what-this-key-is-called-73) 425 (cons (logior (lsh 1 16) 73) 'please-tell-carl-what-this-key-is-called-73)
424 (cons (logior (lsh 2 16) 3) 'kp-enter) 426 (cons (logior (lsh 2 16) 3) 'kp-enter)
425 (cons (logior (lsh 2 16) 9) 'kp-tab) 427 (cons (logior (lsh 2 16) 9) 'kp-tab)
426 (cons (logior (lsh 2 16) 28) 'kp-quit) 428 (cons (logior (lsh 2 16) 28) 'kp-quit)
427 (cons (logior (lsh 2 16) 35) 'kp-hash) 429 (cons (logior (lsh 2 16) 35) 'kp-hash)
428 (cons (logior (lsh 2 16) 42) 'kp-multiply) 430 (cons (logior (lsh 2 16) 42) 'kp-multiply)
429 (cons (logior (lsh 2 16) 43) 'kp-add) 431 (cons (logior (lsh 2 16) 43) 'kp-add)
430 (cons (logior (lsh 2 16) 44) 'kp-separator) 432 (cons (logior (lsh 2 16) 44) 'kp-separator)
431 (cons (logior (lsh 2 16) 45) 'kp-subtract) 433 (cons (logior (lsh 2 16) 45) 'kp-subtract)
432 (cons (logior (lsh 2 16) 46) 'kp-decimal) 434 (cons (logior (lsh 2 16) 46) 'kp-decimal)
433 (cons (logior (lsh 2 16) 47) 'kp-divide) 435 (cons (logior (lsh 2 16) 47) 'kp-divide)
434 (cons (logior (lsh 2 16) 48) 'kp-0) 436 (cons (logior (lsh 2 16) 48) 'kp-0)
435 (cons (logior (lsh 2 16) 49) 'kp-1) 437 (cons (logior (lsh 2 16) 49) 'kp-1)
436 (cons (logior (lsh 2 16) 50) 'kp-2) 438 (cons (logior (lsh 2 16) 50) 'kp-2)
437 (cons (logior (lsh 2 16) 51) 'kp-3) 439 (cons (logior (lsh 2 16) 51) 'kp-3)
438 (cons (logior (lsh 2 16) 52) 'kp-4) 440 (cons (logior (lsh 2 16) 52) 'kp-4)
439 (cons (logior (lsh 2 16) 53) 'kp-5) 441 (cons (logior (lsh 2 16) 53) 'kp-5)
440 (cons (logior (lsh 2 16) 54) 'kp-6) 442 (cons (logior (lsh 2 16) 54) 'kp-6)
441 (cons (logior (lsh 2 16) 55) 'kp-7) 443 (cons (logior (lsh 2 16) 55) 'kp-7)
442 (cons (logior (lsh 2 16) 56) 'kp-8) 444 (cons (logior (lsh 2 16) 56) 'kp-8)
443 (cons (logior (lsh 2 16) 57) 'kp-9) 445 (cons (logior (lsh 2 16) 57) 'kp-9)
444 (cons (logior (lsh 2 16) 60) 'kp-less) 446 (cons (logior (lsh 2 16) 60) 'kp-less)
445 (cons (logior (lsh 2 16) 61) 'kp-equal) 447 (cons (logior (lsh 2 16) 61) 'kp-equal)
446 (cons (logior (lsh 2 16) 62) 'kp-more) 448 (cons (logior (lsh 2 16) 62) 'kp-more)
447 (cons (logior (lsh 2 16) 64) 'kp-at) 449 (cons (logior (lsh 2 16) 64) 'kp-at)
448 (cons (logior (lsh 2 16) 92) 'kp-backslash) 450 (cons (logior (lsh 2 16) 92) 'kp-backslash)
449 (cons (logior (lsh 2 16) 96) 'kp-backtick) 451 (cons (logior (lsh 2 16) 96) 'kp-backtick)
450 (cons (logior (lsh 2 16) 124) 'kp-bar) 452 (cons (logior (lsh 2 16) 124) 'kp-bar)
451 (cons (logior (lsh 2 16) 126) 'kp-tilde) 453 (cons (logior (lsh 2 16) 126) 'kp-tilde)
452 (cons (logior (lsh 2 16) 157) 'kp-mu) 454 (cons (logior (lsh 2 16) 157) 'kp-mu)
453 (cons (logior (lsh 2 16) 165) 'kp-yen) 455 (cons (logior (lsh 2 16) 165) 'kp-yen)
454 (cons (logior (lsh 2 16) 167) 'kp-paragraph) 456 (cons (logior (lsh 2 16) 167) 'kp-paragraph)
455 (cons (logior (lsh 2 16) 172) 'left) 457 (cons (logior (lsh 2 16) 172) 'left)
456 (cons (logior (lsh 2 16) 173) 'up) 458 (cons (logior (lsh 2 16) 173) 'up)
457 (cons (logior (lsh 2 16) 174) 'right) 459 (cons (logior (lsh 2 16) 174) 'right)
458 (cons (logior (lsh 2 16) 175) 'down) 460 (cons (logior (lsh 2 16) 175) 'down)
459 (cons (logior (lsh 2 16) 176) 'kp-ring) 461 (cons (logior (lsh 2 16) 176) 'kp-ring)
460 (cons (logior (lsh 2 16) 201) 'kp-square) 462 (cons (logior (lsh 2 16) 201) 'kp-square)
461 (cons (logior (lsh 2 16) 204) 'kp-cube) 463 (cons (logior (lsh 2 16) 204) 'kp-cube)
462 (cons (logior (lsh 3 16) 8) 'backspace) 464 (cons (logior (lsh 3 16) 8) 'backspace)
463 (cons (logior (lsh 3 16) 9) 'tab) 465 (cons (logior (lsh 3 16) 9) 'tab)
464 (cons (logior (lsh 3 16) 10) 'linefeed) 466 (cons (logior (lsh 3 16) 10) 'linefeed)
465 (cons (logior (lsh 3 16) 11) 'clear) 467 (cons (logior (lsh 3 16) 11) 'clear)
466 (cons (logior (lsh 3 16) 13) 'return) 468 (cons (logior (lsh 3 16) 13) 'return)
467 (cons (logior (lsh 3 16) 18) 'pause) 469 (cons (logior (lsh 3 16) 18) 'pause)
468 (cons (logior (lsh 3 16) 25) 'S-tab) 470 (cons (logior (lsh 3 16) 25) 'S-tab)
469 (cons (logior (lsh 3 16) 27) 'escape) 471 (cons (logior (lsh 3 16) 27) 'escape)
470 (cons (logior (lsh 3 16) 127) 'delete) 472 (cons (logior (lsh 3 16) 127) 'delete)
471 )) 473 ))
472 (set-terminal-parameter frame 'x-setup-function-keys t)))) 474 (set-terminal-parameter frame 'x-setup-function-keys t))))
473 475
474 476
475 477
@@ -505,7 +507,7 @@ This should be bound to a mouse click event type."
505 507
506 508
507 509
508; must come after keybindings 510;; Must come after keybindings.
509 511
510(fmakunbound 'clipboard-yank) 512(fmakunbound 'clipboard-yank)
511(fmakunbound 'clipboard-kill-ring-save) 513(fmakunbound 'clipboard-kill-ring-save)
@@ -516,18 +518,17 @@ This should be bound to a mouse click event type."
516;; Note keymap defns must be given last-to-first 518;; Note keymap defns must be given last-to-first
517(define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")) 519(define-key global-map [menu-bar] (make-sparse-keymap "menu-bar"))
518 520
519(cond ((eq system-type 'darwin) 521(setq menu-bar-final-items
520 (setq menu-bar-final-items '(buffer windows services help-menu))) 522 (cond ((eq system-type 'darwin)
521 ;; otherwise, gnustep 523 '(buffer windows services help-menu))
522 (t 524 ;; Otherwise, GNUstep.
523 (setq menu-bar-final-items '(buffer windows services hide-app quit)) ) 525 (t
524) 526 '(buffer windows services hide-app quit))))
525 527
526;; add standard top-level items to GNUstep menu 528;; Add standard top-level items to GNUstep menu.
527(cond ((not (eq system-type 'darwin)) 529(unless (eq system-type 'darwin)
528 (define-key global-map [menu-bar quit] '("Quit" . save-buffers-kill-emacs)) 530 (define-key global-map [menu-bar quit] '("Quit" . save-buffers-kill-emacs))
529 (define-key global-map [menu-bar hide-app] '("Hide" . ns-do-hide-emacs)) 531 (define-key global-map [menu-bar hide-app] '("Hide" . ns-do-hide-emacs)))
530))
531 532
532(define-key global-map [menu-bar services] 533(define-key global-map [menu-bar services]
533 (cons "Services" (make-sparse-keymap "Services"))) 534 (cons "Services" (make-sparse-keymap "Services")))
@@ -623,32 +624,32 @@ This should be bound to a mouse click event type."
623 624
624;;;; Edit menu: Modify slightly 625;;;; Edit menu: Modify slightly
625 626
626; Substitute a Copy function that works better under X (for GNUstep) 627;; Substitute a Copy function that works better under X (for GNUstep).
627(easy-menu-remove-item global-map '("menu-bar" "edit") 'copy) 628(easy-menu-remove-item global-map '("menu-bar" "edit") 'copy)
628(define-key-after menu-bar-edit-menu [copy] 629(define-key-after menu-bar-edit-menu [copy]
629 '(menu-item "Copy" ns-copy-including-secondary 630 '(menu-item "Copy" ns-copy-including-secondary
630 :enable mark-active 631 :enable mark-active
631 :help "Copy text in region between mark and current position") 632 :help "Copy text in region between mark and current position")
632 'cut) 633 'cut)
633 634
634; Change to same precondition as select-and-paste, as we don't have 635;; Change to same precondition as select-and-paste, as we don't have
635; 'x-selection-exists-p 636;; `x-selection-exists-p'.
636(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste) 637(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste)
637(define-key-after menu-bar-edit-menu [paste] 638(define-key-after menu-bar-edit-menu [paste]
638 '(menu-item "Paste" yank 639 '(menu-item "Paste" yank
639 :enable (and (cdr yank-menu) (not buffer-read-only)) 640 :enable (and (cdr yank-menu) (not buffer-read-only))
640 :help "Paste (yank) text most recently cut/copied") 641 :help "Paste (yank) text most recently cut/copied")
641 'copy) 642 'copy)
642 643
643; Change text to be more consistent with surrounding menu items 'paste', etc. 644;; Change text to be more consistent with surrounding menu items `paste', etc.
644(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste-from-menu) 645(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste-from-menu)
645(define-key-after menu-bar-edit-menu [select-paste] 646(define-key-after menu-bar-edit-menu [select-paste]
646 '(menu-item "Select and Paste" yank-menu 647 '(menu-item "Select and Paste" yank-menu
647 :enable (and (cdr yank-menu) (not buffer-read-only)) 648 :enable (and (cdr yank-menu) (not buffer-read-only))
648 :help "Choose a string from the kill ring and paste it") 649 :help "Choose a string from the kill ring and paste it")
649 'paste) 650 'paste)
650 651
651; Separate undo item from cut/paste section, add spell for platform consistency 652;; Separate undo from cut/paste section, add spell for platform consistency.
652(define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo) 653(define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo)
653(define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill) 654(define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill)
654 655
@@ -662,32 +663,31 @@ This should be bound to a mouse click event type."
662 663
663(defun menu-bar-update-frames () 664(defun menu-bar-update-frames ()
664 ;; If user discards the Windows item, play along. 665 ;; If user discards the Windows item, play along.
665 (and (lookup-key (current-global-map) [menu-bar windows]) 666 (when (lookup-key (current-global-map) [menu-bar windows])
666 (let ((frames (frame-list)) 667 (let ((frames (frame-list))
667 (frames-menu (make-sparse-keymap "Select Frame"))) 668 (frames-menu (make-sparse-keymap "Select Frame")))
668 (setcdr frames-menu 669 (setcdr frames-menu
669 (nconc 670 (nconc
670 (mapcar '(lambda (frame) 671 (mapcar (lambda (frame)
671 (nconc (list frame 672 (list* frame
672 (cdr (assq 'name (frame-parameters frame))) 673 (cdr (assq 'name (frame-parameters frame)))
673 (cons nil nil)) 674 'menu-bar-select-frame))
674 'menu-bar-select-frame)) 675 frames)
675 frames) 676 (cdr frames-menu)))
676 (cdr frames-menu))) 677 (define-key frames-menu [separator-frames] '("--"))
677 (define-key frames-menu [separator-frames] '("--")) 678 (define-key frames-menu [popup-color-panel]
678 (define-key frames-menu [popup-color-panel] 679 '("Colors..." . ns-popup-color-panel))
679 '("Colors..." . ns-popup-color-panel)) 680 (define-key frames-menu [popup-font-panel]
680 (define-key frames-menu [popup-font-panel] 681 '("Font Panel..." . ns-popup-font-panel))
681 '("Font Panel..." . ns-popup-font-panel)) 682 (define-key frames-menu [separator-arrange] '("--"))
682 (define-key frames-menu [separator-arrange] '("--")) 683 (define-key frames-menu [arrange-all-frames]
683 (define-key frames-menu [arrange-all-frames] 684 '("Arrange All Frames" . ns-arrange-all-frames))
684 '("Arrange All Frames" . ns-arrange-all-frames)) 685 (define-key frames-menu [arrange-visible-frames]
685 (define-key frames-menu [arrange-visible-frames] 686 '("Arrange Visible Frames" . ns-arrange-visible-frames))
686 '("Arrange Visible Frames" . ns-arrange-visible-frames)) 687 ;; Don't use delete-frame as event name
687 ;; Don't use delete-frame as event name 688 ;; because that is a special event.
688 ;; because that is a special event. 689 (define-key (current-global-map) [menu-bar windows]
689 (define-key (current-global-map) [menu-bar windows] 690 (cons "Windows" frames-menu)))))
690 (cons "Windows" frames-menu)))))
691 691
692(defun force-menu-bar-update-buffers () 692(defun force-menu-bar-update-buffers ()
693 ;; This is a hack to get around fact that we already checked 693 ;; This is a hack to get around fact that we already checked
@@ -731,7 +731,7 @@ This should be bound to a mouse click event type."
731 (done nil)) 731 (done nil))
732 (while (not done) ;cycle through all frames 732 (while (not done) ;cycle through all frames
733 (if (not (or vis (eq (frame-visible-p frame) t))) 733 (if (not (or vis (eq (frame-visible-p frame) t)))
734 (setq x-pos x-pos); do nothing; true case 734 (setq x-pos x-pos); do nothing; true case
735 (set-frame-position frame x-pos y-pos) 735 (set-frame-position frame x-pos y-pos)
736 (setq x-pos (+ x-pos inc-x)) 736 (setq x-pos (+ x-pos inc-x))
737 (setq y-pos (+ y-pos inc-y)) 737 (setq y-pos (+ y-pos inc-y))
@@ -749,23 +749,26 @@ This should be bound to a mouse click event type."
749 (let ((mapping [menu-bar services]) 749 (let ((mapping [menu-bar services])
750 (service (mapconcat 'identity path "/")) 750 (service (mapconcat 'identity path "/"))
751 (name (intern 751 (name (intern
752 (mapconcat '(lambda (s) (if (= s 32) "-" (char-to-string s))) 752 (subst-char-in-string
753 (mapconcat 'identity (cons "ns-service" path) "-") 753 ?\s ?-
754 "")))) 754 (mapconcat 'identity (cons "ns-service" path) "-")))))
755 ;; This defines the function 755 ;; This defines the function.
756 (eval (append (list 'defun name) 756 (defalias name
757 `((arg) 757 (lexical-let ((service service))
758 (interactive "p") 758 (lambda (arg)
759 (let* ((in-string (if (stringp arg) arg (if mark-active 759 (interactive "p")
760 (buffer-substring (region-beginning) (region-end))))) 760 (let* ((in-string
761 (out-string (ns-perform-service (,@service) in-string))) 761 (cond ((stringp arg) arg)
762 (cond 762 (mark-active
763 ((stringp arg) out-string) 763 (buffer-substring (region-beginning) (region-end)))))
764 ((and out-string (or (not in-string) 764 (out-string (ns-perform-service service in-string)))
765 (not (string= in-string out-string)))) 765 (cond
766 (if mark-active (delete-region (region-beginning) (region-end))) 766 ((stringp arg) out-string)
767 (insert out-string) 767 ((and out-string (or (not in-string)
768 (setq deactivate-mark nil))))))) 768 (not (string= in-string out-string))))
769 (if mark-active (delete-region (region-beginning) (region-end)))
770 (insert out-string)
771 (setq deactivate-mark nil)))))))
769 (cond 772 (cond
770 ((lookup-key global-map mapping) 773 ((lookup-key global-map mapping)
771 (while (cdr path) 774 (while (cdr path)
@@ -823,8 +826,8 @@ This should be bound to a mouse click event type."
823 "Length of working text during compose sequence insert.") 826 "Length of working text during compose sequence insert.")
824(make-variable-buffer-local 'ns-working-overlay-len) 827(make-variable-buffer-local 'ns-working-overlay-len)
825 828
826; Based on mac-win.el 2007/08/26 unicode-2. This will fail if called 829;; Based on mac-win.el 2007/08/26 unicode-2. This will fail if called
827; from an "interactive" function. 830;; from an "interactive" function.
828(defun ns-in-echo-area () 831(defun ns-in-echo-area ()
829 "Whether, for purposes of inserting working composition text, the minibuffer 832 "Whether, for purposes of inserting working composition text, the minibuffer
830is currently being used." 833is currently being used."
@@ -840,8 +843,8 @@ is currently being used."
840 (eq (get-char-property (1- (point)) 'composition) 843 (eq (get-char-property (1- (point)) 'composition)
841 (get-char-property (point) 'composition))))))) 844 (get-char-property (point) 'composition)))))))
842 845
843; currently not used, doesn't work because the 'interactive' here stays 846;; Currently not used, doesn't work because the 'interactive' here stays
844; for subinvocations 847;; for subinvocations.
845(defun ns-insert-working-text () 848(defun ns-insert-working-text ()
846 (interactive) 849 (interactive)
847 (if (ns-in-echo-area) (ns-echo-working-text) (ns-put-working-text))) 850 (if (ns-in-echo-area) (ns-echo-working-text) (ns-put-working-text)))
@@ -920,7 +923,7 @@ See ns-insert-working-text."
920;; PENDING: disable composition-based display for Indic scripts as it 923;; PENDING: disable composition-based display for Indic scripts as it
921;; is not working well under NS for some reason 924;; is not working well under NS for some reason
922(set-char-table-range composition-function-table 925(set-char-table-range composition-function-table
923 '(#x0900 . #x0DFF) nil) 926 '(#x0900 . #x0DFF) nil)
924 927
925 928
926;;;; Inter-app communications support. 929;;;; Inter-app communications support.
@@ -1026,13 +1029,13 @@ and highlights lines indicated by ns-input-line."
1026 (ns-set-resource nil "ControlModifier" (symbol-name ns-control-modifier)) 1029 (ns-set-resource nil "ControlModifier" (symbol-name ns-control-modifier))
1027 (ns-set-resource nil "FunctionModifier" (symbol-name ns-function-modifier)) 1030 (ns-set-resource nil "FunctionModifier" (symbol-name ns-function-modifier))
1028 (ns-set-resource nil "CursorBlinkRate" 1031 (ns-set-resource nil "CursorBlinkRate"
1029 (if ns-cursor-blink-rate 1032 (if ns-cursor-blink-rate
1030 (number-to-string ns-cursor-blink-rate) 1033 (number-to-string ns-cursor-blink-rate)
1031 "NO")) 1034 "NO"))
1032 (ns-set-resource nil "ExpandSpace" 1035 (ns-set-resource nil "ExpandSpace"
1033 (if ns-expand-space 1036 (if ns-expand-space
1034 (number-to-string ns-expand-space) 1037 (number-to-string ns-expand-space)
1035 "NO")) 1038 "NO"))
1036 (ns-set-resource nil "GSFontAntiAlias" (if ns-antialias-text "YES" "NO")) 1039 (ns-set-resource nil "GSFontAntiAlias" (if ns-antialias-text "YES" "NO"))
1037 (ns-set-resource nil "UseQuickdrawSmoothing" 1040 (ns-set-resource nil "UseQuickdrawSmoothing"
1038 (if ns-use-qd-smoothing "YES" "NO")) 1041 (if ns-use-qd-smoothing "YES" "NO"))
@@ -1052,7 +1055,8 @@ and highlights lines indicated by ns-input-line."
1052 (if cc (ns-set-resource nil "CursorColor" (cdr cc)))) 1055 (if cc (ns-set-resource nil "CursorColor" (cdr cc))))
1053 (let ((ct (assq 'cursor-type p))) 1056 (let ((ct (assq 'cursor-type p)))
1054 (if ct (ns-set-resource nil "CursorType" 1057 (if ct (ns-set-resource nil "CursorType"
1055 (if (symbolp (cdr ct)) (symbol-name (cdr ct)) (cdr ct))))) 1058 (if (symbolp (cdr ct))
1059 (symbol-name (cdr ct)) (cdr ct)))))
1056 (let ((under (assq 'underline p))) 1060 (let ((under (assq 'underline p)))
1057 (if under (ns-set-resource nil "Underline" 1061 (if under (ns-set-resource nil "Underline"
1058 (cond ((eq (cdr under) t) "YES") 1062 (cond ((eq (cdr under) t) "YES")
@@ -1060,36 +1064,37 @@ and highlights lines indicated by ns-input-line."
1060 (t (cdr under)))))) 1064 (t (cdr under))))))
1061 (let ((ibw (assq 'internal-border-width p))) 1065 (let ((ibw (assq 'internal-border-width p)))
1062 (if ibw (ns-set-resource nil "InternalBorderWidth" 1066 (if ibw (ns-set-resource nil "InternalBorderWidth"
1063 (number-to-string (cdr ibw))))) 1067 (number-to-string (cdr ibw)))))
1064 (let ((vsb (assq 'vertical-scroll-bars p))) 1068 (let ((vsb (assq 'vertical-scroll-bars p)))
1065 (if vsb (ns-set-resource nil "VerticalScrollBars" (cond 1069 (if vsb (ns-set-resource nil "VerticalScrollBars"
1066 ((eq t (cdr vsb)) "YES") 1070 (case (cdr vsb)
1067 ((eq nil (cdr vsb)) "NO") 1071 ((t) "YES")
1068 ((eq 'left (cdr vsb)) "left") 1072 ((nil) "NO")
1069 ((eq 'right (cdr vsb)) "right") 1073 ((left) "left")
1070 (t nil))))) 1074 ((right) "right")
1075 (t nil)))))
1071 (let ((height (assq 'height p))) 1076 (let ((height (assq 'height p)))
1072 (if height (ns-set-resource nil "Height" 1077 (if height (ns-set-resource nil "Height"
1073 (number-to-string (cdr height))))) 1078 (number-to-string (cdr height)))))
1074 (let ((width (assq 'width p))) 1079 (let ((width (assq 'width p)))
1075 (if width (ns-set-resource nil "Width" 1080 (if width (ns-set-resource nil "Width"
1076 (number-to-string (cdr width))))) 1081 (number-to-string (cdr width)))))
1077 (let ((top (assq 'top p))) 1082 (let ((top (assq 'top p)))
1078 (if top (ns-set-resource nil "Top" 1083 (if top (ns-set-resource nil "Top"
1079 (number-to-string (cdr top))))) 1084 (number-to-string (cdr top)))))
1080 (let ((left (assq 'left p))) 1085 (let ((left (assq 'left p)))
1081 (if left (ns-set-resource nil "Left" 1086 (if left (ns-set-resource nil "Left"
1082 (number-to-string (cdr left))))) 1087 (number-to-string (cdr left)))))
1083 ;; These not fully supported 1088 ;; These not fully supported
1084 (let ((ar (assq 'auto-raise p))) 1089 (let ((ar (assq 'auto-raise p)))
1085 (if ar (ns-set-resource nil "AutoRaise" 1090 (if ar (ns-set-resource nil "AutoRaise"
1086 (if (cdr ar) "YES" "NO")))) 1091 (if (cdr ar) "YES" "NO"))))
1087 (let ((al (assq 'auto-lower p))) 1092 (let ((al (assq 'auto-lower p)))
1088 (if al (ns-set-resource nil "AutoLower" 1093 (if al (ns-set-resource nil "AutoLower"
1089 (if (cdr al) "YES" "NO")))) 1094 (if (cdr al) "YES" "NO"))))
1090 (let ((mbl (assq 'menu-bar-lines p))) 1095 (let ((mbl (assq 'menu-bar-lines p)))
1091 (if mbl (ns-set-resource nil "Menus" 1096 (if mbl (ns-set-resource nil "Menus"
1092 (if (cdr mbl) "YES" "NO")))) 1097 (if (cdr mbl) "YES" "NO"))))
1093 ) 1098 )
1094 (let ((fl (face-list))) 1099 (let ((fl (face-list)))
1095 (while (consp fl) 1100 (while (consp fl)
@@ -1099,32 +1104,32 @@ and highlights lines indicated by ns-input-line."
1099 ;; have already been saved from the frame-parameters anyway. 1104 ;; have already been saved from the frame-parameters anyway.
1100 (let* ((name (symbol-name (car fl))) 1105 (let* ((name (symbol-name (car fl)))
1101 (font (face-font (car fl))) 1106 (font (face-font (car fl)))
1102; (fontsize (face-fontsize (car fl))) 1107 ;; (fontsize (face-fontsize (car fl)))
1103 (foreground (face-foreground (car fl))) 1108 (foreground (face-foreground (car fl)))
1104 (background (face-background (car fl))) 1109 (background (face-background (car fl)))
1105 (underline (face-underline-p (car fl))) 1110 (underline (face-underline-p (car fl)))
1106 (italic (face-italic-p (car fl))) 1111 (italic (face-italic-p (car fl)))
1107 (bold (face-bold-p (car fl))) 1112 (bold (face-bold-p (car fl)))
1108 (stipple (face-stipple (car fl)))) 1113 (stipple (face-stipple (car fl))))
1109; (ns-set-resource nil (concat name ".attributeFont") 1114 ;; (ns-set-resource nil (concat name ".attributeFont")
1110; (if font font nil)) 1115 ;; (if font font nil))
1111; (ns-set-resource nil (concat name ".attributeFontSize") 1116 ;; (ns-set-resource nil (concat name ".attributeFontSize")
1112; (if fontsize (number-to-string fontsize) nil)) 1117 ;; (if fontsize (number-to-string fontsize) nil))
1113 (ns-set-resource nil (concat name ".attributeForeground") 1118 (ns-set-resource nil (concat name ".attributeForeground")
1114 (if foreground foreground nil)) 1119 (if foreground foreground nil))
1115 (ns-set-resource nil (concat name ".attributeBackground") 1120 (ns-set-resource nil (concat name ".attributeBackground")
1116 (if background background nil)) 1121 (if background background nil))
1117 (ns-set-resource nil (concat name ".attributeUnderline") 1122 (ns-set-resource nil (concat name ".attributeUnderline")
1118 (if underline "YES" nil)) 1123 (if underline "YES" nil))
1119 (ns-set-resource nil (concat name ".attributeItalic") 1124 (ns-set-resource nil (concat name ".attributeItalic")
1120 (if italic "YES" nil)) 1125 (if italic "YES" nil))
1121 (ns-set-resource nil (concat name ".attributeBold") 1126 (ns-set-resource nil (concat name ".attributeBold")
1122 (if bold "YES" nil)) 1127 (if bold "YES" nil))
1123 (and stipple 1128 (and stipple
1124 (or (stringp stipple) 1129 (or (stringp stipple)
1125 (setq stipple (prin1-to-string stipple)))) 1130 (setq stipple (prin1-to-string stipple))))
1126 (ns-set-resource nil (concat name ".attributeStipple") 1131 (ns-set-resource nil (concat name ".attributeStipple")
1127 (if stipple stipple nil)))) 1132 (if stipple stipple nil))))
1128 (setq fl (cdr fl))))) 1133 (setq fl (cdr fl)))))
1129 1134
1130(declare-function menu-bar-options-save-orig "ns-win" () t) 1135(declare-function menu-bar-options-save-orig "ns-win" () t)
@@ -1143,7 +1148,7 @@ and highlights lines indicated by ns-input-line."
1143(defun ns-open-file-using-panel () 1148(defun ns-open-file-using-panel ()
1144 "Pop up open-file panel, and load the result in a buffer." 1149 "Pop up open-file panel, and load the result in a buffer."
1145 (interactive) 1150 (interactive)
1146 ; prompt dir defaultName isLoad initial 1151 ;; Prompt dir defaultName isLoad initial.
1147 (setq ns-input-file (ns-read-file-name "Select File to Load" nil t nil)) 1152 (setq ns-input-file (ns-read-file-name "Select File to Load" nil t nil))
1148 (if ns-input-file 1153 (if ns-input-file
1149 (and (setq ns-input-file (list ns-input-file)) (ns-find-file)))) 1154 (and (setq ns-input-file (list ns-input-file)) (ns-find-file))))
@@ -1152,7 +1157,7 @@ and highlights lines indicated by ns-input-line."
1152 "Pop up save-file panel, and save buffer in resulting name." 1157 "Pop up save-file panel, and save buffer in resulting name."
1153 (interactive) 1158 (interactive)
1154 (let (ns-output-file) 1159 (let (ns-output-file)
1155 ; prompt dir defaultName isLoad initial 1160 ;; Prompt dir defaultName isLoad initial.
1156 (setq ns-output-file (ns-read-file-name "Save As" nil nil nil)) 1161 (setq ns-output-file (ns-read-file-name "Save As" nil nil nil))
1157 (message ns-output-file) 1162 (message ns-output-file)
1158 (if ns-output-file (write-file ns-output-file)))) 1163 (if ns-output-file (write-file ns-output-file))))
@@ -1226,29 +1231,29 @@ unless the current buffer is a scratch buffer.")
1226 (interactive) 1231 (interactive)
1227 (other-frame -1)) 1232 (other-frame -1))
1228 1233
1229; If no position specified, make new frame offset by 25 from current. 1234;; If no position specified, make new frame offset by 25 from current.
1230(add-hook 'before-make-frame-hook 1235(add-hook 'before-make-frame-hook
1231 '(lambda () 1236 (lambda ()
1232 (let ((left (cdr (assq 'left (frame-parameters)))) 1237 (let ((left (cdr (assq 'left (frame-parameters))))
1233 (top (cdr (assq 'top (frame-parameters))))) 1238 (top (cdr (assq 'top (frame-parameters)))))
1234 (if (consp left) (setq left (cadr left))) 1239 (if (consp left) (setq left (cadr left)))
1235 (if (consp top) (setq top (cadr top))) 1240 (if (consp top) (setq top (cadr top)))
1236 (cond 1241 (cond
1237 ((or (assq 'top parameters) (assq 'left parameters))) 1242 ((or (assq 'top parameters) (assq 'left parameters)))
1238 ((or (not left) (not top))) 1243 ((or (not left) (not top)))
1239 (t 1244 (t
1240 (setq parameters (cons (cons 'left (+ left 25)) 1245 (setq parameters (cons (cons 'left (+ left 25))
1241 (cons (cons 'top (+ top 25)) 1246 (cons (cons 'top (+ top 25))
1242 parameters)))))))) 1247 parameters))))))))
1243 1248
1244; frame will be focused anyway, so select it 1249;; frame will be focused anyway, so select it
1245(add-hook 'after-make-frame-functions 'select-frame) 1250(add-hook 'after-make-frame-functions 'select-frame)
1246 1251
1247;;; (defun ns-win-suspend-error () 1252;; (defun ns-win-suspend-error ()
1248;;; (error "Suspending an emacs running under *Step/OS X makes no sense")) 1253;; (error "Suspending an emacs running under *Step/OS X makes no sense"))
1249;;; (add-hook 'suspend-hook 'ns-win-suspend-error) 1254;; (add-hook 'suspend-hook 'ns-win-suspend-error)
1250;;; (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame 1255;; (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
1251;;; global-map) 1256;; global-map)
1252 1257
1253;; Based on a function by David Reitter <dreitter@inf.ed.ac.uk> ; 1258;; Based on a function by David Reitter <dreitter@inf.ed.ac.uk> ;
1254;; see http://lists.gnu.org/archive/html/emacs-devel/2005-09/msg00681.html . 1259;; see http://lists.gnu.org/archive/html/emacs-devel/2005-09/msg00681.html .
@@ -1256,15 +1261,15 @@ unless the current buffer is a scratch buffer.")
1256 "Switches the tool bar on and off in frame FRAME. 1261 "Switches the tool bar on and off in frame FRAME.
1257 If FRAME is nil, the change applies to the selected frame." 1262 If FRAME is nil, the change applies to the selected frame."
1258 (interactive) 1263 (interactive)
1259 (modify-frame-parameters frame 1264 (modify-frame-parameters
1260 (list (cons 'tool-bar-lines 1265 frame (list (cons 'tool-bar-lines
1261 (if (> (or (frame-parameter frame 'tool-bar-lines) 0) 0) 1266 (if (> (or (frame-parameter frame 'tool-bar-lines) 0) 0)
1262 0 1)) )) 1267 0 1)) ))
1263 (if (not tool-bar-mode) (tool-bar-mode t))) 1268 (if (not tool-bar-mode) (tool-bar-mode t)))
1264 1269
1265(defvar ns-cursor-blink-mode) ; nsterm.m 1270(defvar ns-cursor-blink-mode) ; nsterm.m
1266 1271
1267; Redefine from frame.el 1272;; Redefine from frame.el.
1268(define-minor-mode blink-cursor-mode 1273(define-minor-mode blink-cursor-mode
1269 "Toggle blinking cursor mode. 1274 "Toggle blinking cursor mode.
1270With a numeric argument, turn blinking cursor mode on if ARG is positive, 1275With a numeric argument, turn blinking cursor mode on if ARG is positive,
@@ -1293,23 +1298,23 @@ cursor display. On a text-only terminal, this is not implemented."
1293 "Interactive front-end to `print-buffer': asks for user confirmation first." 1298 "Interactive front-end to `print-buffer': asks for user confirmation first."
1294 (interactive) 1299 (interactive)
1295 (if (and (interactive-p) 1300 (if (and (interactive-p)
1296 (or (listp last-nonmenu-event) 1301 (or (listp last-nonmenu-event)
1297 (and (char-or-string-p (event-basic-type last-command-event)) 1302 (and (char-or-string-p (event-basic-type last-command-event))
1298 (memq 'super (event-modifiers last-command-event))))) 1303 (memq 'super (event-modifiers last-command-event)))))
1299 (let ((last-nonmenu-event (if (listp last-nonmenu-event) 1304 (let ((last-nonmenu-event (if (listp last-nonmenu-event)
1300 last-nonmenu-event 1305 last-nonmenu-event
1301 ;; fake it: 1306 ;; Fake it:
1302 `(mouse-1 POSITION 1)))) 1307 `(mouse-1 POSITION 1))))
1303 (if (y-or-n-p (format "Print buffer %s? " (buffer-name))) 1308 (if (y-or-n-p (format "Print buffer %s? " (buffer-name)))
1304 (print-buffer) 1309 (print-buffer)
1305 (error "Cancelled"))) 1310 (error "Cancelled")))
1306 (print-buffer))) 1311 (print-buffer)))
1307 1312
1308(defun ns-yes-or-no-p (prompt) 1313(defun ns-yes-or-no-p (prompt)
1309 "As yes-or-no-p except that NS panel always used for querying." 1314 "As yes-or-no-p except that NS panel always used for querying."
1310 (interactive) 1315 (interactive)
1311 (setq last-nonmenu-event nil) 1316 (setq last-nonmenu-event nil)
1312 (yes-or-no-p prompt)) 1317 (yes-or-no-p prompt))
1313 1318
1314 1319
1315;;;; Font support. 1320;;;; Font support.
@@ -1340,30 +1345,35 @@ ns-input-fontsize of new font."
1340;; can be set up manually. Ordinarily, fontsets are auto-created whenever 1345;; can be set up manually. Ordinarily, fontsets are auto-created whenever
1341;; a font is chosen by 1346;; a font is chosen by
1342(defvar ns-standard-fontset-spec 1347(defvar ns-standard-fontset-spec
1343; Only some code supports this so far, so use uglier XLFD version 1348 ;; Only some code supports this so far, so use uglier XLFD version
1344; "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard,latin:Courier,han:Kai" 1349 ;; "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard,latin:Courier,han:Kai"
1345"-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard,latin:-*-Courier-*-*-*-*-10-*-*-*-*-*-iso10646-1,han:-*-Kai-*-*-*-*-10-*-*-*-*-*-iso10646-1,cyrillic:-*-Trebuchet$MS-*-*-*-*-10-*-*-*-*-*-iso10646-1" 1350 (mapconcat 'identity
1346 "String of fontset spec of the standard fontset. 1351 '("-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard"
1352 "latin:-*-Courier-*-*-*-*-10-*-*-*-*-*-iso10646-1"
1353 "han:-*-Kai-*-*-*-*-10-*-*-*-*-*-iso10646-1"
1354 "cyrillic:-*-Trebuchet$MS-*-*-*-*-10-*-*-*-*-*-iso10646-1")
1355 ",")
1356 "String of fontset spec of the standard fontset.
1347This defines a fontset consisting of the Courier and other fonts that 1357This defines a fontset consisting of the Courier and other fonts that
1348come with OS X\". 1358come with OS X\".
1349See the documentation of `create-fontset-from-fontset-spec for the format.") 1359See the documentation of `create-fontset-from-fontset-spec for the format.")
1350 1360
1351;; Conditional on new-fontset so bootstrapping works on non-GUI compiles 1361;; Conditional on new-fontset so bootstrapping works on non-GUI compiles.
1352(if (fboundp 'new-fontset) 1362(if (fboundp 'new-fontset)
1353 (progn 1363 (progn
1354 ;; Setup the default fontset. 1364 ;; Setup the default fontset.
1355 (setup-default-fontset) 1365 (setup-default-fontset)
1356 ;; Create the standard fontset. 1366 ;; Create the standard fontset.
1357 (create-fontset-from-fontset-spec ns-standard-fontset-spec t) 1367 (create-fontset-from-fontset-spec ns-standard-fontset-spec t)))
1358))
1359 1368
1360;(setq default-frame-alist (cons (cons 'font "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard") default-frame-alist)) 1369;;(push (cons 'font "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard")
1370;; default-frame-alist)
1361 1371
1362;; add some additional scripts to var we use for fontset generation 1372;; Add some additional scripts to var we use for fontset generation.
1363(setq script-representative-chars 1373(setq script-representative-chars
1364 (cons '(kana #xff8a) 1374 (cons '(kana #xff8a)
1365 (cons '(symbol #x2295 #x2287 #x25a1) 1375 (cons '(symbol #x2295 #x2287 #x25a1)
1366 script-representative-chars))) 1376 script-representative-chars)))
1367 1377
1368 1378
1369;;;; Pasteboard support. 1379;;;; Pasteboard support.
@@ -1382,21 +1392,21 @@ See the documentation of `create-fontset-from-fontset-spec for the format.")
1382 (if (not (stringp string)) (error "Nonstring given to pasteboard")) 1392 (if (not (stringp string)) (error "Nonstring given to pasteboard"))
1383 (ns-store-cut-buffer-internal 'PRIMARY string)) 1393 (ns-store-cut-buffer-internal 'PRIMARY string))
1384 1394
1385;;; We keep track of the last text selected here, so we can check the 1395;; We keep track of the last text selected here, so we can check the
1386;;; current selection against it, and avoid passing back our own text 1396;; current selection against it, and avoid passing back our own text
1387;;; from ns-pasteboard-value. 1397;; from ns-pasteboard-value.
1388(defvar ns-last-selected-text nil) 1398(defvar ns-last-selected-text nil)
1389 1399
1390;;; Put TEXT, a string, on the pasteboard.
1391(defun ns-select-text (text &optional push) 1400(defun ns-select-text (text &optional push)
1401 "Put TEXT, a string, on the pasteboard."
1392 ;; Don't send the pasteboard too much text. 1402 ;; Don't send the pasteboard too much text.
1393 ;; It becomes slow, and if really big it causes errors. 1403 ;; It becomes slow, and if really big it causes errors.
1394 (ns-set-pasteboard text) 1404 (ns-set-pasteboard text)
1395 (setq ns-last-selected-text text)) 1405 (setq ns-last-selected-text text))
1396 1406
1397;;; Return the value of the current NS selection. For compatibility 1407;; Return the value of the current NS selection. For compatibility
1398;;; with older NS applications, this checks cut buffer 0 before 1408;; with older NS applications, this checks cut buffer 0 before
1399;;; retrieving the value of the primary selection. 1409;; retrieving the value of the primary selection.
1400(defun ns-pasteboard-value () 1410(defun ns-pasteboard-value ()
1401 (let (text) 1411 (let (text)
1402 1412
@@ -1425,10 +1435,10 @@ See the documentation of `create-fontset-from-fontset-spec for the format.")
1425 (insert (ns-get-cut-buffer-internal 'SECONDARY))) 1435 (insert (ns-get-cut-buffer-internal 'SECONDARY)))
1426 1436
1427;; PENDING: not sure what to do here.. for now interprog- are set in 1437;; PENDING: not sure what to do here.. for now interprog- are set in
1428;; init-fn-keys, and unsure whether these x- settings have an effect 1438;; init-fn-keys, and unsure whether these x- settings have an effect.
1429;;(setq interprogram-cut-function 'ns-select-text 1439;;(setq interprogram-cut-function 'ns-select-text
1430;; interprogram-paste-function 'ns-pasteboard-value) 1440;; interprogram-paste-function 'ns-pasteboard-value)
1431; these only needed if above not working 1441;; These only needed if above not working.
1432(defalias 'x-select-text 'ns-select-text) 1442(defalias 'x-select-text 'ns-select-text)
1433(defalias 'x-cut-buffer-or-selection-value 'ns-pasteboard-value) 1443(defalias 'x-cut-buffer-or-selection-value 'ns-pasteboard-value)
1434(defalias 'x-disown-selection-internal 'ns-disown-selection-internal) 1444(defalias 'x-disown-selection-internal 'ns-disown-selection-internal)
@@ -1478,7 +1488,7 @@ See the documentation of `create-fontset-from-fontset-spec for the format.")
1478 ((eq bar-part 'handle) 1488 ((eq bar-part 'handle)
1479 (if (eq window (selected-window)) 1489 (if (eq window (selected-window))
1480 (track-mouse (ns-scroll-bar-move event)) 1490 (track-mouse (ns-scroll-bar-move event))
1481 ; track-mouse faster for selected window, slower for unselected 1491 ;; track-mouse faster for selected window, slower for unselected.
1482 (ns-scroll-bar-move event))) 1492 (ns-scroll-bar-move event)))
1483 (t 1493 (t
1484 (select-window window) 1494 (select-window window)
@@ -1516,9 +1526,8 @@ The value may be different for frames on different NS displays."
1516 (while all-colors 1526 (while all-colors
1517 (setq this-color (car all-colors) 1527 (setq this-color (car all-colors)
1518 all-colors (cdr all-colors)) 1528 all-colors (cdr all-colors))
1519; (and (face-color-supported-p frame this-color t) 1529 ;; (and (face-color-supported-p frame this-color t)
1520 (setq defined-colors (cons this-color defined-colors))) 1530 (setq defined-colors (cons this-color defined-colors))) ;;)
1521;)
1522 defined-colors)) 1531 defined-colors))
1523(defalias 'x-defined-colors 'ns-defined-colors) 1532(defalias 'x-defined-colors 'ns-defined-colors)
1524(defalias 'xw-defined-colors 'ns-defined-colors) 1533(defalias 'xw-defined-colors 'ns-defined-colors)
@@ -1607,7 +1616,7 @@ Note, tranparency works better on Tiger (10.4) and higher."
1607 1616
1608 1617
1609 1618
1610;; Misc aliases 1619;; Misc aliases.
1611(defalias 'x-display-mm-width 'ns-display-mm-width) 1620(defalias 'x-display-mm-width 'ns-display-mm-width)
1612(defalias 'x-display-mm-height 'ns-display-mm-height) 1621(defalias 'x-display-mm-height 'ns-display-mm-height)
1613(defalias 'x-display-backing-store 'ns-display-backing-store) 1622(defalias 'x-display-backing-store 'ns-display-backing-store)
@@ -1620,15 +1629,14 @@ Note, tranparency works better on Tiger (10.4) and higher."
1620(setq frame-title-format t 1629(setq frame-title-format t
1621 icon-title-format t) 1630 icon-title-format t)
1622 1631
1623;; Set up browser connectivity 1632;; Set up browser connectivity.
1624(defvar browse-url-generic-program) 1633(defvar browse-url-generic-program)
1625 1634
1626(setq browse-url-browser-function 'browse-url-generic) 1635(setq browse-url-browser-function 'browse-url-generic)
1627(cond ((eq system-type 'darwin) 1636(setq browse-url-generic-program
1628 (setq browse-url-generic-program "open")) 1637 (cond ((eq system-type 'darwin) "open")
1629 ;; otherwise, gnustep 1638 ;; Otherwise, GNUstep.
1630 (t 1639 (t "gopen")))
1631 (setq browse-url-generic-program "gopen")) )
1632 1640
1633 1641
1634(defvar ns-initialized nil 1642(defvar ns-initialized nil
@@ -1639,29 +1647,27 @@ Note, tranparency works better on Tiger (10.4) and higher."
1639 1647
1640(declare-function ns-list-services "nsfns.m" ()) 1648(declare-function ns-list-services "nsfns.m" ())
1641 1649
1642;;; Do the actual NS Windows setup here; the above code just defines 1650;; Do the actual NS Windows setup here; the above code just defines
1643;;; functions and variables that we use now. 1651;; functions and variables that we use now.
1644(defun ns-initialize-window-system () 1652(defun ns-initialize-window-system ()
1645 "Initialize Emacs for NS (Cocoa / GNUstep) windowing." 1653 "Initialize Emacs for NS (Cocoa / GNUstep) windowing."
1646 1654
1647 ; PENDING: not needed? 1655 ;; PENDING: not needed?
1648 (setq command-line-args (ns-handle-args command-line-args)) 1656 (setq command-line-args (ns-handle-args command-line-args))
1649 1657
1650 (ns-open-connection (system-name) nil t) 1658 (ns-open-connection (system-name) nil t)
1651 1659
1652 (let ((services (ns-list-services))) 1660 (dolist (service (ns-list-services))
1653 (while services 1661 (if (eq (car service) 'undefined)
1654 (if (eq (caar services) 'undefined) 1662 (ns-define-service (cdr service))
1655 (ns-define-service (cdar services)) 1663 (define-key global-map (vector (car service))
1656 (define-key global-map (vector (caar services)) 1664 (ns-define-service (cdr service)))))
1657 (ns-define-service (cdar services)))
1658 )
1659 (setq services (cdr services))))
1660 1665
1661 (if (and (eq (get-lisp-resource nil "NXAutoLaunch") t) 1666 (if (and (eq (get-lisp-resource nil "NXAutoLaunch") t)
1662 (eq (get-lisp-resource nil "HideOnAutoLaunch") t)) 1667 (eq (get-lisp-resource nil "HideOnAutoLaunch") t))
1663 (add-hook 'after-init-hook 'ns-do-hide-emacs)) 1668 (add-hook 'after-init-hook 'ns-do-hide-emacs))
1664 1669
1670 ;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings.
1665 (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1)) 1671 (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1))
1666 (mouse-wheel-mode 1) 1672 (mouse-wheel-mode 1)
1667 1673