(describe_syntax_1): Delete excess arg to describe_vector.
[bpt/emacs.git] / lisp / add-log.el
CommitLineData
84fc2cfa
ER
1;;; add-log.el --- change log maintenance commands for Emacs
2
ec367ad6 3;; Copyright (C) 1985, 1986, 1988, 1993 Free Software Foundation, Inc.
84fc2cfa
ER
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
fd7fa35a 9;; the Free Software Foundation; either version 2, or (at your option)
84fc2cfa
ER
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to
19;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
20
fd7fa35a 21;;; Code:
84fc2cfa
ER
22
23;;;###autoload
24(defvar change-log-default-name nil
25 "*Name of a change log file for \\[add-change-log-entry].")
26
27(defun change-log-name ()
28 (or change-log-default-name
29 (if (eq system-type 'vax-vms) "$CHANGE_LOG$.TXT" "ChangeLog")))
30
31(defun prompt-for-change-log-name ()
32 "Prompt for a change log name."
33 (let ((default (change-log-name)))
34 (expand-file-name
35 (read-file-name (format "Log file (default %s): " default)
36 nil default))))
37
38;;;###autoload
39(defun add-change-log-entry (&optional whoami file-name other-window)
40 "Find change log file and add an entry for today.
41Optional arg (interactive prefix) non-nil means prompt for user name and site.
42Second arg is file name of change log. If nil, uses `change-log-default-name'.
43Third arg OTHER-WINDOW non-nil means visit in other window."
44 (interactive (list current-prefix-arg
45 (prompt-for-change-log-name)))
dd309224 46 (let* ((full-name (if whoami
84fc2cfa
ER
47 (read-input "Full name: " (user-full-name))
48 (user-full-name)))
49 ;; Note that some sites have room and phone number fields in
50 ;; full name which look silly when inserted. Rather than do
51 ;; anything about that here, let user give prefix argument so that
52 ;; s/he can edit the full name field in prompter if s/he wants.
53 (login-name (if whoami
54 (read-input "Login name: " (user-login-name))
55 (user-login-name)))
56 (site-name (if whoami
57 (read-input "Site name: " (system-name))
21d7e080
ER
58 (system-name)))
59 (defun (add-log-current-defun))
82f4acaf 60 paragraph-end entry)
84fc2cfa
ER
61 (or file-name
62 (setq file-name (or change-log-default-name
63 default-directory)))
dd309224
RM
64 (setq file-name (if (file-directory-p file-name)
65 (expand-file-name (change-log-name) file-name)
66 (expand-file-name file-name)))
09b389d0
RS
67 ;; Chase links before visiting the file.
68 ;; This makes it easier to use a single change log file
69 ;; for several related directories.
e12d0df7
RS
70 (setq file-name
71 (expand-file-name (or (file-symlink-p file-name) file-name)))
6d7ee041
RS
72 ;; Move up in the dir hierarchy till we find a change log file.
73 (let ((file1 file-name)
74 parent-dir)
75 (while (and (not (file-exists-p file1))
76 (progn (setq parent-dir
77 (file-name-directory
78 (directory-file-name
79 (file-name-directory file1))))
80 ;; Give up if we are already at the root dir.
81 (not (string= (file-name-directory file1) parent-dir))))
82 ;; Move up to the parent dir and try again.
83 (setq file1 (expand-file-name (change-log-name) parent-dir)))
84 ;; If we found a change log in a parent, use that.
85 (if (file-exists-p file1)
86 (setq file-name file1)))
87
84fc2cfa 88 (set (make-local-variable 'change-log-default-name) file-name)
82f4acaf
RM
89
90 ;; Set ENTRY to the file name to use in the new entry.
91 (and buffer-file-name
92 ;; Never want to add a change log entry for the ChangeLog file itself.
93 (not (string= buffer-file-name file-name))
94 (setq entry (if (string-match
95 (concat "^" (regexp-quote (file-name-directory
96 file-name)))
97 buffer-file-name)
98 (substring buffer-file-name (match-end 0))
99 (file-name-nondirectory buffer-file-name))))
100
84fc2cfa
ER
101 (if (and other-window (not (equal file-name buffer-file-name)))
102 (find-file-other-window file-name)
103 (find-file file-name))
104 (undo-boundary)
105 (goto-char (point-min))
ec367ad6 106 (if (looking-at (concat (regexp-quote (substring (current-time-string)
82f4acaf
RM
107 0 10))
108 ".* " (regexp-quote full-name)
109 " (" (regexp-quote login-name) "@"))
ec367ad6
RS
110 (forward-line 1)
111 (insert (current-time-string)
112 " " full-name
113 " (" login-name "@" site-name ")\n\n"))
82f4acaf 114
74046d00 115 ;; Search only within the first paragraph.
82f4acaf
RM
116 (forward-paragraph 1)
117 (setq paragraph-end (point))
84fc2cfa 118 (goto-char (point-min))
82f4acaf 119
1832dbd1 120 ;; Now insert the new line for this entry.
82f4acaf
RM
121 (cond ((re-search-forward "^\\s *\\*\\s *$" paragraph-end t)
122 ;; Put this file name into the existing empty entry.
123 (if entry
124 (insert entry)))
125 ((and (re-search-forward
126 (concat (regexp-quote (concat "* " entry))
127 ;; Don't accept `foo.bar' when
128 ;; looking for `foo':
129 "\\(\\s \\|[(),:]\\)")
130 paragraph-end t))
131 ;; Add to the existing entry for the same file.
132 (re-search-forward "^\\s *$\\|^\\s \\*")
1832dbd1 133 (beginning-of-line)
09b389d0 134 (while (and (not (eobp)) (looking-at "^\\s *$"))
1832dbd1
RS
135 (delete-region (point) (save-excursion (forward-line 1) (point))))
136 (insert "\n\n")
137 (forward-line -2)
dd309224 138 (indent-relative-maybe))
21d7e080 139 (t
dd309224
RM
140 ;; Make a new entry.
141 (forward-line 1)
142 (while (looking-at "\\sW")
143 (forward-line 1))
09b389d0 144 (while (and (not (eobp)) (looking-at "^\\s *$"))
1832dbd1
RS
145 (delete-region (point) (save-excursion (forward-line 1) (point))))
146 (insert "\n\n\n")
147 (forward-line -2)
dd309224
RM
148 (indent-to left-margin)
149 (insert "* " (or entry ""))))
1832dbd1 150 ;; Now insert the function name, if we have one.
21d7e080
ER
151 ;; Point is at the entry for this file,
152 ;; either at the end of the line or at the first blank line.
153 (if defun
154 (progn
dd309224 155 ;; Make it easy to get rid of the function name.
21d7e080 156 (undo-boundary)
dd309224
RM
157 (insert (if (save-excursion
158 (beginning-of-line 1)
159 (looking-at "\\s *$"))
160 ""
161 " ")
162 "(" defun "): "))
1832dbd1 163 ;; No function name, so put in a colon unless we have just a star.
dd309224
RM
164 (if (not (save-excursion
165 (beginning-of-line 1)
166 (looking-at "\\s *\\(\\*\\s *\\)?$")))
1832dbd1 167 (insert ": ")))))
84fc2cfa 168
84fc2cfa
ER
169;;;###autoload
170(defun add-change-log-entry-other-window (&optional whoami file-name)
171 "Find change log file in other window and add an entry for today.
172First arg (interactive prefix) non-nil means prompt for user name and site.
173Second arg is file name of change log.
174Interactively, with a prefix argument, the file name is prompted for."
175 (interactive (if current-prefix-arg
176 (list current-prefix-arg
177 (prompt-for-change-log-name))))
178 (add-change-log-entry whoami file-name t))
82f4acaf 179;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
84fc2cfa 180
1da56800 181;;;###autoload
21d7e080 182(defun change-log-mode ()
dd309224 183 "Major mode for editting change logs; like Indented Text Mode.
09b389d0 184Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
5516387c
RM
185New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
186Each entry behaves as a paragraph, and the entries for one day as a page.
187Runs `change-log-mode-hook'."
21d7e080
ER
188 (interactive)
189 (kill-all-local-variables)
190 (indented-text-mode)
82f4acaf
RM
191 (setq major-mode 'change-log-mode
192 mode-name "Change Log"
193 left-margin 8
194 fill-column 74)
21d7e080 195 ;; Let each entry behave as one paragraph:
dd309224
RM
196 (set (make-local-variable 'paragraph-start) "^\\s *$\\|^^L")
197 (set (make-local-variable 'paragraph-separate) "^\\s *$\\|^^L\\|^\\sw")
21d7e080 198 ;; Let all entries for one day behave as one page.
2c91c85c
RS
199 ;; Match null string on the date-line so that the date-line
200 ;; is grouped with what follows.
201 (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
dd309224
RM
202 (set (make-local-variable 'version-control) 'never)
203 (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
21d7e080
ER
204 (run-hooks 'change-log-mode-hook))
205
206(defvar add-log-current-defun-header-regexp
d80788d8 207 "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[a-z_---A-Z]+\\)[ \t]*[:=]"
21d7e080
ER
208 "*Heuristic regexp used by `add-log-current-defun' for unknown major modes.")
209
210(defun add-log-current-defun ()
211 "Return name of function definition point is in, or nil.
212
213Understands Lisp, LaTeX (\"functions\" are chapters, sections, ...),
214Texinfo (@node titles), and C.
215
216Other modes are handled by a heuristic that looks in the 10K before
217point for uppercase headings starting in the first column or
218identifiers followed by `:' or `=', see variable
219`add-log-current-defun-header-regexp'.
220
221Has a preference of looking backwards."
2cc0b765
RS
222 (condition-case nil
223 (save-excursion
224 (let ((location (point)))
225 (cond ((memq major-mode '(emacs-lisp-mode lisp-mode scheme-mode))
226 ;; If we are now precisely a the beginning of a defun,
227 ;; make sure beginning-of-defun finds that one
228 ;; rather than the previous one.
229 (or (eobp) (forward-char 1))
230 (beginning-of-defun)
231 ;; Make sure we are really inside the defun found, not after it.
232 (if (and (progn (end-of-defun)
233 (< location (point)))
234 (progn (forward-sexp -1)
235 (>= location (point))))
236 (progn
237 (forward-word 1)
238 (skip-chars-forward " ")
239 (buffer-substring (point)
240 (progn (forward-sexp 1) (point))))))
241 ((and (memq major-mode '(c-mode 'c++-mode))
242 (save-excursion (beginning-of-line)
243 ;; Use eq instead of = here to avoid
244 ;; error when at bob and char-after
245 ;; returns nil.
246 (while (eq (char-after (- (point) 2)) ?\\)
36e6631c 247 (forward-line -1))
2cc0b765
RS
248 (looking-at "[ \t]*#[ \t]*define[ \t]")))
249 ;; Handle a C macro definition.
250 (beginning-of-line)
251 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
252 (forward-line -1))
253 (search-forward "define")
254 (skip-chars-forward " \t")
255 (buffer-substring (point)
256 (progn (forward-sexp 1) (point))))
257 ((memq major-mode '(c-mode 'c++-mode))
258 (beginning-of-line)
259 ;; See if we are in the beginning part of a function,
260 ;; before the open brace. If so, advance forward.
261 (while (not (looking-at "{\\|\\(\\s *$\\)"))
262 (forward-line 1))
263 (or (eobp)
264 (forward-char 1))
265 (beginning-of-defun)
266 (if (progn (end-of-defun)
267 (< location (point)))
268 (progn
269 (backward-sexp 1)
270 (let (beg tem)
fd7fa35a 271
2cc0b765
RS
272 (forward-line -1)
273 ;; Skip back over typedefs of arglist.
274 (while (and (not (bobp))
275 (looking-at "[ \t\n]"))
276 (forward-line -1))
277 ;; See if this is using the DEFUN macro used in Emacs,
278 ;; or the DEFUN macro used by the C library.
279 (if (condition-case nil
280 (and (save-excursion
281 (forward-line 1)
282 (backward-sexp 1)
283 (beginning-of-line)
284 (setq tem (point))
285 (looking-at "DEFUN\\b"))
286 (>= location tem))
287 (error nil))
288 (progn
289 (goto-char tem)
290 (down-list 1)
291 (if (= (char-after (point)) ?\")
292 (progn
293 (forward-sexp 1)
294 (skip-chars-forward " ,")))
295 (buffer-substring (point)
296 (progn (forward-sexp 1) (point))))
297 ;; Ordinary C function syntax.
298 (setq beg (point))
299 (if (condition-case nil
300 ;; Protect against "Unbalanced parens" error.
301 (progn
302 (down-list 1) ; into arglist
303 (backward-up-list 1)
304 (skip-chars-backward " \t")
305 t)
306 (error nil))
307 ;; Verify initial pos was after
308 ;; real start of function.
309 (if (and (save-excursion
310 (goto-char beg)
311 ;; For this purpose, include the line
312 ;; that has the decl keywords. This
313 ;; may also include some of the
314 ;; comments before the function.
315 (while (and (not (bobp))
316 (save-excursion
317 (forward-line -1)
318 (looking-at "[^\n\f]")))
319 (forward-line -1))
320 (>= location (point)))
321 ;; Consistency check: going down and up
322 ;; shouldn't take us back before BEG.
323 (> (point) beg))
324 (buffer-substring (point)
325 (progn (backward-sexp 1)
326 (point))))))))))
327 ((memq major-mode
328 '(TeX-mode plain-TeX-mode LaTeX-mode;; tex-mode.el
329 plain-tex-mode latex-mode;; cmutex.el
330 ))
331 (if (re-search-backward
332 "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
333 (progn
334 (goto-char (match-beginning 0))
335 (buffer-substring (1+ (point));; without initial backslash
336 (progn
337 (end-of-line)
338 (point))))))
339 ((eq major-mode 'texinfo-mode)
340 (if (re-search-backward "^@node[ \t]+\\([^,]+\\)," nil t)
341 (buffer-substring (match-beginning 1)
342 (match-end 1))))
343 (t
344 ;; If all else fails, try heuristics
345 (let (case-fold-search)
346 (end-of-line)
347 (if (re-search-backward add-log-current-defun-header-regexp
348 (- (point) 10000)
349 t)
350 (buffer-substring (match-beginning 1)
351 (match-end 1))))))))
352 (error nil)))
ef15f270
JB
353
354
1da56800
RS
355(provide 'add-log)
356
fd7fa35a 357;;; add-log.el ends here