PageRenderTime 54ms CodeModel.GetById 23ms RepoModel.GetById 1ms app.codeStats 0ms

/external/dvc/lisp/xhg.el

https://bitbucket.org/henrik/emacs-old
Emacs Lisp | 1368 lines | 1035 code | 111 blank | 222 comment | 30 complexity | 3af8db955df0e5cf9937e5278ab74984 MD5 | raw file
Possible License(s): LGPL-2.0, GPL-3.0, GPL-2.0

Large files files are truncated, but you can click here to view the full file

  1. ;;; xhg.el --- Mercurial interface for dvc
  2. ;; Copyright (C) 2005-2009 by all contributors
  3. ;; Author: Stefan Reichoer, <stefan@xsteve.at>
  4. ;; This file is free software; you can redistribute it and/or modify
  5. ;; it under the terms of the GNU General Public License as published by
  6. ;; the Free Software Foundation; either version 3, or (at your option)
  7. ;; any later version.
  8. ;; This file is distributed in the hope that it will be useful,
  9. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. ;; GNU General Public License for more details.
  12. ;; You should have received a copy of the GNU General Public License
  13. ;; along with GNU Emacs; see the file COPYING. If not, write to
  14. ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  15. ;; Boston, MA 02110-1301, USA.
  16. ;;; Commentary:
  17. ;; The mercurial interface for dvc
  18. ;;; Commands:
  19. ;;
  20. ;; Below are complete command list:
  21. ;;
  22. ;; `xhg-init'
  23. ;; Run hg init.
  24. ;; `xhg-rollback'
  25. ;; Run hg rollback.
  26. ;; `xhg-addremove'
  27. ;; Run hg addremove.
  28. ;; `xhg-dvc-rename'
  29. ;; Run hg rename.
  30. ;; `xhg-forget'
  31. ;; Run hg forget.
  32. ;; `xhg-add-all-files'
  33. ;; Run 'hg add' to add all files to mercurial.
  34. ;; `xhg-log'
  35. ;; Run hg log.
  36. ;; `xhg-search-regexp-in-log'
  37. ;; Run hg log -k <pattern>
  38. ;; `xhg-diff-1'
  39. ;; Run hg diff.
  40. ;; `xhg-dvc-diff'
  41. ;; Run hg diff.
  42. ;; `xhg-pull'
  43. ;; Run hg pull.
  44. ;; `xhg-push'
  45. ;; Run hg push.
  46. ;; `xhg-clone'
  47. ;; Run hg clone.
  48. ;; `xhg-dired-clone'
  49. ;; Run `xhg-clone' from dired.
  50. ;; `xhg-bundle'
  51. ;; Run hg bundle.
  52. ;; `xhg-unbundle'
  53. ;; Run hg unbundle.
  54. ;; `xhg-incoming'
  55. ;; Run hg incoming.
  56. ;; `xhg-outgoing'
  57. ;; Run hg outgoing.
  58. ;; `xhg-strip'
  59. ;; Run hg strip.
  60. ;; `xhg-merge'
  61. ;; Run hg merge.
  62. ;; `xhg-resolve'
  63. ;; Run hg resolve --all or <spec file>.
  64. ;; `xhg-resolve-list'
  65. ;; Run hg resolve --list.
  66. ;; `xhg-command-version'
  67. ;; Run hg version.
  68. ;; `xhg-branch'
  69. ;; Run hg branch.
  70. ;; `xhg-branches'
  71. ;; run xhg-branches
  72. ;; `xhg-merge-branch'
  73. ;; Run hg merge <branch-name>.
  74. ;; `xhg-manifest'
  75. ;; Run hg manifest.
  76. ;; `xhg-tip'
  77. ;; Run hg tip.
  78. ;; `xhg-heads'
  79. ;; Run hg heads.
  80. ;; `xhg-parents'
  81. ;; Run hg parents.
  82. ;; `xhg-identify'
  83. ;; Run hg identify.
  84. ;; `xhg-verify'
  85. ;; Run hg verify.
  86. ;; `xhg-showconfig'
  87. ;; Run hg showconfig.
  88. ;; `xhg-paths'
  89. ;; Run hg paths.
  90. ;; `xhg-tag'
  91. ;; Run hg tag -r <REV> NAME.
  92. ;; `xhg-tags'
  93. ;; Run hg tags.
  94. ;; `xhg-view'
  95. ;; Run hg view.
  96. ;; `xhg-export'
  97. ;; Run hg export.
  98. ;; `xhg-import'
  99. ;; Run hg import.
  100. ;; `xhg-undo'
  101. ;; Run hg undo.
  102. ;; `xhg-update'
  103. ;; Run hg update.
  104. ;; `xhg-convert'
  105. ;; Convert a foreign SCM repository to a Mercurial one.
  106. ;; `xhg-serve'
  107. ;; Run hg serve --daemon.
  108. ;; `xhg-serve-kill'
  109. ;; Kill a hg serve process started with `xhg-serve'.
  110. ;; `xhg-revision-get-last-or-num-revision'
  111. ;; Run the command:
  112. ;; `xhg-ediff-file-at-rev'
  113. ;; Ediff file at rev1 against rev2.
  114. ;; `xhg-missing-1'
  115. ;; Shows the logs of the new arrived changesets after a pull and before an update.
  116. ;; `xhg-save-diff'
  117. ;; Save the current hg diff to a file named FILENAME.
  118. ;; `xhg-hgrc-edit-repository-hgrc'
  119. ;; Edit the .hg/hgrc file for the current working copy
  120. ;; `xhg-hgrc-edit-global-hgrc'
  121. ;; Edit the ~/.hgrc file
  122. ;; `hgrc-mode-help'
  123. ;; Show the manual for the hgrc configuration file.
  124. ;;
  125. ;;; Customizable Options:
  126. ;;
  127. ;; Below are customizable option list:
  128. ;;
  129. ;;; History:
  130. ;;
  131. ;;; Code:
  132. (require 'dired-x)
  133. (require 'dvc-core)
  134. (require 'dvc-diff)
  135. (require 'xhg-core)
  136. (require 'xhg-log)
  137. (require 'xhg-mq)
  138. (require 'xhg-annotate)
  139. (defvar xhg-export-git-style-patches t "Run hg export --git.")
  140. ;;;###autoload
  141. (defun xhg-init (&optional dir)
  142. "Run hg init."
  143. (interactive
  144. (list (expand-file-name (dvc-read-directory-name "Directory for hg init: "
  145. (or default-directory
  146. (getenv "HOME"))))))
  147. (dvc-run-dvc-sync 'xhg (list "init" dir)
  148. :finished (dvc-capturing-lambda
  149. (output error status arguments)
  150. (message "hg init %s finished" dir))))
  151. ;;;###autoload
  152. (defun xhg-dvc-add-files (&rest files)
  153. "Run hg add."
  154. (dvc-trace "xhg-add-files: %s" files)
  155. (let ((default-directory (xhg-tree-root)))
  156. (dvc-run-dvc-sync 'xhg (append '("add") (mapcar #'file-relative-name files))
  157. :finished (dvc-capturing-lambda
  158. (output error status arguments)
  159. (message "hg add finished")))))
  160. ;;;###autoload
  161. (defun xhg-dvc-revert-files (&rest files)
  162. "Run hg revert."
  163. (dvc-trace "xhg-revert-files: %s" files)
  164. (let ((default-directory (xhg-tree-root)))
  165. (dvc-run-dvc-sync 'xhg (append '("revert") (mapcar #'file-relative-name files))
  166. :finished (dvc-capturing-lambda
  167. (output error status arguments)
  168. (message "hg revert finished")))))
  169. (defun xhg-dry-tip ()
  170. "Extract only the revision number of tip"
  171. (let ((revision (with-temp-buffer
  172. (apply #'call-process "hg" nil t nil
  173. '("tip" "--template" "#rev#"))
  174. (buffer-string))))
  175. revision))
  176. ;;;###autoload
  177. (defun xhg-rollback (&optional revert)
  178. "Run hg rollback.
  179. if prefix-arg (C-u) run hg revert"
  180. (interactive "P")
  181. (let ((act-rev (xhg-dry-tip))
  182. (new-rev))
  183. (if (yes-or-no-p (format "Really rollback rev %s?" act-rev))
  184. (progn
  185. (dvc-run-dvc-sync 'xhg (list "rollback")
  186. :finished
  187. (lambda (output error status arguments)
  188. (setq new-rev (xhg-dry-tip))
  189. (message
  190. (when (equal act-rev new-rev)
  191. "no rollback information available"))))
  192. (if (and current-prefix-arg
  193. (not (equal act-rev new-rev)))
  194. (progn
  195. (dvc-run-dvc-sync 'xhg (list "revert" "--all")
  196. :finished
  197. (lambda (output error status arguments)
  198. (message "hg revert finished, now at rev %s" new-rev))))
  199. (when (not (equal act-rev new-rev))
  200. (message
  201. "hg rollback finished, tip is now at %s don't forget to revert" new-rev))))
  202. (message "hg rollback aborted"))))
  203. ;;;###autoload
  204. (defun xhg-dvc-remove-files (&rest files)
  205. "Run hg remove."
  206. (dvc-trace "xhg-remove-files: %s" files)
  207. (let ((default-directory (xhg-tree-root)))
  208. (dvc-run-dvc-sync 'xhg (append '("remove") (mapcar #'file-relative-name files))
  209. :finished (dvc-capturing-lambda
  210. (output error status arguments)
  211. (message "hg remove finished")))))
  212. ;;;###autoload
  213. (defun xhg-addremove ()
  214. "Run hg addremove."
  215. (interactive)
  216. (dvc-run-dvc-sync 'xhg '("addremove")
  217. :finished (dvc-capturing-lambda
  218. (output error status arguments)
  219. (message "hg addremove finished"))))
  220. ;;;###autoload
  221. (defun xhg-dvc-rename (from to &optional after force)
  222. "Run hg rename."
  223. (interactive
  224. (let* ((from-name (dvc-confirm-read-file-name "xhg rename: "))
  225. (to-name (dvc-confirm-read-file-name (concat "xhg rename '" from-name "' to: ") nil "" from-name)))
  226. (list from-name to-name nil nil)))
  227. (dvc-run-dvc-sync 'xhg (list "rename" (dvc-uniquify-file-name from) (dvc-uniquify-file-name to)
  228. (when after "--after") (when force "--force"))
  229. :finished (dvc-capturing-lambda
  230. (output error status arguments)
  231. (message "hg rename finished"))))
  232. ;;;###autoload
  233. (defun xhg-forget (&rest files)
  234. "Run hg forget."
  235. (interactive (dvc-current-file-list))
  236. (let ((multiprompt (format "Forget %%d files for hg? "))
  237. (singleprompt (format "Forget file for hg: ")))
  238. (when (dvc-confirm-read-file-name-list multiprompt files singleprompt t)
  239. (dvc-run-dvc-sync 'xhg (append '("forget") files)
  240. :finished (dvc-capturing-lambda
  241. (output error status arguments)
  242. (message "hg forget finished"))))))
  243. ;;;###autoload
  244. (defun xhg-add-all-files (arg)
  245. "Run 'hg add' to add all files to mercurial.
  246. Normally run 'hg add -n' to simulate the operation to see which files will be added.
  247. Only when called with a prefix argument, add the files."
  248. (interactive "P")
  249. (dvc-run-dvc-sync 'xhg (list "add" (unless arg "-n"))))
  250. ;;;###autoload
  251. (defun xhg-log-toggle-verbose ()
  252. (interactive)
  253. (if xhg-log-verbose
  254. (progn
  255. (setq xhg-log-verbose nil)
  256. (apply #'xhg-log
  257. xhg-log-remember-func-args))
  258. (setq xhg-log-verbose t)
  259. (apply #'xhg-log
  260. xhg-log-remember-func-args)))
  261. (defvar xhg-log-verbose nil)
  262. (defvar xhg-log-remember-last-args nil)
  263. (defvar xhg-log-remember-func-args nil)
  264. ;;;###autoload
  265. (defun xhg-log (&optional r1 r2 show-patch file)
  266. "Run hg log.
  267. When run interactively, the prefix argument decides, which parameters are queried from the user.
  268. C-u : Show patches also, use all revisions
  269. C-u C-u : Show patches also, ask for revisions
  270. positive : Don't show patches, ask for revisions.
  271. negative : Don't show patches, limit to n revisions."
  272. (interactive "P")
  273. (when (interactive-p)
  274. (cond ((equal current-prefix-arg '(4))
  275. (setq show-patch t)
  276. (setq r1 nil))
  277. ((equal current-prefix-arg '(16))
  278. (setq show-patch t)
  279. (setq r1 1)))
  280. (when (and (numberp r1) (> r1 0))
  281. (setq r1 (read-string "hg log, R1:"))
  282. (setq r2 (read-string "hg log, R2:"))))
  283. (let ((buffer (dvc-get-buffer-create 'xhg 'log))
  284. (command-list '("log"))
  285. (cur-dir default-directory))
  286. (when r1
  287. (when (numberp r1)
  288. (setq r1 (number-to-string r1))))
  289. (when r2
  290. (when (numberp r2)
  291. (setq r2 (number-to-string r2))))
  292. (if (and (> (length r2) 0) (> (length r1) 0))
  293. (setq command-list (append command-list (list "-r" (concat r2 ":" r1))))
  294. (when (> (length r1) 0)
  295. (let ((r1-num (string-to-number r1)))
  296. (if (> r1-num 0)
  297. (setq command-list (append command-list (list "-r" r1)))
  298. (setq command-list
  299. (append command-list
  300. (list "-l" (number-to-string (abs r1-num)))))))))
  301. (when show-patch
  302. (setq command-list (append command-list (list "-p"))))
  303. ;; be verbose or not
  304. (setq xhg-log-remember-last-args command-list)
  305. (if (and xhg-log-remember-last-args
  306. xhg-log-verbose)
  307. (setq command-list (append '("-v") xhg-log-remember-last-args))
  308. (setq command-list xhg-log-remember-last-args))
  309. (setf file (expand-file-name (or file (buffer-file-name) default-directory)))
  310. (setq command-list (append command-list (list file)))
  311. (setq xhg-log-remember-func-args (list r1 r2 show-patch file))
  312. (dvc-switch-to-buffer-maybe buffer)
  313. (let ((inhibit-read-only t))
  314. (erase-buffer))
  315. (xhg-log-mode)
  316. ;;(dvc-trace "xhg-log command-list: %S, default-directory: %s" command-list cur-dir)
  317. (let ((default-directory cur-dir))
  318. (dvc-run-dvc-sync 'xhg command-list
  319. :finished
  320. (dvc-capturing-lambda (output error status arguments)
  321. (progn
  322. (with-current-buffer (capture buffer)
  323. (let ((inhibit-read-only t))
  324. (erase-buffer)
  325. (insert-buffer-substring output)
  326. (goto-char (point-min))
  327. (insert (format "hg log for %s\n\n" default-directory))
  328. (toggle-read-only 1)))))))))
  329. ;;;###autoload
  330. (defun xhg-search-regexp-in-log ()
  331. "Run hg log -k <pattern>"
  332. (interactive)
  333. (let* ((regex (read-string "Pattern: "))
  334. (args `("log" "-k" ,regex))
  335. (buffer (dvc-get-buffer-create 'xhg 'log)))
  336. (dvc-switch-to-buffer-maybe buffer)
  337. (let ((inhibit-read-only t))
  338. (erase-buffer))
  339. (xhg-log-mode)
  340. (dvc-run-dvc-sync 'xhg args
  341. :finished
  342. (dvc-capturing-lambda (output error status arguments)
  343. (progn
  344. (with-current-buffer (capture buffer)
  345. (let ((inhibit-read-only t))
  346. (erase-buffer)
  347. (insert-buffer-substring output)
  348. (goto-char (point-min))
  349. (insert (format "hg log for %s\n\n" default-directory))
  350. (toggle-read-only 1))))))))
  351. (defun xhg-parse-diff (changes-buffer)
  352. (save-excursion
  353. (while (re-search-forward
  354. "^diff -r [^ ]+ \\(.*\\)$" nil t)
  355. (let* ((name (match-string-no-properties 1))
  356. (added (progn (forward-line 1)
  357. (looking-at "^--- /dev/null")))
  358. (removed (progn (forward-line 1)
  359. (looking-at "^\\+\\+\\+ /dev/null"))))
  360. (with-current-buffer changes-buffer
  361. (ewoc-enter-last
  362. dvc-fileinfo-ewoc
  363. (make-dvc-fileinfo-legacy
  364. :data (list 'file
  365. name
  366. (cond (added "A")
  367. (removed "D")
  368. (t " "))
  369. (cond ((or added removed) " ")
  370. (t "M"))
  371. " " ; dir. Nothing is a directory in hg.
  372. nil))))))))
  373. (defun xhg-parse-status (changes-buffer)
  374. (let ((status-list (split-string (dvc-buffer-content (current-buffer)) "\n")))
  375. (let ((inhibit-read-only t)
  376. (modif)
  377. (modif-char))
  378. (erase-buffer)
  379. (setq dvc-header (format "hg status for %s\n" default-directory))
  380. (dolist (elem status-list)
  381. (unless (string= "" elem)
  382. (setq modif-char (substring elem 0 1))
  383. (with-current-buffer changes-buffer
  384. (ewoc-enter-last
  385. dvc-fileinfo-ewoc
  386. (make-dvc-fileinfo-legacy
  387. :data (list 'file (substring elem 2) modif-char)))))))))
  388. (defun xhg-diff-1 (modified path dont-switch base-rev)
  389. "Run hg diff.
  390. If DONT-SWITCH, don't switch to the diff buffer"
  391. (interactive (list nil nil current-prefix-arg))
  392. (let* ((window-conf (current-window-configuration))
  393. (cur-dir (or path default-directory))
  394. (orig-buffer (current-buffer))
  395. (root (xhg-tree-root cur-dir))
  396. (buffer (dvc-prepare-changes-buffer
  397. `(xhg (last-revision ,root 1))
  398. `(xhg (local-tree ,root))
  399. 'diff root 'xhg))
  400. (command-list '("diff")))
  401. (dvc-switch-to-buffer-maybe buffer)
  402. (dvc-buffer-push-previous-window-config window-conf)
  403. (when dont-switch (pop-to-buffer orig-buffer))
  404. (dvc-save-some-buffers root)
  405. (when base-rev
  406. (setq command-list (append command-list (list "-r" base-rev)))
  407. (when modified
  408. (setq command-list (append command-list (list "-r" modified)))))
  409. (dvc-run-dvc-sync 'xhg command-list
  410. :finished
  411. (dvc-capturing-lambda (output error status arguments)
  412. (dvc-show-changes-buffer output 'xhg-parse-diff
  413. (capture buffer))))))
  414. ;;;###autoload
  415. (defun xhg-dvc-diff (&optional base-rev path dont-switch)
  416. "Run hg diff.
  417. If DONT-SWITCH, don't switch to the diff buffer"
  418. (interactive (list nil nil current-prefix-arg))
  419. (xhg-diff-1 nil path dont-switch
  420. (dvc-revision-to-string base-rev nil "tip")))
  421. (defun xhg-delta (base-rev modified &optional path dont-switch)
  422. ;; TODO: dvc-revision-to-string doesn't work for me.
  423. (interactive (list nil nil nil current-prefix-arg))
  424. (xhg-diff-1 (dvc-revision-to-string modified) path dont-switch
  425. (dvc-revision-to-string base-rev)))
  426. (defun xhg-dvc-status ()
  427. "Run hg status."
  428. (let* ((window-conf (current-window-configuration))
  429. ;;(root (xhg-tree-root))
  430. (root default-directory) ;; default-directory is setup by the caller...
  431. (buffer (dvc-prepare-changes-buffer
  432. `(xhg (last-revision ,root 1))
  433. `(xhg (local-tree ,root))
  434. 'status root 'xhg)))
  435. ;; (message "xhg-dvc-status root: %s" root)
  436. (dvc-switch-to-buffer-maybe buffer)
  437. (dvc-buffer-push-previous-window-config window-conf)
  438. (dvc-save-some-buffers root)
  439. (dvc-run-dvc-sync 'xhg '("status" ".")
  440. :finished
  441. (dvc-capturing-lambda (output error status arguments)
  442. (with-current-buffer (capture buffer)
  443. (xhg-status-extra-mode-setup)
  444. (if (> (point-max) (point-min))
  445. (dvc-show-changes-buffer output 'xhg-parse-status
  446. (capture buffer))
  447. (dvc-diff-no-changes (capture buffer)
  448. "No changes in %s"
  449. (capture root))))))))
  450. (easy-menu-define xhg-mode-menu dvc-diff-mode-map
  451. "`xhg' menu"
  452. `("hg"
  453. ,xhg-mq-submenu
  454. ["Edit project hgrc file" xhg-hgrc-edit-repository-hgrc t]
  455. ["Edit global ~/.hgrc file" xhg-hgrc-edit-global-hgrc t]
  456. ))
  457. (defun xhg-status-extra-mode-setup ()
  458. "Do some additonal setup for xhg status buffers."
  459. (dvc-trace "xhg-status-extra-mode-setup called.")
  460. (easy-menu-add xhg-mode-menu)
  461. (when (boundp 'xhg-mq-sub-mode-map)
  462. (local-set-key [?Q] xhg-mq-sub-mode-map))
  463. (setq dvc-buffer-refresh-function 'xhg-dvc-status))
  464. (defun xhg-pull-finish-function (output error status arguments)
  465. (let ((buffer (dvc-get-buffer-create 'xhg 'pull)))
  466. (with-current-buffer buffer
  467. (let ((inhibit-read-only t))
  468. (erase-buffer)
  469. (insert-buffer-substring output)
  470. (toggle-read-only 1)))
  471. (let ((dvc-switch-to-buffer-mode 'show-in-other-window))
  472. (dvc-switch-to-buffer buffer))))
  473. ;;;###autoload
  474. (defun xhg-pull (src &optional update-after-pull)
  475. "Run hg pull."
  476. (interactive (list (let* ((completions (xhg-paths 'both))
  477. (initial-input (car (member "default" completions))))
  478. (dvc-completing-read
  479. "Pull from hg repository: "
  480. completions nil nil initial-input))))
  481. (dvc-run-dvc-async 'xhg (list "pull" (when update-after-pull "--update") src)
  482. :error 'xhg-pull-finish-function
  483. :finished 'xhg-pull-finish-function))
  484. (defun xhg-push-finish-function (output error status arguments)
  485. (let ((buffer (dvc-get-buffer-create 'xhg 'push)))
  486. (with-current-buffer buffer
  487. (let ((inhibit-read-only t))
  488. (erase-buffer)
  489. (insert-buffer-substring output)
  490. (toggle-read-only 1)))
  491. (let ((dvc-switch-to-buffer-mode 'show-in-other-window))
  492. (dvc-switch-to-buffer buffer))))
  493. ;;;###autoload
  494. (defun xhg-push (src)
  495. "Run hg push."
  496. (interactive (list (let* ((completions (xhg-paths 'both))
  497. (initial-input (car (member "default" completions))))
  498. (dvc-completing-read
  499. "Push to hg repository: "
  500. completions nil nil initial-input))))
  501. (dvc-run-dvc-async 'xhg (list "push" src)
  502. :error 'xhg-push-finish-function
  503. :finished 'xhg-push-finish-function))
  504. ;;;###autoload
  505. (defun xhg-clone (src &optional dest rev noupdate pull)
  506. "Run hg clone."
  507. (interactive (list (read-string "hg clone from: ")
  508. (read-string "hg clone to: ")
  509. (if current-prefix-arg
  510. (read-string "hg revision: ") ;; rev
  511. nil)
  512. nil ;; noupdate
  513. nil ;; pull
  514. ))
  515. (if rev
  516. (dvc-run-dvc-async 'xhg (list "clone" "--rev" rev src dest))
  517. (dvc-run-dvc-async 'xhg (list "clone" src dest))))
  518. ;;;###autoload
  519. (defun xhg-dired-clone ()
  520. "Run `xhg-clone' from dired."
  521. (interactive)
  522. (let* ((source (dired-filename-at-point))
  523. (target
  524. (read-string (format "Clone(%s)To: " (file-name-nondirectory source))
  525. (file-name-directory source))))
  526. (xhg-clone source target)))
  527. ;;;###autoload
  528. (defun xhg-bundle (name)
  529. "Run hg bundle."
  530. (interactive "sBundleName: ")
  531. (let ((bundle-name (if (string-match ".*\.hg$" name)
  532. name
  533. (concat name ".hg"))))
  534. (dvc-run-dvc-async 'xhg (list "bundle" "--base" "null" bundle-name))))
  535. ;;;###autoload
  536. (defun xhg-unbundle (fname)
  537. "Run hg unbundle."
  538. (interactive "fBundleName: ")
  539. (dvc-run-dvc-async 'xhg (list "unbundle" (expand-file-name fname))
  540. :finished
  541. (dvc-capturing-lambda (output error status arguments)
  542. (if (y-or-n-p "Update now?")
  543. (xhg-update)
  544. (message "Don't forget to update!")))))
  545. ;;;###autoload
  546. (defun xhg-incoming (&optional src show-patch no-merges)
  547. "Run hg incoming."
  548. (interactive (list (let* ((completions (xhg-paths 'both))
  549. (initial-input (car (member "default" completions))))
  550. (dvc-completing-read
  551. "Show incoming from hg repository: "
  552. completions nil nil initial-input))
  553. nil ;; show-patch
  554. nil ;; no-merges
  555. ))
  556. (let ((window-conf (current-window-configuration))
  557. (buffer (dvc-get-buffer-create 'xhg 'log)))
  558. (dvc-switch-to-buffer-maybe buffer t)
  559. (let ((inhibit-read-only t))
  560. (erase-buffer))
  561. (xhg-log-mode)
  562. (dvc-run-dvc-async 'xhg (list "incoming" (when show-patch "--patch") (when no-merges "--no-merges") src)
  563. :finished
  564. (dvc-capturing-lambda (output error status arguments)
  565. (progn
  566. (with-current-buffer (capture buffer)
  567. (let ((inhibit-read-only t))
  568. (erase-buffer)
  569. (insert-buffer-substring output)
  570. (goto-char (point-min))
  571. (insert (format "hg incoming for %s\n\n" default-directory))
  572. (toggle-read-only 1)
  573. (xhg-log-next 1)))))
  574. :error
  575. (dvc-capturing-lambda (output error status arguments)
  576. (with-current-buffer output
  577. (goto-char (point-max))
  578. (forward-line -1)
  579. (if (looking-at "no changes found")
  580. (progn
  581. (message "No changes found")
  582. (set-window-configuration (capture window-conf)))
  583. (dvc-default-error-function output error status arguments)))))))
  584. ;;;###autoload
  585. (defun xhg-outgoing (&optional src show-patch no-merges)
  586. "Run hg outgoing."
  587. (interactive (list (let* ((completions (xhg-paths 'both))
  588. (initial-input (car (member "default" completions))))
  589. (dvc-completing-read
  590. "Show outgoing to hg repository: "
  591. completions nil nil initial-input))
  592. nil ;; show-patch
  593. nil ;; no-merges
  594. ))
  595. (let ((window-conf (current-window-configuration))
  596. (buffer (dvc-get-buffer-create 'xhg 'log)))
  597. (dvc-switch-to-buffer-maybe buffer t)
  598. (let ((inhibit-read-only t))
  599. (erase-buffer))
  600. (xhg-log-mode)
  601. (dvc-run-dvc-async 'xhg (list "outgoing" (when show-patch "--patch") (when no-merges "--no-merges") src)
  602. :finished
  603. (dvc-capturing-lambda (output error status arguments)
  604. (progn
  605. (with-current-buffer (capture buffer)
  606. (let ((inhibit-read-only t))
  607. (erase-buffer)
  608. (insert-buffer-substring output)
  609. (goto-char (point-min))
  610. (insert (format "hg outgoing for %s\n\n" default-directory))
  611. (toggle-read-only 1)))))
  612. :error
  613. (dvc-capturing-lambda (output error status arguments)
  614. (with-current-buffer output
  615. (goto-char (point-max))
  616. (forward-line -1)
  617. (if (looking-at "no changes found")
  618. (progn
  619. (message "No changes found")
  620. (set-window-configuration (capture window-conf)))
  621. (dvc-default-error-function output error status arguments)))))))
  622. (defun xhg-get-all-heads-list ()
  623. "Get a list of all heads available from the output of hg heads."
  624. (let ((rev-list (with-temp-buffer
  625. (apply #'call-process "hg" nil t nil
  626. '("heads"
  627. "--template"
  628. "#rev#\n"))
  629. (buffer-string))))
  630. (setq rev-list (cons "auto"
  631. (remove "" (split-string rev-list "\n"))))
  632. rev-list))
  633. (defun xhg-changep ()
  634. (let ((change (with-temp-buffer
  635. (apply #'call-process "hg" nil t nil
  636. '("diff"))
  637. (buffer-string))))
  638. (setq change (remove "" (split-string change "\n")))
  639. (if change
  640. t
  641. nil)))
  642. ;;;###autoload
  643. (defun xhg-strip (rev)
  644. "Run hg strip."
  645. (interactive (list (dvc-completing-read "Remove head: "
  646. (xhg-get-all-heads-list))))
  647. (dvc-run-dvc-sync 'xhg (list "strip" rev)))
  648. ;;;###autoload
  649. (defun xhg-merge ()
  650. "Run hg merge.
  651. To merge from specific revision, choose it in completion with tab.
  652. If `auto' is choose use default revision (last) unless there is ONLY
  653. one more head.
  654. See \(hg help merge.\)"
  655. (interactive)
  656. (let* ((haschange (xhg-changep))
  657. (collection (xhg-get-all-heads-list))
  658. (revision (dvc-completing-read "Merge from hg revision: "
  659. collection nil t))
  660. (arg))
  661. (when (or (string= revision "")
  662. (string= revision "auto"))
  663. (setq revision nil))
  664. (setq arg (if revision
  665. '("merge" "--rev")
  666. '("merge")))
  667. (cond ((and (> (length collection) 3)
  668. (not revision))
  669. (error "Abort: branch 'default' has more than 2 heads - please merge with an explicit rev."))
  670. ((equal revision (xhg-dry-tip))
  671. (error "Abort:can't merge with ancestor."))
  672. ((and (not haschange)
  673. (> (length collection) 2))
  674. (dvc-run-dvc-async 'xhg `(,@arg ,revision)
  675. :finished
  676. (dvc-capturing-lambda (output error status arguments)
  677. (message "hg %s %s %s finished => %s"
  678. (nth 0 arg)
  679. (if revision
  680. (nth 1 arg)
  681. "")
  682. (if revision
  683. revision
  684. "")
  685. (concat (dvc-buffer-content error)
  686. (dvc-buffer-content output))))
  687. :error
  688. ;; avoid dvc-error buffer to appear in ediff
  689. (lambda (output error status arguments)
  690. nil)))
  691. (haschange
  692. (error "abort: outstanding uncommitted merges, Please commit before merging"))
  693. ((< (length collection) 3)
  694. (error "There is nothing to merge here")))))
  695. ;;;###autoload
  696. (defun xhg-resolve (&optional file)
  697. "Run hg resolve --all or <spec file>.
  698. With current prefix arg, take a file as argument.
  699. You should run xhg-merge before this.
  700. This command will cleanly retry unresolved file merges
  701. using file revisions preserved from the last update or merge.
  702. If file is given resolve this file else resolve all files."
  703. (interactive)
  704. (let ((unresolved-files
  705. (loop for i in (xhg-resolve-list t)
  706. if (equal (car i) "U")
  707. collect (cadr i))))
  708. (when current-prefix-arg
  709. (setq file
  710. (file-name-nondirectory (read-file-name "File: "))))
  711. (if file
  712. (if (member file unresolved-files)
  713. (dvc-run-dvc-sync 'xhg (list "resolve" file)
  714. :finished
  715. (dvc-capturing-lambda (output error status arguments)
  716. (message "ok finished with status %s" status)
  717. (xhg-resolve-list)))
  718. (message "%s have been already resolved" file))
  719. (dvc-run-dvc-sync 'xhg (list "resolve" "--all")
  720. :finished
  721. (dvc-capturing-lambda (output error status arguments)
  722. (message "ok finished with status %s" status)
  723. (xhg-resolve-list))))))
  724. ;;;###autoload
  725. (defun xhg-resolve-list (&optional quiet)
  726. "Run hg resolve --list.
  727. Call interactively, show buffer with info.
  728. Non interactively, return an alist with
  729. string keys as:
  730. U = unresolved
  731. R = resolved"
  732. (interactive)
  733. (let ((resolve-alist nil))
  734. (if quiet
  735. (progn
  736. (save-window-excursion
  737. (dvc-run-dvc-display-as-info 'xhg (list "resolve" "--list"))
  738. (with-current-buffer "*xhg-info*"
  739. (setq resolve-alist
  740. (mapcar #'split-string
  741. (split-string (buffer-substring-no-properties
  742. (point-min)
  743. (point-max))
  744. "\n"))))
  745. (kill-buffer "*xhg-info*")
  746. resolve-alist))
  747. (dvc-run-dvc-display-as-info 'xhg (list "resolve" "--list")))))
  748. (defun xhg-command-version ()
  749. "Run hg version."
  750. (interactive)
  751. (let ((version (dvc-run-dvc-sync 'xhg '("version")
  752. :finished 'dvc-output-buffer-handler)))
  753. (when (interactive-p)
  754. (message "Mercurial version: %s" version))
  755. version))
  756. ;;;###autoload
  757. (defun xhg-branch (&optional new-name)
  758. "Run hg branch.
  759. When called with a prefix argument, ask for the new branch-name, otherwise
  760. display the current one."
  761. (interactive "P")
  762. (let ((branch (dvc-run-dvc-sync 'xhg (list "branch")
  763. :finished 'dvc-output-buffer-handler)))
  764. (if (not new-name)
  765. (progn
  766. (when (interactive-p)
  767. (message "xhg branch: %s" branch))
  768. branch)
  769. (when (interactive-p)
  770. (setq new-name (read-string (format "Change branch from '%s' to: " branch) nil nil branch)))
  771. (dvc-run-dvc-sync 'xhg (list "branch" new-name)))))
  772. ;;;###autoload
  773. (defun xhg-branches (&optional only-list)
  774. "run xhg-branches"
  775. (interactive)
  776. (dvc-run-dvc-display-as-info 'xhg '("branches"))
  777. (let ((branchs-list (with-current-buffer "*xhg-info*"
  778. (split-string (buffer-string) "\n"))))
  779. (when only-list
  780. (kill-buffer "*xhg-info*")
  781. (loop for i in branchs-list
  782. for e = (car (split-string i))
  783. when e
  784. collect e))))
  785. (defun xhg-branches-sans-current ()
  786. "Run xhg-branches but remove current branch."
  787. (save-window-excursion
  788. (let ((cur-branch (xhg-branch))
  789. (branches (xhg-branches t)))
  790. (remove cur-branch branches))))
  791. ;;;###autoload
  792. (defun xhg-merge-branch ()
  793. "Run hg merge <branch-name>.
  794. Usually merge the change made in dev branch in default branch."
  795. (interactive)
  796. (let* ((current-branch (xhg-branch))
  797. (branch (dvc-completing-read "BranchName: "
  798. (xhg-branches-sans-current))))
  799. (when (y-or-n-p (format "Really merge %s in %s" branch current-branch))
  800. (dvc-run-dvc-sync 'xhg (list "merge" branch)
  801. :finished
  802. (dvc-capturing-lambda (output error status arguments)
  803. (message "Updated! Don't forget to commit."))))))
  804. ;;todo: add support to specify a rev
  805. (defun xhg-manifest ()
  806. "Run hg manifest."
  807. (interactive)
  808. (let ((buffer (dvc-get-buffer-create 'xhg 'manifest)))
  809. (dvc-run-dvc-sync 'xhg '("manifest")
  810. :finished
  811. (dvc-capturing-lambda (output error status arguments)
  812. (progn
  813. (with-current-buffer (capture buffer)
  814. (let ((inhibit-read-only t))
  815. (erase-buffer)
  816. (insert-buffer-substring output)
  817. (toggle-read-only 1)))
  818. (dvc-switch-to-buffer (capture buffer)))))))
  819. ;;;###autoload
  820. (defun xhg-tip ()
  821. "Run hg tip."
  822. (interactive)
  823. (dvc-run-dvc-display-as-info 'xhg '("tip")))
  824. ;;;###autoload
  825. (defun xhg-heads ()
  826. "Run hg heads."
  827. (interactive)
  828. (dvc-run-dvc-display-as-info 'xhg '("heads")))
  829. ;;;###autoload
  830. (defun xhg-parents ()
  831. "Run hg parents."
  832. (interactive)
  833. (dvc-run-dvc-display-as-info 'xhg '("parents")))
  834. ;;;###autoload
  835. (defun xhg-identify ()
  836. "Run hg identify."
  837. (interactive)
  838. (let ((id))
  839. (dvc-run-dvc-sync 'xhg '("identify")
  840. :finished
  841. (lambda (output error status arguments)
  842. (set-buffer output)
  843. (goto-char (point-min))
  844. (setq id
  845. (buffer-substring-no-properties
  846. (point)
  847. (line-end-position))))
  848. :error
  849. (lambda (output error status arguments)
  850. (setq id "<unknown>")))
  851. (when (interactive-p)
  852. (message "hg identity for %s: %s" default-directory id))
  853. id))
  854. ;;;###autoload
  855. (defun xhg-verify ()
  856. "Run hg verify."
  857. (interactive)
  858. (dvc-run-dvc-display-as-info 'xhg '("verify")))
  859. ;;;###autoload
  860. (defun xhg-showconfig ()
  861. "Run hg showconfig."
  862. (interactive)
  863. (dvc-run-dvc-display-as-info 'xhg '("showconfig")))
  864. ;;;###autoload
  865. (defun xhg-paths (&optional type)
  866. "Run hg paths.
  867. When called interactive, display them in an *xhg-info* buffer.
  868. Otherwise the return value depends on TYPE:
  869. 'alias: Return only alias names
  870. 'path: Return only the paths
  871. 'both Return the aliases and the paths in a flat list
  872. otherwise: Return a list of two element sublists containing alias, path"
  873. (interactive)
  874. (if (interactive-p)
  875. (dvc-run-dvc-display-as-info 'xhg '("paths"))
  876. (let* ((path-list (dvc-run-dvc-sync 'xhg (list "paths")
  877. :finished 'dvc-output-buffer-split-handler))
  878. (lisp-path-list (mapcar '(lambda(arg) (dvc-split-string arg " = " arg)) path-list))
  879. (result-list))
  880. (cond ((eq type 'alias)
  881. (setq result-list (mapcar 'car lisp-path-list)))
  882. ((eq type 'path)
  883. (setq result-list (mapcar 'cadr lisp-path-list)))
  884. ((eq type 'both)
  885. (setq result-list (append (mapcar 'car lisp-path-list) (mapcar 'cadr lisp-path-list))))
  886. (t
  887. (setq result-list lisp-path-list))))))
  888. ;;;###autoload
  889. (defun xhg-tag (rev name)
  890. "Run hg tag -r <REV> NAME."
  891. (interactive (list (read-from-minibuffer "Revision: "
  892. nil nil nil nil
  893. (xhg-dry-tip))
  894. (read-string "TagName: ")))
  895. (dvc-run-dvc-sync 'xhg (list "tag" "-r" rev name)
  896. :finished (lambda (output error status arguments)
  897. (message "Ok revision %s tagged as %s"
  898. rev name))))
  899. ;;;###autoload
  900. (defun xhg-tags ()
  901. "Run hg tags."
  902. (interactive)
  903. (dvc-run-dvc-display-as-info 'xhg '("tags")))
  904. ;; hg annotate: add support to edit the parameters
  905. ;; -r --rev revision
  906. ;; -a --text treat all files as text
  907. ;; -u --user show user
  908. ;; -n --number show revision number
  909. ;; -c --changeset show changeset
  910. ;; (defun xhg-annotate ()
  911. ;; "Run hg annotate."
  912. ;; (interactive)
  913. ;; (dvc-run-dvc-display-as-info 'xhg (append '("annotate") (dvc-current-file-list))))
  914. ;;;###autoload
  915. (defun xhg-view ()
  916. "Run hg view."
  917. (interactive)
  918. (dvc-run-dvc-async 'xhg '("view")))
  919. ;;;###autoload
  920. (defun xhg-export (rev fname)
  921. "Run hg export.
  922. `xhg-export-git-style-patches' determines, if git style patches are created."
  923. (interactive (list (xhg-read-revision "Export revision: ")
  924. (read-file-name "Export hg revision to: ")))
  925. (dvc-run-dvc-sync 'xhg (list "export" (when xhg-export-git-style-patches "--git") "-o" (expand-file-name fname) rev)
  926. :finished
  927. (lambda (output error status arguments)
  928. (message "Exported revision %s to %s." rev fname))))
  929. ;;;###autoload
  930. (defun xhg-import (patch-file-name &optional force)
  931. "Run hg import."
  932. (interactive (list (read-file-name "Import hg patch: " nil nil t (when (eq major-mode 'dired-mode)
  933. (file-name-nondirectory (dired-get-filename))))))
  934. (dvc-run-dvc-sync 'xhg (delete nil (list "import" (when force "--force") (expand-file-name patch-file-name)))
  935. :finished
  936. (lambda (output error status arguments)
  937. (message "Imported hg patch from %s." patch-file-name))))
  938. ;;;###autoload
  939. (defun xhg-undo ()
  940. "Run hg undo."
  941. (interactive)
  942. (let ((undo-possible (file-exists-p (concat (xhg-tree-root) ".hg/undo"))))
  943. (if undo-possible
  944. (save-window-excursion
  945. (xhg-log "-1" nil t)
  946. (if (yes-or-no-p "Undo this transaction? ")
  947. (progn
  948. (dvc-run-dvc-sync 'xhg (list "undo")
  949. :finished
  950. (lambda (output error status arguments)
  951. (message "Finished xhg undo."))))
  952. (message "xhg undo aborted.")))
  953. (message "xhg: No undo information available."))))
  954. ;;;###autoload
  955. (defun xhg-update (&optional clean switch)
  956. "Run hg update.
  957. When called with one prefix-arg run hg update -C (clean).
  958. Called with two prefix-args run hg update -C <branch-name> (switch to branch)."
  959. (interactive)
  960. (let* ((opt-list (cond ((or clean
  961. (equal current-prefix-arg '(4)))
  962. (list "update" "-C"))
  963. ((or switch
  964. (equal current-prefix-arg '(16)))
  965. (list "update" "-C" (dvc-completing-read "BranchName: "
  966. (xhg-branches-sans-current))))
  967. (t
  968. (list "update"))))
  969. (opt-string (mapconcat 'identity opt-list " ")))
  970. (dvc-run-dvc-sync 'xhg opt-list
  971. :finished
  972. (lambda (output error status arguments)
  973. (dvc-default-finish-function output error status arguments)
  974. (message "hg %s complete for %s" opt-string default-directory)))))
  975. (defun xhg-convert (source target &optional revnum)
  976. "Convert a foreign SCM repository to a Mercurial one.
  977. With prefix arg prompt for REVNUM.
  978. Accepted source formats [identifiers]:(Mercurial-1.1.2)
  979. - Mercurial [hg]
  980. - CVS [cvs]
  981. - Darcs [darcs]
  982. - git [git]
  983. - Subversion [svn]
  984. - Monotone [mtn]
  985. - GNU Arch [gnuarch]
  986. - Bazaar [bzr]
  987. Be sure to add to your hgrc:
  988. \[extensions\]
  989. hgext.convert =
  990. Read also: hg help convert.
  991. "
  992. (interactive "DSource: \nsTarget: ")
  993. (let* ((src (expand-file-name source))
  994. (tget (expand-file-name target))
  995. (rev (if current-prefix-arg (read-string "Revision: ") revnum))
  996. (arg-list (if rev (list "convert" src tget "-r" rev) (list "convert" src tget))))
  997. (message "HG conversion of `%s' to `%s' ..." source target)
  998. (dvc-run-dvc-async 'xhg arg-list
  999. :finished (dvc-capturing-lambda (output error status arguments)
  1000. (let ((default-directory (capture target)))
  1001. (xhg-update))
  1002. (message "HG conversion of `%s' to `%s' ... done."
  1003. (capture source) (capture target))))))
  1004. ;; --------------------------------------------------------------------------------
  1005. ;; hg serve functionality
  1006. ;; --------------------------------------------------------------------------------
  1007. (defvar xhg-serve-parameter-list (make-hash-table :test 'equal)
  1008. "A hash table that holds the mapping from work directory roots to
  1009. extra parameters used for hg serve.
  1010. The extra parameters are given as alist. The following example shows the supported settings:
  1011. '((port 8235) (name \"my-project\"))")
  1012. ;;;###autoload
  1013. (defun xhg-serve-register-serve-parameter-list (working-copy-root parameter-list &optional start-server)
  1014. "Register a mapping from a work directory root to a parameter list for hg serve.
  1015. When START-SERVER is given, start the server immediately.
  1016. Example usage:
  1017. (xhg-serve-register-serve-parameter-list \"~/proj/simple-counter-1/\" '((port 8100) (name \"simple-counter\")))"
  1018. (puthash (dvc-uniquify-file-name working-copy-root) parameter-list xhg-serve-parameter-list)
  1019. (when start-server
  1020. (let ((default-directory (dvc-uniquify-file-name working-copy-root)))
  1021. (xhg-serve))))
  1022. (defun xhg-serve ()
  1023. "Run hg serve --daemon.
  1024. See `xhg-serve-register-serve-parameter-list' to register specific parameters for the server process."
  1025. (interactive)
  1026. (let* ((tree-root (dvc-tree-root))
  1027. (server-status-dir (concat tree-root ".xhg-serve/"))
  1028. (parameter-alist (gethash (dvc-uniquify-file-name tree-root) xhg-serve-parameter-list))
  1029. (port (or (cadr (assoc 'port parameter-alist)) 8000))
  1030. (name (cadr (assoc 'name parameter-alist)))
  1031. (errorlog (concat server-status-dir "error.log"))
  1032. (accesslog (concat server-status-dir "access.log"))
  1033. (pid-file (concat server-status-dir "server.pid")))
  1034. (when (numberp port)
  1035. (setq port (number-to-string port)))
  1036. (unless (file-directory-p server-status-dir)
  1037. (make-directory server-status-dir))
  1038. (dvc-run-dvc-sync 'xhg (list "serve" "--daemon" (when port "--port") port (when name "--name") name
  1039. "--pid-file" pid-file "--accesslog" accesslog "--errorlog" errorlog)
  1040. :finished (dvc-capturing-lambda (output error status arguments)
  1041. (message "hg server started for %s, using port %s" tree-root port)))))
  1042. (defun xhg-serve-kill ()
  1043. "Kill a hg serve process started with `xhg-serve'."
  1044. (interactive)
  1045. (let* ((tree-root (dvc-tree-root))
  1046. (server-status-dir (concat tree-root ".xhg-serve/"))
  1047. (pid-file (concat server-status-dir "server.pid"))
  1048. (pid)
  1049. (kill-status))
  1050. (if (file-readable-p pid-file)
  1051. (with-current-buffer
  1052. (find-file-noselect pid-file)
  1053. (setq pid (buffer-substring-no-properties (point-min) (- (point-max) 1)))
  1054. (kill-buffer (current-buffer)))
  1055. (message "no hg serve pid file found - aborting"))
  1056. (when pid
  1057. (setq kill-status (call-process "kill" nil nil nil pid))
  1058. (if (eq kill-status 0)
  1059. (progn
  1060. (delete-file pid-file)
  1061. (message "hg serve process killed."))
  1062. (message "kill hg serve process failed, return status: %d" kill-status)))))
  1063. ;; --------------------------------------------------------------------------------
  1064. ;; dvc revision support
  1065. ;; --------------------------------------------------------------------------------
  1066. ;;;###autoload
  1067. (defun xhg-revision-get-last-revision (file last-revision)
  1068. "Insert the content of FILE in LAST-REVISION, in current buffer.
  1069. LAST-REVISION looks like
  1070. \(\"path\" NUM)"
  1071. (dvc-trace "xhg-revision-get-last-revision file:%S last-revision:%S" file last-revision)
  1072. (let ((xhg-rev (int-to-string (nth 1 last-revision)))
  1073. (default-directory (car last-revision)))
  1074. ;; TODO: support the last-revision parameter??
  1075. (insert (dvc-run-dvc-sync
  1076. 'xhg (list "cat" file)
  1077. :finished 'dvc-output-buffer-handler-withnewline))))
  1078. ;;;###autoload
  1079. (defun xhg-revision-get-last-or-num-revision (infile outfile &optional revision)
  1080. "Run the command:
  1081. hg cat --rev <num revision> -o outputfile inputfile"
  1082. (interactive
  1083. (let* ((xhg-infile (read-file-name "InputFile: "))
  1084. (xhg-outfile (read-file-name "OutputFile: "))
  1085. (xhg-rev (if current-prefix-arg
  1086. (read-string "Revision: ")
  1087. "tip")))
  1088. (setq xhg-infile (expand-file-name xhg-infile)
  1089. xhg-outfile (concat (expand-file-name xhg-outfile)
  1090. "."
  1091. xhg-rev))
  1092. (list xhg-infile xhg-outfile xhg-rev)))
  1093. (dvc-run-dvc-sync 'xhg (list "cat"
  1094. "--rev"
  1095. revision
  1096. "-o"
  1097. outfile
  1098. infile)
  1099. :finished 'dvc-output-buffer-handler-withnewline)
  1100. (message "%s extracted in %s at revision %s"
  1101. (file-name-nondirectory infile)
  1102. (file-relative-name outfile)
  1103. revision))
  1104. ;;;###autoload
  1105. (defun xhg-ediff-file-at-rev (file rev1 rev2 &optional keep-variants)
  1106. "Ediff file at rev1 against rev2.
  1107. With prefix arg do not delete the files.
  1108. If rev1 or rev2 are empty, ediff current file against last revision.
  1109. Tip: to quit ediff, use C-u q to kill the ediffied buffers."
  1110. (interactive (list (read-file-name "File:" nil (dvc-get-file-info-at-point))
  1111. (read-from-minibuffer "Rev1: " nil nil nil nil (xhg-dry-tip))
  1112. (read-string "Rev2: ")))
  1113. (let* ((fname (expand-file-name file))
  1114. (bfname (file-name-nondirectory file))
  1115. (file1 (concat dvc-temp-directory "/" rev1 "-" bfname))
  1116. (file2 (concat dvc-temp-directory "/" rev2 "-" bfname))
  1117. (pref-arg (or keep-variants
  1118. current-prefix-arg)))
  1119. (if (or (equal "" rev1)
  1120. (equal "" rev2))
  1121. (dvc-file-ediff fname)
  1122. (unless (equal rev1 rev2)
  1123. (xhg-revision-get-last-or-num-revision fname file1 rev1)
  1124. (xhg-revision-get-last-or-num-revision fname file2 rev2)
  1125. (ediff-files file1 file2)
  1126. (unless pref-arg
  1127. (delete-file file1)
  1128. (delete-file file2))))))
  1129. ;; --------------------------------------------------------------------------------
  1130. ;; higher level commands
  1131. ;; --------------------------------------------------------------------------------
  1132. (defvar xhg-submit-patch-mapping nil)
  1133. ;;(add-to-list 'xhg-submit-patch-mapping '("~/data/wiki" ("joe@host.com" "my-wiki")))
  1134. (defun xhg-export-via-mail (rev)
  1135. (interactive (list (xhg-read-revision "Export revision: ")))
  1136. (let ((file-name)
  1137. (destination-email "")
  1138. (base-file-name nil)
  1139. (subject)
  1140. (description))
  1141. (dolist (m xhg-submit-patch-mapping)
  1142. (when (string= (dvc-uniquify-file-name (car m)) (dvc-uniquify-file-name (xhg-tree-root)))
  1143. ;;(message "%S" (cadr m))
  1144. (setq destination-email (car (cadr m)))
  1145. (setq base-file-name (cadr (cadr m)))))
  1146. (setq file-name (concat (dvc-uniquify-file-name dvc-temp-directory) (or base-file-name "") rev ".patch"))
  1147. (xhg-export rev file-name)
  1148. (setq description
  1149. (dvc-run-dvc-sync 'xhg (list "log" "-r" rev)
  1150. :finished 'dvc-output-buffer-handler))
  1151. (require 'reporter)
  1152. (delete-other-windows)
  1153. (reporter-submit-bug-report
  1154. destination-email
  1155. nil
  1156. nil
  1157. nil
  1158. nil
  1159. description)
  1160. (save-excursion
  1161. (re-search-backward "^summary: +\\(.+\\)")
  1162. (setq subject (match-string-no-properties 1)))
  1163. ;; delete emacs version - its not needed here
  1164. (delete-region (point) (point-max))
  1165. (mml-attach-file file-name "text/x-patch")
  1166. (goto-char (point-min))
  1167. (mail-position-on-field "Subject")
  1168. (insert (concat "[PATCH] " subject))))
  1169. ;; hg log -r $(hg identify)
  1170. ;; add one to that revision number -> actual-rev+1
  1171. ;; hg log -r actual-rev+1:tip, e.g. hg log -r 5:tip
  1172. ;;;###autoload
  1173. (defun xhg-missing-1 ()
  1174. "Shows the logs of the new ar…

Large files files are truncated, but you can click here to view the full file