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