changeset 109224:91be20d0588d

Merge from mainline.
author Katsumi Yamaoka <katsumi@flagship2>
date Tue, 15 Jun 2010 11:40:23 +0000
parents 3d4150adbcf7 (current diff) 0c1f025545a1 (diff)
children cf1662d15309
files lisp/compare-w.el lisp/vc/compare-w.el
diffstat 6 files changed, 526 insertions(+), 398 deletions(-) [+]
line wrap: on
line diff
--- a/etc/NEWS	Mon Jun 14 11:56:46 2010 +0000
+++ b/etc/NEWS	Tue Jun 15 11:40:23 2010 +0000
@@ -125,6 +125,9 @@
 *** Calling `delete-file' or `delete-directory' with a prefix argument
 now forces true deletion, regardless of `delete-by-moving-to-trash'.
 
+** New option `list-colors-sort' defines the color sort order
+for `list-colors-display'.
+
 
 * Editing Changes in Emacs 24.1
 
--- a/lisp/ChangeLog	Mon Jun 14 11:56:46 2010 +0000
+++ b/lisp/ChangeLog	Tue Jun 15 11:40:23 2010 +0000
@@ -1,3 +1,26 @@
+2010-06-15  Juanma Barranquero  <lekktu@gmail.com>
+
+	* facemenu.el (list-colors-sort): Doc fix.
+
+2010-06-15  Bob Rogers  <rogers-emacs@rgrjr.dyndns.org>  (tiny change)
+
+	* progmodes/sql.el (sql-connect-mysql): Fix typo.
+
+2010-06-14  Juri Linkov  <juri@jurta.org>
+
+	Add sort option `list-colors-sort'.  (Bug#6332)
+	* facemenu.el (color-rgb-to-hsv): New function.
+	(list-colors-sort): New defcustom.
+	(list-colors-sort-key): New function.
+	(list-colors-display): Doc fix.  Sort list according to the option
+	`list-colors-sort'.
+	(list-colors-print): Add HSV values to `help-echo' property of
+	RGB strings.
+
+2010-06-14  Juri Linkov  <juri@jurta.org>
+
+	* compare-w.el: Move to the "vc" subdirectory.
+
 2010-06-14  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* image-mode.el (image-mode-map): Remap left-char and right-char.
