(comment-start, comment-start-skip, comment-end): Made `defvar'.

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

diff --git a/lisp/add-log.el b/lisp/add-log.el
index 073a0ccd04409fed4bf3a4ebd8fc5438ea1c5fc1..a89cbd49f6d5667ab29086daa14df1a9ef55cf2f 100644 (file)
--- a/lisp/add-log.el
+++ b/lisp/add-log.el
@@ -1,6 +1,6 @@
 ;;; add-log.el --- change log maintenance commands for Emacs
 
 ;;; add-log.el --- change log maintenance commands for Emacs
 

-;; Copyright (C) 1985, 86, 88, 93, 94, 97, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 88, 93, 94, 97, 98, 2000 Free Software Foundation, Inc.

 
 ;; Keywords: tools
 
 
 ;; Keywords: tools
 


@@ -27,7 +27,8 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'fortran))
+(eval-when-compile
+  (require 'timezone))

 
 (defgroup change-log nil
   "Change log maintenance"
 
 (defgroup change-log nil
   "Change log maintenance"


@@ -49,17 +50,16 @@
   :group 'change-log)
 
 (defcustom add-log-current-defun-function nil
   :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'
-instead) with no arguments.  It returns a string or nil if it cannot guess."
+  "*If non-nil, function to guess name of surrounding function.
+It is used by `add-log-current-defun' in preference to built-in rules.
+Returns function's name as a string, or nil if outside a function."

   :type 'function
   :group 'change-log)
 
 ;;;###autoload
 (defcustom add-log-full-name nil
   "*Full name of user, for inclusion in ChangeLog daily headers.
   :type 'function
   :group 'change-log)
 
 ;;;###autoload
 (defcustom add-log-full-name nil
   "*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 function `user-full-name'."

   :type '(choice (const :tag "Default" nil)
                 string)
   :group 'change-log)
   :type '(choice (const :tag "Default" nil)
                 string)
   :group 'change-log)


@@ -118,12 +118,34 @@ this variable."
 
 (defcustom add-log-file-name-function nil
   "*If non-nil, function to call to identify the filename for a ChangeLog entry.
 
 (defcustom add-log-file-name-function nil
   "*If non-nil, function to call to identify the filename for a ChangeLog entry.

-This function is called with one argument, `buffer-file-name' in that buffer.
-If this is nil, the default is to use the file's name
-relative to the directory of the change log file."
+This function is called with one argument, the value of variable
+`buffer-file-name' in that buffer.  If this is nil, the default is to
+use the file's name relative to the directory of the change log file."

   :type 'function
   :group 'change-log)
 
   :type 'function
   :group 'change-log)
 

+
+(defcustom change-log-version-info-enabled nil
+  "*If non-nil, enable recording version numbers with the changes."
+  :version "21.1"
+  :type 'boolean
+  :group 'change-log)
+
+(defcustom change-log-version-number-regexp-list
+  (let ((re    "\\([0-9]+\.[0-9.]+\\)"))
+    (list
+     ;;  (defconst ad-version "2.15"
+     (concat "^(def[^ \t\n]+[ \t]+[^ \t\n][ \t]\"" re)
+     ;; Revision: pcl-cvs.el,v 1.72 1999/09/05 20:21:54 monnier Exp
+     (concat "^;+ *Revision: +[^ \t\n]+[ \t]+" re)))
+  "*List of regexps to search for version number.
+The version number must be in group 1.
+Note: The search is conducted only within 10%, at the beginning of the file."
+  :version "21.1"
+  :type '(repeat regexp)
+  :group 'change-log)
+
+

 (defvar change-log-font-lock-keywords
   '(;;
     ;; Date lines, new and old styles.
 (defvar change-log-font-lock-keywords
   '(;;
     ;; Date lines, new and old styles.


@@ -158,19 +180,14 @@ relative to the directory of the change log file."
      1 font-lock-comment-face))
   "Additional expressions to highlight in Change Log mode.")
 
      1 font-lock-comment-face))
   "Additional expressions to highlight in Change Log mode.")
 

-(defvar change-log-mode-map nil
+(defvar change-log-mode-map (make-sparse-keymap)

   "Keymap for Change Log major mode.")
   "Keymap for Change Log major mode.")

-(if change-log-mode-map
-    nil
-  (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 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) ?- ?+))
 (defun add-log-iso8601-time-zone (time)
   (let* ((utc-offset (or (car (current-time-zone time)) 0))
         (sign (if (< utc-offset 0) ?- ?+))


@@ -199,6 +216,7 @@ If nil, use local time.")
     (format-time-string "%Y-%m-%d")))
 
 (defun change-log-name ()
     (format-time-string "%Y-%m-%d")))
 
 (defun change-log-name ()

+  "Return (system-dependent) default name for a change log file."

   (or change-log-default-name
       (if (eq system-type 'vax-vms)
          "$CHANGE_LOG$.TXT"
   (or change-log-default-name
       (if (eq system-type 'vax-vms)
          "$CHANGE_LOG$.TXT"


@@ -222,6 +240,35 @@ If nil, use local time.")
                            (file-name-as-directory name))
        name))))
 
                            (file-name-as-directory name))
        name))))
 

