X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/5009803bda518652cc6f4b9fba02c0aed185c2a3..0877d0dc24ee792b9b14592869ea1aa0934aee58:/lisp/term/ns-win.el diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 447d7fd253..b8baaa077c 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -1,6 +1,6 @@ -;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system +;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system -*- lexical-binding: t -*- -;; Copyright (C) 1993-1994, 2005-2011 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2005-2013 Free Software Foundation, Inc. ;; Authors: Carl Edman ;; Christian Limpach @@ -39,13 +39,11 @@ ;; this file, which works in close coordination with src/nsfns.m. ;;; Code: - +(eval-when-compile (require 'cl-lib)) (or (featurep 'ns) (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS" (invocation-name))) -(eval-when-compile (require 'cl)) ; lexical-let - ;; Documentation-purposes only: actually loaded in loadup.el. (require 'frame) (require 'mouse) @@ -65,7 +63,7 @@ ;; nsterm.m. (defvar ns-input-file) -(defun ns-handle-nxopen (switch &optional temp) +(defun ns-handle-nxopen (_switch &optional temp) (setq unread-command-events (append unread-command-events (if temp '(ns-open-temp-file) '(ns-open-file))) @@ -74,7 +72,7 @@ (defun ns-handle-nxopentemp (switch) (ns-handle-nxopen switch t)) -(defun ns-ignore-1-arg (switch) +(defun ns-ignore-1-arg (_switch) (setq x-invocation-args (cdr x-invocation-args))) (defun ns-parse-geometry (geom) @@ -150,8 +148,8 @@ The properties returned may include `top', `left', `height', and `width'." (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) +(define-key global-map [kp-prior] 'scroll-down-command) +(define-key global-map [kp-next] 'scroll-up-command) ;; Allow shift-clicks to work similarly to under Nextstep. (define-key global-map [S-mouse-1] 'mouse-save-then-kill) @@ -163,7 +161,7 @@ The properties returned may include `top', `left', `height', and `width'." (define-key global-map [ns-power-off] 'save-buffers-kill-emacs) (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-file] 'ns-find-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) @@ -201,21 +199,20 @@ The properties returned may include `top', `left', `height', and `width'." (mapconcat 'identity (cons "ns-service" path) "-"))))) ;; This defines the function. (defalias name - (lexical-let ((service service)) - (lambda (arg) - (interactive "p") - (let* ((in-string - (cond ((stringp arg) arg) - (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))))))) + (lambda (arg) + (interactive "p") + (let* ((in-string + (cond ((stringp arg) arg) + (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) @@ -451,10 +448,21 @@ Lines are highlighted according to `ns-input-line'." ;; nsterm.m (declare-function ns-read-file-name "nsfns.m" - (prompt &optional dir isLoad init)) + (prompt &optional dir mustmatch init dir_only_p)) ;;;; File handling. +(defun x-file-dialog (prompt dir default_filename mustmatch only_dir_p) +"Read file name, prompting with PROMPT in directory DIR. +Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file +selection box, if specified. If MUSTMATCH is non-nil, the returned file +or directory must exist. + +This function is only defined on NS, MS Windows, and X Windows with the +Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored. +Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories." + (ns-read-file-name prompt dir mustmatch default_filename only_dir_p)) + (defun ns-open-file-using-panel () "Pop up open-file panel, and load the result in a buffer." (interactive) @@ -492,7 +500,7 @@ unless the current buffer is a scratch buffer." command-line-default-directory))) (file (find-file-noselect f)) (bufwin1 (get-buffer-window file 'visible)) - (bufwin2 (get-buffer-window "*scratch*" 'visibile))) + (bufwin2 (get-buffer-window "*scratch*" 'visible))) (cond (bufwin1 (select-frame (window-frame bufwin1)) @@ -513,9 +521,6 @@ unless the current buffer is a scratch buffer." ;;;; Frame-related functions. -;; Don't show the frame name; that's redundant with Nextstep. -(setq-default mode-line-frame-identification '(" ")) - ;; nsterm.m (defvar ns-alternate-modifier) (defvar ns-right-alternate-modifier) @@ -569,7 +574,7 @@ unless the current buffer is a scratch buffer." parameters)))))))) ;; frame will be focused anyway, so select it -;; (if this is not done, modeline is dimmed until first interaction) +;; (if this is not done, mode line is dimmed until first interaction) (add-hook 'after-make-frame-functions 'select-frame) (defvar tool-bar-mode) @@ -628,8 +633,9 @@ This function has been overloaded in Nextstep.") `ns-input-fontsize' of new font." (interactive) (modify-frame-parameters (selected-frame) - (list (cons 'font ns-input-font) - (cons 'fontsize ns-input-fontsize))) + (list (cons 'fontsize ns-input-fontsize))) + (modify-frame-parameters (selected-frame) + (list (cons 'font ns-input-font))) (set-frame-font ns-input-font)) @@ -650,22 +656,10 @@ 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. -(when (fboundp 'new-fontset) - ;; Setup the default fontset. - (create-default-fontset) - ;; Create the standard fontset. - (condition-case err - (create-fontset-from-fontset-spec ns-standard-fontset-spec t) - (error (display-warning - 'initialization - (format "Creation of the standard fontset failed: %s" err) - :error)))) - (defvar ns-reg-to-script) ; nsfont.m ;; This maps font registries (not exposed by NS APIs for font selection) to -;; unicode scripts (which can be mapped to unicode character ranges which are). +;; Unicode scripts (which can be mapped to Unicode character ranges which are). ;; See ../international/fontset.el (setq ns-reg-to-script '(("iso8859-1" . latin) @@ -705,19 +699,24 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;;;; Pasteboard support. -(declare-function ns-get-cut-buffer-internal "nsselect.m" (buffer)) +(declare-function ns-get-selection-internal "nsselect.m" (buffer)) +(declare-function ns-store-selection-internal "nsselect.m" (buffer string)) + +(define-obsolete-function-alias 'ns-get-cut-buffer-internal + 'ns-get-selection-internal "24.1") +(define-obsolete-function-alias 'ns-store-cut-buffer-internal + 'ns-store-selection-internal "24.1") + (defun ns-get-pasteboard () "Returns the value of the pasteboard." - (ns-get-cut-buffer-internal 'CLIPBOARD)) - -(declare-function ns-store-cut-buffer-internal "nsselect.m" (buffer string)) + (ns-get-selection-internal 'CLIPBOARD)) (defun ns-set-pasteboard (string) "Store STRING into the pasteboard of the Nextstep display server." ;; Check the data type of STRING. (if (not (stringp string)) (error "Nonstring given to pasteboard")) - (ns-store-cut-buffer-internal 'CLIPBOARD string)) + (ns-store-selection-internal 'CLIPBOARD 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 @@ -745,11 +744,11 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (defun ns-copy-including-secondary () (interactive) (call-interactively 'kill-ring-save) - (ns-store-cut-buffer-internal 'SECONDARY - (buffer-substring (point) (mark t)))) + (ns-store-selection-internal 'SECONDARY + (buffer-substring (point) (mark t)))) (defun ns-paste-secondary () (interactive) - (insert (ns-get-cut-buffer-internal 'SECONDARY))) + (insert (ns-get-selection-internal 'SECONDARY))) ;;;; Scrollbar handling. @@ -824,7 +823,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ((not window-pos) nil) ((eq window-pos 'mode-line) - 'modeline) + 'mode-line) ((eq window-pos 'vertical-line) 'default) ((consp window-pos) @@ -898,10 +897,21 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; defines functions and variables that we use now. (defun ns-initialize-window-system () "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing." + (cl-assert (not ns-initialized)) ;; PENDING: not needed? (setq command-line-args (x-handle-args command-line-args)) + ;; Setup the default fontset. + (create-default-fontset) + ;; Create the standard fontset. + (condition-case err + (create-fontset-from-fontset-spec ns-standard-fontset-spec t) + (error (display-warning + 'initialization + (format "Creation of the standard fontset failed: %s" err) + :error))) + (x-open-connection (system-name) nil t) (dolist (service (ns-list-services)) @@ -922,8 +932,10 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html (ns-set-resource nil "ApplePressAndHoldEnabled" "NO") + (x-apply-session-resources) (setq ns-initialized t)) +(add-to-list 'display-format-alist '("\\`ns\\'" . ns)) (add-to-list 'handle-args-function-alist '(ns . x-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))