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