/[emacs]/emacs/lisp/textmodes/sgml-mode.el
ViewVC logotype

Diff of /emacs/lisp/textmodes/sgml-mode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.96 by monnier, Mon May 12 15:46:02 2003 UTC revision 1.97 by monnier, Thu Jun 5 01:14:23 2003 UTC
# Line 368  Otherwise, it is set to be buffer-local Line 368  Otherwise, it is set to be buffer-local
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)
# Line 1045  You might want to turn on `auto-fill-mod Line 1045  You might want to turn on `auto-fill-mod
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
# Line 1082  Leave point at the beginning of the tag. Line 1088  Leave point at the beginning of the tag.
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)
# Line 1101  immediately enclosing the current positi Line 1109  immediately enclosing the current positi
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,
# Line 1117  immediately enclosing the current positi Line 1126  immediately enclosing the current positi
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)
# Line 1207  the current start-tag or the current com Line 1220  the current start-tag or the current com
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."
# Line 1310  the current start-tag or the current com Line 1337  the current start-tag or the current com
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'.

Legend:
Removed from v.1.96  
changed lines
  Added in v.1.97

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26