1;;; scribe.el --- scribe mode, and its idiosyncratic commands
2
3;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005,
4;;   2006, 2007 Free Software Foundation, Inc.
5
6;; Maintainer: FSF
7;; Keywords: wp
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING.  If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;; A major mode for editing source in written for the Scribe text formatter.
29;; Knows about Scribe syntax and standard layout rules.  The command to
30;; run Scribe on a buffer is bogus; someone interested should fix it.
31
32;;; Code:
33
34(defvar compile-command)
35
36(defgroup scribe nil
37  "Scribe mode."
38  :prefix "scribe-"
39  :group 'wp)
40
41(defvar scribe-mode-syntax-table nil
42  "Syntax table used while in scribe mode.")
43
44(defvar scribe-mode-abbrev-table nil
45  "Abbrev table used while in scribe mode.")
46
47(defcustom scribe-fancy-paragraphs nil
48  "*Non-nil makes Scribe mode use a different style of paragraph separation."
49  :type 'boolean
50  :group 'scribe)
51
52(defcustom scribe-electric-quote nil
53  "*Non-nil makes insert of double quote use `` or '' depending on context."
54  :type 'boolean
55  :group 'scribe)
56
57(defcustom scribe-electric-parenthesis nil
58  "*Non-nil makes parenthesis char ( (]}> ) automatically insert its close
59if typed after an @Command form."
60  :type 'boolean
61  :group 'scribe)
62
63(defconst scribe-open-parentheses "[({<"
64  "Open parenthesis characters for Scribe.")
65
66(defconst scribe-close-parentheses "])}>"
67  "Close parenthesis characters for Scribe.
68These should match up with `scribe-open-parenthesis'.")
69
70(if (null scribe-mode-syntax-table)
71    (let ((st (syntax-table)))
72      (unwind-protect
73       (progn
74	(setq scribe-mode-syntax-table (copy-syntax-table
75					text-mode-syntax-table))
76	(set-syntax-table scribe-mode-syntax-table)
77	(modify-syntax-entry ?\" "    ")
78	(modify-syntax-entry ?\\ "    ")
79	(modify-syntax-entry ?@ "w   ")
80	(modify-syntax-entry ?< "(>  ")
81	(modify-syntax-entry ?> ")<  ")
82	(modify-syntax-entry ?[ "(]  ")
83	(modify-syntax-entry ?] ")[  ")
84	(modify-syntax-entry ?{ "(}  ")
85	(modify-syntax-entry ?} "){  ")
86	(modify-syntax-entry ?' "w   "))
87       (set-syntax-table st))))
88
89(defvar scribe-mode-map nil)
90
91(if scribe-mode-map
92    nil
93  (setq scribe-mode-map (make-sparse-keymap))
94  (define-key scribe-mode-map "\t" 'scribe-tab)
95  (define-key scribe-mode-map "\e\t" 'tab-to-tab-stop)
96  (define-key scribe-mode-map "\es" 'center-line)
97  (define-key scribe-mode-map "\e}" 'up-list)
98  (define-key scribe-mode-map "\eS" 'center-paragraph)
99  (define-key scribe-mode-map "\"" 'scribe-insert-quote)
100  (define-key scribe-mode-map "(" 'scribe-parenthesis)
101  (define-key scribe-mode-map "[" 'scribe-parenthesis)
102  (define-key scribe-mode-map "{" 'scribe-parenthesis)
103  (define-key scribe-mode-map "<" 'scribe-parenthesis)
104  (define-key scribe-mode-map "\C-c\C-c" 'scribe-chapter)
105  (define-key scribe-mode-map "\C-c\C-t" 'scribe-section)
106  (define-key scribe-mode-map "\C-c\C-s" 'scribe-subsection)
107  (define-key scribe-mode-map "\C-c\C-v" 'scribe-insert-environment)
108  (define-key scribe-mode-map "\C-c\C-e" 'scribe-bracket-region-be)
109  (define-key scribe-mode-map "\C-c[" 'scribe-begin)
110  (define-key scribe-mode-map "\C-c]" 'scribe-end)
111  (define-key scribe-mode-map "\C-c\C-i" 'scribe-italicize-word)
112  (define-key scribe-mode-map "\C-c\C-b" 'scribe-bold-word)
113  (define-key scribe-mode-map "\C-c\C-u" 'scribe-underline-word))
114
115;;;###autoload
116(define-derived-mode scribe-mode text-mode "Scribe"
117  "Major mode for editing files of Scribe (a text formatter) source.
118Scribe-mode is similar to text-mode, with a few extra commands added.
119\\{scribe-mode-map}
120
121Interesting variables:
122
123`scribe-fancy-paragraphs'
124  Non-nil makes Scribe mode use a different style of paragraph separation.
125
126`scribe-electric-quote'
127  Non-nil makes insert of double quote use `` or '' depending on context.
128
129`scribe-electric-parenthesis'
130  Non-nil makes an open-parenthesis char (one of `([<{')
131  automatically insert its close if typed after an @Command form."
132  (set (make-local-variable 'comment-start) "@Comment[")
133  (set (make-local-variable 'comment-start-skip) (concat "@Comment[" scribe-open-parentheses "]"))
134  (set (make-local-variable 'comment-column) 0)
135  (set (make-local-variable 'comment-end) "]")
136  (set (make-local-variable 'paragraph-start)
137       (concat "\\([\n\f]\\)\\|\\(@\\w+["
138	       scribe-open-parentheses
139	       "].*["
140	       scribe-close-parentheses
141	       "]$\\)"))
142  (set (make-local-variable 'paragraph-separate)
143       (if scribe-fancy-paragraphs paragraph-start "$"))
144  (set (make-local-variable 'sentence-end)
145       "\\([.?!]\\|@:\\)[]\"')}]*\\($\\| $\\|\t\\|  \\)[ \t\n]*")
146  (set (make-local-variable 'compile-command)
147       (concat "scribe " (buffer-file-name))))
148
149(defun scribe-tab ()
150  (interactive)
151  (insert "@\\"))
152
153;; This algorithm could probably be improved somewhat.
154;;  Right now, it loses seriously...
155
156(defun scribe ()
157  "Run Scribe on the current buffer."
158  (interactive)
159  (call-interactively 'compile))
160
161(defun scribe-envelop-word (string count)
162  "Surround current word with Scribe construct @STRING[...].
163COUNT specifies how many words to surround.  A negative count means
164to skip backward."
165  (let ((spos (point)) (epos (point)) (ccoun 0) noparens)
166    (if (not (zerop count))
167	(progn (if (= (char-syntax (preceding-char)) ?w)
168		   (forward-sexp (min -1 count)))
169	       (setq spos (point))
170	       (if (looking-at (concat "@\\w[" scribe-open-parentheses "]"))
171		   (forward-char 2)
172		 (goto-char epos)
173		 (skip-chars-backward "\\W")
174		 (forward-char -1))
175	       (forward-sexp (max count 1))
176	       (setq epos (point))))
177    (goto-char spos)
178    (while (and (< ccoun (length scribe-open-parentheses))
179		(save-excursion
180		  (or (search-forward (char-to-string
181				       (aref scribe-open-parentheses ccoun))
182				      epos t)
183		      (search-forward (char-to-string
184				       (aref scribe-close-parentheses ccoun))
185				      epos t)))
186		(setq ccoun (1+ ccoun))))
187    (if (>= ccoun (length scribe-open-parentheses))
188	(progn (goto-char epos)
189	       (insert "@end(" string ")")
190	       (goto-char spos)
191	       (insert "@begin(" string ")"))
192      (goto-char epos)
193      (insert (aref scribe-close-parentheses ccoun))
194      (goto-char spos)
195      (insert "@" string (aref scribe-open-parentheses ccoun))
196      (goto-char epos)
197      (forward-char 3)
198      (skip-chars-forward scribe-close-parentheses))))
199
200(defun scribe-underline-word (count)
201  "Underline COUNT words around point by means of Scribe constructs."
202  (interactive "p")
203  (scribe-envelop-word "u" count))
204
205(defun scribe-bold-word (count)
206  "Boldface COUNT words around point by means of Scribe constructs."
207  (interactive "p")
208  (scribe-envelop-word "b" count))
209
210(defun scribe-italicize-word (count)
211  "Italicize COUNT words around point by means of Scribe constructs."
212  (interactive "p")
213  (scribe-envelop-word "i" count))
214
215(defun scribe-begin ()
216  (interactive)
217  (insert "\n")
218  (forward-char -1)
219  (scribe-envelop-word "Begin" 0)
220  (re-search-forward (concat "[" scribe-open-parentheses "]")))
221
222(defun scribe-end ()
223  (interactive)
224  (insert "\n")
225  (forward-char -1)
226  (scribe-envelop-word "End" 0)
227  (re-search-forward (concat "[" scribe-open-parentheses "]")))
228
229(defun scribe-chapter ()
230  (interactive)
231  (insert "\n")
232  (forward-char -1)
233  (scribe-envelop-word "Chapter" 0)
234  (re-search-forward (concat "[" scribe-open-parentheses "]")))
235
236(defun scribe-section ()
237  (interactive)
238  (insert "\n")
239  (forward-char -1)
240  (scribe-envelop-word "Section" 0)
241  (re-search-forward (concat "[" scribe-open-parentheses "]")))
242
243(defun scribe-subsection ()
244  (interactive)
245  (insert "\n")
246  (forward-char -1)
247  (scribe-envelop-word "SubSection" 0)
248  (re-search-forward (concat "[" scribe-open-parentheses "]")))
249
250(defun scribe-bracket-region-be (env min max)
251  (interactive "sEnvironment: \nr")
252  (save-excursion
253    (goto-char max)
254    (insert "@end(" env ")\n")
255    (goto-char min)
256    (insert "@begin(" env ")\n")))
257
258(defun scribe-insert-environment (env)
259  (interactive "sEnvironment: ")
260  (scribe-bracket-region-be env (point) (point))
261  (forward-line 1)
262  (insert ?\n)
263  (forward-char -1))
264
265(defun scribe-insert-quote (count)
266  "Insert ``, '' or \" according to preceding character.
267If `scribe-electric-quote' is non-nil, insert ``, '' or \" according
268to preceding character.  With numeric arg N, always insert N \" characters.
269Else just insert \"."
270  (interactive "P")
271  (if (or count (not scribe-electric-quote))
272      (self-insert-command (prefix-numeric-value count))
273    (let (lastfore lastback lastquote)
274      (insert
275       (cond
276	((= (preceding-char) ?\\) ?\")
277	((bobp) "``")
278	(t
279	 (setq lastfore (save-excursion (and (search-backward
280					      "``" (- (point) 1000) t)
281					     (point)))
282	       lastback (save-excursion (and (search-backward
283					      "''" (- (point) 1000) t)
284					     (point)))
285	       lastquote (save-excursion (and (search-backward
286					       "\"" (- (point) 100) t)
287					      (point))))
288	 (if (not lastquote)
289	     (cond ((not lastfore) "``")
290		   ((not lastback) "''")
291		   ((> lastfore lastback) "''")
292		   (t "``"))
293	   (cond ((and (not lastback) (not lastfore)) "\"")
294		 ((and lastback (not lastfore) (> lastquote lastback)) "\"")
295		 ((and lastback (not lastfore) (> lastback lastquote)) "``")
296		 ((and lastfore (not lastback) (> lastquote lastfore)) "\"")
297		 ((and lastfore (not lastback) (> lastfore lastquote)) "''")
298		 ((and (> lastquote lastfore) (> lastquote lastback)) "\"")
299		 ((> lastfore lastback) "''")
300		 (t "``")))))))))
301
302(defun scribe-parenthesis (count)
303  "If scribe-electric-parenthesis is non-nil, insertion of an open-parenthesis
304character inserts the following close parenthesis character if the
305preceding text is of the form @Command."
306  (interactive "P")
307  (self-insert-command (prefix-numeric-value count))
308  (let (at-command paren-char point-save)
309    (if (or count (not scribe-electric-parenthesis))
310	nil
311      (save-excursion
312	(forward-char -1)
313	(setq point-save (point))
314	(skip-chars-backward (concat "^ \n\t\f" scribe-open-parentheses))
315	(setq at-command (and (equal (following-char) ?@)
316			      (/= (point) (1- point-save)))))
317      (if (and at-command
318	       (setq paren-char
319		     (string-match (regexp-quote
320				    (char-to-string (preceding-char)))
321				   scribe-open-parentheses)))
322	  (save-excursion
323	    (insert (aref scribe-close-parentheses paren-char)))))))
324
325(provide 'scribe)
326
327;;; arch-tag: 64f454c4-7544-4ea2-9d14-f0b668f2cdc6
328;;; scribe.el ends here
329