1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-24 07:20:37 +00:00
emacs/lisp/obsolete/vc-mtn.el

382 lines
14 KiB
EmacsLisp
Raw Permalink Normal View History

;;; vc-mtn.el --- VC backend for Monotone -*- lexical-binding: t -*-
2007-09-14 16:33:47 +00:00
2024-01-02 01:47:10 +00:00
;; Copyright (C) 2007-2024 Free Software Foundation, Inc.
2007-09-14 16:33:47 +00:00
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: vc
;; Package: vc
;; Obsolete-since: 29.1
2007-09-14 16:33:47 +00:00
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
2007-09-14 16:33:47 +00:00
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
2007-09-14 16:33:47 +00:00
;; GNU Emacs is distributed in the hope that it will be useful,
2007-09-14 16:33:47 +00:00
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
2007-09-14 16:33:47 +00:00
;;; Commentary:
;;
2007-09-14 16:33:47 +00:00
;;; TODO:
;; - The `previous-version' VC method needs to be supported, 'D' in
;; log-view-mode uses it.
2007-09-14 16:33:47 +00:00
;;; Code:
More CL cleanups and reduction of use of cl.el. * woman.el, winner.el, vc/vc-rcs.el, vc/vc-hooks.el, vc/vc-hg.el: * vc/vc-git.el, vc/vc-dir.el, vc/vc-bzr.el, vc/vc-annotate.el: * textmodes/tex-mode.el, textmodes/sgml-mode.el, tar-mode.el: * strokes.el, ses.el, server.el, progmodes/js.el, progmodes/gdb-mi.el: * progmodes/flymake.el, progmodes/ebrowse.el, progmodes/compile.el: * play/tetris.el, play/snake.el, play/pong.el, play/landmark.el: * play/hanoi.el, play/decipher.el, play/5x5.el, nxml/nxml-mode.el: * net/secrets.el, net/quickurl.el, midnight.el, mail/footnote.el: * image-dired.el, ibuffer.el, ibuf-macs.el, ibuf-ext.el, hexl.el: * eshell/eshell.el, eshell/esh-io.el, eshell/esh-ext.el: * eshell/esh-cmd.el, eshell/em-ls.el, eshell/em-hist.el: * eshell/em-cmpl.el, eshell/em-banner.el: * url/url.el, url/url-queue.el, url/url-parse.el, url/url-http.el: * url/url-future.el, url/url-dav.el, url/url-cookie.el: * calendar/parse-time.el, test/eshell.el: Use cl-lib. * wid-browse.el, wdired.el, vc/vc.el, vc/vc-mtn.el, vc/vc-cvs.el: * vc/vc-arch.el, tree-widget.el, textmodes/texinfo.el: * textmodes/refill.el, textmodes/css-mode.el, term/tvi970.el: * term/ns-win.el, term.el, shell.el, ps-samp.el: * progmodes/perl-mode.el, progmodes/pascal.el, progmodes/gud.el: * progmodes/glasses.el, progmodes/etags.el, progmodes/cwarn.el: * play/gamegrid.el, play/bubbles.el, novice.el, notifications.el: * net/zeroconf.el, net/xesam.el, net/snmp-mode.el, net/mairix.el: * net/ldap.el, net/eudc.el, net/browse-url.el, man.el: * mail/mailheader.el, mail/feedmail.el: * url/url-util.el, url/url-privacy.el, url/url-nfs.el, url/url-misc.el: * url/url-methods.el, url/url-gw.el, url/url-file.el, url/url-expand.el: Dont use CL. * ibuf-ext.el (ibuffer-mark-old-buffers): Use float-time. * eshell/esh-opt.el (eshell-eval-using-options): Quote code with `lambda' rather than with `quote'. (eshell-do-opt): Adjust accordingly. (eshell-process-option): Simplify. * eshell/esh-var.el: * eshell/em-script.el: Require `esh-opt' for eshell-eval-using-options. * emacs-pcase.el (pcase--dontcare-upats, pcase--let*) (pcase--expand, pcase--u1): Rename pcase's internal `dontcare' pattern to `pcase--dontcare'. * emacs-cl.el (labels): Mark obsolete. (cl--letf, letf): Move to cl-lib. (cl--letf*, letf*): Remove. * emacs-cl-lib.el (cl-nth-value): Use defalias. * emacs-cl-macs.el (cl-dolist, cl-dotimes): Add indent rule. (cl-progv): Rewrite. (cl--letf, cl-letf): Move from cl.el. (cl-letf*): New macro. * emacs-cl-extra.el (cl--progv-before, cl--progv-after): Remove.
2012-07-11 23:13:41 +00:00
(eval-when-compile (require 'vc))
2007-09-14 16:33:47 +00:00
(defgroup vc-mtn nil
"VC Monotone (mtn) backend."
:version "24.1"
:group 'vc)
(defcustom vc-mtn-diff-switches t
"String or list of strings specifying switches for monotone diff under VC.
2008-12-03 07:38:45 +00:00
If nil, use the value of `vc-diff-switches'. If t, use no switches."
:type '(choice (const :tag "Unspecified" nil)
(const :tag "None" t)
(string :tag "Argument String")
2008-12-03 07:38:45 +00:00
(repeat :tag "Argument List" :value ("") string))
:version "23.1")
(defcustom vc-mtn-annotate-switches nil
"String or list of strings specifying switches for mtn annotate under VC.
If nil, use the value of `vc-annotate-switches'. If t, use no
switches."
:type '(choice (const :tag "Unspecified" nil)
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "25.1")
(defcustom vc-mtn-program "mtn"
"Name of the monotone executable."
:type 'string)
2007-09-14 16:33:47 +00:00
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
(put 'Mtn 'vc-functions nil)
(unless (executable-find vc-mtn-program)
2007-09-14 16:33:47 +00:00
;; vc-mtn.el is 100% non-functional without the `mtn' executable.
(setq vc-handled-backends (delq 'Mtn vc-handled-backends)))
;;;###autoload
(defconst vc-mtn-admin-dir "_MTN" "Name of the monotone directory.")
2007-09-14 16:33:47 +00:00
;;;###autoload
(defconst vc-mtn-admin-format (concat vc-mtn-admin-dir "/format")
"Name of the monotone directory's format file.")
2007-09-14 16:33:47 +00:00
;;;###autoload (defun vc-mtn-registered (file)
;;;###autoload (if (vc-find-root file vc-mtn-admin-format)
;;;###autoload (progn
;;;###autoload (load "vc-mtn" nil t)
2007-09-14 16:33:47 +00:00
;;;###autoload (vc-mtn-registered file))))
(defun vc-mtn-revision-granularity () 'repository)
(defun vc-mtn-checkout-model (_files) 'implicit)
2007-09-14 16:33:47 +00:00
(defun vc-mtn-root (file)
(setq file (expand-file-name file)
file (if (file-directory-p file)
2007-09-14 16:33:47 +00:00
(file-name-as-directory file)
(file-name-directory file)))
(or (vc-file-getprop file 'vc-mtn-root)
(vc-file-setprop file 'vc-mtn-root
(vc-find-root file vc-mtn-admin-format))))
(defun vc-mtn-find-admin-dir (file)
"Return the administrative directory of FILE."
(expand-file-name vc-mtn-admin-dir (vc-mtn-root file)))
2007-09-14 16:33:47 +00:00
(defun vc-mtn-find-ignore-file (file)
"Return the mtn ignore file that controls FILE."
(expand-file-name ".mtnignore" (vc-mtn-root file)))
2007-09-14 16:33:47 +00:00
(defun vc-mtn-registered (file)
(let ((root (vc-mtn-root file)))
(when root
(vc-mtn-state file))))
(defun vc-mtn-command (buffer okstatus files &rest flags)
"A wrapper around `vc-do-command' for use in vc-mtn.el."
(let ((process-environment
;; Avoid localization of messages so we can parse the output.
(cons "LC_MESSAGES=C" process-environment)))
(apply #'vc-do-command (or buffer "*vc*") okstatus vc-mtn-program
files flags)))
2007-09-14 16:33:47 +00:00
(defun vc-mtn-state (file)
;; If `mtn' fails or returns status>0, or if the search files, just
;; return nil.
(ignore-errors
(with-temp-buffer
(vc-mtn-command t 0 file "status")
(goto-char (point-min))
(re-search-forward
"^ \\(?:\\(patched\\)\\|\\(added\\) \\(?:.*\\)\\)\\|no changes$")
(cond ((match-end 1) 'edited)
((match-end 2) 'added)
(t 'up-to-date)))))
2007-09-14 16:33:47 +00:00
(defun vc-mtn-after-dir-status (update-function)
(let (result)
(goto-char (point-min))
(re-search-forward "\\(?:Current b\\|B\\)ranch: *\\(.*\\)\n?\nChanges against parent \\(.*\\)" nil t)
(while (re-search-forward
"^ \\(?:\\(patched \\)\\|\\(added \\)\\)\\(.*\\)$" nil t)
(cond ((match-end 1) (push (list (match-string 3) 'edited) result))
((match-end 2) (push (list (match-string 3) 'added) result))))
(funcall update-function result)))
;; dir-status-files called from vc-dir, which loads vc,
;; which loads vc-dispatcher.
(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
2014-12-02 15:10:55 +00:00
(defun vc-mtn-dir-status-files (dir _files update-function)
(vc-mtn-command (current-buffer) 'async dir "status")
(vc-run-delayed
(vc-mtn-after-dir-status update-function)))
2007-10-10 18:52:45 +00:00
(defun vc-mtn-working-revision (file)
2007-09-14 16:33:47 +00:00
;; If `mtn' fails or returns status>0, or if the search fails, just
;; return nil.
(ignore-errors
(with-temp-buffer
(vc-mtn-command t 0 file "status")
(goto-char (point-min))
(re-search-forward "\\(?:Current b\\|B\\)ranch: *\\(.*\\)\n?\nChanges against parent \\(.*\\)")
2007-09-14 16:33:47 +00:00
(match-string 2))))
(defun vc-mtn-workfile-branch (file)
;; If `mtn' fails or returns status>0, or if the search files, just
;; return nil.
(ignore-errors
(with-temp-buffer
(vc-mtn-command t 0 file "status")
(goto-char (point-min))
(re-search-forward "\\(?:Current b\\|B\\)ranch: *\\(.*\\)\n?\nChanges against parent \\(.*\\)")
2007-09-14 16:33:47 +00:00
(match-string 1))))
;; Mode-line rewrite code copied from vc-arch.el.
(defcustom vc-mtn-mode-line-rewrite
'(("\\`[^:/#]*[:/#]" . "")) ;Drop the host part.
"Rewrite rules to shorten Mtn's revision names on the mode-line."
:type '(repeat (cons regexp string))
:version "22.2")
2007-09-14 16:33:47 +00:00
(defun vc-mtn-mode-line-string (file)
Remove incorrect uses of "modeline". * ansi-color.el (ansi-color-faces-vector): Change default faces. * cus-edit.el (mode-line): * dframe.el (dframe-mouse-hscroll): * emacs-lisp/re-builder.el: * emacs-lisp/easy-mmode.el (define-minor-mode): * frame.el (set-frame-name): * help.el (lookup-minor-mode-from-indicator): * net/rcirc.el (rcirc-activity-string, rcirc-short-buffer-name): * progmodes/cc-cmds.el (c-toggle-auto-newline) (c-toggle-hungry-state): * progmodes/antlr-mode.el (antlr-language-alist): * progmodes/idlw-shell.el (idlwave-shell-electric-stop-line-face): * progmodes/vhdl-mode.el (vhdl-mode): * progmodes/which-func.el (which-func, which-func-cleanup-function): * term/ns-win.el (ns-face-at-pos): * term/sup-mouse.el (sup-mouse-report): * textmodes/flyspell.el (flyspell-mode-line-string): * textmodes/ispell.el (ispell-highlight-face): * textmodes/reftex-global.el: * vc/vc-arch.el (vc-arch-mode-line-string): * vc/vc-cvs.el (vc-cvs-mode-line-string): * vc/vc-git.el (vc-git-mode-line-string): * vc/vc-hooks.el (vc-display-status) (vc-default-mode-line-string): * vc/vc-mtn.el (vc-mtn-mode-line-string): Doc fixes. * dired.el (dired-sort-set-mode-line): Rename from dired-sort-set-modeline. All callers changed. * foldout.el (foldout-mode-line-string): Rename from foldout-modeline-string. All callers changed. (foldout-update-mode-line): Rename from foldout-update-modeline. * strokes.el (strokes-lighter): Rename from strokes-modeline-string. * subr.el (redraw-modeline): Make into obsolete alias. * calendar/timeclock.el (timeclock-mode-line-display): Rename from timeclock-modeline-display. Make old name an alias. (timeclock-update-mode-line): Likewise. All callers changed. (timeclock-mode-line-display): No need to check before using add-hook. (timeclock-relative, timeclock-day-over-hook) (timeclock-use-elapsed, timeclock-mode-string) (timeclock-mode-line-display): Doc fix, "modeline" -> "mode line". * emulation/crisp.el (crisp-mode-mode-line-string): Rename from crisp-mode-modeline-string. * erc-track.el (erc-track, erc-track-faces-priority-list) (erc-track-faces-normal-list, erc-track-find-face) (erc-track-modified-channels): Fix modeline -> mode line in docs. * eshell/esh-mode.el (eshell-status-in-mode-line): Rename from eshell-status-in-modeline. * org-clock.el (org-clock-string-limit) (org-clock-modeline-total, org-clock-task-overrun-text) (org-clock-mode-line-entry): Doc fix, "modeline" -> "mode line". * play/solitaire.el (solitaire-build-mode-line): Rename from solitaire-build-modeline. All callers changed. * play/zone.el (zone-hiding-mode-line): Rename from zone-hiding-modeline. All callers changed. (zone): Remove unusued `modeline-hidden-level' property. * progmodes/xscheme.el (xscheme-mode-line-initialize): Rename from xscheme-modeline-initialize. All callers changed. * textmodes/sgml-mode.el (html-face-tag-alist) (html-tag-face-alist): Use mode-line face instead of obsolete alias modeline. Fixes: debbugs:10329
2012-06-02 10:56:09 +00:00
"Return a string for `vc-mode-line' to put in the mode line for FILE."
2007-09-14 16:33:47 +00:00
(let ((branch (vc-mtn-workfile-branch file)))
(if branch
(progn
(dolist (rule vc-mtn-mode-line-rewrite)
(if (string-match (car rule) branch)
(setq branch (replace-match (cdr rule) t nil branch))))
(format "Mtn%c%s"
(pcase (vc-state file)
Replace insignificant backquotes Replace most insignificant occurrences of '`' with a straight quote, sharp quote or nothing. This includes backquotes in 'pcase' patterns. * admin/admin.el: * lisp/apropos.el: * lisp/arc-mode.el: * lisp/auth-source.el: * lisp/avoid.el: * lisp/bindings.el: * lisp/bs.el: * lisp/calculator.el: * lisp/calendar/todo-mode.el: * lisp/cedet/semantic.el: * lisp/cedet/semantic/analyze/debug.el: * lisp/cedet/semantic/bovine.el: * lisp/cedet/semantic/dep.el: * lisp/cedet/semantic/grammar.el: * lisp/cedet/semantic/wisent/comp.el: * lisp/cedet/semantic/wisent/grammar.el: * lisp/cedet/srecode/mode.el: * lisp/cus-edit.el: * lisp/doc-view.el: * lisp/elec-pair.el: * lisp/electric.el: * lisp/emacs-lisp/autoload.el: * lisp/emacs-lisp/benchmark.el: * lisp/emacs-lisp/byte-opt.el: * lisp/emacs-lisp/bytecomp.el: * lisp/emacs-lisp/cconv.el: * lisp/emacs-lisp/cl-extra.el: * lisp/emacs-lisp/cl-generic.el: * lisp/emacs-lisp/cl-macs.el: * lisp/emacs-lisp/copyright.el: * lisp/emacs-lisp/debug.el: * lisp/emacs-lisp/eieio-compat.el: * lisp/emacs-lisp/ert.el: * lisp/emacs-lisp/generator.el: * lisp/emacs-lisp/inline.el: * lisp/emacs-lisp/macroexp.el: * lisp/emacs-lisp/map.el: * lisp/emacs-lisp/package-x.el: * lisp/emacs-lisp/package.el: * lisp/emacs-lisp/radix-tree.el: * lisp/emacs-lisp/smie.el: * lisp/epa.el: * lisp/erc/erc-dcc.el: * lisp/erc/erc-track.el: * lisp/erc/erc.el: * lisp/eshell/em-ls.el: * lisp/eshell/esh-cmd.el: * lisp/files.el: * lisp/filesets.el: * lisp/font-lock.el: * lisp/frameset.el: * lisp/gnus/gnus-agent.el: * lisp/gnus/gnus-art.el: * lisp/gnus/gnus-cite.el: * lisp/gnus/gnus-group.el: * lisp/gnus/gnus-msg.el: * lisp/gnus/gnus-salt.el: * lisp/gnus/gnus-srvr.el: * lisp/gnus/gnus-sum.el: * lisp/gnus/gnus-topic.el: * lisp/gnus/gnus-util.el: * lisp/gnus/gnus.el: * lisp/gnus/message.el: * lisp/gnus/mm-util.el: * lisp/gnus/mml.el: * lisp/gnus/nnheader.el: * lisp/gnus/nnimap.el: * lisp/gnus/nnmairix.el: * lisp/gnus/spam.el: * lisp/hexl.el: * lisp/hi-lock.el: * lisp/ibuf-ext.el: * lisp/ibuffer.el: * lisp/ido.el: * lisp/info.el: * lisp/international/mule-cmds.el: * lisp/international/mule-util.el: * lisp/json.el: * lisp/jsonrpc.el: * lisp/language/cyrillic.el: * lisp/language/european.el: * lisp/language/georgian.el: * lisp/language/tibetan.el: * lisp/language/utf-8-lang.el: * lisp/language/vietnamese.el: * lisp/ldefs-boot.el: * lisp/mail/mail-extr.el: * lisp/man.el: * lisp/menu-bar.el: * lisp/mh-e/mh-acros.el: * lisp/mh-e/mh-folder.el: * lisp/mh-e/mh-mime.el: * lisp/mh-e/mh-show.el: * lisp/mh-e/mh-speed.el: * lisp/minibuffer.el: * lisp/mpc.el: * lisp/net/ange-ftp.el: * lisp/net/hmac-def.el: * lisp/net/newst-backend.el: * lisp/net/quickurl.el: * lisp/net/tramp-archive.el: * lisp/net/tramp-compat.el: * lisp/notifications.el: * lisp/obsolete/pgg-parse.el: * lisp/obsolete/vc-arch.el: * lisp/obsolete/xesam.el: * lisp/org/ob-C.el: * lisp/org/ob-core.el: * lisp/org/ob-exp.el: * lisp/org/ob-groovy.el: * lisp/org/ob-haskell.el: * lisp/org/ob-io.el: * lisp/org/ob-lisp.el: * lisp/org/ob-lob.el: * lisp/org/ob-lua.el: * lisp/org/ob-octave.el: * lisp/org/ob-perl.el: * lisp/org/ob-python.el: * lisp/org/ob-ref.el: * lisp/org/ob-ruby.el: * lisp/org/ob-sql.el: * lisp/org/org-agenda.el: * lisp/org/org-capture.el: * lisp/org/org-clock.el: * lisp/org/org-colview.el: * lisp/org/org-duration.el: * lisp/org/org-element.el: * lisp/org/org-entities.el: * lisp/org/org-gnus.el: * lisp/org/org-indent.el: * lisp/org/org-info.el: * lisp/org/org-inlinetask.el: * lisp/org/org-lint.el: * lisp/org/org-list.el: * lisp/org/org-mouse.el: * lisp/org/org-plot.el: * lisp/org/org-src.el: * lisp/org/org-table.el: * lisp/org/org.el: * lisp/org/ox-ascii.el: * lisp/org/ox-html.el: * lisp/org/ox-latex.el: * lisp/org/ox-man.el: * lisp/org/ox-md.el: * lisp/org/ox-org.el: * lisp/org/ox-publish.el: * lisp/org/ox-texinfo.el: * lisp/org/ox.el: * lisp/play/bubbles.el: * lisp/play/gamegrid.el: * lisp/progmodes/autoconf.el: * lisp/progmodes/cc-defs.el: * lisp/progmodes/cc-engine.el: * lisp/progmodes/cc-fonts.el: * lisp/progmodes/cc-langs.el: * lisp/progmodes/cperl-mode.el: * lisp/progmodes/ebrowse.el: * lisp/progmodes/elisp-mode.el: * lisp/progmodes/flymake-cc.el: * lisp/progmodes/flymake.el: * lisp/progmodes/fortran.el: * lisp/progmodes/grep.el: * lisp/progmodes/gud.el: * lisp/progmodes/idlwave.el: * lisp/progmodes/js.el: * lisp/progmodes/m4-mode.el: * lisp/progmodes/make-mode.el: * lisp/progmodes/mixal-mode.el: * lisp/progmodes/modula2.el: * lisp/progmodes/octave.el: * lisp/progmodes/opascal.el: * lisp/progmodes/prolog.el: * lisp/progmodes/ps-mode.el: * lisp/progmodes/python.el: * lisp/progmodes/ruby-mode.el: * lisp/progmodes/sh-script.el: * lisp/progmodes/sql.el: * lisp/progmodes/verilog-mode.el: * lisp/ps-mule.el: * lisp/rtree.el: * lisp/ruler-mode.el: * lisp/ses.el: * lisp/simple.el: * lisp/startup.el: * lisp/subr.el: * lisp/term/ns-win.el: * lisp/textmodes/bibtex.el: * lisp/textmodes/conf-mode.el: * lisp/textmodes/css-mode.el: * lisp/textmodes/refill.el: * lisp/textmodes/sgml-mode.el: * lisp/textmodes/tex-mode.el: * lisp/tutorial.el: * lisp/url/url-dav.el: * lisp/url/url-gw.el: * lisp/url/url-http.el: * lisp/url/url-methods.el: * lisp/url/url-privacy.el: * lisp/vc/cvs-status.el: * lisp/vc/diff-mode.el: * lisp/vc/ediff-init.el: * lisp/vc/ediff-ptch.el: * lisp/vc/log-edit.el: * lisp/vc/log-view.el: * lisp/vc/pcvs-info.el: * lisp/vc/pcvs.el: * lisp/vc/smerge-mode.el: * lisp/vc/vc-git.el: * lisp/vc/vc-hg.el: * lisp/vc/vc-mtn.el: * lisp/vc/vc-rcs.el: * lisp/whitespace.el: * lisp/window.el: * test/lisp/electric-tests.el: * test/lisp/emacs-lisp/cl-lib-tests.el: * test/lisp/emacs-lisp/ert-tests.el: * test/lisp/epg-tests.el: * test/lisp/jsonrpc-tests.el: * test/src/data-tests.el: * test/src/json-tests.el: Replace most insignificant backquotes.
2018-11-05 00:22:15 +00:00
((or 'up-to-date 'needs-update) ?-)
('added ?@)
(_ ?:))
branch))
"")))
2007-09-14 16:33:47 +00:00
(defun vc-mtn-register (files &optional _comment)
2007-09-14 16:33:47 +00:00
(vc-mtn-command nil 0 files "add"))
(defun vc-mtn-responsible-p (file) (vc-mtn-root file))
(declare-function log-edit-extract-headers "log-edit" (headers string))
(defun vc-mtn-checkin (files comment &optional _rev)
(apply #'vc-mtn-command nil 0 files
(nconc (list "commit" "-m")
(log-edit-extract-headers '(("Author" . "--author")
("Date" . "--date"))
comment))))
2007-09-14 16:33:47 +00:00
2007-10-10 18:52:45 +00:00
(defun vc-mtn-find-revision (file rev buffer)
;; null rev means latest revision
(if rev
(vc-mtn-command buffer 0 file "cat" "-r" rev)
(vc-mtn-command buffer 0 file "cat")))
2007-09-14 16:33:47 +00:00
;; (defun vc-mtn-checkout (file &optional rev)
2007-09-14 16:33:47 +00:00
;; )
(defun vc-mtn-revert (file &optional contents-done)
(unless contents-done
(vc-mtn-command nil 0 file "revert")))
(defun vc-mtn-print-log (files buffer &optional _shortlog start-revision limit)
"Print commit logs associated with FILES into specified BUFFER.
_SHORTLOG is ignored.
If START-REVISION is non-nil, it is the newest revision to show.
If LIMIT is non-nil, show no more than this many entries."
(apply #'vc-mtn-command buffer 0 files "log"
(append
(when start-revision (list "--from" (format "%s" start-revision)))
(when limit (list "--last" (format "%s" limit))))))
2007-09-14 16:33:47 +00:00
(defvar log-view-message-re)
(defvar log-view-file-re)
(defvar log-view-font-lock-keywords)
(defvar log-view-per-file-logs)
2007-09-14 16:33:47 +00:00
(define-derived-mode vc-mtn-log-view-mode log-view-mode "Mtn-Log-View"
;; Don't match anything.
(setq-local log-view-file-re regexp-unmatchable)
(setq-local log-view-per-file-logs nil)
2007-09-14 16:33:47 +00:00
;; TODO: Use a more precise regexp than "[ |/]+" to avoid false positives
;; in the ChangeLog text.
(setq-local log-view-message-re
"^[ |/]+Revision: \\([0-9a-f]+\\)")
2007-09-14 16:33:47 +00:00
(require 'add-log) ;For change-log faces.
(setq-local log-view-font-lock-keywords
2007-09-14 16:33:47 +00:00
(append log-view-font-lock-keywords
'(("^[ |]+Author: \\(.*\\)" (1 'change-log-email))
("^[ |]+Date: \\(.*\\)" (1 'change-log-date))))))
2007-09-14 16:33:47 +00:00
;; (defun vc-mtn-show-log-entry (revision)
2007-09-14 16:33:47 +00:00
;; )
(autoload 'vc-switches "vc")
(defun vc-mtn-diff (files &optional rev1 rev2 buffer _async)
"Get a difference report using monotone between two revisions of FILES."
(apply #'vc-mtn-command (or buffer "*vc-diff*")
1 ; bug#21969
files "diff"
(append
(vc-switches 'mtn 'diff)
(if rev1 (list "-r" rev1)) (if rev2 (list "-r" rev2)))))
2007-09-14 16:33:47 +00:00
(defun vc-mtn-annotate-command (file buf &optional rev)
(apply #'vc-mtn-command buf 'async file "annotate"
(append (vc-switches 'mtn 'annotate)
(if rev (list "-r" rev)))))
2007-09-14 16:33:47 +00:00
(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
2007-09-14 16:33:47 +00:00
(defconst vc-mtn-annotate-full-re
"^ *\\([0-9a-f]+\\)\\.* by [^ ]+ \\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\): ")
(defconst vc-mtn-annotate-any-re
(concat "^\\(?: +: \\|" vc-mtn-annotate-full-re "\\)"))
(defun vc-mtn-annotate-time ()
(when (looking-at vc-mtn-annotate-any-re)
(goto-char (match-end 0))
(let ((year (match-string 2)))
(if (not year)
;; Look for the date on a previous line.
(save-excursion
(get-text-property (1- (previous-single-property-change
(point) 'vc-mtn-time nil (point-min)))
'vc-mtn-time))
(let ((time (vc-annotate-convert-time
(encode-time 0 0 0
(string-to-number (match-string 4))
(string-to-number (match-string 3))
(string-to-number year)
t))))
(let ((inhibit-read-only t)
(inhibit-modification-hooks t))
(put-text-property (match-beginning 0) (match-end 0)
'vc-mtn-time time))
time)))))
(defun vc-mtn-annotate-extract-revision-at-line ()
(save-excursion
(when (or (looking-at vc-mtn-annotate-full-re)
(re-search-backward vc-mtn-annotate-full-re nil t))
(match-string 1))))
;;; Revision completion.
(defun vc-mtn-list-tags ()
(with-temp-buffer
(vc-mtn-command t 0 nil "list" "tags")
(goto-char (point-min))
(let ((tags ()))
(while (re-search-forward "^[^ ]+" nil t)
(push (match-string 0) tags))
tags)))
(defun vc-mtn-list-branches ()
(with-temp-buffer
(vc-mtn-command t 0 nil "list" "branches")
(goto-char (point-min))
(let ((branches ()))
(while (re-search-forward "^.+" nil t)
(push (match-string 0) branches))
branches)))
(defun vc-mtn-list-revision-ids (prefix)
(with-temp-buffer
(vc-mtn-command t 0 nil "complete" "revision" prefix)
(goto-char (point-min))
(let ((ids ()))
(while (re-search-forward "^.+" nil t)
(push (match-string 0) ids))
ids)))
(defun vc-mtn-revision-completion-table (_files)
;; What about using `files'?!? --Stef
(lambda (string pred action)
(cond
;; Special chars for composite selectors.
((string-match ".*[^\\]\\(\\\\\\\\\\)*[/|;(]" string)
(completion-table-with-context (substring string 0 (match-end 0))
(vc-mtn-revision-completion-table nil)
(substring string (match-end 0))
pred action))
;; "Tag" selectors.
((string-match "\\`t:" string)
(complete-with-action action
(mapcar (lambda (tag) (concat "t:" tag))
(vc-mtn-list-tags))
string pred))
;; "Branch" or "Head" selectors.
((string-match "\\`[hb]:" string)
(let ((prefix (match-string 0 string)))
(complete-with-action action
(mapcar (lambda (tag) (concat prefix tag))
(vc-mtn-list-branches))
string pred)))
;; "ID" selectors.
((string-match "\\`i:" string)
(complete-with-action action
(mapcar (lambda (tag) (concat "i:" tag))
(vc-mtn-list-revision-ids
(substring string (match-end 0))))
string pred))
(t
(complete-with-action action
'("t:" "b:" "h:" "i:"
;; Completion not implemented for these.
"c:" "a:" "k:" "d:" "m:" "e:" "l:" "i:" "p:"
;; These have no arg to complete.
"u:" "w:"
;; Selector functions.
"difference(" "lca(" "max(" "ancestors("
"descendants(" "parents(" "children("
"pick(")
string pred)))))
2007-09-14 16:33:47 +00:00
(provide 'vc-mtn)
;;; vc-mtn.el ends here