comparison lisp/vc-hg.el @ 82012:878cfe0c0c5a

(vc-hg-dir-state): Fix loop. (vc-hg-print-log): Fix expected return value for vc-hg-command. (vc-hg-next-version, vc-hg-delete-file, vc-hg-rename-file) (vc-hg-register, vc-hg-create-repo, vc-hg-checkin) (vc-hg-revert): Likewise. (vc-hg-revision-table, vc-hg-revision-completion-table): New functions.
author Dan Nicolaescu <dann@ics.uci.edu>
date Sat, 21 Jul 2007 16:44:56 +0000
parents 52950d8efd2b
children 61db43184da9
comparison
equal deleted inserted replaced
82011:79d0a96eebd0 82012:878cfe0c0c5a
74 ;; - wash-log (file) ?? 74 ;; - wash-log (file) ??
75 ;; - logentry-check () NOT NEEDED 75 ;; - logentry-check () NOT NEEDED
76 ;; - comment-history (file) NOT NEEDED 76 ;; - comment-history (file) NOT NEEDED
77 ;; - update-changelog (files) NOT NEEDED 77 ;; - update-changelog (files) NOT NEEDED
78 ;; * diff (files &optional rev1 rev2 buffer) OK 78 ;; * diff (files &optional rev1 rev2 buffer) OK
79 ;; - revision-completion-table (file) ?? 79 ;; - revision-completion-table (file) OK
80 ;; - diff-tree (dir &optional rev1 rev2) TEST IT 80 ;; - diff-tree (dir &optional rev1 rev2) TEST IT
81 ;; - revision-completion-table (file) ??
82 ;; - annotate-command (file buf &optional rev) OK 81 ;; - annotate-command (file buf &optional rev) OK
83 ;; - annotate-time () OK 82 ;; - annotate-time () OK
84 ;; - annotate-current-time () ?? NOT NEEDED 83 ;; - annotate-current-time () ?? NOT NEEDED
85 ;; - annotate-extract-revision-at-line () OK 84 ;; - annotate-extract-revision-at-line () OK
86 ;; SNAPSHOT SYSTEM 85 ;; SNAPSHOT SYSTEM
113 ;; 112 ;;
114 113
115 ;;; Code: 114 ;;; Code:
116 115
117 (eval-when-compile 116 (eval-when-compile
117 (require 'cl)
118 (require 'vc)) 118 (require 'vc))
119 119
120 ;;; Customization options 120 ;;; Customization options
121 121
122 (defcustom vc-hg-global-switches nil 122 (defcustom vc-hg-global-switches nil
182 (with-temp-buffer 182 (with-temp-buffer
183 (vc-hg-command (current-buffer) nil nil "status") 183 (vc-hg-command (current-buffer) nil nil "status")
184 (goto-char (point-min)) 184 (goto-char (point-min))
185 (let ((status-char nil) 185 (let ((status-char nil)
186 (file nil)) 186 (file nil))
187 (while (eq 0 (forward-line)) 187 (while (not (eobp))
188 (setq status-char (char-after)) 188 (setq status-char (char-after))
189 (setq file 189 (setq file
190 (expand-file-name 190 (expand-file-name
191 (buffer-substring-no-properties (+ (point) 2) (line-end-position)))) 191 (buffer-substring-no-properties (+ (point) 2)
192 (line-end-position))))
192 (cond 193 (cond
193 ;; The rest of the possible states in "hg status" output: 194 ;; The rest of the possible states in "hg status" output:
194 ;; R = removed 195 ;; R = removed
195 ;; ! = deleted, but still tracked 196 ;; ! = deleted, but still tracked
196 ;; ? = not tracked 197 ;; ? = not tracked
201 (vc-file-setprop file 'vc-state 'edited)) 202 (vc-file-setprop file 'vc-state 'edited))
202 ((eq status-char ?M) 203 ((eq status-char ?M)
203 (vc-file-setprop file 'vc-state 'edited)) 204 (vc-file-setprop file 'vc-state 'edited))
204 ((eq status-char ??) 205 ((eq status-char ??)
205 (vc-file-setprop file 'vc-backend 'none) 206 (vc-file-setprop file 'vc-backend 'none)
206 (vc-file-setprop file 'vc-state 'nil))))))) 207 (vc-file-setprop file 'vc-state 'nil)))
208 (forward-line)))))
207 209
208 (defun vc-hg-workfile-version (file) 210 (defun vc-hg-workfile-version (file)
209 "Hg-specific version of `vc-workfile-version'." 211 "Hg-specific version of `vc-workfile-version'."
210 (let* 212 (let*
211 ((status nil) 213 ((status nil)
246 ;; together. 248 ;; together.
247 (dolist (file files) 249 (dolist (file files)
248 (with-current-buffer 250 (with-current-buffer
249 buffer 251 buffer
250 (insert "File: " (file-name-nondirectory file) "\n")) 252 (insert "File: " (file-name-nondirectory file) "\n"))
251 (vc-hg-command buffer nil file "log")))) 253 (vc-hg-command buffer 0 file "log"))))
252 254
253 (defvar log-view-message-re) 255 (defvar log-view-message-re)
254 (defvar log-view-file-re) 256 (defvar log-view-file-re)
255 (defvar log-view-font-lock-keywords) 257 (defvar log-view-font-lock-keywords)
256 258
291 (if newvers 293 (if newvers
292 (list "-r" oldvers "-r" newvers) 294 (list "-r" oldvers "-r" newvers)
293 (list "-r" oldvers)) 295 (list "-r" oldvers))
294 (list "")))))) 296 (list ""))))))
295 297
298 (defun vc-hg-revision-table (file)
299 (let ((default-directory (file-name-directory file)))
300 (with-temp-buffer
301 (vc-hg-command t nil file "log" "--template" "{rev} ")
302 (split-string
303 (buffer-substring-no-properties (point-min) (point-max))))))
304
305 ;; Modelled after the similar function in vc-cvs.el
306 (defun vc-hg-revision-completion-table (file)
307 (lexical-let ((file file)
308 table)
309 (setq table (lazy-completion-table
310 table (lambda () (vc-hg-revision-table file))))
311 table))
312
296 (defun vc-hg-diff-tree (file &optional oldvers newvers buffer) 313 (defun vc-hg-diff-tree (file &optional oldvers newvers buffer)
297 (vc-hg-diff (list file) oldvers newvers buffer)) 314 (vc-hg-diff (list file) oldvers newvers buffer))
298 315
299 (defun vc-hg-annotate-command (file buffer &optional version) 316 (defun vc-hg-annotate-command (file buffer &optional version)
300 "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER. 317 "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
329 346
330 (defun vc-hg-next-version (file rev) 347 (defun vc-hg-next-version (file rev)
331 (let ((newrev (1+ (string-to-number rev))) 348 (let ((newrev (1+ (string-to-number rev)))
332 (tip-version 349 (tip-version
333 (with-temp-buffer 350 (with-temp-buffer
334 (vc-hg-command t nil nil "tip") 351 (vc-hg-command t 0 nil "tip")
335 (goto-char (point-min)) 352 (goto-char (point-min))
336 (re-search-forward "^changeset:[ \t]*\\([0-9]+\\):") 353 (re-search-forward "^changeset:[ \t]*\\([0-9]+\\):")
337 (string-to-number (match-string-no-properties 1))))) 354 (string-to-number (match-string-no-properties 1)))))
338 ;; We don't want to exceed the maximum possible version number, ie 355 ;; We don't want to exceed the maximum possible version number, ie
339 ;; the tip version. 356 ;; the tip version.
344 (defun vc-hg-delete-file (file) 361 (defun vc-hg-delete-file (file)
345 "Delete FILE and delete it in the hg repository." 362 "Delete FILE and delete it in the hg repository."
346 (condition-case () 363 (condition-case ()
347 (delete-file file) 364 (delete-file file)
348 (file-error nil)) 365 (file-error nil))
349 (vc-hg-command nil nil file "remove" "--after" "--force")) 366 (vc-hg-command nil 0 file "remove" "--after" "--force"))
350 367
351 ;; Modelled after the similar function in vc-bzr.el 368 ;; Modelled after the similar function in vc-bzr.el
352 (defun vc-hg-rename-file (old new) 369 (defun vc-hg-rename-file (old new)
353 "Rename file from OLD to NEW using `hg mv'." 370 "Rename file from OLD to NEW using `hg mv'."
354 (vc-hg-command nil nil new old "mv")) 371 (vc-hg-command nil 0 new old "mv"))
355 372
356 (defun vc-hg-register (files &optional rev comment) 373 (defun vc-hg-register (files &optional rev comment)
357 "Register FILES under hg. 374 "Register FILES under hg.
358 REV is ignored. 375 REV is ignored.
359 COMMENT is ignored." 376 COMMENT is ignored."
360 (vc-hg-command nil nil files "add")) 377 (vc-hg-command nil 0 files "add"))
361 378
362 (defun vc-hg-create-repo () 379 (defun vc-hg-create-repo ()
363 "Create a new Mercurial repository." 380 "Create a new Mercurial repository."
364 (vc-hg-command nil nil nil "init")) 381 (vc-hg-command nil 0 nil "init"))
365 382
366 (defalias 'vc-hg-responsible-p 'vc-hg-root) 383 (defalias 'vc-hg-responsible-p 'vc-hg-root)
367 384
368 ;; Modelled after the similar function in vc-bzr.el 385 ;; Modelled after the similar function in vc-bzr.el
369 (defun vc-hg-could-register (file) 386 (defun vc-hg-could-register (file)
382 ;; (vc-hg-command nil nil file "remove")) 399 ;; (vc-hg-command nil nil file "remove"))
383 400
384 (defun vc-hg-checkin (files rev comment) 401 (defun vc-hg-checkin (files rev comment)
385 "HG-specific version of `vc-backend-checkin'. 402 "HG-specific version of `vc-backend-checkin'.
386 REV is ignored." 403 REV is ignored."
387 (vc-hg-command nil nil files "commit" "-m" comment)) 404 (vc-hg-command nil 0 files "commit" "-m" comment))
388 405
389 (defun vc-hg-find-version (file rev buffer) 406 (defun vc-hg-find-version (file rev buffer)
390 (let ((coding-system-for-read 'binary) 407 (let ((coding-system-for-read 'binary)
391 (coding-system-for-write 'binary)) 408 (coding-system-for-write 'binary))
392 (if rev 409 (if rev
393 (vc-hg-command buffer nil file "cat" "-r" rev) 410 (vc-hg-command buffer 0 file "cat" "-r" rev)
394 (vc-hg-command buffer nil file "cat")))) 411 (vc-hg-command buffer 0 file "cat"))))
395 412
396 ;; Modelled after the similar function in vc-bzr.el 413 ;; Modelled after the similar function in vc-bzr.el
397 (defun vc-hg-checkout (file &optional editable rev) 414 (defun vc-hg-checkout (file &optional editable rev)
398 "Retrieve a revision of FILE. 415 "Retrieve a revision of FILE.
399 EDITABLE is ignored. 416 EDITABLE is ignored.
400 REV is the revision to check out into WORKFILE." 417 REV is the revision to check out into WORKFILE."
401 (let ((coding-system-for-read 'binary) 418 (let ((coding-system-for-read 'binary)
402 (coding-system-for-write 'binary)) 419 (coding-system-for-write 'binary))
403 (with-current-buffer (or (get-file-buffer file) (current-buffer)) 420 (with-current-buffer (or (get-file-buffer file) (current-buffer))
404 (if rev 421 (if rev
405 (vc-hg-command t nil file "cat" "-r" rev) 422 (vc-hg-command t 0 file "cat" "-r" rev)
406 (vc-hg-command t nil file "cat"))))) 423 (vc-hg-command t 0 file "cat")))))
407 424
408 (defun vc-hg-checkout-model (file) 425 (defun vc-hg-checkout-model (file)
409 'implicit) 426 'implicit)
410 427
411 ;; Modelled after the similar function in vc-bzr.el 428 ;; Modelled after the similar function in vc-bzr.el
422 (vc-default-dired-state-info 'HG file)))) 439 (vc-default-dired-state-info 'HG file))))
423 440
424 ;; Modelled after the similar function in vc-bzr.el 441 ;; Modelled after the similar function in vc-bzr.el
425 (defun vc-hg-revert (file &optional contents-done) 442 (defun vc-hg-revert (file &optional contents-done)
426 (unless contents-done 443 (unless contents-done
427 (with-temp-buffer (vc-hg-command t nil file "revert")))) 444 (with-temp-buffer (vc-hg-command t 0 file "revert"))))
428 445
429 ;;; Internal functions 446 ;;; Internal functions
430 447
431 (defun vc-hg-command (buffer okstatus file-or-list &rest flags) 448 (defun vc-hg-command (buffer okstatus file-or-list &rest flags)
432 "A wrapper around `vc-do-command' for use in vc-hg.el. 449 "A wrapper around `vc-do-command' for use in vc-hg.el.