view lisp/textmodes/scribe.el @ 26088:b7aa6ac26872

Add support for large files, 64-bit Solaris, system locale codings. * Makefile.in (emacs): Set the LC_ALL environment variable to "C" when dumping, so that the dumped Emacs doesn't have stray locale info. (dired.o): Depend on systime.h. (editfns.o): Depend on coding.h. * alloc.c, buffer.c, callproc.c, ccl.c, charset.c, coding.c, data.c, dispnew.c, editfns.c, emacs.c, filelock.c, floatfns.c, hftctl.c, keyboard.c, process.c, sysdep.c, unexelf.c, unexhp9k800.c, unexsunos4.c, vmsfns.c, vmsgmalloc.c, w32faces.c, w32menu.c, w32term.c, w32xfns.c, xfaces.c, xfns.c, xmenu.c, xterm.c: Include <config.h> before any system include files. * alloc.c, buffer.c, ccl.c, data.c, editfns.c, emacs.c, eval.c, fileio.c, filelock.c, frame.c, insdel.c, keymap.c, lread.c, m/alpha.h, print.c, search.c, sysdep.c, xdisp.c, xfaces.c, xfns.c, xmenu.c, xterm.c: Do not include <stdlib.h>, as <config.h> does this now. * callproc.c (Fcall_process): Synchronize messages locale before invoking strerror. Decode resulting string with locale-coding-system. * coding.c (Vlocale_coding_system): New var. (syms_of_coding): Adjust to above change. (emacs_strerror): New function. * coding.h (emacs_strerror, Vlocale_coding_system): New decls. * config.in (HAVE_STDIO_EXT_H, HAVE_TM_GMTOFF, HAVE___FPENDING, HAVE_FTELLO, HAVE_GETLOADAVG, HAVE_MBLEN, HAVE_MBRLEN, HAVE_STRSIGNAL): New macros. (BITS_PER_LONG): Default to 64 if _LP64 is defined. <stdlib.h>: Include if HAVE_STDLIB_H is defined and NOT_C_CODE isn't. * dired.c: Include "systime.h". (Ffile_attributes): Do not cast s.st_size to int; this loses information if int is 32 bits but st_size and EMACS_INT are larger. Treat large device numbers like large inode numbers. * dispnew.c (PENDING_OUTPUT_COUNT): Use __fpending if available. * editfns.c: Include coding.h. (emacs_strftime): Remove decl. (emacs_strftimeu): New decl. (emacs_memftimeu): Renamed from emacs_memftime; new arg UT. Use emacs_strftimeu instead of emacs_strftime. (Fformat_time_string): Convert format string using Vlocale_coding_system, and convert result back. Synchronize time locale before invoking lower level function. Invoke emacs_memftimeu, passing ut, instead of emacs_memftime. * emacs.c: Include <locale.h> if HAVE_SETLOCALE is defined. (Vmessages_locale, Vprevious_messages_locale, Vtime_locale, Vprevious_time_locale): New variables. (main): Invoke setlocale early, so that initial error messages are localized properly. But skip locale-setting if LC_ALL is "C". Fix up locale when it's safe to do so. (fixup_locale): Moved here from xterm.c. (synchronize_locale, synchronize_time_locale, synchronize_messages_locale): New functions. (syms_of_emacs): Accommodate above changes. * fileio.c (report_file_error): Convert strerror output according to Vlocale_coding_system. (Finsert_file_contents): Check for arithmetic overflow in computations that depend on file size. Report IO errors with emacs_strerror, not strerror. * fns.c (Fgethash): Declare dflt parameter. * gmalloc.c: Do not define const to nothing if HAVE_CONFIG_H is defined; that's config.h's job. * lisp.h (EMACS_INT, BITS_PER_EMACS_INT, EMACS_UINT): If _LP64, default these values to long, BITS_PER_LONG, and unsigned long. (VALBITS, MARKBIT, XINT): Do not assume 32-bit EMACS_INT. (PNTR_COMPARISON_TYPE): Default to EMACS_UINT, not to unsigned int. (code_convert_string_norecord, fixup_locale, synchronize_messages_locale, synchronize_time_locale, emacs_open, emacs_close, emacs_read, emacs_write): New decls. All Emacs callers of open, close, read, write changed to use emacs_open, emacs_close, emacs_read, emacs_write. * lread.c (file_offset, file_tell): New macros. All uses of ftell changed to file_tell. (saved_doc_string_position, prev_saved_doc_string_position): Now of type file_offset. (init_lread): Do not fix locale here; fixup_locale now does this. * m/amdahl.h, s/usg5-4.h: (NSIG): Remove. (NSIG_MINIMUM): New macro. * m/cydra5.h, m/dpx2.h, m/mips.h, m/pfa50.h, m/sps7.h, m/stride.h, m/ustation.h, s/gnu-linux.h, s/hpux.h, s/iris3-5.h, s/iris3-6.h, s/umips.h, s/usg5-4.h: (SIGIO): Do not undef. (BROKEN_SIGIO): New macro. * m/ustation.h: (SIGTSTP): Do not undef. (BROKEN_SIGTSTP): New macro. * s/gnu-linux.h: (SIGPOLL, SIGURG): Do not undef. (BROKEN_SIGPOLL, BROKEN_SIGURG): New macros. * s/ptx4.h: (SIGINFO): Do not undef. (BROKEN_SIGINFO): New macros. * m/delta.h, s/ptx.h, s/template.h: Doc fix. * mktime.c, strftime.c: Update to glibc 2.1.2 version, with some Emacs-related changes merged. * print.c (float_to_string): Prepend "-" to representation of a NaN if the NaN is negative. * process.c (sys_siglist): Omit if HAVE_STRSIGNAL. (wait_reading_process_input): Use emacs_strerror, not strerror. * process.c (status_message, sigchld_handler): Synchronize locale, then use strsignal istead of sys_siglist. * w32proc.c (sys_wait): Likewise. * s/aix3-1.h, s/bsd4-1.h, s/dgux.h, s/gnu-linux.h, s/hiuxmpp.h, s/hpux.h, s/iris3-5.h, s/iris3-6.h, s/irix3-3.h, s/osf1.h, s/rtu.h, s/sunos4-1.h, s/unipl5-0.h, s/unipl5-2.h, s/usg5-0.h, s/usg5-2-2.h, s/usg5-2.h, s/usg5-3.h, s/xenix.h: (open, close, read, write, INTERRUPTIBLE_OPEN, INTERRUPTIBLE_CLOSE, INTERRUPTIBLE_IO): Remove. * s/sol2-5.h (_LARGEFILE_SOURCE, _FILE_OFFSET_BITS): New macros. * sysdep.c (sys_read, sys_write, read, write, sys_close, close, sys_open, open): Remove. (emacs_open, emacs_close, emacs_read, emacs_write): Always define; the old INTERRUPTIBLE_OPEN, INTERRUPTIBLE_CLOSE, and INTERRUPTIBLE_IO macros are no longer used. (emacs_open): Renamed from sys_open. Merge BSD4_1 version. (emacs_close): Renamed from sys_close. (emacs_read): Renamed from sys_read. (emacs_write): Renamed from sys_write. (sys_siglist): Do not declare if HAVE_STRSIGNAL. (dup2): Do not print error on failure; the real dup2 doesn't. (strsignal): New function, defined if !HAVE_STRSIGNAL. * syssignal.h (SIGINFO): Undef if defined and if BROKEN_SIGINFO is defined. (SIGIO, SIGPOLL, SIGTSTP, SIGURG): Likewise. (NSIG): If less than NSIG_MINIMUM, define to NSIG_MINIMUM. (strsignal): Declare if !HAVE_STRSIGNAL. * unexelf.c (ElfBitsW, ELFSIZE, ElfExpandBitsW): New macros. (ElfW): Define in terms of ElfExpandBitsW. * w32proc.c (sys_siglist): Remove decl. * xdisp.c (decode_mode_spec): 3rd arg is int, not char, to comply with ANSI C. (display_string): Declare face_string_pos arg. * xfns.c (Fx_show_tip): Declare timeout param. * xterm.c: No need to include locale.h. (x_alloc_lighter_color, x_setup_relief_color): Pass arg as double, not float, for compatibility with ANSI C. (fixup_locale): Move to emacs.c. (x_term_init): Do not setlocale or fixup locale; the main program does this now.

