| ;;;; 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 "https://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") |