Merge from emacs--devo--0

Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-294

6 files changed, 119 insertions, 43 deletions

diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el
index e81f71c582f..3c648b9e6b3 100644
--- a/lisp/term/mac-win.el
+++ b/lisp/term/mac-win.el
@@ -84,6 +84,14 @@
 (defvar mac-font-panel-mode)
 (defvar mac-ts-active-input-overlay)
 (defvar x-invocation-args)
+(declare-function mac-code-convert-string "mac.c")
+(declare-function mac-coerce-ae-data "mac.c")
+(declare-function mac-resume-apple-event "macselect.c")
+;; Suppress warning when compiling on non-Mac.
+(declare-function mac-font-panel-mode "mac-win.el")
+(declare-function mac-atsu-font-face-attributes "macfns.c")
+(declare-function mac-ae-set-reply-parameter "macselect.c")
+(declare-function mac-clear-font-name-table "macfns.c")
 
 (defvar x-command-line-resources nil)
 
@@ -1058,28 +1066,31 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
 
 ;;;; Function keys
 
-(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
-                           global-map)
-
 (defun x-setup-function-keys (frame)
   "Setup Function Keys for mac."
-;; Map certain keypad keys into ASCII characters
-;; that people usually expect.
-(define-key local-function-key-map [backspace] [?\d])
-(define-key local-function-key-map [delete] [?\d])
-(define-key local-function-key-map [tab] [?\t])
-(define-key local-function-key-map [linefeed] [?\n])
-(define-key local-function-key-map [clear] [?\C-l])
-(define-key local-function-key-map [return] [?\C-m])
-(define-key local-function-key-map [escape] [?\e])
-(define-key local-function-key-map [M-backspace] [?\M-\d])
-(define-key local-function-key-map [M-delete] [?\M-\d])
-(define-key local-function-key-map [M-tab] [?\M-\t])
-(define-key local-function-key-map [M-linefeed] [?\M-\n])
-(define-key local-function-key-map [M-clear] [?\M-\C-l])
-(define-key local-function-key-map [M-return] [?\M-\C-m])
-(define-key local-function-key-map [M-escape] [?\M-\e])
-)
+  ;; Don't do this twice on the same display, or it would break
+  ;; normal-erase-is-backspace-mode.
+  (unless (terminal-parameter frame 'x-setup-function-keys)
+    (with-selected-frame frame
+      ;; Map certain keypad keys into ASCII characters
+      ;; that people usually expect.
+      (define-key local-function-key-map [backspace] [?\d])
+      (define-key local-function-key-map [delete] [?\d])
+      (define-key local-function-key-map [tab] [?\t])
+      (define-key local-function-key-map [linefeed] [?\n])
+      (define-key local-function-key-map [clear] [?\C-l])
+      (define-key local-function-key-map [return] [?\C-m])
+      (define-key local-function-key-map [escape] [?\e])
+      (define-key local-function-key-map [M-backspace] [?\M-\d])
+      (define-key local-function-key-map [M-delete] [?\M-\d])
+      (define-key local-function-key-map [M-tab] [?\M-\t])
+      (define-key local-function-key-map [M-linefeed] [?\M-\n])
+      (define-key local-function-key-map [M-clear] [?\M-\C-l])
+      (define-key local-function-key-map [M-return] [?\M-\C-m])
+      (define-key local-function-key-map [M-escape] [?\M-\e])
+      (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
+                                 local-function-key-map global-map))
+    (set-terminal-parameter frame 'x-setup-function-keys t)))
 
 ;; These tell read-char how to convert
 ;; these special chars to ASCII.
@@ -1811,6 +1822,9 @@ if possible.  If there's no such frame, a new frame is created."
       ;; Reaches here if the user has canceled the quit.
       (mac-resume-apple-event ae -128)))) ; userCanceledErr
 
