368 |
(looking-at "\\s-*<\\?xml") |
(looking-at "\\s-*<\\?xml") |
369 |
(when (re-search-forward |
(when (re-search-forward |
370 |
(eval-when-compile |
(eval-when-compile |
371 |
(mapconcat 'identity |
(mapconcat 'identity |
372 |
'("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)" |
'("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)" |
373 |
"\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"") |
"\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"") |
374 |
"\\s-+")) |
"\\s-+")) |
375 |
nil t) |
nil t) |
1045 |
Assume that parsing starts from within a textual context. |
Assume that parsing starts from within a textual context. |
1046 |
Leave point at the beginning of the tag." |
Leave point at the beginning of the tag." |
1047 |
(let (tag-type tag-start tag-end name) |
(let (tag-type tag-start tag-end name) |
1048 |
(or (search-backward ">" limit 'move) |
(or (re-search-backward "[<>]" limit 'move) |
1049 |
(error "No tag found")) |
(error "No tag found")) |
1050 |
|
(when (eq (char-after) ?<) |
1051 |
|
;; Oops!! Looks like we were not in a textual context after all!. |
1052 |
|
;; Let's try to recover. |
1053 |
|
(with-syntax-table sgml-tag-syntax-table |
1054 |
|
(forward-sexp) |
1055 |
|
(forward-char -1))) |
1056 |
(setq tag-end (1+ (point))) |
(setq tag-end (1+ (point))) |
1057 |
(cond |
(cond |
1058 |
((sgml-looking-back-at "--") ; comment |
((sgml-looking-back-at "--") ; comment |
1088 |
(goto-char tag-start) |
(goto-char tag-start) |
1089 |
(sgml-make-tag tag-type tag-start tag-end name))) |
(sgml-make-tag tag-type tag-start tag-end name))) |
1090 |
|
|
1091 |
(defun sgml-get-context (&optional full) |
(defun sgml-get-context (&optional until) |
1092 |
"Determine the context of the current position. |
"Determine the context of the current position. |
1093 |
If FULL is `empty', return even if the context is empty (i.e. |
By default, parse until we find a start-tag as the first thing on a line. |
1094 |
|
If UNTIL is `empty', return even if the context is empty (i.e. |
1095 |
we just skipped over some element and got to a beginning of line). |
we just skipped over some element and got to a beginning of line). |
|
If FULL is non-nil, parse back to the beginning of the buffer, otherwise |
|
|
parse until we find a start-tag as the first thing on a line. |
|
1096 |
|
|
1097 |
The context is a list of tag-info structures. The last one is the tag |
The context is a list of tag-info structures. The last one is the tag |
1098 |
immediately enclosing the current position." |
immediately enclosing the current position. |
1099 |
|
|
1100 |
|
Point is assumed to be outside of any tag. If we discover that it's |
1101 |
|
not the case, the first tag returned is the one inside which we are." |
1102 |
(let ((here (point)) |
(let ((here (point)) |
1103 |
(ignore nil) |
(ignore nil) |
1104 |
(context nil) |
(context nil) |
1109 |
;; enclosing start-tags we'll have to ignore. |
;; enclosing start-tags we'll have to ignore. |
1110 |
(skip-chars-backward " \t\n") ; Make sure we're not at indentation. |
(skip-chars-backward " \t\n") ; Make sure we're not at indentation. |
1111 |
(while |
(while |
1112 |
(and (or ignore |
(and (not (eq until 'now)) |
1113 |
(not (if full (eq full 'empty) context)) |
(or ignore |
1114 |
|
(not (if until (eq until 'empty) context)) |
1115 |
(not (sgml-at-indentation-p)) |
(not (sgml-at-indentation-p)) |
1116 |
(and context |
(and context |
1117 |
(/= (point) (sgml-tag-start (car context))) |
(/= (point) (sgml-tag-start (car context))) |
1118 |
(sgml-unclosed-tag-p (sgml-tag-name (car context))))) |
(sgml-unclosed-tag-p (sgml-tag-name (car context))))) |
1119 |
(setq tag-info (ignore-errors (sgml-parse-tag-backward)))) |
(setq tag-info (ignore-errors (sgml-parse-tag-backward)))) |
1120 |
|
|
1121 |
;; This tag may enclose things we thought were tags. If so, |
;; This tag may enclose things we thought were tags. If so, |
1126 |
(setq context (cdr context))) |
(setq context (cdr context))) |
1127 |
|
|
1128 |
(cond |
(cond |
1129 |
|
((> (sgml-tag-end tag-info) here) |
1130 |
|
;; Oops!! Looks like we were not outside of any tag, after all. |
1131 |
|
(push tag-info context) |
1132 |
|
(setq until 'now)) |
1133 |
|
|
1134 |
;; start-tag |
;; start-tag |
1135 |
((eq (sgml-tag-type tag-info) 'open) |
((eq (sgml-tag-type tag-info) 'open) |
1220 |
(and (not sgml-xml-mode) |
(and (not sgml-xml-mode) |
1221 |
(member-ignore-case tag-name sgml-unclosed-tags))) |
(member-ignore-case tag-name sgml-unclosed-tags))) |
1222 |
|
|
1223 |
(defun sgml-calculate-indent () |
(defun sgml-calculate-indent (&optional lcon) |
1224 |
"Calculate the column to which this line should be indented." |
"Calculate the column to which this line should be indented. |
1225 |
(let ((lcon (sgml-lexical-context))) |
LCON is the lexical context, if any." |
1226 |
|
(unless lcon (setq lcon (sgml-lexical-context))) |
1227 |
;; Indent comment-start markers inside <!-- just like comment-end markers. |
|
1228 |
(if (and (eq (car lcon) 'tag) |
;; Indent comment-start markers inside <!-- just like comment-end markers. |
1229 |
(looking-at "--") |
(if (and (eq (car lcon) 'tag) |
1230 |
(save-excursion (goto-char (cdr lcon)) (looking-at "<!--"))) |
(looking-at "--") |
1231 |
(setq lcon (cons 'comment (+ (cdr lcon) 2)))) |
(save-excursion (goto-char (cdr lcon)) (looking-at "<!--"))) |
1232 |
|
(setq lcon (cons 'comment (+ (cdr lcon) 2)))) |
1233 |
(case (car lcon) |
|
1234 |
|
(case (car lcon) |
1235 |
|
|
1236 |
|
(string |
1237 |
|
;; Go back to previous non-empty line. |
1238 |
|
(while (and (> (point) (cdr lcon)) |
1239 |
|
(zerop (forward-line -1)) |
1240 |
|
(looking-at "[ \t]*$"))) |
1241 |
|
(if (> (point) (cdr lcon)) |
1242 |
|
;; Previous line is inside the string. |
1243 |
|
(current-indentation) |
1244 |
|
(goto-char (cdr lcon)) |
1245 |
|
(1+ (current-column)))) |
1246 |
|
|
1247 |
(string |
(comment |
1248 |
|
(let ((mark (looking-at "--"))) |
1249 |
;; Go back to previous non-empty line. |
;; Go back to previous non-empty line. |
1250 |
(while (and (> (point) (cdr lcon)) |
(while (and (> (point) (cdr lcon)) |
1251 |
(zerop (forward-line -1)) |
(zerop (forward-line -1)) |
1252 |
(looking-at "[ \t]*$"))) |
(or (looking-at "[ \t]*$") |
1253 |
|
(if mark (not (looking-at "[ \t]*--")))))) |
1254 |
(if (> (point) (cdr lcon)) |
(if (> (point) (cdr lcon)) |
1255 |
;; Previous line is inside the string. |
;; Previous line is inside the comment. |
1256 |
(current-indentation) |
(skip-chars-forward " \t") |
1257 |
(goto-char (cdr lcon)) |
(goto-char (cdr lcon)) |
1258 |
(1+ (current-column)))) |
;; Skip `<!' to get to the `--' with which we want to align. |
1259 |
|
(search-forward "--") |
1260 |
(comment |
(goto-char (match-beginning 0))) |
1261 |
(let ((mark (looking-at "--"))) |
(when (and (not mark) (looking-at "--")) |
1262 |
;; Go back to previous non-empty line. |
(forward-char 2) (skip-chars-forward " \t")) |
1263 |
(while (and (> (point) (cdr lcon)) |
(current-column))) |
1264 |
(zerop (forward-line -1)) |
|
1265 |
(or (looking-at "[ \t]*$") |
;; We don't know how to indent it. Let's be honest about it. |
1266 |
(if mark (not (looking-at "[ \t]*--")))))) |
(cdata nil) |
1267 |
(if (> (point) (cdr lcon)) |
|
1268 |
;; Previous line is inside the comment. |
(tag |
1269 |
(skip-chars-forward " \t") |
(goto-char (1+ (cdr lcon))) |
1270 |
(goto-char (cdr lcon))) |
(skip-chars-forward "^ \t\n") ;Skip tag name. |
1271 |
(when (and (not mark) (looking-at "--")) |
(skip-chars-forward " \t") |
1272 |
(forward-char 2) (skip-chars-forward " \t")) |
(if (not (eolp)) |
1273 |
(current-column))) |
(current-column) |
1274 |
|
;; This is the first attribute: indent. |
|
(cdata |
|
|
(current-column)) |
|
|
|
|
|
(tag |
|
1275 |
(goto-char (1+ (cdr lcon))) |
(goto-char (1+ (cdr lcon))) |
1276 |
(skip-chars-forward "^ \t\n") ;Skip tag name. |
(+ (current-column) sgml-basic-offset))) |
|
(skip-chars-forward " \t") |
|
|
(if (not (eolp)) |
|
|
(current-column) |
|
|
;; This is the first attribute: indent. |
|
|
(goto-char (1+ (cdr lcon))) |
|
|
(+ (current-column) sgml-basic-offset))) |
|
|
|
|
|
(text |
|
|
(while (looking-at "</") |
|
|
(forward-sexp 1) |
|
|
(skip-chars-forward " \t")) |
|
|
(let* ((here (point)) |
|
|
(unclosed (and ;; (not sgml-xml-mode) |
|
|
(looking-at sgml-tag-name-re) |
|
|
(member-ignore-case (match-string 1) |
|
|
sgml-unclosed-tags) |
|
|
(match-string 1))) |
|
|
(context |
|
|
;; If possible, align on the previous non-empty text line. |
|
|
;; Otherwise, do a more serious parsing to find the |
|
|
;; tag(s) relative to which we should be indenting. |
|
|
(if (and (not unclosed) (skip-chars-backward " \t") |
|
|
(< (skip-chars-backward " \t\n") 0) |
|
|
(back-to-indentation) |
|
|
(> (point) (cdr lcon))) |
|
|
nil |
|
|
(goto-char here) |
|
|
(nreverse (sgml-get-context (if unclosed nil 'empty))))) |
|
|
(there (point))) |
|
|
;; Ignore previous unclosed start-tag in context. |
|
|
(while (and context unclosed |
|
|
(eq t (compare-strings |
|
|
(sgml-tag-name (car context)) nil nil |
|
|
unclosed nil nil t))) |
|
|
(setq context (cdr context))) |
|
|
;; Indent to reflect nesting. |
|
|
(if (and context |
|
|
(goto-char (sgml-tag-end (car context))) |
|
|
(skip-chars-forward " \t\n") |
|
|
(< (point) here) (sgml-at-indentation-p)) |
|
|
(current-column) |
|
|
(goto-char there) |
|
|
(+ (current-column) |
|
|
(* sgml-basic-offset (length context)))))) |
|
1277 |
|
|
1278 |
(otherwise |
(text |
1279 |
(error "Unrecognised context %s" (car lcon))) |
(while (looking-at "</") |
1280 |
|
(forward-sexp 1) |
1281 |
|
(skip-chars-forward " \t")) |
1282 |
|
(let* ((here (point)) |
1283 |
|
(unclosed (and ;; (not sgml-xml-mode) |
1284 |
|
(looking-at sgml-tag-name-re) |
1285 |
|
(member-ignore-case (match-string 1) |
1286 |
|
sgml-unclosed-tags) |
1287 |
|
(match-string 1))) |
1288 |
|
(context |
1289 |
|
;; If possible, align on the previous non-empty text line. |
1290 |
|
;; Otherwise, do a more serious parsing to find the |
1291 |
|
;; tag(s) relative to which we should be indenting. |
1292 |
|
(if (and (not unclosed) (skip-chars-backward " \t") |
1293 |
|
(< (skip-chars-backward " \t\n") 0) |
1294 |
|
(back-to-indentation) |
1295 |
|
(> (point) (cdr lcon))) |
1296 |
|
nil |
1297 |
|
(goto-char here) |
1298 |
|
(nreverse (sgml-get-context (if unclosed nil 'empty))))) |
1299 |
|
(there (point))) |
1300 |
|
;; Ignore previous unclosed start-tag in context. |
1301 |
|
(while (and context unclosed |
1302 |
|
(eq t (compare-strings |
1303 |
|
(sgml-tag-name (car context)) nil nil |
1304 |
|
unclosed nil nil t))) |
1305 |
|
(setq context (cdr context))) |
1306 |
|
;; Indent to reflect nesting. |
1307 |
|
(cond |
1308 |
|
;; If we were not in a text context after all, let's try again. |
1309 |
|
((and context (> (sgml-tag-end (car context)) here)) |
1310 |
|
(goto-char here) |
1311 |
|
(sgml-calculate-indent |
1312 |
|
(cons (if (memq (sgml-tag-type (car context)) '(comment cdata)) |
1313 |
|
(sgml-tag-type (car context)) 'tag) |
1314 |
|
(sgml-tag-start (car context))))) |
1315 |
|
;; Align on the first element after the nearest open-tag, if any. |
1316 |
|
((and context |
1317 |
|
(goto-char (sgml-tag-end (car context))) |
1318 |
|
(skip-chars-forward " \t\n") |
1319 |
|
(< (point) here) (sgml-at-indentation-p)) |
1320 |
|
(current-column)) |
1321 |
|
(t |
1322 |
|
(goto-char there) |
1323 |
|
(+ (current-column) |
1324 |
|
(* sgml-basic-offset (length context))))))) |
1325 |
|
|
1326 |
))) |
(otherwise |
1327 |
|
(error "Unrecognised context %s" (car lcon))) |
1328 |
|
|
1329 |
|
)) |
1330 |
|
|
1331 |
(defun sgml-indent-line () |
(defun sgml-indent-line () |
1332 |
"Indent the current line as SGML." |
"Indent the current line as SGML." |
1337 |
(back-to-indentation) |
(back-to-indentation) |
1338 |
(if (>= (point) savep) (setq savep nil)) |
(if (>= (point) savep) (setq savep nil)) |
1339 |
(sgml-calculate-indent)))) |
(sgml-calculate-indent)))) |
1340 |
(if savep |
(if (null indent-col) |
1341 |
(save-excursion (indent-line-to indent-col)) |
'noindent |
1342 |
(indent-line-to indent-col)))) |
(if savep |
1343 |
|
(save-excursion (indent-line-to indent-col)) |
1344 |
|
(indent-line-to indent-col))))) |
1345 |
|
|
1346 |
(defun sgml-guess-indent () |
(defun sgml-guess-indent () |
1347 |
"Guess an appropriate value for `sgml-basic-offset'. |
"Guess an appropriate value for `sgml-basic-offset'. |