changeset 108252:623b349bb7c2

Merge from mainline.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Thu, 06 May 2010 03:24:12 +0000
parents b393c00787bb (current diff) 275d802c8570 (diff)
children 2b24f3ddbe67
files
diffstat 4 files changed, 75 insertions(+), 32 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed May 05 23:05:35 2010 +0000
+++ b/lisp/ChangeLog	Thu May 06 03:24:12 2010 +0000
@@ -1,3 +1,13 @@
+2010-05-06  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* minibuffer.el (completion--sreverse, completion--common-suffix):
+	New functions.
+	(completion-pcm--merge-completions): Extract common suffix when safe.
+
+	* emacs-lisp/easy-mmode.el (define-minor-mode):
+	Make :variable more flexible.
+	* files.el (auto-save-mode): Use it to define using define-minor-mode.
+
 2010-05-05  Juri Linkov  <juri@jurta.org>
 
 	Add `slow' and `history' tags to the desktop data.
@@ -20,8 +30,8 @@
 	(ange-ftp-delete-file): Add FORCE arg.
 	(ange-ftp-rename-remote-to-remote)
 	(ange-ftp-rename-local-to-remote, ange-ftp-rename-remote-to-local)
-	(ange-ftp-load, ange-ftp-compress, ange-ftp-uncompress): Force
-	file deletion.
+	(ange-ftp-load, ange-ftp-compress, ange-ftp-uncompress):
+	Force file deletion.
 
 	* net/tramp-compat.el (tramp-compat-delete-file): New defun.
 
@@ -39,8 +49,8 @@
 	(tramp-fish-handle-make-symbolic-link)
 	(tramp-fish-handle-process-file): Use `tramp-compat-delete-file'.
 
-	* net/tramp-ftp.el (tramp-ftp-file-name-handler): Use
-	`tramp-compat-delete-file'.
+	* net/tramp-ftp.el (tramp-ftp-file-name-handler):
+	Use `tramp-compat-delete-file'.
 
 	* net/tramp-gvfs.el (tramp-gvfs-handle-delete-file): Add FORCE arg.
 	(tramp-gvfs-handle-write-region): Use `tramp-compat-delete-file'.
--- a/lisp/emacs-lisp/easy-mmode.el	Wed May 05 23:05:35 2010 +0000
+++ b/lisp/emacs-lisp/easy-mmode.el	Thu May 06 03:24:12 2010 +0000
@@ -117,7 +117,10 @@
 :keymap MAP	Same as the KEYMAP argument.
 :require SYM	Same as in `defcustom'.
 :variable PLACE	The location (as can be used with `setf') to use instead