+;; url-generic-parse-url is autoloaded from url-parse.
+(declare-function url-type "url-parse" t t) ; defstruct
+
 (defun mac-ae-get-url (event)
   "Open the URL specified by the Apple event EVENT.
 Currently the `mailto' scheme is supported."
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index ecbda7d9c1e..2ddb4e40433 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -29,6 +29,10 @@
 
 (load "term/internal" nil t)
 
+(declare-function msdos-remember-default-colors "msdos.c")
+(declare-function w16-set-clipboard-data "w16select.c")
+(declare-function w16-get-clipboard-data "w16select.c")
+
 ;;; This is copied from etc/rgb.txt, except that some values were changed
 ;;; a bit to make them consistent with DOS console colors, and the RGB
 ;;; values were scaled up to 16 bits, as `tty-define-color' requires.
diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el
index 70323e3155b..5622efa022d 100644
--- a/lisp/term/tty-colors.el
+++ b/lisp/term/tty-colors.el
@@ -63,7 +63,6 @@
 ;;; Code:
 
 (defvar msdos-color-values)
-(defvar w32-tty-standard-colors)
 
 ;; The following list is taken from rgb.txt distributed with X.
 ;;
@@ -816,8 +815,6 @@ Value is the modified color alist for FRAME."
   "Register the default set of colors for a character terminal."
   (let* ((colors (cond ((eq window-system 'pc)
                         msdos-color-values)
-                       ((eq system-type 'windows-nt)
-                        w32-tty-standard-colors)
                        (t tty-standard-colors)))
          (color (car colors)))
     (while colors
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index 688dd7deea8..bdaeaf1b52e 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -87,6 +87,10 @@
 (defvar xlfd-regexp-registry-subnum)
 (defvar w32-color-map) ;; defined in w32fns.c
 
+(declare-function w32-send-sys-command "w32fns.c")
+(declare-function w32-select-font "w32fns.c")
+(declare-function set-message-beep "w32console.c")
+
 ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles
 (if (fboundp 'new-fontset)
     (require 'fontset))
@@ -1053,17 +1057,6 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
  If FRAME is nil or not given, use the selected frame."
    (interactive "i")
    (w32-send-sys-command ?\xf100 frame))
-
-(defun x-setup-function-keys (frame)
-  "Setup Function Keys for w32."
-  (with-selected-frame frame
-     (define-key local-function-key-map [f10] 'menu-bar-open)
-
-     (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
-                                local-function-key-map global-map)
-
-     (define-key local-function-key-map [S-tab] [backtab]))
-  (set-terminal-parameter frame 'x-setup-function-keys t))
 
 
 ;; W32 systems have different fonts than commonly found on X, so
diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el
new file mode 100644
index 00000000000..f45d7e0ad7a
--- /dev/null
+++ b/lisp/term/w32console.el
@@ -0,0 +1,65 @@
+;;; w32console.el -- Setup w32 console keys and colors.
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: FSF
+;; 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:
+
+;;; Code:
+
+;; W32 uses different color indexes than standard:
+
+(defvar w32-tty-standard-colors
+  '(("black"          0     0     0     0)
+    ("blue"           1     0     0 52480) ; MediumBlue
+    ("green"          2  8704 35584  8704) ; ForestGreen
+    ("cyan"           3     0 52736 53504) ; DarkTurquoise
+    ("red"            4 45568  8704  8704) ; FireBrick
+    ("magenta"        5 35584     0 35584) ; DarkMagenta
+    ("brown"          6 40960 20992 11520) ; Sienna
+    ("lightgray"      7 48640 48640 48640) ; Gray
+    ("darkgray"       8 26112 26112 26112) ; Gray40
+    ("lightblue"      9     0     0 65535) ; Blue
+    ("lightgreen"    10     0 65535     0) ; Green
+    ("lightcyan"     11     0 65535 65535) ; Cyan
+    ("lightred"      12 65535     0     0) ; Red
+    ("lightmagenta"  13 65535     0 65535) ; Magenta
+    ("yellow"        14 65535 65535     0) ; Yellow
+    ("white"         15 65535 65535 65535))
+"A list of VGA console colors, their indices and 16-bit RGB values.")
+
+(defun terminal-init-w32console ()
+  "Terminal initialization function for w32 console."
+  ;; Share function key initialization with w32 gui frames
+  (x-setup-function-keys (selected-frame))
+  (let* ((colors w32-tty-standard-colors)
+         (color (car colors)))
+    (tty-color-clear)
+    (while colors
+      (tty-color-define (car color) (cadr color) (cddr color))
+      (setq colors (cdr colors)
+            color (car colors))))
+  (clear-face-cache)
+  (tty-set-up-initial-frame-faces)
+  (run-hooks 'terminal-init-w32-hook))
+
+;; arch-tag: 3195fd5e-ab86-4a46-b1dc-4f7a8c8deff3
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index eb2e559a0d1..ffd2a98c6b0 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -2576,15 +2576,18 @@ If you don't want stock icons, set the variable to nil."
 
 (defun x-gtk-map-stock (file)
   "Map icon with file name FILE to a Gtk+ stock name, using `x-gtk-stock-map'."
-  (let* ((file-sans (file-name-sans-extension file))
-         (key (and (string-match "/\\([^/]+/[^/]+/[^/]+$\\)" file-sans)
-                   (match-string 1 file-sans)))
-         (value))
-    (mapc (lambda (elem)
-            (let ((assoc (if (symbolp elem) (symbol-value elem) elem)))
-              (or value (setq value (assoc-string (or key file-sans) assoc)))))
-            icon-map-list)
-    (and value (cdr value))))
+  (if (stringp file)
+      (let* ((file-sans (file-name-sans-extension file))
+             (key (and (string-match "/\\([^/]+/[^/]+/[^/]+$\\)" file-sans)
+                       (match-string 1 file-sans)))
+             (value))
+        (mapc (lambda (elem)
+                (let ((assoc (if (symbolp elem) (symbol-value elem) elem)))
+                  (or value (setq value (assoc-string (or key file-sans)
+                                                      assoc)))))
+              icon-map-list)
+        (and value (cdr value)))
+    nil))
 
 (provide 'x-win)