(change-log-add-make-room): New function.
[bpt/emacs.git] / lisp / add-log.el
index ef0e83d..62b2ef4 100644 (file)
@@ -1,8 +1,8 @@
 ;;; 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, 1997 Free Software Foundation, Inc.
 
-;; Keywords: maint
+;; Keywords: tools
 
 ;; This file is part of GNU Emacs.
 
 
 ;;; Code:
 
-(defvar change-log-default-name nil
-  "*Name of a change log file for \\[add-change-log-entry].")
+(defgroup change-log nil
+  "Change log maintenance"
+  :group 'tools
+  :prefix "change-log-"
+  :prefix "add-log-")
 
-(defvar add-log-current-defun-function nil
+
+(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'
-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)
 
 ;;;###autoload
-(defvar add-log-full-name nil
+(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 `user-full-name' function."
+  :type '(choice (const :tag "Default" nil)
+                string)
+  :group 'change-log)
 
 ;;;###autoload
-(defvar add-log-mailing-address nil
+(defcustom add-log-mailing-address nil
   "*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, then keep changes to the same file together.
+If this variable is nil and you add log for (e.g.) two files,
+the change log entries are added cumulatively to the beginning of log.
+This is the old behaviour:
+
+    Wday Mon DD TIME YYYY
+
+       file A log2  << added this later
+       file B log1
+       File A log1
+
+But if this variable is non-nil, then same file's changes are always kept
+together.  Notice that Log2 has been appended and it is the most recent
+for file A.
+
+    Wday Mon DD TIME YYYY
+
+       file B log1
+       File A log1
+       file A log2  << Added this later"
+  :type 'boolean
+  :group 'change-log)
 
 (defvar change-log-font-lock-keywords
   '(;;
     ;; Date lines, new and old styles.
-    ("^\\sw........."
+    ("^\\sw.........[0-9: ]*"
      (0 font-lock-string-face)
-     ("[A-Z][^\n<]+" nil nil (0 font-lock-reference-face)))
+     ("\\([^<]+\\)<\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)>" nil nil
+      (1 font-lock-reference-face)
+      (2 font-lock-variable-name-face)))
     ;;
     ;; File names.
     ("^\t\\* \\([^ ,:([\n]+\\)"
@@ -59,16 +115,18 @@ This defaults to the value of `user-mail-address'.")
      ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 font-lock-function-name-face)))
     ;;
     ;; Function or variable names.
-    ("(\\([^ ,:\n]+\\)"
+    ("(\\([^) ,:\n]+\\)"
      (1 font-lock-keyword-face)
-     ("\\=, \\([^ ,:\n]+\\)" nil nil (1 font-lock-keyword-face)))
+     ("\\=, *\\([^) ,:\n]+\\)" nil nil (1 font-lock-keyword-face)))
     ;;
     ;; Conditionals.
     ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 font-lock-variable-name-face))
     ;;
