lisp/add-log.el

   1 ;;; add-log.el --- change log maintenance commands for Emacs
   2
   3 ;; Copyright (C) 1985, 86, 88, 93, 94, 1997 Free Software Foundation, Inc.
   4
   5 ;; Keywords: tools
   6
   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
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  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
  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.
  23
  24 ;;; Commentary:
  25
  26 ;; This facility is documented in the Emacs Manual.
  27
  28 ;;; Code:
  29
  30 (defgroup change-log nil
  31   "Change log maintenance"
  32   :group 'tools
  33   :prefix "change-log-"
  34   :prefix "add-log-")
  35
  36
  37 (defcustom change-log-default-name nil
  38   "*Name of a change log file for \\[add-change-log-entry]."
  39   :type '(choice (const :tag "default" nil)
  40                  string)
  41   :group 'change-log)
  42
  43 (defcustom add-log-current-defun-function nil
  44   "\
  45 *If non-nil, function to guess name of current function from surrounding text.
  46 \\[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 This defaults to the value returned by the `user-full-name' function."
  55   :type '(choice (const :tag "Default" nil)
  56                  string)
  57   :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 This defaults to the value of `user-mail-address'."
  63   :type '(choice (const :tag "Default" nil)
  64                  string)
  65   :group 'change-log)
  66
  67 (defcustom add-log-time-format 'add-log-iso8601-time-string
  68   "*Function that defines the time format.
  69 For example, `add-log-iso8601-time-string', which gives the
  70 date in international ISO 8601 format,
  71 and `current-time-string' are two valid values."
  72   :type '(radio (const :tag "International ISO 8601 format"
  73                        add-log-iso8601-time-string)
  74                 (const :tag "Old format, as returned by `current-time-string'"
  75                        current-time-string)
  76                 (function :tag "Other"))
  77   :group 'change-log)
  78
  79 (defcustom add-log-keep-changes-together nil
  80   "*If non-nil, then keep changes to the same file together.
  81 If this variable is nil and you add log for (e.g.) two files,
  82 the change log entries are added cumulatively to the beginning of log.
  83 This is the old behaviour:
  84
  85     Wday Mon DD TIME YYYY
  86
  87         file A log2  << added this later
  88         file B log1
  89         File A log1
  90
  91 But if this variable is non-nil, then same file's changes are always kept
  92 together.  Notice that Log2 has been appended and it is the most recent
  93 for file A.
  94
  95     Wday Mon DD TIME YYYY
  96
  97         file B log1
  98         File A log1
  99         file A log2  << Added this later"
 100   :type 'boolean
 101   :group 'change-log)
 102
 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      ("\\([^<]+\\)<\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)>" nil nil
 109       (1 font-lock-reference-face)
 110       (2 font-lock-variable-name-face)))
 111     ;;
 112     ;; File names.
 113     ("^\t\\* \\([^ ,:([\n]+\\)"
 114      (1 font-lock-function-name-face)
 115      ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 font-lock-function-name-face)))
 116     ;;
 117     ;; Function or variable names.
 118     ("(\\([^) ,:\n]+\\)"
 119      (1 font-lock-keyword-face)
 120      ("\\=, *\\([^) ,:\n]+\\)" nil nil (1 font-lock-keyword-face)))
 121     ;;
 122     ;; Conditionals.
 123     ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 font-lock-variable-name-face))
 124     ;;
 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   "Additional expressions to highlight in Change Log mode.")
 131
 132 (defvar change-log-mode-map nil
 133   "Keymap for Change Log major mode.")
 134 (if change-log-mode-map
 135     nil
 136   (setq change-log-mode-map (make-sparse-keymap)))
 137
 138 (defvar change-log-time-zone-rule nil
 139   "Time zone used for calculating change log time stamps.
 140 It takes the same format as the TZ argument of `set-time-zone-rule'.
 141 If nil, use local time.")
 142
 143 (defun add-log-iso8601-time-zone (time)
 144   (let* ((utc-offset (or (car (current-time-zone time)) 0))
 145          (sign (if (< utc-offset 0) ?- ?+))
 146          (sec (abs utc-offset))
 147          (ss (% sec 60))
 148          (min (/ sec 60))
 149          (mm (% min 60))
 150          (hh (/ min 60)))
 151     (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d")
 152                   ((not (zerop mm)) "%c%02d:%02d")
 153                   (t "%c%02d"))
 154             sign hh mm ss)))
 155
 156 (defun add-log-iso8601-time-string ()
 157   (if change-log-time-zone-rule
 158       (let ((tz (getenv "TZ"))
 159             (now (current-time)))
 160         (unwind-protect
 161             (progn
 162               (set-time-zone-rule
 163                change-log-time-zone-rule)
 164               (concat
 165                (format-time-string "%Y-%m-%d " now)
 166                (add-log-iso8601-time-zone now)))
 167           (set-time-zone-rule tz)))
 168     (format-time-string "%Y-%m-%d")))
 169
 170 (defun change-log-name ()
 171   (or change-log-default-name
 172       (if (eq system-type 'vax-vms)
 173           "$CHANGE_LOG$.TXT"
 174         "ChangeLog")))
 175
 176 ;;;###autoload
 177 (defun prompt-for-change-log-name ()
 178   "Prompt for a change log name."
 179   (let* ((default (change-log-name))
 180          (name (expand-file-name
 181                 (read-file-name (format "Log file (default %s): " default)
 182                                 nil default))))
 183     ;; Handle something that is syntactically a directory name.
 184     ;; Look for ChangeLog or whatever in that directory.
 185     (if (string= (file-name-nondirectory name) "")
 186         (expand-file-name (file-name-nondirectory default)
 187                           name)
 188       ;; Handle specifying a file that is a directory.
 189       (if (file-directory-p name)
 190           (expand-file-name (file-name-nondirectory default)
 191                             (file-name-as-directory name))
 192         name))))
 193
 194 ;;;###autoload
 195 (defun find-change-log (&optional file-name)
 196   "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 If FILE-NAME is nil, use the value of `change-log-default-name'.
 200 If 'change-log-default-name' is nil, behave as though it were 'ChangeLog'
 201 \(or whatever we use on this operating system).
 202
 203 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 Once a file is found, `change-log-default-name' is set locally in the
 208 current buffer to the complete file name."
 209   ;; If user specified a file name or if this buffer knows which one to use,
 210   ;; just use that.
 211   (or file-name
 212       (setq file-name (and change-log-default-name
 213                            (file-name-directory change-log-default-name)
 214                            change-log-default-name))
 215       (progn
 216         ;; Chase links in the source file
 217         ;; and use the change log in the dir where it points.
 218         (setq file-name (or (and buffer-file-name
 219                                  (file-name-directory
 220                                   (file-chase-links buffer-file-name)))
 221                             default-directory))
 222         (if (file-directory-p file-name)
 223             (setq file-name (expand-file-name (change-log-name) file-name)))
 224         ;; Chase links before visiting the file.
 225         ;; This makes it easier to use a single change log file
 226         ;; for several related directories.
 227         (setq file-name (file-chase-links file-name))
 228         (setq file-name (expand-file-name file-name))
 229         ;; Move up in the dir hierarchy till we find a change log file.
 230         (let ((file1 file-name)
 231               parent-dir)
 232           (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
 233                       (progn (setq parent-dir
 234                                    (file-name-directory
 235                                     (directory-file-name
 236                                      (file-name-directory file1))))
 237                              ;; Give up if we are already at the root dir.
 238                              (not (string= (file-name-directory file1)
 239                                            parent-dir))))
 240             ;; Move up to the parent dir and try again.
 241             (setq file1 (expand-file-name
 242                          (file-name-nondirectory (change-log-name))
 243                          parent-dir)))
 244           ;; If we found a change log in a parent, use that.
 245           (if (or (get-file-buffer file1) (file-exists-p file1))
 246               (setq file-name file1)))))
 247   ;; Make a local variable in this buffer so we needn't search again.
 248   (set (make-local-variable 'change-log-default-name) file-name)
 249   file-name)
 250
 251
 252
 253 (defun change-log-add-make-room ()
 254   "Begin a new empty change log entry at point."
 255   ;; Delete excess empty lines; make just 2.
 256   ;;
 257   (while (and (not (eobp)) (looking-at "^\\s *$"))
 258     (delete-region (point) (save-excursion (forward-line 1) (point))))
 259   (insert "\n\n")
 260   (forward-line -2)
 261   (indent-relative-maybe)
 262   )
 263
 264 ;;;###autoload
 265 (defun add-change-log-entry (&optional whoami file-name other-window new-entry)
 266   "Find change log file and add an entry for today.
 267 Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
 268 name and site.
 269
 270 Second arg is FILE-NAME of change log.  If nil, uses `change-log-default-name'.
 271 Third arg OTHER-WINDOW non-nil means visit in other window.
 272 Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
 273 never append to an existing entry.  Today's date is calculated according to
 274 `change-log-time-zone-rule' if non-nil, otherwise in local time."
 275   (interactive (list current-prefix-arg
 276                      (prompt-for-change-log-name)))
 277   (or add-log-full-name
 278       (setq add-log-full-name (user-full-name)))
 279   (or add-log-mailing-address
 280       (setq add-log-mailing-address user-mail-address))
 281   (if whoami
 282       (progn
 283         (setq add-log-full-name (read-input "Full name: " add-log-full-name))
 284          ;; Note that some sites have room and phone number fields in
 285          ;; full name which look silly when inserted.  Rather than do
 286          ;; anything about that here, let user give prefix argument so that
 287          ;; s/he can edit the full name field in prompter if s/he wants.
 288         (setq add-log-mailing-address
 289               (read-input "Mailing address: " add-log-mailing-address))))
 290   (let ((defun (funcall (or add-log-current-defun-function
 291                             'add-log-current-defun)))
 292         today-end
 293         paragraph-end
 294         entry
 295
 296         )
 297     (setq file-name (expand-file-name (find-change-log file-name)))
 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
 310     (if (and other-window (not (equal file-name buffer-file-name)))
 311         (find-file-other-window file-name)
 312       (find-file file-name))
 313     (or (eq major-mode 'change-log-mode)
 314         (change-log-mode))
 315     (undo-boundary)
 316     (goto-char (point-min))
 317     (let ((new-entry (concat (funcall add-log-time-format)
 318                              "  " add-log-full-name
 319                              "  <" add-log-mailing-address ">")))
 320       (if (looking-at (regexp-quote new-entry))
 321           (forward-line 1)
 322         (insert new-entry "\n\n")))
 323
 324     ;; Search only within the first paragraph.
 325     (if (looking-at "\n*[^\n* \t]")
 326         (skip-chars-forward "\n")
 327       (forward-paragraph 1))
 328     (setq paragraph-end (point))
 329     (goto-char (point-min))
 330
 331     ;; Today page's end point.  Used in search boundary
 332
 333     (save-excursion
 334       (goto-char (point-min))   ;Latest change log day
 335       (forward-line 1)
 336       (setq today-end
 337             (if (re-search-forward "^[^ \t\n]" nil t) ;Seek to next day's hdr
 338                 (match-beginning 0)
 339               (point-max))))            ;No next day, use point max
 340
 341     ;; Now insert the new line for this entry.
 342     (cond ((re-search-forward "^\\s *\\*\\s *$" paragraph-end t)
 343            ;; Put this file name into the existing empty entry.
 344            (if entry
 345                (insert entry))
 346            )
 347
 348           ((and (not new-entry)
 349                 (let (case-fold-search)
 350                   (re-search-forward
 351                    (concat (regexp-quote (concat "* " entry))
 352                            ;; Don't accept `foo.bar' when
 353                            ;; looking for `foo':
 354                            "\\(\\s \\|[(),:]\\)")
 355                    paragraph-end t)))
 356            ;; Add to the existing entry for the same file.
 357            (re-search-forward "^\\s *$\\|^\\s \\*")
 358            (goto-char (match-beginning 0))
 359            (change-log-add-make-room)
 360            )
 361
 362           ;;  See if there is existing entry and append to it.
 363           ;;  * file.txt:
 364           ;;
 365           ((and add-log-keep-changes-together ;enabled ?
 366                 (re-search-forward (regexp-quote (concat "* " entry))
 367                                    today-end t))
 368            (re-search-forward "^\\s *$\\|^\\s \\*")
 369            (goto-char (match-beginning 0))
 370            (change-log-add-make-room)
 371            )
 372
 373           (t
 374            ;; Make a new entry.
 375            (forward-line 1)
 376            (while (looking-at "\\sW")
 377              (forward-line 1))
 378            (while (and (not (eobp)) (looking-at "^\\s *$"))
 379              (delete-region (point) (save-excursion (forward-line 1) (point))))
 380            (insert "\n\n\n")
 381            (forward-line -2)
 382            (indent-to left-margin)
 383            (insert "* " (or entry ""))))
 384     ;; Now insert the function name, if we have one.
 385     ;; Point is at the entry for this file,
 386     ;; either at the end of the line or at the first blank line.
 387     (if defun
 388         (progn
 389           ;; Make it easy to get rid of the function name.
 390           (undo-boundary)
 391           (insert (if (save-excursion
 392                         (beginning-of-line 1)
 393                         (looking-at "\\s *$"))
 394                       ""
 395                     " ")
 396                   "(" defun "): "))
 397       ;; No function name, so put in a colon unless we have just a star.
 398       (if (not (save-excursion
 399                  (beginning-of-line 1)
 400                  (looking-at "\\s *\\(\\*\\s *\\)?$")))
 401           (insert ": ")))))
 402
 403 ;;;###autoload
 404 (defun add-change-log-entry-other-window (&optional whoami file-name)
 405   "Find change log file in other window and add an entry for today.
 406 Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
 407 name and site.
 408 Second arg is file name of change log.  \
 409 If nil, uses `change-log-default-name'."
 410   (interactive (if current-prefix-arg
 411                    (list current-prefix-arg
 412                          (prompt-for-change-log-name))))
 413   (add-change-log-entry whoami file-name t))
 414 ;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
 415
 416 ;;;###autoload
 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].
 421 Each entry behaves as a paragraph, and the entries for one day as a page.
 422 Runs `change-log-mode-hook'."
 423   (interactive)
 424   (kill-all-local-variables)
 425   (indented-text-mode)
 426   (setq major-mode 'change-log-mode
 427         mode-name "Change Log"
 428         left-margin 8
 429         fill-column 74
 430         indent-tabs-mode t
 431         tab-width 8)
 432   (use-local-map change-log-mode-map)
 433   (set (make-local-variable 'fill-paragraph-function)
 434        'change-log-fill-paragraph)
 435   ;; Let each entry behave as one paragraph:
 436   ;; We really do want "^" in paragraph-start below: it is only the lines that
 437   ;; begin at column 0 (despite the left-margin of 8) that we are looking for.
 438   (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\<")
 439   (set (make-local-variable 'paragraph-separate) "\\s *$\\|\f\\|^\\<")
 440   ;; Let all entries for one day behave as one page.
 441   ;; Match null string on the date-line so that the date-line
 442   ;; is grouped with what follows.
 443   (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
 444   (set (make-local-variable 'version-control) 'never)
 445   (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
 446   (set (make-local-variable 'font-lock-defaults)
 447        '(change-log-font-lock-keywords t))
 448   (run-hooks 'change-log-mode-hook))
 449
 450 ;; It might be nice to have a general feature to replace this.  The idea I
 451 ;; have is a variable giving a regexp matching text which should not be
 452 ;; moved from bol by filling.  change-log-mode would set this to "^\\s *\\s(".
 453 ;; But I don't feel up to implementing that today.
 454 (defun change-log-fill-paragraph (&optional justify)
 455   "Fill the paragraph, but preserve open parentheses at beginning of lines.
 456 Prefix arg means justify as well."
 457   (interactive "P")
 458   (let ((end (progn (forward-paragraph) (point)))
 459         (beg (progn (backward-paragraph) (point)))
 460         (paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
 461     (fill-region beg end justify)
 462     t))
 463 \f
 464 (defcustom add-log-current-defun-header-regexp
 465   "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[-_a-zA-Z]+\\)[ \t]*[:=]"
 466   "*Heuristic regexp used by `add-log-current-defun' for unknown major modes."
 467   :type 'regexp
 468   :group 'change-log)
 469
 470 ;;;###autoload
 471 (defvar add-log-lisp-like-modes
 472     '(emacs-lisp-mode lisp-mode scheme-mode lisp-interaction-mode)
 473   "*Modes that look like Lisp to `add-log-current-defun'.")
 474
 475 ;;;###autoload
 476 (defvar add-log-c-like-modes
 477     '(c-mode c++-mode c++-c-mode objc-mode)
 478   "*Modes that look like C to `add-log-current-defun'.")
 479
 480 ;;;###autoload
 481 (defvar add-log-tex-like-modes
 482     '(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode)
 483   "*Modes that look like TeX to `add-log-current-defun'.")
 484
 485 ;;;###autoload
 486 (defun add-log-current-defun ()
 487   "Return name of function definition point is in, or nil.
 488
 489 Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
 490 Texinfo (@node titles), Perl, and Fortran.
 491
 492 Other modes are handled by a heuristic that looks in the 10K before
 493 point for uppercase headings starting in the first column or
 494 identifiers followed by `:' or `=', see variable
 495 `add-log-current-defun-header-regexp'.
 496
 497 Has a preference of looking backwards."
 498   (condition-case nil
 499       (save-excursion
 500         (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                  ;; make sure beginning-of-defun finds that one
 504                  ;; rather than the previous one.
 505                  (or (eobp) (forward-char 1))
 506                  (beginning-of-defun)
 507                  ;; Make sure we are really inside the defun found, not after it.
 508                  (if (and (looking-at "\\s(")
 509                           (progn (end-of-defun)
 510                                  (< location (point)))
 511                           (progn (forward-sexp -1)
 512                                  (>= location (point))))
 513                      (progn
 514                        (if (looking-at "\\s(")
 515                            (forward-char 1))
 516                        (forward-sexp 1)
 517                        (skip-chars-forward " '")
 518                        (buffer-substring (point)
 519                                          (progn (forward-sexp 1) (point))))))
 520                 ((and (memq major-mode add-log-c-like-modes)
 521                       (save-excursion
 522                         (beginning-of-line)
 523                         ;; Use eq instead of = here to avoid
 524                         ;; error when at bob and char-after
 525                         ;; returns nil.
 526                         (while (eq (char-after (- (point) 2)) ?\\)
 527                           (forward-line -1))
 528                         (looking-at "[ \t]*#[ \t]*define[ \t]")))
 529                  ;; Handle a C macro definition.
 530                  (beginning-of-line)
 531                  (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
 532                    (forward-line -1))
 533                  (search-forward "define")
 534                  (skip-chars-forward " \t")
 535                  (buffer-substring (point)
 536                                    (progn (forward-sexp 1) (point))))
 537                 ((memq major-mode add-log-c-like-modes)
 538                  (beginning-of-line)
 539                  ;; See if we are in the beginning part of a function,
 540                  ;; before the open brace.  If so, advance forward.
 541                  (while (not (looking-at "{\\|\\(\\s *$\\)"))
 542                    (forward-line 1))
 543                  (or (eobp)
 544                      (forward-char 1))
 545                  (beginning-of-defun)
 546                  (if (progn (end-of-defun)
 547                             (< location (point)))
 548                      (progn
 549                        (backward-sexp 1)
 550                        (let (beg tem)
 551
 552                          (forward-line -1)
 553                          ;; Skip back over typedefs of arglist.
 554                          (while (and (not (bobp))
 555                                      (looking-at "[ \t\n]"))
 556                            (forward-line -1))
 557                          ;; See if this is using the DEFUN macro used in Emacs,
 558                          ;; or the DEFUN macro used by the C library.
 559                          (if (condition-case nil
 560                                  (and (save-excursion
 561                                         (end-of-line)
 562                                         (while (= (preceding-char) ?\\)
 563                                           (end-of-line 2))
 564                                         (backward-sexp 1)
 565                                         (beginning-of-line)
 566                                         (setq tem (point))
 567                                         (looking-at "DEFUN\\b"))
 568                                       (>= location tem))
 569                                (error nil))
 570                              (progn
 571                                (goto-char tem)
 572                                (down-list 1)
 573                                (if (= (char-after (point)) ?\")
 574                                    (progn
 575                                      (forward-sexp 1)
 576                                      (skip-chars-forward " ,")))
 577                                (buffer-substring (point)
 578                                                  (progn (forward-sexp 1) (point))))
 579                            (if (looking-at "^[+-]")
 580                                (change-log-get-method-definition)
 581                              ;; Ordinary C function syntax.
 582                              (setq beg (point))
 583                              (if (and (condition-case nil
 584                                           ;; Protect against "Unbalanced parens" error.
 585                                           (progn
 586                                             (down-list 1) ; into arglist
 587                                             (backward-up-list 1)
 588                                             (skip-chars-backward " \t")
 589                                             t)
 590                                         (error nil))
 591                                       ;; Verify initial pos was after
 592                                       ;; real start of function.
 593                                       (save-excursion
 594                                         (goto-char beg)
 595                                         ;; For this purpose, include the line
 596                                         ;; that has the decl keywords.  This
 597                                         ;; may also include some of the
 598                                         ;; comments before the function.
 599                                         (while (and (not (bobp))
 600                                                     (save-excursion
 601                                                       (forward-line -1)
 602                                                       (looking-at "[^\n\f]")))
 603                                           (forward-line -1))
 604                                         (>= location (point)))
 605                                           ;; Consistency check: going down and up
 606                                           ;; shouldn't take us back before BEG.
 607                                           (> (point) beg))
 608                                  (let (end middle)
 609                                    ;; Don't include any final newline
 610                                    ;; in the name we use.
 611                                    (if (= (preceding-char) ?\n)
 612                                        (forward-char -1))
 613                                    (setq end (point))
 614                                    (backward-sexp 1)
 615                                    ;; Now find the right beginning of the name.
 616                                    ;; Include certain keywords if they
 617                                    ;; precede the name.
 618                                    (setq middle (point))
 619                                    (forward-word -1)
 620                                    ;; Ignore these subparts of a class decl
 621                                    ;; and move back to the class name itself.
 622                                    (while (looking-at "public \\|private ")
 623                                      (skip-chars-backward " \t:")
 624                                      (setq end (point))
 625                                      (backward-sexp 1)
 626                                      (setq middle (point))
 627                                      (forward-word -1))
 628                                    (and (bolp)
 629                                         (looking-at "struct \\|union \\|class ")
 630                                         (setq middle (point)))
 631                                    (buffer-substring middle end)))))))))
 632                 ((memq major-mode add-log-tex-like-modes)
 633                  (if (re-search-backward
 634                       "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
 635                      (progn
 636                        (goto-char (match-beginning 0))
 637                        (buffer-substring (1+ (point));; without initial backslash
 638                                          (progn
 639                                            (end-of-line)
 640                                            (point))))))
 641                 ((eq major-mode 'texinfo-mode)
 642                  (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
 643                      (buffer-substring (match-beginning 1)
 644                                        (match-end 1))))
 645                 ((eq major-mode 'perl-mode)
 646                  (if (re-search-backward "^sub[ \t]+\\([^ \t\n]+\\)" nil t)
 647                      (buffer-substring (match-beginning 1)
 648                                        (match-end 1))))
 649                 ((eq major-mode 'fortran-mode)
 650                  ;; must be inside function body for this to work
 651                  (beginning-of-fortran-subprogram)
 652                  (let ((case-fold-search t)) ; case-insensitive
 653                    ;; search for fortran subprogram start
 654                    (if (re-search-forward
 655                          "^[ \t]*\\(program\\|subroutine\\|function\
 656 \\|[ \ta-z0-9*]*[ \t]+function\\)"
 657                          nil t)
 658                        (progn
 659                          ;; move to EOL or before first left paren
 660                          (if (re-search-forward "[(\n]" nil t)
 661                              (progn (forward-char -1)
 662                                     (skip-chars-backward " \t"))
 663                            (end-of-line))
 664                          ;; Use the name preceding that.
 665                          (buffer-substring (point)
 666                                            (progn (forward-sexp -1)
 667                                                   (point)))))))
 668                 (t
 669                  ;; If all else fails, try heuristics
 670                  (let (case-fold-search)
 671                    (end-of-line)
 672                    (if (re-search-backward add-log-current-defun-header-regexp
 673                                            (- (point) 10000)
 674                                            t)
 675                        (buffer-substring (match-beginning 1)
 676                                          (match-end 1))))))))
 677     (error nil)))
 678
 679 (defvar change-log-get-method-definition-md)
 680
 681 ;; Subroutine used within change-log-get-method-definition.
 682 ;; Add the last match in the buffer to the end of `md',
 683 ;; followed by the string END; move to the end of that match.
 684 (defun change-log-get-method-definition-1 (end)
 685   (setq change-log-get-method-definition-md
 686         (concat change-log-get-method-definition-md
 687                 (buffer-substring (match-beginning 1) (match-end 1))
 688                 end))
 689   (goto-char (match-end 0)))
 690
 691 ;; For objective C, return the method name if we are in a method.
 692 (defun change-log-get-method-definition ()
 693   (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     (save-excursion
 698       (cond
 699        ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t)
 700         (change-log-get-method-definition-1 "")
 701         (while (not (looking-at "[{;]"))
 702           (looking-at
 703            "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
 704           (change-log-get-method-definition-1 ""))
 705         (concat change-log-get-method-definition-md "]"))))))
 706
 707
 708 (provide 'add-log)
 709
 710 ;;; add-log.el ends here