Commit | Line | Data |
---|---|---|
817c6eca TTN |
1 | ;;; update-changelog.el --- stitch rcs2log output to ChangeLog |
2 | ||
6e7d5622 | 3 | ;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. |
817c6eca TTN |
4 | |
5 | ;; This program is free software; you can redistribute it and/or modify | |
6 | ;; it under the terms of the GNU General Public License as published by | |
7 | ;; the Free Software Foundation; either version 2, or (at your option) | |
8 | ;; any later version. | |
9 | ||
10 | ;; This program is distributed in the hope that it will be useful, | |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 | ;; GNU General Public License for more details. | |
14 | ||
15 | ;; You should have received a copy of the GNU General Public License | |
16 | ;; along with this program; see the file COPYING. If not, write to the | |
92205699 MV |
17 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
18 | ;; Boston, MA 02110-1301, USA. | |
817c6eca TTN |
19 | |
20 | ;;; Commentary: | |
21 | ||
22 | ;; Usage: emacs -batch -l update-changelog.el | |
23 | ;; | |
24 | ;; This program is basically a wrapper around rcs2log, and inherits rcs2log's | |
25 | ;; weaknesses, namely, the requirement that there be a checked out (working | |
26 | ;; directory) copy. It would be nice if rcs2log grokked with the repository | |
27 | ;; directly, but until then, we work around it by requiring the environment | |
28 | ;; var `LOCAL_WORK_ROOT' to be defined. This should be a directory under | |
29 | ;; which cvs modules are checked out. | |
30 | ;; | |
31 | ;; Flash! Newer versions of rcs2log do indeed understand the repository, | |
32 | ;; and can be invoked with "-R" therein. We infer this if `LOCAL_WORK_ROOT' | |
33 | ;; is not set, and use instead `CVSROOT'. At least one of these must be set. | |
34 | ;; | |
817c6eca TTN |
35 | ;; You can pass additional options to rcs2log using env var `RCS2LOG_OPTS'. |
36 | ;; | |
7818cea4 TTN |
37 | ;; Usage from a Lisp program: |
38 | ;; (ucl-update filename) -- Update FILENAME, a Change Log file | |
817c6eca TTN |
39 | |
40 | ;;; Code: | |
41 | ||
42 | ;;;--------------------------------------------------------------------------- | |
43 | ;;; Variables | |
44 | ||
817c6eca TTN |
45 | (defvar ucl-o (or (getenv "RCS2LOG_OPTS") "") |
46 | "Additional options to pass to rcs2log.") | |
47 | ||
48 | ;;;--------------------------------------------------------------------------- | |
49 | ;;; Cleanup functions | |
50 | ||
51 | (defun ucl-stitch-new-old (new-old &rest ignore) | |
52 | "In a changelog buffer, remove redundancy around NEW-OLD point. | |
53 | The new text is before NEW-OLD point, and the old after." | |
54 | (goto-char new-old) | |
55 | (or (= new-old (point-max)) ; no old | |
56 | (let ((last-new | |
57 | (save-excursion | |
58 | (buffer-substring (re-search-backward "^[0-9]+") new-old)))) | |
59 | (let ((has-diff (string-match "\n\tdiff.*-r" last-new))) ; ugh | |
60 | (and has-diff (setq last-new (substring last-new 0 has-diff)))) | |
61 | (let ((overlap (search-forward last-new (point-max) t))) | |
62 | (and overlap (delete-region new-old overlap)))))) | |
63 | ||
64 | ;; Sometimes wannabe developers append diffs to their log entries. | |
65 | (defun ucl-omit-diffs (&rest ignore) | |
66 | "In a changelog buffer, delete diffs (assumed at end of entry)." | |
67 | (goto-char (point-min)) | |
68 | (while (re-search-forward "^\tdiff .*-r" (point-max) t) | |
69 | (beginning-of-line) | |
70 | (delete-region (point) | |
71 | (save-excursion | |
72 | (if (re-search-forward "^[0-9]+" (point-max)) | |
73 | (- (point) 4) | |
74 | (point-max)))))) | |
75 | ||
76 | (defun ucl-space-out-entries (&rest ignore) | |
77 | "In a changelog buffer, ensure proper spacing between entries." | |
78 | (goto-char (point-max)) | |
79 | (while (re-search-backward "^[0-9]+" (point-min) t) | |
80 | (unless (= (point) (point-min)) | |
81 | (open-line 3) ; yuk | |
82 | (delete-blank-lines)))) | |
83 | ||
84 | (defun ucl-kill-eol-white-space (&rest ignore) | |
85 | "In a changelog buffer, delete end-of-line white space." | |
86 | (goto-char (point-min)) | |
87 | (while (re-search-forward "[ \t]+$" (point-max) t) | |
88 | (delete-region | |
89 | (match-beginning 0) (match-end 0)))) | |
90 | ||
91 | (defvar ucl-cleanup-hook '(ucl-stitch-new-old | |
92 | ucl-omit-diffs | |
93 | ucl-space-out-entries | |
94 | ucl-kill-eol-white-space) | |
95 | "Hook run after combining the new fragment with the old changelog. These | |
96 | are called with the argument NEW-OLD, which is the buffer position at the | |
97 | boundary of the two pieces of text. This is suboptimal; we should use a | |
98 | marker so that munges on the text do not lose this position. The result is | |
99 | that currently, `ucl-stitch-new-old' must be called first because it depends | |
100 | on NEW-OLD, while the other cleanup funcs ignore it. (Sigh.)") | |
101 | ||
102 | ;;;--------------------------------------------------------------------------- | |
103 | ;;; Update functions | |
104 | ||
105 | (defun ucl-root () | |
106 | (let ((lwr (getenv "LOCAL_WORK_ROOT")) | |
107 | (cr (getenv "CVSROOT"))) | |
108 | (concat (or lwr | |
109 | (and cr (progn | |
110 | (setq ucl-o (concat "-R " ucl-o)) ; hmm | |
111 | cr)) | |
112 | (error "Must set env var LOCAL_WORK_ROOT or CVSROOT")) | |
113 | "/"))) | |
114 | ||
7818cea4 TTN |
115 | (defun ucl-update (filename) |
116 | (interactive "fChangeLog: ") | |
117 | (let* ((ofile (expand-file-name filename)) | |
118 | (cmd (concat "rcs2log " ucl-o " -c " ofile)) | |
119 | (obuf "*ucl-work*")) | |
817c6eca TTN |
120 | (when (and (file-exists-p ofile) |
121 | (progn | |
7818cea4 | 122 | (shell-command cmd obuf) |
817c6eca TTN |
123 | (get-buffer obuf))) |
124 | (save-excursion ; prevent default-directory hosing | |
125 | (set-buffer obuf) | |
126 | (unless (= 0 (buffer-size)) | |
127 | (let ((new-old-boundary (point-max))) | |
128 | (goto-char new-old-boundary) | |
129 | (insert-file ofile) | |
130 | (run-hook-with-args 'ucl-cleanup-hook new-old-boundary)) | |
131 | (or (= (buffer-size) (nth 7 (file-attributes ofile))) | |
132 | (let (make-backup-files) ; less clutter | |
133 | (write-file ofile)))) | |
134 | (kill-buffer (current-buffer)))))) | |
135 | ||
817c6eca TTN |
136 | ;;;--------------------------------------------------------------------------- |
137 | ;;; Load-time actions | |
138 | ||
7818cea4 TTN |
139 | (when noninteractive ; only when `-batch' |
140 | (or (ucl-update "ChangeLog") | |
141 | (message "Sorry, could not update ChangeLog in %s" default-directory))) | |
817c6eca TTN |
142 | |
143 | (provide 'update-changelog) | |
144 | ||
145 | ;;; update-changelog.el ends here |