branch: elpa/vc-fossil
commit 7bb3121ccd89f1533c6b91d5f952755b358eb0eb
Author: venks1 <ven...@gmail.com>
Commit: venks1 <ven...@gmail.com>
Push changes from pdo
---
doc/index.wiki | 9 +++
vc/el/vc-fossil.el | 178 +++++++++++++++++++++++++++++++----------------------
2 files changed, 115 insertions(+), 72 deletions(-)
diff --git a/doc/index.wiki b/doc/index.wiki
index 0226f90..40a13c5 100644
--- a/doc/index.wiki
+++ b/doc/index.wiki
@@ -9,6 +9,15 @@ 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 ff7e140..7c92165 100644
--- a/vc/el/vc-fossil.el
+++ b/vc/el/vc-fossil.el
@@ -22,6 +22,11 @@
;;; 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")
@@ -38,6 +43,7 @@
;; * 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)
@@ -45,6 +51,7 @@
;; * checkout (file &optional editable rev)
;; * revert (file &optional contents-done)
;; * pull (prompt)
+;; - push (prompt)
;; - responsible-p (file)
;; HISTORY FUNCTIONS
;; * print-log (file &optional buffer)
@@ -85,6 +92,9 @@ 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)
@@ -104,22 +114,47 @@ 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-root (file)
- (or (vc-find-root file ".fslckout")
- (vc-find-root file "_FOSSIL_")))
-
-(defun vc-fossil-command (buffer okstatus file-or-list &rest flags)
+(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))
+ (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))))
-(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 9)))
+ (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)))
;;; STATE-QUERYING FUNCTIONS
@@ -170,14 +205,18 @@ If nil, use the value of `vc-diff-switches'. If t, use
no switches."
(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-i dir nil update-function))
+ (vc-fossil--dir-status-files dir nil update-function))
-(defun vc-fossil-dir-status-files-i (dir files update-function)
+(defun vc-fossil--dir-status-files (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"
@@ -215,9 +254,15 @@ 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-i dir files update-function))
+ (vc-fossil--dir-status-files dir files update-function))
(defun vc-fossil-dir-status-files (dir files default-state update-function)
- (vc-fossil-dir-status-files-i dir files 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)))
(defun vc-fossil-checkout-model (files) 'implicit)
@@ -231,63 +276,61 @@ 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 (propertize "Repository : " 'face 'font-lock-type-face)
lines)
- (push (propertize repo 'face 'font-lock-variable-name-face)
lines)))
+ (push (vc-fossil--propertize-header-line "Repository : " repo)
lines)))
((eql field :remote-url)
(let ((remote-url (car (split-string (vc-fossil--run
"remote-url")))))
- (push (propertize "Remote URL : " 'face 'font-lock-type-face)
lines)
- (push (propertize remote-url 'face
'font-lock-variable-name-face) lines)))
+ (push (vc-fossil--propertize-header-line "Remote URL : "
remote-url) lines)))
((eql field :synchro)
- (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)))
+ (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)))
((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 (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)))
+ (leaf (if child-match "non-leaf" "leaf")))
+ (push (vc-fossil--propertize-header-line "Checkout : "
+ (concat coid " " cots
+ (concat " ("
leaf ")")))
+ lines)))
((eql field :comment)
(string-match "comment: *\\(.*\\)$" info)
(let ((msg (match-string 1 info)))
- (push (propertize "Comment : " 'face 'font-lock-type-face)
lines)
- (push (propertize msg 'face 'font-lock-variable-name-face)
lines)))
+ (push (vc-fossil--propertize-header-line "Comment : " msg)
lines)))
((eql field :tags)
(string-match "tags: *\\(.*\\)" info)
(let ((tags (match-string 1 info)))
- (push (propertize "Tags : " 'face 'font-lock-type-face)
lines)
- (push (propertize tags 'face 'font-lock-variable-name-face)
lines)))))
+ (push (vc-fossil--propertize-header-line "Tags : " tags)
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-i (files comment &optional rev)
- (apply 'vc-fossil-command nil 0 files
+(defun vc-fossil--checkin (files comment &optional rev)
+ (apply 'vc-fossil--command nil 0 files
(nconc (list "commit" "-m")
(log-edit-extract-headers
`(("Author" . "--user-override")
@@ -297,19 +340,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-i files comment rev))
+ (vc-fossil--checkin files comment rev))
(defun vc-fossil-checkin (files rev comment)
- (vc-fossil-checkin-i files comment rev)))
+ (vc-fossil--checkin 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
@@ -321,32 +364,23 @@ 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 of PROMPT is non-nil, prompt for a specific
+With a prefix argument, or if PROMPT is non-nil, prompt for a specific
Fossil pull command. The default is \"fossil update\"."
(interactive "P")
- (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)))
+ (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))
;; HISTORY FUNCTIONS
@@ -361,7 +395,7 @@ Fossil pull command. The default is \"fossil update\"."
(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)))
@@ -403,7 +437,7 @@ Fossil pull command. The default is \"fossil update\"."
(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
@@ -417,7 +451,7 @@ Fossil pull command. The default is \"fossil update\"."
"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]+: ")
@@ -444,16 +478,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
@@ -462,14 +496,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))))))
@@ -479,23 +513,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)
