Fixed some bugs related to coding systems and dvc-diff.
Some changes for XEmacs compatibility (incomplete).
Some clarifications to docs/xmtn-readme.txt .
Support monotone release 0.34.
diff -N -aur orig/docs/xmtn-readme.txt new/docs/xmtn-readme.txt
--- orig/docs/xmtn-readme.txt 2007-04-07 11:35:35.000000000 +0200
+++ new/docs/xmtn-readme.txt 2007-04-07 11:35:36.000000000 +0200
@@ -10,6 +10,9 @@
reusable by code that is unrelated to DVC, even though they currently
depend on the subprocess handling utilities that DVC provides.
+xmtn should work on GNU Emacs 21 or newer. Work on supporting XEmacs
+has started but is unfinished; patches welcome. On XEmacs, xmtn
+requires MULE.
* Download and installation
@@ -83,8 +86,10 @@
These commands can also be used from dired buffers.
C-x V s shows the status buffer. This currently shows modified,
-renamed and unknown files. I don't use it much, C-x V = seems
-preferable.
+renamed and unknown files. It's supposed to allow operations like
+diff, commit, revert etc. (like pcl-cvs), but that's not implemented
+yet. C-x V = is preferable at the moment, although it doesn't show
+unknown files.
C-x V a can be used to add a ChangeLog entry to _MTN/log.
@@ -112,9 +117,8 @@
the user has customized monotone's ignore_file hook in a way that
changes the meaning of this file.
-It would be nice to be able to perform operations such as diff and
-commit from the status buffer. For now, use the tree diff buffer for
-this.
+The ability to perform operations such as diff and commit from the
+status buffer is missing. For now, use the tree diff buffer for this.
xmtn doesn't define any key bindings for monotone-specific commands.
Only the backend-independent key bindings defined by DVC are available.
diff -N -aur orig/lisp/dvc-diff.el new/lisp/dvc-diff.el
--- orig/lisp/dvc-diff.el 2007-04-07 11:35:35.000000000 +0200
+++ new/lisp/dvc-diff.el 2007-04-07 11:35:36.000000000 +0200
@@ -725,9 +725,13 @@
(modified-file (make-temp-file "DVC-file-diff-mod")))
(with-temp-buffer
(insert (with-current-buffer base-buffer (buffer-string)))
+ (setq buffer-file-coding-system (with-current-buffer base-buffer
+ buffer-file-coding-system))
(write-file base-file))
(with-temp-buffer
(insert (with-current-buffer modified-buffer (buffer-string)))
+ (setq buffer-file-coding-system (with-current-buffer modified-buffer
+ buffer-file-coding-system))
(write-file modified-file))
(dvc-switch-to-buffer buffer)
(let ((inhibit-read-only t)
diff -N -aur orig/lisp/tests/xmtn-tests.el new/lisp/tests/xmtn-tests.el
--- orig/lisp/tests/xmtn-tests.el 2007-04-07 11:35:35.000000000 +0200
+++ new/lisp/tests/xmtn-tests.el 2007-04-07 11:35:36.000000000 +0200
@@ -34,7 +34,8 @@
(eval-and-compile
(require 'elunit)
(require 'cl)
- (require 'xmtn-match))
+ (require 'xmtn-match)
+ (require 'xmtn-dvc))
(defun xmtn-tests--keypair-string ()
"[keypair xmtn-test]
@@ -281,6 +282,48 @@
((($email ok $cert-name-here $cert-value-here t))
(assert (equal cert-name-here cert-name) t)
(assert (equal cert-value-here cert-value) t)))))))))
+ (dvc-file-diff-with-non-ascii-contents
+ (save-window-excursion
+ (let ((umlaut (string (make-char 'latin-iso8859-1 #xe4)))) ; umlaut a
+ (xmtn-tests--with-test-environment (&key root)
+ (let ((file-name "foo")
+ (contents (concat umlaut
+ "\n" ; avoid "buffer does not end in newline"
+ ))
+ (coding-system 'utf-8-unix))
+ (with-temp-buffer
+ (setq buffer-file-coding-system coding-system)
+ (insert contents)
+ (write-file file-name))
+ (xmtn--add-files root (list file-name))
+ (xmtn--run-command-sync root (list "commit" "--message=commit foo"))
+ (with-temp-buffer
+ (let ((coding-system-for-read coding-system))
+ (insert-file-contents file-name t))
+ (dvc-file-diff file-name)
+ (assert (eql (point-min) (point-max)))))))))
+ (buffer-file-coding-system-in-dvc-dvc-file-diff
+ (save-window-excursion
+ (let ((umlaut (string (make-char 'latin-iso8859-1 #xe4)))) ; umlaut a
+ (xmtn-tests--with-test-environment (&key root)
+ (let ((file-name "foo")
+ (contents (concat umlaut
+ "\n" ; avoid "buffer does not end in newline"
+ ))
+ (coding-system-1 'utf-8-unix)
+ (coding-system-2 'iso-8859-1-unix))
+ (with-temp-buffer
+ (setq buffer-file-coding-system coding-system-1)
+ (insert contents)
+ (write-file file-name))
+ (xmtn--add-files root (list file-name))
+ (xmtn--run-command-sync root (list "commit" "--message=commit foo"))
+ (with-temp-buffer
+ (insert-file-contents file-name t)
+ (setq buffer-file-coding-system coding-system-2)
+ (let ((coding-system-for-read coding-system-1))
+ (dvc-file-diff file-name))
+ (assert (not (eql (point-min) (point-max))))))))))
(file-diff-after-rename
(xmtn-tests--with-test-history (&key root ((:file-name file-name-1))
revision-2
@@ -288,7 +331,7 @@
(let ((file-name-2 "bar"))
(xmtn--run-command-sync root
(xmtn--version-case
- ((or mainline (> 0 33))
+ ((>= 0 34)
`("mv" "--" ,file-name-1 ,file-name-2))
(t
`("mv" "-e" "--" ,file-name-1
,file-name-2))))
diff -N -aur orig/lisp/xmtn-automate.el new/lisp/xmtn-automate.el
--- orig/lisp/xmtn-automate.el 2007-04-07 11:35:35.000000000 +0200
+++ new/lisp/xmtn-automate.el 2007-04-07 11:35:36.000000000 +0200
@@ -533,7 +533,8 @@
(signal t)))
(setq process (xmtn-automate--start-process session))
(setf (xmtn-automate--session-process session) process))
- (xmtn--assert-optional (buffer-name (xmtn-automate--session-buffer
session)))
+ (xmtn--assert-optional (buffer-live-p (xmtn-automate--session-buffer
+ session)))
process))
(defun xmtn-automate--new-buffer (session)
@@ -542,7 +543,7 @@
(buffer (generate-new-buffer buffer-base-name)))
(with-current-buffer buffer
(buffer-disable-undo)
- (set-buffer-multibyte nil)
+ (xmtn--set-buffer-multibyte nil)
(setq buffer-read-only t))
(setf (xmtn-automate--session-buffer session) buffer)
buffer))
@@ -594,7 +595,7 @@
(setq buffer (get-buffer-create buffer-name))
(with-current-buffer buffer
(buffer-disable-undo)
- (set-buffer-multibyte t)
+ (xmtn--set-buffer-multibyte t)
(setq buffer-read-only t)
(let ((inhibit-read-only t))
(when option-plist
@@ -642,7 +643,7 @@
mtn-number session-number))
(with-current-buffer buffer
(buffer-disable-undo)
- (set-buffer-multibyte nil)
+ (xmtn--set-buffer-multibyte nil)
(setq buffer-read-only t)
(xmtn--assert-optional (and (eql (point) (point-min))
(eql (point) (point-max))))
@@ -689,7 +690,7 @@
((= chars-to-read 0)
nil)
((> chars-to-read 0)
- (if (null (buffer-name command-output-buffer))
+ (if (not (buffer-live-p command-output-buffer))
;; Buffer has already been killed, just discard input.
(progn)
(with-current-buffer command-output-buffer
@@ -809,6 +810,20 @@
;; t)
(set-marker read-marker (match-end 0)))
(setq tag 'again))
+ ;; This is just a simple heuristic, there are many
+ ;; kinds of invalid input that it doesn't detect.
+ ;; FIXME: This can errorneously be triggered by
+ ;; warnings that mtn prints on stderr; but Emacs
+ ;; interleaves stdout and stderr (see (elisp)
+ ;; Output from Processes) with no way to
+ ;; distinguish between them. We'll probably have
+ ;; to spawn mtn inside a shell that redirects
+ ;; stderr to a file. But I don't think that's
+ ;; possible in a portable way...
+ ((looking-at "[^0-9]")
+ (error "Invalid output from mtn: %s"
+ (buffer-substring-no-properties (point)
+ (point-max))))
(t
(xmtn--assert-optional command)
(setq tag 'exit-loop)))))
@@ -823,11 +838,15 @@
(let ((status (process-status process))
(session (xmtn-automate--process-session process)))
(let ((buffer (xmtn-automate--session-buffer session)))
- (when (buffer-name buffer)
+ (when (buffer-live-p buffer)
(with-current-buffer buffer
(let ((inhibit-read-only t)
deactivate-mark)
(save-excursion
+ ;; This seems to fail in XEmacs when running the test
+ ;; `file-diff'. I don't know why.
+ (xmtn--assert-optional (marker-position (process-mark process))
+ t)
(goto-char (process-mark process))
(insert (format "\n(process exited: %S)\n"
(if (eql (aref event-string
@@ -865,7 +884,7 @@
(let ((session (xmtn-automate--process-session process)))
(let ((buffer (xmtn-automate--session-buffer session)))
(xmtn--assert-optional (eql (process-buffer process) buffer))
- (xmtn--assert-optional (buffer-name buffer))
+ (xmtn--assert-optional (buffer-live-p buffer))
(with-current-buffer buffer
(let* ((mark (process-mark process))
(move-point-p (= (point) mark)))
diff -N -aur orig/lisp/xmtn-compat.el new/lisp/xmtn-compat.el
--- orig/lisp/xmtn-compat.el 2007-04-07 11:35:35.000000000 +0200
+++ new/lisp/xmtn-compat.el 2007-04-07 11:35:36.000000000 +0200
@@ -33,6 +33,11 @@
(eval-and-compile
(require 'cl))
+(defun xmtn--temp-directory ()
+ (if (fboundp 'temp-directory)
+ (temp-directory)
+ temporary-file-directory))
+
(defun xmtn--make-temp-file (prefix &optional dirp suffix)
;; Do this in a temp buffer to ensure we use the default file output
;; encoding. Emacs 21's `make-temp-file' uses the current buffer's
@@ -40,6 +45,9 @@
;; with a string as its first argument, but coding conversion errors
;; when `write-region' is called in this way.
(with-temp-buffer
+ ;; XEmacs' `make-temp-file' doesn't automatically use temp
+ ;; directory.
+ (setq prefix (expand-file-name prefix (xmtn--temp-directory)))
;; FIXME: Ignoring suffix for now since Emacs 21 doesn't support it.
(make-temp-file prefix dirp)))
@@ -83,6 +91,11 @@
`(with-no-warnings ,@body)
`(progn ,@body)))
+(defmacro* xmtn--with-temp-message (message &body body)
+ (if (fboundp 'with-temp-message)
+ `(with-temp-message ,message ,@body)
+ `(progn ,@body)))
+
(defmacro* xmtn--dotimes-with-progress-reporter ((i n-form &optional res-form)
message-form
&body body)
@@ -92,11 +105,15 @@
(let ((message (gensym)))
`(let ((,message ,message-form))
(prog1
- (with-temp-message ,message
+ (xmtn--with-temp-message ,message
(dotimes (,i ,n-form ,res-form)
,@body))
(message "%sdone" ,message))))))
+(defun xmtn--set-buffer-multibyte (flag)
+ (when (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte flag)))
+
(provide 'xmtn-compat)
;;; xmtn-compat.el ends here
diff -N -aur orig/lisp/xmtn-dvc.el new/lisp/xmtn-dvc.el
--- orig/lisp/xmtn-dvc.el 2007-04-07 11:35:35.000000000 +0200
+++ new/lisp/xmtn-dvc.el 2007-04-07 11:35:36.000000000 +0200
@@ -41,7 +41,9 @@
(require 'xmtn-ids)
(require 'xmtn-match)
(require 'dvc-log)
- (require 'dvc-diff))
+ (require 'dvc-diff)
+ (require 'dvc-core)
+ (require 'ewoc))
;; For debugging.
(defun xmtn--load ()
@@ -832,7 +834,7 @@
(xmtn--run-command-sync
root `("rename"
,@(xmtn--version-case
- ((or mainline (> 0 33))
+ ((>= 0 34)
(if do-not-execute `("--bookkeep-only") `()))
(t
(if do-not-execute `() `("--execute"))))
@@ -1082,15 +1084,43 @@
;; should be computed against an empty file. So just
;; leave the buffer empty.
(progn)
- ;; Note: This could be simplified slightly with the new
- ;; automate get_file_of operation. Not worth any effort
- ;; right now, though. And it would break compatibility with
- ;; 0.30 for no good reason.
- (let ((contents-hash
- (xmtn--revision-file-contents-hash root backend-id
- corresponding-file)))
- (xmtn--insert-file-contents root contents-hash
- (current-buffer))))))))
+ (let (temp-dir)
+ (unwind-protect
+ (progn
+ (setq temp-dir (xmtn--make-temp-file
+ "xmtn--revision-get-file-" t))
+ ;; Using `insert-file-contents' in conjunction with
+ ;; as much of the original file name as possible
+ ;; seems to be the best way to make sure that Emacs'
+ ;; entire file coding system detection logic is
+ ;; applied. Functions like
+ ;; `find-operation-coding-system' and
+ ;; `find-file-name-handler' are not a complete
+ ;; replacement since they don't look at the contents
+ ;; at all.
+ (let ((temp-file (concat temp-dir "/" corresponding-file)))
+ (make-directory (file-name-directory temp-file) t)
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (setq buffer-file-coding-system 'binary)
+ ;; This could be simplified slightly with the
+ ;; new automate get_file_of operation. Not
+ ;; worth any effort right now, though. And it
+ ;; would break compatibility with 0.30 for no
+ ;; good reason.
+ (let ((contents-hash
+ (xmtn--revision-file-contents-hash
+ root backend-id corresponding-file)))
+ (xmtn--insert-file-contents root contents-hash
+ (current-buffer)))
+ (write-file temp-file))
+ (let ((output-buffer (current-buffer)))
+ (with-temp-buffer
+ (insert-file-contents temp-file)
+ (let ((input-buffer (current-buffer)))
+ (with-current-buffer output-buffer
+ (insert-buffer-substring input-buffer)))))))
+ (dvc-delete-recursively temp-dir))))))))
(defun xmtn--get-corresponding-path (root normalized-file-name
diff -N -aur orig/lisp/xmtn-match.el new/lisp/xmtn-match.el
--- orig/lisp/xmtn-match.el 2007-04-07 11:35:35.000000000 +0200
+++ new/lisp/xmtn-match.el 2007-04-07 11:35:36.000000000 +0200
@@ -57,6 +57,16 @@
;; (pprint (macroexpand '(xmtn-match x ([t $y ($y . t)] y))))
+(deftype xmtn-match--bool-vector ()
+ (if (fboundp 'bool-vector-p)
+ ;; For Emacs.
+ `bool-vector
+ ;; For XEmacs.
+ `nil))
+
+(deftype xmtn-match--atom ()
+ `(not cons))
+
;; They say it's bad style if function definitions are too big to fit
;; on a screen. A small font is recommended for this one.
(defun xmtn-match--generate-branch (var-name-prefix-char
@@ -96,7 +106,7 @@
`(,part-reader ,subobject)))))
;; I think this will also allow char-tables.
;; Not sure how useful that is.
- ((and array (not string) (not bool-vector))
+ ((and array (not string) (not xmtn-match--bool-vector))
`((unless (and (typep ,subobject ',(type-of
subpattern))
(eql (length ,subobject)
,(length subpattern)))
@@ -105,7 +115,7 @@
append (walk-part
(aref subpattern index)
`(aref ,subobject ,index)))))
- (t ;; Should be atom, but that errors.
+ (xmtn-match--atom
(if (and (symbolp subpattern)
(eql (aref (symbol-name subpattern) 0)
var-name-prefix-char))
diff -N -aur orig/lisp/xmtn-run.el new/lisp/xmtn-run.el
--- orig/lisp/xmtn-run.el 2007-04-07 11:35:35.000000000 +0200
+++ new/lisp/xmtn-run.el 2007-04-07 11:35:36.000000000 +0200
@@ -33,7 +33,9 @@
(eval-and-compile
(require 'cl)
- (require 'dvc-unified))
+ (require 'dvc-unified)
+ (when (featurep 'xemacs)
+ (require 'un-define)))
(define-coding-system-alias 'xmtn--monotone-normal-form 'utf-8-unix)
@@ -136,7 +138,9 @@
(setq got-output-p t)))
nil))))))))
(lambda ()
- (while (accept-process-output process))
+ (assert (member (process-status process) '(run exit signal)) t)
+ (while (and (eql (process-status process) 'run)
+ (accept-process-output process)))
(assert (member (process-status process) '(exit signal)) t)
;; This (including discarding input) is needed to allow the
;; sentinel to run, at least on GNU Emacs 21.4.2 and on GNU
@@ -297,12 +301,12 @@
;; while they generally have syntax and semantics that match the
;; upcoming release; i.e., their syntax and semantics don't match
;; the version number they report.)
- `(let ((.latest. (xmtn--latest-mtn-release)))
- (or (> (car ,version-var) (car .latest.))
- (and (= (car ,version-var) (car .latest.))
- (or (> (cadr ,version-var) (cadr .latest.))
- (and (= (cadr ,version-var) (cadr .latest.))
- (not (equal (caddr .latest.)
+ `(let ((-latest- (xmtn--latest-mtn-release)))
+ (or (> (car ,version-var) (car -latest-))
+ (and (= (car ,version-var) (car -latest-))
+ (or (> (cadr ,version-var) (cadr -latest-))
+ (and (= (cadr ,version-var) (cadr -latest-))
+ (not (equal (caddr -latest-)
(caddr ,version-var)))))))))
(t
(let ((operator (car condition))
@@ -356,9 +360,9 @@
collect condition)))))))
(defun xmtn--latest-mtn-release ()
- ;; Version and revision id of the latest mtn release at the time of
- ;; this xmtn release,
- '(0 33 "f93b47fe55221c5ce51cc01e522ec0b92df49a2b"))
+ ;; Version number and revision id of the latest mtn release at the
+ ;; time of this xmtn release.
+ '(0 34 "6ae6de16b31495a773ac3002505ad51f2e4a8616"))
(provide 'xmtn-run)
_______________________________________________
Dvc-dev mailing list
[email protected]
https://mail.gna.org/listinfo/dvc-dev