-		of the variable MODE to store the state of the mode.
+		of the variable MODE to store the state of the mode.  PLACE
+		can also be of the form (GET . SET) where GET is an expression
+		that returns the current state and SET is a function that takes
+		a new state and sets it.
 
 For example, you could write
   (define-minor-mode foo-mode \"If enabled, foo on you!\"
@@ -149,8 +152,9 @@
 	 (type nil)
 	 (extra-args nil)
 	 (extra-keywords nil)
-         (variable nil)
-         (modefun mode)
+         (variable nil)          ;The PLACE where the state is stored.
+         (setter nil)            ;The function (if any) to set the mode var.
+         (modefun mode)          ;The minor mode function name we're defining.
 	 (require t)
 	 (hook (intern (concat mode-name "-hook")))
 	 (hook-on (intern (concat mode-name "-on-hook")))
@@ -171,7 +175,12 @@
 	(:type (setq type (list :type (pop body))))
 	(:require (setq require (pop body)))
 	(:keymap (setq keymap (pop body)))
-        (:variable (setq variable (setq mode (pop body))))
+        (:variable (setq variable (pop body))
+         (if (not (functionp (cdr-safe variable)))
+             ;; PLACE is not of the form (GET . SET).
+             (setq mode variable)
+           (setq mode (car variable))
+           (setq setter (cdr variable))))
 	(t (push keyw extra-keywords) (push (pop body) extra-keywords))))
 
     (setq keymap-sym (if (and keymap (symbolp keymap)) keymap
@@ -230,7 +239,8 @@
 	 ;; repeat-command still does the toggling correctly.
 	 (interactive (list (or current-prefix-arg 'toggle)))
 	 (let ((,last-message (current-message)))
-           (,(if (symbolp mode) 'setq 'setf) ,mode
+           (,@(if setter (list setter)
+                (list (if (symbolp mode) 'setq 'setf) mode))
             (if (eq arg 'toggle)
                 (not ,mode)
               ;; A nil argument also means ON now.
@@ -240,7 +250,8 @@
            (run-hooks ',hook (if ,mode ',hook-on ',hook-off))
            (if (called-interactively-p 'any)
                (progn
-                 ,(if globalp `(customize-mark-as-set ',mode))
+                 ,(if (and globalp (symbolp mode))
+                      `(customize-mark-as-set ',mode))
                  ;; Avoid overwriting a message shown by the body,
                  ;; but do overwrite previous messages.
                  (unless (and (current-message)
@@ -265,10 +276,15 @@
 		     (t (error "Invalid keymap %S" ,keymap))))
 	     ,(format "Keymap for `%s'." mode-name)))
 
-       ,(unless variable
-          `(add-minor-mode ',mode ',lighter
+       ,(if (not (symbolp mode))
+            (if (or lighter keymap)
+                (error ":lighter and :keymap unsupported with mode expression %s" mode))
+          `(with-no-warnings
+             (add-minor-mode ',mode ',lighter
                            ,(if keymap keymap-sym
-                              `(if (boundp ',keymap-sym) ,keymap-sym)))))))
+                                `(if (boundp ',keymap-sym) ,keymap-sym))
+                             nil
+                             ,(unless (eq mode modefun) 'modefun)))))))
 
 ;;;
 ;;; make global minor mode
--- a/lisp/files.el	Wed May 05 23:05:35 2010 +0000
+++ b/lisp/files.el	Thu May 06 03:24:12 2010 +0000
@@ -5150,29 +5150,25 @@
         (kill-buffer-ask buffer)))))
 
 
-(defun auto-save-mode (arg)
+(define-minor-mode auto-save-mode
   "Toggle auto-saving of contents of current buffer.
 With prefix argument ARG, turn auto-saving on if positive, else off."
-  (interactive "P")
-  (setq buffer-auto-save-file-name
-        (and (if (null arg)
-		 (or (not buffer-auto-save-file-name)
-		     ;; If auto-save is off because buffer has shrunk,
-		     ;; then toggling should turn it on.
-		     (< buffer-saved-size 0))
-	       (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))
-	     (if (and buffer-file-name auto-save-visited-file-name
-		      (not buffer-read-only))
-		 buffer-file-name
-	       (make-auto-save-file-name))))
+  :variable ((and buffer-auto-save-file-name
+                  ;; If auto-save is off because buffer has shrunk,
+                  ;; then toggling should turn it on.
+                  (>= buffer-saved-size 0))
+             . (lambda (val)
+                 (setq buffer-auto-save-file-name
+                       (cond
+                        ((null val) nil)
+                        ((and buffer-file-name auto-save-visited-file-name
+                              (not buffer-read-only))
+                         buffer-file-name)
+                        (t (make-auto-save-file-name))))))
   ;; If -1 was stored here, to temporarily turn off saving,
   ;; turn it back on.
   (and (< buffer-saved-size 0)
-       (setq buffer-saved-size 0))
-  (if (called-interactively-p 'interactive)
-      (message "Auto-save %s (in this buffer)"
-	       (if buffer-auto-save-file-name "on" "off")))
-  buffer-auto-save-file-name)
+       (setq buffer-saved-size 0)))
 
 (defun rename-auto-save-file ()
   "Adjust current buffer's auto save file name for current conditions.
--- a/lisp/minibuffer.el	Wed May 05 23:05:35 2010 +0000
+++ b/lisp/minibuffer.el	Thu May 06 03:24:12 2010 +0000
@@ -1983,6 +1983,17 @@
       (nconc (completion-pcm--hilit-commonality pattern all)
              (length prefix)))))
 
+(defun completion--sreverse (str)
+  "Like `reverse' but for a string STR rather than a list."
+  (apply 'string (nreverse (mapcar 'identity str))))
+
+(defun completion--common-suffix (strs)
+  "Return the common suffix of the strings STRS."
+  (completion--sreverse
+   (try-completion
+    ""
+    (mapcar 'completion--sreverse comps))))
+
 (defun completion-pcm--merge-completions (strs pattern)
   "Extract the commonality in STRS, with the help of PATTERN."
   ;; When completing while ignoring case, we want to try and avoid
@@ -2044,7 +2055,17 @@
                 ;; `any' into a `star' because the surrounding context has
                 ;; changed such that string->pattern wouldn't add an `any'
                 ;; here any more.
-                (unless unique (push elem res))
+                (unless unique
+                  (push elem res)
+                  (when (memq elem '(star point))
+                    ;; Extract common suffix additionally to common prefix.
+                    ;; Only do it for `point' and `star' since for
+                    ;; `any' it could lead to a merged completion that
+                    ;; doesn't itself match the candidates.
+                    (let ((suffix (completion--common-suffix comps)))
+                      (assert (stringp suffix))
+                      (unless (equal suffix "")
+                        (push suffix res)))))
                 (setq fixed "")))))
         ;; We return it in reverse order.
         res)))))