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, 1986, 1988, 1993 Free Software Foundation, Inc.
   4
   5 ;; Keywords: maint
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22
  23 ;;; Commentary:
  24
  25 ;; This facility is documented in the Emacs Manual.
  26
  27 ;;; Code:
  28
  29 (defvar change-log-default-name nil
  30   "*Name of a change log file for \\[add-change-log-entry].")
  31
  32 (defvar add-log-current-defun-function nil
  33   "\
  34 *If non-nil, function to guess name of current function from surrounding text.
  35 \\[add-change-log-entry] calls this function (if nil, `add-log-current-defun'
  36 instead) with no arguments.  It returns a string or nil if it cannot guess.")
  37
  38 ;; This MUST not be autoloaded, since user-login-name
  39 ;; cannot be known at Emacs dump time.
  40 (defvar add-log-full-name (user-full-name)
  41   "*Full name of user, for inclusion in ChangeLog daily headers.
  42 This defaults to the value returned by the `user-full-name' function.")
  43
  44 ;; This MUST not be autoloaded, since user-login-name
  45 ;; cannot be known at Emacs dump time.
  46 (defvar add-log-mailing-address (concat (user-login-name) "@" (system-name))
  47   "*Electronic mail address of user, for inclusion in ChangeLog daily headers.
  48 This defaults to the value returned by `user-login-name', followed by
  49 an `@' character, followed by the value returned by `system-name'.")
  50
  51 (defun change-log-name ()
  52   (or change-log-default-name
  53       (if (eq system-type 'vax-vms) "$CHANGE_LOG$.TXT" "ChangeLog")))
  54
  55 ;;;###autoload
  56 (defun prompt-for-change-log-name ()
  57   "Prompt for a change log name."
  58   (let ((default (change-log-name)))
  59     (expand-file-name
  60      (read-file-name (format "Log file (default %s): " default)
  61                      nil default))))
  62
  63 ;;;###autoload
  64 (defun find-change-log (&optional file-name)
  65   "Find a change log file for \\[add-change-log-entry] and return the name.
  66 Optional arg FILE-NAME is a name to try first.
  67 If FILE-NAME is nil, use the value of `change-log-default-name' if non-nil.
  68 Failing that, use \"ChangeLog\" in the current directory.
  69 If the file does not exist in the named directory, successive parent
  70 directories are tried.
  71
  72 Once a file is found, `change-log-default-name' is set locally in the
  73 current buffer to the complete file name."
  74   (or file-name
  75       (setq file-name (or change-log-default-name
  76                           ;; Chase links in the source file
  77                           ;; and use the change log in the dir where it points.
  78                           (and buffer-file-name
  79                                (file-name-directory
  80                                 (file-chase-links buffer-file-name)))
  81                           default-directory)))
  82   (if (and (eq file-name change-log-default-name)
  83            (assq 'change-log-default-name (buffer-local-variables)))
  84       ;; Don't do the searching if we already have a buffer-local value.
  85       file-name
  86
  87     (if (file-directory-p file-name)
  88         (setq file-name (expand-file-name (change-log-name) file-name)))
  89     ;; Chase links before visiting the file.
  90     ;; This makes it easier to use a single change log file
  91     ;; for several related directories.
  92     (setq file-name (file-chase-links file-name))
  93     (setq file-name (expand-file-name file-name))
  94     ;; Move up in the dir hierarchy till we find a change log file.
  95     (let ((file1 file-name)
  96           parent-dir)
  97       (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
  98                   (progn (setq parent-dir
  99                                (file-name-directory
 100                                 (directory-file-name
 101                                  (file-name-directory file1))))
 102                          ;; Give up if we are already at the root dir.
 103                          (not (string= (file-name-directory file1)
 104                                        parent-dir))))
 105         ;; Move up to the parent dir and try again.
 106         (setq file1 (expand-file-name (change-log-name) parent-dir)))
 107       ;; If we found a change log in a parent, use that.
 108       (if (or (get-file-buffer file1) (file-exists-p file1))
 109           (setq file-name file1)))
 110     ;; Make a local variable in this buffer so we needn't search again.
 111     (set (make-local-variable 'change-log-default-name) file-name)
 112     file-name))
 113
 114 ;;;###autoload
 115 (defun add-change-log-entry (&optional whoami file-name other-window new-entry)
 116   "Find change log file and add an entry for today.
 117 Optional arg (interactive prefix) non-nil means prompt for user name and site.
 118 Second arg is file name of change log.  If nil, uses `change-log-default-name'.
 119 Third arg OTHER-WINDOW non-nil means visit in other window.
 120 Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
 121 never append to an existing entry."
 122   (interactive (list current-prefix-arg
 123                      (prompt-for-change-log-name)))
 124   (if whoami
 125       (progn
 126         (setq add-log-full-name (read-input "Full name: " add-log-full-name))
 127          ;; Note that some sites have room and phone number fields in
 128          ;; full name which look silly when inserted.  Rather than do
 129          ;; anything about that here, let user give prefix argument so that
 130          ;; s/he can edit the full name field in prompter if s/he wants.
 131         (setq add-log-mailing-address
 132               (read-input "Mailing address: " add-log-mailing-address))))
 133   (let ((defun (funcall (or add-log-current-defun-function
 134                             'add-log-current-defun)))
 135         paragraph-end entry)
 136
 137     (setq file-name (find-change-log file-name))
 138
 139     ;; Set ENTRY to the file name to use in the new entry.
 140     (and buffer-file-name
 141          ;; Never want to add a change log entry for the ChangeLog file itself.
 142          (not (string= buffer-file-name file-name))
 143          (setq entry (if (string-match
 144                           (concat "^" (regexp-quote (file-name-directory
 145                                                      file-name)))
 146                           buffer-file-name)
 147                          (substring buffer-file-name (match-end 0))
 148                        (file-name-nondirectory buffer-file-name))))
 149
 150     (if (and other-window (not (equal file-name buffer-file-name)))
 151         (find-file-other-window file-name)
 152       (find-file file-name))
 153     (undo-boundary)
 154     (goto-char (point-min))
 155     (if (looking-at (concat (regexp-quote (substring (current-time-string)
 156                                                      0 10))
 157                             ".* " (regexp-quote add-log-full-name)
 158                             "  (" (regexp-quote add-log-mailing-address)))
 159         (forward-line 1)
 160       (insert (current-time-string)
 161               "  " add-log-full-name
 162               "  (" add-log-mailing-address ")\n\n"))
 163
 164     ;; Search only within the first paragraph.
 165     (if (looking-at "\n*[^\n* \t]")
 166         (skip-chars-forward "\n")
 167       (forward-paragraph 1))
 168     (setq paragraph-end (point))
 169     (goto-char (point-min))
 170
 171     ;; Now insert the new line for this entry.
 172     (cond ((re-search-forward "^\\s *\\*\\s *$" paragraph-end t)
 173            ;; Put this file name into the existing empty entry.
 174            (if entry
 175                (insert entry)))
 176           ((and (not new-entry)
 177                 (re-search-forward
 178                  (concat (regexp-quote (concat "* " entry))
 179                          ;; Don't accept `foo.bar' when
 180                          ;; looking for `foo':
 181                          "\\(\\s \\|[(),:]\\)")
 182                  paragraph-end t))
 183            ;; Add to the existing entry for the same file.
 184            (re-search-forward "^\\s *$\\|^\\s \\*")
 185            (beginning-of-line)
 186            (while (and (not (eobp)) (looking-at "^\\s *$"))
 187              (delete-region (point) (save-excursion (forward-line 1) (point))))
 188            (insert "\n\n")
 189            (forward-line -2)
 190            (indent-relative-maybe))
 191           (t
 192            ;; Make a new entry.
 193            (forward-line 1)
 194            (while (looking-at "\\sW")
 195              (forward-line 1))
 196            (while (and (not (eobp)) (looking-at "^\\s *$"))
 197              (delete-region (point) (save-excursion (forward-line 1) (point))))
 198            (insert "\n\n\n")
 199            (forward-line -2)
 200            (indent-to left-margin)
 201            (insert "* " (or entry ""))))
 202     ;; Now insert the function name, if we have one.
 203     ;; Point is at the entry for this file,
 204     ;; either at the end of the line or at the first blank line.
 205     (if defun
 206         (progn
 207           ;; Make it easy to get rid of the function name.
 208           (undo-boundary)
 209           (insert (if (save-excursion
 210                         (beginning-of-line 1)
 211                         (looking-at "\\s *$"))
 212                       ""
 213                     " ")
 214                   "(" defun "): "))
 215       ;; No function name, so put in a colon unless we have just a star.
 216       (if (not (save-excursion
 217                  (beginning-of-line 1)
 218                  (looking-at "\\s *\\(\\*\\s *\\)?$")))
 219           (insert ": ")))))
 220
 221 ;;;###autoload
 222 (defun add-change-log-entry-other-window (&optional whoami file-name)
 223   "Find change log file in other window and add an entry for today.
 224 Optional arg (interactive prefix) non-nil means prompt for user name and site.
 225 Second arg is file name of change log.  \
 226 If nil, uses `change-log-default-name'."
 227   (interactive (if current-prefix-arg
 228                    (list current-prefix-arg
 229                          (prompt-for-change-log-name))))
 230   (add-change-log-entry whoami file-name t))
 231 ;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
 232
 233 ;;;###autoload
 234 (defun change-log-mode ()
 235   "Major mode for editing change logs; like Indented Text Mode.
 236 Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
 237 New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
 238 Each entry behaves as a paragraph, and the entries for one day as a page.
 239 Runs `change-log-mode-hook'."
 240   (interactive)
 241   (kill-all-local-variables)
 242   (indented-text-mode)
 243   (setq major-mode 'change-log-mode
 244         mode-name "Change Log"
 245         left-margin 8
 246         fill-column 74)
 247   (use-local-map change-log-mode-map)
 248   ;; Let each entry behave as one paragraph:
 249   (set (make-local-variable 'paragraph-start) "^\\s *$\\|^\f")
 250   (set (make-local-variable 'paragraph-separate) "^\\s *$\\|^\f\\|^\\sw")
 251   ;; Let all entries for one day behave as one page.
 252   ;; Match null string on the date-line so that the date-line
 253   ;; is grouped with what follows.
 254   (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
 255   (set (make-local-variable 'version-control) 'never)
 256   (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
 257   (run-hooks 'change-log-mode-hook))
 258
 259 (defvar change-log-mode-map nil
 260   "Keymap for Change Log major mode.")
 261 (if change-log-mode-map
 262     nil
 263   (setq change-log-mode-map (make-sparse-keymap))
 264   (define-key change-log-mode-map "\M-q" 'change-log-fill-paragraph))
 265
 266 ;; It might be nice to have a general feature to replace this.  The idea I
 267 ;; have is a variable giving a regexp matching text which should not be
 268 ;; moved from bol by filling.  change-log-mode would set this to "^\\s *\\s(".
 269 ;; But I don't feel up to implementing that today.
 270 (defun change-log-fill-paragraph (&optional justify)
 271   "Fill the paragraph, but preserve open parentheses at beginning of lines.
 272 Prefix arg means justify as well."
 273   (interactive "P")
 274   (let ((paragraph-separate (concat paragraph-separate "\\|^\\s *\\s("))
 275         (paragraph-start (concat paragraph-start "\\|^\\s *\\s(")))
 276     (fill-paragraph justify)))
 277 \f
 278 (defvar add-log-current-defun-header-regexp
 279   "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[a-z_---A-Z]+\\)[ \t]*[:=]"
 280   "*Heuristic regexp used by `add-log-current-defun' for unknown major modes.")
 281
 282 (defun add-log-current-defun ()
 283   "Return name of function definition point is in, or nil.
 284
 285 Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
 286 Texinfo (@node titles), and Fortran.
 287
 288 Other modes are handled by a heuristic that looks in the 10K before
 289 point for uppercase headings starting in the first column or
 290 identifiers followed by `:' or `=', see variable
 291 `add-log-current-defun-header-regexp'.
 292
 293 Has a preference of looking backwards."
 294   (condition-case nil
 295       (save-excursion
 296         (let ((location (point)))
 297           (cond ((memq major-mode '(emacs-lisp-mode lisp-mode scheme-mode))
 298                  ;; If we are now precisely a the beginning of a defun,
 299                  ;; make sure beginning-of-defun finds that one
 300                  ;; rather than the previous one.
 301                  (or (eobp) (forward-char 1))
 302                  (beginning-of-defun)
 303                  ;; Make sure we are really inside the defun found, not after it.
 304                  (if (and (progn (end-of-defun)
 305                                  (< location (point)))
 306                           (progn (forward-sexp -1)
 307                                  (>= location (point))))
 308                      (progn
 309                        (if (looking-at "\\s(")
 310                            (forward-char 1))
 311                        (forward-sexp 1)
 312                        (skip-chars-forward " ")
 313                        (buffer-substring (point)
 314                                          (progn (forward-sexp 1) (point))))))
 315                 ((and (memq major-mode '(c-mode 'c++-mode))
 316                       (save-excursion (beginning-of-line)
 317                                       ;; Use eq instead of = here to avoid
 318                                       ;; error when at bob and char-after
 319                                       ;; returns nil.
 320                                       (while (eq (char-after (- (point) 2)) ?\\)
 321                                         (forward-line -1))
 322                                       (looking-at "[ \t]*#[ \t]*define[ \t]")))
 323                  ;; Handle a C macro definition.
 324                  (beginning-of-line)
 325                  (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
 326                    (forward-line -1))
 327                  (search-forward "define")
 328                  (skip-chars-forward " \t")
 329                  (buffer-substring (point)
 330                                    (progn (forward-sexp 1) (point))))
 331                 ((memq major-mode '(c-mode 'c++-mode))
 332                  (beginning-of-line)
 333                  ;; See if we are in the beginning part of a function,
 334                  ;; before the open brace.  If so, advance forward.
 335                  (while (not (looking-at "{\\|\\(\\s *$\\)"))
 336                    (forward-line 1))
 337                  (or (eobp)
 338                      (forward-char 1))
 339                  (beginning-of-defun)
 340                  (if (progn (end-of-defun)
 341                             (< location (point)))
 342                      (progn
 343                        (backward-sexp 1)
 344                        (let (beg tem)
 345
 346                          (forward-line -1)
 347                          ;; Skip back over typedefs of arglist.
 348                          (while (and (not (bobp))
 349                                      (looking-at "[ \t\n]"))
 350                            (forward-line -1))
 351                          ;; See if this is using the DEFUN macro used in Emacs,
 352                          ;; or the DEFUN macro used by the C library.
 353                          (if (condition-case nil
 354                                  (and (save-excursion
 355                                         (forward-line 1)
 356                                         (backward-sexp 1)
 357                                         (beginning-of-line)
 358                                         (setq tem (point))
 359                                         (looking-at "DEFUN\\b"))
 360                                       (>= location tem))
 361                                (error nil))
 362                              (progn
 363                                (goto-char tem)
 364                                (down-list 1)
 365                                (if (= (char-after (point)) ?\")
 366                                    (progn
 367                                      (forward-sexp 1)
 368                                      (skip-chars-forward " ,")))
 369                                (buffer-substring (point)
 370                                                  (progn (forward-sexp 1) (point))))
 371                            ;; Ordinary C function syntax.
 372                            (setq beg (point))
 373                            (if (condition-case nil
 374                                    ;; Protect against "Unbalanced parens" error.
 375                                    (progn
 376                                      (down-list 1) ; into arglist
 377                                      (backward-up-list 1)
 378                                      (skip-chars-backward " \t")
 379                                      t)
 380                                  (error nil))
 381                                ;; Verify initial pos was after
 382                                ;; real start of function.
 383                                (if (and (save-excursion
 384                                           (goto-char beg)
 385                                           ;; For this purpose, include the line
 386                                           ;; that has the decl keywords.  This
 387                                           ;; may also include some of the
 388                                           ;; comments before the function.
 389                                           (while (and (not (bobp))
 390                                                       (save-excursion
 391                                                         (forward-line -1)
 392                                                         (looking-at "[^\n\f]")))
 393                                             (forward-line -1))
 394                                           (>= location (point)))
 395                                         ;; Consistency check: going down and up
 396                                         ;; shouldn't take us back before BEG.
 397                                         (> (point) beg))
 398                                    (buffer-substring (point)
 399                                                      (progn (backward-sexp 1)
 400                                                             (point))))))))))
 401                 ((memq major-mode
 402                        '(TeX-mode plain-TeX-mode LaTeX-mode;; tex-mode.el
 403                                   plain-tex-mode latex-mode;; cmutex.el
 404                                   ))
 405                  (if (re-search-backward
 406                       "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
 407                      (progn
 408                        (goto-char (match-beginning 0))
 409                        (buffer-substring (1+ (point));; without initial backslash
 410                                          (progn
 411                                            (end-of-line)
 412                                            (point))))))
 413                 ((eq major-mode 'texinfo-mode)
 414                  (if (re-search-backward "^@node[ \t]+\\([^,]+\\)," nil t)
 415                      (buffer-substring (match-beginning 1)
 416                                        (match-end 1))))
 417                 ((eq major-mode 'fortran-mode)
 418                  ;; must be inside function body for this to work
 419                  (beginning-of-fortran-subprogram)
 420                  (let ((case-fold-search t)) ; case-insensitive
 421                    ;; search for fortran subprogram start
 422                    (if (re-search-forward
 423                          "^[ \t]*\\(program\\|subroutine\\|function\
 424 \\|[ \ta-z0-9*]*[ \t]+function\\)"
 425                          nil t)
 426                        (progn
 427                          ;; move to EOL or before first left paren
 428                          (if (re-search-forward "[(\n]" nil t)
 429                              (progn (forward-char -1)
 430                                     (skip-chars-backward " \t"))
 431                            (end-of-line))
 432                          ;; Use the name preceding that.
 433                          (buffer-substring (point)
 434                                            (progn (forward-sexp -1)
 435                                                   (point)))))))
 436                 (t
 437                  ;; If all else fails, try heuristics
 438                  (let (case-fold-search)
 439                    (end-of-line)
 440                    (if (re-search-backward add-log-current-defun-header-regexp
 441                                            (- (point) 10000)
 442                                            t)
 443                        (buffer-substring (match-beginning 1)
 444                                          (match-end 1))))))))
 445     (error nil)))
 446
 447
 448 (provide 'add-log)
 449
 450 ;;; add-log.el ends here