;; add-log.el - Improved change log maintenance commands for Emacs
;; Copyright (C) 1985, 1991 Free Software Foundation, Inc.

(defconst add-log-version (substring "$Revision: 1.13 $" 11 -2)
  "$Id: add-log.el,v 1.13 1991/12/20 17:02:37 sk Exp $")

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

;; LISPDIR ENTRY for the Elisp Archive ===============================
;;    LCD Archive Entry:
;;    add-log|Sebastian Kremer|sk@thp.uni-koeln.de
;;    |Improved change log maintenance commands for Emacs
;;    |$Date: 1991/12/20 17:02:37 $|$Revision: 1.13 $|

;; OVERVIEW ==========================================================

;; Modified from Emacs 18.55 for the GNU coding standards and my
;; rcs.el.  (It doesn't hurt if you don't have the latter.)  The
;; advantage over the old version is that it automatically adds the
;; filename, the current defun and the RCS level to the entry, like
;; this:

;; 	* gmhist-app.el,v 4.8
;; 	(gmhist-execute-extended-command-space):

;; You just have to enter the descriptive text, everything else is
;; already there.  If the guessed defun is not appropriate, C-w will
;; wipe it out.

;; All the entries for one day make up a page (use `C-x [' and `C-x ]'
;; to move to next day), each entry for one file is a separate paragraph
;; (use `M-[' and `M-]' to move by entries and `ESC h' to mark an entry).

;; INSTALLATION ======================================================
;; 
;; Put this file in a directory in front of your load-path so that it
;; will be loaded instead of the standard add-log.el.


;;;###autoload (define-key ctl-x-map "a" 'add-change-log-entry)
;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)

;;;###autoload
(defvar add-change-log-entry-rcs-format ",v %s"	; " [%s]" is also nice
  "*Format used by `add-change-log-entry' to insert RCS revision levels.

Besides a format string, it can also be a function of zero arguments
to return the formatted revision level of the current buffer's file or
nil.  This can be used to hook in arbitrary RCS packages.

If it is a string, it is assumed you are using sk's rcs.el (but it
doesn't hurt if you don't, you just don't get any revision levels
inserted.)")

