# HG changeset patch # User Jan D. # Date 1264662373 -3600 # Node ID 1b8ee4a690a1be0949665cc7dd9ca52fffebd112 # Parent 6612625cb8e9040ba957321025be1489d64aaf5b# Parent b38ac2be4408c0a73aa3689a4a92fe34e6676479 Merge from trunk diff -r 6612625cb8e9 -r 1b8ee4a690a1 admin/notes/bugtracker --- a/admin/notes/bugtracker Mon Jan 25 08:45:12 2010 +0100 +++ b/admin/notes/bugtracker Thu Jan 28 08:06:13 2010 +0100 @@ -2,6 +2,36 @@ The Emacs Bug Tracker can be found at http://debbugs.gnu.org/ +* Quick-start guide + +This is 95% of all you will ever need. + +** How do I report a bug? +Use M-x report-emacs-bug, or send mail to bug-gnu-emacs@gnu.org. +If you want to Cc someone, use an "X-Debbugs-CC" header instead. + +** How do I comment on a bug? +Reply to a mail on the bug-gnu-emacs list in the normal way. +Or send a mail to 123@debbugs.gnu.org. + +If the bug is old and closed, you may have to unarchive it first. +Send a mail to control@debbugs.gnu.org with +unarchive 123 +on the first line of the body. + +** How do I close a bug? +Send a mail to 123-done@debbugs.gnu.org. In the body, explain +why the bug is being closed. + +** How do I set bug meta-data? +By mailing commands to control@debbugs.gnu.org. Place commands at the +start of the message body, one per line. + +severity 123 serious|important|normal|minor|wishlist +tags 123 moreinfo|unreproducible|wontfix|patch + +* More detailed information + For a list of all bugs, see http://debbugs.gnu.org/db/pa/lemacs.html This is a static page, updated once a day. There is also a dynamic list, generated on request, but since there are many bug reports this @@ -110,11 +140,7 @@ ** Not interested in tracker control messages (tags being set, etc)? Discard mails matching: -^X-Emacs-PR-Message: transcript - -When you close a bug, you get a message matching: - -^X-Emacs-PR-Message: closed +^X-Emacs-PR-Message: (transcript|closed) ** How to avoid multiple copies of mails. If you reply to reports in the normal way, this should work fine. @@ -131,6 +157,31 @@ submitter; they get copies anyway so this will just result in more duplicate mail. +** Details of closing a bug. +(For information only) +Sending a mail to 123-done does the following: + +1) Mark the bug as closed in the database. + +2) Send a mail to the original submitter telling them that their bug +has been closed. This mail has a header: + +X-Emacs-PR-Message: they-closed 123 + +3) Send a mail to you and to the emacs-bug-tracker list confirming +that the bug has been closed. This mail has a header: + +X-Emacs-PR-Message: closed 123 + +4) Send a copy of your mail to the bug-gnu-emacs list in exactly the +same way as if you had sent mail to "123" (sans -done). This mail has +headers: + +X-Emacs-PR-Message: cc-closed 123 +Mail-Followup-To: 123@debbugs.gnu.org, person-who-closed + +(This is Emacs-specific. Normally the bug list gets the same mail as in 3). + ** Setting bug parameters. There are two ways to set the parameters of bugs in the database (tags, severity level, etc). When you report a new bug, you can @@ -368,13 +419,15 @@ ** Bazaar stuff *** You can use `bzr commit --fixes emacs:123' to mark that a commit fixes -Emacs bug 123. You will first need to add a line to your bazaar.conf -(untested): +Emacs bug 123. You will first need to add a line to your bazaar.conf: bugtracker_emacs_url = http://debbugs.gnu.org/{id} Note that all this does is add some metadata to the commit, it doesn't -actually mark the bug as closed in the tracker. +actually mark the bug as closed in the tracker. There seems to be no +way to see this "metadata" with `bzr log', which is rather poor, but +it will show up as a link in a recent loggerhead installation, or with +some of the graphical frontends to bzr log. ** Gnus-specific voodoo diff -r 6612625cb8e9 -r 1b8ee4a690a1 lisp/ChangeLog --- a/lisp/ChangeLog Mon Jan 25 08:45:12 2010 +0100 +++ b/lisp/ChangeLog Thu Jan 28 08:06:13 2010 +0100 @@ -1,5 +1,44 @@ +2010-01-28 Michael Albinus + + Fix some busybox annoyances. + + * net/tramp.el (tramp-wrong-passwd-regexp): Add "Timeout, server + not responding." string. + (tramp-open-connection-setup-interactive-shell): Dump stty + settings. Enable "neveropen" arg for all `tramp-send-command' + calls. Handle "=" in variable values properly. + (tramp-find-inline-encoding): Raise an error, when no encoding is + found. + (tramp-wait-for-output): Check, whether PROC buffer is available. + Remove spurious " ^H" sequences, sent by busybox. + (tramp-get-ls-command): Suppress coloring, if possible. + +2010-01-28 Glenn Morris + + * vc-svn.el (vc-svn-update): Use "svn --non-interactive". (Bug#4280) + + * log-edit.el (log-edit-strip-single-file-name): Add missing + :safe, :group, and :version tags. + +2010-01-27 Stephen Berman + + * calendar/diary-lib.el (diary-unhide-everything): Handle narrowed + buffers. (Bug#5477) + +2010-01-27 David De La Harpe Golden + + * files.el (delete-directory): Handle moving to trash without + first doing recursion (Bug#5436). + +2010-01-26 Dan Nicolaescu + + * vc-hooks.el (vc-path): Mark as obsolete. + 2010-01-25 Dan Nicolaescu + * vc-annotate.el (vc-annotate-revision-at-line): Compare file + names too. + * vc-bzr.el (vc-bzr-print-log): Use the more compact --line option for the short log. (vc-bzr-log-view-mode): Adjust regexp for the above change. diff -r 6612625cb8e9 -r 1b8ee4a690a1 lisp/calendar/diary-lib.el --- a/lisp/calendar/diary-lib.el Mon Jan 25 08:45:12 2010 +0100 +++ b/lisp/calendar/diary-lib.el Thu Jan 28 08:06:13 2010 +0100 @@ -804,7 +804,9 @@ (defun diary-unhide-everything () "Show all invisible text in the diary." (kill-local-variable 'diary-selective-display) - (remove-overlays (point-min) (point-max) 'invisible 'diary) + (save-restriction ; bug#5477 + (widen) + (remove-overlays (point-min) (point-max) 'invisible 'diary)) (kill-local-variable 'mode-line-format)) (defvar original-date) ; bound in diary-list-entries diff -r 6612625cb8e9 -r 1b8ee4a690a1 lisp/erc/ChangeLog --- a/lisp/erc/ChangeLog Mon Jan 25 08:45:12 2010 +0100 +++ b/lisp/erc/ChangeLog Thu Jan 28 08:06:13 2010 +0100 @@ -1,3 +1,12 @@ +2010-01-25 Vivek Dasmohapatra + + * erc-backend.el (erc-session-connector): New var. + (erc-server-reconnect): Use it to reconnect via old + connector (Bug#4958). + + * erc.el (erc-determine-parameters): Save + erc-server-connect-function to erc-session-connector. + 2009-11-03 Stefan Monnier * erc.el (erc-display-line-1, erc-process-away): diff -r 6612625cb8e9 -r 1b8ee4a690a1 lisp/erc/erc-backend.el --- a/lisp/erc/erc-backend.el Mon Jan 25 08:45:12 2010 +0100 +++ b/lisp/erc/erc-backend.el Thu Jan 28 08:06:13 2010 +0100 @@ -130,6 +130,10 @@ "The server name used to connect to for this session.") (make-variable-buffer-local 'erc-session-server) +(defvar erc-session-connector nil + "The function used to connect to this session (nil for the default).") +(make-variable-buffer-local 'erc-session-connector) + (defvar erc-session-port nil "The port used to connect to.") (make-variable-buffer-local 'erc-session-port) @@ -538,8 +542,10 @@ (erc-set-active-buffer (current-buffer)) (setq erc-server-last-sent-time 0) (setq erc-server-lines-sent 0) - (erc-open erc-session-server erc-session-port erc-server-current-nick - erc-session-user-full-name t erc-session-password)))) + (let ((erc-server-connect-function (or erc-session-connector + 'open-network-stream))) + (erc-open erc-session-server erc-session-port erc-server-current-nick + erc-session-user-full-name t erc-session-password))))) (defun erc-server-filter-function (process string) "The process filter for the ERC server." diff -r 6612625cb8e9 -r 1b8ee4a690a1 lisp/erc/erc.el --- a/lisp/erc/erc.el Mon Jan 25 08:45:12 2010 +0100 +++ b/lisp/erc/erc.el Thu Jan 28 08:06:13 2010 +0100 @@ -5654,11 +5654,13 @@ "Determine the connection and authentication parameters. Sets the buffer local variables: +- `erc-session-connector' - `erc-session-server' - `erc-session-port' - `erc-session-full-name' - `erc-server-current-nick'" - (setq erc-session-server (erc-compute-server server) + (setq erc-session-connector erc-server-connect-function + erc-session-server (erc-compute-server server) erc-session-port (or port erc-default-port) erc-session-user-full-name (erc-compute-full-name name)) (erc-set-current-nick (erc-compute-nick nick))) diff -r 6612625cb8e9 -r 1b8ee4a690a1 lisp/files.el --- a/lisp/files.el Mon Jan 25 08:45:12 2010 +0100 +++ b/lisp/files.el Thu Jan 28 08:06:13 2010 +0100 @@ -4665,21 +4665,35 @@ ;; delete-directory handler. (setq directory (directory-file-name (expand-file-name directory))) (let ((handler (find-file-name-handler directory 'delete-directory))) - (if handler - (funcall handler 'delete-directory directory recursive) + (cond + (handler + (funcall handler 'delete-directory directory recursive)) + (delete-by-moving-to-trash + ;; Only move non-empty dir to trash if recursive deletion was + ;; requested. This mimics the non-`delete-by-moving-to-trash' + ;; case, where the operation fails in delete-directory-internal. + ;; As `move-file-to-trash' trashes directories (empty or + ;; otherwise) as a unit, we do not need to recurse here. + (if (and (not recursive) + ;; Check if directory is empty apart from "." and "..". + (directory-files + directory 'full directory-files-no-dot-files-regexp)) + (error "Directory is not empty, not moving to trash") + (move-file-to-trash directory))) + ;; Otherwise, call outselves recursively if needed. + (t (if (and recursive (not (file-symlink-p directory))) - (mapc - (lambda (file) - ;; This test is equivalent to - ;; (and (file-directory-p fn) (not (file-symlink-p fn))) - ;; but more efficient - (if (eq t (car (file-attributes file))) - (delete-directory file recursive) - (delete-file file))) - ;; We do not want to delete "." and "..". - (directory-files - directory 'full directory-files-no-dot-files-regexp))) - (delete-directory-internal directory)))) + (mapc (lambda (file) + ;; This test is equivalent to + ;; (and (file-directory-p fn) (not (file-symlink-p fn))) + ;; but more efficient + (if (eq t (car (file-attributes file))) + (delete-directory file recursive) + (delete-file file))) + ;; We do not want to delete "." and "..". + (directory-files + directory 'full directory-files-no-dot-files-regexp))) + (delete-directory-internal directory))))) (defun copy-directory (directory newname &optional keep-time parents) "Copy DIRECTORY to NEWNAME. Both args must be strings. diff -r 6612625cb8e9 -r 1b8ee4a690a1 lisp/log-edit.el --- a/lisp/log-edit.el Mon Jan 25 08:45:12 2010 +0100 +++ b/lisp/log-edit.el Thu Jan 28 08:06:13 2010 +0100 @@ -1,7 +1,7 @@ ;;; log-edit.el --- Major mode for editing CVS commit messages -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: pcl-cvs cvs commit log @@ -150,7 +150,10 @@ (defcustom log-edit-strip-single-file-name t "If non-nil, remove file name from single-file log entries." - :type 'boolean) + :type 'boolean + :safe 'booleanp + :group 'log-edit + :version "23.2") (defvar cvs-changelog-full-paragraphs t) (make-obsolete-variable 'cvs-changelog-full-paragraphs diff -r 6612625cb8e9 -r 1b8ee4a690a1 lisp/net/tramp.el --- a/lisp/net/tramp.el Mon Jan 25 08:45:12 2010 +0100 +++ b/lisp/net/tramp.el Thu Jan 28 08:06:13 2010 +0100 @@ -1085,6 +1085,7 @@ "Login Incorrect" "Connection refused" "Connection closed" + "Timeout, server not responding." "Sorry, try again." "Name or service not known" "Host key verification failed." @@ -6732,6 +6733,9 @@ ;; because we're running on a non-MULE Emacs. Let's try ;; stty, instead. (tramp-send-command vec "stty -onlcr" t)))) + ;; Dump stty settings in the traces. + (when (>= tramp-verbose 10) + (tramp-send-command vec "stty -a" t)) (tramp-send-command vec "set +o vi +o emacs" t) ;; Check whether the output of "uname -sr" has been changed. If @@ -6801,15 +6805,16 @@ ;; . We ;; apply the workaround. (if (string-equal (tramp-get-connection-property vec "uname" "") "SunOS 5.11") - (tramp-send-command vec "unset HISTFILE")) + (tramp-send-command vec "unset HISTFILE" t)) (let ((env (copy-sequence tramp-remote-process-environment)) unset item) (while env (setq item (tramp-compat-split-string (car env) "=")) - (if (and (stringp (cadr item)) (not (string-equal (cadr item) ""))) + (setcdr item (mapconcat 'identity (cdr item) "=")) + (if (and (stringp (cdr item)) (not (string-equal (cdr item) ""))) (tramp-send-command - vec (format "%s=%s; export %s" (car item) (cadr item) (car item)) t) + vec (format "%s=%s; export %s" (car item) (cdr item) (car item)) t) (push (car item) unset)) (setq env (cdr env))) (when unset @@ -6981,7 +6986,8 @@ ;; Did we find something? (unless found - (tramp-message vec 2 "Couldn't find an inline transfer encoding")) + (tramp-error + vec 'file-error "Couldn't find an inline transfer encoding")) ;; Set connection properties. (tramp-message vec 5 "Using local encoding `%s'" loc-enc) @@ -7301,7 +7307,10 @@ (unless nooutput (tramp-wait-for-output p)))) (defun tramp-wait-for-output (proc &optional timeout) - "Wait for output from remote rsh command." + "Wait for output from remote command." + (unless (buffer-live-p (process-buffer proc)) + (delete-process proc) + (tramp-error proc 'file-error "Process `%s' not available, try again" proc)) (with-current-buffer (process-buffer proc) (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might ;; be leading escape sequences, which must be ignored. @@ -7313,6 +7322,14 @@ (found (tramp-wait-for-regexp proc timeout regexp1))) (if found (let (buffer-read-only) + ;; A simple-minded busybox has sent " ^H" sequences. + ;; Delete them. + (goto-char (point-min)) + (when (re-search-forward + "^\\(.\b\\)+$" (tramp-compat-line-end-position) t) + (forward-line 1) + (delete-region (point-min) (point))) + ;; Delete the prompt. (goto-char (point-max)) (re-search-backward regexp nil t) (delete-region (point) (point-max))) @@ -8002,9 +8019,14 @@ (let ((dl (tramp-get-remote-path vec)) result) (while (and dl (setq result (tramp-find-executable vec cmd dl t t))) - ;; Check parameter. + ;; Check parameters. On busybox, "ls" output coloring is + ;; enabled by default sometimes. So we try to disable it + ;; when possible. $LS_COLORING is not supported there. (when (zerop (tramp-send-command-and-check vec (format "%s -lnd /" result))) + (when (zerop (tramp-send-command-and-check + vec (format "%s --color=never /" result))) + (setq result (concat result " --color=never"))) (throw 'ls-found result)) (setq dl (cdr dl)))))) (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))) @@ -8481,8 +8503,6 @@ ;; * Don't use globbing for directories with many files, as this is ;; likely to produce long command lines, and some shells choke on ;; long command lines. -;; * `vc-directory' does not work. It never displays any files, even -;; if it does show files when run locally. ;; * How to deal with MULE in `insert-file-contents' and `write-region'? ;; * Test remote ksh or bash for tilde expansion in `tramp-find-shell'? ;; * abbreviate-file-name @@ -8529,8 +8549,6 @@ ;; * Reconnect directly to a compliant shell without first going ;; through the user's default shell. (Pete Forman) ;; * Make `tramp-default-user' obsolete. -;; * Tramp shall reconnect automatically to its ssh connection when it -;; detects that the process "has died". (David Reitter) ;; * How can I interrupt the remote process with a signal ;; (interrupt-process seems not to work)? (Markus Triska) ;; * Avoid the local shell entirely for starting remote processes. If @@ -8552,6 +8570,16 @@ ;; * Keep a second connection open for out-of-band methods like scp or ;; rsync. ;; * Support ptys in `tramp-handle-start-file-process'. +;; * IMHO, it's a drawback that currently Tramp doesn't support +;; Unicode in Dired file names by default. Is it possible to +;; improve Tramp to set LC_ALL to "C" only for commands where Tramp +;; expects English? Or just to set LC_MESSAGES to "C" if Tramp +;; expects only English messages? (Juri Linkov) +;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846) +;; * Do not handle files with drive letter as remote. (Bug#5447) +;; * Load Tramp subpackages only when needed. (Bug#1529, Bug#5448) +;; * Try telnet+curl as new method. It might be useful for busybox, +;; without built-in uuencode/uudecode. ;; Functions for file-name-handler-alist: ;; diff-latest-backup-file -- in diff.el diff -r 6612625cb8e9 -r 1b8ee4a690a1 lisp/vc-annotate.el --- a/lisp/vc-annotate.el Mon Jan 25 08:45:12 2010 +0100 +++ b/lisp/vc-annotate.el Thu Jan 28 08:06:13 2010 +0100 @@ -447,7 +447,8 @@ (let ((rev-at-line (vc-annotate-extract-revision-at-line))) (if (not rev-at-line) (message "Cannot extract revision number from the current line") - (if (equal (car rev-at-line) vc-annotate-parent-rev) + (if (and (equal (car rev-at-line) vc-annotate-parent-rev) + (string= (cdr rev-at-line) vc-annotate-parent-file)) (message "Already at revision %s" rev-at-line) (vc-annotate-warp-revision (car rev-at-line) (cdr rev-at-line))))))) diff -r 6612625cb8e9 -r 1b8ee4a690a1 lisp/vc-hooks.el --- a/lisp/vc-hooks.el Mon Jan 25 08:45:12 2010 +0100 +++ b/lisp/vc-hooks.el Thu Jan 28 08:06:13 2010 +0100 @@ -89,6 +89,8 @@ :type '(repeat directory) :group 'vc) +(make-obsolete 'vc-path "should not be necessary anymore." "23.2") + (defcustom vc-make-backup-files nil "If non-nil, backups of registered files are made as with other files. If nil (the default), files covered by version control don't get backups." diff -r 6612625cb8e9 -r 1b8ee4a690a1 lisp/vc-svn.el --- a/lisp/vc-svn.el Mon Jan 25 08:45:12 2010 +0100 +++ b/lisp/vc-svn.el Thu Jan 28 08:06:13 2010 +0100 @@ -330,6 +330,7 @@ ;; Check out a particular version (or recreate the file). (vc-file-setprop file 'vc-working-revision nil) (apply 'vc-svn-command nil 0 file + "--non-interactive" ; bug#4280 "update" (cond ((null rev) "-rBASE") diff -r 6612625cb8e9 -r 1b8ee4a690a1 src/ChangeLog --- a/src/ChangeLog Mon Jan 25 08:45:12 2010 +0100 +++ b/src/ChangeLog Thu Jan 28 08:06:13 2010 +0100 @@ -1,3 +1,19 @@ +2010-01-27 Jason Rumney + + * w32inevt.c (w32_kbd_patch_key): Save the unicode character. + (key_event): Use unicode for characters 128 and higher. + +2010-01-27 Kenichi Handa + + * regex.c (analyse_first): Fix setting of fastmap for unibyte + pattern string (Bug#4209). + +2010-01-27 David De La Harpe Golden + + * fileio.c (Frename_file): Call copy-directory and + delete-directory for directories, in order to handle cross-device + renaming (Bug#3353). + 2010-01-25 Jan Djärv * xfns.c (Fx_create_frame): If frame height is too big, try @@ -9323,7 +9339,7 @@ (syms_of_xterm): Don't declare it any more. (x_draw_glyph_string): Adjust to the new name. -2008-06-10 David De La Harpe Golden (tiny change) +2008-06-10 David De La Harpe Golden * xterm.c (x_underline_minimum_display_offset): New var. (x_draw_glyph_string): Use it. diff -r 6612625cb8e9 -r 1b8ee4a690a1 src/fileio.c --- a/src/fileio.c Mon Jan 25 08:45:12 2010 +0100 +++ b/src/fileio.c Thu Jan 28 08:06:13 2010 +0100 @@ -215,6 +215,12 @@ /* Lisp function for moving files to trash. */ Lisp_Object Qmove_file_to_trash; +/* Lisp function for recursively copying directories. */ +Lisp_Object Qcopy_directory; + +/* Lisp function for recursively deleting directories. */ +Lisp_Object Qdelete_directory; + extern Lisp_Object Vuser_login_name; #ifdef WINDOWSNT @@ -2241,7 +2247,11 @@ && (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname)))) #endif ) - newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname); + { + Lisp_Object fname = NILP (Ffile_directory_p (file)) + ? file : Fdirectory_file_name (file); + newname = Fexpand_file_name (Ffile_name_nondirectory (fname), newname); + } else newname = Fexpand_file_name (newname, Qnil); @@ -2279,15 +2289,21 @@ NILP (ok_if_already_exists) ? Qnil : Qt); else #endif + if (Ffile_directory_p (file)) + call4 (Qcopy_directory, file, newname, Qt, Qnil); + else + /* We have already prompted if it was an integer, so don't + have copy-file prompt again. */ Fcopy_file (file, newname, - /* We have already prompted if it was an integer, - so don't have copy-file prompt again. */ NILP (ok_if_already_exists) ? Qnil : Qt, Qt, Qt); count = SPECPDL_INDEX (); specbind (Qdelete_by_moving_to_trash, Qnil); - Fdelete_file (file); + if (Ffile_directory_p (file)) + call2 (Qdelete_directory, file, Qt); + else + Fdelete_file (file); unbind_to (count, Qnil); } else @@ -5727,6 +5743,10 @@ Qdelete_by_moving_to_trash = intern_c_string ("delete-by-moving-to-trash"); Qmove_file_to_trash = intern_c_string ("move-file-to-trash"); staticpro (&Qmove_file_to_trash); + Qcopy_directory = intern_c_string ("copy-directory"); + staticpro (&Qcopy_directory); + Qdelete_directory = intern_c_string ("delete-directory"); + staticpro (&Qdelete_directory); defsubr (&Sfind_file_name_handler); defsubr (&Sfile_name_directory); diff -r 6612625cb8e9 -r 1b8ee4a690a1 src/regex.c --- a/src/regex.c Mon Jan 25 08:45:12 2010 +0100 +++ b/src/regex.c Thu Jan 28 08:06:13 2010 +0100 @@ -4083,8 +4083,7 @@ the corresponding multibyte character. */ int c = RE_CHAR_TO_MULTIBYTE (p[1]); - if (! CHAR_BYTE8_P (c)) - fastmap[CHAR_LEADING_CODE (c)] = 1; + fastmap[CHAR_LEADING_CODE (c)] = 1; } } break; diff -r 6612625cb8e9 -r 1b8ee4a690a1 src/w32inevt.c --- a/src/w32inevt.c Mon Jan 25 08:45:12 2010 +0100 +++ b/src/w32inevt.c Thu Jan 28 08:06:13 2010 +0100 @@ -81,6 +81,9 @@ static INPUT_RECORD event_queue[EVENT_QUEUE_SIZE]; static INPUT_RECORD *queue_ptr = event_queue, *queue_end = event_queue; +/* Temporarily store lead byte of DBCS input sequences. */ +static char dbcs_lead = 0; + static int fill_queue (BOOL block) { @@ -253,13 +256,15 @@ keystate, buf, 128, 0); if (isdead > 0) { - char cp[20]; - int cpId; + char cp[20]; + int cpId; + + event->uChar.UnicodeChar = buf[isdead - 1]; - GetLocaleInfo (GetThreadLocale (), + GetLocaleInfo (GetThreadLocale (), LOCALE_IDEFAULTANSICODEPAGE, cp, 20); - cpId = atoi (cp); - isdead = WideCharToMultiByte (cpId, 0, buf, isdead, + cpId = atoi (cp); + isdead = WideCharToMultiByte (cpId, 0, buf, isdead, ansi_code, 4, NULL, NULL); } else @@ -425,8 +430,6 @@ if (lispy_function_keys[event->wVirtualKeyCode] == 0) { - emacs_ev->kind = ASCII_KEYSTROKE_EVENT; - if (!NILP (Vw32_recognize_altgr) && (event->dwControlKeyState & LEFT_CTRL_PRESSED) && (event->dwControlKeyState & RIGHT_ALT_PRESSED)) @@ -461,9 +464,65 @@ else if (event->uChar.AsciiChar == 0) w32_kbd_patch_key (event); } + if (event->uChar.AsciiChar == 0) - return 0; - emacs_ev->code = event->uChar.AsciiChar; + { + emacs_ev->kind = NO_EVENT; + return 0; + } + else if (event->uChar.AsciiChar > 0 && event->uChar.AsciiChar < 128) + { + emacs_ev->kind = ASCII_KEYSTROKE_EVENT; + emacs_ev->code = event->uChar.AsciiChar; + } + else if (event->uChar.UnicodeChar > 0) + { + emacs_ev->kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + emacs_ev->code = event->uChar.UnicodeChar; + } + else + { + /* Fallback for non-Unicode versions of Windows. */ + wchar_t code; + char dbcs[2]; + char cp[20]; + int cpId; + + /* Get the codepage to interpret this key with. */ + GetLocaleInfo (GetThreadLocale (), + LOCALE_IDEFAULTANSICODEPAGE, cp, 20); + cpId = atoi (cp); + + dbcs[0] = dbcs_lead; + dbcs[1] = event->uChar.AsciiChar; + if (dbcs_lead) + { + dbcs_lead = 0; + if (!MultiByteToWideChar (cpId, 0, dbcs, 2, &code, 1)) + { + /* Garbage */ + DebPrint (("Invalid DBCS sequence: %d %d\n", + dbcs[0], dbcs[1])); + emacs_ev->kind = NO_EVENT; + } + } + else if (IsDBCSLeadByteEx (cpId, dbcs[1])) + { + dbcs_lead = dbcs[1]; + emacs_ev->kind = NO_EVENT; + } + else + { + if (!MultiByteToWideChar (cpId, 0, &dbcs[1], 1, &code, 1)) + { + /* Garbage */ + DebPrint (("Invalid character: %d\n", dbcs[1])); + emacs_ev->kind = NO_EVENT; + } + } + emacs_ev->kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + emacs_ev->code = code; + } } else {