Commit | Line | Data |
---|---|---|
3d9d8486 | 1 | ;;; semantic/html.el --- Semantic details for html files |
9573e58b | 2 | |
ab422c4d | 3 | ;; Copyright (C) 2004-2005, 2007-2013 Free Software Foundation, Inc. |
9573e58b CY |
4 | |
5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
24 | ;; Parse HTML files and organize them in a nice way. | |
25 | ;; Pay attention to anchors, including them in the tag list. | |
26 | ;; | |
27 | ;; Copied from the original semantic-texi.el. | |
28 | ;; | |
29 | ;; ToDo: Find <script> tags, and parse the contents in other | |
30 | ;; parsers, such as javascript, php, shtml, or others. | |
31 | ||
b90caf50 CY |
32 | ;;; Code: |
33 | ||
9573e58b CY |
34 | (require 'semantic) |
35 | (require 'semantic/format) | |
b90caf50 | 36 | (require 'sgml-mode) |
9573e58b | 37 | |
b90caf50 | 38 | (defvar semantic-command-separation-character) |
9573e58b CY |
39 | |
40 | (defvar semantic-html-super-regex | |
41 | "<\\(h[1-9]\\|title\\|script\\|body\\|a +href\\)\\>" | |
42 | "Regular expression used to find special sections in an HTML file.") | |
43 | ||
44 | (defvar semantic-html-section-list | |
45 | '(("title" 1) | |
46 | ("script" 1) | |
47 | ("body" 1) | |
48 | ("a" 11) | |
49 | ("h1" 2) | |
50 | ("h2" 3) | |
51 | ("h3" 4) | |
52 | ("h4" 5) | |
53 | ("h5" 6) | |
54 | ("h6" 7) | |
55 | ("h7" 8) | |
56 | ("h8" 9) | |
57 | ("h9" 10) | |
58 | ) | |
59 | "Alist of sectioning commands and their relative level.") | |
60 | ||
61 | (define-mode-local-override semantic-parse-region | |
62 | html-mode (&rest ignore) | |
63 | "Parse the current html buffer for semantic tags. | |
f6b1b0a8 | 64 | IGNORE any arguments. Always parse the whole buffer. |
9573e58b CY |
65 | Each tag returned is of the form: |
66 | (\"NAME\" section (:members CHILDREN)) | |
67 | or | |
68 | (\"NAME\" anchor)" | |
69 | (mapcar 'semantic-html-expand-tag | |
70 | (semantic-html-parse-headings))) | |
71 | ||
72 | (define-mode-local-override semantic-parse-changes | |
73 | html-mode () | |
74 | "We can't parse changes for HTML mode right now." | |
75 | (semantic-parse-tree-set-needs-rebuild)) | |
76 | ||
77 | (defun semantic-html-expand-tag (tag) | |
78 | "Expand the HTML tag TAG." | |
79 | (let ((chil (semantic-html-components tag))) | |
80 | (if chil | |
81 | (semantic-tag-put-attribute | |
82 | tag :members (mapcar 'semantic-html-expand-tag chil))) | |
83 | (car (semantic--tag-expand tag)))) | |
84 | ||
85 | (defun semantic-html-components (tag) | |
86 | "Return components belonging to TAG." | |
87 | (semantic-tag-get-attribute tag :members)) | |
88 | ||
89 | (defun semantic-html-parse-headings () | |
90 | "Parse the current html buffer for all semantic tags." | |
91 | (let ((pass1 nil)) | |
92 | ;; First search and snarf. | |
93 | (save-excursion | |
94 | (goto-char (point-min)) | |
95 | ||
96 | (let ((semantic--progress-reporter | |
97 | (make-progress-reporter | |
98 | (format "Parsing %s..." | |
99 | (file-name-nondirectory buffer-file-name)) | |
100 | (point-min) (point-max)))) | |
101 | (while (re-search-forward semantic-html-super-regex nil t) | |
102 | (setq pass1 (cons (match-beginning 0) pass1)) | |
103 | (progress-reporter-update semantic--progress-reporter (point))) | |
104 | (progress-reporter-done semantic--progress-reporter))) | |
105 | ||
106 | (setq pass1 (nreverse pass1)) | |
107 | ;; Now, make some tags while creating a set of children. | |
108 | (car (semantic-html-recursive-combobulate-list pass1 0)) | |
109 | )) | |
110 | ||
111 | (defun semantic-html-set-endpoint (metataglist pnt) | |
112 | "Set the end point of the first section tag in METATAGLIST to PNT. | |
113 | METATAGLIST is a list of tags in the intermediate tag format used by the | |
114 | html parser. PNT is the new point to set." | |
115 | (let ((metatag nil)) | |
116 | (while (and metataglist | |
117 | (not (eq (semantic-tag-class (car metataglist)) 'section))) | |
118 | (setq metataglist (cdr metataglist))) | |
119 | (setq metatag (car metataglist)) | |
120 | (when metatag | |
121 | (setcar (nthcdr (1- (length metatag)) metatag) pnt) | |
122 | metatag))) | |
123 | ||
124 | (defsubst semantic-html-new-section-tag (name members level start end) | |
125 | "Create a semantic tag of class section. | |
126 | NAME is the name of this section. | |
127 | MEMBERS is a list of semantic tags representing the elements that make | |
128 | up this section. | |
53964682 | 129 | LEVEL is the leveling level. |
9573e58b CY |
130 | START and END define the location of data described by the tag." |
131 | (let ((anchorp (eq level 11))) | |
132 | (append (semantic-tag name | |
133 | (cond (anchorp 'anchor) | |
134 | (t 'section)) | |
135 | :members members) | |
136 | (list start (if anchorp (point) end)) ))) | |
137 | ||
138 | (defun semantic-html-extract-section-name () | |
139 | "Extract a section name from the current buffer and point. | |
140 | Assume the cursor is in the tag representing the section we | |
141 | need the name from." | |
142 | (save-excursion | |
143 | ; Skip over the HTML tag. | |
144 | (forward-sexp -1) | |
145 | (forward-char -1) | |
146 | (forward-sexp 1) | |
147 | (skip-chars-forward "\n\t ") | |
148 | (while (looking-at "<") | |
149 | (forward-sexp 1) | |
150 | (skip-chars-forward "\n\t ") | |
151 | ) | |
152 | (let ((start (point)) | |
153 | (end nil)) | |
154 | (if (re-search-forward "</" nil t) | |
155 | (progn | |
156 | (goto-char (match-beginning 0)) | |
157 | (skip-chars-backward " \n\t") | |
158 | (setq end (point)) | |
159 | (buffer-substring-no-properties start end)) | |
160 | "")) | |
161 | )) | |
162 | ||
163 | (defun semantic-html-recursive-combobulate-list (sectionlist level) | |
164 | "Rearrange SECTIONLIST to be a hierarchical tag list starting at LEVEL. | |
165 | Return the rearranged new list, with all remaining tags from | |
166 | SECTIONLIST starting at ELT 2. Sections not are not dealt with as soon as a | |
167 | tag with greater section value than LEVEL is found." | |
168 | (let ((newl nil) | |
169 | (oldl sectionlist) | |
170 | (case-fold-search t) | |
171 | tag | |
172 | ) | |
173 | (save-excursion | |
174 | (catch 'level-jump | |
175 | (while oldl | |
176 | (goto-char (car oldl)) | |
177 | (if (looking-at "<\\(\\w+\\)") | |
178 | (let* ((word (match-string 1)) | |
3d9d8486 CY |
179 | (levelmatch (assoc-string |
180 | word semantic-html-section-list t)) | |
9573e58b CY |
181 | text begin tmp |
182 | ) | |
183 | (when (not levelmatch) | |
184 | (error "Tag %s matched in regexp but is not in list" | |
185 | word)) | |
186 | ;; Set begin to the right location | |
187 | (setq begin (point)) | |
188 | ;; Get out of here if there if we made it that far. | |
189 | (if (and levelmatch (<= (car (cdr levelmatch)) level)) | |
190 | (progn | |
191 | (when newl | |
192 | (semantic-html-set-endpoint newl begin)) | |
193 | (throw 'level-jump t))) | |
194 | ;; When there is a match, the descriptive text | |
195 | ;; consists of the rest of the line. | |
196 | (goto-char (match-end 1)) | |
197 | (skip-chars-forward " \t") | |
198 | (setq text (semantic-html-extract-section-name)) | |
199 | ;; Next, recurse into the body to find the end. | |
200 | (setq tmp (semantic-html-recursive-combobulate-list | |
201 | (cdr oldl) (car (cdr levelmatch)))) | |
202 | ;; Build a tag | |
203 | (setq tag (semantic-html-new-section-tag | |
204 | text (car tmp) (car (cdr levelmatch)) begin (point-max))) | |
205 | ;; Before appending the newtag, update the previous tag | |
206 | ;; if it is a section tag. | |
207 | (when newl | |
208 | (semantic-html-set-endpoint newl begin)) | |
209 | ;; Append new tag to our master list. | |
210 | (setq newl (cons tag newl)) | |
211 | ;; continue | |
212 | (setq oldl (cdr tmp)) | |
213 | ) | |
214 | (error "Problem finding section in semantic/html parser")) | |
215 | ;; (setq oldl (cdr oldl)) | |
216 | ))) | |
217 | ;; Return the list | |
218 | (cons (nreverse newl) oldl))) | |
219 | ||
220 | (define-mode-local-override semantic-sb-tag-children-to-expand | |
221 | html-mode (tag) | |
222 | "The children TAG expands to." | |
223 | (semantic-html-components tag)) | |
224 | ||
07a79ce4 | 225 | ;; In semantic/imenu.el, not part of Emacs. |
f3628edd GM |
226 | (defvar semantic-imenu-expandable-tag-classes) |
227 | (defvar semantic-imenu-bucketize-file) | |
228 | (defvar semantic-imenu-bucketize-type-members) | |
229 | ||
a60f2e7b | 230 | ;;;###autoload |
9573e58b CY |
231 | (defun semantic-default-html-setup () |
232 | "Set up a buffer for parsing of HTML files." | |
233 | ;; This will use our parser. | |
234 | (setq semantic-parser-name "HTML" | |
235 | semantic--parse-table t | |
236 | imenu-create-index-function 'semantic-create-imenu-index | |
237 | semantic-command-separation-character ">" | |
238 | semantic-type-relation-separator-character '(":") | |
239 | semantic-symbol->name-assoc-list '((section . "Section") | |
240 | ||
241 | ) | |
242 | semantic-imenu-expandable-tag-classes '(section) | |
243 | semantic-imenu-bucketize-file nil | |
244 | semantic-imenu-bucketize-type-members nil | |
245 | senator-step-at-start-end-tag-classes '(section) | |
dd9af436 | 246 | senator-step-at-tag-classes '(section) |
9573e58b CY |
247 | semantic-stickyfunc-sticky-classes '(section) |
248 | ) | |
249 | (semantic-install-function-overrides | |
250 | '((tag-components . semantic-html-components) | |
251 | ) | |
252 | t) | |
253 | ) | |
254 | ||
9573e58b CY |
255 | (define-child-mode html-helper-mode html-mode |
256 | "`html-helper-mode' needs the same semantic support as `html-mode'.") | |
257 | ||
258 | (provide 'semantic/html) | |
259 | ||
a60f2e7b CY |
260 | ;; Local variables: |
261 | ;; generated-autoload-file: "loaddefs.el" | |
a60f2e7b CY |
262 | ;; generated-autoload-load-name: "semantic/html" |
263 | ;; End: | |
264 | ||
3d9d8486 | 265 | ;;; semantic/html.el ends here |