Change term translate-XXX-map to map-XXX

[gnu-emacs] / lisp / add-log.el

diff --git a/lisp/add-log.el b/lisp/add-log.el
index 6305de923928e96e9b798d8f6aa2207b093be740..06c52feebe83a8c2555d9d78fef9b0ba4a0aab2a 100644 (file)
--- a/lisp/add-log.el
+++ b/lisp/add-log.el
@@ -1,8 +1,8 @@
-;;; add-log.el --- change log maintenance commands for Emacs
+;; add-log.el --- change log maintenance commands for Emacs

 
 

-;; Copyright (C) 1985, 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 88, 93, 94, 97, 1998 Free Software Foundation, Inc.

 
 

-;; Keywords: maint
+;; Keywords: tools

 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 


@@ -17,8 +17,9 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; 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.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -26,51 +27,182 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(defvar change-log-default-name nil
-  "*Name of a change log file for \\[add-change-log-entry].")
+(eval-when-compile (require 'fortran))

 
 

-(defvar add-log-current-defun-function nil
+(defgroup change-log nil
+  "Change log maintenance"
+  :group 'tools
+  :link '(custom-manual "(emacs)Change Log")
+  :prefix "change-log-"
+  :prefix "add-log-")
+
+
+(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

   "\
 *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'
   "\
 *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'

-instead) with no arguments.  It returns a string or nil if it cannot guess.")
+instead) with no arguments.  It returns a string or nil if it cannot guess."
+  :type 'function
+  :group 'change-log)

 
 

-(defvar add-log-full-name nil
+;;;###autoload
+(defcustom add-log-full-name nil

   "*Full name of user, for inclusion in ChangeLog daily headers.
   "*Full name of user, for inclusion in ChangeLog daily headers.

-This defaults to the value returned by the `user-full-name' function.")
+This defaults to the value returned by the `user-full-name' function."
+  :type '(choice (const :tag "Default" nil)
+                string)
+  :group 'change-log)

 
 

-(defvar add-log-mailing-address nil
+;;;###autoload
+(defcustom add-log-mailing-address nil

   "*Electronic mail address of user, for inclusion in ChangeLog daily headers.
   "*Electronic mail address of user, for inclusion in ChangeLog daily headers.

-This defaults to the value of `user-mail-address'.")
+This defaults to the value of `user-mail-address'."
+  :type '(choice (const :tag "Default" nil)
+                string)
+  :group 'change-log)
+
+(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)
+
+(defcustom add-log-keep-changes-together nil
+  "*If non-nil, normally keep day's log entries for one file together.
+
+Log entries for a given file made with \\[add-change-log-entry] or
+\\[add-change-log-entry-other-window] will only be added to others \
+for that file made
+today if this variable is non-nil or that file comes first in today's
+entries.  Otherwise another entry for that file will be started.  An
+original log:
+
+       * foo (...): ...
+       * bar (...): change 1
+
+in the latter case, \\[add-change-log-entry-other-window] in a \
+buffer visiting `bar', yields:
+
+       * bar (...): -!-
+       * foo (...): ...
+       * bar (...): change 1
+
+and in the former:
+
+       * foo (...): ...
+       * bar (...): change 1
+       (...): -!-
+
+The NEW-ENTRY arg to `add-change-log-entry' can override the effect of
+this variable."
+  :version "20.3"
+  :type 'boolean
+  :group 'change-log)

 
 (defvar change-log-font-lock-keywords
 
 (defvar change-log-font-lock-keywords

-  '(("^[SMTWF].+" . font-lock-function-name-face)      ; Date line.
-    ("^\t\\* \\([^ :\n]+\\)" 1 font-lock-comment-face) ; File name.
-    ("\(\\([^)\n]+\\)\)" 1 font-lock-keyword-face))    ; Function name.
+  '(;;
+    ;; Date lines, new and old styles.
+    ("^\\sw.........[0-9:+ ]*"
+     (0 font-lock-string-face)
+     ("\\([^<]+\\)<\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)>" nil nil
+      (1 font-lock-constant-face)
+      (2 font-lock-variable-name-face)))
+    ;;
+    ;; File names.
+    ("^\t\\* \\([^ ,:([\n]+\\)"
+     (1 font-lock-function-name-face)
+     ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 font-lock-function-name-face)))
+    ;;
+    ;; Function or variable names.
+    ("(\\([^) ,:\n]+\\)"
+     (1 font-lock-keyword-face)
+     ("\\=, *\\([^) ,:\n]+\\)" nil nil (1 font-lock-keyword-face)))
+    ;;
+    ;; Conditionals.
+    ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 font-lock-variable-name-face))
+    ;;
+    ;; Acknowledgements.
+    ("^\t\\(From\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
+     1 font-lock-comment-face)
+    ("  \\(From\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
+     1 font-lock-comment-face))

   "Additional expressions to highlight in Change Log mode.")
 
 (defvar change-log-mode-map nil
   "Keymap for Change Log major mode.")
 (if change-log-mode-map
     nil
   "Additional expressions to highlight in Change Log mode.")
 
 (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))
-  (define-key change-log-mode-map "\M-q" 'change-log-fill-paragraph))
+  (setq change-log-mode-map (make-sparse-keymap)))
+
+(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.")
+
+(defvar add-log-debugging)
+
+(defun add-log-iso8601-time-zone (time)
+  (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)))
+
+(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")))

 
 (defun change-log-name ()
   (or change-log-default-name
 
 (defun change-log-name ()
   (or change-log-default-name

-      (if (eq system-type 'vax-vms) 
-         "$CHANGE_LOG$.TXT" 
-       (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt))
-           "changelo"
-         "ChangeLog"))))
+      (if (eq system-type 'vax-vms)
+         "$CHANGE_LOG$.TXT"
+       "ChangeLog")))

 
 ;;;###autoload
 (defun prompt-for-change-log-name ()
   "Prompt for a change log name."
 
 ;;;###autoload
 (defun prompt-for-change-log-name ()
   "Prompt for a change log name."

-  (let ((default (change-log-name)))
-    (expand-file-name
-     (read-file-name (format "Log file (default %s): " default)
-                    nil default))))
+  (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))))

 
 ;;;###autoload
 (defun find-change-log (&optional file-name)
 
 ;;;###autoload
 (defun find-change-log (&optional file-name)


@@ -82,7 +214,7 @@ 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
 \(or whatever we use on this operating system).
 
 If 'change-log-default-name' contains a leading directory component, then

-simply find it in the current directory.  Otherwise, search in the current 
+simply find it in the current directory.  Otherwise, search in the current

 directory and its successive parents for a file so named.
 
 Once a file is found, `change-log-default-name' is set locally in the
 directory and its successive parents for a file so named.
 
 Once a file is found, `change-log-default-name' is set locally in the


@@ -119,7 +251,7 @@ current buffer to the complete file name."
                             (not (string= (file-name-directory file1)
                                           parent-dir))))
            ;; Move up to the parent dir and try again.
                             (not (string= (file-name-directory file1)
                                           parent-dir))))
            ;; Move up to the parent dir and try again.

-           (setq file1 (expand-file-name 
+           (setq file1 (expand-file-name

                         (file-name-nondirectory (change-log-name))
                         parent-dir)))
          ;; If we found a change log in a parent, use that.
                         (file-name-nondirectory (change-log-name))
                         parent-dir)))
          ;; If we found a change log in a parent, use that.


@@ -132,13 +264,23 @@ current buffer to the complete file name."
 ;;;###autoload
 (defun add-change-log-entry (&optional whoami file-name other-window new-entry)
   "Find change log file and add an entry for today.
 ;;;###autoload
 (defun add-change-log-entry (&optional whoami file-name other-window new-entry)
   "Find change log file and add an entry for today.

-Optional arg (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'.
+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'.

 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;
 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;

-never append to an existing entry."
+never append to an existing entry.  Option `add-log-keep-changes-together'
+otherwise affects whether a new entry is created.
+
+Today's date is calculated according to `change-log-time-zone-rule' if
+non-nil, otherwise in local time."

   (interactive (list current-prefix-arg
                     (prompt-for-change-log-name)))
   (interactive (list current-prefix-arg
                     (prompt-for-change-log-name)))

+  (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))

   (if whoami
       (progn
        (setq add-log-full-name (read-input "Full name: " add-log-full-name))
   (if whoami
       (progn
        (setq add-log-full-name (read-input "Full name: " add-log-full-name))


@@ -148,13 +290,9 @@ never append to an existing entry."
         ;; s/he can edit the full name field in prompter if s/he wants.
        (setq add-log-mailing-address
              (read-input "Mailing address: " add-log-mailing-address))))
         ;; s/he can edit the full name field in prompter if s/he wants.
        (setq add-log-mailing-address
              (read-input "Mailing address: " add-log-mailing-address))))

-  (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))

   (let ((defun (funcall (or add-log-current-defun-function
                            'add-log-current-defun)))
   (let ((defun (funcall (or add-log-current-defun-function
                            'add-log-current-defun)))

-       paragraph-end entry)
+       bound entry)

 
     (setq file-name (expand-file-name (find-change-log file-name)))
 
 
     (setq file-name (expand-file-name (find-change-log file-name)))
 


@@ -169,6 +307,8 @@ never append to an existing entry."
                         (substring buffer-file-name (match-end 0))
                       (file-name-nondirectory buffer-file-name))))
 
                         (substring buffer-file-name (match-end 0))
                       (file-name-nondirectory buffer-file-name))))
 

+    (let ((buffer (find-buffer-visiting file-name)))
+      (setq add-log-debugging (list (gap-position) (gap-size))))

     (if (and other-window (not (equal file-name buffer-file-name)))
        (find-file-other-window file-name)
       (find-file file-name))
     (if (and other-window (not (equal file-name buffer-file-name)))
        (find-file-other-window file-name)
       (find-file file-name))


@@ -176,37 +316,39 @@ never append to an existing entry."
        (change-log-mode))
     (undo-boundary)
     (goto-char (point-min))
        (change-log-mode))
     (undo-boundary)
     (goto-char (point-min))

-    (if (looking-at (concat (regexp-quote (substring (current-time-string)
-                                                    0 10))
-                           ".* " (regexp-quote add-log-full-name)
-                           "  <" (regexp-quote add-log-mailing-address)))
-       (forward-line 1)
-      (insert (current-time-string)
-             "  " add-log-full-name
-             "  <" add-log-mailing-address ">\n\n"))
-
-    ;; Search only within the first paragraph.
-    (if (looking-at "\n*[^\n* \t]")
-       (skip-chars-forward "\n")
-      (forward-paragraph 1))
-    (setq paragraph-end (point))
+    (let ((new-entry (concat (funcall add-log-time-format)
+                            "  " add-log-full-name
+                            "  <" add-log-mailing-address ">")))
+      (if (looking-at (regexp-quote new-entry))
+         (forward-line 1)
+       (insert new-entry "\n\n")))
+
+    (setq bound
+         (progn
+            (if (looking-at "\n*[^\n* \t]")
+                (skip-chars-forward "\n")
+             (if add-log-keep-changes-together
+                 (forward-page)        ; page delimits entries for date
+               (forward-paragraph)))   ; paragraph delimits entries for file
+           (point)))

     (goto-char (point-min))
     (goto-char (point-min))

-

     ;; Now insert the new line for this entry.
     ;; Now insert the new line for this entry.

-    (cond ((re-search-forward "^\\s *\\*\\s *$" paragraph-end t)
+    (cond ((re-search-forward "^\\s *\\*\\s *$" bound t)

           ;; Put this file name into the existing empty entry.
           (if entry
               (insert entry)))
          ((and (not new-entry)
           ;; Put this file name into the existing empty entry.
           (if entry
               (insert entry)))
          ((and (not new-entry)

-               (re-search-forward
-                (concat (regexp-quote (concat "* " entry))
-                        ;; Don't accept `foo.bar' when
-                        ;; looking for `foo':
-                        "\\(\\s \\|[(),:]\\)")
-                paragraph-end t))
+               (let (case-fold-search)
+                 (re-search-forward
+                  (concat (regexp-quote (concat "* " entry))
+                          ;; Don't accept `foo.bar' when
+                          ;; looking for `foo':
+                          "\\(\\s \\|[(),:]\\)")
+                  bound t)))

           ;; Add to the existing entry for the same file.
           (re-search-forward "^\\s *$\\|^\\s \\*")
           ;; Add to the existing entry for the same file.
           (re-search-forward "^\\s *$\\|^\\s \\*")

-          (beginning-of-line)
+          (goto-char (match-beginning 0))
+          ;; 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")
           (while (and (not (eobp)) (looking-at "^\\s *$"))
             (delete-region (point) (save-excursion (forward-line 1) (point))))
           (insert "\n\n")


@@ -232,7 +374,7 @@ never append to an existing entry."
          (undo-boundary)
          (insert (if (save-excursion
                        (beginning-of-line 1)
          (undo-boundary)
          (insert (if (save-excursion
                        (beginning-of-line 1)

-                       (looking-at "\\s *$")) 
+                       (looking-at "\\s *$"))

                      ""
                    " ")
                  "(" defun "): "))
                      ""
                    " ")
                  "(" defun "): "))


@@ -245,9 +387,12 @@ never append to an existing entry."
 ;;;###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.
 ;;;###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.

-Optional arg (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'."
+Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
+name and site.
+Second optional arg FILE-NAME is file name of change log.
+If nil, use `change-log-default-name'.
+
+Affected by the same options as `add-change-log-entry'."

   (interactive (if current-prefix-arg
                   (list current-prefix-arg
                         (prompt-for-change-log-name))))
   (interactive (if current-prefix-arg
                   (list current-prefix-arg
                         (prompt-for-change-log-name))))


@@ -267,12 +412,18 @@ Runs `change-log-mode-hook'."
   (setq major-mode 'change-log-mode
        mode-name "Change Log"
        left-margin 8
   (setq major-mode 'change-log-mode
        mode-name "Change Log"
        left-margin 8

-       fill-column 74)
+       fill-column 74
+       indent-tabs-mode t
+       tab-width 8)

   (use-local-map change-log-mode-map)
   (use-local-map change-log-mode-map)

-  ;; Let each entry behave as one paragraph:
-  (set (make-local-variable 'paragraph-start) "^\\s *$\\|^\f")
-  (set (make-local-variable 'paragraph-separate) "^\\s *$\\|^\f\\|^\\sw")
-  ;; Let all entries for one day behave as one page.
+  (set (make-local-variable 'fill-paragraph-function)
+       'change-log-fill-paragraph)
+  ;; 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.  Adding `* ' allows eliding the blank line
+  ;; between entries for different files.
+  (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\<")
+  (set (make-local-variable 'paragraph-separate) paragraph-start)

   ;; Match null string on the date-line so that the date-line
   ;; is grouped with what follows.
   (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
   ;; Match null string on the date-line so that the date-line
   ;; is grouped with what follows.
   (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")


@@ -290,13 +441,32 @@ Runs `change-log-mode-hook'."
   "Fill the paragraph, but preserve open parentheses at beginning of lines.
 Prefix arg means justify as well."
   (interactive "P")
   "Fill the paragraph, but preserve open parentheses at beginning of lines.
 Prefix arg means justify as well."
   (interactive "P")

-  (let ((paragraph-separate (concat paragraph-separate "\\|^\\s *\\s("))
-       (paragraph-start (concat paragraph-start "\\|^\\s *\\s(")))
-    (fill-paragraph justify)))
+  (let ((end (progn (forward-paragraph) (point)))
+       (beg (progn (backward-paragraph) (point)))
+       (paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
+    (fill-region beg end justify)
+    t))

 \f
 \f

-(defvar add-log-current-defun-header-regexp
+(defcustom add-log-current-defun-header-regexp

   "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[-_a-zA-Z]+\\)[ \t]*[:=]"
   "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[-_a-zA-Z]+\\)[ \t]*[:=]"

-  "*Heuristic regexp used by `add-log-current-defun' for unknown major modes.")
+  "*Heuristic regexp used by `add-log-current-defun' for unknown major modes."
+  :type 'regexp
+  :group 'change-log)
+
+;;;###autoload
+(defvar add-log-lisp-like-modes
+    '(emacs-lisp-mode lisp-mode scheme-mode dsssl-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'.")

 
 ;;;###autoload
 (defun add-log-current-defun ()
 
 ;;;###autoload
 (defun add-log-current-defun ()


@@ -314,33 +484,38 @@ Has a preference of looking backwards."
   (condition-case nil
       (save-excursion
        (let ((location (point)))
   (condition-case nil
       (save-excursion
        (let ((location (point)))

-         (cond ((memq major-mode '(emacs-lisp-mode lisp-mode scheme-mode
-                                                   lisp-interaction-mode))
-                ;; If we are now precisely a the beginning of a defun,
+         (cond ((memq major-mode add-log-lisp-like-modes)
+                ;; If we are now precisely at the beginning of a defun,

                 ;; 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.
                 ;; 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.

-                (if (and (progn (end-of-defun)
-                                (< location (point)))
-                         (progn (forward-sexp -1)
-                                (>= location (point))))
-                    (progn
-                      (if (looking-at "\\s(")
-                          (forward-char 1))
-                      (forward-sexp 1)
-                      (skip-chars-forward " ")
-                      (buffer-substring (point)
-                                        (progn (forward-sexp 1) (point))))))
-               ((and (memq major-mode '(c-mode c++-mode c++-c-mode))
-                     (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]")))
+                (when (and (looking-at "\\s(")
+                           (progn (end-of-defun)
+                                  (< location (point)))
+                           (progn (forward-sexp -1)
+                                  (>= location (point))))
+                  (if (looking-at "\\s(")
+                      (forward-char 1))
+                  ;; Skip the defining construct name, typically "defun"
+                  ;; or "defvar".
+                  (forward-sexp 1)
+                  ;; The second element is usually a symbol being defined.
+                  ;; If it is not, use the first symbol in it.
+                  (skip-chars-forward " \t\n'(")
+                  (buffer-substring (point)
+                                    (progn (forward-sexp 1)
+                                           (point)))))
+               ((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]")))

                 ;; Handle a C macro definition.
                 (beginning-of-line)
                 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
                 ;; Handle a C macro definition.
                 (beginning-of-line)
                 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above


@@ -349,9 +524,7 @@ Has a preference of looking backwards."
                 (skip-chars-forward " \t")
                 (buffer-substring (point)
                                   (progn (forward-sexp 1) (point))))
                 (skip-chars-forward " \t")
                 (buffer-substring (point)
                                   (progn (forward-sexp 1) (point))))

-               ((and (eq major-mode 'objc-mode)
-                     (get-method-definition)))
-               ((memq major-mode '(c-mode c++-mode c++-c-mode))
+               ((memq major-mode add-log-c-like-modes)

                 (beginning-of-line)
                 ;; See if we are in the beginning part of a function,
                 ;; before the open brace.  If so, advance forward.
                 (beginning-of-line)
                 ;; See if we are in the beginning part of a function,
                 ;; before the open brace.  If so, advance forward.


@@ -393,40 +566,60 @@ Has a preference of looking backwards."
                                     (skip-chars-forward " ,")))
                               (buffer-substring (point)
                                                 (progn (forward-sexp 1) (point))))
                                     (skip-chars-forward " ,")))
                               (buffer-substring (point)
                                                 (progn (forward-sexp 1) (point))))

-                          ;; Ordinary C function syntax.
-                          (setq beg (point))
-                          (if (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.
-                              (if (and (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)))
-                                       ;; Consistency check: going down and up
-                                       ;; shouldn't take us back before BEG.
-                                       (> (point) beg))
-                                  (buffer-substring (point)
-                                                    (progn (backward-sexp 1)
-                                                           (point))))))))))
-               ((memq major-mode
-                      '(TeX-mode plain-TeX-mode LaTeX-mode;; tex-mode.el
-                                 plain-tex-mode latex-mode;; cmutex.el
-                                 ))
+                           (if (looking-at "^[+-]")
+                               (change-log-get-method-definition)
+                             ;; Ordinary C function syntax.
+                             (setq beg (point))
+                             (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)))
+                                          ;; Consistency check: going down and up
+                                          ;; shouldn't take us back before BEG.
+                                          (> (point) beg))
+                                (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)
+                                  ;; 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))
+                                  (and (bolp)
+                                       (looking-at "struct \\|union \\|class ")
+                                       (setq middle (point)))
+                                  (buffer-substring middle end)))))))))
+               ((memq major-mode add-log-tex-like-modes)

                 (if (re-search-backward
                      "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
                     (progn
                 (if (re-search-backward
                      "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
                     (progn


@@ -443,25 +636,31 @@ Has a preference of looking backwards."
                 (if (re-search-backward "^sub[ \t]+\\([^ \t\n]+\\)" nil t)
                     (buffer-substring (match-beginning 1)
                                       (match-end 1))))
                 (if (re-search-backward "^sub[ \t]+\\([^ \t\n]+\\)" nil t)
                     (buffer-substring (match-beginning 1)
                                       (match-end 1))))

-                ((eq major-mode 'fortran-mode)
+                ((or (eq major-mode 'fortran-mode)
+                    ;; Needs work for f90, but better than nothing.
+                    (eq major-mode 'f90-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
                  ;; 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\\)"
-                        nil t)
-                       (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)))))))
+                        "^[ \t]*\\(program\\|subroutine\\|function\
+\\|[ \ta-z0-9*()]*[ \t]+function\\|\\(block[ \t]*data\\)\\)"
+                        (save-excursion (end-of-fortran-subprogram)
+                                        (point))
+                        t)
+                       (or (match-string 2)
+                           (progn
+                             ;; move to EOL or before first left paren
+                             (if (re-search-forward "[(\n]" nil t)
+                                (progn (backward-char)
+                                        (skip-chars-backward " \t"))
+                               (end-of-line))
+                             ;; Use the name preceding that.
+                             (buffer-substring (point)
+                                              (progn (backward-sexp)
+                                                     (point)))))
+                    "main")))

                (t
                 ;; If all else fails, try heuristics
                 (let (case-fold-search)
                (t
                 ;; If all else fails, try heuristics
                 (let (case-fold-search)


@@ -473,30 +672,33 @@ Has a preference of looking backwards."
                                         (match-end 1))))))))
     (error nil)))
 
                                         (match-end 1))))))))
     (error nil)))
 

-;; Subroutine used within get-method-definition.
+(defvar change-log-get-method-definition-md)
+
+;; Subroutine used within change-log-get-method-definition.

 ;; Add the last match in the buffer to the end of `md',
 ;; followed by the string END; move to the end of that match.
 ;; Add the last match in the buffer to the end of `md',
 ;; followed by the string END; move to the end of that match.

-(defun get-method-definition-1 (end)
-  (setq md (concat md 
-                  (buffer-substring (match-beginning 1) (match-end 1))
-                  end))
+(defun change-log-get-method-definition-1 (end)
+  (setq change-log-get-method-definition-md
+       (concat change-log-get-method-definition-md
+               (buffer-substring (match-beginning 1) (match-end 1))
+               end))

   (goto-char (match-end 0)))
 
 ;; For objective C, return the method name if we are in a method.
   (goto-char (match-end 0)))
 
 ;; For objective C, return the method name if we are in a method.

-(defun get-method-definition ()
-  (let ((md "["))
+(defun change-log-get-method-definition ()
+  (let ((change-log-get-method-definition-md "["))

     (save-excursion
     (save-excursion

-      (if (re-search-backward "^@implementation \\(.*\\)$" nil t)
-         (get-method-definition-1 " ")))
+      (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t)
+         (change-log-get-method-definition-1 " ")))

     (save-excursion
       (cond
     (save-excursion
       (cond

-       ((re-search-backward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?" nil t)
-       (get-method-definition-1 "")
+       ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t)
+       (change-log-get-method-definition-1 "")

        (while (not (looking-at "[{;]"))
          (looking-at
        (while (not (looking-at "[{;]"))
          (looking-at

-          "\\([^ ;{:\t\n\f\r]*:?\\)\\(([^)]*)\\)?[^ ;{:\t\n\f\r]*[ \t\n\f\r]*")
-         (get-method-definition-1 ""))
-       (concat md "]"))))))
+          "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
+         (change-log-get-method-definition-1 ""))
+       (concat change-log-get-method-definition-md "]"))))))

 
 
 (provide 'add-log)
 
 
 (provide 'add-log)