| 1 |
|
|---|
| 2 |
|
|---|
| 3 |
|
|---|
| 4 |
|
|---|
| 5 |
|
|---|
| 6 |
|
|---|
| 7 |
|
|---|
| 8 |
|
|---|
| 9 |
|
|---|
| 10 |
|
|---|
| 11 |
|
|---|
| 12 |
|
|---|
| 13 |
|
|---|
| 14 |
|
|---|
| 15 |
|
|---|
| 16 |
|
|---|
| 17 |
|
|---|
| 18 |
|
|---|
| 19 |
|
|---|
| 20 |
|
|---|
| 21 |
|
|---|
| 22 |
|
|---|
| 23 |
|
|---|
| 24 |
|
|---|
| 25 |
|
|---|
| 26 |
|
|---|
| 27 |
|
|---|
| 28 |
|
|---|
| 29 |
|
|---|
| 30 |
|
|---|
| 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 |
|
|---|
| 56 |
|
|---|
| 57 |
(defcustom add-log-current-defun-function nil |
|---|
| 58 |
"*If non-nil, function to guess name of surrounding function. |
|---|
| 59 |
It is used by `add-log-current-defun' in preference to built-in rules. |
|---|
| 60 |
Returns function's name as a string, or nil if outside a function." |
|---|
| 61 |
:type '(choice (const nil) function) |
|---|
| 62 |
:group 'change-log) |
|---|
| 63 |
|
|---|
| 64 |
|
|---|
| 65 |
(defcustom add-log-full-name nil |
|---|
| 66 |
"*Full name of user, for inclusion in ChangeLog daily headers. |
|---|
| 67 |
This 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 |
|
|---|
| 73 |
(defcustom add-log-mailing-address nil |
|---|
| 74 |
"Email addresses of user, for inclusion in ChangeLog headers. |
|---|
| 75 |
This defaults to the value of `user-mail-address'. In addition to |
|---|
| 76 |
being a simple string, this value can also be a list. All elements |
|---|
| 77 |
will be recognized as referring to the same user; when creating a new |
|---|
| 78 |
ChangeLog 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. |
|---|
| 86 |
For example, `add-log-iso8601-time-string', which gives the |
|---|
| 87 |
date in international ISO 8601 format, |
|---|
| 88 |
and `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 |
|
|---|
| 99 |
Log 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 \ |
|---|
| 101 |
for that file made |
|---|
| 102 |
today if this variable is non-nil or that file comes first in today's |
|---|
| 103 |
entries. Otherwise another entry for that file will be started. An |
|---|
| 104 |
original log: |
|---|
| 105 |
|
|---|
| 106 |
* foo (...): ... |
|---|
| 107 |
* bar (...): change 1 |
|---|
| 108 |
|
|---|
| 109 |
in the latter case, \\[add-change-log-entry-other-window] in a \ |
|---|
| 110 |
buffer visiting `bar', yields: |
|---|
| 111 |
|
|---|
| 112 |
* bar (...): -!- |
|---|
| 113 |
* foo (...): ... |
|---|
| 114 |
* bar (...): change 1 |
|---|
| 115 |
|
|---|
| 116 |
and in the former: |
|---|
| 117 |
|
|---|
| 118 |
* foo (...): ... |
|---|
| 119 |
* bar (...): change 1 |
|---|
| 120 |
(...): -!- |
|---|
| 121 |
|
|---|
| 122 |
The NEW-ENTRY arg to `add-change-log-entry' can override the effect of |
|---|
| 123 |
this 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. |
|---|
| 136 |
This function is called with no argument. If this is nil, the default is to |
|---|
| 137 |
use `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. |
|---|
| 143 |
This 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 |
|---|
| 145 |
use 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 |
|
|---|
| 160 |
(concat "^(def[^ \t\n]+[ \t]+[^ \t\n][ \t]\"" re) |
|---|
| 161 |
|
|---|
| 162 |
(concat "^;+ *Revision: +[^ \t\n]+[ \t]+" re))) |
|---|
| 163 |
"*List of regexps to search for version number. |
|---|
| 164 |
The version number must be in group 1. |
|---|
| 165 |
Note: 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 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 232 |
(put 'change-log-acknowledgement-face 'face-alias 'change-log-acknowledgement) |
|---|
| 233 |
|
|---|
| 234 |
(defvar change-log-font-lock-keywords |
|---|
| 235 |
'( |
|---|
| 236 |
|
|---|
| 237 |
|
|---|
| 238 |
|
|---|
| 239 |
|
|---|
| 240 |
|
|---|
| 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 |
|
|---|
| 244 |
("\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" nil nil |
|---|
| 245 |
(1 'change-log-name) |
|---|
| 246 |
(2 'change-log-email))) |
|---|
| 247 |
|
|---|
| 248 |
|
|---|
| 249 |
("^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)" |
|---|
| 250 |
(2 'change-log-file) |
|---|
| 251 |
|
|---|
| 252 |
("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file)) |
|---|
| 253 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 266 |
("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 'change-log-conditionals)) |
|---|
| 267 |
|
|---|
| 268 |
|
|---|
| 269 |
("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function)) |
|---|
| 270 |
|
|---|
| 271 |
|
|---|
| 272 |
|
|---|
| 273 |
|
|---|
| 274 |
|
|---|
| 275 |
|
|---|
| 276 |
|
|---|
| 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 |
|
|---|
| 289 |
|
|---|
| 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. |
|---|
| 293 |
It takes the same format as the TZ argument of `set-time-zone-rule'. |
|---|
| 294 |
If nil, use local time. |
|---|
| 295 |
If 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. |
|---|
| 330 |
With 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. |
|---|
| 349 |
With a numeric prefix ARG, go back ARG comments." |
|---|
| 350 |
(interactive "*p") |
|---|
| 351 |
(add-log-edit-prev-comment (- arg))) |
|---|
| 352 |
|
|---|
| 353 |
|
|---|
| 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 |
|
|---|
| 361 |
|
|---|
| 362 |
(if (string= (file-name-nondirectory name) "") |
|---|
| 363 |
(expand-file-name (file-name-nondirectory default) |
|---|
| 364 |
name) |
|---|
| 365 |
|
|---|
| 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. |
|---|
| 373 |
This is the value returned by `vc-workfile-version' or, if that is |
|---|
| 374 |
nil, by matching `change-log-version-number-regexp-list'." |
|---|
| 375 |
(let* ((size (buffer-size)) |
|---|
| 376 |
(limit |
|---|
| 377 |
|
|---|
| 378 |
|
|---|
| 379 |
|
|---|
| 380 |
|
|---|
| 381 |
|
|---|
| 382 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 402 |
Optional arg FILE-NAME specifies the file to use. |
|---|
| 403 |
If FILE-NAME is nil, use the value of `change-log-default-name'. |
|---|
| 404 |
If `change-log-default-name' is nil, behave as though it were 'ChangeLog' |
|---|
| 405 |
\(or whatever we use on this operating system). |
|---|
| 406 |
|
|---|
| 407 |
If `change-log-default-name' contains a leading directory component, then |
|---|
| 408 |
simply find it in the current directory. Otherwise, search in the current |
|---|
| 409 |
directory and its successive parents for a file so named. |
|---|
| 410 |
|
|---|
| 411 |
Once a file is found, `change-log-default-name' is set locally in the |
|---|
| 412 |
current buffer to the complete file name. |
|---|
| 413 |
Optional arg BUFFER-FILE overrides `buffer-file-name'." |
|---|
| 414 |
|
|---|
| 415 |
|
|---|
| 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 |
|
|---|
| 422 |
|
|---|
| 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 |
|
|---|
| 431 |
|
|---|
| 432 |
|
|---|
| 433 |
(setq file-name (file-chase-links file-name)) |
|---|
| 434 |
(setq file-name (expand-file-name file-name)) |
|---|
| 435 |
|
|---|
| 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 |
|
|---|
| 444 |
(not (string= (file-name-directory file1) |
|---|
| 445 |
parent-dir)))) |
|---|
| 446 |
|
|---|
| 447 |
(setq file1 (expand-file-name |
|---|
| 448 |
(file-name-nondirectory (change-log-name)) |
|---|
| 449 |
parent-dir))) |
|---|
| 450 |
|
|---|
| 451 |
(if (or (get-file-buffer file1) (file-exists-p file1)) |
|---|
| 452 |
(setq file-name file1))))) |
|---|
| 453 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 469 |
|
|---|
| 470 |
|
|---|
| 471 |
(if (backup-file-name-p buffer-file) |
|---|
| 472 |
(file-name-sans-versions buffer-file) |
|---|
| 473 |
buffer-file)))) |
|---|
| 474 |
|
|---|
| 475 |
|
|---|
| 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. |
|---|
| 478 |
Optional arg WHOAMI (interactive prefix) non-nil means prompt for user |
|---|
| 479 |
name and email (stored in `add-log-full-name' and `add-log-mailing-address'). |
|---|
| 480 |
|
|---|
| 481 |
Second arg FILE-NAME is file name of the change log. |
|---|
| 482 |
If nil, use the value of `change-log-default-name'. |
|---|
| 483 |
|
|---|
| 484 |
Third arg OTHER-WINDOW non-nil means visit in other window. |
|---|
| 485 |
|
|---|
| 486 |
Fourth arg NEW-ENTRY non-nil means always create a new entry at the front; |
|---|
| 487 |
never append to an existing entry. Option `add-log-keep-changes-together' |
|---|
| 488 |
otherwise affects whether a new entry is created. |
|---|
| 489 |
|
|---|
| 490 |
Option `add-log-always-start-new-record' non-nil means always create a |
|---|
| 491 |
new record, even when the last record was made on the same date and by |
|---|
| 492 |
the same person. |
|---|
| 493 |
|
|---|
| 494 |
The change log file can start with a copyright notice and a copying |
|---|
| 495 |
permission notice. The first blank line indicates the end of these |
|---|
| 496 |
notices. |
|---|
| 497 |
|
|---|
| 498 |
Today's date is calculated according to `add-log-time-zone-rule' if |
|---|
| 499 |
non-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 |
|
|---|
| 511 |
(item (add-log-file-name buffer-file file-name)) |
|---|
| 512 |
bound full-name mailing-address) |
|---|
| 513 |
|
|---|
| 514 |
(if whoami |
|---|
| 515 |
(progn |
|---|
| 516 |
(setq full-name (read-string "Full name: " |
|---|
| 517 |
(or add-log-full-name (user-full-name)))) |
|---|
| 518 |
|
|---|
| 519 |
|
|---|
| 520 |
|
|---|
| 521 |
|
|---|
| 522 |
(setq mailing-address |
|---|
| 523 |
(read-string "Mailing address: " |
|---|
| 524 |
(or add-log-mailing-address user-mail-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 |
(or full-name |
|---|
| 536 |
(setq full-name (or add-log-full-name (user-full-name)))) |
|---|
| 537 |
(or mailing-address |
|---|
| 538 |
(setq mailing-address (or add-log-mailing-address user-mail-address))) |
|---|
| 539 |
|
|---|
| 540 |
|
|---|
| 541 |
|
|---|
| 542 |
(when (looking-at "Copyright") |
|---|
| 543 |
(search-forward "\n\n") |
|---|
| 544 |
(skip-chars-forward "\n")) |
|---|
| 545 |
|
|---|
| 546 |
|
|---|
| 547 |
(let ((new-entries |
|---|
| 548 |
(mapcar (lambda (addr) |
|---|
| 549 |
(concat |
|---|
| 550 |
(if (stringp add-log-time-zone-rule) |
|---|
| 551 |
(let ((tz (getenv "TZ"))) |
|---|
| 552 |
(unwind-protect |
|---|
| 553 |
(progn |
|---|
| 554 |
(set-time-zone-rule add-log-time-zone-rule) |
|---|
| 555 |
(funcall add-log-time-format)) |
|---|
| 556 |
(set-time-zone-rule tz))) |
|---|
| 557 |
(funcall add-log-time-format)) |
|---|
| 558 |
" " full-name |
|---|
| 559 |
" <" addr ">")) |
|---|
| 560 |
(if (consp mailing-address) |
|---|
| 561 |
mailing-address |
|---|
| 562 |
(list mailing-address))))) |
|---|
| 563 |
(if (and (not add-log-always-start-new-record) |
|---|
| 564 |
(let ((hit nil)) |
|---|
| 565 |
(dolist (entry new-entries hit) |
|---|
| 566 |
(when (looking-at (regexp-quote entry)) |
|---|
| 567 |
(setq hit t))))) |
|---|
| 568 |
(forward-line 1) |
|---|
| 569 |
(insert (nth (random (length new-entries)) |
|---|
| 570 |
new-entries) |
|---|
| 571 |
(if use-hard-newlines hard-newline "\n") |
|---|
| 572 |
(if use-hard-newlines hard-newline "\n")) |
|---|
| 573 |
(forward-line -1))) |
|---|
| 574 |
|
|---|
| 575 |
|
|---|
| 576 |
|
|---|
| 577 |
(setq bound |
|---|
| 578 |
(save-excursion |
|---|
| 579 |
(if (looking-at "\n*[^\n* \t]") |
|---|
| 580 |
(skip-chars-forward "\n") |
|---|
| 581 |
(if add-log-keep-changes-together |
|---|
| 582 |
(forward-page) |
|---|
| 583 |
(forward-paragraph))) |
|---|
| 584 |
(point))) |
|---|
| 585 |
|
|---|
| 586 |
|
|---|
| 587 |
(cond ((re-search-forward "^\\s *\\*\\s *$" bound t) |
|---|
| 588 |
|
|---|
| 589 |
(if item |
|---|
| 590 |
(insert item))) |
|---|
| 591 |
((and (not new-entry) |
|---|
| 592 |
(let (case-fold-search) |
|---|
| 593 |
(re-search-forward |
|---|
| 594 |
(concat (regexp-quote (concat "* " item)) |
|---|
| 595 |
|
|---|
| 596 |
|
|---|
| 597 |
"\\(\\s \\|[(),:]\\)") |
|---|
| 598 |
bound t))) |
|---|
| 599 |
|
|---|
| 600 |
(re-search-forward "^\\s *$\\|^\\s \\*") |
|---|
| 601 |
(goto-char (match-beginning 0)) |
|---|
| 602 |
|
|---|
| 603 |
(while (and (not (eobp)) (looking-at "^\\s *$")) |
|---|
| 604 |
(delete-region (point) (line-beginning-position 2))) |
|---|
| 605 |
(insert (if use-hard-newlines hard-newline "\n") |
|---|
| 606 |
(if use-hard-newlines hard-newline "\n")) |
|---|
| 607 |
(forward-line -2) |
|---|
| 608 |
(indent-relative-maybe)) |
|---|
| 609 |
(t |
|---|
| 610 |
|
|---|
| 611 |
(while (looking-at "\\sW") |
|---|
| 612 |
(forward-line 1)) |
|---|
| 613 |
(while (and (not (eobp)) (looking-at "^\\s *$")) |
|---|
| 614 |
(delete-region (point) (line-beginning-position 2))) |
|---|
| 615 |
(insert (if use-hard-newlines hard-newline "\n") |
|---|
| 616 |
(if use-hard-newlines hard-newline "\n") |
|---|
| 617 |
(if use-hard-newlines hard-newline "\n")) |
|---|
| 618 |
(forward-line -2) |
|---|
| 619 |
(indent-to left-margin) |
|---|
| 620 |
(insert "* ") |
|---|
| 621 |
(if item (insert item)))) |
|---|
| 622 |
|
|---|
| 623 |
|
|---|
| 624 |
|
|---|
| 625 |
(if (not defun) |
|---|
| 626 |
|
|---|
| 627 |
(unless (save-excursion |
|---|
| 628 |
(beginning-of-line 1) |
|---|
| 629 |
(looking-at "\\s *\\(\\*\\s *\\)?$")) |
|---|
| 630 |
(insert ": ") |
|---|
| 631 |
(if version (insert version ?\s))) |
|---|
| 632 |
|
|---|
| 633 |
(undo-boundary) |
|---|
| 634 |
(unless (save-excursion |
|---|
| 635 |
(beginning-of-line 1) |
|---|
| 636 |
(looking-at "\\s *$")) |
|---|
| 637 |
(insert ?\s)) |
|---|
| 638 |
|
|---|
| 639 |
|
|---|
| 640 |
(let ((pos (point-marker))) |
|---|
| 641 |
(skip-syntax-backward " ") |
|---|
| 642 |
(skip-chars-backward "):") |
|---|
| 643 |
(if (and (looking-at "):") |
|---|
| 644 |
(let ((pos (save-excursion (backward-sexp 1) (point)))) |
|---|
| 645 |
(when (equal (buffer-substring pos (point)) defun) |
|---|
| 646 |
(delete-region pos (point))) |
|---|
| 647 |
(> fill-column (+ (current-column) (length defun) 4)))) |
|---|
| 648 |
(progn (skip-chars-backward ", ") |
|---|
| 649 |
(delete-region (point) pos) |
|---|
| 650 |
(unless (memq (char-before) '(?\()) (insert ", "))) |
|---|
| 651 |
(if (looking-at "):") |
|---|
| 652 |
(delete-region (+ 1 (point)) (line-end-position))) |
|---|
| 653 |
(goto-char pos) |
|---|
| 654 |
(insert "(")) |
|---|
| 655 |
(set-marker pos nil)) |
|---|
| 656 |
(insert defun "): ") |
|---|
| 657 |
(if version (insert version ?\s))))) |
|---|
| 658 |
|
|---|
| 659 |
|
|---|
| 660 |
(defun add-change-log-entry-other-window (&optional whoami file-name) |
|---|
| 661 |
"Find change log file in other window and add entry and item. |
|---|
| 662 |
This is just like `add-change-log-entry' except that it displays |
|---|
| 663 |
the change log file in another window." |
|---|
| 664 |
(interactive (if current-prefix-arg |
|---|
| 665 |
(list current-prefix-arg |
|---|
| 666 |
(prompt-for-change-log-name)))) |
|---|
| 667 |
(add-change-log-entry whoami file-name t)) |
|---|
| 668 |
|
|---|
| 669 |
(defvar change-log-indent-text 0) |
|---|
| 670 |
|
|---|
| 671 |
(defun change-log-indent () |
|---|
| 672 |
(let* ((indent |
|---|
| 673 |
(save-excursion |
|---|
| 674 |
(beginning-of-line) |
|---|
| 675 |
(skip-chars-forward " \t") |
|---|
| 676 |
(cond |
|---|
| 677 |
((and (looking-at "\\(.*\\) [^ \n].*[^ \n] <.*>\\(?: +(.*)\\)? *$") |
|---|
| 678 |
|
|---|
| 679 |
|
|---|
| 680 |
(string-match "[[:digit:]][[:digit:]]" (match-string 1))) |
|---|
| 681 |
0) |
|---|
| 682 |
((looking-at "[^*(]") |
|---|
| 683 |
(+ (current-left-margin) change-log-indent-text)) |
|---|
| 684 |
(t (current-left-margin))))) |
|---|
| 685 |
(pos (save-excursion (indent-line-to indent) (point)))) |
|---|
| 686 |
(if (> pos (point)) (goto-char pos)))) |
|---|
| 687 |
|
|---|
| 688 |
|
|---|
| 689 |
(defvar smerge-resolve-function) |
|---|
| 690 |
|
|---|
| 691 |
|
|---|
| 692 |
(define-derived-mode change-log-mode text-mode "Change Log" |
|---|
| 693 |
"Major mode for editing change logs; like Indented Text Mode. |
|---|
| 694 |
Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74. |
|---|
| 695 |
New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window]. |
|---|
| 696 |
Each entry behaves as a paragraph, and the entries for one day as a page. |
|---|
| 697 |
Runs `change-log-mode-hook'. |
|---|
| 698 |
\\{change-log-mode-map}" |
|---|
| 699 |
(setq left-margin 8 |
|---|
| 700 |
fill-column 74 |
|---|
| 701 |
indent-tabs-mode t |
|---|
| 702 |
tab-width 8) |
|---|
| 703 |
(set (make-local-variable 'fill-paragraph-function) |
|---|
| 704 |
'change-log-fill-paragraph) |
|---|
| 705 |
(set (make-local-variable 'indent-line-function) 'change-log-indent) |
|---|
| 706 |
(set (make-local-variable 'tab-always-indent) nil) |
|---|
| 707 |
|
|---|
| 708 |
|
|---|
| 709 |
|
|---|
| 710 |
|
|---|
| 711 |
(set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\<") |
|---|
| 712 |
(set (make-local-variable 'paragraph-separate) paragraph-start) |
|---|
| 713 |
|
|---|
| 714 |
|
|---|
| 715 |
(set (make-local-variable 'page-delimiter) "^\\<\\|^\f") |
|---|
| 716 |
(set (make-local-variable 'version-control) 'never) |
|---|
| 717 |
(set (make-local-variable 'smerge-resolve-function) |
|---|
| 718 |
'change-log-resolve-conflict) |
|---|
| 719 |
(set (make-local-variable 'adaptive-fill-regexp) "\\s *") |
|---|
| 720 |
(set (make-local-variable 'font-lock-defaults) |
|---|
| 721 |
'(change-log-font-lock-keywords t nil nil backward-paragraph))) |
|---|
| 722 |
|
|---|
| 723 |
|
|---|
| 724 |
|
|---|
| 725 |
|
|---|
| 726 |
|
|---|
| 727 |
(defun change-log-fill-paragraph (&optional justify) |
|---|
| 728 |
"Fill the paragraph, but preserve open parentheses at beginning of lines. |
|---|
| 729 |
Prefix arg means justify as well." |
|---|
| 730 |
(interactive "P") |
|---|
| 731 |
(let ((end (progn (forward-paragraph) (point))) |
|---|
| 732 |
(beg (progn (backward-paragraph) (point))) |
|---|
| 733 |
(paragraph-start (concat paragraph-start "\\|\\s *\\s("))) |
|---|
| 734 |
(fill-region beg end justify) |
|---|
| 735 |
t)) |
|---|
| 736 |
|
|---|
| 737 |
(defcustom add-log-current-defun-header-regexp |
|---|
| 738 |
"^\\([[:upper:]][[:upper:]_ ]*[[:upper:]_]\\|[-_[:alpha:]]+\\)[ \t]*[:=]" |
|---|
| 739 |
"Heuristic regexp used by `add-log-current-defun' for unknown major modes." |
|---|
| 740 |
:type 'regexp |
|---|
| 741 |
:group 'change-log) |
|---|
| 742 |
|
|---|
| 743 |
|
|---|
| 744 |
(defvar add-log-lisp-like-modes |
|---|
| 745 |
'(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode) |
|---|
| 746 |
"*Modes that look like Lisp to `add-log-current-defun'.") |
|---|
| 747 |
|
|---|
| 748 |
|
|---|
| 749 |
(defvar add-log-c-like-modes |
|---|
| 750 |
'(c-mode c++-mode c++-c-mode objc-mode) |
|---|
| 751 |
"*Modes that look like C to `add-log-current-defun'.") |
|---|
| 752 |
|
|---|
| 753 |
|
|---|
| 754 |
(defvar add-log-tex-like-modes |
|---|
| 755 |
'(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode) |
|---|
| 756 |
"*Modes that look like TeX to `add-log-current-defun'.") |
|---|
| 757 |
|
|---|
| 758 |
|
|---|
| 759 |
(defun add-log-current-defun () |
|---|
| 760 |
"Return name of function definition point is in, or nil. |
|---|
| 761 |
|
|---|
| 762 |
Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...), |
|---|
| 763 |
Texinfo (@node titles) and Perl. |
|---|
| 764 |
|
|---|
| 765 |
Other modes are handled by a heuristic that looks in the 10K before |
|---|
| 766 |
point for uppercase headings starting in the first column or |
|---|
| 767 |
identifiers followed by `:' or `='. See variables |
|---|
| 768 |
`add-log-current-defun-header-regexp' and |
|---|
| 769 |
`add-log-current-defun-function'. |
|---|
| 770 |
|
|---|
| 771 |
Has a preference of looking backwards." |
|---|
| 772 |
(condition-case nil |
|---|
| 773 |
(save-excursion |
|---|
| 774 |
(let ((location (point))) |
|---|
| 775 |
(cond (add-log-current-defun-function |
|---|
| 776 |
(funcall add-log-current-defun-function)) |
|---|
| 777 |
((memq major-mode add-log-lisp-like-modes) |
|---|
| 778 |
|
|---|
| 779 |
|
|---|
| 780 |
|
|---|
| 781 |
(or (eobp) (forward-char 1)) |
|---|
| 782 |
(beginning-of-defun) |
|---|
| 783 |
|
|---|
| 784 |
|
|---|
| 785 |
(when (and (looking-at "\\s(") |
|---|
| 786 |
(progn (end-of-defun) |
|---|
| 787 |
(< location (point))) |
|---|
| 788 |
(progn (forward-sexp -1) |
|---|
| 789 |
(>= location (point)))) |
|---|
| 79 |
|---|