+(defun change-log-version-number-search ()
+  "Return version number of current buffer's file.
+This is the value returned by `vc-workfile-version' or, if that is
+nil, by matching `change-log-version-number-regexp-list'."
+  (let* ((size (buffer-size))
+        (end
+         ;; The version number can be anywhere in the file, but
+         ;; restrict search to the file beginning: 10% should be
+         ;; enough to prevent some mishits.
+         ;;
+         ;; Apply percentage only if buffer size is bigger than
+         ;; approx 100 lines.
+         (if (> size (* 100 80))
+             (/ size 10)
+           size))
+        version)
+    (or (and buffer-file-name
+            (vc-workfile-version buffer-file-name))
+       (save-restriction
+         (widen)
+         (let ((regexps change-log-version-number-regexp-list))
+           (while regexps
+             (save-excursion
+               (goto-char (point-min))
+               (when (re-search-forward (pop regexps) end t)
+                 (setq version (match-string 1)
+                       regexps nil)))))))))
+
+

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


@@ -308,8 +355,9 @@ non-nil, otherwise in local time."
         ;; 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))))

-  (let ((defun (funcall (or add-log-current-defun-function
-                           'add-log-current-defun)))
+  (let ((defun (add-log-current-defun))
+       (version (and change-log-version-info-enabled
+                     (change-log-version-number-search)))

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


@@ -318,18 +366,22 @@ non-nil, otherwise in local time."
     (and buffer-file-name
         ;; Never want to add a change log entry for the ChangeLog file itself.
         (not (string= buffer-file-name file-name))
     (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 add-log-file-name-function
-                  (funcall add-log-file-name-function buffer-file-name)
+        (if add-log-file-name-function
+            (setq entry
+                  (funcall add-log-file-name-function buffer-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))
                 (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)))))
+                  (file-name-nondirectory buffer-file-name)))
+          ;; If we have a backup file, it's presumably because we're
+          ;; comparing old and new versions (e.g. for deleted
+          ;; functions) and we'll want to use the original name.
+          (if (backup-file-name-p entry)
+              (setq entry (file-name-sans-versions entry)))))

 
 

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


@@ -371,7 +423,7 @@ non-nil, otherwise in local time."
           (goto-char (match-beginning 0))
           ;; Delete excess empty lines; make just 2.
           (while (and (not (eobp)) (looking-at "^\\s *$"))
           (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))))
+            (delete-region (point) (line-beginning-position 2)))

           (insert "\n\n")
           (forward-line -2)
           (indent-relative-maybe))
           (insert "\n\n")
           (forward-line -2)
           (indent-relative-maybe))


@@ -381,7 +433,7 @@ non-nil, otherwise in local time."
           (while (looking-at "\\sW")
             (forward-line 1))
           (while (and (not (eobp)) (looking-at "^\\s *$"))
           (while (looking-at "\\sW")
             (forward-line 1))
           (while (and (not (eobp)) (looking-at "^\\s *$"))

-            (delete-region (point) (save-excursion (forward-line 1) (point))))
+            (delete-region (point) (line-beginning-position 2)))

           (insert "\n\n\n")
           (forward-line -2)
           (indent-to left-margin)
           (insert "\n\n\n")
           (forward-line -2)
           (indent-to left-margin)


@@ -393,17 +445,19 @@ non-nil, otherwise in local time."
        (progn
          ;; Make it easy to get rid of the function name.
          (undo-boundary)
        (progn
          ;; Make it easy to get rid of the function name.
          (undo-boundary)

-         (insert (if (save-excursion
-                       (beginning-of-line 1)
-                       (looking-at "\\s *$"))
-                     ""
-                   " ")
-                 "(" defun "): "))
+         (unless (save-excursion
+                   (beginning-of-line 1)
+                   (looking-at "\\s *$"))
+           (insert ?\ ))
+         (insert "(" defun "): ")
+         (if version
+             (insert version ?\ )))

       ;; No function name, so put in a colon unless we have just a star.
       ;; No function name, so put in a colon unless we have just a star.

-      (if (not (save-excursion
-                (beginning-of-line 1)
-                (looking-at "\\s *\\(\\*\\s *\\)?$")))
-         (insert ": ")))))
+      (unless (save-excursion
+               (beginning-of-line 1)
+               (looking-at "\\s *\\(\\*\\s *\\)?$"))
+       (insert ": ")
+       (if version (insert version ?\ ))))))

 
 ;;;###autoload
 (defun add-change-log-entry-other-window (&optional whoami file-name)
 
 ;;;###autoload
 (defun add-change-log-entry-other-window (&optional whoami file-name)


@@ -494,24 +548,28 @@ Prefix arg means justify as well."
   "Return name of function definition point is in, or nil.
 
 Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
   "Return name of function definition point is in, or nil.
 
 Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),

-Texinfo (@node titles), Perl, and Fortran.
+Texinfo (@node titles) and Perl.

 
 Other modes are handled by a heuristic that looks in the 10K before
 point for uppercase headings starting in the first column or
 
 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'.
+identifiers followed by `:' or `='.  See variables
+`add-log-current-defun-header-regexp' and
+`add-log-current-defun-function'

 
 Has a preference of looking backwards."
   (condition-case nil
       (save-excursion
        (let ((location (point)))
 
 Has a preference of looking backwards."
   (condition-case nil
       (save-excursion
        (let ((location (point)))

-         (cond ((memq major-mode add-log-lisp-like-modes)
+         (cond (add-log-current-defun-function
+                (funcall add-log-current-defun-function))
+               ((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)
                 ;; 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 we are really inside the defun found,
+                ;; not after it.

                 (when (and (looking-at "\\s(")
                            (progn (end-of-defun)
                                   (< location (point)))
                 (when (and (looking-at "\\s(")
                            (progn (end-of-defun)
                                   (< location (point)))


@@ -525,9 +583,9 @@ Has a preference of looking backwards."
                   ;; The second element is usually a symbol being defined.
                   ;; If it is not, use the first symbol in it.
                   (skip-chars-forward " \t\n'(")
                   ;; 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)))))
+                  (buffer-substring-no-properties (point)
+                                                  (progn (forward-sexp 1)
+                                                         (point)))))

                ((and (memq major-mode add-log-c-like-modes)
                      (save-excursion
                        (beginning-of-line)
                ((and (memq major-mode add-log-c-like-modes)
                      (save-excursion
                        (beginning-of-line)


@@ -543,8 +601,9 @@ Has a preference of looking backwards."
                   (forward-line -1))
                 (search-forward "define")
                 (skip-chars-forward " \t")
                   (forward-line -1))
                 (search-forward "define")
                 (skip-chars-forward " \t")

-                (buffer-substring (point)
-                                  (progn (forward-sexp 1) (point))))
+                (buffer-substring-no-properties (point)
+                                                (progn (forward-sexp 1)
+                                                       (point))))

                ((memq major-mode add-log-c-like-modes)
                 (beginning-of-line)
                 ;; See if we are in the beginning part of a function,
                ((memq major-mode add-log-c-like-modes)
                 (beginning-of-line)
                 ;; See if we are in the beginning part of a function,


@@ -554,147 +613,139 @@ Has a preference of looking backwards."
                 (or (eobp)
                     (forward-char 1))
                 (beginning-of-defun)
                 (or (eobp)
                     (forward-char 1))
                 (beginning-of-defun)

-                (if (progn (end-of-defun)
-                           (< location (point)))
-                    (progn
-                      (backward-sexp 1)
-                      (let (beg tem)
-
-                        (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
-                                       (end-of-line)
-                                       (while (= (preceding-char) ?\\)
-                                         (end-of-line 2))
-                                       (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))))
-                           (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 whitespace
-                                  ;; in the name we use.
-                                  (skip-chars-backward " \t\n")
-                                  (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 "enum \\|struct \\|union \\|class ")
-                                       (setq middle (point)))
-                                  (goto-char end)
-                                  (when (eq (preceding-char) ?=)
-                                    (forward-char -1)
-                                    (skip-chars-backward " \t")
-                                    (setq end (point)))
-                                  (buffer-substring middle end)))))))))
+                (when (progn (end-of-defun)
+                             (< location (point)))
+                  (backward-sexp 1)
+                  (let (beg tem)
+
+                    (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
+                                   (end-of-line)
+                                   (while (= (preceding-char) ?\\)
+                                     (end-of-line 2))
+                                   (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-no-properties
+                           (point)
+                           (progn (forward-sexp 1)
+                                  (point))))
+                      (if (looking-at "^[+-]")
+                          (change-log-get-method-definition)
+                        ;; Ordinary C function syntax.
+                        (setq beg (point))
+                        (if (and
+                             ;; Protect against "Unbalanced parens" error.
+                             (condition-case nil
+                                 (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 whitespace
+                              ;; in the name we use.
+                              (skip-chars-backward " \t\n")
+                              (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
+                                    "enum \\|struct \\|union \\|class ")
+                                   (setq middle (point)))
+                              (goto-char end)
+                              (when (eq (preceding-char) ?=)
+                                (forward-char -1)
+                                (skip-chars-backward " \t")
+                                (setq end (point)))
+                              (buffer-substring-no-properties
+                               middle end))))))))

                ((memq major-mode add-log-tex-like-modes)
                 (if (re-search-backward
                ((memq major-mode add-log-tex-like-modes)
                 (if (re-search-backward

-                     "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
+                     "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)"
+                     nil t)

                     (progn
                       (goto-char (match-beginning 0))
                     (progn
                       (goto-char (match-beginning 0))

-                      (buffer-substring (1+ (point));; without initial backslash
-                                        (progn
-                                          (end-of-line)
-                                          (point))))))
+                      (buffer-substring-no-properties
+                       (1+ (point))    ; without initial backslash
+                       (line-end-position)))))

                ((eq major-mode 'texinfo-mode)
                 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
                ((eq major-mode 'texinfo-mode)
                 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)

-                    (buffer-substring (match-beginning 1)
-                                      (match-end 1))))
+                    (match-string-no-properties 1)))

                ((eq major-mode 'perl-mode)
                 (if (re-search-backward "^sub[ \t]+\\([^ \t\n]+\\)" nil t)
                ((eq major-mode 'perl-mode)
                 (if (re-search-backward "^sub[ \t]+\\([^ \t\n]+\\)" nil t)

-                    (buffer-substring (match-beginning 1)
-                                      (match-end 1))))
-                ((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
-                        "^[ \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")))
+                    (match-string-no-properties 1)))
+               ;; Emacs's autoconf-mode installs its own
+               ;; `add-log-current-defun-function'.  This applies to
+               ;; a different mode apparently for editing .m4
+               ;; autoconf source.
+                ((eq major-mode 'autoconf-mode)
+                 (if (re-search-backward
+                     "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t)
+                     (match-string-no-properties 3)))

                (t
                 ;; If all else fails, try heuristics
                (t
                 ;; If all else fails, try heuristics

-                (let (case-fold-search)
+                (let (case-fold-search
+                      result)

                   (end-of-line)
                   (end-of-line)

-                  (if (re-search-backward add-log-current-defun-header-regexp
-                                          (- (point) 10000)
-                                          t)
-                      (buffer-substring (match-beginning 1)
-                                        (match-end 1))))))))
+                  (when (re-search-backward
+                         add-log-current-defun-header-regexp
+                         (- (point) 10000)
+                         t)
+                    (setq result (or (match-string-no-properties 1)
+                                     (match-string-no-properties 0)))
+                    ;; Strip whitespace away
+                    (when (string-match "\\([^ \t\n\r\f].*[^ \t\n\r\f]\\)"
+                                        result)
+                      (setq result (match-string-no-properties 1 result)))
+                    result))))))

     (error nil)))
 
 (defvar change-log-get-method-definition-md)
     (error nil)))
 
 (defvar change-log-get-method-definition-md)


@@ -705,12 +756,12 @@ Has a preference of looking backwards."
 (defun change-log-get-method-definition-1 (end)
   (setq change-log-get-method-definition-md
        (concat change-log-get-method-definition-md
 (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))
+               (match-string 1)

                end))
   (goto-char (match-end 0)))
 
                end))
   (goto-char (match-end 0)))
 

-;; For objective C, return the method name if we are in a method.

 (defun change-log-get-method-definition ()
 (defun change-log-get-method-definition ()

+"For objective C, return the method name if we are in a method."

   (let ((change-log-get-method-definition-md "["))
     (save-excursion
       (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t)
   (let ((change-log-get-method-definition-md "["))
     (save-excursion
       (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t)


@@ -724,7 +775,65 @@ Has a preference of looking backwards."
           "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
          (change-log-get-method-definition-1 ""))
        (concat change-log-get-method-definition-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 "]"))))))

+\f
+(defun change-log-sortable-date-at ()
+  "Return date of log entry in a consistent form for sorting.
+Point is assumed to be at the start of the entry."
+  (require 'timezone)
+  (if (looking-at "^\\sw.........[0-9:+ ]*")
+      (let ((date (match-string-no-properties 0)))
+       (if date
+           (if (string-match "\\(....\\)-\\(..\\)-\\(..\\)\\s-+" date)
+               (concat (match-string 1 date) (match-string 2 date)
+                       (match-string 3 date))
+             (condition-case nil
+                 (timezone-make-date-sortable date)
+               (error nil)))))
+    (error "Bad date")))

 
 

+;;;###autoload
+(defun change-log-merge (other-log)
+  "Merge the contents of ChangeLog file OTHER-LOG with this buffer.
+Both must be found in Change Log mode (since the merging depends on
+the appropriate motion commands).
+
+Entries are inserted in chronological order.
+
+Both the current and old-style time formats for entries are supported,
+so this command could be used to convert old-style logs by merging
+with an empty log."
+  (interactive "*fLog file name to merge: ")
+  (if (not (eq major-mode 'change-log-mode))
+      (error "Not in Change Log mode"))
+  (let ((other-buf (find-file-noselect other-log))
+       (buf (current-buffer))
+       date1 start end)
+    (save-excursion
+      (goto-char (point-min))
+      (set-buffer other-buf)
+      (goto-char (point-min))
+      (if (not (eq major-mode 'change-log-mode))
+         (error "%s not found in Change Log mode" other-log))
+      ;; Loop through all the entries in OTHER-LOG.
+      (while (not (eobp))
+       (setq date1 (change-log-sortable-date-at))
+       (setq start (point)
+             end (progn (forward-page) (point)))
+       ;; Look for an entry in original buffer that isn't later.
+       (with-current-buffer buf
+         (while (and (not (eobp))
+                     (string< date1 (change-log-sortable-date-at)))
+           (forward-page))
+         (if (not (eobp))
+             (insert-buffer-substring other-buf start end)
+           ;; At the end of the original buffer, insert a newline to
+           ;; separate entries and then the rest of the file being
+           ;; merged.  Move to the end of it to terminate outer loop.
+           (insert "\n")
+           (insert-buffer-substring other-buf start
+                                    (with-current-buffer other-buf
+                                      (goto-char (point-max))
+                                      (point)))))))))

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