[nongnu] elpa/vc-fossil 7e84860 091/111: Attempted pushes. Sigh

[ELPA Syncer]

branch: elpa/vc-fossil
commit 7e848609ec53404a30b45ac4890903b9931347ac
Author: venks1 <venksi@gmail.com>
Commit: venks1 <venksi@gmail.com>

    Attempted pushes. Sigh
---
 README.md          |   4 ++
 doc/index.wiki     |   9 ---
 vc/el/vc-fossil.el | 178 ++++++++++++++++++++++-------------------------------
 3 files changed, 76 insertions(+), 115 deletions(-)

diff --git a/README.md b/README.md
new file mode 100644
index 0000000..bd313d4
--- /dev/null
+++ b/README.md
@@ -0,0 +1,4 @@
+# emacs-fossil
+VC Mode for Emacs to work with the Fossil SCM
+
+This is mirrored from https://chiselapp.com/user/venks/repository/emacs-fossil
diff --git a/doc/index.wiki b/doc/index.wiki
index 40a13c5..0226f90 100644
--- a/doc/index.wiki
+++ b/doc/index.wiki
@@ -9,15 +9,6 @@ You need emacs version 24.1 or better.  23.* is not supported 
anymore.
 
 Short answer:
 
-Install the vc-fossil package from the MELPA package repository then
-customize the vc-handled-backend variable by adding "Fossil" to its
-list of names.
-
-Alternative, slightly longer, answer:
-
-Instead of installing from MELPA you may clone this source repository
-directly then add it manually to your Emacs setup as follows.
-
 Add this to your .emacs file, or cut and paste this into the *scratch*
 buffer and do
 <code>C-x C-e</code> to execute it.
diff --git a/vc/el/vc-fossil.el b/vc/el/vc-fossil.el
index 7c92165..ff7e140 100644
--- a/vc/el/vc-fossil.el
+++ b/vc/el/vc-fossil.el
@@ -22,11 +22,6 @@
 
 ;;; Installation:
 
