Mercurial > emacs
changeset 95228:451f4028c096
* 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.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Fri, 23 May 2008 01:58:15 +0000 |
| parents | 6df485632f28 |
| children | 38cbd89dd626 |
| files | lisp/ChangeLog lisp/minibuffer.el lisp/vc-bzr.el |
| diffstat | 3 files changed, 74 insertions(+), 50 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Fri May 23 01:31:32 2008 +0000 +++ b/lisp/ChangeLog Fri May 23 01:58:15 2008 +0000 @@ -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
--- a/lisp/minibuffer.el Fri May 23 01:31:32 2008 +0000 +++ b/lisp/minibuffer.el Fri May 23 01:58:15 2008 +0000 @@ -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 @@ ;;; 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 @@ (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 @@ (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 @@ ((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 @@ 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 @@ ;; 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))
--- a/lisp/vc-bzr.el Fri May 23 01:31:32 2008 +0000 +++ b/lisp/vc-bzr.el Fri May 23 01:58:15 2008 +0000 @@ -538,12 +538,12 @@ (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 @@ (" 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 @@ ((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 @@ ((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:")