PageRenderTime 70ms CodeModel.GetById 32ms RepoModel.GetById 0ms app.codeStats 1ms

/dvc/mode/lisp/xhg.el

https://bitbucket.org/atollena/tidyconfig-antoine-packs
Emacs Lisp | 1362 lines | 1033 code | 109 blank | 220 comment | 30 complexity | 13b0dd13bfe6950468cae839f300aacb MD5 | raw file
Possible License(s): GPL-2.0, MPL-2.0-no-copyleft-exception, JSON

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. (setq xhg-log-remember-func-args (list r1 r2 show-patch file))
  306. (if (and xhg-log-remember-last-args
  307. xhg-log-verbose)
  308. (setq command-list (append '("-v") xhg-log-remember-last-args))
  309. (setq command-list xhg-log-remember-last-args))
  310. (dvc-switch-to-buffer-maybe buffer)
  311. (let ((inhibit-read-only t))
  312. (erase-buffer))
  313. (xhg-log-mode)
  314. ;;(dvc-trace "xhg-log command-list: %S, default-directory: %s" command-list cur-dir)
  315. (let ((default-directory cur-dir))
  316. (dvc-run-dvc-sync 'xhg command-list
  317. :finished
  318. (dvc-capturing-lambda (output error status arguments)
  319. (progn
  320. (with-current-buffer (capture buffer)
  321. (let ((inhibit-read-only t))
  322. (erase-buffer)
  323. (insert-buffer-substring output)
  324. (goto-char (point-min))
  325. (insert (format "hg log for %s\n\n" default-directory))
  326. (toggle-read-only 1)))))))))
  327. ;;;###autoload
  328. (defun xhg-search-regexp-in-log ()
  329. "Run hg log -k <pattern>"
  330. (interactive)
  331. (let* ((regex (read-string "Pattern: "))
  332. (args `("log" "-k" ,regex))
  333. (buffer (dvc-get-buffer-create 'xhg 'log)))
  334. (dvc-switch-to-buffer-maybe buffer)
  335. (let ((inhibit-read-only t))
  336. (erase-buffer))
  337. (xhg-log-mode)
  338. (dvc-run-dvc-sync 'xhg args
  339. :finished
  340. (dvc-capturing-lambda (output error status arguments)
  341. (progn
  342. (with-current-buffer (capture buffer)
  343. (let ((inhibit-read-only t))
  344. (erase-buffer)
  345. (insert-buffer-substring output)
  346. (goto-char (point-min))
  347. (insert (format "hg log for %s\n\n" default-directory))
  348. (toggle-read-only 1))))))))
  349. (defun xhg-parse-diff (changes-buffer)
  350. (save-excursion
  351. (while (re-search-forward
  352. "^diff -r [^ ]+ \\(.*\\)$" nil t)
  353. (let* ((name (match-string-no-properties 1))
  354. (added (progn (forward-line 1)
  355. (looking-at "^--- /dev/null")))
  356. (removed (progn (forward-line 1)
  357. (looking-at "^\\+\\+\\+ /dev/null"))))
  358. (with-current-buffer changes-buffer
  359. (ewoc-enter-last
  360. dvc-fileinfo-ewoc
  361. (make-dvc-fileinfo-legacy
  362. :data (list 'file
  363. name
  364. (cond (added "A")
  365. (removed "D")
  366. (t " "))
  367. (cond ((or added removed) " ")
  368. (t "M"))
  369. " " ; dir. Nothing is a directory in hg.
  370. nil))))))))
  371. (defun xhg-parse-status (changes-buffer)
  372. (let ((status-list (split-string (dvc-buffer-content (current-buffer)) "\n")))
  373. (let ((inhibit-read-only t)
  374. (modif)
  375. (modif-char))
  376. (erase-buffer)
  377. (setq dvc-header (format "hg status for %s\n" default-directory))
  378. (dolist (elem status-list)
  379. (unless (string= "" elem)
  380. (setq modif-char (substring elem 0 1))
  381. (with-current-buffer changes-buffer
  382. (ewoc-enter-last
  383. dvc-fileinfo-ewoc
  384. (make-dvc-fileinfo-legacy
  385. :data (list 'file (substring elem 2) modif-char)))))))))
  386. (defun xhg-diff-1 (modified path dont-switch base-rev)
  387. "Run hg diff.
  388. If DONT-SWITCH, don't switch to the diff buffer"
  389. (interactive (list nil nil current-prefix-arg))
  390. (let* ((window-conf (current-window-configuration))
  391. (cur-dir (or path default-directory))
  392. (orig-buffer (current-buffer))
  393. (root (xhg-tree-root cur-dir))
  394. (buffer (dvc-prepare-changes-buffer
  395. `(xhg (last-revision ,root 1))
  396. `(xhg (local-tree ,root))
  397. 'diff root 'xhg))
  398. (command-list '("diff")))
  399. (dvc-switch-to-buffer-maybe buffer)
  400. (dvc-buffer-push-previous-window-config window-conf)
  401. (when dont-switch (pop-to-buffer orig-buffer))
  402. (dvc-save-some-buffers root)
  403. (when base-rev
  404. (setq command-list (append command-list (list "-r" base-rev)))
  405. (when modified
  406. (setq command-list (append command-list (list "-r" modified)))))
  407. (dvc-run-dvc-sync 'xhg command-list
  408. :finished
  409. (dvc-capturing-lambda (output error status arguments)
  410. (dvc-show-changes-buffer output 'xhg-parse-diff
  411. (capture buffer))))))
  412. ;;;###autoload
  413. (defun xhg-dvc-diff (&optional base-rev path dont-switch)
  414. "Run hg diff.
  415. If DONT-SWITCH, don't switch to the diff buffer"
  416. (interactive (list nil nil current-prefix-arg))
  417. (xhg-diff-1 nil path dont-switch
  418. (dvc-revision-to-string base-rev nil "tip")))
  419. (defun xhg-delta (base-rev modified &optional path dont-switch)
  420. ;; TODO: dvc-revision-to-string doesn't work for me.
  421. (interactive (list nil nil nil current-prefix-arg))
  422. (xhg-diff-1 (dvc-revision-to-string modified) path dont-switch
  423. (dvc-revision-to-string base-rev)))
  424. (defun xhg-dvc-status ()
  425. "Run hg status."
  426. (let* ((window-conf (current-window-configuration))
  427. (root (xhg-tree-root))
  428. (buffer (dvc-prepare-changes-buffer
  429. `(xhg (last-revision ,root 1))
  430. `(xhg (local-tree ,root))
  431. 'status root 'xhg)))
  432. (dvc-switch-to-buffer-maybe buffer)
  433. (dvc-buffer-push-previous-window-config window-conf)
  434. (dvc-save-some-buffers root)
  435. (dvc-run-dvc-sync 'xhg '("status")
  436. :finished
  437. (dvc-capturing-lambda (output error status arguments)
  438. (with-current-buffer (capture buffer)
  439. (xhg-status-extra-mode-setup)
  440. (if (> (point-max) (point-min))
  441. (dvc-show-changes-buffer output 'xhg-parse-status
  442. (capture buffer))
  443. (dvc-diff-no-changes (capture buffer)
  444. "No changes in %s"
  445. (capture root))))))))
  446. (easy-menu-define xhg-mode-menu dvc-diff-mode-map
  447. "`xhg' menu"
  448. `("hg"
  449. ,xhg-mq-submenu
  450. ["Edit project hgrc file" xhg-hgrc-edit-repository-hgrc t]
  451. ["Edit global ~/.hgrc file" xhg-hgrc-edit-global-hgrc t]
  452. ))
  453. (defun xhg-status-extra-mode-setup ()
  454. "Do some additonal setup for xhg status buffers."
  455. (dvc-trace "xhg-status-extra-mode-setup called.")
  456. (easy-menu-add xhg-mode-menu)
  457. (when (boundp 'xhg-mq-sub-mode-map)
  458. (local-set-key [?Q] xhg-mq-sub-mode-map))
  459. (setq dvc-buffer-refresh-function 'xhg-dvc-status))
  460. (defun xhg-pull-finish-function (output error status arguments)
  461. (let ((buffer (dvc-get-buffer-create 'xhg 'pull)))
  462. (with-current-buffer buffer
  463. (let ((inhibit-read-only t))
  464. (erase-buffer)
  465. (insert-buffer-substring output)
  466. (toggle-read-only 1)))
  467. (let ((dvc-switch-to-buffer-mode 'show-in-other-window))
  468. (dvc-switch-to-buffer buffer))))
  469. ;;;###autoload
  470. (defun xhg-pull (src &optional update-after-pull)
  471. "Run hg pull."
  472. (interactive (list (let* ((completions (xhg-paths 'both))
  473. (initial-input (car (member "default" completions))))
  474. (dvc-completing-read
  475. "Pull from hg repository: "
  476. completions nil nil initial-input))))
  477. (dvc-run-dvc-async 'xhg (list "pull" (when update-after-pull "--update") src)
  478. :error 'xhg-pull-finish-function
  479. :finished 'xhg-pull-finish-function))
  480. (defun xhg-push-finish-function (output error status arguments)
  481. (let ((buffer (dvc-get-buffer-create 'xhg 'push)))
  482. (with-current-buffer buffer
  483. (let ((inhibit-read-only t))
  484. (erase-buffer)
  485. (insert-buffer-substring output)
  486. (toggle-read-only 1)))
  487. (let ((dvc-switch-to-buffer-mode 'show-in-other-window))
  488. (dvc-switch-to-buffer buffer))))
  489. ;;;###autoload
  490. (defun xhg-push (src)
  491. "Run hg push."
  492. (interactive (list (let* ((completions (xhg-paths 'both))
  493. (initial-input (car (member "default" completions))))
  494. (dvc-completing-read
  495. "Push to hg repository: "
  496. completions nil nil initial-input))))
  497. (dvc-run-dvc-async 'xhg (list "push" src)
  498. :error 'xhg-push-finish-function
  499. :finished 'xhg-push-finish-function))
  500. ;;;###autoload
  501. (defun xhg-clone (src &optional dest rev noupdate pull)
  502. "Run hg clone."
  503. (interactive (list (read-string "hg clone from: ")
  504. (read-string "hg clone to: ")
  505. (if current-prefix-arg
  506. (read-string "hg revision: ") ;; rev
  507. nil)
  508. nil ;; noupdate
  509. nil ;; pull
  510. ))
  511. (if rev
  512. (dvc-run-dvc-async 'xhg (list "clone" "--rev" rev src dest))
  513. (dvc-run-dvc-async 'xhg (list "clone" src dest))))
  514. ;;;###autoload
  515. (defun xhg-dired-clone ()
  516. "Run `xhg-clone' from dired."
  517. (interactive)
  518. (let* ((source (dired-filename-at-point))
  519. (target
  520. (read-string (format "Clone(%s)To: " (file-name-nondirectory source))
  521. (file-name-directory source))))
  522. (xhg-clone source target)))
  523. ;;;###autoload
  524. (defun xhg-bundle (name)
  525. "Run hg bundle."
  526. (interactive "sBundleName: ")
  527. (let ((bundle-name (if (string-match ".*\.hg$" name)
  528. name
  529. (concat name ".hg"))))
  530. (dvc-run-dvc-async 'xhg (list "bundle" "--base" "null" bundle-name))))
  531. ;;;###autoload
  532. (defun xhg-unbundle (fname)
  533. "Run hg unbundle."
  534. (interactive "fBundleName: ")
  535. (dvc-run-dvc-async 'xhg (list "unbundle" (expand-file-name fname))
  536. :finished
  537. (dvc-capturing-lambda (output error status arguments)
  538. (if (y-or-n-p "Update now?")
  539. (xhg-update)
  540. (message "Don't forget to update!")))))
  541. ;;;###autoload
  542. (defun xhg-incoming (&optional src show-patch no-merges)
  543. "Run hg incoming."
  544. (interactive (list (let* ((completions (xhg-paths 'both))
  545. (initial-input (car (member "default" completions))))
  546. (dvc-completing-read
  547. "Show incoming from hg repository: "
  548. completions nil nil initial-input))
  549. nil ;; show-patch
  550. nil ;; no-merges
  551. ))
  552. (let ((window-conf (current-window-configuration))
  553. (buffer (dvc-get-buffer-create 'xhg 'log)))
  554. (dvc-switch-to-buffer-maybe buffer t)
  555. (let ((inhibit-read-only t))
  556. (erase-buffer))
  557. (xhg-log-mode)
  558. (dvc-run-dvc-async 'xhg (list "incoming" (when show-patch "--patch") (when no-merges "--no-merges") src)
  559. :finished
  560. (dvc-capturing-lambda (output error status arguments)
  561. (progn
  562. (with-current-buffer (capture buffer)
  563. (let ((inhibit-read-only t))
  564. (erase-buffer)
  565. (insert-buffer-substring output)
  566. (goto-char (point-min))
  567. (insert (format "hg incoming for %s\n\n" default-directory))
  568. (toggle-read-only 1)
  569. (xhg-log-next 1)))))
  570. :error
  571. (dvc-capturing-lambda (output error status arguments)
  572. (with-current-buffer output
  573. (goto-char (point-max))
  574. (forward-line -1)
  575. (if (looking-at "no changes found")
  576. (progn
  577. (message "No changes found")
  578. (set-window-configuration (capture window-conf)))
  579. (dvc-default-error-function output error status arguments)))))))
  580. ;;;###autoload
  581. (defun xhg-outgoing (&optional src show-patch no-merges)
  582. "Run hg outgoing."
  583. (interactive (list (let* ((completions (xhg-paths 'both))
  584. (initial-input (car (member "default" completions))))
  585. (dvc-completing-read
  586. "Show outgoing to hg repository: "
  587. completions nil nil initial-input))
  588. nil ;; show-patch
  589. nil ;; no-merges
  590. ))
  591. (let ((window-conf (current-window-configuration))
  592. (buffer (dvc-get-buffer-create 'xhg 'log)))
  593. (dvc-switch-to-buffer-maybe buffer t)
  594. (let ((inhibit-read-only t))
  595. (erase-buffer))
  596. (xhg-log-mode)
  597. (dvc-run-dvc-async 'xhg (list "outgoing" (when show-patch "--patch") (when no-merges "--no-merges") src)
  598. :finished
  599. (dvc-capturing-lambda (output error status arguments)
  600. (progn
  601. (with-current-buffer (capture buffer)
  602. (let ((inhibit-read-only t))
  603. (erase-buffer)
  604. (insert-buffer-substring output)
  605. (goto-char (point-min))
  606. (insert (format "hg outgoing for %s\n\n" default-directory))
  607. (toggle-read-only 1)))))
  608. :error
  609. (dvc-capturing-lambda (output error status arguments)
  610. (with-current-buffer output
  611. (goto-char (point-max))
  612. (forward-line -1)
  613. (if (looking-at "no changes found")
  614. (progn
  615. (message "No changes found")
  616. (set-window-configuration (capture window-conf)))
  617. (dvc-default-error-function output error status arguments)))))))
  618. (defun xhg-get-all-heads-list ()
  619. "Get a list of all heads available from the output of hg heads."
  620. (let ((rev-list (with-temp-buffer
  621. (apply #'call-process "hg" nil t nil
  622. '("heads"
  623. "--template"
  624. "#rev#\n"))
  625. (buffer-string))))
  626. (setq rev-list (cons "auto"
  627. (remove "" (split-string rev-list "\n"))))
  628. rev-list))
  629. (defun xhg-changep ()
  630. (let ((change (with-temp-buffer
  631. (apply #'call-process "hg" nil t nil
  632. '("diff"))
  633. (buffer-string))))
  634. (setq change (remove "" (split-string change "\n")))
  635. (if change
  636. t
  637. nil)))
  638. ;;;###autoload
  639. (defun xhg-strip (rev)
  640. "Run hg strip."
  641. (interactive (list (dvc-completing-read "Remove head: "
  642. (xhg-get-all-heads-list))))
  643. (dvc-run-dvc-sync 'xhg (list "strip" rev)))
  644. ;;;###autoload
  645. (defun xhg-merge ()
  646. "Run hg merge.
  647. To merge from specific revision, choose it in completion with tab.
  648. If `auto' is choose use default revision (last) unless there is ONLY
  649. one more head.
  650. See \(hg help merge.\)"
  651. (interactive)
  652. (let* ((haschange (xhg-changep))
  653. (collection (xhg-get-all-heads-list))
  654. (revision (dvc-completing-read "Merge from hg revision: "
  655. collection nil t))
  656. (arg))
  657. (when (or (string= revision "")
  658. (string= revision "auto"))
  659. (setq revision nil))
  660. (setq arg (if revision
  661. '("merge" "--rev")
  662. '("merge")))
  663. (cond ((and (> (length collection) 3)
  664. (not revision))
  665. (error "Abort: branch 'default' has more than 2 heads - please merge with an explicit rev."))
  666. ((equal revision (xhg-dry-tip))
  667. (error "Abort:can't merge with ancestor."))
  668. ((and (not haschange)
  669. (> (length collection) 2))
  670. (dvc-run-dvc-async 'xhg `(,@arg ,revision)
  671. :finished
  672. (dvc-capturing-lambda (output error status arguments)
  673. (message "hg %s %s %s finished => %s"
  674. (nth 0 arg)
  675. (if revision
  676. (nth 1 arg)
  677. "")
  678. (if revision
  679. revision
  680. "")
  681. (concat (dvc-buffer-content error)
  682. (dvc-buffer-content output))))
  683. :error
  684. ;; avoid dvc-error buffer to appear in ediff
  685. (lambda (output error status arguments)
  686. nil)))
  687. (haschange
  688. (error "abort: outstanding uncommitted merges, Please commit before merging"))
  689. ((< (length collection) 3)
  690. (error "There is nothing to merge here")))))
  691. ;;;###autoload
  692. (defun xhg-resolve (&optional file)
  693. "Run hg resolve --all or <spec file>.
  694. With current prefix arg, take a file as argument.
  695. You should run xhg-merge before this.
  696. This command will cleanly retry unresolved file merges
  697. using file revisions preserved from the last update or merge.
  698. If file is given resolve this file else resolve all files."
  699. (interactive)
  700. (let ((unresolved-files
  701. (loop for i in (xhg-resolve-list t)
  702. if (equal (car i) "U")
  703. collect (cadr i))))
  704. (when current-prefix-arg
  705. (setq file
  706. (file-name-nondirectory (read-file-name "File: "))))
  707. (if file
  708. (if (member file unresolved-files)
  709. (dvc-run-dvc-sync 'xhg (list "resolve" file)
  710. :finished
  711. (dvc-capturing-lambda (output error status arguments)
  712. (message "ok finished with status %s" status)
  713. (xhg-resolve-list)))
  714. (message "%s have been already resolved" file))
  715. (dvc-run-dvc-sync 'xhg (list "resolve" "--all")
  716. :finished
  717. (dvc-capturing-lambda (output error status arguments)
  718. (message "ok finished with status %s" status)
  719. (xhg-resolve-list))))))
  720. ;;;###autoload
  721. (defun xhg-resolve-list (&optional quiet)
  722. "Run hg resolve --list.
  723. Call interactively, show buffer with info.
  724. Non interactively, return an alist with
  725. string keys as:
  726. U = unresolved
  727. R = resolved"
  728. (interactive)
  729. (let ((resolve-alist nil))
  730. (if quiet
  731. (progn
  732. (save-window-excursion
  733. (dvc-run-dvc-display-as-info 'xhg (list "resolve" "--list"))
  734. (with-current-buffer "*xhg-info*"
  735. (setq resolve-alist
  736. (mapcar #'split-string
  737. (split-string (buffer-substring-no-properties
  738. (point-min)
  739. (point-max))
  740. "\n"))))
  741. (kill-buffer "*xhg-info*")
  742. resolve-alist))
  743. (dvc-run-dvc-display-as-info 'xhg (list "resolve" "--list")))))
  744. (defun xhg-command-version ()
  745. "Run hg version."
  746. (interactive)
  747. (let ((version (dvc-run-dvc-sync 'xhg '("version")
  748. :finished 'dvc-output-buffer-handler)))
  749. (when (interactive-p)
  750. (message "Mercurial version: %s" version))
  751. version))
  752. ;;;###autoload
  753. (defun xhg-branch (&optional new-name)
  754. "Run hg branch.
  755. When called with a prefix argument, ask for the new branch-name, otherwise
  756. display the current one."
  757. (interactive "P")
  758. (let ((branch (dvc-run-dvc-sync 'xhg (list "branch")
  759. :finished 'dvc-output-buffer-handler)))
  760. (if (not new-name)
  761. (progn
  762. (when (interactive-p)
  763. (message "xhg branch: %s" branch))
  764. branch)
  765. (when (interactive-p)
  766. (setq new-name (read-string (format "Change branch from '%s' to: " branch) nil nil branch)))
  767. (dvc-run-dvc-sync 'xhg (list "branch" new-name)))))
  768. ;;;###autoload
  769. (defun xhg-branches (&optional only-list)
  770. "run xhg-branches"
  771. (interactive)
  772. (dvc-run-dvc-display-as-info 'xhg '("branches"))
  773. (let ((branchs-list (with-current-buffer "*xhg-info*"
  774. (split-string (buffer-string) "\n"))))
  775. (when only-list
  776. (kill-buffer "*xhg-info*")
  777. (loop for i in branchs-list
  778. for e = (car (split-string i))
  779. when e
  780. collect e))))
  781. (defun xhg-branches-sans-current ()
  782. "Run xhg-branches but remove current branch."
  783. (save-window-excursion
  784. (let ((cur-branch (xhg-branch))
  785. (branches (xhg-branches t)))
  786. (remove cur-branch branches))))
  787. ;;;###autoload
  788. (defun xhg-merge-branch ()
  789. "Run hg merge <branch-name>.
  790. Usually merge the change made in dev branch in default branch."
  791. (interactive)
  792. (let* ((current-branch (xhg-branch))
  793. (branch (dvc-completing-read "BranchName: "
  794. (xhg-branches-sans-current))))
  795. (when (y-or-n-p (format "Really merge %s in %s" branch current-branch))
  796. (dvc-run-dvc-sync 'xhg (list "merge" branch)
  797. :finished
  798. (dvc-capturing-lambda (output error status arguments)
  799. (message "Updated! Don't forget to commit."))))))
  800. ;;todo: add support to specify a rev
  801. (defun xhg-manifest ()
  802. "Run hg manifest."
  803. (interactive)
  804. (let ((buffer (dvc-get-buffer-create 'xhg 'manifest)))
  805. (dvc-run-dvc-sync 'xhg '("manifest")
  806. :finished
  807. (dvc-capturing-lambda (output error status arguments)
  808. (progn
  809. (with-current-buffer (capture buffer)
  810. (let ((inhibit-read-only t))
  811. (erase-buffer)
  812. (insert-buffer-substring output)
  813. (toggle-read-only 1)))
  814. (dvc-switch-to-buffer (capture buffer)))))))
  815. ;;;###autoload
  816. (defun xhg-tip ()
  817. "Run hg tip."
  818. (interactive)
  819. (dvc-run-dvc-display-as-info 'xhg '("tip")))
  820. ;;;###autoload
  821. (defun xhg-heads ()
  822. "Run hg heads."
  823. (interactive)
  824. (dvc-run-dvc-display-as-info 'xhg '("heads")))
  825. ;;;###autoload
  826. (defun xhg-parents ()
  827. "Run hg parents."
  828. (interactive)
  829. (dvc-run-dvc-display-as-info 'xhg '("parents")))
  830. ;;;###autoload
  831. (defun xhg-identify ()
  832. "Run hg identify."
  833. (interactive)
  834. (let ((id))
  835. (dvc-run-dvc-sync 'xhg '("identify")
  836. :finished
  837. (lambda (output error status arguments)
  838. (set-buffer output)
  839. (goto-char (point-min))
  840. (setq id
  841. (buffer-substring-no-properties
  842. (point)
  843. (line-end-position))))
  844. :error
  845. (lambda (output error status arguments)
  846. (setq id "<unknown>")))
  847. (when (interactive-p)
  848. (message "hg identity for %s: %s" default-directory id))
  849. id))
  850. ;;;###autoload
  851. (defun xhg-verify ()
  852. "Run hg verify."
  853. (interactive)
  854. (dvc-run-dvc-display-as-info 'xhg '("verify")))
  855. ;;;###autoload
  856. (defun xhg-showconfig ()
  857. "Run hg showconfig."
  858. (interactive)
  859. (dvc-run-dvc-display-as-info 'xhg '("showconfig")))
  860. ;;;###autoload
  861. (defun xhg-paths (&optional type)
  862. "Run hg paths.
  863. When called interactive, display them in an *xhg-info* buffer.
  864. Otherwise the return value depends on TYPE:
  865. 'alias: Return only alias names
  866. 'path: Return only the paths
  867. 'both Return the aliases and the paths in a flat list
  868. otherwise: Return a list of two element sublists containing alias, path"
  869. (interactive)
  870. (if (interactive-p)
  871. (dvc-run-dvc-display-as-info 'xhg '("paths"))
  872. (let* ((path-list (dvc-run-dvc-sync 'xhg (list "paths")
  873. :finished 'dvc-output-buffer-split-handler))
  874. (lisp-path-list (mapcar '(lambda(arg) (dvc-split-string arg " = " arg)) path-list))
  875. (result-list))
  876. (cond ((eq type 'alias)
  877. (setq result-list (mapcar 'car lisp-path-list)))
  878. ((eq type 'path)
  879. (setq result-list (mapcar 'cadr lisp-path-list)))
  880. ((eq type 'both)
  881. (setq result-list (append (mapcar 'car lisp-path-list) (mapcar 'cadr lisp-path-list))))
  882. (t
  883. (setq result-list lisp-path-list))))))
  884. ;;;###autoload
  885. (defun xhg-tag (rev name)
  886. "Run hg tag -r <REV> NAME."
  887. (interactive (list (read-from-minibuffer "Revision: "
  888. nil nil nil nil
  889. (xhg-dry-tip))
  890. (read-string "TagName: ")))
  891. (dvc-run-dvc-sync 'xhg (list "tag" "-r" rev name)
  892. :finished (lambda (output error status arguments)
  893. (message "Ok revision %s tagged as %s"
  894. rev name))))
  895. ;;;###autoload
  896. (defun xhg-tags ()
  897. "Run hg tags."
  898. (interactive)
  899. (dvc-run-dvc-display-as-info 'xhg '("tags")))
  900. ;; hg annotate: add support to edit the parameters
  901. ;; -r --rev revision
  902. ;; -a --text treat all files as text
  903. ;; -u --user show user
  904. ;; -n --number show revision number
  905. ;; -c --changeset show changeset
  906. ;; (defun xhg-annotate ()
  907. ;; "Run hg annotate."
  908. ;; (interactive)
  909. ;; (dvc-run-dvc-display-as-info 'xhg (append '("annotate") (dvc-current-file-list))))
  910. ;;;###autoload
  911. (defun xhg-view ()
  912. "Run hg view."
  913. (interactive)
  914. (dvc-run-dvc-async 'xhg '("view")))
  915. ;;;###autoload
  916. (defun xhg-export (rev fname)
  917. "Run hg export.
  918. `xhg-export-git-style-patches' determines, if git style patches are created."
  919. (interactive (list (xhg-read-revision "Export revision: ")
  920. (read-file-name "Export hg revision to: ")))
  921. (dvc-run-dvc-sync 'xhg (list "export" (when xhg-export-git-style-patches "--git") "-o" (expand-file-name fname) rev)
  922. :finished
  923. (lambda (output error status arguments)
  924. (message "Exported revision %s to %s." rev fname))))
  925. ;;;###autoload
  926. (defun xhg-import (patch-file-name &optional force)
  927. "Run hg import."
  928. (interactive (list (read-file-name "Import hg patch: " nil nil t (when (eq major-mode 'dired-mode)
  929. (file-name-nondirectory (dired-get-filename))))))
  930. (dvc-run-dvc-sync 'xhg (delete nil (list "import" (when force "--force") (expand-file-name patch-file-name)))
  931. :finished
  932. (lambda (output error status arguments)
  933. (message "Imported hg patch from %s." patch-file-name))))
  934. ;;;###autoload
  935. (defun xhg-undo ()
  936. "Run hg undo."
  937. (interactive)
  938. (let ((undo-possible (file-exists-p (concat (xhg-tree-root) ".hg/undo"))))
  939. (if undo-possible
  940. (save-window-excursion
  941. (xhg-log "-1" nil t)
  942. (if (yes-or-no-p "Undo this transaction? ")
  943. (progn
  944. (dvc-run-dvc-sync 'xhg (list "undo")
  945. :finished
  946. (lambda (output error status arguments)
  947. (message "Finished xhg undo."))))
  948. (message "xhg undo aborted.")))
  949. (message "xhg: No undo information available."))))
  950. ;;;###autoload
  951. (defun xhg-update (&optional clean switch)
  952. "Run hg update.
  953. When called with one prefix-arg run hg update -C (clean).
  954. Called with two prefix-args run hg update -C <branch-name> (switch to branch)."
  955. (interactive)
  956. (let* ((opt-list (cond ((or clean
  957. (equal current-prefix-arg '(4)))
  958. (list "update" "-C"))
  959. ((or switch
  960. (equal current-prefix-arg '(16)))
  961. (list "update" "-C" (dvc-completing-read "BranchName: "
  962. (xhg-branches-sans-current))))
  963. (t
  964. (list "update"))))
  965. (opt-string (mapconcat 'identity opt-list " ")))
  966. (dvc-run-dvc-sync 'xhg opt-list
  967. :finished
  968. (lambda (output error status arguments)
  969. (dvc-default-finish-function output error status arguments)
  970. (message "hg %s complete for %s" opt-string default-directory)))))
  971. (defun xhg-convert (source target &optional revnum)
  972. "Convert a foreign SCM repository to a Mercurial one.
  973. With prefix arg prompt for REVNUM.
  974. Accepted source formats [identifiers]:(Mercurial-1.1.2)
  975. - Mercurial [hg]
  976. - CVS [cvs]
  977. - Darcs [darcs]
  978. - git [git]
  979. - Subversion [svn]
  980. - Monotone [mtn]
  981. - GNU Arch [gnuarch]
  982. - Bazaar [bzr]
  983. Be sure to add to your hgrc:
  984. \[extensions\]
  985. hgext.convert =
  986. Read also: hg help convert.
  987. "
  988. (interactive "DSource: \nsTarget: ")
  989. (let* ((src (expand-file-name source))
  990. (tget (expand-file-name target))
  991. (rev (if current-prefix-arg (read-string "Revision: ") revnum))
  992. (arg-list (if rev (list "convert" src tget "-r" rev) (list "convert" src tget))))
  993. (message "HG conversion of `%s' to `%s' ..." source target)
  994. (dvc-run-dvc-async 'xhg arg-list
  995. :finished (dvc-capturing-lambda (output error status arguments)
  996. (let ((default-directory (capture target)))
  997. (xhg-update))
  998. (message "HG conversion of `%s' to `%s' ... done."
  999. (capture source) (capture target))))))
  1000. ;; --------------------------------------------------------------------------------
  1001. ;; hg serve functionality
  1002. ;; --------------------------------------------------------------------------------
  1003. (defvar xhg-serve-parameter-list (make-hash-table :test 'equal)
  1004. "A hash table that holds the mapping from work directory roots to
  1005. extra parameters used for hg serve.
  1006. The extra parameters are given as alist. The following example shows the supported settings:
  1007. '((port 8235) (name \"my-project\"))")
  1008. ;;;###autoload
  1009. (defun xhg-serve-register-serve-parameter-list (working-copy-root parameter-list &optional start-server)
  1010. "Register a mapping from a work directory root to a parameter list for hg serve.
  1011. When START-SERVER is given, start the server immediately.
  1012. Example usage:
  1013. (xhg-serve-register-serve-parameter-list \"~/proj/simple-counter-1/\" '((port 8100) (name \"simple-counter\")))"
  1014. (puthash (dvc-uniquify-file-name working-copy-root) parameter-list xhg-serve-parameter-list)
  1015. (when start-server
  1016. (let ((default-directory (dvc-uniquify-file-name working-copy-root)))
  1017. (xhg-serve))))
  1018. (defun xhg-serve ()
  1019. "Run hg serve --daemon.
  1020. See `xhg-serve-register-serve-parameter-list' to register specific parameters for the server process."
  1021. (interactive)
  1022. (let* ((tree-root (dvc-tree-root))
  1023. (server-status-dir (concat tree-root ".xhg-serve/"))
  1024. (parameter-alist (gethash (dvc-uniquify-file-name tree-root) xhg-serve-parameter-list))
  1025. (port (or (cadr (assoc 'port parameter-alist)) 8000))
  1026. (name (cadr (assoc 'name parameter-alist)))
  1027. (errorlog (concat server-status-dir "error.log"))
  1028. (accesslog (concat server-status-dir "access.log"))
  1029. (pid-file (concat server-status-dir "server.pid")))
  1030. (when (numberp port)
  1031. (setq port (number-to-string port)))
  1032. (unless (file-directory-p server-status-dir)
  1033. (make-directory server-status-dir))
  1034. (dvc-run-dvc-sync 'xhg (list "serve" "--daemon" (when port "--port") port (when name "--name") name
  1035. "--pid-file" pid-file "--accesslog" accesslog "--errorlog" errorlog)
  1036. :finished (dvc-capturing-lambda (output error status arguments)
  1037. (message "hg server started for %s, using port %s" tree-root port)))))
  1038. (defun xhg-serve-kill ()
  1039. "Kill a hg serve process started with `xhg-serve'."
  1040. (interactive)
  1041. (let* ((tree-root (dvc-tree-root))
  1042. (server-status-dir (concat tree-root ".xhg-serve/"))
  1043. (pid-file (concat server-status-dir "server.pid"))
  1044. (pid)
  1045. (kill-status))
  1046. (if (file-readable-p pid-file)
  1047. (with-current-buffer
  1048. (find-file-noselect pid-file)
  1049. (setq pid (buffer-substring-no-properties (point-min) (- (point-max) 1)))
  1050. (kill-buffer (current-buffer)))
  1051. (message "no hg serve pid file found - aborting"))
  1052. (when pid
  1053. (setq kill-status (call-process "kill" nil nil nil pid))
  1054. (if (eq kill-status 0)
  1055. (progn
  1056. (delete-file pid-file)
  1057. (message "hg serve process killed."))
  1058. (message "kill hg serve process failed, return status: %d" kill-status)))))
  1059. ;; --------------------------------------------------------------------------------
  1060. ;; dvc revision support
  1061. ;; --------------------------------------------------------------------------------
  1062. ;;;###autoload
  1063. (defun xhg-revision-get-last-revision (file last-revision)
  1064. "Insert the content of FILE in LAST-REVISION, in current buffer.
  1065. LAST-REVISION looks like
  1066. \(\"path\" NUM)"
  1067. (dvc-trace "xhg-revision-get-last-revision file:%S last-revision:%S" file last-revision)
  1068. (let ((xhg-rev (int-to-string (nth 1 last-revision)))
  1069. (default-directory (car last-revision)))
  1070. ;; TODO: support the last-revision parameter??
  1071. (insert (dvc-run-dvc-sync
  1072. 'xhg (list "cat" file)
  1073. :finished 'dvc-output-buffer-handler-withnewline))))
  1074. ;;;###autoload
  1075. (defun xhg-revision-get-last-or-num-revision (infile outfile &optional revision)
  1076. "Run the command:
  1077. hg cat --rev <num revision> -o outputfile inputfile"
  1078. (interactive
  1079. (let* ((xhg-infile (read-file-name "InputFile: "))
  1080. (xhg-outfile (read-file-name "OutputFile: "))
  1081. (xhg-rev (if current-prefix-arg
  1082. (read-string "Revision: ")
  1083. "tip")))
  1084. (setq xhg-infile (expand-file-name xhg-infile)
  1085. xhg-outfile (concat (expand-file-name xhg-outfile)
  1086. "."
  1087. xhg-rev))
  1088. (list xhg-infile xhg-outfile xhg-rev)))
  1089. (dvc-run-dvc-sync 'xhg (list "cat"
  1090. "--rev"
  1091. revision
  1092. "-o"
  1093. outfile
  1094. infile)
  1095. :finished 'dvc-output-buffer-handler-withnewline)
  1096. (message "%s extracted in %s at revision %s"
  1097. (file-name-nondirectory infile)
  1098. (file-relative-name outfile)
  1099. revision))
  1100. ;;;###autoload
  1101. (defun xhg-ediff-file-at-rev (file rev1 rev2 &optional keep-variants)
  1102. "Ediff file at rev1 against rev2.
  1103. With prefix arg do not delete the files.
  1104. If rev1 or rev2 are empty, ediff current file against last revision.
  1105. Tip: to quit ediff, use C-u q to kill the ediffied buffers."
  1106. (interactive (list (read-file-name "File:" nil (dvc-get-file-info-at-point))
  1107. (read-from-minibuffer "Rev1: " nil nil nil nil (xhg-dry-tip))
  1108. (read-string "Rev2: ")))
  1109. (let* ((fname (expand-file-name file))
  1110. (bfname (file-name-nondirectory file))
  1111. (file1 (concat dvc-temp-directory "/" rev1 "-" bfname))
  1112. (file2 (concat dvc-temp-directory "/" rev2 "-" bfname))
  1113. (pref-arg (or keep-variants
  1114. current-prefix-arg)))
  1115. (if (or (equal "" rev1)
  1116. (equal "" rev2))
  1117. (dvc-file-ediff fname)
  1118. (unless (equal rev1 rev2)
  1119. (xhg-revision-get-last-or-num-revision fname file1 rev1)
  1120. (xhg-revision-get-last-or-num-revision fname file2 rev2)
  1121. (ediff-files file1 file2)
  1122. (unless pref-arg
  1123. (delete-file file1)
  1124. (delete-file file2))))))
  1125. ;; --------------------------------------------------------------------------------
  1126. ;; higher level commands
  1127. ;; --------------------------------------------------------------------------------
  1128. (defvar xhg-submit-patch-mapping nil)
  1129. ;;(add-to-list 'xhg-submit-patch-mapping '("~/data/wiki" ("joe@host.com" "my-wiki")))
  1130. (defun xhg-export-via-mail (rev)
  1131. (interactive (list (xhg-read-revision "Export revision: ")))
  1132. (let ((file-name)
  1133. (destination-email "")
  1134. (base-file-name nil)
  1135. (subject)
  1136. (description))
  1137. (dolist (m xhg-submit-patch-mapping)
  1138. (when (string= (dvc-uniquify-file-name (car m)) (dvc-uniquify-file-name (xhg-tree-root)))
  1139. ;;(message "%S" (cadr m))
  1140. (setq destination-email (car (cadr m)))
  1141. (setq base-file-name (cadr (cadr m)))))
  1142. (setq file-name (concat (dvc-uniquify-file-name dvc-temp-directory) (or base-file-name "") rev ".patch"))
  1143. (xhg-export rev file-name)
  1144. (setq description
  1145. (dvc-run-dvc-sync 'xhg (list "log" "-r" rev)
  1146. :finished 'dvc-output-buffer-handler))
  1147. (require 'reporter)
  1148. (delete-other-windows)
  1149. (reporter-submit-bug-report
  1150. destination-email
  1151. nil
  1152. nil
  1153. nil
  1154. nil
  1155. description)
  1156. (save-excursion
  1157. (re-search-backward "^summary: +\\(.+\\)")
  1158. (setq subject (match-string-no-properties 1)))
  1159. ;; delete emacs version - its not needed here
  1160. (delete-region (point) (point-max))
  1161. (mml-attach-file file-name "text/x-patch")
  1162. (goto-char (point-min))
  1163. (mail-position-on-field "Subject")
  1164. (insert (concat "[PATCH] " subject))))
  1165. ;; hg log -r $(hg identify)
  1166. ;; add one to that revision number -> actual-rev+1
  1167. ;; hg log -r actual-rev+1:tip, e.g. hg log -r 5:tip
  1168. ;;;###autoload
  1169. (defun xhg-missing-1 ()
  1170. "Shows the logs of the new arrived changesets after a pull and before an update."
  1171. (interactive)
  1172. (let ((id (split-string (xhg-identify)))
  1173. (last-log)
  1174. (actual-rev))
  1175. (if (= 2 (length id))
  1176. (message "Nothing missing, already at tip.")
  1177. (if (string= (car id) "unknown")

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