view contrib/mq.el @ 41773:37ead13fb3d4

rust-cpython: using rustext.dagop.headrevs in revlog

As with the previous oxidation series, revlog plays the role
of the factory, either using its parents function, or passing the
index.

We include below results of revsetbenchmarks.py taken on the
PyPy repository on those of contrib/all-revsets.tx that involve
`heads()`.

In most of the cases, this seems to be either neutral or an improvement.
In the cases where it's actually a bit slower, we suspect that differences
in `heads()` performance is actually burried in variance on the incoming
revset (probably several orders of magnitude slower).

The precheck for filtered revisions of parent changeset has a significative
performance benefit, too.

Result by revset
================

Revision:
0) 0c7b353ce100; rust-cpython: binding for headrevs()
1) Parent of this changeset; changelog: prefilter in headrevs()
2) This changeset


revset #0: heads(commonancestors(last(head(), 2)))
   plain         min           max           first         last          reverse       rev..rst      rev..ast      sort          sor..rst      sor..ast
0) 0.001379      0.001361      0.001381      0.001410      0.001393      0.001372      0.001414      0.001387      0.001411      0.001429      0.001415
1) 0.001351      0.001373      0.001383      0.001392      0.001401      0.001385      0.001405      0.001406      0.001385      0.001424      0.001399
2) 0.001365      0.001362      0.001375      0.001393      0.001370      0.001365      0.001413      0.001386      0.001377      0.001415      0.001411

revset #1: heads(commonancestors(head()))
   plain         min           max           first         last          reverse       rev..rst      rev..ast      sort          sor..rst      sor..ast
0) 0.047578      0.048578      0.047764      0.048065      0.047289      0.047305      0.047729      0.047370      0.047611      0.048005      0.047755
1) 0.048072      0.047471      0.048351      0.048193      0.048380      0.047968      0.047683      0.047355      0.048587      0.047044      0.048299
2) 0.047124      0.046699      0.046896      0.047250      0.046920      0.047379      0.046855      0.047753      0.047289      0.047219      0.046991

revset #2: heads(all())
   plain         min           max           first         last          reverse       rev..rst      rev..ast      sort          sor..rst      sor..ast
0) 0.037654      0.037814      0.037149      0.037457      0.037609      0.037053      0.036825      0.037054      0.037739      0.036816      0.037604
1) 0.021845  58% 0.022172  58% 0.022148  59% 0.022059  58% 0.022261  59% 0.022246  60% 0.021691  58% 0.021967  59% 0.022156  58% 0.021820  59% 0.023141  61%
2) 0.014459  66% 0.014470  65% 0.014420  65% 0.014413  65% 0.014421  64% 0.014492  65% 0.014512  66% 0.014579  66% 0.014500  65% 0.014501  66% 0.014537  62%

revset #3: heads(-10000:-1)
   plain         min           max           first         last          reverse       rev..rst      rev..ast      sort          sor..rst      sor..ast
0) 0.003696      0.003681      0.003719      0.003746      0.003725      0.003750      0.003692      0.003747      0.003712      0.003754      0.003763
1) 0.002131  57% 0.002142  58% 0.002147  57% 0.002203  58% 0.002143  57% 0.002208  58% 0.002158  58% 0.002182  58% 0.002169  58% 0.002209  58% 0.002201  58%
2) 0.001490  69% 0.001524  71% 0.001515  70% 0.001528  69% 0.001531  71% 0.001520  68% 0.001549  71% 0.001542  70% 0.001560  71% 0.001559  70% 0.001544  70%

revset #4: (-5000:-1000) and heads(-10000:-1)
   plain         min           max           first         last          reverse       rev..rst      rev..ast      sort          sor..rst      sor..ast
0) 0.003832      0.003816      0.003747      0.003814      0.003749      0.003894      0.003784      0.003796      0.003915      0.003829      0.003795
1) 0.002282  59% 0.002208  57% 0.002220  59% 0.002240  58% 0.002210  58% 0.002276  58% 0.002250  59% 0.002250  59% 0.002311  59% 0.002230  58% 0.002241  59%
2) 0.001658  72% 0.001662  75% 0.001568  70% 0.001599  71% 0.001588  71% 0.001696  74% 0.001615  71% 0.001593  70% 0.001710  73% 0.001622  72% 0.001616  72%

