Mercurial > hg > xemacs-beta
comparison lisp/packages/filladapt.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | ec9a17fef872 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; filladapt.el --- adaptive fill; replacement for fill commands | |
| 2 | |
| 3 ;; Keywords: wp | |
| 4 | |
| 5 ;;; Copyright (C) 1989, 1995, 1996 Kyle E. Jones | |
| 6 ;;; | |
| 7 ;;; This program is free software; you can redistribute it and/or modify | |
| 8 ;;; it under the terms of the GNU General Public License as published by | |
| 9 ;;; the Free Software Foundation; either version 2, or (at your option) | |
| 10 ;;; any later version. | |
| 11 ;;; | |
| 12 ;;; This program is distributed in the hope that it will be useful, | |
| 13 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 15 ;;; GNU General Public License for more details. | |
| 16 ;;; | |
| 17 ;;; A copy of the GNU General Public License can be obtained from this | |
| 18 ;;; program's author (send electronic mail to kyle@uunet.uu.net) or from | |
| 19 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA | |
| 20 ;;; 02139, USA. | |
| 21 ;;; | |
| 22 ;;; Send bug reports to kyle@wonderworks.com | |
| 23 | |
| 24 ;;; Synched up with: Not in FSF. | |
| 25 | |
| 26 ;; LCD Archive Entry: | |
| 27 ;; filladapt|Kyle Jones|kyle_jones@wonderworks.com| | |
| 28 ;; Minor mode to adaptively set fill-prefix and overload filling functions| | |
| 29 ;; 10-June-1996|2.08|~/packages/filladapt.el| | |
| 30 | |
| 31 ;; These functions enhance the default behavior of Emacs' Auto Fill | |
| 32 ;; mode and the commands fill-paragraph, lisp-fill-paragraph and | |
| 33 ;; fill-region-as-paragraph. | |
| 34 ;; | |
| 35 ;; The chief improvement is that the beginning of a line to be | |
| 36 ;; filled is examined and, based on information gathered, an | |
| 37 ;; appropriate value for fill-prefix is constructed. Also the | |
| 38 ;; boundaries of the current paragraph are located. This occurs | |
| 39 ;; only if the fill prefix is not already non-nil. | |
| 40 ;; | |
| 41 ;; The net result of this is that blurbs of text that are offset | |
| 42 ;; from left margin by asterisks, dashes, and/or spaces, numbered | |
| 43 ;; examples, included text from USENET news articles, etc. are | |
| 44 ;; generally filled correctly with no fuss. | |
| 45 ;; | |
| 46 ;; Since this package replaces existing Emacs functions, it cannot | |
| 47 ;; be autoloaded. Save this in a file named filladapt.el in a | |
| 48 ;; Lisp directory that Emacs knows about, byte-compile it and put | |
| 49 ;; (require 'filladapt) | |
| 50 ;; in your .emacs file. | |
| 51 ;; | |
| 52 ;; Note that in this release Filladapt mode is a minor mode and it is | |
| 53 ;; _off_ by default. If you want it to be on by default, use | |
| 54 ;; (setq-default filladapt-mode t) | |
| 55 ;; | |
| 56 ;; M-x filladapt-mode toggles Filladapt mode on/off in the current | |
| 57 ;; buffer. | |
| 58 ;; | |
| 59 ;; Use | |
| 60 ;; (add-hook 'text-mode-hook 'turn-on-filladapt-mode) | |
| 61 ;; to have Filladapt always enabled in Text mode. | |
| 62 ;; | |
| 63 ;; Use | |
| 64 ;; (add-hook 'c-mode-hook 'turn-off-filladapt-mode) | |
| 65 ;; to have Filladapt always disabled in C mode. | |
| 66 ;; | |
| 67 ;; In many cases, you can extend Filladapt by adding appropriate | |
| 68 ;; entries to the following three `defvar's. See `postscript-comment' | |
| 69 ;; or `texinfo-comment' as a sample of what needs to be done. | |
| 70 ;; | |
| 71 ;; filladapt-token-table | |
| 72 ;; filladapt-token-match-table | |
| 73 ;; filladapt-token-conversion-table | |
| 74 | |
| 75 (provide 'filladapt) | |
| 76 | |
| 77 (defvar filladapt-version "2.08" | |
| 78 "Version string for filladapt.") | |
| 79 | |
| 80 (defvar filladapt-mode nil | |
| 81 "*Non-nil means that Filladapt minor mode is enabled. | |
| 82 Use the filladapt-mode command to toggle the mode on/off.") | |
| 83 (make-variable-buffer-local 'filladapt-mode) | |
| 84 | |
| 85 (defvar filladapt-mode-line-string " Filladapt" | |
| 86 "*String to display in the modeline when Filladapt mode is active. | |
| 87 Set this to nil if you don't want a modeline indicator for Filladapt.") | |
| 88 | |
| 89 ;; install on minor-mode-alist | |
| 90 (or (assq 'filladapt-mode minor-mode-alist) | |
| 91 (setq minor-mode-alist (cons (list 'filladapt-mode | |
| 92 'filladapt-mode-line-string) | |
| 93 minor-mode-alist))) | |
| 94 | |
| 95 (defvar filladapt-token-table | |
| 96 '( | |
| 97 ;; Included text in news or mail replies | |
| 98 (">+" . citation->) | |
| 99 ;; Included text generated by SUPERCITE. We can't hope to match all | |
| 100 ;; the possible variations, your mileage may vary. | |
| 101 ("[A-Za-z0-9][^'`\"< \t\n]*>[ \t]*" . supercite-citation) | |
| 102 ;; Lisp comments | |
| 103 (";+" . lisp-comment) | |
| 104 ;; UNIX shell comments | |
| 105 ("#+" . sh-comment) | |
| 106 ;; Postscript comments | |
| 107 ("%+" . postscript-comment) | |
| 108 ;; C++ comments | |
| 109 ("///*" . c++-comment) | |
| 110 ;; Texinfo comments | |
| 111 ("@c[ \t]" . texinfo-comment) | |
| 112 ("@comment[ \t]" . texinfo-comment) | |
| 113 ;; Bullet types. | |
| 114 ;; | |
| 115 ;; 1. xxxxx | |
| 116 ;; xxxxx | |
| 117 ;; | |
| 118 ("[0-9]+\\.[ \t]" . bullet) | |
| 119 ;; | |
| 120 ;; 2.1.3 xxxxx xx x xx x | |
| 121 ;; xxx | |
| 122 ;; | |
| 123 ("[0-9]+\\(\\.[0-9]+\\)+[ \t]" . bullet) | |
| 124 ;; | |
| 125 ;; a. xxxxxx xx | |
| 126 ;; xxx xxx | |
| 127 ;; | |
| 128 ("[A-Za-z]\\.[ \t]" . bullet) | |
| 129 ;; | |
| 130 ;; 1) xxxx x xx x xx or (1) xx xx x x xx xx | |
| 131 ;; xx xx xxxx xxx xx x x xx x | |
| 132 ;; | |
| 133 ("(?[0-9]+)[ \t]" . bullet) | |
| 134 ;; | |
| 135 ;; a) xxxx x xx x xx or (a) xx xx x x xx xx | |
| 136 ;; xx xx xxxx xxx xx x x xx x | |
| 137 ;; | |
| 138 ("(?[A-Za-z])[ \t]" . bullet) | |
| 139 ;; | |
| 140 ;; 2a. xx x xxx x x xxx | |
| 141 ;; xxx xx x xx x | |
| 142 ;; | |
| 143 ("[0-9]+[A-Za-z]\\.[ \t]" . bullet) | |
| 144 ;; | |
| 145 ;; 1a) xxxx x xx x xx or (1a) xx xx x x xx xx | |
| 146 ;; xx xx xxxx xxx xx x x xx x | |
| 147 ;; | |
| 148 ("(?[0-9]+[A-Za-z])[ \t]" . bullet) | |
| 149 ;; | |
| 150 ;; - xx xxx xxxx or * xx xx x xxx xxx | |
| 151 ;; xxx xx xx x xxx x xx x x x | |
| 152 ;; | |
| 153 ("[-~*+]+[ \t]" . bullet) | |
| 154 ;; | |
| 155 ;; o xx xxx xxxx xx x xx xxx x xxx xx x xxx | |
| 156 ;; xxx xx xx | |
| 157 ;; | |
| 158 ("o[ \t]" . bullet) | |
| 159 ;; don't touch | |
| 160 ("[ \t]+" . space) | |
| 161 ("$" . end-of-line) | |
| 162 ) | |
| 163 "Table of tokens filladapt knows about. | |
| 164 Format is | |
| 165 | |
| 166 ((REGEXP . SYM) ...) | |
| 167 | |
| 168 filladapt uses this table to build a tokenized representation of | |
| 169 the beginning of the current line. Each REGEXP is matched | |
| 170 against the beginning of the line until a match is found. | |
| 171 Matching is done case-sensitively. The corresponding SYM is | |
| 172 added to the list, point is moved to (match-end 0) and the | |
| 173 process is repeated. The process ends when there is no REGEXP in | |
| 174 the table that matches what is at point.") | |
| 175 | |
| 176 (defvar filladapt-not-token-table | |
| 177 '( | |
| 178 "[Ee].g." | |
| 179 "[Ii].e." | |
| 180 ;; end-of-line isn't a token if whole line is empty | |
| 181 "^$" | |
| 182 ) | |
| 183 "List of regexps that can never be a token. | |
| 184 Before trying the regular expressions in filladapt-token-table, | |
| 185 the regexps in this list are tried. If any regexp in this list | |
| 186 matches what is at point then the token generator gives up and | |
| 187 doesn't try any of the regexps in filladapt-token-table. | |
| 188 | |
| 189 Regexp matching is done case-sensitively.") | |
| 190 | |
| 191 (defvar filladapt-token-match-table | |
| 192 '( | |
| 193 (citation-> citation->) | |
| 194 (supercite-citation supercite-citation) | |
| 195 (lisp-comment lisp-comment) | |
| 196 (sh-comment sh-comment) | |
| 197 (postscript-comment postscript-comment) | |
| 198 (c++-comment c++-comment) | |
| 199 (texinfo-comment texinfo-comment) | |
| 200 (bullet) | |
| 201 (space bullet space) | |
| 202 ) | |
| 203 "Table describing what tokens a certain token will match. | |
| 204 | |
| 205 To decide whether a line belongs in the current paragraph, | |
| 206 filladapt creates a token list for the fill prefix of both lines. | |
| 207 Tokens and the columns where tokens end are compared. This table | |
| 208 specifies what a certain token will match. | |
| 209 | |
| 210 Table format is | |
| 211 | |
| 212 (SYM [SYM1 [SYM2 ...]]) | |
| 213 | |
| 214 The first symbol SYM is the token, subsequent symbols are the | |
| 215 tokens that SYM will match.") | |
| 216 | |
| 217 (defvar filladapt-token-match-many-table | |
| 218 '( | |
| 219 space | |
| 220 ) | |
| 221 "List of tokens that can match multiple tokens. | |
| 222 If one of these tokens appears in a token list, it will eat all | |
| 223 matching tokens in a token list being matched against it until it | |
| 224 encounters a token that doesn't match or a token that ends on | |
| 225 a greater column number.") | |
| 226 | |
| 227 (defvar filladapt-token-paragraph-start-table | |
| 228 '( | |
| 229 bullet | |
| 230 ) | |
| 231 "List of tokens that indicate the start of a paragraph. | |
| 232 If parsing a line generates a token list containing one of | |
| 233 these tokens, then the line is considered to be the start of a | |
| 234 paragraph.") | |
| 235 | |
| 236 (defvar filladapt-token-conversion-table | |
| 237 '( | |
| 238 (citation-> . exact) | |
| 239 (supercite-citation . exact) | |
| 240 (lisp-comment . exact) | |
| 241 (sh-comment . exact) | |
| 242 (postscript-comment . exact) | |
| 243 (c++-comment . exact) | |
| 244 (texinfo-comment . exact) | |
| 245 (bullet . spaces) | |
| 246 (space . exact) | |
| 247 (end-of-line . exact) | |
| 248 ) | |
| 249 "Table that specifies how to convert a token into a fill prefix. | |
| 250 Table format is | |
| 251 | |
| 252 ((SYM . HOWTO) ...) | |
| 253 | |
| 254 SYM is the symbol naming the token to be converted. | |
| 255 HOWTO specifies how to do the conversion. | |
| 256 `exact' means copy the token's string directly into the fill prefix. | |
| 257 `spaces' means convert all characters in the token string that are | |
| 258 not a TAB or a space into spaces and copy the resulting string into | |
| 259 the fill prefix.") | |
| 260 | |
| 261 (defvar filladapt-function-table | |
| 262 (let ((assoc-list | |
| 263 (list (cons 'fill-paragraph (symbol-function 'fill-paragraph)) | |
| 264 (cons 'fill-region-as-paragraph | |
| 265 (symbol-function 'fill-region-as-paragraph)) | |
| 266 (cons 'do-auto-fill (symbol-function 'do-auto-fill))))) | |
| 267 ;; v18 Emacs doesn't have lisp-fill-paragraph | |
| 268 (if (fboundp 'lisp-fill-paragraph) | |
| 269 (nconc assoc-list | |
| 270 (list (cons 'lisp-fill-paragraph | |
| 271 (symbol-function 'lisp-fill-paragraph))))) | |
| 272 assoc-list ) | |
| 273 "Table containing the old function definitions that filladapt usurps.") | |
| 274 | |
| 275 (defvar filladapt-fill-paragraph-post-hook nil | |
| 276 "Hooks run after filladapt runs fill-paragraph.") | |
| 277 | |
| 278 (defvar filladapt-inside-filladapt nil | |
| 279 "Non-nil if the filladapt version of a fill function executing. | |
| 280 Currently this is only checked by the filladapt version of | |
| 281 fill-region-as-paragraph to avoid this infinite recursion: | |
| 282 | |
| 283 fill-region-as-paragraph -> fill-paragraph -> fill-region-as-paragraph ...") | |
| 284 | |
| 285 (defvar filladapt-debug nil | |
| 286 "Non-nil means filladapt debugging is enabled. | |
| 287 Use the filladapt-debug command to turn on debugging. | |
| 288 | |
| 289 With debugging enabled, filladapt will | |
| 290 | |
| 291 a. display the proposed indentation with the tokens highlighted | |
| 292 using filladapt-debug-indentation-face-1 and | |
| 293 filladapt-debug-indentation-face-2. | |
| 294 b. display the current paragraph using the face specified by | |
| 295 filladapt-debug-paragraph-face.") | |
| 296 | |
| 297 (if filladapt-debug | |
| 298 (add-hook 'post-command-hook 'filladapt-display-debug-info-maybe)) | |
| 299 | |
| 300 (defvar filladapt-debug-indentation-face-1 'highlight | |
| 301 "Face used to display the indentation when debugging is enabled.") | |
| 302 | |
| 303 (defvar filladapt-debug-indentation-face-2 'secondary-selection | |
| 304 "Another face used to display the indentation when debugging is enabled.") | |
| 305 | |
| 306 (defvar filladapt-debug-paragraph-face 'bold | |
| 307 "Face used to display the current paragraph when debugging is enabled.") | |
| 308 | |
| 309 (defvar filladapt-debug-indentation-extents nil) | |
| 310 (make-variable-buffer-local 'filladapt-debug-indentation-extents) | |
| 311 (defvar filladapt-debug-paragraph-extent nil) | |
| 312 (make-variable-buffer-local 'filladapt-debug-paragraph-extent) | |
| 313 | |
| 314 ;; kludge city, see references in code. | |
| 315 (defvar filladapt-old-line-prefix) | |
| 316 | |
| 317 (defun do-auto-fill () | |
| 318 (catch 'done | |
| 319 (if (and filladapt-mode (null fill-prefix)) | |
| 320 (save-restriction | |
| 321 (let ((paragraph-ignore-fill-prefix nil) | |
| 322 ;; if the user wanted this stuff, they probably | |
| 323 ;; wouldn't be using filladapt-mode. | |
| 324 (adaptive-fill-mode nil) | |
| 325 (adaptive-fill-regexp nil) | |
| 326 ;; need this or Emacs 19 ignores fill-prefix when | |
| 327 ;; inside a comment. | |
| 328 (comment-multi-line t) | |
| 329 (filladapt-inside-filladapt t) | |
| 330 fill-prefix retval) | |
| 331 (if (filladapt-adapt nil nil) | |
| 332 (progn | |
| 333 (setq retval (filladapt-funcall 'do-auto-fill)) | |
| 334 (throw 'done retval)))))) | |
| 335 (filladapt-funcall 'do-auto-fill))) | |
| 336 | |
| 337 (defun filladapt-fill-paragraph (function arg) | |
| 338 (catch 'done | |
| 339 (if (and filladapt-mode (null fill-prefix)) | |
| 340 (save-restriction | |
| 341 (let ((paragraph-ignore-fill-prefix nil) | |
| 342 ;; if the user wanted this stuff, they probably | |
| 343 ;; wouldn't be using filladapt-mode. | |
| 344 (adaptive-fill-mode nil) | |
| 345 (adaptive-fill-regexp nil) | |
| 346 ;; need this or Emacs 19 ignores fill-prefix when | |
| 347 ;; inside a comment. | |
| 348 (comment-multi-line t) | |
| 349 fill-prefix retval) | |
| 350 (if (filladapt-adapt t nil) | |
| 351 (progn | |
| 352 (setq retval (filladapt-funcall function arg)) | |
| 353 (run-hooks 'filladapt-fill-paragraph-post-hook) | |
| 354 (throw 'done retval)))))) | |
| 355 ;; filladapt-adapt failed, so do fill-paragraph normally. | |
| 356 (filladapt-funcall function arg))) | |
| 357 | |
| 358 (defun fill-paragraph (arg) | |
| 359 (interactive "*P") | |
| 360 (let ((filladapt-inside-filladapt t)) | |
| 361 (filladapt-fill-paragraph 'fill-paragraph arg))) | |
| 362 | |
| 363 (defun lisp-fill-paragraph (&optional arg) | |
| 364 (interactive "*P") | |
| 365 (let ((filladapt-inside-filladapt t)) | |
| 366 (filladapt-fill-paragraph 'lisp-fill-paragraph arg))) | |
| 367 | |
| 368 (defun fill-region-as-paragraph (beg end &optional justify nosqueeze squeeze-after) | |
| 369 (interactive "*r\nP") | |
| 370 (if (and filladapt-mode (not filladapt-inside-filladapt)) | |
| 371 (save-restriction | |
| 372 (narrow-to-region beg end) | |
| 373 (let ((filladapt-inside-filladapt t) | |
| 374 line-start last-token) | |
| 375 (goto-char beg) | |
| 376 (end-of-line) | |
| 377 (while (zerop (forward-line)) | |
| 378 (if (setq last-token | |
| 379 (car (filladapt-tail (filladapt-parse-prefixes)))) | |
| 380 (progn | |
| 381 (setq line-start (point)) | |
| 382 (move-to-column (nth 1 last-token)) | |
| 383 (delete-region line-start (point)))) | |
| 384 ;; Dance... | |
| 385 ;; | |
| 386 ;; Do this instead of (delete-char -1) to keep | |
| 387 ;; markers on the correct side of the whitespace. | |
| 388 (goto-char (1- (point))) | |
| 389 (insert " ") | |
| 390 (delete-char 1) | |
| 391 | |
| 392 (end-of-line)) | |
| 393 (goto-char beg) | |
| 394 (fill-paragraph justify)) | |
| 395 ;; In XEmacs 19.12 and Emacs 18.59 fill-region relies on | |
| 396 ;; fill-region-as-paragraph to do this. If we don't do | |
| 397 ;; it, fill-region will spin in an endless loop. | |
| 398 (goto-char (point-max))) | |
| 399 (condition-case nil | |
| 400 ;; five args for Emacs 19.31 | |
| 401 (filladapt-funcall 'fill-region-as-paragraph beg end | |
| 402 justify nosqueeze squeeze-after) | |
| 403 (wrong-number-of-arguments | |
| 404 (condition-case nil | |
| 405 ;; four args for Emacs 19.29 | |
| 406 (filladapt-funcall 'fill-region-as-paragraph beg end | |
| 407 justify nosqueeze) | |
| 408 ;; three args for the rest of the world. | |
| 409 (wrong-number-of-arguments | |
| 410 (filladapt-funcall 'fill-region-as-paragraph beg end justify))))))) | |
| 411 | |
| 412 (defvar zmacs-region-stays) ; for XEmacs | |
| 413 | |
| 414 (defun filladapt-mode (&optional arg) | |
| 415 "Toggle Filladapt minor mode. | |
| 416 With arg, turn Filladapt mode on iff arg is positive. When | |
| 417 Filladapt mode is enabled, auto-fill-mode and the fill-paragraph | |
| 418 command are both smarter about guessing a proper fill-prefix and | |
| 419 finding paragraph boundaries when bulleted and indented lines and | |
| 420 paragraphs are used." | |
| 421 (interactive "P") | |
| 422 ;; don't deactivate the region. | |
| 423 (setq zmacs-region-stays t) | |
| 424 (setq filladapt-mode (or (and arg (> (prefix-numeric-value arg) 0)) | |
| 425 (and (null arg) (null filladapt-mode)))) | |
| 426 (if (fboundp 'force-mode-line-update) | |
| 427 (force-mode-line-update) | |
| 428 (set-buffer-modified-p (buffer-modified-p)))) | |
| 429 | |
| 430 (defun turn-on-filladapt-mode () | |
| 431 "Unconditionally turn on Filladapt mode in the current buffer." | |
| 432 (filladapt-mode 1)) | |
| 433 | |
| 434 (defun turn-off-filladapt-mode () | |
| 435 "Unconditionally turn off Filladapt mode in the current buffer." | |
| 436 (filladapt-mode -1)) | |
| 437 | |
| 438 (defun filladapt-funcall (function &rest args) | |
| 439 "Call the old definition of a function that filladapt has usurped." | |
| 440 (apply (cdr (assoc function filladapt-function-table)) args)) | |
| 441 | |
| 442 (defun filladapt-paragraph-start (list) | |
| 443 "Returns non-nil if LIST contains a paragraph starting token. | |
| 444 LIST should be a token list as returned by filladapt-parse-prefixes." | |
| 445 (catch 'done | |
| 446 (while list | |
| 447 (if (memq (car (car list)) filladapt-token-paragraph-start-table) | |
| 448 (throw 'done t)) | |
| 449 (setq list (cdr list))))) | |
| 450 | |
| 451 (defun filladapt-parse-prefixes () | |
| 452 "Parse all the tokens after point and return a list of them. | |
| 453 The tokens regular expressions are specified in | |
| 454 filladapt-token-table. The list returned is of this form | |
| 455 | |
| 456 ((SYM COL STRING) ...) | |
| 457 | |
| 458 SYM is a token symbol as found in filladapt-token-table. | |
| 459 COL is the column at which the token ended. | |
| 460 STRING is the token's text." | |
| 461 (save-excursion | |
| 462 (let ((token-list nil) | |
| 463 (done nil) | |
| 464 (old-point (point)) | |
| 465 (case-fold-search nil) | |
| 466 token-table not-token-table) | |
| 467 (catch 'done | |
| 468 (while (not done) | |
| 469 (setq not-token-table filladapt-not-token-table) | |
| 470 (while not-token-table | |
| 471 (if (looking-at (car not-token-table)) | |
| 472 (throw 'done t)) | |
| 473 (setq not-token-table (cdr not-token-table))) | |
| 474 (setq token-table filladapt-token-table | |
| 475 done t) | |
| 476 (while token-table | |
| 477 (if (null (looking-at (car (car token-table)))) | |
| 478 (setq token-table (cdr token-table)) | |
| 479 (goto-char (match-end 0)) | |
| 480 (setq token-list (cons (list (cdr (car token-table)) | |
| 481 (current-column) | |
| 482 (buffer-substring | |
| 483 (match-beginning 0) | |
| 484 (match-end 0))) | |
| 485 token-list) | |
| 486 token-table nil | |
| 487 done (eq (point) old-point) | |
| 488 old-point (point)))))) | |
| 489 (nreverse token-list)))) | |
| 490 | |
| 491 (defun filladapt-tokens-match-p (list1 list2) | |
| 492 "Compare two token lists and return non-nil if they match, nil otherwise. | |
| 493 The lists are walked through in lockstep, comparing tokens. | |
| 494 | |
| 495 When two tokens A and B are compared, they are considered to | |
| 496 match if | |
| 497 | |
| 498 1. A appears in B's list of matching tokens or | |
| 499 B appears in A's list of matching tokens | |
| 500 and | |
| 501 2. A and B both end at the same column | |
| 502 or | |
| 503 A can match multiple tokens and ends at a column > than B | |
| 504 or | |
| 505 B can match multiple tokens and ends at a column > than A | |
| 506 | |
| 507 In the case where the end columns differ the list pointer for the | |
| 508 token with the greater end column is not moved forward, which | |
| 509 allows its current token to be matched against the next token in | |
| 510 the other list in the next iteration of the matching loop. | |
| 511 | |
| 512 All tokens must be matched in order for the lists to be considered | |
| 513 matching." | |
| 514 (let ((matched t) | |
| 515 (done nil)) | |
| 516 (while (and (not done) list1 list2) | |
| 517 (let* ((token1 (car (car list1))) | |
| 518 (token1-matches-many-p | |
| 519 (memq token1 filladapt-token-match-many-table)) | |
| 520 (token1-matches (cdr (assq token1 filladapt-token-match-table))) | |
| 521 (token1-endcol (nth 1 (car list1))) | |
| 522 (token2 (car (car list2))) | |
| 523 (token2-matches-many-p | |
| 524 (memq token2 filladapt-token-match-many-table)) | |
| 525 (token2-matches (cdr (assq token2 filladapt-token-match-table))) | |
| 526 (token2-endcol (nth 1 (car list2))) | |
| 527 (tokens-match (or (memq token1 token2-matches) | |
| 528 (memq token2 token1-matches)))) | |
| 529 (cond ((not tokens-match) | |
| 530 (setq matched nil | |
| 531 done t)) | |
| 532 ((and token1-matches-many-p token2-matches-many-p) | |
| 533 (cond ((= token1-endcol token2-endcol) | |
| 534 (setq list1 (cdr list1) | |
| 535 list2 (cdr list2))) | |
| 536 ((< token1-endcol token2-endcol) | |
| 537 (setq list1 (cdr list1))) | |
| 538 (t | |
| 539 (setq list2 (cdr list2))))) | |
| 540 (token1-matches-many-p | |
| 541 (cond ((= token1-endcol token2-endcol) | |
| 542 (setq list1 (cdr list1) | |
| 543 list2 (cdr list2))) | |
| 544 ((< token1-endcol token2-endcol) | |
| 545 (setq matched nil | |
| 546 done t)) | |
| 547 (t | |
| 548 (setq list2 (cdr list2))))) | |
| 549 (token2-matches-many-p | |
| 550 (cond ((= token1-endcol token2-endcol) | |
| 551 (setq list1 (cdr list1) | |
| 552 list2 (cdr list2))) | |
| 553 ((< token2-endcol token1-endcol) | |
| 554 (setq matched nil | |
| 555 done t)) | |
| 556 (t | |
| 557 (setq list1 (cdr list1))))) | |
| 558 ((= token1-endcol token2-endcol) | |
| 559 (setq list1 (cdr list1) | |
| 560 list2 (cdr list2))) | |
| 561 (t | |
| 562 (setq matched nil | |
| 563 done t))))) | |
| 564 (and matched (null list1) (null list2)) )) | |
| 565 | |
| 566 (defun filladapt-make-fill-prefix (list) | |
| 567 "Build a fill-prefix for a token LIST. | |
| 568 filladapt-token-conversion-table specifies how this is done." | |
| 569 (let ((prefix-list nil) | |
| 570 (conversion-spec nil)) | |
| 571 (while list | |
| 572 (setq conversion-spec (cdr (assq (car (car list)) | |
| 573 filladapt-token-conversion-table))) | |
| 574 (cond ((eq conversion-spec 'spaces) | |
| 575 (setq prefix-list | |
| 576 (cons | |
| 577 (filladapt-convert-to-spaces (nth 2 (car list))) | |
| 578 prefix-list))) | |
| 579 ((eq conversion-spec 'exact) | |
| 580 (setq prefix-list | |
| 581 (cons | |
| 582 (nth 2 (car list)) | |
| 583 prefix-list)))) | |
| 584 (setq list (cdr list))) | |
| 585 (apply (function concat) (nreverse prefix-list)) )) | |
| 586 | |
| 587 (defun filladapt-convert-to-spaces (string) | |
| 588 "Return a copy of STRING, with all non-tabs and non-space changed to spaces." | |
| 589 (let ((i 0) | |
| 590 (space-list '(?\ ?\t)) | |
| 591 (space ?\ ) | |
| 592 (lim (length string))) | |
| 593 (setq string (copy-sequence string)) | |
| 594 (while (< i lim) | |
| 595 (if (not (memq (aref string i) space-list)) | |
| 596 (aset string i space)) | |
| 597 (setq i (1+ i))) | |
| 598 string )) | |
| 599 | |
| 600 (defun filladapt-adapt (paragraph debugging) | |
| 601 "Set fill-prefix based on the contents of the current line. | |
| 602 | |
| 603 If the first arg PARAGRAPH is non-nil, also set a clipping region | |
| 604 around the current paragraph. | |
| 605 | |
| 606 If the second arg DEBUGGING is non-nil, don't do the kludge that's | |
| 607 necessary to make certain paragraph fills work properly." | |
| 608 (save-excursion | |
| 609 (beginning-of-line) | |
| 610 (let ((token-list (filladapt-parse-prefixes)) | |
| 611 curr-list done) | |
| 612 (if (null token-list) | |
| 613 nil | |
| 614 (setq fill-prefix (filladapt-make-fill-prefix token-list)) | |
| 615 (if paragraph | |
| 616 (let (beg end) | |
| 617 (if (filladapt-paragraph-start token-list) | |
| 618 (setq beg (point)) | |
| 619 (save-excursion | |
| 620 (setq done nil) | |
| 621 (while (not done) | |
| 622 (cond ((not (= 0 (forward-line -1))) | |
| 623 (setq done t | |
| 624 beg (point))) | |
| 625 ((not (filladapt-tokens-match-p | |
| 626 token-list | |
| 627 (setq curr-list (filladapt-parse-prefixes)))) | |
| 628 (forward-line 1) | |
| 629 (setq done t | |
| 630 beg (point))) | |
| 631 ((filladapt-paragraph-start curr-list) | |
| 632 (setq done t | |
| 633 beg (point))))))) | |
| 634 (save-excursion | |
| 635 (setq done nil) | |
| 636 (while (not done) | |
| 637 (cond ((not (= 0 (progn (end-of-line) (forward-line 1)))) | |
| 638 (setq done t | |
| 639 end (point))) | |
| 640 ((not (filladapt-tokens-match-p | |
| 641 token-list | |
| 642 (setq curr-list (filladapt-parse-prefixes)))) | |
| 643 (setq done t | |
| 644 end (point))) | |
| 645 ((filladapt-paragraph-start curr-list) | |
| 646 (setq done t | |
| 647 end (point)))))) | |
| 648 (narrow-to-region beg end) | |
| 649 ;; Multiple spaces after the bullet at the start of | |
| 650 ;; a hanging list paragraph get squashed by | |
| 651 ;; fill-paragraph. We kludge around this by | |
| 652 ;; replacing the line prefix with the fill-prefix | |
| 653 ;; used by the rest of the lines in the paragraph. | |
| 654 ;; fill-paragraph will not alter the fill prefix so | |
| 655 ;; we win. The post hook restores the old line prefix | |
| 656 ;; after fill-paragraph has been called. | |
| 657 (if (and paragraph (not debugging)) | |
| 658 (let (col) | |
| 659 (setq col (nth 1 (car (filladapt-tail token-list)))) | |
| 660 (goto-char (point-min)) | |
| 661 (move-to-column col) | |
| 662 (setq filladapt-old-line-prefix | |
| 663 (buffer-substring (point-min) (point))) | |
| 664 (delete-region (point-min) (point)) | |
| 665 (insert fill-prefix) | |
| 666 (add-hook 'filladapt-fill-paragraph-post-hook | |
| 667 'filladapt-cleanup-kludge-at-point-min))))) | |
| 668 t )))) | |
| 669 | |
| 670 (defun filladapt-cleanup-kludge-at-point-min () | |
| 671 "Cleanup the paragraph fill kludge. | |
| 672 See filladapt-adapt." | |
| 673 (save-excursion | |
| 674 (goto-char (point-min)) | |
| 675 (insert filladapt-old-line-prefix) | |
| 676 (delete-char (length fill-prefix)) | |
| 677 (remove-hook 'filladapt-fill-paragraph-post-hook | |
| 678 'filladapt-cleanup-kludge-at-point-min))) | |
| 679 | |
| 680 (defun filladapt-tail (list) | |
| 681 "Returns the last cons in LIST." | |
| 682 (if (null list) | |
| 683 nil | |
| 684 (while (consp (cdr list)) | |
| 685 (setq list (cdr list))) | |
| 686 list )) | |
| 687 | |
| 688 (defun filladapt-delete-extent (e) | |
| 689 (if (fboundp 'delete-extent) | |
| 690 (delete-extent e) | |
| 691 (delete-overlay e))) | |
| 692 | |
| 693 (defun filladapt-make-extent (beg end) | |
| 694 (if (fboundp 'make-extent) | |
| 695 (make-extent beg end) | |
| 696 (make-overlay beg end))) | |
| 697 | |
| 698 (defun filladapt-set-extent-endpoints (e beg end) | |
| 699 (if (fboundp 'set-extent-endpoints) | |
| 700 (set-extent-endpoints e beg end) | |
| 701 (move-overlay e beg end))) | |
| 702 | |
| 703 (defun filladapt-set-extent-property (e prop val) | |
| 704 (if (fboundp 'set-extent-property) | |
| 705 (set-extent-property e prop val) | |
| 706 (overlay-put e prop val))) | |
| 707 | |
| 708 (defun filladapt-debug () | |
| 709 "Toggle filladapt debugging on/off in the current buffer." | |
| 710 ;; (interactive) | |
| 711 (make-local-variable 'filladapt-debug) | |
| 712 (setq filladapt-debug (not filladapt-debug)) | |
| 713 ;; make sure these faces exist at least | |
| 714 (make-face 'filladapt-debug-indentation-face-1) | |
| 715 (make-face 'filladapt-debug-indentation-face-2) | |
| 716 (make-face 'filladapt-debug-paragraph-face) | |
| 717 (if (null filladapt-debug) | |
| 718 (progn | |
| 719 (mapcar (function (lambda (e) (filladapt-set-extent-endpoints e 1 1))) | |
| 720 filladapt-debug-indentation-extents) | |
| 721 (if filladapt-debug-paragraph-extent | |
| 722 (progn | |
| 723 (filladapt-delete-extent filladapt-debug-paragraph-extent) | |
| 724 (setq filladapt-debug-paragraph-extent nil))))) | |
| 725 (add-hook 'post-command-hook 'filladapt-display-debug-info-maybe)) | |
| 726 | |
| 727 (defun filladapt-display-debug-info-maybe () | |
| 728 (cond ((null filladapt-debug) nil) | |
| 729 (fill-prefix nil) | |
| 730 (t | |
| 731 (if (null filladapt-debug-paragraph-extent) | |
| 732 (let ((e (filladapt-make-extent 1 1))) | |
| 733 (filladapt-set-extent-property e 'detachable nil) | |
| 734 (filladapt-set-extent-property e 'evaporate nil) | |
| 735 (filladapt-set-extent-property e 'face | |
| 736 filladapt-debug-paragraph-face) | |
| 737 (setq filladapt-debug-paragraph-extent e))) | |
| 738 (save-excursion | |
| 739 (save-restriction | |
| 740 (let ((ei-list filladapt-debug-indentation-extents) | |
| 741 (ep filladapt-debug-paragraph-extent) | |
| 742 (face filladapt-debug-indentation-face-1) | |
| 743 fill-prefix token-list) | |
| 744 (if (null (filladapt-adapt t t)) | |
| 745 (progn | |
| 746 (filladapt-set-extent-endpoints ep 1 1) | |
| 747 (while ei-list | |
| 748 (filladapt-set-extent-endpoints (car ei-list) 1 1) | |
| 749 (setq ei-list (cdr ei-list)))) | |
| 750 (filladapt-set-extent-endpoints ep (point-min) (point-max)) | |
| 751 (beginning-of-line) | |
| 752 (setq token-list (filladapt-parse-prefixes)) | |
| 753 (message "(%s)" (mapconcat (function | |
| 754 (lambda (q) (symbol-name (car q)))) | |
| 755 token-list | |
| 756 " ")) | |
| 757 (while token-list | |
| 758 (if ei-list | |
| 759 (setq e (car ei-list) | |
| 760 ei-list (cdr ei-list)) | |
| 761 (setq e (filladapt-make-extent 1 1)) | |
| 762 (filladapt-set-extent-property e 'detachable nil) | |
| 763 (filladapt-set-extent-property e 'evaporate nil) | |
| 764 (setq filladapt-debug-indentation-extents | |
| 765 (cons e filladapt-debug-indentation-extents))) | |
| 766 (filladapt-set-extent-property e 'face face) | |
| 767 (filladapt-set-extent-endpoints e (point) | |
| 768 (progn | |
| 769 (move-to-column | |
| 770 (nth 1 | |
| 771 (car token-list))) | |
| 772 (point))) | |
| 773 (if (eq face filladapt-debug-indentation-face-1) | |
| 774 (setq face filladapt-debug-indentation-face-2) | |
| 775 (setq face filladapt-debug-indentation-face-1)) | |
| 776 (setq token-list (cdr token-list))) | |
| 777 (while ei-list | |
| 778 (filladapt-set-extent-endpoints (car ei-list) 1 1) | |
| 779 (setq ei-list (cdr ei-list)))))))))) |