* minibuffer.el (completion-boundaries): Change calling convention, so

`string' has the same semantics as in try-completion and all-completions.
(completion-table-with-context, completion--embedded-envvar-table)
(completion--file-name-table, completion-pcm--find-all-completions):
Adjust code accordingly.
* vc-bzr.el (vc-bzr-annotate-time): Reduce memory allocation.
(vc-bzr-revision-completion-table): Handle `boundaries' argument.

3 files changed, 74 insertions, 50 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 86781502425..e2657926e99 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2008-05-23  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * vc-bzr.el (vc-bzr-annotate-time): Reduce memory allocation.
+        (vc-bzr-revision-completion-table): Handle `boundaries' argument.
+
+        * minibuffer.el (completion-boundaries): Change calling convention, so
+        `string' has the same semantics as in try-completion and all-completions.
+        (completion-table-with-context, completion--embedded-envvar-table)
+        (completion--file-name-table, completion-pcm--find-all-completions):
+        Adjust code accordingly.
+
 2008-05-22  Chong Yidong  <cyd@stupidchicken.com>
 
         * image-mode.el (image-mode-winprops): Add argument CLEANUP to
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index f8d7a15a69f..f24d1b068be 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -28,7 +28,8 @@
 ;; - If completion-all-completions-with-base-size is set, then all-completions
 ;;   should return the base-size in the last cdr.
 ;; - The `action' can be (additionally to nil, t, and lambda) of the form
-;;   (boundaries . POS) in which case it should return (boundaries START . END).
+;;   (boundaries . SUFFIX) in which case it should return
+;;   (boundaries START . END).  See `completion-boundaries'.
 ;;   Any other return value should be ignored (so we ignore values returned
 ;;   from completion tables that don't know about this new `action' form).
 ;;   See `completion-boundaries'.
@@ -64,23 +65,23 @@ element in the returned list of completions.  See `completion-base-size'.")
 ;;; Completion table manipulation
 
 ;; New completion-table operation.
-(defun completion-boundaries (string table pred pos)
-  "Return the boundaries of the completions returned by TABLE at POS.
+(defun completion-boundaries (string table pred suffix)
+  "Return the boundaries of the completions returned by TABLE for STRING.
 STRING is the string on which completion will be performed.
-The result is of the form (START . END) and gives the start and end position
-corresponding to the substring of STRING that can be completed by one
-of the elements returned by
-\(all-completions (substring STRING 0 POS) TABLE PRED).
+SUFFIX is the string after point.
+The result is of the form (START . END) where START is the position
+in STRING of the beginning of the completion field and END is the position
+in SUFFIX of the end of the completion field.
 I.e. START is the same as the `completion-base-size'.
-E.g. for simple completion tables, the result is always (0 . (length STRING))
-and for file names the result is the substring around POS delimited by
+E.g. for simple completion tables, the result is always (0 . (length SUFFIX))
+and for file names the result is the positions delimited by
 the closest directory separators."
   (let ((boundaries (if (functionp table)
-                        (funcall table string pred (cons 'boundaries pos)))))
+                        (funcall table string pred (cons 'boundaries suffix)))))
     (if (not (eq (car-safe boundaries) 'boundaries))
         (setq boundaries nil))
     (cons (or (cadr boundaries) 0)
-          (or (cddr boundaries) (length string)))))
+          (or (cddr boundaries) (length suffix)))))
 
 (defun completion--some (fun xs)
   "Apply FUN to each element of XS in turn.
@@ -177,9 +178,8 @@ You should give VAR a non-nil `risky-local-variable' property."
                 (funcall pred (concat prefix (if (consp s) (car s) s)))))))))
   (if (eq (car-safe action) 'boundaries)
       (let* ((len (length prefix))
-             (bound (completion-boundaries string table pred
-                                           (- (cdr action) len))))
-        (list* 'boundaries (+ (car bound) len) (+ (cdr bound) len)))
+             (bound (completion-boundaries string table pred (cdr action))))
+        (list* 'boundaries (+ (car bound) len) (cdr bound)))
     (let ((comp (complete-with-action action table string pred)))
       (cond
        ;; In case of try-completion, add the prefix.
@@ -951,13 +951,12 @@ specified by COMMON-SUBSTRING."
   (if (eq (car-safe action) 'boundaries)
       ;; Compute the boundaries of the subfield to which this
       ;; completion applies.
-      (let* ((pos (cdr action))
-             (suffix (substring string pos)))
-        (if (string-match completion--embedded-envvar-re
-                          (substring string 0 pos))
-            (list* 'boundaries (or (match-beginning 2) (match-beginning 1))
+      (let ((suffix (cdr action)))
+        (if (string-match completion--embedded-envvar-re string)
+            (list* 'boundaries
+                   (or (match-beginning 2) (match-beginning 1))
                    (when (string-match "[^[:alnum:]_]" suffix)
-                     (+ pos (match-beginning 0))))))
+                     (match-beginning 0)))))
     (when (string-match completion--embedded-envvar-re string)
       (let* ((beg (or (match-beginning 2) (match-beginning 1)))
              (table (completion--make-envvar-table))
@@ -976,9 +975,8 @@ specified by COMMON-SUBSTRING."
    ((eq (car-safe action) 'boundaries)
     ;; FIXME: Actually, this is not always right in the presence of
     ;; envvars, but there's not much we can do, I think.
-    (let ((start (length (file-name-directory
-                          (substring string 0 (cdr action)))))
-          (end (string-match "/" string (cdr action))))
+    (let ((start (length (file-name-directory string)))
+          (end (string-match "/" (cdr action))))
       (list* 'boundaries start end)))
     
    (t
@@ -1414,14 +1412,15 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
        base-size))))
 
 (defun completion-pcm--find-all-completions (string table pred point)
-  (let* ((bounds (completion-boundaries string table pred point))
-         (prefix (substring string 0 (car bounds)))
-         (suffix (substring string (cdr bounds)))
-         (origstring string)
+  (let* ((beforepoint (substring string 0 point))
+         (afterpoint (substring string point))
+         (bounds (completion-boundaries beforepoint table pred afterpoint))
+         (prefix (substring beforepoint 0 (car bounds)))
+         (suffix (substring afterpoint (cdr bounds)))
          firsterror)
-    (setq string (substring string (car bounds) (cdr bounds)))
-    (let* ((pattern (completion-pcm--string->pattern
-                     string (- point (car bounds))))
+    (setq string (substring string (car bounds) (+ point (cdr bounds))))
+    (let* ((relpoint (- point (car bounds)))
+           (pattern (completion-pcm--string->pattern string relpoint))
            (all (condition-case err
                     (completion-pcm--all-completions prefix pattern table pred)
                   (error (unless firsterror (setq firsterror err)) nil))))
@@ -1446,28 +1445,30 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
                 ;; Update the boundaries and corresponding pattern.
                 ;; We assume that all submatches result in the same boundaries
                 ;; since we wouldn't know how to merge them otherwise anyway.
-                (let* ((newstring (concat subprefix (car suball) string suffix))
-                       (newpoint (+ point (- (length newstring)
-                                             (length origstring))))
+                ;; FIXME: COMPLETE REWRITE!!!
+                (let* ((newbeforepoint
+                        (concat subprefix (car suball)
+                                (substring string 0 relpoint)))
+                       (leftbound (+ (length subprefix) (length (car suball))))
                        (newbounds (completion-boundaries
-                                   newstring table pred newpoint))
-                       (newsubstring
-                        (substring newstring (car newbounds) (cdr newbounds))))
-                  (unless (or (equal newsubstring string)
+                                   newbeforepoint table pred afterpoint)))
+                  (unless (or (and (eq (cdr bounds) (cdr newbounds))
+                                   (eq (car newbounds) leftbound))
                               ;; Refuse new boundaries if they step over
                               ;; the submatch.
-                              (< (car newbounds)
-                                 (+ (length subprefix) (length (car suball)))))
+                              (< (car newbounds) leftbound))
                     ;; The new completed prefix does change the boundaries
                     ;; of the completed substring.
-                    (setq suffix (substring newstring (cdr newbounds)))
-                    (setq string newsubstring)
-                    (setq between (substring newstring
-                                             (+ (length subprefix)
-                                                (length (car suball)))
+                    (setq suffix (substring afterpoint (cdr newbounds)))
+                    (setq string
+                          (concat (substring newbeforepoint (car newbounds))
+                                  (substring afterpoint 0 (cdr newbounds))))
+                    (setq between (substring newbeforepoint leftbound
                                              (car newbounds)))
                     (setq pattern (completion-pcm--string->pattern
-                                   string (- newpoint (car bounds)))))
+                                   string
+                                   (- (length newbeforepoint)
+                                      (car newbounds)))))
                   (dolist (submatch suball)
                     (setq all (nconc (mapcar
                                       (lambda (s) (concat submatch between s))
diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el
index d9f8a127f3a..a54cd7319f4 100644
--- a/lisp/vc-bzr.el
+++ b/lisp/vc-bzr.el
@@ -538,12 +538,12 @@ property containing author and date information."
   (when (re-search-forward "^ *[0-9.]+ +|" nil t)
     (let ((prop (get-text-property (line-beginning-position) 'help-echo)))
       (string-match "[0-9]+\\'" prop)
+      (let ((str (match-string-no-properties 0 prop)))
       (vc-annotate-convert-time
        (encode-time 0 0 0
-                    (string-to-number (substring (match-string 0 prop) 6 8))
-                    (string-to-number (substring (match-string 0 prop) 4 6))
-                    (string-to-number (substring (match-string 0 prop) 0 4))
-                    )))))
+                      (string-to-number (substring str 6 8))
+                      (string-to-number (substring str 4 6))
+                      (string-to-number (substring str 0 4))))))))
 
 (defun vc-bzr-annotate-extract-revision-at-line ()
   "Return revision for current line of annoation buffer, or nil.
@@ -580,8 +580,11 @@ stream.  Standard error output is discarded."
                        (" M" . edited)
                        ;; XXX: what about ignored files?
                        (" D" . missing)
+                       ;; For conflicts, should we list the .THIS/.BASE/.OTHER?
                        ("C " . conflict)
-                       ("? " . unregistered)))
+                       ("? " . unregistered)
+                       ;; Ignore "P " and "P." for pending patches.
+                       ))
         (translated nil)
         (result nil))
       (goto-char (point-min))
@@ -625,6 +628,8 @@ stream.  Standard error output is discarded."
        ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):"
                       string)
         (completion-table-with-context (substring string 0 (match-end 0))
+                                       ;; FIXME: only allow directories.
+                                       ;; FIXME: don't allow envvars.
                                        'read-file-name-internal
                                        (substring string (match-end 0))
                                        ;; Dropping `pred'.   Maybe we should
@@ -655,7 +660,14 @@ stream.  Standard error output is discarded."
        ((string-match "\\`\\(revid\\):" string)
         ;; FIXME: How can I get a list of revision ids?
         )
+       ((eq (car-safe action) 'boundaries)
+        (list* 'boundaries
+               (if (string-match ":" string) (1+ (match-beginning 0)))
+               (string-match ":" (cdr action))))
        (t
+        ;; Could use completion-table-with-terminator, except that it
+        ;; currently doesn't work right w.r.t pcm and doesn't give
+        ;; the *Completions* output we want.
         (complete-with-action action '("revno:" "revid:" "last:" "before:"
                                        "tag:" "date:" "ancestor:" "branch:"
                                        "submit:")