1 ;;; update-changelog.el --- stitch rcs2log output to ChangeLog
3 ;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
5 ;;;; This library is free software; you can redistribute it and/or
6 ;;;; modify it under the terms of the GNU Lesser General Public
7 ;;;; License as published by the Free Software Foundation; either
8 ;;;; version 3 of the License, or (at your option) any later version.
10 ;;;; This library 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 GNU
13 ;;;; Lesser General Public License for more details.
15 ;;;; You should have received a copy of the GNU Lesser General Public
16 ;;;; License along with this library; if not, write to the Free
17 ;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
22 ;; Usage: emacs -batch -l update-changelog.el
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.
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.
35 ;; You can pass additional options to rcs2log using env var `RCS2LOG_OPTS'.
37 ;; Usage from a Lisp program:
38 ;; (ucl-update filename) -- Update FILENAME, a Change Log file
42 ;;;---------------------------------------------------------------------------
45 (defvar ucl-o
(or (getenv "RCS2LOG_OPTS") "")
46 "Additional options to pass to rcs2log.")
48 ;;;---------------------------------------------------------------------------
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."
55 (or (= new-old
(point-max)) ; no old
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
))))))
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
)
70 (delete-region (point)
72 (if (re-search-forward "^[0-9]+" (point-max))
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))
82 (delete-blank-lines))))
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
)
89 (match-beginning 0) (match-end 0))))
91 (defvar ucl-cleanup-hook
'(ucl-stitch-new-old
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.)")
102 ;;;---------------------------------------------------------------------------
106 (let ((lwr (getenv "LOCAL_WORK_ROOT"))
107 (cr (getenv "CVSROOT")))
110 (setq ucl-o
(concat "-R " ucl-o
)) ; hmm
112 (error "Must set env var LOCAL_WORK_ROOT or CVSROOT"))
115 (defun ucl-update (filename)
116 (interactive "fChangeLog: ")
117 (let* ((ofile (expand-file-name filename
))
118 (cmd (concat "rcs2log " ucl-o
" -c " ofile
))
120 (when (and (file-exists-p ofile
)
122 (shell-command cmd obuf
)
124 (save-excursion ; prevent default-directory hosing
126 (unless (= 0 (buffer-size))
127 (let ((new-old-boundary (point-max)))
128 (goto-char new-old-boundary
)
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))))))
136 ;;;---------------------------------------------------------------------------
137 ;;; Load-time actions
139 (when noninteractive
; only when `-batch'
140 (or (ucl-update "ChangeLog")
141 (message "Sorry, could not update ChangeLog in %s" default-directory
)))
143 (provide 'update-changelog
)
145 ;;; update-changelog.el ends here