comparison lisp/textmodes/sgml-mode.el @ 70823:ca1b3788f58d

(sgml-transformation): Make this the alias for the following variable. (sgml-transformation-function): Make this the real name. (sgml-tag-alist): Mark as risky.

70822:2139854814c1

(defcustom sgml-basic-offset 2
  "*Specifies the basic indentation level for `sgml-indent-line'."
  :type 'integer
  :group 'sgml)

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

(put 'sgml-transformation 'variable-interactive
     "aTransformation function: ")

(defcustom sgml-mode-hook nil
  "Hook run by command `sgml-mode'.
`text-mode-hook' is run first."
  :group 'sgml

ATTRIBUTERULE is a list of optionally t (no value when no input) followed by
an optional alist of possible values."
  :type '(repeat (cons (string :tag "Tag Name")
		       (repeat :tag "Tag Rule" sexp)))
  :group 'sgml)

(defcustom sgml-tag-help
  '(("!" . "Empty declaration for comment")
    ("![" . "Embed declarations with parser directive")
    ("!attlist" . "Tag attributes declaration")

    (comment-indent-new-line soft)))

(defun sgml-mode-facemenu-add-face-function (face end)
  (if (setq face (cdr (assq face sgml-face-tag-alist)))
      (progn
	(setq face (funcall skeleton-transformation face))
	(setq facemenu-end-add-face (concat "</" face ">"))
	(concat "<" face ">"))
    (error "Face not configured for %s mode" mode-name)))

(defun sgml-fill-nobreak ()

An argument of N to a tag-inserting command means to wrap it around
the next N words.  In Transient Mark mode, when the mark is active,
N defaults to -1, which means to wrap it around 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.

  (set (make-local-variable 'facemenu-add-face-function)
       'sgml-mode-facemenu-add-face-function)
  (sgml-xml-guess)
  (if sgml-xml-mode
      (setq mode-name "XML")
    (set (make-local-variable 'skeleton-transformation) sgml-transformation))
  ;; This will allow existing comments within declarations to be
  ;; recognized.
  (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")
  (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
  ;; This definition has an HTML leaning but probably fits well for other modes.

  (setq sgml-name-8bit-mode (not sgml-name-8bit-mode))
  (message "sgml name entity mode is now %s"
	   (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").

(defvar sgml-tag-last nil)
(defvar sgml-tag-history nil)
(define-skeleton sgml-tag
  "Prompt for a tag and insert it, optionally with attributes.
Completion and configuration are 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 (or skeleton-transformation 'identity)
           (setq sgml-tag-last
		 (completing-read
		  (if (> (length sgml-tag-last) 0)
		      (format "Tag (default %s): " sgml-tag-last)
		    "Tag: ")

     ((symbolp v2)
      ;; Make sure we don't fall into an infinite loop.
      ;; For xhtml's `tr' tag, we should maybe use \n instead.
      (if (eq v2 t) (setq v2 nil))
      ;; We use `identity' to prevent skeleton from passing
      ;; `str' through skeleton-transformation a second time.
      '(("") v2 _ v2 "</" (identity ',str) ?>))
     ((eq (car v2) t)
      (cons '("") (cdr v2)))
     (t
      (append '(("") (car v2))

	(or quiet
	    (message "No attributes configured."))
	(if (stringp (car alist))
	    (progn
	      (insert (if (eq (preceding-char) ?\s) "" ?\s)
		      (funcall skeleton-transformation (car alist)))
	      (sgml-value alist))
	  (setq i (length alist))
	  (while (> i 0)
	    (insert ?\s)
	    (insert (funcall skeleton-transformation
			     (setq attribute
				   (skeleton-read '(completing-read
						    "Attribute: "
						    alist)))))
	    (if (string= "" attribute)

  ("Value: "
   "<input type=\"" (identity "checkbox") ; see comment above about identity
   "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: ")))
   "\" value=\"" str ?\"
   (when (y-or-n-p "Set \"checked\" attribute? ")
     (funcall skeleton-transformation
	      (if sgml-xml-mode " checked=\"checked\"" " checked")))
   (if sgml-xml-mode " />" ">")
   (skeleton-read "Text: " (capitalize str))
   (or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
		       (funcall skeleton-transformation
                                (if sgml-xml-mode "<br />" "<br>"))
		     "")))
   \n))

(define-skeleton html-radio-buttons

  ("Value: "
   "<input type=\"" (identity "radio") ; see comment above about identity
   "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: ")))
   "\" value=\"" str ?\"
   (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
     (funcall skeleton-transformation
	      (if sgml-xml-mode " checked=\"checked\"" " checked")))
   (if sgml-xml-mode " />" ">")
   (skeleton-read "Text: " (capitalize str))
   (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
			       (funcall skeleton-transformation
                                        (if sgml-xml-mode "<br />" "<br>"))
			     "")))
   \n))

(provide 'sgml-mode)

70823:ca1b3788f58d

(defcustom sgml-basic-offset 2
  "*Specifies the basic indentation level for `sgml-indent-line'."
  :type 'integer
  :group 'sgml)

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

(put 'sgml-transformation-function 'variable-interactive
     "aTransformation function: ")
(defvaralias 'sgml-transformation 'sgml-transformation-function)

(defcustom sgml-mode-hook nil
  "Hook run by command `sgml-mode'.
`text-mode-hook' is run first."
  :group 'sgml

ATTRIBUTERULE is a list of optionally t (no value when no input) followed by
an optional alist of possible values."
  :type '(repeat (cons (string :tag "Tag Name")
		       (repeat :tag "Tag Rule" sexp)))
  :group 'sgml)
(put 'sgml-tag-alist 'risky-local-variable t)

(defcustom sgml-tag-help
  '(("!" . "Empty declaration for comment")
    ("![" . "Embed declarations with parser directive")
    ("!attlist" . "Tag attributes declaration")

    (comment-indent-new-line soft)))

(defun sgml-mode-facemenu-add-face-function (face end)
  (if (setq face (cdr (assq face sgml-face-tag-alist)))
      (progn
	(setq face (funcall skeleton-transformation-function face))
	(setq facemenu-end-add-face (concat "</" face ">"))
	(concat "<" face ">"))
    (error "Face not configured for %s mode" mode-name)))

(defun sgml-fill-nobreak ()

An argument of N to a tag-inserting command means to wrap it around
the next N words.  In Transient Mark mode, when the mark is active,
N defaults to -1, which means to wrap it around the current region.

If you like upcased tags, put (setq sgml-transformation-function '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.

  (set (make-local-variable 'facemenu-add-face-function)
       'sgml-mode-facemenu-add-face-function)
  (sgml-xml-guess)
  (if sgml-xml-mode
      (setq mode-name "XML")
    (set (make-local-variable 'skeleton-transformation-function)
         sgml-transformation-function))
  ;; This will allow existing comments within declarations to be
  ;; recognized.
  (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")
  (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
  ;; This definition has an HTML leaning but probably fits well for other modes.

  (setq sgml-name-8bit-mode (not sgml-name-8bit-mode))
  (message "sgml name entity mode is now %s"
	   (if sgml-name-8bit-mode "ON" "OFF")))

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

(defvar sgml-tag-last nil)
(defvar sgml-tag-history nil)
(define-skeleton sgml-tag
  "Prompt for a tag and insert it, optionally with attributes.
Completion and configuration are done according to `sgml-tag-alist'.
If you like tags and attributes in uppercase do \\[set-variable]
`skeleton-transformation-function' RET `upcase' RET, or put this
in your `.emacs':
  (setq sgml-transformation-function 'upcase)"
  (funcall (or skeleton-transformation-function 'identity)
           (setq sgml-tag-last
		 (completing-read
		  (if (> (length sgml-tag-last) 0)
		      (format "Tag (default %s): " sgml-tag-last)
		    "Tag: ")

     ((symbolp v2)
      ;; Make sure we don't fall into an infinite loop.
      ;; For xhtml's `tr' tag, we should maybe use \n instead.
      (if (eq v2 t) (setq v2 nil))
      ;; We use `identity' to prevent skeleton from passing
      ;; `str' through `skeleton-transformation-function' a second time.
      '(("") v2 _ v2 "</" (identity ',str) ?>))
     ((eq (car v2) t)
      (cons '("") (cdr v2)))
     (t
      (append '(("") (car v2))

	(or quiet
	    (message "No attributes configured."))
	(if (stringp (car alist))
	    (progn
	      (insert (if (eq (preceding-char) ?\s) "" ?\s)
		      (funcall skeleton-transformation-function (car alist)))
	      (sgml-value alist))
	  (setq i (length alist))
	  (while (> i 0)
	    (insert ?\s)
	    (insert (funcall skeleton-transformation-function
			     (setq attribute
				   (skeleton-read '(completing-read
						    "Attribute: "
						    alist)))))
	    (if (string= "" attribute)

  ("Value: "
   "<input type=\"" (identity "checkbox") ; see comment above about identity
   "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: ")))
   "\" value=\"" str ?\"
   (when (y-or-n-p "Set \"checked\" attribute? ")
     (funcall skeleton-transformation-function
	      (if sgml-xml-mode " checked=\"checked\"" " checked")))
   (if sgml-xml-mode " />" ">")
   (skeleton-read "Text: " (capitalize str))
   (or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
		       (funcall skeleton-transformation-function
                                (if sgml-xml-mode "<br />" "<br>"))
		     "")))
   \n))

(define-skeleton html-radio-buttons

  ("Value: "
   "<input type=\"" (identity "radio") ; see comment above about identity
   "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: ")))
   "\" value=\"" str ?\"
   (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
     (funcall skeleton-transformation-function
	      (if sgml-xml-mode " checked=\"checked\"" " checked")))
   (if sgml-xml-mode " />" ">")
   (skeleton-read "Text: " (capitalize str))
   (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
			       (funcall skeleton-transformation-function
                                        (if sgml-xml-mode "<br />" "<br>"))
			     "")))
   \n))

(provide 'sgml-mode)