branch: elpa/vc-fossil
commit 1bef549e51f961f75be2322dee84be37bb3dbf07
Author: venks1 <[email protected]>
Commit: GitHub <[email protected]>
From Upstream: ams: Add (vc-fossil-link)
---
vc-fossil.el | 35 +++++++++++++++++++++++++++++++++++
1 file changed, 35 insertions(+)
diff --git a/vc-fossil.el b/vc-fossil.el
index 67921a8..04c12eb 100644
--- a/vc-fossil.el
+++ b/vc-fossil.el
@@ -598,6 +598,41 @@ If nil, use the value of `vc-diff-switches'. If t, use no
switches."
(let ((default-directory (vc-fossil-root file-or-dir)))
(cadr (assoc (or remote-name "default") (vc-fossil--remotes)))))
+;; Useful functions for interacting with Fossil
+
+(defun vc-fossil--url-without-authinfo (url)
+ (let ((parsed (url-generic-parse-url url)))
+ (setf (url-user parsed) nil)
+ (setf (url-password parsed) nil)
+ (url-recreate-url parsed)))
+
+(defun vc-fossil--relative-file-name (file)
+ (let ((l0 (car (split-string (vc-fossil--run "finfo" file) "\n" t))))
+ (save-match-data
+ (and (string-match "^History for \\(.*\\)$" l0)
+ (setq file (match-string 1 l0)))
+ file)))
+
+(defun vc-fossil-link (start end)
+ "Puts the current URL to a file in the kill ring."
+ (interactive "r")
+ (let ((default-directory (file-name-directory (buffer-file-name
(current-buffer)))))
+ (unless (vc-fossil-registered (buffer-file-name))
+ (error "%s: file is not registerd in vc" (buffer-file-name)))
+ (let* ((repository-url (vc-fossil--url-without-authinfo
+ (vc-fossil-repository-url (buffer-file-name))))
+ (file (vc-fossil--relative-file-name (buffer-file-name)))
+ (tag (vc-fossil-working-revision (buffer-file-name
(current-buffer))))
+ (start (line-number-at-pos (region-beginning)))
+ (end (line-number-at-pos (region-end))))
+ (if (= start end)
+ (setq link (format "%s/file?ci=%s&name=%s&ln=%s"
+ repository-url tag file start))
+ (setq link (format "%s/file?ci=%s&name=%s&ln=%s-%s"
+ repository-url tag file start end)))
+ (kill-new link)
+ (message "%s" link))))
+
;;; 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
