(add-log-current-defun-function): New defvar.
[bpt/emacs.git] / lisp / add-log.el
index cca5893..2846188 100644 (file)
 (defvar change-log-default-name nil
   "*Name of a change log file for \\[add-change-log-entry].")
 
+;;;###autoload
+(defvar 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.")
+
 (defun change-log-name ()
   (or change-log-default-name
       (if (eq system-type 'vax-vms) "$CHANGE_LOG$.TXT" "ChangeLog")))
@@ -57,12 +64,8 @@ current buffer to the complete file name."
                          ;; Chase links in the source file
                          ;; and use the change log in the dir where it points.
                          (and buffer-file-name
-                              (let (temp (file buffer-file-name))
-                                (while (setq temp (file-symlink-p file))
-                                  (setq file
-                                        (expand-file-name
-                                         temp (file-name-directory file))))
-                                (file-name-directory file)))
+                              (file-name-directory
+                               (file-chase-links buffer-file-name)))
                          default-directory)))
   (if (and (eq file-name change-log-default-name)
           (assq 'change-log-default-name (buffer-local-variables)))
@@ -74,15 +77,12 @@ current buffer to the complete file name."
     ;; Chase links before visiting the file.
     ;; This makes it easier to use a single change log file
     ;; for several related directories.
-    (let (temp)
-      (while (setq temp (file-symlink-p file-name))
-       (setq file-name
-             (expand-file-name temp (file-name-directory file-name)))))
+    (setq file-name (file-chase-links file-name))
     (setq file-name (expand-file-name file-name))
     ;; Move up in the dir hierarchy till we find a change log file.
     (let ((file1 file-name)
          parent-dir)
-      (while (and (not (file-exists-p file1))
+      (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
                  (progn (setq parent-dir
                               (file-name-directory
                                (directory-file-name
@@ -93,7 +93,7 @@ current buffer to the complete file name."
        ;; Move up to the parent dir and try again.
        (setq file1 (expand-file-name (change-log-name) parent-dir)))
       ;; If we found a change log in a parent, use that.
-      (if (file-exists-p file1)
+      (if (or (get-file-buffer file1) (file-exists-p file1))
          (setq file-name file1)))
     ;; Make a local variable in this buffer so we needn't search again.
     (set (make-local-variable 'change-log-default-name) file-name)
@@ -120,7 +120,8 @@ Third arg OTHER-WINDOW non-nil means visit in other window."
         (site-name (if whoami
                        (read-input "Site name: " (system-name))
                      (system-name)))
-        (defun (add-log-current-defun))
+        (defun (funcall (or add-log-current-defun-function
+                            'add-log-current-defun)))
         paragraph-end entry)
 
     (setq file-name (find-change-log file-name))
@@ -209,9 +210,9 @@ Third arg OTHER-WINDOW non-nil means visit in other window."
 ;;;###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.
-First arg (interactive prefix) non-nil means prompt for user name and site.
-Second arg is file name of change log.
-Interactively, with a prefix argument, the file name is prompted for."
+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'."
   (interactive (if current-prefix-arg
                   (list current-prefix-arg
                         (prompt-for-change-log-name))))
@@ -220,7 +221,7 @@ Interactively, with a prefix argument, the file name is prompted for."
 
 ;;;###autoload
 (defun change-log-mode ()
-  "Major mode for editting change logs; like Indented Text Mode.
+  "Major mode for editing change logs; like Indented Text Mode.
 Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
 New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
 Each entry behaves as a paragraph, and the entries for one day as a page.
@@ -250,8 +251,8 @@ Runs `change-log-mode-hook'."
 (defun add-log-current-defun ()
   "Return name of function definition point is in, or nil.
 
-Understands Lisp, LaTeX (\"functions\" are chapters, sections, ...),
-Texinfo (@node titles), and C.
+Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
+Texinfo (@node titles), and Fortran.
 
 Other modes are handled by a heuristic that looks in the 10K before
 point for uppercase headings starting in the first column or
@@ -274,7 +275,9 @@ Has a preference of looking backwards."
                          (progn (forward-sexp -1)
                                 (>= location (point))))
                     (progn
-                      (forward-word 1)
+                      (if (looking-at "\\s(")
+                          (forward-char 1))
+                      (forward-sexp 1)
                       (skip-chars-forward " ")
                       (buffer-substring (point)
                                         (progn (forward-sexp 1) (point))))))
@@ -380,6 +383,25 @@ Has a preference of looking backwards."
                 (if (re-search-backward "^@node[ \t]+\\([^,]+\\)," nil t)
                     (buffer-substring (match-beginning 1)
                                       (match-end 1))))
+                ((eq major-mode 'fortran-mode)
+                 ;; must be inside function body for this to work
+                 (beginning-of-fortran-subprogram)
+                 (let ((case-fold-search t)) ; case-insensitive
+                   ;; search for fortran subprogram start
+                   (if (re-search-forward
+                        "^[ \t]*\\(program\\|subroutine\\|function\
+\\|[ \ta-z0-9*]*[ \t]+function\\)"
+                        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
                 ;; If all else fails, try heuristics
                 (let (case-fold-search)