[nongnu] elpa/vc-fossil 5b0c159 067/111: Updates from Frank Fisher. colorized logs, vc-annotate, fixes for the diff command

[ELPA Syncer]

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