(defun svn-revert ()
"Revert the current buffer and its file to its svn base revision."
(interactive)
(let ((obuf (current-buffer))
(fname (buffer-file-name))
(outbuf (get-buffer-create "*svn output*")))
(set-buffer outbuf)
(delete-region (point-min) (point-max))
(call-process "svn" nil outbuf nil "status" fname)
(goto-char (point-min))
(search-forward fname)
(beginning-of-line)
(if (looking-at "^?")
(error "\"%s\" is not a Subversion-controlled file" fname))
(call-process "svn" nil outbuf nil "revert" fname)
(set-buffer obuf)
(save-excursion
(revert-buffer nil t)
(save-buffer))
(message "Reverted \"%s\"." fname)))
(defun svn-resolved ()
"Tell Subversion that conflicts in the current buffer and its file have
been resolved."
(interactive)
(let ((obuf (current-buffer))
(fname (buffer-file-name))
(outbuf (get-buffer-create "*svn output*")))
(set-buffer outbuf)
(delete-region (point-min) (point-max))
(call-process "svn" nil outbuf nil "status" fname)
(goto-char (point-min))
(search-forward fname)
(beginning-of-line)
(if (looking-at "^?")
(error "\"%s\" is not a Subversion-controlled file" fname))
(call-process "svn" nil outbuf nil "resolved" fname)
(set-buffer obuf)
(save-excursion
(revert-buffer nil t)
(save-buffer))
(message "Marked \"%s\" as conflict-free." fname)))
(defconst svn-adm-area ".svn"
"The name of the Subversion administrative subdirectory.")
(defconst svn-adm-entries ".svn/entries"
"The path from cwd to the Subversion entries file.")
(defun svn-controlled-path-p (path)
"Return non-nil if PATH is under Subversion version control, else
return nil. If PATH does not exist, return nil.
In the future, this will return an Emacs Lisp reflection of PATH's
entry, either an explicit svn-entry-struct, or a list of the form
\(LAST-COMMIT-REV CURRENT-REV LAST-COMMITTER ...\), so we can display
svn information in the mode line. But that requires truly parsing the
entries file, instead of just detecting PATH among the entries."
(interactive "f") (cond
((not (file-exists-p path))
nil)
((file-directory-p path)
(let ((adm-area (concat path "/" svn-adm-area)))
(if (file-directory-p adm-area)
t
nil)))
(t
(let ((entries (concat (file-name-directory path) svn-adm-entries))
(basename (file-name-nondirectory path))
(found nil))
(save-excursion
(if (file-directory-p (concat (file-name-directory path) svn-adm-area))
(progn
(let ((find-file-hooks nil))
(set-buffer (find-file-noselect entries t)))
(goto-char (point-min))
(if (search-forward (format "name=\"%s\"" basename) nil t)
(setq found t)
(setq found nil))
(kill-buffer nil)))
found)))))
(defun svn-text-base-path (file)
"Return the path to the text base for FILE (a string).
If FILE is a directory or not under version control, return nil."
(cond
((not (svn-controlled-path-p file)) nil)
((file-directory-p file) nil)
(t
(let* ((pdir (file-name-directory file))
(base (file-name-nondirectory file)))
(format "%s%s/text-base/%s.svn-base" (or pdir "") svn-adm-area base)))))
(defun svn-ediff (file)
"Ediff FILE against its text base."
(interactive "fsvn ediff: ")
(let ((tb (svn-text-base-path file)))
(if (not tb)
(error "No text base for %s" file)
(ediff-files file tb))))
(defun svn-find-file-hook ()
"Function for find-file-hooks.
Inhibit backup files unless `vc-make-backup-files' is non-nil."
(if (svn-controlled-path-p (buffer-file-name))
(progn
(if (string-match "XEMACS\\|XEmacs\\|xemacs" emacs-version)
(vc-load-vc-hooks)) (unless vc-make-backup-files
(make-local-variable 'backup-inhibited)
(setq backup-inhibited t)))))
(add-hook 'find-file-hooks 'svn-find-file-hook)
(defvar svn-source-tree-top (expand-file-name "~/projects/svn/")
"*Top directory of your Subversion source tree. You almost
certainly want to set this in your .emacs, to override the default;
use `(setq svn-source-tree-top \"/path/to/the/tree\")'.")
(defvar svn-faq-file (concat svn-source-tree-top "/www/faq.html")
"*A local copy of the Subversion FAQ.")
(defvar svn-hacking-file (concat svn-source-tree-top "/www/hacking.html")
"*A local copy of the Subversion hacking.html file.")
(defun svn-bug-url (n)
"Insert the url for Subversion issue number N. Interactively, prompt for N."
(interactive "nSubversion issue number: ")
(insert (format "http://subversion.tigris.org/issues/show_bug.cgi?id=%d" n)))
(defun svn-rev-url (rev &optional transform)
"Insert the url for Subversion revision REV, or if TRANSFORM is not
nil, then transform the revision at or around point into an HTML link.
Interactively, if at or inside a revision number, transform it into
full HTML link; otherwise, prompt for revision number and insert just
the resulting URL."
(interactive (let ((thing (thing-at-point 'word)))
(if (and thing (string-match "r[0-9]+" thing))
(list thing t)
(list (read-string "Subversion revision number: ") nil))))
(if (string-match "^r[0-9]+" rev)
(setq rev (substring rev 1)))
(if transform
(let* ((bounds (bounds-of-thing-at-point 'word))
(start (car bounds))
(end (cdr bounds)))
(delete-region start end)))
(insert (format "http://svn.collab.net/viewcvs/svn?rev=%s&view=rev" rev)))
(defconst svn-url-base "http://subversion.tigris.org/")
(defconst svn-faq-url (concat svn-url-base "faq.html"))
(defconst svn-hacking-url (concat svn-url-base "hacking.html"))
(defun svn-html-get-targets (file)
"Build a list of targets for the Subversion web file FILE."
(let* ((lst nil)
(already-buffer (find-buffer-visiting file))
(faq-buffer (or already-buffer (find-file-noselect file))))
(save-excursion
(set-buffer faq-buffer)
(goto-char (point-min))
(while (search-forward "href=\"#" nil t)
(let ((b (point))
(e (progn (search-forward "\"") (forward-char -1) (point))))
(setq lst (cons (buffer-substring b e) lst))))
(if (not already-buffer)
(kill-buffer (current-buffer)))
lst)))
(defun svn-url-completing-read (file prompt &optional hist-list)
"Completingly read an HTML target for FILE, prompting with PROMPT.
If HIST-LIST is non-nil, it is a symbol: the completion history list to use."
(progn
(let* ((targets (svn-html-get-targets file))
(target-str (completing-read prompt targets nil t nil hist-list)))
(list target-str))))
(defvar svn-faq-history-list nil
"History list for the 'svn-faq-url' prompt.")
(defvar svn-hacking-history-list nil
"History list for the 'svn-hacking-url' prompt.")
(defun svn-faq-url (target)
"Prompt with completion for a targeted SVN FAQ item, then insert it.
If called non-interactively, TARGET is the target within the faq (an
HTML anchor name, that is, the part after the \"#\")."
(interactive
(svn-url-completing-read svn-faq-file "FAQ entry: "
'svn-faq-history-list))
(insert svn-faq-url "#" target))
(defun svn-hacking-url (target)
"Prompt with completion for a targeted hacking.html item, then insert it.
If called non-interactively, TARGET is the target within hacking.html
(an HTML anchor name, that is, the part after the \"#\")."
(interactive
(svn-url-completing-read svn-hacking-file "hacking.html entry: "
'svn-hacking-history-list))
(insert svn-hacking-url "#" target))
(if (eq major-mode 'c-mode)
(progn
(c-add-style "svn" '("gnu" (c-offsets-alist . ((inextern-lang . 0)))))
(c-set-style "svn")))
(setq indent-tabs-mode nil)
(setq angry-mob-with-torches-and-pitchforks t)
(autoload 'python-mode "python-mode" nil t)
(or (assoc "\\.py$" auto-mode-alist)
(setq auto-mode-alist
(cons '("\\.py$" . python-mode) auto-mode-alist)))
(defun svn-python-mode-hook ()
"Set up the Subversion python conventions. The effect of this is
local to the current buffer, which is presumably visiting a file in
the Subversion project. Python setup in other buffers will not be
affected."
(when (string-match "/subversion/" (buffer-file-name))
(make-local-variable 'py-indent-offset)
(setq indent-tabs-mode nil)
(setq py-indent-offset 2)
(make-local-variable 'py-smart-indentation)
(setq py-smart-indentation nil)))
(add-hook 'python-mode-hook 'svn-python-mode-hook)
(defcustom svn-perldoc-overstrike-face 'bold
"*Face to use when fontifying overstrike."
:type 'face
:group 'svn-dev)
(defcustom svn-perldoc-underline-face 'underline
"*Face to use when fontifying underlining."
:type 'face
:group 'svn-dev)
(defun svn-perldoc-softhyphen-to-minus ()
(unless (eq t (compare-strings "latin-" 0 nil
current-language-environment 0 6 t))
(goto-char (point-min))
(let ((str "\255"))
(if enable-multibyte-characters
(setq str (string-as-multibyte str)))
(while (search-forward str nil t) (replace-match "-")))))
(defun svn-perldoc-fontify-buffer ()
"Convert overstriking and underlining to the correct fonts.
Same for the ANSI bold and normal escape sequences."
(interactive)
(message "Please wait, making up the page...")
(goto-char (point-min))
(while (search-forward "\e[1m" nil t)
(delete-backward-char 4)
(put-text-property (point)
(progn (if (search-forward "\e[0m" nil 'move)
(delete-backward-char 4))
(point))
'face svn-perldoc-overstrike-face))
(goto-char (point-min))
(while (search-forward "_\b" nil t)
(backward-delete-char 2)
(put-text-property (point) (1+ (point)) 'face svn-perldoc-underline-face))
(goto-char (point-min))
(while (search-forward "\b_" nil t)
(backward-delete-char 2)
(put-text-property (1- (point)) (point) 'face svn-perldoc-underline-face))
(goto-char (point-min))
(while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
(replace-match "\\1")
(put-text-property (1- (point)) (point) 'face svn-perldoc-overstrike-face))
(goto-char (point-min))
(while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
(replace-match "o")
(put-text-property (1- (point)) (point) 'face 'bold))
(goto-char (point-min))
(while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t)
(replace-match "+")
(put-text-property (1- (point)) (point) 'face 'bold))
(svn-perldoc-softhyphen-to-minus)
(message "Please wait, making up the page...done"))
(defun svn-perldoc-cleanup-buffer ()
"Remove overstriking and underlining from the current buffer."
(interactive)
(message "Please wait, cleaning up the page...")
(progn
(goto-char (point-min))
(while (search-forward "_\b" nil t) (backward-delete-char 2))
(goto-char (point-min))
(while (search-forward "\b_" nil t) (backward-delete-char 2))
(goto-char (point-min))
(while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
(replace-match "\\1"))
(goto-char (point-min))
(while (re-search-forward "\e\\[[0-9]+m" nil t) (replace-match ""))
(goto-char (point-min))
(while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o"))
(goto-char (point-min))
(while (re-search-forward "" nil t) (replace-match " ")))
(goto-char (point-min))
(while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
(svn-perldoc-softhyphen-to-minus)
(message "Please wait, cleaning up the page...done"))
(defun svn-perldoc (file)
"Run perldoc on FILE, display the output in a buffer."
(interactive "fRun perldoc on file: ")
(let ((outbuf (get-buffer-create
(format "*%s PerlDoc*" (file-name-nondirectory file))))
(savepg (getenv "PAGER")))
(setenv "PAGER" "cat") (save-excursion
(set-buffer outbuf)
(delete-region (point-min) (point-max))
(call-process "perldoc" nil outbuf nil (expand-file-name file))
(svn-perldoc-fontify-buffer)
(svn-perldoc-cleanup-buffer)
(goto-char (point-min))
(re-search-forward "[^ \i\n]")
(beginning-of-line)
(delete-region (point-min) (point)))
(setenv "PAGER" savepg)
(display-buffer outbuf)))
(defun svn-log-path-derive (path)
"Derive a relative directory path for absolute PATH, for a log entry."
(save-match-data
(let ((base (file-name-nondirectory path))
(chop-spot (string-match
"\\(code/\\)\\|\\(src/\\)\\|\\(projects/\\)"
path)))
(if chop-spot
(progn
(setq path (substring path (match-end 0)))
(if (string-match "subversion/" path)
(substring path (+ (match-beginning 0) 11))
path))
(string-match (expand-file-name "~/") path)
(substring path (match-end 0))))))
(defun svn-log-message-file ()
"Return the name of the appropriate log message accumulation file.
Usually this is just the file `msg' in the current directory, but
certain areas are treated specially, for example, the Subversion
source tree."
(save-match-data
(if (string-match "subversion" default-directory)
(concat (substring default-directory 0 (match-end 0)) "/msg")
"msg")))
(defun svn-log-message (short-file-names)
"Add to an in-progress log message, based on context around point.
If prefix arg SHORT-FILE-NAMES is non-nil, then use basenames only in
log messages, otherwise use full paths. The current defun name is
always used.
If the log message already contains material about this defun, then put
point there, so adding to that material is easy.
Else if the log message already contains material about this file, put
point there, and push onto the kill ring the defun name with log
message dressing around it, plus the raw defun name, so yank and
yank-next are both useful.
Else if there is no material about this defun nor file anywhere in the
log message, then put point at the end of the message and insert a new
entry for file with defun.
See also the function `svn-log-message-file'."
(interactive "P")
(let ((this-file (if short-file-names
(file-name-nondirectory buffer-file-name)
(svn-log-path-derive buffer-file-name)))
(this-defun (or (add-log-current-defun)
(save-excursion
(save-match-data
(if (eq major-mode 'c-mode)
(progn
(if (fboundp 'c-beginning-of-statement-1)
(c-beginning-of-statement-1)
(c-beginning-of-statement))
(search-forward "(" nil t)
(forward-char -1)
(forward-sexp -1)
(buffer-substring
(point)
(progn (forward-sexp 1) (point)))))))))
(log-file (svn-log-message-file)))
(find-file log-file)
(goto-char (point-min))
(set-text-properties 0 (length this-file) nil this-file)
(set-text-properties 0 (length this-defun) nil this-defun)
(if (and
this-defun (search-forward this-defun nil t) (save-excursion (save-match-data
(if (re-search-backward "^\\*\\s-+\\([a-zA-Z0-9-_.@=+^$/%!?(){}<>]+\\)" nil t)
(string-equal (match-string 1) this-file)
t))))
(if (re-search-forward ":" nil t)
(if (looking-at " ") (forward-char 1)))
(goto-char (point-min))
(if (search-forward this-file nil t)
(progn
(if this-defun (progn
(kill-new (format "(%s): " this-defun))
(kill-new this-defun)))
(search-forward ")" nil t)
(if (looking-at " ") (forward-char 1)))
(goto-char (point-max))
(if (not (bolp)) (insert "\n"))
(insert (format "\n* %s (%s): " this-file (or this-defun "")))
(if (not this-defun) (forward-char -3))))))
(defconst svn-log-msg-sep-line
"------------------------------------------------------------------------"
"The line of dashes that separates log messages in 'svn log' output.")
(defconst svn-log-msg-boundary-regexp
(concat "^" svn-log-msg-sep-line "\n" "r[0-9]+ | ")
"Regular expression matching the start of a log msg. The start is
the beginning of the separator line, not the rev/author/date line that
follows the separator line.")
(defun svn-narrow-to-log-msg ()
"Narrow to the current Subversion log message.
This meant to be used while browsing the output of 'svn log'.
If point is not in such output, error."
(interactive)
(let ((start nil) (end nil))
(save-excursion
(re-search-backward svn-log-msg-boundary-regexp)
(forward-line 1)
(setq start (point))
(end-of-line)
(re-search-backward "| \\([0-9]+\\) ")
(let ((num (match-string 1)))
(re-search-forward "^\n")
(forward-line (string-to-number num)))
(setq end (point)))
(narrow-to-region start end)))
(message "loaded svn-dev.el")