;;; scribe.el --- scribe mode, and its idiosyncratic commands.

;; Copyright (C) 1985 Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: wp

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; A major mode for editing source in written for the Scribe text formatter.
;; Knows about Scribe syntax and standard layout rules.  The command to
;; run Scribe on a buffer is bogus; someone interested should fix it.

;;; Code:

(defgroup scribe nil
  "Scribe mode."
  :prefix "scribe-"
  :group 'wp)

(defvar scribe-mode-syntax-table nil
  "Syntax table used while in scribe mode.")

(defvar scribe-mode-abbrev-table nil
  "Abbrev table used while in scribe mode.")

(defcustom scribe-fancy-paragraphs nil
  "*Non-NIL makes Scribe mode use a different style of paragraph separation."
  :type 'boolean
  :group 'scribe)

(defcustom scribe-electric-quote nil
  "*Non-NIL makes insert of double quote use `` or '' depending on context."
  :type 'boolean
  :group 'scribe)

(defcustom scribe-electric-parenthesis nil
  "*Non-NIL makes parenthesis char ( (]}> ) automatically insert its close
if typed after an @Command form."
  :type 'boolean
  :group 'scribe)

(defconst scribe-open-parentheses "[({<"
  "Open parenthesis characters for Scribe.")

(defconst scribe-close-parentheses "])}>"
  "Close parenthesis characters for Scribe.
These should match up with `scribe-open-parenthesis'.")

(if (null scribe-mode-syntax-table)
    (let ((st (syntax-table)))
      (unwind-protect
       (progn
	(setq scribe-mode-syntax-table (copy-syntax-table
					text-mode-syntax-table))
	(set-syntax-table scribe-mode-syntax-table)
	(modify-syntax-entry ?\" "    ")
	(modify-syntax-entry ?\\ "    ")
	(modify-syntax-entry ?@ "w   ")
	(modify-syntax-entry ?< "(>  ")
	(modify-syntax-entry ?> ")<  ")
	(modify-syntax-entry ?[ "(]  ")
	(modify-syntax-entry ?] ")[  ")
	(modify-syntax-entry ?{ "(}  ")
	(modify-syntax-entry ?} "){  ")
	(modify-syntax-entry ?' "w   "))
       (set-syntax-table st))))

(defvar scribe-mode-map nil)

(if scribe-mode-map
    nil
  (setq scribe-mode-map (make-sparse-keymap))
  (define-key scribe-mode-map "\t" 'scribe-tab)
  (define-key scribe-mode-map "\e\t" 'tab-to-tab-stop)
  (define-key scribe-mode-map "\es" 'center-line)
  (define-key scribe-mode-map "\e}" 'up-list)
  (define-key scribe-mode-map "\eS" 'center-paragraph)
  (define-key scribe-mode-map "\"" 'scribe-insert-quote)
  (define-key scribe-mode-map "(" 'scribe-parenthesis)
  (define-key scribe-mode-map "[" 'scribe-parenthesis)
  (define-key scribe-mode-map "{" 'scribe-parenthesis)
  (define-key scribe-mode-map "<" 'scribe-parenthesis)
  (define-key scribe-mode-map "\C-c\C-c" 'scribe-chapter)
  (define-key scribe-mode-map "\C-c\C-t" 'scribe-section)
  (define-key scribe-mode-map "\C-c\C-s" 'scribe-subsection)
  (define-key scribe-mode-map "\C-c\C-v" 'scribe-insert-environment)
  (define-key scribe-mode-map "\C-c\C-e" 'scribe-bracket-region-be)
  (define-key scribe-mode-map "\C-c[" 'scribe-begin)
  (define-key scribe-mode-map "\C-c]" 'scribe-end)
  (define-key scribe-mode-map "\C-c\C-i" 'scribe-italicize-word)
  (define-key scribe-mode-map "\C-c\C-b" 'scribe-bold-word)
  (define-key scribe-mode-map "\C-c\C-u" 'scribe-underline-word))

;;;###autoload
(defun scribe-mode ()
  "Major mode for editing files of Scribe (a text formatter) source.
Scribe-mode is similar text-mode, with a few extra commands added.
\\{scribe-mode-map}

Interesting variables:

scribe-fancy-paragraphs
  Non-nil makes Scribe mode use a different style of paragraph separation.

scribe-electric-quote
  Non-nil makes insert of double quote use `` or '' depending on context.

scribe-electric-parenthesis
  Non-nil makes an open-parenthesis char (one of `([<{')
  automatically insert its close if typed after an @Command form."
  (interactive)
  (kill-all-local-variables)
  (use-local-map scribe-mode-map)
  (setq mode-name "Scribe")
  (setq major-mode 'scribe-mode)
  (define-abbrev-table 'scribe-mode-abbrev-table ())
  (setq local-abbrev-table scribe-mode-abbrev-table)
  (make-local-variable 'comment-start)
  (setq comment-start "@Comment[")
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip (concat "@Comment[" scribe-open-parentheses "]"))
  (make-local-variable 'comment-column)
  (setq comment-column 0)
  (make-local-variable 'comment-end)
  (setq comment-end "]")
  (make-local-variable 'paragraph-start)
  (setq paragraph-start (concat "\\([\n\f]\\)\\|\\(@\\w+["
				 scribe-open-parentheses
				"].*["
				 scribe-close-parentheses
				"]$\\)"))
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate (if scribe-fancy-paragraphs
			       paragraph-start "$"))
  (make-local-variable 'sentence-end)
  (setq sentence-end "\\([.?!]\\|@:\\)[]\"')}]*\\($\\| $\\|\t\\|  \\)[ \t\n]*")
  (make-local-variable 'compile-command)
  (setq compile-command (concat "scribe " (buffer-file-name)))
  (set-syntax-table scribe-mode-syntax-table)
  (run-hooks 'text-mode-hook 'scribe-mode-hook))

(defun scribe-tab ()
  (interactive)
  (insert "@\\"))

;; This algorithm could probably be improved somewhat.
;;  Right now, it loses seriously...

(defun scribe ()
  "Run Scribe on the current buffer."
  (interactive)
  (call-interactively 'compile))

(defun scribe-envelop-word (string count)
  "Surround current word with Scribe construct @STRING[...].
COUNT specifies how many words to surround.  A negative count means
to skip backward."
  (let ((spos (point)) (epos (point)) (ccoun 0) noparens)
    (if (not (zerop count))
	(progn (if (= (char-syntax (preceding-char)) ?w)
		   (forward-sexp (min -1 count)))
	       (setq spos (point))
	       (if (looking-at (concat "@\\w[" scribe-open-parentheses "]"))
		   (forward-char 2)
		 (goto-char epos)
		 (skip-chars-backward "\\W")
		 (forward-char -1))
	       (forward-sexp (max count 1))
	       (setq epos (point))))
    (goto-char spos)
    (while (and (< ccoun (length scribe-open-parentheses))
		(save-excursion
		  (or (search-forward (char-to-string
				       (aref scribe-open-parentheses ccoun))
				      epos t)
		      (search-forward (char-to-string
				       (aref scribe-close-parentheses ccoun))
				      epos t)))
		(setq ccoun (1+ ccoun))))
    (if (>= ccoun (length scribe-open-parentheses))
	(progn (goto-char epos)
	       (insert "@end(" string ")")
	       (goto-char spos)
	       (insert "@begin(" string ")"))
      (goto-char epos)
      (insert (aref scribe-close-parentheses ccoun))
      (goto-char spos)
      (insert "@" string (aref scribe-open-parentheses ccoun))
      (goto-char epos)
      (forward-char 3)
      (skip-chars-forward scribe-close-parentheses))))

(defun scribe-underline-word (count)
  "Underline COUNT words around point by means of Scribe constructs."
  (interactive "p")
  (scribe-envelop-word "u" count))

(defun scribe-bold-word (count)
  "Boldface COUNT words around point by means of Scribe constructs."
  (interactive "p")
  (scribe-envelop-word "b" count))

(defun scribe-italicize-word (count)
  "Italicize COUNT words around point by means of Scribe constructs."
  (interactive "p")
  (scribe-envelop-word "i" count))

(defun scribe-begin ()
  (interactive)
  (insert "\n")
  (forward-char -1)
  (scribe-envelop-word "Begin" 0)
  (re-search-forward (concat "[" scribe-open-parentheses "]")))

(defun scribe-end ()
  (interactive)
  (insert "\n")
  (forward-char -1)
  (scribe-envelop-word "End" 0)
  (re-search-forward (concat "[" scribe-open-parentheses "]")))

(defun scribe-chapter ()
  (interactive)
  (insert "\n")
  (forward-char -1)
  (scribe-envelop-word "Chapter" 0)
  (re-search-forward (concat "[" scribe-open-parentheses "]")))

(defun scribe-section ()
  (interactive)
  (insert "\n")
  (forward-char -1)
  (scribe-envelop-word "Section" 0)
  (re-search-forward (concat "[" scribe-open-parentheses "]")))

(defun scribe-subsection ()
  (interactive)
  (insert "\n")
  (forward-char -1)
  (scribe-envelop-word "SubSection" 0)
  (re-search-forward (concat "[" scribe-open-parentheses "]")))

(defun scribe-bracket-region-be (env min max)
  (interactive "sEnvironment: \nr")
  (save-excursion
    (goto-char max)
    (insert "@end(" env ")\n")
    (goto-char min)
    (insert "@begin(" env ")\n")))

(defun scribe-insert-environment (env)
  (interactive "sEnvironment: ")
  (scribe-bracket-region-be env (point) (point))
  (forward-line 1)
  (insert ?\n)
  (forward-char -1))

(defun scribe-insert-quote (count)
  "Insert ``, '' or \" according to preceding character.
If `scribe-electric-quote' is non-NIL, insert ``, '' or \" according
to preceding character.  With numeric arg N, always insert N \" characters.
Else just insert \"."
  (interactive "P")
  (if (or count (not scribe-electric-quote))
      (self-insert-command (prefix-numeric-value count))
    (let (lastfore lastback lastquote)
      (insert
       (cond
	((= (preceding-char) ?\\) ?\")
	((bobp) "``")
	(t
	 (setq lastfore (save-excursion (and (search-backward
					      "``" (- (point) 1000) t)
					     (point)))
	       lastback (save-excursion (and (search-backward
					      "''" (- (point) 1000) t)
					     (point)))
	       lastquote (save-excursion (and (search-backward
					       "\"" (- (point) 100) t)
					      (point))))
	 (if (not lastquote)
	     (cond ((not lastfore) "``")
		   ((not lastback) "''")
		   ((> lastfore lastback) "''")
		   (t "``"))
	   (cond ((and (not lastback) (not lastfore)) "\"")
		 ((and lastback (not lastfore) (> lastquote lastback)) "\"")
		 ((and lastback (not lastfore) (> lastback lastquote)) "``")
		 ((and lastfore (not lastback) (> lastquote lastfore)) "\"")
		 ((and lastfore (not lastback) (> lastfore lastquote)) "''")
		 ((and (> lastquote lastfore) (> lastquote lastback)) "\"")
		 ((> lastfore lastback) "''")
		 (t "``")))))))))

(defun scribe-parenthesis (count)
  "If scribe-electric-parenthesis is non-NIL, insertion of an open-parenthesis
character inserts the following close parenthesis character if the
preceding text is of the form @Command."
  (interactive "P")
  (self-insert-command (prefix-numeric-value count))
  (let (at-command paren-char point-save)
    (if (or count (not scribe-electric-parenthesis))
	nil
      (save-excursion
	(forward-char -1)
	(setq point-save (point))
	(skip-chars-backward (concat "^ \n\t\f" scribe-open-parentheses))
	(setq at-command (and (equal (following-char) ?@)
			      (/= (point) (1- point-save)))))
      (if (and at-command
	       (setq paren-char
		     (string-match (regexp-quote
				    (char-to-string (preceding-char)))
				   scribe-open-parentheses)))
	  (save-excursion
	    (insert (aref scribe-close-parentheses paren-char)))))))

(provide 'scribe)

;;; scribe.el ends here