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