Mercurial > hg > xemacs-beta
comparison lisp/apel/tinyrich.el @ 177:6075d714658b r20-3b15
Import from CVS: tag r20-3b15
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 09:51:16 +0200 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 176:6866abce6aaf | 177:6075d714658b |
|---|---|
| 1 ;;; | |
| 2 ;;; $Id: tinyrich.el,v 1.2 1997/07/26 22:09:38 steve Exp $ | |
| 3 ;;; | |
| 4 ;;; by MORIOKA Tomohiko <morioka@jaist.ac.jp> | |
| 5 ;;; modified by YAMATE Keiichirou <ics9118@sem1.info.osaka-cu.ac.jp> | |
| 6 ;;; | |
| 7 | |
| 8 (defvar mime-viewer/face-list-for-text/enriched | |
| 9 (cond ((and (>= emacs-major-version 19) window-system) | |
| 10 '(bold italic fixed underline) | |
| 11 ) | |
| 12 ((and (boundp 'NEMACS) NEMACS) | |
| 13 '("bold" "italic" "underline") | |
| 14 ))) | |
| 15 | |
| 16 (defun enriched-decode (beg end) | |
| 17 (interactive "*r") | |
| 18 (save-excursion | |
| 19 (save-restriction | |
| 20 (narrow-to-region beg end) | |
| 21 (goto-char beg) | |
| 22 (while (re-search-forward "[ \t]*\\(\n+\\)[ \t]*" nil t) | |
| 23 (let ((str (buffer-substring (match-beginning 1) | |
| 24 (match-end 1)))) | |
| 25 (if (string= str "\n") | |
| 26 (replace-match " ") | |
| 27 (replace-match (substring str 1)) | |
| 28 ))) | |
| 29 (goto-char beg) | |
| 30 (let (cmd sym str (fb (point)) fe b e) | |
| 31 (while (re-search-forward "<\\(<\\|[^<>\n\r \t]+>\\)" nil t) | |
| 32 (setq b (match-beginning 0)) | |
| 33 (setq cmd (buffer-substring b (match-end 0))) | |
| 34 (if (string= cmd "<<") | |
| 35 (replace-match "<") | |
| 36 (replace-match "") | |
| 37 (setq cmd (downcase (substring cmd 1 (- (length cmd) 1)))) | |
| 38 ) | |
| 39 (setq sym (intern cmd)) | |
| 40 (cond ((eq sym 'param) | |
| 41 (setq b (point)) | |
| 42 (save-excursion | |
| 43 (save-restriction | |
| 44 (if (search-forward "</param>" nil t) | |
| 45 (progn | |
| 46 (replace-match "") | |
| 47 (setq e (point)) | |
| 48 ) | |
| 49 (setq e end) | |
| 50 ))) | |
| 51 (delete-region b e) | |
| 52 ) | |
| 53 ((memq sym mime-viewer/face-list-for-text/enriched) | |
| 54 (setq b (point)) | |
| 55 (save-excursion | |
| 56 (save-restriction | |
| 57 (if (re-search-forward (concat "</" cmd ">") nil t) | |
| 58 (progn | |
| 59 (replace-match "") | |
| 60 (setq e (point)) | |
| 61 ) | |
| 62 (setq e end) | |
| 63 ))) | |
| 64 (tm:set-face-region b e sym) | |
| 65 ))) | |
| 66 (goto-char (point-max)) | |
| 67 (if (not (eq (preceding-char) ?\n)) | |
| 68 (insert "\n") | |
| 69 ) | |
| 70 )))) | |
| 71 | |
| 72 | |
| 73 ;;; @ text/richtext <-> text/enriched converter | |
| 74 ;;; | |
| 75 | |
| 76 (defun richtext-to-enriched-region (beg end) | |
| 77 "Convert the region of text/richtext style to text/enriched style." | |
| 78 (save-excursion | |
| 79 (save-restriction | |
| 80 (narrow-to-region beg end) | |
| 81 (goto-char (point-min)) | |
| 82 (let (b e i) | |
| 83 (while (re-search-forward "[ \t]*<comment>" nil t) | |
| 84 (setq b (match-beginning 0)) | |
| 85 (delete-region b | |
| 86 (if (re-search-forward "</comment>[ \t]*" nil t) | |
| 87 (match-end 0) | |
| 88 (point-max) | |
| 89 )) | |
| 90 ) | |
| 91 (goto-char (point-min)) | |
| 92 (while (re-search-forward "\n\n+" nil t) | |
| 93 (replace-match "\n") | |
| 94 ) | |
| 95 (goto-char (point-min)) | |
| 96 (while (re-search-forward "[ \t\n]*<nl>[ \t\n]*" nil t) | |
| 97 (setq b (match-beginning 0)) | |
| 98 (setq e (match-end 0)) | |
| 99 (setq i 1) | |
| 100 (while (looking-at "[ \t\n]*<nl>[ \t\n]*") | |
| 101 (setq e (match-end 0)) | |
| 102 (setq i (1+ i)) | |
| 103 (goto-char e) | |
| 104 ) | |
| 105 (delete-region b e) | |
| 106 (while (>= i 0) | |
| 107 (insert "\n") | |
| 108 (setq i (1- i)) | |
| 109 )) | |
| 110 (goto-char (point-min)) | |
| 111 (while (search-forward "<lt>" nil t) | |
| 112 (replace-match "<<") | |
| 113 ) | |
| 114 )))) | |
| 115 | |
| 116 (defun enriched-to-richtext-region (beg end) | |
| 117 "Convert the region of text/enriched style to text/richtext style." | |
| 118 (save-excursion | |
| 119 (save-restriction | |
| 120 (goto-char beg) | |
| 121 (and (search-forward "text/enriched") | |
| 122 (replace-match "text/richtext")) | |
| 123 (search-forward "\n\n") | |
| 124 (narrow-to-region (match-end 0) end) | |
| 125 (let (str n) | |
| 126 (goto-char (point-min)) | |
| 127 (while (re-search-forward "\n\n+" nil t) | |
| 128 (setq str (buffer-substring (match-beginning 0) | |
| 129 (match-end 0))) | |
| 130 (setq n (1- (length str))) | |
| 131 (setq str "") | |
| 132 (while (> n 0) | |
| 133 (setq str (concat str "<nl>\n")) | |
| 134 (setq n (1- n)) | |
| 135 ) | |
| 136 (replace-match str) | |
| 137 ) | |
| 138 (goto-char (point-min)) | |
| 139 (while (search-forward "<<" nil t) | |
| 140 (replace-match "<lt>") | |
| 141 ) | |
| 142 )))) | |
| 143 | |
| 144 | |
| 145 ;;; @ encoder and decoder | |
| 146 ;;; | |
| 147 | |
| 148 (defun richtext-decode (beg end) | |
| 149 (save-restriction | |
| 150 (narrow-to-region beg end) | |
| 151 (richtext-to-enriched-region beg (point-max)) | |
| 152 (enriched-decode beg (point-max)) | |
| 153 )) | |
| 154 | |
| 155 ;; (defun richtext-encode (beg end) | |
| 156 ;; (save-restriction | |
| 157 ;; (narrow-to-region beg end) | |
| 158 ;; (enriched-encode beg (point-max)) | |
| 159 ;; (enriched-to-richtext-region beg (point-max)) | |
| 160 ;; )) | |
| 161 | |
| 162 | |
| 163 ;;; @ end | |
| 164 ;;; | |
| 165 | |
| 166 (provide 'tinyrich) |