--- a/lisp/compare-w.el	Mon Jun 14 11:56:46 2010 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,393 +0,0 @@
-;;; compare-w.el --- compare text between windows for Emacs
-
-;; Copyright (C) 1986, 1989, 1993, 1997, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: convenience files
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package provides one entry point, compare-windows.  It compares
-;; text starting from point in two adjacent windows, advancing point
-;; until it finds a difference.  Option variables permit you to ignore
-;; whitespace differences, or case differences, or both.
-
-;;; Code:
-
-(defgroup compare-windows nil
-  "Compare text between windows."
-  :prefix "compare-"
-  :group 'tools)
-
-(defcustom compare-windows-whitespace "\\(\\s-\\|\n\\)+"
-  "Regexp or function that defines whitespace sequences for `compare-windows'.
-That command optionally ignores changes in whitespace.
-
-The value of `compare-windows-whitespace' is normally a regexp, but it
-can also be a function.  The function's job is to categorize any
-whitespace around (including before) point; it should also advance
-past any whitespace.  The function is called in each window, with
-point at the current scanning point.  It gets one argument, the point
-where \\[compare-windows] was originally called; it should not look at
-any text before that point.
-
-If the function returns the same value for both windows, then the
-whitespace is considered to match, and is skipped."
-  :type '(choice regexp function)
-  :group 'compare-windows)
-
-(defcustom compare-ignore-whitespace nil
-  "Non-nil means `compare-windows' ignores whitespace."
-  :type 'boolean
-  :group 'compare-windows
-  :version "22.1")
-
-(defcustom compare-ignore-case nil
-  "Non-nil means `compare-windows' ignores case differences."
-  :type 'boolean
-  :group 'compare-windows)
-
-(defcustom compare-windows-sync 'compare-windows-sync-default-function
-  "Function or regexp that is used to synchronize points in two
-windows if before calling `compare-windows' points are located
-on mismatched positions.
-
-The value of `compare-windows-sync' can be a function.  The
-function's job is to advance points in both windows to the next
-matching text.  If the value of `compare-windows-sync' is a
-regexp, then points in both windows are advanced to the next
-occurrence of this regexp.
-
-The current default value is the general function
-`compare-windows-sync-default-function' that is able to
-synchronize points by using quadratic algorithm to find the first
-matching 32-character string in two windows.
-
-The other useful values of this variable could be such functions
-as `forward-word', `forward-sentence', `forward-paragraph', or a
-regexp containing some field separator or a newline, depending on
-the nature of the difference units separator.  The variable can
-be made buffer-local.
-
-If the value of this variable is `nil' (option \"No sync\"), then
-no synchronization is performed, and the function `ding' is called
-to beep or flash the screen when points are mismatched."
-  :type '(choice function regexp (const :tag "No sync" nil))
-  :group 'compare-windows
-  :version "22.1")
-
-(defcustom compare-windows-sync-string-size 32
-  "Size of string from one window that is searched in second window.
-
-Small number makes difference regions more fine-grained, but it
-may fail by finding the wrong match.  The bigger number makes
-difference regions more coarse-grained.
-
-The default value 32 is good for the most cases."
-  :type 'integer
-  :group 'compare-windows
-  :version "22.1")
-
-(defcustom compare-windows-recenter nil
-  "List of two values, each of which is used as argument of
-function `recenter' called in each of two windows to place
-matching points side-by-side.
-
-The value `(-1 0)' is useful if windows are split vertically,
-and the value `((4) (4))' for horizontally split windows."
-  :type '(list sexp sexp)
-  :group 'compare-windows
-  :version "22.1")
-
-(defcustom compare-windows-highlight t
-  "Non-nil means compare-windows highlights the differences.
-The value t removes highlighting immediately after invoking a command
-other than `compare-windows'.
-The value `persistent' leaves all highlighted differences.  You can clear
-out all highlighting later with the command `compare-windows-dehighlight'."
-  :type '(choice (const :tag "No highlighting" nil)
-		 (const :tag "Persistent highlighting" persistent)
-		 (other :tag "Highlight until next command" t))
-  :group 'compare-windows
-  :version "22.1")
-
-(defface compare-windows
-  '((t :inherit lazy-highlight))
-  "Face for highlighting of compare-windows difference regions."
-  :group 'compare-windows
-  :version "22.1")
-
-(defvar compare-windows-overlay1 nil)
-(defvar compare-windows-overlay2 nil)
-(defvar compare-windows-overlays1 nil)
-(defvar compare-windows-overlays2 nil)
-(defvar compare-windows-sync-point nil)
-
-;;;###autoload
-(defun compare-windows (ignore-whitespace)
-  "Compare text in current window with text in next window.
-Compares the text starting at point in each window,
-moving over text in each one as far as they match.
-
-This command pushes the mark in each window
-at the prior location of point in that window.
-If both windows display the same buffer,
-the mark is pushed twice in that buffer:
-first in the other window, then in the selected window.
-
-A prefix arg means reverse the value of variable
-`compare-ignore-whitespace'.  If `compare-ignore-whitespace' is
-nil, then a prefix arg means ignore changes in whitespace.  If
-`compare-ignore-whitespace' is non-nil, then a prefix arg means
-don't ignore changes in whitespace.  The variable
-`compare-windows-whitespace' controls how whitespace is skipped.
-If `compare-ignore-case' is non-nil, changes in case are also
-ignored.
-
-If `compare-windows-sync' is non-nil, then successive calls of
-this command work in interlaced mode:
-on first call it advances points to the next difference,
-on second call it synchronizes points by skipping the difference,
-on third call it again advances points to the next difference and so on."
-  (interactive "P")
-  (if compare-ignore-whitespace
-      (setq ignore-whitespace (not ignore-whitespace)))
-  (let* (p1 p2 maxp1 maxp2 b1 b2 w2
-	    (progress 1)
-	    (opoint1 (point))
-	    opoint2
-	    skip-func-1
-	    skip-func-2
-	    (sync-func (if (stringp compare-windows-sync)
-                           'compare-windows-sync-regexp
-                         compare-windows-sync)))
-    (setq p1 (point) b1 (current-buffer))
-    (setq w2 (next-window (selected-window)))
-    (if (eq w2 (selected-window))
-	(setq w2 (next-window (selected-window) nil 'visible)))
-    (if (eq w2 (selected-window))
-	(error "No other window"))
-    (setq p2 (window-point w2)
-	  b2 (window-buffer w2))
-    (setq opoint2 p2)
-    (setq maxp1 (point-max))
-
-    (setq skip-func-1 (if ignore-whitespace
-			  (if (stringp compare-windows-whitespace)
-			      (lambda (pos)
-				(compare-windows-skip-whitespace pos)
-				t)
-			    compare-windows-whitespace)))
-
-    (with-current-buffer b2
-      (setq skip-func-2 (if ignore-whitespace
-			    (if (stringp compare-windows-whitespace)
-			      (lambda (pos)
-				(compare-windows-skip-whitespace pos)
-				t)
-			      compare-windows-whitespace)))
-      (push-mark p2 t)
-      (setq maxp2 (point-max)))
-    (push-mark)
-
-    (while (> progress 0)
-      ;; If both windows have whitespace next to point,
-      ;; optionally skip over it.
-      (and skip-func-1
-	   (save-excursion
-	     (let (p1a p2a w1 w2 result1 result2)
-	       (setq result1 (funcall skip-func-1 opoint1))
-	       (setq p1a (point))
-	       (set-buffer b2)
-	       (goto-char p2)
-	       (setq result2 (funcall skip-func-2 opoint2))
-	       (setq p2a (point))
-	       (if (and result1 result2 (eq result1 result2))
-		   (setq p1 p1a
-			 p2 p2a)))))
-
-      (let ((size (min (- maxp1 p1) (- maxp2 p2)))
-	    (case-fold-search compare-ignore-case))
-	(setq progress (compare-buffer-substrings b2 p2 (+ size p2)
-						  b1 p1 (+ size p1)))
-	(setq progress (if (zerop progress) size (1- (abs progress))))
-	(setq p1 (+ p1 progress) p2 (+ p2 progress)))
-      ;; Advance point now rather than later, in case we're interrupted.
-      (goto-char p1)
-      (set-window-point w2 p2)
-      (when compare-windows-recenter
-        (recenter (car compare-windows-recenter))
-        (with-selected-window w2 (recenter (cadr compare-windows-recenter)))))
-
-    (if (= (point) opoint1)
-	(if (not sync-func)
-            (ding)
-          ;; If points are not advanced (i.e. already on mismatch position),
-          ;; then synchronize points between both windows
-          (save-excursion
-            (setq compare-windows-sync-point nil)
-            (funcall sync-func)
-            (setq p1 (point))
-            (set-buffer b2)
-            (goto-char p2)
-            (funcall sync-func)
-            (setq p2 (point)))
-          (goto-char p1)
-          (set-window-point w2 p2)
-          (when compare-windows-recenter
-            (recenter (car compare-windows-recenter))
-            (with-selected-window w2 (recenter (cadr compare-windows-recenter))))
-          ;; If points are still not synchronized, then ding
-          (when (and (= p1 opoint1) (= p2 opoint2))
-            ;; Display error message when current points in two windows
-            ;; are unmatched and next matching points can't be found.
-            (compare-windows-dehighlight)
-            (ding)
-            (message "No more matching points"))))))
-
-;; Move forward over whatever might be called whitespace.
-;; compare-windows-whitespace is a regexp that matches whitespace.
-;; Match it at various starting points before the original point
-;; and find the latest point at which a match ends.
-;; Don't try starting points before START, though.
-;; Value is non-nil if whitespace is found.
-;; If there is whitespace before point, but none after,
-;; then return t, but don't advance point.
-(defun compare-windows-skip-whitespace (start)
-  (let ((end (point))
-	(beg (point))
-	(opoint (point)))
-    (while (or (and (looking-at compare-windows-whitespace)
-		    (<= end (match-end 0))
-		    ;; This match goes past END, so advance END.
-		    (progn (setq end (match-end 0))
-			   (> (point) start)))
-	       (and (/= (point) start)
-		    ;; Consider at least the char before point,
-		    ;; unless it is also before START.
-		    (= (point) opoint)))
-      ;; keep going back until whitespace
-      ;; doesn't extend to or past end
-      (forward-char -1))
-    (setq beg (point))
-    (goto-char end)
-    (or (/= beg opoint)
-	(/= end opoint))))
-
-;; Move forward to the next synchronization regexp.
-(defun compare-windows-sync-regexp ()
-  (if (stringp compare-windows-sync)
-      (re-search-forward compare-windows-sync nil t)))
-
-;; Function works in two passes: one call on each window.
-;; On the first call both matching points are computed,
-;; and one of them is stored in compare-windows-sync-point
-;; to be used when this function is called on second window.
-(defun compare-windows-sync-default-function ()
-  (if (not compare-windows-sync-point)
-      (let* ((w1 (selected-window))
-             (w2 (next-window w1))
-             (b2 (window-buffer w2))
-             (point-max2 (with-current-buffer b2 (point-max)))
-             (op2 (window-point w2))
-             (op1 (point))
-             (region-size compare-windows-sync-string-size)
-             (string-size compare-windows-sync-string-size)
-             in-bounds-p s1 p2 p12s p12)
-        (while (and
-                ;; until matching points are found
-                (not p12s)
-                ;; until size exceeds the maximum points of both buffers
-                ;; (bounds below take care to not overdo in each of them)
-                (or (setq in-bounds-p (< region-size (max (- (point-max) op1)
-                                                          (- point-max2 op2))))
-                    ;; until string size becomes smaller than 4
-                    (> string-size 4)))
-          (if in-bounds-p
-              ;; make the next search in the double-sized region;
-              ;; on first iteration it is 2*compare-windows-sync-string-size,
-              ;; on last iterations it exceeds both buffers maximum points
-              (setq region-size (* region-size 2))
-            ;; if region size exceeds the maximum points of both buffers,
-            ;; then start to halve the string size until 4;
-            ;; this helps to find differences near the end of buffers
-            (setq string-size (/ string-size 2)))
-          (let ((p1 op1)
-                (bound1 (- (min (+ op1 region-size) (point-max)) string-size))
-                (bound2 (min (+ op2 region-size) point-max2)))
-            (while (< p1 bound1)
-              (setq s1 (buffer-substring-no-properties p1 (+ p1 string-size)))
-              (setq p2 (with-current-buffer b2
-                         (goto-char op2)
-                         (let ((case-fold-search compare-ignore-case))
-                           (search-forward s1 bound2 t))))
-              (when p2
-                (setq p2 (- p2 string-size))
-                (setq p12s (cons (list (+ p1 p2) p1 p2) p12s)))
-              (setq p1 (1+ p1)))))
-        (when p12s
-          ;; use closest matching points (i.e. points with minimal sum)
-          (setq p12 (cdr (assq (apply 'min (mapcar 'car p12s)) p12s)))
-          (goto-char (car p12))
-          (compare-windows-highlight op1 (car p12) (current-buffer) w1
-                                     op2 (cadr p12) b2 w2))
-        (setq compare-windows-sync-point (or (cadr p12) t)))
-    ;; else set point in the second window to the pre-calculated value
-    (if (numberp compare-windows-sync-point)
-        (goto-char compare-windows-sync-point))
-    (setq compare-windows-sync-point nil)))
-
-;; Highlight differences
-(defun compare-windows-highlight (beg1 end1 b1 w1 beg2 end2 b2 w2)
-  (when compare-windows-highlight
-    (if compare-windows-overlay1
-        (move-overlay compare-windows-overlay1 beg1 end1 b1)
-      (setq compare-windows-overlay1 (make-overlay beg1 end1 b1))
-      (overlay-put compare-windows-overlay1 'face 'compare-windows)
-      (overlay-put compare-windows-overlay1 'priority 1000))
-    (overlay-put compare-windows-overlay1 'window w1)
-    (if compare-windows-overlay2
-        (move-overlay compare-windows-overlay2 beg2 end2 b2)
-      (setq compare-windows-overlay2 (make-overlay beg2 end2 b2))
-      (overlay-put compare-windows-overlay2 'face 'compare-windows)
-      (overlay-put compare-windows-overlay2 'priority 1000))
-    (overlay-put compare-windows-overlay2 'window w2)
-    (if (not (eq compare-windows-highlight 'persistent))
-	;; Remove highlighting before next command is executed
-	(add-hook 'pre-command-hook 'compare-windows-dehighlight)
-      (when compare-windows-overlay1
-	(push (copy-overlay compare-windows-overlay1) compare-windows-overlays1)
-	(delete-overlay compare-windows-overlay1))
-      (when compare-windows-overlay2
-	(push (copy-overlay compare-windows-overlay2) compare-windows-overlays2)
-	(delete-overlay compare-windows-overlay2)))))
-
-(defun compare-windows-dehighlight ()
-  "Remove highlighting created by `compare-windows-highlight'."
-  (interactive)
-  (remove-hook 'pre-command-hook 'compare-windows-dehighlight)
-  (mapc 'delete-overlay compare-windows-overlays1)
-  (mapc 'delete-overlay compare-windows-overlays2)
-  (and compare-windows-overlay1 (delete-overlay compare-windows-overlay1))
-  (and compare-windows-overlay2 (delete-overlay compare-windows-overlay2)))
-
-(provide 'compare-w)
-
-;; arch-tag: 4177aab1-48e6-4a98-b7a1-000ee285de46
-;;; compare-w.el ends here
--- a/lisp/facemenu.el	Mon Jun 14 11:56:46 2010 +0000
+++ b/lisp/facemenu.el	Tue Jun 15 11:40:23 2010 +0000
@@ -479,6 +479,73 @@
 	nil
       col)))
 
+(defun color-rgb-to-hsv (r g b)
+  "For R, G, B color components return a list of hue, saturation, value.
+R, G, B input values should be in [0..65535] range.
+Output values for hue are integers in [0..360] range.
+Output values for saturation and value are integers in [0..100] range."
+  (let* ((r (/ r 65535.0))
+	 (g (/ g 65535.0))
+	 (b (/ b 65535.0))
+	 (max (max r g b))
+	 (min (min r g b))
+	 (h (cond ((= max min) 0)
+		  ((= max r) (mod (+ (* 60 (/ (- g b) (- max min))) 360) 360))
+		  ((= max g) (+ (* 60 (/ (- b r) (- max min))) 120))
+		  ((= max b) (+ (* 60 (/ (- r g) (- max min))) 240))))
+	 (s (cond ((= max 0) 0)
+		  (t (- 1 (/ min max)))))
+	 (v max))
+    (list (round h) (round s 0.01) (round v 0.01))))
+
+(defcustom list-colors-sort nil
+  "Color sort order for `list-colors-display'.
+`nil' means default implementation-dependent order (defined in `x-colors').
+`name' sorts by color name.
+`rgb' sorts by red, green, blue components.
+`(rgb-dist . COLOR)' sorts by the RGB distance to the specified color.
+`hsv' sorts by hue, saturation, value.
+`(hsv-dist . COLOR)' sorts by the HSV distance to the specified color
+and excludes grayscale colors."
+  :type '(choice (const :tag "Unsorted" nil)
+		 (const :tag "Color Name" name)
+		 (const :tag "Red-Green-Blue" rgb)
+		 (cons :tag "Distance on RGB cube"
+		       (const :tag "Distance from Color" rgb-dist)
+		       (color :tag "Source Color Name"))
+		 (const :tag "Hue-Saturation-Value" hsv)
+		 (cons :tag "Distance on HSV cylinder"
+		       (const :tag "Distance from Color" hsv-dist)
+		       (color :tag "Source Color Name")))
+  :group 'facemenu
+  :version "24.1")
+
+(defun list-colors-sort-key (color)
+  "Return a list of keys for sorting colors depending on `list-colors-sort'.
+COLOR is the name of the color.  When return value is nil,
+filter out the color from the output."
+  (cond
+   ((null list-colors-sort) color)
+   ((eq list-colors-sort 'name)
+    (downcase color))
+   ((eq list-colors-sort 'rgb)
+    (color-values color))
+   ((eq (car-safe list-colors-sort) 'rgb-dist)
+    (color-distance color (cdr list-colors-sort)))
+   ((eq list-colors-sort 'hsv)
+    (apply 'color-rgb-to-hsv (color-values color)))
+   ((eq (car-safe list-colors-sort) 'hsv-dist)
+    (let* ((c-rgb (color-values color))
+	   (c-hsv (apply 'color-rgb-to-hsv c-rgb))
+	   (o-hsv (apply 'color-rgb-to-hsv
+			 (color-values (cdr list-colors-sort)))))
+      (unless (and (eq (nth 0 c-rgb) (nth 1 c-rgb)) ; exclude grayscale
+		   (eq (nth 1 c-rgb) (nth 2 c-rgb)))
+	;; 3D Euclidean distance (sqrt is not needed for sorting)
+	(+ (expt (- 180 (abs (- 180 (abs (- (nth 0 c-hsv) ; wrap hue
+					    (nth 0 o-hsv)))))) 2)
+	   (expt (- (nth 1 c-hsv) (nth 1 o-hsv)) 2)
+	   (expt (- (nth 2 c-hsv) (nth 2 o-hsv)) 2)))))))
 
 (defun list-colors-display (&optional list buffer-name callback)
   "Display names of defined colors, and show what they look like.
@@ -492,10 +559,38 @@
 If the optional argument CALLBACK is non-nil, it should be a
 function to call each time the user types RET or clicks on a
 color.  The function should accept a single argument, the color
-name."
+name.
+
+You can change the color sort order by customizing `list-colors-sort'."
   (interactive)
   (when (and (null list) (> (display-color-cells) 0))
     (setq list (list-colors-duplicates (defined-colors)))
+    (when list-colors-sort
+      ;; Schwartzian transform with `(color key1 key2 key3 ...)'.
+      (setq list (mapcar
+		  'car
+		  (sort (delq nil (mapcar
+				   (lambda (c)
+				     (let ((key (list-colors-sort-key
+						 (car c))))
+				       (when key
+					 (cons c (if (consp key) key
+						   (list key))))))
+				   list))
+			(lambda (a b)
+			  (let* ((a-keys (cdr a))
+				 (b-keys (cdr b))
+				 (a-key (car a-keys))
+				 (b-key (car b-keys)))
+			    ;; Skip common keys at the beginning of key lists.
+			    (while (and a-key b-key (equal a-key b-key))
+			      (setq a-keys (cdr a-keys) a-key (car a-keys)
+				    b-keys (cdr b-keys) b-key (car b-keys)))
+			    (cond
+			     ((and (numberp a-key) (numberp b-key))
+			      (< a-key b-key))
+			     ((and (stringp a-key) (stringp b-key))
+			      (string< a-key b-key)))))))))
     (when (memq (display-visual-class) '(gray-scale pseudo-color direct-color))
       ;; Don't show more than what the display can handle.
       (let ((lc (nthcdr (1- (display-color-cells)) list)))
@@ -550,9 +645,16 @@
 	 (point)
 	 'face (list :foreground (car color)))
 	(indent-to (max (- (window-width) 8) 44))
-	(insert (apply 'format "#%02x%02x%02x"
-		       (mapcar (lambda (c) (lsh c -8))
-			       color-values)))
+	(insert (propertize
+		 (apply 'format "#%02x%02x%02x"
+			(mapcar (lambda (c) (lsh c -8))
+				color-values))
+		 'mouse-face 'highlight
+		 'help-echo
+		 (let ((hsv (apply 'color-rgb-to-hsv
+				   (color-values (car color)))))
+		   (format "H:%d S:%d V:%d"
+			   (nth 0 hsv) (nth 1 hsv) (nth 2 hsv)))))
 	(when callback
 	  (make-text-button
 	   opoint (point)
--- a/lisp/progmodes/sql.el	Mon Jun 14 11:56:46 2010 +0000
+++ b/lisp/progmodes/sql.el	Tue Jun 15 11:40:23 2010 +0000
@@ -3119,7 +3119,7 @@
 	(setq params (append (list sql-database) params)))
     (if (not (string= "" sql-server))
 	(setq params (append (list (concat "--host=" sql-server)) params)))
-    (if (not (and sql-port (numberp sql-port)))
+    (if (and sql-port (numberp sql-port))
 	(setq params (append (list (concat "--port=" (number-to-string sql-port))) params)))
     (if (not (string= "" sql-password))
 	(setq params (append (list (concat "--password=" sql-password)) params)))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/vc/compare-w.el	Tue Jun 15 11:40:23 2010 +0000
@@ -0,0 +1,393 @@
+;;; compare-w.el --- compare text between windows for Emacs
+
+;; Copyright (C) 1986, 1989, 1993, 1997, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: convenience files vc
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides one entry point, compare-windows.  It compares
+;; text starting from point in two adjacent windows, advancing point
+;; until it finds a difference.  Option variables permit you to ignore
+;; whitespace differences, or case differences, or both.
+
+;;; Code:
+
+(defgroup compare-windows nil
+  "Compare text between windows."
+  :prefix "compare-"
+  :group 'tools)
+
+(defcustom compare-windows-whitespace "\\(\\s-\\|\n\\)+"
+  "Regexp or function that defines whitespace sequences for `compare-windows'.
+That command optionally ignores changes in whitespace.
+
+The value of `compare-windows-whitespace' is normally a regexp, but it
+can also be a function.  The function's job is to categorize any
+whitespace around (including before) point; it should also advance
+past any whitespace.  The function is called in each window, with
+point at the current scanning point.  It gets one argument, the point
+where \\[compare-windows] was originally called; it should not look at
+any text before that point.
+
+If the function returns the same value for both windows, then the
+whitespace is considered to match, and is skipped."
+  :type '(choice regexp function)
+  :group 'compare-windows)
+
+(defcustom compare-ignore-whitespace nil
+  "Non-nil means `compare-windows' ignores whitespace."
+  :type 'boolean
+  :group 'compare-windows
+  :version "22.1")
+
+(defcustom compare-ignore-case nil
+  "Non-nil means `compare-windows' ignores case differences."
+  :type 'boolean
+  :group 'compare-windows)
+
+(defcustom compare-windows-sync 'compare-windows-sync-default-function
+  "Function or regexp that is used to synchronize points in two
+windows if before calling `compare-windows' points are located
+on mismatched positions.
+
+The value of `compare-windows-sync' can be a function.  The
+function's job is to advance points in both windows to the next
+matching text.  If the value of `compare-windows-sync' is a
+regexp, then points in both windows are advanced to the next
+occurrence of this regexp.
+
+The current default value is the general function
+`compare-windows-sync-default-function' that is able to
+synchronize points by using quadratic algorithm to find the first
+matching 32-character string in two windows.
+
+The other useful values of this variable could be such functions
+as `forward-word', `forward-sentence', `forward-paragraph', or a
+regexp containing some field separator or a newline, depending on
+the nature of the difference units separator.  The variable can
+be made buffer-local.
+
+If the value of this variable is `nil' (option \"No sync\"), then
+no synchronization is performed, and the function `ding' is called
+to beep or flash the screen when points are mismatched."
+  :type '(choice function regexp (const :tag "No sync" nil))
+  :group 'compare-windows
+  :version "22.1")
+
+(defcustom compare-windows-sync-string-size 32
+  "Size of string from one window that is searched in second window.
+
+Small number makes difference regions more fine-grained, but it
+may fail by finding the wrong match.  The bigger number makes
+difference regions more coarse-grained.
+
+The default value 32 is good for the most cases."
+  :type 'integer
+  :group 'compare-windows
+  :version "22.1")
+
+(defcustom compare-windows-recenter nil
+  "List of two values, each of which is used as argument of
+function `recenter' called in each of two windows to place
+matching points side-by-side.
+
+The value `(-1 0)' is useful if windows are split vertically,
+and the value `((4) (4))' for horizontally split windows."
+  :type '(list sexp sexp)
+  :group 'compare-windows
+  :version "22.1")
+
+(defcustom compare-windows-highlight t
+  "Non-nil means compare-windows highlights the differences.
+The value t removes highlighting immediately after invoking a command
+other than `compare-windows'.
+The value `persistent' leaves all highlighted differences.  You can clear
+out all highlighting later with the command `compare-windows-dehighlight'."
+  :type '(choice (const :tag "No highlighting" nil)
+		 (const :tag "Persistent highlighting" persistent)
+		 (other :tag "Highlight until next command" t))
+  :group 'compare-windows
+  :version "22.1")
+
+(defface compare-windows
+  '((t :inherit lazy-highlight))
+  "Face for highlighting of compare-windows difference regions."
+  :group 'compare-windows
+  :version "22.1")
+
+(defvar compare-windows-overlay1 nil)
+(defvar compare-windows-overlay2 nil)
+(defvar compare-windows-overlays1 nil)
+(defvar compare-windows-overlays2 nil)
+(defvar compare-windows-sync-point nil)
+
+;;;###autoload
+(defun compare-windows (ignore-whitespace)
+  "Compare text in current window with text in next window.
+Compares the text starting at point in each window,
+moving over text in each one as far as they match.
+
+This command pushes the mark in each window
+at the prior location of point in that window.
+If both windows display the same buffer,
+the mark is pushed twice in that buffer:
+first in the other window, then in the selected window.
+
+A prefix arg means reverse the value of variable
+`compare-ignore-whitespace'.  If `compare-ignore-whitespace' is
+nil, then a prefix arg means ignore changes in whitespace.  If
+`compare-ignore-whitespace' is non-nil, then a prefix arg means
+don't ignore changes in whitespace.  The variable
+`compare-windows-whitespace' controls how whitespace is skipped.
+If `compare-ignore-case' is non-nil, changes in case are also
+ignored.
+
+If `compare-windows-sync' is non-nil, then successive calls of
+this command work in interlaced mode:
+on first call it advances points to the next difference,
+on second call it synchronizes points by skipping the difference,
+on third call it again advances points to the next difference and so on."
+  (interactive "P")
+  (if compare-ignore-whitespace
+      (setq ignore-whitespace (not ignore-whitespace)))
+  (let* (p1 p2 maxp1 maxp2 b1 b2 w2
+	    (progress 1)
+	    (opoint1 (point))
+	    opoint2
+	    skip-func-1
+	    skip-func-2
+	    (sync-func (if (stringp compare-windows-sync)
+                           'compare-windows-sync-regexp
+                         compare-windows-sync)))
+    (setq p1 (point) b1 (current-buffer))
+    (setq w2 (next-window (selected-window)))
+    (if (eq w2 (selected-window))
+	(setq w2 (next-window (selected-window) nil 'visible)))
+    (if (eq w2 (selected-window))
+	(error "No other window"))
+    (setq p2 (window-point w2)
+	  b2 (window-buffer w2))
+    (setq opoint2 p2)
+    (setq maxp1 (point-max))
+
+    (setq skip-func-1 (if ignore-whitespace
+			  (if (stringp compare-windows-whitespace)
+			      (lambda (pos)
+				(compare-windows-skip-whitespace pos)
+				t)
+			    compare-windows-whitespace)))
+
+    (with-current-buffer b2
+      (setq skip-func-2 (if ignore-whitespace
+			    (if (stringp compare-windows-whitespace)
+			      (lambda (pos)
+				(compare-windows-skip-whitespace pos)
+				t)
+			      compare-windows-whitespace)))
+      (push-mark p2 t)
+      (setq maxp2 (point-max)))
+    (push-mark)
+
+    (while (> progress 0)
+      ;; If both windows have whitespace next to point,
+      ;; optionally skip over it.
+      (and skip-func-1
+	   (save-excursion
+	     (let (p1a p2a w1 w2 result1 result2)
+	       (setq result1 (funcall skip-func-1 opoint1))
+	       (setq p1a (point))
+	       (set-buffer b2)
+	       (goto-char p2)
+	       (setq result2 (funcall skip-func-2 opoint2))
+	       (setq p2a (point))
+	       (if (and result1 result2 (eq result1 result2))
+		   (setq p1 p1a
+			 p2 p2a)))))
+
+      (let ((size (min (- maxp1 p1) (- maxp2 p2)))
+	    (case-fold-search compare-ignore-case))
+	(setq progress (compare-buffer-substrings b2 p2 (+ size p2)
+						  b1 p1 (+ size p1)))
+	(setq progress (if (zerop progress) size (1- (abs progress))))
+	(setq p1 (+ p1 progress) p2 (+ p2 progress)))
+      ;; Advance point now rather than later, in case we're interrupted.
+      (goto-char p1)
+      (set-window-point w2 p2)
+      (when compare-windows-recenter
+        (recenter (car compare-windows-recenter))
+        (with-selected-window w2 (recenter (cadr compare-windows-recenter)))))
+
+    (if (= (point) opoint1)
+	(if (not sync-func)
+            (ding)
+          ;; If points are not advanced (i.e. already on mismatch position),
+          ;; then synchronize points between both windows
+          (save-excursion
+            (setq compare-windows-sync-point nil)
+            (funcall sync-func)
+            (setq p1 (point))
+            (set-buffer b2)
+            (goto-char p2)
+            (funcall sync-func)
+            (setq p2 (point)))
+          (goto-char p1)
+          (set-window-point w2 p2)
+          (when compare-windows-recenter
+            (recenter (car compare-windows-recenter))
+            (with-selected-window w2 (recenter (cadr compare-windows-recenter))))
+          ;; If points are still not synchronized, then ding
+          (when (and (= p1 opoint1) (= p2 opoint2))
+            ;; Display error message when current points in two windows
+            ;; are unmatched and next matching points can't be found.
+            (compare-windows-dehighlight)
+            (ding)
+            (message "No more matching points"))))))
+
+;; Move forward over whatever might be called whitespace.
+;; compare-windows-whitespace is a regexp that matches whitespace.
+;; Match it at various starting points before the original point
+;; and find the latest point at which a match ends.
+;; Don't try starting points before START, though.
+;; Value is non-nil if whitespace is found.
+;; If there is whitespace before point, but none after,
+;; then return t, but don't advance point.
+(defun compare-windows-skip-whitespace (start)
+  (let ((end (point))
+	(beg (point))
+	(opoint (point)))
+    (while (or (and (looking-at compare-windows-whitespace)
+		    (<= end (match-end 0))
+		    ;; This match goes past END, so advance END.
+		    (progn (setq end (match-end 0))
+			   (> (point) start)))
+	       (and (/= (point) start)
+		    ;; Consider at least the char before point,
+		    ;; unless it is also before START.
+		    (= (point) opoint)))
+      ;; keep going back until whitespace
+      ;; doesn't extend to or past end
+      (forward-char -1))
+    (setq beg (point))
+    (goto-char end)
+    (or (/= beg opoint)
+	(/= end opoint))))
+
+;; Move forward to the next synchronization regexp.
+(defun compare-windows-sync-regexp ()
+  (if (stringp compare-windows-sync)
+      (re-search-forward compare-windows-sync nil t)))
+
+;; Function works in two passes: one call on each window.
+;; On the first call both matching points are computed,
+;; and one of them is stored in compare-windows-sync-point
+;; to be used when this function is called on second window.
+(defun compare-windows-sync-default-function ()
+  (if (not compare-windows-sync-point)
+      (let* ((w1 (selected-window))
+             (w2 (next-window w1))
+             (b2 (window-buffer w2))
+             (point-max2 (with-current-buffer b2 (point-max)))
+             (op2 (window-point w2))
+             (op1 (point))
+             (region-size compare-windows-sync-string-size)
+             (string-size compare-windows-sync-string-size)
+             in-bounds-p s1 p2 p12s p12)
+        (while (and
+                ;; until matching points are found
+                (not p12s)
+                ;; until size exceeds the maximum points of both buffers
+                ;; (bounds below take care to not overdo in each of them)
+                (or (setq in-bounds-p (< region-size (max (- (point-max) op1)
+                                                          (- point-max2 op2))))
+                    ;; until string size becomes smaller than 4
+                    (> string-size 4)))
+          (if in-bounds-p
+              ;; make the next search in the double-sized region;
+              ;; on first iteration it is 2*compare-windows-sync-string-size,
+              ;; on last iterations it exceeds both buffers maximum points
+              (setq region-size (* region-size 2))
+            ;; if region size exceeds the maximum points of both buffers,
+            ;; then start to halve the string size until 4;
+            ;; this helps to find differences near the end of buffers
+            (setq string-size (/ string-size 2)))
+          (let ((p1 op1)
+                (bound1 (- (min (+ op1 region-size) (point-max)) string-size))
+                (bound2 (min (+ op2 region-size) point-max2)))
+            (while (< p1 bound1)
+              (setq s1 (buffer-substring-no-properties p1 (+ p1 string-size)))
+              (setq p2 (with-current-buffer b2
+                         (goto-char op2)
+                         (let ((case-fold-search compare-ignore-case))
+                           (search-forward s1 bound2 t))))
+              (when p2
+                (setq p2 (- p2 string-size))
+                (setq p12s (cons (list (+ p1 p2) p1 p2) p12s)))
+              (setq p1 (1+ p1)))))
+        (when p12s
+          ;; use closest matching points (i.e. points with minimal sum)
+          (setq p12 (cdr (assq (apply 'min (mapcar 'car p12s)) p12s)))
+          (goto-char (car p12))
+          (compare-windows-highlight op1 (car p12) (current-buffer) w1
+                                     op2 (cadr p12) b2 w2))
+        (setq compare-windows-sync-point (or (cadr p12) t)))
+    ;; else set point in the second window to the pre-calculated value
+    (if (numberp compare-windows-sync-point)
+        (goto-char compare-windows-sync-point))
+    (setq compare-windows-sync-point nil)))
+
+;; Highlight differences
+(defun compare-windows-highlight (beg1 end1 b1 w1 beg2 end2 b2 w2)
+  (when compare-windows-highlight
+    (if compare-windows-overlay1
+        (move-overlay compare-windows-overlay1 beg1 end1 b1)
+      (setq compare-windows-overlay1 (make-overlay beg1 end1 b1))
+      (overlay-put compare-windows-overlay1 'face 'compare-windows)
+      (overlay-put compare-windows-overlay1 'priority 1000))
+    (overlay-put compare-windows-overlay1 'window w1)
+    (if compare-windows-overlay2
+        (move-overlay compare-windows-overlay2 beg2 end2 b2)
+      (setq compare-windows-overlay2 (make-overlay beg2 end2 b2))
+      (overlay-put compare-windows-overlay2 'face 'compare-windows)
+      (overlay-put compare-windows-overlay2 'priority 1000))
+    (overlay-put compare-windows-overlay2 'window w2)
+    (if (not (eq compare-windows-highlight 'persistent))
+	;; Remove highlighting before next command is executed
+	(add-hook 'pre-command-hook 'compare-windows-dehighlight)
+      (when compare-windows-overlay1
+	(push (copy-overlay compare-windows-overlay1) compare-windows-overlays1)
+	(delete-overlay compare-windows-overlay1))
+      (when compare-windows-overlay2
+	(push (copy-overlay compare-windows-overlay2) compare-windows-overlays2)
+	(delete-overlay compare-windows-overlay2)))))
+
+(defun compare-windows-dehighlight ()
+  "Remove highlighting created by `compare-windows-highlight'."
+  (interactive)
+  (remove-hook 'pre-command-hook 'compare-windows-dehighlight)
+  (mapc 'delete-overlay compare-windows-overlays1)
+  (mapc 'delete-overlay compare-windows-overlays2)
+  (and compare-windows-overlay1 (delete-overlay compare-windows-overlay1))
+  (and compare-windows-overlay2 (delete-overlay compare-windows-overlay2)))
+
+(provide 'compare-w)
+
+;; arch-tag: 4177aab1-48e6-4a98-b7a1-000ee285de46
+;;; compare-w.el ends here