80 |
with comments, so we normally turn it off.") |
with comments, so we normally turn it off.") |
81 |
|
|
82 |
(defvar sgml-quick-keys nil |
(defvar sgml-quick-keys nil |
83 |
"Use <, >, &, SPC and `sgml-specials' keys \"electrically\" when non-nil. |
"Use <, >, &, /, SPC and `sgml-specials' keys \"electrically\" when non-nil. |
84 |
This takes effect when first loading the `sgml-mode' library.") |
This takes effect when first loading the `sgml-mode' library.") |
85 |
|
|
86 |
|
|
384 |
(define-derived-mode sgml-mode text-mode "SGML" |
(define-derived-mode sgml-mode text-mode "SGML" |
385 |
"Major mode for editing SGML documents. |
"Major mode for editing SGML documents. |
386 |
Makes > match <. |
Makes > match <. |
387 |
Keys <, &, SPC within <>, \" and ' can be electric depending on |
Keys <, &, SPC within <>, \", / and ' can be electric depending on |
388 |
`sgml-quick-keys'. |
`sgml-quick-keys'. |
389 |
|
|
390 |
An argument of N to a tag-inserting command means to wrap it around |
An argument of N to a tag-inserting command means to wrap it around |
450 |
|
|
451 |
|
|
452 |
(defun sgml-slash (arg) |
(defun sgml-slash (arg) |
453 |
|
"Insert ARG slash characters. |
454 |
|
Behaves electrically if `sgml-quick-keys' is non-nil." |
455 |
|
(interactive "p") |
456 |
|
(cond |
457 |
|
((not (and (eq (char-before) ?<) (= arg 1))) |
458 |
|
(sgml-slash-matching arg)) |
459 |
|
((eq sgml-quick-keys 'indent) |
460 |
|
(insert-char ?/ 1) |
461 |
|
(indent-according-to-mode)) |
462 |
|
((eq sgml-quick-keys 'close) |
463 |
|
(delete-backward-char 1) |
464 |
|
(sgml-insert-end-tag)) |
465 |
|
(t |
466 |
|
(sgml-slash-matching arg)))) |
467 |
|
|
468 |
|
(defun sgml-slash-matching (arg) |
469 |
"Insert `/' and display any previous matching `/'. |
"Insert `/' and display any previous matching `/'. |
470 |
Two `/'s are treated as matching if the first `/' ends a net-enabling |
Two `/'s are treated as matching if the first `/' ends a net-enabling |
471 |
start tag, and the second `/' is the corresponding null end tag." |
start tag, and the second `/' is the corresponding null end tag." |
941 |
(?> . ">")))))))) |
(?> . ">")))))))) |
942 |
|
|
943 |
|
|
944 |
|
(defsubst sgml-at-indentation-p () |
945 |
|
"Return true if point is at the first non-whitespace character on the line." |
946 |
|
(save-excursion |
947 |
|
(skip-chars-backward " \t") |
948 |
|
(bolp))) |
949 |
|
|
950 |
|
|
951 |
|
;; Parsing |
952 |
|
|
953 |
|
(defstruct (sgml-tag |
954 |
|
(:constructor sgml-make-tag (type start end name))) |
955 |
|
type start end name) |
956 |
|
|
957 |
|
(defsubst sgml-parse-tag-name () |
958 |
|
"Skip past a tag-name, and return the name." |
959 |
|
(buffer-substring-no-properties |
960 |
|
(point) (progn (skip-syntax-forward "w_") (point)))) |
961 |
|
|
962 |
|
(defsubst sgml-looking-back-at (s) |
963 |
|
(let ((limit (max (- (point) (length s)) (point-min)))) |
964 |
|
(equal s (buffer-substring-no-properties limit (point))))) |
965 |
|
|
966 |
|
(defun sgml-parse-tag-backward () |
967 |
|
"Parse an SGML tag backward, and return information about the tag. |
968 |
|
Assume that parsing starts from within a textual context. |
969 |
|
Leave point at the beginning of the tag." |
970 |
|
(let (tag-type tag-start tag-end name) |
971 |
|
(search-backward ">") |
972 |
|
(setq tag-end (1+ (point))) |
973 |
|
(cond |
974 |
|
((sgml-looking-back-at "--") ; comment |
975 |
|
(setq tag-type 'comment |
976 |
|
tag-start (search-backward "<!--" nil t))) |
977 |
|
((sgml-looking-back-at "]]") ; cdata |
978 |
|
(setq tag-type 'cdata |
979 |
|
tag-start (search-backward "<![CDATA[" nil t))) |
980 |
|
(t |
981 |
|
(setq tag-start |
982 |
|
(with-syntax-table sgml-tag-syntax-table |
983 |
|
(goto-char tag-end) |
984 |
|
(backward-sexp) |
985 |
|
(point))) |
986 |
|
(goto-char (1+ tag-start)) |
987 |
|
(case (char-after) |
988 |
|
(?! ; declaration |
989 |
|
(setq tag-type 'decl)) |
990 |
|
(?? ; processing-instruction |
991 |
|
(setq tag-type 'pi)) |
992 |
|
(?/ ; close-tag |
993 |
|
(forward-char 1) |
994 |
|
(setq tag-type 'close |
995 |
|
name (sgml-parse-tag-name))) |
996 |
|
((?% ?#) ; JSP tags etc |
997 |
|
(setq tag-type 'unknown)) |
998 |
|
(t ; open or empty tag |
999 |
|
(setq tag-type 'open |
1000 |
|
name (sgml-parse-tag-name)) |
1001 |
|
(if (or (eq ?/ (char-before (- tag-end 1))) |
1002 |
|
(sgml-empty-tag-p name)) |
1003 |
|
(setq tag-type 'empty)))))) |
1004 |
|
(goto-char tag-start) |
1005 |
|
(sgml-make-tag tag-type tag-start tag-end name))) |
1006 |
|
|
1007 |
|
(defsubst sgml-inside-tag-p (tag-info &optional point) |
1008 |
|
"Return true if TAG-INFO contains the POINT." |
1009 |
|
(let ((end (sgml-tag-end tag-info)) |
1010 |
|
(point (or point (point)))) |
1011 |
|
(or (null end) |
1012 |
|
(> end point)))) |
1013 |
|
|
1014 |
|
(defun sgml-get-context (&optional full) |
1015 |
|
"Determine the context of the current position. |
1016 |
|
If FULL is `empty', return even if the context is empty (i.e. |
1017 |
|
we just skipped over some element and got to a beginning of line). |
1018 |
|
If FULL is non-nil, parse back to the beginning of the buffer, otherwise |
1019 |
|
parse until we find a start-tag as the first thing on a line. |
1020 |
|
|
1021 |
|
The context is a list of tag-info structures. The last one is the tag |
1022 |
|
immediately enclosing the current position." |
1023 |
|
(let ((here (point)) |
1024 |
|
(ignore nil) |
1025 |
|
(context nil) |
1026 |
|
tag-info) |
1027 |
|
;; CONTEXT keeps track of the tag-stack |
1028 |
|
;; IGNORE keeps track of the nesting level of point relative to the |
1029 |
|
;; first (outermost) tag on the context. This is the list of |
1030 |
|
;; enclosing start-tags we'll have to ignore. |
1031 |
|
(skip-chars-backward " \t\n") ; Make sure we're not at indentation. |
1032 |
|
(while |
1033 |
|
(and (or ignore |
1034 |
|
(not (if full (eq full 'empty) context)) |
1035 |
|
(not (sgml-at-indentation-p)) |
1036 |
|
(and context |
1037 |
|
(/= (point) (sgml-tag-start (car context))) |
1038 |
|
(sgml-unclosed-tag-p (sgml-tag-name (car context))))) |
1039 |
|
(setq tag-info (ignore-errors (sgml-parse-tag-backward)))) |
1040 |
|
|
1041 |
|
;; This tag may enclose things we thought were tags. If so, |
1042 |
|
;; discard them. |
1043 |
|
(while (and context |
1044 |
|
(> (sgml-tag-end tag-info) |
1045 |
|
(sgml-tag-end (car context)))) |
1046 |
|
(setq context (cdr context))) |
1047 |
|
|
1048 |
|
(cond |
1049 |
|
|
1050 |
|
;; inside a tag ... |
1051 |
|
((sgml-inside-tag-p tag-info here) |
1052 |
|
(push tag-info context)) |
1053 |
|
|
1054 |
|
;; start-tag |
1055 |
|
((eq (sgml-tag-type tag-info) 'open) |
1056 |
|
(cond |
1057 |
|
((null ignore) |
1058 |
|
(if (and context |
1059 |
|
(sgml-unclosed-tag-p (sgml-tag-name tag-info)) |
1060 |
|
(eq t (compare-strings |
1061 |
|
(sgml-tag-name tag-info) nil nil |
1062 |
|
(sgml-tag-name (car context)) nil nil t))) |
1063 |
|
;; There was an implicit end-tag. |
1064 |
|
nil |
1065 |
|
(push tag-info context))) |
1066 |
|
((eq t (compare-strings (sgml-tag-name tag-info) nil nil |
1067 |
|
(car ignore) nil nil t)) |
1068 |
|
(setq ignore (cdr ignore))) |
1069 |
|
(t |
1070 |
|
;; The open and close tags don't match. |
1071 |
|
(if (not sgml-xml-mode) |
1072 |
|
;; Assume the open tag is simply not closed. |
1073 |
|
(unless (sgml-unclosed-tag-p (sgml-tag-name tag-info)) |
1074 |
|
(message "Unclosed tag <%s>" (sgml-tag-name tag-info))) |
1075 |
|
(message "Unmatched tags <%s> and </%s>" |
1076 |
|
(sgml-tag-name tag-info) (pop ignore)))))) |
1077 |
|
|
1078 |
|
;; end-tag |
1079 |
|
((eq (sgml-tag-type tag-info) 'close) |
1080 |
|
(if (sgml-empty-tag-p (sgml-tag-name tag-info)) |
1081 |
|
(message "Spurious </%s>: empty tag" (sgml-tag-name tag-info)) |
1082 |
|
(push (sgml-tag-name tag-info) ignore))) |
1083 |
|
)) |
1084 |
|
|
1085 |
|
;; return context |
1086 |
|
context)) |
1087 |
|
|
1088 |
|
(defun sgml-show-context (&optional full) |
1089 |
|
"Display the current context. |
1090 |
|
If FULL is non-nil, parse back to the beginning of the buffer." |
1091 |
|
(interactive "P") |
1092 |
|
(with-output-to-temp-buffer "*XML Context*" |
1093 |
|
(pp (save-excursion (sgml-get-context full))))) |
1094 |
|
|
1095 |
|
|
1096 |
|
;; Editing shortcuts |
1097 |
|
|
1098 |
|
(defun sgml-insert-end-tag () |
1099 |
|
"Insert an end-tag for the current element." |
1100 |
|
(interactive) |
1101 |
|
(let* ((context (save-excursion (sgml-get-context))) |
1102 |
|
(tag-info (car (last context))) |
1103 |
|
(type (and tag-info (sgml-tag-type tag-info)))) |
1104 |
|
|
1105 |
|
(cond |
1106 |
|
|
1107 |
|
((null context) |
1108 |
|
(error "Nothing to close")) |
1109 |
|
|
1110 |
|
;; inside a tag |
1111 |
|
((sgml-inside-tag-p tag-info) |
1112 |
|
(insert (cond |
1113 |
|
((eq type 'empty) " />") |
1114 |
|
((eq type 'comment) " -->") |
1115 |
|
((eq type 'cdata) "]]>") |
1116 |
|
((eq type 'jsp) "%>") |
1117 |
|
((eq type 'pi) "?>") |
1118 |
|
(t ">")))) |
1119 |
|
|
1120 |
|
;; inside an element |
1121 |
|
((eq type 'open) |
1122 |
|
(insert "</" (sgml-tag-name tag-info) ">") |
1123 |
|
(indent-according-to-mode)) |
1124 |
|
|
1125 |
|
(t |
1126 |
|
(error "Nothing to close"))))) |
1127 |
|
|
1128 |
(defun sgml-empty-tag-p (tag-name) |
(defun sgml-empty-tag-p (tag-name) |
1129 |
"Return non-nil if TAG-NAME is an implicitly empty tag." |
"Return non-nil if TAG-NAME is an implicitly empty tag." |
1130 |
(and (not sgml-xml-mode) |
(and (not sgml-xml-mode) |
1203 |
(> (point) (cdr lcon))) |
(> (point) (cdr lcon))) |
1204 |
nil |
nil |
1205 |
(goto-char here) |
(goto-char here) |
1206 |
(nreverse (xml-lite-get-context (if unclosed nil 'empty))))) |
(nreverse (sgml-get-context (if unclosed nil 'empty))))) |
1207 |
(there (point))) |
(there (point))) |
1208 |
;; Ignore previous unclosed start-tag in context. |
;; Ignore previous unclosed start-tag in context. |
1209 |
(while (and context unclosed |
(while (and context unclosed |
1210 |
(eq t (compare-strings |
(eq t (compare-strings |
1211 |
(xml-lite-tag-name (car context)) nil nil |
(sgml-tag-name (car context)) nil nil |
1212 |
unclosed nil nil t))) |
unclosed nil nil t))) |
1213 |
(setq context (cdr context))) |
(setq context (cdr context))) |
1214 |
;; Indent to reflect nesting. |
;; Indent to reflect nesting. |
1215 |
(if (and context |
(if (and context |
1216 |
(goto-char (xml-lite-tag-end (car context))) |
(goto-char (sgml-tag-end (car context))) |
1217 |
(skip-chars-forward " \t\n") |
(skip-chars-forward " \t\n") |
1218 |
(< (point) here) (xml-lite-at-indentation-p)) |
(< (point) here) (sgml-at-indentation-p)) |
1219 |
(current-column) |
(current-column) |
1220 |
(goto-char there) |
(goto-char there) |
1221 |
(+ (current-column) |
(+ (current-column) |