;;; web-mode.el --- major mode for editing web templates ;;; -*- coding: utf-8 -*- ;; Copyright 2011-2016 François-Xavier Bois ;; Version: 13.1.8 ;; Author: François-Xavier Bois ;; Maintainer: François-Xavier Bois ;; Created: July 2011 ;; Keywords: languages ;; Homepage: http://web-mode.org ;; Repository: http://github.com/fxbois/web-mode ;; License: GNU General Public License >= 2 ;; Distribution: This file is not part of Emacs ;;============================================================================== ;; WEB-MODE is sponsored by Kernix: ultimate Digital Factory & Data Lab in Paris ;;============================================================================== ;; Code goes here ;;---- CONSTS ------------------------------------------------------------------ (defconst web-mode-version "13.1.8" "Web Mode version.") ;;---- GROUPS ------------------------------------------------------------------ (defgroup web-mode nil "Major mode for editing web templates" :group 'languages :prefix "web-" :link '(url-link :tag "Site" "http://web-mode.org") :link '(url-link :tag "Repository" "https://github.com/fxbois/web-mode")) (defgroup web-mode-faces nil "Faces for syntax highlighting." :group 'web-mode :group 'faces) ;;---- CUSTOMS ----------------------------------------------------------------- (defcustom web-mode-script-padding 1 "Script element left padding." :type 'integer :group 'web-mode) (defcustom web-mode-style-padding 1 "Style element left padding." :type 'integer :group 'web-mode) (defcustom web-mode-block-padding 0 "Multi-line block (php, ruby, java, python, asp, etc.) left padding." :type 'integer :group 'web-mode) (defcustom web-mode-attr-indent-offset nil "Html attribute indentation level." :type 'integer :safe #'integerp :group 'web-mode) (defcustom web-mode-attr-value-indent-offset nil "Html attribute value indentation level." :type 'integer :safe #'integerp :group 'web-mode) (defcustom web-mode-markup-indent-offset (if (and (boundp 'standard-indent) standard-indent) standard-indent 2) "Html indentation level." :type 'integer :safe #'integerp :group 'web-mode) (defcustom web-mode-css-indent-offset (if (and (boundp 'standard-indent) standard-indent) standard-indent 2) "CSS indentation level." :type 'integer :safe #'integerp :group 'web-mode) (defcustom web-mode-code-indent-offset (if (and (boundp 'standard-indent) standard-indent) standard-indent 2) "Code (javascript, php, etc.) indentation level." :type 'integer :safe #'integerp :group 'web-mode) (defcustom web-mode-sql-indent-offset 4 "Sql (inside strings) indentation level." :type 'integer :safe #'integerp :group 'web-mode) (defcustom web-mode-enable-css-colorization (display-graphic-p) "In a CSS part, set background according to the color: #xxx, rgb(x,x,x)." :type 'boolean :group 'web-mode) (defcustom web-mode-enable-auto-indentation (display-graphic-p) "Auto-indentation." :type 'boolean :group 'web-mode) (defcustom web-mode-enable-auto-closing (display-graphic-p) "Auto-closing." :type 'boolean :group 'web-mode) (defcustom web-mode-enable-auto-pairing (display-graphic-p) "Auto-pairing." :type 'boolean :group 'web-mode) (defcustom web-mode-enable-auto-opening (display-graphic-p) "Html element auto-opening." :type 'boolean :group 'web-mode) (defcustom web-mode-enable-auto-quoting (display-graphic-p) "Add double quotes after the character = in a tag." :type 'boolean :group 'web-mode) (defcustom web-mode-enable-auto-expanding nil "e.g. s/ expands to |." :type 'boolean :group 'web-mode) (defcustom web-mode-enable-control-block-indentation t "Control blocks increase indentation." :type 'boolean :group 'web-mode) (defcustom web-mode-enable-current-element-highlight nil "Disable element highlight." :type 'boolean :group 'web-mode) (defcustom web-mode-enable-current-column-highlight nil "Show column for current element." :type 'boolean :group 'web-mode) (defcustom web-mode-enable-whitespace-fontification nil "Enable whitespaces." :type 'boolean :group 'web-mode) (defcustom web-mode-enable-html-entities-fontification nil "Enable html entities fontification." :type 'boolean :group 'web-mode) (defcustom web-mode-enable-block-face nil "Enable block face (useful for setting a background for example). See web-mode-block-face." :type 'boolean :group 'web-mode) (defcustom web-mode-enable-part-face nil "Enable part face (useful for setting background of ")) ((string= tname "script") (let (script) (setq script (buffer-substring-no-properties tbeg tend) part-close-tag "") (cond ((string-match-p " type[ ]*=[ ]*[\"']text/\\(jsx\\|babel\\)" script) (setq element-content-type "jsx")) ((string-match-p " type[ ]*=[ ]*[\"']text/\\(x-handlebars\\|x-jquery-tmpl\\|html\\|ng-template\\|template\\|mustache\\)" script) (setq element-content-type "html" part-close-tag nil)) ((string-match-p " type[ ]*=[ ]*[\"']application/\\(ld\\+json\\|json\\)" script) (setq element-content-type "json")) (t (setq element-content-type "javascript")) ) ;cond ) ;let ) ;script ) (add-text-properties tbeg tend props) (put-text-property tbeg (1+ tbeg) 'tag-beg flags) (put-text-property (1- tend) tend 'tag-end t) (when (and part-close-tag (web-mode-dom-sf part-close-tag reg-end t) (setq part-beg tend) (setq part-end (match-beginning 0)) (> part-end part-beg)) (put-text-property part-beg part-end 'part-side (intern element-content-type web-mode-obarray)) (setq tend part-end) ) ;when (goto-char tend) ) ;while ))) ;; tag flags ;; (1)attrs (2)custom (4)slash-beg (8)slash-end (16)bracket-end ;; (32)prefix ;; attr flags ;; (1)custom-attr (2)engine-attr (4)spread-attr[jsx] (8)code-value ;; attr states ;; (0)nil (1)space (2)name (3)space-before (4)equal (5)space-after ;; (6)value-uq (7)value-sq (8)value-dq (9)value-bq : jsx attr={} (defun web-mode-attr-skip (limit) (let ((tag-flags 0) (attr-flags 0) (continue t) (attrs 0) (counter 0) (brace-depth 0) (pos-ori (point)) (state 0) (equal-offset 0) (go-back nil) (is-jsx (string= web-mode-content-type "jsx")) name-beg name-end val-beg char pos escaped spaced quoted) (while continue (setq pos (point) char (char-after) spaced (eq char ?\s)) (when quoted (setq quoted (1+ quoted))) (cond ((>= pos limit) (setq continue nil) (setq go-back t) (setq attrs (+ attrs (web-mode-attr-scan state char name-beg name-end val-beg attr-flags equal-offset))) ) ((or (and (= state 8) (not (member char '(?\" ?\\)))) (and (= state 7) (not (member char '(?\' ?\\)))) (and (= state 9) (not (member char '(?} ?\\)))) ) (when (and (= state 9) (eq char ?\{)) (setq brace-depth (1+ brace-depth))) ) ((and (= state 9) (eq char ?\}) (> brace-depth 1)) (setq brace-depth (1- brace-depth))) ((get-text-property pos 'block-side) (when (= state 2) (setq name-end pos)) ) ((and (= state 2) is-jsx (eq char ?\}) (eq attr-flags 4)) (setq name-end pos) (setq attrs (+ attrs (web-mode-attr-scan state char name-beg name-end val-beg attr-flags equal-offset))) (setq state 0 attr-flags 0 equal-offset 0 name-beg nil name-end nil val-beg nil) ) ((or (and (= state 8) (eq ?\" char) (not escaped)) (and (= state 7) (eq ?\' char) (not escaped)) (and (= state 9) (eq ?\} char) (= brace-depth 1)) ) ;;(message "%S %S" (point) attr-flags) (setq attrs (+ attrs (web-mode-attr-scan state char name-beg name-end val-beg attr-flags equal-offset))) (setq state 0 attr-flags 0 equal-offset 0 name-beg nil name-end nil val-beg nil) ) ((and (member state '(4 5)) (member char '(?\' ?\" ?\{))) (setq val-beg pos) (setq quoted 1) (setq state (cond ((eq ?\' char) 7) ((eq ?\" char) 8) (t 9))) (when (= state 9) (setq brace-depth 1)) ) ((and (eq ?\= char) (member state '(2 3))) (setq equal-offset (- pos name-beg)) (setq state 4) (setq attr (buffer-substring-no-properties name-beg (1+ name-end))) (when (and web-mode-indentless-attributes (member (downcase attr) web-mode-indentless-attributes)) ;;(message "onclick") (setq attr-flags (logior attr-flags 8))) ) ((and spaced (= state 0)) (setq state 1) ) ((and (eq char ?\<) (not (member state '(7 8 9)))) (setq continue nil) (setq go-back t) (setq attrs (+ attrs (web-mode-attr-scan state char name-beg name-end val-beg attr-flags equal-offset))) ) ((and (eq char ?\>) (not (member state '(7 8 9)))) (setq tag-flags (logior tag-flags 16)) (when (eq (char-before) ?\/) (setq tag-flags (logior tag-flags 8)) ) (setq continue nil) (when name-beg (setq attrs (+ attrs (web-mode-attr-scan state char name-beg name-end val-beg attr-flags equal-offset)))) ) ((and spaced (member state '(1 3 5))) ) ((and spaced (= state 2)) (setq state 3) ) ((and (eq char ?\/) (member state '(4 5))) (setq attrs (+ attrs (web-mode-attr-scan state char name-beg name-end val-beg attr-flags equal-offset))) (setq state 1 attr-flags 0 equal-offset 0 name-beg nil name-end nil val-beg nil) ) ((and (eq char ?\/) (member state '(0 1))) ) ((and spaced (= state 4)) (setq state 5) ) ((and (= state 3) (or (and (>= char 97) (<= char 122)) ;a - z (and (>= char 65) (<= char 90)) ;A - Z (eq char ?\-))) (setq attrs (+ attrs (web-mode-attr-scan state char name-beg name-end val-beg attr-flags equal-offset))) (setq state 2 attr-flags 0 equal-offset 0 name-beg pos name-end pos val-beg nil) ) ((and (eq char ?\n) (not (member state '(7 8 9)))) (setq attrs (+ attrs (web-mode-attr-scan state char name-beg name-end val-beg attr-flags equal-offset))) (setq state 1 attr-flags 0 equal-offset 0 name-beg nil name-end nil val-beg nil) ) ((and (= state 6) (member char '(?\s ?\n ?\/))) (setq attrs (+ attrs (web-mode-attr-scan state char name-beg name-end val-beg attr-flags equal-offset))) (setq state 1 attr-flags 0 equal-offset 0 name-beg nil name-end nil val-beg nil) ) ((and quoted (= quoted 2) (member char '(?\s ?\n ?\>))) (when (eq char ?\>) (setq tag-flags (logior tag-flags 16)) (setq continue nil)) (setq state 6) (setq attrs (+ attrs (web-mode-attr-scan state char name-beg name-end val-beg attr-flags equal-offset))) (setq state 1 attr-flags 0 equal-offset 0 name-beg nil name-end nil val-beg nil) ) ((and (not spaced) (= state 1)) (when (and is-jsx (eq char ?\{)) (setq attr-flags 4)) (setq state 2) (setq name-beg pos name-end pos) ) ((member state '(4 5)) (setq val-beg pos) (setq state 6) ) ((= state 1) (setq state 2) ) ((= state 2) (setq name-end pos) (when (and (= attr-flags 0) (member char '(?\- ?\:))) (let (attr) (setq attr (buffer-substring-no-properties name-beg (1+ name-end))) (cond ((member attr '("http-equiv")) (setq attr-flags (1- attr-flags)) ) ((and web-mode-engine-attr-regexp (string-match-p web-mode-engine-attr-regexp attr)) ;;(message "%S: %S" pos web-mode-engine-attr-regexp) (setq attr-flags (logior attr-flags 2)) ;;(setq attr-flags (1- attr-flags)) ) ((and (eq char ?\-) (not (string= attr "http-"))) (setq attr-flags (logior attr-flags 1))) ) ;cond ) ;let ) ;when attr-flags = 1 ) ;state=2 ) ;cond ;;(message "point(%S) end(%S) state(%S) c(%S) name-beg(%S) name-end(%S) val-beg(%S) attr-flags(%S) equal-offset(%S)" pos end state char name-beg name-end val-beg attr-flags equal-offset) (when (and quoted (>= quoted 2)) (setq quoted nil)) (setq escaped (eq ?\\ char)) (when (null go-back) (forward-char)) ) ;while (when (> attrs 0) (setq tag-flags (logior tag-flags 1))) tag-flags)) (defun web-mode-attr-scan (state char name-beg name-end val-beg flags equal-offset) ;; (message "point(%S) state(%S) c(%c) name-beg(%S) name-end(%S) val-beg(%S) flags(%S) equal-offset(%S)" ;; (point) state char name-beg name-end val-beg flags equal-offset) (if (null flags) (setq flags 0)) (cond ((null name-beg) ;; (message "name-beg is null (%S)" (point)) 0) ((or (and (= state 8) (not (eq ?\" char))) (and (= state 7) (not (eq ?\' char)))) (put-text-property name-beg (1+ name-beg) 'tag-attr-beg flags) (put-text-property name-beg val-beg 'tag-attr t) (put-text-property (1- val-beg) val-beg 'tag-attr-end equal-offset) 1) ((and (member state '(4 5)) (null val-beg)) (put-text-property name-beg (1+ name-beg) 'tag-attr-beg flags) (put-text-property name-beg (+ name-beg equal-offset 1) 'tag-attr t) (put-text-property (+ name-beg equal-offset) (+ name-beg equal-offset 1) 'tag-attr-end equal-offset) 1) (t (let (val-end) (if (null val-beg) (setq val-end name-end) (setq val-end (point)) (when (or (null char) (member char '(?\s ?\n ?\> ?\/))) (setq val-end (1- val-end)) ) ) ;if (put-text-property name-beg (1+ name-beg) 'tag-attr-beg flags) (put-text-property name-beg (1+ val-end) 'tag-attr t) (put-text-property val-end (1+ val-end) 'tag-attr-end equal-offset) ) ;let 1) ;t ) ;cond ) (defun web-mode-part-scan (reg-beg reg-end &optional content-type depth) (save-excursion (let (token-re ch-before ch-at ch-next token-type beg continue) ;;(message "%S %S" reg-beg reg-end) (cond (content-type ) ((member web-mode-content-type web-mode-part-content-types) (setq content-type web-mode-content-type)) (t (setq content-type (symbol-name (get-text-property reg-beg 'part-side)))) ) ;cond (goto-char reg-beg) (cond ((member content-type '("javascript" "json")) (setq token-re "/\\|\"\\|'\\|`")) ((member content-type '("jsx")) (setq token-re "/\\|\"\\|'\\|`\\|%S|%S] %S %c %c %c" reg-beg reg-end depth beg ch-before ch-at ch-next) (cond ((eq ?\' ch-at) (while (and continue (search-forward "'" reg-end t)) (cond ((get-text-property (1- (point)) 'block-side) (setq continue t)) ((looking-back "\\\\+'" reg-beg t) (setq continue (= (mod (- (point) (match-beginning 0)) 2) 0)) ) (t (setq continue nil)) ) ) ;while (setq token-type 'string)) ((eq ?\` ch-at) (while (and continue (search-forward "`" reg-end t)) (cond ((get-text-property (1- (point)) 'block-side) (setq continue t)) ((looking-back "\\\\+`" reg-beg t) (setq continue (= (mod (- (point) (match-beginning 0)) 2) 0))) (t (setq continue nil)) ) ) ;while (setq token-type 'string)) ((eq ?\" ch-at) (while (and continue (search-forward "\"" reg-end t)) (cond ((get-text-property (1- (point)) 'block-side) (setq continue t)) ((looking-back "\\\\+\"" reg-beg t) (setq continue (= (mod (- (point) (match-beginning 0)) 2) 0))) (t (setq continue nil)) ) ;cond ) ;while (cond ((string= content-type "json") (if (looking-at-p "[ ]*:") (cond ((eq ?\@ (char-after (1+ beg))) (setq token-type 'context)) (t (setq token-type 'key)) ) (setq token-type 'string)) ) ;json (t (setq token-type 'string)) ) ;cond ) ((eq ?\< ch-at) ;;(message "before [%S>%S|%S] pt=%S" reg-beg reg-end depth (point)) (if (web-mode-jsx-skip reg-end) (web-mode-jsx-scan-element beg (point) depth) (forward-char)) ;;(message "after [%S>%S|%S] pt=%S" reg-beg reg-end depth (point)) ) ((and (eq ?\/ ch-at) (member content-type '("javascript" "jsx"))) (cond ((eq ?\\ ch-before) ) ((eq ?\* ch-next) ;;(message "--> %S %S" (point) reg-end) (when (search-forward "*/" reg-end t) (setq token-type 'comment)) ) ((eq ?\/ ch-next) (setq token-type 'comment) (goto-char (if (< reg-end (line-end-position)) reg-end (line-end-position))) ) ((and (looking-at-p ".*/") (looking-back "[[(,=:!&|?{};][ ]*/")) ;;(re-search-forward "/[gimyu]*" reg-end t)) (let ((eol (line-end-position))) (while (and continue (search-forward "/" eol t)) (cond ((get-text-property (1- (point)) 'block-side) (setq continue t)) ((looking-back "\\\\+/" reg-beg t) (setq continue (= (mod (- (point) (match-beginning 0)) 2) 0))) (t (re-search-forward "[gimyu]*" eol t) (setq token-type 'string) (setq continue nil)) ) ) ;while ) ;let ) ) ;cond ) ((eq ?\/ ch-next) (unless (eq ?\\ ch-before) (setq token-type 'comment) (goto-char (if (< reg-end (line-end-position)) reg-end (line-end-position))) ) ) ((eq ?\* ch-next) (cond ((search-forward "*/" reg-end t) (setq token-type 'comment)) ((not (eobp)) (forward-char)) ) ;cond ) ) ;cond (when (and beg (>= reg-end (point)) token-type) (put-text-property beg (point) 'part-token token-type) (cond ((eq token-type 'comment) (put-text-property beg (1+ beg) 'syntax-table (string-to-syntax "<")) (when (< (point) (point-max)) (if (< (point) (line-end-position)) (put-text-property (1- (point)) (point) 'syntax-table (string-to-syntax ">")) ;#445 (put-text-property (point) (1+ (point)) 'syntax-table (string-to-syntax ">")) ;#377 ) ) ;when ) ;comment ((eq token-type 'string) (put-text-property beg (1+ beg) 'syntax-table (string-to-syntax "|")) (when (< (point) (point-max)) (if (< (point) (line-end-position)) (put-text-property (1- (point)) (point) 'syntax-table (string-to-syntax "|")) (put-text-property (point) (1+ (point)) 'syntax-table (string-to-syntax "|")) ) ) ;when ) ;string ) ;cond ) ;when (when (> (point) reg-end) (message "reg-beg(%S) reg-end(%S) token-type(%S) point(%S)" reg-beg reg-end token-type (point))) ;;(message "#[%S>%S|%S] %S %c %c %c | (%S)" reg-beg reg-end depth beg ch-before ch-at ch-next (point)) ) ;while ))) (defun web-mode-jsx-skip (reg-end) (let ((continue t) (pos nil) (i 0)) (save-excursion (while continue (cond ((> (setq i (1+ i)) 100) (message "jsx-skip ** warning **") (setq continue nil)) ((not (web-mode-dom-rsf ">\\([ \t\n]*[\];,)':}]\\)\\|{" reg-end)) (setq continue nil) ) ((eq (char-before) ?\{) (backward-char) (web-mode-closing-paren reg-end) (forward-char) ) (t (setq continue nil) (setq pos (match-beginning 1)) ) ;t ) ;cond ) ;while ) ;save-excursion (when pos (goto-char pos)) ;;(message "jsx-skip: %S" pos) pos)) ;; http://facebook.github.io/jsx/ ;; https://github.com/facebook/jsx/blob/master/AST.md (defun web-mode-jsx-scan-element (reg-beg reg-end depth) (unless depth (setq depth 1)) (save-excursion (let (token-beg token-end regexp) (goto-char reg-beg) (put-text-property reg-beg (1+ reg-beg) 'jsx-beg depth) (put-text-property (1- reg-end) reg-end 'jsx-end depth) (put-text-property reg-beg reg-end 'jsx-depth depth) (goto-char reg-beg) (while (web-mode-part-sf "/*" reg-end t) (goto-char (match-beginning 0)) (if (looking-back "{") (progn (backward-char) (setq regexp "*/}")) (setq regexp "*/")) (setq token-beg (point)) (if (not (web-mode-part-sf regexp reg-end t)) (goto-char reg-end) (setq token-end (point)) (put-text-property token-beg token-end 'part-token 'comment) ) ;if ) ;while (web-mode-scan-elements reg-beg reg-end) (web-mode-jsx-scan-expression reg-beg reg-end (1+ depth)) ))) (defun web-mode-jsx-scan-expression (reg-beg reg-end depth) (let ((continue t) beg end) (save-excursion (goto-char reg-beg) ;;(message "reg-beg=%S reg-end=%S" reg-beg reg-end) (while (and continue (search-forward "{" reg-end t)) (backward-char) (setq beg (point) end (web-mode-closing-paren reg-end)) (cond ((eq (get-text-property beg 'part-token) 'comment) (forward-char)) ((not end) (setq continue nil)) (t (setq end (1+ end)) (put-text-property beg end 'jsx-depth depth) (put-text-property beg (1+ beg) 'jsx-beg depth) (put-text-property (1- end) end 'jsx-end depth) (web-mode-part-scan beg end "jsx" (1+ depth)) ) ;t ) ;cond ) ) )) (defun web-mode-jsx-is-html (&optional pos) (interactive) (unless pos (setq pos (point))) (let ((depth (get-text-property pos 'jsx-depth))) (cond ((or (null depth) (<= pos 2)) (setq pos nil)) ((and (= depth 1) (get-text-property pos 'jsx-beg)) (setq pos nil)) ((get-text-property pos 'jsx-beg) (setq pos (null (get-text-property pos 'tag-beg)))) ((setq pos (web-mode-jsx-depth-beginning-position pos)) (setq pos (not (null (get-text-property pos 'tag-beg))))) (t (setq pos nil)) ) ;cond ;;(message "is-html: %S (depth=%S)" pos depth) pos)) (defun web-mode-jsx-depth-beginning-position (&optional pos target-depth) (interactive) (unless pos (setq pos (point))) (unless target-depth (setq target-depth (get-text-property pos 'jsx-depth))) (cond ((or (null target-depth) (bobp)) (setq pos nil)) ((and (get-text-property pos 'jsx-beg) (= target-depth (get-text-property pos 'jsx-depth))) ) (t (let ((continue t) depth) (while continue (setq pos (previous-single-property-change pos 'jsx-depth)) (cond ((or (null pos) (null (setq depth (get-text-property pos 'jsx-depth)))) (setq continue nil pos nil)) ((and (get-text-property pos 'jsx-beg) (= target-depth depth)) (setq continue nil)) ) ;cond ) ;while ) ;let ) ;t ) ;cond ;;(message "beg: %S" pos) pos) (defun web-mode-velocity-skip (pos) (goto-char pos) (let ((continue t) (i 0)) (when (eq ?\# (char-after)) (forward-char)) (when (member (char-after) '(?\$ ?\@)) (forward-char)) (when (member (char-after) '(?\!)) (forward-char)) (if (member (char-after) '(?\{)) (search-forward "}") (setq continue t) (while continue (skip-chars-forward "a-zA-Z0-9_-") (when (> (setq i (1+ i)) 500) (message "velocity-skip ** warning (%S) **" pos) (setq continue nil)) (when (member (char-after) '(?\()) (search-forward ")" nil t)) (if (member (char-after) '(?\.)) (forward-char) (setq continue nil)) ) ;while ) ;if )) (defun web-mode-razor-skip (pos) (goto-char pos) (let ((continue t) (i 0)) (while continue (skip-chars-forward " =@a-zA-Z0-9_-") (cond ((> (setq i (1+ i)) 500) (message "razor-skip ** warning **") (setq continue nil)) ((and (eq (char-after) ?\*) (eq (char-before) ?@)) (when (not (search-forward "*@" nil t)) (setq continue nil)) ) ((looking-at-p "@[({]") (forward-char) (when (setq pos (web-mode-closing-paren-position (point))) (goto-char pos)) (forward-char) ) ((and (not (eobp)) (eq ?\( (char-after))) (if (looking-at-p "[ \n]*<") (setq continue nil) (when (setq pos (web-mode-closing-paren-position)) (goto-char pos)) (forward-char) ) ;if ) ((and (not (eobp)) (eq ?\. (char-after))) (forward-char)) ((looking-at-p "[ \n]*{") (search-forward "{") (if (looking-at-p "[ \n]*<") (setq continue nil) (backward-char) (when (setq pos (web-mode-closing-paren-position)) (goto-char pos)) (forward-char) ) ;if ) ((looking-at-p "}") (forward-char)) (t (setq continue nil)) ) ;cond ) ;while )) ;; css rule = selector(s) + declaration (properties) (defun web-mode-css-rule-next (limit) (let (at-rule sel-beg sel-end dec-beg dec-end chunk) (skip-chars-forward "\n\t ") (setq sel-beg (point)) (when (and (< (point) limit) (web-mode-part-rsf "[{;]" limit)) (setq sel-end (1- (point))) (cond ((eq (char-before) ?\{) (setq dec-beg (point)) (setq dec-end (web-mode-closing-paren-position (1- dec-beg) limit)) (if dec-end (progn (goto-char dec-end) (forward-char)) (setq dec-end limit) (goto-char limit)) ) (t ) ) ;cond (setq chunk (buffer-substring-no-properties sel-beg sel-end)) (when (string-match "@\\([[:alpha:]-]+\\)" chunk) (setq at-rule (match-string-no-properties 1 chunk))) ) ;when (if (not sel-end) (progn (goto-char limit) nil) (list :at-rule at-rule :sel-beg sel-beg :sel-end sel-end :dec-beg dec-beg :dec-end dec-end) ) ;if )) (defun web-mode-css-rule-current (&optional pos part-beg part-end) "Current CSS rule boundaries." (unless pos (setq pos (point))) (unless part-beg (setq part-beg (web-mode-part-beginning-position pos))) (unless part-end (setq part-end (web-mode-part-end-position pos))) (save-excursion (let (beg end) (goto-char pos) (if (not (web-mode-part-sb "{" part-beg)) (progn (setq beg part-beg) (if (web-mode-part-sf ";" part-end) (setq end (1+ (point))) (setq end part-end)) ) ;progn (setq beg (point)) (setq end (web-mode-closing-paren-position beg part-end)) (if end (setq end (1+ end)) (setq end (line-end-position))) ;; (message "%S >>beg%S >>end%S" pos beg end) (if (> pos end) ;;selectors (progn (goto-char pos) (if (web-mode-part-rsb "[};]" part-beg) (setq beg (1+ (point))) (setq beg part-beg) ) ;if (goto-char pos) (if (web-mode-part-rsf "[{;]" part-end) (cond ((eq (char-before) ?\;) (setq end (point)) ) (t (setq end (web-mode-closing-paren-position (1- (point)) part-end)) (if end (setq end (1+ end)) (setq end part-end)) ) ) ;cond (setq end part-end) ) ) ;progn selectors ;; declaration (goto-char beg) (if (web-mode-part-rsb "[}{;]" part-beg) (setq beg (1+ (point))) (setq beg part-beg) ) ;if ) ; if > pos end ) ;; (message "beg(%S) end(%S)" beg end) (when (eq (char-after beg) ?\n) (setq beg (1+ beg))) (cons beg end) ))) (defun web-mode-scan-engine-comments (reg-beg reg-end tag-start tag-end) "Scan engine comments (mako, django)." (save-excursion (let (beg end (continue t)) (goto-char reg-beg) (while (and continue (< (point) reg-end) (re-search-forward tag-start reg-end t)) (goto-char (match-beginning 0)) (setq beg (point)) (if (not (re-search-forward tag-end reg-end t)) (setq continue nil) (setq end (point)) (remove-list-of-text-properties beg end web-mode-scan-properties) (add-text-properties beg end '(block-side t block-token comment)) (put-text-property beg (1+ beg) 'block-beg 0) (put-text-property (1- end) end 'block-end t) ) ;if ) ;while ))) (defun web-mode-propertize (&optional beg end) (unless beg (setq beg web-mode-change-beg)) (unless end (setq end web-mode-change-end)) ;; (message "propertize: beg(%S) end(%S)" web-mode-change-beg web-mode-change-end) (when (and end (> end (point-max))) (setq end (point-max))) ;; (remove-text-properties beg end '(font-lock-face nil)) (setq web-mode-change-beg nil web-mode-change-end nil) (cond ((or (null beg) (null end)) nil) ((and (member web-mode-engine '("php" "asp")) (get-text-property beg 'block-side) (get-text-property end 'block-side) (> beg (point-min)) (not (eq (get-text-property (1- beg) 'block-token) 'delimiter-beg)) (not (eq (get-text-property end 'block-token) 'delimiter-end))) ;;(message "invalidate block") (web-mode-invalidate-block-region beg end)) ((and (or (member web-mode-content-type '("css" "jsx" "javascript")) (and (get-text-property beg 'part-side) (get-text-property end 'part-side) (> beg (point-min)) (get-text-property (1- beg) 'part-side) (get-text-property end 'part-side)) )) ;;(message "invalidate part (%S > %S)" beg end) (web-mode-invalidate-part-region beg end)) (t ;;(message "%S %S" beg end) (web-mode-invalidate-region beg end)) ) ;cond ) ;; NOTE: il est important d'identifier des caractères en fin de ligne ;; web-mode-block-tokenize travaille en effet sur les fins de lignes pour ;; les commentaires de type // (defun web-mode-invalidate-block-region (pos-beg pos-end) ;; (message "pos-beg(%S) pos-end(%S)" pos-beg pos-end) (save-excursion (let (beg end code-beg code-end) ;;(message "invalidate-block-region: pos-beg(%S)=%S" pos-beg (get-text-property pos 'block-side)) ;;(message "code-beg(%S) code-end(%S) pos-beg(%S) pos-end(%S)" code-beg code-end pos-beg pos-end) (cond ((not (and (setq code-beg (web-mode-block-code-beginning-position pos-beg)) (setq code-end (web-mode-block-code-end-position pos-beg)) (>= pos-beg code-beg) (<= pos-end code-end) (> code-end code-beg))) (web-mode-invalidate-region pos-beg pos-end)) ((member web-mode-engine '("asp")) (goto-char pos-beg) (forward-line -1) (setq beg (line-beginning-position)) (when (> code-beg beg) (setq beg code-beg)) (goto-char pos-beg) (forward-line) (setq end (line-end-position)) (when (< code-end end) (setq end code-end)) ;; ?? pas de (web-mode-block-tokenize beg end) ? (cons beg end) ) ; asp (t (goto-char pos-beg) (when (string= web-mode-engine "php") (cond ((and (looking-back "\*") (looking-at-p "/")) (search-backward "/*" code-beg)) ) ;cond ) (if (web-mode-block-rsb "[;{}(][ ]*\n" code-beg) (setq beg (match-end 0)) (setq beg code-beg)) (goto-char pos-end) (if (web-mode-block-rsf "[;{})][ ]*\n" code-end) (setq end (1- (match-end 0))) (setq end code-end)) (web-mode-block-tokenize beg end) ;;(message "beg(%S) end(%S)" beg end) (cons beg end) ) ) ;cond ))) (defun web-mode-invalidate-part-region (pos-beg pos-end) (save-excursion (let (beg end part-beg part-end language) (if (member web-mode-content-type '("css" "javascript" "json" "jsx")) (setq language web-mode-content-type) (setq language (symbol-name (get-text-property pos-beg 'part-side)))) (setq part-beg (web-mode-part-beginning-position pos-beg) part-end (web-mode-part-end-position pos-beg)) ;;(message "language(%S) pos-beg(%S) pos-end(%S) part-beg(%S) part-end(%S)" ;; language pos-beg pos-end part-beg part-end) (goto-char pos-beg) (cond ((not (and part-beg part-end (>= pos-beg part-beg) (<= pos-end part-end) (> part-end part-beg))) (web-mode-invalidate-region pos-beg pos-end)) ((member language '("javascript" "json" "jsx")) (if (web-mode-javascript-rsb "[;{}(][ ]*\n" part-beg) (setq beg (match-end 0)) (setq beg part-beg)) (goto-char pos-end) (if (web-mode-javascript-rsf "[;{})][ ]*\n" part-end) (setq end (match-end 0)) (setq end part-end)) (web-mode-scan-region beg end language)) ((string= language "css") (let (rule1 rule2) (setq rule1 (web-mode-css-rule-current pos-beg)) (setq rule2 rule1) (when (> pos-end (cdr rule1)) (setq rule2 (web-mode-css-rule-current pos-end))) (setq beg (car rule1) end (cdr rule2)) ) (web-mode-scan-region beg end language)) (t (setq beg part-beg end part-end) (web-mode-scan-region beg end language)) ) ;cond ))) (defun web-mode-invalidate-region (reg-beg reg-end) ;;(message "%S | reg-beg(%S) reg-end(%S)" (point) reg-beg reg-end) (setq reg-beg (web-mode-invalidate-region-beginning-position reg-beg) reg-end (web-mode-invalidate-region-end-position reg-end)) ;;(message "invalidate-region: reg-beg(%S) reg-end(%S)" reg-beg reg-end) (web-mode-scan-region reg-beg reg-end)) (defun web-mode-invalidate-region-beginning-position (pos) (save-excursion (goto-char pos) (when (and (bolp) (not (bobp))) (backward-char)) (beginning-of-line) ;;(message "pos=%S %S" (point) (text-properties-at (point))) (setq pos (point-min)) (let ((continue (not (bobp)))) (while continue (cond ((bobp) (setq continue nil)) ;; NOTE: Going back to the previous start tag is necessary ;; when inserting a part endtag (e.g. ). ;; Indeed, parts must be identified asap. ((and (progn (back-to-indentation) t) (get-text-property (point) 'tag-beg) (eq (get-text-property (point) 'tag-type) 'start)) (setq pos (point) continue nil)) (t (forward-line -1)) ) ;cond ) ;while ;;(message "pos=%S" pos) pos))) (defun web-mode-invalidate-region-end-position (pos) (save-excursion (goto-char pos) ;;(message "pos=%S %S" pos (get-text-property pos 'block-token)) (when (string= web-mode-engine "jsp") (cond ((and (looking-back "<%") (looking-at-p "--")) (search-forward "--%>")) ((and (looking-back "-- %") (looking-at-p ">")) (search-forward "--%>")) ) ;cond ) ;when (setq pos (point-max)) (let ((continue (not (eobp)))) (while continue (end-of-line) ;;(message "%S %S" (point) (get-text-property (point) 'block-token)) (cond ((eobp) (setq continue nil)) ;;() ((and (not (get-text-property (point) 'tag-type)) (not (get-text-property (point) 'part-side)) (not (get-text-property (point) 'block-side))) (setq pos (point) continue nil)) (t (forward-line)) ) ;cond ) ;while pos))) (defun web-mode-buffer-scan () "Scan entine buffer." (interactive) (web-mode-scan-region (point-min) (point-max))) ;;---- FONTIFICATION ----------------------------------------------------------- (defun web-mode-font-lock-highlight (limit) ;;(message "font-lock-highlight: point(%S) limit(%S) change-beg(%S) change-end(%S)" (point) limit web-mode-change-beg web-mode-change-end) (cond (web-mode-inhibit-fontification nil) (t (web-mode-highlight-region (point) limit) nil) )) (defun web-mode-buffer-highlight () (interactive) (if (fboundp 'font-lock-flush) (font-lock-flush) (font-lock-fontify-buffer))) (defun web-mode-extend-region () ;;(message "extend-region: flb(%S) fle(%S) wmcb(%S) wmce(%S)" font-lock-beg font-lock-end web-mode-change-beg web-mode-change-end) ;; (setq font-lock-beg web-mode-change-beg ;; font-lock-end web-mode-change-end) (cond (web-mode-inhibit-fontification nil) (t ;;(and web-mode-change-beg web-mode-change-end) (when (or (null web-mode-change-beg) (< font-lock-beg web-mode-change-beg)) ;;(message "font-lock-beg(%S) < web-mode-change-beg(%S)" font-lock-beg web-mode-change-beg) (setq web-mode-change-beg font-lock-beg)) (when (or (null web-mode-change-end) (> font-lock-end web-mode-change-end)) ;;(message "font-lock-end(%S) > web-mode-change-end(%S)" font-lock-end web-mode-change-end) (setq web-mode-change-end font-lock-end)) (let ((region (web-mode-propertize web-mode-change-beg web-mode-change-end))) (when region ;;(message "region: %S" region) (setq font-lock-beg (car region) font-lock-end (cdr region) ;;web-mode-change-beg (car region) ;;web-mode-change-end (cdr region) ) ) ;when ) ;let nil) ;t )) (defun web-mode-unfontify-region (beg end) ;;(message "unfontify: %S %S" beg end) ) (defun web-mode-highlight-region (&optional beg end) ;; content-type) ;;(message "highlight-region: beg(%S) end(%S)" beg end) (web-mode-with-silent-modifications (save-excursion (save-restriction (save-match-data (let ((buffer-undo-list t) ;;(inhibit-modification-hooks t) (inhibit-point-motion-hooks t) (inhibit-quit t)) (remove-list-of-text-properties beg end '(font-lock-face face)) (cond ((and (get-text-property beg 'block-side) (not (get-text-property beg 'block-beg))) (web-mode-block-highlight beg end)) ((or (member web-mode-content-type web-mode-part-content-types) ;;(member content-type web-mode-part-content-types) (get-text-property beg 'part-side)) (web-mode-part-highlight beg end) (web-mode-process-blocks beg end 'web-mode-block-highlight)) ((string= web-mode-engine "none") (web-mode-highlight-tags beg end) (web-mode-process-parts beg end 'web-mode-part-highlight)) (t (web-mode-highlight-tags beg end) (web-mode-process-parts beg end 'web-mode-part-highlight) (web-mode-process-blocks beg end 'web-mode-block-highlight)) ) ;cond (when web-mode-enable-element-content-fontification (web-mode-highlight-elements beg end)) (when web-mode-enable-whitespace-fontification (web-mode-highlight-whitespaces beg end)) ;;(message "%S %S" font-lock-keywords font-lock-keywords-alist) )))))) (defun web-mode-highlight-tags (reg-beg reg-end &optional depth) (let ((continue t)) (goto-char reg-beg) (when (and (not (get-text-property (point) 'tag-beg)) (not (web-mode-tag-next))) (setq continue nil)) (when (and continue (>= (point) reg-end)) (setq continue nil)) (while continue (cond (depth (when (eq depth (get-text-property (point) 'jsx-depth)) (web-mode-tag-highlight) ) ;; BGJSX ) (t (web-mode-tag-highlight)) ) ;cond (when (or (not (web-mode-tag-next)) (>= (point) reg-end)) (setq continue nil)) ) ;while (when web-mode-enable-inlays (when (null web-mode-inlay-regexp) (setq web-mode-inlay-regexp (regexp-opt '("\\[" "\\(" "\\begin{align}")))) (let (beg end expr) (goto-char reg-beg) (while (web-mode-dom-rsf web-mode-inlay-regexp reg-end) (setq beg (match-beginning 0) end nil expr (substring (match-string-no-properties 0) 0 2)) (setq expr (cond ((string= expr "\\[") "\\]") ((string= expr "\\(") "\\)") (t "\\end{align}"))) (when (and (web-mode-dom-sf expr reg-end) (setq end (match-end 0)) (not (text-property-any beg end 'tag-end t))) (font-lock-append-text-property beg end 'font-lock-face 'web-mode-inlay-face) ) ;when ) ;while ) ;let ) ;when (when web-mode-enable-html-entities-fontification (let (beg end) (goto-char reg-beg) (while (web-mode-dom-rsf "&\\([#]?[[:alnum:]]\\{2,8\\}\\);" reg-end) (setq beg (match-beginning 0) end (match-end 0)) (when (not (text-property-any beg end 'tag-end t)) (font-lock-append-text-property beg end 'font-lock-face 'web-mode-html-entity-face) ) ;when ) ;while ) ;let ) ;when )) (defun web-mode-tag-highlight (&optional beg end) (unless beg (setq beg (point))) (unless end (setq end (1+ (web-mode-tag-end-position beg)))) (let (name type face flags slash-beg slash-end bracket-end) (setq flags (get-text-property beg 'tag-beg) type (get-text-property beg 'tag-type) name (get-text-property beg 'tag-name)) (cond ((eq type 'comment) (put-text-property beg end 'font-lock-face 'web-mode-comment-face) (when (and web-mode-enable-comment-interpolation (> (- end beg) 5)) (web-mode-interpolate-comment beg end nil))) ((eq type 'cdata) (put-text-property beg end 'font-lock-face 'web-mode-doctype-face)) ((eq type 'doctype) (put-text-property beg end 'font-lock-face 'web-mode-doctype-face)) ((eq type 'declaration) (put-text-property beg end 'font-lock-face 'web-mode-doctype-face)) (name (setq face (cond ((and web-mode-enable-element-tag-fontification (setq face (cdr (assoc name web-mode-element-tag-faces)))) face) ((> (logand flags 2) 0) 'web-mode-html-tag-custom-face) (t 'web-mode-html-tag-face)) slash-beg (> (logand flags 4) 0) slash-end (> (logand flags 8) 0) bracket-end (> (logand flags 16) 0)) (put-text-property beg (+ beg (if slash-beg 2 1)) 'font-lock-face 'web-mode-html-tag-bracket-face) (put-text-property (+ beg (if slash-beg 2 1)) (+ beg (if slash-beg 2 1) (length name)) 'font-lock-face face) (when (or slash-end bracket-end) (put-text-property (- end (if slash-end 2 1)) end 'font-lock-face 'web-mode-html-tag-bracket-face) ) ;when (when (> (logand flags 1) 0) ;;(message "%S>%S" beg end) (web-mode-highlight-attrs beg end)) ) ;case name ) ;cond )) (defun web-mode-highlight-attrs (reg-beg reg-end) (let ((continue t) (pos reg-beg) beg end flags offset face) ;;(message "highlight-attrs %S>%S" reg-beg reg-end) (while continue (setq beg (web-mode-attribute-next-position pos reg-end)) (cond ((or (null beg) (>= beg reg-end)) (setq continue nil)) (t (setq flags (or (get-text-property beg 'tag-attr-beg) 0)) (setq face (cond ((= (logand flags 1) 1) 'web-mode-html-attr-custom-face) ((= (logand flags 2) 2) 'web-mode-html-attr-engine-face) ((= (logand flags 4) 4) nil) (t 'web-mode-html-attr-name-face))) ;;(setq end (if (get-text-property beg 'tag-attr-end) beg (web-mode-attribute-end-position beg))) (setq end (web-mode-attribute-end-position beg)) (cond ((or (null end) (>= end reg-end)) (setq continue nil)) (t (setq offset (get-text-property end 'tag-attr-end)) (if (= offset 0) (put-text-property beg (1+ end) 'font-lock-face face) (put-text-property beg (+ beg offset) 'font-lock-face face) (put-text-property (+ beg offset) (+ beg offset 1) 'font-lock-face 'web-mode-html-attr-equal-face) (when (not (get-text-property (+ beg offset 1) 'jsx-beg)) (put-text-property (+ beg offset 1) (1+ end) 'font-lock-face 'web-mode-html-attr-value-face) ) ) ;if offset (setq pos (1+ end)) ) ;t ) ;cond ) ;t );cond ) ;while )) (defun web-mode-block-highlight (reg-beg reg-end) (let (sub1 sub2 sub3 continue char keywords token-type face beg end (buffer (current-buffer))) ;;(message "reg-beg=%S reg-end=%S" reg-beg reg-end) ;; NOTE: required for block inside tag attr (remove-list-of-text-properties reg-beg reg-end '(font-lock-face)) (goto-char reg-beg) (when (null web-mode-engine-font-lock-keywords) (setq sub1 (buffer-substring-no-properties reg-beg (+ reg-beg 1)) sub2 (buffer-substring-no-properties reg-beg (+ reg-beg 2)) sub3 (buffer-substring-no-properties reg-beg (+ reg-beg (if (>= (point-max) (+ reg-beg 3)) 3 2)))) ) (cond ((and (get-text-property reg-beg 'block-beg) (eq (get-text-property reg-beg 'block-token) 'comment)) (put-text-property reg-beg reg-end 'font-lock-face 'web-mode-comment-face) ) ;comment block (web-mode-engine-font-lock-keywords (setq keywords web-mode-engine-font-lock-keywords) ) ((string= web-mode-engine "django") (cond ((string= sub2 "{{") (setq keywords web-mode-django-expr-font-lock-keywords)) ((string= sub2 "{%") (setq keywords web-mode-django-code-font-lock-keywords)) )) ;django ((string= web-mode-engine "mako") (cond ((member sub3 '("<% " "<%\n" "<%!")) (setq keywords web-mode-mako-block-font-lock-keywords)) ((eq (aref sub2 0) ?\%) (setq keywords web-mode-mako-block-font-lock-keywords)) ((member sub2 '("<%" " %S face(%S)" beg end face) (remove-list-of-text-properties beg end '(face)) (put-text-property beg end 'font-lock-face face) ) (setq continue nil end nil) ) ;if end ) ;progn beg (setq continue nil end nil) ) ;if beg (when (and beg end) (save-match-data (when (and web-mode-enable-heredoc-fontification (eq char ?\<) (> (- end beg) 8) ;;(progn (message "%S" (buffer-substring-no-properties beg end)) t) (string-match-p "JS\\|JAVASCRIPT\\|HTM\\|CSS" (buffer-substring-no-properties beg end))) (setq keywords (cond ((string-match-p "H" (buffer-substring-no-properties beg (+ beg 8))) web-mode-html-font-lock-keywords) (t web-mode-javascript-font-lock-keywords) )) (web-mode-fontify-region beg end keywords) )) ;; (message "%S %c %S beg=%S end=%S" web-mode-enable-string-interpolation char web-mode-engine beg end) (when (and web-mode-enable-string-interpolation (member char '(?\" ?\<)) (member web-mode-engine '("php" "erb")) (> (- end beg) 4)) (web-mode-interpolate-block-string beg end) ) ;when (when (and web-mode-enable-comment-interpolation (eq token-type 'comment) (> (- end beg) 3)) (web-mode-interpolate-comment beg end t) ) ;when (when (and web-mode-enable-sql-detection (eq token-type 'string) (> (- end beg) 6) ;;(eq char ?\<) ;;(web-mode-looking-at-p (concat "[ \n]*" web-mode-sql-queries) (1+ beg)) (web-mode-looking-at-p (concat "\\(.\\|<<<[[:alnum:]]+\\)[ \n]*" web-mode-sql-queries) beg) ) (web-mode-interpolate-sql-string beg end) ) ;when ) ;when beg end ) ;while continue ) ;when keywords (when (and (member web-mode-engine '("jsp" "mako")) (> (- reg-end reg-beg) 12) (eq ?\< (char-after reg-beg))) (web-mode-interpolate-block-tag reg-beg reg-end)) (when web-mode-enable-block-face ;; (message "block-face %S %S" reg-beg reg-end) (font-lock-append-text-property reg-beg reg-end 'face 'web-mode-block-face)) )) (defun web-mode-part-highlight (reg-beg reg-end &optional depth) (unless depth (when (string= web-mode-content-type "jsx") (setq depth 0)) ) (save-excursion (let (start continue token-type face pos beg end string-face comment-face content-type) ;;(message "part-highlight: reg-beg(%S) reg-end(%S)" reg-beg reg-end) (if (member web-mode-content-type web-mode-part-content-types) (setq content-type web-mode-content-type) (setq content-type (symbol-name (get-text-property reg-beg 'part-side)))) (cond ((member content-type '("javascript" "jsx")) (setq string-face 'web-mode-javascript-string-face comment-face 'web-mode-javascript-comment-face) (web-mode-fontify-region reg-beg reg-end web-mode-javascript-font-lock-keywords)) ((string= content-type "json") (setq string-face 'web-mode-json-string-face comment-face 'web-mode-json-comment-face) (web-mode-fontify-region reg-beg reg-end web-mode-javascript-font-lock-keywords)) ((string= content-type "css") (setq string-face 'web-mode-css-string-face comment-face 'web-mode-css-comment-face) (web-mode-css-rules-highlight reg-beg reg-end)) (t (setq string-face 'web-mode-part-string-face comment-face 'web-mode-part-comment-face)) ) (goto-char reg-beg) ;;(when (string= content-type "jsx") (web-mode-highlight-tags reg-beg reg-end)) ;;(setq continue (and pos (< pos reg-end))) (setq continue t pos reg-beg) (while continue (if (get-text-property pos 'part-token) (setq beg pos) (setq beg (next-single-property-change pos 'part-token))) (cond ((or (null beg) (>= beg reg-end)) (setq continue nil end nil)) ((and (eq depth 0) (get-text-property beg 'jsx-depth)) (setq pos (or (next-single-property-change beg 'jsx-depth) (point-max)))) (t (setq token-type (get-text-property beg 'part-token)) (setq face (cond ((eq token-type 'string) string-face) ((eq token-type 'comment) comment-face) ((eq token-type 'context) 'web-mode-json-context-face) ((eq token-type 'key) 'web-mode-json-key-face) (t nil))) (setq end (or (next-single-property-change beg 'part-token) (point-max)) pos end) (cond ((or (null end) (> end reg-end)) (setq continue nil end nil)) (t (when face (remove-list-of-text-properties beg end '(face)) (put-text-property beg end 'font-lock-face face)) (cond ((< (- end beg) 6) ) ((eq token-type 'string) (when (and web-mode-enable-string-interpolation (member content-type '("javascript" "jsx"))) (web-mode-interpolate-javascript-string beg end))) ((eq token-type 'comment) (when web-mode-enable-comment-interpolation (web-mode-interpolate-comment beg end t))) ) ;cond ) ;t ) ;cond ) ;t ) ;cond ) ;while (when (and (string= web-mode-content-type "html") web-mode-enable-part-face) (font-lock-append-text-property reg-beg reg-end 'face (if (string= content-type "javascript") 'web-mode-script-face 'web-mode-style-face)) ) (when (and (eq depth 0) (string= content-type "jsx")) (let (pair elt-beg elt-end exp-beg exp-end exp-depth) (goto-char reg-beg) (while (setq pair (web-mode-jsx-element-next reg-end)) ;;(message "elt-pair=%S" pair) (setq elt-beg (car pair) elt-end (cdr pair)) (remove-list-of-text-properties elt-beg (1+ elt-end) '(face)) (web-mode-highlight-tags elt-beg elt-end 1) (goto-char elt-beg) (while (setq pair (web-mode-jsx-expression-next elt-end)) ;;(message "exp-pair=%S elt-end=%S" pair elt-end) (setq exp-beg (car pair) exp-end (cdr pair)) (when (eq (char-after exp-beg) ?\{) (setq exp-depth (get-text-property exp-beg 'jsx-depth)) (remove-list-of-text-properties exp-beg exp-end '(font-lock-face)) (put-text-property exp-beg (1+ exp-beg) 'font-lock-face 'web-mode-block-delimiter-face) (when (and (eq (get-text-property exp-beg 'tag-attr-beg) 4) (web-mode-looking-at-p "\.\.\." (1+ exp-beg))) (put-text-property exp-beg (+ exp-beg 4) 'font-lock-face 'web-mode-block-delimiter-face)) (put-text-property exp-end (1+ exp-end) 'font-lock-face 'web-mode-block-delimiter-face) (web-mode-highlight-tags (1+ exp-beg) exp-end (1+ exp-depth)) (web-mode-part-highlight (1+ exp-beg) exp-end exp-depth) (web-mode-fontify-region (1+ exp-beg) exp-end web-mode-javascript-font-lock-keywords) ) (goto-char (1+ exp-beg)) ) ;while exp (when (and elt-beg web-mode-jsx-depth-faces) (let (depth-beg depth-end jsx-face) (goto-char elt-beg) (while (setq pair (web-mode-jsx-depth-next reg-end)) ;;(message "depth-pair=%S" pair) (setq depth-beg (car pair) depth-end (cdr pair) depth (get-text-property depth-beg 'jsx-depth) jsx-face (elt web-mode-jsx-depth-faces (1- depth))) ;;(message "%S" jsx-face) (font-lock-prepend-text-property depth-beg (1+ depth-end) 'face jsx-face) (goto-char (+ depth-beg 2)) ) ) ;let ) (goto-char (1+ elt-end)) ) ;while elt ) ;let ) ;when ))) (defun web-mode-jsx-element-next (reg-end) (let (continue beg end) (setq beg (point)) (unless (get-text-property beg 'jsx-depth) (setq beg (next-single-property-change beg 'jsx-beg))) (setq continue (and beg (< beg reg-end)) end beg) (while continue (setq end (next-single-property-change end 'jsx-end)) (cond ((or (null end) (> end reg-end)) (setq continue nil end nil)) ((eq (get-text-property end 'jsx-depth) 1) (setq continue nil)) (t (setq end (1+ end))) ) ;cond ) ;while ;;(message "beg=%S end=%S" beg end) (if (and beg end (< beg end)) (cons beg end) nil))) (defun web-mode-jsx-expression-next (reg-end) (let (beg end depth continue pos) (setq beg (point)) ;;(message "pt=%S" beg) (unless (and (get-text-property beg 'jsx-beg) (null (get-text-property beg 'tag-beg))) ;;(setq beg (next-single-property-change beg 'jsx-beg)) (setq continue t pos (1+ beg)) (while continue (setq pos (next-single-property-change pos 'jsx-beg)) (cond ((null pos) (setq continue nil beg nil)) ((> pos reg-end) (setq continue nil beg nil)) ((null (get-text-property pos 'jsx-beg)) ) ((null (get-text-property pos 'tag-beg)) (setq continue nil beg pos)) ;;(t ;; (setq pos (1+ pos))) ) ;cond ) ;while ) ;unless ;;(message "beg=%S" beg) (when (and beg (< beg reg-end)) (setq depth (get-text-property beg 'jsx-beg) continue (not (null depth)) pos beg) ;;(message "beg=%S" beg) (while continue (setq pos (next-single-property-change pos 'jsx-end)) ;;(message "pos=%S" pos) (cond ((null pos) (setq continue nil)) ((> pos reg-end) (setq continue nil)) ((eq depth (get-text-property pos 'jsx-end)) (setq continue nil end pos)) (t ;;(setq pos (1+ pos)) ) ) ;cond ) ;while ) ;when ;;(message "%S > %S" beg end) (if (and beg end) (cons beg end) nil))) (defun web-mode-jsx-depth-next (reg-end) (let (beg end depth continue pos) (setq beg (point)) ;;(message "pt=%S" beg) (unless (get-text-property beg 'jsx-beg) ;;(setq beg (next-single-property-change beg 'jsx-beg)) ;;(setq pos (1+ beg)) (setq pos (next-single-property-change (1+ beg) 'jsx-beg)) (cond ((null pos) (setq beg nil)) ((>= pos reg-end) (setq beg nil)) (t (setq beg pos)) ) ;cond ) ;unless ;;(message "beg=%S" beg) (when beg (setq depth (get-text-property beg 'jsx-beg) continue (not (null depth)) pos beg) ;;(message "beg=%S" beg) (while continue (setq pos (next-single-property-change pos 'jsx-end)) ;;(message "pos=%S" pos) (cond ((null pos) (setq continue nil)) ((> pos reg-end) (setq continue nil)) ((eq depth (get-text-property pos 'jsx-end)) (setq continue nil end pos)) (t ;;(setq pos (1+ pos)) ) ) ;cond ) ;while ) ;when ;;(message "%S > %S" beg end) (if (and beg end) (cons beg end) nil))) (defun web-mode-css-rules-highlight (part-beg part-end) (save-excursion (goto-char part-beg) (let (rule (continue t) (i 0) (at-rule nil)) (while continue (setq rule (web-mode-css-rule-next part-end)) ;;(message "rule=%S" rule) (cond ((> (setq i (1+ i)) 1000) (message "css-rules-highlight ** too much rules **") (setq continue nil)) ((null rule) (setq continue nil)) ((and (setq at-rule (plist-get rule :at-rule)) (not (member at-rule '("charset" "font-face" "import"))) (plist-get rule :dec-end)) (web-mode-css-rule-highlight (plist-get rule :sel-beg) (plist-get rule :sel-end) nil nil) (web-mode-css-rules-highlight (plist-get rule :dec-beg) (plist-get rule :dec-end))) (t (web-mode-css-rule-highlight (plist-get rule :sel-beg) (plist-get rule :sel-end) (plist-get rule :dec-beg) (plist-get rule :dec-end))) ) ;cond ) ;while ) ;let )) (defun web-mode-css-rule-highlight (sel-beg sel-end dec-beg dec-end) (save-excursion ;; (message "sel-beg=%S sel-end=%S dec-beg=%S dec-end=%S" sel-beg sel-end dec-beg dec-end) (web-mode-fontify-region sel-beg sel-end web-mode-selector-font-lock-keywords) (when (and dec-beg dec-end) (web-mode-fontify-region dec-beg dec-end web-mode-declaration-font-lock-keywords) (goto-char dec-beg) (while (and web-mode-enable-css-colorization (re-search-forward "#[0-9a-fA-F]\\{6\\}\\|#[0-9a-fA-F]\\{3\\}\\|rgba?([ ]*\\([[:digit:]]\\{1,3\\}\\)[ ]*,[ ]*\\([[:digit:]]\\{1,3\\}\\)[ ]*,[ ]*\\([[:digit:]]\\{1,3\\}\\)\\(.*?\\))" dec-end t) (< (point) dec-end)) (web-mode-colorize (match-beginning 0) (match-end 0)) ) ))) (defun web-mode-fontify-region (beg end keywords) ;; (message "beg=%S end=%S" beg end);; (symbol-name keywords)) (save-excursion (let ((font-lock-keywords keywords) (font-lock-multiline nil) (font-lock-keywords-case-fold-search (member web-mode-engine '("asp" "template-toolkit"))) (font-lock-keywords-only t) (font-lock-extend-region-functions nil)) ;; (message "%S" keywords) (when (listp font-lock-keywords) (font-lock-fontify-region beg end) ) ) )) (defun web-mode-colorize-foreground (color) (let* ((values (x-color-values color)) (r (car values)) (g (cadr values)) (b (car (cdr (cdr values))))) (if (> 128.0 (floor (+ (* .3 r) (* .59 g) (* .11 b)) 256)) "white" "black"))) (defun web-mode-colorize (beg end) (let (str plist len) (setq str (buffer-substring-no-properties beg end)) (setq len (length str)) (cond ((string= (substring str 0 1) "#") (setq plist (list :background str :foreground (web-mode-colorize-foreground str))) (put-text-property beg end 'face plist)) ((string= (substring str 0 4) "rgb(") (setq str (format "#%02X%02X%02X" (string-to-number (match-string-no-properties 1)) (string-to-number (match-string-no-properties 2)) (string-to-number (match-string-no-properties 3)))) (setq plist (list :background str :foreground (web-mode-colorize-foreground str))) (put-text-property beg end 'face plist)) ) ;cond )) (defun web-mode-interpolate-block-tag (beg end) (save-excursion (goto-char (+ 4 beg)) (setq end (1- end)) (while (re-search-forward "${.*?}" end t) (remove-list-of-text-properties (match-beginning 0) (match-end 0) '(face)) (web-mode-fontify-region (match-beginning 0) (match-end 0) web-mode-uel-font-lock-keywords)) )) (defun web-mode-interpolate-javascript-string (beg end) (save-excursion (goto-char (1+ beg)) (setq end (1- end)) (while (re-search-forward "${.*?}" end t) (put-text-property (match-beginning 0) (match-end 0) 'font-lock-face 'web-mode-variable-name-face) ) )) ;; todo : parsing plus compliqué: {$obj->values[3]->name} (defun web-mode-interpolate-block-string (beg end) (save-excursion (goto-char (1+ beg)) (setq end (1- end)) (cond ((string= web-mode-engine "php") (while (re-search-forward "$[[:alnum:]_]+\\(->[[:alnum:]_]+\\)*\\|{[ ]*$.+?}" end t) ;; (message "%S > %S" (match-beginning 0) (match-end 0)) (remove-list-of-text-properties (match-beginning 0) (match-end 0) '(font-lock-face)) (web-mode-fontify-region (match-beginning 0) (match-end 0) web-mode-php-var-interpolation-font-lock-keywords) )) ((string= web-mode-engine "erb") (while (re-search-forward "#{.*?}" end t) (remove-list-of-text-properties (match-beginning 0) (match-end 0) '(font-lock-face)) (put-text-property (match-beginning 0) (match-end 0) 'font-lock-face 'web-mode-variable-name-face) )) ) ;cond )) (defun web-mode-interpolate-comment (beg end block-side) (save-excursion (let ((regexp (concat "\\_<\\(" web-mode-comment-keywords "\\)\\_>"))) (goto-char beg) (while (re-search-forward regexp end t) (font-lock-prepend-text-property (match-beginning 1) (match-end 1) 'font-lock-face 'web-mode-comment-keyword-face) ) ;while ))) (defun web-mode-interpolate-sql-string (beg end) (save-excursion (let ((case-fold-search t) (regexp (concat "\\_<\\(" web-mode-sql-keywords "\\)\\_>"))) (goto-char beg) (while (re-search-forward regexp end t) (font-lock-prepend-text-property (match-beginning 1) (match-end 1) 'font-lock-face 'web-mode-sql-keyword-face) ) ;while ))) (defun web-mode-fill-paragraph (&optional justify) (save-excursion (let ((pos (point)) fill-coll prop pair beg end delim-beg delim-end chunk fill-col) (cond ((or (eq (get-text-property pos 'part-token) 'comment) (eq (get-text-property pos 'block-token) 'comment)) (setq prop (if (get-text-property pos 'part-token) 'part-token 'block-token)) (setq pair (web-mode-property-boundaries prop pos)) (when (and pair (> (- (cdr pair) (car pair)) 6)) (setq fill-coll (if (< fill-column 10) 70 fill-column)) (setq beg (car pair) end (cdr pair)) (goto-char beg) (setq chunk (buffer-substring-no-properties beg (+ beg 2))) (cond ((string= chunk "//") (setq delim-beg "//" delim-end "EOL")) ((string= chunk "/*") (setq delim-beg "/*" delim-end "*/")) ((string= chunk "{#") (setq delim-beg "{#" delim-end "#}")) ((string= chunk "")) ) ) ) ;comment - case ((web-mode-is-content) (setq pair (web-mode-content-boundaries pos)) (setq beg (car pair) end (cdr pair)) ) ) ;cond ;; (message "beg(%S) end(%S)" beg end) (when (and beg end) (fill-region beg end)) t))) (defun web-mode-property-boundaries (prop &optional pos) "property boundaries (cdr is 1+)" (unless pos (setq pos (point))) (let (beg end val) (setq val (get-text-property pos prop)) (if (null val) val (if (or (bobp) (not (eq (get-text-property (1- pos) prop) val))) (setq beg pos) (setq beg (previous-single-property-change pos prop)) (when (null beg) (setq beg (point-min)))) (if (or (eobp) (not (eq (get-text-property (1+ pos) prop) val))) (setq end pos) (setq end (next-single-property-change pos prop)) (when (null end) (setq end (point-min)))) (cons beg end)))) (defun web-mode-content-boundaries (&optional pos) (unless pos (setq pos (point))) (let (beg end) (setq beg (or (previous-property-change pos (current-buffer)) (point-max))) (setq end (or (next-property-change pos (current-buffer)) (point-min))) (while (and (< beg end) (member (char-after beg) '(?\s ?\n))) (setq beg (1+ beg))) (while (and (> end beg) (member (char-after (1- end)) '(?\s ?\n))) (setq end (1- end))) ;; (message "beg(%S) end(%S)" beg end) (cons beg end) )) (defun web-mode-engine-syntax-check () (interactive) (let ((proc nil) (errors nil) (file (concat temporary-file-directory "emacs-web-mode-tmp"))) (write-region (point-min) (point-max) file) (cond ;; ((null (buffer-file-name)) ;; ) ((string= web-mode-engine "php") (setq proc (start-process "php-proc" nil "php" "-l" file)) (set-process-filter proc (lambda (proc output) (cond ((string-match-p "No syntax errors" output) (message "No syntax errors") ) (t ;; (setq output (replace-regexp-in-string temporary-file-directory "" output)) ;; (message output) (message "Syntax error") (setq errors t)) ) ;cond ;; (delete-file file) ) ;lambda ) ) ;php (t (message "no syntax checker found") ) ;t ) ;cond errors)) (defun web-mode-jshint () "Run JSHint on all the JavaScript parts." (interactive) (let (proc lines) (when (buffer-file-name) (setq proc (start-process "jshint-proc" nil (or (executable-find "jshint") "/usr/local/bin/jshint") "--extract=auto" (buffer-file-name))) (setq web-mode-jshint-errors 0) (set-process-filter proc (lambda (proc output) (let ((offset 0) overlay pos (old 0) msg) (remove-overlays (point-min) (point-max) 'font-lock-face 'web-mode-error-face) (while (string-match "line \\([[:digit:]]+\\), col \\([[:digit:]]+\\), \\(.+\\)\\.$" output offset) (setq web-mode-jshint-errors (1+ web-mode-jshint-errors)) (setq offset (match-end 0)) (setq pos (web-mode-coord-position (match-string-no-properties 1 output) (match-string-no-properties 2 output))) (when (get-text-property pos 'tag-beg) (setq pos (1- pos))) (when (not (= pos old)) (setq old pos) (setq overlay (make-overlay pos (1+ pos))) (overlay-put overlay 'font-lock-face 'web-mode-error-face) ) (setq msg (or (overlay-get overlay 'help-echo) (concat "line=" (match-string-no-properties 1 output) " column=" (match-string-no-properties 2 output) ))) (overlay-put overlay 'help-echo (concat msg " ## " (match-string-no-properties 3 output))) ) ;while )) ) ) ;when )) (defun web-mode-dom-errors-show () "Show unclosed tags." (interactive) (let (beg end tag pos l n tags i cont cell overlay overlays first (ori (point)) (errors 0) (continue t) ) (setq overlays (overlays-in (point-min) (point-max))) (when overlays (dolist (overlay overlays) (when (eq (overlay-get overlay 'face) 'web-mode-warning-face) (delete-overlay overlay) ) ) ) (goto-char (point-min)) (when (not (or (get-text-property (point) 'tag-beg) (web-mode-tag-next))) (setq continue nil)) (while continue (setq pos (point)) (setq tag (get-text-property pos 'tag-name)) (cond ((eq (get-text-property (point) 'tag-type) 'start) (setq tags (add-to-list 'tags (list tag pos))) ;; (message "(%S) opening %S" pos tag) ) ((eq (get-text-property (point) 'tag-type) 'end) (setq i 0 l (length tags) cont t) (while (and (< i l) cont) (setq cell (nth i tags)) ;; (message "cell=%S" cell) (setq i (1+ i)) (cond ((string= tag (nth 0 cell)) (setq cont nil) ) (t (setq errors (1+ errors)) (setq beg (nth 1 cell)) (setq end (web-mode-tag-end-position beg)) (unless first (setq first beg)) (setq overlay (make-overlay beg (1+ end))) (overlay-put overlay 'font-lock-face 'web-mode-warning-face) ;; (message "invalid <%S> at %S" (nth 0 cell) (nth 1 cell)) ) ) ;cond ) ;while (dotimes (i i) (setq tags (cdr tags))) ) ) ;cond (when (not (web-mode-tag-next)) (setq continue nil)) ) ;while (message "%S error(s) detected" errors) (if (< errors 1) (goto-char ori) (goto-char first) (recenter)) ;; (message "%S" tags) )) (defun web-mode-highlight-elements (beg end) (save-excursion (goto-char beg) (let ((continue (or (get-text-property (point) 'tag-beg) (web-mode-tag-next))) (i 0) (ctx nil) (face nil)) (while continue (cond ((> (setq i (1+ i)) 1000) (message "highlight-elements ** too much tags **") (setq continue nil)) ((> (point) end) (setq continue nil)) ((not (get-text-property (point) 'tag-beg)) (setq continue nil)) ((eq (get-text-property (point) 'tag-type) 'start) (when (and (setq ctx (web-mode-element-boundaries (point))) (<= (car (cdr ctx)) end) (setq face (cdr (assoc (get-text-property (point) 'tag-name) web-mode-element-content-faces)))) (font-lock-prepend-text-property (1+ (cdr (car ctx))) (car (cdr ctx)) 'font-lock-face face)) ) ) ;cond (when (not (web-mode-tag-next)) (setq continue nil)) ) ;while ))) (defun web-mode-enable (feature) "Enable one feature." (interactive (list (completing-read "Feature: " (let (features) (dolist (elt web-mode-features) (setq features (append features (list (car elt))))) features)))) (when (and (or (not feature) (< (length feature) 1)) web-mode-last-enabled-feature) (setq feature web-mode-last-enabled-feature)) (when feature (setq web-mode-last-enabled-feature feature) (setq feature (cdr (assoc feature web-mode-features))) (cond ((eq feature 'web-mode-enable-current-column-highlight) (web-mode-column-show)) ((eq feature 'web-mode-enable-current-element-highlight) (when (not web-mode-enable-current-element-highlight) (web-mode-toggle-current-element-highlight)) ) ((eq feature 'web-mode-enable-whitespace-fontification) (web-mode-whitespaces-on)) (t (set feature t) (web-mode-buffer-highlight)) ) ) ;when ) (defun web-mode-disable (feature) "Disable one feature." (interactive (list (completing-read "Feature: " (let (features) (dolist (elt web-mode-features) (setq features (append features (list (car elt))))) features)))) (when (and (or (not feature) (< (length feature) 1)) web-mode-last-enabled-feature) (setq feature web-mode-last-enabled-feature)) (when feature (setq feature (cdr (assoc feature web-mode-features))) (cond ((eq feature 'web-mode-enable-current-column-highlight) (web-mode-column-hide)) ((eq feature 'web-mode-enable-current-element-highlight) (when web-mode-enable-current-element-highlight (web-mode-toggle-current-element-highlight)) ) ((eq feature 'web-mode-enable-whitespace-fontification) (web-mode-whitespaces-off)) (t (set feature nil) (web-mode-buffer-highlight)) ) ) ;when ) (defun web-mode-make-tag-overlays () (unless web-mode-overlay-tag-start (setq web-mode-overlay-tag-start (make-overlay 1 1) web-mode-overlay-tag-end (make-overlay 1 1)) (overlay-put web-mode-overlay-tag-start 'font-lock-face 'web-mode-current-element-highlight-face) (overlay-put web-mode-overlay-tag-end 'font-lock-face 'web-mode-current-element-highlight-face))) (defun web-mode-delete-tag-overlays () (when web-mode-overlay-tag-start (delete-overlay web-mode-overlay-tag-start) (delete-overlay web-mode-overlay-tag-end))) (defun web-mode-column-overlay-factory (index) (let (overlay) (when (null web-mode-column-overlays) (dotimes (i 100) (setq overlay (make-overlay 1 1)) (overlay-put overlay 'font-lock-face 'web-mode-current-column-highlight-face) (setq web-mode-column-overlays (append web-mode-column-overlays (list overlay))) ) ) ;when (setq overlay (nth index web-mode-column-overlays)) (when (null overlay) (setq overlay (make-overlay 1 1)) (overlay-put overlay 'font-lock-face 'web-mode-current-column-highlight-face) (setq web-mode-column-overlays (append web-mode-column-overlays (list overlay))) ) ;when overlay)) (defun web-mode-column-hide () (setq web-mode-enable-current-column-highlight nil) (remove-overlays (point-min) (point-max) 'font-lock-face 'web-mode-current-column-highlight-face)) (defun web-mode-column-show () (let ((index 0) overlay diff column line-to line-from) (web-mode-column-hide) (setq web-mode-enable-current-column-highlight t) (save-excursion (back-to-indentation) (setq column (current-column) line-to (web-mode-line-number)) (when (and (get-text-property (point) 'tag-beg) (member (get-text-property (point) 'tag-type) '(start end)) (web-mode-tag-match) (setq line-from (web-mode-line-number)) (not (= line-from line-to))) (when (> line-from line-to) (let (tmp) (setq tmp line-from) (setq line-from line-to) (setq line-to tmp)) ) ;when ;;(message "column(%S) line-from(%S) line-to(%S)" column line-from line-to) (goto-char (point-min)) (when (> line-from 1) (forward-line (1- line-from))) (while (<= line-from line-to) (setq overlay (web-mode-column-overlay-factory index)) (setq diff (- (line-end-position) (point))) (cond ((or (and (= column 0) (= diff 0)) (> column diff)) (end-of-line) (move-overlay overlay (point) (point)) (overlay-put overlay 'after-string (concat (if (> column diff) (make-string (- column diff) ?\s) "") (propertize " " 'font-lock-face 'web-mode-current-column-highlight-face) ) ;concat ) ) (t (move-to-column column) (overlay-put overlay 'after-string nil) (move-overlay overlay (point) (1+ (point))) ) ) ;cond (setq line-from (1+ line-from)) (forward-line) (setq index (1+ index)) ) ;while ) ;when ) ;save-excursion ) ;let ) (defun web-mode-highlight-current-element () (let ((ctx (web-mode-element-boundaries)) len) (cond ((null ctx) (web-mode-delete-tag-overlays)) (t (web-mode-make-tag-overlays) (setq len (length (get-text-property (caar ctx) 'tag-name))) (move-overlay web-mode-overlay-tag-start (+ (caar ctx) 1) (+ (caar ctx) 1 len)) (move-overlay web-mode-overlay-tag-end (+ (cadr ctx) 2) (+ (cadr ctx) 2 len)) ) ;t ) ;cond )) (defun web-mode-highlight-whitespaces (beg end) (save-excursion (goto-char beg) (while (re-search-forward web-mode-whitespaces-regexp end t) (add-text-properties (match-beginning 0) (match-end 0) '(face web-mode-whitespace-face)) ) ;while )) (defun web-mode-whitespaces-show () "Toggle whitespaces." (interactive) (if web-mode-enable-whitespace-fontification (web-mode-whitespaces-off) (web-mode-whitespaces-on))) (defun web-mode-whitespaces-on () "Show whitespaces." (interactive) (when web-mode-display-table (setq buffer-display-table web-mode-display-table)) (setq web-mode-enable-whitespace-fontification t)) (defun web-mode-whitespaces-off () (setq buffer-display-table nil) (setq web-mode-enable-whitespace-fontification nil)) (defun web-mode-use-tabs () "Tweaks vars to be compatible with TAB indentation." (let (offset) (setq web-mode-block-padding 0) (setq web-mode-script-padding 0) (setq web-mode-style-padding 0) (setq offset (cond ((and (boundp 'tab-width) tab-width) tab-width) ((and (boundp 'standard-indent) standard-indent) standard-indent) (t 4))) ;; (message "offset(%S)" offset) (setq web-mode-attr-indent-offset offset) (setq web-mode-code-indent-offset offset) (setq web-mode-css-indent-offset offset) (setq web-mode-markup-indent-offset offset) (setq web-mode-sql-indent-offset offset) (add-to-list 'web-mode-indentation-params '("lineup-args" . nil)) (add-to-list 'web-mode-indentation-params '("lineup-calls" . nil)) (add-to-list 'web-mode-indentation-params '("lineup-concats" . nil)) (add-to-list 'web-mode-indentation-params '("lineup-ternary" . nil)) )) (defun web-mode-buffer-indent () "Indent all buffer." (interactive) (indent-region (point-min) (point-max)) (delete-trailing-whitespace)) (defun web-mode-buffer-change-tag-case (&optional type) "Change html tag case." (interactive) (save-excursion (goto-char (point-min)) (let ((continue t) f) (setq f (if (member type '("upper" "uppercase" "upper-case")) 'uppercase 'downcase)) (when (and (not (get-text-property (point) 'tag-beg)) (not (web-mode-tag-next))) (setq continue nil)) (while continue (skip-chars-forward " depth 1)) (when (get-text-property pos 'jsx-beg) (setq depth (1- depth))) (setq reg-beg (web-mode-jsx-depth-beginning-position pos depth)) (setq reg-beg (1+ reg-beg)) (save-excursion (goto-char reg-beg) (cond ((and (not (looking-at-p "[ ]*$")) (looking-back "^[[:space:]]*{")) (setq reg-col (+ (current-indentation) 1 (cond ((looking-at "[ ]+") (length (match-string-no-properties 0))) (t 0)) )) ) ((looking-at-p "[ ]*\\[[ ]*$") ;; #0659 (setq reg-col (current-indentation)) ) (t ;;(message "%S %S : %S %S" (point) (current-indentation) web-mode-code-indent-offset) ;;(setq reg-col (+ (current-indentation) web-mode-code-indent-offset web-mode-jsx-expression-padding))) (setq reg-col (+ (current-indentation) web-mode-code-indent-offset))) ) ;;(message "%S %S %S" (point) (current-indentation) reg-col) ) ;save-excursion ) ((string= web-mode-content-type "jsx") (setq reg-beg (point-min))) (t (setq reg-beg (or (web-mode-part-beginning-position pos) (point-min))) (save-excursion (goto-char reg-beg) (search-backward "<" nil t) (setq reg-col (current-column)) ) ;save-excursion ) ) ;cond ;;(message "jsx reg-beg=%S" reg-beg) ) ;jsx ((string= web-mode-content-type "php") (setq language "php" curr-indentation web-mode-code-indent-offset)) ((or (string= web-mode-content-type "xml")) (setq language "xml" curr-indentation web-mode-markup-indent-offset)) ;; TODO: est ce util ? ((and (get-text-property pos 'tag-beg) (get-text-property pos 'tag-name) ;;(not (get-text-property pos 'part-side)) ) (setq language "html" curr-indentation web-mode-markup-indent-offset)) ((and (get-text-property pos 'block-side) (not (get-text-property pos 'block-beg))) (setq reg-beg (or (web-mode-block-beginning-position pos) (point-min))) (goto-char reg-beg) (setq reg-col (current-column)) (setq language web-mode-engine) (setq curr-indentation web-mode-code-indent-offset) (cond ((string= web-mode-engine "blade") (save-excursion (when (web-mode-rsf "{[{!]+[ ]*") (setq reg-col (current-column)))) (setq reg-beg (+ reg-beg 2)) ) ((string= web-mode-engine "razor") (setq reg-beg (+ reg-beg 2)) ) ;; tests/demo.chtml ((string= web-mode-engine "ctemplate") (save-excursion (when (web-mode-rsf "{{#?") (setq reg-col (current-column)))) ) ((string= web-mode-engine "dust") (save-excursion (when (web-mode-rsf "{@") (setq reg-col (current-column)))) ) ((string= web-mode-engine "template-toolkit") (setq reg-beg (+ reg-beg 3) reg-col (+ reg-col 3)) ) ((and (string= web-mode-engine "jsp") (web-mode-looking-at "<%@\\|<[[:alpha:]]" reg-beg)) (save-excursion (goto-char reg-beg) (looking-at "<%@[ ]*[[:alpha:]]+[ ]+\\| pos (point-min)) (eq (get-text-property pos 'part-token) 'comment) (eq (get-text-property (1- pos) 'part-token) 'comment) (progn (setq reg-beg (previous-single-property-change pos 'part-token)) t)) (and (> pos (point-min)) (eq (get-text-property pos 'block-token) 'comment) (eq (get-text-property (1- pos) 'block-token) 'comment) (progn (setq reg-beg (previous-single-property-change pos 'block-token)) t)) (and (> pos (point-min)) (eq (get-text-property pos 'tag-type) 'comment) (not (get-text-property pos 'tag-beg)) (progn (setq reg-beg (web-mode-tag-beginning-position pos)) t)) ) (setq token "comment")) ((or (and (> pos (point-min)) (member (get-text-property pos 'part-token) '(string context key)) (member (get-text-property (1- pos) 'part-token) '(string context key))) (and (eq (get-text-property pos 'block-token) 'string) (eq (get-text-property (1- pos) 'block-token) 'string))) (setq token "string")) ) (goto-char pos) (setq curr-line (web-mode-trim (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) (setq curr-char (if (string= curr-line "") 0 (aref curr-line 0))) (when (or (member language '("php" "blade" "javascript" "jsx" "razor")) (and (member language '("html" "xml")) (not (eq ?\< curr-char)))) (let (prev) (cond ((member language '("html" "xml" "javascript" "jsx")) (when (setq prev (web-mode-part-previous-live-line reg-beg)) (setq prev-line (car prev) prev-indentation (cdr prev)) (setq prev-line (web-mode-clean-part-line prev-line))) ) ((setq prev (web-mode-block-previous-live-line)) (setq prev-line (car prev) prev-indentation (cdr prev)) (setq prev-line (web-mode-clean-block-line prev-line))) ) ;cond ) ;let (when (>= (length prev-line) 1) (setq prev-char (aref prev-line (1- (length prev-line)))) (setq prev-line (substring-no-properties prev-line)) ) ) (cond ((not (member web-mode-content-type '("html" "xml"))) ) ((member language '("javascript" "jsx")) (setq reg-col (+ reg-col web-mode-script-padding))) ((member language '("css")) (setq reg-col (+ reg-col web-mode-style-padding))) ((not (member language '("html" "xml" "razor"))) (setq reg-col (+ reg-col web-mode-block-padding))) ) (list :curr-char curr-char :curr-indentation curr-indentation :curr-line curr-line :language language :options options :prev-char prev-char :prev-indentation prev-indentation :prev-line prev-line :reg-beg reg-beg :reg-col reg-col :token token) ))) (defun web-mode-indent-line () (web-mode-propertize) (let ((offset nil) (char nil) (inhibit-modification-hooks t) (adjust t)) (save-excursion (back-to-indentation) (setq char (char-after)) (let* ((pos (point)) (ctx (web-mode-point-context pos)) (curr-char (plist-get ctx :curr-char)) (curr-indentation (plist-get ctx :curr-indentation)) (curr-line (plist-get ctx :curr-line)) (language (plist-get ctx :language)) (prev-char (plist-get ctx :prev-char)) (prev-indentation (plist-get ctx :prev-indentation)) (prev-line (plist-get ctx :prev-line)) (reg-beg (plist-get ctx :reg-beg)) (reg-col (plist-get ctx :reg-col)) (token (plist-get ctx :token)) (options (plist-get ctx :options)) (chars (list curr-char prev-char))) ;;(message "curr-char=[%c] prev-char=[%c]\n%S" curr-char prev-char ctx) (cond ((or (bobp) (= (line-number-at-pos pos) 1)) (setq offset 0)) ((string= token "string") (cond ((and web-mode-enable-sql-detection (web-mode-block-token-starts-with (concat "[ \n]*" web-mode-sql-queries))) (save-excursion (let (col) (web-mode-block-string-beginning) (skip-chars-forward "[ \"'\n]") (setq col (current-column)) (goto-char pos) (if (looking-at-p "\\(SELECT\\|INSERT\\|DELETE\\|UPDATE\\|FROM\\|LEFT\\|JOIN\\|WHERE\\|GROUP BY\\|LIMIT\\|HAVING\\|\)\\)") (setq offset col) (setq offset (+ col web-mode-sql-indent-offset))) ) ) ;save-excursion ) (t (setq offset nil)) ) ;cond ) ;case string ((string= token "comment") (if (eq (get-text-property pos 'tag-type) 'comment) (web-mode-tag-beginning) (goto-char (car (web-mode-property-boundaries (if (eq (get-text-property pos 'part-token) 'comment) 'part-token 'block-token) pos)))) (setq offset (current-column)) ;;(message "%S %S" (point) offset) (cond ((member (buffer-substring-no-properties (point) (+ (point) 2)) '("/*" "{*" "@*")) (cond ((eq ?\* curr-char) (setq offset (+ offset 1))) (t (setq offset (+ offset 3))) ) ;cond ) ((string= (buffer-substring-no-properties (point) (+ (point) 4)) "" (point)) (web-mode-insert-text-at-pos "" (point)) (web-mode-insert-text-at-pos "") (search-backward " -->")) ) ) (defun web-mode-comment (pos) (let (ctx language sel beg end tmp block-side single-line-block pos-after content) (setq pos-after pos) (setq block-side (get-text-property pos 'block-side)) (setq single-line-block (web-mode-is-single-line-block pos)) (cond ((and block-side (string= web-mode-engine "erb")) (web-mode-comment-erb-block pos) ) ((and single-line-block block-side (intern-soft (concat "web-mode-comment-" web-mode-engine "-block"))) (funcall (intern (concat "web-mode-comment-" web-mode-engine "-block")) pos) ) (t (setq ctx (web-mode-point-context (if mark-active (region-beginning) (line-beginning-position)))) (setq language (plist-get ctx :language)) (cond (mark-active ) ((and (member language '("html" "xml")) (get-text-property (progn (back-to-indentation) (point)) 'tag-beg)) (web-mode-element-select)) (t (end-of-line) (set-mark (line-beginning-position))) ) ;cond (setq beg (region-beginning) end (region-end)) (when (> (point) (mark)) (exchange-point-and-mark)) (if (and (eq (char-before end) ?\n) (not (eq (char-after end) ?\n))) (setq end (1- end))) (setq sel (buffer-substring-no-properties beg end)) (cond ((member language '("html" "xml")) (cond ((and (= web-mode-comment-style 2) (string= web-mode-engine "django")) (setq content (concat "{# " sel " #}"))) ((and (= web-mode-comment-style 2) (member web-mode-engine '("ejs" "erb"))) (setq content (concat "<%# " sel " %>"))) ((and (= web-mode-comment-style 2) (string= web-mode-engine "aspx")) (setq content (concat "<%-- " sel " --%>"))) ((and (= web-mode-comment-style 2) (string= web-mode-engine "smarty")) (setq content (concat "{* " sel " *}"))) ((and (= web-mode-comment-style 2) (string= web-mode-engine "blade")) (setq content (concat "{{-- " sel " --}}"))) ((and (= web-mode-comment-style 2) (string= web-mode-engine "ctemplate")) (setq content (concat "{{!-- " sel " --}}"))) ((and (= web-mode-comment-style 2) (string= web-mode-engine "razor")) (setq content (concat "@* " sel " *@"))) (t (setq content (concat "")) (when (< (length sel) 1) (search-backward " -->") (setq pos-after nil)) )) ) ;case html ((member language '("php" "javascript" "java" "jsx")) (let (alt) (cond ((get-text-property pos 'jsx-depth) (setq content (concat "{/* " sel " */}")) ;;(message "%S" pos) ) ((and (setq alt (cdr (assoc language web-mode-comment-formats))) (string= alt "//")) (setq content (replace-regexp-in-string "^[ ]*" alt sel))) (t (setq content (concat "/* " sel " */"))) ) ;cond ) ) ((member language '("erb")) (setq content (replace-regexp-in-string "^[ ]*" "#" sel))) ((member language '("asp")) (setq content (replace-regexp-in-string "^[ ]*" "''" sel))) (t (setq content (concat "/* " sel " */"))) ) ;cond (when content (delete-region beg end) (deactivate-mark) (let (beg end) (setq beg (point-at-bol)) (insert content) (setq end (point-at-eol)) (indent-region beg end) ) ) ;when ) ;t ) ;cond (when pos-after (goto-char pos-after)) )) (defun web-mode-comment-ejs-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-insert-text-at-pos "//" (+ beg 2)))) (defun web-mode-comment-erb-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-insert-text-at-pos "#" (+ beg 2)))) (defun web-mode-comment-django-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-insert-text-at-pos "#" end) (web-mode-insert-text-at-pos "#" (1+ beg)))) (defun web-mode-comment-dust-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-insert-text-at-pos "!" end) (web-mode-insert-text-at-pos "!" (1+ beg)))) (defun web-mode-comment-aspx-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-insert-text-at-pos "#" end) (web-mode-insert-text-at-pos "#" (1+ beg)))) (defun web-mode-comment-jsp-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-insert-text-at-pos "--" (+ beg 2)))) (defun web-mode-comment-go-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-insert-text-at-pos "/" (+ beg 2)))) (defun web-mode-comment-php-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-insert-text-at-pos "*/" (- end 1)) (web-mode-insert-text-at-pos "/*" (+ beg (if (web-mode-looking-at "<\\?php" beg) 5 3))))) (defun web-mode-comment-boundaries (&optional pos) (interactive) (unless pos (setq pos (point))) (let ((beg pos) (end pos) prop) (save-excursion (goto-char pos) (setq prop (cond ((eq (get-text-property pos 'block-token) 'comment) 'block-token) ((eq (get-text-property pos 'tag-type) 'comment) 'tag-type) ((eq (get-text-property pos 'part-token) 'comment) 'part-token) (t nil) )) (if (null prop) (setq beg nil end nil) (when (and (not (bobp)) (eq (get-text-property pos prop) (get-text-property (1- pos) prop))) (setq beg (or (previous-single-property-change pos prop) (point-min)))) (when (and (not (eobp)) (eq (get-text-property pos prop) (get-text-property (1+ pos) prop))) (setq end (or (next-single-property-change pos prop) (point-max))))) (when (and beg (string= (buffer-substring-no-properties beg (+ beg 2)) "//")) (goto-char end) (while (and (looking-at-p "\n[ ]*//") (not (eobp))) (search-forward "//") (backward-char 2) ;;(message "%S" (point)) (setq end (next-single-property-change (point) prop)) (goto-char end) ;;(message "%S" (point)) ) ;while ) ;when (when end (setq end (1- end))) ) ; save-excursion ;;(message "beg=%S end=%S" beg end) (if (and beg end) (cons beg end) nil) )) (defun web-mode-uncomment (pos) (let ((beg pos) (end pos) (sub2 "") comment boundaries) (save-excursion (cond ((and (get-text-property pos 'block-side) (intern-soft (concat "web-mode-uncomment-" web-mode-engine "-block"))) (funcall (intern (concat "web-mode-uncomment-" web-mode-engine "-block")) pos)) ((and (setq boundaries (web-mode-comment-boundaries pos)) (setq beg (car boundaries)) (setq end (1+ (cdr boundaries))) (> (- end beg) 4)) ;;(message "beg(%S) end(%S)" beg end) (setq comment (buffer-substring-no-properties beg end)) (setq sub2 (substring comment 0 2)) (cond ((member sub2 '("$\\)" "" comment))) ((string= sub2 "{#") (setq comment (replace-regexp-in-string "\\(^{#[ ]?\\|[ ]?#}$\\)" "" comment))) ((string= sub2 "{/") ;;jsx comments (setq comment (replace-regexp-in-string "\\(^{/\\*[ ]?\\|[ ]?\\*/}$\\)" "" comment))) ((string= sub2 "/*") (setq comment (replace-regexp-in-string "\\(^/\\*[ ]?\\|[ ]?\\*/$\\)" "" comment))) ((string= sub2 "//") (setq comment (replace-regexp-in-string "\\(//\\)" "" comment))) ) ;cond (delete-region beg end) (web-mode-insert-and-indent comment) (goto-char beg) ) ) ;cond (indent-according-to-mode)))) (defun web-mode-uncomment-erb-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (if (string-match-p "<[%[:alpha:]]" (buffer-substring-no-properties (+ beg 2) (- end 2))) (progn (web-mode-remove-text-at-pos 2 (1- end)) (web-mode-remove-text-at-pos 3 beg)) (web-mode-remove-text-at-pos 1 (+ beg 2)) ) ;if ) ) (defun web-mode-uncomment-ejs-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-remove-text-at-pos 1 (+ beg 2)))) (defun web-mode-uncomment-django-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-remove-text-at-pos 2 (1- end)) (web-mode-remove-text-at-pos 2 beg))) (defun web-mode-uncomment-ctemplate-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-remove-text-at-pos 5 (- end 4)) (web-mode-remove-text-at-pos 5 beg))) (defun web-mode-uncomment-dust-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-remove-text-at-pos 1 (1- end)) (web-mode-remove-text-at-pos 1 (1+ beg)))) (defun web-mode-uncomment-aspx-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-remove-text-at-pos 1 (1- end)) (web-mode-remove-text-at-pos 1 (1+ beg)))) (defun web-mode-uncomment-jsp-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-remove-text-at-pos 2 (+ beg 2)))) (defun web-mode-uncomment-go-block (pos) (let (beg end) (setq beg (web-mode-block-beginning-position pos) end (web-mode-block-end-position pos)) (web-mode-remove-text-at-pos 1 (+ beg 2)))) (defun web-mode-snippet-names () (let (codes) (dolist (snippet web-mode-snippets) (add-to-list 'codes (car snippet) t)) codes)) (defun web-mode-snippet-insert (code) "Insert a snippet." (interactive (list (completing-read "Snippet: " (web-mode-snippet-names)))) (let (beg (continue t) (counter 0) end sel snippet (l (length web-mode-snippets)) pos) (when mark-active (setq sel (web-mode-trim (buffer-substring-no-properties (region-beginning) (region-end)))) (delete-region (region-beginning) (region-end))) (while (and continue (< counter l)) (setq snippet (nth counter web-mode-snippets)) (when (string= (car snippet) code) (setq continue nil)) (setq counter (1+ counter))) (when snippet (setq snippet (cdr snippet)) (setq beg (point-at-bol)) (insert snippet) (setq pos (point) end (point)) (when (string-match-p "|" snippet) (search-backward "|") (delete-char 1) (setq pos (point) end (1- end))) (when sel (insert sel) (setq pos (point) end (+ end (length sel)))) (goto-char end) (setq end (point-at-eol)) (unless sel (goto-char pos)) (indent-region beg end)) )) (defun web-mode-looking-at (regexp pos) (save-excursion (goto-char pos) (looking-at regexp))) (defun web-mode-looking-at-p (regexp pos) (save-excursion (goto-char pos) (looking-at-p regexp))) (defun web-mode-looking-back (regexp pos &optional limit greedy) (save-excursion (goto-char pos) (if limit (looking-back regexp limit greedy) (looking-back regexp)))) (defun web-mode-insert-text-at-pos (text pos) (let ((mem web-mode-enable-auto-pairing)) (setq web-mode-enable-auto-pairing nil) (save-excursion (goto-char pos) (insert text) (setq web-mode-enable-auto-pairing mem) ))) (defun web-mode-remove-text-at-pos (n &optional pos) (unless pos (setq pos (point))) (delete-region pos (+ pos n))) (defun web-mode-insert-and-indent (text) (let (beg end) (setq beg (point-at-bol)) (insert text) (setq end (point-at-eol)) (indent-region beg end) )) (defun web-mode-indentation-at-pos (pos) (save-excursion (goto-char pos) (current-indentation))) (defun web-mode-navigate (&optional pos) "Move point to the matching opening/closing tag/block." (interactive) (unless pos (setq pos (point))) (let (init) (goto-char pos) (setq init (point)) (when (> (current-indentation) (current-column)) (back-to-indentation)) (setq pos (point)) (cond ((and (get-text-property pos 'block-side) (web-mode-block-beginning) (web-mode-block-controls-get (point))) (web-mode-block-match)) ((member (get-text-property pos 'tag-type) '(start end)) (web-mode-tag-beginning) (web-mode-tag-match)) (t (goto-char init)) ) )) (defun web-mode-block-match (&optional pos) (unless pos (setq pos (point))) (let (pos-ori controls control (counter 1) type (continue t) pair) (setq pos-ori pos) (goto-char pos) (setq controls (web-mode-block-controls-get pos)) ;; (message "controls=%S" controls) (cond (controls (setq pair (car controls)) (setq control (cdr pair)) (setq type (car pair)) (when (eq type 'inside) (setq type 'close)) (while continue (cond ((and (> pos-ori 1) (bobp)) (setq continue nil)) ((or (and (eq type 'open) (not (web-mode-block-next))) (and (eq type 'close) (not (web-mode-block-previous)))) (setq continue nil) ) ((null (setq controls (web-mode-block-controls-get (point)))) ) (t ;; TODO : est il nécessaire de faire un reverse sur controls si on doit matcher backward (dolist (pair controls) (cond ((not (string= (cdr pair) control)) ) ((eq (car pair) 'inside) ) ((eq (car pair) type) (setq counter (1+ counter))) (t (setq counter (1- counter))) ) ) ;dolist (when (= counter 0) (setq continue nil)) ) ;t ) ;cond ) ;while (if (= counter 0) (point) nil) ) ;controls (t (goto-char pos-ori) nil ) ;controls = nul ) ;conf )) (defun web-mode-tag-match (&optional pos) "Move point to the matching opening/closing tag." (interactive) (unless pos (setq pos (point))) (let (regexp) (setq regexp (concat " counter 0) (re-search-backward regexp nil t)) (when (and (get-text-property (point) 'tag-beg) (member (get-text-property (point) 'tag-type) '(start end))) (setq n (1+ n)) (cond ((eq (get-text-property (point) 'tag-type) 'end) (setq counter (1+ counter))) (t (setq counter (1- counter)) ) ) ) ) (if (= n 0) (goto-char pos)) )) (defun web-mode-tag-fetch-closing (regexp pos) (let ((counter 1) (n 0)) (goto-char pos) (web-mode-tag-end) (while (and (> counter 0) (re-search-forward regexp nil t)) (when (get-text-property (match-beginning 0) 'tag-beg) (setq n (1+ n)) (if (eq (get-text-property (point) 'tag-type) 'end) (setq counter (1- counter)) (setq counter (1+ counter)))) ) (if (> n 0) (web-mode-tag-beginning) (goto-char pos)) )) (defun web-mode-element-tag-name (&optional pos) (unless pos (setq pos (point))) (save-excursion (goto-char pos) (if (and (web-mode-tag-beginning) (looking-at "<\\(/?[[:alpha:]][[:alnum:]:-]*\\)")) (match-string-no-properties 1) nil))) (defun web-mode-element-close () "Close html element." (interactive) (let (jump epp ins tag) (if (and (eq (char-before) ?\>) (web-mode-element-is-void (get-text-property (1- (point)) 'tag-name))) (unless (eq (char-before (1- (point))) ?\/) (backward-char) (insert "/") (forward-char)) (setq epp (web-mode-element-parent-position))) ;;(message "epp=%S" epp) (when epp (setq tag (get-text-property epp 'tag-name)) (setq tag (web-mode-element-tag-name epp)) ;;(message "tag=%S %c" tag (char-before)) (cond ((or (null tag) (web-mode-element-is-void tag)) (setq epp nil)) ((looking-back " (length tag) 4)) (dolist (elt '("div" "span" "strong" "pre" "li")) (when (and (string-match-p (concat "^" elt) tag) (not (string= tag elt))) (setq tag elt) (put-text-property epp (point) 'tag-name tag)) ) ) ;when (if (web-mode-element-is-void (get-text-property (point) 'tag-name)) (setq ins nil epp nil) (setq ins (concat "") (setq ins (concat ins ">"))) (insert ins) (save-excursion (search-backward "<") (setq jump (and (eq (char-before) ?\>) (string= (get-text-property (1- (point)) 'tag-name) tag))) (if jump (setq jump (point))) ) ;save-excursion (if jump (goto-char jump)) ) ;when not ins ) ;when epp epp)) (defun web-mode-detect-content-type () (cond ((and (string= web-mode-engine "none") (< (point) 16) (eq (char-after 1) ?\#) (string-match-p "php" (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) (web-mode-set-engine "php")) ((and (string= web-mode-content-type "javascript") (< (point) web-mode-chunk-length) (eq (char-after (point-min)) ?\/) (string-match-p "@jsx" (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) (web-mode-set-content-type "jsx")) )) (defun web-mode-on-after-change (beg end len) ;; (message "after-change: pos=%d, beg=%d, end=%d, len=%d, ocmd=%S, cmd=%S" (point) beg end len this-original-command this-command) ;; (backtrace) ;; (message "this-command=%S" this-command) (when (eq this-original-command 'yank) (setq web-mode-inhibit-fontification t)) (when (or (null web-mode-change-beg) (< beg web-mode-change-beg)) (setq web-mode-change-beg beg)) (when (or (null web-mode-change-end) (> end web-mode-change-end)) (setq web-mode-change-end end)) ) (defun web-mode-complete () "Autocomple at point." (interactive) (let ((pos (point)) (char (char-before)) (chunk (buffer-substring-no-properties (- (point) 2) (point))) (auto-closed nil) (auto-expanded nil) (auto-paired nil) (auto-quoted nil) expanders) ;;-- auto-closing (when (and web-mode-enable-auto-closing (>= pos 4) (or (string= "" chunk))) (not (get-text-property (- pos 2) 'block-side)) (web-mode-element-close)) (setq auto-closed t)) ;;-- auto-pairing (when (and web-mode-enable-auto-pairing (>= pos 4) (not auto-closed)) (let ((i 0) expr after pos-end (l (length web-mode-auto-pairs))) (setq pos-end (if (> (+ pos 32) (line-end-position)) (line-end-position) (+ pos 10))) (setq chunk (buffer-substring-no-properties (- pos 3) pos) after (buffer-substring-no-properties pos pos-end)) (while (and (< i l) (not auto-paired)) (setq expr (elt web-mode-auto-pairs i) i (1+ i)) ;;(message "chunk=%S expr=%S after=%S" chunk expr after) (when (and (string= (car expr) chunk) (not (string-match-p (regexp-quote (cdr expr)) after))) (setq auto-paired t) (insert (cdr expr)) (if (string-match-p "|" (cdr expr)) (progn (search-backward "|") (delete-char 1)) (goto-char pos)) ) ;when ) ;while ) ;let ) ;;-- auto-expanding (when (and web-mode-enable-auto-expanding (not auto-closed) (not auto-paired) (eq char ?\/) (not (get-text-property (1- pos) 'tag-type)) (not (get-text-property (1- pos) 'part-side)) (not (get-text-property (1- pos) 'block-side)) (looking-back "\\(^\\|[[:punct:][:space:]>]\\)./")) (setq expanders (append web-mode-expanders web-mode-extra-expanders)) (let ((i 0) pair (l (length expanders))) (setq chunk (buffer-substring-no-properties (- pos 2) pos)) ;;(message "%S" chunk) (while (and (< i l) (not auto-expanded)) (setq pair (elt expanders i) i (1+ i)) (when (string= (car pair) chunk) (setq auto-expanded t) (delete-char -2) (insert (cdr pair)) (when (string-match-p "|" (cdr pair)) (search-backward "|") (delete-char 1)) ) ;when ) ;while ) ; let ) ;;-- auto-quoting (when (and web-mode-enable-auto-quoting (>= pos 4) (not (get-text-property pos 'block-side)) (not auto-closed) (not auto-paired) (not auto-expanded) (get-text-property (- pos 2) 'tag-attr) ) (cond ((and (eq char ?\=) (not (looking-at-p "[ ]*[\"']"))) (insert "\"\"") (backward-char) (setq auto-quoted t)) ((and (eq char ?\") (looking-back "=[ ]*\"") (not (looking-at-p "[ ]*[\"]"))) (insert "\"") (backward-char) (setq auto-quoted t)) ((and (eq char ?\') (looking-back "=[ ]*'") (not (looking-at-p "[ ]*[']"))) (insert "'") (backward-char) (setq auto-quoted t)) ((and (eq char ?\") (eq (char-after) ?\")) (delete-char 1) (cond ((looking-back "=\"\"") (backward-char)) ((eq (char-after) ?\s) (forward-char)) (t (insert " ")) ) ;cond ) ) ;cond ) ;when ;;-- (cond ((or auto-closed auto-paired auto-expanded auto-quoted) (when (and web-mode-change-end (>= (line-end-position) web-mode-change-end)) (setq web-mode-change-end (line-end-position))) (list :auto-closed auto-closed :auto-paired auto-paired :auto-expanded auto-expanded :auto-quoted auto-quoted)) (t nil) ) )) (defun web-mode-on-post-command () (let (ctx n char) ;;(message "this-command=%S (%S)" this-command web-mode-expand-previous-state) ;;(message "%S: %S %S" this-command web-mode-change-beg web-mode-change-end) (when (and web-mode-expand-previous-state (not (member this-command '(web-mode-mark-and-expand er/expand-region mc/mark-next-like-this)))) (when (eq this-command 'keyboard-quit) (goto-char web-mode-expand-initial-pos)) (deactivate-mark) (when web-mode-expand-initial-scroll (set-window-start (selected-window) web-mode-expand-initial-scroll) ) (setq web-mode-expand-previous-state nil web-mode-expand-initial-pos nil web-mode-expand-initial-scroll nil)) (when (member this-command '(yank)) (let ((beg web-mode-change-beg) (end web-mode-change-end)) (setq web-mode-inhibit-fontification nil) (when (and web-mode-change-beg web-mode-change-end) (save-excursion (font-lock-fontify-region web-mode-change-beg web-mode-change-end)) (when web-mode-enable-auto-indentation (indent-region beg end)) ) ; and ) ) (when (< (point) 16) (web-mode-detect-content-type)) (when (and web-mode-enable-engine-detection (or (null web-mode-engine) (string= web-mode-engine "none")) (< (point) web-mode-chunk-length) (web-mode-detect-engine)) (web-mode-on-engine-setted) (web-mode-buffer-highlight)) (when (> (point) 1) (setq char (char-before))) (cond ((null char) ) ((and (>= (point) 3) (member this-command '(self-insert-command)) (not (member (get-text-property (point) 'part-token) '(comment string)))) (setq ctx (web-mode-complete))) ((and web-mode-enable-auto-opening (member this-command '(newline electric-newline-and-maybe-indent)) (or (and (not (eobp)) (eq (char-after) ?\<) (eq (get-text-property (point) 'tag-type) 'end) (looking-back ">\n[ \t]*") (setq n (length (match-string-no-properties 0))) (eq (get-text-property (- (point) n) 'tag-type) 'start) (string= (get-text-property (- (point) n) 'tag-name) (get-text-property (point) 'tag-name)) ) (and (get-text-property (1- (point)) 'block-side) (string= web-mode-engine "php") (looking-back "<\\?php[ ]*\n") (looking-at-p "[ ]*\\?>")))) (newline-and-indent) (forward-line -1) (indent-according-to-mode) ) ) ;cond (when (and web-mode-enable-auto-indentation (member this-command '(self-insert-command)) (or (and ctx (or (plist-get ctx :auto-closed) (plist-get ctx :auto-expanded))) (and (> (point) (point-min)) (get-text-property (1- (point)) 'tag-end) (get-text-property (line-beginning-position) 'tag-beg)))) (indent-according-to-mode) (when (and web-mode-change-end (> web-mode-change-end (point-max))) (message "post-command: enlarge web-mode-change-end") (setq web-mode-change-end (point-max)) ) ) ; when auto-indent (when web-mode-enable-current-element-highlight (web-mode-highlight-current-element)) (when (and web-mode-enable-current-column-highlight (not (web-mode-buffer-narrowed-p))) (web-mode-column-show)) ;;(message "post-command (%S) (%S)" web-mode-change-end web-mode-change-end) )) (defun web-mode-dom-apostrophes-replace () "Replace char(') with char(’) in the html contents of the buffer." (interactive) (save-excursion (let ((min (point-min)) (max (point-max))) (when mark-active (setq min (region-beginning) max (region-end)) (deactivate-mark)) (goto-char min) (while (web-mode-content-rsf "\\([[:alpha:]]\\)'\\([[:alpha:]]\\)" max) (replace-match "\\1’\\2")) ))) (defun web-mode-dom-entities-encode () (save-excursion (let (regexp ms elt (min (point-min)) (max (point-max))) (when mark-active (setq min (region-beginning) max (region-end)) (deactivate-mark)) (goto-char min) (setq regexp "[") (dolist (pair web-mode-html-entities) (setq regexp (concat regexp (char-to-string (cdr pair)))) ) (setq regexp (concat regexp "]")) (while (web-mode-content-rsf regexp max) (setq elt (match-string-no-properties 0)) (setq elt (aref elt 0)) (setq elt (car (rassoc elt web-mode-html-entities))) (replace-match (concat "&" elt ";")) ) ;while ))) (defun web-mode-dom-entities-replace () "Replace html entities (e.g. é é or é become é)" (interactive) (save-excursion (let (ms pair elt (min (point-min)) (max (point-max))) (when mark-active (setq min (region-beginning) max (region-end)) (deactivate-mark)) (goto-char min) (while (web-mode-content-rsf "&\\([#]?[[:alnum:]]\\{2,8\\}\\);" max) (setq elt nil) (setq ms (match-string-no-properties 1)) (cond ((not (eq (aref ms 0) ?\#)) (and (setq pair (assoc ms web-mode-html-entities)) (setq elt (cdr pair)) (setq elt (char-to-string elt)))) ((eq (aref ms 1) ?x) (setq elt (substring ms 2)) (setq elt (downcase elt)) (setq elt (string-to-number elt 16)) (setq elt (char-to-string elt))) (t (setq elt (substring ms 1)) (setq elt (char-to-string (string-to-number elt)))) ) ;cond (when elt (replace-match elt)) ) ;while ))) (defun web-mode-dom-xml-replace () "Replace &, > and < in html content." (interactive) (save-excursion (let (expr (min (point-min)) (max (point-max))) (when mark-active (setq min (region-beginning) max (region-end)) (deactivate-mark)) (goto-char min) (while (web-mode-content-rsf "[&<>]" max) (replace-match (cdr (assq (char-before) web-mode-xml-chars)) t t)) ))) (defun web-mode-dom-quotes-replace () "Replace dumb quotes." (interactive) (save-excursion (let (expr (min (point-min)) (max (point-max))) (when mark-active (setq min (region-beginning) max (region-end)) (deactivate-mark)) (goto-char min) (setq expr (concat (car web-mode-smart-quotes) "\\2" (cdr web-mode-smart-quotes))) (while (web-mode-content-rsf "\\(\"\\)\\(.\\{1,200\\}\\)\\(\"\\)" max) (replace-match expr) ) ;while ))) (defun web-mode-dom-xpath (&optional pos) "Display html path." (interactive) (unless pos (setq pos (point))) (save-excursion (goto-char pos) (let (path) (while (web-mode-element-parent) (setq path (cons (get-text-property (point) 'tag-name) path)) ) (message "/%s" (mapconcat 'identity path "/")) ))) (defun web-mode-block-ends-with (regexp &optional pos) (unless pos (setq pos (point))) (save-excursion (goto-char pos) (save-match-data (if (stringp regexp) (and (web-mode-block-end) (progn (backward-char) t) (web-mode-block-skip-blank-backward) (progn (forward-char) t) (looking-back regexp)) (let ((pair regexp) (block-beg (web-mode-block-beginning-position pos)) (block-end (web-mode-block-end-position pos))) (and (web-mode-block-end) (web-mode-block-sb (car pair) block-beg) (not (web-mode-sf (cdr pair) block-end))) ) ;let ) ;if ))) (defun web-mode-block-token-starts-with (regexp &optional pos) (unless pos (setq pos (point))) (save-excursion (and (goto-char pos) (web-mode-block-token-beginning) (skip-chars-forward "[\"']") (looking-at regexp)) )) (defun web-mode-block-starts-with (regexp &optional pos) (unless pos (setq pos (point))) (save-excursion (and (web-mode-block-beginning) (web-mode-block-skip-blank-forward) (looking-at regexp)) )) (defun web-mode-block-skip-blank-backward (&optional pos) (unless pos (setq pos (point))) (let ((continue t)) (goto-char pos) (while continue (if (and (get-text-property (point) 'block-side) (not (bobp)) (or (member (char-after) '(?\s ?\n)) (member (get-text-property (point) 'block-token) '(delimiter-beg delimiter-end comment)))) (backward-char) (setq continue nil)) ) ;while (point))) (defun web-mode-block-skip-blank-forward (&optional pos) (unless pos (setq pos (point))) (let ((continue t)) (goto-char pos) (while continue (if (and (get-text-property (point) 'block-side) (or (member (char-after) '(?\s ?\n ?\t)) (member (get-text-property (point) 'block-token) '(delimiter-beg delimiter-end comment)))) (forward-char) (setq continue nil)) ) ;while ;; (message "pt=%S" (point)) (point))) (defun web-mode-tag-attributes-sort (&optional pos) "Sort the attributes inside the current html tag." (interactive) (unless pos (setq pos (point))) (save-excursion (let (attrs (continue t) min max tag-beg tag-end attr attr-name attr-beg attr-end indent indentation sorter ins) (if (not (member (get-text-property pos 'tag-type) '(start void))) nil (setq tag-beg (web-mode-tag-beginning-position pos) tag-end (web-mode-tag-end-position)) ;; (message "%S %S" tag-beg tag-end) (goto-char tag-beg) (while continue (if (or (not (web-mode-attribute-next)) (>= (point) tag-end)) (setq continue nil) ;;(message "attr=%S" (point)) (setq attr-beg (web-mode-attribute-beginning-position) attr-end (1+ (web-mode-attribute-end-position))) (when (null min) (setq min attr-beg)) (setq max attr-end) (goto-char attr-beg) (setq attr (buffer-substring-no-properties attr-beg attr-end)) (if (string-match "^\\([[:alnum:]-]+\\)=" attr) (setq attr-name (match-string-no-properties 1 attr)) (setq attr-name attr)) (setq indent (looking-back "^[ \t]*")) (setq attrs (append attrs (list (list attr-beg attr-end attr-name attr indent)))) ) ;if ) ;while ) ;if in tag (when attrs (setq sorter (function (lambda (elt1 elt2) (string< (nth 2 elt1) (nth 2 elt2)) ))) (setq attrs (sort attrs sorter)) (delete-region (1- min) max) (setq ins "") (dolist (elt attrs) (if (and (nth 4 elt) (> (length ins) 1)) (setq ins (concat ins "\n")) (setq ins (concat ins " "))) (setq ins (concat ins (nth 3 elt))) ) (goto-char (1- min)) (insert ins) (web-mode-tag-beginning) (setq min (line-beginning-position)) (web-mode-tag-end) (setq max (line-end-position)) (indent-region min max) ) ;;(message "attrs=%S" attrs) ))) (defun web-mode-attribute-insert () "Insert an attribute inside current tag." (interactive) (let (attr attr-name attr-value) (cond ((not (eq (get-text-property (point) 'tag-type) 'start)) (message "attribute-insert ** invalid context **")) ((not (and (setq attr-name (read-from-minibuffer "Attribute name? ")) (> (length attr-name) 0))) (message "attribute-insert ** failure **")) (t (setq attr (concat " " attr-name)) (when (setq attr-value (read-from-minibuffer "Attribute value? ")) (setq attr (concat attr "=\"" attr-value "\""))) (web-mode-tag-end) (re-search-backward "/?>") (insert attr) ) ) ;cond )) (defun web-mode-attribute-transpose (&optional pos) "Transpose the current html attribute." (interactive) (unless pos (setq pos (point))) (let (ret attr-beg attr-end next-beg next-end tag-end) (when (and (get-text-property pos 'tag-attr) (setq next-beg (web-mode-attribute-next-position pos)) (setq next-end (web-mode-attribute-end-position next-beg)) (setq tag-end (web-mode-tag-end-position pos)) (> tag-end next-end)) (setq attr-beg (web-mode-attribute-beginning-position pos) attr-end (web-mode-attribute-end-position pos)) ;; (message "%S %S - %S %S" attr-beg attr-end next-beg next-end) (transpose-regions attr-beg (1+ attr-end) next-beg (1+ next-end)) ))) (defun web-mode-attribute-select (&optional pos) "Select the current html attribute." (interactive) (unless pos (setq pos (point))) (if (null (get-text-property pos 'tag-attr)) nil (goto-char pos) (web-mode-attribute-beginning) (set-mark (point)) (web-mode-attribute-end) (point) )) (defun web-mode-attribute-kill (&optional arg) "Kill the current html attribute." (interactive "p") (unless arg (setq arg 1)) (while (>= arg 1) (setq arg (1- arg)) (web-mode-attribute-select) (when mark-active (let ((beg (region-beginning)) (end (region-end))) (save-excursion (goto-char end) (when (looking-at "[ \n\t]*") (setq end (+ end (length (match-string-no-properties 0))))) ) ;save-excursion (kill-region beg end) ) ;let ) ;when ) ;while ) (defun web-mode-block-close (&optional pos) "Close the first unclosed control block." (interactive) (unless pos (setq pos (point))) (let ((continue t) (h (make-hash-table :test 'equal)) ctx ctrl n closing-block) (save-excursion (while (and continue (web-mode-block-previous)) (when (setq ctx (web-mode-block-is-control (point))) (setq ctrl (car ctx)) (setq n (gethash ctrl h 0)) (if (cdr ctx) (puthash ctrl (1+ n) h) (puthash ctrl (1- n) h)) (when (> (gethash ctrl h) 0) (setq continue nil)) ) ) ;while ) ;save-excursion (when (and (null continue) (setq closing-block (web-mode-closing-block ctrl))) (insert closing-block) (indent-according-to-mode) ;; (indent-for-tab-command) ) )) (defun web-mode-closing-block (type) (cond ((string= web-mode-engine "php") (concat "")) ((string= web-mode-engine "django") (concat "{% end" type " %}")) ((string= web-mode-engine "ctemplate") (concat "{{/" type "}}")) ((string= web-mode-engine "blade") (if (string= type "section") (concat "@show") (concat "@end" type))) ((string= web-mode-engine "dust") (concat "{/" type "}")) ((string= web-mode-engine "mako") (concat "% end" type)) ((string= web-mode-engine "closure") (concat "{/" type "}")) ((string= web-mode-engine "smarty") (concat "{/" type "}")) ((string= web-mode-engine "underscore") "<% } %>") ((string= web-mode-engine "lsp") "<% ) %>") ((string= web-mode-engine "erb") "<% } %>") ((string= web-mode-engine "erb") "<% end %>") ((string= web-mode-engine "go") "{{end}}") ((string= web-mode-engine "velocity") "#end") ((string= web-mode-engine "velocity") "#{end}") ((string= web-mode-engine "template-toolkit") "[% end %]") ((member web-mode-engine '("asp" "jsp")) (if (string-match-p "[:.]" type) (concat "") "<% } %>")) (t nil) ) ;cond ) ;;---- POSITION ---------------------------------------------------------------- (defun web-mode-comment-beginning-position (&optional pos) (unless pos (setq pos (point))) (car (web-mode-comment-boundaries pos))) (defun web-mode-comment-end-position (&optional pos) (unless pos (setq pos (point))) (cdr (web-mode-comment-boundaries pos))) (defun web-mode-part-opening-paren-position (pos &optional limit) (save-restriction (unless limit (setq limit nil)) (goto-char pos) (let* ((n -1) (paren (char-after)) (pairs '((?\) . "[)(]") (?\] . "[\]\[]") (?\} . "[}{]") (?\> . "[><]"))) (regexp (cdr (assoc paren pairs))) (continue (not (null regexp))) (counter 0)) (while (and continue (re-search-backward regexp limit t)) (cond ((> (setq counter (1+ counter)) 500) (message "part-opening-paren-position ** warning **") (setq continue nil)) ((or (web-mode-is-comment-or-string) (get-text-property (point) 'block-side)) ) ((eq (char-after) paren) (setq n (1- n))) (t (setq n (1+ n)) (setq continue (not (= n 0)))) ) ) ;while (if (= n 0) (point) nil) ))) (defun web-mode-closing-paren-position (&optional pos limit) (save-excursion (unless pos (setq pos (point))) (unless limit (setq limit nil)) (goto-char pos) (let* ((n 0) (block-side (and (get-text-property pos 'block-side) (not (string= web-mode-engine "razor")))) (paren (char-after)) (pairs '((?\( . "[)(]") (?\[ . "[\]\[]") (?\{ . "[}{]") (?\< . "[><]"))) (regexp (cdr (assoc paren pairs))) (continue (not (null regexp)))) (while (and continue (re-search-forward regexp limit t)) (cond ((or (web-mode-is-comment-or-string (1- (point))) (and block-side (not (get-text-property (point) 'block-side)))) ;;(message "pt=%S" (point)) ) ((eq (char-before) paren) (setq n (1+ n))) (t (setq n (1- n)) (setq continue (not (= n 0))) ) ) ;cond ) ;while (if (= n 0) (1- (point)) nil) ))) (defun web-mode-closing-delimiter-position (delimiter &optional pos limit) (unless pos (setq pos (point))) (unless limit (setq limit nil)) (save-excursion (goto-char pos) (setq pos nil) (let ((continue t)) (while (and continue (re-search-forward delimiter limit t)) (setq continue nil pos (1- (point))) ) ;while pos))) (defun web-mode-tag-match-position (&optional pos) (unless pos (setq pos (point))) (save-excursion (web-mode-tag-match pos) (if (= pos (point)) nil (point)))) (defun web-mode-tag-beginning-position (&optional pos) (unless pos (setq pos (point))) (let (beg end depth) (setq depth (get-text-property pos 'jsx-depth)) (when (and depth (get-text-property pos 'tag-attr-beg)) (setq depth (get-text-property (1- pos) 'jsx-depth))) (cond ((null pos) (setq end nil)) ((get-text-property pos 'tag-beg) (setq beg pos)) ((and (> pos 1) (get-text-property (1- pos) 'tag-beg)) (setq beg (1- pos))) ((get-text-property pos 'tag-type) (setq beg (previous-single-property-change pos 'tag-beg)) (when beg (setq beg (1- beg))) (cond ((not (get-text-property beg 'tag-beg)) (setq beg nil)) ((and depth (not (eq depth (get-text-property beg 'jsx-depth)))) (let ((continue (> beg (point-min)))) (while continue (setq beg (previous-single-property-change beg 'tag-beg)) (when beg (setq beg (1- beg))) (cond ((null beg) (setq continue nil)) ((not (get-text-property beg 'tag-beg)) (setq continue nil beg nil)) ((eq depth (get-text-property beg 'jsx-depth)) (setq continue nil)) ) ;cond ) ;while ) ;let ) ) ;cond ) (t (setq beg nil)) ) ;cond beg)) (defun web-mode-tag-end-position (&optional pos) (unless pos (setq pos (point))) (let (end depth) (setq depth (get-text-property pos 'jsx-depth)) (when (and depth (get-text-property pos 'tag-attr-beg)) (setq depth (get-text-property (1- pos) 'jsx-depth))) (cond ((null pos) (setq end nil)) ((get-text-property pos 'tag-end) (setq end pos)) ((get-text-property pos 'tag-type) (setq end (next-single-property-change pos 'tag-end)) (cond ((not (get-text-property end 'tag-end)) (setq end nil)) ((and depth (not (eq depth (get-text-property end 'jsx-depth)))) (let ((continue (< end (point-max)))) (while continue (setq end (1+ end)) (setq end (next-single-property-change end 'tag-end)) (cond ((null end) (setq continue nil)) ((not (get-text-property end 'tag-end)) (setq continue nil end nil)) ((eq depth (get-text-property end 'jsx-depth)) (setq continue nil)) ) ;cond ) ;while ) ;let ) ) ;cond ) (t (setq end nil)) ) ;cond end)) ;; TODO: prendre en compte jsx-depth (defun web-mode-tag-next-position (&optional pos limit) (unless pos (setq pos (point))) (unless limit (setq limit (point-max))) (cond ((or (>= pos (point-max)) (>= pos limit)) nil) (t (when (get-text-property pos 'tag-beg) (setq pos (1+ pos))) (setq pos (next-single-property-change pos 'tag-beg)) (if (and pos (<= pos limit)) pos nil)) )) ;; TODO: prendre en compte jsx-depth (defun web-mode-tag-previous-position (&optional pos limit) (unless pos (setq pos (point))) (unless limit (setq limit (point-min))) (cond ((or (<= pos (point-min)) (<= pos limit)) nil) (t (when (get-text-property pos 'tag-beg) (setq pos (1- pos))) (web-mode-go (previous-single-property-change pos 'tag-beg) -1)) )) ;; TODO: prendre en compte jsx-depth (defun web-mode-attribute-beginning-position (&optional pos) (unless pos (setq pos (point))) (cond ((null (get-text-property pos 'tag-attr)) nil) ((get-text-property pos 'tag-attr-beg) pos) (t (setq pos (previous-single-property-change pos 'tag-attr-beg)) (setq pos (1- pos))) )) ;; TODO: retoucher en incluant un param limit et en s'inspirant de ;; web-mode-attribute-next-position (defun web-mode-attribute-end-position (&optional pos) (unless pos (setq pos (point))) (let (end depth) (setq depth (get-text-property pos 'jsx-depth)) (cond ((null pos) (setq end nil)) ((get-text-property pos 'tag-attr-end) (setq end pos)) ((get-text-property pos 'tag-attr) (setq end (next-single-property-change pos 'tag-attr-end)) (cond ((not (get-text-property end 'tag-attr-end)) (setq end nil)) ((and depth (eq depth (get-text-property end 'jsx-depth)) (not (eq depth (get-text-property end 'jsx-end)))) ) ((and depth (eq (1+ depth) (get-text-property end 'jsx-depth))) ) ((and depth (not (eq (1+ depth) (get-text-property end 'jsx-depth)))) (let ((continue (< end (point-max)))) (while continue (setq end (1+ end)) (setq end (next-single-property-change end 'tag-attr-end)) (cond ((null end) (setq continue nil)) ((not (get-text-property end 'tag-attr-end)) (setq continue nil end nil)) ((eq (1+ depth) (get-text-property end 'jsx-depth)) (setq continue nil)) ) ;cond ) ;while ) ;let ) ) ;cond ) (t (setq end nil)) ) ;cond end)) (defun web-mode-attribute-next-position (&optional pos limit) (unless pos (setq pos (point))) (unless limit (setq limit (point-max))) (let (continue depth) (when (get-text-property pos 'tag-attr-beg) (setq pos (1+ pos))) (if (< pos limit) (setq continue t depth (get-text-property pos 'jsx-depth)) (setq continue nil pos nil)) (while continue (setq pos (next-single-property-change pos 'tag-attr-beg)) (cond ((null pos) (setq continue nil)) ((>= pos limit) (setq continue nil pos nil)) ((null depth) (setq continue nil)) ((eq depth (get-text-property pos 'jsx-depth)) (setq continue nil)) (t (setq pos (1+ pos) continue (< pos limit))) ) ) ;while pos)) (defun web-mode-attribute-previous-position (&optional pos limit) (unless pos (setq pos (point))) (unless limit (setq limit (point-min))) (let (continue depth) (when (get-text-property pos 'tag-attr-beg) (setq pos (1- pos))) (if (> pos limit) (setq continue t depth (get-text-property pos 'jsx-depth)) (setq continue nil pos nil)) (while continue (setq pos (previous-single-property-change pos 'tag-attr-beg)) (cond ((null pos) (setq continue nil)) ((< pos limit) (setq continue nil pos nil)) ((null depth) (setq continue nil)) ((eq depth (get-text-property pos 'jsx-depth)) (setq continue nil)) (t (setq pos (1- pos) continue (> pos limit))) ) ;cond ) ;while pos)) ;; TODO: prendre en compte jsx-depth (defun web-mode-element-beginning-position (&optional pos) (unless pos (setq pos (point))) (cond ((null (get-text-property pos 'tag-type)) (setq pos (web-mode-element-parent-position))) ((eq (get-text-property pos 'tag-type) 'end) (setq pos (web-mode-tag-match-position pos)) (setq pos (if (get-text-property pos 'tag-beg) pos nil))) ((member (get-text-property pos 'tag-type) '(start void)) (setq pos (web-mode-tag-beginning-position pos))) (t (setq pos nil)) ) ;cond pos) ;; TODO: prendre en compte jsx-depth (defun web-mode-element-end-position (&optional pos) (unless pos (setq pos (point))) (cond ((null (get-text-property pos 'tag-type)) (setq pos (web-mode-element-parent-position pos)) (when pos (setq pos (web-mode-tag-match-position pos)) (when pos (setq pos (web-mode-tag-end-position pos))) ) ) ((member (get-text-property pos 'tag-type) '(end void)) (setq pos (web-mode-tag-end-position pos)) ) ((member (get-text-property pos 'tag-type) '(start)) (setq pos (web-mode-tag-match-position pos)) (when pos (setq pos (web-mode-tag-end-position pos)))) (t (setq pos nil)) ) ;cond pos) (defun web-mode-element-child-position (&optional pos) (save-excursion (let (child close) (unless pos (setq pos (point))) (goto-char pos) (cond ((eq (get-text-property pos 'tag-type) 'start) (web-mode-tag-match) (setq close (point)) (goto-char pos) ) ((eq (get-text-property pos 'tag-type) 'void) ) ((eq (get-text-property pos 'tag-type) 'end) (web-mode-tag-beginning) (setq close (point)) (web-mode-tag-match) ) ((web-mode-element-parent-position pos) (setq pos (point)) (web-mode-tag-match) (setq close (point)) (goto-char pos) ) ) ;cond (when (and close (web-mode-element-next) (< (point) close)) (setq child (point)) ) child))) (defun web-mode-element-parent-position (&optional pos) (let (n tag-type tag-name (continue t) (tags (make-hash-table :test 'equal))) (save-excursion (if pos (goto-char pos)) (while (and continue (web-mode-tag-previous)) (setq pos (point) tag-type (get-text-property pos 'tag-type) tag-name (get-text-property pos 'tag-name) n (gethash tag-name tags 0)) (when (member tag-type '(end start)) (if (eq tag-type 'end) (puthash tag-name (1- n) tags) (puthash tag-name (1+ n) tags) (when (= n 0) (setq continue nil)) ) ;if ) ;when ) ;while ) ;save-excursion (if (null continue) pos nil))) (defun web-mode-element-previous-position (&optional pos limit) (unless pos (setq pos (point))) (unless limit (setq limit (point-min))) (save-excursion (goto-char pos) (let ((continue (not (bobp))) (props '(start void comment))) (while continue (setq pos (web-mode-tag-previous)) (cond ((or (null pos) (< (point) limit)) (setq continue nil pos nil)) ((member (get-text-property (point) 'tag-type) props) (setq continue nil)) ) ) ;while pos))) (defun web-mode-element-next-position (&optional pos limit) (unless pos (setq pos (point))) (unless limit (setq limit (point-max))) (save-excursion (goto-char pos) (let ((continue (not (eobp))) (props '(start void comment))) (while continue (setq pos (web-mode-tag-next)) (cond ((or (null pos) (> (point) limit)) (setq continue nil pos nil)) ((member (get-text-property (point) 'tag-type) props) (setq continue nil)) ) ) ;while ;; (message "pos=%S" pos) pos))) (defun web-mode-part-end-position (&optional pos) (unless pos (setq pos (point))) (cond ((member web-mode-content-type web-mode-part-content-types) (setq pos (point-max))) ((not (get-text-property pos 'part-side)) (setq pos nil)) ((= pos (point-max)) (setq pos nil)) ((not (get-text-property (1+ pos) 'part-side)) pos) (t (setq pos (next-single-property-change pos 'part-side))) ) ;cond pos) (defun web-mode-part-beginning-position (&optional pos) (unless pos (setq pos (point))) (cond ((member web-mode-content-type web-mode-part-content-types) (setq pos (point-min))) ((not (get-text-property pos 'part-side)) (setq pos nil)) ((= pos (point-min)) (setq pos nil)) ((not (get-text-property (1- pos) 'part-side)) pos) (t (setq pos (previous-single-property-change pos 'part-side))) ) ;cond pos) (defun web-mode-part-next-position (&optional pos) (unless pos (setq pos (point))) (cond ((and (= pos (point-min)) (get-text-property pos 'part-side)) ) ((not (get-text-property pos 'part-side)) (setq pos (next-single-property-change pos 'part-side))) ((and (setq pos (web-mode-part-end-position pos)) (>= pos (point-max))) (setq pos nil)) ((and (setq pos (1+ pos)) (not (get-text-property pos 'part-side))) (setq pos (next-single-property-change pos 'part-side))) ) ;cond pos) (defun web-mode-block-match-position (&optional pos) (unless pos (setq pos (point))) (save-excursion (web-mode-block-match pos) (if (= pos (point)) nil (point)))) (defun web-mode-block-control-previous-position (type &optional pos) (unless pos (setq pos (point))) (let ((continue t) controls) (while continue (setq pos (web-mode-block-previous-position pos)) (cond ((null pos) (setq continue nil pos nil)) ((and (setq controls (web-mode-block-controls-get pos)) (eq (car (car controls)) type)) (setq continue nil)) ) ;cond ) ;while pos)) ;; (defun web-mode-block-opening-paren-position2 (pos limit) ;; (save-excursion ;; (when (> limit pos) ;; (message "block-opening-paren-position: limit(%S) > pos(%S)" limit pos)) ;; (goto-char pos) ;; (let (c ;; n ;; pt ;; (continue (> pos limit)) ;; (pairs '((")" . "(") ;; ("]" . "[") ;; ("}" . "{"))) ;; (h (make-hash-table :test 'equal)) ;; (regexp "[\]\[)(}{]")) ;; (while (and continue (re-search-backward regexp limit t)) ;; (cond ;; ((web-mode-is-comment-or-string) ;; ) ;; (t ;; (setq c (string (char-after))) ;; (cond ;; ((member c '("(" "{" "[")) ;; (setq n (gethash c h 0)) ;; (if (= n 0) ;; (setq continue nil ;; pt (point)) ;; (puthash c (1+ n) h) ;; )) ;; (t ;; (setq c (cdr (assoc c pairs))) ;; (setq n (gethash c h 0)) ;; (puthash c (1- n) h)) ;; ) ;cond ;; ) ;t ;; ) ;cond ;; ) ;while ;; pt))) (defun web-mode-block-opening-paren-position (pos limit) (save-excursion (when (> limit pos) (message "block-opening-paren-position: limit(%S) > pos(%S)" limit pos)) (goto-char pos) (let (c n pt (continue (> pos limit)) (pairs '((?\) . ?\() (?\] . ?\[) (?\} . ?\{))) (h (make-hash-table :test 'equal)) (regexp "[\]\[)(}{]")) (while (and continue (re-search-backward regexp limit t)) (cond ((web-mode-is-comment-or-string) ) (t (setq c (char-after)) (cond ((member c '(?\( ?\{ ?\[)) (setq n (gethash c h 0)) (if (= n 0) (setq continue nil pt (point)) (puthash c (1+ n) h) )) (t (setq c (cdr (assoc c pairs))) (setq n (gethash c h 0)) (puthash c (1- n) h)) ) ;cond ) ;t ) ;cond ) ;while pt))) (defun web-mode-block-code-beginning-position (&optional pos) (unless pos (setq pos (point))) (when (and (setq pos (web-mode-block-beginning-position pos)) (eq (get-text-property pos 'block-token) 'delimiter-beg)) (setq pos (next-single-property-change pos 'block-token))) pos) (defun web-mode-block-beginning-position (&optional pos) (unless pos (setq pos (point))) (cond ((or (and (get-text-property pos 'block-side) (= pos (point-min))) (get-text-property pos 'block-beg)) ) ((and (> pos (point-min)) (get-text-property (1- pos) 'block-beg)) (setq pos (1- pos))) ((get-text-property pos 'block-side) (setq pos (previous-single-property-change pos 'block-beg)) (setq pos (if (and pos (> pos (point-min))) (1- pos) (point-min)))) (t (setq pos nil)) ) ;cond pos) (defun web-mode-block-string-beginning-position (pos &optional block-beg) (unless pos (setq pos (point))) (unless block-beg (setq block-beg (web-mode-block-beginning-position pos))) (let (char (ori pos) (continue (not (null pos)))) (while continue (setq char (char-after pos)) (cond ((< pos block-beg) (setq continue nil pos block-beg)) ((and (member (get-text-property pos 'block-token) '(string comment)) (eq (get-text-property pos 'block-token) (get-text-property (1- pos) 'block-token))) (setq pos (web-mode-block-token-beginning-position pos)) ) ((member char '(?\) ?\])) (setq pos (web-mode-block-opening-paren-position pos block-beg)) (setq pos (1- pos)) ) ((and (> ori pos) (member char '(?\( ?\= ?\[ ?\? ?\: ?\; ?\, ?\`))) (setq continue nil) (web-mode-looking-at ".[ \t\n]*" pos) (setq pos (+ pos (length (match-string-no-properties 0)))) ) ((web-mode-looking-back "\\_<\\(return\\|echo\\|include\\|print\\)[ \n\t]*" pos) (setq continue nil)) (t (setq pos (1- pos))) ) ;cond ) ;while ;;(message "pos=%S" pos) pos)) (defun web-mode-block-statement-beginning-position (pos &optional block-beg) (unless pos (setq pos (point))) (setq pos (1- pos)) (unless block-beg (setq block-beg (web-mode-block-beginning-position pos))) (let (char (continue (not (null pos)))) (while continue (setq char (char-after pos)) (cond ((< pos block-beg) (setq continue nil pos block-beg)) ((and (member (get-text-property pos 'block-token) '(string comment)) (eq (get-text-property pos 'block-token) (get-text-property (1- pos) 'block-token))) (setq pos (web-mode-block-token-beginning-position pos))) ((member char '(?\) ?\] ?\})) (setq pos (web-mode-block-opening-paren-position pos block-beg)) (setq pos (1- pos))) ((member char '(?\( ?\[ ?\{ ?\=)) (setq continue nil) (web-mode-looking-at ".[ \t\n]*" pos) (setq pos (+ pos (length (match-string-no-properties 0))))) ((web-mode-looking-back "\\_<\\(return\\|echo\\|include\\|print\\)[ \n\t]*" pos) (setq continue nil)) (t (setq pos (1- pos))) ) ;cond ) ;while pos)) (defun web-mode-block-args-beginning-position (pos &optional block-beg) (unless pos (setq pos (point))) (setq pos (1- pos)) ; #512 (unless block-beg (setq block-beg (web-mode-block-beginning-position pos))) (let (char (continue (not (null pos)))) (while continue (setq char (char-after pos)) (cond ((< pos block-beg) (message "block-args-beginning-position ** failure **") (setq continue nil pos block-beg)) ((and (member (get-text-property pos 'block-token) '(string comment)) (eq (get-text-property pos 'block-token) (get-text-property (1- pos) 'block-token))) (setq pos (web-mode-block-token-beginning-position pos))) ((member char '(?\) ?\] ?\})) (setq pos (web-mode-block-opening-paren-position pos block-beg)) (setq pos (1- pos))) ((member char '(?\( ?\[ ?\{)) (setq continue nil) (web-mode-looking-at ".[ \t\n]*" pos) (setq pos (+ pos (length (match-string-no-properties 0))))) ((and (string= web-mode-engine "php") (web-mode-looking-back "\\_<\\(extends\\|implements\\)[ \n\t]*" pos)) (setq continue nil)) (t (setq pos (1- pos))) ) ;cond ) ;while pos)) (defun web-mode-block-calls-beginning-position (pos &optional block-beg) (unless pos (setq pos (point))) (unless block-beg (setq block-beg (web-mode-block-beginning-position pos))) (let (char (continue (not (null pos)))) (while continue (setq char (char-after pos)) (cond ((< pos block-beg) (message "block-calls-beginning-position ** failure **") (setq continue nil pos block-beg)) ((and (member (get-text-property pos 'block-token) '(string comment)) (eq (get-text-property pos 'block-token) (get-text-property (1- pos) 'block-token))) (setq pos (web-mode-block-token-beginning-position pos))) ((member char '(?\) ?\])) (setq pos (web-mode-block-opening-paren-position pos block-beg)) (setq pos (1- pos))) ((member char '(?\( ?\[ ?\{ ?\} ?\= ?\? ?\: ?\; ?\,)) (setq continue nil) (web-mode-looking-at ".[ \t\n]*" pos) (setq pos (+ pos (length (match-string-no-properties 0))))) ((web-mode-looking-back "\\(return\\|else\\)[ \n\t]*" pos) (setq ;;pos (point) continue nil)) (t (setq pos (1- pos))) ) ;cond ) ;while pos)) (defun web-mode-javascript-string-beginning-position (pos &optional reg-beg) (unless pos (setq pos (point))) (let ((char nil) (blockside (get-text-property pos 'block-side)) (i 0) (continue (not (null pos)))) (unless reg-beg (if blockside (setq reg-beg (web-mode-block-beginning-position pos)) (setq reg-beg (web-mode-part-beginning-position pos))) ) (while continue (setq char (char-after pos)) (cond ((> (setq i (1+ i)) 20000) (message "javascript-string-beginning-position ** warning (%S) **" pos) (setq continue nil pos nil)) ((null pos) (message "javascript-string-beginning-position ** invalid pos **") (setq continue nil)) ((< pos reg-beg) (message "javascript-string-beginning-position ** failure **") (setq continue nil pos reg-beg)) ((and blockside (member (get-text-property pos 'block-token) '(string comment)) (eq (get-text-property pos 'block-token) (get-text-property (1- pos) 'block-token))) (setq pos (web-mode-block-token-beginning-position pos))) ((and (not blockside) (member (get-text-property pos 'part-token) '(string comment)) (eq (get-text-property pos 'part-token) (get-text-property (1- pos) 'part-token))) (setq pos (web-mode-part-token-beginning-position pos))) ((and (not blockside) (get-text-property pos 'block-side)) (when (setq pos (web-mode-block-beginning-position pos)) (setq pos (1- pos)))) ((member char '(?\) ?\] ?\})) (setq pos (web-mode-part-opening-paren-position pos reg-beg)) (setq pos (1- pos))) ((member char '(?\( ?\{ ?\[ ?\= ?\? ?\: ?\; ?\, ?\& ?\|)) (setq continue nil) (web-mode-looking-at ".[ \t\n]*" pos) (setq pos (+ pos (length (match-string-no-properties 0))))) ((web-mode-looking-back "\\(return\\)[ \n\t]*" pos) (setq continue nil)) (t (setq pos (1- pos))) ) ;cond ) ;while ;;(message "js-statement-beg:%S" pos) pos)) ;; TODO: reg-beg : jsx-beg ;; TODO: skipper les expr dont la depth est superieure ;; NOTE: blockside is useful for ejs (defun web-mode-javascript-statement-beginning-position (pos &optional reg-beg) (unless pos (setq pos (point))) (setq pos (1- pos)) (let ((char nil) (blockside (get-text-property pos 'block-side)) (i 0) (is-jsx (string= web-mode-content-type "jsx")) (depth-o nil) (depth-l nil) (continue (not (null pos)))) (setq depth-o (get-text-property pos 'jsx-depth)) (unless reg-beg (cond (blockside (setq reg-beg (web-mode-block-beginning-position pos))) (is-jsx (setq reg-beg (web-mode-jsx-depth-beginning-position pos))) (t (setq reg-beg (web-mode-part-beginning-position pos))) ) ;cond ) ;unless (while continue (setq char (char-after pos)) (cond ((> (setq i (1+ i)) 20000) (message "javascript-statement-beginning-position ** warning (%S) **" pos) (setq continue nil pos nil)) ((null pos) (message "javascript-statement-beginning-position ** invalid pos **") (setq continue nil)) ((< pos reg-beg) (when (not is-jsx) (message "javascript-statement-beginning-position ** failure **")) (setq continue nil pos reg-beg)) ((and is-jsx (progn (setq depth-l (get-text-property pos 'jsx-depth))) (not (eq depth-l depth-o))) ;;(message "%S > depth-o(%S) depth-l(%S)" pos depth-o depth-l) (setq pos (previous-single-property-change pos 'jsx-depth)) (setq pos (1- pos)) ;;(message "--> %S %S" pos (get-text-property pos 'jsx-depth)) ) ((and blockside (member (get-text-property pos 'block-token) '(string comment)) (eq (get-text-property pos 'block-token) (get-text-property (1- pos) 'block-token))) (setq pos (web-mode-block-token-beginning-position pos))) ((and (not blockside) (member (get-text-property pos 'part-token) '(string comment)) (eq (get-text-property pos 'part-token) (get-text-property (1- pos) 'part-token))) (setq pos (web-mode-part-token-beginning-position pos))) ((and (not blockside) (get-text-property pos 'block-side)) (when (setq pos (web-mode-block-beginning-position pos)) (setq pos (1- pos)))) ((member char '(?\) ?\] ?\})) (setq pos (web-mode-part-opening-paren-position pos reg-beg)) (setq pos (1- pos))) ((and (eq char ?\=) (web-mode-looking-back "[<>!=]+" pos reg-beg t)) (setq pos (- pos 1 (length (match-string-no-properties 0)))) ;;(setq pos (1- pos)) ;;(message "%S pos=%S" (match-string-no-properties 0) pos) ) ((member char '(?\( ?\{ ?\[ ?\=)) (setq continue nil) (web-mode-looking-at ".[ \t\n]*" pos) (setq pos (+ pos (length (match-string-no-properties 0))))) ((web-mode-looking-back "\\_<\\(return\\)[ \n\t]*" pos) (setq continue nil) (web-mode-looking-at "[ \t\n]*" pos) (setq pos (+ pos (length (match-string-no-properties 0))))) (t (setq pos (1- pos))) ) ;cond ) ;while ;;(message "%S -------" pos) pos)) (defun web-mode-javascript-args-beginning-position (pos &optional reg-beg) (unless pos (setq pos (point))) (setq pos (1- pos)) (let ((char nil) (blockside (get-text-property pos 'block-side)) (i 0) (continue (not (null pos)))) (unless reg-beg (if blockside (setq reg-beg (web-mode-block-beginning-position pos)) (setq reg-beg (web-mode-part-beginning-position pos))) ) (while continue (setq char (char-after pos)) (cond ((> (setq i (1+ i)) 20000) (message "javascript-args-beginning-position ** warning (%S) **" pos) (setq continue nil pos nil)) ((null pos) (message "javascript-args-beginning-position ** invalid pos **") (setq continue nil)) ((< pos reg-beg) (message "javascript-args-beginning-position ** failure **") (setq continue nil pos reg-beg)) ((and blockside (member (get-text-property pos 'block-token) '(string comment)) (eq (get-text-property pos 'block-token) (get-text-property (1- pos) 'block-token))) (setq pos (web-mode-block-token-beginning-position pos))) ((and (not blockside) (member (get-text-property pos 'part-token) '(string comment)) (eq (get-text-property pos 'part-token) (get-text-property (1- pos) 'part-token))) (setq pos (web-mode-part-token-beginning-position pos))) ((and (not blockside) (get-text-property pos 'block-side)) (when (setq pos (web-mode-block-beginning-position pos)) (setq pos (1- pos))) ) ((member char '(?\) ?\] ?\})) (when (setq pos (web-mode-part-opening-paren-position pos reg-beg)) (setq pos (1- pos)))) ((member char '(?\( ?\[ ?\{)) ;; (web-mode-looking-at ".[ \t\n]*" pos) (web-mode-looking-at ".[ ]*" pos) (setq pos (+ pos (length (match-string-no-properties 0))) continue nil) ;; (message "=>%S" pos) ) ((web-mode-looking-back "\\_<\\(var\\|let\\|return\\|const\\)[ \n\t]+" pos) ;; (web-mode-looking-at "[ \t\n]*" pos) (web-mode-looking-at "[ \t]*" pos) (setq pos (+ pos (length (match-string-no-properties 0))) continue nil)) (t (setq pos (1- pos))) ) ;cond ) ;while ;;(message "=%S" pos) pos)) (defun web-mode-javascript-calls-beginning-position (pos &optional reg-beg) (unless pos (setq pos (point))) (let ((char nil) (blockside (get-text-property pos 'block-side)) (i 0) (continue (not (null pos)))) (unless reg-beg (if blockside (setq reg-beg (web-mode-block-beginning-position pos)) (setq reg-beg (web-mode-part-beginning-position pos))) ) (while continue (setq char (char-after pos)) (cond ((> (setq i (1+ i)) 20000) (message "javascript-calls-beginning-position ** warning (%S) **" pos) (setq continue nil pos nil)) ((null pos) (message "javascript-calls-beginning-position ** invalid pos **") (setq continue nil)) ((< pos reg-beg) ;;(message "pos(%S) reg-beg(%S)" pos reg-beg) ;;(message "javascript-calls-beginning-position ** failure **") (setq continue nil pos reg-beg)) ((and blockside (member (get-text-property pos 'block-token) '(string comment)) (eq (get-text-property pos 'block-token) (get-text-property (1- pos) 'block-token))) (setq pos (web-mode-block-token-beginning-position pos))) ((and (not blockside) (member (get-text-property pos 'part-token) '(string comment)) (eq (get-text-property pos 'part-token) (get-text-property (1- pos) 'part-token))) (setq pos (web-mode-part-token-beginning-position pos))) ((and (not blockside) (get-text-property pos 'block-side)) (when (setq pos (web-mode-block-beginning-position pos)) (setq pos (1- pos)))) ((member char '(?\) ?\] ?\})) (when (setq pos (web-mode-part-opening-paren-position pos reg-beg)) (setq pos (1- pos)))) ((member char '(?\( ?\{ ?\[ ?\= ?\? ?\: ?\; ?\, ?\& ?\|)) (setq continue nil) (web-mode-looking-at ".[ \t\n]*" pos) (setq pos (+ pos (length (match-string-no-properties 0))))) ((web-mode-looking-back "\\_<\\(return\\|else\\)[ \n\t]*" pos) (setq continue nil)) (t (setq pos (1- pos))) ) ;cond ) ;while pos)) (defun web-mode-part-token-beginning-position (&optional pos) (unless pos (setq pos (point))) (cond ((not (get-text-property pos 'part-token)) nil) ((or (= pos (point-min)) (and (> pos (point-min)) (not (get-text-property (1- pos) 'part-token)))) pos) (t (setq pos (previous-single-property-change pos 'part-token)) (if (and pos (> pos (point-min))) pos (point-min))) )) (defun web-mode-part-token-end-position (&optional pos) (unless pos (setq pos (point))) (cond ((not (get-text-property pos 'part-token)) nil) ((or (= pos (point-max)) (not (get-text-property (1+ pos) 'part-token))) pos) (t (1- (next-single-property-change pos 'part-token))) )) (defun web-mode-block-token-beginning-position (&optional pos) (unless pos (setq pos (point))) (cond ((not (get-text-property pos 'block-token)) nil) ((or (= pos (point-min)) (and (> pos (point-min)) (not (get-text-property (1- pos) 'block-token)))) pos) (t (setq pos (previous-single-property-change pos 'block-token)) (if (and pos (> pos (point-min))) pos (point-min))) )) (defun web-mode-block-token-end-position (&optional pos) (unless pos (setq pos (point))) (cond ((not (get-text-property pos 'block-token)) nil) ((or (= pos (point-max)) (not (get-text-property (1+ pos) 'block-token))) pos) (t (1- (next-single-property-change pos 'block-token))) )) (defun web-mode-block-code-end-position (&optional pos) (unless pos (setq pos (point))) (setq pos (web-mode-block-end-position pos)) (cond ((not pos) nil) ((and (eq (get-text-property pos 'block-token) 'delimiter-end) (eq (get-text-property (1- pos) 'block-token) 'delimiter-end)) (previous-single-property-change pos 'block-token)) ((= pos (1- (point-max))) ;; TODO: comparer plutot avec line-end-position (point-max)) (t pos) )) (defun web-mode-block-end-position (&optional pos) (unless pos (setq pos (point))) (cond ((get-text-property pos 'block-end) pos) ((get-text-property pos 'block-side) (or (next-single-property-change pos 'block-end) (point-max))) (t nil) )) (defun web-mode-block-previous-position (&optional pos) (unless pos (setq pos (point))) (cond ((= pos (point-min)) (setq pos nil)) ((get-text-property pos 'block-side) (setq pos (web-mode-block-beginning-position pos)) (cond ((or (null pos) (= pos (point-min))) (setq pos nil) ) ((and (setq pos (previous-single-property-change pos 'block-beg)) (> pos (point-min))) (setq pos (1- pos)) ) ) ) ;block-side ((get-text-property (1- pos) 'block-side) (setq pos (web-mode-block-beginning-position (1- pos))) ) (t (setq pos (previous-single-property-change pos 'block-side)) (cond ((and (null pos) (get-text-property (point-min) 'block-beg)) (setq pos (point-min))) ((and pos (> pos (point-min))) (setq pos (web-mode-block-beginning-position (1- pos)))) ) ) ) ;conf pos) (defun web-mode-block-next-position (&optional pos limit) (unless pos (setq pos (point))) (unless limit (setq limit (point-max))) (cond ((and (get-text-property pos 'block-side) (setq pos (web-mode-block-end-position pos)) (< pos (point-max)) (setq pos (1+ pos))) (unless (get-text-property pos 'block-beg) (setq pos (next-single-property-change pos 'block-side))) ) (t (setq pos (next-single-property-change pos 'block-side))) ) ;cond (if (and pos (<= pos limit)) pos nil)) ;;---- EXCURSION --------------------------------------------------------------- (defun web-mode-backward-sexp (n) (interactive "p") (if (< n 0) (web-mode-forward-sexp (- n)) (let (pos) (dotimes (_ n) (skip-chars-backward "[:space:]") (setq pos (point)) (cond ((bobp) nil) ((get-text-property (1- pos) 'block-end) (backward-char 1) (web-mode-block-beginning)) ((get-text-property (1- pos) 'block-token) (backward-char 1) (web-mode-block-token-beginning)) ((get-text-property (1- pos) 'part-token) (backward-char 1) (web-mode-part-token-beginning)) ((get-text-property (1- pos) 'tag-end) (backward-char 1) (web-mode-element-beginning)) ((get-text-property (1- pos) 'tag-attr) (backward-char 1) (web-mode-attribute-beginning)) ((get-text-property (1- pos) 'tag-type) (backward-char 1) (web-mode-tag-beginning)) (t (let ((forward-sexp-function nil)) (backward-sexp)) ) ;case t ) ;cond ) ;dotimes ))) ;let if defun (defun web-mode-forward-sexp (n) (interactive "p") (if (< n 0) (web-mode-backward-sexp (- n)) (let (pos) (dotimes (_ n) (skip-chars-forward "[:space:]") (setq pos (point)) (cond ((eobp) nil) ((get-text-property pos 'block-beg) (web-mode-block-end)) ((get-text-property pos 'block-token) (web-mode-block-token-end)) ((get-text-property pos 'part-token) (web-mode-part-token-end)) ((get-text-property pos 'tag-beg) (web-mode-element-end)) ((get-text-property pos 'tag-attr) (web-mode-attribute-end)) ((get-text-property pos 'tag-type) (web-mode-tag-end)) (t (let ((forward-sexp-function nil)) (forward-sexp)) ) ;case t ) ;cond ) ;dotimes ))) ;let if defun (defun web-mode-comment-beginning () "Fetch current comment beg." (interactive) (web-mode-go (web-mode-comment-beginning-position (point)))) (defun web-mode-comment-end () "Fetch current comment end." (interactive) (web-mode-go (web-mode-comment-end-position (point)) 1)) (defun web-mode-tag-beginning () "Fetch current html tag beg." (interactive) (web-mode-go (web-mode-tag-beginning-position (point)))) (defun web-mode-tag-end () "Fetch current html tag end." (interactive) (web-mode-go (web-mode-tag-end-position (point)) 1)) (defun web-mode-tag-previous () "Fetch previous tag." (interactive) (web-mode-go (web-mode-tag-previous-position (point)))) (defun web-mode-tag-next () "Fetch next tag. Might be html comment or server tag (e.g. jsp)." (interactive) (web-mode-go (web-mode-tag-next-position (point)))) (defun web-mode-attribute-beginning () "Fetch html attribute beginning." (interactive) (web-mode-go (web-mode-attribute-beginning-position (point)))) (defun web-mode-attribute-end () "Fetch html attribute end." (interactive) (web-mode-go (web-mode-attribute-end-position (point)) 1)) (defun web-mode-attribute-next (&optional arg) "Fetch next attribute." (interactive "p") (unless arg (setq arg 1)) (cond ((= arg 1) (web-mode-go (web-mode-attribute-next-position (point)))) ((< arg 1) (web-mode-element-previous (* arg -1))) (t (while (>= arg 1) (setq arg (1- arg)) (web-mode-go (web-mode-attribute-next-position (point))) ) ) ) ) (defun web-mode-attribute-previous (&optional arg) "Fetch previous attribute." (interactive "p") (unless arg (setq arg 1)) (unless arg (setq arg 1)) (cond ((= arg 1) (web-mode-go (web-mode-attribute-previous-position (point)))) ((< arg 1) (web-mode-element-next (* arg -1))) (t (while (>= arg 1) (setq arg (1- arg)) (web-mode-go (web-mode-attribute-previous-position (point))) ) ) ) ) (defun web-mode-element-previous (&optional arg) "Fetch previous element." (interactive "p") (unless arg (setq arg 1)) (cond ((= arg 1) (web-mode-go (web-mode-element-previous-position (point)))) ((< arg 1) (web-mode-element-next (* arg -1))) (t (while (>= arg 1) (setq arg (1- arg)) (web-mode-go (web-mode-element-previous-position (point))) ) ;while ) ;t ) ;cond ) (defun web-mode-element-next (&optional arg) "Fetch next element." (interactive "p") (unless arg (setq arg 1)) (cond ((= arg 1) (web-mode-go (web-mode-element-next-position (point)))) ((< arg 1) (web-mode-element-previous (* arg -1))) (t (while (>= arg 1) (setq arg (1- arg)) (web-mode-go (web-mode-element-next-position (point))) ) ;while ) ;t ) ;cond ) (defun web-mode-element-sibling-next () "Fetch next sibling element." (interactive) (let ((pos (point))) (save-excursion (cond ((not (get-text-property pos 'tag-type)) (if (and (web-mode-element-parent) (web-mode-tag-match) (web-mode-element-next)) (setq pos (point)) (setq pos nil)) ) ((eq (get-text-property pos 'tag-type) 'start) (if (and (web-mode-tag-match) (web-mode-element-next)) (setq pos (point)) (setq pos nil)) ) ((web-mode-element-next) (setq pos (point))) (t (setq pos nil)) ) ;cond ) ;save-excursion (web-mode-go pos))) (defun web-mode-element-sibling-previous () "Fetch previous sibling element." (interactive) (let ((pos (point))) (save-excursion (cond ((not (get-text-property pos 'tag-type)) (if (and (web-mode-element-parent) (web-mode-tag-previous) (web-mode-element-beginning)) (setq pos (point)) (setq pos nil)) ) ((eq (get-text-property pos 'tag-type) 'start) (if (and (web-mode-tag-beginning) (web-mode-tag-previous) (web-mode-element-beginning)) (setq pos (point)) (setq pos nil)) ) ((and (web-mode-element-beginning) (web-mode-tag-previous) (web-mode-element-beginning)) (setq pos (point))) (t (setq pos nil)) ) ;cond ) ;save-excursion (web-mode-go pos))) (defun web-mode-element-beginning () "Move to beginning of element." (interactive) (web-mode-go (web-mode-element-beginning-position (point)))) (defun web-mode-element-end () "Move to end of element." (interactive) (web-mode-go (web-mode-element-end-position (point)) 1)) (defun web-mode-element-parent () "Fetch parent element." (interactive) (web-mode-go (web-mode-element-parent-position (point)))) (defun web-mode-element-child () "Fetch child element." (interactive) (web-mode-go (web-mode-element-child-position (point)))) (defun web-mode-dom-traverse () "Traverse html dom tree." (interactive) (cond ((web-mode-element-child) ) ((web-mode-element-sibling-next) ) ((and (web-mode-element-parent) (not (web-mode-element-sibling-next))) (goto-char (point-min))) (t (goto-char (point-min))) ) ;cond ) (defun web-mode-closing-paren (limit) (let ((pos (web-mode-closing-paren-position (point) limit))) (if (or (null pos) (> pos limit)) nil (goto-char pos) pos) )) (defun web-mode-part-next () "Move point to the beginning of the next part." (interactive) (web-mode-go (web-mode-part-next-position (point)))) (defun web-mode-part-beginning () "Move point to the beginning of the current part." (interactive) (web-mode-go (web-mode-part-beginning-position (point)))) (defun web-mode-part-end () "Move point to the end of the current part." (interactive) (web-mode-go (web-mode-part-end-position (point)) 1)) (defun web-mode-block-previous () "Move point to the beginning of the previous block." (interactive) (web-mode-go (web-mode-block-previous-position (point)))) (defun web-mode-block-next () "Move point to the beginning of the next block." (interactive) (web-mode-go (web-mode-block-next-position (point)))) (defun web-mode-block-beginning () "Move point to the beginning of the current block." (interactive) (web-mode-go (web-mode-block-beginning-position (point)))) (defun web-mode-block-end () "Move point to the end of the current block." (interactive) (web-mode-go (web-mode-block-end-position (point)) 1)) (defun web-mode-block-token-beginning () (web-mode-go (web-mode-block-token-beginning-position (point)))) (defun web-mode-block-token-end () (web-mode-go (web-mode-block-token-end-position (point)) 1)) (defun web-mode-part-token-beginning () (web-mode-go (web-mode-part-token-beginning-position (point)))) (defun web-mode-part-token-end () (web-mode-go (web-mode-part-token-end-position (point)) 1)) (defun web-mode-block-opening-paren (limit) (web-mode-go (web-mode-block-opening-paren-position (point) limit))) (defun web-mode-block-string-beginning (&optional pos block-beg) (unless pos (setq pos (point))) (unless block-beg (setq block-beg (web-mode-block-beginning-position pos))) (web-mode-go (web-mode-block-string-beginning-position pos block-beg))) (defun web-mode-block-statement-beginning (&optional pos block-beg) (unless pos (setq pos (point))) (unless block-beg (setq block-beg (web-mode-block-beginning-position pos))) (web-mode-go (web-mode-block-statement-beginning-position pos block-beg))) (defun web-mode-block-args-beginning (&optional pos block-beg) (unless pos (setq pos (point))) (unless block-beg (setq block-beg (web-mode-block-beginning-position pos))) (web-mode-go (web-mode-block-args-beginning-position pos block-beg))) (defun web-mode-block-calls-beginning (&optional pos block-beg) (unless pos (setq pos (point))) (unless block-beg (setq block-beg (web-mode-block-beginning-position pos))) (web-mode-go (web-mode-block-calls-beginning-position pos block-beg))) (defun web-mode-javascript-string-beginning (&optional pos reg-beg) (unless pos (setq pos (point))) (unless reg-beg (if (get-text-property pos 'block-side) (setq reg-beg (web-mode-block-beginning-position pos)) (setq reg-beg (web-mode-part-beginning-position pos)))) (web-mode-go (web-mode-javascript-string-beginning-position pos reg-beg))) (defun web-mode-javascript-statement-beginning (&optional pos reg-beg) (unless pos (setq pos (point))) (unless reg-beg (if (get-text-property pos 'block-side) (setq reg-beg (web-mode-block-beginning-position pos)) (setq reg-beg (web-mode-part-beginning-position pos)))) (web-mode-go (web-mode-javascript-statement-beginning-position pos reg-beg))) (defun web-mode-javascript-args-beginning (&optional pos reg-beg) (unless pos (setq pos (point))) (unless reg-beg (if (get-text-property pos 'block-side) (setq reg-beg (web-mode-block-beginning-position pos)) (setq reg-beg (web-mode-part-beginning-position pos)))) (web-mode-go (web-mode-javascript-args-beginning-position pos reg-beg))) (defun web-mode-javascript-calls-beginning (&optional pos reg-beg) (unless pos (setq pos (point))) (unless reg-beg (if (get-text-property pos 'block-side) (setq reg-beg (web-mode-block-beginning-position pos)) (setq reg-beg (web-mode-part-beginning-position pos)))) (web-mode-go (web-mode-javascript-calls-beginning-position pos reg-beg))) (defun web-mode-go (pos &optional offset) (unless offset (setq offset 0)) (when pos (cond ((and (> offset 0) (<= (+ pos offset) (point-max))) (setq pos (+ pos offset))) ((and (< offset 0) (>= (+ pos offset) (point-min))) (setq pos (+ pos offset))) ) ;cond (goto-char pos)) pos) ;;---- SEARCH ------------------------------------------------------------------ (defun web-mode-rsf-balanced (regexp-open regexp-close &optional limit noerror) (unless noerror (setq noerror t)) (let ((continue t) (level 1) (pos (point)) ret (regexp (concat regexp-open "\\|" regexp-close))) (while continue (setq ret (re-search-forward regexp limit noerror)) (cond ((null ret) (setq continue nil) ) (t (if (string-match-p regexp-open (match-string-no-properties 0)) (setq level (1+ level)) (setq level (1- level))) (when (< level 1) (setq continue nil) ) ) ;t ) ;cond ) ;while (when (not (= level 0)) (goto-char pos)) ret)) (defun web-mode-block-sb (expr &optional limit noerror) (unless limit (setq limit (web-mode-block-beginning-position (point)))) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (search-backward expr limit noerror)) (when (or (null ret) (not (get-text-property (point) 'block-token))) (setq continue nil) ) ;when ) ;while ret)) (defun web-mode-block-sf (expr &optional limit noerror) (unless limit (setq limit (web-mode-block-end-position (point)))) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (search-forward expr limit noerror)) (when (or (null ret) (not (get-text-property (point) 'block-token))) (setq continue nil) ) ;when ) ;while ret)) (defun web-mode-block-rsb (regexp &optional limit noerror) (unless limit (setq limit (web-mode-block-beginning-position (point)))) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (re-search-backward regexp limit noerror)) (when (or (null ret) (not (get-text-property (point) 'block-token))) (setq continue nil) ) ;when ) ;while ret)) (defun web-mode-block-rsf (regexp &optional limit noerror) (unless limit (setq limit (web-mode-block-end-position (point)))) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (re-search-forward regexp limit noerror)) (when (or (null ret) (not (get-text-property (point) 'block-token))) (setq continue nil) ) ;when ) ;while ret)) (defun web-mode-part-sb (expr &optional limit noerror) (unless limit (setq limit (web-mode-part-beginning-position (point)))) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (search-backward expr limit noerror)) (when (or (null ret) (and (not (get-text-property (point) 'part-token)) (not (get-text-property (point) 'block-side))) ) (setq continue nil) ) ;when ) ;while ret)) (defun web-mode-part-sf (expr &optional limit noerror) (unless limit (setq limit (web-mode-part-end-position (point)))) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (search-forward expr limit noerror)) (when (or (null ret) (and (not (get-text-property (point) 'part-token)) (not (get-text-property (point) 'block-side))) ) (setq continue nil) ) ;when ) ;while ret)) (defun web-mode-part-rsb (regexp &optional limit noerror) (unless limit (setq limit (web-mode-part-beginning-position (point)))) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (re-search-backward regexp limit noerror)) (when (or (null ret) (and (not (get-text-property (point) 'part-token)) (not (get-text-property (point) 'block-side))) ) (setq continue nil) ) ;when ) ;while ret)) (defun web-mode-part-rsf (regexp &optional limit noerror) (unless limit (setq limit (web-mode-part-end-position (point)))) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (re-search-forward regexp limit t)) (when (or (null ret) (and (not (get-text-property (point) 'part-token)) (not (get-text-property (point) 'block-side))) ) (setq continue nil) ) ;when ) ;while ret)) (defun web-mode-javascript-rsb (regexp &optional limit noerror) (unless limit (setq limit (web-mode-part-beginning-position (point)))) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (re-search-backward regexp limit noerror)) (when (or (null ret) (and (not (get-text-property (point) 'part-token)) (not (get-text-property (point) 'block-side)) (not (get-text-property (point) 'jsx-depth))) ) (setq continue nil) ) ;when ) ;while ret)) (defun web-mode-javascript-rsf (regexp &optional limit noerror) (unless limit (setq limit (web-mode-part-end-position (point)))) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (re-search-forward regexp limit t)) (when (or (null ret) (and (not (get-text-property (point) 'part-token)) (not (get-text-property (point) 'block-side)) (not (get-text-property (point) 'jsx-depth))) ) (setq continue nil) ) ;when ) ;while ret)) (defun web-mode-dom-sf (expr &optional limit noerror) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (search-forward expr limit noerror)) (if (or (null ret) (not (get-text-property (- (point) (length expr)) 'block-side))) (setq continue nil)) ) ret)) (defun web-mode-dom-rsf (regexp &optional limit noerror) (unless noerror (setq noerror t)) (let ((continue t) (ret nil)) (while continue (setq ret (re-search-forward regexp limit noerror)) ;; (message "ret=%S point=%S limit=%S i=%S" ret (point) limit 0) (cond ((null ret) (setq continue nil)) ((or (get-text-property (match-beginning 0) 'block-side) (get-text-property (match-beginning 0) 'part-token)) ) (t (setq continue nil)) ) ;cond ) ;while ret)) (defun web-mode-rsb (regexp &optional limit noerror) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (re-search-backward regexp limit noerror)) (if (or (null ret) (not (web-mode-is-comment-or-string))) (setq continue nil))) ret)) (defun web-mode-rsf (regexp &optional limit noerror) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (re-search-forward regexp limit noerror)) (if (or (null ret) (not (web-mode-is-comment-or-string))) (setq continue nil)) ) ret)) (defun web-mode-sb (expr &optional limit noerror) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (search-backward expr limit noerror)) (if (or (null ret) (not (web-mode-is-comment-or-string))) (setq continue nil))) ret)) (defun web-mode-sf (expr &optional limit noerror) (unless noerror (setq noerror t)) (let ((continue t) ret) (while continue (setq ret (search-forward expr limit noerror)) (if (or (null ret) (not (web-mode-is-comment-or-string))) (setq continue nil))) ret)) (defun web-mode-content-rsf (regexp &optional limit noerror) (unless noerror (setq noerror t)) (let ((continue t) ret beg end) (while continue (setq ret (re-search-forward regexp limit noerror) beg (if (null ret) (point) (match-beginning 0)) end (if (null ret) (point) (1- (match-end 0)))) (if (or (null ret) (and (web-mode-is-content beg) (web-mode-is-content end))) (setq continue nil))) ret)) ;;---- ADVICES ----------------------------------------------------------------- (defadvice ac-start (before web-mode-set-up-ac-sources activate) "Set `ac-sources' based on current language before running auto-complete." (when (equal major-mode 'web-mode) ;; set ignore each time to nil. User has to implement a hook to change it ;; for each completion (setq web-mode-ignore-ac-start-advice nil) (run-hooks 'web-mode-before-auto-complete-hooks) (unless web-mode-ignore-ac-start-advice (when web-mode-ac-sources-alist (let ((new-web-mode-ac-sources (assoc (web-mode-language-at-pos) web-mode-ac-sources-alist))) (setq ac-sources (cdr new-web-mode-ac-sources))))))) ;;---- MINOR MODE ADDONS ------------------------------------------------------- (defun web-mode-yasnippet-exit-hook () "Yasnippet exit hook" (when (and (boundp 'yas-snippet-beg) (boundp 'yas-snippet-end)) (indent-region yas-snippet-beg yas-snippet-end))) (defun web-mode-imenu-index () (interactive) "Returns imenu items." (let (toc-index line) (save-excursion (goto-char (point-min)) (while (not (eobp)) (setq line (buffer-substring-no-properties (line-beginning-position) (line-end-position))) (let (found (i 0) item regexp type type-idx content content-idx content-regexp close-tag-regexp concat-str jumpto str) (while (and (not found ) (< i (length web-mode-imenu-regexp-list))) (setq item (nth i web-mode-imenu-regexp-list)) (setq regexp (nth 0 item)) (setq type-idx (nth 1 item)) (setq content-idx (nth 2 item)) (setq concat-str (nth 3 item)) (when (not (numberp content-idx)) (setq content-regexp (nth 2 item) close-tag-regexp (nth 4 item) content-idx nil)) (when (string-match regexp line) (cond (content-idx (setq type (match-string type-idx line)) (setq content (match-string content-idx line)) (setq str (concat type concat-str content)) (setq jumpto (line-beginning-position))) (t (let (limit) (setq type (match-string type-idx line)) (goto-char (line-beginning-position)) (save-excursion (setq limit (re-search-forward close-tag-regexp (point-max) t))) (when limit (when (re-search-forward content-regexp limit t) (setq content (match-string 1)) (setq str (concat type concat-str content)) (setq jumpto (line-beginning-position)) ) ))) ) (when str (setq toc-index (cons (cons str jumpto) toc-index) ) (setq found t)) ) (setq i (1+ i)))) (forward-line) (goto-char (line-end-position)) ;; make sure we are at eobp )) (nreverse toc-index))) ;;---- UNIT TESTING ------------------------------------------------------------ (defun web-mode-test () "Executes web-mode unit tests. See `web-mode-tests-directory'." (interactive) (let (files ret regexp) (setq regexp "^[[:alnum:]][[:alnum:]._]+\\'") (setq files (directory-files web-mode-tests-directory t regexp)) (dolist (file files) (cond ((eq (string-to-char (file-name-nondirectory file)) ?\_) (delete-file file)) (t (setq ret (web-mode-test-process file))) ) ;cond ) ;dolist )) (defun web-mode-test-process (file) (with-temp-buffer (let (out sig1 sig2 success err) (setq-default indent-tabs-mode nil) (if (string-match-p "sql" file) (setq web-mode-enable-sql-detection t) (setq web-mode-enable-sql-detection nil)) (insert-file-contents file) (set-visited-file-name file) (web-mode) (setq sig1 (md5 (current-buffer))) (delete-horizontal-space) (while (not (eobp)) (forward-line) (delete-horizontal-space) (end-of-line)) (web-mode-buffer-indent) (setq sig2 (md5 (current-buffer))) (setq success (string= sig1 sig2)) (setq out (concat (if success "ok" "ko") " : " (file-name-nondirectory file))) (message out) (setq err (concat (file-name-directory file) "_err." (file-name-nondirectory file))) (if success (when (file-readable-p err) (delete-file err)) (write-file err) (message "[%s]" (buffer-string)) ) ;if out))) ;;---- MISC -------------------------------------------------------------------- (defun web-mode-set-engine (engine) "Set the engine for the current buffer." (interactive (list (completing-read "Engine: " (let (engines) (dolist (elt web-mode-engines) (setq engines (append engines (list (car elt))))) engines)))) (setq web-mode-content-type "html" web-mode-engine (web-mode-engine-canonical-name engine) web-mode-minor-engine engine) (web-mode-on-engine-setted) (web-mode-buffer-highlight)) (defun web-mode-set-content-type (content-type) "Set the content-type for the current buffer" (interactive (list (completing-read "Content-type: " web-mode-part-content-types))) (setq web-mode-content-type content-type) (when (called-interactively-p 'any) ) (web-mode-buffer-highlight)) (defun web-mode-on-engine-setted () (let (elt elts engines) (when (string= web-mode-engine "razor") (setq web-mode-enable-block-face t)) (setq web-mode-engine-attr-regexp (cdr (assoc web-mode-engine web-mode-engine-attr-regexps))) (setq web-mode-engine-token-regexp (cdr (assoc web-mode-engine web-mode-engine-token-regexps))) ;;(message "%S %S" web-mode-engine-attr-regexp web-mode-engine) (when (null web-mode-minor-engine) (setq web-mode-minor-engine "none")) (setq elt (assoc web-mode-engine web-mode-engine-open-delimiter-regexps)) (if elt (setq web-mode-block-regexp (cdr elt)) (setq web-mode-engine "none")) (unless (boundp 'web-mode-extra-auto-pairs) (setq web-mode-extra-auto-pairs nil)) (setq web-mode-auto-pairs (append (cdr (assoc web-mode-engine web-mode-engines-auto-pairs)) (cdr (assoc nil web-mode-engines-auto-pairs)) (cdr (assoc web-mode-engine web-mode-extra-auto-pairs)) (cdr (assoc nil web-mode-extra-auto-pairs)))) (unless (boundp 'web-mode-extra-snippets) (setq web-mode-extra-snippets nil)) (setq elts (append (cdr (assoc web-mode-engine web-mode-extra-snippets)) (cdr (assoc nil web-mode-extra-snippets)) (cdr (assoc web-mode-engine web-mode-engines-snippets)) (cdr (assoc nil web-mode-engines-snippets)))) (dolist (elt elts) (unless (assoc (car elt) web-mode-snippets) (setq web-mode-snippets (append (list elt) web-mode-snippets))) ) (setq web-mode-engine-font-lock-keywords (symbol-value (cdr (assoc web-mode-engine web-mode-engines-font-lock-keywords)))) (when (and (string= web-mode-minor-engine "jinja") (not (member "endtrans" web-mode-django-control-blocks))) (add-to-list 'web-mode-django-control-blocks "endtrans") (setq web-mode-django-control-blocks-regexp (regexp-opt web-mode-django-control-blocks t)) ) ;; (message "%S" (symbol-value (cdr (assoc web-mode-engine web-mode-engines-font-lock-keywords)))) )) (defun web-mode-detect-engine () (save-excursion (goto-char (point-min)) (when (re-search-forward "-\\*- engine:[ ]*\\([[:alnum:]-]+\\)[ ]*-\\*-" web-mode-chunk-length t) (setq web-mode-minor-engine (match-string-no-properties 1)) (setq web-mode-engine (web-mode-engine-canonical-name web-mode-minor-engine))) web-mode-minor-engine)) (defun web-mode-guess-engine-and-content-type () (let (buff-name elt found) (setq buff-name (buffer-file-name)) (unless buff-name (setq buff-name (buffer-name))) (setq web-mode-is-scratch (string= buff-name "*scratch*")) (setq web-mode-content-type nil) (when (boundp 'web-mode-content-types-alist) (setq found nil) (dolist (elt web-mode-content-types-alist) (when (and (not found) (string-match-p (cdr elt) buff-name)) (setq web-mode-content-type (car elt) found t)) ) ;dolist ) ;when (unless web-mode-content-type (setq found nil) (dolist (elt web-mode-content-types) (when (and (not found) (string-match-p (cdr elt) buff-name)) (setq web-mode-content-type (car elt) found t)) ) ;dolist ) ;unless (when (boundp 'web-mode-engines-alist) (setq found nil) (dolist (elt web-mode-engines-alist) (cond ((stringp (cdr elt)) (when (string-match-p (cdr elt) buff-name) (setq web-mode-engine (car elt)))) ((functionp (cdr elt)) (when (funcall (cdr elt)) (setq web-mode-engine (car elt)))) ) ;cond ) ;dolist ) ;when (unless web-mode-engine (setq found nil) (dolist (elt web-mode-engine-file-regexps) ;;(message "%S %S" (cdr elt) buff-name) (when (and (not found) (string-match-p (cdr elt) buff-name)) (setq web-mode-engine (car elt) found t)) ) ) (when (and (or (null web-mode-engine) (string= web-mode-engine "none")) (string-match-p "php" (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) (setq web-mode-engine "php")) (when (and (string= web-mode-content-type "javascript") (string-match-p "@jsx" (buffer-substring-no-properties (point-min) (if (< (point-max) web-mode-chunk-length) (point-max) web-mode-chunk-length) ))) (setq web-mode-content-type "jsx")) (when web-mode-engine (setq web-mode-minor-engine web-mode-engine web-mode-engine (web-mode-engine-canonical-name web-mode-engine)) ) (when (and (or (null web-mode-engine) (string= web-mode-engine "none")) web-mode-enable-engine-detection) (web-mode-detect-engine)) (web-mode-on-engine-setted) )) (defun web-mode-engine-canonical-name (name) (let (engine) (cond ((null name) nil) ((assoc name web-mode-engines) name) (t (dolist (elt web-mode-engines) (when (and (null engine) (member name (cdr elt))) (setq engine (car elt))) ) ;dolist engine) ))) (defun web-mode-on-after-save () (when web-mode-is-scratch (web-mode-guess-engine-and-content-type) (web-mode-buffer-highlight)) nil) (defun web-mode-on-exit () (web-mode-with-silent-modifications (put-text-property (point-min) (point-max) 'invisible nil) (remove-overlays) (remove-hook 'change-major-mode-hook 'web-mode-on-exit t) )) (defun web-mode-reload () "Reload web-mode." (interactive) (web-mode-with-silent-modifications (put-text-property (point-min) (point-max) 'invisible nil) (remove-overlays) (setq font-lock-unfontify-region-function 'font-lock-default-unfontify-region) (load "web-mode.el") (setq web-mode-change-beg nil web-mode-change-end nil) (web-mode) )) (defun web-mode-trace (msg) (let (sub) ;; (when (null web-mode-time) (setq web-mode-time (current-time))) (setq sub (time-subtract (current-time) web-mode-time)) (when nil (save-excursion (let ((n 0)) (goto-char (point-min)) (while (web-mode-tag-next) (setq n (1+ n)) ) (message "%S tags found" n) ))) (message "%18s: time elapsed = %Ss %9Sµs" msg (nth 1 sub) (nth 2 sub)) )) (defun web-mode-reveal () "Display text properties at point." (interactive) (let (symbols out) (setq out (format "[point=%S engine=%S minor=%S content-type=%S language-at-pos=%S]\n" (point) web-mode-engine web-mode-minor-engine web-mode-content-type (web-mode-language-at-pos (point)))) (setq symbols (append web-mode-scan-properties '(font-lock-face face))) (dolist (symbol symbols) (when symbol (setq out (concat out (format "%s(%S) " (symbol-name symbol) (get-text-property (point) symbol))))) ) (message "%s\n" out) ;;(message "syntax-class=%S" (syntax-class (syntax-after (point)))) (message nil))) (defun web-mode-debug () "Display informations useful for debugging." (interactive) (let ((modes nil) (customs '(web-mode-enable-current-column-highlight web-mode-enable-current-element-highlight indent-tabs-mode)) (ignore '(abbrev-mode auto-composition-mode auto-compression-mode auto-encryption-mode auto-insert-mode blink-cursor-mode column-number-mode delete-selection-mode display-time-mode electric-indent-mode file-name-shadow-mode font-lock-mode global-font-lock-mode global-hl-line-mode line-number-mode menu-bar-mode mouse-wheel-mode recentf-mode show-point-mode tool-bar-mode tooltip-mode transient-mark-mode))) (message "\n") (message "--- WEB-MODE DEBUG BEG ---") (message "versions: emacs(%S.%S) web-mode(%S)" emacs-major-version emacs-minor-version web-mode-version) (message "vars: engine(%S) minor(%S) content-type(%S) file(%S)" web-mode-engine web-mode-minor-engine web-mode-content-type (or (buffer-file-name) (buffer-name))) (message "system: window(%S) config(%S)" window-system system-configuration) (message "colors: fg(%S) bg(%S) " (cdr (assoc 'foreground-color default-frame-alist)) (cdr (assoc 'background-color default-frame-alist))) (mapc (lambda (mode) (condition-case nil (if (and (symbolp mode) (symbol-value mode) (not (member mode ignore))) (add-to-list 'modes mode)) (error nil)) ) ;lambda minor-mode-list) (message "minor modes: %S" modes) (message "vars:") (dolist (custom customs) (message (format "%s=%S " (symbol-name custom) (symbol-value custom)))) (message "--- WEB-MODE DEBUG END ---") (switch-to-buffer "*Messages*") (goto-char (point-max)) (recenter) )) (provide 'web-mode) ;;; web-mode.el ends here ;; Local Variables: ;; coding: utf-8 ;; indent-tabs-mode: nil ;; End: