1.1--- a/.config/containers/storage.conf Sat Jun 15 19:53:29 2024 -0400
1.2+++ b/.config/containers/storage.conf Sat Jun 15 19:57:38 2024 -0400
1.3@@ -1,5 +1,5 @@
1.4 [storage]
1.5 driver = "btrfs"
1.6-graphroot = "/mnt/y/data/containers/storage"
1.7+# graphroot = "/mnt/y/data/containers/storage"
1.8 [storage.options]
1.9 pull_options = {enable_partial_images = "true", use_hard_links = "false", ostree_repos=""}
1.10\ No newline at end of file
2.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
2.2+++ b/.emacs.d/lib/mercurial.el Sat Jun 15 19:57:38 2024 -0400
2.3@@ -0,0 +1,1293 @@
2.4+;;; mercurial.el --- Emacs support for the Mercurial distributed SCM
2.5+
2.6+;; Copyright (C) 2005, 2006 Bryan O'Sullivan
2.7+
2.8+;; Author: Bryan O'Sullivan <bos@serpentine.com>
2.9+
2.10+;; mercurial.el is free software; you can redistribute it and/or
2.11+;; modify it under the terms of the GNU General Public License version
2.12+;; 2 or any later version.
2.13+
2.14+;; mercurial.el is distributed in the hope that it will be useful, but
2.15+;; WITHOUT ANY WARRANTY; without even the implied warranty of
2.16+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
2.17+;; General Public License for more details.
2.18+
2.19+;; You should have received a copy of the GNU General Public License
2.20+;; along with mercurial.el, GNU Emacs, or XEmacs; see the file COPYING
2.21+;; (`C-h C-l'). If not, see <http://www.gnu.org/licenses/>.
2.22+
2.23+;;; Commentary:
2.24+
2.25+;; mercurial.el builds upon Emacs's VC mode to provide flexible
2.26+;; integration with the Mercurial distributed SCM tool.
2.27+
2.28+;; To get going as quickly as possible, load mercurial.el into Emacs and
2.29+;; type `C-c h h'; this runs hg-help-overview, which prints a helpful
2.30+;; usage overview.
2.31+
2.32+;; Much of the inspiration for mercurial.el comes from Rajesh
2.33+;; Vaidheeswarran's excellent p4.el, which does an admirably thorough
2.34+;; job for the commercial Perforce SCM product. In fact, substantial
2.35+;; chunks of code are adapted from p4.el.
2.36+
2.37+;; This code has been developed under XEmacs 21.5, and may not work as
2.38+;; well under GNU Emacs (albeit tested under 21.4). Patches to
2.39+;; enhance the portability of this code, fix bugs, and add features
2.40+;; are most welcome.
2.41+
2.42+;; As of version 22.3, GNU Emacs's VC mode has direct support for
2.43+;; Mercurial, so this package may not prove as useful there.
2.44+
2.45+;; Please send problem reports and suggestions to bos@serpentine.com.
2.46+
2.47+
2.48+;;; Code:
2.49+
2.50+(eval-when-compile (require 'cl))
2.51+(require 'diff-mode)
2.52+(require 'easymenu)
2.53+(require 'executable)
2.54+(require 'vc)
2.55+
2.56+(defmacro hg-feature-cond (&rest clauses)
2.57+ "Test CLAUSES for feature at compile time.
2.58+Each clause is (FEATURE BODY...)."
2.59+ (dolist (x clauses)
2.60+ (let ((feature (car x))
2.61+ (body (cdr x)))
2.62+ (when (or (eq feature t)
2.63+ (featurep feature))
2.64+ (return (cons 'progn body))))))
2.65+
2.66+
2.67+;;; XEmacs has view-less, while GNU Emacs has view. Joy.
2.68+
2.69+(hg-feature-cond
2.70+ (xemacs (require 'view-less))
2.71+ (t (require 'view)))
2.72+
2.73+
2.74+;;; Variables accessible through the custom system.
2.75+
2.76+(defgroup mercurial nil
2.77+ "Mercurial distributed SCM."
2.78+ :group 'tools)
2.79+
2.80+(defcustom hg-binary
2.81+ (or (executable-find "hg")
2.82+ (dolist (path '("~/bin/hg" "/usr/bin/hg" "/usr/local/bin/hg"))
2.83+ (when (file-executable-p path)
2.84+ (return path))))
2.85+ "The path to Mercurial's hg executable."
2.86+ :type '(file :must-match t)
2.87+ :group 'mercurial)
2.88+
2.89+(defcustom hg-mode-hook nil
2.90+ "Hook run when a buffer enters hg-mode."
2.91+ :type 'sexp
2.92+ :group 'mercurial)
2.93+
2.94+(defcustom hg-commit-mode-hook nil
2.95+ "Hook run when a buffer is created to prepare a commit."
2.96+ :type 'sexp
2.97+ :group 'mercurial)
2.98+
2.99+(defcustom hg-pre-commit-hook nil
2.100+ "Hook run before a commit is performed.
2.101+If you want to prevent the commit from proceeding, raise an error."
2.102+ :type 'sexp
2.103+ :group 'mercurial)
2.104+
2.105+(defcustom hg-log-mode-hook nil
2.106+ "Hook run after a buffer is filled with log information."
2.107+ :type 'sexp
2.108+ :group 'mercurial)
2.109+
2.110+(defcustom hg-global-prefix "\C-ch"
2.111+ "The global prefix for Mercurial keymap bindings."
2.112+ :type 'sexp
2.113+ :group 'mercurial)
2.114+
2.115+(defcustom hg-commit-allow-empty-message nil
2.116+ "Whether to allow changes to be committed with empty descriptions."
2.117+ :type 'boolean
2.118+ :group 'mercurial)
2.119+
2.120+(defcustom hg-commit-allow-empty-file-list nil
2.121+ "Whether to allow changes to be committed without any modified files."
2.122+ :type 'boolean
2.123+ :group 'mercurial)
2.124+
2.125+(defcustom hg-rev-completion-limit 100
2.126+ "The maximum number of revisions that hg-read-rev will offer to complete.
2.127+This affects memory usage and performance when prompting for revisions
2.128+in a repository with a lot of history."
2.129+ :type 'integer
2.130+ :group 'mercurial)
2.131+
2.132+(defcustom hg-log-limit 50
2.133+ "The maximum number of revisions that hg-log will display."
2.134+ :type 'integer
2.135+ :group 'mercurial)
2.136+
2.137+(defcustom hg-update-modeline t
2.138+ "Whether to update the modeline with the status of a file after every save.
2.139+Set this to nil on platforms with poor process management, such as Windows."
2.140+ :type 'boolean
2.141+ :group 'mercurial)
2.142+
2.143+(defcustom hg-incoming-repository "default"
2.144+ "The repository from which changes are pulled from by default.
2.145+This should be a symbolic repository name, since it is used for all
2.146+repository-related commands."
2.147+ :type 'string
2.148+ :group 'mercurial)
2.149+
2.150+(defcustom hg-outgoing-repository ""
2.151+ "The repository to which changes are pushed to by default.
2.152+This should be a symbolic repository name, since it is used for all
2.153+repository-related commands."
2.154+ :type 'string
2.155+ :group 'mercurial)
2.156+
2.157+
2.158+;;; Other variables.
2.159+
2.160+(defvar hg-mode nil
2.161+ "Is this file managed by Mercurial?")
2.162+(make-variable-buffer-local 'hg-mode)
2.163+(put 'hg-mode 'permanent-local t)
2.164+
2.165+(defvar hg-status nil)
2.166+(make-variable-buffer-local 'hg-status)
2.167+(put 'hg-status 'permanent-local t)
2.168+
2.169+(defvar hg-prev-buffer nil)
2.170+(make-variable-buffer-local 'hg-prev-buffer)
2.171+(put 'hg-prev-buffer 'permanent-local t)
2.172+
2.173+(defvar hg-root nil)
2.174+(make-variable-buffer-local 'hg-root)
2.175+(put 'hg-root 'permanent-local t)
2.176+
2.177+(defvar hg-view-mode nil)
2.178+(make-variable-buffer-local 'hg-view-mode)
2.179+(put 'hg-view-mode 'permanent-local t)
2.180+
2.181+(defvar hg-view-file-name nil)
2.182+(make-variable-buffer-local 'hg-view-file-name)
2.183+(put 'hg-view-file-name 'permanent-local t)
2.184+
2.185+(defvar hg-output-buffer-name "*Hg*"
2.186+ "The name to use for Mercurial output buffers.")
2.187+
2.188+(defvar hg-file-history nil)
2.189+(defvar hg-repo-history nil)
2.190+(defvar hg-rev-history nil)
2.191+(defvar hg-repo-completion-table nil) ; shut up warnings
2.192+
2.193+
2.194+;;; Random constants.
2.195+
2.196+(defconst hg-commit-message-start
2.197+ "--- Enter your commit message. Type `C-c C-c' to commit. ---\n")
2.198+
2.199+(defconst hg-commit-message-end
2.200+ "--- Files in bold will be committed. Click to toggle selection. ---\n")
2.201+
2.202+(defconst hg-state-alist
2.203+ '((?M . modified)
2.204+ (?A . added)
2.205+ (?R . removed)
2.206+ (?! . deleted)
2.207+ (?C . normal)
2.208+ (?I . ignored)
2.209+ (?? . nil)))
2.210+
2.211+;;; hg-mode keymap.
2.212+
2.213+(defvar hg-prefix-map
2.214+ (let ((map (make-sparse-keymap)))
2.215+ (hg-feature-cond (xemacs (set-keymap-name map 'hg-prefix-map))) ; XEmacs
2.216+ (set-keymap-parent map vc-prefix-map)
2.217+ (define-key map "=" 'hg-diff)
2.218+ (define-key map "c" 'hg-undo)
2.219+ (define-key map "g" 'hg-annotate)
2.220+ (define-key map "i" 'hg-add)
2.221+ (define-key map "l" 'hg-log)
2.222+ (define-key map "n" 'hg-commit-start)
2.223+ ;; (define-key map "r" 'hg-update)
2.224+ (define-key map "u" 'hg-revert-buffer)
2.225+ (define-key map "~" 'hg-version-other-window)
2.226+ map)
2.227+ "This keymap overrides some default vc-mode bindings.")
2.228+
2.229+(defvar hg-mode-map
2.230+ (let ((map (make-sparse-keymap)))
2.231+ (define-key map "\C-xv" hg-prefix-map)
2.232+ map))
2.233+
2.234+(add-minor-mode 'hg-mode 'hg-mode hg-mode-map)
2.235+
2.236+
2.237+;;; Global keymap.
2.238+
2.239+(defvar hg-global-map
2.240+ (let ((map (make-sparse-keymap)))
2.241+ (define-key map "," 'hg-incoming)
2.242+ (define-key map "." 'hg-outgoing)
2.243+ (define-key map "<" 'hg-pull)
2.244+ (define-key map "=" 'hg-diff-repo)
2.245+ (define-key map ">" 'hg-push)
2.246+ (define-key map "?" 'hg-help-overview)
2.247+ (define-key map "A" 'hg-addremove)
2.248+ (define-key map "U" 'hg-revert)
2.249+ (define-key map "a" 'hg-add)
2.250+ (define-key map "c" 'hg-commit-start)
2.251+ (define-key map "f" 'hg-forget)
2.252+ (define-key map "h" 'hg-help-overview)
2.253+ (define-key map "i" 'hg-init)
2.254+ (define-key map "l" 'hg-log-repo)
2.255+ (define-key map "r" 'hg-root)
2.256+ (define-key map "s" 'hg-status)
2.257+ (define-key map "u" 'hg-update)
2.258+ map))
2.259+
2.260+(global-set-key hg-global-prefix hg-global-map)
2.261+
2.262+;;; View mode keymap.
2.263+
2.264+(defvar hg-view-mode-map
2.265+ (let ((map (make-sparse-keymap)))
2.266+ (hg-feature-cond (xemacs (set-keymap-name map 'hg-view-mode-map))) ; XEmacs
2.267+ (define-key map (hg-feature-cond (xemacs [button2])
2.268+ (t [mouse-2]))
2.269+ 'hg-buffer-mouse-clicked)
2.270+ map))
2.271+
2.272+(add-minor-mode 'hg-view-mode "" hg-view-mode-map)
2.273+
2.274+
2.275+;;; Commit mode keymaps.
2.276+
2.277+(defvar hg-commit-mode-map
2.278+ (let ((map (make-sparse-keymap)))
2.279+ (define-key map "\C-c\C-c" 'hg-commit-finish)
2.280+ (define-key map "\C-c\C-k" 'hg-commit-kill)
2.281+ (define-key map "\C-xv=" 'hg-diff-repo)
2.282+ map))
2.283+
2.284+(defvar hg-commit-mode-file-map
2.285+ (let ((map (make-sparse-keymap)))
2.286+ (define-key map (hg-feature-cond (xemacs [button2])
2.287+ (t [mouse-2]))
2.288+ 'hg-commit-mouse-clicked)
2.289+ (define-key map " " 'hg-commit-toggle-file)
2.290+ (define-key map "\r" 'hg-commit-toggle-file)
2.291+ map))
2.292+
2.293+
2.294+;;; Convenience functions.
2.295+
2.296+(defsubst hg-binary ()
2.297+ (if hg-binary
2.298+ hg-binary
2.299+ (error "No `hg' executable found!")))
2.300+
2.301+(defsubst hg-replace-in-string (str regexp newtext &optional literal)
2.302+ "Replace all matches in STR for REGEXP with NEWTEXT string.
2.303+Return the new string. Optional LITERAL non-nil means do a literal
2.304+replacement.
2.305+
2.306+This function bridges yet another pointless impedance gap between
2.307+XEmacs and GNU Emacs."
2.308+ (hg-feature-cond
2.309+ (xemacs (replace-in-string str regexp newtext literal))
2.310+ (t (replace-regexp-in-string regexp newtext str nil literal))))
2.311+
2.312+(defsubst hg-strip (str)
2.313+ "Strip leading and trailing blank lines from a string."
2.314+ (hg-replace-in-string (hg-replace-in-string str "[\r\n][ \t\r\n]*\\'" "")
2.315+ "\\`[ \t\r\n]*[\r\n]" ""))
2.316+
2.317+(defsubst hg-chomp (str)
2.318+ "Strip trailing newlines from a string."
2.319+ (hg-replace-in-string str "[\r\n]+\\'" ""))
2.320+
2.321+(defun hg-run-command (command &rest args)
2.322+ "Run the shell command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT).
2.323+The list ARGS contains a list of arguments to pass to the command."
2.324+ (let* (exit-code
2.325+ (output
2.326+ (with-output-to-string
2.327+ (with-current-buffer
2.328+ standard-output
2.329+ (setq exit-code
2.330+ (apply 'call-process command nil t nil args))))))
2.331+ (cons exit-code output)))
2.332+
2.333+(defun hg-run (command &rest args)
2.334+ "Run the Mercurial command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT)."
2.335+ (apply 'hg-run-command (hg-binary) command args))
2.336+
2.337+(defun hg-run0 (command &rest args)
2.338+ "Run the Mercurial command COMMAND, returning its output.
2.339+If the command does not exit with a zero status code, raise an error."
2.340+ (let ((res (apply 'hg-run-command (hg-binary) command args)))
2.341+ (if (not (eq (car res) 0))
2.342+ (error "Mercurial command failed %s - exit code %s"
2.343+ (cons command args)
2.344+ (car res))
2.345+ (cdr res))))
2.346+
2.347+(defmacro hg-do-across-repo (path &rest body)
2.348+ (let ((root-name (make-symbol "root-"))
2.349+ (buf-name (make-symbol "buf-")))
2.350+ `(let ((,root-name (hg-root ,path)))
2.351+ (save-excursion
2.352+ (dolist (,buf-name (buffer-list))
2.353+ (set-buffer ,buf-name)
2.354+ (when (and hg-status (equal (hg-root buffer-file-name) ,root-name))
2.355+ ,@body))))))
2.356+
2.357+(put 'hg-do-across-repo 'lisp-indent-function 1)
2.358+
2.359+(defun hg-sync-buffers (path)
2.360+ "Sync buffers visiting PATH with their on-disk copies.
2.361+If PATH is not being visited, but is under the repository root, sync
2.362+all buffers visiting files in the repository."
2.363+ (let ((buf (find-buffer-visiting path)))
2.364+ (if buf
2.365+ (with-current-buffer buf
2.366+ (vc-buffer-sync))
2.367+ (hg-do-across-repo path
2.368+ (vc-buffer-sync)))))
2.369+
2.370+(defun hg-buffer-commands (pnt)
2.371+ "Use the properties of a character to do something sensible."
2.372+ (interactive "d")
2.373+ (let ((rev (get-char-property pnt 'rev))
2.374+ (file (get-char-property pnt 'file)))
2.375+ (cond
2.376+ (file
2.377+ (find-file-other-window file))
2.378+ (rev
2.379+ (hg-diff hg-view-file-name rev rev))
2.380+ ((message "I don't know how to do that yet")))))
2.381+
2.382+(defsubst hg-event-point (event)
2.383+ "Return the character position of the mouse event EVENT."
2.384+ (hg-feature-cond (xemacs (event-point event))
2.385+ (t (posn-point (event-start event)))))
2.386+
2.387+(defsubst hg-event-window (event)
2.388+ "Return the window over which mouse event EVENT occurred."
2.389+ (hg-feature-cond (xemacs (event-window event))
2.390+ (t (posn-window (event-start event)))))
2.391+
2.392+(defun hg-buffer-mouse-clicked (event)
2.393+ "Translate the mouse clicks in a HG log buffer to character events.
2.394+These are then handed off to `hg-buffer-commands'.
2.395+
2.396+Handle frickin' frackin' gratuitous event-related incompatibilities."
2.397+ (interactive "e")
2.398+ (select-window (hg-event-window event))
2.399+ (hg-buffer-commands (hg-event-point event)))
2.400+
2.401+(defsubst hg-abbrev-file-name (file)
2.402+ "Portable wrapper around abbreviate-file-name."
2.403+ (hg-feature-cond (xemacs (abbreviate-file-name file t))
2.404+ (t (abbreviate-file-name file))))
2.405+
2.406+(defun hg-read-file-name (&optional prompt default)
2.407+ "Read a file or directory name, or a pattern, to use with a command."
2.408+ (save-excursion
2.409+ (while hg-prev-buffer
2.410+ (set-buffer hg-prev-buffer))
2.411+ (let ((path (or default
2.412+ (buffer-file-name)
2.413+ (expand-file-name default-directory))))
2.414+ (if (or (not path) current-prefix-arg)
2.415+ (expand-file-name
2.416+ (eval (list* 'read-file-name
2.417+ (format "File, directory or pattern%s: "
2.418+ (or prompt ""))
2.419+ (and path (file-name-directory path))
2.420+ nil nil
2.421+ (and path (file-name-nondirectory path))
2.422+ (hg-feature-cond
2.423+ (xemacs (cons (quote 'hg-file-history) nil))
2.424+ (t nil)))))
2.425+ path))))
2.426+
2.427+(defun hg-read-number (&optional prompt default)
2.428+ "Read a integer value."
2.429+ (save-excursion
2.430+ (if (or (not default) current-prefix-arg)
2.431+ (string-to-number
2.432+ (eval (list* 'read-string
2.433+ (or prompt "")
2.434+ (if default (cons (format "%d" default) nil) nil))))
2.435+ default)))
2.436+
2.437+(defun hg-read-config ()
2.438+ "Return an alist of (key . value) pairs of Mercurial config data.
2.439+Each key is of the form (section . name)."
2.440+ (let (items)
2.441+ (dolist (line (split-string (hg-chomp (hg-run0 "debugconfig")) "\n") items)
2.442+ (string-match "^\\([^=]*\\)=\\(.*\\)" line)
2.443+ (let* ((left (substring line (match-beginning 1) (match-end 1)))
2.444+ (right (substring line (match-beginning 2) (match-end 2)))
2.445+ (key (split-string left "\\."))
2.446+ (value (hg-replace-in-string right "\\\\n" "\n" t)))
2.447+ (setq items (cons (cons (cons (car key) (cadr key)) value) items))))))
2.448+
2.449+(defun hg-config-section (section config)
2.450+ "Return an alist of (name . value) pairs for SECTION of CONFIG."
2.451+ (let (items)
2.452+ (dolist (item config items)
2.453+ (when (equal (caar item) section)
2.454+ (setq items (cons (cons (cdar item) (cdr item)) items))))))
2.455+
2.456+(defun hg-string-starts-with (sub str)
2.457+ "Indicate whether string STR starts with the substring or character SUB."
2.458+ (if (not (stringp sub))
2.459+ (and (> (length str) 0) (equal (elt str 0) sub))
2.460+ (let ((sub-len (length sub)))
2.461+ (and (<= sub-len (length str))
2.462+ (string= sub (substring str 0 sub-len))))))
2.463+
2.464+(defun hg-complete-repo (string predicate all)
2.465+ "Attempt to complete a repository name.
2.466+We complete on either symbolic names from Mercurial's config or real
2.467+directory names from the file system. We do not penalize URLs."
2.468+ (or (if all
2.469+ (all-completions string hg-repo-completion-table predicate)
2.470+ (try-completion string hg-repo-completion-table predicate))
2.471+ (let* ((str (expand-file-name string))
2.472+ (dir (file-name-directory str))
2.473+ (file (file-name-nondirectory str)))
2.474+ (if all
2.475+ (let (completions)
2.476+ (dolist (name (delete "./" (file-name-all-completions file dir))
2.477+ completions)
2.478+ (let ((path (concat dir name)))
2.479+ (when (file-directory-p path)
2.480+ (setq completions (cons name completions))))))
2.481+ (let ((comp (file-name-completion file dir)))
2.482+ (if comp
2.483+ (hg-abbrev-file-name (concat dir comp))))))))
2.484+
2.485+(defun hg-read-repo-name (&optional prompt initial-contents default)
2.486+ "Read the location of a repository."
2.487+ (save-excursion
2.488+ (while hg-prev-buffer
2.489+ (set-buffer hg-prev-buffer))
2.490+ (let (hg-repo-completion-table)
2.491+ (if current-prefix-arg
2.492+ (progn
2.493+ (dolist (path (hg-config-section "paths" (hg-read-config)))
2.494+ (setq hg-repo-completion-table
2.495+ (cons (cons (car path) t) hg-repo-completion-table))
2.496+ (unless (hg-string-starts-with (hg-feature-cond
2.497+ (xemacs directory-sep-char)
2.498+ (t ?/))
2.499+ (cdr path))
2.500+ (setq hg-repo-completion-table
2.501+ (cons (cons (cdr path) t) hg-repo-completion-table))))
2.502+ (completing-read (format "Repository%s: " (or prompt ""))
2.503+ 'hg-complete-repo
2.504+ nil
2.505+ nil
2.506+ initial-contents
2.507+ 'hg-repo-history
2.508+ default))
2.509+ default))))
2.510+
2.511+(defun hg-read-rev (&optional prompt default)
2.512+ "Read a revision or tag, offering completions."
2.513+ (save-excursion
2.514+ (while hg-prev-buffer
2.515+ (set-buffer hg-prev-buffer))
2.516+ (let ((rev (or default "tip")))
2.517+ (if current-prefix-arg
2.518+ (let ((revs (split-string
2.519+ (hg-chomp
2.520+ (hg-run0 "-q" "log" "-l"
2.521+ (format "%d" hg-rev-completion-limit)))
2.522+ "[\n:]")))
2.523+ (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n"))
2.524+ (setq revs (cons (car (split-string line "\\s-")) revs)))
2.525+ (completing-read (format "Revision%s (%s): "
2.526+ (or prompt "")
2.527+ (or default "tip"))
2.528+ (mapcar (lambda (x) (cons x x)) revs)
2.529+ nil
2.530+ nil
2.531+ nil
2.532+ 'hg-rev-history
2.533+ (or default "tip")))
2.534+ rev))))
2.535+
2.536+(defun hg-parents-for-mode-line (root)
2.537+ "Format the parents of the working directory for the mode line."
2.538+ (let ((parents (split-string (hg-chomp
2.539+ (hg-run0 "--cwd" root "parents" "--template"
2.540+ "{rev}\n")) "\n")))
2.541+ (mapconcat 'identity parents "+")))
2.542+
2.543+(defun hg-buffers-visiting-repo (&optional path)
2.544+ "Return a list of buffers visiting the repository containing PATH."
2.545+ (let ((root-name (hg-root (or path (buffer-file-name))))
2.546+ bufs)
2.547+ (save-excursion
2.548+ (dolist (buf (buffer-list) bufs)
2.549+ (set-buffer buf)
2.550+ (let ((name (buffer-file-name)))
2.551+ (when (and hg-status name (equal (hg-root name) root-name))
2.552+ (setq bufs (cons buf bufs))))))))
2.553+
2.554+(defun hg-update-mode-lines (path)
2.555+ "Update the mode lines of all buffers visiting the same repository as PATH."
2.556+ (let* ((root (hg-root path))
2.557+ (parents (hg-parents-for-mode-line root)))
2.558+ (save-excursion
2.559+ (dolist (info (hg-path-status
2.560+ root
2.561+ (mapcar
2.562+ (function
2.563+ (lambda (buf)
2.564+ (substring (buffer-file-name buf) (length root))))
2.565+ (hg-buffers-visiting-repo root))))
2.566+ (let* ((name (car info))
2.567+ (status (cdr info))
2.568+ (buf (find-buffer-visiting (concat root name))))
2.569+ (when buf
2.570+ (set-buffer buf)
2.571+ (hg-mode-line-internal status parents)))))))
2.572+
2.573+
2.574+;;; View mode bits.
2.575+
2.576+(defun hg-exit-view-mode (buf)
2.577+ "Exit from hg-view-mode.
2.578+We delete the current window if entering hg-view-mode split the
2.579+current frame."
2.580+ (when (and (eq buf (current-buffer))
2.581+ (> (length (window-list)) 1))
2.582+ (delete-window))
2.583+ (when (buffer-live-p buf)
2.584+ (kill-buffer buf)))
2.585+
2.586+(defun hg-view-mode (prev-buffer &optional file-name)
2.587+ (goto-char (point-min))
2.588+ (set-buffer-modified-p nil)
2.589+ (toggle-read-only t)
2.590+ (hg-feature-cond (xemacs (view-minor-mode prev-buffer 'hg-exit-view-mode))
2.591+ (t (view-mode-enter nil 'hg-exit-view-mode)))
2.592+ (setq hg-view-mode t)
2.593+ (setq truncate-lines t)
2.594+ (when file-name
2.595+ (setq hg-view-file-name
2.596+ (hg-abbrev-file-name file-name))))
2.597+
2.598+(defun hg-file-status (file)
2.599+ "Return status of FILE, or nil if FILE does not exist or is unmanaged."
2.600+ (let* ((s (hg-run "status" file))
2.601+ (exit (car s))
2.602+ (output (cdr s)))
2.603+ (if (= exit 0)
2.604+ (let ((state (and (>= (length output) 2)
2.605+ (= (aref output 1) ? )
2.606+ (assq (aref output 0) hg-state-alist))))
2.607+ (if state
2.608+ (cdr state)
2.609+ 'normal)))))
2.610+
2.611+(defun hg-path-status (root paths)
2.612+ "Return status of PATHS in repo ROOT as an alist.
2.613+Each entry is a pair (FILE-NAME . STATUS)."
2.614+ (let ((s (apply 'hg-run "--cwd" root "status" "-marduc" paths))
2.615+ result)
2.616+ (dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result))
2.617+ (let (state name)
2.618+ (cond ((= (aref entry 1) ? )
2.619+ (setq state (assq (aref entry 0) hg-state-alist)
2.620+ name (substring entry 2)))
2.621+ ((string-match "\\(.*\\): " entry)
2.622+ (setq name (match-string 1 entry))))
2.623+ (setq result (cons (cons name state) result))))))
2.624+
2.625+(defmacro hg-view-output (args &rest body)
2.626+ "Execute BODY in a clean buffer, then quickly display that buffer.
2.627+If the buffer contains one line, its contents are displayed in the
2.628+minibuffer. Otherwise, the buffer is displayed in view-mode.
2.629+ARGS is of the form (BUFFER-NAME &optional FILE), where BUFFER-NAME is
2.630+the name of the buffer to create, and FILE is the name of the file
2.631+being viewed."
2.632+ (let ((prev-buf (make-symbol "prev-buf-"))
2.633+ (v-b-name (car args))
2.634+ (v-m-rest (cdr args)))
2.635+ `(let ((view-buf-name ,v-b-name)
2.636+ (,prev-buf (current-buffer)))
2.637+ (get-buffer-create view-buf-name)
2.638+ (kill-buffer view-buf-name)
2.639+ (get-buffer-create view-buf-name)
2.640+ (set-buffer view-buf-name)
2.641+ (save-excursion
2.642+ ,@body)
2.643+ (case (count-lines (point-min) (point-max))
2.644+ ((0)
2.645+ (kill-buffer view-buf-name)
2.646+ (message "(No output)"))
2.647+ ((1)
2.648+ (let ((msg (hg-chomp (buffer-substring (point-min) (point-max)))))
2.649+ (kill-buffer view-buf-name)
2.650+ (message "%s" msg)))
2.651+ (t
2.652+ (pop-to-buffer view-buf-name)
2.653+ (setq hg-prev-buffer ,prev-buf)
2.654+ (hg-view-mode ,prev-buf ,@v-m-rest))))))
2.655+
2.656+(put 'hg-view-output 'lisp-indent-function 1)
2.657+
2.658+;;; Context save and restore across revert and other operations.
2.659+
2.660+(defun hg-position-context (pos)
2.661+ "Return information to help find the given position again."
2.662+ (let* ((end (min (point-max) (+ pos 98))))
2.663+ (list pos
2.664+ (buffer-substring (max (point-min) (- pos 2)) end)
2.665+ (- end pos))))
2.666+
2.667+(defun hg-buffer-context ()
2.668+ "Return information to help restore a user's editing context.
2.669+This is useful across reverts and merges, where a context is likely
2.670+to have moved a little, but not really changed."
2.671+ (let ((point-context (hg-position-context (point)))
2.672+ (mark-context (let ((mark (mark-marker)))
2.673+ (and mark
2.674+ ;; make sure active mark
2.675+ (marker-buffer mark)
2.676+ (marker-position mark)
2.677+ (hg-position-context mark)))))
2.678+ (list point-context mark-context)))
2.679+
2.680+(defun hg-find-context (ctx)
2.681+ "Attempt to find a context in the given buffer.
2.682+Always returns a valid, hopefully sane, position."
2.683+ (let ((pos (nth 0 ctx))
2.684+ (str (nth 1 ctx))
2.685+ (fixup (nth 2 ctx)))
2.686+ (save-excursion
2.687+ (goto-char (max (point-min) (- pos 15000)))
2.688+ (if (and (not (equal str ""))
2.689+ (search-forward str nil t))
2.690+ (- (point) fixup)
2.691+ (max pos (point-min))))))
2.692+
2.693+(defun hg-restore-context (ctx)
2.694+ "Attempt to restore the user's editing context."
2.695+ (let ((point-context (nth 0 ctx))
2.696+ (mark-context (nth 1 ctx)))
2.697+ (goto-char (hg-find-context point-context))
2.698+ (when mark-context
2.699+ (set-mark (hg-find-context mark-context)))))
2.700+
2.701+
2.702+;;; Hooks.
2.703+
2.704+(defun hg-mode-line-internal (status parents)
2.705+ (setq hg-status status
2.706+ hg-mode (and status (concat " Hg:"
2.707+ parents
2.708+ (cdr (assq status
2.709+ '((normal . "")
2.710+ (removed . "r")
2.711+ (added . "a")
2.712+ (deleted . "!")
2.713+ (modified . "m"))))))))
2.714+
2.715+(defun hg-mode-line (&optional force)
2.716+ "Update the modeline with the current status of a file.
2.717+An update occurs if optional argument FORCE is non-nil,
2.718+hg-update-modeline is non-nil, or we have not yet checked the state of
2.719+the file."
2.720+ (let ((root (hg-root)))
2.721+ (when (and root (or force hg-update-modeline (not hg-mode)))
2.722+ (let ((status (hg-file-status buffer-file-name))
2.723+ (parents (hg-parents-for-mode-line root)))
2.724+ (hg-mode-line-internal status parents)
2.725+ status))))
2.726+
2.727+(defun hg-mode (&optional toggle)
2.728+ "Minor mode for Mercurial distributed SCM integration.
2.729+
2.730+The Mercurial mode user interface is based on that of VC mode, so if
2.731+you're already familiar with VC, the same keybindings and functions
2.732+will generally work.
2.733+
2.734+Below is a list of many common SCM tasks. In the list, `G/L\'
2.735+indicates whether a key binding is global (G) to a repository or
2.736+local (L) to a file. Many commands take a prefix argument.
2.737+
2.738+SCM Task G/L Key Binding Command Name
2.739+-------- --- ----------- ------------
2.740+Help overview (what you are reading) G C-c h h hg-help-overview
2.741+
2.742+Tell Mercurial to manage a file G C-c h a hg-add
2.743+Commit changes to current file only L C-x v n hg-commit-start
2.744+Undo changes to file since commit L C-x v u hg-revert-buffer
2.745+
2.746+Diff file vs last checkin L C-x v = hg-diff
2.747+
2.748+View file change history L C-x v l hg-log
2.749+View annotated file L C-x v a hg-annotate
2.750+
2.751+Diff repo vs last checkin G C-c h = hg-diff-repo
2.752+View status of files in repo G C-c h s hg-status
2.753+Commit all changes G C-c h c hg-commit-start
2.754+
2.755+Undo all changes since last commit G C-c h U hg-revert
2.756+View repo change history G C-c h l hg-log-repo
2.757+
2.758+See changes that can be pulled G C-c h , hg-incoming
2.759+Pull changes G C-c h < hg-pull
2.760+Update working directory after pull G C-c h u hg-update
2.761+See changes that can be pushed G C-c h . hg-outgoing
2.762+Push changes G C-c h > hg-push"
2.763+ (unless vc-make-backup-files
2.764+ (set (make-local-variable 'backup-inhibited) t))
2.765+ (run-hooks 'hg-mode-hook))
2.766+
2.767+(defun hg-find-file-hook ()
2.768+ (ignore-errors
2.769+ (when (hg-mode-line)
2.770+ (hg-mode))))
2.771+
2.772+(add-hook 'find-file-hooks 'hg-find-file-hook)
2.773+
2.774+(defun hg-after-save-hook ()
2.775+ (ignore-errors
2.776+ (let ((old-status hg-status))
2.777+ (hg-mode-line)
2.778+ (if (and (not old-status) hg-status)
2.779+ (hg-mode)))))
2.780+
2.781+(add-hook 'after-save-hook 'hg-after-save-hook)
2.782+
2.783+
2.784+;;; User interface functions.
2.785+
2.786+(defun hg-help-overview ()
2.787+ "This is an overview of the Mercurial SCM mode for Emacs.
2.788+
2.789+You can find the source code, license (GPLv2+), and credits for this
2.790+code by typing `M-x find-library mercurial RET'."
2.791+ (interactive)
2.792+ (hg-view-output ("Mercurial Help Overview")
2.793+ (insert (documentation 'hg-help-overview))
2.794+ (let ((pos (point)))
2.795+ (insert (documentation 'hg-mode))
2.796+ (goto-char pos)
2.797+ (end-of-line 1)
2.798+ (delete-region pos (point)))
2.799+ (let ((hg-root-dir (hg-root)))
2.800+ (if (not hg-root-dir)
2.801+ (error "error: %s: directory is not part of a Mercurial repository."
2.802+ default-directory)
2.803+ (cd hg-root-dir)))))
2.804+
2.805+(defun hg-fix-paths ()
2.806+ "Fix paths reported by some Mercurial commands."
2.807+ (save-excursion
2.808+ (goto-char (point-min))
2.809+ (while (re-search-forward " \\.\\.." nil t)
2.810+ (replace-match " " nil nil))))
2.811+
2.812+(defun hg-add (path)
2.813+ "Add PATH to the Mercurial repository on the next commit.
2.814+With a prefix argument, prompt for the path to add."
2.815+ (interactive (list (hg-read-file-name " to add")))
2.816+ (let ((buf (current-buffer))
2.817+ (update (equal buffer-file-name path)))
2.818+ (hg-view-output (hg-output-buffer-name)
2.819+ (apply 'call-process (hg-binary) nil t nil (list "add" path))
2.820+ (hg-fix-paths)
2.821+ (goto-char (point-min))
2.822+ (cd (hg-root path)))
2.823+ (when update
2.824+ (unless vc-make-backup-files
2.825+ (set (make-local-variable 'backup-inhibited) t))
2.826+ (with-current-buffer buf
2.827+ (hg-mode-line)))))
2.828+
2.829+(defun hg-addremove ()
2.830+ (interactive)
2.831+ (error "not implemented"))
2.832+
2.833+(defun hg-annotate ()
2.834+ (interactive)
2.835+ (error "not implemented"))
2.836+
2.837+(defun hg-commit-toggle-file (pos)
2.838+ "Toggle whether or not the file at POS will be committed."
2.839+ (interactive "d")
2.840+ (save-excursion
2.841+ (goto-char pos)
2.842+ (let (face
2.843+ (inhibit-read-only t)
2.844+ bol)
2.845+ (beginning-of-line)
2.846+ (setq bol (+ (point) 4))
2.847+ (setq face (get-text-property bol 'face))
2.848+ (end-of-line)
2.849+ (if (eq face 'bold)
2.850+ (progn
2.851+ (remove-text-properties bol (point) '(face nil))
2.852+ (message "%s will not be committed"
2.853+ (buffer-substring bol (point))))
2.854+ (add-text-properties bol (point) '(face bold))
2.855+ (message "%s will be committed"
2.856+ (buffer-substring bol (point)))))))
2.857+
2.858+(defun hg-commit-mouse-clicked (event)
2.859+ "Toggle whether or not the file at POS will be committed."
2.860+ (interactive "@e")
2.861+ (hg-commit-toggle-file (hg-event-point event)))
2.862+
2.863+(defun hg-commit-kill ()
2.864+ "Kill the commit currently being prepared."
2.865+ (interactive)
2.866+ (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this commit? "))
2.867+ (let ((buf hg-prev-buffer))
2.868+ (kill-buffer nil)
2.869+ (switch-to-buffer buf))))
2.870+
2.871+(defun hg-commit-finish ()
2.872+ "Finish preparing a commit, and perform the actual commit.
2.873+The hook hg-pre-commit-hook is run before anything else is done. If
2.874+the commit message is empty and hg-commit-allow-empty-message is nil,
2.875+an error is raised. If the list of files to commit is empty and
2.876+hg-commit-allow-empty-file-list is nil, an error is raised."
2.877+ (interactive)
2.878+ (let ((root hg-root))
2.879+ (save-excursion
2.880+ (run-hooks 'hg-pre-commit-hook)
2.881+ (goto-char (point-min))
2.882+ (search-forward hg-commit-message-start)
2.883+ (let (message files)
2.884+ (let ((start (point)))
2.885+ (goto-char (point-max))
2.886+ (search-backward hg-commit-message-end)
2.887+ (setq message (hg-strip (buffer-substring start (point)))))
2.888+ (when (and (= (length message) 0)
2.889+ (not hg-commit-allow-empty-message))
2.890+ (error "Cannot proceed - commit message is empty"))
2.891+ (forward-line 1)
2.892+ (beginning-of-line)
2.893+ (while (< (point) (point-max))
2.894+ (let ((pos (+ (point) 4)))
2.895+ (end-of-line)
2.896+ (when (eq (get-text-property pos 'face) 'bold)
2.897+ (end-of-line)
2.898+ (setq files (cons (buffer-substring pos (point)) files))))
2.899+ (forward-line 1))
2.900+ (when (and (= (length files) 0)
2.901+ (not hg-commit-allow-empty-file-list))
2.902+ (error "Cannot proceed - no files to commit"))
2.903+ (setq message (concat message "\n"))
2.904+ (apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files))
2.905+ (let ((buf hg-prev-buffer))
2.906+ (kill-buffer nil)
2.907+ (switch-to-buffer buf))
2.908+ (hg-update-mode-lines root))))
2.909+
2.910+(defun hg-commit-mode ()
2.911+ "Mode for describing a commit of changes to a Mercurial repository.
2.912+This involves two actions: describing the changes with a commit
2.913+message, and choosing the files to commit.
2.914+
2.915+To describe the commit, simply type some text in the designated area.
2.916+
2.917+By default, all modified, added and removed files are selected for
2.918+committing. Files that will be committed are displayed in bold face\;
2.919+those that will not are displayed in normal face.
2.920+
2.921+To toggle whether a file will be committed, move the cursor over a
2.922+particular file and hit space or return. Alternatively, middle click
2.923+on the file.
2.924+
2.925+Key bindings
2.926+------------
2.927+\\[hg-commit-finish] proceed with commit
2.928+\\[hg-commit-kill] kill commit
2.929+
2.930+\\[hg-diff-repo] view diff of pending changes"
2.931+ (interactive)
2.932+ (use-local-map hg-commit-mode-map)
2.933+ (set-syntax-table text-mode-syntax-table)
2.934+ (setq local-abbrev-table text-mode-abbrev-table
2.935+ major-mode 'hg-commit-mode
2.936+ mode-name "Hg-Commit")
2.937+ (set-buffer-modified-p nil)
2.938+ (setq buffer-undo-list nil)
2.939+ (run-hooks 'text-mode-hook 'hg-commit-mode-hook))
2.940+
2.941+(defun hg-commit-start ()
2.942+ "Prepare a commit of changes to the repository containing the current file."
2.943+ (interactive)
2.944+ (while hg-prev-buffer
2.945+ (set-buffer hg-prev-buffer))
2.946+ (let ((root (hg-root))
2.947+ (prev-buffer (current-buffer))
2.948+ modified-files)
2.949+ (unless root
2.950+ (error "Cannot commit outside a repository!"))
2.951+ (hg-sync-buffers root)
2.952+ (setq modified-files (hg-chomp (hg-run0 "--cwd" root "status" "-arm")))
2.953+ (when (and (= (length modified-files) 0)
2.954+ (not hg-commit-allow-empty-file-list))
2.955+ (error "No pending changes to commit"))
2.956+ (let* ((buf-name (format "*Mercurial: Commit %s*" root)))
2.957+ (pop-to-buffer (get-buffer-create buf-name))
2.958+ (when (= (point-min) (point-max))
2.959+ (set (make-local-variable 'hg-root) root)
2.960+ (setq hg-prev-buffer prev-buffer)
2.961+ (insert "\n")
2.962+ (let ((bol (point)))
2.963+ (insert hg-commit-message-end)
2.964+ (add-text-properties bol (point) '(face bold-italic)))
2.965+ (let ((file-area (point)))
2.966+ (insert modified-files)
2.967+ (goto-char file-area)
2.968+ (while (< (point) (point-max))
2.969+ (let ((bol (point)))
2.970+ (forward-char 1)
2.971+ (insert " ")
2.972+ (end-of-line)
2.973+ (add-text-properties (+ bol 4) (point)
2.974+ '(face bold mouse-face highlight)))
2.975+ (forward-line 1))
2.976+ (goto-char file-area)
2.977+ (add-text-properties (point) (point-max)
2.978+ `(keymap ,hg-commit-mode-file-map))
2.979+ (goto-char (point-min))
2.980+ (insert hg-commit-message-start)
2.981+ (add-text-properties (point-min) (point) '(face bold-italic))
2.982+ (insert "\n\n")
2.983+ (forward-line -1)
2.984+ (save-excursion
2.985+ (goto-char (point-max))
2.986+ (search-backward hg-commit-message-end)
2.987+ (add-text-properties (match-beginning 0) (point-max)
2.988+ '(read-only t))
2.989+ (goto-char (point-min))
2.990+ (search-forward hg-commit-message-start)
2.991+ (add-text-properties (match-beginning 0) (match-end 0)
2.992+ '(read-only t)))
2.993+ (hg-commit-mode)
2.994+ (cd root))))))
2.995+
2.996+(defun hg-diff (path &optional rev1 rev2)
2.997+ "Show the differences between REV1 and REV2 of PATH.
2.998+When called interactively, the default behaviour is to treat REV1 as
2.999+the \"parent\" revision, REV2 as the current edited version of the file, and
2.1000+PATH as the file edited in the current buffer.
2.1001+With a prefix argument, prompt for all of these."
2.1002+ (interactive (list (hg-read-file-name " to diff")
2.1003+ (let ((rev1 (hg-read-rev " to start with" 'parent)))
2.1004+ (and (not (eq rev1 'parent)) rev1))
2.1005+ (let ((rev2 (hg-read-rev " to end with" 'working-dir)))
2.1006+ (and (not (eq rev2 'working-dir)) rev2))))
2.1007+ (hg-sync-buffers path)
2.1008+ (let ((a-path (hg-abbrev-file-name path))
2.1009+ ;; none revision is specified explicitly
2.1010+ (none (and (not rev1) (not rev2)))
2.1011+ ;; only one revision is specified explicitly
2.1012+ (one (or (and (or (equal rev1 rev2) (not rev2)) rev1)
2.1013+ (and (not rev1) rev2)))
2.1014+ diff)
2.1015+ (hg-view-output ((cond
2.1016+ (none
2.1017+ (format "Mercurial: Diff against parent of %s" a-path))
2.1018+ (one
2.1019+ (format "Mercurial: Diff of rev %s of %s" one a-path))
2.1020+ (t
2.1021+ (format "Mercurial: Diff from rev %s to %s of %s"
2.1022+ rev1 rev2 a-path))))
2.1023+ (cond
2.1024+ (none
2.1025+ (call-process (hg-binary) nil t nil "diff" path))
2.1026+ (one
2.1027+ (call-process (hg-binary) nil t nil "diff" "-r" one path))
2.1028+ (t
2.1029+ (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path)))
2.1030+ (diff-mode)
2.1031+ (setq diff (not (= (point-min) (point-max))))
2.1032+ (font-lock-fontify-buffer)
2.1033+ (cd (hg-root path)))
2.1034+ diff))
2.1035+
2.1036+(defun hg-diff-repo (path &optional rev1 rev2)
2.1037+ "Show the differences between REV1 and REV2 of repository containing PATH.
2.1038+When called interactively, the default behaviour is to treat REV1 as
2.1039+the \"parent\" revision, REV2 as the current edited version of the file, and
2.1040+PATH as the `hg-root' of the current buffer.
2.1041+With a prefix argument, prompt for all of these."
2.1042+ (interactive (list (hg-read-file-name " to diff")
2.1043+ (let ((rev1 (hg-read-rev " to start with" 'parent)))
2.1044+ (and (not (eq rev1 'parent)) rev1))
2.1045+ (let ((rev2 (hg-read-rev " to end with" 'working-dir)))
2.1046+ (and (not (eq rev2 'working-dir)) rev2))))
2.1047+ (hg-diff (hg-root path) rev1 rev2))
2.1048+
2.1049+(defun hg-forget (path)
2.1050+ "Lose track of PATH, which has been added, but not yet committed.
2.1051+This will prevent the file from being incorporated into the Mercurial
2.1052+repository on the next commit.
2.1053+With a prefix argument, prompt for the path to forget."
2.1054+ (interactive (list (hg-read-file-name " to forget")))
2.1055+ (let ((buf (current-buffer))
2.1056+ (update (equal buffer-file-name path)))
2.1057+ (hg-view-output (hg-output-buffer-name)
2.1058+ (apply 'call-process (hg-binary) nil t nil (list "forget" path))
2.1059+ ;; "hg forget" shows pathes relative NOT TO ROOT BUT TO REPOSITORY
2.1060+ (hg-fix-paths)
2.1061+ (goto-char (point-min))
2.1062+ (cd (hg-root path)))
2.1063+ (when update
2.1064+ (with-current-buffer buf
2.1065+ (when (local-variable-p 'backup-inhibited)
2.1066+ (kill-local-variable 'backup-inhibited))
2.1067+ (hg-mode-line)))))
2.1068+
2.1069+(defun hg-incoming (&optional repo)
2.1070+ "Display changesets present in REPO that are not present locally."
2.1071+ (interactive (list (hg-read-repo-name " where changes would come from")))
2.1072+ (hg-view-output ((format "Mercurial: Incoming from %s to %s"
2.1073+ (hg-abbrev-file-name (hg-root))
2.1074+ (hg-abbrev-file-name
2.1075+ (or repo hg-incoming-repository))))
2.1076+ (call-process (hg-binary) nil t nil "incoming"
2.1077+ (or repo hg-incoming-repository))
2.1078+ (hg-log-mode)
2.1079+ (cd (hg-root))))
2.1080+
2.1081+(defun hg-init ()
2.1082+ (interactive)
2.1083+ (error "not implemented"))
2.1084+
2.1085+(defun hg-log-mode ()
2.1086+ "Mode for viewing a Mercurial change log."
2.1087+ (goto-char (point-min))
2.1088+ (when (looking-at "^searching for changes.*$")
2.1089+ (delete-region (match-beginning 0) (match-end 0)))
2.1090+ (run-hooks 'hg-log-mode-hook))
2.1091+
2.1092+(defun hg-log (path &optional rev1 rev2 log-limit)
2.1093+ "Display the revision history of PATH.
2.1094+History is displayed between REV1 and REV2.
2.1095+Number of displayed changesets is limited to LOG-LIMIT.
2.1096+REV1 defaults to the tip, while REV2 defaults to 0.
2.1097+LOG-LIMIT defaults to `hg-log-limit'.
2.1098+With a prefix argument, prompt for each parameter."
2.1099+ (interactive (list (hg-read-file-name " to log")
2.1100+ (hg-read-rev " to start with"
2.1101+ "tip")
2.1102+ (hg-read-rev " to end with"
2.1103+ "0")
2.1104+ (hg-read-number "Output limited to: "
2.1105+ hg-log-limit)))
2.1106+ (let ((a-path (hg-abbrev-file-name path))
2.1107+ (r1 (or rev1 "tip"))
2.1108+ (r2 (or rev2 "0"))
2.1109+ (limit (format "%d" (or log-limit hg-log-limit))))
2.1110+ (hg-view-output ((if (equal r1 r2)
2.1111+ (format "Mercurial: Log of rev %s of %s" rev1 a-path)
2.1112+ (format
2.1113+ "Mercurial: at most %s log(s) from rev %s to %s of %s"
2.1114+ limit r1 r2 a-path)))
2.1115+ (eval (list* 'call-process (hg-binary) nil t nil
2.1116+ "log"
2.1117+ "-r" (format "%s:%s" r1 r2)
2.1118+ "-l" limit
2.1119+ (if (> (length path) (length (hg-root path)))
2.1120+ (cons path nil)
2.1121+ nil)))
2.1122+ (hg-log-mode)
2.1123+ (cd (hg-root path)))))
2.1124+
2.1125+(defun hg-log-repo (path &optional rev1 rev2 log-limit)
2.1126+ "Display the revision history of the repository containing PATH.
2.1127+History is displayed between REV1 and REV2.
2.1128+Number of displayed changesets is limited to LOG-LIMIT,
2.1129+REV1 defaults to the tip, while REV2 defaults to 0.
2.1130+LOG-LIMIT defaults to `hg-log-limit'.
2.1131+With a prefix argument, prompt for each parameter."
2.1132+ (interactive (list (hg-read-file-name " to log")
2.1133+ (hg-read-rev " to start with"
2.1134+ "tip")
2.1135+ (hg-read-rev " to end with"
2.1136+ "0")
2.1137+ (hg-read-number "Output limited to: "
2.1138+ hg-log-limit)))
2.1139+ (hg-log (hg-root path) rev1 rev2 log-limit))
2.1140+
2.1141+(defun hg-outgoing (&optional repo)
2.1142+ "Display changesets present locally that are not present in REPO."
2.1143+ (interactive (list (hg-read-repo-name " where changes would go to" nil
2.1144+ hg-outgoing-repository)))
2.1145+ (hg-view-output ((format "Mercurial: Outgoing from %s to %s"
2.1146+ (hg-abbrev-file-name (hg-root))
2.1147+ (hg-abbrev-file-name
2.1148+ (or repo hg-outgoing-repository))))
2.1149+ (call-process (hg-binary) nil t nil "outgoing"
2.1150+ (or repo hg-outgoing-repository))
2.1151+ (hg-log-mode)
2.1152+ (cd (hg-root))))
2.1153+
2.1154+(defun hg-pull (&optional repo)
2.1155+ "Pull changes from repository REPO.
2.1156+This does not update the working directory."
2.1157+ (interactive (list (hg-read-repo-name " to pull from")))
2.1158+ (hg-view-output ((format "Mercurial: Pull to %s from %s"
2.1159+ (hg-abbrev-file-name (hg-root))
2.1160+ (hg-abbrev-file-name
2.1161+ (or repo hg-incoming-repository))))
2.1162+ (call-process (hg-binary) nil t nil "pull"
2.1163+ (or repo hg-incoming-repository))
2.1164+ (cd (hg-root))))
2.1165+
2.1166+(defun hg-push (&optional repo)
2.1167+ "Push changes to repository REPO."
2.1168+ (interactive (list (hg-read-repo-name " to push to")))
2.1169+ (hg-view-output ((format "Mercurial: Push from %s to %s"
2.1170+ (hg-abbrev-file-name (hg-root))
2.1171+ (hg-abbrev-file-name
2.1172+ (or repo hg-outgoing-repository))))
2.1173+ (call-process (hg-binary) nil t nil "push"
2.1174+ (or repo hg-outgoing-repository))
2.1175+ (cd (hg-root))))
2.1176+
2.1177+(defun hg-revert-buffer-internal ()
2.1178+ (let ((ctx (hg-buffer-context)))
2.1179+ (message "Reverting %s..." buffer-file-name)
2.1180+ (hg-run0 "revert" buffer-file-name)
2.1181+ (revert-buffer t t t)
2.1182+ (hg-restore-context ctx)
2.1183+ (hg-mode-line)
2.1184+ (message "Reverting %s...done" buffer-file-name)))
2.1185+
2.1186+(defun hg-revert-buffer ()
2.1187+ "Revert current buffer's file back to the latest committed version.
2.1188+If the file has not changed, nothing happens. Otherwise, this
2.1189+displays a diff and asks for confirmation before reverting."
2.1190+ (interactive)
2.1191+ (let ((vc-suppress-confirm nil)
2.1192+ (obuf (current-buffer))
2.1193+ diff)
2.1194+ (vc-buffer-sync)
2.1195+ (unwind-protect
2.1196+ (setq diff (hg-diff buffer-file-name))
2.1197+ (when diff
2.1198+ (unless (yes-or-no-p "Discard changes? ")
2.1199+ (error "Revert cancelled")))
2.1200+ (when diff
2.1201+ (let ((buf (current-buffer)))
2.1202+ (delete-window (selected-window))
2.1203+ (kill-buffer buf))))
2.1204+ (set-buffer obuf)
2.1205+ (when diff
2.1206+ (hg-revert-buffer-internal))))
2.1207+
2.1208+(defun hg-root (&optional path)
2.1209+ "Return the root of the repository that contains the given path.
2.1210+If the path is outside a repository, return nil.
2.1211+When called interactively, the root is printed. A prefix argument
2.1212+prompts for a path to check."
2.1213+ (interactive (list (hg-read-file-name)))
2.1214+ (if (or path (not hg-root))
2.1215+ (let ((root (do ((prev nil dir)
2.1216+ (dir (file-name-directory
2.1217+ (or
2.1218+ path
2.1219+ buffer-file-name
2.1220+ (expand-file-name default-directory)))
2.1221+ (file-name-directory (directory-file-name dir))))
2.1222+ ((equal prev dir))
2.1223+ (when (file-directory-p (concat dir ".hg"))
2.1224+ (return dir)))))
2.1225+ (when (interactive-p)
2.1226+ (if root
2.1227+ (message "The root of this repository is `%s'." root)
2.1228+ (message "The path `%s' is not in a Mercurial repository."
2.1229+ (hg-abbrev-file-name path))))
2.1230+ root)
2.1231+ hg-root))
2.1232+
2.1233+(defun hg-cwd (&optional path)
2.1234+ "Return the current directory of PATH within the repository."
2.1235+ (do ((stack nil (cons (file-name-nondirectory
2.1236+ (directory-file-name dir))
2.1237+ stack))
2.1238+ (prev nil dir)
2.1239+ (dir (file-name-directory (or path buffer-file-name
2.1240+ (expand-file-name default-directory)))
2.1241+ (file-name-directory (directory-file-name dir))))
2.1242+ ((equal prev dir))
2.1243+ (when (file-directory-p (concat dir ".hg"))
2.1244+ (let ((cwd (mapconcat 'identity stack "/")))
2.1245+ (unless (equal cwd "")
2.1246+ (return (file-name-as-directory cwd)))))))
2.1247+
2.1248+(defun hg-status (path)
2.1249+ "Print revision control status of a file or directory.
2.1250+With prefix argument, prompt for the path to give status for.
2.1251+Names are displayed relative to the repository root."
2.1252+ (interactive (list (hg-read-file-name " for status" (hg-root))))
2.1253+ (let ((root (hg-root)))
2.1254+ (hg-view-output ((format "Mercurial: Status of %s in %s"
2.1255+ (let ((name (substring (expand-file-name path)
2.1256+ (length root))))
2.1257+ (if (> (length name) 0)
2.1258+ name
2.1259+ "*"))
2.1260+ (hg-abbrev-file-name root)))
2.1261+ (apply 'call-process (hg-binary) nil t nil
2.1262+ (list "--cwd" root "status" path))
2.1263+ (cd (hg-root path)))))
2.1264+
2.1265+(defun hg-undo ()
2.1266+ (interactive)
2.1267+ (error "not implemented"))
2.1268+
2.1269+(defun hg-update ()
2.1270+ (interactive)
2.1271+ (error "not implemented"))
2.1272+
2.1273+(defun hg-version-other-window (rev)
2.1274+ "Visit version REV of the current file in another window.
2.1275+If the current file is named `F', the version is named `F.~REV~'.
2.1276+If `F.~REV~' already exists, use it instead of checking it out again."
2.1277+ (interactive "sVersion to visit (default is workfile version): ")
2.1278+ (let* ((file buffer-file-name)
2.1279+ (version (if (string-equal rev "")
2.1280+ "tip"
2.1281+ rev))
2.1282+ (automatic-backup (vc-version-backup-file-name file version))
2.1283+ (manual-backup (vc-version-backup-file-name file version 'manual)))
2.1284+ (unless (file-exists-p manual-backup)
2.1285+ (if (file-exists-p automatic-backup)
2.1286+ (rename-file automatic-backup manual-backup nil)
2.1287+ (hg-run0 "-q" "cat" "-r" version "-o" manual-backup file)))
2.1288+ (find-file-other-window manual-backup)))
2.1289+
2.1290+
2.1291+(provide 'mercurial)
2.1292+
2.1293+
2.1294+;;; Local Variables:
2.1295+;;; prompt-to-byte-compile: nil
2.1296+;;; end:
3.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
3.2+++ b/.emacs.d/lib/mq.el Sat Jun 15 19:57:38 2024 -0400
3.3@@ -0,0 +1,417 @@
3.4+;;; mq.el --- Emacs support for Mercurial Queues
3.5+
3.6+;; Copyright (C) 2006 Bryan O'Sullivan
3.7+
3.8+;; Author: Bryan O'Sullivan <bos@serpentine.com>
3.9+
3.10+;; mq.el is free software; you can redistribute it and/or modify it
3.11+;; under the terms of the GNU General Public License version 2 or any
3.12+;; later version.
3.13+
3.14+;; mq.el is distributed in the hope that it will be useful, but
3.15+;; WITHOUT ANY WARRANTY; without even the implied warranty of
3.16+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3.17+;; General Public License for more details.
3.18+
3.19+;; You should have received a copy of the GNU General Public License
3.20+;; along with mq.el, GNU Emacs, or XEmacs; see the file COPYING (`C-h
3.21+;; C-l'). If not, see <http://www.gnu.org/licenses/>.
3.22+
3.23+(eval-when-compile (require 'cl))
3.24+(require 'mercurial)
3.25+
3.26+
3.27+(defcustom mq-mode-hook nil
3.28+ "Hook run when a buffer enters mq-mode."
3.29+ :type 'sexp
3.30+ :group 'mercurial)
3.31+
3.32+(defcustom mq-global-prefix "\C-cq"
3.33+ "The global prefix for Mercurial Queues keymap bindings."
3.34+ :type 'sexp
3.35+ :group 'mercurial)
3.36+
3.37+(defcustom mq-edit-mode-hook nil
3.38+ "Hook run after a buffer is populated to edit a patch description."
3.39+ :type 'sexp
3.40+ :group 'mercurial)
3.41+
3.42+(defcustom mq-edit-finish-hook nil
3.43+ "Hook run before a patch description is finished up with."
3.44+ :type 'sexp
3.45+ :group 'mercurial)
3.46+
3.47+(defcustom mq-signoff-address nil
3.48+ "Address with which to sign off on a patch."
3.49+ :type 'string
3.50+ :group 'mercurial)
3.51+
3.52+
3.53+;;; Internal variables.
3.54+
3.55+(defvar mq-mode nil
3.56+ "Is this file managed by MQ?")
3.57+(make-variable-buffer-local 'mq-mode)
3.58+(put 'mq-mode 'permanent-local t)
3.59+
3.60+(defvar mq-patch-history nil)
3.61+
3.62+(defvar mq-top-patch '(nil))
3.63+
3.64+(defvar mq-prev-buffer nil)
3.65+(make-variable-buffer-local 'mq-prev-buffer)
3.66+(put 'mq-prev-buffer 'permanent-local t)
3.67+
3.68+(defvar mq-top nil)
3.69+(make-variable-buffer-local 'mq-top)
3.70+(put 'mq-top 'permanent-local t)
3.71+
3.72+;;; Global keymap.
3.73+
3.74+(defvar mq-global-map
3.75+ (let ((map (make-sparse-keymap)))
3.76+ (define-key map "." 'mq-push)
3.77+ (define-key map ">" 'mq-push-all)
3.78+ (define-key map "," 'mq-pop)
3.79+ (define-key map "<" 'mq-pop-all)
3.80+ (define-key map "=" 'mq-diff)
3.81+ (define-key map "r" 'mq-refresh)
3.82+ (define-key map "e" 'mq-refresh-edit)
3.83+ (define-key map "i" 'mq-new)
3.84+ (define-key map "n" 'mq-next)
3.85+ (define-key map "o" 'mq-signoff)
3.86+ (define-key map "p" 'mq-previous)
3.87+ (define-key map "s" 'mq-edit-series)
3.88+ (define-key map "t" 'mq-top)
3.89+ map))
3.90+
3.91+(global-set-key mq-global-prefix mq-global-map)
3.92+
3.93+(add-minor-mode 'mq-mode 'mq-mode)
3.94+
3.95+
3.96+;;; Refresh edit mode keymap.
3.97+
3.98+(defvar mq-edit-mode-map
3.99+ (let ((map (make-sparse-keymap)))
3.100+ (define-key map "\C-c\C-c" 'mq-edit-finish)
3.101+ (define-key map "\C-c\C-k" 'mq-edit-kill)
3.102+ (define-key map "\C-c\C-s" 'mq-signoff)
3.103+ map))
3.104+
3.105+
3.106+;;; Helper functions.
3.107+
3.108+(defun mq-read-patch-name (&optional source prompt force)
3.109+ "Read a patch name to use with a command.
3.110+May return nil, meaning \"use the default\"."
3.111+ (let ((patches (split-string
3.112+ (hg-chomp (hg-run0 (or source "qseries"))) "\n")))
3.113+ (when force
3.114+ (completing-read (format "Patch%s: " (or prompt ""))
3.115+ (mapcar (lambda (x) (cons x x)) patches)
3.116+ nil
3.117+ nil
3.118+ nil
3.119+ 'mq-patch-history))))
3.120+
3.121+(defun mq-refresh-buffers (root)
3.122+ (save-excursion
3.123+ (dolist (buf (hg-buffers-visiting-repo root))
3.124+ (when (not (verify-visited-file-modtime buf))
3.125+ (set-buffer buf)
3.126+ (let ((ctx (hg-buffer-context)))
3.127+ (message "Refreshing %s..." (buffer-name))
3.128+ (revert-buffer t t t)
3.129+ (hg-restore-context ctx)
3.130+ (message "Refreshing %s...done" (buffer-name))))))
3.131+ (hg-update-mode-lines root)
3.132+ (mq-update-mode-lines root))
3.133+
3.134+(defun mq-last-line ()
3.135+ (goto-char (point-max))
3.136+ (beginning-of-line)
3.137+ (when (looking-at "^$")
3.138+ (forward-line -1))
3.139+ (let ((bol (point)))
3.140+ (end-of-line)
3.141+ (let ((line (buffer-substring bol (point))))
3.142+ (when (> (length line) 0)
3.143+ line))))
3.144+
3.145+(defun mq-push (&optional patch)
3.146+ "Push patches until PATCH is reached.
3.147+If PATCH is nil, push at most one patch."
3.148+ (interactive (list (mq-read-patch-name "qunapplied" " to push"
3.149+ current-prefix-arg)))
3.150+ (let ((root (hg-root))
3.151+ (prev-buf (current-buffer))
3.152+ last-line ok)
3.153+ (unless root
3.154+ (error "Cannot push outside a repository!"))
3.155+ (hg-sync-buffers root)
3.156+ (let ((buf-name (format "MQ: Push %s" (or patch "next patch"))))
3.157+ (kill-buffer (get-buffer-create buf-name))
3.158+ (split-window-vertically)
3.159+ (other-window 1)
3.160+ (switch-to-buffer (get-buffer-create buf-name))
3.161+ (cd root)
3.162+ (message "Pushing...")
3.163+ (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpush"
3.164+ (if patch (list patch))))
3.165+ last-line (mq-last-line))
3.166+ (let ((lines (count-lines (point-min) (point-max))))
3.167+ (if (or (<= lines 1)
3.168+ (and (equal lines 2) (string-match "Now at:" last-line)))
3.169+ (progn
3.170+ (kill-buffer (current-buffer))
3.171+ (delete-window))
3.172+ (hg-view-mode prev-buf))))
3.173+ (mq-refresh-buffers root)
3.174+ (sit-for 0)
3.175+ (when last-line
3.176+ (if ok
3.177+ (message "Pushing... %s" last-line)
3.178+ (error "Pushing... %s" last-line)))))
3.179+
3.180+(defun mq-push-all ()
3.181+ "Push patches until all are applied."
3.182+ (interactive)
3.183+ (mq-push "-a"))
3.184+
3.185+(defun mq-pop (&optional patch)
3.186+ "Pop patches until PATCH is reached.
3.187+If PATCH is nil, pop at most one patch."
3.188+ (interactive (list (mq-read-patch-name "qapplied" " to pop to"
3.189+ current-prefix-arg)))
3.190+ (let ((root (hg-root))
3.191+ last-line ok)
3.192+ (unless root
3.193+ (error "Cannot pop outside a repository!"))
3.194+ (hg-sync-buffers root)
3.195+ (set-buffer (generate-new-buffer "qpop"))
3.196+ (cd root)
3.197+ (message "Popping...")
3.198+ (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpop"
3.199+ (if patch (list patch))))
3.200+ last-line (mq-last-line))
3.201+ (kill-buffer (current-buffer))
3.202+ (mq-refresh-buffers root)
3.203+ (sit-for 0)
3.204+ (when last-line
3.205+ (if ok
3.206+ (message "Popping... %s" last-line)
3.207+ (error "Popping... %s" last-line)))))
3.208+
3.209+(defun mq-pop-all ()
3.210+ "Push patches until none are applied."
3.211+ (interactive)
3.212+ (mq-pop "-a"))
3.213+
3.214+(defun mq-refresh-internal (root &rest args)
3.215+ (hg-sync-buffers root)
3.216+ (let ((patch (mq-patch-info "qtop")))
3.217+ (message "Refreshing %s..." patch)
3.218+ (let ((ret (apply 'hg-run "qrefresh" args)))
3.219+ (if (equal (car ret) 0)
3.220+ (message "Refreshing %s... done." patch)
3.221+ (error "Refreshing %s... %s" patch (hg-chomp (cdr ret)))))))
3.222+
3.223+(defun mq-refresh (&optional git)
3.224+ "Refresh the topmost applied patch.
3.225+With a prefix argument, generate a git-compatible patch."
3.226+ (interactive "P")
3.227+ (let ((root (hg-root)))
3.228+ (unless root
3.229+ (error "Cannot refresh outside of a repository!"))
3.230+ (apply 'mq-refresh-internal root (if git '("--git")))))
3.231+
3.232+(defun mq-patch-info (cmd &optional msg)
3.233+ (let* ((ret (hg-run cmd))
3.234+ (info (hg-chomp (cdr ret))))
3.235+ (if (equal (car ret) 0)
3.236+ (if msg
3.237+ (message "%s patch: %s" msg info)
3.238+ info)
3.239+ (error "%s" info))))
3.240+
3.241+(defun mq-top ()
3.242+ "Print the name of the topmost applied patch."
3.243+ (interactive)
3.244+ (mq-patch-info "qtop" "Top"))
3.245+
3.246+(defun mq-next ()
3.247+ "Print the name of the next patch to be pushed."
3.248+ (interactive)
3.249+ (mq-patch-info "qnext" "Next"))
3.250+
3.251+(defun mq-previous ()
3.252+ "Print the name of the first patch below the topmost applied patch.
3.253+This would become the active patch if popped to."
3.254+ (interactive)
3.255+ (mq-patch-info "qprev" "Previous"))
3.256+
3.257+(defun mq-edit-finish ()
3.258+ "Finish editing the description of this patch, and refresh the patch."
3.259+ (interactive)
3.260+ (unless (equal (mq-patch-info "qtop") mq-top)
3.261+ (error "Topmost patch has changed!"))
3.262+ (hg-sync-buffers hg-root)
3.263+ (run-hooks 'mq-edit-finish-hook)
3.264+ (mq-refresh-internal hg-root "-m" (buffer-substring (point-min) (point-max)))
3.265+ (let ((buf mq-prev-buffer))
3.266+ (kill-buffer nil)
3.267+ (switch-to-buffer buf)))
3.268+
3.269+(defun mq-edit-kill ()
3.270+ "Kill the edit currently being prepared."
3.271+ (interactive)
3.272+ (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this edit? "))
3.273+ (let ((buf mq-prev-buffer))
3.274+ (kill-buffer nil)
3.275+ (switch-to-buffer buf))))
3.276+
3.277+(defun mq-get-top (root)
3.278+ (let ((entry (assoc root mq-top-patch)))
3.279+ (if entry
3.280+ (cdr entry))))
3.281+
3.282+(defun mq-set-top (root patch)
3.283+ (let ((entry (assoc root mq-top-patch)))
3.284+ (if entry
3.285+ (if patch
3.286+ (setcdr entry patch)
3.287+ (setq mq-top-patch (delq entry mq-top-patch)))
3.288+ (setq mq-top-patch (cons (cons root patch) mq-top-patch)))))
3.289+
3.290+(defun mq-update-mode-lines (root)
3.291+ (let ((cwd default-directory))
3.292+ (cd root)
3.293+ (condition-case nil
3.294+ (mq-set-top root (mq-patch-info "qtop"))
3.295+ (error (mq-set-top root nil)))
3.296+ (cd cwd))
3.297+ (let ((patch (mq-get-top root)))
3.298+ (save-excursion
3.299+ (dolist (buf (hg-buffers-visiting-repo root))
3.300+ (set-buffer buf)
3.301+ (if mq-mode
3.302+ (setq mq-mode (or (and patch (concat " MQ:" patch)) " MQ")))))))
3.303+
3.304+(defun mq-mode (&optional arg)
3.305+ "Minor mode for Mercurial repositories with an MQ patch queue"
3.306+ (interactive "i")
3.307+ (cond ((hg-root)
3.308+ (setq mq-mode (if (null arg) (not mq-mode)
3.309+ arg))
3.310+ (mq-update-mode-lines (hg-root))))
3.311+ (run-hooks 'mq-mode-hook))
3.312+
3.313+(defun mq-edit-mode ()
3.314+ "Mode for editing the description of a patch.
3.315+
3.316+Key bindings
3.317+------------
3.318+\\[mq-edit-finish] use this description
3.319+\\[mq-edit-kill] abandon this description"
3.320+ (interactive)
3.321+ (use-local-map mq-edit-mode-map)
3.322+ (set-syntax-table text-mode-syntax-table)
3.323+ (setq local-abbrev-table text-mode-abbrev-table
3.324+ major-mode 'mq-edit-mode
3.325+ mode-name "MQ-Edit")
3.326+ (set-buffer-modified-p nil)
3.327+ (setq buffer-undo-list nil)
3.328+ (run-hooks 'text-mode-hook 'mq-edit-mode-hook))
3.329+
3.330+(defun mq-refresh-edit ()
3.331+ "Refresh the topmost applied patch, editing the patch description."
3.332+ (interactive)
3.333+ (while mq-prev-buffer
3.334+ (set-buffer mq-prev-buffer))
3.335+ (let ((root (hg-root))
3.336+ (prev-buffer (current-buffer))
3.337+ (patch (mq-patch-info "qtop")))
3.338+ (hg-sync-buffers root)
3.339+ (let ((buf-name (format "*MQ: Edit description of %s*" patch)))
3.340+ (switch-to-buffer (get-buffer-create buf-name))
3.341+ (when (= (point-min) (point-max))
3.342+ (set (make-local-variable 'hg-root) root)
3.343+ (set (make-local-variable 'mq-top) patch)
3.344+ (setq mq-prev-buffer prev-buffer)
3.345+ (insert (hg-run0 "qheader"))
3.346+ (goto-char (point-min)))
3.347+ (mq-edit-mode)
3.348+ (cd root)))
3.349+ (message "Type `C-c C-c' to finish editing and refresh the patch."))
3.350+
3.351+(defun mq-new (name)
3.352+ "Create a new empty patch named NAME.
3.353+The patch is applied on top of the current topmost patch.
3.354+With a prefix argument, forcibly create the patch even if the working
3.355+directory is modified."
3.356+ (interactive (list (mq-read-patch-name "qseries" " to create" t)))
3.357+ (message "Creating patch...")
3.358+ (let ((ret (if current-prefix-arg
3.359+ (hg-run "qnew" "-f" name)
3.360+ (hg-run "qnew" name))))
3.361+ (if (equal (car ret) 0)
3.362+ (progn
3.363+ (hg-update-mode-lines (buffer-file-name))
3.364+ (message "Creating patch... done."))
3.365+ (error "Creating patch... %s" (hg-chomp (cdr ret))))))
3.366+
3.367+(defun mq-edit-series ()
3.368+ "Edit the MQ series file directly."
3.369+ (interactive)
3.370+ (let ((root (hg-root)))
3.371+ (unless root
3.372+ (error "Not in an MQ repository!"))
3.373+ (find-file (concat root ".hg/patches/series"))))
3.374+
3.375+(defun mq-diff (&optional git)
3.376+ "Display a diff of the topmost applied patch.
3.377+With a prefix argument, display a git-compatible diff."
3.378+ (interactive "P")
3.379+ (hg-view-output ((format "MQ: Diff of %s" (mq-patch-info "qtop")))
3.380+ (if git
3.381+ (call-process (hg-binary) nil t nil "qdiff" "--git")
3.382+ (call-process (hg-binary) nil t nil "qdiff"))
3.383+ (diff-mode)
3.384+ (font-lock-fontify-buffer)))
3.385+
3.386+(defun mq-signoff ()
3.387+ "Sign off on the current patch, in the style used by the Linux kernel.
3.388+If the variable mq-signoff-address is non-nil, it will be used, otherwise
3.389+the value of the ui.username item from your hgrc will be used."
3.390+ (interactive)
3.391+ (let ((was-editing (eq major-mode 'mq-edit-mode))
3.392+ signed)
3.393+ (unless was-editing
3.394+ (mq-refresh-edit))
3.395+ (save-excursion
3.396+ (let* ((user (or mq-signoff-address
3.397+ (hg-run0 "debugconfig" "ui.username")))
3.398+ (signoff (concat "Signed-off-by: " user)))
3.399+ (if (search-forward signoff nil t)
3.400+ (message "You have already signed off on this patch.")
3.401+ (goto-char (point-max))
3.402+ (let ((case-fold-search t))
3.403+ (if (re-search-backward "^Signed-off-by: " nil t)
3.404+ (forward-line 1)
3.405+ (insert "\n")))
3.406+ (insert signoff)
3.407+ (message "%s" signoff)
3.408+ (setq signed t))))
3.409+ (unless was-editing
3.410+ (if signed
3.411+ (mq-edit-finish)
3.412+ (mq-edit-kill)))))
3.413+
3.414+
3.415+(provide 'mq)
3.416+
3.417+
3.418+;;; Local Variables:
3.419+;;; prompt-to-byte-compile: nil
3.420+;;; end:
