branch: elpa/vc-fossil
commit e0192e533af7da79ddc3657d3cfd321a337b367f
Author: Venkat Iyer <venkat_i...@apple.com>
Commit: Venkat Iyer <venkat_i...@apple.com>
Bring in changes from upstream: Switch to using "fossil changes" (by ams).
---
vc-fossil.el | 715 +++++++++++++++++++++++++++++++----------------------------
1 file changed, 379 insertions(+), 336 deletions(-)
diff --git a/vc-fossil.el b/vc-fossil.el
index bb1b6c5..22eb57b 100644
--- a/vc-fossil.el
+++ b/vc-fossil.el
@@ -3,102 +3,114 @@
;; Author: Venkat Iyer <ven...@comit.com>
;; vc-fossil.el free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
-;; vc-fossil.el is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
+;; vc-fossil.el is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
;; For a copy of the license, please see <http://www.gnu.org/licenses/>.
-
;;; Commentary:
;; This file contains a VC backend for the fossil version control
;; system.
-;;; Installation:
-
-;; 1. Install this vc-fossil package.
-;; 2. Add "Fossil" to the list of VC backends using
-;; M-x customize-variable vc-handled-backends
+;;; Todo:
-;; 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")
-;; 3. Add Fossil to the list of supported backends:
-;; (add-to-list 'vc-handled-backends 'Fossil t)
+;; 1) Implement the rest of the vc interface. See the comment at the
+;; beginning of vc.el. The current status is:
-;;; Implemented Functions
+;; FUNCTION NAME STATUS
;; BACKEND PROPERTIES
-;; * revision-granularity
+;; * revision-granularity OK
+;; - update-on-retrieve-tag OK
;; STATE-QUERYING FUNCTIONS
-;; * registered (file)
-;; * state (file) - 'up-to-date 'edited 'needs-patch 'needs-merge
-;; * dir-status-files (dir files uf)
-;; * workfile-version (file)
-;; * checkout-model (file)
-;; - workfile-unchanged-p (file)
-;; - root (file)
+;; * registered (file) OK
+;; * state (file) OK
+;; - dir-status-files (dir files update-function) OK
+;; - dir-extra-headers (dir) OK
+;; - dir-printer (fileinfo) ??
+;; - status-fileinfo-extra (file) ??
+;; * working-revision (file) OK
+;; * checkout-model (files) OK
+;; - mode-line-string (file) ??
;; STATE-CHANGING FUNCTIONS
-;; * register (file &optional rev comment)
-;; * checkin (file comment &optional rev)
-;; * find-version (file rev buffer)
-;; * checkout (file &optional editable rev)
-;; * revert (file &optional contents-done)
-;; * pull (prompt)
-;; - push (prompt)
-;; - responsible-p (file)
+;; * create-repo (backend) OK
+;; * register (files &optional comment) OK
+;; - responsible-p (file) OK
+;; - receive-file (file rev) ??
+;; - unregister (file) OK
+;; * checkin (files comment &optional rev) OK
+;; * find-revision (file rev buffer) OK
+;; * checkout (file &optional rev) OK
+;; * revert (file &optional contents-done) OK
+;; - merge-file (file rev1 rev2) ??
+;; - merge-branch () ??
+;; - merge-news (file) ??
+;; - pull (prompt) OK
+;; ? push (prompt) OK
+;; - steal-lock (file &optional revision) ??
+;; - modify-change-comment (files rev comment) ??
+;; - mark-resolved (files) ??
+;; - find-admin-dir (file) ??
;; HISTORY FUNCTIONS
-;; * print-log (file &optional buffer)
-;; * diff (file &optional rev1 rev2 buffer async)
+;; * print-log (files buffer &optional shortlog start-revision limit) OK
+;; * log-outgoing (backend remote-location) ??
+;; * log-incoming (backend remote-location) ??
+;; - log-search (pattern) ??
+;; - log-view-mode () OK
+;; - show-log-entry (revision) ??
+;; - comment-history (file) ??
+;; - update-changelog (files) ??
+;; * diff (files &optional rev1 rev2 buffer async) OK
+;; - revision-completion-table (files) ??
+;; - annotate-command (file buf &optional rev) OK
+;; - annotate-time () OK
+;; - annotate-current-time () ??
+;; - annotate-extract-revision-at-line () OK
+;; - region-history (file buffer lfrom lto) ??
+;; - region-history-mode () ??
+;; - mergebase (rev1 &optional rev2) ??
+;; TAG SYSTEM
+;; - create-tag (dir name branchp) OK
+;; - retrieve-tag (dir name update) OK
;; MISCELLANEOUS
-;; - delete-file (file)
-;; - rename-file (old new)
+;; - make-version-backups-p (file) ??
+;; - root (file) OK
+;; - ignore (file &optional directory) ??
+;; - ignore-completion-table ??
+;; - previous-revision (file rev) OK
+;; - next-revision (file rev) OK
+;; - log-edit-mode () ??
+;; - check-headers () ??
+;; - delete-file (file) OK
+;; - rename-file (old new) OK
+;; - find-file-hook () ??
+;; - extra-menu () ??
+;; - extra-dir-menu () ??
+;; - conflicted-files (dir) ??
;;; Code:
-(eval-when-compile (require 'vc))
+(eval-when-compile
+ (require 'vc))
(autoload 'vc-switches "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)
-
-(defcustom vc-fossil-extra-header-fields (list :checkout :tags)
- "A list of keywords denoting extra header fields to show in the vc-dir
buffer."
- :type '(set (const :repository) (const :remote-url) (const :synchro)
- (const :checkout) (const :comment) (const :tags))
- :group 'vc-fossil)
-
-
-;;; BACKEND PROPERTIES
-
-(defvar vc-fossil-history nil)
-
-(defvar vc-fossil-pull-history nil)
-(defvar vc-fossil-push-history nil)
+(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-fossil-revision-granularity () 'repository)
+(autoload 'vc-setup-buffer "vc-dispatcher")
+(declare-function vc-compilation-mode "vc-dispatcher" (backend))
+(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
+(declare-function vc-annotate-convert-time "vc-annotate" (time))
-;; Internal Commands
+;; Internal Functions
(defun vc-fossil--call (buffer &rest args)
(apply #'process-file "fossil" nil buffer nil args))
@@ -107,114 +119,60 @@ If nil, use the value of `vc-diff-switches'. If t, use
no switches."
(zerop (apply #'vc-fossil--call '(t nil) args)))
(defun vc-fossil--run (&rest args)
- "Run a fossil command and return its output as a string"
(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--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
+ (when (eql major-mode 'vc-dir-mode) ; Update header info.
(revert-buffer (current-buffer))))
-(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)))
+(defvar vc-fossil--history nil)
(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 '()))
+ (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))
+ (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)))
+ 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
-
-;;;###autoload
-(defun vc-fossil-registered (file)
- "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))))
- (and str
- (> (length str) 7)
- (not (string= (substring str 0 7) "unknown"))))))
+(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-state-code (code)
+(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)
- ((string= code "EXTRA") 'unregistered)
- ((string= code "MISSING") 'missing)
- ((string= code "RENAMED") 'added)
- (t nil)))
-
-(defun vc-fossil-state (file)
- "Fossil specific version of `vc-state'."
- (let* ((line (vc-fossil--run "update" "-n" "-v" "current" (file-truename
file)))
- (state (vc-fossil-state-code (car (split-string line)))))
- ;; if 'fossil update' says file is UNCHANGED check to see if it has been
RENAMED
- (when (or (not state) (eql state 'up-to-date))
- (let ((line (vc-fossil--run "changes" "--classify" "--unchanged"
"--renamed"
- (file-truename file))))
- (setq state (and line (vc-fossil-state-code (car (split-string
line)))))))
- state))
-
-(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)))))
-
-(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))
+ ((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)
+ ((string= code "EXTRA") 'unregistered)
+ ((string= code "MISSING") 'missing)
+ ((string= code "RENAMED") 'added)
+ (t nil)))
(defvar vc-fossil--file-classifications nil
"An alist of (filename . classification) pairs.")
@@ -222,193 +180,254 @@ Allow user to edit command in minibuffer if PROMPT is
non-nil."
(defun vc-fossil--classify-all-files (dir)
(setq vc-fossil--file-classifications nil)
(let* ((default-directory dir)
- (lines (split-string (vc-fossil--run "changes" "--classify" "--all")
"[\n\r]+" t)))
+ (lines (split-string (vc-fossil--run "changes" "--classify" "--all")
"[\n\r]+" t)))
(dolist (line lines)
(string-match "^\\(\\w+\\)\\s-+\\(.+\\)$" line)
(let ((pair (cons (match-string 2 line) (match-string 1 line))))
- (push pair vc-fossil--file-classifications)))))
+ (push pair vc-fossil--file-classifications)))))
+
+(defun vc-fossil--propertize-header-line (name value)
+ (concat (propertize name 'face 'font-lock-type-face)
+ (propertize value 'face 'font-lock-variable-name-face)))
+
+;; Customization
+
+(defgroup vc-fossil nil
+ "VC Fossil backend."
+ :group 'vc)
+
+(defcustom vc-fossil-diff-switches t
+ "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)
+
+(defcustom vc-fossil-extra-header-fields (list :checkout :tags)
+ "A list of keywords denoting extra header fields to show in the vc-dir
buffer."
+ :type '(set (const :repository) (const :remote-url) (const :synchro)
+ (const :checkout) (const :comment) (const :tags))
+ :group 'vc-fossil)
+
+;; BACKEND PROPERTIES
+
+(defun vc-fossil-revision-granularity () 'repository)
-(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."
+(defun vc-fossil-update-on-retrieve-tag () nil)
+
+;; STATE-QUERYING FUNCTIONS
+
+;;;###autoload
+(defun vc-fossil-registered (file)
+ (with-temp-buffer
+ (let* ((str (ignore-errors
+ (vc-fossil--out-ok "finfo" "-s" (file-truename file))
+ (buffer-string))))
+ (and str
+ (> (length str) 7)
+ (not (string= (substring str 0 7) "unknown"))))))
+
+(defun vc-fossil-state (file)
+ (let* ((line (vc-fossil--run "changes" "--classify" "--all" (file-truename
file)))
+ (state (vc-fossil--state-code (car (split-string line)))))
+ ;; ---!!! Does 'fossil update' and 'fossil changes' have different
+ ;; ---!!! semantics here?
+ ;;;
+ ;; If 'fossil update' says file is UNCHANGED check to see if it
+ ;; has been RENAMED.
+ (when (or (not state) (eql state 'up-to-date))
+ (let ((line (vc-fossil--run "changes" "--classify" "--unchanged"
"--renamed"
+ (file-truename file))))
+ (setq state (and line (vc-fossil--state-code (car (split-string
line)))))))
+ state))
+
+(defun vc-fossil-dir-status-files (dir files update-function)
(vc-fossil--classify-all-files dir)
- (insert (apply 'vc-fossil--run "update" "-n" "-v" "current"
- (or files (list dir))))
+ (insert (apply 'vc-fossil--run "changes" "--classify" "--all"
+ (or files (list dir))))
(let ((result '())
- (root (vc-fossil-root dir)))
+ (root (vc-fossil-root dir)))
(goto-char (point-min))
(while (not (eobp))
(let* ((line (buffer-substring-no-properties (point)
(line-end-position)))
- (status-word (car (split-string line))))
- (if (string-match "-----" status-word)
- (goto-char (point-max))
- (let ((file (substring line (+ (length status-word) 1)))
- (state (vc-fossil-state-code status-word)))
- (setq file (expand-file-name file root))
- (setq file (file-relative-name file dir))
- ;; if 'fossil update' says file is UNCHANGED check to see if it
has been RENAMED
- (when (or (not state) (eql state 'up-to-date))
- (setq state (vc-fossil-state-code (cdr (assoc file
vc-fossil--file-classifications)))))
- (push (list file state) result)))
- (forward-line)))
- ;; now collect untracked files
+ (status-word (car (split-string line))))
+ (if (string-match "-----" status-word)
+ (goto-char (point-max))
+ (let ((file (cadr (split-string line)))
+ (state (vc-fossil--state-code status-word)))
+ (setq file (expand-file-name file root))
+ (setq file (file-relative-name file dir))
+ ;; If 'fossil update' says file is UNCHANGED check to see
+ ;; if it has been RENAMED.
+ (when (or (not state) (eql state 'up-to-date))
+ (setq state (vc-fossil--state-code (cdr (assoc file
vc-fossil--file-classifications)))))
+ (when (not (eq state 'up-to-date))
+ (push (list file state) 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 ((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)))
+ (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)))
-(if (>= emacs-major-version 25)
- (defun vc-fossil-dir-status-files (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 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-dir-extra-headers (dir)
(let ((info (vc-fossil--run "info"))
- (settings (vc-fossil--run "settings"))
- (lines nil))
+ (settings (vc-fossil--run "settings"))
+ (lines nil))
(dolist (field vc-fossil-extra-header-fields)
(unless (null lines)
- (push "\n" lines))
+ (push "\n" lines))
(cond ((eql field :repository)
- (string-match "repository: *\\(.*\\)$" info)
- (let ((repo (match-string 1 info)))
- (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 (vc-fossil--propertize-header-line "Remote URL : "
remote-url) 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)))
- ((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)))
- ((eql field :comment)
- (string-match "comment: *\\(.*\\)$" info)
- (let ((msg (match-string 1 info)))
- (push (vc-fossil--propertize-header-line "Comment : " msg)
lines)))
- ((eql field :tags)
- (string-match "tags: *\\(.*\\)" info)
- (let ((tags (match-string 1 info)))
- (push (vc-fossil--propertize-header-line "Tags : " tags)
lines)))))
+ (string-match "repository: *\\(.*\\)$" info)
+ (let ((repo (match-string 1 info)))
+ (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 (vc-fossil--propertize-header-line "Remote URL : "
remote-url) 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)))
+ ((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)))
+ ((eql field :comment)
+ (string-match "comment: *\\(.*\\)$" info)
+ (let ((msg (match-string 1 info)))
+ (push (vc-fossil--propertize-header-line "Comment : " msg)
lines)))
+ ((eql field :tags)
+ (string-match "tags: *\\(.*\\)" info)
+ (let ((tags (match-string 1 info)))
+ (push (vc-fossil--propertize-header-line "Tags : " tags)
lines)))))
(apply #'concat (nreverse lines))))
-;;; STATE-CHANGING FUNCTIONS
+;; - dir-printer (fileinfo)
+
+;; - status-fileinfo-extra (file)
+
+(defun vc-fossil-working-revision (file)
+ (let ((line (vc-fossil--run "finfo" "-s" (file-truename file))))
+ (and line
+ (cadr (split-string line)))))
+
+(defun vc-fossil-checkout-model (files) 'implicit)
+
+;; - mode-line-string (file)
+
+;; STATE-CHANGING FUNCTIONS
(defun vc-fossil-create-repo ()
- "Create a new Fossil Repository."
(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."
+ ;; We ignore the comment. There's no comment on add.
(vc-fossil--command nil 0 files "add"))
(defun vc-fossil-responsible-p (file)
(vc-fossil-root file))
+;; - receive-file (file rev)
+
(defun vc-fossil-unregister (file)
(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)
+(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")
- ("Date" . "--date-override"))
- comment)
- (vc-switches 'Fossil 'checkin))))
-
-(if (>= emacs-major-version 25)
- (defun vc-fossil-checkin (files comment &optional rev)
- (vc-fossil--checkin files comment rev))
- (defun vc-fossil-checkin (files rev comment)
- (vc-fossil--checkin files comment rev)))
+ (nconc (list "commit" "-m")
+ (log-edit-extract-headers
+ `(("Author" . "--user-override")
+ ("Date" . "--date-override"))
+ comment)
+ (vc-switches 'Fossil 'checkin))))
(defun vc-fossil-find-revision (file rev buffer)
(apply #'vc-fossil--command buffer 0 file
- "cat"
- (nconc
- (unless (zerop (length rev)) (list "-r" rev))
- (vc-switches 'Fossil 'checkout))))
+ "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
- "update"
- (nconc
- (cond
- ((eq rev t) (list "current"))
- ((equal rev "") (list "trunk"))
- ((stringp rev) (list rev)))
- (vc-switches 'Fossil 'checkout))))
+ "update"
+ (nconc
+ (cond
+ ((eq rev t) (list "current"))
+ ((equal rev "") (list "trunk"))
+ ((stringp rev) (list rev)))
+ (vc-switches 'Fossil 'checkout))))
(defun vc-fossil-revert (file &optional contents-done)
- "Revert FILE to the version stored in the fossil repository."
- (if contents-done t
+ (if contents-done
+ t
(vc-fossil--command nil 0 file "revert")))
-(defun vc-fossil-pull (prompt)
- "Pull upstream changes into the current branch.
+;; - merge-file (file rev1 rev2)
+
+;; - merge-branch ()
-With a prefix argument, or if PROMPT is non-nil, prompt for a specific
-Fossil pull command. The default is \"fossil update\"."
+;; - merge-news (file)
+
+(defvar vc-fossil--pull-history nil)
+(defvar vc-fossil--push-history nil)
+
+(defun vc-fossil-pull (prompt)
(interactive "P")
- (vc-fossil--do-async-prompted-command "update" prompt
'vc-fossil-pull-history))
+ (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
+;; - steal-lock (file &optional revision)
-;; FIXME, we actually already have short, start and limit, need to
-;; add it into the code
+;; - modify-change-comment (files rev comment)
-(autoload 'vc-setup-buffer "vc-dispatcher")
+;; - mark-resolved (files)
+
+;; - find-admin-dir (file)
+
+;; HISTORY FUNCTIONS
(defun vc-fossil-print-log (files buffer &optional shortlog start-revision
limit)
- "Print full log for a file"
+ ;; TODO: We actually already have short, start and limit, need to
+ ;; add it into the code.
(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" (file-relative-name (expand-file-name file)))))))))
+ (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" (file-relative-name (expand-file-name file)))))))))
+
+;; * log-outgoing (backend remote-location)
+
+;; * log-incoming (backend remote-location)
+
+;; - log-search (pattern)
(defvar log-view-message-re)
(defvar log-view-file-re)
@@ -416,7 +435,6 @@ Fossil push command. The default is \"fossil push\"."
(defvar log-view-per-file-logs)
(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\\`")
@@ -425,53 +443,57 @@ Fossil push command. The default is \"fossil push\"."
"^[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
+ '(
+ ("^\\([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))))))
+
+;; - show-log-entry (revision)
+
+;; - comment-history (file)
+
+;; - update-changelog (files)
+
(defun vc-fossil-diff (files &optional rev1 rev2 buffer async)
- "Get Differences for a file"
+ ;; TODO: Implement diff for directories.
(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
+ (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))
+ (and (null (cdr files))
+ (equal root (expand-file-name (car files)))))
+ (setq files nil))
(apply #'vc-fossil--command
- buf 0 files "diff" "-i"
- (nconc
- (cond
- (rev2 (list "--from" (or rev1 "current") "--to" rev2))
- (rev1 (list "--from" rev1)))
- (vc-switches 'Fossil 'diff)))))
+ buf 0 files "diff" "-i"
+ (nconc
+ (cond
+ (rev2 (list "--from" (or rev1 "current") "--to" rev2))
+ (rev1 (list "--from" rev1)))
+ (vc-switches 'Fossil 'diff)))))
-(declare-function vc-annotate-convert-time "vc-annotate" (time))
-
-(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"))
+;; - revision-completion-table (files)
(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-command (file buffer &optional rev)
+ (vc-fossil--command buffer 0 file "annotate"))
+
(defun vc-fossil-annotate-time ()
+ ;; TODO: Currently only the date is used, not the 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))))))
+;; - annotate-current-time ()
+
(defun vc-fossil-annotate-extract-revision-at-line ()
(save-excursion
(beginning-of-line)
@@ -479,60 +501,73 @@ If REV is specified, annotate that revision."
(goto-char (match-end 0))
(match-string-no-properties 1))))
-;;; TAG SYSTEM
+;; - region-history (file buffer lfrom lto)
+
+;; - region-history-mode ()
-;; FIXME: we need a convenience function to check that there's nothing checked
-;; out in the tree, since we tag or branch the whole repository
+;; - mergebase (rev1 &optional rev2)
+
+;; TAG SYSTEM
(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)))))
-
-;; FIXME: we should update buffers if update is non-nill
+ '("branch" "new")
+ '("tag" "add"))
+ ,name ,(vc-fossil--get-id dir)))))
(defun vc-fossil-retrieve-tag (dir name update)
(let ((default-directory dir))
(vc-fossil--command nil 0 nil "checkout" name)))
-;;; MISCELLANEOUS
+;; MISCELLANEOUS
+
+;; - make-version-backups-p (file)
+
+(defun vc-fossil-root (file)
+ (or (vc-find-root file ".fslckout")
+ (vc-find-root file "_FOSSIL_")))
+
+;; - ignore (file &optional directory)
+
+;; - ignore-completion-table
(defun vc-fossil-previous-revision (file rev)
- "Fossil specific version of the `vc-previous-revision'."
(with-temp-buffer
(cond
(file
(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)))
+ (zerop (forward-line))
+ (looking-at "^\\([0-9a-zA-Z]+\\)")
+ (match-string 1)))
(t
(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))))))
+ (match-string 1))))))
(defun vc-fossil-next-revision (file rev)
- "Fossil specific version of the `vc-previous-revision'."
(with-temp-buffer
(cond
(file
(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)))
+ (zerop (forward-line -1))
+ (looking-at "^\\([0-9a-zA-Z]+\\)")
+ (match-string 1)))
(t
(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))))))
+ (match-string 1))))))
+
+;; - log-edit-mode ()
+
+;; - check-headers ()
(defun vc-fossil-delete-file (file)
(vc-fossil--command nil 0 (file-truename file) "rm" "--hard"))
@@ -540,6 +575,14 @@ If REV is specified, annotate that revision."
(defun vc-fossil-rename-file (old new)
(vc-fossil--command nil 0 (list (file-truename old) (file-truename new))
"mv" "--hard"))
+;; - find-file-hook ()
+
+;; - extra-menu ()
+
+;; - extra-dir-menu ()
+
+;; - conflicted-files (dir)
+
;;; This snippet enables the Fossil VC backend so it will work once
;;; this file is loaded. By also marking it for inclusion in the
;;; autoloads file, installing packaged versions of this should work
