| ;;;; 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") |