-    ;; Acknowledgments.
-    ("^\t\\(From\\|Reported by\\)" 1 font-lock-comment-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
@@ -82,7 +140,7 @@ This defaults to the value of `user-mail-address'.")
 It takes the same format as the TZ argument of `set-time-zone-rule'.
 If nil, use local time.")
 
-(defun iso8601-time-zone (time)
+(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))
@@ -95,9 +153,23 @@ If nil, use local time.")
                  (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
-      (if (eq system-type 'vax-vms) 
+      (if (eq system-type 'vax-vms)
          "$CHANGE_LOG$.TXT"
        "ChangeLog")))
 
@@ -129,7 +201,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
-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
@@ -166,7 +238,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.
-           (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.
@@ -176,11 +248,26 @@ current buffer to the complete file name."
   (set (make-local-variable 'change-log-default-name) file-name)
   file-name)
 
+
+
+(defun change-log-add-make-room ()
+  "Begin a new empty change log entry at point."
+  ;; 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")
+  (forward-line -2)
+  (indent-relative-maybe)
+  )
+
 ;;;###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;
 never append to an existing entry.  Today's date is calculated according to
@@ -202,8 +289,11 @@ never append to an existing entry.  Today's date is calculated according to
              (read-input "Mailing address: " add-log-mailing-address))))
   (let ((defun (funcall (or add-log-current-defun-function
                            'add-log-current-defun)))
-       paragraph-end entry)
+       today-end
+       paragraph-end
+       entry
 
+       )
     (setq file-name (expand-file-name (find-change-log file-name)))
 
     ;; Set ENTRY to the file name to use in the new entry.
@@ -224,18 +314,7 @@ never append to an existing entry.  Today's date is calculated according to
        (change-log-mode))
     (undo-boundary)
     (goto-char (point-min))
-    (let ((new-entry (concat (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)
-                                         (iso8601-time-zone now)))
-                                    (set-time-zone-rule tz)))
-                              (format-time-string "%Y-%m-%d"))
+    (let ((new-entry (concat (funcall add-log-time-format)
                             "  " add-log-full-name
                             "  <" add-log-mailing-address ">")))
       (if (looking-at (regexp-quote new-entry))
@@ -249,11 +328,23 @@ never append to an existing entry.  Today's date is calculated according to
     (setq paragraph-end (point))
     (goto-char (point-min))
 
+    ;; Today page's end point.  Used in search boundary
+
+    (save-excursion
+      (goto-char (point-min))  ;Latest change log day
+      (forward-line 1)
+      (setq today-end
+           (if (re-search-forward "^[^ \t\n]" nil t) ;Seek to next day's hdr
+               (match-beginning 0)
+             (point-max))))            ;No next day, use point max
+
     ;; 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)))
+              (insert entry))
+          )
+
          ((and (not new-entry)
                (let (case-fold-search)
                  (re-search-forward
@@ -265,12 +356,20 @@ never append to an existing entry.  Today's date is calculated according to
           ;; Add to the existing entry for the same file.
           (re-search-forward "^\\s *$\\|^\\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))))
-          (insert "\n\n")
-          (forward-line -2)
-          (indent-relative-maybe))
+          (change-log-add-make-room)
+          )
+
+         ;;  See if there is existing entry and append to it.
+         ;;  * file.txt:
+         ;;
+         ((and add-log-keep-changes-together ;enabled ?
+               (re-search-forward (regexp-quote (concat "* " entry))
+                                  today-end t))
+          (re-search-forward "^\\s *$\\|^\\s \\*")
+          (goto-char (match-beginning 0))
+          (change-log-add-make-room)
+          )
+
          (t
           ;; Make a new entry.
           (forward-line 1)
@@ -291,7 +390,7 @@ never append to an existing entry.  Today's date is calculated according to
          (undo-boundary)
          (insert (if (save-excursion
                        (beginning-of-line 1)
-                       (looking-at "\\s *$")) 
+                       (looking-at "\\s *$"))
                      ""
                    " ")
                  "(" defun "): "))
@@ -304,7 +403,8 @@ never append to an existing entry.  Today's date is calculated according to
 ;;;###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.
+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'."
   (interactive (if current-prefix-arg
@@ -317,7 +417,7 @@ If nil, uses `change-log-default-name'."
 (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].
+New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-before-other-window].
 Each entry behaves as a paragraph, and the entries for one day as a page.
 Runs `change-log-mode-hook'."
   (interactive)
@@ -361,9 +461,26 @@ Prefix arg means justify as well."
     (fill-region beg end justify)
     t))
 \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]*[:=]"
-  "*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 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 ()
@@ -381,8 +498,7 @@ 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
-                                                   lisp-interaction-mode))
+         (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.
@@ -401,14 +517,15 @@ Has a preference of looking backwards."
                       (skip-chars-forward " '")
                       (buffer-substring (point)
                                         (progn (forward-sexp 1) (point))))))
-               ((and (memq major-mode '(c-mode c++-mode c++-c-mode objc-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]")))
+               ((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
@@ -417,7 +534,7 @@ Has a preference of looking backwards."
                 (skip-chars-forward " \t")
                 (buffer-substring (point)
                                   (progn (forward-sexp 1) (point))))
-               ((memq major-mode '(c-mode c++-mode c++-c-mode objc-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.
@@ -460,7 +577,7 @@ Has a preference of looking backwards."
                               (buffer-substring (point)
                                                 (progn (forward-sexp 1) (point))))
                            (if (looking-at "^[+-]")
-                               (get-method-definition)
+                               (change-log-get-method-definition)
                              ;; Ordinary C function syntax.
                              (setq beg (point))
                              (if (and (condition-case nil
@@ -512,10 +629,7 @@ Has a preference of looking backwards."
                                        (looking-at "struct \\|union \\|class ")
                                        (setq middle (point)))
                                   (buffer-substring middle end)))))))))
-               ((memq major-mode
-                      '(TeX-mode plain-TeX-mode LaTeX-mode;; tex-mode.el
-                                 plain-tex-mode latex-mode;; cmutex.el
-                                 ))
+               ((memq major-mode add-log-tex-like-modes)
                 (if (re-search-backward
                      "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
                     (progn
@@ -562,33 +676,33 @@ Has a preference of looking backwards."
                                         (match-end 1))))))))
     (error nil)))
 
-(defvar get-method-definition-md)
+(defvar change-log-get-method-definition-md)
 
-;; Subroutine used within get-method-definition.
+;; 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.
-(defun get-method-definition-1 (end)
-  (setq get-method-definition-md
-       (concat 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))
                end))
   (goto-char (match-end 0)))
 
 ;; For objective C, return the method name if we are in a method.
-(defun get-method-definition ()
-  (let ((get-method-definition-md "["))
+(defun change-log-get-method-definition ()
+  (let ((change-log-get-method-definition-md "["))
     (save-excursion
       (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t)
-         (get-method-definition-1 " ")))
+         (change-log-get-method-definition-1 " ")))
     (save-excursion
       (cond
        ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t)
-       (get-method-definition-1 "")
+       (change-log-get-method-definition-1 "")
        (while (not (looking-at "[{;]"))
          (looking-at
           "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
-         (get-method-definition-1 ""))
-       (concat get-method-definition-md "]"))))))
+         (change-log-get-method-definition-1 ""))
+       (concat change-log-get-method-definition-md "]"))))))
 
 
 (provide 'add-log)