Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 102709. ------------------------------------------------------------ revno: 102709 committer: Stefan Monnier branch nick: trunk timestamp: Sun 2010-12-26 20:27:08 -0500 message: * admin/bzrmerge.el: New file to help merge branches while skipping some revisions (e.g. from emacs-23 to trunk). diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2010-12-03 22:08:05 +0000 +++ admin/ChangeLog 2010-12-27 01:27:08 +0000 @@ -1,3 +1,8 @@ +2010-12-27 Stefan Monnier + + * bzrmerge.el: New file to help merge branches while skipping + some revisions (e.g. from emacs-23 to trunk). + 2010-12-03 Andreas Schwab * CPP-DEFINES (EXPLICIT_SIGN_EXTEND): Remove. === added file 'admin/bzrmerge.el' --- admin/bzrmerge.el 1970-01-01 00:00:00 +0000 +++ admin/bzrmerge.el 2010-12-27 01:27:08 +0000 @@ -0,0 +1,296 @@ +;;; bzrmerge.el --- + +;; Copyright (C) 2010 Stefan Monnier + +;; Author: Stefan Monnier +;; Keywords: + +;; This program 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 of the License, or +;; (at your option) any later version. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(defun bzrmerge-merges () + "Return the list of already merged (not not committed) revisions. +The list returned is sorted by oldest-first." + (with-current-buffer (get-buffer-create "*bzrmerge*") + (erase-buffer) + ;; We generally want to make sure we start with a clean tree, but we also + ;; want to allow restarts (i.e. with some part of FROM already merged but + ;; not yet committed). + (call-process "bzr" nil t nil "status" "-v") + (goto-char (point-min)) + (when (re-search-forward "^conflicts:\n" nil t) + (error "You still have unresolved conflicts")) + (let ((merges ())) + (if (not (re-search-forward "^pending merges:\n" nil t)) + (when (save-excursion + (goto-char (point-min)) + (re-search-forward "^[a-z ]*:\n" nil t)) + (error "You still have uncommitted changes")) + ;; This is really stupid, but it seems there's no easy way to figure + ;; out which revisions have been merged already. The only info I can + ;; find is the "pending merges" from "bzr status -v", which is not + ;; very machine-friendly. + (while (not (eobp)) + (skip-chars-forward " ") + (push (buffer-substring (point) (line-end-position)) merges) + (forward-line 1))) + merges))) + +(defun bzrmerge-check-match (merge) + ;; Make sure the MERGES match the revisions on the FROM branch. + ;; Stupidly the best form of MERGES I can find is the one from + ;; "bzr status -v" which is very machine non-friendly, so I have + ;; to do some fuzzy matching. + (let ((author + (or + (save-excursion + (if (re-search-forward "^author: *\\([^<]*[^ ]\\) +<.*" + nil t) + (match-string 1))) + (save-excursion + (if (re-search-forward + "^committer: *\\([^<]*[^< ]\\) +<" nil t) + (match-string 1))))) + (timestamp + (save-excursion + (if (re-search-forward + "^timestamp:[^0-9]*\\([-0-9]+\\)" nil t) + (match-string 1)))) + (line1 + (save-excursion + (if (re-search-forward "^message:[ \n]*" nil t) + (buffer-substring (point) (line-end-position)))))) + ;; The `merge' may have a truncated line1 with "...", so get + ;; rid of any "..." and then look for a prefix match. + (when (string-match "\\.+\\'" merge) + (setq merge (substring merge 0 (match-beginning 0)))) + (or (string-prefix-p + merge (concat author " " timestamp " " line1)) + (string-prefix-p + merge (concat author " " timestamp " [merge] " line1))))) + +(defun bzrmerge-missing (from merges) + "Return the list of revisions that need to be merged. +MERGES is the revisions already merged but not yet committed. +The result is of the form (TOMERGE . TOSKIP) where TOMERGE and TOSKIP +are both lists of revnos, in oldest-first order." + (with-current-buffer (get-buffer-create "*bzrmerge*") + (erase-buffer) + (call-process "bzr" nil t nil "missing" "--theirs-only" + (expand-file-name from)) + (let ((revnos ()) (skipped ())) + (pop-to-buffer (current-buffer)) + (goto-char (point-max)) + (while (re-search-backward "^------------------------------------------------------------\nrevno: \\([0-9.]+\\).*" nil t) + (save-excursion + (if merges + (while (not (bzrmerge-check-match (pop merges))) + (unless merges + (error "Unmatched tip of merged revisions"))) + (let ((case-fold-search t) + (revno (match-string 1)) + (skip nil)) + (if (string-match "\\." revno) + (error "Unexpected dotted revno!") + (setq revno (string-to-number revno))) + (re-search-forward "^message:\n") + (while (and (not skip) + (re-search-forward + "back[- ]?port\\|merge\\|re-?generate\\|bump version" nil t)) + (let ((str (buffer-substring (line-beginning-position) + (line-end-position)))) + (when (string-match "\\` *" str) + (setq str (substring str (match-end 0)))) + (when (string-match "[.!;, ]+\\'" str) + (setq str (substring str 0 (match-beginning 0)))) + (if (save-excursion (y-or-n-p (concat str ": Skip? "))) + (setq skip t)))) + (if skip + (push revno skipped) + (push revno revnos))))) + (delete-region (point) (point-max))) + (cons (nreverse revnos) (nreverse skipped))))) + +(defun bzrmerge-resolve (file) + (unless (file-exists-p file) (error "Bzrmerge-resolve: Can't find %s" file)) + (with-demoted-errors + (let ((exists (find-buffer-visiting file))) + (with-current-buffer (find-file-noselect file) + (if (buffer-modified-p) + (error "Unsaved changes in %s" (current-buffer))) + (save-excursion + (cond + ((derived-mode-p 'change-log-mode) + ;; Fix up dates before resolving the conflicts. + (goto-char (point-min)) + (let ((diff-auto-refine-mode nil)) + (while (re-search-forward smerge-begin-re nil t) + (smerge-match-conflict) + (smerge-ensure-match 3) + (let ((start1 (match-beginning 1)) + (end1 (match-end 1)) + (start3 (match-beginning 3)) + (end3 (copy-marker (match-end 3) t))) + (goto-char start3) + (while (re-search-forward change-log-start-entry-re end3 t) + (let* ((str (match-string 0)) + (newstr (save-match-data + (concat (add-log-iso8601-time-string) + (when (string-match " *\\'" str) + (match-string 0 str)))))) + (replace-match newstr t t))) + ;; change-log-resolve-conflict prefers to put match-1's + ;; elements first (for equal dates), whereas we want to put + ;; match-3's first. + (let ((match3 (buffer-substring start3 end3)) + (match1 (buffer-substring start1 end1))) + (delete-region start3 end3) + (goto-char start3) + (insert match1) + (delete-region start1 end1) + (goto-char start1) + (insert match3))))) + ;; (pop-to-buffer (current-buffer)) (debug 'before-resolve) + )) + ;; Try to resolve the conflicts. + (cond + ((member file '("configure" "lisp/ldefs-boot.el")) + (call-process "bzr" nil t nil "revert" file) + (revert-buffer nil 'noconfirm)) + (t + (goto-char (point-max)) + (while (re-search-backward smerge-begin-re nil t) + (save-excursion + (ignore-errors + (smerge-match-conflict) + (smerge-resolve)))) + ;; (when (derived-mode-p 'change-log-mode) + ;; (pop-to-buffer (current-buffer)) (debug 'after-resolve)) + (save-buffer))) + (goto-char (point-min)) + (prog1 (re-search-forward smerge-begin-re nil t) + (unless exists (kill-buffer)))))))) + +(defun bzrmerge-add-metadata (from endrevno) + "Add the metadata for a merge of FROM upto ENDREVNO. +Does not make other difference." + (if (with-temp-buffer + (call-process "bzr" nil t nil "status") + (goto-char (point-min)) + (re-search-forward "^conflicts:\n" nil t)) + (error "Don't know how to add metadata in the presence of conflicts") + (call-process "bzr" nil t nil "shelve" "--all" + "-m" "Bzrmerge shelved merge during skipping") + (call-process "bzr" nil t nil "revert") + (call-process "bzr" nil t nil + "merge" "-r" (format "%s" endrevno) from) + (call-process "bzr" nil t nil "revert" ".") + (call-process "bzr" nil t nil "unshelve"))) + +(defvar bzrmerge-already-done nil) + +(defun bzrmerge-apply (missing from) + (setq from (expand-file-name from)) + (with-current-buffer (get-buffer-create "*bzrmerge*") + (erase-buffer) + (when (equal (cdr bzrmerge-already-done) (list from missing)) + (setq missing (car bzrmerge-already-done))) + (setq bzrmerge-already-done nil) + (let ((merge (car missing)) + (skip (cdr missing)) + beg end) + (when (or merge skip) + (cond + ((and skip (or (null merge) (< (car skip) (car merge)))) + ;; Do a "skip" (i.e. merge the meta-data only). + (setq beg (1- (car skip))) + (while (and skip (or (null merge) (< (car skip) (car merge)))) + (assert (> (car skip) (or end beg))) + (setq end (pop skip))) + (message "Skipping %s..%s" beg end) + (bzrmerge-add-metadata from end)) + + (t + ;; Do a "normal" merge. + (assert (or (null skip) (< (car merge) (car skip)))) + (setq beg (1- (car merge))) + (while (and merge (or (null skip) (< (car merge) (car skip)))) + (assert (> (car merge) (or end beg))) + (setq end (pop merge))) + (message "Merging %s..%s" beg end) + (if (with-temp-buffer + (call-process "bzr" nil t nil "status") + (zerop (buffer-size))) + (call-process "bzr" nil t nil + "merge" "-r" (format "%s" end) from) + ;; Stupidly, "bzr merge --force -r A..B" dos not maintain the + ;; metadata properly except when the checkout is clean. + (call-process "bzr" nil t nil "merge" + "--force" "-r" (format "%s..%s" beg end) from) + ;; The merge did not update the metadata, so force the next time + ;; around to update it (as a "skip"). + (push end skip)) + (pop-to-buffer (current-buffer)) + (sit-for 1) + ;; (debug 'after-merge) + ;; Check the conflicts. + (let ((conflicted nil) + (files ())) + (goto-char (point-min)) + (when (re-search-forward "bzr: ERROR:" nil t) + (error "Internal Bazaar error!!")) + (while (re-search-forward "^Text conflict in " nil t) + (push (buffer-substring (point) (line-end-position)) files)) + (if (re-search-forward "^\\([0-9]+\\) conflicts encountered" nil t) + (if (/= (length files) (string-to-number (match-string 1))) + (setq conflicted t)) + (if files (setq conflicted t))) + (dolist (file files) + (if (bzrmerge-resolve file) + (setq conflicted t))) + (when conflicted + (setq bzrmerge-already-done + (list (cons merge skip) from missing)) + (error "Resolve conflicts manually"))))) + (cons merge skip))))) + +(defun bzrmerge (from) + "Merge from branch FROM into `default-directory'." + (interactive + (list + (let ((def + (with-temp-buffer + (call-process "bzr" nil t nil "info") + (goto-char (point-min)) + (when (re-search-forward "submit branch: *" nil t) + (buffer-substring (point) (line-end-position)))))) + (read-file-name "From branch: " nil nil nil def)))) + (message "Merging from %s..." from) + (require 'vc-bzr) + (let ((default-directory (or (vc-bzr-root default-directory) + (error "Not in a Bzr tree")))) + ;; First, check the status. + (let* ((merges (bzrmerge-merges)) + ;; OK, we have the status, now check the missing data. + (missing (bzrmerge-missing from merges))) + (while missing + (setq missing (bzrmerge-apply missing from)))))) + +(provide 'bzrmerge) +;;; bzrmerge.el ends here ------------------------------------------------------------ revno: 102708 committer: Stefan Monnier branch nick: trunk timestamp: Sun 2010-12-26 18:17:09 -0500 message: * lisp/emacs-lisp/rx.el: Make it a superset of sregex. (rx-constituents): Add `any => "."', mark `repeat' as taking any number of args, add `regex' alias. (rx-info): Add arg to distinguish head and standalone forms. (rx-check, rx-form): Pass the corresponding arg. (rx-**): Simplify. (rx-repeat): Make it work for any number of args. (rx-syntax): Make it accept syntax chars as is. * lisp/obsolete/sregex.el: Move from emacs-lisp/. * lisp/emacs-lisp/re-builder.el: Remove sregex support. * lisp/emacs-lisp/edebug.el (sregexq, rx): Remove redundant defs. diff: === modified file 'etc/NEWS' --- etc/NEWS 2010-12-20 11:11:30 +0000 +++ etc/NEWS 2010-12-26 23:17:09 +0000 @@ -541,6 +541,8 @@ *** An API for manipulating SQL product definitions has been added. +** sregex.el is now obsolete, since rx.el is a strict superset. + ** s-region.el is now declared obsolete, superceded by shift-select-mode enabled by default in 23.1. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-12-25 10:57:02 +0000 +++ lisp/ChangeLog 2010-12-26 23:17:09 +0000 @@ -1,3 +1,17 @@ +2010-12-26 Stefan Monnier + + * emacs-lisp/rx.el: Make it a superset of sregex. + (rx-constituents): Add `any => "."', mark `repeat' as taking any number + of args, add `regex' alias. + (rx-info): Add arg to distinguish head and standalone forms. + (rx-check, rx-form): Pass the corresponding arg. + (rx-**): Simplify. + (rx-repeat): Make it work for any number of args. + (rx-syntax): Make it accept syntax chars as is. + * obsolete/sregex.el: Move from emacs-lisp/. + * emacs-lisp/re-builder.el: Remove sregex support. + * emacs-lisp/edebug.el (sregexq, rx): Remove redundant defs. + 2010-12-25 Eli Zaretskii * mouse.el (mouse-yank-primary): On MS-Windows, try the (emulated) @@ -19,8 +33,8 @@ 2010-12-21 Daiki Ueno * obsolete/pgg-parse.el, obsolete/pgg-pgp5.el, obsolete/pgg-pgp.el, - * obsolete/pgg-gpg.el, obsolete/pgg-def.el, obsolete/pgg.el: Move - from lisp/. + * obsolete/pgg-gpg.el, obsolete/pgg-def.el, obsolete/pgg.el: + Move from lisp/. 2010-12-20 Leo === modified file 'lisp/emacs-lisp/edebug.el' --- lisp/emacs-lisp/edebug.el 2010-11-06 20:23:42 +0000 +++ lisp/emacs-lisp/edebug.el 2010-12-26 23:17:09 +0000 @@ -2131,8 +2131,6 @@ (def-edebug-spec with-custom-print body) -(def-edebug-spec sregexq (&rest sexp)) -(def-edebug-spec rx (&rest sexp)) ;;; The debugger itself === modified file 'lisp/emacs-lisp/re-builder.el' --- lisp/emacs-lisp/re-builder.el 2010-07-27 23:38:46 +0000 +++ lisp/emacs-lisp/re-builder.el 2010-12-26 23:17:09 +0000 @@ -60,8 +60,8 @@ ;; even the auto updates go all the way. Forcing an update overrides ;; this limit allowing an easy way to see all matches. -;; Currently `re-builder' understands five different forms of input, -;; namely `read', `string', `rx', and `sregex' syntax. Read +;; Currently `re-builder' understands three different forms of input, +;; namely `read', `string', and `rx' syntax. Read ;; syntax and string syntax are both delimited by `"'s and behave ;; according to their name. With the `string' syntax there's no need ;; to escape the backslashes and double quotes simplifying the editing @@ -75,7 +75,7 @@ ;; When editing a symbolic regular expression, only the first ;; expression in the RE Builder buffer is considered, which helps ;; limiting the extent of the expression like the `"'s do for the text -;; modes. For the `sregex' syntax the function `sregex' is applied to +;; modes. For the `rx' syntax the function `rx-to-string' is applied to ;; the evaluated expression read. So you can use quoted arguments ;; with something like '("findme") or you can construct arguments to ;; your hearts delight with a valid ELisp expression. (The compiled @@ -126,11 +126,10 @@ (defcustom reb-re-syntax 'read "Syntax for the REs in the RE Builder. -Can either be `read', `string', `sregex', or `rx'." +Can either be `read', `string', or `rx'." :group 're-builder :type '(choice (const :tag "Read syntax" read) (const :tag "String syntax" string) - (const :tag "`sregex' syntax" sregex) (const :tag "`rx' syntax" rx))) (defcustom reb-auto-match-limit 200 @@ -279,10 +278,8 @@ emacs-lisp-mode "RE Builder Lisp" "Major mode for interactively building symbolic Regular Expressions." ;; Pull in packages as needed - (cond ((eq reb-re-syntax 'sregex) ; sregex is not autoloaded - (require 'sregex)) ; right now.. - ((eq reb-re-syntax 'rx) ; rx-to-string is autoloaded - (require 'rx))) ; require rx anyway + (cond ((memq reb-re-syntax '(sregex rx)) ; rx-to-string is autoloaded + (require 'rx))) ; require rx anyway (reb-mode-common)) ;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from @@ -612,9 +609,7 @@ (defun reb-cook-regexp (re) "Return RE after processing it according to `reb-re-syntax'." - (cond ((eq reb-re-syntax 'sregex) - (apply 'sregex (eval (car (read-from-string re))))) - ((eq reb-re-syntax 'rx) + (cond ((memq reb-re-syntax '(sregex rx)) (rx-to-string (eval (car (read-from-string re))))) (t re))) === modified file 'lisp/emacs-lisp/rx.el' --- lisp/emacs-lisp/rx.el 2010-09-05 09:44:55 +0000 +++ lisp/emacs-lisp/rx.el 2010-12-26 23:17:09 +0000 @@ -120,19 +120,17 @@ (nonl . not-newline) ; SRE (anything . (rx-anything 0 nil)) (any . (rx-any 1 nil rx-check-any)) ; inconsistent with SRE + (any . ".") ; sregex (in . any) (char . any) ; sregex (not-char . (rx-not-char 1 nil rx-check-any)) ; sregex (not . (rx-not 1 1 rx-check-not)) - ;; Partially consistent with sregex, whose `repeat' is like our - ;; `**'. (`repeat' with optional max arg and multiple sexp forms - ;; is ambiguous.) - (repeat . (rx-repeat 2 3)) + (repeat . (rx-repeat 2 nil)) (= . (rx-= 2 nil)) ; SRE (>= . (rx->= 2 nil)) ; SRE (** . (rx-** 2 nil)) ; SRE (submatch . (rx-submatch 1 nil)) ; SRE - (group . submatch) + (group . submatch) ; sregex (zero-or-more . (rx-kleene 1 nil)) (one-or-more . (rx-kleene 1 nil)) (zero-or-one . (rx-kleene 1 nil)) @@ -175,6 +173,7 @@ (category . (rx-category 1 1 rx-check-category)) (eval . (rx-eval 1 1)) (regexp . (rx-regexp 1 1 stringp)) + (regex . regexp) ; sregex (digit . "[[:digit:]]") (numeric . digit) ; SRE (num . digit) ; SRE @@ -295,15 +294,27 @@ `zero-or-more', and `one-or-more'. Dynamically bound.") -(defun rx-info (op) +(defun rx-info (op head) "Return parsing/code generation info for OP. If OP is the space character ASCII 32, return info for the symbol `?'. If OP is the character `?', return info for the symbol `??'. -See also `rx-constituents'." +See also `rx-constituents'. +If HEAD is non-nil, then OP is the head of a sexp, otherwise it's +a standalone symbol." (cond ((eq op ? ) (setq op '\?)) ((eq op ??) (setq op '\??))) - (while (and (not (null op)) (symbolp op)) - (setq op (cdr (assq op rx-constituents)))) + (let (old-op) + (while (and (not (null op)) (symbolp op)) + (setq old-op op) + (setq op (cdr (assq op rx-constituents))) + (when (if head (stringp op) (consp op)) + ;; We found something but of the wrong kind. Let's look for an + ;; alternate definition for the other case. + (let ((new-op + (cdr (assq old-op (cdr (memq (assq old-op rx-constituents) + rx-constituents)))))) + (if (and new-op (not (if head (stringp new-op) (consp new-op)))) + (setq op new-op)))))) op) @@ -311,7 +322,7 @@ "Check FORM according to its car's parsing info." (unless (listp form) (error "rx `%s' needs argument(s)" form)) - (let* ((rx (rx-info (car form))) + (let* ((rx (rx-info (car form) 'head)) (nargs (1- (length form))) (min-args (nth 1 rx)) (max-args (nth 2 rx)) @@ -643,14 +654,17 @@ (defun rx-** (form) "Parse and produce code from FORM `(** N M ...)'." (rx-check form) - (setq form (cons 'repeat (cdr (rx-trans-forms form 2)))) - (rx-form form '*)) + (rx-form (cons 'repeat (cdr (rx-trans-forms form 2))) '*)) (defun rx-repeat (form) "Parse and produce code from FORM. -FORM is either `(repeat N FORM1)' or `(repeat N M FORM1)'." +FORM is either `(repeat N FORM1)' or `(repeat N M FORMS...)'." (rx-check form) + (if (> (length form) 4) + (setq form (rx-trans-forms form 2))) + (if (null (nth 2 form)) + (setq form (list* (nth 0 form) (nth 1 form) (nthcdr 3 form)))) (cond ((= (length form) 3) (unless (and (integerp (nth 1 form)) (> (nth 1 form) 0)) @@ -749,15 +763,18 @@ "Parse and produce code from FORM, which is `(syntax SYMBOL)'." (rx-check form) (let* ((sym (cadr form)) - (syntax (assq sym rx-syntax))) + (syntax (cdr (assq sym rx-syntax)))) (unless syntax ;; Try sregex compatibility. - (let ((name (symbol-name sym))) - (if (= 1 (length name)) - (setq syntax (rassq (aref name 0) rx-syntax)))) + (cond + ((character sym) (setq syntax sym)) + ((symbolp sym) + (let ((name (symbol-name sym))) + (if (= 1 (length name)) + (setq syntax (aref name 0)))))) (unless syntax - (error "Unknown rx syntax `%s'" (cadr form)))) - (format "\\s%c" (cdr syntax)))) + (error "Unknown rx syntax `%s'" sym))) + (format "\\s%c" syntax))) (defun rx-check-category (form) @@ -811,7 +828,7 @@ (cond ((integerp form) (regexp-quote (char-to-string form))) ((symbolp form) - (let ((info (rx-info form))) + (let ((info (rx-info form nil))) (cond ((stringp info) info) ((null info) @@ -819,7 +836,7 @@ (t (funcall (nth 0 info) form))))) ((consp form) - (let ((info (rx-info (car form)))) + (let ((info (rx-info (car form) 'head))) (unless (consp info) (error "Unknown rx form `%s'" (car form))) (funcall (nth 0 info) form))) === renamed file 'lisp/emacs-lisp/sregex.el' => 'lisp/obsolete/sregex.el' --- lisp/emacs-lisp/sregex.el 2010-01-13 08:35:10 +0000 +++ lisp/obsolete/sregex.el 2010-12-26 23:17:09 +0000 @@ -6,6 +6,7 @@ ;; Author: Bob Glickstein ;; Maintainer: Bob Glickstein ;; Keywords: extensions +;; Obsolete-since: 24.1 ;; This file is part of GNU Emacs. ------------------------------------------------------------ revno: 102707 committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2010-12-25 12:57:02 +0200 message: Fix bug #7699 with pasting selected text on MS-Windows. mouse.el (mouse-yank-primary): On MS-Windows, try the (emulated) PRIMARY first, then the clipboard. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-12-23 00:00:12 +0000 +++ lisp/ChangeLog 2010-12-25 10:57:02 +0000 @@ -1,3 +1,8 @@ +2010-12-25 Eli Zaretskii + + * mouse.el (mouse-yank-primary): On MS-Windows, try the (emulated) + PRIMARY first, then the clipboard. (Bug#7699) + 2010-12-22 Stefan Monnier * emacs-lisp/bytecomp.el (byte-compile-output-docform): Fix up use of === modified file 'lisp/mouse.el' --- lisp/mouse.el 2010-12-13 15:27:36 +0000 +++ lisp/mouse.el 2010-12-25 10:57:02 +0000 @@ -1282,7 +1282,16 @@ (or mouse-yank-at-point (mouse-set-point click)) (let ((primary (cond - ((fboundp 'x-get-selection-value) ; MS-DOS, MS-Windows and X. + ((eq system-type 'windows-nt) + ;; MS-Windows emulates PRIMARY in x-get-selection, but not + ;; in x-get-selection-value (the latter only accesses the + ;; clipboard). So try PRIMARY first, in case they selected + ;; something with the mouse in the current Emacs session. + (or (x-get-selection 'PRIMARY) + (x-get-selection-value))) + ((fboundp 'x-get-selection-value) ; MS-DOS and X. + ;; On X, x-get-selection-value supports more formats and + ;; encodings, so use it in preference to x-get-selection. (or (x-get-selection-value) (x-get-selection 'PRIMARY))) ;; FIXME: What about xterm-mouse-mode etc.?