html.el 8.3 KB

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