------------------------------------------------------------ revno: 117089 [merge] committer: Glenn Morris branch nick: trunk timestamp: Sun 2014-05-11 23:59:30 -0700 message: Merge from emacs-24; up to r117108 diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2014-04-18 23:36:51 +0000 +++ admin/ChangeLog 2014-05-12 06:59:30 +0000 @@ -1,3 +1,11 @@ +2014-05-12 Glenn Morris + + * find-gc.el: Move here from ../lisp/emacs-lisp. + + * admin.el (set-version-in-file): Don't set identical version. + (set-version): Provide default version number. + (set-version, set-copyright): Give start/end messages. + 2014-04-18 Paul Eggert * notes/bzr: Update instructions for merging from gnulib. === modified file 'admin/admin.el' --- admin/admin.el 2014-01-13 22:21:32 +0000 +++ admin/admin.el 2014-05-10 21:59:05 +0000 @@ -65,17 +65,25 @@ "Subroutine of `set-version' and `set-copyright'." (find-file (expand-file-name file root)) (goto-char (point-min)) + (setq version (format "%s" version)) (unless (re-search-forward rx nil :noerror) (user-error "Version not found in %s" file)) - (replace-match (format "%s" version) nil nil nil 1)) + (if (not (equal version (match-string 1))) + (replace-match version nil nil nil 1) + (kill-buffer) + (message "No need to update `%s'" file))) -;; TODO report the progress (defun set-version (root version) "Set Emacs version to VERSION in relevant files under ROOT. Root must be the root of an Emacs source tree." - (interactive "DEmacs root directory: \nsVersion number: ") + (interactive (list + (read-directory-name "Emacs root directory: " source-directory) + (read-string "Version number: " + (replace-regexp-in-string "\\.[0-9]+\\'" "" + emacs-version)))) (unless (file-exists-p (expand-file-name "src/emacs.c" root)) (user-error "%s doesn't seem to be the root of an Emacs source tree" root)) + (message "Setting version numbers...") ;; There's also a "version 3" (standing for GPLv3) at the end of ;; `README', but since `set-version-in-file' only replaces the first ;; occurrence, it won't be replaced. @@ -158,11 +166,10 @@ {\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs") (set-version-in-file root "etc/refcards/emacsver.tex" version "\\\\def\\\\versionemacs\ -{\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs")))) - +{\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs"))) + (message "Setting version numbers...done")) ;; Note this makes some assumptions about form of short copyright. -;; TODO report the progress (defun set-copyright (root copyright) "Set Emacs short copyright to COPYRIGHT in relevant files under ROOT. Root must be the root of an Emacs source tree." @@ -174,6 +181,7 @@ (format-time-string "%Y"))))) (unless (file-exists-p (expand-file-name "src/emacs.c" root)) (user-error "%s doesn't seem to be the root of an Emacs source tree" root)) + (message "Setting copyrights...") (set-version-in-file root "configure.ac" copyright (rx (and bol "copyright" (0+ (not (in ?\"))) ?\" (submatch (1+ (not (in ?\")))) ?\"))) @@ -195,7 +203,8 @@ {\\([0-9]\\{4\\}\\)}.+%.+copyright year") (set-version-in-file root "etc/refcards/emacsver.tex" copyright "\\\\def\\\\year\ -{\\([0-9]\\{4\\}\\)}.+%.+copyright year"))) +{\\([0-9]\\{4\\}\\)}.+%.+copyright year")) + (message "Setting copyrights...done")) ;;; Various bits of magic for generating the web manuals === renamed file 'lisp/emacs-lisp/find-gc.el' => 'admin/find-gc.el' === modified file 'doc/lispref/functions.texi' --- doc/lispref/functions.texi 2014-03-22 22:12:52 +0000 +++ doc/lispref/functions.texi 2014-05-12 06:59:30 +0000 @@ -1240,7 +1240,8 @@ global value of @var{place}. Whereas if @var{place} is of the form @code{(local @var{symbol})}, where @var{symbol} is an expression which returns the variable name, then @var{function} will only be added in the -current buffer. +current buffer. Finally, if you want to modify a lexical variable, you will +have to use @code{(var @var{VARIABLE})}. Every function added with @code{add-function} can be accompanied by an association list of properties @var{props}. Currently only two of those === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-05-11 05:49:14 +0000 +++ lisp/ChangeLog 2014-05-12 06:59:30 +0000 @@ -1,3 +1,54 @@ +2014-05-12 Stefan Monnier + + * emacs-lisp/nadvice.el (advice--interactive-form): Don't get fooled + into autoloading just because of a silly indirection. + +2014-05-12 Santiago Payà i Miralta (tiny change) + + * vc/vc-hg.el (vc-hg-unregister): New function. (Bug#17454) + +2014-05-12 Glenn Morris + + * emacs-lisp/find-gc.el: Move to ../admin. + + * printing.el (pr-version): + * ps-print.el (ps-print-version): Also mention bug-gnu-emacs. + + * net/browse-url.el (browse-url-mosaic): + Create /tmp/Mosaic.PID as a private file. + +2014-05-12 Stefan Monnier + + * emacs-lisp/nadvice.el: Support adding a given function multiple times. + (advice--member-p): If name is given, only compare the name. + (advice--remove-function): Don't stop at the first match. + (advice--normalize-place): New function. + (add-function, remove-function): Use it. + (advice--add-function): Pass the name, if any, to + advice--remove-function. + +2014-05-12 Philipp Rumpf (tiny change) + + * electric.el (electric-indent-post-self-insert-function): Don't use + `pos' after modifying the buffer (bug#17449). + +2014-05-12 Stephen Berman + + * calendar/todo-mode.el (todo-insert-item-from-calendar): + Correct argument list to conform to todo-insert-item--basic. + +2014-05-12 Glenn Morris + + * files.el (cd-absolute): Test if directory is accessible + rather than executable. (Bug#17330) + + * progmodes/compile.el (recompile): + Handle C-u M-x recompile from a non-compilation buffer. (Bug#17444) + + * net/browse-url.el (browse-url-mosaic): + Be careful when writing /tmp/Mosaic.PID. (Bug#17428) + This is CVE-2014-3423. + 2014-05-11 Stefan Monnier * mouse.el: Use the normal toplevel loop while dragging. @@ -89,6 +140,7 @@ (tramp-remote-coding-commands): Enhance docstring. (tramp-find-inline-encoding): Replace "%t" by a temporary file name. (Bug#17415) + This is CVE-2014-3424. 2014-05-08 Glenn Morris @@ -96,6 +148,7 @@ (find-gc-source-files): Update some names. (trace-call-tree): Simplify and update. Avoid predictable temp-file names. (http://bugs.debian.org/747100) + This is CVE-2014-3422. 2014-05-08 Stefan Monnier === modified file 'lisp/calendar/todo-mode.el' --- lisp/calendar/todo-mode.el 2014-05-07 09:31:27 +0000 +++ lisp/calendar/todo-mode.el 2014-05-09 07:50:42 +0000 @@ -1984,7 +1984,7 @@ (setq todo-date-from-calendar (calendar-date-string (calendar-cursor-to-date t) t t)) (calendar-exit) - (todo-insert-item--basic arg nil nil todo-date-from-calendar)) + (todo-insert-item--basic arg nil todo-date-from-calendar)) (define-key calendar-mode-map "it" 'todo-insert-item-from-calendar) === modified file 'lisp/electric.el' --- lisp/electric.el 2014-05-05 19:04:40 +0000 +++ lisp/electric.el 2014-05-09 18:03:21 +0000 @@ -259,29 +259,30 @@ (unless (eq act 'do-indent) (nth 8 (syntax-ppss)))))))) ;; For newline, we want to reindent both lines and basically behave like ;; reindent-then-newline-and-indent (whose code we hence copied). - (when (<= pos (line-beginning-position)) - (let ((before (copy-marker (1- pos) t))) - (save-excursion - (unless (or (memq indent-line-function - electric-indent-functions-without-reindent) - electric-indent-inhibit) - ;; Don't reindent the previous line if the indentation function - ;; is not a real one. + (let ((at-newline (<= pos (line-beginning-position)))) + (when at-newline + (let ((before (copy-marker (1- pos) t))) + (save-excursion + (unless (or (memq indent-line-function + electric-indent-functions-without-reindent) + electric-indent-inhibit) + ;; Don't reindent the previous line if the indentation function + ;; is not a real one. + (goto-char before) + (indent-according-to-mode)) + ;; We are at EOL before the call to indent-according-to-mode, and + ;; after it we usually are as well, but not always. We tried to + ;; address it with `save-excursion' but that uses a normal marker + ;; whereas we need `move after insertion', so we do the + ;; save/restore by hand. (goto-char before) - (indent-according-to-mode)) - ;; We are at EOL before the call to indent-according-to-mode, and - ;; after it we usually are as well, but not always. We tried to - ;; address it with `save-excursion' but that uses a normal marker - ;; whereas we need `move after insertion', so we do the - ;; save/restore by hand. - (goto-char before) - (when (eolp) - ;; Remove the trailing whitespace after indentation because - ;; indentation may (re)introduce the whitespace. - (delete-horizontal-space t))))) - (unless (and electric-indent-inhibit - (> pos (line-beginning-position))) - (indent-according-to-mode))))) + (when (eolp) + ;; Remove the trailing whitespace after indentation because + ;; indentation may (re)introduce the whitespace. + (delete-horizontal-space t))))) + (unless (and electric-indent-inhibit + (not at-newline)) + (indent-according-to-mode)))))) (put 'electric-indent-post-self-insert-function 'priority 60) === modified file 'lisp/emacs-lisp/nadvice.el' --- lisp/emacs-lisp/nadvice.el 2014-03-20 16:00:17 +0000 +++ lisp/emacs-lisp/nadvice.el 2014-05-12 05:25:34 +0000 @@ -134,7 +134,7 @@ (defun advice--interactive-form (function) ;; Like `interactive-form' but tries to avoid autoloading functions. (when (commandp function) - (if (not (and (symbolp function) (autoloadp (symbol-function function)))) + (if (not (and (symbolp function) (autoloadp (indirect-function function)))) (interactive-form function) `(interactive (advice-eval-interactive-spec (cadr (interactive-form ',function))))))) @@ -183,9 +183,9 @@ (defun advice--member-p (function name definition) (let ((found nil)) (while (and (not found) (advice--p definition)) - (if (or (equal function (advice--car definition)) - (when name - (equal name (cdr (assq 'name (advice--props definition)))))) + (if (if name + (equal name (cdr (assq 'name (advice--props definition)))) + (equal function (advice--car definition))) (setq found definition) (setq definition (advice--cdr definition)))) found)) @@ -209,8 +209,8 @@ (lambda (first rest props) (cond ((not first) rest) ((or (equal function first) - (equal function (cdr (assq 'name props)))) - (list rest)))))) + (equal function (cdr (assq 'name props)))) + (list (advice--remove-function rest function))))))) (defvar advice--buffer-local-function-sample nil "keeps an example of the special \"run the default value\" functions. @@ -232,6 +232,12 @@ ;; This function acts like the t special value in buffer-local hooks. (lambda (&rest args) (apply (default-value var) args))))) +(defun advice--normalize-place (place) + (cond ((eq 'local (car-safe place)) `(advice--buffer-local ,@(cdr place))) + ((eq 'var (car-safe place)) (nth 1 place)) + ((symbolp place) `(default-value ',place)) + (t place))) + ;;;###autoload (defmacro add-function (where place function &optional props) ;; TODO: @@ -267,8 +273,9 @@ the advice should be innermost (i.e. at the end of the list), whereas a depth of -100 means that the advice should be outermost. -If PLACE is a simple variable, only its global value will be affected. -Use (local 'VAR) if you want to apply FUNCTION to VAR buffer-locally. +If PLACE is a symbol, its `default-value' will be affected. +Use (local 'SYMBOL) if you want to apply FUNCTION to SYMBOL buffer-locally. +Use (var VAR) if you want to apply FUNCTION to the (lexical) VAR. If one of FUNCTION or OLDFUN is interactive, then the resulting function is also interactive. There are 3 cases: @@ -278,20 +285,18 @@ `advice-eval-interactive-spec') and return the list of arguments to use. - Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN." (declare (debug t)) ;;(indent 2) - (cond ((eq 'local (car-safe place)) - (setq place `(advice--buffer-local ,@(cdr place)))) - ((symbolp place) - (setq place `(default-value ',place)))) - `(advice--add-function ,where (gv-ref ,place) ,function ,props)) + `(advice--add-function ,where (gv-ref ,(advice--normalize-place place)) + ,function ,props)) ;;;###autoload (defun advice--add-function (where ref function props) - (let ((a (advice--member-p function (cdr (assq 'name props)) - (gv-deref ref)))) + (let* ((name (cdr (assq 'name props))) + (a (advice--member-p function name (gv-deref ref)))) (when a ;; The advice is already present. Remove the old one, first. (setf (gv-deref ref) - (advice--remove-function (gv-deref ref) (advice--car a)))) + (advice--remove-function (gv-deref ref) + (or name (advice--car a))))) (setf (gv-deref ref) (advice--make where function (gv-deref ref) props)))) @@ -302,11 +307,7 @@ Instead of FUNCTION being the actual function, it can also be the `name' of the piece of advice." (declare (debug t)) - (cond ((eq 'local (car-safe place)) - (setq place `(advice--buffer-local ,@(cdr place)))) - ((symbolp place) - (setq place `(default-value ',place)))) - (gv-letplace (getter setter) place + (gv-letplace (getter setter) (advice--normalize-place place) (macroexp-let2 nil new `(advice--remove-function ,getter ,function) `(unless (eq ,new ,getter) ,(funcall setter new))))) === modified file 'lisp/files.el' --- lisp/files.el 2014-05-09 07:02:00 +0000 +++ lisp/files.el 2014-05-12 06:59:30 +0000 @@ -685,7 +685,7 @@ (if (file-exists-p dir) (error "%s is not a directory" dir) (error "%s: no such directory" dir)) - (unless (file-executable-p dir) + (unless (file-accessible-directory-p dir) (error "Cannot cd to %s: Permission denied" dir)) (setq default-directory dir) (setq list-buffers-directory dir))) === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2014-05-09 09:50:14 +0000 +++ lisp/gnus/ChangeLog 2014-05-12 06:59:30 +0000 @@ -15,6 +15,7 @@ * gnus-fun.el (gnus-grab-cam-face): Do not use predictable temp-file name. (http://bugs.debian.org/747100) + This is CVE-2014-3421. 2014-05-04 Glenn Morris === modified file 'lisp/net/browse-url.el' --- lisp/net/browse-url.el 2014-05-06 03:55:54 +0000 +++ lisp/net/browse-url.el 2014-05-10 20:48:36 +0000 @@ -1333,31 +1333,32 @@ (let ((pidfile (expand-file-name browse-url-mosaic-pidfile)) pid) (if (file-readable-p pidfile) - (save-excursion - (find-file pidfile) - (goto-char (point-min)) - (setq pid (read (current-buffer))) - (kill-buffer nil))) - (if (and pid (zerop (signal-process pid 0))) ; Mosaic running - (save-excursion - ;; This is a predictable temp-file name, which is bad, - ;; but it is what Mosaic uses/used. - ;; So it's not Emacs's problem. http://bugs.debian.org/747100 - (find-file (format "/tmp/Mosaic.%d" pid)) - (erase-buffer) - (insert (if (browse-url-maybe-new-window new-window) - "newwin\n" - "goto\n") - url "\n") - (save-buffer) - (kill-buffer nil) + (with-temp-buffer + (insert-file-contents pidfile) + (setq pid (read (current-buffer))))) + (if (and (integerp pid) (zerop (signal-process pid 0))) ; Mosaic running + (progn + (with-temp-buffer + (insert (if (browse-url-maybe-new-window new-window) + "newwin\n" + "goto\n") + url "\n") + (let ((umask (default-file-modes))) + (unwind-protect + (progn + (set-default-file-modes ?\700) + (if (file-exists-p + (setq pidfile (format "/tmp/Mosaic.%d" pid))) + (delete-file pidfile)) + ;; http://debbugs.gnu.org/17428. Use O_EXCL. + (write-region nil nil pidfile nil 'silent nil 'excl)) + (set-default-file-modes umask)))) ;; Send signal SIGUSR to Mosaic (message "Signaling Mosaic...") (signal-process pid 'SIGUSR1) ;; Or you could try: ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid)) - (message "Signaling Mosaic...done") - ) + (message "Signaling Mosaic...done")) ;; Mosaic not running - start it (message "Starting %s..." browse-url-mosaic-program) (apply 'start-process "xmosaic" nil browse-url-mosaic-program === modified file 'lisp/org/ChangeLog' --- lisp/org/ChangeLog 2014-04-22 14:07:45 +0000 +++ lisp/org/ChangeLog 2014-05-12 06:09:43 +0000 @@ -1,3 +1,9 @@ +2014-05-12 Eric Schulte + + * ob-screen.el (org-babel-screen-session-write-temp-file) + (org-babel-screen-test): + Use unpredictable names for temporary files. (Bug#17416) + 2014-04-22 Aaron Ecay * org-src.el (org-edit-src-exit): Place an undo boundary before @@ -286,7 +292,7 @@ 2014-04-22 Justin Gordon - * ox-md (org-md-separate-elements): Fix blank line insertion + * ox-md.el (org-md-separate-elements): Fix blank line insertion between elements. * ox-md.el (org-md-inner-template): New function. === modified file 'lisp/org/ob-screen.el' --- lisp/org/ob-screen.el 2014-01-01 07:43:34 +0000 +++ lisp/org/ob-screen.el 2014-05-12 06:09:43 +0000 @@ -106,7 +106,7 @@ (defun org-babel-screen-session-write-temp-file (session body) "Save BODY in a temp file that is named after SESSION." - (let ((tmpfile (concat "/tmp/screen.org-babel-session-" session))) + (let ((tmpfile (org-babel-temp-file "screen-"))) (with-temp-file tmpfile (insert body) @@ -121,7 +121,7 @@ (interactive) (let* ((session "org-babel-testing") (random-string (format "%s" (random 99999))) - (tmpfile "/tmp/org-babel-screen.test") + (tmpfile (org-babel-temp-file "ob-screen-test-")) (body (concat "echo '" random-string "' > " tmpfile "\nexit\n")) process tmp-string) (org-babel-execute:screen body org-babel-default-header-args:screen) === modified file 'lisp/printing.el' --- lisp/printing.el 2014-05-09 07:02:00 +0000 +++ lisp/printing.el 2014-05-12 06:59:30 +0000 @@ -12,7 +12,7 @@ "printing.el, v 6.9.3 <2007/12/09 vinicius> Please send all bug fixes and enhancements to - Vinicius Jose Latorre + bug-gnu-emacs@gnu.org and Vinicius Jose Latorre ") ;; This file is part of GNU Emacs. === modified file 'lisp/progmodes/compile.el' --- lisp/progmodes/compile.el 2014-05-05 10:58:06 +0000 +++ lisp/progmodes/compile.el 2014-05-12 06:59:30 +0000 @@ -1460,7 +1460,7 @@ `compilation-shell-minor-mode'. Interactively, prompts for the command if the variable -`compilation-read-command' is non-nil; otherwise uses`compile-command'. +`compilation-read-command' is non-nil; otherwise uses `compile-command'. With prefix arg, always prompts. Additionally, with universal prefix arg, compilation buffer will be in comint mode, i.e. interactive. @@ -1499,12 +1499,13 @@ (interactive "P") (save-some-buffers (not compilation-ask-about-save) compilation-save-buffers-predicate) - (let ((default-directory (or compilation-directory default-directory))) + (let ((default-directory (or compilation-directory default-directory)) + (command (eval compile-command))) (when edit-command - (setcar compilation-arguments - (compilation-read-command (car compilation-arguments)))) - (apply 'compilation-start (or compilation-arguments - `(,(eval compile-command)))))) + (setq command (compilation-read-command (or (car compilation-arguments) + command))) + (if compilation-arguments (setcar compilation-arguments command))) + (apply 'compilation-start (or compilation-arguments (list command))))) (defcustom compilation-scroll-output nil "Non-nil to scroll the *compilation* buffer window as output appears. === modified file 'lisp/ps-print.el' --- lisp/ps-print.el 2014-03-19 19:12:50 +0000 +++ lisp/ps-print.el 2014-05-10 21:41:12 +0000 @@ -20,7 +20,7 @@ report the version of Emacs, if any, that ps-print was distributed with. Please send all bug fixes and enhancements to - Vinicius Jose Latorre .") + bug-gnu-emacs@gnu.org and Vinicius Jose Latorre .") ;; This file is part of GNU Emacs. === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2014-05-04 19:37:56 +0000 +++ lisp/url/ChangeLog 2014-05-12 06:59:30 +0000 @@ -1,3 +1,8 @@ +2014-05-12 Michael Albinus + + * url-handlers.el (url-file-handler-load-in-progress): New defvar. + (url-file-handler): Use it, in order to avoid recursive load. + 2014-05-04 Glenn Morris * url-parse.el (url-generic-parse-url): Doc fix (replace `iff'). === modified file 'lisp/url/url-handlers.el' --- lisp/url/url-handlers.el 2014-04-01 12:41:56 +0000 +++ lisp/url/url-handlers.el 2014-05-12 06:59:30 +0000 @@ -138,34 +138,41 @@ (inhibit-file-name-operation operation)) (apply operation args))) +(defvar url-file-handler-load-in-progress nil + "Check for recursive load.") + ;;;###autoload (defun url-file-handler (operation &rest args) "Function called from the `file-name-handler-alist' routines. OPERATION is what needs to be done (`file-exists-p', etc). ARGS are the arguments that would have been passed to OPERATION." - ;; Check, whether there are arguments we want pass to Tramp. - (if (catch :do - (dolist (url (cons default-directory args)) - (and (member - (url-type (url-generic-parse-url (and (stringp url) url))) - url-tramp-protocols) - (throw :do t)))) - (apply 'url-tramp-file-handler operation args) - ;; Otherwise, let's do the job. - (let ((fn (get operation 'url-file-handlers)) - (val nil) - (hooked nil)) - (if (and (not fn) (intern-soft (format "url-%s" operation)) - (fboundp (intern-soft (format "url-%s" operation)))) - (error "Missing URL handler mapping for %s" operation)) - (if fn - (setq hooked t - val (save-match-data (apply fn args))) - (setq hooked nil - val (url-run-real-handler operation args))) - (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real") - operation args val) - val))) + ;; Avoid recursive load. + (if (and load-in-progress url-file-handler-load-in-progress) + (url-run-real-handler operation args) + (let ((url-file-handler-load-in-progress load-in-progress)) + ;; Check, whether there are arguments we want pass to Tramp. + (if (catch :do + (dolist (url (cons default-directory args)) + (and (member + (url-type (url-generic-parse-url (and (stringp url) url))) + url-tramp-protocols) + (throw :do t)))) + (apply 'url-tramp-file-handler operation args) + ;; Otherwise, let's do the job. + (let ((fn (get operation 'url-file-handlers)) + (val nil) + (hooked nil)) + (if (and (not fn) (intern-soft (format "url-%s" operation)) + (fboundp (intern-soft (format "url-%s" operation)))) + (error "Missing URL handler mapping for %s" operation)) + (if fn + (setq hooked t + val (save-match-data (apply fn args))) + (setq hooked nil + val (url-run-real-handler operation args))) + (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real") + operation args val) + val))))) (defun url-file-handler-identity (&rest args) ;; Identity function === modified file 'lisp/vc/vc-hg.el' --- lisp/vc/vc-hg.el 2014-02-10 01:34:22 +0000 +++ lisp/vc/vc-hg.el 2014-05-11 02:01:08 +0000 @@ -60,7 +60,7 @@ ;; - responsible-p (file) OK ;; - could-register (file) OK ;; - receive-file (file rev) ?? PROBABLY NOT NEEDED -;; - unregister (file) COMMENTED OUT, MAY BE INCORRECT +;; - unregister (file) OK ;; * checkin (files rev comment) OK ;; * find-revision (file rev buffer) OK ;; * checkout (file &optional editable rev) OK @@ -436,10 +436,9 @@ ;; registered. (error)))) -;; FIXME: This would remove the file. Is that correct? -;; (defun vc-hg-unregister (file) -;; "Unregister FILE from hg." -;; (vc-hg-command nil nil file "remove")) +(defun vc-hg-unregister (file) + "Unregister FILE from hg." + (vc-hg-command nil 0 file "forget")) (declare-function log-edit-extract-headers "log-edit" (headers string)) === modified file 'src/ChangeLog' --- src/ChangeLog 2014-05-08 03:41:21 +0000 +++ src/ChangeLog 2014-05-12 06:59:30 +0000 @@ -1,3 +1,12 @@ +2014-05-12 Glenn Morris + + * fileio.c (Ffile_executable_p): Doc tweak. + +2014-05-12 Jan Djärv + + * xsettings.c (init_gsettings): Use g_settings_schema_source_lookup + instead of deprecated g_settings_list_schemas if possible (Bug#17434). + 2014-05-08 Paul Eggert * minibuf.c (read_minibuf): Avoid C99ism in previous patch (Bug#17430). === modified file 'src/fileio.c' --- src/fileio.c 2014-04-03 20:46:04 +0000 +++ src/fileio.c 2014-05-12 06:59:30 +0000 @@ -2546,7 +2546,9 @@ DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, doc: /* Return t if FILENAME can be executed by you. -For a directory, this means you can access files in that directory. */) +For a directory, this means you can access files in that directory. +\(It is generally better to use `file-accessible-directory-p' for that +purpose, though.) */) (Lisp_Object filename) { Lisp_Object absname; === modified file 'src/xsettings.c' --- src/xsettings.c 2014-02-28 21:45:34 +0000 +++ src/xsettings.c 2014-05-10 10:42:08 +0000 @@ -795,17 +795,29 @@ { #ifdef HAVE_GSETTINGS GVariant *val; - const gchar *const *schemas; int schema_found = 0; #if ! GLIB_CHECK_VERSION (2, 36, 0) g_type_init (); #endif - schemas = g_settings_list_schemas (); - if (schemas == NULL) return; - while (! schema_found && *schemas != NULL) - schema_found = strcmp (*schemas++, GSETTINGS_SCHEMA) == 0; +#if GLIB_CHECK_VERSION (2, 32, 0) + { + GSettingsSchema *sc = g_settings_schema_source_lookup + (g_settings_schema_source_get_default (), + GSETTINGS_SCHEMA, + TRUE); + schema_found = sc != NULL; + if (sc) g_settings_schema_unref (sc); + } +#else + { + const gchar *const *schemas = g_settings_list_schemas (); + if (schemas == NULL) return; + while (! schema_found && *schemas != NULL) + schema_found = strcmp (*schemas++, GSETTINGS_SCHEMA) == 0; + } +#endif if (!schema_found) return; gsettings_client = g_settings_new (GSETTINGS_SCHEMA); === modified file 'test/automated/advice-tests.el' --- test/automated/advice-tests.el 2014-01-01 07:43:34 +0000 +++ test/automated/advice-tests.el 2014-05-10 20:07:01 +0000 @@ -179,6 +179,29 @@ (interactive "P") nil) (should (equal (interactive-form 'sm-test9) '(interactive "P")))) +(ert-deftest advice-test-multiples () + (let ((sm-test10 (lambda (a) (+ a 10))) + (sm-advice (lambda (x) (if (consp x) (list (* 5 (car x))) (* 4 x))))) + (should (equal (funcall sm-test10 5) 15)) + (add-function :filter-args (var sm-test10) sm-advice) + (should (equal (funcall sm-test10 5) 35)) + (add-function :filter-return (var sm-test10) sm-advice) + (should (equal (funcall sm-test10 5) 60)) + ;; Make sure we can add multiple times the same function, under the + ;; condition that they have different `name' properties. + (add-function :filter-args (var sm-test10) sm-advice '((name . "args"))) + (should (equal (funcall sm-test10 5) 140)) + (remove-function (var sm-test10) "args") + (should (equal (funcall sm-test10 5) 60)) + (add-function :filter-args (var sm-test10) sm-advice '((name . "args"))) + (add-function :filter-return (var sm-test10) sm-advice '((name . "ret"))) + (should (equal (funcall sm-test10 5) 560)) + ;; Make sure that if we specify to remove a function that was added + ;; multiple times, they are all removed, rather than removing only some + ;; arbitrary subset of them. + (remove-function (var sm-test10) sm-advice) + (should (equal (funcall sm-test10 5) 15)))) + ;; Local Variables: ;; no-byte-compile: t ;; End: === modified file 'test/automated/vc-bzr.el' --- test/automated/vc-bzr.el 2014-05-08 06:58:46 +0000 +++ test/automated/vc-bzr.el 2014-05-08 07:23:40 +0000 @@ -33,17 +33,18 @@ (skip-unless (executable-find vc-bzr-program)) ;; Bzr wants to access HOME, e.g. to write ~/.bzr.log. ;; This is a problem on hydra, where HOME is non-existent. - ;; You can disable logging with BZR_LOG=/dev/null, but then - ;; some commands (eg `bzr status') want to access ~/.bazaar, - ;; and will abort if they cannot. I could not figure out how to - ;; stop bzr doing that, so just set HOME to a tempir for the duration. + ;; You can disable logging with BZR_LOG=/dev/null, but then some + ;; commands (eg `bzr status') want to access ~/.bazaar, and will + ;; abort if they cannot. I could not figure out how to stop bzr + ;; doing that, so just give it a temporary homedir for the duration. + ;; http://bugs.launchpad.net/bzr/+bug/137407 ? (let* ((homedir (make-temp-file "vc-bzr-test" t)) (bzrdir (expand-file-name "bzr" homedir)) (ignored-dir (progn (make-directory bzrdir) (expand-file-name "ignored-dir" bzrdir))) (default-directory (file-name-as-directory bzrdir)) - (process-environment (cons (format "HOME=%s" homedir) + (process-environment (cons (format "BZR_HOME=%s" homedir) process-environment))) (unwind-protect (progn @@ -79,7 +80,7 @@ (expand-file-name "subdir" bzrdir))) (file (expand-file-name "file" bzrdir)) (default-directory (file-name-as-directory bzrdir)) - (process-environment (cons (format "HOME=%s" homedir) + (process-environment (cons (format "BZR_HOME=%s" homedir) process-environment))) (unwind-protect (progn @@ -120,7 +121,7 @@ (expand-file-name "foo.el" bzrdir))) (default-directory (file-name-as-directory bzrdir)) (generated-autoload-file (expand-file-name "loaddefs.el" bzrdir)) - (process-environment (cons (format "HOME=%s" homedir) + (process-environment (cons (format "BZR_HOME=%s" homedir) process-environment))) (unwind-protect (progn === modified file 'test/indent/perl.perl' --- test/indent/perl.perl 2014-04-25 19:22:26 +0000 +++ test/indent/perl.perl 2014-05-12 06:59:30 +0000 @@ -1,6 +1,17 @@ #!/usr/bin/perl # -*- eval: (bug-reference-mode 1) -*- +use v5.14; + +my $str= < committer: Paul Eggert branch nick: trunk timestamp: Sun 2014-05-11 23:09:27 -0700 message: * configure.ac (EMACS_CHECK_MODULES): Fix typo in previous change. diff: === modified file 'ChangeLog' --- ChangeLog 2014-05-11 19:14:12 +0000 +++ ChangeLog 2014-05-12 06:09:27 +0000 @@ -1,3 +1,7 @@ +2014-05-12 Katsumi Yamaoka + + * configure.ac (EMACS_CHECK_MODULES): Fix typo in previous change. + 2014-05-11 Paul Eggert Work around bug in pkg-config before 0.26 (Bug#17438). === modified file 'configure.ac' --- configure.ac 2014-05-11 19:14:12 +0000 +++ configure.ac 2014-05-12 06:09:27 +0000 @@ -1366,7 +1366,7 @@ emacs_check_module_ok=false AS_IF([test -n "$PKG_CONFIG" && { $PKG_CONFIG --atleast-pkgconfig-version 0.26 || - { $PKG_CONFIG --cflags "$1" "$2" && $PKG_CONFIG --libs "$1" "$2"; } + { $PKG_CONFIG --cflags "$2" && $PKG_CONFIG --libs "$2"; } } >/dev/null 2>&AS_MESSAGE_LOG_FD], [PKG_CHECK_MODULES([$1], [$2], [$1_CFLAGS=`AS_ECHO(["$$1_CFLAGS"]) | sed -e "$edit_cflags"` ------------------------------------------------------------ revno: 117087 fixes bug: http://debbugs.gnu.org/17438 committer: Paul Eggert branch nick: trunk timestamp: Sun 2014-05-11 12:14:12 -0700 message: Work around bug in pkg-config before 0.26. * configure.ac (EMACS_CHECK_MODULES): Check for failed exit status of pkg-config, on older pkg-config versions that don't do it properly. diff: === modified file 'ChangeLog' --- ChangeLog 2014-05-11 02:52:00 +0000 +++ ChangeLog 2014-05-11 19:14:12 +0000 @@ -1,3 +1,10 @@ +2014-05-11 Paul Eggert + + Work around bug in pkg-config before 0.26 (Bug#17438). + * configure.ac (EMACS_CHECK_MODULES): Check for failed exit status + of pkg-config, on older pkg-config versions that don't do it + properly. + 2014-05-07 Glenn Morris * autogen.sh: Check for failing aclocal. === modified file 'configure.ac' --- configure.ac 2014-05-11 02:47:57 +0000 +++ configure.ac 2014-05-11 19:14:12 +0000 @@ -1354,15 +1354,29 @@ dnl EMACS_CHECK_MODULES(GSTUFF, gtk+-2.0 >= 1.3 glib = 1.3.4) dnl acts like PKG_CHECK_MODULES(GSTUFF, gtk+-2.0 >= 1.3 glib = 1.3.4, dnl HAVE_GSTUFF=yes, HAVE_GSTUFF=no) -- see pkg-config man page -- -dnl except that it postprocesses CFLAGS as needed for --enable-gcc-warnings. +dnl except that it works around older pkg-config bugs and +dnl it postprocesses CFLAGS as needed for --enable-gcc-warnings. dnl EMACS_CHECK_MODULES accepts optional 3rd and 4th arguments that dnl can take the place of the default HAVE_GSTUFF=yes and HAVE_GSTUFF=no dnl actions. AC_DEFUN([EMACS_CHECK_MODULES], - [PKG_CHECK_MODULES([$1], [$2], - [$1_CFLAGS=`AS_ECHO(["$$1_CFLAGS"]) | sed -e "$edit_cflags"` - m4_default([$3], [HAVE_$1=yes])], - [m4_default([$4], [HAVE_$1=no])])]) + [dnl pkg-config before 0.26 doesn't check exit status properly; see: + dnl https://bugs.freedesktop.org/show_bug.cgi?id=29801 + dnl Work around the bug by checking the status ourselves. + emacs_check_module_ok=false + AS_IF([test -n "$PKG_CONFIG" && + { $PKG_CONFIG --atleast-pkgconfig-version 0.26 || + { $PKG_CONFIG --cflags "$1" "$2" && $PKG_CONFIG --libs "$1" "$2"; } + } >/dev/null 2>&AS_MESSAGE_LOG_FD], + [PKG_CHECK_MODULES([$1], [$2], + [$1_CFLAGS=`AS_ECHO(["$$1_CFLAGS"]) | sed -e "$edit_cflags"` + emacs_check_module_ok=:], + [:])]) + if $emacs_check_module_ok; then + m4_default([$3], [HAVE_$1=yes]) + else + m4_default([$4], [HAVE_$1=no]) + fi]) HAVE_SOUND=no if test "${with_sound}" != "no"; then ------------------------------------------------------------ revno: 117086 committer: Stefan Monnier branch nick: trunk timestamp: Sun 2014-05-11 01:49:14 -0400 message: * lisp/mouse.el: Use the normal toplevel loop while dragging. (mouse-set-point): Handle multi-clicks. (mouse-set-region): Handle multi-clicks for drags. (mouse-drag-region): Update call accordingly. (mouse-drag-track): Remove `do-mouse-drag-region-post-process' hack. Use the normal event loop instead of a local while/read-event loop. (global-map): Remove redundant bindings for double/triple-mouse-1. * lisp/xt-mouse.el (xterm-mouse-translate-1): Only process one event at a time. Generate synthetic down events when the protocol only sends up events. (xterm-mouse-last): Remove. (xterm-mouse--read-event-sequence-1000): Use xterm-mouse-last-down terminal parameter instead. (xterm-mouse--set-click-count): New function. (xterm-mouse-event): Detect/generate double/triple clicks. * lisp/reveal.el (reveal-close-old-overlays): Don't close while dragging. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-05-11 03:49:53 +0000 +++ lisp/ChangeLog 2014-05-11 05:49:14 +0000 @@ -1,5 +1,21 @@ 2014-05-11 Stefan Monnier + * mouse.el: Use the normal toplevel loop while dragging. + (mouse-set-point): Handle multi-clicks. + (mouse-set-region): Handle multi-clicks for drags. + (mouse-drag-region): Update call accordingly. + (mouse-drag-track): Remove `do-mouse-drag-region-post-process' hack. + Use the normal event loop instead of a local while/read-event loop. + (global-map): Remove redundant bindings for double/triple-mouse-1. + * xt-mouse.el (xterm-mouse-translate-1): Only process one event at a time. + Generate synthetic down events when the protocol only sends up events. + (xterm-mouse-last): Remove. + (xterm-mouse--read-event-sequence-1000): Use xterm-mouse-last-down + terminal parameter instead. + (xterm-mouse--set-click-count): New function. + (xterm-mouse-event): Detect/generate double/triple clicks. + * reveal.el (reveal-close-old-overlays): Don't close while dragging. + * info.el (Info-quoted): New face. (Info-mode-font-lock-keywords): New var. (Info-mode): Use it. === modified file 'lisp/mouse.el' --- lisp/mouse.el 2014-02-10 01:34:22 +0000 +++ lisp/mouse.el 2014-05-11 05:49:14 +0000 @@ -514,14 +514,18 @@ (interactive "e") (mouse-drag-line start-event 'vertical)) -(defun mouse-set-point (event) +(defun mouse-set-point (event &optional promote-to-region) "Move point to the position clicked on with the mouse. -This should be bound to a mouse click event type." - (interactive "e") +This should be bound to a mouse click event type. +If PROMOTE-TO-REGION is non-nil and event is a multiple-click, +select the corresponding element around point." + (interactive "e\np") (mouse-minibuffer-check event) - ;; Use event-end in case called from mouse-drag-region. - ;; If EVENT is a click, event-end and event-start give same value. - (posn-set-point (event-end event))) + (if (and promote-to-region (> (event-click-count event) 1)) + (mouse-set-region event) + ;; Use event-end in case called from mouse-drag-region. + ;; If EVENT is a click, event-end and event-start give same value. + (posn-set-point (event-end event)))) (defvar mouse-last-region-beg nil) (defvar mouse-last-region-end nil) @@ -534,6 +538,8 @@ (eq mouse-last-region-end (region-end)) (eq mouse-last-region-tick (buffer-modified-tick)))) +(defvar mouse--drag-start-event nil) + (defun mouse-set-region (click) "Set the region to the text dragged over, and copy to kill ring. This should be bound to a mouse drag event. @@ -543,7 +549,22 @@ (mouse-minibuffer-check click) (select-window (posn-window (event-start click))) (let ((beg (posn-point (event-start click))) - (end (posn-point (event-end click)))) + (end (posn-point (event-end click))) + (click-count (event-click-count click))) + (let ((drag-start (terminal-parameter nil 'mouse-drag-start))) + ;; Drag events don't come with a click count, sadly, so we hack + ;; our way around this problem by remembering the start-event in + ;; `mouse-drag-start' and fetching the click-count from there. + (when drag-start + (when (and (<= click-count 1) + (equal beg (posn-point (event-start drag-start)))) + (setq click-count (event-click-count drag-start))) + (setf (terminal-parameter nil 'mouse-drag-start) nil))) + (when (and (integerp beg) (integerp end)) + (let ((range (mouse-start-end beg end (1- click-count)))) + (if (< end beg) + (setq end (nth 0 range) beg (nth 1 range)) + (setq beg (nth 0 range) end (nth 1 range))))) (and mouse-drag-copy-region (integerp beg) (integerp end) ;; Don't set this-command to `kill-region', so a following ;; C-w won't double the text in the kill ring. Ignore @@ -637,13 +658,11 @@ Highlight the drag area as you move the mouse. This must be bound to a button-down mouse event. In Transient Mark mode, the highlighting remains as long as the mark -remains active. Otherwise, it remains until the next input event. - -If the click is in the echo area, display the `*Messages*' buffer." +remains active. Otherwise, it remains until the next input event." (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) - (mouse-drag-track start-event t)) + (mouse-drag-track start-event)) (defun mouse-posn-property (pos property) @@ -747,12 +766,9 @@ "mouse-1" (substring msg 7))))))) msg) -(defun mouse-drag-track (start-event &optional - do-mouse-drag-region-post-process) +(defun mouse-drag-track (start-event) "Track mouse drags by highlighting area between point and cursor. -The region will be defined with mark and point. -DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by -`mouse-drag-region'." +The region will be defined with mark and point." (mouse-minibuffer-check start-event) (setq mouse-selection-click-count-buffer (current-buffer)) (deactivate-mark) @@ -765,8 +781,6 @@ (start-posn (event-start start-event)) (start-point (posn-point start-posn)) (start-window (posn-window start-posn)) - (start-window-start (window-start start-window)) - (start-hscroll (window-hscroll start-window)) (bounds (window-edges start-window)) (make-cursor-line-fully-visible nil) (top (nth 1 bounds)) @@ -777,9 +791,7 @@ (click-count (1- (event-click-count start-event))) ;; Suppress automatic hscrolling, because that is a nuisance ;; when setting point near the right fringe (but see below). - (auto-hscroll-mode-saved auto-hscroll-mode) - (auto-hscroll-mode nil) - moved-off-start event end end-point) + (auto-hscroll-mode-saved auto-hscroll-mode)) (setq mouse-selection-click-count click-count) ;; In case the down click is in the middle of some intangible text, @@ -798,23 +810,21 @@ (push-mark (nth 0 range) t t) (goto-char (nth 1 range))) - ;; Track the mouse until we get a non-movement event. - (track-mouse - (while (progn - (setq event (read-event)) - (or (mouse-movement-p event) - (memq (car-safe event) '(switch-frame select-window)))) - (unless (memq (car-safe event) '(switch-frame select-window)) - ;; Automatic hscrolling did not occur during the call to - ;; `read-event'; but if the user subsequently drags the - ;; mouse, go ahead and hscroll. - (let ((auto-hscroll-mode auto-hscroll-mode-saved)) - (redisplay)) - (setq end (event-end event) - end-point (posn-point end)) - ;; Note whether the mouse has left the starting position. + (setf (terminal-parameter nil 'mouse-drag-start) start-event) + (setq track-mouse t) + (setq auto-hscroll-mode nil) + + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map [switch-frame] #'ignore) + (define-key map [select-window] #'ignore) + (define-key map [mouse-movement] + (lambda (event) (interactive "e") + (let* ((end (event-end event)) + (end-point (posn-point end))) (unless (eq end-point start-point) - (setq moved-off-start t)) + ;; As soon as the user moves, we can re-enable auto-hscroll. + (setq auto-hscroll-mode auto-hscroll-mode-saved)) (if (and (eq (posn-window end) start-window) (integer-or-marker-p end-point)) (mouse--drag-set-mark-and-point start-point @@ -828,55 +838,12 @@ ((>= mouse-row bottom) (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) nil start-point)))))))) - - ;; Handle the terminating event if possible. - (when (consp event) - ;; Ensure that point is on the end of the last event. - (when (and (setq end-point (posn-point (event-end event))) - (eq (posn-window end) start-window) - (integer-or-marker-p end-point) - (/= start-point end-point)) - (mouse--drag-set-mark-and-point start-point - end-point click-count)) - - ;; Find its binding. - (let* ((fun (key-binding (vector (car event)))) - ;; FIXME This doesn't make sense, because - ;; event-click-count always returns something >= 1. - (do-multi-click (and (> (event-click-count event) 0) - (functionp fun) - (not (memq fun '(mouse-set-point - mouse-set-region)))))) - (if (and (/= (mark) (point)) - (not do-multi-click)) - - ;; If point has moved, finish the drag. - (let* (last-command this-command) - (and mouse-drag-copy-region - do-mouse-drag-region-post-process - (let (deactivate-mark) - (copy-region-as-kill (mark) (point))))) - - ;; Otherwise, run binding of terminating up-event. + map) + t (lambda () + (setq track-mouse nil) + (setq auto-hscroll-mode auto-hscroll-mode-saved) (deactivate-mark) - (if do-multi-click - (goto-char start-point) - (unless moved-off-start - (pop-mark))) - - (when (and (functionp fun) - (= start-hscroll (window-hscroll start-window)) - ;; Don't run the up-event handler if the window - ;; start changed in a redisplay after the - ;; mouse-set-point for the down-mouse event at - ;; the beginning of this function. When the - ;; window start has changed, the up-mouse event - ;; contains a different position due to the new - ;; window contents, and point is set again. - (or end-point - (= (window-start start-window) - start-window-start))) - (push event unread-command-events))))))) + (pop-mark))))) (defun mouse--drag-set-mark-and-point (start click click-count) (let* ((range (mouse-start-end start click click-count)) @@ -1904,14 +1871,10 @@ ;;; Bindings for mouse commands. -(define-key global-map [down-mouse-1] 'mouse-drag-region) +(global-set-key [down-mouse-1] 'mouse-drag-region) (global-set-key [mouse-1] 'mouse-set-point) (global-set-key [drag-mouse-1] 'mouse-set-region) -;; These are tested for in mouse-drag-region. -(global-set-key [double-mouse-1] 'mouse-set-point) -(global-set-key [triple-mouse-1] 'mouse-set-point) - (defun mouse--strip-first-event (_prompt) (substring (this-single-command-raw-keys) 1)) === modified file 'lisp/reveal.el' --- lisp/reveal.el 2014-01-01 07:43:34 +0000 +++ lisp/reveal.el 2014-05-11 05:49:14 +0000 @@ -83,7 +83,8 @@ (cond ((eq (car x) (selected-window)) (cdr x)) ((not (and (window-live-p (car x)) - (eq (window-buffer (car x)) (current-buffer)))) + (eq (window-buffer (car x)) + (current-buffer)))) ;; Adopt this since it's owned by a window that's ;; either not live or at least not showing this ;; buffer any more. @@ -135,8 +136,9 @@ old-ols) (defun reveal-close-old-overlays (old-ols) - (if (not (eq reveal-last-tick - (setq reveal-last-tick (buffer-modified-tick)))) + (if (or track-mouse ;Don't close in the middle of a click. + (not (eq reveal-last-tick + (setq reveal-last-tick (buffer-modified-tick))))) ;; The buffer was modified since last command: let's refrain from ;; closing any overlay because it tends to behave poorly when ;; inserting text at the end of an overlay (basically the overlay === modified file 'lisp/xt-mouse.el' --- lisp/xt-mouse.el 2014-05-08 03:41:21 +0000 +++ lisp/xt-mouse.el 2014-05-11 05:49:14 +0000 @@ -42,13 +42,12 @@ (defvar xterm-mouse-debug-buffer nil) -(defvar xterm-mouse-last) - ;; Mouse events symbols must have an 'event-kind property with ;; the value 'mouse-click. -(dolist (event-type '(mouse-1 mouse-2 mouse-3 - M-down-mouse-1 M-down-mouse-2 M-down-mouse-3)) - (put event-type 'event-kind 'mouse-click)) +(dolist (event '(mouse-1 mouse-2 mouse-3 mouse-4 mouse-5)) + (let ((M-event (intern (concat "M-" (symbol-name event))))) + (put event 'event-kind 'mouse-click) + (put M-event 'event-kind 'mouse-click))) (defun xterm-mouse-translate (_event) "Read a click and release event from XTerm." @@ -65,59 +64,47 @@ (save-excursion (save-window-excursion ;FIXME: Why? (deactivate-mark) ;FIXME: Why? - (let* ((xterm-mouse-last nil) - (down (xterm-mouse-event extension)) - (down-command (nth 0 down)) - (down-data (nth 1 down)) - (down-where (nth 1 down-data)) - (down-binding (key-binding (if (symbolp down-where) - (vector down-where down-command) - (vector down-command)))) - (is-down (string-match "down" (symbol-name (car down))))) - - ;; Retrieve the expected preface for the up-event. - (unless is-down - (unless (cond ((null extension) - (and (eq (read-event) ?\e) - (eq (read-event) ?\[) - (eq (read-event) ?M))) - ((eq extension 1006) - (and (eq (read-event) ?\e) - (eq (read-event) ?\[) - (eq (read-event) ?<)))) - (error "Unexpected escape sequence from XTerm"))) - - ;; Process the up-event. - (let* ((click (if is-down (xterm-mouse-event extension) down)) - (click-data (nth 1 click)) - (click-where (nth 1 click-data))) + (let* ((event (xterm-mouse-event extension)) + (ev-command (nth 0 event)) + (ev-data (nth 1 event)) + (ev-where (nth 1 ev-data)) + (vec (if (and (symbolp ev-where) (consp ev-where)) + ;; FIXME: This condition can *never* be non-nil!?! + (vector (list ev-where ev-data) event) + (vector event))) + (is-down (string-match "down-" (symbol-name ev-command)))) + (cond - ((null down) nil) - ((memq down-binding '(nil ignore)) - (if (and (symbolp click-where) - (consp click-where)) - (vector (list click-where click-data) click) - (vector click))) + ((null event) nil) ;Unknown/bogus byte sequence! + (is-down + (setf (terminal-parameter nil 'xterm-mouse-last-down) event) + vec) + (t + (let* ((down (terminal-parameter nil 'xterm-mouse-last-down)) + (down-data (nth 1 down)) + (down-where (nth 1 down-data))) + (setf (terminal-parameter nil 'xterm-mouse-last-down) nil) + (cond + ((null down) + ;; This is an "up-only" event. Pretend there was an up-event + ;; right before and keep the up-event for later. + (push event unread-command-events) + (vector (cons (intern (replace-regexp-in-string + "\\`\\([ACMHSs]-\\)*" "\\&down-" + (symbol-name ev-command) t)) + (cdr event)))) + ((equal ev-where down-where) vec) (t - (setq unread-command-events - (append (if (eq down-where click-where) - (list click) - (list - ;; Cheat `mouse-drag-region' with move event. - (list 'mouse-movement click-data) - ;; Generate a drag event. - (if (symbolp down-where) - 0 - (list (intern (format "drag-mouse-%d" - (1+ xterm-mouse-last))) - down-data click-data)))) - unread-command-events)) - (if xterm-mouse-debug-buffer - (print unread-command-events xterm-mouse-debug-buffer)) - (if (and (symbolp down-where) - (consp down-where)) - (vector (list down-where down-data) down) - (vector down))))))))) + (let ((drag (if (symbolp ev-where) + 0 ;FIXME: Why?!? + (list (replace-regexp-in-string + "\\`\\([ACMHSs]-\\)*" "\\&drag-" + (symbol-name ev-command) t) + down-data ev-data)))) + (if (null track-mouse) + (vector drag) + (push drag unread-command-events) + (vector (list 'mouse-movement ev-data))))))))))))) ;; These two variables have been converted to terminal parameters. ;; @@ -165,16 +152,14 @@ (cond ((>= code 64) (format "mouse-%d" (- code 60))) ((memq code '(8 9 10)) - (setq xterm-mouse-last (- code 8)) (format "M-down-mouse-%d" (- code 7))) - ((and (= code 11) xterm-mouse-last) - (format "M-mouse-%d" (1+ xterm-mouse-last))) - ((and (= code 3) xterm-mouse-last) - ;; For buttons > 5 xterm only reports a button-release event. - ;; Drop them since they're not usable and can be spurious. - (format "mouse-%d" (1+ xterm-mouse-last))) + ((memq code '(3 11)) + (let ((down (car (terminal-parameter + nil 'xterm-mouse-last-down)))) + (when (and down (string-match "[0-9]" (symbol-name down))) + (format (if (eq code 3) "mouse-%s" "M-mouse-%s") + (match-string 0 (symbol-name down)))))) ((memq code '(0 1 2)) - (setq xterm-mouse-last code) (format "down-mouse-%d" (+ 1 code)))))) (x (- (read-event) 33)) (y (- (read-event) 33))) @@ -212,10 +197,20 @@ (if down "down-" "") (if wheel (- code 60) - (1+ (setq xterm-mouse-last (mod code 4))))))) + (1+ (mod code 4)))))) (1- (string-to-number (apply 'string (nreverse x-bytes)))) (1- (string-to-number (apply 'string (nreverse y-bytes))))))) +(defun xterm-mouse--set-click-count (event click-count) + (setcdr (cdr event) (list click-count)) + (let ((name (symbol-name (car event)))) + (when (string-match "\\(.*?\\)\\(\\(?:down-\\)?mouse-.*\\)" name) + (setcar event + (intern (concat (match-string 1 name) + (if (= click-count 2) + "double-" "triple-") + (match-string 2 name))))))) + (defun xterm-mouse-event (&optional extension) "Convert XTerm mouse event to Emacs mouse event. EXTENSION, if non-nil, means to use an extension to the usual @@ -241,18 +236,42 @@ (w (window-at x y)) (ltrb (window-edges w)) (left (nth 0 ltrb)) - (top (nth 1 ltrb))) + (top (nth 1 ltrb)) + (posn (if w + (posn-at-x-y (- x left) (- y top) w t) + (append (list nil 'menu-bar) + (nthcdr 2 (posn-at-x-y x y))))) + (event (list type posn))) + (setcar (nthcdr 3 posn) timestamp) + + ;; Try to handle double/triple clicks. + (let* ((last-click (terminal-parameter nil 'xterm-mouse-last-click)) + (last-type (nth 0 last-click)) + (last-name (symbol-name last-type)) + (last-time (nth 1 last-click)) + (click-count (nth 2 last-click)) + (this-time (float-time)) + (name (symbol-name type))) + (cond + ((not (string-match "down-" name)) + ;; For up events, make the up side match the down side. + (setq this-time last-time) + (when (and (> click-count 1) + (string-match "down-" last-name) + (equal name (replace-match "" t t last-name))) + (xterm-mouse--set-click-count event click-count))) + ((not last-time) nil) + ((and (> double-click-time (* 1000 (- this-time last-time))) + (equal last-name (replace-match "" t t name))) + (setq click-count (1+ click-count)) + (xterm-mouse--set-click-count event click-count)) + (t (setq click-count 1))) + (set-terminal-parameter nil 'xterm-mouse-last-click + (list type this-time click-count))) + (set-terminal-parameter nil 'xterm-mouse-x x) (set-terminal-parameter nil 'xterm-mouse-y y) - (setq - last-input-event - (list type - (let ((event (if w - (posn-at-x-y (- x left) (- y top) w t) - (append (list nil 'menu-bar) - (nthcdr 2 (posn-at-x-y x y)))))) - (setcar (nthcdr 3 event) timestamp) - event))))))) + (setq last-input-event event))))) ;;;###autoload (define-minor-mode xterm-mouse-mode ------------------------------------------------------------ Use --include-merged or -n0 to see merged revisions.