]> code.delx.au - gnu-emacs/blobdiff - lisp/add-log.el
Initial revision
[gnu-emacs] / lisp / add-log.el
index 0f4cc97347b80b4152bbf5373506307228daa913..1277fd7e7b34478556f05e3fefdc56d8cc6328e5 100644 (file)
@@ -1,7 +1,8 @@
 ;;; add-log.el --- change log maintenance commands for Emacs
 
-;; Copyright (C) 1985, 86, 87, 88, 89, 90, 91, 1992
-;;     Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1988, 1993 Free Software Foundation, Inc.
+
+;; Keywords: maint
 
 ;; This file is part of GNU Emacs.
 
 ;; along with GNU Emacs; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
+;;; Commentary:
+
+;; This facility is documented in the Emacs Manual.
+
 ;;; Code:
 
 ;;;###autoload
      (read-file-name (format "Log file (default %s): " default)
                     nil default))))
 
+;;;###autoload
+(defun find-change-log (&optional file-name)
+  "Find a change log file for \\[add-change-log-entry] and return the name.
+Optional arg FILE-NAME is a name to try first.
+If FILE-NAME is nil, use the value of `change-log-default-name' if non-nil.
+Failing that, use \"ChangeLog\" in the current directory.
+If the file does not exist in the named directory, successive parent
+directories are tried.
+
+Once a file is found, `change-log-default-name' is set locally in the
+current buffer to the complete file name."
+  (or file-name
+      (setq file-name (or change-log-default-name
+                         ;; Chase links in the source file
+                         ;; and use the change log in the dir where it points.
+                         (and buffer-file-name
+                              (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)))
+      ;; Don't do the searching if we already have a buffer-local value.
+      file-name
+
+    (if (file-directory-p file-name)
+       (setq file-name (expand-file-name (change-log-name) file-name)))
+    ;; Chase links before visiting the file.
+    ;; This makes it easier to use a single change log file
+    ;; for several related directories.
+    (setq file-name (file-chase-links file-name))
+    (setq file-name (expand-file-name file-name))
+    ;; Move up in the dir hierarchy till we find a change log file.
+    (let ((file1 file-name)
+         parent-dir)
+      (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
+                 (progn (setq parent-dir
+                              (file-name-directory
+                               (directory-file-name
+                                (file-name-directory file1))))
+                        ;; Give up if we are already at the root dir.
+                        (not (string= (file-name-directory file1)
+                                      parent-dir))))
+       ;; Move up to the parent dir and try again.
+       (setq file1 (expand-file-name (change-log-name) parent-dir)))
+      ;; If we found a change log in a parent, use that.
+      (if (or (get-file-buffer file1) (file-exists-p file1))
+         (setq file-name file1)))
+    ;; Make a local variable in this buffer so we needn't search again.
+    (set (make-local-variable 'change-log-default-name) file-name)
+    file-name))
+
 ;;;###autoload
 (defun add-change-log-entry (&optional whoami file-name other-window)
   "Find change log file and add an entry for today.
@@ -59,34 +115,8 @@ Third arg OTHER-WINDOW non-nil means visit in other window."
                      (system-name)))
         (defun (add-log-current-defun))
         paragraph-end entry)
-    (or file-name
-       (setq file-name (or change-log-default-name
-                           default-directory)))
-    (setq file-name (if (file-directory-p file-name)
-                       (expand-file-name (change-log-name) file-name)
-                     (expand-file-name file-name)))
-    ;; Chase links before visiting the file.
-    ;; This makes it easier to use a single change log file
-    ;; for several related directories.
-    (setq file-name
-         (expand-file-name (or (file-symlink-p 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))
-                 (progn (setq parent-dir
-                              (file-name-directory
-                               (directory-file-name
-                                (file-name-directory file1))))
-                        ;; Give up if we are already at the root dir.
-                        (not (string= (file-name-directory file1) parent-dir))))
-       ;; Move up to the parent dir and try again.
-       (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)
-         (setq file-name file1)))
 
-    (set (make-local-variable 'change-log-default-name) file-name)
+    (setq file-name (find-change-log file-name))
 
     ;; Set ENTRY to the file name to use in the new entry.
     (and buffer-file-name
@@ -104,22 +134,21 @@ Third arg OTHER-WINDOW non-nil means visit in other window."
       (find-file file-name))
     (undo-boundary)
     (goto-char (point-min))
-    (or (looking-at (concat (regexp-quote (substring (current-time-string)
+    (if (looking-at (concat (regexp-quote (substring (current-time-string)
                                                     0 10))
                            ".* " (regexp-quote full-name)
                            "  (" (regexp-quote login-name) "@"))
-       (insert (current-time-string)
-               "  " full-name
-               "  (" login-name "@" site-name ")\n\n"))
+       (forward-line 1)
+      (insert (current-time-string)
+             "  " full-name
+             "  (" login-name "@" site-name ")\n\n"))
 
-    ;; Search only within the first paragraph of the first page.
-    (forward-paragraph 1)
+    ;; Search only within the first paragraph.
+    (if (looking-at "\n*[^\n* \t]")
+       (skip-chars-forward "\n")
+      (forward-paragraph 1))
     (setq paragraph-end (point))
     (goto-char (point-min))
-    (forward-page 1)
-    (if (< (point) paragraph-end)
-       (setq paragraph-end (point)))
-    (goto-char (point-min))
 
     ;; Now insert the new line for this entry.
     (cond ((re-search-forward "^\\s *\\*\\s *$" paragraph-end t)
@@ -184,7 +213,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.
@@ -214,8 +243,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
@@ -238,7 +267,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))))))
@@ -344,6 +375,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)