branch: elpa/vc-fossil
commit 5b0c159c35a82ab6def1b8c2f391946e0a349e53
Merge: fe3e0d3 ec8c00c
Author: venks <venks>
Commit: venks <venks>
Updates from Frank Fisher. colorized logs, vc-annotate, fixes for the diff
command
---
vc/el/vc-fossil.el | 308 +++++++++++++++++++++++++++++++++--------------------
1 file changed, 194 insertions(+), 114 deletions(-)
diff --git a/vc/el/vc-fossil.el b/vc/el/vc-fossil.el
index b26303e..1b5af79 100644
--- a/vc/el/vc-fossil.el
+++ b/vc/el/vc-fossil.el
@@ -39,6 +39,22 @@
(eval-when-compile (require 'vc))
+;;; Customization
+
+(defgroup vc-fossil nil
+ "VC Fossil backend."
+ :group 'vc)
+
+(defcustom vc-fossil-diff-switches t ; Fossil doesn't support common args like
-u
+ "String or list of strings specifying switches for Fossil diff under VC.
+If nil, use the value of `vc-diff-switches'. If t, use no switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :group 'vc-fossil)
+
+
;;; BACKEND PROPERTIES
(defun vc-fossil-revision-granularity () 'repository)
@@ -57,8 +73,8 @@
(catch 'bail
(with-output-to-string
(with-current-buffer standard-output
- (unless (apply #'vc-fossil--out-ok args)
- (throw 'bail nil))))))
+ (unless (apply #'vc-fossil--out-ok args)
+ (throw 'bail nil))))))
(defun vc-fossil-root (file)
(or (vc-find-root file ".fslckout")
@@ -71,10 +87,10 @@
(defun vc-fossil-get-id (dir)
(let* ((default-directory dir)
- (info (vc-fossil--run "info"))
- (pos (string-match "checkout: *\\([0-9a-fA-F]+\\)" info))
- (uid (match-string 1 info))
- )
+ (info (vc-fossil--run "info"))
+ (pos (string-match "checkout: *\\([0-9a-fA-F]+\\)" info))
+ (uid (match-string 1 info))
+ )
(substring uid 0 9)))
;;; STATE-QUERYING FUNCTIONS
@@ -84,39 +100,36 @@
"Check whether FILE is registered with fossil."
(with-temp-buffer
(let* ((str (ignore-errors
- (vc-fossil--out-ok "finfo" "-s" (file-truename file))
- (buffer-string))))
+ (vc-fossil--out-ok "finfo" "-s" (file-truename file))
+ (buffer-string))))
(and str
- (> (length str) 7)
- (not (string= (substring str 0 7) "unknown"))))))
+ (> (length str) 7)
+ (not (string= (substring str 0 7) "unknown"))))))
(defun vc-fossil-state-code (code)
- (cond ((not code) 'unregistered)
- ((string= code "UNKNOWN") 'unregistered)
- ((string= code "UNCHANGED") 'up-to-date)
- ((string= code "CONFLICT") 'edited)
- ((string= code "ADDED") 'added)
- ((string= code "ADD") 'needs-update)
- ((string= code "EDITED") 'edited)
- ((string= code "REMOVE") 'removed)
- ((string= code "UPDATE") 'needs-update)
- ((string= code "MERGE") 'needs-merge)
- (t nil)))
-
-;; (vc-fossil-state
"/proj/fiesta/tools/fossil/emacs-fossil/vc/el/vc-fossil.el")
+ (cond ((not code) 'unregistered)
+ ((string= code "UNKNOWN") 'unregistered)
+ ((string= code "UNCHANGED") 'up-to-date)
+ ((string= code "CONFLICT") 'edited)
+ ((string= code "ADDED") 'added)
+ ((string= code "ADD") 'needs-update)
+ ((string= code "EDITED") 'edited)
+ ((string= code "REMOVE") 'removed)
+ ((string= code "UPDATE") 'needs-update)
+ ((string= code "MERGE") 'needs-merge)
+ (t nil)))
(defun vc-fossil-state (file)
"Fossil specific version of `vc-state'."
- ;; (message (format "vc-fossil-state on %s %s" file (file-truename file)))
(let ((line (vc-fossil--run "update" "-n" "-v" "current" (file-truename
file))))
(and line
- (vc-fossil-state-code (car (split-string line))))))
+ (vc-fossil-state-code (car (split-string line))))))
(defun vc-fossil-working-revision (file)
"Fossil Specific version of `vc-working-revision'."
(let ((line (vc-fossil--run "finfo" "-s" (file-truename file))))
(and line
- (cadr (split-string line)))))
+ (cadr (split-string line)))))
(defun vc-fossil-workfile-unchanged-p (file)
(eq 'up-to-date (vc-fossil-state file)))
@@ -126,53 +139,50 @@
(defun vc-fossil-dir-status (dir update-function)
- "Get Fossil status for all files in a directory"
- ;; (message dir)
- (insert (vc-fossil--run "update" "-n" "-v" "current" dir))
+ "Get fossil status for all files in a directory"
+ (vc-fossil-dir-status-files dir nil nil update-function))
+
+(defun vc-fossil-dir-status-files (dir files default-state update-function)
+ "Get fossil status for all specified files in a directory.
+If `files` is nil return the status for all files."
+ (insert (apply 'vc-fossil--run "update" "-n" "-v" "current"
+ (or files (list dir))))
(let ((result '())
- (done nil)
- (root (vc-fossil-root dir)))
+ (root (vc-fossil-root dir)))
(goto-char (point-min))
- (while (and (not (eobp)) (not done))
+ (while (not (eobp))
(let* ((line (buffer-substring-no-properties (point)
(line-end-position)))
- (status-word (car (split-string line))))
- (setq done (string-match "-----" status-word))
- (unless done
- (let ((file (substring line (+ (length status-word) 1))))
- (let ((file (expand-file-name file root)))
- (let ((file (file-relative-name file dir)))
- (setq result
- (cons (list file (vc-fossil-state-code status-word))
- result)))))))
- (forward-line))
- (funcall update-function result nil)))
-
-(defun vc-fossil-after-dir-status (callback)
- "Function to call after the status process has finished"
- (message "after-dir-status called %s" (buffer-string))
- (let ((result '()))
+ (status-word (car (split-string line))))
+ (if (string-match "-----" status-word)
+ (goto-char (point-max))
+ (let ((file (substring line (+ (length status-word) 1))))
+ (setq file (expand-file-name file root))
+ (setq file (file-relative-name file dir))
+ (push (list file (vc-fossil-state-code status-word)) result)))
+ (forward-line)))
+ ;; now collect untracked files
+ (delete-region (point-min) (point-max))
+ (insert (apply 'vc-fossil--run "extras" "--dotfiles" (or files (list
dir))))
(goto-char (point-min))
(while (not (eobp))
- (let ((line (buffer-substring-no-properties (point) (line-end-position)))
- (status-word '()))
- (message line)
- (let* ((state (vc-fossil-state-code (car (split-string line))))
- (file (expand-file-name (substring line (+ (length status-word)
1)))))
- (setq result (cons (list file state) result))))
- (forward-line))
- (funcall callback result t)))
+ (let ((file (buffer-substring-no-properties (point)
(line-end-position))))
+ (setq file (expand-file-name file dir))
+ (setq file (file-relative-name file dir))
+ (push (list file (vc-fossil-state-code nil)) result)
+ (forward-line)))
+ (funcall update-function result nil)))
(defun vc-fossil-checkout-model (files) 'implicit)
(defun vc-fossil-dir-extra-headers (dir)
(let* ((info (vc-fossil--run "info"))
- (posco (string-match "checkout: *\\([0-9a-fA-F]+\\) \\([-0-9: ]+
UTC\\)" info))
- (coid (substring (match-string 1 info) 0 9))
- (cots (format-time-string "%Y-%m-%d %H:%M:%S %Z"
- (safe-date-to-time (match-string 2 info))))
- (postag (string-match "tags: *\\(.*\\)" info))
- (tags (match-string 1 info))
- )
+ (posco (string-match "checkout: *\\([0-9a-fA-F]+\\) \\([-0-9: ]+
UTC\\)" info))
+ (coid (substring (match-string 1 info) 0 9))
+ (cots (format-time-string "%Y-%m-%d %H:%M:%S %Z"
+ (safe-date-to-time (match-string 2 info))))
+ (postag (string-match "tags: *\\(.*\\)" info))
+ (tags (match-string 1 info))
+ )
(concat
(propertize "Checkout : " 'face 'font-lock-type-face)
(propertize (concat coid " " cots) 'face 'font-lock-variable-name-face)
@@ -199,17 +209,26 @@
(defun vc-fossil-checkin (files rev comment)
- (vc-fossil-command nil 0 files "commit" "-m" comment))
+ (apply 'vc-fossil-command nil 0 files "commit" "-m" comment
+ (vc-switches 'Fossil 'checkin)))
(defun vc-fossil-find-revision (file rev buffer)
- (apply #'vc-fossil-command buffer 0 file
- "finfo" `(,@(if (or (null rev) (string= rev ""))
- '()
- `("-r" ,rev)) "-p")))
+ (if (zerop (length rev))
+ (apply #'vc-fossil-command buffer 0 file
+ "cat"
+ (vc-switches 'Fossil 'checkout))
+ (apply #'vc-fossil-command buffer 0 file
+ "cat" "-r" rev
+ (vc-switches 'Fossil 'checkout))))
(defun vc-fossil-checkout (file &optional editable rev)
- (apply #'vc-fossil-command nil 0 nil
- "update" `(,@(if (eq rev t) '() `(,rev)))))
+ (apply #'vc-fossil-command nil 0 file
+ "update"
+ (append (cond
+ ((eq rev t) nil)
+ (rev (list rev))
+ (t nil))
+ (vc-switches 'Fossil 'checkout))))
(defun vc-fossil-revert (file &optional contents-done)
"Revert FILE to the version stored in the fossil repository."
@@ -223,20 +242,77 @@
(defun vc-fossil-print-log (files buffer &optional shortlog start-revision
limit)
"Print full log for a file"
- (when files
- (vc-fossil-command buffer 0 (car files) "finfo" "-l")
- (vc-fossil-print-log (cdr files) buffer)))
-
-;; TBD: log-entry
-
-(defun vc-fossil-diff (file &optional rev1 rev2 buffer)
+ (vc-setup-buffer buffer)
+ (let ((inhibit-read-only t))
+ (with-current-buffer buffer
+ (dolist (file files)
+ (apply #'vc-fossil-command buffer 0 nil "timeline"
+ (nconc
+ (when start-revision (list "before" start-revision))
+ (when limit (list "-n" (number-to-string limit)))
+ (list "-p" (expand-file-name file))))))))
+
+(define-derived-mode vc-fossil-log-view-mode log-view-mode "Fossil-Log-View"
+ (require 'add-log) ;; we need the add-log faces
+ (setq word-wrap t)
+ (set (make-local-variable 'wrap-prefix) " ")
+ (set (make-local-variable 'log-view-file-re) "\\`a\\`")
+ (set (make-local-variable 'log-view-per-file-logs) nil)
+ (set (make-local-variable 'log-view-message-re)
+ "^[0-9:]+ \\[\\([0-9a-fA-F]*\\)\\] \\(?:\\*[^*]*\\*\\)? ?\\(.*\\)")
+ (set (make-local-variable 'log-view-font-lock-keywords)
+ (append
+ '(
+ ("^\\([0-9:]*\\) \\(\\[[[:alnum:]]*\\]\\)
\\(\\(?:\\*[[:word:]]*\\*\\)?\\) ?\\(.*?\\) (user: \\([[:word:]]*\\) tags:
\\(.*\\))"
+ (1 'change-log-date)
+ (2 'change-log-name)
+ (3 'highlight)
+ (4 'log-view-message)
+ (5 'change-log-name)
+ (6 'highlight))
+ ("^=== \\(.*\\) ==="
+ (1 'change-log-date))))))
+
+;; TODO: implement diff for directories
+(defun vc-fossil-diff (files &optional rev1 rev2 buffer)
"Get Differences for a file"
- ;; (message (format "Get diffs between rev <%s> and <%s> for file <%s>" rev1
rev2 file))
- (let ((buf (or buffer "*vc-diff*")))
+ (let ((buf (or buffer "*vc-diff*"))
+ (root (and files (expand-file-name (vc-fossil-root (car files))))))
+ ;; if we diff the root directory, do not specify a file
+ (if (or (null files)
+ (and (null (cdr files))
+ (equal root (expand-file-name (car files)))))
+ (setq files nil))
(apply #'vc-fossil-command
- buf 0 file "diff" "-i"
- `(,@(if rev1 `("--from" ,rev1) '())
- ,@(if rev2 `("--to" ,rev2) '())))))
+ buf 0 files "diff" "-i"
+ (nconc
+ (cond
+ (rev2 (list "--from" (or rev1 "current") "--to" rev2))
+ (rev1 (list "--from" rev1)))
+ (vc-switches 'Fossil 'diff)))))
+
+(defun vc-fossil-annotate-command (file buffer &optional rev)
+ "Execute \"fossil annotate\" on FILE, inserting the contents in BUFFER.
+If REV is specified, annotate that revision."
+ ;;(assert (not rev) nil "Annotating a revision not supported")
+ (vc-fossil-command buffer 0 file "annotate"))
+
+(defconst vc-fossil-annotate-re
+ "\\([[:word:]]+\\)\\s-+\\([-0-9]+\\)\\s-+[0-9]+: ")
+
+;; TODO: currently only the date is used, not the time
+(defun vc-fossil-annotate-time ()
+ (when (looking-at vc-fossil-annotate-re)
+ (goto-char (match-end 0))
+ (vc-annotate-convert-time
+ (date-to-time (format "%s 00:00:00" (match-string-no-properties 2))))))
+
+(defun vc-fossil-annotate-extract-revision-at-line ()
+ (save-excursion
+ (beginning-of-line)
+ (when (looking-at vc-fossil-annotate-re)
+ (goto-char (match-end 0))
+ (match-string-no-properties 1))))
;;; TAG SYSTEM
@@ -245,11 +321,11 @@
(defun vc-fossil-create-tag (file name branchp)
(let* ((dir (if (file-directory-p file) file (file-name-directory file)))
- (default-directory dir))
+ (default-directory dir))
(apply #'vc-fossil-command nil 0 nil `(,@(if branchp
- '("branch" "new")
- '("tag" "add"))
- ,name ,(vc-fossil-get-id dir)))))
+ '("branch" "new")
+ '("tag" "add"))
+ ,name ,(vc-fossil-get-id dir)))))
;; FIXME: we should update buffers if update is non-nill
@@ -261,44 +337,48 @@
(defun vc-fossil-previous-revision (file rev)
"Fossil specific version of the `vc-previous-revision'."
- (when file
- (with-temp-buffer
- (let ((found (not rev))
- (newver nil))
- (insert (vc-fossil--run "finfo" "-l" "-b" (file-truename file)))
- ;; (vc-fossil--call "fossil" "finfo" "-l" "-b" file)
- (goto-char (point-min))
- (while (not (eobp))
- (let* ((line (buffer-substring-no-properties (point)
(line-end-position)))
- (version (car (split-string line))))
- ;; (message line)
- (setq newver (or newver (and found version)))
- (setq found (string= version rev)))
- (forward-line))
- newver))))
+ (if file
+ (with-temp-buffer
+ (let ((found (not rev))
+ (newver nil))
+ (insert (vc-fossil--run "finfo" "-l" "-b" (file-truename file)))
+ ;; (vc-fossil--call "fossil" "finfo" "-l" "-b" file)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((line (buffer-substring-no-properties (point)
(line-end-position)))
+ (version (car (split-string line))))
+ (setq newver (or newver (and found version)))
+ (setq found (string= version rev)))
+ (forward-line))
+ newver))
+ (let ((info (vc-fossil--run "info" rev)))
+ (and (string-match "parent: *\\([0-9a-fA-F]+\\)" info)
+ (match-string 1 info)))))
(defun vc-fossil-next-revision (file rev)
"Fossil specific version of the `vc-previous-revision'."
(when file
(with-temp-buffer
(let ((found (not rev))
- (oldver nil))
- (insert (vc-fossil--run "finfo" "-l" "-b" (file-truename file)))
- ;; (vc-fossil--call "fossil" "finfo" "-l" "-b" file)
- (goto-char (point-min))
- (while (not (eobp))
- (let* ((line (buffer-substring-no-properties (point)
(line-end-position)))
- (version (car (split-string line))))
- (setq found (string= version rev))
- (setq oldver (or oldver found version)))
- (forward-line))
- oldver))))
+ (oldver nil))
+ (insert (vc-fossil--run "finfo" "-l" "-b" (file-truename file)))
+ ;; (vc-fossil--call "fossil" "finfo" "-l" "-b" file)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((line (buffer-substring-no-properties (point)
(line-end-position)))
+ (version (car (split-string line))))
+ (setq found (string= version rev))
+ (setq oldver (or oldver found version)))
+ (forward-line))
+ oldver))))
(defun vc-fossil-delete-file (file)
- (vc-fossil-command nil 0 (file-truename file) "rm"))
+ (vc-fossil-command nil 0 (file-truename file) "rm" "--hard"))
(defun vc-fossil-rename-file (old new)
- (vc-fossil-command nil 0 (list (file-truename old) (file-truename new))
"mv"))
+ (vc-fossil-command nil 0 (list (file-truename old) (file-truename new)) "mv"
"--hard"))
(provide 'vc-fossil)
+
+;;; vc-fossil.el ends here
