(change-log-mode): Add `* ' to paragraph-start.
[bpt/emacs.git] / lisp / add-log.el
CommitLineData
84fc2cfa
ER
1;;; add-log.el --- change log maintenance commands for Emacs
2
3697b807 3;; Copyright (C) 1985, 86, 88, 93, 94, 97, 1998 Free Software Foundation, Inc.
84fc2cfa 4
df63ae66 5;; Keywords: tools
e9571d2a 6
84fc2cfa
ER
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
fd7fa35a 11;; the Free Software Foundation; either version 2, or (at your option)
84fc2cfa
ER
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
b578f267
EN
20;; along with GNU Emacs; see the file COPYING. If not, write to the
21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22;; Boston, MA 02111-1307, USA.
84fc2cfa 23
e41b2db1
ER
24;;; Commentary:
25
26;; This facility is documented in the Emacs Manual.
27
fd7fa35a 28;;; Code:
84fc2cfa 29
3697b807
DL
30(eval-when-compile (require 'fortran))
31
fcad5199
RS
32(defgroup change-log nil
33 "Change log maintenance"
34 :group 'tools
3697b807 35 :link '(custom-manual "(emacs)Change Log")
fcad5199
RS
36 :prefix "change-log-"
37 :prefix "add-log-")
84fc2cfa 38
fcad5199
RS
39
40(defcustom change-log-default-name nil
41 "*Name of a change log file for \\[add-change-log-entry]."
42 :type '(choice (const :tag "default" nil)
43 string)
44 :group 'change-log)
45
46(defcustom add-log-current-defun-function nil
6258d3af
RM
47 "\
48*If non-nil, function to guess name of current function from surrounding text.
49\\[add-change-log-entry] calls this function (if nil, `add-log-current-defun'
fcad5199 50instead) with no arguments. It returns a string or nil if it cannot guess."
5cb58f82 51 :type 'function
fcad5199 52 :group 'change-log)
6258d3af 53
29db528b 54;;;###autoload
fcad5199 55(defcustom add-log-full-name nil
02ec1592 56 "*Full name of user, for inclusion in ChangeLog daily headers.
fcad5199
RS
57This defaults to the value returned by the `user-full-name' function."
58 :type '(choice (const :tag "Default" nil)
59 string)
60 :group 'change-log)
02ec1592 61
29db528b 62;;;###autoload
fcad5199 63(defcustom add-log-mailing-address nil
02ec1592 64 "*Electronic mail address of user, for inclusion in ChangeLog daily headers.
fcad5199
RS
65This defaults to the value of `user-mail-address'."
66 :type '(choice (const :tag "Default" nil)
67 string)
68 :group 'change-log)
69
df63ae66
RS
70(defcustom add-log-time-format 'add-log-iso8601-time-string
71 "*Function that defines the time format.
72For example, `add-log-iso8601-time-string', which gives the
73date in international ISO 8601 format,
74and `current-time-string' are two valid values."
75 :type '(radio (const :tag "International ISO 8601 format"
76 add-log-iso8601-time-string)
77 (const :tag "Old format, as returned by `current-time-string'"
78 current-time-string)
79 (function :tag "Other"))
80 :group 'change-log)
02ec1592 81
83afd62c 82(defcustom add-log-keep-changes-together nil
3697b807
DL
83 "*If non-nil, normally keep day's log entries for one file together.
84
85Log entries for a given file made with \\[add-change-log-entry] or
86\\[add-change-log-entry-other-window] will only be added to others \
87for that file made
88today if this variable is non-nil or that file comes first in today's
89entries. Otherwise another entry for that file will be started. An
90original log:
91
92 * foo (...): ...
93 * bar (...): change 1
83afd62c 94
3697b807
DL
95in the latter case, \\[add-change-log-entry-other-window] in a \
96buffer visiting `bar', yields:
83afd62c 97
3697b807
DL
98 * bar (...): -!-
99 * foo (...): ...
100 * bar (...): change 1
83afd62c 101
3697b807 102and in the former:
83afd62c 103
3697b807
DL
104 * foo (...): ...
105 * bar (...): change 1
106 (...): -!-
83afd62c 107
3697b807
DL
108The NEW-ENTRY arg to `add-change-log-entry' can override the effect of
109this variable."
110 :version "20.3"
83afd62c
KH
111 :type 'boolean
112 :group 'change-log)
113
5f562719 114(defvar change-log-font-lock-keywords
5572c1d1
SM
115 '(;;
116 ;; Date lines, new and old styles.
3307b0ca 117 ("^\\sw.........[0-9:+ ]*"
5572c1d1 118 (0 font-lock-string-face)
6f6a2641 119 ("\\([^<]+\\)<\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)>" nil nil
883212ce 120 (1 font-lock-constant-face)
6f6a2641 121 (2 font-lock-variable-name-face)))
5572c1d1
SM
122 ;;
123 ;; File names.
124 ("^\t\\* \\([^ ,:([\n]+\\)"
125 (1 font-lock-function-name-face)
126 ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 font-lock-function-name-face)))
127 ;;
128 ;; Function or variable names.
6f187d8d 129 ("(\\([^) ,:\n]+\\)"
5572c1d1 130 (1 font-lock-keyword-face)
6f187d8d 131 ("\\=, *\\([^) ,:\n]+\\)" nil nil (1 font-lock-keyword-face)))
5572c1d1
SM
132 ;;
133 ;; Conditionals.
134 ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 font-lock-variable-name-face))
135 ;;
a3cab9f0 136 ;; Acknowledgements.
095fb03e 137 ("^\t\\(From\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
b438e1cb 138 1 font-lock-comment-face)
095fb03e 139 (" \\(From\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
b438e1cb 140 1 font-lock-comment-face))
5f562719
RS
141 "Additional expressions to highlight in Change Log mode.")
142
45c50c5d
KH
143(defvar change-log-mode-map nil
144 "Keymap for Change Log major mode.")
145(if change-log-mode-map
146 nil
147 (setq change-log-mode-map (make-sparse-keymap)))
148
51bd1843
EN
149(defvar change-log-time-zone-rule nil
150 "Time zone used for calculating change log time stamps.
151It takes the same format as the TZ argument of `set-time-zone-rule'.
152If nil, use local time.")
153
df63ae66 154(defun add-log-iso8601-time-zone (time)
51bd1843
EN
155 (let* ((utc-offset (or (car (current-time-zone time)) 0))
156 (sign (if (< utc-offset 0) ?- ?+))
157 (sec (abs utc-offset))
158 (ss (% sec 60))
159 (min (/ sec 60))
160 (mm (% min 60))
161 (hh (/ min 60)))
162 (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d")
163 ((not (zerop mm)) "%c%02d:%02d")
164 (t "%c%02d"))
165 sign hh mm ss)))
166
df63ae66
RS
167(defun add-log-iso8601-time-string ()
168 (if change-log-time-zone-rule
169 (let ((tz (getenv "TZ"))
170 (now (current-time)))
171 (unwind-protect
172 (progn
173 (set-time-zone-rule
174 change-log-time-zone-rule)
175 (concat
176 (format-time-string "%Y-%m-%d " now)
177 (add-log-iso8601-time-zone now)))
178 (set-time-zone-rule tz)))
179 (format-time-string "%Y-%m-%d")))
180
84fc2cfa
ER
181(defun change-log-name ()
182 (or change-log-default-name
513063cf 183 (if (eq system-type 'vax-vms)
4a047d23
RS
184 "$CHANGE_LOG$.TXT"
185 "ChangeLog")))
84fc2cfa 186
287d149f 187;;;###autoload
84fc2cfa
ER
188(defun prompt-for-change-log-name ()
189 "Prompt for a change log name."
117aaf60
KH
190 (let* ((default (change-log-name))
191 (name (expand-file-name
192 (read-file-name (format "Log file (default %s): " default)
193 nil default))))
194 ;; Handle something that is syntactically a directory name.
195 ;; Look for ChangeLog or whatever in that directory.
196 (if (string= (file-name-nondirectory name) "")
197 (expand-file-name (file-name-nondirectory default)
198 name)
199 ;; Handle specifying a file that is a directory.
200 (if (file-directory-p name)
201 (expand-file-name (file-name-nondirectory default)
202 (file-name-as-directory name))
203 name))))
84fc2cfa 204
45a13f0d
RM
205;;;###autoload
206(defun find-change-log (&optional file-name)
207 "Find a change log file for \\[add-change-log-entry] and return the name.
a82e2ed5
RS
208
209Optional arg FILE-NAME specifies the file to use.
de98fcaf
RS
210If FILE-NAME is nil, use the value of `change-log-default-name'.
211If 'change-log-default-name' is nil, behave as though it were 'ChangeLog'
212\(or whatever we use on this operating system).
213
214If 'change-log-default-name' contains a leading directory component, then
513063cf 215simply find it in the current directory. Otherwise, search in the current
de98fcaf 216directory and its successive parents for a file so named.
45a13f0d
RM
217
218Once a file is found, `change-log-default-name' is set locally in the
219current buffer to the complete file name."
a82e2ed5
RS
220 ;; If user specified a file name or if this buffer knows which one to use,
221 ;; just use that.
45a13f0d 222 (or file-name
de98fcaf
RS
223 (setq file-name (and change-log-default-name
224 (file-name-directory change-log-default-name)
225 change-log-default-name))
a82e2ed5
RS
226 (progn
227 ;; Chase links in the source file
228 ;; and use the change log in the dir where it points.
229 (setq file-name (or (and buffer-file-name
230 (file-name-directory
231 (file-chase-links buffer-file-name)))
232 default-directory))
233 (if (file-directory-p file-name)
234 (setq file-name (expand-file-name (change-log-name) file-name)))
235 ;; Chase links before visiting the file.
236 ;; This makes it easier to use a single change log file
237 ;; for several related directories.
238 (setq file-name (file-chase-links file-name))
239 (setq file-name (expand-file-name file-name))
240 ;; Move up in the dir hierarchy till we find a change log file.
241 (let ((file1 file-name)
242 parent-dir)
243 (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
244 (progn (setq parent-dir
245 (file-name-directory
246 (directory-file-name
247 (file-name-directory file1))))
248 ;; Give up if we are already at the root dir.
249 (not (string= (file-name-directory file1)
250 parent-dir))))
251 ;; Move up to the parent dir and try again.
513063cf 252 (setq file1 (expand-file-name
a82e2ed5
RS
253 (file-name-nondirectory (change-log-name))
254 parent-dir)))
255 ;; If we found a change log in a parent, use that.
256 (if (or (get-file-buffer file1) (file-exists-p file1))
257 (setq file-name file1)))))
258 ;; Make a local variable in this buffer so we needn't search again.
259 (set (make-local-variable 'change-log-default-name) file-name)
260 file-name)
45a13f0d 261
84fc2cfa 262;;;###autoload
287d149f 263(defun add-change-log-entry (&optional whoami file-name other-window new-entry)
84fc2cfa 264 "Find change log file and add an entry for today.
83afd62c
KH
265Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
266name and site.
267
268Second arg is FILE-NAME of change log. If nil, uses `change-log-default-name'.
287d149f
RM
269Third arg OTHER-WINDOW non-nil means visit in other window.
270Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
3697b807
DL
271never append to an existing entry. Option `add-log-keep-changes-together'
272otherwise affects whether a new entry is created.
273
274Today's date is calculated according to `change-log-time-zone-rule' if
275non-nil, otherwise in local time."
84fc2cfa
ER
276 (interactive (list current-prefix-arg
277 (prompt-for-change-log-name)))
550d8777
RS
278 (or add-log-full-name
279 (setq add-log-full-name (user-full-name)))
280 (or add-log-mailing-address
281 (setq add-log-mailing-address user-mail-address))
02ec1592
BF
282 (if whoami
283 (progn
284 (setq add-log-full-name (read-input "Full name: " add-log-full-name))
84fc2cfa
ER
285 ;; Note that some sites have room and phone number fields in
286 ;; full name which look silly when inserted. Rather than do
287 ;; anything about that here, let user give prefix argument so that
288 ;; s/he can edit the full name field in prompter if s/he wants.
02ec1592
BF
289 (setq add-log-mailing-address
290 (read-input "Mailing address: " add-log-mailing-address))))
291 (let ((defun (funcall (or add-log-current-defun-function
292 'add-log-current-defun)))
3697b807 293 bound entry)
45a13f0d 294
3e1c918b 295 (setq file-name (expand-file-name (find-change-log file-name)))
82f4acaf
RM
296
297 ;; Set ENTRY to the file name to use in the new entry.
298 (and buffer-file-name
299 ;; Never want to add a change log entry for the ChangeLog file itself.
300 (not (string= buffer-file-name file-name))
301 (setq entry (if (string-match
302 (concat "^" (regexp-quote (file-name-directory
303 file-name)))
304 buffer-file-name)
305 (substring buffer-file-name (match-end 0))
306 (file-name-nondirectory buffer-file-name))))
307
84fc2cfa
ER
308 (if (and other-window (not (equal file-name buffer-file-name)))
309 (find-file-other-window file-name)
310 (find-file file-name))
675a998f
RS
311 (or (eq major-mode 'change-log-mode)
312 (change-log-mode))
84fc2cfa
ER
313 (undo-boundary)
314 (goto-char (point-min))
df63ae66 315 (let ((new-entry (concat (funcall add-log-time-format)
51bd1843
EN
316 " " add-log-full-name
317 " <" add-log-mailing-address ">")))
318 (if (looking-at (regexp-quote new-entry))
319 (forward-line 1)
320 (insert new-entry "\n\n")))
82f4acaf 321
3697b807
DL
322 (setq bound
323 (progn
324 (if (looking-at "\n*[^\n* \t]")
325 (skip-chars-forward "\n")
326 (if add-log-keep-changes-together
327 (forward-page) ; page delimits entries for date
328 (forward-paragraph))) ; paragraph delimits entries for file
329 (point)))
84fc2cfa 330 (goto-char (point-min))
1832dbd1 331 ;; Now insert the new line for this entry.
3697b807 332 (cond ((re-search-forward "^\\s *\\*\\s *$" bound t)
82f4acaf
RM
333 ;; Put this file name into the existing empty entry.
334 (if entry
3697b807 335 (insert entry)))
287d149f 336 ((and (not new-entry)
e172f546
KH
337 (let (case-fold-search)
338 (re-search-forward
339 (concat (regexp-quote (concat "* " entry))
340 ;; Don't accept `foo.bar' when
341 ;; looking for `foo':
342 "\\(\\s \\|[(),:]\\)")
3697b807 343 bound t)))
82f4acaf
RM
344 ;; Add to the existing entry for the same file.
345 (re-search-forward "^\\s *$\\|^\\s \\*")
e172f546 346 (goto-char (match-beginning 0))
3697b807
DL
347 ;; Delete excess empty lines; make just 2.
348 (while (and (not (eobp)) (looking-at "^\\s *$"))
349 (delete-region (point) (save-excursion (forward-line 1) (point))))
350 (insert "\n\n")
351 (forward-line -2)
352 (indent-relative-maybe))
21d7e080 353 (t
dd309224
RM
354 ;; Make a new entry.
355 (forward-line 1)
356 (while (looking-at "\\sW")
357 (forward-line 1))
09b389d0 358 (while (and (not (eobp)) (looking-at "^\\s *$"))
1832dbd1
RS
359 (delete-region (point) (save-excursion (forward-line 1) (point))))
360 (insert "\n\n\n")
361 (forward-line -2)
dd309224
RM
362 (indent-to left-margin)
363 (insert "* " (or entry ""))))
1832dbd1 364 ;; Now insert the function name, if we have one.
21d7e080
ER
365 ;; Point is at the entry for this file,
366 ;; either at the end of the line or at the first blank line.
367 (if defun
368 (progn
dd309224 369 ;; Make it easy to get rid of the function name.
21d7e080 370 (undo-boundary)
dd309224
RM
371 (insert (if (save-excursion
372 (beginning-of-line 1)
513063cf 373 (looking-at "\\s *$"))
dd309224
RM
374 ""
375 " ")
376 "(" defun "): "))
1832dbd1 377 ;; No function name, so put in a colon unless we have just a star.
dd309224
RM
378 (if (not (save-excursion
379 (beginning-of-line 1)
380 (looking-at "\\s *\\(\\*\\s *\\)?$")))
1832dbd1 381 (insert ": ")))))
84fc2cfa 382
84fc2cfa
ER
383;;;###autoload
384(defun add-change-log-entry-other-window (&optional whoami file-name)
385 "Find change log file in other window and add an entry for today.
83afd62c
KH
386Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
387name and site.
3697b807
DL
388Second optional arg FILE-NAME is file name of change log.
389If nil, use `change-log-default-name'.
390
391Affected by the same options as `add-change-log-entry'."
84fc2cfa
ER
392 (interactive (if current-prefix-arg
393 (list current-prefix-arg
394 (prompt-for-change-log-name))))
395 (add-change-log-entry whoami file-name t))
82f4acaf 396;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
84fc2cfa 397
1da56800 398;;;###autoload
21d7e080 399(defun change-log-mode ()
eb8c3be9 400 "Major mode for editing change logs; like Indented Text Mode.
09b389d0 401Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
3697b807 402New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
5516387c
RM
403Each entry behaves as a paragraph, and the entries for one day as a page.
404Runs `change-log-mode-hook'."
21d7e080
ER
405 (interactive)
406 (kill-all-local-variables)
407 (indented-text-mode)
82f4acaf
RM
408 (setq major-mode 'change-log-mode
409 mode-name "Change Log"
410 left-margin 8
4f675a8c 411 fill-column 74
60f10a06
KH
412 indent-tabs-mode t
413 tab-width 8)
45c50c5d 414 (use-local-map change-log-mode-map)
60f10a06
KH
415 (set (make-local-variable 'fill-paragraph-function)
416 'change-log-fill-paragraph)
4b7d4d0d
DL
417 ;; We really do want "^" in paragraph-start below: it is only the
418 ;; lines that begin at column 0 (despite the left-margin of 8) that
419 ;; we are looking for. Adding `* ' allows eliding the blank line
420 ;; between entries for different files.
421 (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\<\\|\\* ")
422 (set (make-local-variable 'paragraph-separate) paragraph-start)
2c91c85c
RS
423 ;; Match null string on the date-line so that the date-line
424 ;; is grouped with what follows.
964141f2 425 (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
dd309224
RM
426 (set (make-local-variable 'version-control) 'never)
427 (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
4b286eca
SM
428 (set (make-local-variable 'font-lock-defaults)
429 '(change-log-font-lock-keywords t))
21d7e080
ER
430 (run-hooks 'change-log-mode-hook))
431
287d149f
RM
432;; It might be nice to have a general feature to replace this. The idea I
433;; have is a variable giving a regexp matching text which should not be
434;; moved from bol by filling. change-log-mode would set this to "^\\s *\\s(".
435;; But I don't feel up to implementing that today.
436(defun change-log-fill-paragraph (&optional justify)
437 "Fill the paragraph, but preserve open parentheses at beginning of lines.
438Prefix arg means justify as well."
439 (interactive "P")
8d6467a4
RS
440 (let ((end (progn (forward-paragraph) (point)))
441 (beg (progn (backward-paragraph) (point)))
14ee1953 442 (paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
8d6467a4
RS
443 (fill-region beg end justify)
444 t))
287d149f 445\f
fcad5199 446(defcustom add-log-current-defun-header-regexp
26add1bf 447 "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[-_a-zA-Z]+\\)[ \t]*[:=]"
fcad5199
RS
448 "*Heuristic regexp used by `add-log-current-defun' for unknown major modes."
449 :type 'regexp
450 :group 'change-log)
21d7e080 451
fb644f48
EN
452;;;###autoload
453(defvar add-log-lisp-like-modes
3697b807 454 '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode)
fb644f48
EN
455 "*Modes that look like Lisp to `add-log-current-defun'.")
456
457;;;###autoload
458(defvar add-log-c-like-modes
459 '(c-mode c++-mode c++-c-mode objc-mode)
460 "*Modes that look like C to `add-log-current-defun'.")
461
462;;;###autoload
463(defvar add-log-tex-like-modes
464 '(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode)
465 "*Modes that look like TeX to `add-log-current-defun'.")
466
e332f80b 467;;;###autoload
21d7e080
ER
468(defun add-log-current-defun ()
469 "Return name of function definition point is in, or nil.
470
63314951 471Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
64bd2d51 472Texinfo (@node titles), Perl, and Fortran.
21d7e080
ER
473
474Other modes are handled by a heuristic that looks in the 10K before
475point for uppercase headings starting in the first column or
476identifiers followed by `:' or `=', see variable
477`add-log-current-defun-header-regexp'.
478
479Has a preference of looking backwards."
2cc0b765
RS
480 (condition-case nil
481 (save-excursion
482 (let ((location (point)))
fb644f48 483 (cond ((memq major-mode add-log-lisp-like-modes)
a0151877 484 ;; If we are now precisely at the beginning of a defun,
2cc0b765
RS
485 ;; make sure beginning-of-defun finds that one
486 ;; rather than the previous one.
487 (or (eobp) (forward-char 1))
488 (beginning-of-defun)
489 ;; Make sure we are really inside the defun found, not after it.
947b2743
RS
490 (if (and (looking-at "\\s(")
491 (progn (end-of-defun)
2cc0b765
RS
492 (< location (point)))
493 (progn (forward-sexp -1)
494 (>= location (point))))
495 (progn
0e933219
JB
496 (if (looking-at "\\s(")
497 (forward-char 1))
498 (forward-sexp 1)
a0151877 499 (skip-chars-forward " '")
2cc0b765
RS
500 (buffer-substring (point)
501 (progn (forward-sexp 1) (point))))))
fb644f48
EN
502 ((and (memq major-mode add-log-c-like-modes)
503 (save-excursion
504 (beginning-of-line)
505 ;; Use eq instead of = here to avoid
506 ;; error when at bob and char-after
507 ;; returns nil.
508 (while (eq (char-after (- (point) 2)) ?\\)
509 (forward-line -1))
510 (looking-at "[ \t]*#[ \t]*define[ \t]")))
2cc0b765
RS
511 ;; Handle a C macro definition.
512 (beginning-of-line)
513 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
514 (forward-line -1))
515 (search-forward "define")
516 (skip-chars-forward " \t")
517 (buffer-substring (point)
518 (progn (forward-sexp 1) (point))))
fb644f48 519 ((memq major-mode add-log-c-like-modes)
2cc0b765
RS
520 (beginning-of-line)
521 ;; See if we are in the beginning part of a function,
522 ;; before the open brace. If so, advance forward.
523 (while (not (looking-at "{\\|\\(\\s *$\\)"))
524 (forward-line 1))
525 (or (eobp)
526 (forward-char 1))
527 (beginning-of-defun)
528 (if (progn (end-of-defun)
529 (< location (point)))
530 (progn
531 (backward-sexp 1)
532 (let (beg tem)
fd7fa35a 533
2cc0b765
RS
534 (forward-line -1)
535 ;; Skip back over typedefs of arglist.
536 (while (and (not (bobp))
537 (looking-at "[ \t\n]"))
538 (forward-line -1))
539 ;; See if this is using the DEFUN macro used in Emacs,
540 ;; or the DEFUN macro used by the C library.
541 (if (condition-case nil
542 (and (save-excursion
019644ee
RS
543 (end-of-line)
544 (while (= (preceding-char) ?\\)
545 (end-of-line 2))
2cc0b765
RS
546 (backward-sexp 1)
547 (beginning-of-line)
548 (setq tem (point))
549 (looking-at "DEFUN\\b"))
550 (>= location tem))
551 (error nil))
552 (progn
553 (goto-char tem)
554 (down-list 1)
555 (if (= (char-after (point)) ?\")
556 (progn
557 (forward-sexp 1)
558 (skip-chars-forward " ,")))
559 (buffer-substring (point)
560 (progn (forward-sexp 1) (point))))
32e986d4 561 (if (looking-at "^[+-]")
83afd62c 562 (change-log-get-method-definition)
32e986d4
RS
563 ;; Ordinary C function syntax.
564 (setq beg (point))
e172f546
KH
565 (if (and (condition-case nil
566 ;; Protect against "Unbalanced parens" error.
567 (progn
568 (down-list 1) ; into arglist
569 (backward-up-list 1)
570 (skip-chars-backward " \t")
571 t)
572 (error nil))
573 ;; Verify initial pos was after
574 ;; real start of function.
575 (save-excursion
576 (goto-char beg)
577 ;; For this purpose, include the line
578 ;; that has the decl keywords. This
579 ;; may also include some of the
580 ;; comments before the function.
581 (while (and (not (bobp))
582 (save-excursion
583 (forward-line -1)
584 (looking-at "[^\n\f]")))
585 (forward-line -1))
586 (>= location (point)))
32e986d4
RS
587 ;; Consistency check: going down and up
588 ;; shouldn't take us back before BEG.
589 (> (point) beg))
e172f546
KH
590 (let (end middle)
591 ;; Don't include any final newline
592 ;; in the name we use.
593 (if (= (preceding-char) ?\n)
594 (forward-char -1))
595 (setq end (point))
596 (backward-sexp 1)
597 ;; Now find the right beginning of the name.
598 ;; Include certain keywords if they
599 ;; precede the name.
600 (setq middle (point))
601 (forward-word -1)
6dfa1d83
RS
602 ;; Ignore these subparts of a class decl
603 ;; and move back to the class name itself.
604 (while (looking-at "public \\|private ")
605 (skip-chars-backward " \t:")
606 (setq end (point))
607 (backward-sexp 1)
608 (setq middle (point))
609 (forward-word -1))
e172f546
KH
610 (and (bolp)
611 (looking-at "struct \\|union \\|class ")
612 (setq middle (point)))
613 (buffer-substring middle end)))))))))
fb644f48 614 ((memq major-mode add-log-tex-like-modes)
2cc0b765
RS
615 (if (re-search-backward
616 "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
617 (progn
618 (goto-char (match-beginning 0))
619 (buffer-substring (1+ (point));; without initial backslash
620 (progn
621 (end-of-line)
622 (point))))))
623 ((eq major-mode 'texinfo-mode)
3071ee28 624 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
2cc0b765
RS
625 (buffer-substring (match-beginning 1)
626 (match-end 1))))
64bd2d51
RS
627 ((eq major-mode 'perl-mode)
628 (if (re-search-backward "^sub[ \t]+\\([^ \t\n]+\\)" nil t)
629 (buffer-substring (match-beginning 1)
630 (match-end 1))))
3697b807
DL
631 ((or (eq major-mode 'fortran-mode)
632 ;; Needs work for f90, but better than nothing.
633 (eq major-mode 'f90-mode))
a9e2a7f2
RS
634 ;; must be inside function body for this to work
635 (beginning-of-fortran-subprogram)
636 (let ((case-fold-search t)) ; case-insensitive
637 ;; search for fortran subprogram start
638 (if (re-search-forward
639 "^[ \t]*\\(program\\|subroutine\\|function\
3697b807
DL
640\\|[ \ta-z0-9*()]*[ \t]+function\\|\\(block[ \t]*data\\)\\)"
641 (progn (end-of-fortran-subprogram)
642 (point))
643 t)
644 (or (match-string 2)
a9e2a7f2
RS
645 (progn
646 ;; move to EOL or before first left paren
647 (if (re-search-forward "[(\n]" nil t)
3697b807 648 (progn (backward-char)
a9e2a7f2
RS
649 (skip-chars-backward " \t"))
650 (end-of-line))
651 ;; Use the name preceding that.
652 (buffer-substring (point)
3697b807
DL
653 (progn (backward-sexp)
654 (point)))))
655 "main")))
2cc0b765
RS
656 (t
657 ;; If all else fails, try heuristics
658 (let (case-fold-search)
659 (end-of-line)
660 (if (re-search-backward add-log-current-defun-header-regexp
661 (- (point) 10000)
662 t)
663 (buffer-substring (match-beginning 1)
664 (match-end 1))))))))
665 (error nil)))
ef15f270 666
83afd62c 667(defvar change-log-get-method-definition-md)
15319a8f 668
83afd62c 669;; Subroutine used within change-log-get-method-definition.
59c1a7de
RS
670;; Add the last match in the buffer to the end of `md',
671;; followed by the string END; move to the end of that match.
83afd62c
KH
672(defun change-log-get-method-definition-1 (end)
673 (setq change-log-get-method-definition-md
674 (concat change-log-get-method-definition-md
15319a8f
RS
675 (buffer-substring (match-beginning 1) (match-end 1))
676 end))
59c1a7de
RS
677 (goto-char (match-end 0)))
678
679;; For objective C, return the method name if we are in a method.
83afd62c
KH
680(defun change-log-get-method-definition ()
681 (let ((change-log-get-method-definition-md "["))
59c1a7de 682 (save-excursion
f27f16ed 683 (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t)
83afd62c 684 (change-log-get-method-definition-1 " ")))
59c1a7de
RS
685 (save-excursion
686 (cond
f27f16ed 687 ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t)
83afd62c 688 (change-log-get-method-definition-1 "")
59c1a7de
RS
689 (while (not (looking-at "[{;]"))
690 (looking-at
f27f16ed 691 "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
83afd62c
KH
692 (change-log-get-method-definition-1 ""))
693 (concat change-log-get-method-definition-md "]"))))))
59c1a7de 694
ef15f270 695
1da56800
RS
696(provide 'add-log)
697
fd7fa35a 698;;; add-log.el ends here