/[emacs]/emacs/lisp/textmodes/xml-lite.el
ViewVC logotype

Diff of /emacs/lisp/textmodes/xml-lite.el

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

revision 1.1 by monnier, Mon Mar 4 01:08:34 2002 UTC revision 1.2 by monnier, Wed Mar 27 00:06:19 2002 UTC
# Line 99  Set this to nil if you don't want a mode Line 99  Set this to nil if you don't want a mode
99  (make-variable-buffer-local 'xml-lite-mode)  (make-variable-buffer-local 'xml-lite-mode)
100    
101    
102    ;; Syntax analysis
103    
104    (defsubst xml-lite-at-indentation-p ()
105      "Return true if point is at the first non-whitespace character on the line."
106      (save-excursion
107        (skip-chars-backward " \t")
108        (bolp)))
109    
110    (defun xml-lite-in-string-p (&optional limit)
111      "Determine whether point is inside a string."
112      (let (syntax-info)
113        (or limit
114            (setq limit (or (save-excursion
115                              (re-search-backward "^[ \t]*<" nil t))
116                            (point-min))))
117        (setq syntax-info (parse-partial-sexp limit (point)))
118        (if (nth 3 syntax-info)
119            (list (nth 3 syntax-info) (nth 8 syntax-info)))))
120    
121    
122  ;; Parsing  ;; Parsing
123    
124  (defstruct (xml-lite-tag  (defstruct (xml-lite-tag
# Line 111  Set this to nil if you don't want a mode Line 131  Set this to nil if you don't want a mode
131      (if (> (skip-chars-forward "-._:A-Za-z0-9") 0)      (if (> (skip-chars-forward "-._:A-Za-z0-9") 0)
132          (buffer-substring-no-properties here (point)))))          (buffer-substring-no-properties here (point)))))
133    
134    (defsubst xml-lite-looking-back-at (s)
135      (let ((limit (max (- (point) (length s)) (point-min))))
136        (equal s (buffer-substring-no-properties limit (point)))))
137    
138    (defsubst xml-lite-looking-at (s)  
139      (let ((limit (min (+ (point) (length s)))))
140        (equal s (buffer-substring-no-properties (point) limit))))
141    
142  (defun xml-lite-parse-tag-backward ()  (defun xml-lite-parse-tag-backward ()
143    "Get information about the parent tag."    "Get information about the parent tag."
144    (let ((limit (point))    (let ((limit (point))
145          (tag-type 'open)          tag-type tag-start tag-end name name-end)
         (tag-start (search-backward "<" nil t))  
         tag-end name name-end)  
146    
147      (if (not tag-start) nil      (cond
       (setq tag-end (search-forward ">" limit t))  
148    
149        ;; determine tag type       ((null (re-search-backward "[<>]" nil t)))
150        
151         ((= ?> (char-after))               ;--- found tag-end ---
152          (setq tag-end (1+ (point)))
153          (goto-char tag-end)
154          (cond
155           ((xml-lite-looking-back-at "--") ; comment
156            (setq tag-type 'comment
157                  tag-start (search-backward "<!--" nil t)))
158           ((xml-lite-looking-back-at "]]>") ; cdata
159            (setq tag-type 'cdata
160                  tag-start (search-backward "![CDATA[" nil t)))
161           (t
162            (setq tag-start
163                  (ignore-errors (backward-sexp) (point))))))
164          
165         ((= ?< (char-after))               ;--- found tag-start ---
166          (setq tag-start (point))
167        (goto-char (1+ tag-start))        (goto-char (1+ tag-start))
168        (cond        (cond
169           ((xml-lite-looking-at "!--")     ; comment
170         ((= ?? (char-after))             ; processing-instruction          (setq tag-type 'comment
171          (setq tag-type 'pi))                tag-end (search-forward "-->" nil t)))
172           ((xml-lite-looking-at "![CDATA[")   ; cdata
173         ((= ?! (char-after))             ; declaration          (setq tag-type 'cdata
174          (setq tag-type 'decl)                tag-end (search-forward "]]>" nil t)))
         (cond  
          ((looking-at "!--")            ; comment  
           (setq tag-type 'comment  
                 tag-end (search-forward "-->" nil t)))  
          ((looking-at "!\\[CDATA\\[")   ; cdata  
           (setq tag-type 'cdata  
                 tag-end (search-forward "]]>" nil t)))  
          (t  
           (ignore-errors  
             (goto-char tag-start)  
             (forward-sexp 1)  
             (setq tag-end (point))))))  
   
        ((= ?% (char-after))             ; JSP tag  
         (setq tag-type 'jsp  
               tag-end (search-forward "%>" nil t)))  
   
        ((= ?/ (char-after))             ; close-tag  
         (goto-char (+ 2 tag-start))  
         (setq tag-type 'close  
               name (xml-lite-parse-tag-name)  
               name-end (point)))  
   
175         (t         (t
176          (setq tag-type 'open          (goto-char tag-start)
177                name (xml-lite-parse-tag-name)          (setq tag-end
178                name-end (point))                (ignore-errors (forward-sexp) (point))))))
179          ;; check whether it's an empty tag  
180          (if (and tag-end (eq ?/ (char-before (- tag-end 1))))       )
181              (setq tag-type 'empty))))      
182        (cond
183    
184         ((or tag-type (null tag-start)))
185        
186         ((= ?! (char-after (1+ tag-start))) ; declaration
187          (setq tag-type 'decl))
188        
189         ((= ?? (char-after (1+ tag-start))) ; processing-instruction
190          (setq tag-type 'pi))
191        
192         ((= ?/ (char-after (1+ tag-start))) ; close-tag
193          (goto-char (+ 2 tag-start))
194          (setq tag-type 'close
195                name (xml-lite-parse-tag-name)
196                name-end (point)))
197    
198         ((member                           ; JSP tags etc
199           (char-after (1+ tag-start))
200           '(?% ?#))
201          (setq tag-type 'unknown))
202    
203        (goto-char tag-start)       (t
204        (xml-lite-make-tag tag-type tag-start tag-end name name-end))))        (goto-char (1+ tag-start))
205          (setq tag-type 'open
206                name (xml-lite-parse-tag-name)
207                name-end (point))
208          ;; check whether it's an empty tag
209          (if (and tag-end (eq ?/ (char-before (- tag-end 1))))
210              (setq tag-type 'empty))))
211    
212  (defsubst xml-lite-at-indentation-p ()      (cond
213    "Return true if point is at the first non-whitespace character on the line."       (tag-start
214    (save-excursion        (goto-char tag-start)
215      (skip-chars-backward " \t")        (xml-lite-make-tag tag-type tag-start tag-end name name-end)))))
     (bolp)))  
216    
217  (defsubst xml-lite-inside-tag-p (tag-info &optional point)  (defsubst xml-lite-inside-tag-p (tag-info &optional point)
218    "Return true if TAG-INFO contains the POINT."    "Return true if TAG-INFO contains the POINT."
# Line 185  parse until we find a start-tag as the f Line 229  parse until we find a start-tag as the f
229  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
230  immediately enclosing the current position."  immediately enclosing the current position."
231    (let ((here (point))    (let ((here (point))
232          (level 0)          (ignore-depth 0)
233          tag-info context)          tag-info context)
234        ;; CONTEXT keeps track of the tag-stack
235        ;; IGNORE-DEPTH keeps track of the nesting level of point relative to the
236        ;;   first (outermost) tag on the context.  This is the number of
237        ;;   enclosing start-tags we'll have to ignore.
238      (save-excursion      (save-excursion
239    
240        (while        (while
# Line 203  immediately enclosing the current positi Line 251  immediately enclosing the current positi
251    
252           ;; start-tag           ;; start-tag
253           ((eq (xml-lite-tag-type tag-info) 'open)           ((eq (xml-lite-tag-type tag-info) 'open)
254            (setq level (1- level))            (setq ignore-depth (1- ignore-depth))
255            (when (= level -1)            (when (= ignore-depth -1)
256              (setq context (cons tag-info context))              (setq context (cons tag-info context))
257              (setq level 0)))              (setq ignore-depth 0)))
258    
259           ;; end-tag           ;; end-tag
260           ((eq (xml-lite-tag-type tag-info) 'close)           ((eq (xml-lite-tag-type tag-info) 'close)
261            (setq level (1+ level)))            (setq ignore-depth (1+ ignore-depth)))
262            
263             ((eq (xml-lite-tag-type tag-info) 'comment)
264              ;; this comment may enclose things we thought were tags
265              (while (and context
266                          (> (xml-lite-tag-end tag-info)
267                             (xml-lite-tag-end (car context))))
268                (setq context (cdr context))))
269              
270           )))           )))
271    
272      ;; return context      ;; return context
# Line 249  If FULL is non-nil, parse back to the be Line 304  If FULL is non-nil, parse back to the be
304    
305         ;; inside a tag         ;; inside a tag
306         ((xml-lite-inside-tag-p last-tag-info here)         ((xml-lite-inside-tag-p last-tag-info here)
307          (let ((syntax-info          
308                 (parse-partial-sexp (xml-lite-tag-start last-tag-info)          (let ((in-string
309                                     (point))))                 (xml-lite-in-string-p (xml-lite-tag-start last-tag-info))))
310            (cond            (cond
311             ;; inside a string             ;; inside a string
312             ((nth 3 syntax-info)             (in-string
313              (goto-char (nth 8 syntax-info))              (goto-char (nth 1 in-string))
314              (1+ (current-column)))              (1+ (current-column)))
315             ;; if we have a tag-name, base indent on that             ;; if we have a tag-name, base indent on that
316             ((and (xml-lite-tag-name-end last-tag-info)             ((and (xml-lite-tag-name-end last-tag-info)
# Line 362  Behaves electrically if `xml-lite-electr Line 417  Behaves electrically if `xml-lite-electr
417      (insert-char ?/ arg))))      (insert-char ?/ arg))))
418    
419    
 ;; Movement commands  
   
 (defun forward-xml-tag (arg)  
   "Move forward ARG XML-tags."  
   (interactive "p")  
   (cond  
    ((> arg 0)  
     (search-forward ">" nil nil arg))  
    ((< arg 0)  
     (search-backward "<" nil nil (- arg)))  
    ))  
   
 (defun backward-xml-tag (arg)  
   "Move backward ARG XML-tags."  
   (interactive "p")  
   (forward-xml-tag (- arg)))  
   
 (defun beginning-of-xml-tag ()  
   "Move to the beginning of the current XML-tag."  
   (interactive)  
   (if (= ?< (char-after (point)))  
       (point)  
     (search-backward "<")))  
   
 (defun end-of-xml-tag ()  
   "Move to the end of the current XML-tag."  
   (interactive)  
   (forward-xml-tag 1))  
   
   
420  ;; Keymap  ;; Keymap
421    
422  (defvar xml-lite-mode-map  (defvar xml-lite-mode-map

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

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