summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorAdrian Robert <Adrian.B.Robert@gmail.com>2008-07-15 18:15:18 +0000
committerAdrian Robert <Adrian.B.Robert@gmail.com>2008-07-15 18:15:18 +0000
commitedfda78355c5528eee489fa8a7f9c73bf8e734f2 (patch)
tree78d2414d9791e1efc17ec9b35b438ae35602340a /lisp
parent1391cd548782097e34d7856ec4f20ca90bdf2c26 (diff)
downloademacs-edfda78355c5528eee489fa8a7f9c73bf8e734f2.tar.gz
merging Emacs.app (NeXTstep port)
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog39
-rw-r--r--lisp/Makefile.in3
-rw-r--r--lisp/cus-edit.el12
-rw-r--r--lisp/cus-face.el2
-rw-r--r--lisp/disp-table.el8
-rw-r--r--lisp/emulation/viper-util.el8
-rw-r--r--lisp/facemenu.el3
-rw-r--r--lisp/faces.el18
-rw-r--r--lisp/frame.el55
-rw-r--r--lisp/gnus/gnus-util.el4
-rw-r--r--lisp/info.el2
-rw-r--r--lisp/international/mule-cmds.el2
-rw-r--r--lisp/loadup.el5
-rw-r--r--lisp/mouse.el2
-rw-r--r--lisp/mwheel.el4
-rw-r--r--lisp/ns-carbon-compat.el37
-rw-r--r--lisp/ns-grabenv.el67
-rw-r--r--lisp/simple.el2
-rw-r--r--lisp/startup.el80
-rw-r--r--lisp/term/ns-win.el1608
-rw-r--r--lisp/version.el2
-rw-r--r--lisp/woman.el10
22 files changed, 1910 insertions, 63 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 61497df6504..afcd19bef32 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,42 @@
+2008-07-15 Adrian Robert <Adrian.B.Robert@gmail.com>
+ * ns-carbon-compat.el: New file: user-visible compatibility of
+ NeXTstep port with Carbon port.
+ * ns-grabenv.el: New file: functionality useful on OS X platform to
+ expose environment variables inside Emacs started from icon.
+ * Makefile.in: Add above three files.
+ * cus-edit.el
+ * cus-face.el
+ * disp-table.el
+ * faces.el
+ * info.el
+ * mouse.el
+ * mwheel.el
+ * simple.el: Add ns to window systems treated as GUIs.
+ * facemenu.el (facemenu-read-color): Don't require a name match under
+ NS, to allow numeric color entry.
+ * frame.el (make-frame-on-display): Follow code for 'x in initializing
+ 'ns window system if need be.
+ (various): Add 'ns as described above.
+ * loadup.el: Load ns-win.el if ns-windowing is active.
+ * startup.el (command-line-ns-option-alist): New constant to handle NS
+ windowing system specific command line args analogous to how they are
+ handled for X windows.
+ (command-line-1): Use the above where appropriate.
+ * version.el: Add NS port version.
+ * woman.el (woman-man.conf-path): Add /usr/share/misc to init path on
+ Darwin (usually OS X) systems.
+ (woman-use-own-frame): Include 'ns in list of GUI window systems.
+ * emulation/viper-util.el (ns-display-color-p)
+ (ns-color-defined-p): Remove these (caustically-commented) outdated
+ compensations for a port that was never itself integrated until now.
+ * gnus/gnus-util.el (gnus-select-frame-set-input-focus): Add support
+ for NS window system.
+ * international/mule-cmds.el: Add 'ns to list of special-cased window
+ systems (probably most of these, x/w32/mac/ns could be changed to
+ window-system non-nil).
+ * term/ns-win.el: New file: lisp-side support for NS windowing system.
+
+
2008-07-14 Jason Rumney <jasonr@gnu.org>
* term/w32-win.el (x-handle-switch, x-handle-name-switch)
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index e4d878d5abd..4c590b04ddd 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -867,6 +867,8 @@ ELCFILES = \
$(lisp)/net/zeroconf.elc \
$(lisp)/newcomment.elc \
$(lisp)/novice.elc \
+ $(lisp)/ns-grabenv.elc \
+ $(lisp)/ns-carbon-compat.elc \
$(lisp)/nxml/nxml-enc.elc \
$(lisp)/nxml/nxml-glyph.elc \
$(lisp)/nxml/nxml-maint.elc \
@@ -1110,6 +1112,7 @@ ELCFILES = \
$(lisp)/tempo.elc \
$(lisp)/term.elc \
$(lisp)/term/mac-win.elc \
+ $(lisp)/term/ns-win.elc \
$(lisp)/term/pc-win.elc \
$(lisp)/term/rxvt.elc \
$(lisp)/term/sun.elc \
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 63bc854a7a0..fe23aa76b7e 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -2068,7 +2068,7 @@ and `face'."
;;; The `custom' Widget.
(defface custom-button
- '((((type x w32 mac) (class color)) ; Like default modeline
+ '((((type x w32 mac ns) (class color)) ; Like default modeline
(:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
(t
@@ -2080,7 +2080,7 @@ and `face'."
(put 'custom-button-face 'face-alias 'custom-button)
(defface custom-button-mouse
- '((((type x w32 mac) (class color))
+ '((((type x w32 mac ns) (class color))
(:box (:line-width 2 :style released-button)
:background "grey90" :foreground "black"))
(t
@@ -2102,7 +2102,7 @@ and `face'."
(if custom-raised-buttons 'custom-button-mouse 'highlight))
(defface custom-button-pressed
- '((((type x w32 mac) (class color))
+ '((((type x w32 mac ns) (class color))
(:box (:line-width 2 :style pressed-button)
:background "lightgrey" :foreground "black"))
(t
@@ -3163,8 +3163,12 @@ Windows NT/9X.")
w32)
(const :format "MAC "
:sibling-args (:help-echo "\
-Macintosh OS.")
+Macintosh OS (Carbon interface).")
mac)
+ (const :format "NS "
+ :sibling-args (:help-echo "\
+GNUstep or Macintosh OS Cocoa interface.")
+ ns)
(const :format "DOS "
:sibling-args (:help-echo "\
Plain MS-DOS.")
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 318fd61fc34..5581cff9588 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -44,7 +44,7 @@
;; Create frame-local faces
(dolist (frame (frame-list))
(face-spec-set-2 face frame value)
- (when (memq (window-system frame) '(x w32 mac))
+ (when (memq (window-system frame) '(x w32 mac ns))
(setq have-window-system t)))
;; When making a face after frames already exist
(if have-window-system
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 9f7d25d7502..e7ade431181 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -142,7 +142,7 @@ Valid symbols are `truncation', `wrap', `escape', `control',
"Display character C as character SC in the g1 character set.
This function assumes that your terminal uses the SO/SI characters;
it is meaningless for an X frame."
- (if (memq window-system '(x w32 mac))
+ (if (memq window-system '(x w32 mac ns))
(error "Cannot use string glyphs in a windowing system"))
(or standard-display-table
(setq standard-display-table (make-display-table)))
@@ -154,7 +154,7 @@ it is meaningless for an X frame."
"Display character C as character GC in graphics character set.
This function assumes VT100-compatible escapes; it is meaningless for an
X frame."
- (if (memq window-system '(x w32 mac))
+ (if (memq window-system '(x w32 mac ns))
(error "Cannot use string glyphs in a windowing system"))
(or standard-display-table
(setq standard-display-table (make-display-table)))
@@ -243,7 +243,7 @@ for users who call this function in `.emacs'."
(equal (aref standard-display-table 161) [161])))
(progn
(standard-display-default 160 255)
- (unless (or (memq window-system '(x w32 mac)))
+ (unless (or (memq window-system '(x w32 mac ns)))
(and (terminal-coding-system)
(set-terminal-coding-system nil))))
@@ -255,7 +255,7 @@ for users who call this function in `.emacs'."
;; unless some other has been specified.
(if (equal current-language-environment "English")
(set-language-environment "latin-1"))
- (unless (or noninteractive (memq window-system '(x w32 mac)))
+ (unless (or noninteractive (memq window-system '(x w32 mac ns)))
;; Send those codes literally to a character-based terminal.
;; If we are using single-byte characters,
;; it doesn't matter which coding system we use.
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index e4db4701828..d5e63dd9983 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -52,14 +52,6 @@
(require 'viper-init)
-;; A fix for NeXT Step
-;; Should go away, when NS people fix the design flaw, which leaves the
-;; two x-* functions undefined.
-(if (and (not (fboundp 'x-display-color-p)) (fboundp 'ns-display-color-p))
- (fset 'x-display-color-p (symbol-function 'ns-display-color-p)))
-(if (and (not (fboundp 'x-color-defined-p)) (fboundp 'ns-color-defined-p))
- (fset 'x-color-defined-p (symbol-function 'ns-color-defined-p)))
-
(defalias 'viper-overlay-p
(if (featurep 'xemacs) 'extentp 'overlayp))
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 39d518cf52d..a6d83f949f6 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -460,10 +460,11 @@ These special properties include `invisible', `intangible' and `read-only'."
(defun facemenu-read-color (&optional prompt)
"Read a color using the minibuffer."
(let* ((completion-ignore-case t)
+ (require-match (not (eq window-system 'ns)))
(col (completing-read (or prompt "Color: ")
(or facemenu-color-alist
(defined-colors))
- nil t)))
+ nil require-match)))
(if (equal "" col)
nil
col)))
diff --git a/lisp/faces.el b/lisp/faces.el
index 5d80b9319d0..a12a87eef51 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -338,7 +338,7 @@ specifies an invalid attribute."
(defun set-face-attributes-from-resources (face frame)
"Set attributes of FACE from X resources for FRAME."
- (when (memq (framep frame) '(x w32 mac))
+ (when (memq (framep frame) '(x w32 mac ns))
(dolist (definition face-x-resources)
(let ((attribute (car definition)))
(dolist (entry (cdr definition))
@@ -1010,7 +1010,7 @@ an integer value."
((:height)
'integerp)
(:stipple
- (and (memq (window-system frame) '(x w32 mac))
+ (and (memq (window-system frame) '(x w32 mac ns))
(mapcar #'list
(apply #'nconc
(mapcar (lambda (dir)
@@ -1129,7 +1129,7 @@ of a global face. Value is the new attribute value."
;; explicitly in VALID, using color approximation code
;; in tty-colors.el.
(when (and (memq attribute '(:foreground :background))
- (not (memq (window-system frame) '(x w32 mac)))
+ (not (memq (window-system frame) '(x w32 mac ns)))
(not (member new-value
'("unspecified"
"unspecified-fg" "unspecified-bg"))))
@@ -1624,7 +1624,7 @@ The argument FRAME specifies which frame to try.
The value may be different for frames on different display types.
If FRAME doesn't support colors, the value is nil.
If FRAME is nil, that stands for the selected frame."
- (if (memq (framep (or frame (selected-frame))) '(x w32 mac))
+ (if (memq (framep (or frame (selected-frame))) '(x w32 mac ns))
(xw-defined-colors frame)
(mapcar 'car (tty-color-alist frame))))
(defalias 'x-defined-colors 'defined-colors)
@@ -1638,7 +1638,7 @@ If COLOR is the symbol `unspecified' or one of the strings
\"unspecified-fg\" or \"unspecified-bg\", the value is nil."
(if (member color '(unspecified "unspecified-bg" "unspecified-fg"))
nil
- (if (member (framep (or frame (selected-frame))) '(x w32 mac))
+ (if (member (framep (or frame (selected-frame))) '(x w32 mac ns))
(xw-color-defined-p color frame)
(numberp (tty-color-translate color frame)))))
(defalias 'x-color-defined-p 'color-defined-p)
@@ -1656,7 +1656,7 @@ If COLOR is the symbol `unspecified' or one of the strings
\"unspecified-fg\" or \"unspecified-bg\", the value is nil."
(if (member color '(unspecified "unspecified-fg" "unspecified-bg"))
nil
- (if (memq (framep (or frame (selected-frame))) '(x w32 mac))
+ (if (memq (framep (or frame (selected-frame))) '(x w32 mac ns))
(xw-color-values color frame)
(tty-color-values color frame))))
(defalias 'x-color-values 'color-values)
@@ -1668,7 +1668,7 @@ If COLOR is the symbol `unspecified' or one of the strings
The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be either a frame or a display name (a string).
If omitted or nil, that stands for the selected frame's display."
- (if (memq (framep-on-display display) '(x w32 mac))
+ (if (memq (framep-on-display display) '(x w32 mac ns))
(xw-display-color-p display)
(tty-display-color-p display)))
(defalias 'x-display-color-p 'display-color-p)
@@ -1679,7 +1679,7 @@ If omitted or nil, that stands for the selected frame's display."
"Return non-nil if frames on DISPLAY can display shades of gray."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 mac))
+ ((memq frame-type '(x w32 mac ns))
(x-display-grayscale-p display))
(t
(> (tty-color-gray-shades display) 2)))))
@@ -2495,7 +2495,7 @@ Note: Other faces cannot inherit from the cursor face."
'((default
:box (:line-width 1 :style released-button)
:foreground "black")
- (((type x w32 mac) (class color))
+ (((type x w32 mac ns) (class color))
:background "grey75")
(((type x) (class mono))
:background "grey"))
diff --git a/lisp/frame.el b/lisp/frame.el
index 6e0d5f359eb..1a91ba306a2 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -610,12 +610,19 @@ is not considered (see `next-frame')."
"Make a frame on X display DISPLAY.
The optional second argument PARAMETERS specifies additional frame parameters."
(interactive "sMake frame on display: ")
- (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
- (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
- (when (and (boundp 'x-initialized) (not x-initialized))
- (setq x-display-name display)
- (x-initialize-window-system))
- (make-frame `((window-system . x) (display . ,display) . ,parameters)))
+ (if (featurep 'ns-windowing)
+ (progn
+ (when (and (boundp 'ns-initialized) (not ns-initialized))
+ (setq ns-display-name display)
+ (ns-initialize-window-system))
+ (make-frame `((window-system . ns) (display . ,display) . ,parameters)))
+ (progn
+ (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
+ (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
+ (when (and (boundp 'x-initialized) (not x-initialized))
+ (setq x-display-name display)
+ (x-initialize-window-system))
+ (make-frame `((window-system . x) (display . ,display) . ,parameters)))))
(defun make-frame-on-tty (tty type &optional parameters)
"Make a frame on terminal device TTY.
@@ -835,7 +842,7 @@ the user during startup."
(select-frame frame)
(raise-frame frame)
;; Ensure, if possible, that frame gets input focus.
- (when (memq (window-system frame) '(x mac w32))
+ (when (memq (window-system frame) '(x mac w32 ns))
(x-focus-frame frame))
(when focus-follows-mouse
(set-mouse-position (selected-frame) (1- (frame-width)) 0)))
@@ -880,7 +887,7 @@ Calls `suspend-emacs' if invoked from the controlling tty device,
(interactive)
(let ((type (framep (selected-frame))))
(cond
- ((memq type '(x w32)) (iconify-or-deiconify-frame))
+ ((memq type '(x ns w32)) (iconify-or-deiconify-frame))
((eq type t)
(if (controlling-tty-p)
(suspend-emacs)
@@ -920,7 +927,7 @@ If there is no frame by that name, signal an error."
(raise-frame frame)
(select-frame frame)
;; Ensure, if possible, that frame gets input focus.
- (cond ((memq (window-system frame) '(x w32))
+ (cond ((memq (window-system frame) '(x w32 ns))
(x-focus-frame frame)))
(when focus-follows-mouse
(set-mouse-position frame (1- (frame-width frame)) 0))))
@@ -1157,8 +1164,8 @@ frame's display)."
((eq system-type 'windows-nt)
(with-no-warnings
(> w32-num-mouse-buttons 0)))
- ((memq frame-type '(x mac))
- t) ;; We assume X and Mac *always* have a pointing device
+ ((memq frame-type '(x mac ns))
+ t) ;; We assume X, Mac, NeXTstep *always* have a pointing device
(t
(or (and (featurep 'xt-mouse)
xterm-mouse-mode)
@@ -1173,7 +1180,7 @@ frame's display).
Support for popup menus requires that the mouse be available."
(and
(let ((frame-type (framep-on-display display)))
- (memq frame-type '(x w32 pc mac)))
+ (memq frame-type '(x w32 pc mac ns)))
(display-mouse-p display)))
(defun display-graphic-p (&optional display)
@@ -1183,7 +1190,7 @@ frames and several different fonts at once. This is true for displays
that use a window system such as X, and false for text-only terminals.
DISPLAY can be a display name, a frame, or nil (meaning the selected
frame's display)."
- (not (null (memq (framep-on-display display) '(x w32 mac)))))
+ (not (null (memq (framep-on-display display) '(x w32 mac ns)))))
(defun display-images-p (&optional display)
"Return non-nil if DISPLAY can display images.
@@ -1211,7 +1218,7 @@ frame's display)."
;; the Windows' DOS Box.
(with-no-warnings
(not (null dos-windows-version))))
- ((memq frame-type '(x w32 mac))
+ ((memq frame-type '(x w32 mac ns))
t) ;; FIXME?
(t
nil))))
@@ -1222,7 +1229,7 @@ frame's display)."
"Return the number of screens associated with DISPLAY."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 mac))
+ ((memq frame-type '(x w32 mac ns))
(x-display-screens display))
(t
1))))
@@ -1234,7 +1241,7 @@ frame's display)."
For character terminals, each character counts as a single pixel."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 mac))
+ ((memq frame-type '(x w32 mac ns))
(x-display-pixel-height display))
(t
(frame-height (if (framep display) display (selected-frame)))))))
@@ -1246,7 +1253,7 @@ For character terminals, each character counts as a single pixel."
For character terminals, each character counts as a single pixel."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 mac))
+ ((memq frame-type '(x w32 mac ns))
(x-display-pixel-width display))
(t
(frame-width (if (framep display) display (selected-frame)))))))
@@ -1275,7 +1282,7 @@ displays not explicitely specified."
"Return the height of DISPLAY's screen in millimeters.
System values can be overridden by `display-mm-dimensions-alist'.
If the information is unavailable, value is nil."
- (and (memq (framep-on-display display) '(x w32 mac))
+ (and (memq (framep-on-display display) '(x w32 mac ns))
(or (cddr (assoc (or display (frame-parameter nil 'display))
display-mm-dimensions-alist))
(cddr (assoc t display-mm-dimensions-alist))
@@ -1287,7 +1294,7 @@ If the information is unavailable, value is nil."
"Return the width of DISPLAY's screen in millimeters.
System values can be overridden by `display-mm-dimensions-alist'.
If the information is unavailable, value is nil."
- (and (memq (framep-on-display display) '(x w32 mac))
+ (and (memq (framep-on-display display) '(x w32 mac ns))
(or (cadr (assoc (or display (frame-parameter nil 'display))
display-mm-dimensions-alist))
(cadr (assoc t display-mm-dimensions-alist))
@@ -1301,7 +1308,7 @@ The value may be `always', `when-mapped', `not-useful', or nil if
the question is inapplicable to a certain kind of display."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 mac))
+ ((memq frame-type '(x w32 mac ns))
(x-display-backing-store display))
(t
'not-useful))))
@@ -1312,7 +1319,7 @@ the question is inapplicable to a certain kind of display."
"Return non-nil if DISPLAY's screen supports the SaveUnder feature."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 mac))
+ ((memq frame-type '(x w32 mac ns))
(x-display-save-under display))
(t
'not-useful))))
@@ -1323,7 +1330,7 @@ the question is inapplicable to a certain kind of display."
"Return the number of planes supported by DISPLAY."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 mac))
+ ((memq frame-type '(x w32 mac ns))
(x-display-planes display))
((eq frame-type 'pc)
4)
@@ -1336,7 +1343,7 @@ the question is inapplicable to a certain kind of display."
"Return the number of color cells supported by DISPLAY."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 mac))
+ ((memq frame-type '(x w32 mac ns))
(x-display-color-cells display))
((eq frame-type 'pc)
16)
@@ -1351,7 +1358,7 @@ The value is one of the symbols `static-gray', `gray-scale',
`static-color', `pseudo-color', `true-color', or `direct-color'."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 mac))
+ ((memq frame-type '(x w32 mac ns))
(x-display-visual-class display))
((and (memq frame-type '(pc t))
(tty-display-color-p display))
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 8d86c36dbe9..66a7e342614 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1612,7 +1612,9 @@ CHOICE is a list of the choice char and help message at IDX."
(cond ((memq window-system '(x mac))
(x-focus-frame frame))
((eq window-system 'w32)
- (w32-focus-frame frame)))
+ (w32-focus-frame frame))
+ ((eq window-system 'ns)
+ (ns-focus-frame frame)))
(when focus-follows-mouse
(set-mouse-position frame (1- (frame-width frame)) 0)))))
diff --git a/lisp/info.el b/lisp/info.el
index 4ebb601d27a..f07d0890933 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -3893,7 +3893,7 @@ the variable `Info-file-list-for-emacs'."
;; This is a serious problem for trying to handle multiple
;; frame types at once. We want this text to be invisible
;; on frames that can display the font above.
- (when (memq (framep (selected-frame)) '(x pc w32 mac))
+ (when (memq (framep (selected-frame)) '(x pc w32 mac ns))
(add-text-properties (1- (match-beginning 2)) (match-end 2)
'(invisible t front-sticky nil rear-nonsticky t)))))
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 63aa2c448a1..e0220a87d6f 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -148,7 +148,7 @@
t)
(define-key-after set-coding-system-map [set-terminal-coding-system]
'(menu-item "For Terminal" set-terminal-coding-system
- :enable (null (memq initial-window-system '(x w32 mac)))
+ :enable (null (memq initial-window-system '(x w32 mac ns)))
:help "How to encode terminal output")
t)
(define-key-after set-coding-system-map [separator-3]
diff --git a/lisp/loadup.el b/lisp/loadup.el
index eb51d10ee9e..bd4d08b0449 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -212,6 +212,11 @@
(if (featurep 'mac-carbon)
(progn
(load "term/mac-win")))
+(if (featurep 'ns-windowing)
+ (progn
+ (load "emacs-lisp/easymenu") ;; for platform-related menu adjustments
+ (load "emacs-lisp/easy-mmode")
+ (load "term/ns-win")))
(if (fboundp 'atan) ; preload some constants and
(progn ; floating pt. functions if we have float support.
(load "emacs-lisp/float-sup")))
diff --git a/lisp/mouse.el b/lisp/mouse.el
index ffdfb86dac2..6a296e702a2 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -673,7 +673,7 @@ This should be bound to a mouse drag event."
;; If mark is highlighted, no need to bounce the cursor.
;; On X, we highlight while dragging, thus once again no need to bounce.
(or transient-mark-mode
- (memq (framep (selected-frame)) '(x pc w32 mac))
+ (memq (framep (selected-frame)) '(x pc w32 mac ns))
(sit-for 1))
(push-mark)
(set-mark (point))
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 75d6a44ccba..e51b2d9dc78 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -58,7 +58,7 @@
"22.1")
(defcustom mouse-wheel-down-event
;; In the latest versions of XEmacs, we could just use mouse-%s as well.
- (if (memq window-system '(w32 mac))
+ (if (memq window-system '(w32 mac ns))
'wheel-up
(intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
mouse-wheel-down-button)))
@@ -73,7 +73,7 @@
"22.1")
(defcustom mouse-wheel-up-event
;; In the latest versions of XEmacs, we could just use mouse-%s as well.
- (if (memq window-system '(w32 mac))
+ (if (memq window-system '(w32 mac ns))
'wheel-down
(intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
mouse-wheel-up-button)))
diff --git a/lisp/ns-carbon-compat.el b/lisp/ns-carbon-compat.el
new file mode 100644
index 00000000000..b4565248a4d
--- /dev/null
+++ b/lisp/ns-carbon-compat.el
@@ -0,0 +1,37 @@
+;;; ns-carbon-compat.el ---
+;;; Carbon compatibility layer for Mac users of NS (Cocoa) GUI.
+;;; Copyright (C) 2008 Free Software Foundation, Inc.
+
+;;; Author: Adrian Robert
+;;; Keywords: Carbon, MacOSX
+
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING. If not, write to
+;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; ns-carbon-compat.el: this file is loaded from termp/ns-win.el when
+;; run on a Mac OS X system. It sets up a number of aliases and other
+;; layers to enable human and machine users (Mac distributions of GNU Emacs)
+;; to pretend they are using the Choi/Mitsuharu Carbon port.
+
+;;; Code:
+
+(defvaralias 'mac-allow-anti-aliasing 'ns-antialias-text)
+(defvaralias 'mac-command-modifier 'ns-command-modifier)
+(defvaralias 'mac-control-modifier 'ns-control-modifier)
+(defvaralias 'mac-option-modifier 'ns-option-modifier)
+(defvaralias 'mac-function-modifier 'ns-function-modifier)
diff --git a/lisp/ns-grabenv.el b/lisp/ns-grabenv.el
new file mode 100644
index 00000000000..c9cea0ed9d9
--- /dev/null
+++ b/lisp/ns-grabenv.el
@@ -0,0 +1,67 @@
+;;; ns-grabenv.el --- functions to set environment variables by running a subshell
+;;; Copyright (C) 1993, 1994, 2005, 2006, 2008 Free Software Foundation, Inc.
+
+;;; Author: Carl Edman, Christian Limpach, Scott Bender, Christophe de Dinechin,
+;;; Adrian Robert
+;;; Keywords: terminals
+
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING. If not, write to
+;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;; Boston, MA 02110-1301, USA.
+
+;;; Idea based on NS 4.2 distribution, this version of code based on
+;;; mac-read-environment-vars-from-shell () by David Reitter in Aquamacs dist..
+
+
+;; utility function
+(defun ns-make-command-string (cmdlist)
+ (let ((str "")
+ (cmds cmdlist))
+ (while cmds
+ (if (not (eq str "")) (setq str (format "%s ; " str)))
+ (setq str (format "%s%s" str (car cmds)))
+ (setq cmds (cdr cmds)))
+ str))
+
+
+;;;###autoload
+(defun ns-grabenv (&optional shell-path &optional startup)
+ "Run a shell subprocess, and interpret its output as a series of environment\n\
+variables to insert into the emacs environment. The first optional argument\n\
+gives the path to the shell (defaults to the current setting of\n\
+shell-file-name). The remaining arguments are interpreted as a list of\n\
+commands for it to execute (defaults to \"printenv\")."
+ (interactive)
+ (with-temp-buffer
+ (let ((shell-file-name (if shell-path shell-path shell-file-name))
+ (cmd (ns-make-command-string (if startup startup '("printenv")))))
+ (shell-command cmd t)
+ (while (search-forward-regexp "^\\([A-Za-z_0-9]+\\)=\\(.*\\)$" nil t)
+ (setenv (match-string 1)
+ (if (equal (match-string 1) "PATH")
+ (concat (getenv "PATH") ":" (match-string 2))
+ (match-string 2)))))))
+
+(provide 'ns-grabenv)
+
+;;; ns-grabenv.el ends here
+
+; (autoload (quote ns-grabenv) "ns-grabenv" "\
+; Run a shell subprocess, and interpret its output as a series of environment
+; variables to insert into the emacs environment. The first optional argument
+; gives the path to the shell (defaults to the current setting of
+; shell-file-name). The remaining arguments are interpreted as a list of
+; commands for it to execute (defaults to \"printenv\")." nil nil)
diff --git a/lisp/simple.el b/lisp/simple.el
index 56371ac25e1..c7622954037 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5984,7 +5984,7 @@ See also `normal-erase-is-backspace'."
(set-terminal-parameter nil 'normal-erase-is-backspace
(if enabled 1 0))
- (cond ((or (memq window-system '(x w32 mac pc))
+ (cond ((or (memq window-system '(x w32 mac ns pc))
(memq system-type '(ms-dos windows-nt)))
(let* ((bindings
`(([C-delete] [C-backspace])
diff --git a/lisp/startup.el b/lisp/startup.el
index 3b509b57c6f..33ad8a586cb 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -182,6 +182,72 @@ FRAME-PARAM (optional) is the frame parameter this option specifies,
and VALUE is the value which is given to that frame parameter
\(most options use the argument for this, so VALUE is not present).")
+(defconst command-line-ns-option-alist
+ '(("-NSAutoLaunch" 1 ns-ignore-1-arg)
+ ("-NXAutoLaunch" 1 ns-ignore-1-arg)
+ ("-macosx" 0 ns-ignore-0-arg)
+ ("-NSHost" 1 ns-ignore-1-arg)
+ ("-_NSMachLaunch" 1 ns-ignore-1-arg)
+ ("-MachLaunch" 1 ns-ignore-1-arg)
+ ("-NXOpen" 1 ns-ignore-1-arg)
+ ("-NSOpen" 1 ns-handle-nxopen)
+ ("-NXOpenTemp" 1 ns-ignore-1-arg)
+ ("-NSOpenTemp" 1 ns-handle-nxopentemp)
+ ("-GSFilePath" 1 ns-handle-nxopen)
+ ;;("-bw" . x-handle-numeric-switch)
+ ;;("-d" . x-handle-display)
+ ;;("-display" . x-handle-display)
+ ("-name" 1 ns-handle-name-switch)
+ ("-title" 1 ns-handle-switch title)
+ ("-T" 1 ns-handle-switch title)
+ ("-r" 0 ns-handle-switch reverse t)
+ ("-rv" 0 ns-handle-switch reverse t)
+ ("-reverse" 0 ns-handle-switch reverse t)
+ ("-fn" 1 ns-handle-switch font)
+ ("-font" 1 ns-handle-switch font)
+ ("-ib" 1 ns-handle-numeric-switch internal-border-width)
+ ;;("-g" . x-handle-geometry)
+ ;;("-geometry" . x-handle-geometry)
+ ("-fg" 1 ns-handle-switch foreground-color)
+ ("-foreground" 1 ns-handle-switch foreground-color)
+ ("-bg" 1 ns-handle-switch background-color)
+ ("-background" 1 ns-handle-switch background-color)
+; ("-ms" 1 ns-handle-switch mouse-color)
+ ("-itype" 0 ns-handle-switch icon-type t)
+ ("-i" 0 ns-handle-switch icon-type t)
+ ("-iconic" 0 ns-handle-iconic icon-type t)
+ ;;("-xrm" . x-handle-xrm-switch)
+ ("-cr" 1 ns-handle-switch cursor-color)
+ ("-vb" 0 ns-handle-switch vertical-scroll-bars t)
+ ("-hb" 0 ns-handle-switch horizontal-scroll-bars t)
+ ("-bd" 1 ns-handle-switch)
+ ;; ("--border-width" 1 ns-handle-numeric-switch border-width)
+ ;; ("--display" 1 ns-handle-display)
+ ("--name" 1 ns-handle-name-switch)
+ ("--title" 1 ns-handle-switch title)
+ ("--reverse-video" 0 ns-handle-switch reverse t)
+ ("--font" 1 ns-handle-switch font)
+ ("--internal-border" 1 ns-handle-numeric-switch internal-border-width)
+ ;; ("--geometry" 1 ns-handle-geometry)
+ ("--foreground-color" 1 ns-handle-switch foreground-color)
+ ("--background-color" 1 ns-handle-switch background-color)
+ ("--mouse-color" 1 ns-handle-switch mouse-color)
+ ("--icon-type" 0 ns-handle-switch icon-type t)
+ ("--iconic" 0 ns-handle-iconic)
+ ;; ("--xrm" 1 ns-handle-xrm-switch)
+ ("--cursor-color" 1 ns-handle-switch cursor-color)
+ ("--vertical-scroll-bars" 0 ns-handle-switch vertical-scroll-bars t)
+ ("--border-color" 1 ns-handle-switch border-width))
+ "Alist of NS options.
+Each element has the form
+ (NAME NUMARGS HANDLER FRAME-PARAM VALUE)
+where NAME is the option name string, NUMARGS is the number of arguments
+that the option accepts, HANDLER is a function to call to handle the option.
+FRAME-PARAM (optional) is the frame parameter this option specifies,
+and VALUE is the value which is given to that frame parameter
+\(most options use the argument for this, so VALUE is not present).")
+
+
(defvar before-init-hook nil
"Normal hook run after handling urgent options but before loading init files.")
@@ -820,7 +886,7 @@ opening the first frame (e.g. open a connection to an X server).")
;; only because all other settings of no-blinking-cursor are here.
(unless (or noninteractive
emacs-basic-display
- (and (memq window-system '(x w32 mac))
+ (and (memq window-system '(x w32 mac ns))
(not (member (x-get-resource "cursorBlink" "CursorBlink")
'("off" "false")))))
(setq no-blinking-cursor t))
@@ -2021,6 +2087,13 @@ A fancy display is used on graphic displays, normal otherwise."
(if (string-match "^--" (car tem))
(push (list (car tem)) longopts)))
+ ;; Add the long NS options to longopts.
+ (setq tem command-line-ns-option-alist)
+ (while tem
+ (if (string-match "^--" (car (car tem)))
+ (setq longopts (cons (list (car (car tem))) longopts)))
+ (setq tem (cdr tem)))
+
;; Loop, processing options.
(while command-line-args-left
(let* ((argi (car command-line-args-left))
@@ -2131,6 +2204,11 @@ A fancy display is used on graphic displays, normal otherwise."
(setq command-line-args-left
(nthcdr (nth 1 tem) command-line-args-left)))
+ ((setq tem (assoc argi command-line-ns-option-alist))
+ ;; Ignore NS-windows options and their args if not using NS.
+ (setq command-line-args-left
+ (nthcdr (nth 1 tem) command-line-args-left)))
+
((member argi '("-find-file" "-file" "-visit"))
(setq inhibit-startup-screen t)
;; An explicit option to specify visiting a file.
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
new file mode 100644
index 00000000000..e524cc56ffe
--- /dev/null
+++ b/lisp/term/ns-win.el
@@ -0,0 +1,1608 @@
+;;; ns-win.el --- lisp side of interface with
+;;; NeXT/Open/GNUstep/MacOS X window system
+;;; Copyright (C) 1993, 1994, 2005, 2006, 2008 Free Software Foundation, Inc.
+
+;;; Author: Carl Edman, Christian Limpach, Scott Bender, Christophe de Dinechin,
+;;; Adrian Robert
+;;; Keywords: terminals
+
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING. If not, write to
+;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; ns-win.el: this file is loaded from ../lisp/startup.el when it recognizes
+;; that NS windows are to be used. Command line switches are parsed and those
+;; pertaining to NS are processed and removed from the command line. The
+;; NS display is opened and hooks are set for popping up the initial window.
+
+;; startup.el will then examine startup files, and eventually call the hooks
+;; which create the first window (s).
+
+;; A number of other NS convenience functions are defined in this file,
+;; which works in close coordination with src/nsfns.m.
+
+;;; Code:
+
+
+(if (not (featurep 'ns-windowing))
+ (error "%s: Loading ns-win.el but not compiled for *Step/OS X"
+ (invocation-name)))
+
+;; Documentation-purposes only: actually loaded in loadup.el
+(require 'frame)
+(require 'mouse)
+(require 'faces)
+(require 'easymenu)
+(require 'menu-bar)
+(require 'fontset)
+
+; Not needed?
+;(require 'ispell)
+
+(defun ns-submit-bug-report ()
+ "Submit via mail a bug report on Emacs 23.0.0 for GNUstep / OS X."
+ (interactive)
+ (let ((frame-parameters (frame-parameters))
+ (server-vendor (ns-server-vendor))
+ (server-version (ns-server-version)))
+ (reporter-submit-bug-report
+ "Adrian Robert <Adrian.B.Robert@gmail.com>"
+ ;;"Christophe de Dinechin <descubes@earthlink.net>"
+ ;;"Scott Bender <emacs@harmony-ds.com>"
+ ;;"Christian Limpach <chris@nice.ch>"
+ ;;"Carl Edman <cedman@princeton.edu>"
+ (concat "Emacs for GNUstep / OS X " ns-version-string)
+ '(ns-expand-space ns-cursor-blink-rate ns-alternate-modifier
+ data-directory frame-parameters window-system window-system-version
+ server-vendor server-version system-configuration-options))))
+
+
+;;;; Command line argument handling.
+
+(defvar ns-invocation-args nil)
+(defvar ns-command-line-resources nil)
+
+;; Handler for switches of the form "-switch value" or "-switch".
+(defun ns-handle-switch (switch)
+ (let ((aelt (assoc switch command-line-ns-option-alist)))
+ (if aelt
+ (let ((param (nth 3 aelt))
+ (value (nth 4 aelt)))
+ (if value
+ (setq default-frame-alist
+ (cons (cons param value)
+ default-frame-alist))
+ (setq default-frame-alist
+ (cons (cons param
+ (car ns-invocation-args))
+ default-frame-alist)
+ ns-invocation-args (cdr ns-invocation-args)))))))
+
+;; Handler for switches of the form "-switch n"
+(defun ns-handle-numeric-switch (switch)
+ (let ((aelt (assoc switch command-line-ns-option-alist)))
+ (if aelt
+ (let ((param (nth 3 aelt)))
+ (setq default-frame-alist
+ (cons (cons param
+ (string-to-number (car ns-invocation-args)))
+ default-frame-alist)
+ ns-invocation-args
+ (cdr ns-invocation-args))))))
+
+;; Make -iconic apply only to the initial frame!
+(defun ns-handle-iconic (switch)
+ (setq initial-frame-alist
+ (cons '(visibility . icon) initial-frame-alist)))
+
+;; Handle the -name option, set the name of
+;; the initial frame.
+(defun ns-handle-name-switch (switch)
+ (or (consp ns-invocation-args)
+ (error "%s: missing argument to `%s' option" (invocation-name) switch))
+ (setq initial-frame-alist (cons (cons 'name (car ns-invocation-args))
+ initial-frame-alist)
+ ns-invocation-args (cdr ns-invocation-args)))
+
+(defun ns-handle-nxopen (switch)
+ (setq unread-command-events (append unread-command-events '(ns-open-file))
+ ns-input-file (append ns-input-file (list (car ns-invocation-args)))
+ ns-invocation-args (cdr ns-invocation-args)))
+
+(defun ns-handle-nxopentemp (switch)
+ (setq unread-command-events (append unread-command-events '(ns-open-temp-file))
+ ns-input-file (append ns-input-file (list (car ns-invocation-args)))
+ ns-invocation-args (cdr ns-invocation-args)))
+
+(defun ns-ignore-0-arg (switch)
+ )
+(defun ns-ignore-1-arg (switch)
+ (setq ns-invocation-args (cdr ns-invocation-args)))
+(defun ns-ignore-2-arg (switch)
+ (setq ns-invocation-args (cddr ns-invocation-args)))
+
+(defun ns-handle-args (args)
+ "Here the NS-related command line options in ARGS are processed,
+before the user's startup file is loaded. They are copied to
+`ns-invocation-args', from which the NS related things are extracted, first
+the switch (e.g., \"-fg\") in the following code, and possible values
+\(e.g., \"black\") in the option handler code (e.g., ns-handle-switch).
+This function returns ARGS minus the arguments that have been processed."
+ ;; We use ARGS to accumulate the args that we don't handle here, to return.
+ (setq ns-invocation-args args
+ args nil)
+ (while ns-invocation-args
+ (let* ((this-switch (car ns-invocation-args))
+ (orig-this-switch this-switch)
+ completion argval aelt handler)
+ (setq ns-invocation-args (cdr ns-invocation-args))
+ ;; Check for long options with attached arguments
+ ;; and separate out the attached option argument into argval.
+ (if (string-match "^--[^=]*=" this-switch)
+ (setq argval (substring this-switch (match-end 0))
+ this-switch (substring this-switch 0 (1- (match-end 0)))))
+ ;; Complete names of long options.
+ (if (string-match "^--" this-switch)
+ (progn
+ (setq completion (try-completion this-switch
+ command-line-ns-option-alist))
+ (if (eq completion t)
+ ;; Exact match for long option.
+ nil
+ (if (stringp completion)
+ (let ((elt (assoc completion command-line-ns-option-alist)))
+ ;; Check for abbreviated long option.
+ (or elt
+ (error "Option `%s' is ambiguous" this-switch))
+ (setq this-switch completion))))))
+ (setq aelt (assoc this-switch command-line-ns-option-alist))
+ (if aelt (setq handler (nth 2 aelt)))
+ (if handler
+ (if argval
+ (let ((ns-invocation-args
+ (cons argval ns-invocation-args)))
+ (funcall handler this-switch))
+ (funcall handler this-switch))
+ (setq args (cons orig-this-switch args)))))
+ (nreverse args))
+
+(defun x-parse-geometry (geom)
+ "Parse an NS-style geometry string STRING.
+Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
+The properties returned may include `top', `left', `height', and `width'."
+ (if (string-match "\\([0-9]+\\)\\( \\([0-9]+\\)\\( \\([0-9]+\\)\\( \\([0-9]+\\) ?\\)?\\)?\\)?"
+ geom)
+ (apply 'append
+ (list
+ (list (cons 'top (string-to-number (match-string 1 geom))))
+ (if (match-string 3 geom)
+ (list (cons 'left (string-to-number (match-string 3 geom)))))
+ (if (match-string 5 geom)
+ (list (cons 'height (string-to-number (match-string 5 geom)))))
+ (if (match-string 7 geom)
+ (list (cons 'width (string-to-number (match-string 7 geom)))))))
+ '()))
+
+
+
+;;;; Keyboard mapping.
+
+;; These tell read-char how to convert
+;; these special chars to ASCII.
+(put 'backspace 'ascii-character 127)
+(put 'delete 'ascii-character 127)
+(put 'tab 'ascii-character ?\t)
+(put 'S-tab 'ascii-character (logior 16 ?\t))
+(put 'linefeed 'ascii-character ?\n)
+(put 'clear 'ascii-character 12)
+(put 'return 'ascii-character 13)
+(put 'escape 'ascii-character ?\e)
+
+;; Map certain keypad keys into ASCII characters
+;; that people usually expect.
+(define-key function-key-map [backspace] [127])
+(define-key function-key-map [delete] [127])
+(define-key function-key-map [tab] [?\t])
+(define-key function-key-map [S-tab] [25])
+(define-key function-key-map [linefeed] [?\n])
+(define-key function-key-map [clear] [11])
+(define-key function-key-map [return] [13])
+(define-key function-key-map [escape] [?\e])
+(define-key function-key-map [M-backspace] [?\M-\d])
+(define-key function-key-map [M-delete] [?\M-\d])
+(define-key function-key-map [M-tab] [?\M-\t])
+(define-key function-key-map [M-linefeed] [?\M-\n])
+(define-key function-key-map [M-clear] [?\M-\013])
+(define-key function-key-map [M-return] [?\M-\015])
+(define-key function-key-map [M-escape] [?\M-\e])
+
+
+;; Here are some NeXTSTEP like bindings for command key sequences.
+(define-key global-map [?\s-,] 'ns-popup-prefs-panel)
+(define-key global-map [?\s-'] 'next-multiframe-window)
+(define-key global-map [?\s-`] 'other-frame)
+(define-key global-map [?\s--] 'center-line)
+(define-key global-map [?\s-:] 'ispell)
+(define-key global-map [?\s-\;] 'ispell-next)
+(define-key global-map [?\s-?] 'info)
+(define-key global-map [?\s-^] 'kill-some-buffers)
+(define-key global-map [?\s-&] 'kill-this-buffer)
+(define-key global-map [?\s-C] 'ns-popup-color-panel)
+(define-key global-map [?\s-D] 'dired)
+(define-key global-map [?\s-E] 'edit-abbrevs)
+(define-key global-map [?\s-L] 'shell-command)
+(define-key global-map [?\s-M] 'manual-entry)
+(define-key global-map [?\s-S] 'ns-write-file-using-panel)
+(define-key global-map [?\s-a] 'mark-whole-buffer)
+(define-key global-map [?\s-c] 'ns-copy-including-secondary)
+(define-key global-map [?\s-d] 'isearch-repeat-backward)
+(define-key global-map [?\s-e] 'isearch-yank-kill)
+(define-key global-map [?\s-f] 'isearch-forward)
+(define-key global-map [?\s-g] 'isearch-repeat-forward)
+(define-key global-map [?\s-h] 'ns-do-hide-emacs)
+(define-key global-map [?\s-H] 'ns-do-hide-others)
+(define-key global-map [?\s-j] 'exchange-point-and-mark)
+(define-key global-map [?\s-k] 'kill-this-buffer)
+(define-key global-map [?\s-l] 'goto-line)
+(define-key global-map [?\s-m] 'iconify-frame)
+(define-key global-map [?\s-n] 'make-frame)
+(define-key global-map [?\s-o] 'ns-open-file-using-panel)
+(define-key global-map [?\s-p] 'ns-print-buffer)
+(define-key global-map [?\s-q] 'save-buffers-kill-emacs)
+(define-key global-map [?\s-s] 'save-buffer)
+(define-key global-map [?\s-t] 'ns-popup-font-panel)
+(define-key global-map [?\s-u] 'revert-buffer)
+(define-key global-map [?\s-v] 'yank)
+(define-key global-map [?\s-w] 'delete-frame)
+(define-key global-map [?\s-x] 'kill-region)
+(define-key global-map [?\s-y] 'ns-paste-secondary)
+(define-key global-map [?\s-z] 'undo)
+(define-key global-map [?\s-|] 'shell-command-on-region)
+(define-key global-map [s-kp-bar] 'shell-command-on-region)
+; (as in Terminal.app)
+(define-key global-map [s-right] 'ns-next-frame)
+(define-key global-map [s-left] 'ns-prev-frame)
+
+(define-key global-map [home] 'beginning-of-buffer)
+(define-key global-map [end] 'end-of-buffer)
+(define-key global-map [kp-home] 'beginning-of-buffer)
+(define-key global-map [kp-end] 'end-of-buffer)
+(define-key global-map [kp-prior] 'scroll-down)
+(define-key global-map [kp-next] 'scroll-up)
+
+
+;; Special NeXTSTEP generated events are converted to function keys. Here
+;; are the bindings for them.
+(define-key global-map [ns-power-off]
+ '(lambda () (interactive) (save-buffers-kill-emacs t)))
+(define-key global-map [ns-open-file] 'ns-find-file)
+(define-key global-map [ns-open-temp-file] [ns-open-file])
+(define-key global-map [ns-drag-file] 'ns-insert-file)
+(define-key global-map [ns-drag-color] 'ns-set-foreground-at-mouse)
+(define-key global-map [S-ns-drag-color] 'ns-set-background-at-mouse)
+(define-key global-map [ns-drag-text] 'ns-insert-text)
+(define-key global-map [ns-change-font] 'ns-respond-to-change-font)
+(define-key global-map [ns-open-file-line] 'ns-open-file-select-line)
+(define-key global-map [ns-insert-working-text] 'ns-insert-working-text)
+(define-key global-map [ns-delete-working-text] 'ns-delete-working-text)
+(define-key global-map [ns-spi-service-call] 'ns-spi-service-call)
+
+
+
+;;;; Lisp niceties, most used only under ns-extended-platform-support-mode,
+;;;; defined below
+
+(autoload 'ns-grabenv "ns-grabenv" "Get environment from your shell." t nil)
+(load "ns-carbon-compat")
+
+;; alt-up/down scrolling a la Stuart.app
+;; only activated if ns-extended-platform-support is on
+(defun up-one () (interactive) (scroll-up 1))
+(defun down-one () (interactive) (scroll-down 1))
+(defun left-one () (interactive) (scroll-left 1))
+(defun right-one () (interactive) (scroll-right 1))
+
+;; Toggle some additional NS-like features that may interfere with users'
+;; expectations coming from emacs on other platforms.
+(define-minor-mode ns-extended-platform-support-mode
+ "Toggle NS extended platform support features.
+ When this mode is active (no modeline indicator):
+ - File menus is altered slightly in keeping with conventions.
+ - Meta-up, meta-down are bound to scroll window up and down one line.
+ - Meta-p, Meta-n navigate forwards and backwards in the mark ring."
+ :init-value nil
+ :global t
+ :group 'ns
+ (if ns-extended-platform-support-mode
+ (progn
+ (global-set-key [M-up] 'down-one)
+ (global-set-key [M-down] 'up-one)
+ ; These conflict w/word-left, word-right
+ ;;(global-set-key [M-left] 'left-one)
+ ;;(global-set-key [M-right] 'right-one)
+
+ (setq scroll-preserve-screen-position t)
+ (transient-mark-mode 1)
+
+ ;; Change file menu to simplify and add a couple of NS-specific items
+ (easy-menu-remove-item global-map '("menu-bar") 'file)
+ (easy-menu-add-item global-map '(menu-bar)
+ (cons "File" menu-bar-ns-file-menu) 'edit))
+ (progn
+ ; undo everything above
+ (global-unset-key [M-up])
+ (global-unset-key [M-down])
+ (setq scroll-preserve-screen-position nil)
+ (transient-mark-mode 0)
+ (easy-menu-remove-item global-map '("menu-bar") 'file)
+ (easy-menu-add-item global-map '(menu-bar)
+ (cons "File" menu-bar-file-menu) 'edit))))
+
+
+(defun x-setup-function-keys (frame)
+ "Set up function Keys for NS for given FRAME."
+ (unless (terminal-parameter frame 'x-setup-function-keys)
+ (with-selected-frame frame
+ (setq interprogram-cut-function 'ns-select-text
+ interprogram-paste-function 'ns-pasteboard-value)
+;;; (let ((map (copy-keymap x-alternatives-map)))
+;;; (set-keymap-parent map (keymap-parent local-function-key-map))
+;;; (set-keymap-parent local-function-key-map map))
+ (setq system-key-alist
+ (list
+ (cons (logior (lsh 0 16) 1) 'ns-power-off)
+ (cons (logior (lsh 0 16) 2) 'ns-open-file)
+ (cons (logior (lsh 0 16) 3) 'ns-open-temp-file)
+ (cons (logior (lsh 0 16) 4) 'ns-drag-file)
+ (cons (logior (lsh 0 16) 5) 'ns-drag-color)
+ (cons (logior (lsh 0 16) 6) 'ns-drag-text)
+ (cons (logior (lsh 0 16) 7) 'ns-change-font)
+ (cons (logior (lsh 0 16) 8) 'ns-open-file-line)
+ (cons (logior (lsh 0 16) 9) 'ns-insert-working-text)
+ (cons (logior (lsh 0 16) 10) 'ns-delete-working-text)
+ (cons (logior (lsh 0 16) 11) 'ns-spi-service-call)
+ (cons (logior (lsh 1 16) 32) 'f1)
+ (cons (logior (lsh 1 16) 33) 'f2)
+ (cons (logior (lsh 1 16) 34) 'f3)
+ (cons (logior (lsh 1 16) 35) 'f4)
+ (cons (logior (lsh 1 16) 36) 'f5)
+ (cons (logior (lsh 1 16) 37) 'f6)
+ (cons (logior (lsh 1 16) 38) 'f7)
+ (cons (logior (lsh 1 16) 39) 'f8)
+ (cons (logior (lsh 1 16) 40) 'f9)
+ (cons (logior (lsh 1 16) 41) 'f10)
+ (cons (logior (lsh 1 16) 42) 'f11)
+ (cons (logior (lsh 1 16) 43) 'f12)
+ (cons (logior (lsh 1 16) 44) 'kp-insert)
+ (cons (logior (lsh 1 16) 45) 'kp-delete)
+ (cons (logior (lsh 1 16) 46) 'kp-home)
+ (cons (logior (lsh 1 16) 47) 'kp-end)
+ (cons (logior (lsh 1 16) 48) 'kp-prior)
+ (cons (logior (lsh 1 16) 49) 'kp-next)
+ (cons (logior (lsh 1 16) 50) 'print-screen)
+ (cons (logior (lsh 1 16) 51) 'scroll-lock)
+ (cons (logior (lsh 1 16) 52) 'pause)
+ (cons (logior (lsh 1 16) 53) 'system)
+ (cons (logior (lsh 1 16) 54) 'break)
+ (cons (logior (lsh 1 16) 56) 'please-tell-carl-what-this-key-is-called-56)
+ (cons (logior (lsh 1 16) 61) 'please-tell-carl-what-this-key-is-called-61)
+ (cons (logior (lsh 1 16) 62) 'please-tell-carl-what-this-key-is-called-62)
+ (cons (logior (lsh 1 16) 63) 'please-tell-carl-what-this-key-is-called-63)
+ (cons (logior (lsh 1 16) 64) 'please-tell-carl-what-this-key-is-called-64)
+ (cons (logior (lsh 1 16) 69) 'please-tell-carl-what-this-key-is-called-69)
+ (cons (logior (lsh 1 16) 70) 'please-tell-carl-what-this-key-is-called-70)
+ (cons (logior (lsh 1 16) 71) 'please-tell-carl-what-this-key-is-called-71)
+ (cons (logior (lsh 1 16) 72) 'please-tell-carl-what-this-key-is-called-72)
+ (cons (logior (lsh 1 16) 73) 'please-tell-carl-what-this-key-is-called-73)
+ (cons (logior (lsh 2 16) 3) 'kp-enter)
+ (cons (logior (lsh 2 16) 9) 'kp-tab)
+ (cons (logior (lsh 2 16) 28) 'kp-quit)
+ (cons (logior (lsh 2 16) 35) 'kp-hash)
+ (cons (logior (lsh 2 16) 42) 'kp-multiply)
+ (cons (logior (lsh 2 16) 43) 'kp-add)
+ (cons (logior (lsh 2 16) 44) 'kp-separator)
+ (cons (logior (lsh 2 16) 45) 'kp-subtract)
+ (cons (logior (lsh 2 16) 46) 'kp-decimal)
+ (cons (logior (lsh 2 16) 47) 'kp-divide)
+ (cons (logior (lsh 2 16) 48) 'kp-0)
+ (cons (logior (lsh 2 16) 49) 'kp-1)
+ (cons (logior (lsh 2 16) 50) 'kp-2)
+ (cons (logior (lsh 2 16) 51) 'kp-3)
+ (cons (logior (lsh 2 16) 52) 'kp-4)
+ (cons (logior (lsh 2 16) 53) 'kp-5)
+ (cons (logior (lsh 2 16) 54) 'kp-6)
+ (cons (logior (lsh 2 16) 55) 'kp-7)
+ (cons (logior (lsh 2 16) 56) 'kp-8)
+ (cons (logior (lsh 2 16) 57) 'kp-9)
+ (cons (logior (lsh 2 16) 60) 'kp-less)
+ (cons (logior (lsh 2 16) 61) 'kp-equal)
+ (cons (logior (lsh 2 16) 62) 'kp-more)
+ (cons (logior (lsh 2 16) 64) 'kp-at)
+ (cons (logior (lsh 2 16) 92) 'kp-backslash)
+ (cons (logior (lsh 2 16) 96) 'kp-backtick)
+ (cons (logior (lsh 2 16) 124) 'kp-bar)
+ (cons (logior (lsh 2 16) 126) 'kp-tilde)
+ (cons (logior (lsh 2 16) 157) 'kp-mu)
+ (cons (logior (lsh 2 16) 165) 'kp-yen)
+ (cons (logior (lsh 2 16) 167) 'kp-paragraph)
+ (cons (logior (lsh 2 16) 172) 'left)
+ (cons (logior (lsh 2 16) 173) 'up)
+ (cons (logior (lsh 2 16) 174) 'right)
+ (cons (logior (lsh 2 16) 175) 'down)
+ (cons (logior (lsh 2 16) 176) 'kp-ring)
+ (cons (logior (lsh 2 16) 201) 'kp-square)
+ (cons (logior (lsh 2 16) 204) 'kp-cube)
+ (cons (logior (lsh 3 16) 8) 'backspace)
+ (cons (logior (lsh 3 16) 9) 'tab)
+ (cons (logior (lsh 3 16) 10) 'linefeed)
+ (cons (logior (lsh 3 16) 11) 'clear)
+ (cons (logior (lsh 3 16) 13) 'return)
+ (cons (logior (lsh 3 16) 18) 'pause)
+ (cons (logior (lsh 3 16) 25) 'S-tab)
+ (cons (logior (lsh 3 16) 27) 'escape)
+ (cons (logior (lsh 3 16) 127) 'delete)
+ ))
+ (set-terminal-parameter frame 'x-setup-function-keys t))))
+
+
+
+;;;; Miscellaneous mouse bindings.
+
+;;; Allow shift-clicks to work just like under NS
+(defun mouse-extend-region (event)
+ "Move point or mark so as to extend region.
+This should be bound to a mouse click event type."
+ (interactive "e")
+ (mouse-minibuffer-check event)
+ (let ((posn (event-end event)))
+ (if (not (windowp (posn-window posn)))
+ (error "Cursor not in text area of window"))
+ (select-window (posn-window posn))
+ (cond
+ ((not (numberp (posn-point posn))))
+ ((or (not mark-active) (> (abs (- (posn-point posn) (point)))
+ (abs (- (posn-point posn) (mark)))))
+ (let ((point-save (point)))
+ (unwind-protect
+ (progn
+ (goto-char (posn-point posn))
+ (push-mark nil t t)
+ (or transient-mark-mode
+ (sit-for 1)))
+ (goto-char point-save))))
+ (t
+ (goto-char (posn-point posn))))))
+
+(define-key global-map [S-mouse-1] 'mouse-extend-region)
+(global-unset-key [S-down-mouse-1])
+
+
+
+; must come after keybindings
+
+(fmakunbound 'clipboard-yank)
+(fmakunbound 'clipboard-kill-ring-save)
+(fmakunbound 'clipboard-kill-region)
+(fmakunbound 'menu-bar-enable-clipboard)
+
+;; Add a couple of menus and rearrange some others; easiest just to redo toplvl
+;; Note keymap defns must be given last-to-first
+(define-key global-map [menu-bar] (make-sparse-keymap "menu-bar"))
+
+(cond ((eq system-type 'darwin)
+ (setq menu-bar-final-items '(buffer windows services help-menu)))
+ ;; otherwise, gnustep
+ (t
+ (setq menu-bar-final-items '(buffer windows services hide-app quit)) )
+)
+
+;; add standard top-level items to GNUstep menu
+(cond ((not (eq system-type 'darwin))
+ (define-key global-map [menu-bar quit] '("Quit" . save-buffers-kill-emacs))
+ (define-key global-map [menu-bar hide-app] '("Hide" . ns-do-hide-emacs))
+))
+
+(define-key global-map [menu-bar services]
+ (cons "Services" (make-sparse-keymap "Services")))
+(define-key global-map [menu-bar windows] (make-sparse-keymap "Windows"))
+(define-key global-map [menu-bar buffer]
+ (cons "Buffers" global-buffers-menu-map))
+;; (cons "Buffers" (make-sparse-keymap "Buffers")))
+(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
+(define-key global-map [menu-bar options] (cons "Options" menu-bar-options-menu))
+(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
+(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu))
+
+;; If running under GNUstep, rename "Help" to "Info"
+(cond ((eq system-type 'darwin)
+ (define-key global-map [menu-bar help-menu]
+ (cons "Help" menu-bar-help-menu)))
+ (t
+ (let ((contents (reverse (cdr menu-bar-help-menu))))
+ (setq menu-bar-help-menu
+ (append (list 'keymap) (cdr contents) (list "Info"))))
+ (define-key global-map [menu-bar help-menu]
+ (cons "Info" menu-bar-help-menu))))
+
+
+;;;; Add to help / info menu
+(defun info-ns-emacs ()
+ "Jump to ns-emacs info item."
+ (interactive)
+ (info "ns-emacs"))
+
+(define-key menu-bar-help-menu [ns-bug-report]
+ '("Report Emacs.app bug..." . ns-submit-bug-report))
+(define-key menu-bar-help-menu [info-ns]
+ '("Emacs.app Manual" . info-ns-emacs))
+(if (not (eq system-type 'darwin))
+ ;; in OS X it's in the app menu already
+ (define-key menu-bar-help-menu [info-panel]
+ '("About Emacs..." . ns-do-emacs-info-panel)))
+
+
+;;;; File menu, replaces standard under ns-extended-platform-support
+(defvar menu-bar-ns-file-menu (make-sparse-keymap "File"))
+(define-key menu-bar-ns-file-menu [one-window]
+ '("Remove Splits" . delete-other-windows))
+(define-key menu-bar-ns-file-menu [split-window]
+ '("Split Window" . split-window-vertically))
+
+(define-key menu-bar-ns-file-menu [separator-print] '("--"))
+
+(defvar ns-ps-print-menu-map (make-sparse-keymap "Postscript Print"))
+(define-key ns-ps-print-menu-map [ps-print-region]
+ '("Region (B+W)" . ps-print-region))
+(define-key ns-ps-print-menu-map [ps-print-buffer]
+ '("Buffer (B+W)" . ps-print-buffer))
+(define-key ns-ps-print-menu-map [ps-print-region-faces]
+ '("Region" . ps-print-region-with-faces))
+(define-key ns-ps-print-menu-map [ps-print-buffer-faces]
+ '("Buffer" . ns-ps-print-buffer-with-faces))
+(define-key menu-bar-ns-file-menu [postscript-print]
+ (cons "Postscript Print" ns-ps-print-menu-map))
+
+(define-key menu-bar-ns-file-menu [print-region]
+ '("Print Region" . print-region))
+(define-key menu-bar-ns-file-menu [print-buffer]
+ '("Print Buffer" . ns-print-buffer))
+
+(define-key menu-bar-ns-file-menu [separator-save] '("--"))
+
+(define-key menu-bar-ns-file-menu [recover-session]
+ '("Recover Crashed Session" . recover-session))
+(define-key menu-bar-ns-file-menu [revert-buffer]
+ '("Revert Buffer" . revert-buffer))
+(define-key menu-bar-ns-file-menu [write-file]
+ '("Save Buffer As..." . ns-write-file-using-panel))
+(define-key menu-bar-ns-file-menu [save-buffer] '("Save Buffer" . save-buffer))
+
+(define-key menu-bar-ns-file-menu [kill-buffer]
+ '("Kill Current Buffer" . kill-this-buffer))
+(define-key menu-bar-ns-file-menu [delete-this-frame]
+ '("Close Frame" . delete-frame))
+
+(define-key menu-bar-ns-file-menu [separator-open] '("--"))
+
+(define-key menu-bar-ns-file-menu [insert-file]
+ '("Insert File..." . insert-file))
+(define-key menu-bar-ns-file-menu [dired]
+ '("Open Directory..." . ns-open-file-using-panel))
+(define-key menu-bar-ns-file-menu [open-file]
+ '("Open File..." . ns-open-file-using-panel))
+(define-key menu-bar-ns-file-menu [make-frame]
+ '("New Frame" . make-frame))
+
+
+;;;; Edit menu: Modify slightly
+
+; Substitute a Copy function that works better under X (for GNUstep)
+(easy-menu-remove-item global-map '("menu-bar" "edit") 'copy)
+(define-key-after menu-bar-edit-menu [copy]
+ '(menu-item "Copy" ns-copy-including-secondary
+ :enable mark-active
+ :help "Copy text in region between mark and current position")
+ 'cut)
+
+; Change to same precondition as select-and-paste, as we don't have
+; 'x-selection-exists-p
+(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste)
+(define-key-after menu-bar-edit-menu [paste]
+ '(menu-item "Paste" yank
+ :enable (and (cdr yank-menu) (not buffer-read-only))
+ :help "Paste (yank) text most recently cut/copied")
+ 'copy)
+
+; Change text to be more consistent with surrounding menu items 'paste', etc.
+(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste-from-menu)
+(define-key-after menu-bar-edit-menu [select-paste]
+ '(menu-item "Select and Paste" yank-menu
+ :enable (and (cdr yank-menu) (not buffer-read-only))
+ :help "Choose a string from the kill ring and paste it")
+ 'paste)
+
+; Separate undo item from cut/paste section, add spell for platform consistency
+(define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo)
+(define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill)
+
+
+;;;; Windows menu
+(defun menu-bar-select-frame ()
+ (interactive)
+ (make-frame-visible last-command-event)
+ (raise-frame last-command-event)
+ (select-frame last-command-event))
+
+(defun menu-bar-update-frames ()
+ ;; If user discards the Windows item, play along.
+ (and (lookup-key (current-global-map) [menu-bar windows])
+ (let ((frames (frame-list))
+ (frames-menu (make-sparse-keymap "Select Frame")))
+ (setcdr frames-menu
+ (nconc
+ (mapcar '(lambda (frame)
+ (nconc (list frame
+ (cdr (assq 'name (frame-parameters frame)))
+ (cons nil nil))
+ 'menu-bar-select-frame))
+ frames)
+ (cdr frames-menu)))
+ (define-key frames-menu [separator-frames] '("--"))
+ (define-key frames-menu [popup-color-panel]
+ '("Colors..." . ns-popup-color-panel))
+ (define-key frames-menu [popup-font-panel]
+ '("Font Panel..." . ns-popup-font-panel))
+ (define-key frames-menu [separator-arrange] '("--"))
+ (define-key frames-menu [arrange-all-frames]
+ '("Arrange All Frames" . ns-arrange-all-frames))
+ (define-key frames-menu [arrange-visible-frames]
+ '("Arrange Visible Frames" . ns-arrange-visible-frames))
+ ;; Don't use delete-frame as event name
+ ;; because that is a special event.
+ (define-key (current-global-map) [menu-bar windows]
+ (cons "Windows" frames-menu)))))
+
+(defun force-menu-bar-update-buffers ()
+ ;; This is a hack to get around fact that we already checked
+ ;; frame-or-buffer-changed-p and reset it, so menu-bar-update-buffers
+ ;; does not pick up any change.
+ (menu-bar-update-buffers t))
+
+(add-hook 'menu-bar-update-fab-hook 'menu-bar-update-frames)
+(add-hook 'menu-bar-update-fab-hook 'force-menu-bar-update-buffers)
+
+(defun menu-bar-update-frames-and-buffers ()
+ (if (frame-or-buffer-changed-p)
+ (run-hooks 'menu-bar-update-fab-hook)))
+
+(setq menu-bar-update-hook
+ (delq 'menu-bar-update-buffers menu-bar-update-hook))
+(add-hook 'menu-bar-update-hook 'menu-bar-update-frames-and-buffers)
+
+(menu-bar-update-frames-and-buffers)
+
+
+;; ns-arrange functions contributed
+;; by Eberhard Mandler <mandler@dbag.ulm.DaimlerBenz.COM>
+(defun ns-arrange-all-frames ()
+ "Arranges all frames according to topline"
+ (interactive)
+ (ns-arrange-frames t))
+
+(defun ns-arrange-visible-frames ()
+ "Arranges all visible frames according to topline"
+ (interactive)
+ (ns-arrange-frames nil))
+
+(defun ns-arrange-frames ( vis)
+ (let ((frame (next-frame))
+ (end-frame (selected-frame))
+ (inc-x 20) ;relative position of frames
+ (inc-y 22)
+ (x-pos 100) ;start position
+ (y-pos 40)
+ (done nil))
+ (while (not done) ;cycle through all frames
+ (if (not (or vis (eq (frame-visible-p frame) t)))
+ (setq x-pos x-pos); do nothing; true case
+ (set-frame-position frame x-pos y-pos)
+ (setq x-pos (+ x-pos inc-x))
+ (setq y-pos (+ y-pos inc-y))
+ (raise-frame frame))
+ (select-frame frame)
+ (setq frame (next-frame))
+ (setq done (equal frame end-frame)))
+ (set-frame-position end-frame x-pos y-pos)
+ (raise-frame frame)
+ (select-frame frame)))
+
+
+;;;; Services
+(defun ns-define-service (path)
+ (let ((mapping [menu-bar services])
+ (service (mapconcat 'identity path "/"))
+ (name (intern
+ (mapconcat '(lambda (s) (if (= s 32) "-" (char-to-string s)))
+ (mapconcat 'identity (cons "ns-service" path) "-")
+ ""))))
+ ;; This defines the function
+ (eval (append (list 'defun name)
+ `((arg)
+ (interactive "p")
+ (let* ((in-string (if (stringp arg) arg (if mark-active
+ (buffer-substring (region-beginning) (region-end)))))
+ (out-string (ns-perform-service (,@service) in-string)))
+ (cond
+ ((stringp arg) out-string)
+ ((and out-string (or (not in-string)
+ (not (string= in-string out-string))))
+ (if mark-active (delete-region (region-beginning) (region-end)))
+ (insert out-string)
+ (setq deactivate-mark nil)))))))
+ (cond
+ ((lookup-key global-map mapping)
+ (while (cdr path)
+ (setq mapping (vconcat mapping (list (intern (car path)))))
+ (if (not (keymapp (lookup-key global-map mapping)))
+ (define-key global-map mapping
+ (cons (car path) (make-sparse-keymap (car path)))))
+ (setq path (cdr path)))
+ (setq mapping (vconcat mapping (list (intern (car path)))))
+ (define-key global-map mapping (cons (car path) name))))
+ name))
+
+(precompute-menubar-bindings)
+
+(defun ns-spi-service-call ()
+ "Respond to a service request to Emacs.app."
+ (interactive)
+ (cond ((string-equal ns-input-spi-name "open-selection")
+ (switch-to-buffer (generate-new-buffer "*untitled*"))
+ (insert ns-input-spi-arg))
+ ((string-equal ns-input-spi-name "open-file")
+ (dnd-open-file ns-input-spi-arg nil))
+ ((string-equal ns-input-spi-name "mail-selection")
+ (compose-mail)
+ (rfc822-goto-eoh)
+ (forward-line 1)
+ (insert ns-input-spi-arg))
+ ((string-equal ns-input-spi-name "mail-to")
+ (compose-mail ns-input-spi-arg))
+ (t (error (concat "Service " ns-input-spi-name " not recognized")))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+;;;; Composed key sequence handling for NS system input methods.
+;;;; (On NS systems, input methods are provided for CJK characters,
+;;;; etc. which require multiple keystrokes, and during entry a
+;;;; partial ("working") result is typically shown in the editing window.)
+
+(defface ns-working-text-face
+ '((t :underline t))
+ "Face used to highlight working text during compose sequence insert."
+ :group 'ns)
+
+(defvar ns-working-overlay nil
+ "Overlay used to highlight working text during compose sequence insert.")
+(make-variable-buffer-local 'ns-working-overlay)
+(defvar ns-working-overlay-len 0
+ "Length of working text during compose sequence insert.")
+(make-variable-buffer-local 'ns-working-overlay-len)
+
+; Based on mac-win.el 2007/08/26 unicode-2. This will fail if called
+; from an "interactive" function.
+(defun ns-in-echo-area ()
+ "Whether, for purposes of inserting working composition text, the minibuffer
+is currently being used."
+ (or isearch-mode
+ (and cursor-in-echo-area (current-message))
+ ;; Overlay strings are not shown in some cases.
+ (get-char-property (point) 'invisible)
+ (and (not (bobp))
+ (or (and (get-char-property (point) 'display)
+ (eq (get-char-property (1- (point)) 'display)
+ (get-char-property (point) 'display)))
+ (and (get-char-property (point) 'composition)
+ (eq (get-char-property (1- (point)) 'composition)
+ (get-char-property (point) 'composition)))))))
+
+; currently not used, doesn't work because the 'interactive' here stays
+; for subinvocations
+(defun ns-insert-working-text ()
+ (interactive)
+ (if (ns-in-echo-area) (ns-echo-working-text) (ns-put-working-text)))
+
+(defun ns-put-working-text ()
+ "Insert contents of ns-working-text as UTF8 string and mark with
+ns-working-overlay. Any previously existing working text is cleared first.
+The overlay is assigned the face ns-working-text-face."
+ (interactive)
+ (if ns-working-overlay (ns-delete-working-text))
+ (let ((start (point)))
+ (insert ns-working-text)
+ (overlay-put (setq ns-working-overlay (make-overlay start (point)
+ (current-buffer) nil t))
+ 'face 'ns-working-text-face)
+ (setq ns-working-overlay-len (+ ns-working-overlay-len (- (point) start)))))
+
+(defun ns-echo-working-text ()
+ "Echo contents of ns-working-text in message display area.
+See ns-insert-working-text."
+ (if ns-working-overlay (ns-unecho-working-text))
+ (let* ((msg (current-message))
+ (msglen (length msg))
+ message-log-max)
+ (setq ns-working-overlay-len (length ns-working-text))
+ (setq msg (concat msg ns-working-text))
+ (put-text-property msglen (+ msglen ns-working-overlay-len) 'face 'ns-working-text-face msg)
+ (message "%s" msg)
+ (setq ns-working-overlay t)))
+
+(defun ns-delete-working-text()
+ "Delete working text and clear ns-working-overlay."
+ (interactive)
+ (delete-backward-char ns-working-overlay-len)
+ (setq ns-working-overlay-len 0)
+ (delete-overlay ns-working-overlay))
+
+(defun ns-unecho-working-text()
+ "Delete working text from echo area and clear ns-working-overlay."
+ (let ((msg (current-message))
+ message-log-max)
+ (setq msg (substring msg 0 (- (length msg) ns-working-overlay-len)))
+ (setq ns-working-overlay-len 0)
+ (setq ns-working-overlay nil)))
+
+
+;;;; OS X file system Unicode UTF-8 NFD (decomposed form) support
+;; Lisp code based on utf-8m.el, by Seiji Zenitani, Eiji Honjoh, and
+;; Carsten Bormann.
+(if (eq system-type 'darwin)
+ (progn
+
+ (defun ns-utf8-nfd-post-read-conversion (length)
+ "Calls ns-convert-utf8-nfd-to-nfc to compose char sequences."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point) (+ (point) length))
+ (let ((str (buffer-string)))
+ (delete-region (point-min) (point-max))
+ (insert (ns-convert-utf8-nfd-to-nfc str))
+ (- (point-max) (point-min))
+ ))))
+
+ (define-coding-system 'utf-8-nfd
+ "UTF-8 NFD (decomposed) encoding."
+ :coding-type 'utf-8
+ :mnemonic ?U
+ :charset-list '(unicode)
+ :post-read-conversion 'ns-utf8-nfd-post-read-conversion)
+ (set-file-name-coding-system 'utf-8-nfd)))
+
+;; PENDING: disable composition-based display for Indic scripts as it
+;; is not working well under NS for some reason
+(set-char-table-range composition-function-table
+ '(#x0900 . #x0DFF) nil)
+
+
+;;;; Inter-app communications support.
+
+(defun ns-insert-text ()
+ "Insert contents of ns-input-text at point."
+ (interactive)
+ (insert ns-input-text)
+ (setq ns-input-text nil))
+
+(defun ns-insert-file ()
+ "Insert contents of file ns-input-file like insert-file but with less
+prompting. If file is a directory perform a find-file on it."
+ (interactive)
+ (let ((f))
+ (setq f (car ns-input-file))
+ (setq ns-input-file (cdr ns-input-file))
+ (if (file-directory-p f)
+ (find-file f)
+ (push-mark (+ (point) (car (cdr (insert-file-contents f))))))))
+
+(defvar ns-select-overlay nil
+ "Overlay used to highlight areas in files requested by NS apps.")
+(make-variable-buffer-local 'ns-select-overlay)
+
+(defun ns-open-file-select-line ()
+ "Brings up a buffer containing file ns-input-file,\n\
+and highlights lines indicated by ns-input-line."
+ (interactive)
+ (ns-find-file)
+ (cond
+ ((and ns-input-line (buffer-modified-p))
+ (if ns-select-overlay
+ (setq ns-select-overlay (delete-overlay ns-select-overlay)))
+ (deactivate-mark)
+ (goto-line (if (consp ns-input-line)
+ (min (car ns-input-line) (cdr ns-input-line))
+ ns-input-line)))
+ (ns-input-line
+ (if (not ns-select-overlay)
+ (overlay-put (setq ns-select-overlay (make-overlay (point-min) (point-min)))
+ 'face 'highlight))
+ (let ((beg (save-excursion
+ (goto-line (if (consp ns-input-line)
+ (min (car ns-input-line) (cdr ns-input-line))
+ ns-input-line))
+ (point)))
+ (end (save-excursion
+ (goto-line (+ 1 (if (consp ns-input-line)
+ (max (car ns-input-line) (cdr ns-input-line))
+ ns-input-line)))
+ (point))))
+ (move-overlay ns-select-overlay beg end)
+ (deactivate-mark)
+ (goto-char beg)))
+ (t
+ (if ns-select-overlay
+ (setq ns-select-overlay (delete-overlay ns-select-overlay))))))
+
+(defun ns-unselect-line ()
+ "Removes any NS highlight a buffer may contain."
+ (if ns-select-overlay
+ (setq ns-select-overlay (delete-overlay ns-select-overlay))))
+
+(add-hook 'first-change-hook 'ns-unselect-line)
+
+
+
+;;;; Preferences handling.
+
+(defun get-lisp-resource (arg1 arg2)
+ (let ((res (ns-get-resource arg1 arg2)))
+ (cond
+ ((not res) 'unbound)
+ ((string-equal (upcase res) "YES") t)
+ ((string-equal (upcase res) "NO") nil)
+ (t (read res)))))
+
+(defun ns-save-preferences ()
+ "Set all the defaults."
+ (interactive)
+ ;; Global preferences
+ (ns-set-resource nil "AlternateModifier" (symbol-name ns-alternate-modifier))
+ (ns-set-resource nil "CommandModifier" (symbol-name ns-command-modifier))
+ (ns-set-resource nil "ControlModifier" (symbol-name ns-control-modifier))
+ (ns-set-resource nil "FunctionModifier" (symbol-name ns-function-modifier))
+ (ns-set-resource nil "CursorBlinkRate"
+ (if ns-cursor-blink-rate
+ (number-to-string ns-cursor-blink-rate)
+ "NO"))
+ (ns-set-resource nil "ExpandSpace"
+ (if ns-expand-space
+ (number-to-string ns-expand-space)
+ "NO"))
+ (ns-set-resource nil "GSFontAntiAlias" (if ns-antialias-text "YES" "NO"))
+ (ns-set-resource nil "UseQuickdrawSmoothing"
+ (if ns-use-qd-smoothing "YES" "NO"))
+ (ns-set-resource nil "UseSystemHighlightColor"
+ (if ns-use-system-highlight-color "YES" "NO"))
+ ;; Default frame parameters
+ (let ((p (frame-parameters)))
+ (let ((f (assq 'font p)))
+ (if f (ns-set-resource nil "Font" (ns-font-name (cdr f)))))
+ (let ((fs (assq 'fontsize p)))
+ (if fs (ns-set-resource nil "FontSize" (number-to-string (cdr fs)))))
+ (let ((fgc (assq 'foreground-color p)))
+ (if fgc (ns-set-resource nil "Foreground" (cdr fgc))))
+ (let ((bgc (assq 'background-color p)))
+ (if bgc (ns-set-resource nil "Background" (cdr bgc))))
+ (let ((cc (assq 'cursor-color p)))
+ (if cc (ns-set-resource nil "CursorColor" (cdr cc))))
+ (let ((ct (assq 'cursor-type p)))
+ (if ct (ns-set-resource nil "CursorType"
+ (if (symbolp (cdr ct)) (symbol-name (cdr ct)) (cdr ct)))))
+ (let ((under (assq 'underline p)))
+ (if under (ns-set-resource nil "Underline"
+ (cond ((eq (cdr under) t) "YES")
+ ((eq (cdr under) nil) "NO")
+ (t (cdr under))))))
+ (let ((ibw (assq 'internal-border-width p)))
+ (if ibw (ns-set-resource nil "InternalBorderWidth"
+ (number-to-string (cdr ibw)))))
+ (let ((vsb (assq 'vertical-scroll-bars p)))
+ (if vsb (ns-set-resource nil "VerticalScrollBars" (cond
+ ((eq t (cdr vsb)) "YES")
+ ((eq nil (cdr vsb)) "NO")
+ ((eq 'left (cdr vsb)) "left")
+ ((eq 'right (cdr vsb)) "right")
+ (t nil)))))
+ (let ((height (assq 'height p)))
+ (if height (ns-set-resource nil "Height"
+ (number-to-string (cdr height)))))
+ (let ((width (assq 'width p)))
+ (if width (ns-set-resource nil "Width"
+ (number-to-string (cdr width)))))
+ (let ((top (assq 'top p)))
+ (if top (ns-set-resource nil "Top"
+ (number-to-string (cdr top)))))
+ (let ((left (assq 'left p)))
+ (if left (ns-set-resource nil "Left"
+ (number-to-string (cdr left)))))
+ ;; These not fully supported
+ (let ((ar (assq 'auto-raise p)))
+ (if ar (ns-set-resource nil "AutoRaise"
+ (if (cdr ar) "YES" "NO"))))
+ (let ((al (assq 'auto-lower p)))
+ (if al (ns-set-resource nil "AutoLower"
+ (if (cdr al) "YES" "NO"))))
+ (let ((mbl (assq 'menu-bar-lines p)))
+ (if mbl (ns-set-resource nil "Menus"
+ (if (cdr mbl) "YES" "NO"))))
+ )
+ (let ((fl (face-list)))
+ (while (consp fl)
+ (or (eq 'default (car fl))
+ ;; dont save Default* since it causes all created faces to
+ ;; inherit its values. The properties of the default face
+ ;; have already been saved from the frame-parameters anyway.
+ (let* ((name (symbol-name (car fl)))
+ (font (face-font (car fl)))
+; (fontsize (face-fontsize (car fl)))
+ (foreground (face-foreground (car fl)))
+ (background (face-background (car fl)))
+ (underline (face-underline-p (car fl)))
+ (italic (face-italic-p (car fl)))
+ (bold (face-bold-p (car fl)))
+ (stipple (face-stipple (car fl))))
+; (ns-set-resource nil (concat name ".attributeFont")
+; (if font font nil))
+; (ns-set-resource nil (concat name ".attributeFontSize")
+; (if fontsize (number-to-string fontsize) nil))
+ (ns-set-resource nil (concat name ".attributeForeground")
+ (if foreground foreground nil))
+ (ns-set-resource nil (concat name ".attributeBackground")
+ (if background background nil))
+ (ns-set-resource nil (concat name ".attributeUnderline")
+ (if underline "YES" nil))
+ (ns-set-resource nil (concat name ".attributeItalic")
+ (if italic "YES" nil))
+ (ns-set-resource nil (concat name ".attributeBold")
+ (if bold "YES" nil))
+ (and stipple
+ (or (stringp stipple)
+ (setq stipple (prin1-to-string stipple))))
+ (ns-set-resource nil (concat name ".attributeStipple")
+ (if stipple stipple nil))))
+ (setq fl (cdr fl)))))
+
+;; call ns-save-preferences when menu-bar-options-save is called
+(fset 'menu-bar-options-save-orig (symbol-function 'menu-bar-options-save))
+(defun ns-save-options ()
+ (interactive)
+ (menu-bar-options-save-orig)
+ (ns-save-preferences))
+(fset 'menu-bar-options-save (symbol-function 'ns-save-options))
+
+
+;;;; File handling.
+
+(defun ns-open-file-using-panel ()
+ "Pop up open-file panel, and load the result in a buffer."
+ (interactive)
+ ; prompt dir defaultName isLoad initial
+ (setq ns-input-file (ns-read-file-name "Select File to Load" nil t nil))
+ (if ns-input-file
+ (and (setq ns-input-file (list ns-input-file)) (ns-find-file))))
+
+(defun ns-write-file-using-panel ()
+ "Pop up save-file panel, and save buffer in resulting name."
+ (interactive)
+ (let (ns-output-file)
+ ; prompt dir defaultName isLoad initial
+ (setq ns-output-file (ns-read-file-name "Save As" nil nil nil))
+ (message ns-output-file)
+ (if ns-output-file (write-file ns-output-file))))
+
+(defun ns-find-file ()
+ "Do a find-file with the ns-input-file as argument."
+ (interactive)
+ (let ((f) (file) (bufwin1) (bufwin2))
+ (setq f (file-truename (car ns-input-file)))
+ (setq ns-input-file (cdr ns-input-file))
+ (setq file (find-file-noselect f))
+ (setq bufwin1 (get-buffer-window file 'visible))
+ (setq bufwin2 (get-buffer-window "*scratch*" 'visibile))
+ (cond
+ (bufwin1
+ (select-frame (window-frame bufwin1))
+ (raise-frame (window-frame bufwin1))
+ (select-window bufwin1))
+ ((and (eq ns-pop-up-frames 'fresh) bufwin2)
+ (ns-hide-emacs 'activate)
+ (select-frame (window-frame bufwin2))
+ (raise-frame (window-frame bufwin2))
+ (select-window bufwin2)
+ (find-file f))
+ (ns-pop-up-frames
+ (ns-hide-emacs 'activate)
+ (let ((pop-up-frames t)) (pop-to-buffer file nil)))
+ (t
+ (ns-hide-emacs 'activate)
+ (find-file f)))))
+
+
+
+;;;; Frame-related functions.
+
+;; Don't show the frame name; that's redundant with NS.
+(setq-default mode-line-frame-identification '(" "))
+
+(defvar ns-pop-up-frames 'fresh
+ "* Should file opened upon request from the Workspace be opened in a new frame ?
+If t, always. If nil, never. Otherwise a new frame is opened
+unless the current buffer is a scratch buffer.")
+
+;; You say tomAYto, I say tomAHto..
+(defvaralias 'ns-option-modifier 'ns-alternate-modifier)
+
+(defun ns-do-hide-emacs ()
+ (interactive)
+ (ns-hide-emacs t))
+
+(defun ns-do-hide-others ()
+ (interactive)
+ (ns-hide-others))
+
+(defun ns-do-emacs-info-panel ()
+ (interactive)
+ (ns-emacs-info-panel))
+
+(defun ns-next-frame ()
+ "Switch to next visible frame."
+ (interactive)
+ (other-frame 1))
+(defun ns-prev-frame ()
+ "Switch to previous visible frame."
+ (interactive)
+ (other-frame -1))
+
+; If no position specified, make new frame offset by 25 from current.
+(add-hook 'before-make-frame-hook
+ '(lambda ()
+ (let ((left (cdr (assq 'left (frame-parameters))))
+ (top (cdr (assq 'top (frame-parameters)))))
+ (if (consp left) (setq left (cadr left)))
+ (if (consp top) (setq top (cadr top)))
+ (cond
+ ((or (assq 'top parameters) (assq 'left parameters)))
+ ((or (not left) (not top)))
+ (t
+ (setq parameters (cons (cons 'left (+ left 25))
+ (cons (cons 'top (+ top 25))
+ parameters))))))))
+
+; frame will be focused anyway, so select it
+(add-hook 'after-make-frame-functions 'select-frame)
+
+;;; (defun ns-win-suspend-error ()
+;;; (error "Suspending an emacs running under *Step/OS X makes no sense"))
+;;; (add-hook 'suspend-hook 'ns-win-suspend-error)
+;;; (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
+;;; global-map)
+
+;; Based on a function by David Reitter <dreitter@inf.ed.ac.uk> ;
+;; see http://lists.gnu.org/archive/html/emacs-devel/2005-09/msg00681.html .
+(defun ns-toggle-toolbar (&optional frame)
+ "Switches the tool bar on and off in frame FRAME.
+ If FRAME is nil, the change applies to the selected frame."
+ (interactive)
+ (modify-frame-parameters frame
+ (list (cons 'tool-bar-lines
+ (if (> (or (frame-parameter frame 'tool-bar-lines) 0) 0)
+ 0 1)) ))
+ (if (not tool-bar-mode) (tool-bar-mode t)))
+
+; Redefine from frame.el
+(define-minor-mode blink-cursor-mode
+ "Toggle blinking cursor mode.
+With a numeric argument, turn blinking cursor mode on if ARG is positive,
+otherwise turn it off. When blinking cursor mode is enabled, the
+cursor of the selected window blinks.
+
+Note that this command is effective only when Emacs
+displays through a window system, because then Emacs does its own
+cursor display. On a text-only terminal, this is not implemented."
+ :init-value (not (or noninteractive
+ no-blinking-cursor
+ (eq ns-cursor-blink-rate nil)))
+ :initialize 'custom-initialize-safe-default
+ :group 'cursor
+ :global t
+ (if blink-cursor-mode
+ (setq ns-cursor-blink-mode t)
+ (setq ns-cursor-blink-mode nil)))
+
+
+
+;;;; Dialog-related functions.
+
+;; Ask user for confirm before printing. Due to Kevin Rodgers.
+(defun ns-print-buffer ()
+ "Interactive front-end to `print-buffer': asks for user confirmation first."
+ (interactive)
+ (if (and (interactive-p)
+ (or (listp last-nonmenu-event)
+ (and (char-or-string-p (event-basic-type last-command-event))
+ (memq 'super (event-modifiers last-command-event)))))
+ (let ((last-nonmenu-event (if (listp last-nonmenu-event)
+ last-nonmenu-event
+ ;; fake it:
+ `(mouse-1 POSITION 1))))
+ (if (y-or-n-p (format "Print buffer %s? " (buffer-name)))
+ (print-buffer)
+ (error "Cancelled")))
+ (print-buffer)))
+
+(defun ns-yes-or-no-p (prompt)
+ "As yes-or-no-p except that NS panel always used for querying."
+ (interactive)
+ (setq last-nonmenu-event nil)
+ (yes-or-no-p prompt))
+
+
+;;;; Font support.
+
+(defalias 'x-list-fonts 'ns-list-fonts)
+;; Needed for font listing functions under both backend and normal
+(setq scalable-fonts-allowed t)
+
+;; Set to use font panel instead
+(defalias 'generate-fontset-menu 'ns-popup-font-panel)
+(defalias 'mouse-set-font 'ns-popup-font-panel)
+
+(defun ns-respond-to-change-font ()
+ "Respond to changeFont: event, expecting ns-input-font and\n\
+ns-input-fontsize of new font."
+ (interactive)
+ (modify-frame-parameters (selected-frame)
+ (list (cons 'font ns-input-font)
+ (cons 'fontsize ns-input-fontsize)))
+ (set-frame-font ns-input-font))
+
+
+;; Default fontset for Mac OS X. This is mainly here to show how a fontset
+;; can be set up manually. Ordinarily, fontsets are auto-created whenever
+;; a font is chosen by
+(defvar ns-standard-fontset-spec
+; Only some code supports this so far, so use uglier XLFD version
+; "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard,latin:Courier,han:Kai"
+"-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard,latin:-*-Courier-*-*-*-*-10-*-*-*-*-*-iso10646-1,han:-*-Kai-*-*-*-*-10-*-*-*-*-*-iso10646-1,cyrillic:-*-Trebuchet$MS-*-*-*-*-10-*-*-*-*-*-iso10646-1"
+ "String of fontset spec of the standard fontset.
+This defines a fontset consisting of the Courier and other fonts that
+come with OS X\".
+See the documentation of `create-fontset-from-fontset-spec for the format.")
+
+;; Conditional on new-fontset so bootstrapping works on non-GUI compiles
+(if (fboundp 'new-fontset)
+ (progn
+ ;; Setup the default fontset.
+ (setup-default-fontset)
+ ;; Create the standard fontset.
+ (create-fontset-from-fontset-spec ns-standard-fontset-spec t)
+))
+
+;(setq default-frame-alist (cons (cons 'font "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard") default-frame-alist))
+
+;; add some additional scripts to var we use for fontset generation
+(setq script-representative-chars
+ (cons '(kana #xff8a)
+ (cons '(symbol #x2295 #x2287 #x25a1)
+ script-representative-chars)))
+
+
+;;;; Pasteboard support.
+
+(defun ns-get-pasteboard ()
+ "Returns the value of the pasteboard."
+ (ns-get-cut-buffer-internal 'PRIMARY))
+
+(defun ns-set-pasteboard (string)
+ "Store STRING into the NS server's pasteboard."
+ ;; Check the data type of STRING.
+ (if (not (stringp string)) (error "Nonstring given to pasteboard"))
+ (ns-store-cut-buffer-internal 'PRIMARY string))
+
+;;; We keep track of the last text selected here, so we can check the
+;;; current selection against it, and avoid passing back our own text
+;;; from ns-pasteboard-value.
+(defvar ns-last-selected-text nil)
+
+;;; Put TEXT, a string, on the pasteboard.
+(defun ns-select-text (text &optional push)
+ ;; Don't send the pasteboard too much text.
+ ;; It becomes slow, and if really big it causes errors.
+ (ns-set-pasteboard text)
+ (setq ns-last-selected-text text))
+
+;;; Return the value of the current NS selection. For compatibility
+;;; with older NS applications, this checks cut buffer 0 before
+;;; retrieving the value of the primary selection.
+(defun ns-pasteboard-value ()
+ (let (text)
+
+ ;; Consult the selection, then the cut buffer. Treat empty strings
+ ;; as if they were unset.
+ (or text (setq text (ns-get-pasteboard)))
+ (if (string= text "") (setq text nil))
+
+ (cond
+ ((not text) nil)
+ ((eq text ns-last-selected-text) nil)
+ ((string= text ns-last-selected-text)
+ ;; Record the newer string, so subsequent calls can use the `eq' test.
+ (setq ns-last-selected-text text)
+ nil)
+ (t
+ (setq ns-last-selected-text text)))))
+
+(defun ns-copy-including-secondary ()
+ (interactive)
+ (call-interactively 'kill-ring-save)
+ (ns-store-cut-buffer-internal 'SECONDARY
+ (buffer-substring (point) (mark t))))
+(defun ns-paste-secondary ()
+ (interactive)
+ (insert (ns-get-cut-buffer-internal 'SECONDARY)))
+
+;; PENDING: not sure what to do here.. for now interprog- are set in
+;; init-fn-keys, and unsure whether these x- settings have an effect
+;;(setq interprogram-cut-function 'ns-select-text
+;; interprogram-paste-function 'ns-pasteboard-value)
+; these only needed if above not working
+(defalias 'x-select-text 'ns-select-text)
+(defalias 'x-cut-buffer-or-selection-value 'ns-pasteboard-value)
+(defalias 'x-disown-selection-internal 'ns-disown-selection-internal)
+(defalias 'x-get-selection-internal 'ns-get-selection-internal)
+(defalias 'x-own-selection-internal 'ns-own-selection-internal)
+
+(set-face-background 'region "ns_selection_color")
+
+
+
+;;;; Scrollbar handling.
+
+(global-set-key [vertical-scroll-bar down-mouse-1] 'ns-handle-scroll-bar-event)
+(global-unset-key [vertical-scroll-bar mouse-1])
+(global-unset-key [vertical-scroll-bar drag-mouse-1])
+
+(defun ns-scroll-bar-move (event)
+ "Scroll the frame according to an NS scroller event."
+ (interactive "e")
+ (let* ((pos (event-end event))
+ (window (nth 0 pos))
+ (scale (nth 2 pos)))
+ (save-excursion
+ (set-buffer (window-buffer window))
+ (cond
+ ((eq (car scale) (cdr scale))
+ (goto-char (point-max)))
+ ((= (car scale) 0)
+ (goto-char (point-min)))
+ (t
+ (goto-char (+ (point-min) 1
+ (scroll-bar-scale scale (- (point-max) (point-min)))))))
+ (beginning-of-line)
+ (set-window-start window (point))
+ (vertical-motion (/ (window-height window) 2) window))))
+
+(defun ns-handle-scroll-bar-event (event)
+ "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling."
+ (interactive "e")
+ (let* ((position (event-start event))
+ (bar-part (nth 4 position))
+ (window (nth 0 position))
+ (old-window (selected-window)))
+ (cond
+ ((eq bar-part 'ratio)
+ (ns-scroll-bar-move event))
+ ((eq bar-part 'handle)
+ (if (eq window (selected-window))
+ (track-mouse (ns-scroll-bar-move event))
+ ; track-mouse faster for selected window, slower for unselected
+ (ns-scroll-bar-move event)))
+ (t
+ (select-window window)
+ (cond
+ ((eq bar-part 'up)
+ (goto-char (window-start window))
+ (scroll-down 1))
+ ((eq bar-part 'above-handle)
+ (scroll-down))
+ ((eq bar-part 'below-handle)
+ (scroll-up))
+ ((eq bar-part 'down)
+ (goto-char (window-start window))
+ (scroll-up 1)))
+ (select-window old-window)))))
+
+
+;;;; Color support.
+
+(defvar x-colors (ns-list-colors)
+ "The list of colors defined in non-PANTONE color files.")
+(defvar colors x-colors
+ "The list of colors defined in non-PANTONE color files.")
+
+(defun ns-defined-colors (&optional frame)
+ "Return a list of colors supported for a particular frame.
+The argument FRAME specifies which frame to try.
+The value may be different for frames on different NS displays."
+ (or frame (setq frame (selected-frame)))
+ (let ((all-colors x-colors)
+ (this-color nil)
+ (defined-colors nil))
+ (while all-colors
+ (setq this-color (car all-colors)
+ all-colors (cdr all-colors))
+; (and (face-color-supported-p frame this-color t)
+ (setq defined-colors (cons this-color defined-colors)))
+;)
+ defined-colors))
+(defalias 'x-defined-colors 'ns-defined-colors)
+(defalias 'xw-defined-colors 'ns-defined-colors)
+
+;; Convenience and work-around for fact that set color fns now require named.
+(defun ns-set-background-alpha (alpha)
+ "Sets alpha (opacity) of background.
+Set from 0.0 (fully transparent) to 1.0 (fully opaque; default).
+Note, tranparency works better on Tiger (10.4) and higher."
+ (interactive "nSet background alpha to: ")
+ (let ((bgcolor (cdr (assq 'background-color (frame-parameters)))))
+ (set-frame-parameter (selected-frame)
+ 'background-color (ns-set-alpha bgcolor alpha))))
+
+;; Functions for color panel + drag
+(defun ns-face-at-pos (pos)
+ (let* ((frame (car pos))
+ (frame-pos (cons (cadr pos) (cddr pos)))
+ (window (window-at (car frame-pos) (cdr frame-pos) frame))
+ (window-pos (coordinates-in-window-p frame-pos window))
+ (buffer (window-buffer window))
+ (edges (window-edges window)))
+ (cond
+ ((not window-pos)
+ nil)
+ ((eq window-pos 'mode-line)
+ 'modeline)
+ ((eq window-pos 'vertical-line)
+ 'default)
+ ((consp window-pos)
+ (save-excursion
+ (set-buffer buffer)
+ (let ((p (car (compute-motion (window-start window)
+ (cons (nth 0 edges) (nth 1 edges))
+ (window-end window)
+ frame-pos
+ (- (window-width window) 1)
+ nil
+ window))))
+ (cond
+ ((eq p (window-point window))
+ 'cursor)
+ ((and mark-active (< (region-beginning) p) (< p (region-end)))
+ 'region)
+ (t
+ (let ((faces (get-char-property p 'face window)))
+ (if (consp faces) (car faces) faces)))))))
+ (t
+ nil))))
+
+(defun ns-set-foreground-at-mouse ()
+ "Set the foreground color at the mouse location to ns-input-color."
+ (interactive)
+ (let* ((pos (mouse-position))
+ (frame (car pos))
+ (face (ns-face-at-pos pos)))
+ (cond
+ ((eq face 'cursor)
+ (modify-frame-parameters frame (list (cons 'cursor-color
+ ns-input-color))))
+ ((not face)
+ (modify-frame-parameters frame (list (cons 'foreground-color
+ ns-input-color))))
+ (t
+ (set-face-foreground face ns-input-color frame)))))
+
+(defun ns-set-background-at-mouse ()
+ "Set the background color at the mouse location to ns-input-color."
+ (interactive)
+ (let* ((pos (mouse-position))
+ (frame (car pos))
+ (face (ns-face-at-pos pos)))
+ (cond
+ ((eq face 'cursor)
+ (modify-frame-parameters frame (list (cons 'cursor-color
+ ns-input-color))))
+ ((not face)
+ (modify-frame-parameters frame (list (cons 'background-color
+ ns-input-color))))
+ (t
+ (set-face-background face ns-input-color frame)))))
+
+
+
+;; Misc aliases
+(defalias 'x-display-mm-width 'ns-display-mm-width)
+(defalias 'x-display-mm-height 'ns-display-mm-height)
+(defalias 'x-display-backing-store 'ns-display-backing-store)
+(defalias 'x-display-save-under 'ns-display-save-under)
+(defalias 'x-display-visual-class 'ns-display-visual-class)
+(defalias 'x-display-screens 'ns-display-screens)
+(defalias 'x-focus-frame 'ns-focus-frame)
+
+;; Set some options to be as NS-like as possible.
+(setq frame-title-format t
+ icon-title-format t)
+
+;; Set up browser connectivity
+(setq browse-url-browser-function 'browse-url-generic)
+(cond ((eq system-type 'darwin)
+ (setq browse-url-generic-program "open"))
+ ;; otherwise, gnustep
+ (t
+ (setq browse-url-generic-program "gopen")) )
+
+
+(defvar ns-initialized nil
+ "Non-nil if NS windowing has been initialized.")
+
+;;; Do the actual NS Windows setup here; the above code just defines
+;;; functions and variables that we use now.
+(defun ns-initialize-window-system ()
+ "Initialize Emacs for NS (Cocoa / GNUstep) windowing."
+
+ ; PENDING: not needed?
+ (setq command-line-args (ns-handle-args command-line-args))
+
+ (ns-open-connection (system-name) nil t)
+
+ (let ((services (ns-list-services)))
+ (while services
+ (if (eq (caar services) 'undefined)
+ (ns-define-service (cdar services))
+ (define-key global-map (vector (caar services))
+ (ns-define-service (cdar services)))
+ )
+ (setq services (cdr services))))
+
+ (if (and (eq (get-lisp-resource nil "NXAutoLaunch") t)
+ (eq (get-lisp-resource nil "HideOnAutoLaunch") t))
+ (add-hook 'after-init-hook 'ns-do-hide-emacs))
+
+ (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1))
+ (mouse-wheel-mode 1)
+
+ (setq ns-initialized t))
+
+(add-to-list 'handle-args-function-alist '(ns . ns-handle-args))
+(add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces))
+(add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system))
+
+
+(provide 'ns-win)
+
+;;; ns-win.el ends here
diff --git a/lisp/version.el b/lisp/version.el
index 07c033f72d7..5f136a5f4e1 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -65,6 +65,8 @@ to the system configuration; look at `system-configuration' instead."
((featurep 'gtk)
(concat ", GTK+ Version " gtk-version-string))
((featurep 'x-toolkit) ", X toolkit")
+ ((featurep 'ns-windowing)
+ (format ", *Step %s" ns-version-string))
((boundp 'mac-carbon-version-string)
(concat ", Carbon Version " mac-carbon-version-string))
(t ""))
diff --git a/lisp/woman.el b/lisp/woman.el
index 685304e979c..99de62e3a3f 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -545,9 +545,11 @@ Change only via `Customization' or the function `add-hook'."
(defcustom woman-man.conf-path
(let ((path '("/usr/lib" "/etc")))
- (if (eq system-type 'windows-nt)
- (mapcar 'woman-Cyg-to-Win path)
- path))
+ (cond ((eq system-type 'windows-nt)
+ (mapcar 'woman-Cyg-to-Win path))
+ ((eq system-type 'darwin)
+ (cons "/usr/share/misc" path))
+ (t path)))
"List of dirs to search and/or files to try for man config file.
A trailing separator (`/' for UNIX etc.) on directories is
optional, and the filename is used if a directory specified is
@@ -860,7 +862,7 @@ Should begin with \\. and end with \\' and MUST NOT be optional."
(defcustom woman-use-own-frame ; window-system
(or (and (fboundp 'display-graphic-p) (display-graphic-p)) ; Emacs 21
- (memq window-system '(x w32))) ; Emacs 20
+ (memq window-system '(x w32 ns))) ; Emacs 20
"If non-nil then use a dedicated frame for displaying WoMan windows.
Only useful when run on a graphic display such as X or MS-Windows."
:type 'boolean
View Lorry Controller Status