1 files changed, 566 insertions, 0 deletions
diff --git a/tools/dev/svn-dev.el b/tools/dev/svn-dev.el
new file mode 100644
index 0000000..2fc32c3
--- /dev/null
+++ b/tools/dev/svn-dev.el
@@ -0,0 +1,566 @@
+;;;; Emacs Lisp help for writing Subversion code. ;;;;
+
+;; Licensed to the Apache Software Foundation (ASF) under one
+;; or more contributor license agreements.  See the NOTICE file
+;; distributed with this work for additional information
+;; regarding copyright ownership.  The ASF licenses this file
+;; to you under the Apache License, Version 2.0 (the
+;; "License"); you may not use this file except in compliance
+;; with the License.  You may obtain a copy of the License at
+;;
+;;   http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing,
+;; software distributed under the License is distributed on an
+;; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+;; KIND, either express or implied.  See the License for the
+;; specific language governing permissions and limitations
+;; under the License.
+
+
+;; Later on, there will be auto-detection of svn files, modeline
+;; status, and a whole library of routines to interface with the
+;; command-line client.  For now, there's this, at Ben's request.
+;;
+;; All this stuff should get folded into Emacs VC mode, really.
+
+(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)
+    ;; todo: make a backup~ file?
+    (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)
+    ;; todo: make a backup~ file?
+    (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")  ; any use for interactive, other than testing?
+  (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)) ; for `vc-make-backup-files'
+        (unless vc-make-backup-files
+          (make-local-variable 'backup-inhibited)
+          (setq backup-inhibited t)))))
+
+(add-hook 'find-file-hooks 'svn-find-file-hook)
+
+
+
+;;; Dynamic generation of common Subversion URLs.
+;;;
+;;; (I have a version of this that actually fetches the stuff from the
+;;; Net if you don't have a local copy, but it requires a very recent
+;;; version of Emacs, so I didn't bother with it here.  -kfogel)
+
+(defvar svn-site-source-tree-top (expand-file-name "~/projects/svn/site/")
+  "*Top directory of your Subversion site source tree of
+repository \"http://svn.apache.org/repos/asf/subversion/site\".
+You almost certainly want to set this in your .emacs, to override
+the default; use `(setq svn-site-source-tree-top
+\"/path/to/the/site/tree\")'.")
+
+(defvar svn-faq-file (concat svn-site-source-tree-top "/publish/faq.html")
+  "*A local copy of the Subversion FAQ.")
+
+(defvar svn-hacking-file (concat svn-site-source-tree-top 
+                                 "/docs/community-guide/community-guide.html")
+  "*A local copy of the Subversion hacking.html file.")
+
+;; Helper for referring to issue numbers in a user-friendly way.
+(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)))
+
+;; Helper for referring to revisions in a browser-friendly way.
+(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.apache.org/viewcvs?view=revision&revision=%s" 
+                  rev)))
+
+(defconst svn-url-base "http://subversion.apache.org/")
+(defconst svn-faq-url (concat svn-url-base "faq.html"))
+(defconst svn-hacking-url (concat svn-url-base 
+                                  "docs/community-guide/community-guide.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))
+      ;; TODO: Ideally, this wouldn't depend on the presence of a
+      ;; table of contents with "#" URLs, it would read the divs and
+      ;; anchors themselves.
+      (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))
+
+
+
+;;; Subversion C conventions
+(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)
+
+
+
+;; Subversion Python conventions, plus some harmless helpers for
+;; people who don't have python mode set up by default.
+(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)
+
+
+
+;; Much of the APR documentation is embedded perldoc format.  The
+;; perldoc program itself sucks, however.  If you're the author of
+;; perldoc, I'm sorry, but what were you thinking?  Don't you know
+;; that there are people in the world who don't work in vt100
+;; terminals?  If I want to view a perldoc page in my Emacs shell
+;; buffer, I have to run the ridiculous command
+;;
+;;   $ PAGER=cat perldoc -t target_file
+;;
+;; (Not that this was documented anywhere, I had to figure it out for
+;; myself by reading /usr/bin/perldoc).
+;;
+;; Non-paging behavior should be a standard command-line option.  No
+;; program that can output text should *ever* insist on invoking the
+;; pager.
+;;
+;; Anyway, these Emacs commands will solve the problem for us.
+;;
+;; Acknowledgements:
+;; Much of this code is copied from man.el in the FSF Emacs 21.x
+;; sources.
+
+(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 ()
+  ;; \255 is some kind of dash in Latin-N.  Versions of Debian man, at
+  ;; least, emit it even when not in a Latin-N locale.
+  (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"))
+
+
+;; Entry point to svn-perldoc functionality.
+(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")  ;; for perldoc
+    (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)
+      ;; Clean out the inevitable leading dead space.
+      (goto-char (point-min))
+      (re-search-forward "[^ \i\n]")
+      (beginning-of-line)
+      (delete-region (point-min) (point)))
+    (setenv "PAGER" savepg)
+    (display-buffer outbuf)))
+
+
+
+;;; Help developers write log messages.
+
+;; How to use this: just run `svn-log-message'.  You might want to
+;; bind it to a key, for example,
+;;
+;;   (define-key "\C-cl" 'svn-log-message)
+;;
+;; The log message will accumulate in a file.  Later, you can use
+;; that file when you commit:
+;;
+;;   $ svn ci -F msg ...
+
+(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)))
+            ;; Kluge for Subversion developers.
+            (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))
+    ;; Strip text properties from strings
+    (set-text-properties 0 (length this-file) nil this-file)
+    (set-text-properties 0 (length this-defun) nil this-defun)
+    ;; If log message for defun already in progress, add to it
+    (if (and
+         this-defun                        ;; we have a defun to work with
+         (search-forward this-defun nil t) ;; it's in the log msg already
+         (save-excursion                   ;; and it's about the same file
+           (save-match-data
+             (if (re-search-backward  ; Ick, I want a real filename regexp!
+                  "^\\*\\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)))
+      ;; Else no log message for this defun in progress...
+      (goto-char (point-min))
+      ;; But if log message for file already in progress, add to it.
+      (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)))
+        ;; Found neither defun nor its file, so create new entry.
+        (goto-char (point-max))
+        (if (not (bolp)) (insert "\n"))
+        (insert (format "\n* %s (%s): " this-file (or this-defun "")))
+        ;; Finally, if no derived defun, put point where the user can
+        ;; type it themselves.
+        (if (not this-defun) (forward-char -3))))))
+
+
+
+;;; Log message helpers.
+
+(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")