Download
(provide 'sr-monotone)
(defun mtn-get-parent-directory (child)
"Retruns the parent directory or nil, if there is no parent.
Parent has always a trailing slash, or what ever is your systems
file separtor.
Improvements and suggestions to sebastian_rose gmx de."
(if (file-regular-p child)
(file-name-as-directory (file-name-directory child))
(let ((child (file-name-as-directory child)))
(let ((dir (file-name-as-directory (expand-file-name child)))
(parent (file-truename
(file-name-as-directory (expand-file-name (concat child ".."))))))
(if (string= dir parent)
nil
parent)))))
(defun mtn-add-change-log-entry()
"Searches in buffers default-directory and above for a directory
named '_MTN'. If it exists, monotone-add-change-log-entry calls
add-change-log-entry interactively with apropriate arguments.
Otherwise interactively calls add-change-log-entry the normal way.
So one can just bind this function to the keys, that call
add-change-log-entry now, and it will work just fine.
Improvements and suggestions to sebastian_rose gmx de."
(interactive)
(let ((filename buffer-file-name)
(is-mtn-dir nil)
(original-default-directory default-directory)
(original-change-log-filename nil))
(if (boundp 'change-log-default-name)
(setq original-change-log-filename change-log-default-name))
(unwind-protect
(progn
(if filename
(progn
(catch 'done
(while (setq filename (mtn-get-parent-directory filename))
(if (file-directory-p (concat filename "_MTN"))
(progn
(setq change-log-default-name "log")
(setq is-mtn-dir (concat filename "_MTN"))
(throw 'done 'is-mtn-dir)))))
(if is-mtn-dir
(let ((default-directory is-mtn-dir))
(call-interactively 'add-change-log-entry))
(call-interactively 'add-change-log-entry))
)))
(setq default-directory original-default-directory)
(setq change-log-default-name original-change-log-filename))))
(defun mtn-add-log-file-name(original-name)
"Return the filename printed in _MTN/log (or ChangeLog) relative to
the projects root. That is the driectory the file ChangeLog lives in,
if not a monotone project, _MTN/../ otherwise.
Improvements and suggestions to sebastian_rose gmx de."
(let ((directory (mtn-get-parent-directory log-file))
(file (file-truename original-name)))
(if (string= change-log-default-name "log")
(let ((directory (mtn-get-parent-directory directory)))
(file-relative-name file directory))
(file-relative-name file directory))))