diff --git a/.bashrc b/.bashrc new file mode 100644 index 0000000..ba2705b --- /dev/null +++ b/.bashrc @@ -0,0 +1,154 @@ +# Oklomsy's .bashrc file +# Includes snippets from the following sites: +# https://gitlab.com/FallFur/config-files-bashrc-vimrc/-/blob/master/.bashrc +# https://gitlab.com/dwarmstrong/dotfiles/blob/master/.bashrc +# https://gitlab.com/only_vip/mxtest-dope-dots/-/blob/master/.bashrc +# http://bashrcgenerator.com/ + +# If not running interactively, don't do anything +case $- in + *i*) ;; + *) return;; +esac +# Colour codes +red='\[\e[0;31m\]' +RED='\[\e[1;31m\]' +blue='\[\e[0;34m\]' +BLUE='\[\e[1;34m\]' +cyan='\[\e[0;36m\]' +CYAN='\[\e[1;36m\]' +green='\[\e[0;32m\]' +GREEN='\[\e[1;32m\]' +yellow='\[\e[0;33m\]' +YELLOW='\[\e[1;33m\]' +PURPLE='\[\e[1;35m\]' +purple='\[\e[0;35m\]' +nc='\[\e[0m\]' +WHITE="\\[\\e[1;37m\\]" +RESET="\\[\\e[0m\\]" + +# (Un)mount usb devices +mu() { sudo mountusb -m $1 ; } +umu() { sudo mountusb -u $1 ; } +# LUKS-encrypted usb device +muc() { sudo cryptset -o $1 && sudo mountusb -m $1 ; } +umuc() { sudo mountusb -u $1 && sudo cryptset -c $1 ; } + + +# don't put duplicate lines or lines starting with space in the history. +# See bash(1) for more options +HISTCONTROL=ignoreboth:ignoredups:erasedups + +# Unlimited history +HISTSIZE= +HISTFILESIZE= + +# Change the history file location because certain bash sessions truncate +# ~/.bash_history upon close +HISTFILE=~/.bash_unlimited_history + +# After each command, append to the history file and reread it +PROMPT_COMMAND="${PROMPT_COMMAND:+$PROMPT_COMMAND$'\n'}history -a; history -c; history -r" + +# Append to the history file, don't overwrite it. +shopt -s histappend + +# Set colours +eval `dircolors` + +# check the window size after each command and, if necessary, +# update the values of LINES and COLUMNS. +shopt -s checkwinsize + +### Useful aliases + +alias aaa="sudo apt update && apt list --upgradable && sudo apt full-upgrade && sudo apt-get autoclean && sudo apt autoremove" +alias shutdown="/usr/sbin/shutdown now" +alias suspend="systemctl suspend" +alias reboot="/usr/sbin/shutdown -r now" +alias hibernate="systemctl hibernate" +alias ls="exa" +alias x="exit" +alias cat="bat" + +# enable programmable completion features (you don't need to enable +# this, if it's already enabled in /etc/bash.bashrc and /etc/profile +# sources /etc/bash.bashrc). +if ! shopt -oq posix; then + if [ -f /usr/share/bash-completion/bash_completion ]; then + . /usr/share/bash-completion/bash_completion + elif [ -f /etc/bash_completion ]; then + . /etc/bash_completion + fi +fi + + +# set variable identifying the chroot you work in. +if [ -z "${debian_chroot:-}" ] && [ -r /etc/debian_chroot ]; then + debian_chroot=$(cat /etc/debian_chroot) +fi + +# uncomment for a colored prompt, if the terminal has the capability; turned +# off by default to not distract the user: the focus in a terminal window +# should be on the output of commands, not on the prompt +force_color_prompt=yes + +if [ -n "$force_color_prompt" ]; then + if [ -x /usr/bin/tput ] && tput setaf 1 >&/dev/null; then + # We have color support; assume it's compliant with Ecma-48 + # (ISO/IEC-6429). (Lack of such support is extremely rare, and such + # a case would tend to support setf rather than setaf.) + color_prompt=yes + else + color_prompt= + fi +fi + +if [ "$color_prompt" = yes ]; then + PS1='${debian_chroot:+($debian_chroot)}\[\033[01;32m\]\u@\h\[\033[00m\]:\[\033[01;34m\]\w\[\033[00m\]\$ ' +else + PS1='${debian_chroot:+($debian_chroot)}\u@\h:\w\$ ' +fi +unset color_prompt force_color_prompt + +# color GCC warning and errors +export GCC_COLORS='error=01;31:warning=01;35:note=01;36:caret=01;32:locus=01:quote=01' + +# Separate aliases file... I don't need it now but maybe later. +if [ -f ~/.bash_aliases ]; then + . ~/.bash_aliases +fi + +# Add sbin directories to PATH. This is useful on systems that have sudo +echo $PATH | grep -Eq "(^|:)/sbin(:|)" || PATH=$PATH:/sbin +echo $PATH | grep -Eq "(^|:)/usr/sbin(:|)" || PATH=$PATH:/usr/sbin + + +# Archive extraction (Usage: ex ) +ex () +{ + if [ -f $1 ] ; then + case $1 in + *.tar.bz2) tar xjf $1 ;; + *.tar.gz) tar xzf $1 ;; + *.bz2) bunzip2 $1 ;; + *.rar) unrar x $1 ;; + *.gz) gunzip $1 ;; + *.tar) tar xf $1 ;; + *.tbz2) tar xjf $1 ;; + *.tgz) tar xzf $1 ;; + *.zip) unzip $1 ;; + *.Z) uncompress $1;; + *.7z) 7z x $1 ;; + *.deb) ar x $1 ;; + *.tar.xz) tar xf $1 ;; + *.tar.zst) unzstd $1 ;; + *) echo "'$1' cannot be extracted via ex()" ;; + esac + else + echo "'$1' is not a valid file" + fi +} + + +export PS1="\[\033[38;5;13m\]\u\[$(tput sgr0)\]@\[$(tput sgr0)\]\[\033[38;5;14m\]\H\[$(tput sgr0)\]:\[$(tput sgr0)\]\[\033[38;5;10m\][\w]\[$(tput sgr0)\]:\[$(tput sgr0)\]\[\033[38;5;11m\]\\$\[$(tput sgr0)\] " diff --git a/.bg.jpg b/.bg.jpg new file mode 100644 index 0000000..adb30c8 Binary files /dev/null and b/.bg.jpg differ diff --git a/.config/openbox/autostart b/.config/openbox/autostart new file mode 100755 index 0000000..3c5691d --- /dev/null +++ b/.config/openbox/autostart @@ -0,0 +1,40 @@ +# System-wide support stuff +. $GLOBALAUTOSTART & + +# Compositor +compton & + +# Pulseaudio insanity +pulseaudio --kill & +/usr/sbin/alsactl restore & +pulseaudio --start & + +# Networking +nm-applet & + +# Restore background. +nitrogen --restore & + +# Screensaver +xscreensaver -no-splash & + +# Clock, panel, everything. +tint2 & + +# Notifications +dunst & + +# Power manager +xfce4-power-manager & + +# Clipboard +parcellite & + +# Volume manager +pnmixer & + +# Gnome Keyring +gnome-keyring-daemon -r & + +# Play startup audio +mplayer ~/.config/openbox/login.ogg diff --git a/.config/openbox/login.ogg b/.config/openbox/login.ogg new file mode 100755 index 0000000..a8325cc Binary files /dev/null and b/.config/openbox/login.ogg differ diff --git a/.config/openbox/menu.xml b/.config/openbox/menu.xml new file mode 100644 index 0000000..fd16d80 --- /dev/null +++ b/.config/openbox/menu.xml @@ -0,0 +1,3 @@ + + + diff --git a/.config/openbox/obamenu.py b/.config/openbox/obamenu.py new file mode 100755 index 0000000..553b131 --- /dev/null +++ b/.config/openbox/obamenu.py @@ -0,0 +1,330 @@ +#!/usr/bin/env python3 +# +# Version 3.0.0 +# Revised: onuronsekiz (overlord) +# Original Author: rmoe (v1.1.7) +# +# / revisions and additions: +# +# - recoded for python 3.9+ +# - menu sort for both categories and programs +# - finding all possible icons by searching deeply in themes +# - icon search algorithm for faster approach +# - desktop item ignored if Exec command not found in system +# - automatic and direct theme selection if possible +# - flatpak applications support +# - duplicate icon handling +# +# ----- config --- + +import subprocess, glob, os + +userhome = os.path.expanduser('~') +applications_dirs = ("/usr/share/applications", userhome + "/.local/share/applications","/var/lib/flatpak/exports/share/applications") +image_dir_base = ("/usr/share", "/var/lib/flatpak/exports/share") # without "pixmaps" -/usr/local/share in FreeBSD, /usr/share on linux +try: #automatic theme selection + with open(userhome + "/.gtkrc-2.0", 'r') as readobj: + for line in readobj: + if "gtk-icon-theme-name" in line: + selected_theme=line.split("\"")[1] +except IOError: + selected_theme = "Adwaita" #fallback theme + +selected_theme = "Adwaita" # direct theme selection, don't make it hicolor. ***** SOME DISTRIBUTIONS REQUIRES THIS OPTION UNCOMMENTED. +application_groups = ("AudioVideo", "Development", "Editors", "Engineering", "Games", "Graphics", "Internet", "Multimedia", "Office", "Other", "Settings", "System", "Utilities") # enter here new category as you wish, it will be sorted +group_aliases = {"Audio":"Multimedia","Video":"Multimedia","AudioVideo":"Multimedia","Network":"Internet","Game":"Games", "Utility":"Utilities", "Development":"Editors","GTK":"", "GNOME":""} +ignoreList = ("gtk3-icon-browser","evince-previewer", "Ted", "wingide3.2", "python3.4", "feh","xfce4-power-manager-settings", "picom","compton","yad-icon-browser" ) +prefixes = ("legacy","categories","apps","devices","mimetypes","places","preferences","actions", "status","emblems") #added for prefered icon dirs and sizes. could be gathered automatically but wouldn't be sorted like this +iconSizes = ("48","32","24","16","48x48","40x40","36x36","32x32","24x24","64x64","72x72","96x96","16x16","128x128","256x256","scalable","apps","symbolic") +terminal_string = "xfce4-terminal -e " # your favourites terminal exec string +simpleOBheader = True # print full xml style OB header +# --- End of user config --- + +#constants and list for icon list generating +image_file_prefix = (".png", ".svg", ".xpm") +image_cat_prefix = ("applications-", "accessories-dictionary", "accessories-text-editor","preferences-desktop.","audio-speakers") +iconThemes=os.listdir(image_dir_base[0]+"/icons") +tmplst=[s for s in iconThemes if selected_theme in s] +selected_theme = iconThemes[0] if tmplst == [] else tmplst[0] +iconThemes.sort(key=str.lower) +#iconThemes = ("hicolor", "breeze", "Adwaita", "Papirus", "Tango") #you can manually enter icon names here with your own sorting +iconThemes.remove(selected_theme) +iconThemes.remove('hicolor') if 'hicolor' in iconThemes else False +iconThemes.insert(0, selected_theme) if selected_theme != 'hicolor' else False +iconThemes.insert(0, "hicolor") +iconList=[] + +#getting icons to lists for faster menu generate +def addIconsToList(List, theme): # skip to next icon theme if any icon couldn't found on current + for path in reversed(image_dir_base): + for prfx in prefixes: + for size in iconSizes: + tmp = path + "/icons/" + theme + "/" + size + "/" + prfx + if theme == "breeze" or theme == "breeze-dark": + tmp = path + "/icons/" + theme + "/" + prfx + "/" + size + try: + List.extend(tmp + "/" + x for x in os.listdir(tmp) if x.lower().endswith(image_file_prefix)) + except IOError: + continue + return List + +def which(program): #check if program exist + def is_exe(fpath): + return os.path.isfile(fpath) and os.access(fpath, os.X_OK) + fpath, fname = os.path.split(program) + if fpath: + if is_exe(program): + return program + else: + for path in os.environ["PATH"].split(os.pathsep): + exe_file = os.path.join(path, program) + if is_exe(exe_file): + return exe_file + return None + +class dtItem(object): + def __init__(self, fName): + self.fileName = fName + self.Name = "" + self.Comment = "" + self.Exec = "" + self.Terminal = None + self.Type = "" + self.Icon = "" + self.Categories = () + + def addName(self, data): + self.Name = xescape(data) + + def addComment(self, data): + self.Comment = data + + def addExec(self, data): + if len(data) > 3 and data[-2] == '%': # get rid of filemanager arguments in dt files + data = data[:-2].strip() + self.Exec = data + + def addIcon(self, data): + self.Icon = "" + if image_cat_prefix == "": + return + image_dir = image_dir_base[0] + "/pixmaps/" + di = data.strip() + if len(di) < 3: + #"Error in %s: Invalid or no icon '%s'" % (self.fileName, di) + return + dix = di.find("/") # is it a full path? + if dix >= 0 and dix <= 2: # yes, its a path (./path or ../path or /path ...) + self.Icon = di + return + #else a short name like "myapp" + tmp = glob.glob(image_dir + di + ".*") + if len(tmp) == 0: #if there is not correct icon in pixmap, check for icon theme + for theme in iconThemes: + tmp=[s for s in iconList if di in s] #check program name in icon list + if len(tmp) > 0: + break # end loop if found + else: + addIconsToList(iconList, theme) + if len(tmp) == 1 and tmp[0] != "/": + self.Icon = tmp[0] + if len(tmp) > 1: # if there are duplicated icons take one that has the shortest name + temp=tmp[0] # assign first item to a temp path + flen=len(temp.split("/")[-1]) # split filepath with "/" and take last element of list + for fpath in tmp: # check filepath list for shortest filename + tlen=len(fpath.split("/")[-1]) # split filepath with / and take last element of list + if tlen 0: + return tmp[0] + return "" + +def xescape(s): + Rep = {"&":"&", "<":"<", ">":">", "'":"'", "\"":"""} + for p in ("&", "<", ">", "'","\""): + sl = len(s); last = -1 + while last < sl: + i = s.find(p, last+1) + if i < 0: + done = True + break + last = i + l = s[:i] + r = s[i+1:] + s = l + Rep[p] + r + return s + +def process_category(cat, curCats, aliases=group_aliases, appGroups=application_groups): + # first process aliases + if aliases.__contains__(cat): + if aliases[cat] == "": + return "" # ignore this one + cat = aliases[cat] + if cat in appGroups and cat not in curCats: # valid categories only and no doublettes, please + curCats.append(cat) + return cat + return "" + +def process_dtfile(dtf, catDict): # process this file & extract relevant info + active = False # parse only after "[Desktop Entry]" line + fh = open(dtf, "r") + lines = fh.readlines() + this = dtItem(dtf) + for l in lines: + l = l.strip() + if l == "[Desktop Entry]": + active = True + continue + if active == False: # we don't care about licenses or other comments + continue + if l == None or len(l) < 1 or l[0] == '#': + continue + if l[0] == '[' and l != "[Desktop Entry]": + active = False + continue + # else + eqi = l.split('=',1) + if len(eqi) < 2: + print ("Error: Invalid .desktop line'" + l + "'") + continue + # Check what it is ... + if eqi[0] == "Name": + this.addName(eqi[1]) + elif eqi[0] == "Comment": + this.addComment(eqi[1]) + elif eqi[0] == "Exec": + # check if appExec command in desktop file is installed in system + eqx=eqi[1].split(" ", 1)[0] + if which(eqx) == None: + return #don't add anything to menu if executable not found, goto next desktop file + this.addExec(eqi[1]) # add appExec to list + elif eqi[0] == "Icon": + this.addIcon(eqi[1]) + elif eqi[0] == "Terminal": + this.addTerminal(eqi[1]) + elif eqi[0] == "Type": + if eqi[1] != "Application": + continue + this.addType(eqi[1]) + elif eqi[0] == "Categories": + if eqi[1] == '': + eqi[1] = "Other" + if eqi[1][-1] == ';': + eqi[1] = eqi[1][0:-1] + cats = [] + dtCats = eqi[1].split(';') + for cat in dtCats: + result = process_category(cat, cats) + this.addCategories(cats) + else: + continue + # add to catDict + #this.dprint() + if len(this.Categories) > 0: # don't care about stuff w/o category + for cat in this.Categories: + catDict[cat].append(this) + #catDict[cat].sort() #python2 code, not working on py3 + +addIconsToList(iconList, selected_theme) # getting first icons for list +categoryDict = {} + +if __name__ == "__main__": + # init the application group dict (which will contain list of apps) + application_groups=sorted(application_groups, key=str.lower) + for appGroup in application_groups: + categoryDict[appGroup] = [] + # now let's look into the app dirs ... + #changed desktop files processing loops to add flatpak applications and sorting + dtFiles=[] + for appDir in applications_dirs: + appDir += "/*.desktop" + dtFiles+=glob.glob(appDir) + # process each .desktop file in dir + for dtf in dtFiles: + skipFlag = False + for ifn in ignoreList: + if dtf.find(ifn) >= 0: + skipFlag = True + if skipFlag == False: + process_dtfile(dtf, categoryDict) + # now, generate jwm menu include + if simpleOBheader == True: + print ("") # magic header + else: + print ('') #magic header + appGroupLen = len(application_groups) + for ag in range(appGroupLen): + catList = categoryDict[application_groups[ag]] + if len(catList) < 1: + continue # don't create empty menus + # sort list + tmpList=[] #blank list to convert to tuple for sorting purpose + for app in catList: + app.Name= ' '.join([word[0].upper()+word[1:] for word in app.Name.split(' ')]) # fancy way to capitalize first letters + tmpList.append([app.Name, [app.Icon, app.Terminal, app.Exec]]) #creating a tuple to sort + catList=sorted(tmpList, key = lambda x: x[0].lower()) #recreating catList with sorted tuple list + #catList=sorted(tmpList, key=lambda (a,b): (a.lower(), b)) # sort with case ignore, py2 code, not working on py3 + # end of sort + catStr = "") + for app in catList: + progStr = "" % app[1][2] #adding exec command + print (progStr) + print ("") + print ("") # magic footer + pass # done/debug break diff --git a/.config/openbox/rc.xml b/.config/openbox/rc.xml new file mode 100644 index 0000000..b336459 --- /dev/null +++ b/.config/openbox/rc.xml @@ -0,0 +1,798 @@ + + + + + 10 + 20 + + + yes + + no + + yes + + no + + 200 + + no + + + + Smart + +
yes
+ + Primary + + 1 + + + + E5150-Cyan + NLIMC + + yes + yes + + sans + 8 + + bold + + normal + + + + sans + 8 + + bold + + normal + + + + sans + 9 + + normal + + normal + + + + sans + 9 + + normal + + normal + + + + sans + 9 + + bold + + normal + + + + sans + 9 + + bold + + normal + + + + + + 4 + 1 + + + + 875 + + + + yes + Nonpixel + + Center + + + + 10 + + 10 + + + + + + 0 + 0 + 0 + 0 + + + TopLeft + + 0 + 0 + no + Above + + Vertical + + no + 300 + + 300 + + Middle + + + + C-g + + + + left + no + + + + + right + no + + + + + up + no + + + + + down + no + + + + + left + no + + + + + right + no + + + + + up + no + + + + + down + no + + + + + 1 + + + + + 2 + + + + + 3 + + + + + 4 + + + + + + + + + + + + + + + + + client-menu + + + + + + scrot -s + + + + + + + + + + + + + + + + + + + + + + + + yes + yes + + + + + + + + + + + right + + + + + left + + + + + up + + + + + down + + + + + + + true + Konqueror + + kfmclient openProfile filemanagement + + + + + + scrot + + + + + 1 + + 500 + + 400 + + false + + + + + + + + + + + + + + + + + + + + + + + + + + + + previous + + + + + next + + + + + previous + + + + + next + + + + + previous + + + + + next + + + + + + + + + + + + + no + + + + + + + + + + + yes + + + + + + + + + + + + + + + + + + + + + + + client-menu + + + + + + + top + + + + + + + left + + + + + + + right + + + + + + + bottom + + + + + + + client-menu + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + client-menu + + + + + + + client-menu + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + vertical + + + + + horizontal + + + + + + + + + + + + + + + + + previous + + + + + next + + + + + previous + + + + + next + + + + + previous + + + + + next + + + + + + + + + + + + + + + + client-list-combined-menu + + + + + root-menu + + + + + + + previous + + + + + next + + + + + previous + + + + + next + + + + + + + + + /var/lib/openbox/debian-menu.xml + menu.xml + 200 + + no + + 100 + + 400 + + yes + + yes + + + + + + diff --git a/.emacs b/.emacs new file mode 100644 index 0000000..d48d0d1 --- /dev/null +++ b/.emacs @@ -0,0 +1,62 @@ +(add-to-list 'load-path "~/.emacs.d/lisp/") +(require 'web-mode) +(add-to-list 'auto-mode-alist '("\\.phtml\\'" . web-mode)) +(add-to-list 'auto-mode-alist '("\\.tpl\\.php\\'" . web-mode)) +(add-to-list 'auto-mode-alist '("\\.[agj]sp\\'" . web-mode)) +(add-to-list 'auto-mode-alist '("\\.as[cp]x\\'" . web-mode)) +(add-to-list 'auto-mode-alist '("\\.erb\\'" . web-mode)) +(add-to-list 'auto-mode-alist '("\\.mustache\\'" . web-mode)) +(add-to-list 'auto-mode-alist '("\\.djhtml\\'" . web-mode)) +(add-to-list 'auto-mode-alist '("\\.html?\\'" . web-mode)) + +; do not break hard linked files +(setq backup-by-copying-when-linked t) + +; use aspell instead of ispell +(setq-default ispell-program-name "aspell") + +; enable auto compression mode +(auto-compression-mode 1) + +; make scripts executable upon saving +(add-hook 'after-save-hook 'executable-make-buffer-file-executable-if-script-p) + +;; Make all yes/no prompts into y/n prompts +(fset 'yes-or-no-p 'y-or-n-p) + +;; set time to show in corner +(setq display-time-day-and-date t) +(display-time) + + +(custom-set-variables + ;; custom-set-variables was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(inhibit-startup-screen t) + '(safe-local-variable-values + (quote + ((sgml-local-ecat-files) + (sgml-local-catalogs) + (sgml-exposed-tags) + (sgml-default-dtd-file) + (sgml-parent-document) + (sgml-indent-data . t) + (sgml-indent-step . 2) + (sgml-always-quote-attributes . t) + (sgml-minimize-attributes) + (sgml-shorttag . t) + (sgml-omittag . t)))) + '(send-mail-function (quote mailclient-send-it))) +(custom-set-faces + ;; custom-set-faces was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + ) + +(require 'lua-mode) +(autoload 'lua-mode "lua-mode" "Lua editing mode." t) +(add-to-list 'auto-mode-alist '("\\.lua$" . lua-mode)) +(add-to-list 'interpreter-mode-alist '("lua" . lua-mode)) diff --git a/.emacs.d/games/dunnet-scores b/.emacs.d/games/dunnet-scores new file mode 100644 index 0000000..f86bc8b --- /dev/null +++ b/.emacs.d/games/dunnet-scores @@ -0,0 +1 @@ +Thu Jun 10 08:03:27 2021 abdul quit at E/W Dirt road. score: 0 saves: 0 commands: 5 diff --git a/.emacs.d/lisp/lua-mode.el b/.emacs.d/lisp/lua-mode.el new file mode 100644 index 0000000..4ac107c --- /dev/null +++ b/.emacs.d/lisp/lua-mode.el @@ -0,0 +1,2238 @@ +;;; lua-mode.el --- a major-mode for editing Lua scripts -*- lexical-binding: t -*- + +;; Author: 2011-2013 immerrr +;; 2010-2011 Reuben Thomas +;; 2006 Juergen Hoetzel +;; 2004 various (support for Lua 5 and byte compilation) +;; 2001 Christian Vogler +;; 1997 Bret Mogilefsky starting from +;; tcl-mode by Gregor Schmid +;; with tons of assistance from +;; Paul Du Bois and +;; Aaron Smith . +;; +;; URL: http://immerrr.github.com/lua-mode +;; Version: 20151025 +;; Package-Requires: ((emacs "24.3")) +;; +;; This file is NOT part of Emacs. +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +;; MA 02110-1301, USA. + +;; Keywords: languages, processes, tools + +;; This field is expanded to commit SHA and commit date during the +;; archive creation. +;; Revision: 2d9a468 (Thu, 21 Jan 2021 09:44:50 +0100) +;; + +;;; Commentary: + +;; lua-mode provides support for editing Lua, including automatic +;; indentation, syntactical font-locking, running interactive shell, +;; interacting with `hs-minor-mode' and online documentation lookup. + +;; The following variables are available for customization (see more via +;; `M-x customize-group lua`): + +;; - Var `lua-indent-level': +;; indentation offset in spaces +;; - Var `lua-indent-string-contents': +;; set to `t` if you like to have contents of multiline strings to be +;; indented like comments +;; - Var `lua-indent-nested-block-content-align': +;; set to `nil' to stop aligning the content of nested blocks with the +;; open parenthesis +;; - Var `lua-indent-close-paren-align': +;; set to `t' to align close parenthesis with the open parenthesis, +;; rather than with the beginning of the line +;; - Var `lua-mode-hook': +;; list of functions to execute when lua-mode is initialized +;; - Var `lua-documentation-url': +;; base URL for documentation lookup +;; - Var `lua-documentation-function': function used to +;; show documentation (`eww` is a viable alternative for Emacs 25) + +;; These are variables/commands that operate on the Lua process: + +;; - Var `lua-default-application': +;; command to start the Lua process (REPL) +;; - Var `lua-default-command-switches': +;; arguments to pass to the Lua process on startup (make sure `-i` is there +;; if you expect working with Lua shell interactively) +;; - Cmd `lua-start-process': start new REPL process, usually happens automatically +;; - Cmd `lua-kill-process': kill current REPL process + +;; These are variables/commands for interaction with the Lua process: + +;; - Cmd `lua-show-process-buffer': switch to REPL buffer +;; - Cmd `lua-hide-process-buffer': hide window showing REPL buffer +;; - Var `lua-always-show': show REPL buffer after sending something +;; - Cmd `lua-send-buffer': send whole buffer +;; - Cmd `lua-send-current-line': send current line +;; - Cmd `lua-send-defun': send current top-level function +;; - Cmd `lua-send-region': send active region +;; - Cmd `lua-restart-with-whole-file': restart REPL and send whole buffer + +;; See "M-x apropos-command ^lua-" for a list of commands. +;; See "M-x customize-group lua" for a list of customizable variables. + + +;;; Code: +(eval-when-compile + (require 'cl-lib)) + +(require 'comint) +(require 'newcomment) +(require 'rx) + + +;; rx-wrappers for Lua + +(eval-when-compile + ;; Silence compilation warning about `compilation-error-regexp-alist' defined + ;; in compile.el. + (require 'compile)) + +(eval-and-compile + (if (fboundp #'rx-let) + (progn + ;; Emacs 27+ way of customizing rx + (defvar lua--rx-bindings) + + (setq + lua--rx-bindings + '((symbol (&rest x) (seq symbol-start (or x) symbol-end)) + (ws (* (any " \t"))) + (ws+ (+ (any " \t"))) + + (lua-name (symbol (seq (+ (any alpha "_")) (* (any alnum "_"))))) + (lua-funcname (seq lua-name (* ws "." ws lua-name) + (opt ws ":" ws lua-name))) + (lua-funcheader + ;; Outer (seq ...) is here to shy-group the definition + (seq (or (seq (symbol "function") ws (group-n 1 lua-funcname)) + (seq (group-n 1 lua-funcname) ws "=" ws + (symbol "function"))))) + (lua-number + (seq (or (seq (+ digit) (opt ".") (* digit)) + (seq (* digit) (opt ".") (+ digit))) + (opt (regexp "[eE][+-]?[0-9]+")))) + (lua-assignment-op (seq "=" (or buffer-end (not (any "="))))) + (lua-operator (or "+" "-" "*" "/" "%" "^" "#" "==" "~=" "<=" ">=" "<" + ">" "=" ";" ":" "," "." ".." "...")) + (lua-keyword-operator (symbol "and" "not" "or")) + (lua-keyword + (symbol "break" "do" "else" "elseif" "end" "for" "function" + "goto" "if" "in" "local" "repeat" "return" + "then" "until" "while")) + (lua-up-to-9-variables + (seq (group-n 1 lua-name) ws + (? "," ws (group-n 2 lua-name) ws + (? "," ws (group-n 3 lua-name) ws + (? "," ws (group-n 4 lua-name) ws + (? "," ws (group-n 5 lua-name) ws + (? "," ws (group-n 6 lua-name) ws + (? "," ws (group-n 7 lua-name) ws + (? "," ws (group-n 8 lua-name) ws + (? "," ws (group-n 9 lua-name) ws)))))))))))) + + (defmacro lua-rx (&rest regexps) + (eval `(rx-let ,lua--rx-bindings + (rx ,@regexps)))) + + (defun lua-rx-to-string (form &optional no-group) + (rx-let-eval lua--rx-bindings + (rx-to-string form no-group)))) + (progn + ;; Pre-Emacs 27 way of customizing rx + (defvar lua-rx-constituents) + (defvar rx-parent) + + (defun lua-rx-to-string (form &optional no-group) + "Lua-specific replacement for `rx-to-string'. + +See `rx-to-string' documentation for more information FORM and +NO-GROUP arguments." + (let ((rx-constituents lua-rx-constituents)) + (rx-to-string form no-group))) + + (defmacro lua-rx (&rest regexps) + "Lua-specific replacement for `rx'. + +See `rx' documentation for more information about REGEXPS param." + (cond ((null regexps) + (error "No regexp")) + ((cdr regexps) + (lua-rx-to-string `(and ,@regexps) t)) + (t + (lua-rx-to-string (car regexps) t)))) + + (defun lua--new-rx-form (form) + "Add FORM definition to `lua-rx' macro. + +FORM is a cons (NAME . DEFN), see more in `rx-constituents' doc. +This function enables specifying new definitions using old ones: +if DEFN is a list that starts with `:rx' symbol its second +element is itself expanded with `lua-rx-to-string'. " + (let ((form-definition (cdr form))) + (when (and (listp form-definition) (eq ':rx (car form-definition))) + (setcdr form (lua-rx-to-string (cadr form-definition) 'nogroup))) + (push form lua-rx-constituents))) + + (defun lua--rx-symbol (form) + ;; form is a list (symbol XXX ...) + ;; Skip initial 'symbol + (setq form (cdr form)) + ;; If there's only one element, take it from the list, otherwise wrap the + ;; whole list into `(or XXX ...)' form. + (setq form (if (eq 1 (length form)) + (car form) + (append '(or) form))) + (and (fboundp 'rx-form) ; Silence Emacs 27's byte-compiler. + (rx-form `(seq symbol-start ,form symbol-end) rx-parent))) + + (setq lua-rx-constituents (copy-sequence rx-constituents)) + + (mapc 'lua--new-rx-form + `((symbol lua--rx-symbol 1 nil) + (ws . "[ \t]*") (ws+ . "[ \t]+") + (lua-name :rx (symbol (regexp "[[:alpha:]_]+[[:alnum:]_]*"))) + (lua-funcname + :rx (seq lua-name (* ws "." ws lua-name) + (opt ws ":" ws lua-name))) + (lua-funcheader + ;; Outer (seq ...) is here to shy-group the definition + :rx (seq (or (seq (symbol "function") ws (group-n 1 lua-funcname)) + (seq (group-n 1 lua-funcname) ws "=" ws + (symbol "function"))))) + (lua-number + :rx (seq (or (seq (+ digit) (opt ".") (* digit)) + (seq (* digit) (opt ".") (+ digit))) + (opt (regexp "[eE][+-]?[0-9]+")))) + (lua-assignment-op + :rx (seq "=" (or buffer-end (not (any "="))))) + (lua-operator + :rx (or "+" "-" "*" "/" "%" "^" "#" "==" "~=" "<=" ">=" "<" + ">" "=" ";" ":" "," "." ".." "...")) + (lua-keyword-operator + :rx (symbol "and" "not" "or")) + (lua-keyword + :rx (symbol "break" "do" "else" "elseif" "end" "for" "function" + "goto" "if" "in" "local" "repeat" "return" + "then" "until" "while")) + (lua-up-to-9-variables + :rx (seq (group-n 1 lua-name) ws + (? "," ws (group-n 2 lua-name) ws + (? "," ws (group-n 3 lua-name) ws + (? "," ws (group-n 4 lua-name) ws + (? "," ws (group-n 5 lua-name) ws + (? "," ws (group-n 6 lua-name) ws + (? "," ws (group-n 7 lua-name) ws + (? "," ws (group-n 8 lua-name) ws + (? "," ws (group-n 9 lua-name) ws))))))))))))))) + + +;; Local variables +(defgroup lua nil + "Major mode for editing Lua code." + :prefix "lua-" + :group 'languages) + +(defcustom lua-indent-level 3 + "Amount by which Lua subexpressions are indented." + :type 'integer + :group 'lua + :safe #'integerp) + +(defcustom lua-comment-start "-- " + "Default value of `comment-start'." + :type 'string + :group 'lua) + +(defcustom lua-comment-start-skip "---*[ \t]*" + "Default value of `comment-start-skip'." + :type 'string + :group 'lua) + +(defcustom lua-default-application "lua" + "Default application to run in Lua process. + +Can be a string, where it denotes a command to be executed to +start Lua process, or a (HOST . PORT) cons, that can be used to +connect to Lua process running remotely." + :type '(choice (string) + (cons string integer)) + :group 'lua) + +(defcustom lua-default-command-switches (list "-i") + "Command switches for `lua-default-application'. +Should be a list of strings." + :type '(repeat string) + :group 'lua) +(make-variable-buffer-local 'lua-default-command-switches) + +(defcustom lua-always-show t + "*Non-nil means display lua-process-buffer after sending a command." + :type 'boolean + :group 'lua) + +(defcustom lua-documentation-function 'browse-url + "Function used to fetch the Lua reference manual." + :type `(radio (function-item browse-url) + ,@(when (fboundp 'eww) '((function-item eww))) + ,@(when (fboundp 'w3m-browse-url) '((function-item w3m-browse-url))) + (function :tag "Other function")) + :group 'lua) + +(defcustom lua-documentation-url + (or (and (file-readable-p "/usr/share/doc/lua/manual.html") + "file:///usr/share/doc/lua/manual.html") + "http://www.lua.org/manual/5.1/manual.html") + "URL pointing to the Lua reference manual." + :type 'string + :group 'lua) + + +(defvar lua-process nil + "The active Lua process") + +(defvar lua-process-buffer nil + "Buffer used for communication with the Lua process.") + +(defun lua--customize-set-prefix-key (prefix-key-sym prefix-key-val) + (cl-assert (eq prefix-key-sym 'lua-prefix-key)) + (set prefix-key-sym (if (and prefix-key-val (> (length prefix-key-val) 0)) + ;; read-kbd-macro returns a string or a vector + ;; in both cases (elt x 0) is ok + (elt (read-kbd-macro prefix-key-val) 0))) + (if (fboundp 'lua-prefix-key-update-bindings) + (lua-prefix-key-update-bindings))) + +(defcustom lua-prefix-key "\C-c" + "Prefix for all lua-mode commands." + :type 'string + :group 'lua + :set 'lua--customize-set-prefix-key + :get '(lambda (sym) + (let ((val (eval sym))) (if val (single-key-description (eval sym)) "")))) + +(defvar lua-mode-menu (make-sparse-keymap "Lua") + "Keymap for lua-mode's menu.") + +(defvar lua-prefix-mode-map + (eval-when-compile + (let ((result-map (make-sparse-keymap))) + (mapc (lambda (key_defn) + (define-key result-map (read-kbd-macro (car key_defn)) (cdr key_defn))) + '(("C-l" . lua-send-buffer) + ("C-f" . lua-search-documentation))) + result-map)) + "Keymap that is used to define keys accessible by `lua-prefix-key'. + +If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") + +(defvar lua--electric-indent-chars + (mapcar #'string-to-char '("}" "]" ")"))) + + +(defvar lua-mode-map + (let ((result-map (make-sparse-keymap))) + (unless (boundp 'electric-indent-chars) + (mapc (lambda (electric-char) + (define-key result-map + (read-kbd-macro + (char-to-string electric-char)) + #'lua-electric-match)) + lua--electric-indent-chars)) + (define-key result-map [menu-bar lua-mode] (cons "Lua" lua-mode-menu)) + (define-key result-map [remap backward-up-list] 'lua-backward-up-list) + + ;; handle prefix-keyed bindings: + ;; * if no prefix, set prefix-map as parent, i.e. + ;; if key is not defined look it up in prefix-map + ;; * if prefix is set, bind the prefix-map to that key + (if lua-prefix-key + (define-key result-map (vector lua-prefix-key) lua-prefix-mode-map) + (set-keymap-parent result-map lua-prefix-mode-map)) + result-map) + "Keymap used in lua-mode buffers.") + +(defvar lua-electric-flag t + "If t, electric actions (like automatic reindentation) will happen when an electric + key like `{' is pressed") +(make-variable-buffer-local 'lua-electric-flag) + +(defcustom lua-prompt-regexp "[^\n]*\\(>[\t ]+\\)+$" + "Regexp which matches the Lua program's prompt." + :type 'regexp + :group 'lua) + +(defcustom lua-traceback-line-re + ;; This regexp skips prompt and meaningless "stdin:N:" prefix when looking + ;; for actual file-line locations. + "^\\(?:[\t ]*\\|.*>[\t ]+\\)\\(?:[^\n\t ]+:[0-9]+:[\t ]*\\)*\\(?:\\([^\n\t ]+\\):\\([0-9]+\\):\\)" + "Regular expression that describes tracebacks and errors." + :type 'regexp + :group 'lua) + +(defvar lua--repl-buffer-p nil + "Buffer-local flag saying if this is a Lua REPL buffer.") +(make-variable-buffer-local 'lua--repl-buffer-p) + + +(defadvice compilation-find-file (around lua--repl-find-file + (marker filename directory &rest formats) + activate) + "Return Lua REPL buffer when looking for \"stdin\" file in it." + (if (and + lua--repl-buffer-p + (string-equal filename "stdin") + ;; NOTE: this doesn't traverse `compilation-search-path' when + ;; looking for filename. + (not (file-exists-p (expand-file-name + filename + (when directory (expand-file-name directory)))))) + (setq ad-return-value (current-buffer)) + ad-do-it)) + + +(defadvice compilation-goto-locus (around lua--repl-goto-locus + (msg mk end-mk) + activate) + "When message points to Lua REPL buffer, go to the message itself. +Usually, stdin:XX line number points to nowhere." + (let ((errmsg-buf (marker-buffer msg)) + (error-buf (marker-buffer mk))) + (if (and (with-current-buffer errmsg-buf lua--repl-buffer-p) + (eq error-buf errmsg-buf)) + (progn + (compilation-set-window (display-buffer (marker-buffer msg)) msg) + (goto-char msg)) + ad-do-it))) + + +(defcustom lua-indent-string-contents nil + "If non-nil, contents of multiline string will be indented. +Otherwise leading amount of whitespace on each line is preserved." + :group 'lua + :type 'boolean + :safe #'booleanp) + +(defcustom lua-indent-nested-block-content-align t + "If non-nil, the contents of nested blocks are indented to +align with the column of the opening parenthesis, rather than +just forward by `lua-indent-level'." + :group 'lua + :type 'boolean + :safe #'booleanp) + +(defcustom lua-indent-close-paren-align t + "If non-nil, close parenthesis are aligned with their open +parenthesis. If nil, close parenthesis are aligned to the +beginning of the line." + :group 'lua + :type 'boolean + :safe #'booleanp) + +(defcustom lua-jump-on-traceback t + "*Jump to innermost traceback location in *lua* buffer. When this +variable is non-nil and a traceback occurs when running Lua code in a +process, jump immediately to the source code of the innermost +traceback location." + :type 'boolean + :group 'lua) + +(defcustom lua-mode-hook nil + "Hooks called when Lua mode fires up." + :type 'hook + :group 'lua) + +(defvar lua-region-start (make-marker) + "Start of special region for Lua communication.") + +(defvar lua-region-end (make-marker) + "End of special region for Lua communication.") + +(defvar lua-emacs-menu + '(["Restart With Whole File" lua-restart-with-whole-file t] + ["Kill Process" lua-kill-process t] + ["Hide Process Buffer" lua-hide-process-buffer t] + ["Show Process Buffer" lua-show-process-buffer t] + ["Beginning Of Proc" lua-beginning-of-proc t] + ["End Of Proc" lua-end-of-proc t] + ["Set Lua-Region Start" lua-set-lua-region-start t] + ["Set Lua-Region End" lua-set-lua-region-end t] + ["Send Lua-Region" lua-send-lua-region t] + ["Send Current Line" lua-send-current-line t] + ["Send Region" lua-send-region t] + ["Send Proc" lua-send-proc t] + ["Send Buffer" lua-send-buffer t] + ["Search Documentation" lua-search-documentation t]) + "Emacs menu for Lua mode.") + +;; the whole defconst is inside eval-when-compile, because it's later referenced +;; inside another eval-and-compile block +(eval-and-compile + (defconst + lua--builtins + (let* + ((modules + '("_G" "_VERSION" "assert" "collectgarbage" "dofile" "error" "getfenv" + "getmetatable" "ipairs" "load" "loadfile" "loadstring" "module" + "next" "pairs" "pcall" "print" "rawequal" "rawget" "rawlen" "rawset" + "require" "select" "setfenv" "setmetatable" "tonumber" "tostring" + "type" "unpack" "xpcall" "self" + ("bit32" . ("arshift" "band" "bnot" "bor" "btest" "bxor" "extract" + "lrotate" "lshift" "replace" "rrotate" "rshift")) + ("coroutine" . ("create" "isyieldable" "resume" "running" "status" + "wrap" "yield")) + ("debug" . ("debug" "getfenv" "gethook" "getinfo" "getlocal" + "getmetatable" "getregistry" "getupvalue" "getuservalue" + "setfenv" "sethook" "setlocal" "setmetatable" + "setupvalue" "setuservalue" "traceback" "upvalueid" + "upvaluejoin")) + ("io" . ("close" "flush" "input" "lines" "open" "output" "popen" + "read" "stderr" "stdin" "stdout" "tmpfile" "type" "write")) + ("math" . ("abs" "acos" "asin" "atan" "atan2" "ceil" "cos" "cosh" + "deg" "exp" "floor" "fmod" "frexp" "huge" "ldexp" "log" + "log10" "max" "maxinteger" "min" "mininteger" "modf" "pi" + "pow" "rad" "random" "randomseed" "sin" "sinh" "sqrt" + "tan" "tanh" "tointeger" "type" "ult")) + ("os" . ("clock" "date" "difftime" "execute" "exit" "getenv" + "remove" "rename" "setlocale" "time" "tmpname")) + ("package" . ("config" "cpath" "loaded" "loaders" "loadlib" "path" + "preload" "searchers" "searchpath" "seeall")) + ("string" . ("byte" "char" "dump" "find" "format" "gmatch" "gsub" + "len" "lower" "match" "pack" "packsize" "rep" "reverse" + "sub" "unpack" "upper")) + ("table" . ("concat" "insert" "maxn" "move" "pack" "remove" "sort" + "unpack")) + ("utf8" . ("char" "charpattern" "codepoint" "codes" "len" + "offset"))))) + + (cl-labels + ((module-name-re (x) + (concat "\\(?1:\\_<" + (if (listp x) (car x) x) + "\\_>\\)")) + (module-members-re (x) (if (listp x) + (concat "\\(?:[ \t]*\\.[ \t]*" + "\\_<\\(?2:" + (regexp-opt (cdr x)) + "\\)\\_>\\)?") + ""))) + + (concat + ;; common prefix: + ;; - beginning-of-line + ;; - or neither of [ '.', ':' ] to exclude "foo.string.rep" + ;; - or concatenation operator ".." + "\\(?:^\\|[^:. \t]\\|[.][.]\\)" + ;; optional whitespace + "[ \t]*" + "\\(?:" + ;; any of modules/functions + (mapconcat (lambda (x) (concat (module-name-re x) + (module-members-re x))) + modules + "\\|") + "\\)")))) + + "A regexp that matches Lua builtin functions & variables. + +This is a compilation of 5.1, 5.2 and 5.3 builtins taken from the +index of respective Lua reference manuals.") + + +(defvar lua-font-lock-keywords + `(;; highlight the hash-bang line "#!/foo/bar/lua" as comment + ("^#!.*$" . font-lock-comment-face) + + ;; Builtin constants + (,(lua-rx (symbol "true" "false" "nil")) + . font-lock-constant-face) + + ;; Keywords + (, (lua-rx (or lua-keyword lua-keyword-operator)) + . font-lock-keyword-face) + + ;; Labels used by the "goto" statement + ;; Highlights the following syntax: ::label:: + (,(lua-rx "::" ws lua-name ws "::") + . font-lock-constant-face) + + ;; Highlights the name of the label in the "goto" statement like + ;; "goto label" + (,(lua-rx (symbol (seq "goto" ws+ (group-n 1 lua-name)))) + (1 font-lock-constant-face)) + + ;; Highlight Lua builtin functions and variables + (,lua--builtins + (1 font-lock-builtin-face) (2 font-lock-builtin-face nil noerror)) + + (,(lua-rx (symbol "for") ws+ lua-up-to-9-variables) + (1 font-lock-variable-name-face) + (2 font-lock-variable-name-face nil noerror) + (3 font-lock-variable-name-face nil noerror) + (4 font-lock-variable-name-face nil noerror) + (5 font-lock-variable-name-face nil noerror) + (6 font-lock-variable-name-face nil noerror) + (7 font-lock-variable-name-face nil noerror) + (8 font-lock-variable-name-face nil noerror) + (9 font-lock-variable-name-face nil noerror)) + + (,(lua-rx (symbol "function") (? ws+ lua-funcname) ws "(" ws lua-up-to-9-variables) + (1 font-lock-variable-name-face) + (2 font-lock-variable-name-face nil noerror) + (3 font-lock-variable-name-face nil noerror) + (4 font-lock-variable-name-face nil noerror) + (5 font-lock-variable-name-face nil noerror) + (6 font-lock-variable-name-face nil noerror) + (7 font-lock-variable-name-face nil noerror) + (8 font-lock-variable-name-face nil noerror) + (9 font-lock-variable-name-face nil noerror)) + + (,(lua-rx lua-funcheader) + (1 font-lock-function-name-face)) + + ;; local x, y, z + ;; local x = ..... + ;; + ;; NOTE: this is intentionally below funcheader matcher, so that in + ;; + ;; local foo = function() ... + ;; + ;; "foo" is fontified as function-name-face, and variable-name-face is not applied. + (,(lua-rx (symbol "local") ws+ lua-up-to-9-variables) + (1 font-lock-variable-name-face) + (2 font-lock-variable-name-face nil noerror) + (3 font-lock-variable-name-face nil noerror) + (4 font-lock-variable-name-face nil noerror) + (5 font-lock-variable-name-face nil noerror) + (6 font-lock-variable-name-face nil noerror) + (7 font-lock-variable-name-face nil noerror) + (8 font-lock-variable-name-face nil noerror) + (9 font-lock-variable-name-face nil noerror)) + + (,(lua-rx (or (group-n 1 + "@" (symbol "author" "copyright" "field" "release" + "return" "see" "usage" "description")) + (seq (group-n 1 "@" (symbol "param" "class" "name")) ws+ + (group-n 2 lua-name)))) + (1 font-lock-keyword-face t) + (2 font-lock-variable-name-face t noerror))) + + "Default expressions to highlight in Lua mode.") + +(defvar lua-imenu-generic-expression + `(("Requires" ,(lua-rx (or bol ";") ws (opt (seq (symbol "local") ws)) (group-n 1 lua-name) ws "=" ws (symbol "require")) 1) + (nil ,(lua-rx (or bol ";") ws (opt (seq (symbol "local") ws)) lua-funcheader) 1)) + "Imenu generic expression for lua-mode. See `imenu-generic-expression'.") + +(defvar lua-sexp-alist '(("then" . "end") + ("function" . "end") + ("do" . "end") + ("repeat" . "until"))) + +(defvar lua-mode-abbrev-table nil + "Abbreviation table used in lua-mode buffers.") + +(define-abbrev-table 'lua-mode-abbrev-table + '(("end" "end" lua-indent-line :system t) + ("else" "else" lua-indent-line :system t) + ("elseif" "elseif" lua-indent-line :system t))) + +(defvar lua-mode-syntax-table + (with-syntax-table (copy-syntax-table) + ;; main comment syntax: begins with "--", ends with "\n" + (modify-syntax-entry ?- ". 12") + (modify-syntax-entry ?\n ">") + + ;; main string syntax: bounded by ' or " + (modify-syntax-entry ?\' "\"") + (modify-syntax-entry ?\" "\"") + + ;; single-character binary operators: punctuation + (modify-syntax-entry ?+ ".") + (modify-syntax-entry ?* ".") + (modify-syntax-entry ?/ ".") + (modify-syntax-entry ?^ ".") + (modify-syntax-entry ?% ".") + (modify-syntax-entry ?> ".") + (modify-syntax-entry ?< ".") + (modify-syntax-entry ?= ".") + (modify-syntax-entry ?~ ".") + + (syntax-table)) + "`lua-mode' syntax table.") + +;;;###autoload +(define-derived-mode lua-mode prog-mode "Lua" + "Major mode for editing Lua code." + :abbrev-table lua-mode-abbrev-table + :syntax-table lua-mode-syntax-table + :group 'lua + (setq-local font-lock-defaults '(lua-font-lock-keywords ;; keywords + nil ;; keywords-only + nil ;; case-fold + nil ;; syntax-alist + nil ;; syntax-begin + )) + + (setq-local syntax-propertize-function + 'lua--propertize-multiline-bounds) + + (setq-local parse-sexp-lookup-properties t) + (setq-local indent-line-function 'lua-indent-line) + (setq-local beginning-of-defun-function 'lua-beginning-of-proc) + (setq-local end-of-defun-function 'lua-end-of-proc) + (setq-local comment-start lua-comment-start) + (setq-local comment-start-skip lua-comment-start-skip) + (setq-local comment-use-syntax t) + (setq-local fill-paragraph-function #'lua--fill-paragraph) + (with-no-warnings + (setq-local comment-use-global-state t)) + (setq-local imenu-generic-expression lua-imenu-generic-expression) + (when (boundp 'electric-indent-chars) + ;; If electric-indent-chars is not defined, electric indentation is done + ;; via `lua-mode-map'. + (setq-local electric-indent-chars + (append electric-indent-chars lua--electric-indent-chars))) + + + ;; setup menu bar entry (XEmacs style) + (if (and (featurep 'menubar) + (boundp 'current-menubar) + (fboundp 'set-buffer-menubar) + (fboundp 'add-menu) + (not (assoc "Lua" current-menubar))) + (progn + (set-buffer-menubar (copy-sequence current-menubar)) + (add-menu nil "Lua" lua-emacs-menu))) + ;; Append Lua menu to popup menu for Emacs. + (if (boundp 'mode-popup-menu) + (setq mode-popup-menu + (cons (concat mode-name " Mode Commands") lua-emacs-menu))) + + ;; hideshow setup + (unless (assq 'lua-mode hs-special-modes-alist) + (add-to-list 'hs-special-modes-alist + `(lua-mode + ,(regexp-opt (mapcar 'car lua-sexp-alist) 'words) ;start + ,(regexp-opt (mapcar 'cdr lua-sexp-alist) 'words) ;end + nil lua-forward-sexp)))) + + + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-mode)) + +;;;###autoload +(add-to-list 'interpreter-mode-alist '("lua" . lua-mode)) + +(defun lua-electric-match (arg) + "Insert character and adjust indentation." + (interactive "P") + (let (blink-paren-function) + (self-insert-command (prefix-numeric-value arg))) + (if lua-electric-flag + (lua-indent-line)) + (blink-matching-open)) + +;; private functions + +(defun lua--fill-paragraph (&optional justify region) + ;; Implementation of forward-paragraph for filling. + ;; + ;; This function works around a corner case in the following situations: + ;; + ;; <> + ;; -- some very long comment .... + ;; some_code_right_after_the_comment + ;; + ;; If point is at the beginning of the comment line, fill paragraph code + ;; would have gone for comment-based filling and done the right thing, but it + ;; does not find a comment at the beginning of the empty line before the + ;; comment and falls back to text-based filling ignoring comment-start and + ;; spilling the comment into the code. + (save-excursion + (while (and (not (eobp)) + (progn (move-to-left-margin) + (looking-at paragraph-separate))) + (forward-line 1)) + (let ((fill-paragraph-handle-comment t)) + (fill-paragraph justify region)))) + + +(defun lua-prefix-key-update-bindings () + (let (old-cons) + (if (eq lua-prefix-mode-map (keymap-parent lua-mode-map)) + ;; if prefix-map is a parent, delete the parent + (set-keymap-parent lua-mode-map nil) + ;; otherwise, look for it among children + (if (setq old-cons (rassoc lua-prefix-mode-map lua-mode-map)) + (delq old-cons lua-mode-map))) + + (if (null lua-prefix-key) + (set-keymap-parent lua-mode-map lua-prefix-mode-map) + (define-key lua-mode-map (vector lua-prefix-key) lua-prefix-mode-map)))) + +(defun lua-set-prefix-key (new-key-str) + "Changes `lua-prefix-key' properly and updates keymaps + +This function replaces previous prefix-key binding with a new one." + (interactive "sNew prefix key (empty string means no key): ") + (lua--customize-set-prefix-key 'lua-prefix-key new-key-str) + (message "Prefix key set to %S" (single-key-description lua-prefix-key)) + (lua-prefix-key-update-bindings)) + +(defun lua-string-p (&optional pos) + "Returns true if the point is in a string." + (save-excursion (elt (syntax-ppss pos) 3))) + +(defun lua--containing-double-hyphen-start-pos () + "Return position of the beginning comment delimiter (--). + +Emacs syntax framework does not consider comment delimiters as +part of the comment itself, but for this package it is useful to +consider point as inside comment when it is between the two hyphens" + (and (eql (char-before) ?-) + (eql (char-after) ?-) + (1- (point)))) + +(defun lua-comment-start-pos (&optional parsing-state) + "Return position of comment containing current point. + +If point is not inside a comment, return nil." + (unless parsing-state (setq parsing-state (syntax-ppss))) + (and + ;; Not a string + (not (nth 3 parsing-state)) + ;; Syntax-based comment + (or (and (nth 4 parsing-state) (nth 8 parsing-state)) + (lua--containing-double-hyphen-start-pos)))) + +(defun lua-comment-or-string-p (&optional pos) + "Returns true if the point is in a comment or string." + (save-excursion (let ((parse-result (syntax-ppss pos))) + (or (elt parse-result 3) (lua-comment-start-pos parse-result))))) + +(defun lua-comment-or-string-start-pos (&optional pos) + "Returns start position of string or comment which contains point. + +If point is not inside string or comment, return nil." + (save-excursion + (when pos (goto-char pos)) + (or (elt (syntax-ppss pos) 8) + (lua--containing-double-hyphen-start-pos)))) + +;; They're propertized as follows: +;; 1. generic-comment +;; 2. generic-string +;; 3. equals signs +(defconst lua-ml-begin-regexp + "\\(?:\\(?1:-\\)-\\[\\|\\(?2:\\[\\)\\)\\(?3:=*\\)\\[") + + +(defun lua-try-match-multiline-end (end) + "Try to match close-bracket for multiline literal around point. + +Basically, detect form of close bracket from syntactic +information provided at point and re-search-forward to it." + (let ((comment-or-string-start-pos (lua-comment-or-string-start-pos))) + ;; Is there a literal around point? + (and comment-or-string-start-pos + ;; It is, check if the literal is a multiline open-bracket + (save-excursion + (goto-char comment-or-string-start-pos) + (looking-at lua-ml-begin-regexp)) + + ;; Yes it is, look for it matching close-bracket. Close-bracket's + ;; match group is determined by match-group of open-bracket. + (re-search-forward + (format "]%s\\(?%s:]\\)" + (match-string-no-properties 3) + (if (match-beginning 1) 1 2)) + end 'noerror)))) + + +(defun lua-try-match-multiline-begin (limit) + "Try to match multiline open-brackets. + +Find next opening long bracket outside of any string/comment. +If none can be found before reaching LIMIT, return nil." + + (let (last-search-matched) + (while + ;; This loop will iterate skipping all multiline-begin tokens that are + ;; inside strings or comments ending either at EOL or at valid token. + (and (setq last-search-matched + (re-search-forward lua-ml-begin-regexp limit 'noerror)) + ;; Ensure --[[ is not inside a comment or string. + ;; + ;; This includes "---[[" sequence, in which "--" at the beginning + ;; creates a single-line comment, and thus "-[[" is no longer a + ;; multi-line opener. + ;; + ;; XXX: need to ensure syntax-ppss beyond (match-beginning 0) is + ;; not calculated, or otherwise we'll need to flush the cache. + (lua-comment-or-string-start-pos (match-beginning 0)))) + + last-search-matched)) + +(defun lua-match-multiline-literal-bounds (limit) + ;; First, close any multiline literal spanning from previous block. This will + ;; move the point accordingly so as to avoid double traversal. + (or (lua-try-match-multiline-end limit) + (lua-try-match-multiline-begin limit))) + +(defun lua--propertize-multiline-bounds (start end) + "Put text properties on beginnings and ends of multiline literals. + +Intended to be used as a `syntax-propertize-function'." + (save-excursion + (goto-char start) + (while (lua-match-multiline-literal-bounds end) + (when (match-beginning 1) + (put-text-property (match-beginning 1) (match-end 1) + 'syntax-table (string-to-syntax "!"))) + (when (match-beginning 2) + (put-text-property (match-beginning 2) (match-end 2) + 'syntax-table (string-to-syntax "|")))))) + + +(defun lua-indent-line () + "Indent current line for Lua mode. +Return the amount the indentation changed by." + (let (indent + (case-fold-search nil) + ;; save point as a distance to eob - it's invariant w.r.t indentation + (pos (- (point-max) (point)))) + (back-to-indentation) + (if (lua-comment-or-string-p) + (setq indent (lua-calculate-string-or-comment-indentation)) ;; just restore point position + (setq indent (max 0 (lua-calculate-indentation)))) + + (when (not (equal indent (current-column))) + (delete-region (line-beginning-position) (point)) + (indent-to indent)) + + ;; If initial point was within line's indentation, + ;; position after the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) + + indent)) + +(defun lua-calculate-string-or-comment-indentation () + "This function should be run when point at (current-indentation) is inside string" + (if (and (lua-string-p) (not lua-indent-string-contents)) + ;; if inside string and strings aren't to be indented, return current indentation + (current-indentation) + + ;; At this point, we know that we're inside comment, so make sure + ;; close-bracket is unindented like a block that starts after + ;; left-shifter. + (let ((left-shifter-p (looking-at "\\s *\\(?:--\\)?\\]\\(?1:=*\\)\\]"))) + (save-excursion + (goto-char (lua-comment-or-string-start-pos)) + (+ (current-indentation) + (if (and left-shifter-p + (looking-at (format "--\\[%s\\[" + (match-string-no-properties 1)))) + 0 + lua-indent-level)))))) + + +(defun lua--signum (x) + "Return 1 if X is positive, -1 if negative, 0 if zero." + ;; XXX: backport from cl-extras for Emacs24 + (cond ((> x 0) 1) ((< x 0) -1) (t 0))) + +(defun lua--ensure-point-within-limit (limit backward) + "Return non-nil if point is within LIMIT going forward. + +With BACKWARD non-nil, return non-nil if point is within LIMIT +going backward. + +If point is beyond limit, move it onto limit." + (if (= (lua--signum (- (point) limit)) + (if backward 1 -1)) + t + (goto-char limit) + nil)) + + +(defun lua--escape-from-string (&optional backward) + "Move point outside of string if it is inside one. + +By default, point is placed after the string, with BACKWARD it is +placed before the string." + (interactive) + (let ((parse-state (syntax-ppss))) + (when (nth 3 parse-state) + (if backward + (goto-char (nth 8 parse-state)) + (parse-partial-sexp (point) (line-end-position) nil nil (syntax-ppss) 'syntax-table)) + t))) + + +(defun lua-find-regexp (direction regexp &optional limit) + "Searches for a regular expression in the direction specified. + +Direction is one of 'forward and 'backward. + +Matches in comments and strings are ignored. If the regexp is +found, returns point position, nil otherwise." + (let ((search-func (if (eq direction 'forward) + 're-search-forward 're-search-backward)) + (case-fold-search nil)) + (cl-loop + always (or (null limit) + (lua--ensure-point-within-limit limit (not (eq direction 'forward)))) + always (funcall search-func regexp limit 'noerror) + for match-beg = (match-beginning 0) + for match-end = (match-end 0) + while (or (lua-comment-or-string-p match-beg) + (lua-comment-or-string-p match-end)) + do (let ((parse-state (syntax-ppss))) + (cond + ;; Inside a string + ((nth 3 parse-state) + (lua--escape-from-string (not (eq direction 'forward)))) + ;; Inside a comment + ((nth 4 parse-state) + (goto-char (nth 8 parse-state)) + (when (eq direction 'forward) + (forward-comment 1))))) + finally return (point)))) + + +(defconst lua-block-regexp + (eval-when-compile + (concat + "\\(\\_<" + (regexp-opt '("do" "function" "repeat" "then" + "else" "elseif" "end" "until") t) + "\\_>\\)\\|" + (regexp-opt '("{" "(" "[" "]" ")" "}") t)))) + +(defconst lua-block-token-alist + '(("do" "\\_" "\\_" middle-or-open) + ("function" "\\_" nil open) + ("repeat" "\\_" nil open) + ("then" "\\_<\\(e\\(lse\\(if\\)?\\|nd\\)\\)\\_>" "\\_<\\(else\\)?if\\_>" middle) + ("{" "}" nil open) + ("[" "]" nil open) + ("(" ")" nil open) + ("if" "\\_" nil open) + ("for" "\\_" nil open) + ("while" "\\_" nil open) + ("else" "\\_" "\\_" middle) + ("elseif" "\\_" "\\_" middle) + ("end" nil "\\_<\\(do\\|function\\|then\\|else\\)\\_>" close) + ("until" nil "\\_" close) + ("}" nil "{" close) + ("]" nil "\\[" close) + (")" nil "(" close)) + "This is a list of block token information blocks. +Each token information entry is of the form: + KEYWORD FORWARD-MATCH-REGEXP BACKWARDS-MATCH-REGEXP TOKEN-TYPE +KEYWORD is the token. +FORWARD-MATCH-REGEXP is a regexp that matches all possible tokens when going forward. +BACKWARDS-MATCH-REGEXP is a regexp that matches all possible tokens when going backwards. +TOKEN-TYPE determines where the token occurs on a statement. open indicates that the token appears at start, close indicates that it appears at end, middle indicates that it is a middle type token, and middle-or-open indicates that it can appear both as a middle or an open type.") + +(defconst lua-indentation-modifier-regexp + ;; The absence of else is deliberate, since it does not modify the + ;; indentation level per se. It only may cause the line, in which the + ;; else is, to be shifted to the left. + (concat + "\\(\\_<" + (regexp-opt '("do" "function" "repeat" "then" "if" "else" "elseif" "for" "while") t) + "\\_>\\|" + (regexp-opt '("{" "(" "[")) + "\\)\\|\\(\\_<" + (regexp-opt '("end" "until") t) + "\\_>\\|" + (regexp-opt '("]" ")" "}")) + "\\)") + ) + +(defun lua-get-block-token-info (token) + "Returns the block token info entry for TOKEN from lua-block-token-alist" + (assoc token lua-block-token-alist)) + +(defun lua-get-token-match-re (token-info direction) + "Returns the relevant match regexp from token info" + (cond + ((eq direction 'forward) (cadr token-info)) + ((eq direction 'backward) (nth 2 token-info)) + (t nil))) + +(defun lua-get-token-type (token-info) + "Returns the relevant match regexp from token info" + (nth 3 token-info)) + +(defun lua-backwards-to-block-begin-or-end () + "Move backwards to nearest block begin or end. Returns nil if not successful." + (interactive) + (lua-find-regexp 'backward lua-block-regexp)) + +(defun lua-find-matching-token-word (token &optional direction) + "Find matching open- or close-token for TOKEN in DIRECTION. +Point has to be exactly at the beginning of TOKEN, e.g. with | being point + + {{ }|} -- (lua-find-matching-token-word \"}\" 'backward) will return + -- the first { + {{ |}} -- (lua-find-matching-token-word \"}\" 'backward) will find + -- the second {. + +DIRECTION has to be either 'forward or 'backward." + (let* ((token-info (lua-get-block-token-info token)) + (match-type (lua-get-token-type token-info)) + ;; If we are on a middle token, go backwards. If it is a middle or open, + ;; go forwards + (search-direction (or direction + (if (or (eq match-type 'open) + (eq match-type 'middle-or-open)) + 'forward + 'backward) + 'backward)) + (match (lua-get-token-match-re token-info search-direction)) + maybe-found-pos) + ;; if we are searching forward from the token at the current point + ;; (i.e. for a closing token), need to step one character forward + ;; first, or the regexp will match the opening token. + (if (eq search-direction 'forward) (forward-char 1)) + (catch 'found + ;; If we are attempting to find a matching token for a terminating token + ;; (i.e. a token that starts a statement when searching back, or a token + ;; that ends a statement when searching forward), then we don't need to look + ;; any further. + (if (or (and (eq search-direction 'forward) + (eq match-type 'close)) + (and (eq search-direction 'backward) + (eq match-type 'open))) + (throw 'found nil)) + (while (lua-find-regexp search-direction lua-indentation-modifier-regexp) + ;; have we found a valid matching token? + (let ((found-token (match-string 0)) + (found-pos (match-beginning 0))) + (let ((found-type (lua-get-token-type + (lua-get-block-token-info found-token)))) + (if (not (and match (string-match match found-token))) + ;; no - then there is a nested block. If we were looking for + ;; a block begin token, found-token must be a block end + ;; token; likewise, if we were looking for a block end token, + ;; found-token must be a block begin token, otherwise there + ;; is a grammatical error in the code. + (if (not (and + (or (eq match-type 'middle) + (eq found-type 'middle) + (eq match-type 'middle-or-open) + (eq found-type 'middle-or-open) + (eq match-type found-type)) + (goto-char found-pos) + (lua-find-matching-token-word found-token + search-direction))) + (when maybe-found-pos + (goto-char maybe-found-pos) + (throw 'found maybe-found-pos))) + ;; yes. + ;; if it is a not a middle kind, report the location + (when (not (or (eq found-type 'middle) + (eq found-type 'middle-or-open))) + (throw 'found found-pos)) + ;; if it is a middle-or-open type, record location, but keep searching. + ;; If we fail to complete the search, we'll report the location + (when (eq found-type 'middle-or-open) + (setq maybe-found-pos found-pos)) + ;; Cannot use tail recursion. too much nesting on long chains of + ;; if/elseif. Will reset variables instead. + (setq token found-token) + (setq token-info (lua-get-block-token-info token)) + (setq match (lua-get-token-match-re token-info search-direction)) + (setq match-type (lua-get-token-type token-info)))))) + maybe-found-pos))) + +(defun lua-goto-matching-block-token (&optional parse-start direction) + "Find block begion/end token matching the one at the point. +This function moves the point to the token that matches the one +at the current point. Returns the point position of the first character of +the matching token if successful, nil otherwise. + +Optional PARSE-START is a position to which the point should be moved first. +DIRECTION has to be 'forward or 'backward ('forward by default)." + (if parse-start (goto-char parse-start)) + (let ((case-fold-search nil)) + (if (looking-at lua-indentation-modifier-regexp) + (let ((position (lua-find-matching-token-word (match-string 0) + direction))) + (and position + (goto-char position)))))) + +(defun lua-goto-matching-block (&optional noreport) + "Go to the keyword balancing the one under the point. +If the point is on a keyword/brace that starts a block, go to the +matching keyword that ends the block, and vice versa. + +If optional NOREPORT is non-nil, it won't flag an error if there +is no block open/close open." + (interactive) + ;; search backward to the beginning of the keyword if necessary + (when (and (eq (char-syntax (following-char)) ?w) + (not (looking-at "\\_<"))) + (re-search-backward "\\_<" nil t)) + (let ((position (lua-goto-matching-block-token))) + (if (and (not position) + (not noreport)) + (error "Not on a block control keyword or brace") + position))) + +(defun lua-skip-ws-and-comments-backward (&optional limit) + "Move point back skipping all whitespace and comments. + +If LIMIT is given, stop at it or before. + +Return non-nil if moved point." + (interactive) + (unless (lua-string-p) + (let ((start-pos (point)) + (comment-start-pos (lua-comment-start-pos))) + (setq limit (min (point) (or limit (point-min)))) + (when comment-start-pos + (goto-char (max limit comment-start-pos))) + (when (< limit (point)) (forward-comment (- limit (point)))) + (when (< (point) limit) (goto-char limit)) + (when (/= start-pos (point)) + (point))))) + +(defun lua-skip-ws-and-comments-forward (&optional limit) + "Move point forward skipping all whitespace and comments. + +If LIMIT is given, stop at it or before. + +Return non-nil if moved point." + (interactive) + (unless (lua-string-p) + (let ((start-pos (point)) + (comment-start-pos (lua-comment-start-pos))) + (setq limit (max (point) (or limit (point-max)))) + ;; Escape from current comment. It is necessary to use "while" because + ;; luadoc parameters have non-comment face, and parse-partial-sexp with + ;; 'syntax-table flag will stop on them. + (when comment-start-pos + (goto-char comment-start-pos) + (forward-comment 1)) + (when (< (point) limit) (forward-comment (- limit (point)))) + (when (< limit (point)) (goto-char limit)) + (when (/= start-pos (point)) + (point))))) + + +(defun lua-forward-line-skip-blanks (&optional back) + "Move 1 line forward/backward and skip all insignificant ws/comment lines. + +Moves point 1 line forward (or backward) skipping lines that contain +no Lua code besides comments. The point is put to the beginning of +the line. + +Returns final value of point as integer or nil if operation failed." + (let ((start-pos (point))) + (if back + (progn + (beginning-of-line) + (lua-skip-ws-and-comments-backward)) + (forward-line) + (lua-skip-ws-and-comments-forward)) + (beginning-of-line) + (when (> (count-lines start-pos (point)) 0) + (point)))) + +(eval-when-compile + (defconst lua-operator-class + "-+*/^.=<>~:&|")) + +(defconst lua-cont-eol-regexp + (eval-when-compile + (concat + "\\(?:\\(?1:\\_<" + (regexp-opt '("and" "or" "not" "in" "for" "while" + "local" "function" "if" "until" "elseif" "return") + t) + "\\_>\\)\\|" + "\\(?:^\\|[^" lua-operator-class "]\\)\\(?2:" + (regexp-opt '("+" "-" "*" "/" "%" "^" ".." "==" + "=" "<" ">" "<=" ">=" "~=" "." ":" + "&" "|" "~" ">>" "<<" "~" ",") + t) + "\\)\\)" + "\\s *\\=")) + "Regexp that matches the ending of a line that needs continuation. + +This regexp starts from eol and looks for a binary operator or an unclosed +block intro (i.e. 'for' without 'do' or 'if' without 'then') followed by +an optional whitespace till the end of the line.") + +(defconst lua-cont-bol-regexp + (eval-when-compile + (concat + "\\=\\s *" + "\\(?:\\(?1:\\_<" + (regexp-opt '("and" "or" "not" "in") t) + "\\_>\\)\\|\\(?2:" + (regexp-opt '("," "+" "-" "*" "/" "%" "^" ".." "==" + "=" "<" ">" "<=" ">=" "~=" "." ":" + "&" "|" "~" ">>" "<<" "~") + t) + "\\)\\(?:$\\|[^" lua-operator-class "]\\)" + "\\)")) + "Regexp that matches a line that continues previous one. + +This regexp means, starting from point there is an optional whitespace followed +by Lua binary operator. Lua is very liberal when it comes to continuation line, +so we're safe to assume that every line that starts with a binop continues +previous one even though it looked like an end-of-statement.") + +(defun lua-last-token-continues-p () + "Return non-nil if the last token on this line is a continuation token." + (let ((line-begin (line-beginning-position)) + return-value) + (save-excursion + (end-of-line) + (lua-skip-ws-and-comments-backward line-begin) + (setq return-value (and (re-search-backward lua-cont-eol-regexp line-begin t) + (or (match-beginning 1) + (match-beginning 2)))) + (if (and return-value + (string-equal (match-string-no-properties 0) "return")) + ;; "return" keyword is ambiguous and depends on next token + (unless (save-excursion + (goto-char (match-end 0)) + (forward-comment (point-max)) + (and + ;; Not continuing: at end of file + (not (eobp)) + (or + ;; "function" keyword: it is a continuation, e.g. + ;; + ;; return + ;; function() return 123 end + ;; + (looking-at (lua-rx (symbol "function"))) + ;; Looking at semicolon or any other keyword: not continuation + (not (looking-at (lua-rx (or ";" lua-keyword))))))) + (setq return-value nil))) + return-value))) + + +(defun lua-first-token-continues-p () + "Return non-nil if the first token on this line is a continuation token." + (let ((line-end (line-end-position))) + (save-excursion + (beginning-of-line) + (lua-skip-ws-and-comments-forward line-end) + ;; if first character of the line is inside string, it's a continuation + ;; if strings aren't supposed to be indented, `lua-calculate-indentation' won't even let + ;; the control inside this function + (and + (re-search-forward lua-cont-bol-regexp line-end t) + (or (match-beginning 1) + (match-beginning 2)))))) + + +(defun lua--backward-up-list-noerror () + "Safe version of lua-backward-up-list that does not signal an error." + (condition-case nil + (lua-backward-up-list) + (scan-error nil))) + + +(defun lua-backward-up-list () + "Goto starter/opener of the block that contains point." + (interactive) + (let ((start-pos (point)) + end-pos) + (or + ;; Return parent block opener token if it exists. + (cl-loop + ;; Search indentation modifier backward, return nil on failure. + always (lua-find-regexp 'backward lua-indentation-modifier-regexp) + ;; Fetch info about the found token + for token = (match-string-no-properties 0) + for token-info = (lua-get-block-token-info token) + for token-type = (lua-get-token-type token-info) + ;; If the token is a close token, continue to skip its opener. If not + ;; close, stop and return found token. + while (eq token-type 'close) + ;; Find matching opener to skip it and continue from beginning. + ;; + ;; Return nil on failure. + always (let ((position (lua-find-matching-token-word token 'backward))) + (and position (goto-char position))) + finally return token-info) + (progn + (setq end-pos (point)) + (goto-char start-pos) + (signal 'scan-error + (list "Block open token not found" + ;; If start-pos == end-pos, the "obstacle" is current + (if (eql start-pos end-pos) start-pos (match-beginning 0)) + (if (eql start-pos end-pos) start-pos (match-end 0)))))))) + +(defun lua--continuation-breaking-line-p () + "Return non-nil if looking at token(-s) that forbid continued line." + (save-excursion + (lua-skip-ws-and-comments-forward (line-end-position)) + (looking-at (lua-rx (or (symbol "do" "while" "repeat" "until" + "if" "then" "elseif" "else" + "for" "local") + lua-funcheader))))) + + +(defun lua-is-continuing-statement-p-1 () + "Return non-nil if current lined continues a statement. + +More specifically, return the point in the line that is continued. +The criteria for a continuing statement are: + +* the last token of the previous line is a continuing op, + OR the first token of the current line is a continuing op + +* the expression is not enclosed by a parentheses/braces/brackets" + (let (prev-line continuation-pos parent-block-opener) + (save-excursion (setq prev-line (lua-forward-line-skip-blanks 'back))) + (and prev-line + (not (lua--continuation-breaking-line-p)) + (save-excursion + (or + ;; Binary operator or keyword that implies continuation. + (and (setq continuation-pos + (or (lua-first-token-continues-p) + (save-excursion (and (goto-char prev-line) + ;; check last token of previous nonblank line + (lua-last-token-continues-p))))) + (not + ;; Operators/keywords does not create continuation inside some blocks: + (and + (setq parent-block-opener (car-safe (lua--backward-up-list-noerror))) + (or + ;; - inside parens/brackets + (member parent-block-opener '("(" "[")) + ;; - inside braces if it is a comma + (and (eq (char-after continuation-pos) ?,) + (equal parent-block-opener "{"))))) + continuation-pos)))))) + + +(defun lua-is-continuing-statement-p (&optional parse-start) + "Returns non-nil if the line at PARSE-START should be indented as continuation line. + +This true is when the line : + +* is continuing a statement itself + +* starts with a 1+ block-closer tokens, an top-most block opener is on a continuation line +" + (save-excursion + (if parse-start (goto-char parse-start)) + + ;; If line starts with a series of closer tokens, whether or not the line + ;; is a continuation line is decided by the opener line, e.g. + ;; + ;; x = foo + + ;; long_function_name( + ;; long_parameter_1, + ;; long_parameter_2, + ;; long_parameter_3, + ;; ) + long_function_name2({ + ;; long_parameter_1, + ;; long_parameter_2, + ;; long_parameter_3, + ;; }) + ;; + ;; Final line, "})" is a continuation line, but it is decided by the + ;; opener line, ") + long_function_name2({", which in its turn is decided + ;; by the "long_function_name(" line, which is a continuation line + ;; because the line before it ends with a binary operator. + (cl-loop + ;; Go to opener line + while (and (lua--goto-line-beginning-rightmost-closer) + (lua--backward-up-list-noerror)) + ;; If opener line is continuing, repeat. If opener line is not + ;; continuing, return nil. + always (lua-is-continuing-statement-p-1) + ;; We get here if there was no opener to go to: check current line. + finally return (lua-is-continuing-statement-p-1)))) + +(defun lua-make-indentation-info-pair (found-token found-pos) + "Create a pair from FOUND-TOKEN and FOUND-POS for indentation calculation. + +This is a helper function to lua-calculate-indentation-info. +Don't use standalone." + (cond + ;; function is a bit tricky to indent right. They can appear in a lot ot + ;; different contexts. Until I find a shortcut, I'll leave it with a simple + ;; relative indentation. + ;; The special cases are for indenting according to the location of the + ;; function. i.e.: + ;; (cons 'absolute (+ (current-column) lua-indent-level)) + ;; TODO: Fix this. It causes really ugly indentations for in-line functions. + ((string-equal found-token "function") + (cons 'relative lua-indent-level)) + + ;; block openers + ((and lua-indent-nested-block-content-align + (member found-token (list "{" "(" "["))) + (save-excursion + (let ((found-bol (line-beginning-position))) + (forward-comment (point-max)) + ;; If the next token is on this line and it's not a block opener, + ;; the next line should align to that token. + (if (and (zerop (count-lines found-bol (line-beginning-position))) + (not (looking-at lua-indentation-modifier-regexp))) + (cons 'absolute (current-column)) + (cons 'relative lua-indent-level))))) + + ;; These are not really block starters. They should not add to indentation. + ;; The corresponding "then" and "do" handle the indentation. + ((member found-token (list "if" "for" "while")) + (cons 'relative 0)) + ;; closing tokens follow: These are usually taken care of by + ;; lua-calculate-indentation-override. + ;; elseif is a bit of a hack. It is not handled separately, but it needs to + ;; nullify a previous then if on the same line. + ((member found-token (list "until" "elseif")) + (save-excursion + (let* ((line-beginning (line-beginning-position)) + (same-line (and (lua-goto-matching-block-token found-pos 'backward) + (<= line-beginning (point))))) + (if same-line + (cons 'remove-matching 0) + (cons 'relative 0))))) + + ;; else is a special case; if its matching block token is on the same line, + ;; instead of removing the matching token, it has to replace it, so that + ;; either the next line will be indented correctly, or the end on the same + ;; line will remove the effect of the else. + ((string-equal found-token "else") + (save-excursion + (let* ((line-beginning (line-beginning-position)) + (same-line (and (lua-goto-matching-block-token found-pos 'backward) + (<= line-beginning (point))))) + (if same-line + (cons 'replace-matching (cons 'relative lua-indent-level)) + (cons 'relative lua-indent-level))))) + + ;; Block closers. If they are on the same line as their openers, they simply + ;; eat up the matching indentation modifier. Otherwise, they pull + ;; indentation back to the matching block opener. + ((member found-token (list ")" "}" "]" "end")) + (save-excursion + (let* ((line-beginning (line-beginning-position)) + (same-line (and (lua-goto-matching-block-token found-pos 'backward) + (<= line-beginning (point)))) + (opener-pos (point)) + opener-continuation-offset) + (if same-line + (cons 'remove-matching 0) + (back-to-indentation) + (setq opener-continuation-offset + (if (lua-is-continuing-statement-p-1) lua-indent-level 0)) + + ;; Accumulate indentation up to opener, including indentation. If + ;; there were no other indentation modifiers until said opener, + ;; ensure there is no continuation after the closer. + `(multiple . ((absolute . ,(- (current-indentation) opener-continuation-offset)) + ,@(when (/= opener-continuation-offset 0) + (list (cons 'continued-line opener-continuation-offset))) + ,@(delete nil (list (lua-calculate-indentation-info-1 nil opener-pos))) + (cancel-continued-line . nil))))))) + + ((member found-token '("do" "then")) + `(multiple . ((cancel-continued-line . nil) (relative . ,lua-indent-level)))) + + ;; Everything else. This is from the original code: If opening a block + ;; (match-data 1 exists), then push indentation one level up, if it is + ;; closing a block, pull it one level down. + ('other-indentation-modifier + (cons 'relative (if (nth 2 (match-data)) + ;; beginning of a block matched + lua-indent-level + ;; end of a block matched + (- lua-indent-level)))))) + +(defun lua-add-indentation-info-pair (pair info-list) + "Add the given indentation info PAIR to the list of indentation INFO-LIST. +This function has special case handling for two tokens: remove-matching, +and replace-matching. These two tokens are cleanup tokens that remove or +alter the effect of a previously recorded indentation info. + +When a remove-matching token is encountered, the last recorded info, i.e. +the car of the list is removed. This is used to roll-back an indentation of a +block opening statement when it is closed. + +When a replace-matching token is seen, the last recorded info is removed, +and the cdr of the replace-matching info is added in its place. This is used +when a middle-of the block (the only case is 'else') is seen on the same line +the block is opened." + (cond + ( (eq 'multiple (car pair)) + (let ((info-pair-elts (cdr pair))) + (while info-pair-elts + (setq info-list (lua-add-indentation-info-pair (car info-pair-elts) info-list) + info-pair-elts (cdr info-pair-elts))) + info-list)) + ( (eq 'cancel-continued-line (car pair)) + (if (eq (caar info-list) 'continued-line) + (cdr info-list) + info-list)) + ( (eq 'remove-matching (car pair)) + ;; Remove head of list + (cdr info-list)) + ( (eq 'replace-matching (car pair)) + ;; remove head of list, and add the cdr of pair instead + (cons (cdr pair) (cdr info-list))) + ( (listp (cdr-safe pair)) + (nconc pair info-list)) + ( t + ;; Just add the pair + (cons pair info-list)))) + +(defun lua-calculate-indentation-info-1 (indentation-info bound) + "Helper function for `lua-calculate-indentation-info'. + +Return list of indentation modifiers from point to BOUND." + (while (lua-find-regexp 'forward lua-indentation-modifier-regexp + bound) + (let ((found-token (match-string 0)) + (found-pos (match-beginning 0))) + (setq indentation-info + (lua-add-indentation-info-pair + (lua-make-indentation-info-pair found-token found-pos) + indentation-info)))) + indentation-info) + + +(defun lua-calculate-indentation-info (&optional parse-end) + "For each block token on the line, computes how it affects the indentation. +The effect of each token can be either a shift relative to the current +indentation level, or indentation to some absolute column. This information +is collected in a list of indentation info pairs, which denote absolute +and relative each, and the shift/column to indent to." + (let (indentation-info cont-stmt-pos) + (while (setq cont-stmt-pos (lua-is-continuing-statement-p)) + (lua-forward-line-skip-blanks 'back) + (when (< cont-stmt-pos (point)) + (goto-char cont-stmt-pos))) + + ;; calculate indentation modifiers for the line itself + (setq indentation-info (list (cons 'absolute (current-indentation)))) + + (back-to-indentation) + (setq indentation-info + (lua-calculate-indentation-info-1 + indentation-info (min parse-end (line-end-position)))) + + ;; and do the following for each continuation line before PARSE-END + (while (and (eql (forward-line 1) 0) + (<= (point) parse-end)) + + ;; handle continuation lines: + (if (lua-is-continuing-statement-p) + ;; if it's the first continuation line, add one level + (unless (eq (car (car indentation-info)) 'continued-line) + (push (cons 'continued-line lua-indent-level) indentation-info)) + + ;; if it's the first non-continued line, subtract one level + (when (eq (car (car indentation-info)) 'continued-line) + (push (cons 'stop-continued-line (- lua-indent-level)) indentation-info))) + + ;; add modifiers found in this continuation line + (setq indentation-info + (lua-calculate-indentation-info-1 + indentation-info (min parse-end (line-end-position))))) + + indentation-info)) + + +(defun lua-accumulate-indentation-info (reversed-indentation-info) + "Accumulates the indentation information previously calculated by +lua-calculate-indentation-info. Returns either the relative indentation +shift, or the absolute column to indent to." + (let (indentation-info + (type 'relative) + (accu 0)) + ;; Aggregate all neighbouring relative offsets, reversing the INFO list. + (cl-dolist (elt reversed-indentation-info) + (if (and (eq (car elt) 'relative) + (eq (caar indentation-info) 'relative)) + (setcdr (car indentation-info) (+ (cdar indentation-info) (cdr elt))) + (push elt indentation-info))) + + ;; Aggregate indentation info, taking 'absolute modifiers into account. + (mapc (lambda (x) + (let ((new-val (cdr x))) + (if (eq 'absolute (car x)) + (progn (setq type 'absolute + accu new-val)) + (setq accu (+ accu new-val))))) + indentation-info) + + (cons type accu))) + +(defun lua-calculate-indentation-block-modifier (&optional parse-end) + "Return amount by which this line modifies the indentation. +Beginnings of blocks add lua-indent-level once each, and endings +of blocks subtract lua-indent-level once each. This function is used +to determine how the indentation of the following line relates to this +one." + (let (indentation-info) + (save-excursion + ;; First go back to the line that starts it all + ;; lua-calculate-indentation-info will scan through the whole thing + (let ((case-fold-search nil)) + (setq indentation-info + (lua-accumulate-indentation-info + (lua-calculate-indentation-info parse-end))))) + + (if (eq (car indentation-info) 'absolute) + (- (cdr indentation-info) (current-indentation)) + (cdr indentation-info)))) + + +(eval-when-compile + (defconst lua--function-name-rx + '(seq symbol-start + (+ (any alnum "_")) + (* "." (+ (any alnum "_"))) + (? ":" (+ (any alnum "_"))) + symbol-end) + "Lua function name regexp in `rx'-SEXP format.")) + + +(defconst lua--left-shifter-regexp + (eval-when-compile + (rx + ;; This regexp should answer the following questions: + ;; 1. is there a left shifter regexp on that line? + ;; 2. where does block-open token of that left shifter reside? + (or (seq (group-n 1 symbol-start "local" (+ blank)) "function" symbol-end) + + (seq (group-n 1 (eval lua--function-name-rx) (* blank)) (any "{(")) + (seq (group-n 1 (or + ;; assignment statement prefix + (seq (* nonl) (not (any "<=>~")) "=" (* blank)) + ;; return statement prefix + (seq word-start "return" word-end (* blank)))) + ;; right hand side + (or "{" + "function" + "(" + (seq (group-n 1 (eval lua--function-name-rx) (* blank)) + (any "({"))))))) + + "Regular expression that matches left-shifter expression. + +Left-shifter expression is defined as follows. If a block +follows a left-shifter expression, its contents & block-close +token should be indented relative to left-shifter expression +indentation rather then to block-open token. + +For example: + -- 'local a = ' is a left-shifter expression + -- 'function' is a block-open token + local a = function() + -- block contents is indented relative to left-shifter + foobarbaz() + -- block-end token is unindented to left-shifter indentation + end + +The following left-shifter expressions are currently handled: +1. local function definition with function block, begin-end +2. function call with arguments block, () or {} +3. assignment/return statement with + - table constructor block, {} + - function call arguments block, () or {} block + - function expression a.k.a. lambda, begin-end block.") + + +(defun lua-point-is-after-left-shifter-p () + "Check if point is right after a left-shifter expression. + +See `lua--left-shifter-regexp' for description & example of +left-shifter expression. " + (save-excursion + (let ((old-point (point))) + (back-to-indentation) + (and + (/= (point) old-point) + (looking-at lua--left-shifter-regexp) + (= old-point (match-end 1)))))) + +(defun lua--goto-line-beginning-rightmost-closer (&optional parse-start) + (let (case-fold-search pos line-end-pos return-val) + (save-excursion + (if parse-start (goto-char parse-start)) + (setq line-end-pos (line-end-position)) + (back-to-indentation) + (unless (lua-comment-or-string-p) + (cl-loop while (and (<= (point) line-end-pos) + (looking-at lua-indentation-modifier-regexp)) + for token-info = (lua-get-block-token-info (match-string 0)) + for token-type = (lua-get-token-type token-info) + while (not (eq token-type 'open)) + do (progn + (setq pos (match-beginning 0) + return-val token-info) + (goto-char (match-end 0)) + (forward-comment (line-end-position)))))) + (when pos + (progn + (goto-char pos) + return-val)))) + + +(defun lua-calculate-indentation-override (&optional parse-start) + "Return overriding indentation amount for special cases. + +If there's a sequence of block-close tokens starting at the +beginning of the line, calculate indentation according to the +line containing block-open token for the last block-close token +in the sequence. + +If not, return nil." + (let (case-fold-search rightmost-closer-info opener-info opener-pos) + (save-excursion + (when (and (setq rightmost-closer-info (lua--goto-line-beginning-rightmost-closer parse-start)) + (setq opener-info (lua--backward-up-list-noerror)) + ;; Ensure opener matches closer. + (string-match (lua-get-token-match-re rightmost-closer-info 'backward) + (car opener-info))) + + ;; Special case: "middle" tokens like for/do, while/do, if/then, + ;; elseif/then: corresponding "end" or corresponding "else" must be + ;; unindented to the beginning of the statement, which is not + ;; necessarily the same as beginning of string that contains "do", e.g. + ;; + ;; while ( + ;; foo and + ;; bar) do + ;; hello_world() + ;; end + (setq opener-pos (point)) + (when (/= (- opener-pos (line-beginning-position)) (current-indentation)) + (unless (or + (and (string-equal (car opener-info) "do") + (member (car (lua--backward-up-list-noerror)) '("while" "for"))) + (and (string-equal (car opener-info) "then") + (member (car (lua--backward-up-list-noerror)) '("if" "elseif")))) + (goto-char opener-pos))) + + ;; (let (cont-stmt-pos) + ;; (while (setq cont-stmt-pos (lua-is-continuing-statement-p)) + ;; (goto-char cont-stmt-pos))) + ;; Exception cases: when the start of the line is an assignment, + ;; go to the start of the assignment instead of the matching item + (if (and lua-indent-close-paren-align + (member (car opener-info) '("{" "(" "[")) + (not (lua-point-is-after-left-shifter-p))) + (current-column) + (current-indentation)))))) + + +(defun lua-calculate-indentation () + "Return appropriate indentation for current line as Lua code." + (save-excursion + (let ((cur-line-begin-pos (line-beginning-position))) + (or + ;; when calculating indentation, do the following: + ;; 1. check, if the line starts with indentation-modifier (open/close brace) + ;; and if it should be indented/unindented in special way + (lua-calculate-indentation-override) + + (when (lua-forward-line-skip-blanks 'back) + ;; the order of function calls here is important. block modifier + ;; call may change the point to another line + (let* ((modifier + (lua-calculate-indentation-block-modifier cur-line-begin-pos))) + (+ (current-indentation) modifier))) + + ;; 4. if there's no previous line, indentation is 0 + 0)))) + +(defvar lua--beginning-of-defun-re + (lua-rx-to-string '(: bol (? (symbol "local") ws+) lua-funcheader)) + "Lua top level (matches only at the beginning of line) function header regex.") + + +(defun lua-beginning-of-proc (&optional arg) + "Move backward to the beginning of a Lua proc (or similar). + +With argument, do it that many times. Negative arg -N +means move forward to Nth following beginning of proc. + +Returns t unless search stops due to beginning or end of buffer." + (interactive "P") + (or arg (setq arg 1)) + + (while (and (> arg 0) + (re-search-backward lua--beginning-of-defun-re nil t)) + (setq arg (1- arg))) + + (while (and (< arg 0) + (re-search-forward lua--beginning-of-defun-re nil t)) + (beginning-of-line) + (setq arg (1+ arg))) + + (zerop arg)) + +(defun lua-end-of-proc (&optional arg) + "Move forward to next end of Lua proc (or similar). +With argument, do it that many times. Negative argument -N means move +back to Nth preceding end of proc. + +This function just searches for a `end' at the beginning of a line." + (interactive "P") + (or arg + (setq arg 1)) + (let ((found nil) + (ret t)) + (if (and (< arg 0) + (not (bolp)) + (save-excursion + (beginning-of-line) + (eq (following-char) ?}))) + (forward-char -1)) + (while (> arg 0) + (if (re-search-forward "^end" nil t) + (setq arg (1- arg) + found t) + (setq ret nil + arg 0))) + (while (< arg 0) + (if (re-search-backward "^end" nil t) + (setq arg (1+ arg) + found t) + (setq ret nil + arg 0))) + (if found + (progn + (beginning-of-line) + (forward-line))) + ret)) + +(defvar lua-process-init-code + (mapconcat + 'identity + '("local loadstring = loadstring or load" + "function luamode_loadstring(str, displayname, lineoffset)" + " if lineoffset > 1 then" + " str = string.rep('\\n', lineoffset - 1) .. str" + " end" + "" + " local x, e = loadstring(str, '@'..displayname)" + " if e then" + " error(e)" + " end" + " return x()" + "end") + " ")) + +(defun lua-make-lua-string (str) + "Convert string to Lua literal." + (save-match-data + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (while (re-search-forward "[\"'\\\t\\\n]" nil t) + (cond + ((string= (match-string 0) "\n") + (replace-match "\\\\n")) + ((string= (match-string 0) "\t") + (replace-match "\\\\t")) + (t + (replace-match "\\\\\\&" t)))) + (concat "'" (buffer-string) "'")))) + +;;;###autoload +(defalias 'run-lua #'lua-start-process) + +;;;###autoload +(defun lua-start-process (&optional name program startfile &rest switches) + "Start a Lua process named NAME, running PROGRAM. +PROGRAM defaults to NAME, which defaults to `lua-default-application'. +When called interactively, switch to the process buffer." + (interactive) + (setq name (or name (if (consp lua-default-application) + (car lua-default-application) + lua-default-application))) + (setq program (or program lua-default-application)) + ;; don't re-initialize if there already is a lua process + (unless (comint-check-proc (format "*%s*" name)) + (setq lua-process-buffer (apply #'make-comint name program startfile + (or switches lua-default-command-switches))) + (setq lua-process (get-buffer-process lua-process-buffer)) + (set-process-query-on-exit-flag lua-process nil) + (with-current-buffer lua-process-buffer + ;; enable error highlighting in stack traces + (require 'compile) + (setq lua--repl-buffer-p t) + (make-local-variable 'compilation-error-regexp-alist) + (setq compilation-error-regexp-alist + (cons (list lua-traceback-line-re 1 2) + compilation-error-regexp-alist)) + (compilation-shell-minor-mode 1) + (setq-local comint-prompt-regexp lua-prompt-regexp) + + ;; Don't send initialization code until seeing the prompt to ensure that + ;; the interpreter is ready. + (while (not (lua-prompt-line)) + (accept-process-output (get-buffer-process (current-buffer))) + (goto-char (point-max))) + (lua-send-string lua-process-init-code))) + + ;; when called interactively, switch to process buffer + (if (called-interactively-p 'any) + (switch-to-buffer lua-process-buffer))) + +(defun lua-get-create-process () + "Return active Lua process creating one if necessary." + (lua-start-process) + lua-process) + +(defun lua-kill-process () + "Kill Lua process and its buffer." + (interactive) + (when (buffer-live-p lua-process-buffer) + (kill-buffer lua-process-buffer) + (setq lua-process-buffer nil))) + +(defun lua-set-lua-region-start (&optional arg) + "Set start of region for use with `lua-send-lua-region'." + (interactive) + (set-marker lua-region-start (or arg (point)))) + +(defun lua-set-lua-region-end (&optional arg) + "Set end of region for use with `lua-send-lua-region'." + (interactive) + (set-marker lua-region-end (or arg (point)))) + +(defun lua-send-string (str) + "Send STR plus a newline to the Lua process. + +If `lua-process' is nil or dead, start a new process first." + (unless (string-equal (substring str -1) "\n") + (setq str (concat str "\n"))) + (process-send-string (lua-get-create-process) str)) + +(defun lua-send-current-line () + "Send current line to the Lua process, found in `lua-process'. +If `lua-process' is nil or dead, start a new process first." + (interactive) + (lua-send-region (line-beginning-position) (line-end-position))) + +(defun lua-send-defun (pos) + "Send the function definition around point to the Lua process." + (interactive "d") + (save-excursion + (let ((start (if (save-match-data (looking-at "^function[ \t]")) + ;; point already at the start of "function". + ;; We need to handle this case explicitly since + ;; lua-beginning-of-proc will move to the + ;; beginning of the _previous_ function. + (point) + ;; point is not at the beginning of function, move + ;; there and bind start to that position + (lua-beginning-of-proc) + (point))) + (end (progn (lua-end-of-proc) (point)))) + + ;; make sure point is in a function definition before sending to + ;; the process + (if (and (>= pos start) (< pos end)) + (lua-send-region start end) + (error "Not on a function definition"))))) + +(defun lua-maybe-skip-shebang-line (start) + "Skip shebang (#!/path/to/interpreter/) line at beginning of buffer. + +Return a position that is after Lua-recognized shebang line (1st +character in file must be ?#) if START is at its beginning. +Otherwise, return START." + (save-restriction + (widen) + (if (and (eq start (point-min)) + (eq (char-after start) ?#)) + (save-excursion + (goto-char start) + (forward-line) + (point)) + start))) + +(defun lua-send-region (start end) + (interactive "r") + (setq start (lua-maybe-skip-shebang-line start)) + (let* ((lineno (line-number-at-pos start)) + (lua-file (or (buffer-file-name) (buffer-name))) + (region-str (buffer-substring-no-properties start end)) + (command + ;; Print empty line before executing the code so that the first line + ;; of output doesn't end up on the same line as current prompt. + (format "print(''); luamode_loadstring(%s, %s, %s);\n" + (lua-make-lua-string region-str) + (lua-make-lua-string lua-file) + lineno))) + (lua-send-string command) + (when lua-always-show (lua-show-process-buffer)))) + +(defun lua-prompt-line () + (save-excursion + (save-match-data + (forward-line 0) + (if (looking-at comint-prompt-regexp) + (match-end 0))))) + +(defun lua-send-lua-region () + "Send preset Lua region to Lua process." + (interactive) + (unless (and lua-region-start lua-region-end) + (error "lua-region not set")) + (lua-send-region lua-region-start lua-region-end)) + +(defalias 'lua-send-proc 'lua-send-defun) + +(defun lua-send-buffer () + "Send whole buffer to Lua process." + (interactive) + (lua-send-region (point-min) (point-max))) + +(defun lua-restart-with-whole-file () + "Restart Lua process and send whole file as input." + (interactive) + (lua-kill-process) + (lua-send-buffer)) + +(defun lua-show-process-buffer () + "Make sure `lua-process-buffer' is being displayed. +Create a Lua process if one doesn't already exist." + (interactive) + (display-buffer (process-buffer (lua-get-create-process)))) + + +(defun lua-hide-process-buffer () + "Delete all windows that display `lua-process-buffer'." + (interactive) + (when (buffer-live-p lua-process-buffer) + (delete-windows-on lua-process-buffer))) + +(defun lua--funcname-char-p (c) + "Check if character C is part of a function name. +Return nil if C is nil. See `lua-funcname-at-point'." + (and c (string-match-p "\\`[A-Za-z_.]\\'" (string c)))) + +(defun lua-funcname-at-point () + "Get current Name { '.' Name } sequence." + (when (or (lua--funcname-char-p (char-before)) + (lua--funcname-char-p (char-after))) + (save-excursion + (save-match-data + (re-search-backward "\\`\\|[^A-Za-z_.]") + ;; NOTE: `point' will be either at the start of the buffer or on a + ;; non-symbol character. + (re-search-forward "\\([A-Za-z_]+\\(?:\\.[A-Za-z_]+\\)*\\)") + (match-string-no-properties 1))))) + +(defun lua-search-documentation () + "Search Lua documentation for the word at the point." + (interactive) + (let ((url (concat lua-documentation-url "#pdf-" (lua-funcname-at-point)))) + (funcall lua-documentation-function url))) + +(defun lua-toggle-electric-state (&optional arg) + "Toggle the electric indentation feature. +Optional numeric ARG, if supplied, turns on electric indentation when +positive, turns it off when negative, and just toggles it when zero or +left out." + (interactive "P") + (let ((num_arg (prefix-numeric-value arg))) + (setq lua-electric-flag (cond ((or (null arg) + (zerop num_arg)) (not lua-electric-flag)) + ((< num_arg 0) nil) + ((> num_arg 0) t)))) + (message "%S" lua-electric-flag)) + +(defun lua-forward-sexp (&optional count) + "Forward to block end" + (interactive "p") + ;; negative offsets not supported + (cl-assert (or (not count) (>= count 0))) + (save-match-data + (let ((count (or count 1)) + (block-start (mapcar 'car lua-sexp-alist))) + (while (> count 0) + ;; skip whitespace + (skip-chars-forward " \t\n") + (if (looking-at (regexp-opt block-start 'words)) + (let ((keyword (match-string 1))) + (lua-find-matching-token-word keyword 'forward)) + ;; If the current keyword is not a "begin" keyword, then just + ;; perform the normal forward-sexp. + (forward-sexp 1)) + (setq count (1- count)))))) + + +;; menu bar + +(define-key lua-mode-menu [restart-with-whole-file] + '("Restart With Whole File" . lua-restart-with-whole-file)) +(define-key lua-mode-menu [kill-process] + '("Kill Process" . lua-kill-process)) + +(define-key lua-mode-menu [hide-process-buffer] + '("Hide Process Buffer" . lua-hide-process-buffer)) +(define-key lua-mode-menu [show-process-buffer] + '("Show Process Buffer" . lua-show-process-buffer)) + +(define-key lua-mode-menu [end-of-proc] + '("End Of Proc" . lua-end-of-proc)) +(define-key lua-mode-menu [beginning-of-proc] + '("Beginning Of Proc" . lua-beginning-of-proc)) + +(define-key lua-mode-menu [send-lua-region] + '("Send Lua-Region" . lua-send-lua-region)) +(define-key lua-mode-menu [set-lua-region-end] + '("Set Lua-Region End" . lua-set-lua-region-end)) +(define-key lua-mode-menu [set-lua-region-start] + '("Set Lua-Region Start" . lua-set-lua-region-start)) + +(define-key lua-mode-menu [send-current-line] + '("Send Current Line" . lua-send-current-line)) +(define-key lua-mode-menu [send-region] + '("Send Region" . lua-send-region)) +(define-key lua-mode-menu [send-proc] + '("Send Proc" . lua-send-proc)) +(define-key lua-mode-menu [send-buffer] + '("Send Buffer" . lua-send-buffer)) +(define-key lua-mode-menu [search-documentation] + '("Search Documentation" . lua-search-documentation)) + + +(provide 'lua-mode) + +;;; lua-mode.el ends here diff --git a/.emacs.d/lisp/web-mode.el b/.emacs.d/lisp/web-mode.el new file mode 100644 index 0000000..b384f97 --- /dev/null +++ b/.emacs.d/lisp/web-mode.el @@ -0,0 +1,14401 @@ +;;; web-mode.el --- major mode for editing web templates +;;; -*- coding: utf-8; lexical-binding: t; -*- + +;; Copyright 2011-2021 François-Xavier Bois + +;; Version: 17.0.4 +;; Author: François-Xavier Bois +;; Maintainer: François-Xavier Bois +;; Package-Requires: ((emacs "23.1")) +;; URL: https://web-mode.org +;; Repository: http://github.com/fxbois/web-mode +;; Created: July 2011 +;; Keywords: languages +;; License: GNU General Public License >= 2 +;; Distribution: This file is not part of Emacs + +;;; Commentary: + +;;============================================================================== +;; WEB-MODE is sponsored by ** Kernix ** Best Digital Factory & Data Lab (Paris) +;;============================================================================== + +;;; Code: + +;;---- CONSTS ------------------------------------------------------------------ + +(defconst web-mode-version "17.0.4" + "Web Mode version.") + +;;---- GROUPS ------------------------------------------------------------------ + +(defgroup web-mode nil + "Major mode for editing web templates" + :group 'languages + :prefix "web-" + :link '(url-link :tag "Site" "https://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-block-padding 0 + "Multi-line block (php, ruby, java, python, asp, etc.) left padding. + -1 to have to code aligned on the column 0." + :type '(choice (integer :tags "Number of spaces") + (const :tags "No indent" nil)) + :group 'web-mode) + +(defcustom web-mode-part-padding 1 + "Part elements (script, style) left padding." + :type '(choice (integer :tags "Number of spaces") + (const :tags "No indent" nil)) + :group 'web-mode) + +(defcustom web-mode-script-padding web-mode-part-padding + "Script element left padding." + :type '(choice (integer :tags "Number of spaces") + (const :tags "No indent" nil)) + :group 'web-mode) + +(defcustom web-mode-style-padding web-mode-part-padding + "Style element left padding." + :type '(choice (integer :tags "Number of spaces") + (const :tags "No indent" nil)) + :group 'web-mode) + +(defcustom web-mode-attr-indent-offset nil + "Html attribute indentation level." + :type '(choice (integer :tags "Number of spaces") + (const :tags "Default" nil)) + :safe #'(lambda (v) (or (integerp v) (booleanp v))) + :group 'web-mode) + +(defcustom web-mode-attr-value-indent-offset nil + "Html attribute value indentation level." + :type '(choice (integer :tags "Number of spaces") + (const :tags "Default" nil)) + :safe #'(lambda (v) (or (integerp v) (booleanp v))) + :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-comment-interpolation nil + "Enable highlight of keywords like FIXME, TODO, etc. in comments." + :type 'boolean + :group 'web-mode) + +(defcustom web-mode-enable-comment-annotation nil + "Enable annotation in comments (jsdoc, phpdoc, etc.)." + :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-curly-brace-indentation nil + "Indent lines beginning with {." + :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 + "Enable current 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 ") + (cond + ((string-match-p " lang[ ]*=[ ]*[\"']stylus" style) + (setq element-content-type "stylus")) + ((string-match-p " lang[ ]*=[ ]*[\"']sass" style) + (setq element-content-type "sass")) + (t + (setq element-content-type "css")) + ) ;cond + ) ;let + ) ;style + ((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/\\(markdown\\|template\\)" script) + (setq element-content-type "markdown")) + ((string-match-p " type[ ]*=[ ]*[\"']text/ruby" script) + (setq element-content-type "ruby")) + ((seq-some (lambda (x) + (string-match-p (concat "type[ ]*=[ ]*[\"']" x) script)) + web-mode-script-template-types) + (setq element-content-type "html" + part-close-tag nil)) + ((string-match-p " type[ ]*=[ ]*[\"']application/\\(ld\\+json\\|json\\)" script) + (setq element-content-type "json")) + ((string-match-p " lang[ ]*=[ ]*[\"']\\(typescript\\|ts\\)" script) + (setq element-content-type "typescript")) + (t + (setq element-content-type "javascript")) + ) ;cond + ) ;let + ) ;script + ((and (string= tname "template") (string-match-p " lang" (buffer-substring-no-properties tbeg tend))) + (let (template) + (setq template (buffer-substring-no-properties tbeg tend) + part-close-tag "") + (cond + ((string-match-p " lang[ ]*=[ ]*[\"']pug" template) + (setq element-content-type "pug")) + (t + (setq element-content-type "html")) + ) ;cond + ) ;let + ) ;style + ((and (string= web-mode-engine "archibus") + (string= tname "sql")) + (setq element-content-type "sql" + part-close-tag "")) + ) + + (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 + + ))) + +;; FLAGS: attr +;; (1)custom-attr (2)engine-attr (4)spread-attr[jsx] (8)code-value + +;; STATES: attr +;; (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 (or (string= web-mode-content-type "jsx") (eq (get-text-property (point) 'part-type) 'jsx))) + attr name-beg name-end val-beg char pos escaped spaced quoted) + + (while continue + + (setq pos (point) + char (char-after) + ;;spaced (eq char ?\s) + spaced (member char '(?\s ?\n)) + ) + + (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) + name-end (1- pos)) + (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))) ;#1150 + (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 nil (= 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)) + ;; (setq attr-flags (logior attr-flags 2)) + ;; ) + ((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) + (when (null flags) (setq flags 0)) + (when (and name-beg name-end web-mode-engine-attr-regexp) + (let (name) + (setq name (buffer-substring-no-properties name-beg (1+ name-end))) + ;;(message "%S" name) + (cond + ((string-match-p "^data[-]" name) + (setq flags (logior flags 1)) + ) + ((string-match-p web-mode-engine-attr-regexp name) + (setq flags (logior flags 2)) + ) + ) + ) ;name + ) + ;;(message "%S" name) + (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)) + (cond + ((null char) + (setq val-end (1- val-end))) + ((member char '(?\s ?\n ?\/)) + (setq val-end (1- val-end))) + ((eq char ?\>) + (if (logior flags 8) + (setq val-end (- val-end 2)) + (setq val-end (- val-end 1))) + ) + ) + ) ;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-foreach (reg-beg reg-end func) + (let ((i 0) (continue t) (part-beg reg-beg) (part-end nil)) + (while continue + (setq part-end nil) + (unless (get-text-property part-beg 'part-side) + (setq part-beg (web-mode-part-next-position part-beg))) + (when (and part-beg (< part-beg reg-end)) + (setq part-end (web-mode-part-end-position part-beg))) + (cond + ((> (setq i (1+ i)) 100) + (message "process-parts ** warning (%S) **" (point)) + (setq continue nil)) + ((or (null part-end) (> part-end reg-end)) + (setq continue nil)) + (t + (setq part-end (1+ part-end)) + (funcall func part-beg part-end) + (setq part-beg part-end)) + ) ;cond + ) ;while + )) + +(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 '("typescript")) + (setq token-re "\"\\|'\\|`\\|//\\|/\\*")) + ((member content-type '("jsx")) + (setq token-re "/\\|\"\\|'\\|`\\|]")) + ((string= web-mode-content-type "css") + (setq token-re "\"\\|'\\|/\\*\\|//")) + ((string= content-type "css") + (setq token-re "\"\\|'\\|/\\*")) + (t + (setq token-re "/\\*\\|\"\\|'")) + ) + + (while (and token-re (< (point) reg-end) (web-mode-dom-rsf token-re reg-end t)) + + (setq beg (match-beginning 0) + token-type nil + continue t + ch-at (char-after beg) + ch-next (or (char-after (1+ beg)) ?\d) + ch-before (or (char-before beg) ?\d)) + + ;;(message "[%S>%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)) + (t + (setq continue (web-mode-string-continue-p reg-beg))) + ) + ) ;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)) + (t + (setq continue (web-mode-string-continue-p reg-beg))) + ) + ) ;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)) + (t + (setq continue (web-mode-string-continue-p reg-beg))) + ) ;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 + ) + + ((and (eq ?\< ch-at) + (not (or (and (>= ch-before 97) (<= ch-before 122)) + (and (>= ch-before 65) (<= ch-before 90))))) + ;;(message "before [%S>%S|%S] pt=%S" reg-beg reg-end depth (point)) + (search-backward "<") + (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 "\\(^\\|case\\|[[(,=:!&|?{};]\\)[ ]*/" (point-min))) + ;;(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) + ;;(message "%S" (point)) + (cond + ((and (string= content-type "css") + (eq ?/ ch-at) + (eq ?: ch-before)) + ) + (t + (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-string-continue-p (reg-beg) + "Is `point' preceeded by an odd number of backslashes?" + (let ((p (1- (point)))) + (while (and (< reg-beg p) (eq ?\\ (char-before p))) + (setq p (1- p))) + (= (mod (- (point) p) 2) 0))) + +;; css rule = selector(s) + declaration (properties) +(defun web-mode-css-rule-next (limit) + (let (at-rule var-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)) + (cond + ((string-match "@\\([[:alpha:]-]+\\)" chunk) + (setq at-rule (match-string-no-properties 1 chunk))) + ((string-match "\\$\\([[:alpha:]-]+\\)" chunk) + (setq var-rule (match-string-no-properties 1 chunk))) + ) ;cond + ) ;when + (if (not sel-end) + (progn (goto-char limit) nil) + (list :at-rule at-rule + :var-rule var-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-jsx-skip (reg-end) + (let ((continue t) (pos nil) (i 0) tag) + (looking-at "<\\([[:alpha:]][[:alnum:]:-]*\\)") + (setq tag (match-string-no-properties 1)) + ;;(message "point=%S tag=%S" (point) tag) + (save-excursion + (while continue + (cond + ((> (setq i (1+ i)) 1000) + (message "jsx-skip ** warning **") + (setq continue nil)) + ((looking-at "<[[:alpha:]][[:alnum:]:-]*[ ]*/>") + (goto-char (match-end 0)) + (setq pos (point)) + (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)) + +;; (defun web-mode-jsx-skip2 (reg-end) +;; (let ((continue t) (pos nil) (i 0) (tag nil) (regexp nil) (counter 1)) +;; (looking-at "<\\([[:alpha:]][[:alnum:]:-]*\\)") +;; (setq tag (match-string-no-properties 1)) +;; (setq regexp (concat " (setq i (1+ i)) 100) +;; (message "jsx-skip ** warning **") +;; (setq continue nil)) +;; ((looking-at "<[[:alpha:]][[:alnum:]:-]*[ ]*/>") +;; (goto-char (match-end 0)) +;; (setq pos (point)) +;; (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) + (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 + ) ;while + ) ;save-excursion + )) + +(defun web-mode-jsx-is-html (&optional pos) + (interactive) + (unless pos (setq pos (point))) + (let (ret (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 'tag-end) + (setq pos nil)) + ((get-text-property pos 'tag-attr-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-is-expr (&optional pos) + (cond + ((and (get-text-property pos 'jsx-beg) + (not (get-text-property pos 'tag-beg))) + nil) + (t + (setq pos (web-mode-jsx-depth-beginning-position pos)) + (null (get-text-property pos 'tag-beg))) + ) ;cond + ) + +(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-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-jsx-beginning () + (interactive) + (let (depth (continue t) (reg-beg (point-min)) (pos (point))) + (setq depth (get-text-property pos 'jsx-depth)) + (cond + ((not depth) + ) + ((get-text-property (1- pos) 'jsx-beg) + (goto-char (1- pos))) + (t + (while continue + (setq pos (previous-single-property-change pos 'jsx-beg)) + ;;(message "pos=%S" pos) + (cond + ((null pos) + (setq continue nil)) + ((<= pos reg-beg) + (setq continue nil)) + ((eq depth (get-text-property pos 'jsx-beg)) + (setq continue nil)) + ) ;cond + ) ;while + (web-mode-go pos) + ) ;t + ) ;cond + )) + +(defun web-mode-jsx-end () + (interactive) + (let (depth (continue t) (reg-end (point-max)) (pos (point))) + (setq depth (get-text-property pos 'jsx-depth)) + (cond + ((not depth) + ) + ((get-text-property pos 'jsx-end) + (goto-char (+ pos 1))) + (t + (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)) + ) ;cond + ) ;while + (web-mode-go pos 1) + ) ;t + ) ;cond + )) + +;;---- FONTIFICATION ----------------------------------------------------------- + +(defun web-mode-fontify (limit) + (when web-mode-trace + (message "fontify: point(%S) limit(%S)" (point) limit)) + (cond + ;;(web-mode-skip-fontification + ;; nil) + (t + (web-mode-with-silent-modifications + (save-excursion + (save-restriction + (save-match-data + (let ((beg (point)) + (buffer-undo-list t) + (end limit) + (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-fontify-block beg end)) + ((or (member web-mode-content-type web-mode-part-content-types) + (get-text-property beg 'part-side)) + (web-mode-fontify-part beg end) + (web-mode-block-foreach beg end 'web-mode-fontify-block)) + ((string= web-mode-engine "none") + (web-mode-fontify-tags beg end) + (web-mode-part-foreach beg end 'web-mode-fontify-part)) + (t + (web-mode-fontify-tags beg end) + (web-mode-part-foreach beg end 'web-mode-fontify-part) + (web-mode-block-foreach beg end 'web-mode-fontify-block)) + ) ;cond + (when web-mode-enable-element-content-fontification + (web-mode-fontify-elements beg end)) + (when web-mode-enable-whitespace-fontification + (web-mode-fontify-whitespaces beg end)) + ) ;let + )))) + nil) ;t + )) + +(defun web-mode-buffer-fontify () + (interactive) + (cond + ((and (fboundp 'font-lock-flush) global-font-lock-mode) + (font-lock-flush) + (font-lock-ensure)) + (t ;emacs 24 + ;;(font-lock-fontify-buffer) + (and global-font-lock-mode + (font-lock-fontify-region (point-min) (point-max)))) + )) + +(defun web-mode-unfontify-region (beg end) + ;;(message "unfontify: %S %S" beg end) + ) + +(defun web-mode-fontify-region (beg end keywords) +;; (message "beg=%S end=%S keywords=%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 '("archibus" "asp" "template-toolkit"))) + (font-lock-keywords-only t) + (font-lock-extend-region-functions nil)) + (when (and (listp font-lock-keywords) global-font-lock-mode) + (font-lock-fontify-region beg end) + ) + ))) + +(defun web-mode-fontify-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-fontify-tag)) + ) + (t + (web-mode-fontify-tag)) + ) ;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-fontify-tag (&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)) + (setq bracket-end (> (logand flags 16) 0)) + (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 slash-beg (> (logand flags 4) 0) + slash-end (> (logand flags 8) 0) + bracket-end (> (logand flags 16) 0)) + (setq face (cond + ((not bracket-end) 'web-mode-html-tag-unclosed-face) + ((and web-mode-enable-element-tag-fontification + (setq face (cdr (assoc name web-mode-element-tag-faces)))) + face) + ((> (logand flags 32) 0) 'web-mode-html-tag-namespaced-face) + ((> (logand flags 2) 0) 'web-mode-html-tag-custom-face) + (t 'web-mode-html-tag-face))) + (put-text-property beg (+ beg (if slash-beg 2 1)) + 'font-lock-face 'web-mode-html-tag-bracket-face) + (unless (string= name "_fragment_") + (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-fontify-attrs beg end)) + ) ;case name + ) ;cond + )) + +(defun web-mode-fontify-attrs (reg-beg reg-end) + (let ((continue t) (pos reg-beg) beg end flags offset face) + ;;(message "fontify-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)) + ;;(message "beg=%S end=%S" beg end) + (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-fontify-block (reg-beg reg-end) + (when web-mode-trace + (message "fontify-block: reg-beg(%S) reg-end(%S) engine(%S) keywords(%S)" + reg-beg reg-end web-mode-engine (not (null web-mode-engine-font-lock-keywords)))) + + (let (sub1 sub2 sub3 continue char keywords token-type face beg end (buffer (current-buffer))) + + ;; NOTE: required for blocks inside tag attrs + (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)) + ((string= sub1 "#") + (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) + (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) + ) + ) ;save-match-data + (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-comment-annotation + (eq token-type 'comment) + (> (- end beg) 3)) + (web-mode-annotate-comment beg end) + ) ;when + (when (and web-mode-enable-sql-detection + (eq token-type 'string) + (> (- end beg) 6) + (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 '("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 + (font-lock-append-text-property reg-beg reg-end 'face 'web-mode-block-face)) + + )) + +(defun web-mode-fontify-part (reg-beg reg-end &optional depth) + (save-excursion + (let (start continue token-type face pos beg end string-face comment-face content-type) + ;;(message "fontify-part: 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)))) + ;;(message "content-type=%S" content-type) + (unless depth + (when (string= content-type "jsx") (setq depth 0)) + ) + (setq string-face 'web-mode-part-string-face + comment-face 'web-mode-part-comment-face) + (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-fontify-css-rules reg-beg reg-end)) + ((string= content-type "sql") + (web-mode-fontify-region reg-beg reg-end web-mode-sql-font-lock-keywords)) + ((string= content-type "stylus") + (web-mode-fontify-region reg-beg reg-end web-mode-stylus-font-lock-keywords)) + ((string= content-type "sass") + (web-mode-fontify-region reg-beg reg-end web-mode-sass-font-lock-keywords)) + ((string= content-type "pug") + (web-mode-fontify-region reg-beg reg-end web-mode-pug-font-lock-keywords)) + ((string= content-type "markdown") + (web-mode-fontify-region reg-beg reg-end web-mode-markdown-font-lock-keywords)) + ((string= content-type "ruby") + (web-mode-fontify-region reg-beg reg-end web-mode-erb-font-lock-keywords)) + ((string= content-type "typescript") + (web-mode-fontify-region reg-beg reg-end web-mode-javascript-font-lock-keywords)) + ) ;cond + + (goto-char reg-beg) + + ;;(when (string= content-type "jsx") (web-mode-fontify-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 + ;;(message "%c" (char-after beg)) + (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) + (cond + ((and (eq (char-after beg) ?\`) + web-mode-enable-literal-interpolation + (member content-type '("javascript" "jsx"))) + (web-mode-interpolate-javascript-literal beg end) + ) + ((and (eq (char-after beg) ?\") + web-mode-enable-string-interpolation + (member content-type '("javascript" "jsx"))) + (web-mode-interpolate-javascript-string beg end)) + ) ;cond + ) ;case string + ((eq token-type 'comment) + (when web-mode-enable-comment-interpolation + (web-mode-interpolate-comment beg end t)) + (when web-mode-enable-comment-annotation + (web-mode-annotate-comment beg end)) + ) + ) ;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 + (cond + ((string= content-type "javascript") + 'web-mode-script-face) + ((string= content-type "css") + 'web-mode-style-face) + (t + 'web-mode-part-face))) + ) + + (when (and web-mode-enable-css-colorization (string= content-type "stylus")) + (goto-char reg-beg) + (while (and (re-search-forward "#[0-9a-fA-F]\\{6\\}\\|#[0-9a-fA-F]\\{3\\}\\|rgba?([ ]*\\([[:digit:]]\\{1,3\\}\\)[ ]*,[ ]*\\([[:digit:]]\\{1,3\\}\\)[ ]*,[ ]*\\([[:digit:]]\\{1,3\\}\\)\\(.*?\\))" end t) + (<= (point) reg-end)) + (web-mode-colorize (match-beginning 0) (match-end 0)) + ) + ) + + (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-fontify-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) ?\{) + ;;(message "%S : %c %c" exp-beg (char-after (+ exp-beg 1)) (char-after (+ exp-beg 2))) + (cond + ;;((and (eq (char-after (+ exp-beg 1)) ?\/) (eq (char-after (+ exp-beg 2)) ?\*)) + ;; (put-text-property exp-beg (1+ exp-end) 'font-lock-face 'web-mode-part-comment-face) + ;; ) + (t + (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-fontify-tags (1+ exp-beg) exp-end (1+ exp-depth)) + (web-mode-fontify-part (1+ exp-beg) exp-end exp-depth) + (web-mode-fontify-region (1+ exp-beg) exp-end web-mode-javascript-font-lock-keywords) + ) ;t + ) ;cond + ) ;when + (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 + + ) ;let + ) ;save-excursion + ) + +(defun web-mode-fontify-css-rules (part-beg part-end) + (save-excursion + (goto-char part-beg) + (let (rule (continue t) (i 0) (at-rule nil) (var-rule nil)) + (while continue + (setq rule (web-mode-css-rule-next part-end)) + ;;(message "rule=%S" rule) + (cond + ((> (setq i (1+ i)) 1000) + (message "fontify-css-rules ** 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" "viewport"))) + (plist-get rule :dec-end)) + (web-mode-fontify-css-rule (plist-get rule :sel-beg) + (plist-get rule :sel-end) + nil nil) + (web-mode-fontify-css-rules (plist-get rule :dec-beg) + (plist-get rule :dec-end))) + (t + (web-mode-fontify-css-rule (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-fontify-css-rule (sel-beg sel-end dec-beg dec-end) + (save-excursion + ;;(let ((end sel-end)) + ;;(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) + ;;(setq end dec-end) + (web-mode-fontify-region dec-beg dec-end web-mode-declaration-font-lock-keywords) + ) ;when + (when (and dec-beg dec-end) + (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) + ;;(progn (message "%S %S" end (point)) t) + (<= (point) dec-end)) + (web-mode-colorize (match-beginning 0) (match-end 0)) + ) ;while + ) ;when + ;;) ;let + )) + +(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)) + ((or (string= (substring str 0 4) "rgb(") (string= (substring str 0 5) "rgba(")) + (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) + ) + )) + +(defun web-mode-interpolate-javascript-literal (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) + ) + (cond + ((web-mode-looking-back "\\(css\\|styled[[:alnum:].]+\\)" beg) + (goto-char (1+ beg)) + (while (re-search-forward ".*?:" end t) + (put-text-property (match-beginning 0) (match-end 0) + 'font-lock-face + 'web-mode-interpolate-color1-face) + ) + ) ;case css + ((web-mode-looking-back "\\(template\\|html\\)" beg) + (goto-char (1+ beg)) + (while (re-search-forward web-mode-tag-regexp end t) + (put-text-property (match-beginning 1) (match-end 1) + 'font-lock-face + 'web-mode-interpolate-color1-face) + ) + (goto-char (1+ beg)) + (while (re-search-forward "\\| [[:alnum:]]+=" end t) + (cond + ((member (char-after (match-beginning 0)) '(?\< ?\/ ?\>)) + (put-text-property (match-beginning 0) (match-end 0) + 'font-lock-face + 'web-mode-interpolate-color2-face) + ) + (t + (put-text-property (1+ (match-beginning 0)) (1- (match-end 0)) + 'font-lock-face + 'web-mode-interpolate-color3-face) + ) ;t + ) ;cond + ) ;while + ) ;case html + ) ;cond type of literal + )) + +;; 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-annotate-comment (beg end) + (save-excursion + ;;(message "beg=%S end=%S" beg end) + (goto-char beg) + (when (looking-at-p "/\\*\\*") + (while (re-search-forward "\\(.+\\)" end t) + (font-lock-prepend-text-property (match-beginning 1) (match-end 1) + 'font-lock-face + 'web-mode-annotation-face)) + (goto-char beg) + (while (re-search-forward "[ ]+\\({[^}]+}\\)" end t) + (font-lock-prepend-text-property (match-beginning 1) (match-end 1) + 'font-lock-face + 'web-mode-annotation-type-face)) + (goto-char beg) + (while (re-search-forward "\\(@[[:alnum:]]+\\)" end t) + (font-lock-prepend-text-property (match-beginning 1) (match-end 1) + 'font-lock-face + 'web-mode-annotation-tag-face)) + (goto-char beg) + (while (re-search-forward "}[[:blank:]]+\\([[:graph:]]+\\)" end t) + (font-lock-prepend-text-property (match-beginning 1) (match-end 1) + 'font-lock-face + 'web-mode-annotation-value-face)) + (goto-char beg) + (while (re-search-forward "@see[[:blank:]]+\\([[:graph:]]+\\)" end t) + (font-lock-prepend-text-property (match-beginning 1) (match-end 1) + 'font-lock-face + 'web-mode-annotation-value-face)) + (goto-char beg) + (while (re-search-forward "{\\(@\\(?:link\\|code\\)\\)\\s-+\\([^}\n]+\\)\\(#.+\\)?}" end t) + (font-lock-prepend-text-property (match-beginning 2) (match-end 2) + 'font-lock-face + 'web-mode-annotation-value-face)) + (goto-char beg) + (while (re-search-forward "\\(\\)" end t) + (font-lock-prepend-text-property (match-beginning 1) (match-end 1) + 'font-lock-face + 'web-mode-annotation-html-face) + (font-lock-prepend-text-property (match-beginning 2) (match-end 2) + 'font-lock-face + 'web-mode-annotation-html-face) + (font-lock-prepend-text-property (match-beginning 3) (match-end 3) + 'font-lock-face + 'web-mode-annotation-html-face)) + ) ;when + )) + +(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 + ))) + +;;---- EFFECTS ----------------------------------------------------------------- + +(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-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-fontify-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 "fontify-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-fontify)) + ) + ) ;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-fontify)) + ) + ) ;when + ) + +(defun web-mode-toggle-current-element-highlight () + "Toggle highlighting of the current html element." + (interactive) + (if web-mode-enable-current-element-highlight + (progn + (web-mode-delete-tag-overlays) + (setq web-mode-enable-current-element-highlight nil)) + (setq web-mode-enable-current-element-highlight t) + )) + +(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)) + ((eq (get-text-property (caar ctx) 'tag-type) 'void) ;; #1046 + (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)) + ) + (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-fontify-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-element-children-fold-or-unfold (&optional pos) + "Fold/Unfold all the children of the current html element." + (interactive) + (unless pos (setq pos (point))) + (save-excursion + (dolist (child (reverse (web-mode-element-children pos))) + (goto-char child) + (web-mode-fold-or-unfold)) + )) + +(defun web-mode-fold-or-unfold (&optional pos) + "Toggle folding on an html element or a control block." + (interactive) + (web-mode-scan) + (web-mode-with-silent-modifications + (save-excursion + (if pos (goto-char pos)) + (let (beg-inside beg-outside end-inside end-outside overlay overlays regexp) + (when (looking-back "^[\t ]*" (point-min)) + (back-to-indentation)) + (setq overlays (overlays-at (point))) + (dolist (elt overlays) + (when (and (not overlay) + (eq (overlay-get elt 'font-lock-face) 'web-mode-folded-face)) + (setq overlay elt))) + (cond + ;; *** unfolding + (overlay + (setq beg-inside (overlay-start overlay) + end-inside (overlay-end overlay)) + (remove-overlays beg-inside end-inside) + (put-text-property beg-inside end-inside 'invisible nil) + ) + ;; *** block folding + ((and (get-text-property (point) 'block-side) + (cdr (web-mode-block-is-control (point)))) + (setq beg-outside (web-mode-block-beginning-position (point))) + (setq beg-inside (1+ (web-mode-block-end-position (point)))) + (when (web-mode-block-match) + (setq end-inside (point)) + (setq end-outside (1+ (web-mode-block-end-position (point))))) + ) + ;; *** html comment folding + ((eq (get-text-property (point) 'tag-type) 'comment) + (setq beg-outside (web-mode-tag-beginning-position)) + (setq beg-inside (+ beg-outside 4)) + (setq end-outside (web-mode-tag-end-position)) + (setq end-inside (- end-outside 3)) + ) + ;; *** tag folding + ((or (member (get-text-property (point) 'tag-type) '(start end)) + (web-mode-element-parent)) + (when (not (web-mode-element-is-collapsed (point))) + (web-mode-tag-beginning) + (when (eq (get-text-property (point) 'tag-type) 'end) + (web-mode-tag-match)) + (setq beg-outside (point)) + (web-mode-tag-end) + (setq beg-inside (point)) + (goto-char beg-outside) + (when (web-mode-tag-match) + (setq end-inside (point)) + (web-mode-tag-end) + (setq end-outside (point))) + ) + ) + ) ;cond + (when (and beg-inside beg-outside end-inside end-outside) + (setq overlay (make-overlay beg-outside end-outside)) + (overlay-put overlay 'font-lock-face 'web-mode-folded-face) + (put-text-property beg-inside end-inside 'invisible t)) + )))) + +;;---- TRANSFORMATION ---------------------------------------------------------- + +(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 " 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 + ))) + +;;---- INDENTATION ------------------------------------------------------------- + +;; todo : passer de règle en règle et mettre un \n à la fin +(defun web-mode-css-indent () + (save-excursion + (goto-char (point-min)) + (let ((continue t) rule part-end) + (while continue + (cond + ((not (web-mode-part-next)) + (setq continue nil)) + ((eq (get-text-property (point) 'part-side) 'css) + (setq part-end (web-mode-part-end-position)) + (while (setq rule (web-mode-css-rule-next part-end)) + (when (not (looking-at-p "[[:space:]]*\\($\\|<\\)")) + (newline) + (indent-according-to-mode) + (setq part-end (web-mode-part-end-position))) + ) + ) + ) ;cond + ) + ))) + +(defun web-mode-buffer-indent () + "Indent all buffer." + (interactive) + (let ((debug t) (ts (current-time)) (sub nil)) + (indent-region (point-min) (point-max)) + (when debug + (setq sub (time-subtract (current-time) ts)) + (message "buffer-indent: time elapsed = %Ss %9Sµs" (nth 1 sub) (nth 2 sub))) + (delete-trailing-whitespace))) + +(defun web-mode-point-context (pos) + "POS should be at the beginning of the indentation." + (save-excursion + (let (curr-char curr-indentation curr-line + language + options + reg-beg reg-col + prev-char prev-indentation prev-line prev-pos + token + part-language + depth) + + (setq reg-beg (point-min) + reg-col 0 + token "live" + options "" + language "" + prev-line "" + prev-char 0 + prev-pos nil) + + (when (get-text-property pos 'part-side) + (setq part-language (symbol-name (get-text-property pos 'part-side)))) + + ;;(message "part-language=%S" part-language) + + (cond + + ((and (bobp) (member web-mode-content-type '("html" "xml"))) + (setq language web-mode-content-type) + ) + + ((string= web-mode-content-type "css") + (setq language "css" + curr-indentation web-mode-css-indent-offset)) + + ((member web-mode-content-type '("javascript" "json" "typescript")) + (setq language web-mode-content-type + curr-indentation web-mode-code-indent-offset)) + + ((or (string= web-mode-content-type "jsx") + (and part-language (string= part-language "jsx"))) + (setq language "jsx" + curr-indentation web-mode-code-indent-offset) + (cond + ((web-mode-jsx-is-html pos) + (setq curr-indentation web-mode-markup-indent-offset + options "is-html")) + ((and (setq depth (get-text-property pos 'jsx-depth)) (> 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)) + ;;(message "%S" (point)) + (save-excursion + (goto-char reg-beg) + ;;(message "pt=%S" reg-beg) + (cond + ((and (not (looking-at-p "[ ]*$")) + (looking-back "^[[:space:]]*{" (point-min))) + (setq reg-col (+ (current-indentation) ;; #1027 + (cond + ((looking-at "[ ]+") (1+ (length (match-string-no-properties 0)))) + (t 0)) + )) + ) + ((looking-at-p "[ ]*\\[[ ]*$") ;; #0659 + (setq reg-col (current-indentation)) + ) + ((and (looking-back "=[ ]*{" (point-min)) ;; #0739 #1022 + (not (looking-at-p "[[:space:]]*<"))) + (setq reg-col (current-indentation)) + ) + ;;((and (looking-back "=[ ]*{" (point-min)) ;; #0739 + ;; (looking-at-p "{[ ]*")) + ;; (setq reg-col (current-indentation)) + ;; ) + ((get-text-property (1- (point)) 'tag-beg) + ;;(message "point=%S" (point)) + (setq reg-col (current-indentation)) + ) + (t + (message "%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)) + ;;(message "%S %S" reg-beg reg-col) + (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)) + ;;(setq reg-col (current-column)) + ) + ;; 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 "svelte") + (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 "<%@" 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" "typescript" "jsx" "razor" "css")) + (and (member language '("html" "xml")) + (not (eq ?\< curr-char)))) + (let (prev) + (cond + ((member language '("html" "xml" "javascript" "jsx" "css")) + (when (setq prev (web-mode-part-previous-live-line reg-beg)) + (setq prev-line (nth 0 prev) + prev-indentation (nth 1 prev) + prev-pos (nth 2 prev)) + ) + ) + ((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" "typescript" "jsx" "ruby")) + (setq reg-col (if web-mode-script-padding (+ reg-col web-mode-script-padding) 0))) + ((member language '("css" "sql" "markdown" "pug" "sass" "stylus")) + (setq reg-col (if web-mode-style-padding (+ reg-col web-mode-style-padding) 0))) + ((not (member language '("html" "xml"))) + (setq reg-col + (cond + ((not web-mode-block-padding) reg-col) + ((eq web-mode-block-padding -1) 0) + (t (+ reg-col web-mode-block-padding)) + ) ;cond + ) ;setq + ) + ) + + (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 + :prev-pos prev-pos + :reg-beg reg-beg + :reg-col reg-col + :token token) + ))) + +(defun web-mode-indent-line () + + (web-mode-scan) + + (let ((offset nil) + (char nil) + (debug nil) + (inhibit-modification-hooks nil) + (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)) + (prev-pos (plist-get ctx :prev-pos)) + (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)) + (tmp nil) + (is-js (member language '("javascript" "jsx" "ejs")))) + + (when (member language '("json" "typescript")) + (setq language "javascript")) + + ;;(message "%S" language) + ;;(message "curr-char=[%c] prev-char=[%c]\n%S" curr-char prev-char ctx) + ;;(message "options=%S" ctx) + + (cond + + ((or (bobp) (= (line-number-at-pos pos) 1)) + (when debug (message "I100(%S) first line" pos)) + (setq offset 0)) + + ;; #123 #1145 + ((and web-mode-enable-front-matter-block + (eq (char-after (point-min)) ?\-) + (or (looking-at-p "---") + (search-forward "---" (point-max) t))) + (when debug (message "I108(%S) front-matter-block" pos)) + (setq offset nil)) + + ;; #1073 + ((get-text-property pos 'invisible) + (when debug (message "I110(%S) invible" pos)) + (setq offset nil)) + + ((string= token "string") + (when debug (message "I120(%S) string" pos)) + (cond + ((web-mode-is-token-end pos) + (if (get-text-property pos 'block-side) + (web-mode-block-token-beginning) + (web-mode-part-token-beginning)) + (setq offset (current-indentation)) + ) + ((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 + ) + ((and is-js + (web-mode-is-ql-string pos "Relay\.QL")) + (setq offset (web-mode-relayql-indentation pos)) + ) + ((and is-js + (web-mode-is-ql-string pos "gql")) + (setq offset (web-mode-relayql-indentation pos "gql")) + ) + ((and is-js + (web-mode-is-ql-string pos "graphql")) + (setq offset (web-mode-relayql-indentation pos "graphql")) + ) + ((and is-js + (web-mode-is-css-string pos)) + (when debug (message "I127(%S) css string" pos)) + (setq offset (web-mode-token-css-indentation pos)) + ) + ((and is-js + (web-mode-is-html-string pos)) + (when debug (message "I128(%S) html string" pos)) + (setq offset (web-mode-token-html-indentation pos)) + ) + (t + (setq offset nil)) + ) ;cond + ) ;case string + + ((string= token "comment") + (when debug (message "I130(%S) comment" pos)) + (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)) + (cond + ((string= web-mode-engine "freemarker") + (setq offset (+ (current-indentation) 2))) + ((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)) "" curr-line) + (setq offset offset)) + ((string-match-p "^-" curr-line) + (setq offset (+ offset 3))) + (t + (setq offset (+ offset 5))) + ) ;cond + ) + ((and (string= web-mode-engine "django") (looking-back "{% comment %}" (point-min))) + (setq offset (- offset 12))) + ((and (string= web-mode-engine "mako") (looking-back "<%doc%>" (point-min))) + (setq offset (- offset 6))) + ((and (string= web-mode-engine "mason") (looking-back "<%doc%>" (point-min))) + (setq offset (- offset 6))) + ) ;cond + ) ;case comment + + ((and (string= web-mode-engine "mason") + (string-match-p "^%" curr-line)) + (when debug (message "I140(%S) mason" pos)) + (setq offset 0)) + + ((and (string= web-mode-engine "django") + (string-match-p "^#" curr-line)) + (when debug (message "I144(%S) django line statements" pos)) + (setq offset 0)) + + ((and (get-text-property pos 'block-beg) + (or (web-mode-block-is-close pos) + (web-mode-block-is-inside pos))) + (when debug (message "I150(%S) block-match" pos)) + (cond + ((not (web-mode-block-match)) + ) + ((and (string= web-mode-engine "closure") + (string-match-p "{\\(case\\|default\\)" curr-line)) + (setq offset (+ (current-indentation) web-mode-markup-indent-offset))) + (t + (setq offset (current-indentation)) + (if (and (string= web-mode-engine "blade") + (string-match-p "@break" curr-line)) + (setq offset (+ (current-indentation) offset))) + ) + ) ;cond + ) + + ((eq (get-text-property pos 'block-token) 'delimiter-end) + (when debug (message "I160(%S) block-beginning" pos)) + (when (web-mode-block-beginning) + (setq reg-col (current-indentation)) + (setq offset (current-column)))) + + ((or (and (get-text-property pos 'tag-beg) + (eq (get-text-property pos 'tag-type) 'end)) + (and (eq (get-text-property pos 'tag-type) 'comment) + (string-match-p "" (point)) + (web-mode-insert-text-at-pos "" (point)) + (web-mode-insert-text-at-pos "") + (search-backward " -->") + ) ;case html + ) ;cond + )) + +(defun web-mode-comment (pos) + (let (ctx language col 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 block-side (string= web-mode-engine "artanis")) + (web-mode-comment-artanis-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)))) + ;;(message "%S" ctx) + (setq language (plist-get ctx :language)) + (setq col (current-column)) + (cond + (mark-active + ;;(message "%S %S" (point) col) + ) + ((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 "artanis")) + (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 "expressionengine")) + (setq content (concat "{!-- " sel " --}"))) + ((and (= web-mode-comment-style 2) (string= web-mode-engine "xoops")) + (setq content (concat "<{* " sel " *}>"))) + ((and (= web-mode-comment-style 2) (string= web-mode-engine "hero")) + (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" "typescript" "java" "jsx")) + (let (alt) + (setq alt (cdr (assoc language web-mode-comment-formats))) + ;;(message "language=%S alt=%S sel=%S col=%S" language alt sel col) + (cond + ((and alt (string= alt "//")) + (setq content (replace-regexp-in-string (concat "\n[ ]\\{" (number-to-string col) "\\}") "\n" sel)) + (setq content (replace-regexp-in-string (concat "\n") "\n// " content)) + (setq content (concat "// " content))) + ((get-text-property pos 'jsx-depth) + (setq content (concat "{/* " sel " */}"))) + (web-mode-comment-prefixing + (setq content (replace-regexp-in-string (concat "\n[ ]\\{" (number-to-string col) "\\}") "\n* " sel)) + (setq content (concat "/* " content " */"))) + (t + (setq content (concat "/* " sel " */"))) + ) ;cond + ) ;let + ) + + ((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-artanis-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 "*/" (1- end)) + (web-mode-insert-text-at-pos "/*" (+ beg (if (web-mode-looking-at "{{" beg) 2 0))))) + +(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 2)) + (web-mode-insert-text-at-pos "/*" (+ beg 1 (if (web-mode-looking-at "<\\?php" beg) 5 3))))) + +(defun web-mode-comment-svelte-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-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))))) + (message "beg(%S) end(%S) point-max(%S)" beg end (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))) ;; #1021 + ) ;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)) + (when (and (eq (get-text-property beg 'part-token) 'comment) + (> beg 1) ;#1158 + (get-text-property (1- beg) 'jsx-beg)) + (setq beg (1- beg) + end (1+ 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 "/*") + ;;(message "%S" comment) + ;;(setq comment (replace-regexp-in-string "\\(\\*/\\|^/\\*[ ]?\\|^[ \t]*\\*\\)" "" comment)) + (setq comment (replace-regexp-in-string "\\([ ]?\\*/$\\|^/\\*[ ]?\\)" "" comment)) + (setq comment (replace-regexp-in-string "\\(^[ \t]*\\*\\)" "" comment)) + ;;(message "%S" 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)) + (cond + ((string= (buffer-substring-no-properties beg (+ beg 4)) "<%#=") + (web-mode-remove-text-at-pos 1 (+ beg 2))) + ((string-match-p "<[%[:alpha:]]" (buffer-substring-no-properties (+ beg 2) (- end 2))) + (web-mode-remove-text-at-pos 2 (1- end)) + (web-mode-remove-text-at-pos 3 beg)) + (t + (web-mode-remove-text-at-pos 1 (+ beg 2))) + ) ;cond + ) + ) + +(defun web-mode-uncomment-artanis-block (pos) + (let (beg end) + (setq beg (web-mode-block-beginning-position pos) + end (web-mode-block-end-position pos)) + (cond + ((string= (buffer-substring-no-properties beg (+ beg 4)) "<%;=") + (web-mode-remove-text-at-pos 1 (+ beg 2))) + ((string-match-p "<[%[:alpha:]]" (buffer-substring-no-properties (+ beg 2) (- end 2))) + (web-mode-remove-text-at-pos 2 (1- end)) + (web-mode-remove-text-at-pos 3 beg)) + (t + (web-mode-remove-text-at-pos 1 (+ beg 2))) + ) ;cond + ) + ) + +(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)) + (cond + ((web-mode-looking-at-p "{#[{%]" beg) + (web-mode-remove-text-at-pos 1 (1- end)) + (web-mode-remove-text-at-pos 1 (1+ beg)) + ) + (t + (web-mode-remove-text-at-pos 2 (1- end)) + (web-mode-remove-text-at-pos 2 beg)) + ) ;cond + )) + +(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 2 (+ beg 2)) + (web-mode-remove-text-at-pos 2 (- end 5)))) + +(defun web-mode-uncomment-svelte-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-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)) + (cond + ((string-match-p "¦" snippet) + (search-backward "¦") + (delete-char 1) + (setq pos (point) + end (1- end))) + ((string-match-p "|" snippet) + (search-backward "|") + (delete-char 1) + (setq pos (point) + end (1- end))) + ) ;cond + (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 (point-min))))) + +(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-column-at-pos (pos) + (save-excursion + (goto-char pos) + (current-column))) + +(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 name) + (cond + ((eq (get-text-property pos 'tag-type) 'void) + (web-mode-tag-beginning)) + ((and (eq (get-text-property pos 'tag-type) 'comment) + (web-mode-looking-at-p " %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))))) + ((member char '(?\( ?\{ ?\[ ?\= ?\< ?\>)) + (web-mode-looking-at ".[ \t\n]*" pos) + (setq continue nil + pos (+ pos (length (match-string-no-properties 0))))) + + ((web-mode-looking-at "\\(return\\)[ \n]" pos) + (setq continue nil + pos (+ pos (length (match-string-no-properties 0))))) + ((and (eq char ?\:) + (web-mode-looking-back "[{,][ \t\n]*[[:alnum:]_]+[ ]*" pos)) + (web-mode-looking-at ".[ \t\n]*" pos) + (setq continue nil + pos (+ pos (length (match-string-no-properties 0))))) + (t + (setq pos (web-mode-rsb-position pos regexp reg-beg)) + (when (not pos) + (cond + (is-jsx + (when (web-mode-looking-at "[ \n]*" reg-beg) + (setq pos (+ reg-beg (length (match-string-no-properties 0))))) + (setq continue nil)) + (t + (message "javascript-statement-beginning-position ** search failure **") + (setq continue nil + pos reg-beg)) + ) ;cond + ) + ) ;t + ) ;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)) + ;;(message "pos(%S) char(%c)" pos char) + (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(position) **") + (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 ".[ ]*" pos) + (setq pos (+ pos (length (match-string-no-properties 0))) + continue nil) + ) + ((web-mode-looking-at "\\(var\\|let\\|return\\|const\\)[ \n]" pos) + (setq pos (+ pos (length (match-string-no-properties 0))) + continue nil)) + (t + (setq pos (web-mode-rsb-position pos "[\]\[}{)(]\\|\\(var\\|let\\|return\\|const\\)" reg-beg)) + (when (not pos) + (message "javascript-args-beginning-position ** search failure **") + (setq continue nil + pos reg-beg))) + ) ;cond + ) ;while + ;;(message "=%S" pos) + pos)) + +(defun web-mode-javascript-calls-beginning-position (pos &optional reg-beg) + (unless pos (setq pos (point))) + ;;(message "pos=%S" pos) + (let ((char nil) + (dot-pos nil) + (blockside (get-text-property pos 'block-side)) + (i 0) + (continue (not (null pos)))) + (unless reg-beg + (setq reg-beg (if blockside + (web-mode-block-beginning-position pos) + (web-mode-part-beginning-position pos)))) + (while continue + (setq char (char-after pos)) + ;;(message "%S| %S=%c" reg-beg pos char) + (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) + (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)))) + ((and (member char '(?\.)) (> i 1)) + (setq dot-pos pos + 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) + (setq pos (+ pos (length (match-string-no-properties 0))) + continue nil)) + ((web-mode-looking-at "\\(return\\|else\\|const\\)[ \n]" pos) + (setq pos (+ pos (length (match-string-no-properties 0))) + continue nil)) + (t + (setq pos (web-mode-rsb-position pos "[\]\[}{)(=?:;,&|>.]\\|\\(return\\|else\\|const\\)" reg-beg)) + (when (not pos) + (message "javascript-calls-beginning-position ** search failure **") + (setq pos reg-beg + continue nil)) + ) ;t + ) ;cond + ) ;while + ;;(message "pos=%S dot-pos=%S" pos dot-pos) + (if (null pos) pos (cons pos dot-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)) + +(defun web-mode-is-css-string (pos) + (let (beg) + (cond + ((and (setq beg (web-mode-part-token-beginning-position pos)) + (web-mode-looking-at-p "`" beg) + (web-mode-looking-back "\\(styled[[:alnum:].]+\\|css\\)" beg)) + beg) + (t + nil) + ) ;cond + )) + +;; Relay.QL , gql, graphql +(defun web-mode-is-ql-string (pos prefix-regexp) + (let (beg) + (cond + ((and (setq beg (web-mode-part-token-beginning-position pos)) + (web-mode-looking-back prefix-regexp beg)) + beg) + (t + nil) + ) ;cond + )) + +(defun web-mode-is-html-string (pos) + (let (beg) + (cond + ((and (setq beg (web-mode-part-token-beginning-position pos)) + (web-mode-looking-at-p "`[ \t\n]*<[a-zA-Z]" beg) + (web-mode-looking-back "\\(template\\|html\\)\\([ ]*[=:][ ]*\\)?" beg)) + beg) + (t + nil) + ) ;cond + )) + +;;---- 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)) + ((get-text-property (1- pos) 'jsx-end) + (backward-char 1) + (web-mode-jsx-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)) + ((get-text-property pos 'jsx-beg) + (web-mode-jsx-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-tag-next) + (member (get-text-property (point) 'tag-type) '(start void comment))) + (setq pos (point)) + (setq pos nil)) + ) + ((member (get-text-property pos 'tag-type) '(start void)) + (if (and (web-mode-tag-match) + (web-mode-tag-next) + (member (get-text-property (point) 'tag-type) '(start void comment))) + (setq pos (point)) + (setq pos nil)) + ) + ((and (web-mode-tag-next) + (member (get-text-property (point) 'tag-type) '(start void comment))) + (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 (pos block-beg is-ternary) + (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 is-ternary))) + +(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 (pos reg-beg is-ternary) + (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 is-ternary))) + +(defun web-mode-javascript-args-beginning (&optional pos reg-beg) + (unless pos (setq pos (point))) + (unless reg-beg + (setq reg-beg (if (get-text-property pos 'block-side) + (web-mode-block-beginning-position pos) + (web-mode-part-beginning-position pos)))) + ;;(message "reg-beg%S" reg-beg) + (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)))) + (let (pair) + (setq pair (web-mode-javascript-calls-beginning-position pos reg-beg)) + (when pair (web-mode-go (car pair))) + )) + +(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-position (pos regexp &optional limit noerror) + (unless noerror (setq noerror t)) + (save-excursion + (goto-char pos) + (if (re-search-backward regexp limit noerror) (point) nil) + )) + +(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) "\n")) + (princ 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-fontify)) + +(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-fontify)) + +(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 %S" web-mode-engine web-mode-engine-attr-regexp web-mode-engine-token-regexp) + + (when (null web-mode-minor-engine) + (setq web-mode-minor-engine "none")) + + (setq elt (assoc web-mode-engine web-mode-engine-open-delimiter-regexps)) + (cond + (elt + (setq web-mode-block-regexp (cdr elt))) + ((string= web-mode-engine "archibus") + (setq web-mode-block-regexp nil)) + (t + (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)))) + + ;;(message "%S" elts) + + (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)) + ) + + (when (string= web-mode-engine "spip") + (modify-syntax-entry ?# "w" (syntax-table))) + +;; (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) + ;;(message "%S" web-mode-content-type) + ) ;when + ) ;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-fontify)) + 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-file-link (file) + "Insert a link to a file in html document. This function can be +extended to support more filetypes by customizing +`web-mode-links'." + (interactive + (list (file-relative-name (read-file-name "Link file: ")))) + (let ((matched nil) + (point-line (line-number-at-pos)) + (point-column (current-column))) + (dolist (type web-mode-links) + (when (string-match (car type) file) + (setq matched t) + (when (nth 2 type) + (goto-char (point-min)) + (search-forward "") + (backward-char 7) + (open-line 1)) + (insert (format (cadr type) file)) + (indent-for-tab-command) + (when (nth 2 type) + ;; return point where it was and fix indentation + (forward-line) + (indent-for-tab-command) + (if (> point-line (- (line-number-at-pos) 2)) + (forward-line (+ (- point-line (line-number-at-pos)) 1)) + (forward-line (- point-line (line-number-at-pos)))) + (move-to-column point-column)) + ;; move point back if needed + (backward-char (nth 3 type)))) + (when (not matched) + (user-error "Unknown file type")))) + +(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-measure (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-toggle-tracing () + "Toggle tracing." + (interactive) + (if web-mode-trace + (setq web-mode-trace nil) + (message "** tracing on ** point(%S) web-mode-change-beg(%S) web-mode-change-end(%S) web-mode-skip-fontification(%S)" + (point) web-mode-change-beg web-mode-change-end web-mode-skip-fontification) + (setq web-mode-trace t))) + +(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: diff --git a/.emacs.d/session.107c96f9b022627944162418049141699800000014480078 b/.emacs.d/session.107c96f9b022627944162418049141699800000014480078 new file mode 100644 index 0000000..e69de29 diff --git a/.emacs.d/url/cache/abdul/https/com/oklomsy/0bf2840e8829c3d4e059fe472711778e b/.emacs.d/url/cache/abdul/https/com/oklomsy/0bf2840e8829c3d4e059fe472711778e new file mode 100644 index 0000000..ac4dfe8 Binary files /dev/null and b/.emacs.d/url/cache/abdul/https/com/oklomsy/0bf2840e8829c3d4e059fe472711778e differ diff --git a/.emacs.d/url/cache/abdul/https/com/oklomsy/43e0ac23a3e605ecff4a3d1a9e5321fe b/.emacs.d/url/cache/abdul/https/com/oklomsy/43e0ac23a3e605ecff4a3d1a9e5321fe new file mode 100644 index 0000000..95f6d57 Binary files /dev/null and b/.emacs.d/url/cache/abdul/https/com/oklomsy/43e0ac23a3e605ecff4a3d1a9e5321fe differ diff --git a/.emacs.d/url/cache/abdul/https/com/oklomsy/b2ca891d6d6162d822a38bff8fb05672 b/.emacs.d/url/cache/abdul/https/com/oklomsy/b2ca891d6d6162d822a38bff8fb05672 new file mode 100644 index 0000000..a4eb3d6 Binary files /dev/null and b/.emacs.d/url/cache/abdul/https/com/oklomsy/b2ca891d6d6162d822a38bff8fb05672 differ diff --git a/.emacs.d/url/cache/abdul/https/com/oklomsy/fb0b6176631c5655332690f3b0d76d8f b/.emacs.d/url/cache/abdul/https/com/oklomsy/fb0b6176631c5655332690f3b0d76d8f new file mode 100644 index 0000000..5319fb2 Binary files /dev/null and b/.emacs.d/url/cache/abdul/https/com/oklomsy/fb0b6176631c5655332690f3b0d76d8f differ diff --git a/E5150-Blue.obt b/E5150-Blue.obt new file mode 100644 index 0000000..01543c0 Binary files /dev/null and b/E5150-Blue.obt differ diff --git a/E5150-Blue.tar.gz b/E5150-Blue.tar.gz new file mode 100644 index 0000000..ab3c353 Binary files /dev/null and b/E5150-Blue.tar.gz differ diff --git a/config b/config new file mode 100644 index 0000000..7e146ba --- /dev/null +++ b/config @@ -0,0 +1,8 @@ +ControlMaster auto + ControlPath /tmp/ssh_mux_%h_%p_%r + +ControlPersist 5m + +ForwardAgent yes + +ForwardX11 yes