annotate lisp/textmodes/scribe.el @ 1717:aa7d6d57504b

* frame.h (struct frame): New fields `can_have_scrollbars' and `has_vertical_scrollbars'. (FRAME_CAN_HAVE_SCROLLBARS, FRAME_HAS_VERTICAL_SCROLLBARS): New accessors, for both the MULTI_FRAME and non-MULTI_FRAME. (VERTICAL_SCROLLBAR_WIDTH, WINDOW_VERTICAL_SCROLLBAR, WINDOW_VERTICAL_SCROLLBAR_COLUMN, WINDOW_VERTICAL_SCROLLBAR_HEIGHT): New macros. * window.h (struct window): New field `vertical_scrollbar'. * xterm.h (struct x_display): vertical_scrollbars, judge_timestamp, vertical_scrollbar_extra: New fields. (struct scrollbar): New struct. (VERTICAL_SCROLLBAR_PIXEL_WIDTH, VERTICAL_SCROLLBAR_PIXEL_HEIGHT, VERTICAL_SCROLLBAR_LEFT_BORDER, VERTICAL_SCROLLBAR_RIGHT_BORDER, VERTICAL_SCROLLBAR_TOP_BORDER, VERTICAL_SCROLLBAR_BOTTOM_BORDER, CHAR_TO_PIXEL_WIDTH, CHAR_TO_PIXEL_HEIGHT, PIXEL_TO_CHAR_WIDTH, PIXEL_TO_CHAR_HEIGHT): New accessors and macros. * frame.c (make_frame): Initialize the `can_have_scrollbars' and `has_vertical_scrollbars' fields of the frame. * term.c (term_init): Note that TERMCAP terminals don't support scrollbars. (mouse_position_hook): Document new args. (set_vertical_scrollbar_hook, condemn_scrollbars_hook, redeem_scrollbar_hook, judge_scrollbars_hook): New hooks. * termhooks.h: Declare and document them. (enum scrollbar_part): New type. (struct input_event): Describe the new form of the scrollbar_click event type. Change `part' from a Lisp_Object to an enum scrollbar_part. Add a new field `scrollbar'. * keyboard.c (kbd_buffer_get_event): Pass appropriate new parameters to *mouse_position_hook, and make_lispy_movement. * xfns.c (x_set_vertical_scrollbar): New function. (x_figure_window_size): Use new macros to calculate frame size. (Fx_create_frame): Note that X Windows frames do support scroll bars. Default to "yes". * xterm.c: #include <X11/cursorfont.h> and "window.h". (x_vertical_scrollbar_cursor): New variable. (x_term_init): Initialize it. (last_mouse_bar, last_mouse_bar_frame, last_mouse_part, last_mouse_scroll_range_start, last_mouse_scroll_range_end): New variables. (XTmouse_position): Use them to return scrollbar movement events. Take new arguments, for that purpose. (x_window_to_scrollbar, x_scrollbar_create, x_scrollbar_set_handle, x_scrollbar_remove, x_scrollbar_move, XTset_scrollbar, XTcondemn_scrollbars, XTredeem_scrollbar, XTjudge_scrollbars, x_scrollbar_expose, x_scrollbar_background_expose, x_scrollbar_handle_click, x_scrollbar_handle_motion): New functions to implement scrollbars. (x_term_init): Set the termhooks.h hooks to point to them. (x_set_window_size): Use new macros to calculate frame size. Set vertical_scrollbar_extra field. (x_make_frame_visible): Use the frame accessor FRAME_HAS_VERTICAL_SCROLLBARS to decide if we need to map the frame's subwindows as well. (XTread_socket): Use new size-calculation macros from xterm.h when processing ConfigureNotify events. (x_wm_set_size_hint): Use PIXEL_TO_CHAR_WIDTH and PIXEL_TO_CHAR_HEIGHT macros. * ymakefile (xdisp.o): This now depends on termhooks.h. (xterm.o): This now depends on window.h.

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

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

;; Maintainer: FSF

;; This file might become part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but without any warranty.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; document "GNU Emacs copying permission notice".   An exact copy
;; of the document is supposed to have been given to you along with
;; GNU Emacs so that you can know how you may redistribute it all.
;; It should be in a file named COPYING.  Among other things, the
;; copyright notice and this notice must be preserved on all copies.

;;; Code:

(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.")

(defvar scribe-fancy-paragraphs nil
  "*Non-NIL makes Scribe mode use a different style of paragraph separation.")

(defvar scribe-electric-quote nil
  "*Non-NIL makes insert of double quote use `` or '' depending on context.")

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

(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 "\^cc" 'scribe-chapter)
  (define-key scribe-mode-map "\^cS" 'scribe-section)
  (define-key scribe-mode-map "\^cs" 'scribe-subsection)
  (define-key scribe-mode-map "\^ce" 'scribe-insert-environment)
  (define-key scribe-mode-map "\^c\^e" 'scribe-bracket-region-be)
  (define-key scribe-mode-map "\^c[" 'scribe-begin)
  (define-key scribe-mode-map "\^c]" 'scribe-end)
  (define-key scribe-mode-map "\^ci" 'scribe-italicize-word)
  (define-key scribe-mode-map "\^cb" 'scribe-bold-word)
  (define-key scribe-mode-map "\^cu" '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 '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)))))))

;;; scribe.el ends here