Mercurial > hg > xemacs-beta
comparison lisp/modes/enriched.el @ 215:1f0dabaa0855 r20-4b6
Import from CVS: tag r20-4b6
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:07:35 +0200 |
parents | e45d5e7c476e |
children |
comparison
equal
deleted
inserted
replaced
214:c5d88c05e1e9 | 215:1f0dabaa0855 |
---|---|
1 ;;; enriched.el --- read and save files in text/enriched format | 1 ;;; enriched.el --- read and save files in text/enriched format |
2 ;; Copyright (c) 1994, 1995 Free Software Foundation, Inc. | 2 |
3 ;; Copyright (c) 1994, 1995, 1996 Free Software Foundation, Inc. | |
3 | 4 |
4 ;; XEmacs version: Mike Sperber <sperber@informatik.uni-tuebingen.de> | 5 ;; XEmacs version: Mike Sperber <sperber@informatik.uni-tuebingen.de> |
5 ;; Original author: Boris Goldowsky <boris@gnu.ai.mit.edu> | 6 ;; Original author: Boris Goldowsky <boris@gnu.ai.mit.edu> |
6 ;; Keywords: wp, faces | 7 ;; Keywords: wp, faces |
7 | 8 |
20 ;; You should have received a copy of the GNU General Public License | 21 ;; You should have received a copy of the GNU General Public License |
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free | 22 ;; along with XEmacs; see the file COPYING. If not, write to the Free |
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | 23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA |
23 ;; 02111-1307, USA. | 24 ;; 02111-1307, USA. |
24 | 25 |
25 ;;; Synched up with: FSF 19.34. | 26 ;;; Synched up with: FSF 20.2. |
26 | 27 |
27 ;;; Commentary: | 28 ;;; Commentary: |
28 ;; | 29 |
29 ;; This file implements reading, editing, and saving files with | 30 ;; This file implements reading, editing, and saving files with |
30 ;; text-properties such as faces, levels of indentation, and true line | 31 ;; text-properties such as faces, levels of indentation, and true line |
31 ;; breaks distinguished from newlines just used to fit text into the | 32 ;; breaks distinguished from newlines just used to fit text into the window. |
32 ;; window. | 33 |
33 ;; | |
34 ;; The file format used is the MIME text/enriched format, which is a | 34 ;; The file format used is the MIME text/enriched format, which is a |
35 ;; standard format defined in internet RFC 1563. All standard | 35 ;; standard format defined in internet RFC 1563. All standard annotations |
36 ;; annotations are supported. | 36 ;; are supported except for <smaller> and <bigger>, which are currently not |
37 ;; | 37 ;; possible to display. |
38 ;; A separate file, enriched.doc, contains further documentation and | 38 |
39 ;; other important information about this code. It also serves as an | 39 ;; A separate file, enriched.doc, contains further documentation and other |
40 ;; example file in text/enriched format. It should be in the etc | 40 ;; important information about this code. It also serves as an example |
41 ;; directory of your emacs distribution. | 41 ;; file in text/enriched format. It should be in the etc directory of your |
42 ;; | 42 ;; emacs distribution. |
43 | |
43 ;;; TODO for the XEmacs port: | 44 ;;; TODO for the XEmacs port: |
44 ;; | 45 ;; |
45 ;; Currently XEmacs does not support default-text-properties. The | 46 ;; Currently XEmacs does not support default-text-properties. The |
46 ;; original enriched.el uses this to set the left-margin, | 47 ;; original enriched.el uses this to set the left-margin, |
47 ;; right-margin, and justification properties to 'front-sticky. | 48 ;; right-margin, and justification properties to 'front-sticky. |
48 ;; If you know the Right Way to fix this, contact | 49 ;; If you know the Right Way to fix this, contact |
49 ;; Mike Sperber <sperber@informatik.uni-tuebingen.de>. | 50 ;; Mike Sperber <sperber@informatik.uni-tuebingen.de>. |
50 | 51 |
52 ;;; Code: | |
53 | |
51 (provide 'enriched) | 54 (provide 'enriched) |
52 (if window-system (require 'facemenu)) | |
53 | 55 |
54 ;;; | 56 ;;; |
55 ;;; Variables controlling the display | 57 ;;; Variables controlling the display |
56 ;;; | 58 ;;; |
57 | 59 |
58 (defgroup enriched nil | 60 (defgroup enriched nil |
59 "Read and save files in text/enriched format" | 61 "Read and save files in text/enriched format" |
60 :group 'wp) | 62 :group 'wp) |
61 | |
62 | 63 |
63 (defcustom enriched-verbose t | 64 (defcustom enriched-verbose t |
64 "*If non-nil, give status messages when reading and writing files." | 65 "*If non-nil, give status messages when reading and writing files." |
65 :type 'boolean | 66 :type 'boolean |
66 :group 'enriched) | 67 :group 'enriched) |
67 | 68 |
68 (defcustom enriched-default-right-margin 10 | 69 ;;; |
69 "*Default amount of space to leave on the right edge of the screen. | 70 ;;; Set up faces & display table |
70 This can be increased inside text by changing the 'right-margin text property. | 71 ;;; |
71 Measured in character widths. If the screen is narrower than this, it is | 72 |
72 assumed to be 0." | 73 ;; Emacs doesn't have a "fixed" face by default, since all faces currently |
73 :type 'integer | 74 ;; have to be fixed-width. So we just pick one that looks different from the |
75 ;; default. | |
76 (defface fixed | |
77 '((t (:bold t))) | |
78 "Face used for text that must be shown in fixed width. | |
79 Currently, emacs can only display fixed-width fonts, but this may change. | |
80 This face is used for text specifically marked as fixed-width, for example | |
81 in text/enriched files." | |
74 :group 'enriched) | 82 :group 'enriched) |
75 | 83 |
76 (defcustom enriched-fill-after-visiting t | 84 (defface excerpt |
77 "If t, fills paragraphs when reading in enriched documents. | 85 '((t (:italic t))) |
78 If nil, only fills when you explicitly request it. If the value is 'ask, then | 86 "Face used for text that is an excerpt from another document. |
79 it will query you whether to fill. | 87 This is used in enriched-mode for text explicitly marked as an excerpt." |
80 Filling is never done if the current text-width is the same as the value | |
81 stored in the file." | |
82 :type '(choice (const nil) (const t) (const ask)) | |
83 :group 'enriched) | 88 :group 'enriched) |
84 | 89 |
85 ;;; | 90 (defconst enriched-display-table |
86 ;;; Set up faces & display table | 91 ;; XEmacs change |
87 ;;; | 92 ;; (or (copy-sequence standard-display-table) |
88 | 93 ;; (make-display-table))) |
89 ;; XEmacs change (Can't cheat, we have variable width fonts) | 94 (make-display-table)) |
90 (if (not (find-face 'fixed)) | 95 (aset enriched-display-table ?\f (make-vector (1- (frame-width)) ?-)) |
91 (copy-face 'default 'fixed)) | |
92 | |
93 (if (not (find-face 'excerpt)) | |
94 (copy-face 'italic 'excerpt)) | |
95 | |
96 (defconst enriched-display-table (make-display-table)) | |
97 (aset enriched-display-table ?\f (make-string (1- (frame-width)) ?-)) | |
98 | 96 |
99 (defconst enriched-par-props '(left-margin right-margin justification) | 97 (defconst enriched-par-props '(left-margin right-margin justification) |
100 "Text-properties that usually apply to whole paragraphs. | 98 "Text-properties that usually apply to whole paragraphs. |
101 These are set front-sticky everywhere except at hard newlines.") | 99 These are set front-sticky everywhere except at hard newlines.") |
102 | 100 |
105 ;;; (bidirectional) | 103 ;;; (bidirectional) |
106 | 104 |
107 (defconst enriched-initial-annotation | 105 (defconst enriched-initial-annotation |
108 (lambda () | 106 (lambda () |
109 (format "Content-Type: text/enriched\nText-Width: %d\n\n" | 107 (format "Content-Type: text/enriched\nText-Width: %d\n\n" |
110 (enriched-text-width))) | 108 fill-column)) |
111 "What to insert at the start of a text/enriched file. | 109 "What to insert at the start of a text/enriched file. |
112 If this is a string, it is inserted. If it is a list, it should be a lambda | 110 If this is a string, it is inserted. If it is a list, it should be a lambda |
113 expression, which is evaluated to get the string to insert.") | 111 expression, which is evaluated to get the string to insert.") |
114 | 112 |
115 (defconst enriched-annotation-format "<%s%s>" | 113 (defconst enriched-annotation-format "<%s%s>" |
178 (defvar enriched-old-bindings nil | 176 (defvar enriched-old-bindings nil |
179 "Store old variable values that we change when entering mode. | 177 "Store old variable values that we change when entering mode. |
180 The value is a list of \(VAR VALUE VAR VALUE...).") | 178 The value is a list of \(VAR VALUE VAR VALUE...).") |
181 (make-variable-buffer-local 'enriched-old-bindings) | 179 (make-variable-buffer-local 'enriched-old-bindings) |
182 | 180 |
183 (defvar enriched-text-width nil) | |
184 (make-variable-buffer-local 'enriched-text-width) | |
185 | |
186 ;;; | 181 ;;; |
187 ;;; Define the mode | 182 ;;; Define the mode |
188 ;;; | 183 ;;; |
189 | 184 |
190 ;;;###autoload | 185 ;;;###autoload |
214 (setq enriched-old-bindings (cdr (cdr enriched-old-bindings))))) | 209 (setq enriched-old-bindings (cdr (cdr enriched-old-bindings))))) |
215 | 210 |
216 (enriched-mode nil) ; Mode already on; do nothing. | 211 (enriched-mode nil) ; Mode already on; do nothing. |
217 | 212 |
218 (t (setq enriched-mode t) ; Turn mode on | 213 (t (setq enriched-mode t) ; Turn mode on |
219 (if (not (memq 'text/enriched buffer-file-format)) | 214 (add-to-list 'buffer-file-format 'text/enriched) |
220 (setq buffer-file-format | |
221 (cons 'text/enriched buffer-file-format))) | |
222 ;; Save old variable values before we change them. | 215 ;; Save old variable values before we change them. |
223 ;; These will be restored if we exit Enriched mode. | 216 ;; These will be restored if we exit Enriched mode. |
224 (setq enriched-old-bindings | 217 (setq enriched-old-bindings |
225 ;; XEmacs change | 218 ;; XEmacs change |
226 (list ; 'buffer-display-table buffer-display-table | 219 (list ; 'buffer-display-table buffer-display-table |
227 'indent-line-function indent-line-function | 220 'indent-line-function indent-line-function |
228 'use-hard-newlines use-hard-newlines | |
229 'default-text-properties default-text-properties)) | 221 'default-text-properties default-text-properties)) |
230 (make-local-variable 'indent-line-function) | 222 (make-local-variable 'indent-line-function) |
231 (make-local-variable 'use-hard-newlines) | |
232 (make-local-variable 'default-text-properties) | 223 (make-local-variable 'default-text-properties) |
233 (setq indent-line-function 'indent-to-left-margin | 224 (setq indent-line-function 'indent-to-left-margin |
234 ;; XEmacs change | 225 ;; XEmacs change |
235 ;; buffer-display-table enriched-display-table | 226 ;; buffer-display-table enriched-display-table |
236 use-hard-newlines t) | 227 ) |
228 (use-hard-newlines 1 nil) | |
237 (let ((sticky (plist-get default-text-properties 'front-sticky)) | 229 (let ((sticky (plist-get default-text-properties 'front-sticky)) |
238 (p enriched-par-props)) | 230 (p enriched-par-props)) |
239 (while p | 231 (while p |
240 (if (not (memq (car p) sticky)) | 232 (add-to-list 'sticky (car p)) |
241 (setq sticky (cons (car p) sticky))) | |
242 (setq p (cdr p))) | 233 (setq p (cdr p))) |
243 (if sticky | 234 (if sticky |
244 (setq default-text-properties | 235 (setq default-text-properties |
245 (plist-put default-text-properties | 236 (plist-put default-text-properties |
246 'front-sticky sticky)))) | 237 'front-sticky sticky)))) |
315 nil ; skip blank lines | 306 nil ; skip blank lines |
316 (indent-to (current-left-margin)) | 307 (indent-to (current-left-margin)) |
317 (justify-current-line t nil t)) | 308 (justify-current-line t nil t)) |
318 (forward-line 1))))) | 309 (forward-line 1))))) |
319 | 310 |
320 (defun enriched-text-width () | |
321 "The width of unindented text in this window, in characters. | |
322 This is the width of the window minus `enriched-default-right-margin'." | |
323 (or enriched-text-width | |
324 (let ((ww (window-width))) | |
325 (setq enriched-text-width | |
326 (if (> ww enriched-default-right-margin) | |
327 (- ww enriched-default-right-margin) | |
328 ww))))) | |
329 | |
330 ;;; | 311 ;;; |
331 ;;; Encoding Files | 312 ;;; Encoding Files |
332 ;;; | 313 ;;; |
333 | 314 |
334 ;;;###autoload | 315 ;;;###autoload |
335 (defun enriched-encode (from to) | 316 (defun enriched-encode (from to &optional orig-buf) |
336 (if enriched-verbose (message "Enriched: encoding document...")) | 317 (if enriched-verbose (message "Enriched: encoding document...")) |
337 (save-restriction | 318 (save-restriction |
338 (narrow-to-region from to) | 319 (narrow-to-region from to) |
339 (delete-to-left-margin) | 320 (delete-to-left-margin) |
340 (unjustify-region) | 321 (unjustify-region) |
344 (format-annotate-region from (point-max) enriched-translations | 325 (format-annotate-region from (point-max) enriched-translations |
345 'enriched-make-annotation enriched-ignore)) | 326 'enriched-make-annotation enriched-ignore)) |
346 (goto-char from) | 327 (goto-char from) |
347 (insert (if (stringp enriched-initial-annotation) | 328 (insert (if (stringp enriched-initial-annotation) |
348 enriched-initial-annotation | 329 enriched-initial-annotation |
349 (funcall enriched-initial-annotation))) | 330 (save-excursion |
331 ;; Eval this in the buffer we are annotating. This | |
332 ;; fixes a bug which was saving incorrect File-Width | |
333 ;; information, since we were looking at local | |
334 ;; variables in the wrong buffer. | |
335 (if orig-buf (set-buffer orig-buf)) | |
336 (funcall enriched-initial-annotation)))) | |
350 (enriched-map-property-regions 'hard | 337 (enriched-map-property-regions 'hard |
351 (lambda (v b e) | 338 (lambda (v b e) |
352 (if (and v (= ?\n (char-after b))) | 339 (if (and v (= ?\n (char-after b))) |
353 (progn (goto-char b) (insert "\n")))) | 340 (progn (goto-char b) (insert "\n")))) |
354 (point) nil) | 341 (point) nil) |
454 ;;; | 441 ;;; |
455 | 442 |
456 ;;;###autoload | 443 ;;;###autoload |
457 (defun enriched-decode (from to) | 444 (defun enriched-decode (from to) |
458 (if enriched-verbose (message "Enriched: decoding document...")) | 445 (if enriched-verbose (message "Enriched: decoding document...")) |
446 (use-hard-newlines 1 'never) | |
459 (save-excursion | 447 (save-excursion |
460 (save-restriction | 448 (save-restriction |
461 (narrow-to-region from to) | 449 (narrow-to-region from to) |
462 (goto-char from) | 450 (goto-char from) |
463 (let ((file-width (enriched-get-file-width)) | 451 |
464 (use-hard-newlines t)) | 452 ;; Deal with header |
453 (let ((file-width (enriched-get-file-width))) | |
465 (enriched-remove-header) | 454 (enriched-remove-header) |
466 | 455 |
467 ;; Deal with newlines | 456 ;; Deal with newlines |
468 (goto-char from) | |
469 (while (search-forward-regexp "\n\n+" nil t) | 457 (while (search-forward-regexp "\n\n+" nil t) |
470 (if (current-justification) | 458 (if (current-justification) |
471 (delete-char -1)) | 459 (delete-char -1)) |
472 (put-text-property (match-beginning 0) (point) 'hard t) | 460 (set-hard-newline-properties (match-beginning 0) (point))) |
473 (put-text-property (match-beginning 0) (point) 'front-sticky nil)) | |
474 | 461 |
475 ;; Translate annotations | 462 ;; Translate annotations |
476 (format-deannotate-region from (point-max) enriched-translations | 463 (format-deannotate-region from (point-max) enriched-translations |
477 'enriched-next-annotation) | 464 'enriched-next-annotation) |
478 | 465 |
479 ;; Fill paragraphs | 466 ;; Indent or fill the buffer |
480 (if (or (and file-width ; possible reasons not to fill: | 467 (cond (file-width ; File was filled to this width |
481 (= file-width (enriched-text-width))) ; correct wd. | 468 (setq fill-column file-width) |
482 (null enriched-fill-after-visiting) ; never fill | 469 (if enriched-verbose (message "Indenting...")) |
483 (and (eq 'ask enriched-fill-after-visiting) ; asked & declined | 470 (enriched-insert-indentation)) |
484 (not (y-or-n-p "Re-fill for current display width? ")))) | 471 (t ; File was not filled. |
485 ;; Minimally, we have to insert indentation and justification. | 472 (if enriched-verbose (message "Filling paragraphs...")) |
486 (enriched-insert-indentation) | 473 (fill-region (point-min) (point-max)))) |
487 (if enriched-verbose (message "Filling paragraphs...")) | 474 (if enriched-verbose (message nil))) |
488 (fill-region (point-min) (point-max)))) | |
489 (if enriched-verbose (message nil)) | |
490 (point-max)))) | 475 (point-max)))) |
491 | 476 |
492 (defun enriched-next-annotation () | 477 (defun enriched-next-annotation () |
493 "Find and return next text/enriched annotation. | 478 "Find and return next text/enriched annotation. |
494 Any \"<<\" strings encountered are converted to \"<\". | 479 Any \"<<\" strings encountered are converted to \"<\". |
522 (while (looking-at "^[-A-Za-z]+: .*\n") | 507 (while (looking-at "^[-A-Za-z]+: .*\n") |
523 (delete-region (point) (match-end 0))) | 508 (delete-region (point) (match-end 0))) |
524 (if (looking-at "^\n") | 509 (if (looking-at "^\n") |
525 (delete-char 1))) | 510 (delete-char 1))) |
526 | 511 |
527 (defun enriched-decode-foreground (from to color) | 512 (defun enriched-decode-foreground (from to &optional color) |
528 ;; XEmacs change | 513 ;; XEmacs change |
529 (let ((face (facemenu-get-face (intern (concat "fg:" color))))) | 514 (let ((face (facemenu-get-face (intern (concat "fg:" color))))) |
530 (if (not face) | 515 (if (not face) |
531 (progn | 516 (progn |
532 (make-face face) | 517 (make-face face) |
533 (message "Warning: Color \"%s\" can't be displayed." color))) | 518 (message "Warning: Color \"%s\" can't be displayed." color))) |
534 (list from to 'face face))) | 519 (list from to 'face face))) |
535 | 520 |
536 (defun enriched-decode-background (from to color) | 521 (defun enriched-decode-background (from to &optional color) |
537 ;; XEmacs change | 522 ;; XEmacs change |
538 (let ((face (facemenu-get-face (intern (concat "bg:" color))))) | 523 (let ((face (facemenu-get-face (intern (concat "bg:" color))))) |
539 (if (not face) | 524 (if (not face) |
540 (progn | 525 (progn |
541 (make-face face) | 526 (make-face face) |