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