diff options
| author | Stefan Monnier | 2008-07-16 20:06:14 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2008-07-16 20:06:14 +0000 |
| commit | ebe680424766ed6a27f1e4b98515c5e52187fe5f (patch) | |
| tree | 20c68edc1978b4c3d213b9cb949cd113b4e2dfb1 | |
| parent | 0bcfd7d7798f089b5754ce188a33da2610620a3c (diff) | |
| download | emacs-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/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/term/ns-win.el | 662 |
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 @@ | |||
| 1 | 2008-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 | |||
| 1 | 2008-07-16 Adrian Robert <Adrian.B.Robert@gmail.com> | 8 | 2008-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 | ||
| 8 | 2008-07-16 Glenn Morris <rgm@gnu.org> | 15 | 2008-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 |
| 830 | is currently being used." | 833 | is 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. |
| 1270 | With a numeric argument, turn blinking cursor mode on if ARG is positive, | 1275 | With 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. | ||
| 1347 | This defines a fontset consisting of the Courier and other fonts that | 1357 | This defines a fontset consisting of the Courier and other fonts that |
| 1348 | come with OS X\". | 1358 | come with OS X\". |
| 1349 | See the documentation of `create-fontset-from-fontset-spec for the format.") | 1359 | See 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 | ||