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