[Emacs-diffs] Changes to emacs/lisp/term/ns-win.el,v

[Stefan Monnier]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Stefan Monnier <monnier>        08/07/16 20:06:14

Index: term/ns-win.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/term/ns-win.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- term/ns-win.el      16 Jul 2008 02:46:09 -0000      1.4
+++ term/ns-win.el      16 Jul 2008 20:06:14 -0000      1.5
@@ -40,6 +40,8 @@
     (error "%s: Loading ns-win.el but not compiled for *Step/OS X"
           (invocation-name)))
 
+(eval-when-compile (require 'cl))
+
 ;; Documentation-purposes only: actually loaded in loadup.el
 (require 'frame)
 (require 'mouse)
@@ -48,8 +50,8 @@
 (require 'menu-bar)
 (require 'fontset)
 
-; Not needed?
-;(require 'ispell)
+;; Not needed?
+;;(require 'ispell)
 
 ;; nsterm.m
 (defvar ns-version-string)
@@ -283,7 +285,7 @@
 (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)
+;; (as in Terminal.app)
 (define-key global-map [s-right] 'ns-next-frame)
 (define-key global-map [s-left] 'ns-prev-frame)
 
@@ -298,7 +300,7 @@
 ;; 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)))
+  (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)
@@ -344,7 +346,7 @@
       (progn
        (global-set-key [M-up] 'down-one)
        (global-set-key [M-down] 'up-one)
-       ; These conflict w/word-left, word-right
+        ;; These conflict w/word-left, word-right.
        ;;(global-set-key [M-left] 'left-one)
        ;;(global-set-key [M-right] 'right-one)
 
@@ -356,7 +358,7 @@
        (easy-menu-add-item global-map '(menu-bar)
                           (cons "File" menu-bar-ns-file-menu) 'edit))
     (progn
-     ; undo everything above
+      ;; Undo everything above.
        (global-unset-key [M-up])
        (global-unset-key [M-down])
        (setq scroll-preserve-screen-position nil)
@@ -372,9 +374,9 @@
     (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))
+      ;; (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)
@@ -505,7 +507,7 @@
 
 
 
-; must come after keybindings
+;; Must come after keybindings.
 
 (fmakunbound 'clipboard-yank)
 (fmakunbound 'clipboard-kill-ring-save)
@@ -516,18 +518,17 @@
 ;; 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
+(setq menu-bar-final-items
+      (cond ((eq system-type 'darwin)
+             '(buffer windows services help-menu))
+            ;; Otherwise, GNUstep.
       (t
-       (setq menu-bar-final-items '(buffer windows services hide-app quit)) )
-)
+             '(buffer windows services hide-app quit))))
 
-;; add standard top-level items to GNUstep menu
-(cond ((not (eq system-type 'darwin))
+;; Add standard top-level items to GNUstep menu.
+(unless (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 hide-app] '("Hide" . ns-do-hide-emacs)))
 
 (define-key global-map [menu-bar services]
   (cons "Services" (make-sparse-keymap "Services")))
@@ -623,7 +624,7 @@
 
 ;;;; Edit menu: Modify slightly
 
-; Substitute a Copy function that works better under X (for GNUstep)
+;; 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
@@ -631,8 +632,8 @@
              :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
+;; 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
@@ -640,7 +641,7 @@
              :help "Paste (yank) text most recently cut/copied")
   'copy)
 
-; Change text to be more consistent with surrounding menu items 'paste', etc.
+;; 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
@@ -648,7 +649,7 @@
              :help "Choose a string from the kill ring and paste it")
   'paste)
 
-; Separate undo item from cut/paste section, add spell for platform consistency
+;; Separate undo 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)
 
@@ -662,15 +663,14 @@
 
 (defun menu-bar-update-frames ()
   ;; If user discards the Windows item, play along.
-  (and (lookup-key (current-global-map) [menu-bar windows])
+  (when (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
+               (mapcar (lambda (frame)
+                         (list* frame
                                          (cdr (assq 'name (frame-parameters 
frame)))
-                                         (cons nil nil))
                                    'menu-bar-select-frame))
                          frames)
                  (cdr frames-menu)))
@@ -749,16 +749,19 @@
   (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)
+               (subst-char-in-string
+                ?\s ?-
+                (mapconcat 'identity (cons "ns-service" path) "-")))))
+    ;; This defines the function.
+    (defalias name
+      (lexical-let ((service service))
+        (lambda (arg)
            (interactive "p")
-           (let* ((in-string (if (stringp arg) arg (if mark-active
+          (let* ((in-string
+                  (cond ((stringp arg) arg)
+                        (mark-active
                          (buffer-substring (region-beginning) (region-end)))))
-                  (out-string (ns-perform-service (,@service) in-string)))
+                 (out-string (ns-perform-service service in-string)))
              (cond
               ((stringp arg) out-string)
               ((and out-string (or (not in-string)
@@ -823,8 +826,8 @@
   "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.
+;; 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."
@@ -840,8 +843,8 @@
                    (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
+;; 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)))
@@ -1052,7 +1055,8 @@
       (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)))))
+                              (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")
@@ -1062,11 +1066,12 @@
       (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")
+      (if vsb (ns-set-resource nil "VerticalScrollBars"
+                               (case (cdr vsb)
+                                ((t) "YES")
+                                ((nil) "NO")
+                                ((left) "left")
+                                ((right) "right")
                                        (t nil)))))
     (let ((height (assq 'height p)))
       (if height (ns-set-resource nil "Height"
@@ -1099,17 +1104,17 @@
           ;; 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)))
+                 ;; (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 ".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")
@@ -1143,7 +1148,7 @@
 (defun ns-open-file-using-panel ()
   "Pop up open-file panel, and load the result in a buffer."
   (interactive)
-  ; prompt dir defaultName isLoad initial
+  ;; 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))))
@@ -1152,7 +1157,7 @@
   "Pop up save-file panel, and save buffer in resulting name."
   (interactive)
   (let (ns-output-file)
-    ; prompt dir defaultName isLoad initial
+    ;; 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))))
@@ -1226,9 +1231,9 @@
   (interactive)
   (other-frame -1))
 
-; If no position specified, make new frame offset by 25 from current.
+;; If no position specified, make new frame offset by 25 from current.
 (add-hook 'before-make-frame-hook
-          '(lambda ()
+          (lambda ()
              (let ((left (cdr (assq 'left (frame-parameters))))
                    (top (cdr (assq 'top (frame-parameters)))))
               (if (consp left) (setq left (cadr left)))
@@ -1241,14 +1246,14 @@
                                         (cons (cons 'top (+ top 25))
                                               parameters))))))))
 
-; frame will be focused anyway, so select it
+;; 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)
+;; (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 <address@hidden> ;
 ;; see http://lists.gnu.org/archive/html/emacs-devel/2005-09/msg00681.html .
@@ -1256,15 +1261,15 @@
   "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
+  (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)))
 
 (defvar ns-cursor-blink-mode)          ; nsterm.m
 
-; Redefine from frame.el
+;; 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,
@@ -1298,7 +1303,7 @@
                      (memq 'super (event-modifiers last-command-event)))))
     (let ((last-nonmenu-event (if (listp last-nonmenu-event)
                                  last-nonmenu-event
-                               ;; fake it:
+                                  ;; Fake it:
                                `(mouse-1 POSITION 1))))
       (if (y-or-n-p (format "Print buffer %s? " (buffer-name)))
          (print-buffer)
@@ -1340,26 +1345,31 @@
 ;; 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"
+  ;; Only some code supports this so far, so use uglier XLFD version
+  ;; "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard,latin:Courier,han:Kai"
+  (mapconcat 'identity
+             '("-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
+;; 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)
-))
+      (create-fontset-from-fontset-spec ns-standard-fontset-spec t)))
 
-;(setq default-frame-alist (cons (cons 'font 
"-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard") default-frame-alist))
+;;(push (cons 'font "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard")
+;;      default-frame-alist)
 
-;; add some additional scripts to var we use for fontset generation
+;; Add some additional scripts to var we use for fontset generation.
 (setq script-representative-chars
       (cons '(kana #xff8a)
            (cons '(symbol #x2295 #x2287 #x25a1)
@@ -1382,21 +1392,21 @@
   (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.
+;; 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)
+  "Put TEXT, a string, on the pasteboard."
   ;; 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.
+;; 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)
     
@@ -1425,10 +1435,10 @@
   (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
+;; 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
+;; 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)
@@ -1478,7 +1488,7 @@
      ((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
+        ;; track-mouse faster for selected window, slower for unselected.
        (ns-scroll-bar-move event)))
      (t
       (select-window window)
@@ -1516,9 +1526,8 @@
     (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)))
-;)
+      ;; (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)
@@ -1607,7 +1616,7 @@
 
 
 
-;; Misc aliases
+;; 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)
@@ -1620,15 +1629,14 @@
 (setq frame-title-format t
       icon-title-format t)
 
-;; Set up browser connectivity
+;; Set up browser connectivity.
 (defvar browse-url-generic-program)
 
 (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")) )
+(setq browse-url-generic-program
+      (cond ((eq system-type 'darwin) "open")
+            ;; Otherwise, GNUstep.
+            (t "gopen")))
 
 
 (defvar ns-initialized nil
@@ -1639,29 +1647,27 @@
 
 (declare-function ns-list-services "nsfns.m" ())
 
-;;; Do the actual NS Windows setup here; the above code just defines
-;;; functions and variables that we use now.
+;; 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?
+  ;; 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))))
+  (dolist (service (ns-list-services))
+      (if (eq (car service) 'undefined)
+         (ns-define-service (cdr service))
+       (define-key global-map (vector (car service))
+         (ns-define-service (cdr service)))))
 
   (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))
 
+  ;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings.
   (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1))
   (mouse-wheel-mode 1)