Support completion of classes and IDs in CSS mode

* lisp/textmodes/css-mode.el (css-class-list-function): New variable
holding the function to call for retrieving completions of class
names.
(css-id-list-function): New variable holding the function to call for
retrieving completions of IDs.
(css--foreign-completions): New function for retrieving completions
from other buffers.
(css--complete-selector): Support completing HTML class names and IDs
from other buffers in addition to completing HTML tags.

* lisp/textmodes/sgml-mode.el (html--buffer-classes-cache): New
variable holding a cache for `html-current-buffer-classes'.
(html--buffer-ids-cache): New variable holding a cache for
`html-current-buffer-ids'.
(html-current-buffer-classes): New function returning a list of class
names used in the current buffer.
(html-current-buffer-ids): New function returning a list of IDs used
in the current buffer.
(html-mode): Set `css-class-list-function' and `css-id-list-function'
to `html-current-buffer-classes' and `html-current-buffer-ids'
respectively.

1 files changed, 58 insertions, 0 deletions

diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 990c09bfda7..43effefdecd 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -32,6 +32,9 @@
 
 ;;; Code:
 
+(require 'dom)
+(require 'seq)
+(require 'subr-x)
 (eval-when-compile
   (require 'skeleton)
   (require 'cl-lib))
@@ -2168,6 +2171,55 @@ This takes effect when first loading the library.")
 	 nil t)
 	(match-string-no-properties 1))))
 
+(defvar html--buffer-classes-cache nil
+  "Cache for `html-current-buffer-classes'.
+When set, this should be a cons cell where the CAR is the
+buffer's tick counter (as produced by `buffer-modified-tick'),
+and the CDR is the list of class names found in the buffer.")
+(make-variable-buffer-local 'html--buffer-classes-cache)
+
+(defvar html--buffer-ids-cache nil
+  "Cache for `html-current-buffer-ids'.
+When set, this should be a cons cell where the CAR is the
+buffer's tick counter (as produced by `buffer-modified-tick'),
+and the CDR is the list of class names found in the buffer.")
+(make-variable-buffer-local 'html--buffer-ids-cache)
+
+(defun html-current-buffer-classes ()
+  "Return a list of class names used in the current buffer.
+The result is cached in `html--buffer-classes-cache'."
+  (let ((tick (buffer-modified-tick)))
+    (if (eq (car html--buffer-classes-cache) tick)
+        (cdr html--buffer-classes-cache)
+      (let* ((dom (libxml-parse-html-region (point-min) (point-max)))
+             (classes
+              (seq-mapcat
+               (lambda (el)
+                 (when-let (class-list
+                            (cdr (assq 'class (dom-attributes el))))
+                   (split-string class-list)))
+               (dom-by-class dom ""))))
+        (setq-local html--buffer-classes-cache (cons tick classes))
+        classes))))
+
+(defun html-current-buffer-ids ()
+  "Return a list of IDs used in the current buffer.
+The result is cached in `html--buffer-ids-cache'."
+  (let ((tick (buffer-modified-tick)))
+    (if (eq (car html--buffer-ids-cache) tick)
+        (cdr html--buffer-ids-cache)
+      (let* ((dom
+              (libxml-parse-html-region (point-min) (point-max)))
+             (ids
+              (seq-mapcat
+               (lambda (el)
+                 (when-let (id-list
+                            (cdr (assq 'id (dom-attributes el))))
+                   (split-string id-list)))
+               (dom-by-id dom ""))))
+        (setq-local html--buffer-ids-cache (cons tick ids))
+        ids))))
+
 
 ;;;###autoload
 (define-derived-mode html-mode sgml-mode '(sgml-xml-mode "XHTML" "HTML")
@@ -2218,6 +2270,12 @@ To work around that, do:
   (setq-local add-log-current-defun-function #'html-current-defun-name)
   (setq-local sentence-end-base "[.?!][]\"'”)}]*\\(<[^>]*>\\)*")
 
+  (when (fboundp 'libxml-parse-html-region)
+    (defvar css-class-list-function)
+    (setq-local css-class-list-function #'html-current-buffer-classes)
+    (defvar css-id-list-function)
+    (setq-local css-id-list-function #'html-current-buffer-ids))
+
   (setq imenu-create-index-function 'html-imenu-index)
 
   (setq-local sgml-empty-tags