Mercurial > hg > xemacs-beta

comparison lisp/modes/scribe.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 489f57a838ef
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; scribe.el --- scribe mode, and its idiosyncratic commands.
2 ;; Keywords: wp
3
4 ;; Copyright (C) 1985 Free Software Foundation, Inc.
5
6 ;; This file might become part of GNU Emacs.
7
8 ;; GNU Emacs is distributed in the hope that it will be useful,
9 ;; but without any warranty. No author or distributor
10 ;; accepts responsibility to anyone for the consequences of using it
11 ;; or for whether it serves any particular purpose or works at all,
12 ;; unless he says so in writing.
13
14 ;; Everyone is granted permission to copy, modify and redistribute
15 ;; GNU Emacs, but only under the conditions described in the
16 ;; document "GNU Emacs copying permission notice". An exact copy
17 ;; of the document is supposed to have been given to you along with
18 ;; GNU Emacs so that you can know how you may redistribute it all.
19 ;; It should be in a file named COPYING. Among other things, the
20 ;; copyright notice and this notice must be preserved on all copies.
21
22
23 (defvar scribe-mode-syntax-table nil
24 "Syntax table used while in scribe mode.")
25
26 (defvar scribe-mode-abbrev-table nil
27 "Abbrev table used while in scribe mode.")
28
29 (defvar scribe-fancy-paragraphs nil
30 "*Non-NIL makes Scribe mode use a different style of paragraph separation.")
31
32 (defvar scribe-electric-quote nil
33 "*Non-NIL makes insert of double quote use `` or '' depending on context.")
34
35 (defvar scribe-electric-parenthesis nil
36 "*Non-NIL makes parenthesis char ( (]}> ) automatically insert its close
37 if typed after an @Command form.")
38
39 (defconst scribe-open-parentheses "[({<"
40 "Open parenthesis characters for Scribe.")
41
42 (defconst scribe-close-parentheses "])}>"
43 "Close parenthesis characters for Scribe. These should match up with
44 scribe-open-parenthesis.")
45
46 (if (null scribe-mode-syntax-table)
47 (let ((st (syntax-table)))
48 (unwind-protect
49 (progn
50 (setq scribe-mode-syntax-table (copy-syntax-table
51 text-mode-syntax-table))
52 (set-syntax-table scribe-mode-syntax-table)
53 (modify-syntax-entry ?\" " ")
54 (modify-syntax-entry ?\\ " ")
55 (modify-syntax-entry ?@ "w ")
56 (modify-syntax-entry ?< "(> ")
57 (modify-syntax-entry ?> ")< ")
58 (modify-syntax-entry ?[ "(] ")
59 (modify-syntax-entry ?] ")[ ")
60 (modify-syntax-entry ?{ "(} ")
61 (modify-syntax-entry ?} "){ ")
62 (modify-syntax-entry ?' "w "))
63 (set-syntax-table st))))
64
65 (defvar scribe-mode-map nil)
66
67 (if scribe-mode-map
68 nil
69 (setq scribe-mode-map (make-sparse-keymap))
70 (define-key scribe-mode-map "\t" 'scribe-tab)
71 (define-key scribe-mode-map "\e\t" 'tab-to-tab-stop)
72 (define-key scribe-mode-map "\es" 'center-line)
73 (define-key scribe-mode-map "\e}" 'up-list)
74 (define-key scribe-mode-map "\eS" 'center-paragraph)
75 (define-key scribe-mode-map "\"" 'scribe-insert-quote)
76 (define-key scribe-mode-map "(" 'scribe-parenthesis)
77 (define-key scribe-mode-map "[" 'scribe-parenthesis)
78 (define-key scribe-mode-map "{" 'scribe-parenthesis)
79 (define-key scribe-mode-map "<" 'scribe-parenthesis)
80 (define-key scribe-mode-map "\^cc" 'scribe-chapter)
81 (define-key scribe-mode-map "\^cS" 'scribe-section)
82 (define-key scribe-mode-map "\^cs" 'scribe-subsection)
83 (define-key scribe-mode-map "\^ce" 'scribe-insert-environment)
84 (define-key scribe-mode-map "\^c\^e" 'scribe-bracket-region-be)
85 (define-key scribe-mode-map "\^c[" 'scribe-begin)
86 (define-key scribe-mode-map "\^c]" 'scribe-end)
87 (define-key scribe-mode-map "\^ci" 'scribe-italicize-word)
88 (define-key scribe-mode-map "\^cb" 'scribe-bold-word)
89 (define-key scribe-mode-map "\^cu" 'scribe-underline-word))
90
91 ;;;###autoload
92 (defun scribe-mode ()
93 "Major mode for editing files of Scribe (a text formatter) source.
94 Scribe-mode is similar text-mode, with a few extra commands added.
95 \\{scribe-mode-map}
96
97 Interesting variables:
98
99 scribe-fancy-paragraphs
100 Non-nil makes Scribe mode use a different style of paragraph separation.
101
102 scribe-electric-quote
103 Non-nil makes insert of double quote use `` or '' depending on context.
104
105 scribe-electric-parenthesis
106 Non-nil makes an open-parenthesis char (one of `([<{')
107 automatically insert its close if typed after an @Command form."
108 (interactive)
109 (kill-all-local-variables)
110 (use-local-map scribe-mode-map)
111 (setq mode-name "Scribe")
112 (setq major-mode 'scribe-mode)
113 (define-abbrev-table 'scribe-mode-abbrev-table ())
114 (setq local-abbrev-table scribe-mode-abbrev-table)
115 (make-local-variable 'comment-start)
116 (setq comment-start "@Comment[")
117 (make-local-variable 'comment-start-skip)
118 (setq comment-start-skip (concat "@Comment[" scribe-open-parentheses "]"))
119 (make-local-variable 'comment-column)
120 (setq comment-column 0)
121 (make-local-variable 'comment-end)
122 (setq comment-end "]")
123 (make-local-variable 'paragraph-start)
124 (setq paragraph-start (concat "\\(^[\n\f]\\)\\|\\(^@\\w+["
125 scribe-open-parentheses
126 "].*["
127 scribe-close-parentheses
128 "]$\\)"))
129 (make-local-variable 'paragraph-separate)
130 (setq paragraph-separate (if scribe-fancy-paragraphs
131 paragraph-start "^$"))
132 (make-local-variable 'compile-command)
133 (setq compile-command (concat "scribe " (buffer-file-name)))
134 (set-syntax-table scribe-mode-syntax-table)
135 (run-hooks 'text-mode-hook 'scribe-mode-hook))
136
137 (defun scribe-tab ()
138 (interactive)
139 (insert "@\\"))
140
141 ;; This algorithm could probably be improved somewhat.
142 ;; Right now, it loses seriously...
143
144 (defun scribe ()
145 "Run Scribe on the current buffer."
146 (interactive)
147 (call-interactively 'compile))
148
149 (defun scribe-envelop-word (string count)
150 "Surround current word with Scribe construct @STRING[...]. COUNT
151 specifies how many words to surround. A negative count means to skip
152 backward."
153 (let ((spos (point)) (epos (point)) (ccoun 0) noparens)
154 (if (not (zerop count))
155 (progn (if (= (char-syntax (preceding-char)) ?w)
156 (forward-sexp (min -1 count)))
157 (setq spos (point))
158 (if (looking-at (concat "@\\w[" scribe-open-parentheses "]"))
159 (forward-char 2)
160 (goto-char epos)
161 (skip-chars-backward "\\W")
162 (forward-char -1))
163 (forward-sexp (max count 1))
164 (setq epos (point))))
165 (goto-char spos)
166 (while (and (< ccoun (length scribe-open-parentheses))
167 (save-excursion
168 (or (search-forward (char-to-string
169 (aref scribe-open-parentheses ccoun))
170 epos t)
171 (search-forward (char-to-string
172 (aref scribe-close-parentheses ccoun))
173 epos t)))
174 (setq ccoun (1+ ccoun))))
175 (if (>= ccoun (length scribe-open-parentheses))
176 (progn (goto-char epos)
177 (insert "@end(" string ")")
178 (goto-char spos)
179 (insert "@begin(" string ")"))
180 (goto-char epos)
181 (insert (aref scribe-close-parentheses ccoun))
182 (goto-char spos)
183 (insert "@" string (aref scribe-open-parentheses ccoun))
184 (goto-char epos)
185 (forward-char 3)
186 (skip-chars-forward scribe-close-parentheses))))
187
188 (defun scribe-underline-word (count)
189 "Underline COUNT words around point by means of Scribe constructs."
190 (interactive "p")
191 (scribe-envelop-word "u" count))
192
193 (defun scribe-bold-word (count)
194 "Boldface COUNT words around point by means of Scribe constructs."
195 (interactive "p")
196 (scribe-envelop-word "b" count))
197
198 (defun scribe-italicize-word (count)
199 "Italicize COUNT words around point by means of Scribe constructs."
200 (interactive "p")
201 (scribe-envelop-word "i" count))
202
203 (defun scribe-begin ()
204 (interactive)
205 (insert "\n")
206 (forward-char -1)
207 (scribe-envelop-word "Begin" 0)
208 (re-search-forward (concat "[" scribe-open-parentheses "]")))
209
210 (defun scribe-end ()
211 (interactive)
212 (insert "\n")
213 (forward-char -1)
214 (scribe-envelop-word "End" 0)
215 (re-search-forward (concat "[" scribe-open-parentheses "]")))
216
217 (defun scribe-chapter ()
218 (interactive)
219 (insert "\n")
220 (forward-char -1)
221 (scribe-envelop-word "Chapter" 0)
222 (re-search-forward (concat "[" scribe-open-parentheses "]")))
223
224 (defun scribe-section ()
225 (interactive)
226 (insert "\n")
227 (forward-char -1)
228 (scribe-envelop-word "Section" 0)
229 (re-search-forward (concat "[" scribe-open-parentheses "]")))
230
231 (defun scribe-subsection ()
232 (interactive)
233 (insert "\n")
234 (forward-char -1)
235 (scribe-envelop-word "SubSection" 0)
236 (re-search-forward (concat "[" scribe-open-parentheses "]")))
237
238 (defun scribe-bracket-region-be (env min max)
239 (interactive "sEnvironment: \nr")
240 (save-excursion
241 (goto-char max)
242 (insert "@end(" env ")\n")
243 (goto-char min)
244 (insert "@begin(" env ")\n")))
245
246 (defun scribe-insert-environment (env)
247 (interactive "sEnvironment: ")
248 (scribe-bracket-region-be env (point) (point))
249 (forward-line 1)
250 (insert ?\n)
251 (forward-char -1))
252
253 (defun scribe-insert-quote (count)
254 "If scribe-electric-quote is non-NIL, insert ``, '' or \" according
255 to preceding character. With numeric arg N, always insert N \" characters.
256 Else just insert \"."
257 (interactive "P")
258 (if (or count (not scribe-electric-quote))
259 (self-insert-command (prefix-numeric-value count))
260 (let (lastfore lastback lastquote)
261 (insert
262 (cond
263 ((= (preceding-char) ?\\) ?\")
264 ((bobp) "``")
265 (t
266 (setq lastfore (save-excursion (and (search-backward
267 "``" (- (point) 1000) t)
268 (point)))
269 lastback (save-excursion (and (search-backward
270 "''" (- (point) 1000) t)
271 (point)))
272 lastquote (save-excursion (and (search-backward
273 "\"" (- (point) 100) t)
274 (point))))
275 (if (not lastquote)
276 (cond ((not lastfore) "``")
277 ((not lastback) "''")
278 ((> lastfore lastback) "''")
279 (t "``"))
280 (cond ((and (not lastback) (not lastfore)) "\"")
281 ((and lastback (not lastfore) (> lastquote lastback)) "\"")
282 ((and lastback (not lastfore) (> lastback lastquote)) "``")
283 ((and lastfore (not lastback) (> lastquote lastfore)) "\"")
284 ((and lastfore (not lastback) (> lastfore lastquote)) "''")
285 ((and (> lastquote lastfore) (> lastquote lastback)) "\"")
286 ((> lastfore lastback) "''")
287 (t "``")))))))))
288
289 (defun scribe-parenthesis (count)
290 "If scribe-electric-parenthesis is non-NIL, insertion of an open-parenthesis
291 character inserts the following close parenthesis character if the
292 preceding text is of the form @Command."
293 (interactive "P")
294 (self-insert-command (prefix-numeric-value count))
295 (let (at-command paren-char point-save)
296 (if (or count (not scribe-electric-parenthesis))
297 nil
298 (save-excursion
299 (forward-char -1)
300 (setq point-save (point))
301 (skip-chars-backward (concat "^ \n\t\f" scribe-open-parentheses))
302 (setq at-command (and (equal (following-char) ?@)
303 (/= (point) (1- point-save)))))
304 (if (and at-command
305 (setq paren-char
306 (string-match (regexp-quote
307 (char-to-string (preceding-char)))
308 scribe-open-parentheses)))
309 (save-excursion
310 (insert (aref scribe-close-parentheses paren-char)))))))