Annotation of 43BSDReno/contrib/emacs-18.55/lisp/scribe.el, revision 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.