PageRenderTime 139ms CodeModel.GetById 35ms app.highlight 78ms RepoModel.GetById 1ms app.codeStats 2ms

/monky.el

http://github.com/ananthakumaran/monky
Emacs Lisp | 3276 lines | 2749 code | 432 blank | 95 comment | 54 complexity | 863a30ac743630b265f81a214c3a9723 MD5 | raw file

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

   1;;; monky.el --- Control Hg from Emacs.  -*- lexical-binding: t; -*-
   2
   3;; Copyright (C) 2011 Anantha Kumaran.
   4
   5;; Author: Anantha kumaran <ananthakumaran@gmail.com>
   6;; URL: http://github.com/ananthakumaran/monky
   7;; Version: 0.2
   8;; Keywords: tools
   9
  10;; Monky is free software: you can redistribute it and/or modify it
  11;; under the terms of the GNU General Public License as published by
  12;; the Free Software Foundation, either version 3 of the License, or
  13;; (at your option) any later version.
  14
  15;; Monky is distributed in the hope that it will be useful, but
  16;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18;; General Public License for more details.
  19
  20;; You should have received a copy of the GNU General Public License
  21;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23;;; Commentary:
  24
  25;;; Code:
  26
  27(require 'cl)
  28(require 'cl-lib)
  29(require 'bindat)
  30(require 'ediff)
  31(require 'subr-x)
  32(require 'view)
  33(require 'tramp)
  34
  35(defgroup monky nil
  36  "Controlling Hg from Emacs."
  37  :prefix "monky-"
  38  :group 'tools)
  39
  40(defcustom monky-hg-executable "hg"
  41  "The name of the Hg executable."
  42  :group 'monky
  43  :type 'string)
  44
  45(defcustom monky-hg-standard-options '("--config" "diff.git=Off" "--config" "ui.merge=:merge")
  46  "Standard options when running Hg."
  47  :group 'monky
  48  :type '(repeat string))
  49
  50(defcustom monky-hg-process-environment '("TERM=dumb" "HGPLAIN=" "LANGUAGE=C")
  51  "Default environment variables for hg."
  52  :group 'monky
  53  :type '(repeat string))
  54
  55;; TODO
  56(defcustom monky-save-some-buffers t
  57  "Non-nil means that \\[monky-status] will save modified buffers before running.
  58Setting this to t will ask which buffers to save, setting it to 'dontask will
  59save all modified buffers without asking."
  60  :group 'monky
  61  :type '(choice (const :tag "Never" nil)
  62                 (const :tag "Ask" t)
  63                 (const :tag "Save without asking" dontask)))
  64
  65(defcustom monky-revert-item-confirm t
  66  "Require acknowledgment before reverting an item."
  67  :group 'monky
  68  :type 'boolean)
  69
  70(defcustom monky-log-edit-confirm-cancellation nil
  71  "Require acknowledgment before canceling the log edit buffer."
  72  :group 'monky
  73  :type 'boolean)
  74
  75(defcustom monky-process-popup-time -1
  76  "Popup the process buffer if a command takes longer than this many seconds."
  77  :group 'monky
  78  :type '(choice (const :tag "Never" -1)
  79                 (const :tag "Immediately" 0)
  80                 (integer :tag "After this many seconds")))
  81
  82(defcustom monky-log-cutoff-length 100
  83  "The maximum number of commits to show in the log buffer."
  84  :group 'monky
  85  :type 'integer)
  86
  87(defcustom monky-log-infinite-length 99999
  88  "Number of log used to show as maximum for `monky-log-cutoff-length'."
  89  :group 'monky
  90  :type 'integer)
  91
  92(defcustom monky-log-auto-more t
  93  "Insert more log entries automatically when moving past the last entry.
  94
  95Only considered when moving past the last entry with `monky-goto-next-section'."
  96  :group 'monky
  97  :type 'boolean)
  98
  99(defcustom monky-incoming-repository "default"
 100  "The repository from which changes are pulled from by default."
 101  :group 'monky
 102  :type 'string)
 103
 104(defcustom monky-outgoing-repository ""
 105  "The repository to which changes are pushed to by default."
 106  :group 'monky
 107  :type 'string)
 108
 109(defcustom monky-process-type nil
 110  "How monky spawns Mercurial processes.
 111Monky can either spawn a new Mercurial process for each request or
 112use Mercurial's command server feature to run several commands in a
 113single process instances. While the former is more robust, the latter
 114is usually faster if Monky runs several commands."
 115  :group 'monky
 116  :type '(choice (const :tag "Single processes" :value nil)
 117                 (const :tag "Use command server" :value cmdserver)))
 118
 119(defcustom monky-pull-args ()
 120  "Extra args to pass to pull."
 121  :group 'monky
 122  :type '(repeat string))
 123
 124(defcustom monky-repository-paths nil
 125  "*Paths where to find repositories.  For each repository an alias is defined, which can then be passed to `monky-open-repository` to open the repository.
 126
 127Lisp-type of this option: The value must be a list L whereas each
 128element of L is a 2-element list: The first element is the full
 129path of a directory \(string) and the second element is an
 130arbitrary alias \(string) for this directory which is then
 131displayed instead of the underlying directory."
 132  :group 'monky
 133  :initialize 'custom-initialize-default
 134  :set (function (lambda (symbol value)
 135                   (set symbol value)
 136                   (if (and (boundp 'ecb-minor-mode)
 137                            ecb-minor-mode
 138			    (functionp 'ecb-update-directories-buffer))
 139		       (ecb-update-directories-buffer))))
 140  :type '(repeat (cons :tag "Path with alias"
 141		       (string :tag "Alias")
 142		       (directory :tag "Path"))))
 143
 144(defun monky-root-dir-descr (dir)
 145  "Return the name of dir if it matches a path in monky-repository-paths, otherwise return nil"
 146  (catch 'exit
 147    (dolist (root-dir monky-repository-paths)
 148      (let ((base-dir
 149	     (concat
 150	      (replace-regexp-in-string
 151	       "/$" ""
 152	       (replace-regexp-in-string
 153		"^\~" (getenv "HOME")
 154		(cdr root-dir)))
 155	      "/")))
 156	(when (equal base-dir dir)
 157	  (throw 'exit (cons (car root-dir)
 158			     base-dir)))))))
 159
 160(defun monky-open-repository ()
 161  "Prompt for a repository path or alias, then display the status
 162buffer.  Aliases are set in monky-repository-paths."
 163  (interactive)
 164  (let* ((rootdir (condition-case nil
 165		      (monky-get-root-dir)
 166		    (error nil)))
 167	 (default-repo (or (monky-root-dir-descr rootdir) rootdir))
 168	 (msg (if default-repo
 169		  (concat "repository (default " (car default-repo) "): ")
 170		"repository: "))
 171	 (repo-name (completing-read msg (mapcar 'car monky-repository-paths)))
 172	 (repo (or (assoc repo-name monky-repository-paths) default-repo)))
 173    (when repo (monky-status (cdr repo)))))
 174
 175(defgroup monky-faces nil
 176  "Customize the appearance of Monky"
 177  :prefix "monky-"
 178  :group 'faces
 179  :group 'monky)
 180
 181(defface monky-header
 182  '((t :weight bold))
 183  "Face for generic header lines.
 184
 185Many Monky faces inherit from this one by default."
 186  :group 'monky-faces)
 187
 188(defface monky-section-title
 189  '((((class color) (background light)) :foreground "DarkGoldenrod4" :inherit monky-header)
 190    (((class color) (background  dark)) :foreground "LightGoldenrod2" :inherit monky-header))
 191  "Face for section titles."
 192  :group 'monky-faces)
 193
 194(defface monky-branch
 195  '((t :weight bold :inherit monky-header))
 196  "Face for the current branch."
 197  :group 'monky-faces)
 198
 199(defface monky-diff-title
 200  '((t :inherit (monky-header)))
 201  "Face for diff title lines."
 202  :group 'monky-faces)
 203
 204(defface monky-diff-hunk-header
 205  '((((class color) (background light))
 206     :background "grey80"
 207     :foreground "grey30")
 208    (((class color) (background dark))
 209     :background "grey25"
 210     :foreground "grey70"))
 211  "Face for diff hunk header lines."
 212  :group 'monky-faces)
 213
 214(defface monky-diff-add
 215  '((((class color) (background light))
 216     :background "#cceecc"
 217     :foreground "#22aa22")
 218    (((class color) (background dark))
 219     :background "#336633"
 220     :foreground "#cceecc"))
 221  "Face for lines in a diff that have been added."
 222  :group 'monky-faces)
 223
 224(defface monky-diff-none
 225  '((t))
 226  "Face for lines in a diff that are unchanged."
 227  :group 'monky-faces)
 228
 229(defface monky-diff-del
 230  '((((class color) (background light))
 231     :background "#eecccc"
 232     :foreground "#aa2222")
 233    (((class color) (background dark))
 234     :background "#663333"
 235     :foreground "#eecccc"))
 236  "Face for lines in a diff that have been deleted."
 237  :group 'monky-faces)
 238
 239(defface monky-commit-id
 240  '((((class color) (background light))
 241     :foreground "firebrick")
 242    (((class color) (background dark))
 243     :foreground "tomato"))
 244  "Face for commit IDs: SHA1 codes and commit numbers."
 245  :group 'monky-faces)
 246
 247(defface monky-log-sha1
 248  '((t :inherit monky-commit-id))
 249  "Face for the sha1 element of the log output."
 250  :group 'monky-faces)
 251
 252(defface monky-log-message
 253  '((t))
 254  "Face for the message element of the log output."
 255  :group 'monky-faces)
 256
 257(defface monky-log-author
 258  '((((class color) (background light))
 259     :foreground "navy")
 260    (((class color) (background dark))
 261     :foreground "cornflower blue"))
 262  "Face for author shown in log buffer."
 263  :group 'monky-faces)
 264
 265(defface monky-log-head-label-local
 266  '((((class color) (background light))
 267     :box t
 268     :background "Grey85"
 269     :foreground "LightSkyBlue4")
 270    (((class color) (background dark))
 271     :box t
 272     :background "Grey13"
 273     :foreground "LightSkyBlue1"))
 274  "Face for local branch head labels shown in log buffer."
 275  :group 'monky-faces)
 276
 277(defface monky-log-head-label-tags
 278  '((((class color) (background light))
 279     :box t
 280     :background "LemonChiffon1"
 281     :foreground "goldenrod4")
 282    (((class color) (background dark))
 283     :box t
 284     :background "LemonChiffon1"
 285     :foreground "goldenrod4"))
 286  "Face for tag labels shown in log buffer."
 287  :group 'monky-faces)
 288
 289(defface monky-queue-patch
 290  '((t :weight bold :inherit (monky-header highlight)))
 291  "Face for patch name"
 292  :group 'monky-faces)
 293
 294(defface monky-log-head-label-bookmarks
 295  '((((class color) (background light))
 296     :box t
 297     :background "IndianRed1"
 298     :foreground "IndianRed4")
 299    (((class color) (background dark))
 300     :box t
 301     :background "IndianRed1"
 302     :foreground "IndianRed4"))
 303  "Face for bookmark labels shown in log buffer."
 304  :group 'monky-faces)
 305
 306(defface monky-log-head-label-phase
 307  '((((class color) (background light))
 308     :box t
 309     :background "light green"
 310     :foreground "dark olive green")
 311    (((class color) (background dark))
 312     :box t
 313     :background "light green"
 314     :foreground "dark olive green"))
 315  "Face for phase label shown in log buffer."
 316  :group 'monky-faces)
 317
 318(defface monky-log-date
 319  '((t :weight bold :inherit monky-header))
 320  "Face for date in log."
 321  :group 'monky-faces)
 322
 323(defface monky-queue-active
 324  '((((class color) (background light))
 325     :box t
 326     :background "light green"
 327     :foreground "dark olive green")
 328    (((class color) (background dark))
 329     :box t
 330     :background "light green"
 331     :foreground "dark olive green"))
 332  "Face for active patch queue"
 333  :group 'monky-faces)
 334
 335(defface monky-queue-positive-guard
 336  '((((class color) (background light))
 337     :box t
 338     :background "light green"
 339     :foreground "dark olive green")
 340    (((class color) (background dark))
 341     :box t
 342     :background "light green"
 343     :foreground "dark olive green"))
 344  "Face for queue postive guards"
 345  :group 'monky-faces)
 346
 347(defface monky-queue-negative-guard
 348  '((((class color) (background light))
 349     :box t
 350     :background "IndianRed1"
 351     :foreground "IndianRed4")
 352    (((class color) (background dark))
 353     :box t
 354     :background "IndianRed1"
 355     :foreground "IndianRed4"))
 356  "Face for queue negative guards"
 357  :group 'monky-faces)
 358
 359(defvar monky-mode-hook nil
 360  "Hook run by `monky-mode'.")
 361
 362;;; User facing configuration
 363
 364(put 'monky-mode 'mode-class 'special)
 365
 366;;; Compatibilities
 367
 368(eval-when-compile
 369  (when (< emacs-major-version 23)
 370    (defvar line-move-visual nil)))
 371
 372;;; Utilities
 373
 374(defmacro monky-with-process-environment (&rest body)
 375  (declare (indent 0)
 376           (debug (body)))
 377  `(let ((process-environment (append monky-hg-process-environment
 378                                      process-environment)))
 379     ,@body))
 380
 381(defmacro monky-with-refresh (&rest body)
 382  "Refresh monky buffers after evaluating BODY.
 383
 384It is safe to call the functions which uses this macro inside of
 385this macro.  As it is time consuming to refresh monky buffers,
 386this macro enforces refresh to occur exactly once by pending
 387refreshes inside of this macro.  Nested calls of this
 388macro (possibly via functions) does not refresh buffers multiple
 389times.  Instead, only the outside-most call of this macro
 390refreshes buffers."
 391  (declare (indent 0)
 392           (debug (body)))
 393  `(monky-refresh-wrapper (lambda () ,@body)))
 394
 395(defun monky-completing-read (&rest args)
 396  (apply (if (null ido-mode)
 397             'completing-read
 398           'ido-completing-read)
 399         args))
 400
 401(defun monky-start-process (&rest args)
 402  (monky-with-process-environment
 403    (apply (if (functionp 'start-file-process)
 404               'start-file-process
 405             'start-process) args)))
 406
 407(defun monky-process-file-single (&rest args)
 408  (monky-with-process-environment
 409    (apply 'process-file args)))
 410
 411
 412;; Command server
 413(defvar monky-process nil)
 414(defvar monky-process-buffer-name "*monky-process*")
 415(defvar monky-process-client-buffer nil)
 416
 417(defvar monky-cmd-process nil)
 418(defvar monky-cmd-process-buffer-name "*monky-cmd-process*")
 419(defvar monky-cmd-process-input-buffer nil)
 420(defvar monky-cmd-process-input-point nil)
 421(defvar monky-cmd-error-message nil)
 422(defvar monky-cmd-hello-message nil
 423  "Variable to store parsed hello message.")
 424
 425;; TODO: does this need to be permanent? If it's only used in monky buffers (not source file buffers), it shouldn't be.
 426(defvar-local monky-root-dir nil)
 427(put 'monky-root-dir 'permanent-local t)
 428
 429(defun monky-cmdserver-sentinel (proc _change)
 430  (unless (memq (process-status proc) '(run stop))
 431    (delete-process proc)))
 432
 433(defun monky-cmdserver-read-data (size)
 434  (with-current-buffer (process-buffer monky-cmd-process)
 435    (while (< (point-max) size)
 436      (accept-process-output monky-cmd-process 0.1 nil t))
 437    (let ((str (buffer-substring (point-min) (+ (point-min) size))))
 438      (delete-region (point-min) (+ (point-min) size))
 439      (goto-char (point-min))
 440      (vconcat str))))
 441
 442(defun monky-cmdserver-read ()
 443  "Read one channel and return cons (CHANNEL . RAW-DATA)."
 444  (let* ((data (bindat-unpack '((channel byte) (len u32))
 445                              (monky-cmdserver-read-data 5)))
 446         (channel (bindat-get-field data 'channel))
 447         (len (bindat-get-field data 'len)))
 448    (cons channel (monky-cmdserver-read-data len))))
 449
 450(defun monky-cmdserver-unpack-int (data)
 451  (bindat-get-field (bindat-unpack '((field u32)) data) 'field))
 452
 453(defun monky-cmdserver-unpack-string (data)
 454  (bindat-get-field (bindat-unpack `((field str ,(length data))) data) 'field))
 455
 456(defun monky-cmdserver-write (data)
 457  (process-send-string monky-cmd-process
 458                       (concat (bindat-pack '((len u32))
 459                                            `((len . ,(length data))))
 460                               data)))
 461
 462(defun monky-cmdserver-start ()
 463  (unless monky-root-dir
 464    (let (monky-process monky-process-type)
 465      (setq monky-root-dir (monky-get-root-dir))))
 466
 467  (let ((dir monky-root-dir)
 468        (buf (get-buffer-create monky-cmd-process-buffer-name))
 469        (default-directory monky-root-dir)
 470        (process-connection-type nil))
 471    (with-current-buffer buf
 472      (setq buffer-read-only nil)
 473      (setq buffer-file-coding-system 'no-conversion)
 474      (set-buffer-multibyte nil)
 475      (erase-buffer)
 476      (setq view-exit-action
 477            #'(lambda (buffer)
 478                (with-current-buffer buffer
 479                  (bury-buffer))))
 480      (setq default-directory dir)
 481      (let ((monky-cmd-process (monky-start-process
 482                                "monky-hg" buf "sh" "-c"
 483                                (format "%s --config extensions.mq= serve --cmdserver pipe 2> /dev/null" monky-hg-executable))))
 484        (set-process-coding-system monky-cmd-process 'no-conversion 'no-conversion)
 485        (set-process-sentinel monky-cmd-process #'monky-cmdserver-sentinel)
 486        (setq monky-cmd-hello-message
 487              (monky-cmdserver-parse-hello (monky-cmdserver-read)))
 488        monky-cmd-process))))
 489
 490(defun monky-cmdserver-parse-hello (hello-message)
 491  "Parse hello message to get encoding information."
 492  (let ((channel (car hello-message))
 493        (text (cdr hello-message)))
 494    (if (eq channel ?o)
 495        (progn
 496          (mapcar
 497           (lambda (s)
 498             (string-match "^\\([a-z0-9]+\\) *: *\\(.*\\)$" s)
 499             (let ((field-name (match-string 1 s))
 500                   (field-data (match-string 2 s)))
 501               (cons (intern field-name) field-data)))
 502           (split-string (monky-cmdserver-unpack-string text) "\n")))
 503      (error "unknown channel %c for hello message" channel))))
 504
 505(defun monky-cmdserver-get-encoding (&optional default)
 506  "Get encoding stored in `monky-cmd-hello-message'."
 507  (let ((e (assoc 'encoding monky-cmd-hello-message)))
 508    (if e
 509        (cond
 510         ((string-equal (downcase (cdr e)) "ascii")
 511          'us-ascii)
 512         (t
 513          (intern (downcase (cdr e)))))
 514      default)))
 515
 516(defun monky-cmdserver-runcommand (&rest cmd-and-args)
 517  (setq monky-cmd-error-message nil)
 518  (with-current-buffer (process-buffer monky-cmd-process)
 519    (setq buffer-read-only nil)
 520    (erase-buffer))
 521  (process-send-string monky-cmd-process "runcommand\n")
 522  (monky-cmdserver-write (mapconcat #'identity cmd-and-args "\0"))
 523  (let* ((inhibit-read-only t)
 524         (start (point))
 525         (result
 526          (catch 'finished
 527            (while t
 528              (let* ((result (monky-cmdserver-read))
 529                     (channel (car result))
 530                     (text (cdr result)))
 531                (cond
 532                 ((eq channel ?o)
 533                  (insert (monky-cmdserver-unpack-string text)))
 534                 ((eq channel ?r)
 535                  (throw 'finished
 536                         (monky-cmdserver-unpack-int text)))
 537                 ((eq channel ?e)
 538                  (setq monky-cmd-error-message
 539                        (concat monky-cmd-error-message text)))
 540                 ((memq channel '(?I ?L))
 541                  (with-current-buffer monky-cmd-process-input-buffer
 542                    (let* ((max (if (eq channel ?I)
 543                                    (point-max)
 544                                  (save-excursion
 545                                    (goto-char monky-cmd-process-input-point)
 546                                    (line-beginning-position 2))))
 547                           (maxreq (monky-cmdserver-unpack-int text))
 548                           (len (min (- max monky-cmd-process-input-point)
 549                                     maxreq))
 550                           (end (+ monky-cmd-process-input-point len)))
 551                      (monky-cmdserver-write
 552                       (buffer-substring monky-cmd-process-input-point end))
 553                      (setq monky-cmd-process-input-point end))))
 554                 (t
 555                  (setq monky-cmd-error-message
 556                        (format "Unsupported channel: %c" channel)))))))))
 557    (decode-coding-region start (point)
 558                          (monky-cmdserver-get-encoding 'utf-8))
 559    result))
 560
 561(defun monky-cmdserver-process-file (program infile buffer display &rest args)
 562  "Same as `process-file' but uses the currently active hg command-server."
 563  (if (or infile display)
 564      (apply #'monky-process-file-single program infile buffer display args)
 565    (let ((stdout (if (consp buffer) (car buffer) buffer))
 566          (stderr (and (consp buffer) (cadr buffer))))
 567      (if (eq stdout t) (setq stdout (current-buffer)))
 568      (if (eq stderr t) (setq stderr stdout))
 569      (let ((result
 570             (if stdout
 571                 (with-current-buffer stdout
 572                   (apply #'monky-cmdserver-runcommand args))
 573               (with-temp-buffer
 574                 (apply #'monky-cmdserver-runcommand args)))))
 575        (cond
 576         ((bufferp stderr)
 577          (when monky-cmd-error-message
 578            (with-current-buffer stderr
 579              (insert monky-cmd-error-message))))
 580         ((stringp stderr)
 581          (with-temp-file stderr
 582            (when monky-cmd-error-message
 583              (insert monky-cmd-error-message)))))
 584        result))))
 585
 586(defun monky-process-file (&rest args)
 587  "Same as `process-file' in the current hg environment.
 588This function either calls `monky-cmdserver-process-file' or
 589`monky-process-file-single' depending on whether the hg
 590command-server should be used."
 591  (apply (cond
 592          (monky-cmd-process #'monky-cmdserver-process-file)
 593          ;; ((eq monky-process-type 'cmdserver)
 594          ;;  (error "No process started (forget `monky-with-process`?)"))
 595          (t #'monky-process-file-single))
 596         args))
 597
 598(defmacro monky-with-process (&rest body)
 599  (declare (indent 0)
 600	   (debug (body)))
 601  `(let ((outer (not monky-cmd-process)))
 602     (when (and outer (eq monky-process-type 'cmdserver))
 603       (setq monky-cmd-process (monky-cmdserver-start)))
 604     (unwind-protect
 605	 (progn ,@body)
 606       (when (and monky-cmd-process outer (eq monky-process-type 'cmdserver))
 607	 (delete-process monky-cmd-process)
 608	 (setq monky-cmd-process nil)))))
 609
 610
 611
 612(defvar monky-bug-report-url "http://github.com/ananthakumaran/monky/issues")
 613(defun monky-bug-report (str)
 614  (message "Unknown error: %s\nPlease file a bug at %s"
 615           str monky-bug-report-url))
 616
 617(defun monky-string-starts-with-p (string prefix)
 618  (eq (compare-strings string nil (length prefix) prefix nil nil) t))
 619
 620(defun monky-trim-line (str)
 621  (if (string= str "")
 622      nil
 623    (if (equal (elt str (- (length str) 1)) ?\n)
 624        (substring str 0 (- (length str) 1))
 625      str)))
 626
 627(defun monky-delete-line (&optional end)
 628  "Delete the text in current line.
 629If END is non-nil, deletes the text including the newline character"
 630  (let ((end-point (if end
 631                       (1+ (point-at-eol))
 632                     (point-at-eol))))
 633    (delete-region (point-at-bol) end-point)))
 634
 635(defun monky-split-lines (str)
 636  (if (string= str "")
 637      nil
 638    (let ((lines (nreverse (split-string str "\n"))))
 639      (if (string= (car lines) "")
 640          (setq lines (cdr lines)))
 641      (nreverse lines))))
 642
 643(defun monky-put-line-property (prop val)
 644  (put-text-property (line-beginning-position) (line-beginning-position 2)
 645                     prop val))
 646
 647(defun monky-parse-args (command)
 648  (require 'pcomplete)
 649  (car (with-temp-buffer
 650         (insert command)
 651         (pcomplete-parse-buffer-arguments))))
 652
 653(defun monky-prefix-p (prefix list)
 654  "Return non-nil if PREFIX is a prefix of LIST.
 655PREFIX and LIST should both be lists.
 656
 657If the car of PREFIX is the symbol '*, then return non-nil if the cdr of PREFIX
 658is a sublist of LIST (as if '* matched zero or more arbitrary elements of LIST)"
 659  (or (null prefix)
 660      (if (eq (car prefix) '*)
 661          (or (monky-prefix-p (cdr prefix) list)
 662              (and (not (null list))
 663                   (monky-prefix-p prefix (cdr list))))
 664        (and (not (null list))
 665             (equal (car prefix) (car list))
 666             (monky-prefix-p (cdr prefix) (cdr list))))))
 667
 668(defun monky-wash-sequence (func)
 669  "Run FUNC until end of buffer is reached.
 670
 671FUNC should leave point at the end of the modified region"
 672  (while (and (not (eobp))
 673              (funcall func))))
 674
 675(defun monky-goto-line (line)
 676  "Like `goto-line' but doesn't set the mark."
 677  (save-restriction
 678    (widen)
 679    (goto-char 1)
 680    (forward-line (1- line))))
 681
 682;;; Key bindings
 683
 684(defvar monky-mode-map
 685  (let ((map (make-keymap)))
 686    (suppress-keymap map t)
 687    (define-key map (kbd "n") 'monky-goto-next-section)
 688    (define-key map (kbd "p") 'monky-goto-previous-section)
 689    (define-key map (kbd "RET") 'monky-visit-item)
 690    (define-key map (kbd "TAB") 'monky-toggle-section)
 691    (define-key map (kbd "SPC") 'monky-show-item-or-scroll-up)
 692    (define-key map (kbd "DEL") 'monky-show-item-or-scroll-down)
 693    (define-key map (kbd "g") 'monky-refresh)
 694    (define-key map (kbd "$") 'monky-display-process)
 695    (define-key map (kbd ":") 'monky-hg-command)
 696    (define-key map (kbd "l l") 'monky-log-current-branch)
 697    (define-key map (kbd "l a") 'monky-log-all)
 698    (define-key map (kbd "l r") 'monky-log-revset)
 699    (define-key map (kbd "b") 'monky-branches)
 700    (define-key map (kbd "Q") 'monky-queue)
 701    (define-key map (kbd "q") 'monky-quit-window)
 702
 703    (define-key map (kbd "M-1") 'monky-section-show-level-1-all)
 704    (define-key map (kbd "M-2") 'monky-section-show-level-2-all)
 705    (define-key map (kbd "M-3") 'monky-section-show-level-3-all)
 706    (define-key map (kbd "M-4") 'monky-section-show-level-4-all)
 707    map))
 708
 709(defvar monky-status-mode-map
 710  (let ((map (make-keymap)))
 711    (define-key map (kbd "s") 'monky-stage-item)
 712    (define-key map (kbd "S") 'monky-stage-all)
 713    (define-key map (kbd "u") 'monky-unstage-item)
 714    (define-key map (kbd "U") 'monky-unstage-all)
 715    (define-key map (kbd "a") 'monky-commit-amend)
 716    (define-key map (kbd "c") 'monky-log-edit)
 717    (define-key map (kbd "e") 'monky-ediff-item)
 718    (define-key map (kbd "y") 'monky-bookmark-create)
 719    (define-key map (kbd "C") 'monky-checkout)
 720    (define-key map (kbd "M") 'monky-merge)
 721    (define-key map (kbd "B") 'monky-backout)
 722    (define-key map (kbd "P") 'monky-push)
 723    (define-key map (kbd "f") 'monky-pull)
 724    (define-key map (kbd "k") 'monky-discard-item)
 725    (define-key map (kbd "m") 'monky-resolve-item)
 726    (define-key map (kbd "x") 'monky-unresolve-item)
 727    (define-key map (kbd "X") 'monky-reset-tip)
 728    (define-key map (kbd "A") 'monky-addremove-all)
 729    (define-key map (kbd "L") 'monky-rollback)
 730    map))
 731
 732(defvar monky-log-mode-map
 733  (let ((map (make-keymap)))
 734    (define-key map (kbd "e") 'monky-log-show-more-entries)
 735    (define-key map (kbd "C") 'monky-checkout-item)
 736    (define-key map (kbd "M") 'monky-merge-item)
 737    (define-key map (kbd "B") 'monky-backout-item)
 738    (define-key map (kbd "i") 'monky-qimport-item)
 739    map))
 740
 741(defvar monky-blame-mode-map
 742  (let ((map (make-keymap)))
 743    map))
 744
 745(defvar monky-branches-mode-map
 746  (let ((map (make-keymap)))
 747    (define-key map (kbd "C") 'monky-checkout-item)
 748    (define-key map (kbd "M") 'monky-merge-item)
 749    map))
 750
 751(defvar monky-commit-mode-map
 752  (let ((map (make-keymap)))
 753    map))
 754
 755(defvar monky-queue-mode-map
 756  (let ((map (make-keymap)))
 757    (define-key map (kbd "u") 'monky-qpop-item)
 758    (define-key map (kbd "U") 'monky-qpop-all)
 759    (define-key map (kbd "s") 'monky-qpush-item)
 760    (define-key map (kbd "S") 'monky-qpush-all)
 761    (define-key map (kbd "r") 'monky-qrefresh)
 762    (define-key map (kbd "R") 'monky-qrename-item)
 763    (define-key map (kbd "k") 'monky-qremove-item)
 764    (define-key map (kbd "N") 'monky-qnew)
 765    (define-key map (kbd "f") 'monky-qfinish-item)
 766    (define-key map (kbd "F") 'monky-qfinish-applied)
 767    (define-key map (kbd "d") 'monky-qfold-item)
 768    (define-key map (kbd "G") 'monky-qguard-item)
 769    (define-key map (kbd "o") 'monky-qreorder)
 770    (define-key map (kbd "A") 'monky-addremove-all)
 771    map))
 772
 773(defvar monky-pre-log-edit-window-configuration nil)
 774(defvar monky-log-edit-client-buffer nil)
 775(defvar monky-log-edit-operation nil)
 776(defvar monky-log-edit-info nil)
 777
 778(defvar monky-log-edit-mode-map
 779  (let ((map (make-sparse-keymap)))
 780    (define-key map (kbd "C-c C-c") 'monky-log-edit-commit)
 781    (define-key map (kbd "C-c C-k") 'monky-log-edit-cancel-log-message)
 782    (define-key map (kbd "C-x C-s")
 783      (lambda ()
 784        (interactive)
 785        (message "Not saved. Use C-c C-c to finalize this %s." monky-log-edit-operation)))
 786    map))
 787
 788;;; Sections
 789
 790(defvar-local monky-top-section nil)
 791(defvar monky-old-top-section nil)
 792(defvar monky-section-hidden-default nil)
 793
 794;; A buffer in monky-mode is organized into hierarchical sections.
 795;; These sections are used for navigation and for hiding parts of the
 796;; buffer.
 797;;
 798;; Most sections also represent the objects that Monky works with,
 799;; such as files, diffs, hunks, commits, etc.  The 'type' of a section
 800;; identifies what kind of object it represents (if any), and the
 801;; parent and grand-parent, etc provide the context.
 802
 803(defstruct monky-section
 804  parent children beginning end type title hidden info)
 805
 806(defun monky-set-section-info (info &optional section)
 807  (setf (monky-section-info (or section monky-top-section)) info))
 808
 809
 810(defun monky-new-section (title type)
 811  "Create a new section with title TITLE and type TYPE in current buffer.
 812
 813If not `monky-top-section' exist, the new section will be the new top-section
 814otherwise, the new-section will be a child of the current top-section.
 815
 816If TYPE is nil, the section won't be highlighted."
 817  (let* ((s (make-monky-section :parent monky-top-section
 818                                :title title
 819                                :type type
 820                                :hidden monky-section-hidden-default))
 821         (old (and monky-old-top-section
 822                   (monky-find-section (monky-section-path s)
 823                                       monky-old-top-section))))
 824    (if monky-top-section
 825        (push s (monky-section-children monky-top-section))
 826      (setq monky-top-section s))
 827    (if old
 828        (setf (monky-section-hidden s) (monky-section-hidden old)))
 829    s))
 830
 831(defmacro monky-with-section (title type &rest body)
 832  "Create a new section of title TITLE and type TYPE and evaluate BODY there.
 833
 834Sections create into BODY will be child of the new section.
 835BODY must leave point at the end of the created section.
 836
 837If TYPE is nil, the section won't be highlighted."
 838  (declare (indent 2)
 839           (debug (symbolp symbolp body)))
 840  (let ((s (make-symbol "*section*")))
 841    `(let* ((,s (monky-new-section ,title ,type))
 842            (monky-top-section ,s))
 843       (setf (monky-section-beginning ,s) (point))
 844       ,@body
 845       (setf (monky-section-end ,s) (point))
 846       (setf (monky-section-children ,s)
 847             (nreverse (monky-section-children ,s)))
 848       ,s)))
 849
 850(defmacro monky-create-buffer-sections (&rest body)
 851  "Empty current buffer of text and monky's section, and then evaluate BODY."
 852  (declare (indent 0)
 853           (debug (body)))
 854  `(let ((inhibit-read-only t))
 855     (erase-buffer)
 856     (let ((monky-old-top-section monky-top-section))
 857       (setq monky-top-section nil)
 858       ,@body
 859       (when (null monky-top-section)
 860         (monky-with-section 'top nil
 861           (insert "(empty)\n")))
 862       (monky-propertize-section monky-top-section)
 863       (monky-section-set-hidden monky-top-section
 864                                 (monky-section-hidden monky-top-section)))))
 865
 866(defun monky-propertize-section (section)
 867  "Add text-property needed for SECTION."
 868  (put-text-property (monky-section-beginning section)
 869                     (monky-section-end section)
 870                     'monky-section section)
 871  (dolist (s (monky-section-children section))
 872    (monky-propertize-section s)))
 873
 874(defun monky-find-section (path top)
 875  "Find the section at the path PATH in subsection of section TOP."
 876  (if (null path)
 877      top
 878    (let ((secs (monky-section-children top)))
 879      (while (and secs (not (equal (car path)
 880                                   (monky-section-title (car secs)))))
 881        (setq secs (cdr secs)))
 882      (and (car secs)
 883           (monky-find-section (cdr path) (car secs))))))
 884
 885(defun monky-section-path (section)
 886  "Return the path of SECTION."
 887  (if (not (monky-section-parent section))
 888      '()
 889    (append (monky-section-path (monky-section-parent section))
 890            (list (monky-section-title section)))))
 891
 892(defun monky-insert-section (section-title-and-type buffer-title washer cmd &rest args)
 893  "Run CMD and put its result in a new section.
 894
 895SECTION-TITLE-AND-TYPE is either a string that is the title of the section
 896or (TITLE . TYPE) where TITLE is the title of the section and TYPE is its type.
 897
 898If there is no type, or if type is nil, the section won't be highlighted.
 899
 900BUFFER-TITLE is the inserted title of the section
 901
 902WASHER is a function that will be run after CMD.
 903The buffer will be narrowed to the inserted text.
 904It should add sectioning as needed for monky interaction
 905
 906CMD is an external command that will be run with ARGS as arguments"
 907  (monky-with-process
 908    (let* ((body-beg nil)
 909           (section-title (if (consp section-title-and-type)
 910                              (car section-title-and-type)
 911                            section-title-and-type))
 912           (section-type (if (consp section-title-and-type)
 913                             (cdr section-title-and-type)
 914                           nil))
 915           (section (monky-with-section section-title section-type
 916                      (if buffer-title
 917                          (insert (propertize buffer-title 'face 'monky-section-title) "\n"))
 918                      (setq body-beg (point))
 919                      (apply 'monky-process-file cmd nil t nil args)
 920                      (if (not (eq (char-before) ?\n))
 921                          (insert "\n"))
 922                      (if washer
 923                          (save-restriction
 924                            (narrow-to-region body-beg (point))
 925                            (goto-char (point-min))
 926                            (funcall washer)
 927                            (goto-char (point-max)))))))
 928      (when (= body-beg (point))
 929        (monky-cancel-section section))
 930      section)))
 931
 932(defun monky-cancel-section (section)
 933  (delete-region (monky-section-beginning section)
 934                 (monky-section-end section))
 935  (let ((parent (monky-section-parent section)))
 936    (if parent
 937        (setf (monky-section-children parent)
 938              (delq section (monky-section-children parent)))
 939      (setq monky-top-section nil))))
 940
 941(defun monky-current-section ()
 942  "Return the monky section at point."
 943  (monky-section-at (point)))
 944
 945(defun monky-section-at (pos)
 946  "Return the monky section at position POS."
 947  (or (get-text-property pos 'monky-section)
 948      monky-top-section))
 949
 950(defun monky-find-section-after (pos secs)
 951  "Find the first section that begins after POS in the list SECS."
 952  (while (and secs
 953              (not (> (monky-section-beginning (car secs)) pos)))
 954    (setq secs (cdr secs)))
 955  (car secs))
 956
 957(defun monky-find-section-before (pos secs)
 958  "Find the last section that begins before POS in the list SECS."
 959  (let ((prev nil))
 960    (while (and secs
 961                (not (> (monky-section-beginning (car secs)) pos)))
 962      (setq prev (car secs))
 963      (setq secs (cdr secs)))
 964    prev))
 965
 966(defun monky-next-section (section)
 967  "Return the section that is after SECTION."
 968  (let ((parent (monky-section-parent section)))
 969    (if parent
 970        (let ((next (cadr (memq section
 971                                (monky-section-children parent)))))
 972          (or next
 973              (monky-next-section parent))))))
 974
 975(defvar-local monky-submode nil)
 976(defvar-local monky-refresh-function nil)
 977(defvar-local monky-refresh-args nil)
 978
 979(defun monky-goto-next-section ()
 980  "Go to the next monky section."
 981  (interactive)
 982  (let* ((section (monky-current-section))
 983         (next (or (and (not (monky-section-hidden section))
 984                        (monky-section-children section)
 985                        (monky-find-section-after (point)
 986                                                  (monky-section-children
 987                                                   section)))
 988                   (monky-next-section section))))
 989    (cond
 990     ((and next (eq (monky-section-type next) 'longer))
 991      (when monky-log-auto-more
 992        (monky-log-show-more-entries)
 993        (monky-goto-next-section)))
 994     (next
 995      (goto-char (monky-section-beginning next))
 996      (if (memq monky-submode '(log blame))
 997          (monky-show-commit next)))
 998     (t (message "No next section")))))
 999
1000(defun monky-prev-section (section)
1001  "Return the section that is before SECTION."
1002  (let ((parent (monky-section-parent section)))
1003    (if parent
1004        (let ((prev (cadr (memq section
1005                                (reverse (monky-section-children parent))))))
1006          (cond (prev
1007                 (while (and (not (monky-section-hidden prev))
1008                             (monky-section-children prev))
1009                   (setq prev (car (reverse (monky-section-children prev)))))
1010                 prev)
1011                (t
1012                 parent))))))
1013
1014
1015(defun monky-goto-previous-section ()
1016  "Goto the previous monky section."
1017  (interactive)
1018  (let ((section (monky-current-section)))
1019    (cond ((= (point) (monky-section-beginning section))
1020           (let ((prev (monky-prev-section (monky-current-section))))
1021             (if prev
1022                 (progn
1023                   (if (memq monky-submode '(log blame))
1024                       (monky-show-commit prev))
1025                   (goto-char (monky-section-beginning prev)))
1026               (message "No previous section"))))
1027          (t
1028           (let ((prev (monky-find-section-before (point)
1029                                                  (monky-section-children
1030                                                   section))))
1031             (if (memq monky-submode '(log blame))
1032                 (monky-show-commit (or prev section)))
1033             (goto-char (monky-section-beginning (or prev section))))))))
1034
1035
1036(defun monky-section-context-type (section)
1037  (if (null section)
1038      '()
1039    (let ((c (or (monky-section-type section)
1040                 (if (symbolp (monky-section-title section))
1041                     (monky-section-title section)))))
1042      (if c
1043          (cons c (monky-section-context-type
1044                   (monky-section-parent section)))
1045        '()))))
1046
1047(defun monky-hg-section (section-title-and-type buffer-title washer &rest args)
1048  (apply #'monky-insert-section
1049         section-title-and-type
1050         buffer-title
1051         washer
1052         monky-hg-executable
1053         (append monky-hg-standard-options args)))
1054
1055(defun monky-section-set-hidden (section hidden)
1056  "Hide SECTION if HIDDEN is not nil, show it otherwise."
1057  (setf (monky-section-hidden section) hidden)
1058  (let ((inhibit-read-only t)
1059        (beg (save-excursion
1060               (goto-char (monky-section-beginning section))
1061               (forward-line)
1062               (point)))
1063        (end (monky-section-end section)))
1064    (if (< beg end)
1065        (put-text-property beg end 'invisible hidden)))
1066  (if (not hidden)
1067      (dolist (c (monky-section-children section))
1068        (monky-section-set-hidden c (monky-section-hidden c)))))
1069
1070(defun monky-toggle-section ()
1071  "Toggle hidden status of current section."
1072  (interactive)
1073  (let ((section (monky-current-section)))
1074    (when (monky-section-parent section)
1075      (goto-char (monky-section-beginning section))
1076      (monky-section-set-hidden section (not (monky-section-hidden section))))))
1077
1078(defun monky-section-show-level-1-all ()
1079  "Collapse all the sections in the monky status buffer."
1080  (interactive)
1081  (save-excursion
1082    (goto-char (point-min))
1083    (while (not (eobp))
1084      (let ((section (monky-current-section)))
1085	(monky-section-set-hidden section t))
1086      (forward-line 1))))
1087
1088(defun monky-section-show-level-2-all ()
1089  "Show all the files changes, but not their contents."
1090  (interactive)
1091  (save-excursion
1092    (goto-char (point-min))
1093    (while (not (eobp))
1094      (let ((section (monky-current-section)))
1095	(if (memq (monky-section-type section) (list 'hunk 'diff))
1096	    (monky-section-set-hidden section t)
1097	  (monky-section-set-hidden section nil)))
1098      (forward-line 1))))
1099
1100(defun monky-section-show-level-3-all ()
1101  "Expand all file contents and line numbers, but not the actual changes."
1102  (interactive)
1103  (save-excursion
1104    (goto-char (point-min))
1105    (while (not (eobp))
1106      (let ((section (monky-current-section)))
1107	(if (memq (monky-section-type section) (list 'hunk))
1108	    (monky-section-set-hidden section t)
1109	  (monky-section-set-hidden section nil)))
1110      (forward-line 1))))
1111
1112(defun monky-section-show-level-4-all ()
1113  "Expand all sections."
1114  (interactive)
1115  (save-excursion
1116    (goto-char (point-min))
1117    (while (not (eobp))
1118      (let ((section (monky-current-section)))
1119	(monky-section-set-hidden section nil))
1120      (forward-line 1))))
1121
1122;;; Running commands
1123
1124(defun monky-set-mode-line-process (str)
1125  (let ((pr (if str (concat " " str) "")))
1126    (save-excursion
1127      (monky-for-all-buffers (lambda ()
1128                               (setq mode-line-process pr))))))
1129
1130(defun monky-process-indicator-from-command (comps)
1131  (if (monky-prefix-p (cons monky-hg-executable monky-hg-standard-options)
1132                      comps)
1133      (setq comps (nthcdr (+ (length monky-hg-standard-options) 1) comps)))
1134  (car comps))
1135
1136(defun monky-run* (cmd-and-args
1137		   &optional logline noerase noerror nowait input)
1138  (if (and monky-process
1139           (get-buffer monky-process-buffer-name))
1140      (error "Hg is already running"))
1141  (let ((cmd (car cmd-and-args))
1142        (args (cdr cmd-and-args))
1143        (dir default-directory)
1144        (buf (get-buffer-create monky-process-buffer-name))
1145        (successp nil))
1146    (monky-set-mode-line-process
1147     (monky-process-indicator-from-command cmd-and-args))
1148    (setq monky-process-client-buffer (current-buffer))
1149    (with-current-buffer buf
1150      (view-mode 1)
1151      (set (make-local-variable 'view-no-disable-on-exit) t)
1152      (setq view-exit-action
1153            (lambda (buffer)
1154              (with-current-buffer buffer
1155                (bury-buffer))))
1156      (setq buffer-read-only t)
1157      (let ((inhibit-read-only t))
1158        (setq default-directory dir)
1159        (if noerase
1160            (goto-char (point-max))
1161          (erase-buffer))
1162        (insert "$ " (or logline
1163                         (mapconcat #'identity cmd-and-args " "))
1164                "\n")
1165        (cond (nowait
1166               (setq monky-process
1167                     (let ((process-connection-type nil))
1168                       (apply 'monky-start-process cmd buf cmd args)))
1169               (set-process-sentinel monky-process 'monky-process-sentinel)
1170               (set-process-filter monky-process 'monky-process-filter)
1171               (when input
1172                 (with-current-buffer input
1173                   (process-send-region monky-process
1174                                        (point-min) (point-max))
1175                   (process-send-eof monky-process)
1176                   (sit-for 0.1 t)))
1177               (cond ((= monky-process-popup-time 0)
1178                      (pop-to-buffer (process-buffer monky-process)))
1179                     ((> monky-process-popup-time 0)
1180                      (run-with-timer
1181                       monky-process-popup-time nil
1182                       (function
1183                        (lambda (buf)
1184                          (with-current-buffer buf
1185                            (when monky-process
1186                              (display-buffer (process-buffer monky-process))
1187                              (goto-char (point-max))))))
1188                       (current-buffer))))
1189               (setq successp t))
1190	      (monky-cmd-process
1191	       (let ((monky-cmd-process-input-buffer input)
1192		     (monky-cmd-process-input-point (and input
1193						         (with-current-buffer input
1194						           (point-min)))))
1195		 (setq successp
1196		       (equal (apply #'monky-cmdserver-runcommand (cdr cmd-and-args)) 0))
1197		 (monky-set-mode-line-process nil)
1198		 (monky-need-refresh monky-process-client-buffer)))
1199              (input
1200               (with-current-buffer input
1201                 (setq default-directory dir)
1202                 (setq monky-process
1203                       ;; Don't use a pty, because it would set icrnl
1204                       ;; which would modify the input (issue #20).
1205                       (let ((process-connection-type nil))
1206                         (apply 'monky-start-process cmd buf cmd args)))
1207                 (set-process-filter monky-process 'monky-process-filter)
1208                 (process-send-region monky-process
1209                                      (point-min) (point-max))
1210                 (process-send-eof monky-process)
1211                 (while (equal (process-status monky-process) 'run)
1212                   (sit-for 0.1 t))
1213                 (setq successp
1214                       (equal (process-exit-status monky-process) 0))
1215                 (setq monky-process nil))
1216               (monky-set-mode-line-process nil)
1217               (monky-need-refresh monky-process-client-buffer))
1218              (t
1219               (setq successp
1220                     (equal (apply 'monky-process-file-single cmd nil buf nil args) 0))
1221               (monky-set-mode-line-process nil)
1222               (monky-need-refresh monky-process-client-buffer))))
1223      (or successp
1224          noerror
1225          (error
1226           (or monky-cmd-error-message
1227	       (monky-abort-message (get-buffer monky-process-buffer-name))
1228               "Hg failed")))
1229      successp)))
1230
1231
1232(defun monky-process-sentinel (process event)
1233  (let ((msg (format "Hg %s." (substring event 0 -1)))
1234        (successp (string-match "^finished" event)))
1235    (with-current-buffer (process-buffer process)
1236      (let ((inhibit-read-only t))
1237        (goto-char (point-max))
1238        (insert msg "\n")
1239        (message msg)))
1240    (when (not successp)
1241      (let ((msg (monky-abort-message (process-buffer process))))
1242        (when msg
1243          (message msg))))
1244    (setq monky-process nil)
1245    (monky-set-mode-line-process nil)
1246    (if (buffer-live-p monky-process-client-buffer)
1247        (with-current-buffer monky-process-client-buffer
1248          (monky-with-refresh
1249            (monky-need-refresh monky-process-client-buffer))))))
1250
1251(defun monky-abort-message (buffer)
1252  (with-current-buffer buffer
1253    (save-excursion
1254      (goto-char (point-min))
1255      (when (re-search-forward
1256             (concat "^abort: \\(.*\\)" paragraph-separate) nil t)
1257        (match-string 1)))))
1258
1259;; TODO password?
1260
1261(defun monky-process-filter (proc string)
1262  (save-current-buffer
1263    (set-buffer (process-buffer proc))
1264    (let ((inhibit-read-only t))
1265      (goto-char (process-mark proc))
1266      (insert string)
1267      (set-marker (process-mark proc) (point)))))
1268
1269
1270(defun monky-run-hg (&rest args)
1271  (monky-with-refresh
1272    (monky-run* (append (cons monky-hg-executable
1273                              monky-hg-standard-options)
1274                        args))))
1275
1276(defun monky-run-hg-sync (&rest args)
1277  (message "Running %s %s"
1278           monky-hg-executable
1279           (mapconcat #'identity args " "))
1280  (monky-run* (append (cons monky-hg-executable
1281			    monky-hg-standard-options)
1282		      args)))
1283
1284(defun monky-run-hg-async (&rest args)
1285  (message "Running %s %s"
1286           monky-hg-executable
1287           (mapconcat #'identity args " "))
1288  (monky-run* (append (cons monky-hg-executable
1289                            monky-hg-standard-options)
1290                      args)
1291              nil nil nil t))
1292
1293(defun monky-run-async-with-input (input cmd &rest args)
1294  (monky-run* (cons cmd args) nil nil nil t input))
1295
1296(defun monky-display-process ()
1297  "Display output from most recent hg command."
1298  (interactive)
1299  (unless (get-buffer monky-process-buffer-name)
1300    (user-error "No Hg commands have run"))
1301  (display-buffer monky-process-buffer-name))
1302
1303(defun monky-hg-command (command)
1304  "Perform arbitrary Hg COMMAND."
1305  (interactive "sRun hg like this: ")
1306  (let ((args (monky-parse-args command))
1307        (monky-process-popup-time 0))
1308    (monky-with-refresh
1309      (monky-run* (append (cons monky-hg-executable
1310                                monky-hg-standard-options)
1311                          args)
1312                  nil nil nil t))))
1313
1314;;; Actions
1315
1316(defmacro monky-section-case (opname &rest clauses)
1317  "Make different action depending of current section.
1318
1319HEAD is (SECTION INFO &optional OPNAME),
1320  SECTION will be bind to the current section,
1321  INFO will be bind to the info's of the current section,
1322  OPNAME is a string that will be used to describe current action,
1323
1324CLAUSES is a list of CLAUSE, each clause is (SECTION-TYPE &BODY)
1325where SECTION-TYPE describe section where BODY will be run.
1326
1327This returns non-nil if some section matches.  If the
1328corresponding body return a non-nil value, it is returned,
1329otherwise it return t.
1330
1331If no section matches, this returns nil if no OPNAME was given
1332and throws an error otherwise."
1333
1334  (declare (indent 1)
1335           (debug (form &rest (sexp body))))
1336  (let ((section (make-symbol "*section*"))
1337        (type (make-symbol "*type*"))
1338        (context (make-symbol "*context*")))
1339    `(let* ((,section (monky-current-section))
1340            (,type (monky-section-type ,section))
1341            (,context (monky-section-context-type ,section)))
1342       (cond ,@(mapcar (lambda (clause)
1343                         (let ((prefix (car clause))
1344                               (body (cdr clause)))
1345                           `(,(if (eq prefix t)
1346                                  `t
1347                                `(monky-prefix-p ',(reverse prefix) ,context))
1348                             (or (progn ,@body)
1349                                 t))))
1350                       clauses)
1351             ,@(when opname
1352                 `(((not ,type)
1353                    (user-error "Nothing to %s here" ,opname))
1354                   (t
1355                    (error "Can't %s as %s"
1356                           ,opname
1357                           ,type))))))))
1358
1359(defmacro monky-section-action (opname &rest clauses)
1360  "Refresh monky buffers after executing action defined in CLAUSES.
1361
1362See `monky-section-case' for the definition of HEAD and CLAUSES and
1363`monky-with-refresh' for how the buffers are refreshed."
1364  (declare (indent 1)
1365           (debug (form &rest (sexp body))))
1366  `(monky-with-refresh
1367     (monky-section-case ,opname ,@clauses)))
1368
1369(defun monky-visit-item (&optional other-window)
1370  "Visit current item.
1371With a prefix argument, visit in other window."
1372  (interactive (list current-prefix-arg))
1373  (let ((ff (if other-window 'find-file-other-window 'find-file)))
1374    (monky-section-action "visit"
1375      ((file)
1376       (funcall ff (monky-section-info (monky-current-section))))
1377      ((diff)
1378       (funcall ff (monky-diff-item-file (monky-current-section))))
1379      ((hunk)
1380       (let ((file (monky-diff-item-file (monky-hunk-item-diff (monky-current-section))))
1381             (line (monky-hunk-item-target-line (monky-current-section))))
1382         (funcall ff file)
1383         (goto-char (point-min))
1384         (forward-line (1- line))))
1385      ((commit)
1386       (monky-show-commit (monky-section-info (monky-current-section))))
1387      ((longer)
1388       

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