]> code.delx.au - gnu-emacs/blobdiff - lisp/add-log.el
Initial revision
[gnu-emacs] / lisp / add-log.el
index f2c279ae3571336d5ed79788166afef2d61060ce..1277fd7e7b34478556f05e3fefdc56d8cc6328e5 100644 (file)
@@ -1,12 +1,14 @@
 ;;; add-log.el --- change log maintenance commands for Emacs
 
-;; Copyright (C) 1985-1991 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1988, 1993 Free Software Foundation, Inc.
+
+;; Keywords: maint
 
 ;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 1, or (at your option)
+;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; 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
 (defvar change-log-default-name nil
      (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.
@@ -54,40 +112,92 @@ Third arg OTHER-WINDOW non-nil means visit in other window."
                       (user-login-name)))
         (site-name (if whoami
                        (read-input "Site name: " (system-name))
-                     (system-name))))
-    (or file-name
-       (setq file-name (or change-log-default-name
-                           default-directory)))
-    (if (file-directory-p file-name)
-       (setq file-name (concat (file-name-as-directory file-name)
-                               (change-log-name))))
-    (set (make-local-variable 'change-log-default-name) file-name)
+                     (system-name)))
+        (defun (add-log-current-defun))
+        paragraph-end entry)
+
+    (setq file-name (find-change-log file-name))
+
+    ;; Set ENTRY to the file name to use in the new entry.
+    (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 (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))))
+
     (if (and other-window (not (equal file-name buffer-file-name)))
        (find-file-other-window file-name)
       (find-file file-name))
     (undo-boundary)
     (goto-char (point-min))
-    (if (not (and (looking-at (substring (current-time-string) 0 10))
-                 (looking-at (concat ".* " full-name "  (" login-name "@"))))
-       (progn (insert (current-time-string)
-                      "  " full-name
-                      "  (" login-name
-                      "@" site-name ")\n\n")))
+    (if (looking-at (concat (regexp-quote (substring (current-time-string)
+                                                    0 10))
+                           ".* " (regexp-quote full-name)
+                           "  (" (regexp-quote login-name) "@"))
+       (forward-line 1)
+      (insert (current-time-string)
+             "  " full-name
+             "  (" login-name "@" site-name ")\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))
     (goto-char (point-min))
-    (forward-line 1)
-    (while (looking-at "\\sW")
-      (forward-line 1))
-    (delete-region (point)
-                  (progn
-                    (skip-chars-backward "\n")
-                    (point)))
-    (open-line 3)
-    (forward-line 2)
-    (indent-to left-margin)
-    (insert "* ")))
 
-;;;###autoload
-(define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
+    ;; Now insert the new line for this entry.
+    (cond ((re-search-forward "^\\s *\\*\\s *$" paragraph-end t)
+          ;; Put this file name into the existing empty entry.
+          (if entry
+              (insert entry)))
+         ((and (re-search-forward
+                (concat (regexp-quote (concat "* " entry))
+                        ;; Don't accept `foo.bar' when
+                        ;; looking for `foo':
+                        "\\(\\s \\|[(),:]\\)")
+                paragraph-end t))
+          ;; Add to the existing entry for the same file.
+          (re-search-forward "^\\s *$\\|^\\s \\*")
+          (beginning-of-line)
+          (while (and (not (eobp)) (looking-at "^\\s *$"))
+            (delete-region (point) (save-excursion (forward-line 1) (point))))
+          (insert "\n\n")
+          (forward-line -2)
+          (indent-relative-maybe))
+         (t
+          ;; Make a new entry.
+          (forward-line 1)
+          (while (looking-at "\\sW")
+            (forward-line 1))
+          (while (and (not (eobp)) (looking-at "^\\s *$"))
+            (delete-region (point) (save-excursion (forward-line 1) (point))))
+          (insert "\n\n\n")
+          (forward-line -2)
+          (indent-to left-margin)
+          (insert "* " (or entry ""))))
+    ;; Now insert the function name, if we have one.
+    ;; Point is at the entry for this file,
+    ;; either at the end of the line or at the first blank line.
+    (if defun
+       (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 "): "))
+      ;; 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 ": ")))))
 
 ;;;###autoload
 (defun add-change-log-entry-other-window (&optional whoami file-name)
@@ -99,5 +209,203 @@ Interactively, with a prefix argument, the file name is prompted for."
                   (list current-prefix-arg
                         (prompt-for-change-log-name))))
   (add-change-log-entry whoami file-name t))
+;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
+
+;;;###autoload
+(defun change-log-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.
+Runs `change-log-mode-hook'."
+  (interactive)
+  (kill-all-local-variables)
+  (indented-text-mode)
+  (setq major-mode 'change-log-mode
+       mode-name "Change Log"
+       left-margin 8
+       fill-column 74)
+  ;; Let each entry behave as one paragraph:
+  (set (make-local-variable 'paragraph-start) "^\\s *$\\|^^L")
+  (set (make-local-variable 'paragraph-separate) "^\\s *$\\|^^L\\|^\\sw")
+  ;; Let all entries for one day behave as one page.
+  ;; Match null string on the date-line so that the date-line
+  ;; is grouped with what follows.
+  (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
+  (set (make-local-variable 'version-control) 'never)
+  (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
+  (run-hooks 'change-log-mode-hook))
+
+(defvar add-log-current-defun-header-regexp
+  "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[a-z_---A-Z]+\\)[ \t]*[:=]"
+  "*Heuristic regexp used by `add-log-current-defun' for unknown major modes.")
+
+(defun add-log-current-defun ()
+  "Return name of function definition point is in, or nil.
+
+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
+identifiers followed by `:' or `=', see variable
+`add-log-current-defun-header-regexp'.
+
+Has a preference of looking backwards."
+  (condition-case nil
+      (save-excursion
+       (let ((location (point)))
+         (cond ((memq major-mode '(emacs-lisp-mode lisp-mode scheme-mode))
+                ;; If we are now precisely a 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.
+                (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))
+                     (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
+                  (forward-line -1))
+                (search-forward "define")
+                (skip-chars-forward " \t")
+                (buffer-substring (point)
+                                  (progn (forward-sexp 1) (point))))
+               ((memq major-mode '(c-mode 'c++-mode))
+                (beginning-of-line)
+                ;; See if we are in the beginning part of a function,
+                ;; before the open brace.  If so, advance forward.
+                (while (not (looking-at "{\\|\\(\\s *$\\)"))
+                  (forward-line 1))
+                (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
+                                       (forward-line 1)
+                                       (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))))
+                          ;; 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 (re-search-backward
+                     "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
+                    (progn
+                      (goto-char (match-beginning 0))
+                      (buffer-substring (1+ (point));; without initial backslash
+                                        (progn
+                                          (end-of-line)
+                                          (point))))))
+               ((eq major-mode 'texinfo-mode)
+                (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)
+                  (end-of-line)
+                  (if (re-search-backward add-log-current-defun-header-regexp
+                                          (- (point) 10000)
+                                          t)
+                      (buffer-substring (match-beginning 1)
+                                        (match-end 1))))))))
+    (error nil)))
+
+
+(provide 'add-log)
 
 ;;; add-log.el ends here