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