changeset 109217:40e65e1697a4

Merge from mainline.
author Katsumi Yamaoka <katsumi@flagship2>
date Wed, 09 Jun 2010 11:45:35 +0000
parents 42fed2a860b2 (current diff) 5173ad363d4b (diff)
children 8929f83798c1
files
diffstat 12 files changed, 394 insertions(+), 34 deletions(-) [+]
line wrap: on
line diff
--- a/admin/notes/bugtracker	Tue Jun 08 13:59:22 2010 +0000
+++ b/admin/notes/bugtracker	Wed Jun 09 11:45:35 2010 +0000
@@ -149,6 +149,23 @@
 
 ^X-GNU-PR-Message: (transcript|closed)
 
+** Not receiving messages in response to your control commands?
+The messages debbugs sends out in response to control-server commands
+always have headers To: your@email, and Cc: tracker@debbugs.gnu.org
+(the latter is an alias for the emacs-bug-tracker mailing list).
+These are also the addresses to which a copy of the response is sent.
+(In general, there need not be any relation between the To: and Cc:
+headers visible in a message and where debbugs actually sends it.)
+If you used an X-Debbugs-No-Ack header, however, a copy is _not_ sent
+to you, but the To: header is unchanged.  If you are subscribed to the
+emacs-bug-tracker mailing list and have duplicate suppression turned
+on, the presence of your address in the To: header will cause Mailman
+to not send you a list copy, because it thinks you have received a
+direct copy.  If you used X-Debbugs-No-Ack, this is not the case, and
+you won't get any copy at all.  If this bothers you, don't use both
+X-Debbugs-No-Ack and Mailman duplicate suppression for the
+emacs-bug-tracker mailing list, just pick one or the other.
+
 ** How to avoid multiple copies of mails.
 If you reply to reports in the normal way, this should work fine.
 Basically, reply only to the numbered bug address (and any individual
--- a/etc/ChangeLog	Tue Jun 08 13:59:22 2010 +0000
+++ b/etc/ChangeLog	Wed Jun 09 11:45:35 2010 +0000
@@ -1,3 +1,7 @@
+2010-06-09  Michael Albinus  <michael.albinus@gmx.de>
+
+	* NEWS: Add notifications.el.
+
 2010-05-28  Glenn Morris  <rgm@gnu.org>
 
 	* MACHINES: Remove some old information no longer of relevance.
--- a/etc/NEWS	Tue Jun 08 13:59:22 2010 +0000
+++ b/etc/NEWS	Wed Jun 09 11:45:35 2010 +0000
@@ -183,6 +183,11 @@
 Some backends handle some of those headers specially, but any unknown header
 is just left as is in the message, so it is not lost.
 
+**** vc-git handles Author: and Date:
+**** vc-hg handles  Author: and Date:
+**** vc-bzr handles Author:, Date: and Fixes:
+**** vc-mtn handles Author: and Date:
+
 ** Directory local variables can apply to file-less buffers.
 For example, adding "(diff-mode . ((mode . whitespace)))" to your
 .dir-locals.el file, will turn on `whitespace-mode' for *vc-diff* buffers.
@@ -239,6 +244,9 @@
 `secrets-show-secrets' offers a buffer with a visualization of the
 secrets.
 
+** notifications.el provides an implementation of the Desktop
+Notifications API.  It requires D-Bus for communication.
+
 
 * Incompatible Lisp Changes in Emacs 24.1
 
--- a/lisp/ChangeLog	Tue Jun 08 13:59:22 2010 +0000
+++ b/lisp/ChangeLog	Wed Jun 09 11:45:35 2010 +0000
@@ -1,3 +1,47 @@
+2010-06-09  Juanma Barranquero  <lekktu@gmail.com>
+
+	* emacs-lisp/smie.el (comment-string-strip): Declare function.
+	(smie-precs-precedence-table): Fix typo in docstring.
+
+	* vc-mtn.el (log-edit-extract-headers): Declare function.
+
+	* vc-hg.el (log-edit-extract-headers): Remove duplicate declaration.
+
+	* net/notifications.el (dbus-register-signal): Declare function.
+	(notifications-notify): Fix typos and reflow docstring.
+
+2010-06-09  Dan Nicolaescu  <dann@ics.uci.edu>
+
+	Improve VC create/retrieve tag/branch.
+	* vc.el (vc-create-tag): Do not read the directory name for VCs
+	with repository revision granularity.  Adjust the tag/branch
+	prompt.  Reset VC properties.
+	(vc-retrieve-tag): Do not read the directory name for VCs
+	with repository revision granularity.  Reset VC properties.
+
+2010-06-09  Julien Danjou  <julien@danjou.info>
+
+	* net/notifications.el: New file.
+
+2010-06-09  Dan Nicolaescu  <dann@ics.uci.edu>
+
+	Add optional support for resetting VC properties.
+	* vc-dispatcher.el (vc-resynch-window): Add new optional argument,
+	call vc-file-clearprops when true.
+	(vc-resynch-buffer): Add new optional argument, pass it down.
+	(vc-resynch-buffers-in-directory): Likewise.
+
+	Improve support for special markup in the VC commit message.
+	* vc-mtn.el (vc-mtn-checkin): Add support for Author: and Date: markup.
+	* vc-hg.el (vc-hg-checkin): Add support for Date:.
+	* vc-git.el (vc-git-checkin):
+	* vc-bzr.el (vc-bzr-checkin): Likewise.
+
+2010-06-09  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* emacs-lisp/smie.el (smie-indent-keyword): Remove special case that
+	can be handled with a ((:before "fn") (:prev "=>" parent)) rule.
+
 2010-06-07  Martin Pohlack  <mp26@os.inf.tu-dresden.de>
 
 	* iimage.el: Remove images as soon as the underlying text is modified.
--- a/lisp/emacs-lisp/smie.el	Tue Jun 08 13:59:22 2010 +0000
+++ b/lisp/emacs-lisp/smie.el	Wed Jun 09 11:45:35 2010 +0000
@@ -45,7 +45,7 @@
 ;;   the parser's state;
 ;; - because of that locality, indentation also works just fine when earlier
 ;;   parts of the buffer are syntactically incorrect since the indentation
-;;   looks at "as little as possible" of the buffer make an indentation
+;;   looks at "as little as possible" of the buffer to make an indentation
 ;;   decision.
 ;; - they typically have no error handling and can't even detect a parsing
 ;;   error, so we don't have to worry about what to do in case of a syntax
@@ -58,14 +58,17 @@
 ;; and Ceriel Jacobs (BookBody.pdf available at
 ;; http://www.cs.vu.nl/~dick/PTAPG.html).
 ;;
-;; OTOH we had to kill many chickens, read many coffee grounds, and practiced
-;; untold numbers of black magic spells.
+;; OTOH we had to kill many chickens, read many coffee grounds, and practice
+;; untold numbers of black magic spells, to come up with the indentation code.
+;; Since then, some of that code has been beaten into submission, but the
+;; smie-indent-keyword is still pretty obscure.
 
 ;;; Code:
 
 (eval-when-compile (require 'cl))
 
 (defvar comment-continue)
+(declare-function comment-string-strip "newcomment" (str beforep afterp))
 
 ;;; Building precedence level tables from BNF specs.
 
@@ -87,7 +90,7 @@
   "Compute a 2D precedence table from a list of precedences.
 PRECS should be a list, sorted by precedence (e.g. \"+\" will
 come before \"*\"), of elements of the form \(left OP ...)
-or (right OP ...) or (nonassoc OP ...)  or (assoc OP ...).  All operators in
+or (right OP ...) or (nonassoc OP ...) or (assoc OP ...).  All operators in
 one of those elements share the same precedence level and associativity."
   (let ((prec2-table (make-hash-table :test 'equal)))
     (dolist (prec precs)
@@ -700,12 +703,6 @@
             ;;    -> d
             ;; So as to align with the earliest appropriate place.
             (smie-indent-virtual))
-           ((equal token (save-excursion
-                           (funcall smie-backward-token-function)))
-            ;; in cases such as "fn x => fn y => fn z =>",
-            ;; jump back to the very first fn.
-            ;; FIXME: should we only do that for special tokens like "=>"?
-            (smie-indent-virtual))
            ((setq tmp (assoc (cons (caddr res) token)
                              smie-indent-rules))
             (goto-char (cadr res))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/net/notifications.el	Wed Jun 09 11:45:35 2010 +0000
@@ -0,0 +1,267 @@
+;;; notifications.el --- Client interface to desktop notifications.
+
+;; Copyright (C) 2010 Free Software Foundation, Inc.
+
+;; Author: Julien Danjou <julien@danjou.info>
+;; Keywords: comm desktop notifications
+
+;; 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 an implementation of the Desktop Notifications
+;; <http://www.galago-project.org/specs/notification/>.
+
+;; In order to activate this package, you must add the following code
+;; into your .emacs:
+;;
+;;   (require 'notifications)
+
+;;; Code:
+(eval-when-compile
+  (require 'cl))
+
+;; Pacify byte-compiler.  D-Bus support in the Emacs core can be
+;; disabled with configuration option "--without-dbus".  Declare used
+;; subroutines and variables of `dbus' therefore.
+(declare-function dbus-call-method "dbusbind.c")
+(declare-function dbus-register-signal "dbusbind.c")
+
+(require 'dbus)
+
+(defconst notifications-application-name "Emacs"
+  "Default application name.")
+
+(defconst notifications-application-icon
+  (expand-file-name
+   "images/icons/hicolor/scalable/apps/emacs.svg"
+   data-directory)
+  "Default application icon.")
+
+(defconst notifications-service "org.freedesktop.Notifications"
+  "D-Bus notifications service name.")
+
+(defconst notifications-path "/org/freedesktop/Notifications"
+  "D-Bus notifications service path.")
+
+(defconst notifications-interface "org.freedesktop.Notifications"
+  "D-Bus notifications service path.")
+
+(defconst notifications-notify-method "Notify"
+  "D-Bus notifications service path.")
+
+(defconst notifications-close-notification-method "CloseNotification"
+  "D-Bus notifications service path.")
+
+(defconst notifications-action-signal "ActionInvoked"
+  "D-Bus notifications action signal.")
+
+(defconst notifications-closed-signal "NotificationClosed"
+  "D-Bus notifications closed signal.")
+
+(defconst notifications-closed-reason
+  '((1 expired)
+    (2 dismissed)
+    (3 close-notification)
+    (4 undefined))
+  "List of reasons why a notification has been closed.")
+
+(defvar notifications-on-action-map nil
+  "Mapping between notification and action callback functions.")
+
+(defvar notifications-on-close-map nil
+  "Mapping between notification and close callback functions.")
+
+(defun notifications-on-action-signal (id action)
+  (let ((entry (assoc id notifications-on-action-map)))
+    (when entry
+      (funcall (cadr entry) action)
+      (remove entry 'notifications-on-action-map))))
+
+(dbus-register-signal
+ :session
+ notifications-service
+ notifications-path
+ notifications-interface
+ notifications-action-signal
+ 'notifications-on-action-signal)
+
+(defun notifications-on-closed-signal (id reason)
+  (let ((entry (assoc id notifications-on-close-map)))
+    (when entry
+      (funcall (cadr entry) (cadr (assoc reason notifications-closed-reason)))
+      (remove entry 'notifications-on-close-map))))
+
+(dbus-register-signal
+ :session
+ notifications-service
+ notifications-path
+ notifications-interface
+ notifications-closed-signal
+ 'notifications-on-closed-signal)
+
+(defun notifications-notify (&rest params)
+  "Send notification via D-Bus using the Freedesktop notification protocol.
+Various PARAMS can be set:
+
+ :title          The notification title.
+ :body           The notification body text.
+ :app-name       The name of the application sending the notification.
+                 Default to `notifications-application-name'.
+ :replaces-id    The notification ID that this notification replaces.
+ :app-icon       The notification icon.
+                 Default is `notifications-application-icon'.
+                 Set to nil if you do not want any icon displayed.
+ :actions        A list of actions in the form:
+                   (KEY TITLE KEY TITLE ...)
+                 where KEY and TITLE are both strings.
+                 The default action (usually invoked by clicking the
+                 notification) should have a key named \"default\".
+                 The name can be anything, though implementations are free
+                 not to display it.
+ :timeout        The timeout time in milliseconds since the display
+                 of the notification at which the notification should
+                 automatically close.
+                 If -1, the notification's expiration time is dependent
+                 on the notification server's settings, and may vary for
+                 the type of notification.
+                 If 0, the notification never expires.
+                 Default value is -1.
+ :urgency        The urgency level.
+                 Either `low', `normal' or `critical'.
+ :category       The type of notification this is.
+ :desktop-entry  This specifies the name of the desktop filename representing
+                 the calling program.
+ :image-data     This is a raw data image format which describes the width,
+                 height, rowstride, has alpha, bits per sample, channels and
+                 image data respectively.
+ :sound-file     The path to a sound file to play when the notification pops up.
+ :suppress-sound Causes the server to suppress playing any sounds, if it has
+                 that ability.
+ :x              Specifies the X location on the screen that the notification
+                 should point to.  The \"y\" hint must also be specified.
+ :y              Specifies the Y location on the screen that the notification
+                 should point to.  The \"x\" hint must also be specified.
+ :on-action      Function to call when an action is invoked.  The key of the
+                 action is passed as argument to the function.
+ :on-close       Function to call when the notification has been closed
+                 by timeout or by the user.
+                 The function receives the closing reason as argument:
+                   - `expired' if the notification has expired
+                   - `dismissed' if the notification was dismissed by the user
+                   - `close-notification' if the notification was closed
+                     by a call to CloseNotification
+
+This function returns a notification id, an integer, which can be
+used to manipulate the notification item with
+`notifications-close'."
+  (let ((title (plist-get params :title))
+        (body (plist-get params :body))
+        (app-name (plist-get params :app-name))
+        (replaces-id (plist-get params :replaces-id))
+        (app-icon (plist-get params :app-icon))
+        (actions (plist-get params :actions))
+        (timeout (plist-get params :timeout))
+        ;; Hints
+        (hints '())
+        (urgency (plist-get params :urgency))
+        (category (plist-get params :category))
+        (desktop-entry (plist-get params :desktop-entry))
+        (image-data (plist-get params :image-data))
+        (sound-file (plist-get params :sound-file))
+        (suppress-sound (plist-get params :suppress-sound))
+        (x (plist-get params :x))
+        (y (plist-get params :y))
+        id)
+    ;; Build hints array
+    (when urgency
+      (add-to-list 'hints `(:dict-entry
+                            "urgency"
+                            (:variant :byte ,(case urgency
+                                               ('low 0)
+                                               ('critical 2)
+                                               (t 1)))) t))
+    (when category
+      (add-to-list 'hints `(:dict-entry
+                            "category"
+                            (:variant :string ,category)) t))
+    (when desktop-entry
+      (add-to-list 'hints `(:dict-entry
+                            "desktop-entry"
+                            (:variant :string ,desktop-entry)) t))
+    (when image-data
+      (add-to-list 'hints `(:dict-entry
+                            "image_data"
+                            (:variant :struct ,image-data)) t))
+    (when sound-file
+      (add-to-list 'hints `(:dict-entry
+                            "sound-file"
+                            (:variant :string ,sound-file)) t))
+    (when suppress-sound
+      (add-to-list 'hints `(:dict-entry
+                            "suppress-sound"
+                            (:variant :boolean ,suppress-sound)) t))
+    (when x
+      (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
+    (when y
+      (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
+
+    ;; Call Notify method
+    (setq id
+          (dbus-call-method :session
+                            notifications-service
+                            notifications-path
+                            notifications-interface
+                            notifications-notify-method
+                            :string (or app-name
+                                        notifications-application-name)
+                            :uint32 (or replaces-id 0)
+                            :string (if app-icon
+                                        (expand-file-name app-icon)
+                                      ;; If app-icon is nil because user
+                                      ;; requested it to be so, send the
+                                      ;; empty string
+                                      (if (plist-member params :app-icon)
+                                          ""
+                                        ;; Otherwise send the default icon path
+                                        notifications-application-icon))
+                            :string (or title "")
+                            :string (or body "")
+                            `(:array ,@actions)
+                            (or hints '(:array :signature "{sv}"))
+                            :int32 (or timeout -1)))
+
+    ;; Register close/action callback function
+    (let ((on-action (plist-get params :on-action))
+          (on-close (plist-get params :on-close)))
+      (when on-action
+        (add-to-list 'notifications-on-action-map (list id on-action)))
+      (when on-close
+        (add-to-list 'notifications-on-close-map (list id on-close))))
+
+    ;; Return notification id
+    id))
+
+(defun notifications-close-notification (id)
+  "Close a notification with identifier ID."
+  (dbus-call-method :session
+                    notifications-service
+                    notifications-path
+                    notifications-interface
+                    notifications-close-notification-method
+                    :int32 id))
+
+(provide 'notifications)
--- a/lisp/vc-bzr.el	Tue Jun 08 13:59:22 2010 +0000
+++ b/lisp/vc-bzr.el	Wed Jun 09 11:45:35 2010 +0000
@@ -459,6 +459,7 @@
   (if rev (error "Can't check in a specific revision with bzr"))
   (apply 'vc-bzr-command "commit" nil 0
          files (cons "-m" (log-edit-extract-headers '(("Author" . "--author")
+						      ("Date" . "--commit-time")
                                                       ("Fixes" . "--fixes"))
                                                     comment))))
 
--- a/lisp/vc-dispatcher.el	Tue Jun 08 13:59:22 2010 +0000
+++ b/lisp/vc-dispatcher.el	Wed Jun 09 11:45:35 2010 +0000
@@ -446,7 +446,7 @@
       (revert-buffer arg no-confirm t))
     (vc-restore-buffer-context context)))
 
-(defun vc-resynch-window (file &optional keep noquery)
+(defun vc-resynch-window (file &optional keep noquery reset-vc-info)
   "If FILE is in the current buffer, either revert or unvisit it.
 The choice between revert (to see expanded keywords) and unvisit
 depends on KEEP.  NOQUERY if non-nil inhibits confirmation for
@@ -457,6 +457,8 @@
   (and (string= buffer-file-name file)
        (if keep
 	   (when (file-exists-p file)
+	     (when reset-vc-info
+	       (vc-file-clearprops file))
 	     (vc-revert-buffer-internal t noquery)
 
 	     ;; VC operations might toggle the read-only state.  In
@@ -477,24 +479,24 @@
 (declare-function vc-dir-resynch-file "vc-dir" (&optional fname))
 (declare-function vc-string-prefix-p "vc" (prefix string))
 
-(defun vc-resynch-buffers-in-directory (directory &optional keep noquery)
+(defun vc-resynch-buffers-in-directory (directory &optional keep noquery reset-vc-info)
   "Resync all buffers that visit files in DIRECTORY."
   (dolist (buffer (buffer-list))
     (let ((fname (buffer-file-name buffer)))
       (when (and fname (vc-string-prefix-p directory fname))
 	(with-current-buffer buffer
-	  (vc-resynch-buffer fname keep noquery))))))
+	  (vc-resynch-buffer fname keep noquery reset-vc-info))))))
 
-(defun vc-resynch-buffer (file &optional keep noquery)
+(defun vc-resynch-buffer (file &optional keep noquery reset-vc-info)
   "If FILE is currently visited, resynch its buffer."
   (if (string= buffer-file-name file)
-      (vc-resynch-window file keep noquery)
+      (vc-resynch-window file keep noquery reset-vc-info)
     (if (file-directory-p file)
-	(vc-resynch-buffers-in-directory file keep noquery)
+	(vc-resynch-buffers-in-directory file keep noquery reset-vc-info)
       (let ((buffer (get-file-buffer file)))
 	(when buffer
 	  (with-current-buffer buffer
-	    (vc-resynch-window file keep noquery))))))
+	    (vc-resynch-window file keep noquery reset-vc-info))))))
   ;; Try to avoid unnecessary work, a *vc-dir* buffer is only present
   ;; if this is true.
   (when vc-dir-buffers
--- a/lisp/vc-git.el	Tue Jun 08 13:59:22 2010 +0000
+++ b/lisp/vc-git.el	Wed Jun 09 11:45:35 2010 +0000
@@ -554,7 +554,8 @@
   (let ((coding-system-for-write vc-git-commits-coding-system))
     (apply 'vc-git-command nil 0 files
 	   (nconc (list "commit" "-m")
-                  (log-edit-extract-headers '(("Author" . "--author"))
+                  (log-edit-extract-headers '(("Author" . "--author")
+					      ("Date" . "--date"))
                                             comment)
                   (list "--only" "--")))))
 
--- a/lisp/vc-hg.el	Tue Jun 08 13:59:22 2010 +0000
+++ b/lisp/vc-hg.el	Wed Jun 09 11:45:35 2010 +0000
@@ -297,8 +297,6 @@
 	  ("^tag: +\\([^ ]+\\)$" (1 'highlight))
 	  ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
 
-(declare-function log-edit-extract-headers "log-edit" (headers string))
-
 (defun vc-hg-diff (files &optional oldvers newvers buffer)
   "Get a difference report using hg between two revisions of FILES."
   (let* ((firstfile (car files))
@@ -429,7 +427,8 @@
 REV is ignored."
   (apply 'vc-hg-command nil 0 files
          (nconc (list "commit" "-m")
-                (log-edit-extract-headers '(("Author" . "--user"))
+                (log-edit-extract-headers '(("Author" . "--user")
+					    ("Date" . "--date"))
                                           comment))))
 
 (defun vc-hg-find-revision (file rev buffer)
--- a/lisp/vc-mtn.el	Tue Jun 08 13:59:22 2010 +0000
+++ b/lisp/vc-mtn.el	Wed Jun 09 11:45:35 2010 +0000
@@ -3,7 +3,7 @@
 ;; Copyright (C) 2007, 2008, 2009, 2010  Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-;; Keywords: 
+;; Keywords:
 
 ;; This file is part of GNU Emacs.
 
@@ -22,7 +22,7 @@
 
 ;;; Commentary:
 
-;; 
+;;
 
 ;;; TODO:
 
@@ -172,8 +172,14 @@
 (defun vc-mtn-responsible-p (file) (vc-mtn-root file))
 (defun vc-mtn-could-register (file) (vc-mtn-root file))
 
+(declare-function log-edit-extract-headers "log-edit" (headers string))
+
 (defun vc-mtn-checkin (files rev comment  &optional extra-args-ignored)
-  (vc-mtn-command nil 0 files "commit" "-m" comment))
+  (apply 'vc-mtn-command nil 0 files
+	 (nconc (list "commit" "-m")
+		(log-edit-extract-headers '(("Author" . "--author")
+					    ("Date" . "--date"))
+					  comment))))
 
 (defun vc-mtn-find-revision (file rev buffer)
   (vc-mtn-command buffer 0 file "cat" "-r" rev))
--- a/lisp/vc.el	Tue Jun 08 13:59:22 2010 +0000
+++ b/lisp/vc.el	Wed Jun 09 11:45:35 2010 +0000
@@ -580,9 +580,6 @@
 ;;   display the branch name in the mode-line. Replace
 ;;   vc-cvs-sticky-tag with that.
 ;;
-;; - vc-create-tag and vc-retrieve-tag should update the
-;;   buffers that might be visiting the affected files.
-;;
 ;;;; Internal cleanups:
 ;;
 ;; - backends that care about vc-stay-local should try to take it into
@@ -1896,14 +1893,22 @@
 given, the tag is made as a new branch and the files are
 checked out in that new branch."
   (interactive
-   (list (read-file-name "Directory: " default-directory default-directory t)
-         (read-string "New tag name: ")
-	 current-prefix-arg))
+   (let ((granularity
+	  (vc-call-backend (vc-responsible-backend default-directory)
+			   'revision-granularity)))
+     (list
+      (if (eq granularity 'repository)
+	  ;; For VC's that do not work at file level, it's pointless
+	  ;; to ask for a directory, branches are created at repository level.
+	  default-directory
+	(read-file-name "Directory: " default-directory default-directory t))
+      (read-string (if current-prefix-arg "New branch name: " "New tag name: "))
+      current-prefix-arg)))
   (message "Making %s... " (if branchp "branch" "tag"))
   (when (file-directory-p dir) (setq dir (file-name-as-directory dir)))
   (vc-call-backend (vc-responsible-backend dir)
 		   'create-tag dir name branchp)
-  (vc-resynch-buffer dir t t)
+  (vc-resynch-buffer dir t t t)
   (message "Making %s... done" (if branchp "branch" "tag")))
 
 ;;;###autoload
@@ -1914,8 +1919,16 @@
 locked files at or below DIR (but if NAME is empty, locked files are
 allowed and simply skipped)."
   (interactive
-   (list (read-file-name "Directory: " default-directory default-directory t)
-         (read-string "Tag name to retrieve (default latest revisions): ")))
+   (let ((granularity
+	  (vc-call-backend (vc-responsible-backend default-directory)
+			   'revision-granularity)))
+     (list
+      (if (eq granularity 'repository)
+	  ;; For VC's that do not work at file level, it's pointless
+	  ;; to ask for a directory, branches are created at repository level.
+	  default-directory
+	(read-file-name "Directory: " default-directory default-directory t))
+      (read-string "Tag name to retrieve (default latest revisions): "))))
   (let ((update (yes-or-no-p "Update any affected buffers? "))
 	(msg (if (or (not name) (string= name ""))
 		 (format "Updating %s... " (abbreviate-file-name dir))
@@ -1924,9 +1937,10 @@
     (message "%s" msg)
     (vc-call-backend (vc-responsible-backend dir)
 		     'retrieve-tag dir name update)
-    (vc-resynch-buffer dir t t)
+    (vc-resynch-buffer dir t t t)
     (message "%s" (concat msg "done"))))
 
+
 ;; Miscellaneous other entry points
 
 ;; FIXME: this should be a defcustom