revset #5: heads(matching(tip, "author"))
   plain         min           max           first         last          reverse       rev..rst      rev..ast      sort          sor..rst      sor..ast
0) 7.826449      7.563260      7.581034      7.688493      7.634001      7.777860      7.768228      8.026097      7.767422      7.565254      7.938643
1) 7.750766      7.562555      7.660426      7.574089      7.492220      7.438582      7.562015      7.530635  93% 7.636343      7.636712      7.645113
2) 7.617941      7.519601      7.584922      7.507653      7.547440      7.524436      7.575291      7.883991      7.792142      7.709622      7.868595

revset #6: heads(matching(tip, "author")) and -10000:-1
   plain         min           max           first         last          reverse       rev..rst      rev..ast      sort          sor..rst      sor..ast
0) 7.744489      7.728684      7.734065      7.928513      7.875949      7.883727      7.815492      7.791335      7.784793      7.761218      7.815731
1) 7.808956      7.480446      7.618759      7.920270      7.676343      7.803613      7.770210      7.713100      7.584420      7.767335      7.825140
2) 7.519987      7.938748 106% 7.805328      7.694162      7.750129      7.714229      7.603825      7.580734      7.555291      7.524207      7.504580

revset #7: (-10000:-1) and heads(matching(tip, "author"))
   plain         min           max           first         last          reverse       rev..rst      rev..ast      sort          sor..rst      sor..ast
0) 7.909321      7.694357      7.666021      7.538686      7.771821      7.876217      7.852103      7.812727      7.545919      7.788860      7.764585
1) 7.749232      7.683715      7.968393      7.895257      7.764160      8.314884 105% 7.921697      7.882613      7.867209      7.684707      7.544501
2) 7.824903      7.784605      7.727846      7.566613      7.581994      7.539205  90% 7.555316      7.535572      7.581786      7.901795      7.662832

;;; mq.el --- Emacs support for Mercurial Queues

;; Copyright (C) 2006 Bryan O'Sullivan

;; Author: Bryan O'Sullivan <[e-mail]>

;; mq.el is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License version 2 or any
;; later version.