;;;###autoload
(defun add-change-log-entry (whoami &optional file-name other-window)
  ;; The docstring is carefully formatted to look good with C-h f
  "Find change log file and add an entry for current day, file and defun.

First arg (interactive prefix) non-nil means prompt for user, site and
log file.

If there is an empty entry (just a `*') it is used and filled in with
the current filename and defun.  Else, if there is an entry of today
for the same file, it is used and a new line for the current defun is
added at the beginning.  Else, a new entry is created.

Thus you can force using a new entry by first creating an empty entry
with \\[add-change-log-entry] from the ChangeLog buffer itself, even if there is already
an entry from today for the current file.  This is useful if you check
in two RCS revisions on the same day.

If the guessed defun was wrong, use \\[kill-region] to wipe it out.  See also
function `add-log-current-defun'.

The ChangeLog is set up so that entries are paragraphs and days are
pages.  Use \\[backward-paragraph] and \\[forward-paragraph] to move to entries, and \\[backward-page] and \\[forward-page] to
move to different days.

When called from a lisp, second arg is file name of change log.
Optional third arg OTHER-WINDOW non-nil means visit in other window."
  (interactive "P")
  (let* ((default (if (eq system-type 'vax-vms)
			   "$CHANGE_LOG$.TXT"
			 "ChangeLog"))
	 (full-name (if whoami
			(read-string "Full name: " (user-full-name))
		      (user-full-name)))
	 ;; Note that some sites have room and phone number fields in
	 ;; full name which look silly when inserted.  Rather than do
	 ;; anything about that here, let user give prefix argument so that
	 ;; s/he can edit the full name field in prompter if s/he wants.
	 (login-name (if whoami
			 (read-string "Login name: " (user-login-name))
		       (user-login-name)))
	 (site-name (if whoami
			(read-string "Site name: " (system-name))
		      (system-name)))
	 (revision (and (boundp 'rcs-mode-string)
			rcs-mode-string
			;; Find out the RCS level, assuming sk's rcs.el
			(let ((pos (string-match ":" rcs-mode-string)))
			  (and pos
			       (substring rcs-mode-string (1+ pos))))))
	 (formatted-revision
	  (if (not (stringp add-change-log-entry-rcs-format))
	      ;; Assume it is a function.  Call it even if REVISION is
	      ;; nil so that it can be used to hook in other rcs packages.
	      (funcall add-change-log-entry-rcs-format)
	    (and revision
		 (format add-change-log-entry-rcs-format revision))))
	 (defun (add-log-current-defun))
	 (entry (and buffer-file-name
		     (file-name-nondirectory buffer-file-name)))
	 entry-position entry-boundary empty-entry)
    ;; Never want to add a change log entry for the ChangeLog buffer itself:
    (if (equal default entry)
	(setq entry nil
	      formatted-revision nil
	      defun nil))
    (if whoami
	(setq file-name
	      (expand-file-name
	       (read-file-name
		(format "Log file (default %s): " default) nil default))))
    (or file-name
	(setq file-name default-directory))
    (if (file-directory-p file-name)
	(setq file-name (concat (file-name-as-directory file-name) default)))
    (if other-window
	(find-file-other-window file-name)
      (find-file file-name))
    (or (eq major-mode 'indented-text-mode)
	(indented-text-mode))
    ;; Must always set the following variables as being in
    ;; indented-text-mode does not guarantee those are set (it may be
    ;; the default-major-mode).
    (setq left-margin 8
	  fill-column 74)
    ;; Let each entry behave as one paragraph:
    (set (make-local-variable 'paragraph-start) "^$\\|^^L")
    (set (make-local-variable 'paragraph-separate) "^$\\|^^L")
    ;; Let all entries for one day behave as one page.
    ;; Note that a page boundary is also a paragraph boundary.
    ;; Unfortunately the date line of a page actually belongs to
    ;; the next day, but I don't see how to avoid that since
    ;; page moving cmds go to the end of the match, and Emacs
    ;; regexps don't have a context feature.
    (set (make-local-variable 'page-delimiter) "^[A-Z][a-z][a-z] .*\n\\|^")
    (auto-fill-mode 1)
    (undo-boundary)
    (goto-char (point-min))
    ;; Insert today's headerline, if not already present:
    (if (not (and (looking-at (substring (current-time-string) 0 10))
		  (save-excursion (re-search-forward "(.* at")
				  (skip-chars-backward "^(")
				  (looking-at login-name))))
	(progn (insert (current-time-string)
		       "  " full-name
		       "  (" login-name
		       " at " site-name ")\n\n")))
    (goto-char (point-min))
    (setq empty-entry
	  (and (search-forward "\n\t* \n" nil t)
	       (1- (point))))
    (if (and entry
	     (not empty-entry))
	;; Look for today's entry for same file
	;; Requiring the revision to match is no good because users
	;; may ci before or after doing the change log.
	;; If there is an empty entry (just a `*'), take the hint and
	;; use it.  This is so that C-x a from the ChangeLog buffer
	;; itself can be used to force the next entry to be added at
	;; the beginning, even if there are today's entries for the
	;; same file (but perhaps different revisions).
	(setq entry-boundary (save-excursion
			       (and (re-search-forward "\n[A-Z]" nil t)
				    (point)))
	      entry-position (save-excursion
			       (and (re-search-forward
				     (concat
				      (regexp-quote (concat "* " entry))
				      ;; don't accept `foo.bar' when
				      ;; looking for `foo':
				      "[ \n\t,]")
				     entry-boundary
				     t)
				    (1- (match-end 0))))))
    (cond ( empty-entry
	    (goto-char empty-entry)
	    (insert (or entry "") (or formatted-revision "")) )
	  ( entry-position
	    ;; just move to existing entry for same file
	    (goto-char entry-position)
	    ;; Add rcs revision level if not already something there
	    (if (eolp)
		(insert (or formatted-revision "")))
	    (end-of-line))
	  ( t
	    ;; else make a new entry
	    (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 "* " (or entry "") (or formatted-revision ""))))
    ;; By now, there is an entry and maybe an RCS level inserted.
    ;; Point is at the end of the entry (`*' line).
    (if defun
	(progn
	  (newline-and-indent);; each entry starts on a separate line
	  ;; Note that the GNU coding standard gives examples where
	  ;; the first defun is on the same line as the filename, but
	  ;; I think it is irritating.
	  (push-mark);; so it is easy to delete if DEFUN was the wrong guess
	  ;; This is the format endorsed by the GNU coding standards:
	  (insert "(" defun "): ")))))

;;;###autoload
(defun add-change-log-entry-other-window (&optional arg)
  "Like `add-change-log-entry', but in other window."
  (interactive "P")
  (add-change-log-entry arg default-directory t))

;;;###autoload
(defvar add-log-current-defun-header-regexp
  "^\\([A-Z][A-Z_ ]+\\|[a-z_---A-Z]+\\)[ \t]*[:=]"
  "*Heuristic regexp used by `add-log-current-defun' for unknown major modes.")

;;;###autoload
(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.

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."
  (save-excursion
    (cond ((memq major-mode '(emacs-lisp-mode lisp-mode))
	   (beginning-of-defun)
	   (forward-word 1)
	   (skip-chars-forward " ")
	   (buffer-substring (point)
			     (progn (forward-sexp 1) (point))))
	  ((eq major-mode 'c-mode)
	   ;; must be inside function body for this to work
	   (beginning-of-defun)
	   (forward-line -1)
	   (while (looking-at "[ \t\n]") ; skip typedefs of arglist
	     (forward-line -1))
	   (down-list 1)		; into arglist
	   (backward-up-list 1)
	   (skip-chars-backward " \t")
	   (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))))
	  (t
	   ;; If all else fails, try heuristics
	   (let (case-fold-search)
	     (if (re-search-backward add-log-current-defun-header-regexp
				     (- (point) 10000)
				     t)
		 (buffer-substring (match-beginning 1)
				   (match-end 1))))))))