final tt updates
[emacs-init.git] / nxhtml / util / css-simple-completion.el
1 ;;; css-simple-completion.el --- Partly context aware css completion
2 ;;
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: 2009-11-22 Sun
5 ;; Version:
6 ;; Last-Updated: 2009-11-22 Sun
7 ;; URL:
8 ;; Keywords:
9 ;; Compatibility:
10 ;;
11 ;; Features that might be required by this library:
12 ;;
13 ;;   None
14 ;;
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16 ;;
17 ;;; Commentary:
18 ;;
19 ;; Simple partly context aware completion. Context is based on
20 ;; guessing mainly.
21 ;;
22 ;; This can be combined with with flymake-css.el that can check the
23 ;; syntax.
24 ;;
25 ;;
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27 ;;
28 ;;; Change log:
29 ;;
30 ;;
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32 ;;
33 ;; This program is free software; you can redistribute it and/or
34 ;; modify it under the terms of the GNU General Public License as
35 ;; published by the Free Software Foundation; either version 3, or
36 ;; (at your option) any later version.
37 ;;
38 ;; This program is distributed in the hope that it will be useful,
39 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
40 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
41 ;; General Public License for more details.
42 ;;
43 ;; You should have received a copy of the GNU General Public License
44 ;; along with this program; see the file COPYING.  If not, write to
45 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
46 ;; Floor, Boston, MA 02110-1301, USA.
47 ;;
48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
49 ;;
50 ;;; Code:
51
52 ;; Fix-me: bad structure, does not fit completion frameworks
53 (defun css-simple-completing-w-pred (regexp matnum prompt collection)
54   (let (pre start len)
55     (when (looking-back regexp (line-beginning-position) t)
56       (setq pre (downcase (match-string matnum)))
57       (setq len (length pre))
58       (setq start (match-beginning matnum))
59       (unless (try-completion pre collection)
60         (throw 'result nil))
61       (throw 'result (list start
62                            (completing-read prompt
63                                             collection
64                                             (lambda (alt)
65                                               (and (>= (length alt) len)
66                                                    (string= pre
67                                                             (substring alt 0 len))))
68                                             t
69                                             pre))))))
70
71 (defun css-simple-complete ()
72   "Try to complete at current point.
73 This tries to complete keywords, but no CSS values.
74
75 This is of course a pity since the value syntax is a bit
76 complicated. However you can at least check the syntax with
77 flymake-css if you want to."
78   (interactive)
79   (let ((context (css-simple-guess-context))
80         result
81         cur
82         pre
83         start)
84     (setq result
85           (catch 'result
86
87             (case context
88
89               ( 'css-media-ids
90                 (css-simple-completing-w-pred "\\<[a-z0-9-]*" 0 "Media type: " css-media-ids))
91
92               ( 'css-at-ids
93                 (css-simple-completing-w-pred "@\\([a-z0-9-]*\\)" 1 "At rule: @" css-at-ids))
94
95               ( 'css-property-ids
96                 (css-simple-completing-w-pred "\\<[a-z-]*" 0 "CSS property name: " css-property-ids))
97
98               ( 'css-simple-selectors
99
100                 ;; Fix-me: Break out the first two
101                 (when (looking-back "\\W#\\([a-z0-9-]*\\)")
102                   (setq cur (match-string 1))
103                   (setq start (match-beginning 1))
104                   (throw 'result (list (point)
105                                        (read-string (concat "Html tag Id: " cur)))))
106                 (when (looking-back "\\W\\.\\([a-z0-9-]*\\)")
107                   (setq cur (match-string 1))
108                   (setq start (match-beginning 1))
109                   (throw 'result (list (point)
110                                        (read-string (concat "CSS class name: " cur)))))
111
112                 (css-simple-completing-w-pred "[a-z0-9]:\\([a-z0-9-]*\\)" 1 "Pseudo id: " css-pseudo-ids)
113
114                 (css-simple-completing-w-pred "[a-z0-9-]+" 0 "HTML tag: " (cddr css-simple-selectors))
115
116                 (when (looking-back "\\<\\(?:#\\|\\.\\)")
117                   (setq pre nil)
118                   (while t
119                     (setq pre (completing-read "HTML tag, id or CSS class: " css-simple-selectors nil nil pre))
120                     (if (string= (substring pre 0 1) "#")
121                         (if (or (= 1 (length pre))
122                                 (and (> (length pre) 2)
123                                      (string= (substring pre 0 3) "# (")))
124                             (throw 'result (list (point) (concat "#" (read-string "Html tag id: #"))))
125                           (throw 'result (list (point) pre)))
126                       (if (string= (substring pre 0 1) ".")
127                           (if (or (= 1 (length pre))
128                                   (and (> (length pre) 2)
129                                        (string= (substring pre 0 3) ". (")))
130                               (throw 'result (list (point) (concat "." (read-string "CSS class name: ."))))
131                             (throw 'result (list (point) pre)))
132                         (when (member pre css-simple-selectors)
133                           (throw 'result (list (point) pre)))))
134                     ))))))
135     (message "result=%S" result)
136     (if result
137         (let ((str (cadr result))
138               (len (- (point) (car result))))
139           (insert (substring str len)))
140       (message "No matching alternatives"))))
141
142 (defun css-simple-guess-context ()
143   "Try to find a context matching none constant.
144 Return the symbol corresponding to the context or nil if none
145 could be found.
146
147 The symbols are the names of the defconst holding the possibly
148 matching ids.
149
150 * Note: This function assumes that comments are fontified before
151   point."
152   ;; Kind of hand-written backward parser ... ;-)
153   (let ((ignore-case t) ;; fix-me
154         (here (point))
155         (after-colon (and (not (bobp)) (eq (char-before) ?:)))
156         ret)
157     (prog1
158         (catch 'return
159           ;; No completion in comments.
160           (when (eq (get-text-property (point) 'face)
161                     'font-lock-comment-face)
162             (throw 'return nil))
163
164           ;; If we are not on whitespace then don't complete
165           (css-simple-skip-backwards-to-code)
166           (unless (or (eobp)
167                       (= (char-syntax (char-after)) ?\ )
168                       (< (point) here))
169             (throw 'return nil))
170
171           ;; Skip backwards to see if after first selector
172           (let ((here2 (1+ (point))))
173             (while (/= here2 (point))
174               (setq here2 (point))
175               (css-simple-skip-backwards-to-code)
176               (when (and (not (bobp))
177                          (eq (char-before) ?,))
178                 (backward-char))
179               (skip-chars-backward "#.:a-z0-9-")))
180           ;; Selector
181           (when (or (bobp)
182                     (eq (char-before) ?}))
183             (throw 'return 'css-simple-selectors))
184
185           ;; Property names
186           (when (memq (char-before) '( ?{ ?\; ))
187             (throw 'return 'css-property-ids))
188
189           ;; If we are in the value we can't complete there yet.
190           (when (eq (char-before) ?:)
191             (throw 'return nil))
192
193
194           ;; @
195           (goto-char here)
196           (skip-chars-backward "a-z0-9-")
197           (when (eq (char-before) ?@)
198             (throw 'return 'css-at-ids))
199
200           ;; @media ids
201           (when (looking-back "@media\\W+")
202             (throw 'return 'css-media-ids))
203
204           )
205       (goto-char here))))
206 ;;; Fix-me: complete these ...
207 ;;css-descriptor-ids ;; Removed or?
208
209 (defun css-simple-skip-backwards-to-code ()
210   "Skip backwards until we reach code.
211 Requires that comments are fontified."
212   (let ((here (1+ (point))))
213     (while (/= here (point))
214       (setq here (point))
215       (skip-syntax-backward " ")
216       (unless (bobp)
217         (when (memq (get-text-property (1- (point)) 'face)
218                     '(font-lock-comment-face font-lock-comment-delimiter-face))
219           (goto-char (or (previous-single-property-change (1- (point)) 'face)
220                          (point-min))))))))
221
222 (defconst css-simple-selectors
223   '(". (for class)"
224     "# (for id)"
225     ;; HTML 4.01 tags
226     "a" "abbr" "acronym" "address" "applet" "area" "b" "base" "basefont" "bdo" "big"
227     "blockquote" "body" "br" "button" "caption" "center" "cite" "code" "col"
228     "colgroup" "dd" "del" "dfn" "dir" "div" "dl" "dt" "em" "fieldset" "font" "form"
229     "frame" "frameset" "head" "h1" "h2" "h3" "h4" "h5" "h6" "hr" "html" "i" "iframe" "img"
230     "input" "ins" "kbd" "label" "legend" "li" "link" "map" "menu" "meta" "noframes"
231     "noscript" "object" "ol" "optgroup" "option" "p" "param" "pre" "q" "s" "samp"
232     "script" "select" "small" "span" "strike" "strong" "style" "sub" "sup" "table"
233     "tbody" "td" "textarea" "tfoot" "th" "thead" "title" "tr" "tt" "u" "ul" "var"
234     ))
235
236 (provide 'css-simple-completion)
237 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
238 ;;; css-simple-completion.el ends here