;; mq.el is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with mq.el, GNU Emacs, or XEmacs; see the file COPYING (`C-h
;; C-l').  If not, see <http://www.gnu.org/licenses/>.

(eval-when-compile (require 'cl))
(require 'mercurial)


(defcustom mq-mode-hook nil
  "Hook run when a buffer enters mq-mode."
  :type 'sexp
  :group 'mercurial)

(defcustom mq-global-prefix "\C-cq"
  "The global prefix for Mercurial Queues keymap bindings."
  :type 'sexp
  :group 'mercurial)

(defcustom mq-edit-mode-hook nil
  "Hook run after a buffer is populated to edit a patch description."
  :type 'sexp
  :group 'mercurial)

(defcustom mq-edit-finish-hook nil
  "Hook run before a patch description is finished up with."
  :type 'sexp
  :group 'mercurial)

(defcustom mq-signoff-address nil
  "Address with which to sign off on a patch."
  :type 'string
  :group 'mercurial)


;;; Internal variables.

(defvar mq-mode nil
  "Is this file managed by MQ?")
(make-variable-buffer-local 'mq-mode)
(put 'mq-mode 'permanent-local t)

(defvar mq-patch-history nil)

(defvar mq-top-patch '(nil))

(defvar mq-prev-buffer nil)
(make-variable-buffer-local 'mq-prev-buffer)
(put 'mq-prev-buffer 'permanent-local t)

(defvar mq-top nil)
(make-variable-buffer-local 'mq-top)
(put 'mq-top 'permanent-local t)

;;; Global keymap.

(defvar mq-global-map
  (let ((map (make-sparse-keymap)))
    (define-key map "." 'mq-push)
    (define-key map ">" 'mq-push-all)
    (define-key map "," 'mq-pop)
    (define-key map "<" 'mq-pop-all)
    (define-key map "=" 'mq-diff)
    (define-key map "r" 'mq-refresh)
    (define-key map "e" 'mq-refresh-edit)
    (define-key map "i" 'mq-new)
    (define-key map "n" 'mq-next)
    (define-key map "o" 'mq-signoff)
    (define-key map "p" 'mq-previous)
    (define-key map "s" 'mq-edit-series)
    (define-key map "t" 'mq-top)
    map))

(global-set-key mq-global-prefix mq-global-map)

(add-minor-mode 'mq-mode 'mq-mode)


;;; Refresh edit mode keymap.

(defvar mq-edit-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-c\C-c" 'mq-edit-finish)
    (define-key map "\C-c\C-k" 'mq-edit-kill)
    (define-key map "\C-c\C-s" 'mq-signoff)
    map))


;;; Helper functions.

(defun mq-read-patch-name (&optional source prompt force)
  "Read a patch name to use with a command.
May return nil, meaning \"use the default\"."
  (let ((patches (split-string
		  (hg-chomp (hg-run0 (or source "qseries"))) "\n")))
    (when force
      (completing-read (format "Patch%s: " (or prompt ""))
		       (mapcar (lambda (x) (cons x x)) patches)
		       nil
		       nil
		       nil
		       'mq-patch-history))))

(defun mq-refresh-buffers (root)
  (save-excursion
    (dolist (buf (hg-buffers-visiting-repo root))
      (when (not (verify-visited-file-modtime buf))
	(set-buffer buf)
	(let ((ctx (hg-buffer-context)))
	  (message "Refreshing %s..." (buffer-name))
	  (revert-buffer t t t)
	  (hg-restore-context ctx)
	  (message "Refreshing %s...done" (buffer-name))))))
  (hg-update-mode-lines root)
  (mq-update-mode-lines root))

(defun mq-last-line ()
  (goto-char (point-max))
  (beginning-of-line)
  (when (looking-at "^$")
    (forward-line -1))
  (let ((bol (point)))
    (end-of-line)
    (let ((line (buffer-substring bol (point))))
      (when (> (length line) 0)
	line))))

(defun mq-push (&optional patch)
  "Push patches until PATCH is reached.
If PATCH is nil, push at most one patch."
  (interactive (list (mq-read-patch-name "qunapplied" " to push"
					 current-prefix-arg)))
  (let ((root (hg-root))
	(prev-buf (current-buffer))
	last-line ok)
    (unless root
      (error "Cannot push outside a repository!"))
    (hg-sync-buffers root)
    (let ((buf-name (format "MQ: Push %s" (or patch "next patch"))))
      (kill-buffer (get-buffer-create buf-name))
      (split-window-vertically)
      (other-window 1)
      (switch-to-buffer (get-buffer-create buf-name))
      (cd root)
      (message "Pushing...")
      (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpush"
			   (if patch (list patch))))
	    last-line (mq-last-line))
      (let ((lines (count-lines (point-min) (point-max))))
	(if (or (<= lines 1)
		(and (equal lines 2) (string-match "Now at:" last-line)))
	    (progn
	      (kill-buffer (current-buffer))
	      (delete-window))
	  (hg-view-mode prev-buf))))
    (mq-refresh-buffers root)
    (sit-for 0)
    (when last-line
      (if ok
	  (message "Pushing... %s" last-line)
	(error "Pushing... %s" last-line)))))

(defun mq-push-all ()
  "Push patches until all are applied."
  (interactive)
  (mq-push "-a"))

(defun mq-pop (&optional patch)
  "Pop patches until PATCH is reached.
If PATCH is nil, pop at most one patch."
  (interactive (list (mq-read-patch-name "qapplied" " to pop to"
					 current-prefix-arg)))
  (let ((root (hg-root))
	last-line ok)
    (unless root
      (error "Cannot pop outside a repository!"))
    (hg-sync-buffers root)
    (set-buffer (generate-new-buffer "qpop"))
    (cd root)
    (message "Popping...")
    (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpop"
			 (if patch (list patch))))
	  last-line (mq-last-line))
    (kill-buffer (current-buffer))
    (mq-refresh-buffers root)
    (sit-for 0)
    (when last-line
      (if ok
	  (message "Popping... %s" last-line)
	(error "Popping... %s" last-line)))))

(defun mq-pop-all ()
  "Push patches until none are applied."
  (interactive)
  (mq-pop "-a"))

(defun mq-refresh-internal (root &rest args)
  (hg-sync-buffers root)
  (let ((patch (mq-patch-info "qtop")))
    (message "Refreshing %s..." patch)
    (let ((ret (apply 'hg-run "qrefresh" args)))
      (if (equal (car ret) 0)
	  (message "Refreshing %s... done." patch)
	(error "Refreshing %s... %s" patch (hg-chomp (cdr ret)))))))

(defun mq-refresh (&optional git)
  "Refresh the topmost applied patch.
With a prefix argument, generate a git-compatible patch."
  (interactive "P")
  (let ((root (hg-root)))
    (unless root
      (error "Cannot refresh outside of a repository!"))
    (apply 'mq-refresh-internal root (if git '("--git")))))

(defun mq-patch-info (cmd &optional msg)
  (let* ((ret (hg-run cmd))
	 (info (hg-chomp (cdr ret))))
    (if (equal (car ret) 0)
	(if msg
	    (message "%s patch: %s" msg info)
	  info)
      (error "%s" info))))

(defun mq-top ()
  "Print the name of the topmost applied patch."
  (interactive)
  (mq-patch-info "qtop" "Top"))

(defun mq-next ()
  "Print the name of the next patch to be pushed."
  (interactive)
  (mq-patch-info "qnext" "Next"))

(defun mq-previous ()
  "Print the name of the first patch below the topmost applied patch.
This would become the active patch if popped to."
  (interactive)
  (mq-patch-info "qprev" "Previous"))

(defun mq-edit-finish ()
  "Finish editing the description of this patch, and refresh the patch."
  (interactive)
  (unless (equal (mq-patch-info "qtop") mq-top)
    (error "Topmost patch has changed!"))
  (hg-sync-buffers hg-root)
  (run-hooks 'mq-edit-finish-hook)
  (mq-refresh-internal hg-root "-m" (buffer-substring (point-min) (point-max)))
  (let ((buf mq-prev-buffer))
    (kill-buffer nil)
    (switch-to-buffer buf)))

(defun mq-edit-kill ()
  "Kill the edit currently being prepared."
  (interactive)
  (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this edit? "))
    (let ((buf mq-prev-buffer))
      (kill-buffer nil)
      (switch-to-buffer buf))))

(defun mq-get-top (root)
  (let ((entry (assoc root mq-top-patch)))
    (if entry
        (cdr entry))))

(defun mq-set-top (root patch)
  (let ((entry (assoc root mq-top-patch)))
    (if entry
        (if patch
            (setcdr entry patch)
          (setq mq-top-patch (delq entry mq-top-patch)))
      (setq mq-top-patch (cons (cons root patch) mq-top-patch)))))

(defun mq-update-mode-lines (root)
  (let ((cwd default-directory))
    (cd root)
    (condition-case nil
        (mq-set-top root (mq-patch-info "qtop"))
      (error (mq-set-top root nil)))
    (cd cwd))
  (let ((patch (mq-get-top root)))
    (save-excursion
      (dolist (buf (hg-buffers-visiting-repo root))
        (set-buffer buf)
        (if mq-mode
            (setq mq-mode (or (and patch (concat " MQ:" patch)) " MQ")))))))
	
(defun mq-mode (&optional arg)
  "Minor mode for Mercurial repositories with an MQ patch queue"
  (interactive "i")
  (cond ((hg-root)
         (setq mq-mode (if (null arg) (not mq-mode)
                         arg))
         (mq-update-mode-lines (hg-root))))
  (run-hooks 'mq-mode-hook))

(defun mq-edit-mode ()
  "Mode for editing the description of a patch.

Key bindings
------------
\\[mq-edit-finish]	use this description
\\[mq-edit-kill]	abandon this description"
  (interactive)
  (use-local-map mq-edit-mode-map)
  (set-syntax-table text-mode-syntax-table)
  (setq local-abbrev-table text-mode-abbrev-table
	major-mode 'mq-edit-mode
	mode-name "MQ-Edit")
  (set-buffer-modified-p nil)
  (setq buffer-undo-list nil)
  (run-hooks 'text-mode-hook 'mq-edit-mode-hook))

(defun mq-refresh-edit ()
  "Refresh the topmost applied patch, editing the patch description."
  (interactive)
  (while mq-prev-buffer
    (set-buffer mq-prev-buffer))
  (let ((root (hg-root))
	(prev-buffer (current-buffer))
	(patch (mq-patch-info "qtop")))
    (hg-sync-buffers root)
    (let ((buf-name (format "*MQ: Edit description of %s*" patch)))
      (switch-to-buffer (get-buffer-create buf-name))
      (when (= (point-min) (point-max))
	(set (make-local-variable 'hg-root) root)
	(set (make-local-variable 'mq-top) patch)
	(setq mq-prev-buffer prev-buffer)
	(insert (hg-run0 "qheader"))
	(goto-char (point-min)))
      (mq-edit-mode)
      (cd root)))
  (message "Type `C-c C-c' to finish editing and refresh the patch."))

(defun mq-new (name)
  "Create a new empty patch named NAME.
The patch is applied on top of the current topmost patch.
With a prefix argument, forcibly create the patch even if the working
directory is modified."
  (interactive (list (mq-read-patch-name "qseries" " to create" t)))
  (message "Creating patch...")
  (let ((ret (if current-prefix-arg
		 (hg-run "qnew" "-f" name)
	       (hg-run "qnew" name))))
    (if (equal (car ret) 0)
	(progn
	  (hg-update-mode-lines (buffer-file-name))
	  (message "Creating patch... done."))
      (error "Creating patch... %s" (hg-chomp (cdr ret))))))

(defun mq-edit-series ()
  "Edit the MQ series file directly."
  (interactive)
  (let ((root (hg-root)))
    (unless root
      (error "Not in an MQ repository!"))
    (find-file (concat root ".hg/patches/series"))))

(defun mq-diff (&optional git)
  "Display a diff of the topmost applied patch.
With a prefix argument, display a git-compatible diff."
  (interactive "P")
  (hg-view-output ((format "MQ: Diff of %s" (mq-patch-info "qtop")))
    (if git
	(call-process (hg-binary) nil t nil "qdiff" "--git")
    (call-process (hg-binary) nil t nil "qdiff"))
    (diff-mode)
    (font-lock-fontify-buffer)))

(defun mq-signoff ()
  "Sign off on the current patch, in the style used by the Linux kernel.
If the variable mq-signoff-address is non-nil, it will be used, otherwise
the value of the ui.username item from your hgrc will be used."
  (interactive)
  (let ((was-editing (eq major-mode 'mq-edit-mode))
	signed)
    (unless was-editing
      (mq-refresh-edit))
    (save-excursion
      (let* ((user (or mq-signoff-address
		       (hg-run0 "debugconfig" "ui.username")))
	     (signoff (concat "Signed-off-by: " user)))
	(if (search-forward signoff nil t)
	    (message "You have already signed off on this patch.")
	  (goto-char (point-max))
	  (let ((case-fold-search t))
	    (if (re-search-backward "^Signed-off-by: " nil t)
		(forward-line 1)
	      (insert "\n")))
	  (insert signoff)
	  (message "%s" signoff)
	  (setq signed t))))
    (unless was-editing
      (if signed
	  (mq-edit-finish)
	(mq-edit-kill)))))


(provide 'mq)


;;; Local Variables:
;;; prompt-to-byte-compile: nil
;;; end: