add-log.el 24.6 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1 2
;;; add-log.el --- change log maintenance commands for Emacs

3
;; Copyright (C) 1985, 86, 88, 93, 94, 1997 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
4

5
;; Keywords: tools
Eric S. Raymond's avatar
Eric S. Raymond committed
6

Eric S. Raymond's avatar
Eric S. Raymond committed
7 8 9 10
;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
Eric S. Raymond's avatar
Eric S. Raymond committed
11
;; the Free Software Foundation; either version 2, or (at your option)
Eric S. Raymond's avatar
Eric S. Raymond committed
12 13 14 15 16 17 18 19
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
20 21 22
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
Eric S. Raymond's avatar
Eric S. Raymond committed
23

24 25 26 27
;;; Commentary:

;; This facility is documented in the Emacs Manual.

Eric S. Raymond's avatar
Eric S. Raymond committed
28
;;; Code:
Eric S. Raymond's avatar
Eric S. Raymond committed
29

30 31 32 33 34
(defgroup change-log nil
  "Change log maintenance"
  :group 'tools
  :prefix "change-log-"
  :prefix "add-log-")
Eric S. Raymond's avatar
Eric S. Raymond committed
35

36 37 38 39 40 41 42 43

(defcustom change-log-default-name nil
  "*Name of a change log file for \\[add-change-log-entry]."
  :type '(choice (const :tag "default" nil)
		 string)
  :group 'change-log)

(defcustom add-log-current-defun-function nil
44 45 46
  "\
*If non-nil, function to guess name of current function from surrounding text.
\\[add-change-log-entry] calls this function (if nil, `add-log-current-defun'
47
instead) with no arguments.  It returns a string or nil if it cannot guess."
48
  :type 'function
49
  :group 'change-log)
50

51
;;;###autoload
52
(defcustom add-log-full-name nil
53
  "*Full name of user, for inclusion in ChangeLog daily headers.
54 55 56 57
This defaults to the value returned by the `user-full-name' function."
  :type '(choice (const :tag "Default" nil)
		 string)
  :group 'change-log)
58

59
;;;###autoload
60
(defcustom add-log-mailing-address nil
61
  "*Electronic mail address of user, for inclusion in ChangeLog daily headers.
62 63 64 65 66
This defaults to the value of `user-mail-address'."
  :type '(choice (const :tag "Default" nil)
		 string)
  :group 'change-log)

67 68 69 70 71 72 73 74 75 76 77
(defcustom add-log-time-format 'add-log-iso8601-time-string
  "*Function that defines the time format.
For example, `add-log-iso8601-time-string', which gives the
date in international ISO 8601 format,
and `current-time-string' are two valid values."
  :type '(radio (const :tag "International ISO 8601 format"
		       add-log-iso8601-time-string)
		(const :tag "Old format, as returned by `current-time-string'"
		       current-time-string)
		(function :tag "Other"))
  :group 'change-log)
78

79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102
(defcustom add-log-keep-changes-together nil
  "*If non-nil, then keep changes to the same file together.
If this variable is nil and you add log for (e.g.) two files,
the change log entries are added cumulatively to the beginning of log.
This is the old behaviour:

    Wday Mon DD TIME YYYY

	file A log2  << added this later
	file B log1
	File A log1

But if this variable is non-nil, then same file's changes are always kept
together.  Notice that Log2 has been appended and it is the most recent
for file A.

    Wday Mon DD TIME YYYY

	file B log1
	File A log1
	file A log2  << Added this later"
  :type 'boolean
  :group 'change-log)

103
(defvar change-log-font-lock-keywords
104 105
  '(;;
    ;; Date lines, new and old styles.
106
    ("^\\sw.........[0-9: ]*"
107
     (0 font-lock-string-face)
108 109 110
     ("\\([^<]+\\)<\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)>" nil nil
      (1 font-lock-reference-face)
      (2 font-lock-variable-name-face)))
111 112 113 114 115 116 117
    ;;
    ;; File names.
    ("^\t\\* \\([^ ,:([\n]+\\)"
     (1 font-lock-function-name-face)
     ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 font-lock-function-name-face)))
    ;;
    ;; Function or variable names.
118
    ("(\\([^) ,:\n]+\\)"
119
     (1 font-lock-keyword-face)
120
     ("\\=, *\\([^) ,:\n]+\\)" nil nil (1 font-lock-keyword-face)))
121 122 123 124
    ;;
    ;; Conditionals.
    ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 font-lock-variable-name-face))
    ;;
Richard M. Stallman's avatar
Richard M. Stallman committed
125
    ;; Acknowledgements.
126
    ("^\t\\(From\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
127
     1 font-lock-comment-face)
128
    ("  \\(From\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
129
     1 font-lock-comment-face))
130 131
  "Additional expressions to highlight in Change Log mode.")

Karl Heuer's avatar
Karl Heuer committed
132 133 134 135 136 137
(defvar change-log-mode-map nil
  "Keymap for Change Log major mode.")
(if change-log-mode-map
    nil
  (setq change-log-mode-map (make-sparse-keymap)))

138 139 140 141 142
(defvar change-log-time-zone-rule nil
  "Time zone used for calculating change log time stamps.
It takes the same format as the TZ argument of `set-time-zone-rule'.
If nil, use local time.")

143
(defun add-log-iso8601-time-zone (time)
144 145 146 147 148 149 150 151 152 153 154 155
  (let* ((utc-offset (or (car (current-time-zone time)) 0))
	 (sign (if (< utc-offset 0) ?- ?+))
	 (sec (abs utc-offset))
	 (ss (% sec 60))
	 (min (/ sec 60))
	 (mm (% min 60))
	 (hh (/ min 60)))
    (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d")
		  ((not (zerop mm)) "%c%02d:%02d")
		  (t "%c%02d"))
	    sign hh mm ss)))

156 157 158 159 160 161 162 163 164 165 166 167 168 169
(defun add-log-iso8601-time-string ()
  (if change-log-time-zone-rule
      (let ((tz (getenv "TZ"))
	    (now (current-time)))
	(unwind-protect
	    (progn
	      (set-time-zone-rule
	       change-log-time-zone-rule)
	      (concat
	       (format-time-string "%Y-%m-%d " now)
	       (add-log-iso8601-time-zone now)))
	  (set-time-zone-rule tz)))
    (format-time-string "%Y-%m-%d")))

Eric S. Raymond's avatar
Eric S. Raymond committed
170 171
(defun change-log-name ()
  (or change-log-default-name
172
      (if (eq system-type 'vax-vms)
173 174
	  "$CHANGE_LOG$.TXT"
	"ChangeLog")))
Eric S. Raymond's avatar
Eric S. Raymond committed
175

176
;;;###autoload
Eric S. Raymond's avatar
Eric S. Raymond committed
177 178
(defun prompt-for-change-log-name ()
  "Prompt for a change log name."
179 180 181 182 183 184 185 186 187 188 189 190 191 192
  (let* ((default (change-log-name))
	 (name (expand-file-name
		(read-file-name (format "Log file (default %s): " default)
				nil default))))
    ;; Handle something that is syntactically a directory name.
    ;; Look for ChangeLog or whatever in that directory.
    (if (string= (file-name-nondirectory name) "")
	(expand-file-name (file-name-nondirectory default)
			  name)
      ;; Handle specifying a file that is a directory.
      (if (file-directory-p name)
	  (expand-file-name (file-name-nondirectory default)
			    (file-name-as-directory name))
	name))))
Eric S. Raymond's avatar
Eric S. Raymond committed
193

194 195 196
;;;###autoload
(defun find-change-log (&optional file-name)
  "Find a change log file for \\[add-change-log-entry] and return the name.
197 198

Optional arg FILE-NAME specifies the file to use.
199 200 201 202 203
If FILE-NAME is nil, use the value of `change-log-default-name'.
If 'change-log-default-name' is nil, behave as though it were 'ChangeLog'
\(or whatever we use on this operating system).

If 'change-log-default-name' contains a leading directory component, then
204
simply find it in the current directory.  Otherwise, search in the current
205
directory and its successive parents for a file so named.
206 207 208

Once a file is found, `change-log-default-name' is set locally in the
current buffer to the complete file name."
209 210
  ;; If user specified a file name or if this buffer knows which one to use,
  ;; just use that.
211
  (or file-name
212 213 214
      (setq file-name (and change-log-default-name
			   (file-name-directory change-log-default-name)
			   change-log-default-name))
215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240
      (progn
	;; Chase links in the source file
	;; and use the change log in the dir where it points.
	(setq file-name (or (and buffer-file-name
				 (file-name-directory
				  (file-chase-links buffer-file-name)))
			    default-directory))
	(if (file-directory-p file-name)
	    (setq file-name (expand-file-name (change-log-name) file-name)))
	;; Chase links before visiting the file.
	;; This makes it easier to use a single change log file
	;; for several related directories.
	(setq file-name (file-chase-links file-name))
	(setq file-name (expand-file-name file-name))
	;; Move up in the dir hierarchy till we find a change log file.
	(let ((file1 file-name)
	      parent-dir)
	  (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
		      (progn (setq parent-dir
				   (file-name-directory
				    (directory-file-name
				     (file-name-directory file1))))
			     ;; Give up if we are already at the root dir.
			     (not (string= (file-name-directory file1)
					   parent-dir))))
	    ;; Move up to the parent dir and try again.
241
	    (setq file1 (expand-file-name
242 243 244 245 246 247 248 249
			 (file-name-nondirectory (change-log-name))
			 parent-dir)))
	  ;; If we found a change log in a parent, use that.
	  (if (or (get-file-buffer file1) (file-exists-p file1))
	      (setq file-name file1)))))
  ;; Make a local variable in this buffer so we needn't search again.
  (set (make-local-variable 'change-log-default-name) file-name)
  file-name)
250

251

252 253 254 255 256 257 258 259 260 261 262 263

(defun change-log-add-make-room ()
  "Begin a new empty change log entry at point."
  ;; Delete excess empty lines; make just 2.
  ;;
  (while (and (not (eobp)) (looking-at "^\\s *$"))
    (delete-region (point) (save-excursion (forward-line 1) (point))))
  (insert "\n\n")
  (forward-line -2)
  (indent-relative-maybe)
  )

Eric S. Raymond's avatar
Eric S. Raymond committed
264
;;;###autoload
265
(defun add-change-log-entry (&optional whoami file-name other-window new-entry)
Eric S. Raymond's avatar
Eric S. Raymond committed
266
  "Find change log file and add an entry for today.
267 268 269 270
Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
name and site.

Second arg is FILE-NAME of change log.  If nil, uses `change-log-default-name'.
271 272
Third arg OTHER-WINDOW non-nil means visit in other window.
Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
273 274
never append to an existing entry.  Today's date is calculated according to
`change-log-time-zone-rule' if non-nil, otherwise in local time."
Eric S. Raymond's avatar
Eric S. Raymond committed
275 276
  (interactive (list current-prefix-arg
		     (prompt-for-change-log-name)))
277 278 279 280
  (or add-log-full-name
      (setq add-log-full-name (user-full-name)))
  (or add-log-mailing-address
      (setq add-log-mailing-address user-mail-address))
281 282 283
  (if whoami
      (progn
	(setq add-log-full-name (read-input "Full name: " add-log-full-name))
Eric S. Raymond's avatar
Eric S. Raymond committed
284 285 286 287
	 ;; Note that some sites have room and phone number fields in
	 ;; full name which look silly when inserted.  Rather than do
	 ;; anything about that here, let user give prefix argument so that
	 ;; s/he can edit the full name field in prompter if s/he wants.
288 289 290 291
	(setq add-log-mailing-address
	      (read-input "Mailing address: " add-log-mailing-address))))
  (let ((defun (funcall (or add-log-current-defun-function
			    'add-log-current-defun)))
292 293 294
	today-end
	paragraph-end
	entry
295

296
	)
297
    (setq file-name (expand-file-name (find-change-log file-name)))
298 299 300 301 302 303 304 305 306 307 308 309

    ;; Set ENTRY to the file name to use in the new entry.
    (and buffer-file-name
	 ;; Never want to add a change log entry for the ChangeLog file itself.
	 (not (string= buffer-file-name file-name))
	 (setq entry (if (string-match
			  (concat "^" (regexp-quote (file-name-directory
						     file-name)))
			  buffer-file-name)
			 (substring buffer-file-name (match-end 0))
		       (file-name-nondirectory buffer-file-name))))

Eric S. Raymond's avatar
Eric S. Raymond committed
310 311 312
    (if (and other-window (not (equal file-name buffer-file-name)))
	(find-file-other-window file-name)
      (find-file file-name))
313 314
    (or (eq major-mode 'change-log-mode)
	(change-log-mode))
Eric S. Raymond's avatar
Eric S. Raymond committed
315 316
    (undo-boundary)
    (goto-char (point-min))
317
    (let ((new-entry (concat (funcall add-log-time-format)
318 319 320 321 322
			     "  " add-log-full-name
			     "  <" add-log-mailing-address ">")))
      (if (looking-at (regexp-quote new-entry))
	  (forward-line 1)
	(insert new-entry "\n\n")))
323

324
    ;; Search only within the first paragraph.
325 326 327
    (if (looking-at "\n*[^\n* \t]")
	(skip-chars-forward "\n")
      (forward-paragraph 1))
328
    (setq paragraph-end (point))
Eric S. Raymond's avatar
Eric S. Raymond committed
329
    (goto-char (point-min))
330

331 332 333 334 335 336 337 338 339 340
    ;; Today page's end point.  Used in search boundary

    (save-excursion
      (goto-char (point-min))	;Latest change log day
      (forward-line 1)
      (setq today-end
	    (if (re-search-forward "^[^ \t\n]" nil t) ;Seek to next day's hdr
		(match-beginning 0)
	      (point-max))))		;No next day, use point max

341
    ;; Now insert the new line for this entry.
342 343 344
    (cond ((re-search-forward "^\\s *\\*\\s *$" paragraph-end t)
	   ;; Put this file name into the existing empty entry.
	   (if entry
345 346 347
	       (insert entry))
	   )

348
	  ((and (not new-entry)
349 350 351 352 353 354 355
		(let (case-fold-search)
		  (re-search-forward
		   (concat (regexp-quote (concat "* " entry))
			   ;; Don't accept `foo.bar' when
			   ;; looking for `foo':
			   "\\(\\s \\|[(),:]\\)")
		   paragraph-end t)))
356 357
	   ;; Add to the existing entry for the same file.
	   (re-search-forward "^\\s *$\\|^\\s \\*")
358
	   (goto-char (match-beginning 0))
359 360 361 362 363 364 365 366 367 368 369 370 371 372
	   (change-log-add-make-room)
	   )

	  ;;  See if there is existing entry and append to it.
	  ;;  * file.txt:
	  ;;
	  ((and add-log-keep-changes-together ;enabled ?
		(re-search-forward (regexp-quote (concat "* " entry))
				   today-end t))
	   (re-search-forward "^\\s *$\\|^\\s \\*")
	   (goto-char (match-beginning 0))
	   (change-log-add-make-room)
	   )

Eric S. Raymond's avatar
Eric S. Raymond committed
373
	  (t
Roland McGrath's avatar
Roland McGrath committed
374 375 376 377
	   ;; Make a new entry.
	   (forward-line 1)
	   (while (looking-at "\\sW")
	     (forward-line 1))
378
	   (while (and (not (eobp)) (looking-at "^\\s *$"))
379 380 381
	     (delete-region (point) (save-excursion (forward-line 1) (point))))
	   (insert "\n\n\n")
	   (forward-line -2)
Roland McGrath's avatar
Roland McGrath committed
382 383
	   (indent-to left-margin)
	   (insert "* " (or entry ""))))
384
    ;; Now insert the function name, if we have one.
Eric S. Raymond's avatar
Eric S. Raymond committed
385 386 387 388
    ;; Point is at the entry for this file,
    ;; either at the end of the line or at the first blank line.
    (if defun
	(progn
Roland McGrath's avatar
Roland McGrath committed
389
	  ;; Make it easy to get rid of the function name.
Eric S. Raymond's avatar
Eric S. Raymond committed
390
	  (undo-boundary)
Roland McGrath's avatar
Roland McGrath committed
391 392
	  (insert (if (save-excursion
			(beginning-of-line 1)
393
			(looking-at "\\s *$"))
Roland McGrath's avatar
Roland McGrath committed
394 395 396
		      ""
		    " ")
		  "(" defun "): "))
397
      ;; No function name, so put in a colon unless we have just a star.
Roland McGrath's avatar
Roland McGrath committed
398 399 400
      (if (not (save-excursion
		 (beginning-of-line 1)
		 (looking-at "\\s *\\(\\*\\s *\\)?$")))
401
	  (insert ": ")))))
Eric S. Raymond's avatar
Eric S. Raymond committed
402 403 404 405

;;;###autoload
(defun add-change-log-entry-other-window (&optional whoami file-name)
  "Find change log file in other window and add an entry for today.
406 407
Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
name and site.
408 409
Second arg is file name of change log.  \
If nil, uses `change-log-default-name'."
Eric S. Raymond's avatar
Eric S. Raymond committed
410 411 412 413
  (interactive (if current-prefix-arg
		   (list current-prefix-arg
			 (prompt-for-change-log-name))))
  (add-change-log-entry whoami file-name t))
414
;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
Eric S. Raymond's avatar
Eric S. Raymond committed
415

416
;;;###autoload
Eric S. Raymond's avatar
Eric S. Raymond committed
417
(defun change-log-mode ()
418
  "Major mode for editing change logs; like Indented Text Mode.
419
Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
420
New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-before-other-window].
Roland McGrath's avatar
Roland McGrath committed
421 422
Each entry behaves as a paragraph, and the entries for one day as a page.
Runs `change-log-mode-hook'."
Eric S. Raymond's avatar
Eric S. Raymond committed
423 424 425
  (interactive)
  (kill-all-local-variables)
  (indented-text-mode)
426 427 428
  (setq major-mode 'change-log-mode
	mode-name "Change Log"
	left-margin 8
429
	fill-column 74
430 431
	indent-tabs-mode t
	tab-width 8)
Karl Heuer's avatar
Karl Heuer committed
432
  (use-local-map change-log-mode-map)
433 434
  (set (make-local-variable 'fill-paragraph-function)
       'change-log-fill-paragraph)
Eric S. Raymond's avatar
Eric S. Raymond committed
435
  ;; Let each entry behave as one paragraph:
436 437
  ;; We really do want "^" in paragraph-start below: it is only the lines that
  ;; begin at column 0 (despite the left-margin of 8) that we are looking for.
438 439
  (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\<")
  (set (make-local-variable 'paragraph-separate) "\\s *$\\|\f\\|^\\<")
Eric S. Raymond's avatar
Eric S. Raymond committed
440
  ;; Let all entries for one day behave as one page.
441 442
  ;; Match null string on the date-line so that the date-line
  ;; is grouped with what follows.
443
  (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
Roland McGrath's avatar
Roland McGrath committed
444 445
  (set (make-local-variable 'version-control) 'never)
  (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
446 447
  (set (make-local-variable 'font-lock-defaults)
       '(change-log-font-lock-keywords t))
Eric S. Raymond's avatar
Eric S. Raymond committed
448 449
  (run-hooks 'change-log-mode-hook))

450 451 452 453 454 455 456 457
;; It might be nice to have a general feature to replace this.  The idea I
;; have is a variable giving a regexp matching text which should not be
;; moved from bol by filling.  change-log-mode would set this to "^\\s *\\s(".
;; But I don't feel up to implementing that today.
(defun change-log-fill-paragraph (&optional justify)
  "Fill the paragraph, but preserve open parentheses at beginning of lines.
Prefix arg means justify as well."
  (interactive "P")
458 459
  (let ((end (progn (forward-paragraph) (point)))
	(beg (progn (backward-paragraph) (point)))
460
	(paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
461 462
    (fill-region beg end justify)
    t))
463

464
(defcustom add-log-current-defun-header-regexp
465
  "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[-_a-zA-Z]+\\)[ \t]*[:=]"
466 467 468
  "*Heuristic regexp used by `add-log-current-defun' for unknown major modes."
  :type 'regexp
  :group 'change-log)
Eric S. Raymond's avatar
Eric S. Raymond committed
469

470 471 472 473 474 475 476 477 478 479 480 481 482 483 484
;;;###autoload
(defvar add-log-lisp-like-modes
    '(emacs-lisp-mode lisp-mode scheme-mode lisp-interaction-mode)
  "*Modes that look like Lisp to `add-log-current-defun'.")

;;;###autoload
(defvar add-log-c-like-modes
    '(c-mode c++-mode c++-c-mode objc-mode)
  "*Modes that look like C to `add-log-current-defun'.")

;;;###autoload
(defvar add-log-tex-like-modes
    '(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode)
  "*Modes that look like TeX to `add-log-current-defun'.")

485
;;;###autoload
Eric S. Raymond's avatar
Eric S. Raymond committed
486 487 488
(defun add-log-current-defun ()
  "Return name of function definition point is in, or nil.

489
Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
490
Texinfo (@node titles), Perl, and Fortran.
Eric S. Raymond's avatar
Eric S. Raymond committed
491 492 493 494 495 496 497

Other modes are handled by a heuristic that looks in the 10K before
point for uppercase headings starting in the first column or
identifiers followed by `:' or `=', see variable
`add-log-current-defun-header-regexp'.

Has a preference of looking backwards."
498 499 500
  (condition-case nil
      (save-excursion
	(let ((location (point)))
501
	  (cond ((memq major-mode add-log-lisp-like-modes)
502
		 ;; If we are now precisely at the beginning of a defun,
503 504 505 506 507
		 ;; make sure beginning-of-defun finds that one
		 ;; rather than the previous one.
		 (or (eobp) (forward-char 1))
		 (beginning-of-defun)
		 ;; Make sure we are really inside the defun found, not after it.
508 509
		 (if (and (looking-at "\\s(")
			  (progn (end-of-defun)
510 511 512 513
				 (< location (point)))
			  (progn (forward-sexp -1)
				 (>= location (point))))
		     (progn
514 515 516
		       (if (looking-at "\\s(")
			   (forward-char 1))
		       (forward-sexp 1)
517
		       (skip-chars-forward " '")
518 519
		       (buffer-substring (point)
					 (progn (forward-sexp 1) (point))))))
520 521 522 523 524 525 526 527 528
		((and (memq major-mode add-log-c-like-modes)
		      (save-excursion
			(beginning-of-line)
			;; Use eq instead of = here to avoid
			;; error when at bob and char-after
			;; returns nil.
			(while (eq (char-after (- (point) 2)) ?\\)
			  (forward-line -1))
			(looking-at "[ \t]*#[ \t]*define[ \t]")))
529 530 531 532 533 534 535 536
		 ;; Handle a C macro definition.
		 (beginning-of-line)
		 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
		   (forward-line -1))
		 (search-forward "define")
		 (skip-chars-forward " \t")
		 (buffer-substring (point)
				   (progn (forward-sexp 1) (point))))
537
		((memq major-mode add-log-c-like-modes)
538 539 540 541 542 543 544 545 546 547 548 549 550
		 (beginning-of-line)
		 ;; See if we are in the beginning part of a function,
		 ;; before the open brace.  If so, advance forward.
		 (while (not (looking-at "{\\|\\(\\s *$\\)"))
		   (forward-line 1))
		 (or (eobp)
		     (forward-char 1))
		 (beginning-of-defun)
		 (if (progn (end-of-defun)
			    (< location (point)))
		     (progn
		       (backward-sexp 1)
		       (let (beg tem)
Eric S. Raymond's avatar
Eric S. Raymond committed
551

552 553 554 555 556 557 558 559 560
			 (forward-line -1)
			 ;; Skip back over typedefs of arglist.
			 (while (and (not (bobp))
				     (looking-at "[ \t\n]"))
			   (forward-line -1))
			 ;; See if this is using the DEFUN macro used in Emacs,
			 ;; or the DEFUN macro used by the C library.
			 (if (condition-case nil
				 (and (save-excursion
561 562 563
					(end-of-line)
					(while (= (preceding-char) ?\\)
					  (end-of-line 2))
564 565 566 567 568 569 570 571 572 573 574 575 576 577 578
					(backward-sexp 1)
					(beginning-of-line)
					(setq tem (point))
					(looking-at "DEFUN\\b"))
				      (>= location tem))
			       (error nil))
			     (progn
			       (goto-char tem)
			       (down-list 1)
			       (if (= (char-after (point)) ?\")
				   (progn
				     (forward-sexp 1)
				     (skip-chars-forward " ,")))
			       (buffer-substring (point)
						 (progn (forward-sexp 1) (point))))
579
                           (if (looking-at "^[+-]")
580
                               (change-log-get-method-definition)
581 582
                             ;; Ordinary C function syntax.
                             (setq beg (point))
583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604
                             (if (and (condition-case nil
					  ;; Protect against "Unbalanced parens" error.
					  (progn
					    (down-list 1) ; into arglist
					    (backward-up-list 1)
					    (skip-chars-backward " \t")
					    t)
					(error nil))
				      ;; Verify initial pos was after
				      ;; real start of function.
				      (save-excursion
					(goto-char beg)
					;; For this purpose, include the line
					;; that has the decl keywords.  This
					;; may also include some of the
					;; comments before the function.
					(while (and (not (bobp))
						    (save-excursion
						      (forward-line -1)
						      (looking-at "[^\n\f]")))
					  (forward-line -1))
					(>= location (point)))
605 606 607
                                          ;; Consistency check: going down and up
                                          ;; shouldn't take us back before BEG.
                                          (> (point) beg))
608 609 610 611 612 613 614 615 616 617 618 619
				 (let (end middle)
				   ;; Don't include any final newline
				   ;; in the name we use.
				   (if (= (preceding-char) ?\n)
				       (forward-char -1))
				   (setq end (point))
				   (backward-sexp 1)
				   ;; Now find the right beginning of the name.
				   ;; Include certain keywords if they
				   ;; precede the name.
				   (setq middle (point))
				   (forward-word -1)
620 621 622 623 624 625 626 627
				   ;; Ignore these subparts of a class decl
				   ;; and move back to the class name itself.
				   (while (looking-at "public \\|private ")
				     (skip-chars-backward " \t:")
				     (setq end (point))
				     (backward-sexp 1)
				     (setq middle (point))
				     (forward-word -1))
628 629 630 631
				   (and (bolp)
					(looking-at "struct \\|union \\|class ")
					(setq middle (point)))
				   (buffer-substring middle end)))))))))
632
		((memq major-mode add-log-tex-like-modes)
633 634 635 636 637 638 639 640 641
		 (if (re-search-backward
		      "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
		     (progn
		       (goto-char (match-beginning 0))
		       (buffer-substring (1+ (point));; without initial backslash
					 (progn
					   (end-of-line)
					   (point))))))
		((eq major-mode 'texinfo-mode)
642
		 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
643 644
		     (buffer-substring (match-beginning 1)
				       (match-end 1))))
645 646 647 648
		((eq major-mode 'perl-mode)
		 (if (re-search-backward "^sub[ \t]+\\([^ \t\n]+\\)" nil t)
		     (buffer-substring (match-beginning 1)
				       (match-end 1))))
649 650 651 652 653 654 655 656
                ((eq major-mode 'fortran-mode)
                 ;; must be inside function body for this to work
                 (beginning-of-fortran-subprogram)
                 (let ((case-fold-search t)) ; case-insensitive
                   ;; search for fortran subprogram start
                   (if (re-search-forward
			 "^[ \t]*\\(program\\|subroutine\\|function\
\\|[ \ta-z0-9*]*[ \t]+function\\)"
657
			 nil t)
658 659 660 661 662 663 664 665 666 667
                       (progn
                         ;; move to EOL or before first left paren
                         (if (re-search-forward "[(\n]" nil t)
			     (progn (forward-char -1)
				    (skip-chars-backward " \t"))
			   (end-of-line))
			 ;; Use the name preceding that.
                         (buffer-substring (point)
                                           (progn (forward-sexp -1)
                                                  (point)))))))
668 669 670 671 672 673 674 675 676 677
		(t
		 ;; If all else fails, try heuristics
		 (let (case-fold-search)
		   (end-of-line)
		   (if (re-search-backward add-log-current-defun-header-regexp
					   (- (point) 10000)
					   t)
		       (buffer-substring (match-beginning 1)
					 (match-end 1))))))))
    (error nil)))
Jim Blandy's avatar
Jim Blandy committed
678

679
(defvar change-log-get-method-definition-md)
680

681
;; Subroutine used within change-log-get-method-definition.
682 683
;; Add the last match in the buffer to the end of `md',
;; followed by the string END; move to the end of that match.
684 685 686
(defun change-log-get-method-definition-1 (end)
  (setq change-log-get-method-definition-md
	(concat change-log-get-method-definition-md
687 688
		(buffer-substring (match-beginning 1) (match-end 1))
		end))
689 690 691
  (goto-char (match-end 0)))

;; For objective C, return the method name if we are in a method.
692 693
(defun change-log-get-method-definition ()
  (let ((change-log-get-method-definition-md "["))
694
    (save-excursion
695
      (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t)
696
	  (change-log-get-method-definition-1 " ")))
697 698
    (save-excursion
      (cond
699
       ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t)
700
	(change-log-get-method-definition-1 "")
701 702
	(while (not (looking-at "[{;]"))
	  (looking-at
703
	   "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
704 705
	  (change-log-get-method-definition-1 ""))
	(concat change-log-get-method-definition-md "]"))))))
706

Jim Blandy's avatar
Jim Blandy committed
707

708 709
(provide 'add-log)

Eric S. Raymond's avatar
Eric S. Raymond committed
710
;;; add-log.el ends here