(require): Wrap requirement of w3 and url in
[bpt/emacs.git] / lisp / add-log.el
CommitLineData
5abdc915 1;;; add-log.el --- change log maintenance commands for Emacs
84fc2cfa 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
5522b032
RS
154(defvar add-log-debugging)
155
df63ae66 156(defun add-log-iso8601-time-zone (time)
51bd1843
EN
157 (let* ((utc-offset (or (car (current-time-zone time)) 0))
158 (sign (if (< utc-offset 0) ?- ?+))
159 (sec (abs utc-offset))
160 (ss (% sec 60))
161 (min (/ sec 60))
162 (mm (% min 60))
163 (hh (/ min 60)))
164 (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d")
165 ((not (zerop mm)) "%c%02d:%02d")
166 (t "%c%02d"))
167 sign hh mm ss)))
168
df63ae66
RS
169(defun add-log-iso8601-time-string ()
170 (if change-log-time-zone-rule
171 (let ((tz (getenv "TZ"))
172 (now (current-time)))
173 (unwind-protect
174 (progn
175 (set-time-zone-rule
176 change-log-time-zone-rule)
177 (concat
178 (format-time-string "%Y-%m-%d " now)
179 (add-log-iso8601-time-zone now)))
180 (set-time-zone-rule tz)))
181 (format-time-string "%Y-%m-%d")))
182
84fc2cfa
ER
183(defun change-log-name ()
184 (or change-log-default-name
513063cf 185 (if (eq system-type 'vax-vms)
4a047d23
RS
186 "$CHANGE_LOG$.TXT"
187 "ChangeLog")))
84fc2cfa 188
287d149f 189;;;###autoload
84fc2cfa
ER
190(defun prompt-for-change-log-name ()
191 "Prompt for a change log name."
117aaf60
KH
192 (let* ((default (change-log-name))
193 (name (expand-file-name
194 (read-file-name (format "Log file (default %s): " default)
195 nil default))))
196 ;; Handle something that is syntactically a directory name.
197 ;; Look for ChangeLog or whatever in that directory.
198 (if (string= (file-name-nondirectory name) "")
199 (expand-file-name (file-name-nondirectory default)
200 name)
201 ;; Handle specifying a file that is a directory.
202 (if (file-directory-p name)
203 (expand-file-name (file-name-nondirectory default)
204 (file-name-as-directory name))
205 name))))
84fc2cfa 206
45a13f0d
RM
207;;;###autoload
208(defun find-change-log (&optional file-name)
209 "Find a change log file for \\[add-change-log-entry] and return the name.
a82e2ed5
RS
210
211Optional arg FILE-NAME specifies the file to use.
de98fcaf
RS
212If FILE-NAME is nil, use the value of `change-log-default-name'.
213If 'change-log-default-name' is nil, behave as though it were 'ChangeLog'
214\(or whatever we use on this operating system).
215
216If 'change-log-default-name' contains a leading directory component, then
513063cf 217simply find it in the current directory. Otherwise, search in the current
de98fcaf 218directory and its successive parents for a file so named.
45a13f0d
RM
219
220Once a file is found, `change-log-default-name' is set locally in the
221current buffer to the complete file name."
a82e2ed5
RS
222 ;; If user specified a file name or if this buffer knows which one to use,
223 ;; just use that.
45a13f0d 224 (or file-name
de98fcaf
RS
225 (setq file-name (and change-log-default-name
226 (file-name-directory change-log-default-name)
227 change-log-default-name))
a82e2ed5
RS
228 (progn
229 ;; Chase links in the source file
230 ;; and use the change log in the dir where it points.
231 (setq file-name (or (and buffer-file-name
232 (file-name-directory
233 (file-chase-links buffer-file-name)))
234 default-directory))
235 (if (file-directory-p file-name)
236 (setq file-name (expand-file-name (change-log-name) file-name)))
237 ;; Chase links before visiting the file.
238 ;; This makes it easier to use a single change log file
239 ;; for several related directories.
240 (setq file-name (file-chase-links file-name))
241 (setq file-name (expand-file-name file-name))
242 ;; Move up in the dir hierarchy till we find a change log file.
243 (let ((file1 file-name)
244 parent-dir)
245 (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
246 (progn (setq parent-dir
247 (file-name-directory
248 (directory-file-name
249 (file-name-directory file1))))
250 ;; Give up if we are already at the root dir.
251 (not (string= (file-name-directory file1)
252 parent-dir))))
253 ;; Move up to the parent dir and try again.
513063cf 254 (setq file1 (expand-file-name
a82e2ed5
RS
255 (file-name-nondirectory (change-log-name))
256 parent-dir)))
257 ;; If we found a change log in a parent, use that.
258 (if (or (get-file-buffer file1) (file-exists-p file1))
259 (setq file-name file1)))))
260 ;; Make a local variable in this buffer so we needn't search again.
261 (set (make-local-variable 'change-log-default-name) file-name)
262 file-name)
45a13f0d 263
84fc2cfa 264;;;###autoload
287d149f 265(defun add-change-log-entry (&optional whoami file-name other-window new-entry)
84fc2cfa 266 "Find change log file and add an entry for today.
83afd62c
KH
267Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
268name and site.
269
270Second arg is FILE-NAME of change log. If nil, uses `change-log-default-name'.
287d149f
RM
271Third arg OTHER-WINDOW non-nil means visit in other window.
272Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
3697b807
DL
273never append to an existing entry. Option `add-log-keep-changes-together'
274otherwise affects whether a new entry is created.
275
276Today's date is calculated according to `change-log-time-zone-rule' if
277non-nil, otherwise in local time."
84fc2cfa
ER
278 (interactive (list current-prefix-arg
279 (prompt-for-change-log-name)))
550d8777
RS
280 (or add-log-full-name
281 (setq add-log-full-name (user-full-name)))
282 (or add-log-mailing-address
283 (setq add-log-mailing-address user-mail-address))
02ec1592
BF
284 (if whoami
285 (progn
286 (setq add-log-full-name (read-input "Full name: " add-log-full-name))
84fc2cfa
ER
287 ;; Note that some sites have room and phone number fields in
288 ;; full name which look silly when inserted. Rather than do
289 ;; anything about that here, let user give prefix argument so that
290 ;; s/he can edit the full name field in prompter if s/he wants.
02ec1592
BF
291 (setq add-log-mailing-address
292 (read-input "Mailing address: " add-log-mailing-address))))
293 (let ((defun (funcall (or add-log-current-defun-function
294 'add-log-current-defun)))
3697b807 295 bound entry)
45a13f0d 296
3e1c918b 297 (setq file-name (expand-file-name (find-change-log file-name)))
82f4acaf
RM
298
299 ;; Set ENTRY to the file name to use in the new entry.
300 (and buffer-file-name
301 ;; Never want to add a change log entry for the ChangeLog file itself.
302 (not (string= buffer-file-name file-name))
303 (setq entry (if (string-match
304 (concat "^" (regexp-quote (file-name-directory
305 file-name)))
306 buffer-file-name)
307 (substring buffer-file-name (match-end 0))
308 (file-name-nondirectory buffer-file-name))))
309
5522b032
RS
310 (let ((buffer (find-buffer-visiting file-name)))
311 (setq add-log-debugging (list (gap-position) (gap-size))))
84fc2cfa
ER
312 (if (and other-window (not (equal file-name buffer-file-name)))
313 (find-file-other-window file-name)
314 (find-file file-name))
675a998f
RS
315 (or (eq major-mode 'change-log-mode)
316 (change-log-mode))
84fc2cfa
ER
317 (undo-boundary)
318 (goto-char (point-min))
df63ae66 319 (let ((new-entry (concat (funcall add-log-time-format)
51bd1843
EN
320 " " add-log-full-name
321 " <" add-log-mailing-address ">")))
322 (if (looking-at (regexp-quote new-entry))
323 (forward-line 1)
324 (insert new-entry "\n\n")))
82f4acaf 325
3697b807
DL
326 (setq bound
327 (progn
328 (if (looking-at "\n*[^\n* \t]")
329 (skip-chars-forward "\n")
330 (if add-log-keep-changes-together
331 (forward-page) ; page delimits entries for date
332 (forward-paragraph))) ; paragraph delimits entries for file
333 (point)))
84fc2cfa 334 (goto-char (point-min))
1832dbd1 335 ;; Now insert the new line for this entry.
3697b807 336 (cond ((re-search-forward "^\\s *\\*\\s *$" bound t)
82f4acaf
RM
337 ;; Put this file name into the existing empty entry.
338 (if entry
3697b807 339 (insert entry)))
287d149f 340 ((and (not new-entry)
e172f546
KH
341 (let (case-fold-search)
342 (re-search-forward
343 (concat (regexp-quote (concat "* " entry))
344 ;; Don't accept `foo.bar' when
345 ;; looking for `foo':
346 "\\(\\s \\|[(),:]\\)")
3697b807 347 bound t)))
82f4acaf
RM
348 ;; Add to the existing entry for the same file.
349 (re-search-forward "^\\s *$\\|^\\s \\*")
e172f546 350 (goto-char (match-beginning 0))
3697b807
DL
351 ;; Delete excess empty lines; make just 2.
352 (while (and (not (eobp)) (looking-at "^\\s *$"))
353 (delete-region (point) (save-excursion (forward-line 1) (point))))
354 (insert "\n\n")
355 (forward-line -2)
356 (indent-relative-maybe))
21d7e080 357 (t
dd309224
RM
358 ;; Make a new entry.
359 (forward-line 1)
360 (while (looking-at "\\sW")
361 (forward-line 1))
09b389d0 362 (while (and (not (eobp)) (looking-at "^\\s *$"))
1832dbd1
RS
363 (delete-region (point) (save-excursion (forward-line 1) (point))))
364 (insert "\n\n\n")
365 (forward-line -2)
dd309224
RM
366 (indent-to left-margin)
367 (insert "* " (or entry ""))))
1832dbd1 368 ;; Now insert the function name, if we have one.
21d7e080
ER
369 ;; Point is at the entry for this file,
370 ;; either at the end of the line or at the first blank line.
371 (if defun
372 (progn
dd309224 373 ;; Make it easy to get rid of the function name.
21d7e080 374 (undo-boundary)
dd309224
RM
375 (insert (if (save-excursion
376 (beginning-of-line 1)
513063cf 377 (looking-at "\\s *$"))
dd309224
RM
378 ""
379 " ")
380 "(" defun "): "))
1832dbd1 381 ;; No function name, so put in a colon unless we have just a star.
dd309224
RM
382 (if (not (save-excursion
383 (beginning-of-line 1)
384 (looking-at "\\s *\\(\\*\\s *\\)?$")))
1832dbd1 385 (insert ": ")))))
84fc2cfa 386
84fc2cfa
ER
387;;;###autoload
388(defun add-change-log-entry-other-window (&optional whoami file-name)
389 "Find change log file in other window and add an entry for today.
83afd62c
KH
390Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
391name and site.
3697b807
DL
392Second optional arg FILE-NAME is file name of change log.
393If nil, use `change-log-default-name'.
394
395Affected by the same options as `add-change-log-entry'."
84fc2cfa
ER
396 (interactive (if current-prefix-arg
397 (list current-prefix-arg
398 (prompt-for-change-log-name))))
399 (add-change-log-entry whoami file-name t))
82f4acaf 400;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
84fc2cfa 401
1da56800 402;;;###autoload
21d7e080 403(defun change-log-mode ()
eb8c3be9 404 "Major mode for editing change logs; like Indented Text Mode.
09b389d0 405Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
3697b807 406New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
5516387c
RM
407Each entry behaves as a paragraph, and the entries for one day as a page.
408Runs `change-log-mode-hook'."
21d7e080
ER
409 (interactive)
410 (kill-all-local-variables)
411 (indented-text-mode)
82f4acaf
RM
412 (setq major-mode 'change-log-mode
413 mode-name "Change Log"
414 left-margin 8
4f675a8c 415 fill-column 74
60f10a06
KH
416 indent-tabs-mode t
417 tab-width 8)
45c50c5d 418 (use-local-map change-log-mode-map)
60f10a06
KH
419 (set (make-local-variable 'fill-paragraph-function)
420 'change-log-fill-paragraph)
4b7d4d0d
DL
421 ;; We really do want "^" in paragraph-start below: it is only the
422 ;; lines that begin at column 0 (despite the left-margin of 8) that
423 ;; we are looking for. Adding `* ' allows eliding the blank line
424 ;; between entries for different files.
c9cfb0f2 425 (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\<")
4b7d4d0d 426 (set (make-local-variable 'paragraph-separate) paragraph-start)
2c91c85c
RS
427 ;; Match null string on the date-line so that the date-line
428 ;; is grouped with what follows.
964141f2 429 (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
dd309224
RM
430 (set (make-local-variable 'version-control) 'never)
431 (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
4b286eca
SM
432 (set (make-local-variable 'font-lock-defaults)
433 '(change-log-font-lock-keywords t))
21d7e080
ER
434 (run-hooks 'change-log-mode-hook))
435
287d149f
RM
436;; It might be nice to have a general feature to replace this. The idea I
437;; have is a variable giving a regexp matching text which should not be
438;; moved from bol by filling. change-log-mode would set this to "^\\s *\\s(".
439;; But I don't feel up to implementing that today.
440(defun change-log-fill-paragraph (&optional justify)
441 "Fill the paragraph, but preserve open parentheses at beginning of lines.
442Prefix arg means justify as well."
443 (interactive "P")
8d6467a4
RS
444 (let ((end (progn (forward-paragraph) (point)))
445 (beg (progn (backward-paragraph) (point)))
14ee1953 446 (paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
8d6467a4
RS
447 (fill-region beg end justify)
448 t))
287d149f 449\f
fcad5199 450(defcustom add-log-current-defun-header-regexp
26add1bf 451 "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[-_a-zA-Z]+\\)[ \t]*[:=]"
fcad5199
RS
452 "*Heuristic regexp used by `add-log-current-defun' for unknown major modes."
453 :type 'regexp
454 :group 'change-log)
21d7e080 455
fb644f48
EN
456;;;###autoload
457(defvar add-log-lisp-like-modes
3697b807 458 '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode)
fb644f48
EN
459 "*Modes that look like Lisp to `add-log-current-defun'.")
460
461;;;###autoload
462(defvar add-log-c-like-modes
463 '(c-mode c++-mode c++-c-mode objc-mode)
464 "*Modes that look like C to `add-log-current-defun'.")
465
466;;;###autoload
467(defvar add-log-tex-like-modes
468 '(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode)
469 "*Modes that look like TeX to `add-log-current-defun'.")
470
e332f80b 471;;;###autoload
21d7e080
ER
472(defun add-log-current-defun ()
473 "Return name of function definition point is in, or nil.
474
63314951 475Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
64bd2d51 476Texinfo (@node titles), Perl, and Fortran.
21d7e080
ER
477
478Other modes are handled by a heuristic that looks in the 10K before
479point for uppercase headings starting in the first column or
480identifiers followed by `:' or `=', see variable
481`add-log-current-defun-header-regexp'.
482
483Has a preference of looking backwards."
2cc0b765
RS
484 (condition-case nil
485 (save-excursion
486 (let ((location (point)))
fb644f48 487 (cond ((memq major-mode add-log-lisp-like-modes)
a0151877 488 ;; If we are now precisely at the beginning of a defun,
2cc0b765
RS
489 ;; make sure beginning-of-defun finds that one
490 ;; rather than the previous one.
491 (or (eobp) (forward-char 1))
492 (beginning-of-defun)
493 ;; Make sure we are really inside the defun found, not after it.
42b1fc29
RS
494 (when (and (looking-at "\\s(")
495 (progn (end-of-defun)
496 (< location (point)))
497 (progn (forward-sexp -1)
498 (>= location (point))))
499 (if (looking-at "\\s(")
500 (forward-char 1))
501 ;; Skip the defining construct name, typically "defun"
502 ;; or "defvar".
503 (forward-sexp 1)
504 ;; The second element is usually a symbol being defined.
505 ;; If it is not, use the first symbol in it.
63c7727f 506 (skip-chars-forward " \t\n'(")
42b1fc29
RS
507 (buffer-substring (point)
508 (progn (forward-sexp 1)
509 (point)))))
fb644f48
EN
510 ((and (memq major-mode add-log-c-like-modes)
511 (save-excursion
512 (beginning-of-line)
513 ;; Use eq instead of = here to avoid
514 ;; error when at bob and char-after
515 ;; returns nil.
516 (while (eq (char-after (- (point) 2)) ?\\)
517 (forward-line -1))
518 (looking-at "[ \t]*#[ \t]*define[ \t]")))
2cc0b765
RS
519 ;; Handle a C macro definition.
520 (beginning-of-line)
521 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
522 (forward-line -1))
523 (search-forward "define")
524 (skip-chars-forward " \t")
525 (buffer-substring (point)
526 (progn (forward-sexp 1) (point))))
fb644f48 527 ((memq major-mode add-log-c-like-modes)
2cc0b765
RS
528 (beginning-of-line)
529 ;; See if we are in the beginning part of a function,
530 ;; before the open brace. If so, advance forward.
531 (while (not (looking-at "{\\|\\(\\s *$\\)"))
532 (forward-line 1))
533 (or (eobp)
534 (forward-char 1))
535 (beginning-of-defun)
536 (if (progn (end-of-defun)
537 (< location (point)))
538 (progn
539 (backward-sexp 1)
540 (let (beg tem)
fd7fa35a 541
2cc0b765
RS
542 (forward-line -1)
543 ;; Skip back over typedefs of arglist.
544 (while (and (not (bobp))
545 (looking-at "[ \t\n]"))
546 (forward-line -1))
547 ;; See if this is using the DEFUN macro used in Emacs,
548 ;; or the DEFUN macro used by the C library.
549 (if (condition-case nil
550 (and (save-excursion
019644ee
RS
551 (end-of-line)
552 (while (= (preceding-char) ?\\)
553 (end-of-line 2))
2cc0b765
RS
554 (backward-sexp 1)
555 (beginning-of-line)
556 (setq tem (point))
557 (looking-at "DEFUN\\b"))
558 (>= location tem))
559 (error nil))
560 (progn
561 (goto-char tem)
562 (down-list 1)
563 (if (= (char-after (point)) ?\")
564 (progn
565 (forward-sexp 1)
566 (skip-chars-forward " ,")))
567 (buffer-substring (point)
568 (progn (forward-sexp 1) (point))))
32e986d4 569 (if (looking-at "^[+-]")
83afd62c 570 (change-log-get-method-definition)
32e986d4
RS
571 ;; Ordinary C function syntax.
572 (setq beg (point))
e172f546
KH
573 (if (and (condition-case nil
574 ;; Protect against "Unbalanced parens" error.
575 (progn
576 (down-list 1) ; into arglist
577 (backward-up-list 1)
578 (skip-chars-backward " \t")
579 t)
580 (error nil))
581 ;; Verify initial pos was after
582 ;; real start of function.
583 (save-excursion
584 (goto-char beg)
585 ;; For this purpose, include the line
586 ;; that has the decl keywords. This
587 ;; may also include some of the
588 ;; comments before the function.
589 (while (and (not (bobp))
590 (save-excursion
591 (forward-line -1)
592 (looking-at "[^\n\f]")))
593 (forward-line -1))
594 (>= location (point)))
32e986d4
RS
595 ;; Consistency check: going down and up
596 ;; shouldn't take us back before BEG.
597 (> (point) beg))
e172f546
KH
598 (let (end middle)
599 ;; Don't include any final newline
600 ;; in the name we use.
601 (if (= (preceding-char) ?\n)
602 (forward-char -1))
603 (setq end (point))
604 (backward-sexp 1)
605 ;; Now find the right beginning of the name.
606 ;; Include certain keywords if they
607 ;; precede the name.
608 (setq middle (point))
609 (forward-word -1)
6dfa1d83
RS
610 ;; Ignore these subparts of a class decl
611 ;; and move back to the class name itself.
612 (while (looking-at "public \\|private ")
613 (skip-chars-backward " \t:")
614 (setq end (point))
615 (backward-sexp 1)
616 (setq middle (point))
617 (forward-word -1))
e172f546
KH
618 (and (bolp)
619 (looking-at "struct \\|union \\|class ")
620 (setq middle (point)))
621 (buffer-substring middle end)))))))))
fb644f48 622 ((memq major-mode add-log-tex-like-modes)
2cc0b765
RS
623 (if (re-search-backward
624 "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
625 (progn
626 (goto-char (match-beginning 0))
627 (buffer-substring (1+ (point));; without initial backslash
628 (progn
629 (end-of-line)
630 (point))))))
631 ((eq major-mode 'texinfo-mode)
3071ee28 632 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
2cc0b765
RS
633 (buffer-substring (match-beginning 1)
634 (match-end 1))))
64bd2d51
RS
635 ((eq major-mode 'perl-mode)
636 (if (re-search-backward "^sub[ \t]+\\([^ \t\n]+\\)" nil t)
637 (buffer-substring (match-beginning 1)
638 (match-end 1))))
3697b807
DL
639 ((or (eq major-mode 'fortran-mode)
640 ;; Needs work for f90, but better than nothing.
641 (eq major-mode 'f90-mode))
a9e2a7f2
RS
642 ;; must be inside function body for this to work
643 (beginning-of-fortran-subprogram)
644 (let ((case-fold-search t)) ; case-insensitive
645 ;; search for fortran subprogram start
646 (if (re-search-forward
bfce6476 647 "^[ \t]*\\(program\\|subroutine\\|function\
3697b807 648\\|[ \ta-z0-9*()]*[ \t]+function\\|\\(block[ \t]*data\\)\\)"
bfce6476
RS
649 (save-excursion (end-of-fortran-subprogram)
650 (point))
651 t)
3697b807 652 (or (match-string 2)
bfce6476
RS
653 (progn
654 ;; move to EOL or before first left paren
655 (if (re-search-forward "[(\n]" nil t)
3697b807 656 (progn (backward-char)
bfce6476
RS
657 (skip-chars-backward " \t"))
658 (end-of-line))
659 ;; Use the name preceding that.
660 (buffer-substring (point)
3697b807
DL
661 (progn (backward-sexp)
662 (point)))))
663 "main")))
2cc0b765
RS
664 (t
665 ;; If all else fails, try heuristics
666 (let (case-fold-search)
667 (end-of-line)
668 (if (re-search-backward add-log-current-defun-header-regexp
669 (- (point) 10000)
670 t)
671 (buffer-substring (match-beginning 1)
672 (match-end 1))))))))
673 (error nil)))
ef15f270 674
83afd62c 675(defvar change-log-get-method-definition-md)
15319a8f 676
83afd62c 677;; Subroutine used within change-log-get-method-definition.
59c1a7de
RS
678;; Add the last match in the buffer to the end of `md',
679;; followed by the string END; move to the end of that match.
83afd62c
KH
680(defun change-log-get-method-definition-1 (end)
681 (setq change-log-get-method-definition-md
682 (concat change-log-get-method-definition-md
15319a8f
RS
683 (buffer-substring (match-beginning 1) (match-end 1))
684 end))
59c1a7de
RS
685 (goto-char (match-end 0)))
686
687;; For objective C, return the method name if we are in a method.
83afd62c
KH
688(defun change-log-get-method-definition ()
689 (let ((change-log-get-method-definition-md "["))
59c1a7de 690 (save-excursion
f27f16ed 691 (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t)
83afd62c 692 (change-log-get-method-definition-1 " ")))
59c1a7de
RS
693 (save-excursion
694 (cond
f27f16ed 695 ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t)
83afd62c 696 (change-log-get-method-definition-1 "")
59c1a7de
RS
697 (while (not (looking-at "[{;]"))
698 (looking-at
f27f16ed 699 "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
83afd62c
KH
700 (change-log-get-method-definition-1 ""))
701 (concat change-log-get-method-definition-md "]"))))))
59c1a7de 702
ef15f270 703
1da56800
RS
704(provide 'add-log)
705
fd7fa35a 706;;; add-log.el ends here