smartdoc-elisp 1.0-5 / usr / share / emacs / site-lisp / smartdoc / sdoc-mode.el

;;
;; SmartDoc mode
;;
;; @since   Nov.  4, 1998
;; @version Nov. 25, 2000
;; @author  ASAMI, Tomoharu (asami@zeomtech.com)
;;

(require 'sgml-mode)
(require 'sdoc-helper)

(defvar sdoc-quick-keys sgml-quick-keys
  "Use C-c X combinations for quick insertion of frequent tags when non-nil.
This defaults to `sgml-quick-keys'.
This takes effect when first loading the library.")

(defvar sdoc-mode-map
  (let ((map
	 (if (string-match "XEmacs" emacs-version)
					; by txnakamu@yk.rim.or.jp
					; [sdoc-usersj 7]
					; by seiki@flab.fujitsu.co.jp
					; [sdoc-usersj 256]
	     sgml-mode-map
	   (nconc (make-sparse-keymap) sgml-mode-map)))
	(menu-map (make-sparse-keymap "SmartDoc")))
    (define-key map "\C-c\C-c" 'sdoc-compile)
    (define-key map "\C-c\C-k" 'sdoc-kill-content)
    (define-key map "\C-c\C-s\C-p" 'sdoc-insert-prototype)
    (define-key map "\C-c\C-s\C-e" 'sdoc-use-entities)
    (define-key map "\C-c\C-s\C-r" 'sdoc-make-table-records)
    (define-key map "\C-c\C-s\C-a" 'sdoc-insert-internal-link)
    (define-key map "\C-c\C-s\C-t" 'sdoc-auto-id-title)
    (define-key map "\C-c\C-s\C-s" 'sdoc-insert-program)
    (define-key map "\C-c\C-s\C-f" 'sdoc-insert-figure)
    map)
  "Keymap for commands for use in SDOC mode.")

(defvar sdoc-face-tag-alist
  '((bold . "b")
    (italic . "i")
    (underline . "u")
    (modeline . "rev"))
  "Value of `sgml-face-tag-alist' for SDOC mode.")

(defvar sdoc-tag-face-alist
  '(("b" . bold)
    ("big" . bold)
    ("blink" . highlight)
    ("cite" . italic)
    ("em" . italic)
    ("h1" bold underline)
    ("h2" bold-italic underline)
    ("h3" italic underline)
    ("h4" . underline)
    ("h5" . underline)
    ("h6" . underline)
    ("i" . italic)
    ("rev"  . modeline)
    ("s" . underline)
    ("small" . default)
    ("strong" . bold)
    ("title" bold underline)
    ("tt" . default)
    ("u" . underline)
    ("var" . italic))
  "Value of `sgml-tag-face-alist' for HTML mode.")

(defvar sdoc-display-text
  '((img . "[/]")
    (hr . "----------")
    (li . "o "))
  "Value of `sgml-display-text' for SDOC mode.")

(defvar sdoc-tag-alist
  (let* ((xml:lang '("xml:lang" ("jp" "en")))
	 (locale '("locale" ("jp" "en")))
	 (format '("format" ("html4" "latex2e")))
	 (id '("id" nil))
	 (class '("class" nil))
	 (style '("style" nil))
	 (title '("title" nil))
	 (src '("src" nil))
	 (encoding '("encoding" ("ISO2022-JP" "EUC-JP" "Shift_JIS" "UTF-8")))
;	 (adapter '("adapter" ("csv" "tab" "sp"))) ; obsolate
	 (date '("date" nil))
	 (note '("note" nil))
	 (normalizer '("normalizer" nil))
	 (adapter '("adapter" nil))
	 (basic `(,xml:lang ,locale ,id ,class ,style ,format ,src ,encoding ,title ,normalizer ,adapter))
	 (1-7 '(("1") ("2") ("3") ("4") ("5") ("6") ("7")))
	 (1-9 '(,@1-7 ("8") ("9")))
	 (align '(("align" ("left") ("center") ("right"))))
	 (valign '(("top") ("middle") ("bottom") ("baseline")))
	 (rel '(("next") ("previous") ("parent") ("subdocument") ("made")))
	 (href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:")
		 ("mailto:") ("news:") ("rlogin:") ("telnet:") ("tn3270:")
		 ("wais:") ("/cgi-bin/")))
	 (name '("name"))
	 (link `(,href
		 ("rel" ,@rel)
		 ("rev" ,@rel)
		 ("title")))
	 (list '((nil \n ( "List item: "
			   "<li>" str \n))))
	 (cell `(,@basic
		 ("align" ,@align)
		 ("valign" ,@valign)
		 ("colspan" ,@1-9)
		 ("rowspan" ,@1-9)
		 ("nowrap" t))))
    ;;
    `(("doc" \n ,@basic)
      ("head" \n ,@basic)
      ("body" \n ,@basic)
      ("p" \n ,@basic)
      ("span" nil ,@basic ("ruby" nil))
      ("term" nil ,@basic ("category" nil))
      ("div" \n ,@basic)
      ("blockquote" \n ,@basic)
      ("q" nil ,@basic)
      ("title" nil ,@basic)
      ("date" nil ,@basic)
      ("author" nil ,@basic)
      ("hp" nil ,@basic)
      ("email" nil ,@basic)
      ("abstract" \n ,@basic)
      ("part" \n ,@basic ("sequencable" ("true" "false")))
      ("chapter" \n ,@basic ("sequencable" ("true" "false")))
      ("section" \n ,@basic ("sequencable" ("true" "false")))
      ("subsection" \n ,@basic ("sequencable" ("true" "false")))
      ("subsubsection" \n ,@basic ("sequencable" ("true" "false")))
      ("ul" \n ,@basic)
      ("ol" \n ,@basic)
      ("li" nil ,@basic)
      ("dl" \n ,@basic)
      ("dt" nil ,@basic)
      ("dd" nil ,@basic)
      ("a" nil ,@basic ,@link)
      ("table" \n ,@basic ("width" nil) ("height" nil))
      ("colgroup" \n ,@basic ("span" nil) ("align" nil) ("width" nil) ("type" nil))
      ("col" nil ,@basic ("span" nil) ("align" nil) ("width" nil) ("type" nil))
      ("thead" \n ,@basic \n)
      ("tbody" \n ,@basic \n)
      ("tr" \n ,@basic \n)
      ("th" nil ,@basic ,@cell)
      ("td" nil ,@basic ,@cell)
      ("img" \n ,@basic)
      ("figure" \n ,@basic ("width" nil) ("height" nil))
      ("program" \n ,@basic)
      ("console" \n ,@basic)
      ("fyi" \n ,@basic)
      ("note" nil ,@basic)
      ("comment" nil ,@basic)
      ("native" \n ,@basic)))
    "*Value of `sgml-tag-alist' for SDOC mode.")

(defvar sdoc-tag-help
  `(,@sgml-tag-help
    ("a" . "Anchor of point or link elsewhere")
    ("abbrev" . "?")
    ("acronym" . "?")
    ("address" . "Formatted mail address")
    ("array" . "Math array")
    ("au" . "?")
    ("b" . "Bold face")
    ("base" . "Base address for URLs")
    ("big" . "Font size")
    ("blink" . "Blinking text")
    ("blockquote" . "Indented quotation")
    ("body" . "Document body")
    ("box" . "Math fraction")
    ("br" . "Line break")
    ("center" . "Centered text")
    ("changed" . "Change bars")
    ("cite" . "Citation of a document")
    ("code" . "Formatted source code")
    ("dd" . "Definition of term")
    ("del" . "?")
    ("dfn" . "?")
    ("dir" . "Directory list (obsolete)")
    ("dl" . "Definition list")
    ("dt" . "Term to be definined")
    ("em" . "Emphasised") 
    ("embed" . "Embedded data in foreign format")
    ("fig" . "Figure")
    ("figa" . "Figure anchor")
    ("figd" . "Figure description")
    ("figt" . "Figure text")
    ;("fn" . "?")  ; ???
    ("font" . "Font size")
    ("form" . "Form with input fields")
    ("group" . "Document grouping")
    ("h1" . "Most important section headline")
    ("h2" . "Important section headline")
    ("h3" . "Section headline")
    ("h4" . "Minor section headline")
    ("h5" . "Unimportant section headline")
    ("h6" . "Least important section headline")
    ("head" . "Document header")
    ("hr" . "Horizontal rule")
    ("sdoc" . "SDOC Document")
    ("i" . "Italic face")
    ("img" . "Graphic image")
    ("input" . "Form input field")
    ("ins" . "?")
    ("isindex" . "Input field for index search")
    ("kbd" . "Keybard example face")
    ("lang" . "Natural language")
    ("li" . "List item")
    ("link" . "Link relationship")
    ("math" . "Math formula")
    ("menu" . "Menu list (obsolete)")
    ("mh" . "Form mail header")
    ("nextid" . "Allocate new id")
    ("nobr" . "Text without line break")
    ("ol" . "Ordered list")
    ("option" . "Selection list item")
    ("over" . "Math fraction rule")
    ("p" . "Paragraph start")
    ("panel" . "Floating panel")
    ("person" . "?")
    ("pre" . "Preformatted fixed width text")
    ("q" . "?")
    ("rev" . "Reverse video")
    ("s" . "?")
    ("samp" . "Sample text")
    ("select" . "Selection list")
    ("small" . "Font size")
    ("sp" . "Nobreak space")
    ("strong" . "Standout text")
    ("sub" . "Subscript")
    ("sup" . "Superscript")
    ("table" . "Table with rows and columns")
    ("tb" . "Table vertical break")
    ("td" . "Table data cell")
    ("textarea" . "Form multiline edit area")
    ("th" . "Table header cell")
    ("title" . "Document title")
    ("tr" . "Table row separator")
    ("tt" . "Typewriter face")
    ("u" . "Underlined text")
    ("ul" . "Unordered list")
    ("var" . "Math variable face")
    ("wbr" . "Enable <br> within <nobr>"))
"*Value of `sgml-tag-help' for SDOC mode.")

;;
;; font-lock
;;

(defvar sdoc-use-font-lock t)

;;
;; font-lock-comment-face <!--
;; font-lock-string-face "'CDATA
;; font-lock-keyword-face <!?
;; font-lock-builtin-face <doc
;; font-lock-function-name-face <foo
;; font-lock-variable-name-face &foo; foo=
;; font-lock-type-face
;; font-lock-reference-face
;; font-lock-warning-face
;;
(defvar sdoc-font-lock-type-tags
  '("doc"
    "head"
    "body"
    "part"
    "chapter"
    "section"
    "subsection"
    "subsubsection"
    "appendix"))

(defvar sdoc-font-lock-builtin-tags
  '("title"
    "date"
    "author"
    "email"
    "hp"
    "abstract"
    "p"
    "sen"
    "img"
    "a"
    "cite"
    "comment"
    "note"
    "span"
    "b"
    "i"
    "dfn"
    "tt"
    "em"
    "abbr"
    "acronym"
    "code"
    "q"
    "div"
    "fyi"
    "figure"
    "ul"
    "ol"
    "li"
    "dl"
    "dt"
    "dd"
    "table"
    "rowgroup"
    "colgroup"
    "col"
    "thead"
    "tfoot"
    "tbody"
    "tr"
    "th"
    "td"
    "tnote"
    "pre"
    "program"
    "console"
    "dvi"
    "blockquote"))

(defvar sdoc-font-lock-default-keywords
  '(("<!\\[CDATA\\[[^]]*\\]\\]>" . font-lock-string-face)
    ("<[!?][a-z0-9]+" . font-lock-keyword-face)
    ("<[?][a-z0-9]+[^<>]*\\([?]>\\)" 1 font-lock-keyword-face)
    ("<![a-z0-9]+[^<>]*\\(\\[\\|>\\)" 1 font-lock-keyword-face)
    ("</?[a-z0-9]+" . font-lock-function-name-face)
    ("[&%][-.A-Za-z0-9#]+;?" . font-lock-variable-name-face)
    ("<!--[^<>]*-->" . font-lock-comment-face)
    ("[a-z0-9:]+=" . font-lock-variable-name-face)
    ("\'[^\']*\'" . font-lock-string-face)
    ("\\]>" . font-lock-keyword-face)
    ("[?]>" . font-lock-keyword-face)
    ("/>" . font-lock-function-name-face)
    (">" . font-lock-function-name-face))
  "Default expressions to highlight in SmartDoc mode.")

(defvar sdoc-font-lock-keywords nil)

;;;###autoload
(defun sdoc-mode ()
  "Major mode based on SGML mode for editing SDOC documents.
This allows inserting skeleton costructs used in hypertext documents with
completion.  See below for an introduction to SDOC.  Use
\\[browse-url-of-buffer] to see how this comes out.  See also `sgml-mode' on
which this is based.

Do \\[describe-variable] sdoc- SPC and \\[describe-variable] sgml- SPC to see available variables.

To write fairly well formatted pages you only need to know few things.  Most
browsers have a function to read the source code of the page being seen, so
you can imitate various tricks.  Here's a very short SDOC primer which you
can also view with a browser to see what happens:

<title>A Title Describing Contents</title> should be on every page.  Pages can
have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
<hr> Parts can be separated with horizontal rules.

<p>Paragraphs only need an opening tag.  Line breaks and multiple spaces are
ignored unless the text is <pre>preformatted.</pre>  Text can be marked as
<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal  M-g  or
Edit/Text Properties/Face commands.

Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
to them with <a href=\"#SOMENAME\">see also somename</a>.  In the same way <a
href=\"URL\">see also URL</a> where URL is a filename relative to current
directory, or absolute as in `http://www.cs.indiana.edu/elisp/w3/docs.html'.

Images in many formats can be inlined with <img src=\"URL\">.

If you mainly create your own documents, `sgml-specials' might be
interesting.  But note that some SDOC 2 browsers can't handle `&apos;'.
To work around that, do:
   (eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))

\\{sdoc-mode-map}"
  (interactive)
  (sgml-mode-common sdoc-tag-face-alist sdoc-display-text)
  (use-local-map sdoc-mode-map)
  (make-local-variable 'sgml-tag-alist)
  (make-local-variable 'sgml-face-tag-alist)
  (make-local-variable 'sgml-tag-help)
  (make-local-variable 'outline-regexp)
  (make-local-variable 'outline-heading-end-regexp)
  (make-local-variable 'outline-level)
  (make-local-variable 'sentence-end)
  (make-local-variable 'sdoc-font-lock-buffer-keywords)
  (setq sdoc-font-lock-buffer-keywords (sdoc-make-font-lock-keywords))
  (setq font-lock-defaults '((sgml-font-lock-keywords-1
			      sdoc-font-lock-buffer-keywords) nil t))
  (setq sentence-end
	"[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\| $\\|\t\\|  \\)[ \t\n]*")
  (setq mode-name "SmartDoc"
        major-mode 'sdoc-mode
	sgml-tag-alist sdoc-tag-alist
	sgml-face-tag-alist sdoc-face-tag-alist
	sgml-tag-help sdoc-tag-help
	outline-regexp "^.*<\\(part\\|chapter\\|\\(sub\\)*section\\)"
	outline-heading-end-regexp "^.*<\\(part\\|chapter\\|\\(sub\\)*section\\)/>"
	outline-level (lambda ()
			(char-after (1- (match-end 0)))))
  (if sdoc-use-font-lock
      (font-lock-mode 1))
  (run-hooks 'sdoc-mode-hook))

(defun sdoc-make-font-lock-keywords ()
  (cond (sdoc-font-lock-keywords
	 sdoc-font-lock-keywords)
	(t
	 (let (keywrods1 keywords2)
	   (setq keywords1
		 (cond (sdoc-font-lock-type-tags
			(list (sdoc-make-font-lock-prologue
			       sdoc-font-lock-type-tags
			       'font-lock-type-face)
			      (sdoc-make-font-lock-epilogue
			       sdoc-font-lock-type-tags
			       'font-lock-type-face)))))
	   (setq keywords2
		 (cond (sdoc-font-lock-builtin-tags
			(list (sdoc-make-font-lock-prologue
			       sdoc-font-lock-builtin-tags
			       (if (string-match "XEmacs" emacs-version)
				   'default
				 'font-lock-builtin-face))
			      (sdoc-make-font-lock-epilogue
			       sdoc-font-lock-builtin-tags
			       (if (string-match "XEmacs" emacs-version)
				   'default
				 'font-lock-builtin-face))))))
	   (append keywords1
		   keywords2
		   sdoc-font-lock-default-keywords)))))

(defun sdoc-make-font-lock-prologue (tags face)
  (list
   (concat "\\(</?"
	   (sdoc-make-font-lock-tag-list tags)
	   "\\)\\( +[^ >]+\\)*/?>")
   1
   face))

(defun sdoc-make-font-lock-epilogue (tags face)
  (list
   (concat "</?"
	   (sdoc-make-font-lock-tag-list tags)
	   "\\( +[^ >]+\\)*\\(/?>\\)")
   3
   face))

(defun sdoc-make-font-lock-tag-list (tags)
  (let (string)
    (setq string "\\(");
    (setq string (concat string (car tags)))
    (setq tags (cdr tags))
    (while tags
      (setq string (concat string "\\|" (car tags)))
      (setq tags (cdr tags)))
    (concat string "\\)")))

(define-skeleton sdoc-href-anchor
  "SDOC anchor tag with href attribute."
  "URL: "
  '(setq input "http:")
  "<a href=\"" str "\">" _ "</a>")

(define-skeleton sdoc-name-anchor
  "SDOC anchor tag with name attribute."
  "Name: "
  "<a name=\"" str "\">" _ "</a>")

(define-skeleton sdoc-headline-1
  "SDOC level 1 headline tags."
  nil
  "<h1>" _ "</h1>")

(define-skeleton sdoc-headline-2
  "SDOC level 2 headline tags."
  nil
  "<h2>" _ "</h2>")

(define-skeleton sdoc-headline-3
  "SDOC level 3 headline tags."
  nil
  "<h3>" _ "</h3>")

(define-skeleton sdoc-headline-4
  "SDOC level 4 headline tags."
  nil
  "<h4>" _ "</h4>")

(define-skeleton sdoc-headline-5
  "SDOC level 5 headline tags."
  nil
  "<h5>" _ "</h5>")

(define-skeleton sdoc-headline-6
  "SDOC level 6 headline tags."
  nil
  "<h6>" _ "</h6>")

(define-skeleton sdoc-horizontal-rule
  "SDOC horizontal rule tag."
  nil
  "<hr>" \n)

(define-skeleton sdoc-image
  "SDOC image tag."
  nil
  "<img src=\"" _ "\">")

(define-skeleton sdoc-line
  "SDOC line break tag."
  nil
  "<br>" \n)

(define-skeleton sdoc-ordered-list
  "SDOC ordered list tags."
  nil
  "<ol>" \n
  "<li>" _ \n
  "</ol>")

(define-skeleton sdoc-unordered-list
  "SDOC unordered list tags."
  nil
  "<ul>" \n
  "<li>" _ \n
  "</ul>")

(define-skeleton sdoc-list-item
  "SDOC list item tag."
  nil
  (if (bolp) nil '\n)
  "<li>")

(define-skeleton sdoc-paragraph
  "SDOC paragraph tag."
  nil
  (if (bolp) nil ?\n)
  \n "<p>")

(define-skeleton sdoc-checkboxes
  "Group of connected checkbox inputs."
  nil
  '(setq v1 nil
	 v2 nil)
  ("Value: "
   "<input type=\"" (identity "checkbox") ; see comment above about identity
   "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: ")))
   "\" value=\"" str ?\"
   (if (y-or-n-p "Set \"checked\" attribute? ")
        (funcall skeleton-transformation " checked")) ">"
   (skeleton-read "Text: " (capitalize str))
   (or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
		       (funcall skeleton-transformation "<br>")
		     "")))
   \n))

(define-skeleton sdoc-radio-buttons
  "Group of connected radio button inputs."
  nil
  '(setq v1 nil
	 v2 (cons nil nil))
  ("Value: "
   "<input type=\"" (identity "radio") ; see comment above about identity
   "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: ")))
   "\" value=\"" str ?\"
   (if (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
       (funcall skeleton-transformation " checked") ">")
   (skeleton-read "Text: " (capitalize str))
   (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
			       (funcall skeleton-transformation "<br>")
			     "")))
   \n))


(defun sdoc-autoview-mode (&optional arg)
  "Toggle automatic viewing via `sdoc-viewer' upon saving buffer.
With positive prefix ARG always turns viewing on, with negative ARG always off.
Can be used as a value for `sdoc-mode-hook'."
  (interactive "P")
  (if (setq arg (if arg
		    (< (prefix-numeric-value arg) 0)
		  (and (boundp 'after-save-hook)
		       (memq 'browse-url-of-buffer after-save-hook))))
      (setq after-save-hook (delq 'browse-url-of-buffer after-save-hook))
    (make-local-hook 'after-save-hook)
    (add-hook 'after-save-hook 'browse-url-of-buffer nil t))
  (message "Autoviewing turned %s."
	   (if arg "off" "on")))

(provide 'sdoc-mode)