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          paragraph-end 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
  75     ;; Set ENTRY to the file name to use in the new entry.
  76     (and buffer-file-name
  77          ;; Never want to add a change log entry for the ChangeLog file itself.
  78          (not (string= buffer-file-name file-name))
  79          (setq entry (if (string-match
  80                           (concat "^" (regexp-quote (file-name-directory
  81                                                      file-name)))
  82                           buffer-file-name)
  83                          (substring buffer-file-name (match-end 0))
  84                        (file-name-nondirectory buffer-file-name))))
  85
  86     (if (and other-window (not (equal file-name buffer-file-name)))
  87         (find-file-other-window file-name)
  88       (find-file file-name))
  89     (undo-boundary)
  90     (goto-char (point-min))
  91     (or (looking-at (concat (regexp-quote (substring (current-time-string)
  92                                                      0 10))
  93                             ".* " (regexp-quote full-name)
  94                             "  (" (regexp-quote login-name) "@"))
  95         (insert (current-time-string)
  96                 "  " full-name
  97                 "  (" login-name "@" site-name ")\n\n"))
  98
  99     ;; Search only within the first paragraph.
 100     (forward-paragraph 1)
 101     (setq paragraph-end (point))
 102     (goto-char (point-min))
 103
 104     ;; Now insert the new line for this entry.
 105     (cond ((re-search-forward "^\\s *\\*\\s *$" paragraph-end t)
 106            ;; Put this file name into the existing empty entry.
 107            (if entry
 108                (insert entry)))
 109           ((and (re-search-forward
 110                  (concat (regexp-quote (concat "* " entry))
 111                          ;; Don't accept `foo.bar' when
 112                          ;; looking for `foo':
 113                          "\\(\\s \\|[(),:]\\)")
 114                  paragraph-end t))
 115            ;; Add to the existing entry for the same file.
 116            (re-search-forward "^\\s *$\\|^\\s \\*")
 117            (beginning-of-line)
 118            (while (and (not (eobp)) (looking-at "^\\s *$"))
 119              (delete-region (point) (save-excursion (forward-line 1) (point))))
 120            (insert "\n\n")
 121            (forward-line -2)
 122            (indent-relative-maybe))
 123           (t
 124            ;; Make a new entry.
 125            (forward-line 1)
 126            (while (looking-at "\\sW")
 127              (forward-line 1))
 128            (while (and (not (eobp)) (looking-at "^\\s *$"))
 129              (delete-region (point) (save-excursion (forward-line 1) (point))))
 130            (insert "\n\n\n")
 131            (forward-line -2)
 132            (indent-to left-margin)
 133            (insert "* " (or entry ""))))
 134     ;; Now insert the function name, if we have one.
 135     ;; Point is at the entry for this file,
 136     ;; either at the end of the line or at the first blank line.
 137     (if defun
 138         (progn
 139           ;; Make it easy to get rid of the function name.
 140           (undo-boundary)
 141           (insert (if (save-excursion
 142                         (beginning-of-line 1)
 143                         (looking-at "\\s *$"))
 144                       ""
 145                     " ")
 146                   "(" defun "): "))
 147       ;; No function name, so put in a colon unless we have just a star.
 148       (if (not (save-excursion
 149                  (beginning-of-line 1)
 150                  (looking-at "\\s *\\(\\*\\s *\\)?$")))
 151           (insert ": ")))))
 152
 153 ;;;###autoload
 154 (defun add-change-log-entry-other-window (&optional whoami file-name)
 155   "Find change log file in other window and add an entry for today.
 156 First arg (interactive prefix) non-nil means prompt for user name and site.
 157 Second arg is file name of change log.
 158 Interactively, with a prefix argument, the file name is prompted for."
 159   (interactive (if current-prefix-arg
 160                    (list current-prefix-arg
 161                          (prompt-for-change-log-name))))
 162   (add-change-log-entry whoami file-name t))
 163 ;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
 164
 165 ;;;###autoload
 166 (defun change-log-mode ()
 167   "Major mode for editting change logs; like Indented Text Mode.
 168 Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
 169 New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
 170 Each entry behaves as a paragraph, and the entries for one day as a page.
 171 Runs `change-log-mode-hook'."
 172   (interactive)
 173   (kill-all-local-variables)
 174   (indented-text-mode)
 175   (setq major-mode 'change-log-mode
 176         mode-name "Change Log"
 177         left-margin 8
 178         fill-column 74)
 179   ;; Let each entry behave as one paragraph:
 180   (set (make-local-variable 'paragraph-start) "^\\s *$\\|^^L")
 181   (set (make-local-variable 'paragraph-separate) "^\\s *$\\|^^L\\|^\\sw")
 182   ;; Let all entries for one day behave as one page.
 183   ;; Match null string on the date-line so that the date-line
 184   ;; is grouped with what follows.
 185   (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
 186   (set (make-local-variable 'version-control) 'never)
 187   (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
 188   (run-hooks 'change-log-mode-hook))
 189
 190 (defvar add-log-current-defun-header-regexp
 191   "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[a-z_---A-Z]+\\)[ \t]*[:=]"
 192   "*Heuristic regexp used by `add-log-current-defun' for unknown major modes.")
 193
 194 (defun add-log-current-defun ()
 195   "Return name of function definition point is in, or nil.
 196
 197 Understands Lisp, LaTeX (\"functions\" are chapters, sections, ...),
 198 Texinfo (@node titles), and C.
 199
 200 Other modes are handled by a heuristic that looks in the 10K before
 201 point for uppercase headings starting in the first column or
 202 identifiers followed by `:' or `=', see variable
 203 `add-log-current-defun-header-regexp'.
 204
 205 Has a preference of looking backwards."
 206   (condition-case nil
 207       (save-excursion
 208         (let ((location (point)))
 209           (cond ((memq major-mode '(emacs-lisp-mode lisp-mode scheme-mode))
 210                  ;; If we are now precisely a the beginning of a defun,
 211                  ;; make sure beginning-of-defun finds that one
 212                  ;; rather than the previous one.
 213                  (or (eobp) (forward-char 1))
 214                  (beginning-of-defun)
 215                  ;; Make sure we are really inside the defun found, not after it.
 216                  (if (and (progn (end-of-defun)
 217                                  (< location (point)))
 218                           (progn (forward-sexp -1)
 219                                  (>= location (point))))
 220                      (progn
 221                        (forward-word 1)
 222                        (skip-chars-forward " ")
 223                        (buffer-substring (point)
 224                                          (progn (forward-sexp 1) (point))))))
 225                 ((and (memq major-mode '(c-mode 'c++-mode))
 226                       (save-excursion (beginning-of-line)
 227                                       ;; Use eq instead of = here to avoid
 228                                       ;; error when at bob and char-after
 229                                       ;; returns nil.
 230                                       (while (eq (char-after (- (point) 2)) ?\\)
 231                                         (forward-line -1))
 232                                       (looking-at "[ \t]*#[ \t]*define[ \t]")))
 233                  ;; Handle a C macro definition.
 234                  (beginning-of-line)
 235                  (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
 236                    (forward-line -1))
 237                  (search-forward "define")
 238                  (skip-chars-forward " \t")
 239                  (buffer-substring (point)
 240                                    (progn (forward-sexp 1) (point))))
 241                 ((memq major-mode '(c-mode 'c++-mode))
 242                  (beginning-of-line)
 243                  ;; See if we are in the beginning part of a function,
 244                  ;; before the open brace.  If so, advance forward.
 245                  (while (not (looking-at "{\\|\\(\\s *$\\)"))
 246                    (forward-line 1))
 247                  (or (eobp)
 248                      (forward-char 1))
 249                  (beginning-of-defun)
 250                  (if (progn (end-of-defun)
 251                             (< location (point)))
 252                      (progn
 253                        (backward-sexp 1)
 254                        (let (beg tem)
 255
 256                          (forward-line -1)
 257                          ;; Skip back over typedefs of arglist.
 258                          (while (and (not (bobp))
 259                                      (looking-at "[ \t\n]"))
 260                            (forward-line -1))
 261                          ;; See if this is using the DEFUN macro used in Emacs,
 262                          ;; or the DEFUN macro used by the C library.
 263                          (if (condition-case nil
 264                                  (and (save-excursion
 265                                         (forward-line 1)
 266                                         (backward-sexp 1)
 267                                         (beginning-of-line)
 268                                         (setq tem (point))
 269                                         (looking-at "DEFUN\\b"))
 270                                       (>= location tem))
 271                                (error nil))
 272                              (progn
 273                                (goto-char tem)
 274                                (down-list 1)
 275                                (if (= (char-after (point)) ?\")
 276                                    (progn
 277                                      (forward-sexp 1)
 278                                      (skip-chars-forward " ,")))
 279                                (buffer-substring (point)
 280                                                  (progn (forward-sexp 1) (point))))
 281                            ;; Ordinary C function syntax.
 282                            (setq beg (point))
 283                            (if (condition-case nil
 284                                    ;; Protect against "Unbalanced parens" error.
 285                                    (progn
 286                                      (down-list 1) ; into arglist
 287                                      (backward-up-list 1)
 288                                      (skip-chars-backward " \t")
 289                                      t)
 290                                  (error nil))
 291                                ;; Verify initial pos was after
 292                                ;; real start of function.
 293                                (if (and (save-excursion
 294                                           (goto-char beg)
 295                                           ;; For this purpose, include the line
 296                                           ;; that has the decl keywords.  This
 297                                           ;; may also include some of the
 298                                           ;; comments before the function.
 299                                           (while (and (not (bobp))
 300                                                       (save-excursion
 301                                                         (forward-line -1)
 302                                                         (looking-at "[^\n\f]")))
 303                                             (forward-line -1))
 304                                           (>= location (point)))
 305                                         ;; Consistency check: going down and up
 306                                         ;; shouldn't take us back before BEG.
 307                                         (> (point) beg))
 308                                    (buffer-substring (point)
 309                                                      (progn (backward-sexp 1)
 310                                                             (point))))))))))
 311                 ((memq major-mode
 312                        '(TeX-mode plain-TeX-mode LaTeX-mode;; tex-mode.el
 313                                   plain-tex-mode latex-mode;; cmutex.el
 314                                   ))
 315                  (if (re-search-backward
 316                       "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
 317                      (progn
 318                        (goto-char (match-beginning 0))
 319                        (buffer-substring (1+ (point));; without initial backslash
 320                                          (progn
 321                                            (end-of-line)
 322                                            (point))))))
 323                 ((eq major-mode 'texinfo-mode)
 324                  (if (re-search-backward "^@node[ \t]+\\([^,]+\\)," nil t)
 325                      (buffer-substring (match-beginning 1)
 326                                        (match-end 1))))
 327                 (t
 328                  ;; If all else fails, try heuristics
 329                  (let (case-fold-search)
 330                    (end-of-line)
 331                    (if (re-search-backward add-log-current-defun-header-regexp
 332                                            (- (point) 10000)
 333                                            t)
 334                        (buffer-substring (match-beginning 1)
 335                                          (match-end 1))))))))
 336     (error nil)))
 337
 338
 339 (provide 'add-log)
 340
 341 ;;; add-log.el ends here