code.delx.au - gnu-emacs/blob - lisp/add-log.el

   1 ;;; add-log.el --- change log maintenance commands for Emacs
   2
   3 ;; Copyright (C) 1985, 86, 87, 88, 89, 90, 91, 1992
   4 ;;      Free Software Foundation, Inc.
   5
   6 ;; This file is part of GNU Emacs.
   7
   8 ;; GNU Emacs is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  20 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21
  22 ;;; Code:
  23
  24 ;;;###autoload
  25 (defvar change-log-default-name nil
  26   "*Name of a change log file for \\[add-change-log-entry].")
  27
  28 (defun change-log-name ()
  29   (or change-log-default-name
  30       (if (eq system-type 'vax-vms) "$CHANGE_LOG$.TXT" "ChangeLog")))
  31
  32 (defun prompt-for-change-log-name ()
  33   "Prompt for a change log name."
  34   (let ((default (change-log-name)))
  35     (expand-file-name
  36      (read-file-name (format "Log file (default %s): " default)
  37                      nil default))))
  38
  39 ;;;###autoload
  40 (defun add-change-log-entry (&optional whoami file-name other-window)
  41   "Find change log file and add an entry for today.
  42 Optional arg (interactive prefix) non-nil means prompt for user name and site.
  43 Second arg is file name of change log.  If nil, uses `change-log-default-name'.
  44 Third arg OTHER-WINDOW non-nil means visit in other window."
  45   (interactive (list current-prefix-arg
  46                      (prompt-for-change-log-name)))
  47   (let* ((full-name (if whoami
  48                         (read-input "Full name: " (user-full-name))
  49                       (user-full-name)))
  50          ;; Note that some sites have room and phone number fields in
  51          ;; full name which look silly when inserted.  Rather than do
  52          ;; anything about that here, let user give prefix argument so that
  53          ;; s/he can edit the full name field in prompter if s/he wants.
  54          (login-name (if whoami
  55                          (read-input "Login name: " (user-login-name))
  56                        (user-login-name)))
  57          (site-name (if whoami
  58                         (read-input "Site name: " (system-name))
  59                       (system-name)))
  60          (defun (add-log-current-defun))
  61          entry entry-position empty-entry)
  62     (or file-name
  63         (setq file-name (or change-log-default-name
  64                             default-directory)))
  65     (setq file-name (if (file-directory-p file-name)
  66                         (expand-file-name (change-log-name) file-name)
  67                       (expand-file-name file-name)))
  68     ;; Chase links before visiting the file.
  69     ;; This makes it easier to use a single change log file
  70     ;; for several related directories.
  71     (setq file-name
  72           (expand-file-name (or (file-symlink-p file-name) file-name)))
  73     (set (make-local-variable 'change-log-default-name) file-name)
  74     (if buffer-file-name
  75         (setq entry (if (string-match
  76                          (concat "^" (regexp-quote (file-name-directory
  77                                                     file-name)))
  78                          buffer-file-name)
  79                         (substring buffer-file-name (match-end 0))
  80                       (file-name-nondirectory buffer-file-name))))
  81     ;; Never want to add a change log entry for the ChangeLog file itself.
  82     (if (equal entry "ChangeLog")
  83         (setq entry nil
  84               defun nil))
  85     (if (and other-window (not (equal file-name buffer-file-name)))
  86         (find-file-other-window file-name)
  87       (find-file file-name))
  88     (undo-boundary)
  89     (goto-char (point-min))
  90     (or (looking-at (concat (substring (current-time-string) 0 10)
  91                                  ".* " full-name "  (" login-name "@"))
  92         (insert (current-time-string)
  93                 "  " full-name
  94                 "  (" login-name
  95                 "@" site-name ")\n\n"))
  96     (goto-char (point-min))
  97     (setq empty-entry
  98           (and (search-forward "\n\t* \n" nil t)
  99                (1- (point))))
 100     (if (and entry
 101              (not empty-entry))
 102         ;; Look for today's entry for the same file.
 103         ;; If there is an empty entry (just a `*'), take the hint and
 104         ;; use it.  This is so that C-x a from the ChangeLog buffer
 105         ;; itself can be used to force the next entry to be added at
 106         ;; the beginning, even if there are today's entries for the
 107         ;; same file (but perhaps different revisions).
 108         (let ((entry-boundary (save-excursion
 109                                 (and (re-search-forward "\n[A-Z]" nil t)
 110                                      (point)))))
 111           (setq entry-position (save-excursion
 112                                  (and (re-search-forward
 113                                        (concat
 114                                         (regexp-quote (concat "* " entry))
 115                                         ;; don't accept `foo.bar' when
 116                                         ;; looking for `foo':
 117                                         "[ \n\t,:]")
 118                                        entry-boundary
 119                                        t)
 120                                       (1- (match-end 0)))))))
 121     ;; Now insert the new line for this entry.
 122     (cond (entry-position
 123            ;; Move to the existing entry for the same file.
 124            (goto-char entry-position)
 125            (re-search-forward "^\\s *$")
 126            (beginning-of-line)
 127            (while (and (not (eobp)) (looking-at "^\\s *$"))
 128              (delete-region (point) (save-excursion (forward-line 1) (point))))
 129            (insert "\n\n")
 130            (forward-line -2)
 131            (indent-relative-maybe))
 132           (empty-entry
 133            ;; Put this file name into the existing empty entry.
 134            (goto-char empty-entry)
 135            (if entry
 136                (insert entry)))
 137           (t
 138            ;; Make a new entry.
 139            (forward-line 1)
 140            (while (looking-at "\\sW")
 141              (forward-line 1))
 142            (while (and (not (eobp)) (looking-at "^\\s *$"))
 143              (delete-region (point) (save-excursion (forward-line 1) (point))))
 144            (insert "\n\n\n")
 145            (forward-line -2)
 146            (indent-to left-margin)
 147            (insert "* " (or entry ""))))
 148     ;; Now insert the function name, if we have one.
 149     ;; Point is at the entry for this file,
 150     ;; either at the end of the line or at the first blank line.
 151     (if defun
 152         (progn
 153           ;; Make it easy to get rid of the function name.
 154           (undo-boundary)
 155           (insert (if (save-excursion
 156                         (beginning-of-line 1)
 157                         (looking-at "\\s *$"))
 158                       ""
 159                     " ")
 160                   "(" defun "): "))
 161       ;; No function name, so put in a colon unless we have just a star.
 162       (if (not (save-excursion
 163                  (beginning-of-line 1)
 164                  (looking-at "\\s *\\(\\*\\s *\\)?$")))
 165           (insert ": ")))))
 166
 167 ;;;###autoload
 168 (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
 169
 170 ;;;###autoload
 171 (defun add-change-log-entry-other-window (&optional whoami file-name)
 172   "Find change log file in other window and add an entry for today.
 173 First arg (interactive prefix) non-nil means prompt for user name and site.
 174 Second arg is file name of change log.
 175 Interactively, with a prefix argument, the file name is prompted for."
 176   (interactive (if current-prefix-arg
 177                    (list current-prefix-arg
 178                          (prompt-for-change-log-name))))
 179   (add-change-log-entry whoami file-name t))
 180
 181 ;;;###autoload
 182 (defun change-log-mode ()
 183   "Major mode for editting change logs; like Indented Text Mode.
 184 Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
 185 New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
 186 Each entry behaves as a paragraph, and the entries for one day as a page.
 187 Runs `change-log-mode-hook'."
 188   (interactive)
 189   (kill-all-local-variables)
 190   (indented-text-mode)
 191   (setq major-mode 'change-log-mode)
 192   (setq mode-name "Change Log")
 193   (setq left-margin 8)
 194   (setq fill-column 74)
 195   ;; Let each entry behave as one paragraph:
 196   (set (make-local-variable 'paragraph-start) "^\\s *$\\|^^L")
 197   (set (make-local-variable 'paragraph-separate) "^\\s *$\\|^^L\\|^\\sw")
 198   ;; Let all entries for one day behave as one page.
 199   ;; Match null string on the date-line so that the date-line
 200   ;; is grouped with what follows.
 201   (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
 202   (set (make-local-variable 'version-control) 'never)
 203   (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
 204   (run-hooks 'change-log-mode-hook))
 205
 206 (defvar add-log-current-defun-header-regexp
 207   "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[a-z_---A-Z]+\\)[ \t]*[:=]"
 208   "*Heuristic regexp used by `add-log-current-defun' for unknown major modes.")
 209
 210 (defun add-log-current-defun ()
 211   "Return name of function definition point is in, or nil.
 212
 213 Understands Lisp, LaTeX (\"functions\" are chapters, sections, ...),
 214 Texinfo (@node titles), and C.
 215
 216 Other modes are handled by a heuristic that looks in the 10K before
 217 point for uppercase headings starting in the first column or
 218 identifiers followed by `:' or `=', see variable
 219 `add-log-current-defun-header-regexp'.
 220
 221 Has a preference of looking backwards."
 222   (condition-case nil
 223       (save-excursion
 224         (let ((location (point)))
 225           (cond ((memq major-mode '(emacs-lisp-mode lisp-mode scheme-mode))
 226                  ;; If we are now precisely a the beginning of a defun,
 227                  ;; make sure beginning-of-defun finds that one
 228                  ;; rather than the previous one.
 229                  (or (eobp) (forward-char 1))
 230                  (beginning-of-defun)
 231                  ;; Make sure we are really inside the defun found, not after it.
 232                  (if (and (progn (end-of-defun)
 233                                  (< location (point)))
 234                           (progn (forward-sexp -1)
 235                                  (>= location (point))))
 236                      (progn
 237                        (forward-word 1)
 238                        (skip-chars-forward " ")
 239                        (buffer-substring (point)
 240                                          (progn (forward-sexp 1) (point))))))
 241                 ((and (memq major-mode '(c-mode 'c++-mode))
 242                       (save-excursion (beginning-of-line)
 243                                       ;; Use eq instead of = here to avoid
 244                                       ;; error when at bob and char-after
 245                                       ;; returns nil.
 246                                       (while (eq (char-after (- (point) 2)) ?\\)
 247                                         (forward-line -1))
 248                                       (looking-at "[ \t]*#[ \t]*define[ \t]")))
 249                  ;; Handle a C macro definition.
 250                  (beginning-of-line)
 251                  (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
 252                    (forward-line -1))
 253                  (search-forward "define")
 254                  (skip-chars-forward " \t")
 255                  (buffer-substring (point)
 256                                    (progn (forward-sexp 1) (point))))
 257                 ((memq major-mode '(c-mode 'c++-mode))
 258                  (beginning-of-line)
 259                  ;; See if we are in the beginning part of a function,
 260                  ;; before the open brace.  If so, advance forward.
 261                  (while (not (looking-at "{\\|\\(\\s *$\\)"))
 262                    (forward-line 1))
 263                  (or (eobp)
 264                      (forward-char 1))
 265                  (beginning-of-defun)
 266                  (if (progn (end-of-defun)
 267                             (< location (point)))
 268                      (progn
 269                        (backward-sexp 1)
 270                        (let (beg tem)
 271
 272                          (forward-line -1)
 273                          ;; Skip back over typedefs of arglist.
 274                          (while (and (not (bobp))
 275                                      (looking-at "[ \t\n]"))
 276                            (forward-line -1))
 277                          ;; See if this is using the DEFUN macro used in Emacs,
 278                          ;; or the DEFUN macro used by the C library.
 279                          (if (condition-case nil
 280                                  (and (save-excursion
 281                                         (forward-line 1)
 282                                         (backward-sexp 1)
 283                                         (beginning-of-line)
 284                                         (setq tem (point))
 285                                         (looking-at "DEFUN\\b"))
 286                                       (>= location tem))
 287                                (error nil))
 288                              (progn
 289                                (goto-char tem)
 290                                (down-list 1)
 291                                (if (= (char-after (point)) ?\")
 292                                    (progn
 293                                      (forward-sexp 1)
 294                                      (skip-chars-forward " ,")))
 295                                (buffer-substring (point)
 296                                                  (progn (forward-sexp 1) (point))))
 297                            ;; Ordinary C function syntax.
 298                            (setq beg (point))
 299                            (if (condition-case nil
 300                                    ;; Protect against "Unbalanced parens" error.
 301                                    (progn
 302                                      (down-list 1) ; into arglist
 303                                      (backward-up-list 1)
 304                                      (skip-chars-backward " \t")
 305                                      t)
 306                                  (error nil))
 307                                ;; Verify initial pos was after
 308                                ;; real start of function.
 309                                (if (and (save-excursion
 310                                           (goto-char beg)
 311                                           ;; For this purpose, include the line
 312                                           ;; that has the decl keywords.  This
 313                                           ;; may also include some of the
 314                                           ;; comments before the function.
 315                                           (while (and (not (bobp))
 316                                                       (save-excursion
 317                                                         (forward-line -1)
 318                                                         (looking-at "[^\n\f]")))
 319                                             (forward-line -1))
 320                                           (>= location (point)))
 321                                         ;; Consistency check: going down and up
 322                                         ;; shouldn't take us back before BEG.
 323                                         (> (point) beg))
 324                                    (buffer-substring (point)
 325                                                      (progn (backward-sexp 1)
 326                                                             (point))))))))))
 327                 ((memq major-mode
 328                        '(TeX-mode plain-TeX-mode LaTeX-mode;; tex-mode.el
 329                                   plain-tex-mode latex-mode;; cmutex.el
 330                                   ))
 331                  (if (re-search-backward
 332                       "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
 333                      (progn
 334                        (goto-char (match-beginning 0))
 335                        (buffer-substring (1+ (point));; without initial backslash
 336                                          (progn
 337                                            (end-of-line)
 338                                            (point))))))
 339                 ((eq major-mode 'texinfo-mode)
 340                  (if (re-search-backward "^@node[ \t]+\\([^,]+\\)," nil t)
 341                      (buffer-substring (match-beginning 1)
 342                                        (match-end 1))))
 343                 (t
 344                  ;; If all else fails, try heuristics
 345                  (let (case-fold-search)
 346                    (end-of-line)
 347                    (if (re-search-backward add-log-current-defun-header-regexp
 348                                            (- (point) 10000)
 349                                            t)
 350                        (buffer-substring (match-beginning 1)
 351                                          (match-end 1))))))))
 352     (error nil)))
 353
 354
 355 (provide 'add-log)
 356
 357 ;;; add-log.el ends here