1;;; add-log.el --- change log maintenance commands for Emacs 2 3;; Copyright (C) 1985, 1986, 1988, 1993, 1994, 1997, 1998, 2000, 2001, 4;; 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Maintainer: FSF 7;; Keywords: tools 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; This facility is documented in the Emacs Manual. 29 30;;; Code: 31 32(eval-when-compile 33 (require 'timezone)) 34 35(defgroup change-log nil 36 "Change log maintenance." 37 :group 'tools 38 :link '(custom-manual "(emacs)Change Log") 39 :prefix "change-log-" 40 :prefix "add-log-") 41 42 43(defcustom change-log-default-name nil 44 "*Name of a change log file for \\[add-change-log-entry]." 45 :type '(choice (const :tag "default" nil) 46 string) 47 :group 'change-log) 48(put 'change-log-default-name 'safe-local-variable 'string-or-null-p) 49 50(defcustom change-log-mode-hook nil 51 "Normal hook run by `change-log-mode'." 52 :type 'hook 53 :group 'change-log) 54 55;; Many modes set this variable, so avoid warnings. 56;;;###autoload 57(defcustom add-log-current-defun-function nil 58 "*If non-nil, function to guess name of surrounding function. 59It is used by `add-log-current-defun' in preference to built-in rules. 60Returns function's name as a string, or nil if outside a function." 61 :type '(choice (const nil) function) 62 :group 'change-log) 63 64;;;###autoload 65(defcustom add-log-full-name nil 66 "*Full name of user, for inclusion in ChangeLog daily headers. 67This defaults to the value returned by the function `user-full-name'." 68 :type '(choice (const :tag "Default" nil) 69 string) 70 :group 'change-log) 71 72;;;###autoload 73(defcustom add-log-mailing-address nil 74 "Email addresses of user, for inclusion in ChangeLog headers. 75This defaults to the value of `user-mail-address'. In addition to 76being a simple string, this value can also be a list. All elements 77will be recognized as referring to the same user; when creating a new 78ChangeLog entry, one element will be chosen at random." 79 :type '(choice (const :tag "Default" nil) 80 (string :tag "String") 81 (repeat :tag "List of Strings" string)) 82 :group 'change-log) 83 84(defcustom add-log-time-format 'add-log-iso8601-time-string 85 "Function that defines the time format. 86For example, `add-log-iso8601-time-string', which gives the 87date in international ISO 8601 format, 88and `current-time-string' are two valid values." 89 :type '(radio (const :tag "International ISO 8601 format" 90 add-log-iso8601-time-string) 91 (const :tag "Old format, as returned by `current-time-string'" 92 current-time-string) 93 (function :tag "Other")) 94 :group 'change-log) 95 96(defcustom add-log-keep-changes-together nil 97 "If non-nil, normally keep day's log entries for one file together. 98 99Log entries for a given file made with \\[add-change-log-entry] or 100\\[add-change-log-entry-other-window] will only be added to others \ 101for that file made 102today if this variable is non-nil or that file comes first in today's 103entries. Otherwise another entry for that file will be started. An 104original log: 105 106 * foo (...): ... 107 * bar (...): change 1 108 109in the latter case, \\[add-change-log-entry-other-window] in a \ 110buffer visiting `bar', yields: 111 112 * bar (...): -!- 113 * foo (...): ... 114 * bar (...): change 1 115 116and in the former: 117 118 * foo (...): ... 119 * bar (...): change 1 120 (...): -!- 121 122The NEW-ENTRY arg to `add-change-log-entry' can override the effect of 123this variable." 124 :version "20.3" 125 :type 'boolean 126 :group 'change-log) 127 128(defcustom add-log-always-start-new-record nil 129 "If non-nil, `add-change-log-entry' will always start a new record." 130 :version "22.1" 131 :type 'boolean 132 :group 'change-log) 133 134(defcustom add-log-buffer-file-name-function nil 135 "If non-nil, function to call to identify the full filename of a buffer. 136This function is called with no argument. If this is nil, the default is to 137use `buffer-file-name'." 138 :type '(choice (const nil) function) 139 :group 'change-log) 140 141(defcustom add-log-file-name-function nil 142 "If non-nil, function to call to identify the filename for a ChangeLog entry. 143This function is called with one argument, the value of variable 144`buffer-file-name' in that buffer. If this is nil, the default is to 145use the file's name relative to the directory of the change log file." 146 :type '(choice (const nil) function) 147 :group 'change-log) 148 149 150(defcustom change-log-version-info-enabled nil 151 "*If non-nil, enable recording version numbers with the changes." 152 :version "21.1" 153 :type 'boolean 154 :group 'change-log) 155 156(defcustom change-log-version-number-regexp-list 157 (let ((re "\\([0-9]+\.[0-9.]+\\)")) 158 (list 159 ;; (defconst ad-version "2.15" 160 (concat "^(def[^ \t\n]+[ \t]+[^ \t\n][ \t]\"" re) 161 ;; Revision: pcl-cvs.el,v 1.72 1999/09/05 20:21:54 monnier Exp 162 (concat "^;+ *Revision: +[^ \t\n]+[ \t]+" re))) 163 "*List of regexps to search for version number. 164The version number must be in group 1. 165Note: The search is conducted only within 10%, at the beginning of the file." 166 :version "21.1" 167 :type '(repeat regexp) 168 :group 'change-log) 169 170(defface change-log-date 171 '((t (:inherit font-lock-string-face))) 172 "Face used to highlight dates in date lines." 173 :version "21.1" 174 :group 'change-log) 175;; backward-compatibility alias 176(put 'change-log-date-face 'face-alias 'change-log-date) 177 178(defface change-log-name 179 '((t (:inherit font-lock-constant-face))) 180 "Face for highlighting author names." 181 :version "21.1" 182 :group 'change-log) 183;; backward-compatibility alias 184(put 'change-log-name-face 'face-alias 'change-log-name) 185 186(defface change-log-email 187 '((t (:inherit font-lock-variable-name-face))) 188 "Face for highlighting author email addresses." 189 :version "21.1" 190 :group 'change-log) 191;; backward-compatibility alias 192(put 'change-log-email-face 'face-alias 'change-log-email) 193 194(defface change-log-file 195 '((t (:inherit font-lock-function-name-face))) 196 "Face for highlighting file names." 197 :version "21.1" 198 :group 'change-log) 199;; backward-compatibility alias 200(put 'change-log-file-face 'face-alias 'change-log-file) 201 202(defface change-log-list 203 '((t (:inherit font-lock-keyword-face))) 204 "Face for highlighting parenthesized lists of functions or variables." 205 :version "21.1" 206 :group 'change-log) 207;; backward-compatibility alias 208(put 'change-log-list-face 'face-alias 'change-log-list) 209 210(defface change-log-conditionals 211 '((t (:inherit font-lock-variable-name-face))) 212 "Face for highlighting conditionals of the form `[...]'." 213 :version "21.1" 214 :group 'change-log) 215;; backward-compatibility alias 216(put 'change-log-conditionals-face 'face-alias 'change-log-conditionals) 217 218(defface change-log-function 219 '((t (:inherit font-lock-variable-name-face))) 220 "Face for highlighting items of the form `<....>'." 221 :version "21.1" 222 :group 'change-log) 223;; backward-compatibility alias 224(put 'change-log-function-face 'face-alias 'change-log-function) 225 226(defface change-log-acknowledgement 227 '((t (:inherit font-lock-comment-face))) 228 "Face for highlighting acknowledgments." 229 :version "21.1" 230 :group 'change-log) 231;; backward-compatibility alias 232(put 'change-log-acknowledgement-face 'face-alias 'change-log-acknowledgement) 233 234(defvar change-log-font-lock-keywords 235 '(;; 236 ;; Date lines, new (2000-01-01) and old (Sat Jan 1 00:00:00 2000) styles. 237 ;; Fixme: this regepx is just an approximate one and may match 238 ;; wrongly with a non-date line existing as a random note. In 239 ;; addition, using any kind of fixed setting like this doesn't 240 ;; work if a user customizes add-log-time-format. 241 ("^[0-9-]+ +\\|^\\(Sun\\|Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\) [A-z][a-z][a-z] [0-9:+ ]+" 242 (0 'change-log-date-face) 243 ;; Name and e-mail; some people put e-mail in parens, not angles. 244 ("\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" nil nil 245 (1 'change-log-name) 246 (2 'change-log-email))) 247 ;; 248 ;; File names. 249 ("^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)" 250 (2 'change-log-file) 251 ;; Possibly further names in a list: 252 ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file)) 253 ;; Possibly a parenthesized list of names: 254 ("\\= (\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" 255 nil nil (1 'change-log-list)) 256 ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" 257 nil nil (1 'change-log-list))) 258 ;; 259 ;; Function or variable names. 260 ("^\\( +\\|\t\\)(\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" 261 (2 'change-log-list) 262 ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" nil nil 263 (1 'change-log-list))) 264 ;; 265 ;; Conditionals. 266 ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 'change-log-conditionals)) 267 ;; 268 ;; Function of change. 269 ("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function)) 270 ;; 271 ;; Acknowledgements. 272 ;; Don't include plain "From" because that is vague; 273 ;; we want to encourage people to say something more specific. 274 ;; Note that the FSF does not use "Patches by"; our convention 275 ;; is to put the name of the author of the changes at the top 276 ;; of the change log entry. 277 ("\\(^\\( +\\|\t\\)\\| \\)\\(Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)" 278 3 'change-log-acknowledgement)) 279 "Additional expressions to highlight in Change Log mode.") 280 281(defvar change-log-mode-map 282 (let ((map (make-sparse-keymap))) 283 (define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment) 284 (define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment) 285 map) 286 "Keymap for Change Log major mode.") 287 288;; It used to be called change-log-time-zone-rule but really should be 289;; called add-log-time-zone-rule since it's only used from add-log-* code. 290(defvaralias 'change-log-time-zone-rule 'add-log-time-zone-rule) 291(defvar add-log-time-zone-rule nil 292 "Time zone used for calculating change log time stamps. 293It takes the same format as the TZ argument of `set-time-zone-rule'. 294If nil, use local time. 295If t, use universal time.") 296(put 'add-log-time-zone-rule 'safe-local-variable 297 '(lambda (x) (or (booleanp x) (stringp x)))) 298 299(defun add-log-iso8601-time-zone (&optional time) 300 (let* ((utc-offset (or (car (current-time-zone time)) 0)) 301 (sign (if (< utc-offset 0) ?- ?+)) 302 (sec (abs utc-offset)) 303 (ss (% sec 60)) 304 (min (/ sec 60)) 305 (mm (% min 60)) 306 (hh (/ min 60))) 307 (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d") 308 ((not (zerop mm)) "%c%02d:%02d") 309 (t "%c%02d")) 310 sign hh mm ss))) 311 312(defvar add-log-iso8601-with-time-zone nil) 313 314(defun add-log-iso8601-time-string () 315 (let ((time (format-time-string "%Y-%m-%d" 316 nil (eq t add-log-time-zone-rule)))) 317 (if add-log-iso8601-with-time-zone 318 (concat time " " (add-log-iso8601-time-zone)) 319 time))) 320 321(defun change-log-name () 322 "Return (system-dependent) default name for a change log file." 323 (or change-log-default-name 324 (if (eq system-type 'vax-vms) 325 "$CHANGE_LOG$.TXT" 326 "ChangeLog"))) 327 328(defun add-log-edit-prev-comment (arg) 329 "Cycle backward through Log-Edit mode comment history. 330With a numeric prefix ARG, go back ARG comments." 331 (interactive "*p") 332 (save-restriction 333 (narrow-to-region (point) 334 (if (memq last-command '(add-log-edit-prev-comment 335 add-log-edit-next-comment)) 336 (mark) (point))) 337 (when (fboundp 'log-edit-previous-comment) 338 (log-edit-previous-comment arg) 339 (indent-region (point-min) (point-max)) 340 (goto-char (point-min)) 341 (unless (save-restriction (widen) (bolp)) 342 (delete-region (point) (progn (skip-chars-forward " \t\n") (point)))) 343 (set-mark (point-min)) 344 (goto-char (point-max)) 345 (delete-region (point) (progn (skip-chars-backward " \t\n") (point)))))) 346 347(defun add-log-edit-next-comment (arg) 348 "Cycle forward through Log-Edit mode comment history. 349With a numeric prefix ARG, go back ARG comments." 350 (interactive "*p") 351 (add-log-edit-prev-comment (- arg))) 352 353;;;###autoload 354(defun prompt-for-change-log-name () 355 "Prompt for a change log name." 356 (let* ((default (change-log-name)) 357 (name (expand-file-name 358 (read-file-name (format "Log file (default %s): " default) 359 nil default)))) 360 ;; Handle something that is syntactically a directory name. 361 ;; Look for ChangeLog or whatever in that directory. 362 (if (string= (file-name-nondirectory name) "") 363 (expand-file-name (file-name-nondirectory default) 364 name) 365 ;; Handle specifying a file that is a directory. 366 (if (file-directory-p name) 367 (expand-file-name (file-name-nondirectory default) 368 (file-name-as-directory name)) 369 name)))) 370 371(defun change-log-version-number-search () 372 "Return version number of current buffer's file. 373This is the value returned by `vc-workfile-version' or, if that is 374nil, by matching `change-log-version-number-regexp-list'." 375 (let* ((size (buffer-size)) 376 (limit 377 ;; The version number can be anywhere in the file, but 378 ;; restrict search to the file beginning: 10% should be 379 ;; enough to prevent some mishits. 380 ;; 381 ;; Apply percentage only if buffer size is bigger than 382 ;; approx 100 lines. 383 (if (> size (* 100 80)) (+ (point) (/ size 10))))) 384 (or (and buffer-file-name (vc-workfile-version buffer-file-name)) 385 (save-restriction 386 (widen) 387 (let ((regexps change-log-version-number-regexp-list) 388 version) 389 (while regexps 390 (save-excursion 391 (goto-char (point-min)) 392 (when (re-search-forward (pop regexps) limit t) 393 (setq version (match-string 1) 394 regexps nil)))) 395 version))))) 396 397 398;;;###autoload 399(defun find-change-log (&optional file-name buffer-file) 400 "Find a change log file for \\[add-change-log-entry] and return the name. 401 402Optional arg FILE-NAME specifies the file to use. 403If FILE-NAME is nil, use the value of `change-log-default-name'. 404If `change-log-default-name' is nil, behave as though it were 'ChangeLog' 405\(or whatever we use on this operating system). 406 407If `change-log-default-name' contains a leading directory component, then 408simply find it in the current directory. Otherwise, search in the current 409directory and its successive parents for a file so named. 410 411Once a file is found, `change-log-default-name' is set locally in the 412current buffer to the complete file name. 413Optional arg BUFFER-FILE overrides `buffer-file-name'." 414 ;; If user specified a file name or if this buffer knows which one to use, 415 ;; just use that. 416 (or file-name 417 (setq file-name (and change-log-default-name 418 (file-name-directory change-log-default-name) 419 change-log-default-name)) 420 (progn 421 ;; Chase links in the source file 422 ;; and use the change log in the dir where it points. 423 (setq file-name (or (and (or buffer-file buffer-file-name) 424 (file-name-directory 425 (file-chase-links 426 (or buffer-file buffer-file-name)))) 427 default-directory)) 428 (if (file-directory-p file-name) 429 (setq file-name (expand-file-name (change-log-name) file-name))) 430 ;; Chase links before visiting the file. 431 ;; This makes it easier to use a single change log file 432 ;; for several related directories. 433 (setq file-name (file-chase-links file-name)) 434 (setq file-name (expand-file-name file-name)) 435 ;; Move up in the dir hierarchy till we find a change log file. 436 (let ((file1 file-name) 437 parent-dir) 438 (while (and (not (or (get-file-buffer file1) (file-exists-p file1))) 439 (progn (setq parent-dir 440 (file-name-directory 441 (directory-file-name 442 (file-name-directory file1)))) 443 ;; Give up if we are already at the root dir. 444 (not (string= (file-name-directory file1) 445 parent-dir)))) 446 ;; Move up to the parent dir and try again. 447 (setq file1 (expand-file-name 448 (file-name-nondirectory (change-log-name)) 449 parent-dir))) 450 ;; If we found a change log in a parent, use that. 451 (if (or (get-file-buffer file1) (file-exists-p file1)) 452 (setq file-name file1))))) 453 ;; Make a local variable in this buffer so we needn't search again. 454 (set (make-local-variable 'change-log-default-name) file-name) 455 file-name) 456 457(defun add-log-file-name (buffer-file log-file) 458 ;; Never want to add a change log entry for the ChangeLog file itself. 459 (unless (or (null buffer-file) (string= buffer-file log-file)) 460 (if add-log-file-name-function 461 (funcall add-log-file-name-function buffer-file) 462 (setq buffer-file 463 (if (string-match 464 (concat "^" (regexp-quote (file-name-directory log-file))) 465 buffer-file) 466 (substring buffer-file (match-end 0)) 467 (file-name-nondirectory buffer-file))) 468 ;; If we have a backup file, it's presumably because we're 469 ;; comparing old and new versions (e.g. for deleted 470 ;; functions) and we'll want to use the original name. 471 (if (backup-file-name-p buffer-file) 472 (file-name-sans-versions buffer-file) 473 buffer-file)))) 474 475;;;###autoload 476(defun add-change-log-entry (&optional whoami file-name other-window new-entry) 477 "Find change log file, and add an entry for today and an item for this file. 478Optional arg WHOAMI (interactive prefix) non-nil means prompt for user 479name and email (stored in `add-log-full-name' and `add-log-mailing-address'). 480 481Second arg FILE-NAME is file name of the change log. 482If nil, use the value of `change-log-default-name'. 483 484Third arg OTHER-WINDOW non-nil means visit in other window. 485 486Fourth arg NEW-ENTRY non-nil means always create a new entry at the front; 487never append to an existing entry. Option `add-log-keep-changes-together' 488otherwise affects whether a new entry is created. 489 490Option `add-log-always-start-new-record' non-nil means always create a 491new record, even when the last record was made on the same date and by 492the same person. 493 494The change log file can start with a copyright notice and a copying 495permission notice. The first blank line indicates the end of these 496notices. 497 498Today's date is calculated according to `add-log-time-zone-rule' if 499non-nil, otherwise in local time." 500 (interactive (list current-prefix-arg 501 (prompt-for-change-log-name))) 502 (let* ((defun (add-log-current-defun)) 503 (version (and change-log-version-info-enabled 504 (change-log-version-number-search))) 505 (buf-file-name (if add-log-buffer-file-name-function 506 (funcall add-log-buffer-file-name-function) 507 buffer-file-name)) 508 (buffer-file (if buf-file-name (expand-file-name buf-file-name))) 509 (file-name (expand-file-name (find-change-log file-name buffer-file))) 510 ;; Set ITEM to the file name to use in the new item. 511 (item (add-log-file-name buffer-file file-name)) 512 bound 513 (full-name (or add-log-full-name (user-full-name))) 514 (mailing-address (or add-log-mailing-address user-mail-address))) 515 516 (if whoami 517 (progn 518 (setq full-name (read-string "Full name: " full-name)) 519 ;; Note that some sites have room and phone number fields in 520 ;; full name which look silly when inserted. Rather than do 521 ;; anything about that here, let user give prefix argument so that 522 ;; s/he can edit the full name field in prompter if s/he wants. 523 (setq mailing-address 524 (read-string "Mailing address: " mailing-address)))) 525 526 (unless (equal file-name buffer-file-name) 527 (if (or other-window (window-dedicated-p (selected-window))) 528 (find-file-other-window file-name) 529 (find-file file-name))) 530 (or (eq major-mode 'change-log-mode) 531 (change-log-mode)) 532 (undo-boundary) 533 (goto-char (point-min)) 534 535 ;; If file starts with a copyright and permission notice, skip them. 536 ;; Assume they end at first blank line. 537 (when (looking-at "Copyright") 538 (search-forward "\n\n") 539 (skip-chars-forward "\n")) 540 541 ;; Advance into first entry if it is usable; else make new one. 542 (let ((new-entries 543 (mapcar (lambda (addr) 544 (concat 545 (if (stringp add-log-time-zone-rule) 546 (let ((tz (getenv "TZ"))) 547 (unwind-protect 548 (progn 549 (set-time-zone-rule add-log-time-zone-rule) 550 (funcall add-log-time-format)) 551 (set-time-zone-rule tz))) 552 (funcall add-log-time-format)) 553 " " full-name 554 " <" addr ">")) 555 (if (consp mailing-address) 556 mailing-address 557 (list mailing-address))))) 558 (if (and (not add-log-always-start-new-record) 559 (let ((hit nil)) 560 (dolist (entry new-entries hit) 561 (when (looking-at (regexp-quote entry)) 562 (setq hit t))))) 563 (forward-line 1) 564 (insert (nth (random (length new-entries)) 565 new-entries) 566 (if use-hard-newlines hard-newline "\n") 567 (if use-hard-newlines hard-newline "\n")) 568 (forward-line -1))) 569 570 ;; Determine where we should stop searching for a usable 571 ;; item to add to, within this entry. 572 (setq bound 573 (save-excursion 574 (if (looking-at "\n*[^\n* \t]") 575 (skip-chars-forward "\n") 576 (if add-log-keep-changes-together 577 (forward-page) ; page delimits entries for date 578 (forward-paragraph))) ; paragraph delimits entries for file 579 (point))) 580 581 ;; Now insert the new line for this item. 582 (cond ((re-search-forward "^\\s *\\*\\s *$" bound t) 583 ;; Put this file name into the existing empty item. 584 (if item 585 (insert item))) 586 ((and (not new-entry) 587 (let (case-fold-search) 588 (re-search-forward 589 (concat (regexp-quote (concat "* " item)) 590 ;; Don't accept `foo.bar' when 591 ;; looking for `foo': 592 "\\(\\s \\|[(),:]\\)") 593 bound t))) 594 ;; Add to the existing item for the same file. 595 (re-search-forward "^\\s *$\\|^\\s \\*") 596 (goto-char (match-beginning 0)) 597 ;; Delete excess empty lines; make just 2. 598 (while (and (not (eobp)) (looking-at "^\\s *$")) 599 (delete-region (point) (line-beginning-position 2))) 600 (insert (if use-hard-newlines hard-newline "\n") 601 (if use-hard-newlines hard-newline "\n")) 602 (forward-line -2) 603 (indent-relative-maybe)) 604 (t 605 ;; Make a new item. 606 (while (looking-at "\\sW") 607 (forward-line 1)) 608 (while (and (not (eobp)) (looking-at "^\\s *$")) 609 (delete-region (point) (line-beginning-position 2))) 610 (insert (if use-hard-newlines hard-newline "\n") 611 (if use-hard-newlines hard-newline "\n") 612 (if use-hard-newlines hard-newline "\n")) 613 (forward-line -2) 614 (indent-to left-margin) 615 (insert "* ") 616 (if item (insert item)))) 617 ;; Now insert the function name, if we have one. 618 ;; Point is at the item for this file, 619 ;; either at the end of the line or at the first blank line. 620 (if (not defun) 621 ;; No function name, so put in a colon unless we have just a star. 622 (unless (save-excursion 623 (beginning-of-line 1) 624 (looking-at "\\s *\\(\\*\\s *\\)?$")) 625 (insert ": ") 626 (if version (insert version ?\s))) 627 ;; Make it easy to get rid of the function name. 628 (undo-boundary) 629 (unless (save-excursion 630 (beginning-of-line 1) 631 (looking-at "\\s *$")) 632 (insert ?\s)) 633 ;; See if the prev function name has a message yet or not. 634 ;; If not, merge the two items. 635 (let ((pos (point-marker))) 636 (skip-syntax-backward " ") 637 (skip-chars-backward "):") 638 (if (and (looking-at "):") 639 (let ((pos (save-excursion (backward-sexp 1) (point)))) 640 (when (equal (buffer-substring pos (point)) defun) 641 (delete-region pos (point))) 642 (> fill-column (+ (current-column) (length defun) 4)))) 643 (progn (skip-chars-backward ", ") 644 (delete-region (point) pos) 645 (unless (memq (char-before) '(?\()) (insert ", "))) 646 (if (looking-at "):") 647 (delete-region (+ 1 (point)) (line-end-position))) 648 (goto-char pos) 649 (insert "(")) 650 (set-marker pos nil)) 651 (insert defun "): ") 652 (if version (insert version ?\s))))) 653 654;;;###autoload 655(defun add-change-log-entry-other-window (&optional whoami file-name) 656 "Find change log file in other window and add entry and item. 657This is just like `add-change-log-entry' except that it displays 658the change log file in another window." 659 (interactive (if current-prefix-arg 660 (list current-prefix-arg 661 (prompt-for-change-log-name)))) 662 (add-change-log-entry whoami file-name t)) 663;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window) 664 665(defvar change-log-indent-text 0) 666 667(defun change-log-indent () 668 (let* ((indent 669 (save-excursion 670 (beginning-of-line) 671 (skip-chars-forward " \t") 672 (cond 673 ((and (looking-at "\\(.*\\) [^ \n].*[^ \n] <.*>\\(?: +(.*)\\)? *$") 674 ;; Matching the output of add-log-time-format is difficult, 675 ;; but I'll get it has at least two adjacent digits. 676 (string-match "[[:digit:]][[:digit:]]" (match-string 1))) 677 0) 678 ((looking-at "[^*(]") 679 (+ (current-left-margin) change-log-indent-text)) 680 (t (current-left-margin))))) 681 (pos (save-excursion (indent-line-to indent) (point)))) 682 (if (> pos (point)) (goto-char pos)))) 683 684 685(defvar smerge-resolve-function) 686 687;;;###autoload 688(define-derived-mode change-log-mode text-mode "Change Log" 689 "Major mode for editing change logs; like Indented Text Mode. 690Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74. 691New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window]. 692Each entry behaves as a paragraph, and the entries for one day as a page. 693Runs `change-log-mode-hook'. 694\\{change-log-mode-map}" 695 (setq left-margin 8 696 fill-column 74 697 indent-tabs-mode t 698 tab-width 8) 699 (set (make-local-variable 'fill-paragraph-function) 700 'change-log-fill-paragraph) 701 (set (make-local-variable 'indent-line-function) 'change-log-indent) 702 (set (make-local-variable 'tab-always-indent) nil) 703 ;; We really do want "^" in paragraph-start below: it is only the 704 ;; lines that begin at column 0 (despite the left-margin of 8) that 705 ;; we are looking for. Adding `* ' allows eliding the blank line 706 ;; between entries for different files. 707 (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\<") 708 (set (make-local-variable 'paragraph-separate) paragraph-start) 709 ;; Match null string on the date-line so that the date-line 710 ;; is grouped with what follows. 711 (set (make-local-variable 'page-delimiter) "^\\<\\|^\f") 712 (set (make-local-variable 'version-control) 'never) 713 (set (make-local-variable 'smerge-resolve-function) 714 'change-log-resolve-conflict) 715 (set (make-local-variable 'adaptive-fill-regexp) "\\s *") 716 (set (make-local-variable 'font-lock-defaults) 717 '(change-log-font-lock-keywords t nil nil backward-paragraph))) 718 719;; It might be nice to have a general feature to replace this. The idea I 720;; have is a variable giving a regexp matching text which should not be 721;; moved from bol by filling. change-log-mode would set this to "^\\s *\\s(". 722;; But I don't feel up to implementing that today. 723(defun change-log-fill-paragraph (&optional justify) 724 "Fill the paragraph, but preserve open parentheses at beginning of lines. 725Prefix arg means justify as well." 726 (interactive "P") 727 (let ((end (progn (forward-paragraph) (point))) 728 (beg (progn (backward-paragraph) (point))) 729 (paragraph-start (concat paragraph-start "\\|\\s *\\s("))) 730 (fill-region beg end justify) 731 t)) 732 733(defcustom add-log-current-defun-header-regexp 734 "^\\([[:upper:]][[:upper:]_ ]*[[:upper:]_]\\|[-_[:alpha:]]+\\)[ \t]*[:=]" 735 "Heuristic regexp used by `add-log-current-defun' for unknown major modes." 736 :type 'regexp 737 :group 'change-log) 738 739;;;###autoload 740(defvar add-log-lisp-like-modes 741 '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode) 742 "*Modes that look like Lisp to `add-log-current-defun'.") 743 744;;;###autoload 745(defvar add-log-c-like-modes 746 '(c-mode c++-mode c++-c-mode objc-mode) 747 "*Modes that look like C to `add-log-current-defun'.") 748 749;;;###autoload 750(defvar add-log-tex-like-modes 751 '(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode) 752 "*Modes that look like TeX to `add-log-current-defun'.") 753 754;;;###autoload 755(defun add-log-current-defun () 756 "Return name of function definition point is in, or nil. 757 758Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...), 759Texinfo (@node titles) and Perl. 760 761Other modes are handled by a heuristic that looks in the 10K before 762point for uppercase headings starting in the first column or 763identifiers followed by `:' or `='. See variables 764`add-log-current-defun-header-regexp' and 765`add-log-current-defun-function'. 766 767Has a preference of looking backwards." 768 (condition-case nil 769 (save-excursion 770 (let ((location (point))) 771 (cond (add-log-current-defun-function 772 (funcall add-log-current-defun-function)) 773 ((memq major-mode add-log-lisp-like-modes) 774 ;; If we are now precisely at the beginning of a defun, 775 ;; make sure beginning-of-defun finds that one 776 ;; rather than the previous one. 777 (or (eobp) (forward-char 1)) 778 (beginning-of-defun) 779 ;; Make sure we are really inside the defun found, 780 ;; not after it. 781 (when (and (looking-at "\\s(") 782 (progn (end-of-defun) 783 (< location (point))) 784 (progn (forward-sexp -1) 785 (>= location (point)))) 786 (if (looking-at "\\s(") 787 (forward-char 1)) 788 ;; Skip the defining construct name, typically "defun" 789 ;; or "defvar". 790 (forward-sexp 1) 791 ;; The second element is usually a symbol being defined. 792 ;; If it is not, use the first symbol in it. 793 (skip-chars-forward " \t\n'(") 794 (buffer-substring-no-properties (point) 795 (progn (forward-sexp 1) 796 (point))))) 797 ((and (memq major-mode add-log-c-like-modes) 798 (save-excursion 799 (beginning-of-line) 800 ;; Use eq instead of = here to avoid 801 ;; error when at bob and char-after 802 ;; returns nil. 803 (while (eq (char-after (- (point) 2)) ?\\) 804 (forward-line -1)) 805 (looking-at "[ \t]*#[ \t]*define[ \t]"))) 806 ;; Handle a C macro definition. 807 (beginning-of-line) 808 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above 809 (forward-line -1)) 810 (search-forward "define") 811 (skip-chars-forward " \t") 812 (buffer-substring-no-properties (point) 813 (progn (forward-sexp 1) 814 (point)))) 815 ((memq major-mode add-log-c-like-modes) 816 ;; See whether the point is inside a defun. 817 (let (having-previous-defun 818 having-next-defun 819 previous-defun-end 820 next-defun-beginning) 821 822 (save-excursion 823 (setq having-previous-defun 824 (c-beginning-of-defun)) 825 (c-end-of-defun) 826 ;; `c-end-of-defun' moves point to the line after 827 ;; the function close, but the position we prefer 828 ;; here is the position after the final }. 829 (backward-sexp 1) 830 (forward-sexp 1) 831 ;; Skip the semicolon ``;'' for 832 ;; enum/union/struct/class definition. 833 (if (= (char-after (point)) ?\;) 834 (forward-char 1)) 835 (setq previous-defun-end (point))) 836 837 (save-excursion 838 (setq having-next-defun 839 (c-end-of-defun)) 840 (c-beginning-of-defun) 841 (setq next-defun-beginning (point))) 842 843 (if (and having-next-defun 844 (< location next-defun-beginning)) 845 (skip-syntax-forward " ")) 846 (if (and having-previous-defun 847 (> location previous-defun-end)) 848 (skip-syntax-backward " ")) 849 (unless (or 850 ;; When there is no previous defun, the 851 ;; point is not in a defun if it is not at 852 ;; the beginning of the next defun. 853 (and (not having-previous-defun) 854 (not (= (point) 855 next-defun-beginning))) 856 ;; When there is no next defun, the point 857 ;; is not in a defun if it is not at the 858 ;; end of the previous defun. 859 (and (not having-next-defun) 860 (not (= (point) 861 previous-defun-end))) 862 ;; If the point is between two defuns, it 863 ;; is not in a defun. 864 (and (> (point) previous-defun-end) 865 (< (point) next-defun-beginning))) 866 ;; If the point is already at the beginning of a 867 ;; defun, there is no need to move point again. 868 (if (not (= (point) next-defun-beginning)) 869 (c-beginning-of-defun)) 870 ;; Is this a DEFUN construct? And is LOCATION in it? 871 (if (and (looking-at "DEFUN\\b") 872 (>= location (point))) 873 ;; DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, ...) ==> Ffile_name_directory 874 ;; DEFUN(POSIX::STREAM-LOCK, stream lockp &key BLOCK SHARED START LENGTH) ==> POSIX::STREAM-LOCK 875 (progn 876 (down-list 1) 877 (when (= (char-after (point)) ?\") 878 (forward-sexp 1) 879 (search-forward ",")) 880 (skip-syntax-forward " ") 881 (buffer-substring-no-properties 882 (point) 883 (progn (search-forward ",") 884 (forward-char -1) 885 (skip-syntax-backward " ") 886 (point)))) 887 (if (looking-at "^[+-]") 888 ;; Objective-C 889 (change-log-get-method-definition) 890 ;; Ordinary C function syntax. 891 (let ((beg (point))) 892 (if (and 893 ;; Protect against "Unbalanced parens" error. 894 (condition-case nil 895 (progn 896 (down-list 1) ; into arglist 897 (backward-up-list 1) 898 (skip-chars-backward " \t") 899 t) 900 (error nil)) 901 ;; Verify initial pos was after 902 ;; real start of function. 903 (save-excursion 904 (goto-char beg) 905 ;; For this purpose, include the line 906 ;; that has the decl keywords. This 907 ;; may also include some of the 908 ;; comments before the function. 909 (while (and (not (bobp)) 910 (save-excursion 911 (forward-line -1) 912 (looking-at "[^\n\f]"))) 913 (forward-line -1)) 914 (>= location (point))) 915 ;; Consistency check: going down and up 916 ;; shouldn't take us back before BEG. 917 (> (point) beg)) 918 (let (end middle) 919 ;; Don't include any final whitespace 920 ;; in the name we use. 921 (skip-chars-backward " \t\n") 922 (setq end (point)) 923 (backward-sexp 1) 924 ;; Now find the right beginning of the name. 925 ;; Include certain keywords if they 926 ;; precede the name. 927 (setq middle (point)) 928 ;; We tried calling `forward-sexp' in a loop 929 ;; but it causes inconsistency for C names. 930 (forward-sexp -1) 931 ;; Is this C++ method? 932 (when (and (< 2 middle) 933 (string= (buffer-substring (- middle 2) 934 middle) 935 "::")) 936 ;; Include "classname::". 937 (setq middle (point))) 938 ;; Ignore these subparts of a class decl 939 ;; and move back to the class name itself. 940 (while (looking-at "public \\|private ") 941 (skip-chars-backward " \t:") 942 (setq end (point)) 943 (backward-sexp 1) 944 (setq middle (point)) 945 (forward-word -1)) 946 (and (bolp) 947 (looking-at 948 "enum \\|struct \\|union \\|class ") 949 (setq middle (point))) 950 (goto-char end) 951 (when (eq (preceding-char) ?=) 952 (forward-char -1) 953 (skip-chars-backward " \t") 954 (setq end (point))) 955 (buffer-substring-no-properties 956 middle end))))))))) 957 ((memq major-mode add-log-tex-like-modes) 958 (if (re-search-backward 959 "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" 960 nil t) 961 (progn 962 (goto-char (match-beginning 0)) 963 (buffer-substring-no-properties 964 (1+ (point)) ; without initial backslash 965 (line-end-position))))) 966 ((eq major-mode 'texinfo-mode) 967 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t) 968 (match-string-no-properties 1))) 969 ((memq major-mode '(perl-mode cperl-mode)) 970 (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t) 971 (match-string-no-properties 1))) 972 ;; Emacs's autoconf-mode installs its own 973 ;; `add-log-current-defun-function'. This applies to 974 ;; a different mode apparently for editing .m4 975 ;; autoconf source. 976 ((eq major-mode 'autoconf-mode) 977 (if (re-search-backward 978 "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t) 979 (match-string-no-properties 3))) 980 (t 981 ;; If all else fails, try heuristics 982 (let (case-fold-search 983 result) 984 (end-of-line) 985 (when (re-search-backward 986 add-log-current-defun-header-regexp 987 (- (point) 10000) 988 t) 989 (setq result (or (match-string-no-properties 1) 990 (match-string-no-properties 0))) 991 ;; Strip whitespace away 992 (when (string-match "\\([^ \t\n\r\f].*[^ \t\n\r\f]\\)" 993 result) 994 (setq result (match-string-no-properties 1 result))) 995 result)))))) 996 (error nil))) 997 998(defvar change-log-get-method-definition-md) 999 1000;; Subroutine used within change-log-get-method-definition. 1001;; Add the last match in the buffer to the end of `md', 1002;; followed by the string END; move to the end of that match. 1003(defun change-log-get-method-definition-1 (end) 1004 (setq change-log-get-method-definition-md 1005 (concat change-log-get-method-definition-md 1006 (match-string 1) 1007 end)) 1008 (goto-char (match-end 0))) 1009 1010(defun change-log-get-method-definition () 1011"For Objective C, return the method name if we are in a method." 1012 (let ((change-log-get-method-definition-md "[")) 1013 (save-excursion 1014 (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t) 1015 (change-log-get-method-definition-1 " "))) 1016 (save-excursion 1017 (cond 1018 ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t) 1019 (change-log-get-method-definition-1 "") 1020 (while (not (looking-at "[{;]")) 1021 (looking-at 1022 "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*") 1023 (change-log-get-method-definition-1 "")) 1024 (concat change-log-get-method-definition-md "]")))))) 1025 1026(defun change-log-sortable-date-at () 1027 "Return date of log entry in a consistent form for sorting. 1028Point is assumed to be at the start of the entry." 1029 (require 'timezone) 1030 (if (looking-at "^\\sw.........[0-9:+ ]*") 1031 (let ((date (match-string-no-properties 0))) 1032 (if date 1033 (if (string-match "\\(....\\)-\\(..\\)-\\(..\\)\\s-+" date) 1034 (concat (match-string 1 date) (match-string 2 date) 1035 (match-string 3 date)) 1036 (condition-case nil 1037 (timezone-make-date-sortable date) 1038 (error nil))))) 1039 (error "Bad date"))) 1040 1041(defun change-log-resolve-conflict () 1042 "Function to be used in `smerge-resolve-function'." 1043 (let ((buf (current-buffer))) 1044 (with-temp-buffer 1045 (insert-buffer-substring buf (match-beginning 1) (match-end 1)) 1046 (save-match-data (change-log-mode)) 1047 (let ((other-buf (current-buffer))) 1048 (with-current-buffer buf 1049 (save-excursion 1050 (save-restriction 1051 (narrow-to-region (match-beginning 0) (match-end 0)) 1052 (replace-match (match-string 3) t t) 1053 (change-log-merge other-buf)))))))) 1054 1055;;;###autoload 1056(defun change-log-merge (other-log) 1057 "Merge the contents of change log file OTHER-LOG with this buffer. 1058Both must be found in Change Log mode (since the merging depends on 1059the appropriate motion commands). OTHER-LOG can be either a file name 1060or a buffer. 1061 1062Entries are inserted in chronological order. Both the current and 1063old-style time formats for entries are supported." 1064 (interactive "*fLog file name to merge: ") 1065 (if (not (eq major-mode 'change-log-mode)) 1066 (error "Not in Change Log mode")) 1067 (let ((other-buf (if (bufferp other-log) other-log 1068 (find-file-noselect other-log))) 1069 (buf (current-buffer)) 1070 date1 start end) 1071 (save-excursion 1072 (goto-char (point-min)) 1073 (set-buffer other-buf) 1074 (goto-char (point-min)) 1075 (if (not (eq major-mode 'change-log-mode)) 1076 (error "%s not found in Change Log mode" other-log)) 1077 ;; Loop through all the entries in OTHER-LOG. 1078 (while (not (eobp)) 1079 (setq date1 (change-log-sortable-date-at)) 1080 (setq start (point) 1081 end (progn (forward-page) (point))) 1082 ;; Look for an entry in original buffer that isn't later. 1083 (with-current-buffer buf 1084 (while (and (not (eobp)) 1085 (string< date1 (change-log-sortable-date-at))) 1086 (forward-page)) 1087 (if (not (eobp)) 1088 (insert-buffer-substring other-buf start end) 1089 ;; At the end of the original buffer, insert a newline to 1090 ;; separate entries and then the rest of the file being 1091 ;; merged. 1092 (unless (or (bobp) 1093 (and (= ?\n (char-before)) 1094 (or (<= (1- (point)) (point-min)) 1095 (= ?\n (char-before (1- (point))))))) 1096 (insert (if use-hard-newlines hard-newline "\n"))) 1097 ;; Move to the end of it to terminate outer loop. 1098 (with-current-buffer other-buf 1099 (goto-char (point-max))) 1100 (insert-buffer-substring other-buf start))))))) 1101 1102;;;###autoload 1103(defun change-log-redate () 1104 "Fix any old-style date entries in the current log file to default format." 1105 (interactive) 1106 (require 'timezone) 1107 (save-excursion 1108 (goto-char (point-min)) 1109 (while (re-search-forward "^\\sw.........[0-9:+ ]*" nil t) 1110 (unless (= 12 (- (match-end 0) (match-beginning 0))) 1111 (let* ((date (save-match-data 1112 (timezone-fix-time (match-string 0) nil nil))) 1113 (zone (if (consp (aref date 6)) 1114 (nth 1 (aref date 6))))) 1115 (replace-match (format-time-string 1116 "%Y-%m-%d " 1117 (encode-time (aref date 5) 1118 (aref date 4) 1119 (aref date 3) 1120 (aref date 2) 1121 (aref date 1) 1122 (aref date 0) 1123 zone)))))))) 1124 1125(provide 'add-log) 1126 1127;; arch-tag: 81eee6fc-088f-4372-a37f-80ad9620e762 1128;;; add-log.el ends here 1129