lisp/obsolete/scribe.el

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