;;; anything-mercurial.el --- ;; ;; Copyright (C) 2008, 2009 Thierry Volpiatto, all rights reserved ;; ;; Filename: anything-mercurial.el ;; Description: ;; Author: thierry ;; Maintainer: ;; URL: ;; Keywords: ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation; either version 3, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth ;; Floor, Boston, MA 02110-1301, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: ;; This file provide two sources for that provide support ;; for hg qpatchs within `anything'. ;; `anything-c-source-qapplied-patchs' and ;; `anything-c-source-qunapplied-patchs'. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Code: ;; Internal use only! (defvar anything-qapplied-alist nil) (defvar anything-c-qpatch-directory nil) (defvar anything-c-qunpatch-directory nil) (defvar anything-c-qapplied-show-headers t) ;; User variables (defvar anything-hg-default-export-fname ".hg-anything-export" "*You can put in this file the path of your usual dir to export patchs.") ;; Clean up (add-hook 'anything-before-initialize-hook #'(lambda () (setq anything-c-qunpatch-directory nil))) (add-hook 'anything-before-initialize-hook #'(lambda () (setq anything-qapplied-alist nil))) (add-hook 'anything-before-initialize-hook #'(lambda () (setq anything-c-qpatch-directory nil))) ;;; Applied patchs (defun anything-hg-init-applied () (condition-case nil (setq anything-c-qpatch-directory (xhg-tree-root (expand-file-name (if (eq major-mode 'dired-mode) (dired-current-directory) default-directory)))) (error nil))) (defun anything-hg-applied-candidates () (condition-case nil (let ((applied-patchs (with-temp-buffer (apply #'call-process "hg" nil t nil (if anything-c-qapplied-show-headers `("qapplied" "-s" "-R" ,anything-c-qpatch-directory) `("qapplied" "-R" ,anything-c-qpatch-directory))) (buffer-string))) (top (with-temp-buffer (apply #'call-process "hg" nil t nil `("tip" "--template" "{rev}" "-R" ,anything-c-qpatch-directory)) (buffer-string)))) (setq top (string-to-number top)) (setq applied-patchs (remove "" (split-string applied-patchs "\n"))) (setq anything-qapplied-alist (loop for i in (reverse applied-patchs) collect (list i top) and do (incf top -1))) (unless (or (string-match "abort:" (car applied-patchs)) (zerop (length applied-patchs))) (setq applied-patchs (reverse applied-patchs)))) (error nil))) (defun anything-hg-applied-persistent-action (elm) (let ((default-directory anything-c-qpatch-directory)) (xhg-qpop) (anything-delete-current-selection))) (defun anything-hg-applied-show-patch (elm) (let ((default-directory anything-c-qpatch-directory)) (xhg-log (cadr (assoc elm anything-qapplied-alist)) nil t))) (defun anything-hg-applied-refresh (elm) (let ((default-directory anything-c-qpatch-directory)) (xhg-qrefresh))) (defun anything-hg-applied-rename-header (elm) (let ((default-directory anything-c-qpatch-directory)) (xhg-qrefresh-header) (save-window-excursion (when (get-buffer "*xhg-log*") (kill-buffer "*xhg-log*")) (xhg-log (cadr (assoc elm anything-qapplied-alist)) nil t)) (save-excursion (display-buffer "*xhg-log*")))) (defun anything-hg-applied-qnew (elm) (let ((default-directory anything-c-qpatch-directory)) (xhg-qnew (xhg-qnew-name-patch) "New patch"))) (defun anything-hg-applied-export (elm) (let* ((default-directory anything-c-qpatch-directory) (abs-export-fname (expand-file-name anything-hg-default-export-fname anything-c-qpatch-directory)) (export-dir-name (if (file-exists-p abs-export-fname) (with-temp-buffer (insert-file-contents abs-export-fname) (replace-regexp-in-string "\n" "" (buffer-string))) anything-c-qpatch-directory))) (xhg-export (int-to-string (cadr (assoc elm anything-qapplied-alist))) (read-from-minibuffer "Destination: " nil nil nil nil (expand-file-name (if (string-match "^patch-r[0-9]+" elm) (match-string 0 elm) "Initial-patch") export-dir-name))))) (defun anything-hg-applied-export-via-mail (elm) (let ((default-directory anything-c-qpatch-directory)) (xhg-export-via-mail (int-to-string (cadr (assoc elm anything-qapplied-alist)))))) (defun anything-hg-applied-apply-all-patchs (elm) (let ((default-directory anything-c-qpatch-directory)) (xhg-qconvert-to-permanent))) (defun anything-hg-applied-uniquify (elm) (let ((default-directory anything-c-qpatch-directory) (patch-name (if (string-match "^patch-r[0-9]+" elm) (match-string 0 elm) "Initial-patch"))) (xhg-qsingle (concat anything-c-qpatch-directory "Single" patch-name "ToTip.patch") patch-name))) (defun anything-hg-applied-export-single-via-mail (elm) (let ((patch-name (if (string-match "^patch-r[0-9]+" elm) (match-string 0 elm) "Initial-patch")) (default-directory anything-c-qpatch-directory)) (xhg-mq-export-via-mail patch-name t))) (defun anything-hg-applied-qpop (elm) (let ((default-directory anything-c-qpatch-directory)) (xhg-qpop))) (defun anything-hg-applied-qpop-all (elm) (let ((default-directory anything-c-qpatch-directory)) (xhg-qpop t))) (defvar anything-c-source-qapplied-patchs '((name . "Hg Qapplied Patchs") (volatile) (init . anything-hg-init-applied) (candidates . anything-hg-applied-candidates) (persistent-action . anything-hg-applied-persistent-action) (action . (("Show Patch" . anything-hg-applied-show-patch) ("Hg Qrefresh" . anything-hg-applied-refresh) ("Rename Header" . anything-hg-applied-rename-header) ("Hg Qnew" . anything-hg-applied-qnew) ("Export" . anything-hg-applied-export) ("Export via Mail" . anything-hg-applied-export-via-mail) ("Apply all patchs" . anything-hg-applied-apply-all-patchs) ("Uniquify all patchs from rev" . anything-hg-applied-uniquify) ("Export Single Patch via mail" . anything-hg-applied-export-single-via-mail) ("Hg-Qpop (top of stack)" . anything-hg-applied-qpop) ("Hg-Qpop-All" . anything-hg-applied-qpop-all))))) ;; (anything 'anything-c-source-qapplied-patchs) ;;; Unapplied patchs (defun anything-c-qunapplied-delete (elm) (if anything-c-qunapplied-show-headers (progn (string-match "^patch-r[0-9]+" elm) (xhg-qdelete (match-string 0 elm))) (xhg-qdelete elm))) (defun anything-hg-unapplied-init () (condition-case nil (setq anything-c-qunpatch-directory (xhg-tree-root (expand-file-name (if (eq major-mode 'dired-mode) (dired-current-directory) default-directory)))) (error nil))) (defun anything-hg-unapplied-candidates () (condition-case nil (let ((unapplied-patchs (with-temp-buffer (apply #'call-process "hg" nil t nil (if anything-c-qunapplied-show-headers `("qunapplied" "-s" "-R" ,anything-c-qunpatch-directory) `("qunapplied" "-R" ,anything-c-qunpatch-directory))) (buffer-string)))) (setq unapplied-patchs (split-string unapplied-patchs "\n")) (unless (or (string-match "abort:" (car unapplied-patchs)) (zerop (length unapplied-patchs))) unapplied-patchs)) (error nil))) (defun anything-hg-unapplied-persistent-action (elm) (let ((default-directory anything-c-qpatch-directory)) (xhg-qpush) (anything-delete-current-selection))) (defun anything-hg-unapplied-push (elm) (let ((default-directory anything-c-qpatch-directory)) (xhg-qpush))) (defun anything-hg-unapplied-push-all (elm) (let ((default-directory anything-c-qpatch-directory)) (xhg-qpush t))) (defun anything-hg-unapplied-delete (elm) (let ((default-directory anything-c-qpatch-directory)) (dolist (i (anything-marked-candidates)) (anything-c-qunapplied-delete i)))) (defvar anything-c-qunapplied-show-headers nil) (defvar anything-c-source-qunapplied-patchs '((name . "Hg Qunapplied Patchs") (volatile) (init . anything-hg-unapplied-init) (candidates . anything-hg-unapplied-candidates) (persistent-action . anything-hg-unapplied-persistent-action) (action . (("hg-qpush" . anything-hg-unapplied-push) ("hg-qpush-all" . anything-hg-unapplied-push-all) ("hg-qdelete patch(s)" . anything-hg-unapplied-delete))))) ;; (anything 'anything-c-source-qunapplied-patchs) (provide 'anything-mercurial) ;;; anything-mercurial.el ends here