-;; 1. Install this vc-fossil package.
-;; 2. Add "Fossil" to the list of VC backends using
-;;    M-x customize-variable vc-handled-backends
-
-;; Alternative manual installation
 ;; 1. Put this file somewhere in the Emacs load-path.
 ;; 2. Tell Emacs to load it when needed:
 ;;    (autoload 'vc-fossil-registered "vc-fossil")
@@ -43,7 +38,6 @@
 ;; * workfile-version (file)
 ;; * checkout-model (file)
 ;; - workfile-unchanged-p (file)
-;; - root (file)
 ;; STATE-CHANGING FUNCTIONS
 ;; * register (file &optional rev comment)
 ;; * checkin (file comment &optional rev)
@@ -51,7 +45,6 @@
 ;; * checkout (file &optional editable rev)
 ;; * revert (file &optional contents-done)
 ;; * pull (prompt)
-;; - push (prompt)
 ;; - responsible-p (file)
 ;; HISTORY FUNCTIONS
 ;; * print-log (file &optional buffer)
@@ -92,9 +85,6 @@ If nil, use the value of `vc-diff-switches'.  If t, use no 
switches."
 
 (defvar vc-fossil-history nil)
 
-(defvar vc-fossil-pull-history nil)
-(defvar vc-fossil-push-history nil)
-
 (defun vc-fossil-revision-granularity () 'repository)
 
 
@@ -114,47 +104,22 @@ If nil, use the value of `vc-diff-switches'.  If t, use 
no switches."
         (unless (apply #'vc-fossil--out-ok args)
           (throw 'bail nil))))))
 
-(defun vc-fossil--command (buffer okstatus file-or-list &rest flags)
+(defun vc-fossil-root (file)
+  (or (vc-find-root file ".fslckout")
+      (vc-find-root file "_FOSSIL_")))
+
+(defun vc-fossil-command (buffer okstatus file-or-list &rest flags)
   "A wrapper around `vc-do-command' for use in vc-fossil.el.
   The difference to vc-do-command is that this function always invokes 
`fossil'."
-  (apply #'vc-do-command (or buffer "*vc*") okstatus "fossil" file-or-list 
flags)
-  (when (eql major-mode 'vc-dir-mode)  ; update header info
-    (revert-buffer (current-buffer))))
+  (apply #'vc-do-command (or buffer "*vc*") okstatus "fossil" file-or-list 
flags))
 
-(defun vc-fossil--get-id (dir)
+(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))
          )
-    (substring uid 0 10)))
-
-(defun vc-fossil--get-repository (dir)
-  (let* ((default-directory dir)
-         (info (vc-fossil--run "info")))
-    (string-match "repository: *\\(.*\\)$" info)
-    (match-string 1 info)))
-
-(defun vc-fossil--do-async-prompted-command (command &optional prompt hist-var)
-  "Run a fossil command asynchronously.
-Allow user to edit command in minibuffer if PROMPT is non-nil."
-  (let* ((root (vc-fossil-root default-directory))
-         (buffer (format "*vc-fossil : %s*" (expand-file-name root)))
-         (fossil-program "fossil")
-         (args '()))
-    (when prompt
-      (setq args (split-string
-                  (read-shell-command "Run Fossil (like this): "
-                                      (concat fossil-program " " command)
-                                      (or hist-var 'vc-fossil-history))
-                  " " t))
-      (setq fossil-program (car args)
-            command (cadr args)
-            args (cddr args)))
-    (apply 'vc-do-async-command buffer root fossil-program command args)
-    (with-current-buffer buffer
-      (vc-run-delayed (vc-compilation-mode 'Fossil)))
-    (vc-set-async-update buffer)))
+    (substring uid 0 9)))
 
 ;;; STATE-QUERYING FUNCTIONS
 
@@ -205,18 +170,14 @@ Allow user to edit command in minibuffer if PROMPT is 
non-nil."
 (defun vc-fossil-workfile-unchanged-p (file)
   (eq 'up-to-date (vc-fossil-state file)))
 
-(defun vc-fossil-root (file)
-  (or (vc-find-root file ".fslckout")
-      (vc-find-root file "_FOSSIL_")))
-
 ;; TODO: mode-line-string
 ;; TODO: dir-printer
 
 (defun vc-fossil-dir-status (dir update-function)
   "Get fossil status for all files in a directory"
-  (vc-fossil--dir-status-files dir nil update-function))
+  (vc-fossil-dir-status-files-i dir nil update-function))
 
-(defun vc-fossil--dir-status-files (dir files update-function)
+(defun vc-fossil-dir-status-files-i (dir files 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"
@@ -254,15 +215,9 @@ If `files` is nil return the status for all files."
 
 (if (>= emacs-major-version 25)
     (defun vc-fossil-dir-status-files (dir files update-function)
-      (vc-fossil--dir-status-files dir files update-function))
+      (vc-fossil-dir-status-files-i dir files update-function))
   (defun vc-fossil-dir-status-files (dir files default-state update-function)
-    (vc-fossil--dir-status-files dir files update-function)))
-
-(defun vc-fossil-checkout-model (files) 'implicit)
-
-(defun vc-fossil--propertize-header-line (name value)
-  (concat (propertize name  'face 'font-lock-type-face)
-          (propertize value 'face 'font-lock-variable-name-face)))
+    (vc-fossil-dir-status-files-i dir files update-function)))
 
 (defun vc-fossil-checkout-model (files) 'implicit)
 
@@ -276,61 +231,63 @@ If `files` is nil return the status for all files."
       (cond ((eql field :repository)
              (string-match "repository: *\\(.*\\)$" info)
              (let ((repo (match-string 1 info)))
-               (push (vc-fossil--propertize-header-line "Repository : " repo) 
lines)))
+               (push (propertize "Repository : " 'face 'font-lock-type-face) 
lines)
+               (push (propertize repo 'face 'font-lock-variable-name-face) 
lines)))
             ((eql field :remote-url)
              (let ((remote-url (car (split-string (vc-fossil--run 
"remote-url")))))
-               (push (vc-fossil--propertize-header-line "Remote URL : " 
remote-url) lines)))
+               (push (propertize "Remote URL : " 'face 'font-lock-type-face) 
lines)
+               (push (propertize remote-url 'face 
'font-lock-variable-name-face) lines)))
             ((eql field :synchro)
-             (let* ((as-match (string-match "^autosync +.+ 
+\\([[:graph:]]+\\)$" settings))
-                    (autosync (and as-match (match-string 1 settings)))
-                    (dp-match (string-match "^dont-push +.+ 
+\\([[:graph:]]+\\)$" settings))
-                    (dontpush (and dp-match (match-string 1 settings))))
-               (push (vc-fossil--propertize-header-line "Synchro    : "
-                                                        (concat (and autosync 
"autosync=") autosync
-                                                                (and dontpush 
" dont-push=") dontpush))
-                     lines)))
+             (let* ((as-match (string-match "^autosync.+\\([[:digit:]]\\)$" 
settings))
+                    (autosync (if as-match (match-string 1 settings) "0"))
+                    (dp-match (string-match "^dont-push.+\\([[:digit:]]\\)$" 
settings))
+                    (dontpush (if dp-match (match-string 1 settings) "0")))
+               (push (propertize "Synchro    : " 'face 'font-lock-type-face) 
lines)
+               (push (propertize (concat "autosync=" autosync) 'face 
'font-lock-variable-name-face) lines)
+               (push (propertize (concat " dont-push=" dontpush) 'face 
'font-lock-variable-name-face) lines)))
             ((eql field :checkout)
              (let* ((posco (string-match "checkout: *\\([0-9a-fA-F]+\\) 
\\([-0-9: ]+ UTC\\)" info))
                     (coid (substring (match-string 1 info) 0 10))
                     (cots (format-time-string "%Y-%m-%d %H:%M:%S %Z"
                                               (safe-date-to-time (match-string 
2 info))))
                     (child-match (string-match "child: *\\(.*\\)$" info))
-                    (leaf (if child-match "non-leaf" "leaf")))
-               (push (vc-fossil--propertize-header-line "Checkout   : "
-                                                        (concat coid " " cots
-                                                                (concat " (" 
leaf ")")))
-                     lines)))
+                    (leaf (if child-match "NON-LEAF" "leaf")))
+               (push (propertize "Checkout   : " 'face 'font-lock-type-face) 
lines)
+               (push (propertize (concat coid " " cots) 'face 
'font-lock-variable-name-face) lines)
+               (push (propertize (concat " (" leaf ")") 'face 
'font-lock-variable-name-face) lines)))
             ((eql field :comment)
              (string-match "comment: *\\(.*\\)$" info)
              (let ((msg (match-string 1 info)))
-               (push (vc-fossil--propertize-header-line "Comment    : " msg) 
lines)))
+               (push (propertize "Comment    : " 'face 'font-lock-type-face) 
lines)
+               (push (propertize msg 'face 'font-lock-variable-name-face) 
lines)))
             ((eql field :tags)
              (string-match "tags: *\\(.*\\)" info)
              (let ((tags (match-string 1 info)))
-               (push (vc-fossil--propertize-header-line "Tags       : " tags) 
lines)))))
+               (push (propertize "Tags       : " 'face 'font-lock-type-face) 
lines)
+               (push (propertize tags 'face 'font-lock-variable-name-face) 
lines)))))
     (apply #'concat (nreverse lines))))
 
 ;;; STATE-CHANGING FUNCTIONS
 
 (defun vc-fossil-create-repo ()
   "Create a new Fossil Repository."
-  (vc-fossil--command nil 0 nil "new"))
+  (vc-fossil-command nil 0 nil "new"))
 
 ;; We ignore the comment.  There's no comment on add.
 (defun vc-fossil-register (files &optional rev comment)
   "Register FILE into the fossil version-control system."
-  (vc-fossil--command nil 0 files "add"))
+  (vc-fossil-command nil 0 files "add"))
 
 (defun vc-fossil-responsible-p (file)
   (vc-fossil-root file))
 
 (defun vc-fossil-unregister (file)
-  (vc-fossil--command nil 0 file "rm"))
+  (vc-fossil-command nil 0 file "rm"))
 
 (declare-function log-edit-extract-headers "log-edit" (headers string))
 
-(defun vc-fossil--checkin (files comment &optional rev)
-  (apply 'vc-fossil--command nil 0 files
+(defun vc-fossil-checkin-i (files comment &optional rev)
+  (apply 'vc-fossil-command nil 0 files
          (nconc (list "commit" "-m")
                 (log-edit-extract-headers
                  `(("Author" . "--user-override")
@@ -340,19 +297,19 @@ If `files` is nil return the status for all files."
 
 (if (>= emacs-major-version 25)
     (defun vc-fossil-checkin (files comment &optional rev)
-      (vc-fossil--checkin files comment rev))
+      (vc-fossil-checkin-i files comment rev))
   (defun vc-fossil-checkin (files rev comment)
-    (vc-fossil--checkin files comment rev)))
+    (vc-fossil-checkin-i files comment rev)))
 
 (defun vc-fossil-find-revision (file rev buffer)
-  (apply #'vc-fossil--command buffer 0 file
+  (apply #'vc-fossil-command buffer 0 file
          "cat"
          (nconc
           (unless (zerop (length rev)) (list "-r" rev))
           (vc-switches 'Fossil 'checkout))))
 
 (defun vc-fossil-checkout (file &optional editable rev)
-  (apply #'vc-fossil--command nil 0 file
+  (apply #'vc-fossil-command nil 0 file
          "update"
          (nconc
           (cond
@@ -364,23 +321,32 @@ If `files` is nil return the status for all files."
 (defun vc-fossil-revert (file &optional contents-done)
   "Revert FILE to the version stored in the fossil repository."
   (if contents-done t
-    (vc-fossil--command nil 0 file "revert")))
+    (vc-fossil-command nil 0 file "revert")))
 
 (defun vc-fossil-pull (prompt)
   "Pull upstream changes into the current branch.
 
-With a prefix argument, or if PROMPT is non-nil, prompt for a specific
+With a prefix argument or of PROMPT is non-nil, prompt for a specific
 Fossil pull command.  The default is \"fossil update\"."
   (interactive "P")
-  (vc-fossil--do-async-prompted-command "update" prompt 
'vc-fossil-pull-history))
-
-(defun vc-fossil-push (prompt)
-  "Push changes to upstream repository.
-
-With a prefix argument or if PROMPT is non-nil, prompt for a specific
-Fossil push command.  The default is \"fossil push\"."
-  (interactive "P")
-  (vc-fossil--do-async-prompted-command "push" prompt 'vc-fossil-push-history))
+  (let* ((root (vc-fossil-root default-directory))
+         (buffer (format "*vc-fossil : %s*" (expand-file-name root)))
+         (fossil-program "fossil")
+         (command "update")
+         (args '()))
+    (when prompt
+      (setq args (split-string
+                  (read-shell-command "Run Fossil (like this): "
+                                      "fossil update"
+                                      'vc-fossil-history)
+                  " " t))
+      (setq fossil-program (car args)
+            command (cadr args)
+            args (cddr args)))
+    (apply 'vc-do-async-command buffer root fossil-program command args)
+    (with-current-buffer buffer
+      (vc-run-delayed (vc-compilation-mode 'Fossil)))
+    (vc-set-async-update buffer)))
 
 ;; HISTORY FUNCTIONS
 
@@ -395,7 +361,7 @@ Fossil push command.  The default is \"fossil push\"."
   (let ((inhibit-read-only t))
     (with-current-buffer buffer
       (dolist (file files)
-        (apply #'vc-fossil--command buffer 0 nil "timeline"
+        (apply #'vc-fossil-command buffer 0 nil "timeline"
                (nconc
                 (when start-revision (list "before" start-revision))
                 (when limit (list "-n" (number-to-string limit)))
@@ -437,7 +403,7 @@ Fossil push command.  The default is \"fossil push\"."
             (and (null (cdr files))
                  (equal root (expand-file-name (car files)))))
         (setq files nil))
-    (apply #'vc-fossil--command
+    (apply #'vc-fossil-command
            buf 0 files "diff" "-i"
            (nconc
             (cond
@@ -451,7 +417,7 @@ Fossil push command.  The default is \"fossil push\"."
   "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"))
+  (vc-fossil-command buffer 0 file "annotate"))
 
 (defconst vc-fossil-annotate-re
   "\\([[:word:]]+\\)\\s-+\\([-0-9]+\\)\\s-+[0-9]+: ")
@@ -478,16 +444,16 @@ If REV is specified, annotate that revision."
 (defun vc-fossil-create-tag (file name branchp)
   (let* ((dir (if (file-directory-p file) file (file-name-directory file)))
          (default-directory dir))
-    (apply #'vc-fossil--command nil 0 nil `(,@(if branchp
+    (apply #'vc-fossil-command nil 0 nil `(,@(if branchp
                                                  '("branch" "new")
                                                '("tag" "add"))
-                                           ,name ,(vc-fossil--get-id dir)))))
+                                           ,name ,(vc-fossil-get-id dir)))))
 
 ;; FIXME: we should update buffers if update is non-nill
 
 (defun vc-fossil-retrieve-tag (dir name update)
   (let ((default-directory dir))
-    (vc-fossil--command nil 0 nil "checkout" name)))
+    (vc-fossil-command nil 0 nil "checkout" name)))
 
 ;;; MISCELLANEOUS
 
@@ -496,14 +462,14 @@ If REV is specified, annotate that revision."
   (with-temp-buffer
     (cond
      (file
-      (vc-fossil--command t 0 (file-truename file) "finfo" "-l" "-b")
+      (vc-fossil-command t 0 (file-truename file) "finfo" "-l" "-b")
       (goto-char (point-min))
       (and (re-search-forward (concat "^" (regexp-quote rev)) nil t)
            (zerop (forward-line))
            (looking-at "^\\([0-9a-zA-Z]+\\)")
            (match-string 1)))
      (t
-      (vc-fossil--command t 0 nil "info" rev)
+      (vc-fossil-command t 0 nil "info" rev)
       (goto-char (point-min))
       (and (re-search-forward "parent: *\\([0-9a-fA-F]+\\)" nil t)
            (match-string 1))))))
@@ -513,23 +479,23 @@ If REV is specified, annotate that revision."
   (with-temp-buffer
     (cond
      (file
-      (vc-fossil--command t 0 (file-truename file) "finfo" "-l" "-b")
+      (vc-fossil-command t 0 (file-truename file) "finfo" "-l" "-b")
       (goto-char (point-min))
       (and (re-search-forward (concat "^" (regexp-quote rev)) nil t)
            (zerop (forward-line -1))
            (looking-at "^\\([0-9a-zA-Z]+\\)")
            (match-string 1)))
      (t
-      (vc-fossil--command t 0 nil "info" rev)
+      (vc-fossil-command t 0 nil "info" rev)
       (goto-char (point-min))
       (and (re-search-forward "child: *\\([0-9a-fA-F]+\\)" nil t)
            (match-string 1))))))
 
 (defun vc-fossil-delete-file (file)
-  (vc-fossil--command nil 0 (file-truename file) "rm" "--hard"))
+  (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" "--hard"))
+  (vc-fossil-command nil 0 (list (file-truename old) (file-truename new)) "mv" 
"--hard"))
 
 (provide 'vc-fossil)