Annotation of 43BSDReno/contrib/emacs-18.55/lisp/scribe.el, revision 1.1.1.1

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)))))))

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.