view contrib/mq.el @ 39515:93486cc46125

treemanifest: introduce lazy loading of subdirs An earlier patch series made it so that what to load was up to the calling code, which works fine until manifests are copied - when they're copied, they're loaded completely and thus we lose the entire benefit. By lazy loading everything, we can avoid having to pass in the matcher to ~every manifest function, and handle copies correctly as well. This changeset doesn't go as far as it could with loading only the necessary subsets, that will happen in later changes in this series; at the moment, except in a few situations, we just load everything the moment we want to interact with treemanifest._dirs. This is thus most likely to be a small slowdown if treemanifests is in use regardless of whether narrow is in use, but hopefully easier to verify correctness and review. This is part of a series of speedups, it is not expected to produce any real speed improvements itself, but the numbers show that it doesn't produce a large speed penalty in any common case, and for the cases it does provide a penalty in, it is not a large absolute amount (even if it is a large percentage amount). Timing numbers according to command: hyperfine --prepare <preparation_script> 'hg status' HGRCPATH points to a file with the following contents: [extensions] narrow = strip = rebase = mozilla-unified (called m-u below) was at revision #468856. regular hash: eb39298e432d treemanifests hash: 0553b7f29eaf large-dir-repo (called l-d-r below) was generated with the following script: #!/bin/bash hg init large-dir-repo mkdir -p large-dir-repo/third_party/rust/log touch large-dir-repo/third_party/rust/log/foo.txt for i in $(seq 1 30000); do d=$(mktemp -d large-dir-repo/third_party/XXXXXXXXX) touch $d/file.txt done hg -R large-dir-repo ci -Am 'rev0' --user test --date '0 0' echo hi > large-dir-repo/third_party/rust/log/bar.txt hg -R large-dir-repo ci -Am 'rev1' --user test --date '0 0' echo hi > large-dir-repo/third_party/rust/log/baz.txt hg -R large-dir-repo ci -Am 'rev2' --user test --date '0 0' for the repos that use narrow, the narrowspec was this: [include] rootfilesin:accessible/jsat rootfilesin:accessible/tests/mochitest/jsat rootfilesin:mobile/android/chrome/content rootfilesin:mobile/android/modules/geckoview rootfilesin:third_party/rust/log [exclude] This narrowspec was chosen due to the size of the third_party/rust directory (this directory was *not* modified in revision #468856 in mozilla-unified), plus all the directories that *were* modified in revision #468856 of mozilla-unified. Importantly, when using narrow, these repos had everything checked out (in the case of large-dir-repo, that means all 30,001 directories), *before* adding the narrowspec. This is to simulate the behavior when using a virtual filesystem that shows everything for the user even if they haven't added it to the narrowspec yet. This is not a supported configuration, and `hg update` and `hg rebase` will not really do the "correct" thing if there are mutations outside of the narrowspec (which is not the case in these tests, due to a carefully crafted narrowspec), but non-mutating commands should behave correctly. I'm not claiming anything less than a 5% speed win as improvements due to this change; these are probably eiter measurement artifacts or constant time improvements. The numbers that aren't changing are shown primarily to prove that this doesn't make anything worse in any case I plan on testing during this series. 'before' is hg from commit 6268fed3 'N' indicates narrow in use 'T' indicates treemanifest in use Please note that these commands and the narrowspec are a little different than the ones in a similar table that I made in a3cabe9415e1. Important: it is my understanding that these numbers below are *not super reliable*, the large slowdowns may be artifacts of some odd interaction between GC and python module/code complexity. Another changeset of mine (D4351) had shown large timing differences when ~empty, uncalled functions were added to match.py, though only when using --color=never or redirecting to /dev/null. We seem to be on some cusp of complexity or code size that is causing, at my best guess (according to linux `perf` benchmarks) GC to alter behavior and cause a 200-400ms difference in timings. I haven't had a chance to replicate these results on another machine. diff --git: repo | N | T | before (mean +- stdev) | after (mean +- stdev) | % of before ------+---+---+------------------------+-----------------------+------------ m-u | | | 1.580 s +- 0.034 s | 1.576 s +- 0.022 s | 99.7% m-u | | x | 1.568 s +- 0.025 s | 1.584 s +- 0.044 s | 101.0% m-u | x | | 1.569 s +- 0.031 s | 1.554 s +- 0.025 s | 99.0% m-u | x | x | 107.3 ms +- 1.6 ms | 106.3 ms +- 1.5 ms | 99.1% l-d-r | | | 232.5 ms +- 5.9 ms | 233.5 ms +- 5.3 ms | 100.4% l-d-r | | x | 236.6 ms +- 6.3 ms | 233.6 ms +- 7.0 ms | 98.7% l-d-r | x | | 118.4 ms +- 2.1 ms | 118.4 ms +- 1.4 ms | 100.0% l-d-r | x | x | 116.8 ms +- 1.5 ms | 118.9 ms +- 1.6 ms | 101.8% diff -c . --git: repo | N | T | before (mean +- stdev) | after (mean +- stdev) | % of before ------+---+---+------------------------+-----------------------+------------ m-u | | | 354.4 ms +- 16.6 ms | 351.0 ms +- 6.9 ms | 99.0% m-u | | x | 207.2 ms +- 3.0 ms | 206.2 ms +- 2.7 ms | 99.5% m-u | x | | 422.0 ms +- 26.0 ms | 351.2 ms +- 6.4 ms | 83.2% <-- m-u | x | x | 166.7 ms +- 2.1 ms | 169.5 ms +- 4.1 ms | 101.7% l-d-r | | | 98.4 ms +- 4.5 ms | 98.5 ms +- 2.1 ms | 100.1% l-d-r | | x | 5.519 s +- 0.060 s | 5.149 s +- 0.042 s | 93.3% <-- l-d-r | x | | 99.1 ms +- 3.2 ms | 102.6 ms +- 9.7 ms | 103.5% <--? l-d-r | x | x | 994.9 ms +- 10.7 ms | 1.026 s +- 0.012 s | 103.1% <--? rebase -r . --keep -d .^^: repo | N | T | before (mean +- stdev) | after (mean +- stdev) | % of before ------+---+---+------------------------+-----------------------+------------ m-u | | | 6.639 s +- 0.168 s | 6.559 s +- 0.097 s | 98.8% m-u | | x | 6.601 s +- 0.143 s | 6.640 s +- 0.207 s | 100.6% m-u | x | | 6.582 s +- 0.098 s | 6.543 s +- 0.098 s | 99.4% m-u | x | x | 678.4 ms +- 57.7 ms | 703.7 ms +- 52.4 ms | 103.7% <--? l-d-r | | | 780.0 ms +- 23.9 ms | 776.0 ms +- 12.6 ms | 99.5% l-d-r | | x | 7.520 s +- 0.255 s | 7.395 s +- 0.044 s | 98.3% l-d-r | x | | 331.9 ms +- 16.5 ms | 327.0 ms +- 3.4 ms | 98.5% l-d-r | x | x | 6.228 s +- 0.113 s | 5.924 s +- 0.044 s | 95.1% status --change . --copies: repo | N | T | before (mean +- stdev) | after (mean +- stdev) | % of before ------+---+---+------------------------+-----------------------+------------ m-u | | | 330.8 ms +- 7.2 ms | 329.0 ms +- 7.1 ms | 99.5% m-u | | x | 182.9 ms +- 2.7 ms | 183.5 ms +- 2.7 ms | 100.3% m-u | x | | 330.0 ms +- 7.6 ms | 327.1 ms +- 5.4 ms | 99.1% m-u | x | x | 146.2 ms +- 2.4 ms | 147.1 ms +- 1.3 ms | 100.6% l-d-r | | | 95.3 ms +- 1.4 ms | 95.9 ms +- 1.5 ms | 100.6% l-d-r | | x | 5.157 s +- 0.035 s | 5.166 s +- 0.058 s | 100.2% l-d-r | x | | 99.7 ms +- 3.0 ms | 100.2 ms +- 4.4 ms | 100.5% l-d-r | x | x | 993.6 ms +- 13.1 ms | 1.025 s +- 0.015 s | 103.2% <--? status --copies: repo | N | T | before (mean +- stdev) | after (mean +- stdev) | % of before ------+---+---+------------------------+-----------------------+------------ m-u | | | 2.348 s +- 0.031 s | 2.329 s +- 0.019 s | 99.2% m-u | | x | 2.337 s +- 0.026 s | 2.346 s +- 0.034 s | 100.4% m-u | x | | 2.354 s +- 0.015 s | 2.342 s +- 0.021 s | 99.5% m-u | x | x | 120.6 ms +- 4.3 ms | 119.2 ms +- 2.1 ms | 98.8% l-d-r | | | 731.5 ms +- 11.1 ms | 719.6 ms +- 9.8 ms | 98.4% l-d-r | | x | 729.0 ms +- 15.5 ms | 725.7 ms +- 10.6 ms | 99.5% l-d-r | x | | 211.0 ms +- 3.9 ms | 212.8 ms +- 3.7 ms | 100.9% l-d-r | x | x | 211.5 ms +- 4.2 ms | 211.0 ms +- 3.3 ms | 99.8% update $rev^; ~/src/hg/hg{hg}/hg update $rev: repo | N | T | before (mean +- stdev) | after (mean +- stdev) | % of before ------+---+---+------------------------+-----------------------+------------ m-u | | | 3.910 s +- 0.055 s | 3.920 s +- 0.075 s | 100.3% m-u | | x | 3.613 s +- 0.056 s | 3.630 s +- 0.056 s | 100.5% m-u | x | | 3.873 s +- 0.055 s | 3.864 s +- 0.049 s | 99.8% m-u | x | x | 400.4 ms +- 7.4 ms | 403.6 ms +- 5.0 ms | 100.8% l-d-r | | | 531.6 ms +- 10.0 ms | 528.8 ms +- 9.6 ms | 99.5% l-d-r | | x | 10.377 s +- 0.049 s | 9.955 s +- 0.046 s | 95.9% l-d-r | x | | 308.3 ms +- 4.4 ms | 306.8 ms +- 3.7 ms | 99.5% l-d-r | x | x | 1.805 s +- 0.015 s | 1.834 s +- 0.020 s | 101.6% Differential Revision: https://phab.mercurial-scm.org/D4366
author spectral <spectral@google.com>
date Thu, 16 Aug 2018 12:31:52 -0700
parents 7de7630053cb
children
line wrap: on
line source

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

;; Copyright (C) 2006 Bryan O'Sullivan

;; Author: Bryan O'Sullivan <bos@serpentine.com>

;; 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: