>From 1ca24c576e10477bdf360dc1433bf7d7eb166d4e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= <address@hidden>
Date: Sat, 25 Jun 2016 15:12:09 +0200
Subject: [PATCH] WIP: Support completion of classes and IDs in CSS mode

---
 lisp/textmodes/css-mode.el  | 55 +++++++++++++++++++++++++++++++++++++++------
 lisp/textmodes/sgml-mode.el | 29 ++++++++++++++++++++++++
 2 files changed, 77 insertions(+), 7 deletions(-)

diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 060af33..a77c8ba 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -30,7 +30,6 @@
 ;; - electric ; and }
 ;; - filling code with auto-fill-mode
 ;; - fix font-lock errors with multi-line selectors
-;; - support completion of user-defined classes names and IDs
 
 ;;; Code:
 
@@ -863,16 +862,58 @@ css--nested-selectors-allowed
   "Non-nil if nested selectors are allowed in the current mode.")
 (make-variable-buffer-local 'css--nested-selectors-allowed)
 
-;; TODO: Currently only supports completion of HTML tags.  By looking
-;; at open HTML mode buffers we should be able to provide completion
-;; of user-defined classes and IDs too.
+(defun css--complete-html-tag ()
+  (save-excursion
+    (let ((end (point)))
+      (skip-chars-backward "-[:alnum:]")
+      (list (point) end css--html-tags))))
+
+(defvar css--foreign-completion-cache
+  (list 'html-class-extractor-function (make-hash-table :test 'equal)
+        'html-id-extractor-function (make-hash-table :test 'equal))
+  "Cache of completions provided by other buffers.
+This is a property list where each property is the name of an
+extractor function and the associated value is a hash table
+serving as a cache for that function.")
+
+(defun css--foreign-completions (extractor)
+  "Return a list of completions provided by other buffers.
+EXTRACTOR should be the name of a function that may be defined in
+one or more buffers.  In each of the buffers where EXTRACTOR is
+defined, EXTRACTOR is called and the results are accumulated into
+a list."
+  (seq-uniq
+   (seq-mapcat
+    (lambda (buf)
+      (with-current-buffer buf
+        (when (boundp extractor)
+          (let ((cache
+                 (plist-get css--foreign-completion-cache extractor)))
+            (if cache
+                (let ((hash (buffer-hash buf)))
+                  (or (gethash hash cache)
+                      (puthash hash (funcall (symbol-value extractor))
+                               cache)))
+              (funcall (symbol-value extractor)))))))
+    (buffer-list))))
+
 (defun css--complete-selector ()
   "Complete part of a CSS selector at point."
   (when (or (= (nth 0 (syntax-ppss)) 0) css--nested-selectors-allowed)
-    (save-excursion
-      (let ((end (point)))
+    (let ((end (point)))
+      (save-excursion
         (skip-chars-backward "-[:alnum:]")
-        (list (point) end css--html-tags)))))
+        (let ((start-char (char-before)))
+          (list
+           (point) end
+           (completion-table-dynamic
+            (lambda (_)
+              (cond
+               ((eq start-char ?.) (css--foreign-completions
+                                    'html-class-extractor-function))
+               ((eq start-char ?#) (css--foreign-completions
+                                    'html-id-extractor-function))
+               (t css--html-tags))))))))))
 
 (defun css-completion-at-point ()
   "Complete current symbol at point.
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 990c09b..5e943de 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,27 @@ html-current-defun-name
 	 nil t)
 	(match-string-no-properties 1))))
 
+(defun html-current-buffer-classes ()
+  "Return a list of class names used in the current buffer."
+  (let ((dom (libxml-parse-html-region (point-min) (point-max))))
+    (seq-mapcat
+     (lambda (el)
+       (when-let (class-list (cdr (assq 'class (dom-attributes el))))
+         (split-string class-list)))
+     (dom-by-class dom ""))))
+
+(defun html-current-buffer-ids ()
+  "Return a list of IDs used in the current buffer."
+  (let ((dom (libxml-parse-html-region (point-min) (point-max))))
+    (seq-mapcat
+     (lambda (el)
+       (when-let (id-list (cdr (assq 'id (dom-attributes el))))
+         (split-string id-list)))
+     (dom-by-id dom ""))))
+
+(defvar html-class-extractor-function)
+(defvar html-id-extractor-function)
+
 
 ;;;###autoload
 (define-derived-mode html-mode sgml-mode '(sgml-xml-mode "XHTML" "HTML")
@@ -2218,6 +2242,11 @@ html-mode
   (setq-local add-log-current-defun-function #'html-current-defun-name)
   (setq-local sentence-end-base "[.?!][]\"'”)}]*\\(<[^>]*>\\)*")
 
+  (when (fboundp 'libxml-parse-html-region)
+    (setq-local html-class-extractor-function
+                #'html-current-buffer-classes)
+    (setq-local html-id-extractor-function #'html-current-buffer-ids))
+
   (setq imenu-create-index-function 'html-imenu-index)
 
   (setq-local sgml-empty-tags
-- 
2.8.1