comparison lisp/textmodes/sgml-mode.el @ 17545:c67787f92aea

(sgml-value): Use 'identity as default value. (sgml-mode): Doc fix. (sgml-name-8bit-mode): Tell the user if set or reset. (sgml-tag): Doc fix. (sgml-tag): Protect "&lt;" from skeleton-transformation. (sgml-attributes): Doc fix. (sgml-attributes): Square brackets removed from prompt. (sgml-attributes): Arg ALIST renamed to TAG. (sgml-attributes): Apply skeleton-transformation when necessary. (sgml-value): Doc added. (sgml-value): Square brackets removed from prompt. (html-tag-alist): New variable 1-7, variable `list' changed. (html-tag-alist)<dir>, <menu>: Use new value of `list'. (html-tag-alist)<font>: Fixed (doc of sgml-tag-alist needs fixing). (html-tag-alist)<ol>, <ul>: Fixed. (html-tag-alist)<fn>: Commented out.

17544:9ba1f7641826

(defgroup sgml nil
  "SGML editing mode"
  :group 'languages)

(defcustom sgml-transformation nil
  "*Default value for `skeleton-transformation' (which see) in SGML mode."
  :type 'function
  :group 'sgml)

(put 'sgml-transformation 'variable-interactive

An argument of N to a tag-inserting command means that the next N
words should be wrapped.  When the region is highlighted, N defaults
to -1, which means the current region.

If you like upcased tags, put (setq skeleton-transformation 'upcase) in
sgml-mode-hook. 

Use \\[sgml-validate] to validate your document with an SGML parser.

Do \\[describe-variable] sgml- SPC to see available variables.
Do \\[describe-key] on the following bindings to discover what they do.

(defun sgml-name-8bit-mode ()
  "Toggle insertion of 8 bit characters."
  (interactive)
  (setq sgml-name-8bit-mode (not sgml-name-8bit-mode)))



(define-skeleton sgml-tag
  "Insert a tag you are prompted for, optionally with attributes.
Completion and configuration is according to `sgml-tag-alist'.
If you like tags and attributes in uppercase set `skeleton-transformation'
to `upcase'."
  (funcall skeleton-transformation
	   (completing-read "Tag: " sgml-tag-alist))
  ?< (setq v1 (eval str)) |
  (("") -1 '(undo-boundary) "&lt;") |
  (("") '(setq v2 (sgml-attributes v1 t)) ?>
   (if (string= "![" v1)
       (prog1 '(("") " [ " _ " ]]")
	 (backward-char))
     (if (or (eq v2 t)

		   (cdr v2)
		   '(resume: (car v2) _ "</" v1 ?>))))))))

(autoload 'skeleton-read "skeleton")

(defun sgml-attributes (alist &optional quiet)
  "When at toplevel of a tag, interactively insert attributes."
  (interactive (list (save-excursion (sgml-beginning-of-tag t))))
  (or (stringp alist) (error "Wrong context for adding attribute"))
  (if alist
      (let ((completion-ignore-case t)
	    car attribute i)
	(setq alist (cdr (assoc (downcase alist) sgml-tag-alist)))
	(if (or (symbolp (car alist))
		(symbolp (car (car alist))))
	    (setq car (car alist)
		  alist (cdr alist)))
	(or quiet
	    (message "No attributes configured."))
	(if (stringp (car alist))
	    (progn
	      (insert (if (eq (preceding-char) ? ) "" ? ) (car alist))
	      (sgml-value alist))
	  (setq i (length alist))
	  (while (> i 0)
	    (insert ? )
	    (insert (funcall skeleton-transformation
			     (setq attribute
				   (skeleton-read '(completing-read
						    "[Attribute]: "
						    alist)))))
	    (if (string= "" attribute)
		(setq i 0)
	      (sgml-value (assoc attribute alist))
	      (setq i (1- i))))

	   (1+ (point))
	   (match-end 0))
	t)))

(defun sgml-value (alist)
  (setq alist (cdr alist))
  (if (stringp (car alist))
      (insert "=\"" (car alist) ?\")
    (if (eq (car alist) t)
	(if (cdr alist)
	    (progn
	      (insert "=\"")
	      (setq alist (skeleton-read '(completing-read
					   "[Value]: " (cdr alist))))
	      (if (string< "" alist)
		  (insert alist ?\")
		(delete-backward-char 2))))
      (insert "=\"")
      (if alist

  "Value of `sgml-display-text' for HTML mode.")


; should code exactly HTML 3 here when that is finished
(defvar html-tag-alist
  (let* ((1-9 '(("8") ("9")
		("1") ("2") ("3") ("4") ("5") ("6") ("7")))
	 (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:")

	 (name '("name"))
	 (link `(,href
		 ("rel" ,@rel)
		 ("rev" ,@rel)
		 ("title")))
	 (list '((nil \n
		      ( "List item: "
			"<li>" str \n))
		 ("type" ("A") ("a") ("I") ("i") ("1"))))
	 (cell `(t
		 ,align
		 ("valign" ,@valign)
		 ("colspan" ,@1-9)
		 ("rowspan" ,@1-9)

    ;; put ,-expressions first, else byte-compile chokes (as of V19.29)
    ;; and like this it's more efficient anyway
    `(("a" ,name ,@link)
      ("base" t ,@href)
      ("dir" ,@list)
      ("font" ("size" ("-1") ("+1") ("-2") ("+2") ,@(cdr (cdr 1-9))))
      ("form" (\n _ \n "<input type=\"submit\" value=\"\">")
       ("action" ,@(cdr href)) ("method" ("get") ("post")))
      ("h1" ,@align)
      ("h2" ,@align)
      ("h3" ,@align)

       ("type" ("text") ("password") ("checkbox") ("radio")
	("submit") ("reset"))
       ("value"))
      ("link" t ,@link)
      ("menu" ,@list)
      ("ol" ,@list)
      ("p" t ,@align)
      ("select" (nil \n
		     ("Text: "
		      "<option>" str \n))
       ,name ("size" ,@1-9) ("multiple" t))

		     "<tr><" str ?> _ \n))
       ("border" t ,@1-9) ("width" "10") ("cellpadding"))
      ("td" ,@cell)
      ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9))
      ("th" ,@cell)
      ("ul" ,@list)

      ,@sgml-tag-alist

      ("abbrev")
      ("acronym")

      ("dl" (nil \n
		 ( "Term: "
		   "<dt>" str "<dd>" _ \n)))
      ("dt" (t _ "<dd>"))
      ("em")
      ("fn" "id" "fn")
      ("head" \n)
      ("html" (\n
	       "<head>\n"
	       "<title>" (setq str (read-input "Title: ")) "</title>\n"
	       "<body>\n<h1>" str "</h1>\n" _

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

  "Group of connected checkbox inputs."
  nil
  '(setq v1 nil
	 v2 nil)
  ("Value: "
   "<input type=\"" (identity "checkbox")
   "\" 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))

  "Group of connected radio button inputs."
  nil
  '(setq v1 nil
	 v2 (cons nil nil))
  ("Value: "
   "<input type=\"" (identity "radio")
   "\" 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))

17545:c67787f92aea

(defgroup sgml nil
  "SGML editing mode"
  :group 'languages)

(defcustom sgml-transformation 'identity
  "*Default value for `skeleton-transformation' (which see) in SGML mode."
  :type 'function
  :group 'sgml)

(put 'sgml-transformation 'variable-interactive

An argument of N to a tag-inserting command means that the next N
words should be wrapped.  When the region is highlighted, N defaults
to -1, which means the current region.

If you like upcased tags, put (setq sgml-transformation 'upcase) in
your .emacs file.

Use \\[sgml-validate] to validate your document with an SGML parser.

Do \\[describe-variable] sgml- SPC to see available variables.
Do \\[describe-key] on the following bindings to discover what they do.

(defun sgml-name-8bit-mode ()
  "Toggle insertion of 8 bit characters."
  (interactive)
  (setq sgml-name-8bit-mode (not sgml-name-8bit-mode))
  (message "sgml name 8 bit mode  is now %"
	   (if sgml-name-8bit-mode "ON" "OFF")))


; When an element of a skeleton is a string "str", it is passed
; through skeleton-transformation and inserted.  If "str" is to be
; inserted literally, one should obtain it as the return value of a
; function, e.g. (identity "str").

(define-skeleton sgml-tag
  "Insert a tag you are prompted for, optionally with attributes.
Completion and configuration is done according to `sgml-tag-alist'.
If you like tags and attributes in uppercase do \\[set-variable]
skeleton-transformation RET upcase RET, or put this in your .emacs
  (setq sgml-transformation 'upcase)."
  (funcall skeleton-transformation
	   (completing-read "Tag: " sgml-tag-alist))
  ?< (setq v1 (eval str)) |
  (("") -1 '(undo-boundary) (identity "&lt;")) |	; see comment above
  (("") '(setq v2 (sgml-attributes v1 t)) ?>
   (if (string= "![" v1)
       (prog1 '(("") " [ " _ " ]]")
	 (backward-char))
     (if (or (eq v2 t)

		   (cdr v2)
		   '(resume: (car v2) _ "</" v1 ?>))))))))

(autoload 'skeleton-read "skeleton")

(defun sgml-attributes (tag &optional quiet)
  "When at toplevel of a tag, interactively insert attributes.

Completion and configuration of TAG is done according to `sgml-tag-alist'.
If QUIET, does not print a message when there are no attributes for TAG."
  (interactive (list (save-excursion (sgml-beginning-of-tag t))))
  (or (stringp tag) (error "Wrong context for adding attribute"))
  (if tag
      (let ((completion-ignore-case t)
	    (alist (cdr (assoc (downcase tag) sgml-tag-alist)))
	    car attribute i)
	(if (or (symbolp (car alist))
		(symbolp (car (car alist))))
	    (setq car (car alist)
		  alist (cdr alist)))
	(or quiet
	    (message "No attributes configured."))
	(if (stringp (car alist))
	    (progn
	      (insert (if (eq (preceding-char) ? ) "" ? )
		      (funcall skeleton-transformation (car alist)))
	      (sgml-value alist))
	  (setq i (length alist))
	  (while (> i 0)
	    (insert ? )
	    (insert (funcall skeleton-transformation
			     (setq attribute
				   (skeleton-read '(completing-read
						    "Attribute: "
						    alist)))))
	    (if (string= "" attribute)
		(setq i 0)
	      (sgml-value (assoc attribute alist))
	      (setq i (1- i))))

	   (1+ (point))
	   (match-end 0))
	t)))

(defun sgml-value (alist)
  "Interactively insert value taken from ALIST, which is an
`attributerule' as described in sgml-tag-alist."
  (setq alist (cdr alist))
  (if (stringp (car alist))
      (insert "=\"" (car alist) ?\")
    (if (eq (car alist) t)
	(if (cdr alist)
	    (progn
	      (insert "=\"")
	      (setq alist (skeleton-read '(completing-read
					   "Value: " (cdr alist))))
	      (if (string< "" alist)
		  (insert alist ?\")
		(delete-backward-char 2))))
      (insert "=\"")
      (if alist

  "Value of `sgml-display-text' for HTML mode.")


; should code exactly HTML 3 here when that is finished
(defvar html-tag-alist
  (let* ((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:")

	 (name '("name"))
	 (link `(,href
		 ("rel" ,@rel)
		 ("rev" ,@rel)
		 ("title")))
	 (list '((nil \n ( "List item: "
			   "<li>" str \n))))
	 (cell `(t
		 ,align
		 ("valign" ,@valign)
		 ("colspan" ,@1-9)
		 ("rowspan" ,@1-9)

    ;; put ,-expressions first, else byte-compile chokes (as of V19.29)
    ;; and like this it's more efficient anyway
    `(("a" ,name ,@link)
      ("base" t ,@href)
      ("dir" ,@list)
      ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7)
      ("form" (\n _ \n "<input type=\"submit\" value=\"\">")
       ("action" ,@(cdr href)) ("method" ("get") ("post")))
      ("h1" ,@align)
      ("h2" ,@align)
      ("h3" ,@align)

       ("type" ("text") ("password") ("checkbox") ("radio")
	("submit") ("reset"))
       ("value"))
      ("link" t ,@link)
      ("menu" ,@list)
      ("ol" ,@list ("type" ("A") ("a") ("I") ("i") ("1")))
      ("p" t ,@align)
      ("select" (nil \n
		     ("Text: "
		      "<option>" str \n))
       ,name ("size" ,@1-9) ("multiple" t))

		     "<tr><" str ?> _ \n))
       ("border" t ,@1-9) ("width" "10") ("cellpadding"))
      ("td" ,@cell)
      ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9))
      ("th" ,@cell)
      ("ul" ,@list ("type" ("disc") ("circle") ("square")))

      ,@sgml-tag-alist

      ("abbrev")
      ("acronym")

      ("dl" (nil \n
		 ( "Term: "
		   "<dt>" str "<dd>" _ \n)))
      ("dt" (t _ "<dd>"))
      ("em")
      ;("fn" "id" "fn")  ; ???
      ("head" \n)
      ("html" (\n
	       "<head>\n"
	       "<title>" (setq str (read-input "Title: ")) "</title>\n"
	       "<body>\n<h1>" str "</h1>\n" _

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

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

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