├── .clang-format ├── .editorconfig ├── .gitignore ├── CONTRIBUTING.md ├── LICENSE ├── Makefile ├── README.md ├── lua └── nelisp │ ├── .gitignore │ ├── c.lua │ └── scripts │ ├── differ.lua │ └── makedoc.lua └── src ├── alloc.c ├── bignum.c ├── bignum.h ├── buffer.c ├── buffer.h ├── bytecode.c ├── callproc.c ├── casefiddle.c ├── casetab.c ├── ccl.c ├── character.c ├── character.h ├── charset.c ├── charset.h ├── chartab.c ├── coding.c ├── coding.h ├── composite.h ├── data.c ├── dispnew.c ├── disptab.h ├── doc.c ├── editfns.c ├── emacs.c ├── eval.c ├── fileio.c ├── fns.c ├── insdel.c ├── intervals.c ├── intervals.h ├── keyboard.c ├── keyboard.h ├── keymap.c ├── keymap.h ├── lisp.h ├── lread.c ├── lua.c ├── lua.h ├── nvim.c ├── nvim.h ├── print.c ├── process.c ├── puresize.h ├── regex-emacs.c ├── regex-emacs.h ├── search.c ├── syntax.c ├── syntax.h ├── sysdep.c ├── termhooks.h ├── textprop.c ├── thread.c ├── thread.h ├── timefns.c ├── xdisp.c └── xfaces.c /.clang-format: -------------------------------------------------------------------------------- 1 | BasedOnStyle: GNU 2 | AlignEscapedNewlinesLeft: true 3 | AlignOperands: Align 4 | AlwaysBreakAfterReturnType: TopLevelDefinitions 5 | BreakBeforeBinaryOperators: All 6 | BreakBeforeBraces: GNU 7 | ColumnLimit: 80 8 | ContinuationIndentWidth: 2 9 | IndentPPDirectives: AfterHash 10 | PPIndentWidth: 1 11 | ForEachMacros: 12 | - FOR_EACH_TAIL 13 | - FOR_EACH_TAIL_SAFE 14 | - FOR_EACH_LIVE_BUFFER 15 | - ITREE_FOREACH 16 | - FOR_EACH_ALIST_VALUE 17 | IncludeCategories: 18 | - Regex: '^$' 19 | Priority: -1 20 | - Regex: '^<' 21 | Priority: 1 22 | - Regex: '^"lisp\.h"$' 23 | Priority: 2 24 | - Regex: '.*' 25 | Priority: 3 26 | WhitespaceSensitiveMacros: 27 | - STR 28 | - CALL1I 29 | - CALL2I 30 | - STR_VALUE 31 | 32 | - DEFUN 33 | - DEFVAR_LISP 34 | - DEFVAR_LISP_NOPRO 35 | - DEFVAR_BOOL 36 | - DEFVAR_INT 37 | - DEFVAR_KBOARD 38 | - DEFSYM 39 | Macros: 40 | - CASE(op)=case op 41 | - FIRST=switch (op) 42 | - "CASE_DEFAULT=case 255: default:" 43 | - CASE_ABORT=case 0 44 | KeepEmptyLinesAtTheStartOfBlocks: false 45 | MaxEmptyLinesToKeep: 1 46 | PenaltyBreakBeforeFirstCallParameter: 2000 47 | SpaceAfterCStyleCast: true 48 | SpaceBeforeParens: Always 49 | UseTab: Never 50 | 51 | # Local Variables: 52 | # mode: yaml 53 | # End: 54 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | root = true 2 | 3 | [*.{c,h,in}] 4 | indent_style = space 5 | indent_size = 2 6 | 7 | [*.lua] 8 | indent_style = space 9 | indent_size = 4 10 | 11 | [Makefile] 12 | indent_style = tab 13 | indent_size = 8 14 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.so 2 | /src/globals.h 3 | /src/link.c 4 | /.cache 5 | /compile_commands.json 6 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Commits 2 | Do [Conventional Commits](https://www.conventionalcommits.org) 3 | 4 | # Coding 5 | ## Comments 6 | All comments have to use `//`, and not `/* */`, with the exception of when a `/* */` is required/used by external tools to generate stuff. This makes it easier to know what's a comment from the emacs source code and what's a nelisp comment. 7 | 8 | ## Supported os 9 | Only the tartets which nvim has tier 1 support for are designed to be supported (see `:h support). 10 | 11 | ## Lint 12 | The linter is run with `make check` (uses `clang-check`). 13 | A stronger version of the linter is run with `make analyze` (which also uses `clang-check`). 14 | Only the weaker version is needs to pass. 15 | 16 | ## Style 17 | The formatter is run with `make format` (uses `clang-format`). 18 | There's not yet any style guide for lua code, so do whatever you want. 19 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | CC=gcc 2 | 3 | CFLAGS= 4 | 5 | all: 6 | which jq >/dev/null && test $$(jq length compile_commands.json) = 0 && rm compile_commands.json || true 7 | [ Makefile -nt compile_commands.json ] && intercept-build make nelisp || make nelisp 8 | 9 | nelisp: 10 | ./lua/nelisp/scripts/makedoc.lua src/lua.c lua/nelisp/_c_meta.lua src src/globals.h src/link.c 11 | $(CC) src/link.c -lluajit-5.1 -shared -o nelisp.so -Wall -Wextra -Werror -pedantic -Wimplicit-fallthrough $(CFLAGS) -fvisibility=hidden -fPIC -std=gnu17 -lgmp 12 | 13 | format: 14 | clang-format src/*.c src/*.h -i --style=file 15 | 16 | check: 17 | find src/ -name '*.c' -o -name '*.h' -not -name 'globals.h'|\ 18 | xargs clang-check 19 | 20 | analyze: 21 | find src/ -name '*.c' -o -name '*.h' -not -name 'globals.h'|\ 22 | xargs clang-check --analyze --analyzer-output-path=/dev/null --extra-arg=-Dlint 23 | 24 | .PHONY: all nelisp format check analyze 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Nelisp 2 | The **N**eovim **E**macs **LISP** interpreter. 3 | 4 | > [!NOTE] 5 | > This is a work in progress. 6 | 7 | ## Init 8 | ```lua 9 | -- Remember to run `make` once. 10 | 11 | -- The `nelisp.c` module is a wrapper around `nelisp.so` using `package.loadlib`. 12 | -- Run `make` to generate a meta file for completions. 13 | local c = require'nelisp.c' 14 | 15 | -- Emacs doesn't really give this path a name, so I call it emacs's runtime path. 16 | -- It is the parent directory of the `data-directory` and the parent directory of root load path. 17 | -- Typically, either `/usr/share/emacs/30.1/`(or local variant) or the git repo's root. 18 | c.init({runtime_path = EMACS_RUNTIME_PATH}) 19 | 20 | c.eval[[ 21 | (message "Hello World!") 22 | ]] 23 | ``` 24 | 25 | ## Goals 26 | + Being able to run emacs plugins such as magit and org-mode 27 | + Performant(fast) loading of elisp-stdlib (100-200ms) 28 | 29 | ## Roadmap 30 | + [x] Rewrite in C ([old-lua-branch](https://github.com/altermo/nelisp/tree/lua)) 31 | + Implement all functions(/other features) to be able to load all of `loadup.el` without errors 32 | + Implement dumping 33 | + Implement a bridge between nelisp and neovim 34 | + Implement the rest of the functions(/other features); make all emacs test pass 35 | -------------------------------------------------------------------------------- /lua/nelisp/.gitignore: -------------------------------------------------------------------------------- 1 | /_c_meta.lua 2 | -------------------------------------------------------------------------------- /lua/nelisp/c.lua: -------------------------------------------------------------------------------- 1 | local env={ 2 | memtbl=setmetatable({},{__mode='v'}), 3 | buftbl=setmetatable({},{__mode='k'}), 4 | } 5 | 6 | local path 7 | 8 | local M=vim.defaulttable(function (k) 9 | if not path then 10 | path=vim.api.nvim_get_runtime_file('nelisp.so',false)[1] 11 | end 12 | assert(path,'nelisp.so not found in runtimepath') 13 | local f,err=package.loadlib(path,k) 14 | if err then 15 | error(err) 16 | end 17 | assert(f,k..' not found') 18 | debug.setfenv(f,env) 19 | return f 20 | end) 21 | 22 | M._memtbl=env.memtbl 23 | M._buftbl=env.buftbl 24 | 25 | return M 26 | -------------------------------------------------------------------------------- /lua/nelisp/scripts/differ.lua: -------------------------------------------------------------------------------- 1 | local query=vim.treesitter.query.parse('c',[[ 2 | (preproc_def name: (identifier) @name) @definition 3 | (preproc_function_def name: (identifier) @name) @definition 4 | 5 | (function_definition declarator: (_ declarator: (identifier) @name . (parameter_list))) @definition 6 | (function_definition declarator: (pointer_declarator declarator: (_ declarator: (identifier) @name))) @definition 7 | (function_definition declarator: (pointer_declarator declarator: (pointer_declarator declarator: (_ declarator: (identifier) @name)))) @definition 8 | (function_definition declarator: (parenthesized_declarator (identifier) @name)) @definition 9 | (function_definition declarator: (_ declarator: (parenthesized_declarator (identifier) @name))) @definition 10 | (function_definition declarator: (function_declarator declarator: (_ parameters: (_ (parameter_declaration) @name)))) @definition 11 | (function_definition declarator: (_ (ERROR (identifier) @name) . (parameter_list))) @definition 12 | 13 | (enumerator name: (identifier) @name) @definition 14 | 15 | ((expression_statement (call_expression (call_expression function: (_) @_defun (#eq? @_defun "DEFUN") arguments: (_ (string_literal) . (identifier) @name)))) . (compound_statement) @definition) @definition2 16 | ]]) 17 | local query_check=vim.treesitter.query.parse('c',[[ 18 | (preproc_def) @1 19 | (preproc_function_def) @1 20 | (function_definition) @1 21 | (enumerator) @1 22 | ; (enum_specifier) @1 23 | ; (struct_specifier) @1 24 | ; (type_definition) @1 25 | 26 | ((expression_statement (call_expression (call_expression function: (_) @1 (#eq? @1 "DEFUN") arguments: (_ (string_literal) . (identifier))))) . (compound_statement)) 27 | ]]) 28 | local function get_nodes_with_injections(parser) 29 | ---Taken from runtime/lua/vim/treesitter/dev.lua 30 | local injections = {} 31 | parser:for_each_tree(function(parent_tree, parent_ltree) 32 | local parent = parent_tree:root() 33 | for _, child in pairs(parent_ltree:children()) do 34 | for _, tree in pairs(child:trees()) do 35 | local r = tree:root() 36 | local node = assert(parent:named_descendant_for_range(r:range())) 37 | -- HACK: `node:id` may return the same id if different trees 38 | local id = node:id() 39 | if not injections[id] or r:byte_length() > injections[id]:byte_length() then 40 | injections[id] = r 41 | end 42 | end 43 | end 44 | end) 45 | return injections 46 | end 47 | local function get_definitions(source) 48 | local parser=vim.treesitter.get_string_parser(source,'c') 49 | local tree=parser:parse(true)[1] 50 | local out=vim.defaulttable(function () return {} end) 51 | out._nameless={} 52 | local n=0 53 | for _,match in query:iter_matches(tree:root(),source,0,-1,{}) do 54 | n=n+1 55 | local name,definition,definition2 56 | for id,nodes in pairs(match) do 57 | local fname=query.captures[id] 58 | assert(#nodes==1) 59 | if fname=='name' then 60 | name=vim.treesitter.get_node_text(nodes[1],source) 61 | elseif fname=='definition' then 62 | definition=nodes[1] 63 | elseif fname=='definition2' then 64 | definition2=nodes[1] 65 | elseif fname:sub(1,1)=='_' then 66 | else 67 | error('unexpected capture') 68 | end 69 | end 70 | assert(name and definition) 71 | table.insert(out[name],{definition,definition2}) 72 | end 73 | local n_check=0 74 | local check_nodes={} 75 | for _,match in query_check:iter_matches(tree:root(),source,0,-1,{}) do 76 | n_check=n_check+1 77 | assert(#match==1 and #match[1]==1) 78 | check_nodes[match[1][1]:id()]=match[1][1] 79 | end 80 | if n_check~=n then 81 | for _,nodes_s in pairs(out) do 82 | for _,nodes in ipairs(nodes_s) do 83 | for _,node in ipairs(nodes) do 84 | check_nodes[node:id()]=nil 85 | end 86 | end 87 | end 88 | local err={} 89 | for _,v in pairs(check_nodes) do 90 | table.insert(err,'```\n'..vim.treesitter.get_node_text(v,source)..'\n```') 91 | end 92 | error(('miscount: %d-%d \n'):format(n,n_check)..table.concat(err,'\n*AND*\n')) 93 | end 94 | return out,get_nodes_with_injections(parser) 95 | end 96 | local function diff_node_ignore_comments(a,b,a_source,b_source,a_injections,b_injections) 97 | if type(a)=='table' and type(b)=='table' then 98 | if #a~=#b then 99 | return true 100 | end 101 | for i=1,#a do 102 | if diff_node_ignore_comments(a[i],b[i],a_source,b_source,a_injections,b_injections) then 103 | return true 104 | end 105 | end 106 | return false 107 | end 108 | if a:type()=='comment' then 109 | assert(b:type()=='comment') 110 | return false 111 | end 112 | if a:type()~=b:type() then 113 | return true 114 | end 115 | local filter_a={} 116 | for node in a:iter_children() do 117 | if node:type()~='comment' then 118 | table.insert(filter_a,node) 119 | end 120 | end 121 | local filter_b={} 122 | for node in b:iter_children() do 123 | if node:type()~='comment' then 124 | table.insert(filter_b,node) 125 | end 126 | end 127 | if #filter_a~=#filter_b then 128 | return true 129 | end 130 | if a_injections[a:id()] then 131 | if not b_injections[b:id()] then 132 | return true 133 | end 134 | return diff_node_ignore_comments(a_injections[a:id()],b_injections[b:id()],a_source,b_source,a_injections,b_injections) 135 | end 136 | if #filter_a==0 then 137 | if a:named() and b:named() then --HACK: needed for e.x. `# define`/`#define` 138 | if vim.treesitter.get_node_text(a,a_source)~=vim.treesitter.get_node_text(b,b_source) then 139 | return true 140 | end 141 | end 142 | end 143 | for i=1,#filter_a do 144 | if diff_node_ignore_comments(filter_a[i],filter_b[i],a_source,b_source,a_injections,b_injections) then 145 | return true 146 | end 147 | end 148 | return false 149 | end 150 | local function diff(a,b) 151 | -- These break the parser, so remove them 152 | local remove={ 153 | 'DEFINE_GDB_SYMBOL_BEGIN%s*%b()', 154 | 'DEFINE_GDB_SYMBOL_END%s*%b()', 155 | 'ATTRIBUTE_NO_SANITIZE_UNDEFINED', 156 | '%s*##%s*', 157 | } 158 | for _,r in ipairs(remove) do 159 | a=a:gsub(r,'') 160 | b=b:gsub(r,'') 161 | end 162 | local a_def,a_injections=get_definitions(a) 163 | local b_def,b_injections=get_definitions(b) 164 | local new={} 165 | local missing={} 166 | local both={} 167 | for name,_ in pairs(a_def) do 168 | if #b_def[name]==0 then 169 | table.insert(new,name) 170 | else 171 | table.insert(both,name) 172 | end 173 | end 174 | for name,_ in pairs(b_def) do 175 | if #a_def[name]==0 then 176 | table.insert(missing,name) 177 | end 178 | end 179 | local differ={} 180 | for _,name in pairs(both) do 181 | local a_nodes=a_def[name] 182 | local b_nodes=b_def[name] 183 | for j=1,#a_nodes do 184 | local a_node=a_nodes[j] 185 | for i=1,#b_nodes do 186 | local b_node=b_nodes[i] 187 | if not diff_node_ignore_comments(a_node,b_node,a,b,a_injections,b_injections) then 188 | goto continue 189 | end 190 | end 191 | table.insert(differ,name) 192 | ::continue:: 193 | end 194 | end 195 | return new,missing,both,differ,a_def,b_def,a,b 196 | end 197 | local state={cache={}} 198 | local function buf_set_lines(buf,start,end_,lines) 199 | vim.bo[buf].modifiable=true 200 | vim.api.nvim_buf_set_lines(buf,start,end_,false,lines) 201 | vim.bo[buf].modifiable=false 202 | end 203 | local function create_get_buff(name) 204 | if vim.fn.bufexists(name)==1 then 205 | return vim.fn.bufnr(name) 206 | end 207 | local b=vim.api.nvim_create_buf(false,true) 208 | vim.api.nvim_buf_set_name(b,name) 209 | vim.bo[b].bufhidden='unload' 210 | vim.bo[b].modifiable=false 211 | return b 212 | end 213 | local function buf_get_line(buf) 214 | if vim.fn.bufwinid(buf)==-1 then 215 | return nil 216 | end 217 | local win=vim.fn.bufwinid(buf) 218 | local line=vim.fn.line('.',win) 219 | return vim.fn.getbufoneline(buf,line) 220 | end 221 | local function ui(path_nelisp,path_emacs) 222 | local files=vim.fn.readdir(path_nelisp) 223 | local e_files=vim.fn.readdir(path_emacs) 224 | for i=#files,1,-1 do 225 | local f=files[i] 226 | if not vim.tbl_contains(e_files,f) then 227 | table.remove(files,i) 228 | end 229 | end 230 | local b_file_selector=create_get_buff('nelisp://file_selector') 231 | local width=math.max(unpack(vim.tbl_map(string.len,files)))+9 232 | buf_set_lines(b_file_selector,0,-1,files) 233 | local b_option_selector=create_get_buff('nelisp://option_selector') 234 | buf_set_lines(b_option_selector,0,-1,{'diff','new','missing','both'}) 235 | local b_function_selector=create_get_buff('nelisp://function_selector') 236 | local b_diff_old=create_get_buff('nelisp://diff_old') 237 | vim.bo[b_diff_old].filetype='c' 238 | local b_diff_new=create_get_buff('nelisp://diff_new') 239 | vim.bo[b_diff_new].filetype='c' 240 | local function render() 241 | local do_render_function 242 | do 243 | local file=buf_get_line(b_file_selector) 244 | if not file then return end 245 | if state.file~=file then 246 | do_render_function=true 247 | end 248 | if file then 249 | state.file=file 250 | end 251 | end 252 | do 253 | local option=buf_get_line(b_option_selector) 254 | if state.option~=option then 255 | do_render_function=true 256 | end 257 | if option then 258 | state.option=option 259 | end 260 | end 261 | local new,missing,both,differ,new_def,old_def,new_source,old_source 262 | if not state.cache[state.file] then 263 | local a_file=vim.fs.joinpath(path_nelisp,state.file) 264 | local b_file=vim.fs.joinpath(path_emacs,state.file) 265 | new,missing,both,differ,new_def,old_def,new_source,old_source=diff(vim.fn.readblob(a_file),vim.fn.readblob(b_file)) 266 | state.cache[state.file]={new,missing,both,differ,new_def,old_def,new_source,old_source} 267 | else 268 | new,missing,both,differ,new_def,old_def,new_source,old_source=unpack(state.cache[state.file]) 269 | end 270 | if do_render_function then 271 | local funcs={} 272 | if state.option=='diff' then 273 | funcs=differ 274 | elseif state.option=='new' then 275 | funcs=new 276 | elseif state.option=='missing' then 277 | funcs=missing 278 | elseif state.option=='both' then 279 | funcs=both 280 | end 281 | buf_set_lines(b_function_selector,0,-1,funcs) 282 | end 283 | local func=buf_get_line(b_function_selector) 284 | if func=='' then 285 | buf_set_lines(b_diff_old,0,-1,{}) 286 | buf_set_lines(b_diff_new,0,-1,{}) 287 | return 288 | end 289 | if not new_def[func] then 290 | buf_set_lines(b_diff_new,0,-1,{}) 291 | else 292 | local lines={} 293 | for _,nodes in ipairs(new_def[func]) do 294 | for _,node in ipairs(nodes) do 295 | for _,line in ipairs(vim.split(vim.treesitter.get_node_text(node,new_source),'\n')) do 296 | table.insert(lines,line) 297 | end 298 | end 299 | table.insert(lines,'/*'..('-'):rep(30)..'*/') 300 | end 301 | buf_set_lines(b_diff_new,0,-1,lines) 302 | end 303 | if not old_def[func] then 304 | buf_set_lines(b_diff_old,0,-1,{}) 305 | else 306 | local lines={} 307 | for _,nodes in ipairs(old_def[func]) do 308 | for _,node in ipairs(nodes) do 309 | for _,line in ipairs(vim.split(vim.treesitter.get_node_text(node,old_source),'\n')) do 310 | table.insert(lines,line) 311 | end 312 | end 313 | table.insert(lines,'/*'..('-'):rep(30)..'*/') 314 | end 315 | buf_set_lines(b_diff_old,0,-1,lines) 316 | end 317 | end 318 | vim.cmd.split{mods={tab=vim.fn.tabpagenr()}} 319 | vim.api.nvim_set_current_buf(b_file_selector) 320 | local w_file_selector=vim.api.nvim_get_current_win() 321 | vim.cmd.vsplit() 322 | vim.api.nvim_set_current_buf(b_function_selector) 323 | local w_function_selector=vim.api.nvim_get_current_win() 324 | vim.cmd.split() 325 | vim.api.nvim_set_current_buf(b_diff_old) 326 | local w_diff_old=vim.api.nvim_get_current_win() 327 | vim.cmd.vsplit() 328 | vim.api.nvim_set_current_buf(b_diff_new) 329 | local w_diff_new=vim.api.nvim_get_current_win() 330 | vim.cmd.wincmd('t') 331 | vim.cmd.split() 332 | vim.api.nvim_set_current_buf(b_option_selector) 333 | local w_option_selector=vim.api.nvim_get_current_win() 334 | vim.cmd.wincmd{'|',count=width} 335 | vim.wo[w_option_selector].cursorline=true 336 | vim.wo[w_function_selector].cursorline=true 337 | vim.wo[w_file_selector].cursorline=true 338 | vim.wo[w_diff_old].diff=true 339 | vim.wo[w_diff_new].diff=true 340 | vim.api.nvim_create_autocmd('CursorMoved',{buffer=b_file_selector,callback=render}) 341 | vim.api.nvim_create_autocmd('CursorMoved',{buffer=b_option_selector,callback=render}) 342 | vim.api.nvim_create_autocmd('CursorMoved',{buffer=b_function_selector,callback=render}) 343 | render() 344 | end 345 | return ui 346 | -------------------------------------------------------------------------------- /lua/nelisp/scripts/makedoc.lua: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env -S nvim -l 2 | ---@alias nelisp.makedoc.lfn table 3 | --- name ret args 4 | ---@alias nelisp.makedoc.cfn table 5 | --- name maxargs attrs 6 | ---@alias nelisp.makedoc.sym table 7 | --- name sname 8 | ---@alias nelisp.makedoc.var table 9 | --- name type 10 | local map={ 11 | string={'string','str'}, 12 | number={'number','n'}, 13 | object={'nelisp.obj','obj'}, 14 | table={'table','tbl'}, 15 | } 16 | ---@param path string 17 | ---@return nelisp.makedoc.lfn 18 | local function scan_lua_c(path) 19 | local s=vim.fn.readblob(path) 20 | ---@return string 21 | local out={} 22 | for pos in s:gmatch('[\n\r]int pub()') do 23 | local ret,name 24 | ret,name,pos=s:match('^%s+ret%s*(%b())%s+([a-zA-Z_1-9]+)%s*%(lua_State %*L%)%s*{%s*()',pos) 25 | if not ret then 26 | error('pub function bad format') 27 | end 28 | ret=ret:sub(2,-2) 29 | if ret:find('^%s*/%*(.*)%*/%s*$') then 30 | ret=ret:match('^%s*/%*(.*)%*/%s*$') 31 | end 32 | if ret=='' then 33 | ret=nil 34 | end 35 | if s:find('^_global_lua_state%s*=%s*L;',pos) then 36 | pos=s:match('^_global_lua_state%s*=%s*L;%s*()',pos) 37 | end 38 | local nargs 39 | nargs,pos=s:match('^check_nargs%s*%(%s*L,%s*(%d+)%s*%);%s*()',pos) 40 | if not nargs then 41 | error('pub function bad format') 42 | end 43 | local type_map={} 44 | local args={} 45 | for _=1,tonumber(nargs) do 46 | local type_ 47 | type_,pos=s:match('^check_is(%w*)[^\n\r]-[\n\r]%s*()',pos) 48 | if not type_ then 49 | error('pub function bad format') 50 | end 51 | if type(type_map[type_])=='table' then 52 | type_map[type_][2]=map[type_][2]..'1' 53 | type_map[type_]=2 54 | end 55 | local varname=map[type_][2]..(type_map[type_] or '') 56 | table.insert(args,{map[type_][1],varname}) 57 | if type_map[type_] then 58 | type_map[type_]=type_map[type_]+1 59 | else 60 | type_map[type_]=args[#args] 61 | end 62 | end 63 | out[name]={ret,args} 64 | ::continue:: 65 | end 66 | return out 67 | end 68 | ---@param lfn nelisp.makedoc.lfn 69 | ---@param out string[] 70 | local function lfn_to_meta(lfn,out) 71 | for name,info in vim.spairs(lfn) do 72 | local ret,args=unpack(info) 73 | table.insert(out,'') 74 | local arg_vars={} 75 | for _,v in ipairs(args) do 76 | table.insert(out,('---@param %s %s'):format(v[2],v[1])) 77 | table.insert(arg_vars,v[2]) 78 | end 79 | if ret then 80 | table.insert(out,('---@return %s'):format(ret)) 81 | end 82 | table.insert(out,('function M.%s(%s) end'):format(name,table.concat(arg_vars,','))) 83 | end 84 | end 85 | ---@param path string 86 | ---@param out {f:nelisp.makedoc.cfn,s:nelisp.makedoc.sym,v:nelisp.makedoc.var} 87 | local function scan_c(path,out) 88 | local s=vim.fn.readblob(path) 89 | for pos in s:gmatch('[\n\r]%s*()DEF[UVS]') do 90 | local typ 91 | if s:match('^DEFUN',pos) then 92 | pos=pos+#('DEFUN') 93 | typ='function' 94 | elseif s:match('^DEFSYM[ \t(]',pos) then 95 | typ='symbol' 96 | elseif s:match('^DEFVAR_',pos) then 97 | pos=pos+#('DEFVAR_') 98 | if s:match('^I',pos) then 99 | pos=pos+1 100 | typ='integer' 101 | elseif s:match('^L',pos) then 102 | pos=pos+1 103 | typ='object' 104 | elseif s:match('^BO',pos) then 105 | pos=pos+2 106 | typ='boolean' 107 | end 108 | end 109 | if not typ then goto continue end 110 | pos=s:match('^[^(]*%(()',pos) 111 | if not pos then goto continue end 112 | if typ~='symbol' then 113 | pos=s:match('^"[^"]*"()',pos) 114 | if not pos then goto continue end 115 | end 116 | pos=assert(s:match('^[%s,]*()',pos)) 117 | local name 118 | name,pos=assert(s:match('^([^%s,]*)()',pos)) 119 | if typ=='symbol' then 120 | pos=assert(s:match('^[%s,]*()',pos)) 121 | local sname 122 | sname,pos=s:match('^"([^"]*)"()',pos) 123 | out.s[name]=sname 124 | goto continue 125 | elseif typ~='function' then 126 | out.v[name]=typ 127 | goto continue 128 | end 129 | local function get_comma() 130 | pos=s:match('^[^,]*,%s*()',pos) 131 | if not pos then error('EOF') end 132 | local val 133 | val,pos=s:match('^([^,]*)()',pos) 134 | return val 135 | end 136 | get_comma() 137 | get_comma() 138 | local maxargs=get_comma() 139 | if maxargs=='MANY' then 140 | maxargs=-2 141 | elseif maxargs=='UNEVALLED' then 142 | maxargs=-1 143 | else 144 | maxargs=tonumber(maxargs) 145 | if not maxargs then error('') end 146 | end 147 | get_comma() 148 | pos=assert(s:match('^.-%*/%s*()',pos)) 149 | local attrs={} 150 | if s:match('^attributes:',pos) then 151 | pos=pos+#'attributes:' 152 | local attr 153 | attr,pos=assert(s:match('(.-)%)()',pos)) 154 | if attr:find('noreturn') then 155 | table.insert(attrs,'_Noreturn') 156 | elseif attr:find('const') then 157 | table.insert(attrs,'__attribute__((__const__))') 158 | end 159 | end 160 | out.f[name]={maxargs,attrs} 161 | ::continue:: 162 | end 163 | end 164 | ---@param file string 165 | ---@return number 166 | local function file_mtime(file) 167 | local stat=vim.uv.fs_stat(file) 168 | if not stat then return -math.huge end 169 | return stat.mtime.sec+stat.mtime.nsec/1000000000 170 | end 171 | local function outfile_needs_update(out,other) 172 | local out_mtime=file_mtime(out) 173 | local other_mtime 174 | if vim.uv.fs_stat(other).type=='directory' then 175 | other_mtime=-math.huge 176 | for file in vim.fs.dir(other) do 177 | other_mtime=math.max(other_mtime,file_mtime(vim.fs.joinpath(other,file))) 178 | end 179 | else 180 | other_mtime=file_mtime(other) 181 | end 182 | return out_mtimevalue); 82 | mpz_swap (b->value, mpz[0]); 83 | return make_lisp_ptr (b, Lisp_Vectorlike); 84 | } 85 | 86 | Lisp_Object 87 | make_integer_mpz (void) 88 | { 89 | size_t bits = mpz_sizeinbase (mpz[0], 2); 90 | 91 | if (bits <= FIXNUM_BITS) 92 | { 93 | EMACS_INT v = 0; 94 | int i = 0, shift = 0; 95 | 96 | do 97 | { 98 | EMACS_INT limb = mpz_getlimbn (mpz[0], i++); 99 | v += limb << shift; 100 | shift += GMP_NUMB_BITS; 101 | } 102 | while (shift < (long) bits); 103 | 104 | if (mpz_sgn (mpz[0]) < 0) 105 | v = -v; 106 | 107 | if (!FIXNUM_OVERFLOW_P (v)) 108 | return make_fixnum (v); 109 | } 110 | 111 | return make_bignum_bits (bits); 112 | } 113 | 114 | intmax_t 115 | check_integer_range (Lisp_Object x, intmax_t lo, intmax_t hi) 116 | { 117 | CHECK_INTEGER (x); 118 | intmax_t i; 119 | if (!(integer_to_intmax (x, &i) && lo <= i && i <= hi)) 120 | args_out_of_range_3 (x, make_int (lo), make_int (hi)); 121 | return i; 122 | } 123 | -------------------------------------------------------------------------------- /src/bignum.h: -------------------------------------------------------------------------------- 1 | #ifndef BIGNUM_H 2 | #define BIGNUM_H 3 | 4 | #include 5 | #include "lisp.h" 6 | 7 | extern mpz_t mpz[5]; 8 | 9 | struct Lisp_Bignum 10 | { 11 | union vectorlike_header header; 12 | mpz_t value; 13 | } GCALIGNED_STRUCT; 14 | 15 | extern Lisp_Object make_integer_mpz (void); 16 | extern void init_bignum (void); 17 | extern void emacs_mpz_mul_2exp (mpz_t, mpz_t const, EMACS_INT); 18 | 19 | INLINE struct Lisp_Bignum * 20 | XBIGNUM (Lisp_Object a) 21 | { 22 | eassert (BIGNUMP (a)); 23 | return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Bignum); 24 | } 25 | 26 | INLINE void 27 | mpz_set_intmax (mpz_t result, intmax_t v) 28 | { 29 | if (LONG_MIN <= v && v <= LONG_MAX) 30 | mpz_set_si (result, v); 31 | else 32 | TODO; // mpz_set_intmax_slow (result, v); 33 | } 34 | INLINE void 35 | mpz_set_uintmax (mpz_t result, uintmax_t v) 36 | { 37 | if (v <= ULONG_MAX) 38 | mpz_set_ui (result, v); 39 | else 40 | TODO; // mpz_set_uintmax_slow (result, v); 41 | } 42 | 43 | INLINE mpz_t const * 44 | bignum_val (struct Lisp_Bignum const *i) 45 | { 46 | return &i->value; 47 | } 48 | INLINE mpz_t const * 49 | xbignum_val (Lisp_Object i) 50 | { 51 | return bignum_val (XBIGNUM (i)); 52 | } 53 | 54 | INLINE mpz_t const * 55 | bignum_integer (mpz_t *tmp, Lisp_Object i) 56 | { 57 | if (FIXNUMP (i)) 58 | { 59 | mpz_set_intmax (*tmp, XFIXNUM (i)); 60 | return (mpz_t const *) tmp; 61 | } 62 | return xbignum_val (i); 63 | } 64 | 65 | #endif 66 | -------------------------------------------------------------------------------- /src/buffer.c: -------------------------------------------------------------------------------- 1 | #include "buffer.h" 2 | #include "lisp.h" 3 | #include "nvim.h" 4 | 5 | struct buffer buffer_defaults; 6 | 7 | EMACS_INT 8 | fix_position (Lisp_Object pos) 9 | { 10 | if (FIXNUMP (pos)) 11 | return XFIXNUM (pos); 12 | if (MARKERP (pos)) 13 | TODO; // return marker_position (pos); 14 | CHECK_TYPE (BIGNUMP (pos), Qinteger_or_marker_p, pos); 15 | return !NILP (Fnatnump (pos)) ? MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM; 16 | } 17 | 18 | void 19 | nsberror (Lisp_Object spec) 20 | { 21 | if (STRINGP (spec)) 22 | error ("No buffer named %s", SDATA (spec)); 23 | error ("Invalid buffer argument"); 24 | } 25 | 26 | DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0, 27 | doc: /* Return the buffer named BUFFER-OR-NAME. 28 | BUFFER-OR-NAME must be either a string or a buffer. If BUFFER-OR-NAME 29 | is a string and there is no buffer with that name, return nil. If 30 | BUFFER-OR-NAME is a buffer, return it as given. */) 31 | (register Lisp_Object buffer_or_name) 32 | { 33 | if (BUFFERP (buffer_or_name)) 34 | return buffer_or_name; 35 | CHECK_STRING (buffer_or_name); 36 | 37 | return nvim_name_to_bufobj (buffer_or_name); 38 | } 39 | 40 | DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 2, 0, 41 | doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed. 42 | If BUFFER-OR-NAME is a string and a live buffer with that name exists, 43 | return that buffer. If no such buffer exists, create a new buffer with 44 | that name and return it. 45 | 46 | If BUFFER-OR-NAME starts with a space, the new buffer does not keep undo 47 | information. If optional argument INHIBIT-BUFFER-HOOKS is non-nil, the 48 | new buffer does not run the hooks `kill-buffer-hook', 49 | `kill-buffer-query-functions', and `buffer-list-update-hook'. This 50 | avoids slowing down internal or temporary buffers that are never 51 | presented to users or passed on to other applications. 52 | 53 | If BUFFER-OR-NAME is a buffer instead of a string, return it as given, 54 | even if it is dead. The return value is never nil. */) 55 | (register Lisp_Object buffer_or_name, Lisp_Object inhibit_buffer_hooks) 56 | { 57 | register Lisp_Object buffer; 58 | 59 | buffer = Fget_buffer (buffer_or_name); 60 | if (!NILP (buffer)) 61 | return buffer; 62 | 63 | if (SCHARS (buffer_or_name) == 0) 64 | error ("Empty string for buffer name is not allowed"); 65 | buffer = nvim_create_buf (buffer_or_name, inhibit_buffer_hooks); 66 | return buffer; 67 | } 68 | 69 | DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0, 70 | doc: /* Return the current buffer as a Lisp object. */) 71 | (void) 72 | { 73 | register Lisp_Object buf; 74 | XSETBUFFER (buf, current_buffer); 75 | return buf; 76 | } 77 | 78 | void 79 | set_buffer_internal (register struct buffer *b) 80 | { 81 | TODO_NELISP_LATER; 82 | nvim_set_buffer (b); 83 | } 84 | 85 | DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0, 86 | doc: /* Make buffer BUFFER-OR-NAME current for editing operations. 87 | BUFFER-OR-NAME may be a buffer or the name of an existing buffer. 88 | See also `with-current-buffer' when you want to make a buffer current 89 | temporarily. This function does not display the buffer, so its effect 90 | ends when the current command terminates. Use `switch-to-buffer' or 91 | `pop-to-buffer' to switch buffers permanently. 92 | The return value is the buffer made current. */) 93 | (register Lisp_Object buffer_or_name) 94 | { 95 | register Lisp_Object buffer; 96 | buffer = Fget_buffer (buffer_or_name); 97 | if (NILP (buffer)) 98 | nsberror (buffer_or_name); 99 | if (!BUFFER_LIVE_P (XBUFFER (buffer))) 100 | error ("Selecting deleted buffer"); 101 | set_buffer_internal (XBUFFER (buffer)); 102 | return buffer; 103 | } 104 | 105 | DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0, 106 | doc: /* Return the name of BUFFER, as a string. 107 | BUFFER defaults to the current buffer. 108 | Return nil if BUFFER has been killed. */) 109 | (register Lisp_Object buffer) { return BVAR (decode_buffer (buffer), name); } 110 | 111 | void 112 | init_buffer (void) 113 | { 114 | AUTO_STRING (scratch, "*scratch*"); 115 | Fget_buffer_create (scratch, Qnil); 116 | } 117 | 118 | void 119 | syms_of_buffer (void) 120 | { 121 | DEFVAR_LISP ("case-fold-search", Vcase_fold_search, 122 | doc: /* Non-nil if searches and matches should ignore case. */); 123 | Vcase_fold_search = Qt; 124 | DEFSYM (Qcase_fold_search, "case-fold-search"); 125 | Fmake_variable_buffer_local (Qcase_fold_search); 126 | 127 | defsubr (&Sget_buffer); 128 | defsubr (&Sget_buffer_create); 129 | defsubr (&Scurrent_buffer); 130 | defsubr (&Sset_buffer); 131 | defsubr (&Sbuffer_name); 132 | } 133 | -------------------------------------------------------------------------------- /src/buffer.h: -------------------------------------------------------------------------------- 1 | #ifndef EMACS_BUFFER_H 2 | #define EMACS_BUFFER_H 3 | 4 | #include "lisp.h" 5 | #include "nvim.h" 6 | 7 | #define current_buffer (nvim_current_buffer ()) 8 | 9 | extern struct buffer buffer_defaults; 10 | 11 | #define ZV (nvim_get_field_zv (current_buffer, true)) 12 | #define ZV_BYTE (nvim_get_field_zv (current_buffer, false)) 13 | #define BEGV (nvim_get_field_begv (current_buffer, true)) 14 | #define BEGV_BYTE (nvim_get_field_begv (current_buffer, false)) 15 | 16 | INLINE bool 17 | BUFFERP (Lisp_Object a) 18 | { 19 | return PSEUDOVECTORP (a, PVEC_BUFFER); 20 | } 21 | 22 | INLINE void 23 | CHECK_BUFFER (Lisp_Object x) 24 | { 25 | CHECK_TYPE (BUFFERP (x), Qbufferp, x); 26 | } 27 | 28 | INLINE struct buffer * 29 | XBUFFER (Lisp_Object a) 30 | { 31 | eassert (BUFFERP (a)); 32 | return XUNTAG (a, Lisp_Vectorlike, struct buffer); 33 | } 34 | 35 | INLINE struct buffer * 36 | decode_buffer (Lisp_Object b) 37 | { 38 | return NILP (b) ? current_buffer : (CHECK_BUFFER (b), XBUFFER (b)); 39 | } 40 | 41 | #define BVAR(buf, field) nvim_bvar (buf, NVIM_BUFFER_VAR__##field) 42 | 43 | INLINE bool 44 | BUFFER_LIVE_P (struct buffer *b) 45 | { 46 | return !NILP (BVAR (b, name)); 47 | } 48 | 49 | enum 50 | { 51 | BUFFER_LISP_SIZE = PSEUDOVECSIZE (struct buffer, _last_obj), 52 | }; 53 | 54 | enum 55 | { 56 | BUFFER_REST_SIZE = VECSIZE (struct buffer) - BUFFER_LISP_SIZE 57 | }; 58 | 59 | INLINE void 60 | BUFFER_PVEC_INIT (struct buffer *b) 61 | { 62 | XSETPVECTYPESIZE (b, PVEC_BUFFER, BUFFER_LISP_SIZE, BUFFER_REST_SIZE); 63 | } 64 | 65 | extern EMACS_INT fix_position (Lisp_Object); 66 | #define CHECK_FIXNUM_COERCE_MARKER(x) ((x) = make_fixnum (fix_position (x))) 67 | 68 | INLINE void 69 | bset_local_var_alist (struct buffer *b, Lisp_Object val) 70 | { 71 | b->_local_var_alist = val; 72 | } 73 | 74 | INLINE void 75 | buffer_memcpy (unsigned char *dst, ptrdiff_t beg, ptrdiff_t size) 76 | { 77 | nvim_buf_memcpy (dst, beg, size); 78 | } 79 | 80 | INLINE int 81 | CHARACTER_WIDTH (int c) 82 | { 83 | return (0x20 <= c && c < 0x7f ? 1 84 | : 0x7f < c ? (TODO, 0) 85 | : c == '\t' ? (TODO, 0) 86 | : c == '\n' ? 0 87 | : !NILP ((TODO, Qnil)) ? 2 88 | : 4); 89 | } 90 | 91 | INLINE int 92 | downcase (int c) 93 | { 94 | Lisp_Object downcase_table = BVAR (current_buffer, downcase_table); 95 | Lisp_Object down = CHAR_TABLE_REF (downcase_table, c); 96 | return FIXNATP (down) ? XFIXNAT (down) : c; 97 | } 98 | 99 | INLINE int 100 | upcase (int c) 101 | { 102 | Lisp_Object upcase_table = BVAR (current_buffer, upcase_table); 103 | Lisp_Object up = CHAR_TABLE_REF (upcase_table, c); 104 | return FIXNATP (up) ? XFIXNAT (up) : c; 105 | } 106 | #endif 107 | -------------------------------------------------------------------------------- /src/callproc.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | 3 | void 4 | syms_of_callproc (void) 5 | { 6 | DEFVAR_LISP ("data-directory", Vdata_directory, 7 | doc: /* Directory of machine-independent files that come with GNU Emacs. 8 | These are files intended for Emacs to use while it runs. */); 9 | } 10 | -------------------------------------------------------------------------------- /src/casefiddle.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | #include "character.h" 3 | #include "syntax.h" 4 | 5 | enum case_action 6 | { 7 | CASE_UP, 8 | CASE_DOWN, 9 | CASE_CAPITALIZE, 10 | CASE_CAPITALIZE_UP 11 | }; 12 | 13 | struct casing_context 14 | { 15 | Lisp_Object titlecase_char_table; 16 | 17 | Lisp_Object specialcase_char_tables[3]; 18 | 19 | enum case_action flag; 20 | 21 | bool inbuffer; 22 | 23 | bool inword; 24 | 25 | bool downcase_last; 26 | }; 27 | 28 | static bool 29 | case_ch_is_word (enum syntaxcode syntax) 30 | { 31 | return syntax == Sword || (case_symbols_as_words && syntax == Ssymbol); 32 | } 33 | 34 | static void 35 | prepare_casing_context (struct casing_context *ctx, enum case_action flag, 36 | bool inbuffer) 37 | { 38 | ctx->flag = flag; 39 | ctx->inbuffer = inbuffer; 40 | ctx->inword = false; 41 | ctx->titlecase_char_table 42 | = (flag < CASE_CAPITALIZE ? Qnil : uniprop_table (Qtitlecase)); 43 | ctx->specialcase_char_tables[CASE_UP] 44 | = (flag == CASE_DOWN ? Qnil : uniprop_table (Qspecial_uppercase)); 45 | ctx->specialcase_char_tables[CASE_DOWN] 46 | = (flag == CASE_UP ? Qnil : uniprop_table (Qspecial_lowercase)); 47 | ctx->specialcase_char_tables[CASE_CAPITALIZE] 48 | = (flag < CASE_CAPITALIZE ? Qnil : uniprop_table (Qspecial_titlecase)); 49 | 50 | #if TODO_NELISP_LATER_AND 51 | if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1])) 52 | Fset_case_table (BVAR (current_buffer, downcase_table)); 53 | 54 | if (inbuffer && flag >= CASE_CAPITALIZE) 55 | SETUP_BUFFER_SYNTAX_TABLE (); 56 | #endif 57 | } 58 | 59 | struct casing_str_buf 60 | { 61 | unsigned char data[max (6, MAX_MULTIBYTE_LENGTH)]; 62 | unsigned char len_chars; 63 | unsigned char len_bytes; 64 | }; 65 | 66 | static int 67 | case_character_impl (struct casing_str_buf *buf, struct casing_context *ctx, 68 | int ch) 69 | { 70 | enum case_action flag; 71 | Lisp_Object prop; 72 | int cased; 73 | 74 | bool was_inword = ctx->inword; 75 | ctx->inword = case_ch_is_word (SYNTAX (ch)) 76 | && (!ctx->inbuffer || was_inword || !syntax_prefix_flag_p (ch)); 77 | 78 | if (ctx->flag == CASE_CAPITALIZE) 79 | flag = ctx->flag - was_inword; 80 | else if (ctx->flag != CASE_CAPITALIZE_UP) 81 | flag = ctx->flag; 82 | else if (!was_inword) 83 | flag = CASE_CAPITALIZE; 84 | else 85 | { 86 | cased = ch; 87 | goto done; 88 | } 89 | 90 | if (buf && !NILP (ctx->specialcase_char_tables[flag])) 91 | { 92 | prop = CHAR_TABLE_REF (ctx->specialcase_char_tables[flag], ch); 93 | if (STRINGP (prop)) 94 | { 95 | struct Lisp_String *str = XSTRING (prop); 96 | if (STRING_BYTES (str) <= (long) sizeof buf->data) 97 | { 98 | buf->len_chars = str->u.s.size; 99 | buf->len_bytes = STRING_BYTES (str); 100 | memcpy (buf->data, str->u.s.data, buf->len_bytes); 101 | return 1; 102 | } 103 | } 104 | } 105 | 106 | if (flag == CASE_DOWN) 107 | { 108 | cased = downcase (ch); 109 | ctx->downcase_last = true; 110 | } 111 | else 112 | { 113 | bool cased_is_set = false; 114 | ctx->downcase_last = false; 115 | if (!NILP (ctx->titlecase_char_table)) 116 | { 117 | prop = CHAR_TABLE_REF (ctx->titlecase_char_table, ch); 118 | if (CHARACTERP (prop)) 119 | { 120 | cased = XFIXNAT (prop); 121 | cased_is_set = true; 122 | } 123 | } 124 | if (!cased_is_set) 125 | cased = upcase (ch); 126 | } 127 | 128 | done: 129 | if (!buf) 130 | return cased; 131 | buf->len_chars = 1; 132 | buf->len_bytes = CHAR_STRING (cased, buf->data); 133 | return cased != ch; 134 | } 135 | 136 | enum 137 | { 138 | GREEK_CAPITAL_LETTER_SIGMA = 0x03A3 139 | }; 140 | enum 141 | { 142 | GREEK_SMALL_LETTER_FINAL_SIGMA = 0x03C2 143 | }; 144 | 145 | static inline int 146 | case_single_character (struct casing_context *ctx, int ch) 147 | { 148 | return case_character_impl (NULL, ctx, ch); 149 | } 150 | 151 | static bool 152 | case_character (struct casing_str_buf *buf, struct casing_context *ctx, int ch, 153 | const unsigned char *next) 154 | { 155 | bool was_inword = ctx->inword; 156 | bool changed = case_character_impl (buf, ctx, ch); 157 | 158 | if (was_inword && ch == GREEK_CAPITAL_LETTER_SIGMA && changed 159 | && (!next || !case_ch_is_word (SYNTAX (STRING_CHAR (next))))) 160 | { 161 | buf->len_bytes = CHAR_STRING (GREEK_SMALL_LETTER_FINAL_SIGMA, buf->data); 162 | buf->len_chars = 1; 163 | } 164 | 165 | return changed; 166 | } 167 | 168 | static inline int 169 | make_char_unibyte (int c) 170 | { 171 | return ASCII_CHAR_P (c) ? c : CHAR_TO_BYTE8 (c); 172 | } 173 | 174 | static Lisp_Object 175 | do_casify_natnum (struct casing_context *ctx, Lisp_Object obj) 176 | { 177 | int flagbits 178 | = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META); 179 | int ch = XFIXNAT (obj); 180 | 181 | if (!(0 <= ch && ch <= flagbits)) 182 | return obj; 183 | 184 | int flags = ch & flagbits; 185 | ch = ch & ~flagbits; 186 | 187 | #if TODO_NELISP_LATER_AND 188 | bool multibyte 189 | = (ch >= 256 || !NILP (BVAR (current_buffer, enable_multibyte_characters))); 190 | #else 191 | bool multibyte = false; 192 | #endif 193 | if (!multibyte) 194 | ch = make_char_multibyte (ch); 195 | int cased = case_single_character (ctx, ch); 196 | if (cased == ch) 197 | return obj; 198 | 199 | if (!multibyte) 200 | cased = make_char_unibyte (cased); 201 | return make_fixed_natnum (cased | flags); 202 | } 203 | 204 | static Lisp_Object 205 | do_casify_multibyte_string (struct casing_context *ctx, Lisp_Object obj) 206 | { 207 | verify (offsetof (struct casing_str_buf, data) == 0); 208 | 209 | ptrdiff_t size = SCHARS (obj), n; 210 | USE_SAFE_ALLOCA; 211 | if (ckd_mul (&n, size, MAX_MULTIBYTE_LENGTH) 212 | || ckd_add (&n, n, sizeof (struct casing_str_buf))) 213 | n = PTRDIFF_MAX; 214 | unsigned char *dst = SAFE_ALLOCA (n); 215 | unsigned char *dst_end = dst + n; 216 | unsigned char *o = dst; 217 | 218 | const unsigned char *src = SDATA (obj); 219 | 220 | for (n = 0; size; --size) 221 | { 222 | if ((unsigned long) (dst_end - o) < sizeof (struct casing_str_buf)) 223 | string_overflow (); 224 | int ch = string_char_advance (&src); 225 | case_character ((struct casing_str_buf *) o, ctx, ch, 226 | size > 1 ? src : NULL); 227 | n += ((struct casing_str_buf *) o)->len_chars; 228 | o += ((struct casing_str_buf *) o)->len_bytes; 229 | } 230 | eassert (o <= dst_end); 231 | obj = make_multibyte_string ((char *) dst, n, o - dst); 232 | SAFE_FREE (); 233 | return obj; 234 | } 235 | 236 | static int 237 | ascii_casify_character (bool downcase, int c) 238 | { 239 | Lisp_Object cased = CHAR_TABLE_REF (downcase ? uniprop_table (Qlowercase) 240 | : uniprop_table (Quppercase), 241 | c); 242 | return FIXNATP (cased) ? XFIXNAT (cased) : c; 243 | } 244 | 245 | static Lisp_Object 246 | do_casify_unibyte_string (struct casing_context *ctx, Lisp_Object obj) 247 | { 248 | ptrdiff_t i, size = SCHARS (obj); 249 | int ch, cased; 250 | 251 | obj = Fcopy_sequence (obj); 252 | for (i = 0; i < size; i++) 253 | { 254 | ch = make_char_multibyte (SREF (obj, i)); 255 | cased = case_single_character (ctx, ch); 256 | if (ch == cased) 257 | continue; 258 | if (ASCII_CHAR_P (ch) && !SINGLE_BYTE_CHAR_P (cased)) 259 | cased = ascii_casify_character (ctx->downcase_last, ch); 260 | SSET (obj, i, make_char_unibyte (cased)); 261 | } 262 | return obj; 263 | } 264 | 265 | static Lisp_Object 266 | casify_object (enum case_action flag, Lisp_Object obj) 267 | { 268 | struct casing_context ctx; 269 | prepare_casing_context (&ctx, flag, false); 270 | 271 | if (FIXNATP (obj)) 272 | return do_casify_natnum (&ctx, obj); 273 | else if (!STRINGP (obj)) 274 | wrong_type_argument (Qchar_or_string_p, obj); 275 | else if (!SCHARS (obj)) 276 | return obj; 277 | else if (STRING_MULTIBYTE (obj)) 278 | return do_casify_multibyte_string (&ctx, obj); 279 | else 280 | return do_casify_unibyte_string (&ctx, obj); 281 | } 282 | 283 | DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0, 284 | doc: /* Convert argument to capitalized form and return that. 285 | This means that each word's first character is converted to either 286 | title case or upper case, and the rest to lower case. 287 | 288 | The argument may be a character or string. The result has the same 289 | type. (See `downcase' for further details about the type.) 290 | 291 | The argument object is not altered--the value is a copy. If argument 292 | is a character, characters which map to multiple code points when 293 | cased, e.g. fi, are returned unchanged. */) 294 | (Lisp_Object obj) { return casify_object (CASE_CAPITALIZE, obj); } 295 | 296 | void 297 | syms_of_casefiddle (void) 298 | { 299 | DEFSYM (Qbounds, "bounds"); 300 | DEFSYM (Qidentity, "identity"); 301 | DEFSYM (Qtitlecase, "titlecase"); 302 | DEFSYM (Qlowercase, "lowercase"); 303 | DEFSYM (Quppercase, "uppercase"); 304 | DEFSYM (Qspecial_uppercase, "special-uppercase"); 305 | DEFSYM (Qspecial_lowercase, "special-lowercase"); 306 | DEFSYM (Qspecial_titlecase, "special-titlecase"); 307 | 308 | DEFVAR_BOOL ("case-symbols-as-words", case_symbols_as_words, 309 | doc: /* If non-nil, case functions treat symbol syntax as part of words. 310 | 311 | Functions such as `upcase-initials' and `replace-match' check or modify 312 | the case pattern of sequences of characters. Normally, these operate on 313 | sequences of characters whose syntax is word constituent. If this 314 | variable is non-nil, then they operate on sequences of characters whose 315 | syntax is either word constituent or symbol constituent. 316 | 317 | This is useful for programming languages and styles where only the first 318 | letter of a symbol's name is ever capitalized.*/); 319 | case_symbols_as_words = 0; 320 | DEFSYM (Qcase_symbols_as_words, "case-symbols-as-words"); 321 | Fmake_variable_buffer_local (Qcase_symbols_as_words); 322 | 323 | defsubr (&Scapitalize); 324 | } 325 | -------------------------------------------------------------------------------- /src/casetab.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | 3 | Lisp_Object Vascii_downcase_table; 4 | static Lisp_Object Vascii_upcase_table; 5 | Lisp_Object Vascii_canon_table; 6 | static Lisp_Object Vascii_eqv_table; 7 | 8 | DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0, 9 | doc: /* Return t if OBJECT is a case table. 10 | See `set-case-table' for more information on these data structures. */) 11 | (Lisp_Object object) 12 | { 13 | Lisp_Object up, canon, eqv; 14 | 15 | if (!CHAR_TABLE_P (object)) 16 | return Qnil; 17 | if (!EQ (XCHAR_TABLE (object)->purpose, Qcase_table)) 18 | return Qnil; 19 | 20 | up = XCHAR_TABLE (object)->extras[0]; 21 | canon = XCHAR_TABLE (object)->extras[1]; 22 | eqv = XCHAR_TABLE (object)->extras[2]; 23 | 24 | return ( 25 | (NILP (up) || CHAR_TABLE_P (up)) 26 | && ((NILP (canon) && NILP (eqv)) 27 | || (CHAR_TABLE_P (canon) && (NILP (eqv) || CHAR_TABLE_P (eqv)))) 28 | ? Qt 29 | : Qnil); 30 | } 31 | 32 | DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0, 33 | doc: /* Return the standard case table. 34 | This is the one used for new buffers. */) 35 | (void) { return Vascii_downcase_table; } 36 | 37 | static Lisp_Object 38 | check_case_table (Lisp_Object obj) 39 | { 40 | CHECK_TYPE (!NILP (Fcase_table_p (obj)), Qcase_table_p, obj); 41 | return (obj); 42 | } 43 | 44 | static void 45 | set_canon (Lisp_Object case_table, Lisp_Object range, Lisp_Object elt) 46 | { 47 | Lisp_Object up = XCHAR_TABLE (case_table)->extras[0]; 48 | Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1]; 49 | 50 | if (FIXNATP (elt)) 51 | Fset_char_table_range (canon, range, Faref (case_table, Faref (up, elt))); 52 | } 53 | 54 | static void 55 | set_identity (Lisp_Object table, Lisp_Object c, Lisp_Object elt) 56 | { 57 | if (FIXNATP (elt)) 58 | { 59 | int from, to; 60 | 61 | if (CONSP (c)) 62 | { 63 | from = XFIXNUM (XCAR (c)); 64 | to = XFIXNUM (XCDR (c)); 65 | } 66 | else 67 | from = to = XFIXNUM (c); 68 | 69 | to++; 70 | for (; from < to; from++) 71 | CHAR_TABLE_SET (table, from, make_fixnum (from)); 72 | } 73 | } 74 | 75 | static void 76 | shuffle (Lisp_Object table, Lisp_Object c, Lisp_Object elt) 77 | { 78 | if (FIXNATP (elt)) 79 | { 80 | int from, to; 81 | 82 | if (CONSP (c)) 83 | { 84 | from = XFIXNUM (XCAR (c)); 85 | to = XFIXNUM (XCDR (c)); 86 | } 87 | else 88 | from = to = XFIXNUM (c); 89 | 90 | to++; 91 | for (; from < to; from++) 92 | { 93 | Lisp_Object tem = Faref (table, elt); 94 | Faset (table, elt, make_fixnum (from)); 95 | Faset (table, make_fixnum (from), tem); 96 | } 97 | } 98 | } 99 | 100 | static Lisp_Object 101 | set_case_table (Lisp_Object table, bool standard) 102 | { 103 | Lisp_Object up, canon, eqv; 104 | 105 | check_case_table (table); 106 | 107 | up = XCHAR_TABLE (table)->extras[0]; 108 | canon = XCHAR_TABLE (table)->extras[1]; 109 | eqv = XCHAR_TABLE (table)->extras[2]; 110 | 111 | if (NILP (up)) 112 | { 113 | up = Fmake_char_table (Qcase_table, Qnil); 114 | map_char_table (set_identity, Qnil, table, up); 115 | map_char_table (shuffle, Qnil, table, up); 116 | set_char_table_extras (table, 0, up); 117 | } 118 | 119 | if (NILP (canon)) 120 | { 121 | canon = Fmake_char_table (Qcase_table, Qnil); 122 | set_char_table_extras (table, 1, canon); 123 | map_char_table (set_canon, Qnil, table, table); 124 | } 125 | 126 | if (NILP (eqv)) 127 | { 128 | eqv = Fmake_char_table (Qcase_table, Qnil); 129 | map_char_table (set_identity, Qnil, canon, eqv); 130 | map_char_table (shuffle, Qnil, canon, eqv); 131 | set_char_table_extras (table, 2, eqv); 132 | } 133 | 134 | set_char_table_extras (canon, 2, eqv); 135 | 136 | if (standard) 137 | { 138 | Vascii_downcase_table = table; 139 | Vascii_upcase_table = up; 140 | Vascii_canon_table = canon; 141 | Vascii_eqv_table = eqv; 142 | } 143 | else 144 | { 145 | TODO; 146 | } 147 | 148 | return table; 149 | } 150 | 151 | void 152 | init_casetab_once (void) 153 | { 154 | register int i; 155 | Lisp_Object down, up, eqv; 156 | 157 | DEFSYM (Qcase_table, "case-table"); 158 | Fput (Qcase_table, Qchar_table_extra_slots, make_fixnum (3)); 159 | 160 | down = Fmake_char_table (Qcase_table, Qnil); 161 | Vascii_downcase_table = down; 162 | set_char_table_purpose (down, Qcase_table); 163 | 164 | for (i = 0; i < 128; i++) 165 | { 166 | int c = (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i; 167 | CHAR_TABLE_SET (down, i, make_fixnum (c)); 168 | } 169 | 170 | set_char_table_extras (down, 1, Fcopy_sequence (down)); 171 | 172 | up = Fmake_char_table (Qcase_table, Qnil); 173 | set_char_table_extras (down, 0, up); 174 | 175 | for (i = 0; i < 128; i++) 176 | { 177 | int c = (i >= 'a' && i <= 'z') ? i + ('A' - 'a') : i; 178 | CHAR_TABLE_SET (up, i, make_fixnum (c)); 179 | } 180 | 181 | eqv = Fmake_char_table (Qcase_table, Qnil); 182 | 183 | for (i = 0; i < 128; i++) 184 | { 185 | int c = ((i >= 'A' && i <= 'Z') 186 | ? i + ('a' - 'A') 187 | : ((i >= 'a' && i <= 'z') ? i + ('A' - 'a') : i)); 188 | CHAR_TABLE_SET (eqv, i, make_fixnum (c)); 189 | } 190 | 191 | set_char_table_extras (down, 2, eqv); 192 | 193 | set_case_table (down, 1); 194 | } 195 | 196 | void 197 | syms_of_casetab (void) 198 | { 199 | DEFSYM (Qcase_table_p, "case-table-p"); 200 | 201 | staticpro (&Vascii_canon_table); 202 | staticpro (&Vascii_downcase_table); 203 | staticpro (&Vascii_eqv_table); 204 | staticpro (&Vascii_upcase_table); 205 | 206 | defsubr (&Scase_table_p); 207 | defsubr (&Sstandard_case_table); 208 | } 209 | -------------------------------------------------------------------------------- /src/ccl.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | 3 | void 4 | syms_of_ccl (void) 5 | { 6 | DEFSYM (Qccl, "ccl"); 7 | } 8 | -------------------------------------------------------------------------------- /src/character.c: -------------------------------------------------------------------------------- 1 | #include "character.h" 2 | #include "buffer.h" 3 | 4 | Lisp_Object Vchar_unify_table; 5 | 6 | EMACS_INT 7 | char_resolve_modifier_mask (EMACS_INT c) 8 | { 9 | if (!ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) 10 | return c; 11 | 12 | if (c & CHAR_SHIFT) 13 | { 14 | if ((c & 0377) >= 'A' && (c & 0377) <= 'Z') 15 | c &= ~CHAR_SHIFT; 16 | else if ((c & 0377) >= 'a' && (c & 0377) <= 'z') 17 | c = (c & ~CHAR_SHIFT) - ('a' - 'A'); 18 | else if ((c & ~CHAR_MODIFIER_MASK) <= 0x20) 19 | c &= ~CHAR_SHIFT; 20 | } 21 | if (c & CHAR_CTL) 22 | { 23 | if ((c & 0377) == ' ') 24 | c &= ~0177 & ~CHAR_CTL; 25 | else if ((c & 0377) == '?') 26 | c = 0177 | (c & ~0177 & ~CHAR_CTL); 27 | else if ((c & 0137) >= 0101 && (c & 0137) <= 0132) 28 | c &= (037 | (~0177 & ~CHAR_CTL)); 29 | else if ((c & 0177) >= 0100 && (c & 0177) <= 0137) 30 | c &= (037 | (~0177 & ~CHAR_CTL)); 31 | } 32 | 33 | return c; 34 | } 35 | int 36 | char_string (unsigned int c, unsigned char *p) 37 | { 38 | int bytes; 39 | 40 | if (c & CHAR_MODIFIER_MASK) 41 | { 42 | c = char_resolve_modifier_mask (c); 43 | /* If C still has any modifier bits, just ignore it. */ 44 | c &= ~CHAR_MODIFIER_MASK; 45 | } 46 | 47 | if (c <= MAX_3_BYTE_CHAR) 48 | { 49 | bytes = CHAR_STRING (c, p); 50 | } 51 | else if (c <= MAX_4_BYTE_CHAR) 52 | { 53 | p[0] = (0xF0 | (c >> 18)); 54 | p[1] = (0x80 | ((c >> 12) & 0x3F)); 55 | p[2] = (0x80 | ((c >> 6) & 0x3F)); 56 | p[3] = (0x80 | (c & 0x3F)); 57 | bytes = 4; 58 | } 59 | else if (c <= MAX_5_BYTE_CHAR) 60 | { 61 | p[0] = 0xF8; 62 | p[1] = (0x80 | ((c >> 18) & 0x0F)); 63 | p[2] = (0x80 | ((c >> 12) & 0x3F)); 64 | p[3] = (0x80 | ((c >> 6) & 0x3F)); 65 | p[4] = (0x80 | (c & 0x3F)); 66 | bytes = 5; 67 | } 68 | else if (c <= MAX_CHAR) 69 | { 70 | c = CHAR_TO_BYTE8 (c); 71 | bytes = BYTE8_STRING (c, p); 72 | } 73 | else 74 | error ("Invalid character: %x", c); 75 | 76 | return bytes; 77 | } 78 | 79 | ptrdiff_t 80 | str_as_unibyte (unsigned char *str, ptrdiff_t bytes) 81 | { 82 | const unsigned char *p = str, *endp = str + bytes; 83 | unsigned char *to; 84 | int c, len; 85 | 86 | while (p < endp) 87 | { 88 | c = *p; 89 | len = BYTES_BY_CHAR_HEAD (c); 90 | if (CHAR_BYTE8_HEAD_P (c)) 91 | break; 92 | p += len; 93 | } 94 | to = str + (p - str); 95 | while (p < endp) 96 | { 97 | c = *p; 98 | len = BYTES_BY_CHAR_HEAD (c); 99 | if (CHAR_BYTE8_HEAD_P (c)) 100 | { 101 | c = string_char_advance (&p); 102 | *to++ = CHAR_TO_BYTE8 (c); 103 | } 104 | else 105 | { 106 | while (len--) 107 | *to++ = *p++; 108 | } 109 | } 110 | return (to - str); 111 | } 112 | INLINE int 113 | multibyte_length (unsigned char const *p, unsigned char const *pend, bool check, 114 | bool allow_8bit) 115 | { 116 | if (!check || p < pend) 117 | { 118 | unsigned char c = p[0]; 119 | if (c < 0x80) 120 | return 1; 121 | if (!check || p + 1 < pend) 122 | { 123 | unsigned char d = p[1]; 124 | int w = ((d & 0xC0) << 2) + c; 125 | if ((allow_8bit ? 0x2C0 : 0x2C2) <= w && w <= 0x2DF) 126 | return 2; 127 | if (!check || p + 2 < pend) 128 | { 129 | unsigned char e = p[2]; 130 | w += (e & 0xC0) << 4; 131 | int w1 = w | ((d & 0x20) >> 2); 132 | if (0xAE1 <= w1 && w1 <= 0xAEF) 133 | return 3; 134 | if (!check || p + 3 < pend) 135 | { 136 | unsigned char f = p[3]; 137 | w += (f & 0xC0) << 6; 138 | int w2 = w | ((d & 0x30) >> 3); 139 | if (0x2AF1 <= w2 && w2 <= 0x2AF7) 140 | return 4; 141 | if (!check || p + 4 < pend) 142 | { 143 | int_fast64_t lw = w + ((p[4] & 0xC0) << 8), 144 | w3 = (lw << 24) + (d << 16) + (e << 8) + f; 145 | if (0xAAF8888080 <= w3 && w3 <= 0xAAF88FBFBD) 146 | return 5; 147 | } 148 | } 149 | } 150 | } 151 | } 152 | 153 | return 0; 154 | } 155 | void 156 | parse_str_as_multibyte (const unsigned char *str, ptrdiff_t len, 157 | ptrdiff_t *nchars, ptrdiff_t *nbytes) 158 | { 159 | const unsigned char *endp = str + len; 160 | ptrdiff_t chars = 0, bytes = 0; 161 | 162 | if (len >= MAX_MULTIBYTE_LENGTH) 163 | { 164 | const unsigned char *adjusted_endp = endp - (MAX_MULTIBYTE_LENGTH - 1); 165 | while (str < adjusted_endp) 166 | { 167 | int n = multibyte_length (str, NULL, false, false); 168 | if (0 < n) 169 | str += n, bytes += n; 170 | else 171 | str++, bytes += 2; 172 | chars++; 173 | } 174 | } 175 | while (str < endp) 176 | { 177 | int n = multibyte_length (str, endp, true, false); 178 | if (0 < n) 179 | str += n, bytes += n; 180 | else 181 | str++, bytes += 2; 182 | chars++; 183 | } 184 | 185 | *nchars = chars; 186 | *nbytes = bytes; 187 | return; 188 | } 189 | ptrdiff_t 190 | str_to_multibyte (unsigned char *dst, const unsigned char *src, 191 | ptrdiff_t nchars) 192 | { 193 | unsigned char *d = dst; 194 | for (ptrdiff_t i = 0; i < nchars; i++) 195 | { 196 | unsigned char c = src[i]; 197 | if (c <= 0x7f) 198 | *d++ = c; 199 | else 200 | { 201 | *d++ = 0xc0 + ((c >> 6) & 1); 202 | *d++ = 0x80 + (c & 0x3f); 203 | } 204 | } 205 | return d - dst; 206 | } 207 | ptrdiff_t 208 | count_size_as_multibyte (const unsigned char *str, ptrdiff_t len) 209 | { 210 | ptrdiff_t nonascii = 0; 211 | for (ptrdiff_t i = 0; i < len; i++) 212 | nonascii += str[i] >> 7; 213 | ptrdiff_t bytes; 214 | if (ckd_add (&bytes, len, nonascii)) 215 | TODO; // string_overflow (); 216 | return bytes; 217 | } 218 | 219 | static ptrdiff_t 220 | string_count_byte8 (Lisp_Object string) 221 | { 222 | bool multibyte = STRING_MULTIBYTE (string); 223 | ptrdiff_t nbytes = SBYTES (string); 224 | unsigned char *p = SDATA (string); 225 | unsigned char *pend = p + nbytes; 226 | ptrdiff_t count = 0; 227 | int c, len; 228 | 229 | if (multibyte) 230 | while (p < pend) 231 | { 232 | c = *p; 233 | len = BYTES_BY_CHAR_HEAD (c); 234 | 235 | if (CHAR_BYTE8_HEAD_P (c)) 236 | count++; 237 | p += len; 238 | } 239 | else 240 | while (p < pend) 241 | { 242 | if (*p++ >= 0x80) 243 | count++; 244 | } 245 | return count; 246 | } 247 | 248 | Lisp_Object 249 | string_escape_byte8 (Lisp_Object string) 250 | { 251 | ptrdiff_t nchars = SCHARS (string); 252 | ptrdiff_t nbytes = SBYTES (string); 253 | bool multibyte = STRING_MULTIBYTE (string); 254 | ptrdiff_t byte8_count; 255 | ptrdiff_t uninit_nchars = 0; 256 | ptrdiff_t uninit_nbytes = 0; 257 | ptrdiff_t thrice_byte8_count; 258 | const unsigned char *src, *src_end; 259 | unsigned char *dst; 260 | Lisp_Object val; 261 | int c, len; 262 | 263 | if (multibyte && nchars == nbytes) 264 | return string; 265 | 266 | byte8_count = string_count_byte8 (string); 267 | 268 | if (byte8_count == 0) 269 | return string; 270 | 271 | if (ckd_mul (&thrice_byte8_count, byte8_count, 3)) 272 | string_overflow (); 273 | 274 | if (multibyte) 275 | { 276 | if (ckd_add (&uninit_nchars, nchars, thrice_byte8_count) 277 | || ckd_add (&uninit_nbytes, nbytes, 2 * byte8_count)) 278 | string_overflow (); 279 | val = make_uninit_multibyte_string (uninit_nchars, uninit_nbytes); 280 | } 281 | else 282 | { 283 | if (ckd_add (&uninit_nbytes, thrice_byte8_count, nbytes)) 284 | string_overflow (); 285 | val = make_uninit_string (uninit_nbytes); 286 | } 287 | 288 | src = SDATA (string); 289 | src_end = src + nbytes; 290 | dst = SDATA (val); 291 | if (multibyte) 292 | while (src < src_end) 293 | { 294 | c = *src; 295 | len = BYTES_BY_CHAR_HEAD (c); 296 | 297 | if (CHAR_BYTE8_HEAD_P (c)) 298 | { 299 | c = string_char_advance (&src); 300 | c = CHAR_TO_BYTE8 (c); 301 | dst += sprintf ((char *) dst, "\\%03o", c + 0u); 302 | } 303 | else 304 | while (len--) 305 | *dst++ = *src++; 306 | } 307 | else 308 | while (src < src_end) 309 | { 310 | c = *src++; 311 | if (c >= 0x80) 312 | dst += sprintf ((char *) dst, "\\%03o", c + 0u); 313 | else 314 | *dst++ = c; 315 | } 316 | return val; 317 | } 318 | 319 | static ptrdiff_t 320 | char_width (int c, struct Lisp_Char_Table *dp) 321 | { 322 | ptrdiff_t width = CHARACTER_WIDTH (c); 323 | 324 | if (dp) 325 | TODO; 326 | return width; 327 | } 328 | 329 | ptrdiff_t 330 | lisp_string_width (Lisp_Object string, ptrdiff_t from, ptrdiff_t to, 331 | ptrdiff_t precision, ptrdiff_t *nchars, ptrdiff_t *nbytes, 332 | bool auto_comp) 333 | { 334 | UNUSED (auto_comp); 335 | bool multibyte = SCHARS (string) < SBYTES (string); 336 | ptrdiff_t i = from, i_byte = from ? string_char_to_byte (string, from) : 0; 337 | ptrdiff_t from_byte = i_byte; 338 | ptrdiff_t width = 0; 339 | #if TODO_NELISP_LATER_AND 340 | struct Lisp_Char_Table *dp = buffer_display_table (); 341 | #else 342 | struct Lisp_Char_Table *dp = NULL; 343 | #endif 344 | 345 | eassert (precision <= 0 || (nchars && nbytes)); 346 | 347 | while (i < to) 348 | { 349 | ptrdiff_t chars, bytes, thiswidth; 350 | #if TODO_NELISP_LATER_AND 351 | Lisp_Object val; 352 | ptrdiff_t cmp_id; 353 | ptrdiff_t ignore, end; 354 | 355 | if (find_composition (i, -1, &ignore, &end, &val, string) 356 | && ((cmp_id = get_composition_id (i, i_byte, end - i, val, string)) 357 | >= 0)) 358 | { 359 | thiswidth = composition_table[cmp_id]->width; 360 | chars = end - i; 361 | bytes = string_char_to_byte (string, end) - i_byte; 362 | } 363 | else 364 | #endif 365 | { 366 | int c; 367 | unsigned char *str = SDATA (string); 368 | 369 | if (multibyte) 370 | { 371 | int cbytes; 372 | c = string_char_and_length (str + i_byte, &cbytes); 373 | bytes = cbytes; 374 | } 375 | else 376 | c = str[i_byte], bytes = 1; 377 | chars = 1; 378 | thiswidth = char_width (c, dp); 379 | } 380 | 381 | if (0 < precision && precision - width < thiswidth) 382 | { 383 | *nchars = i - from; 384 | *nbytes = i_byte - from_byte; 385 | return width; 386 | } 387 | if (ckd_add (&width, width, thiswidth)) 388 | string_overflow (); 389 | i += chars; 390 | i_byte += bytes; 391 | } 392 | 393 | if (precision > 0) 394 | { 395 | *nchars = i - from; 396 | *nbytes = i_byte - from_byte; 397 | } 398 | 399 | return width; 400 | } 401 | 402 | signed char const hexdigit[UCHAR_MAX + 1] 403 | = { ['0'] = 1 + 0, ['1'] = 1 + 1, ['2'] = 1 + 2, ['3'] = 1 + 3, 404 | ['4'] = 1 + 4, ['5'] = 1 + 5, ['6'] = 1 + 6, ['7'] = 1 + 7, 405 | ['8'] = 1 + 8, ['9'] = 1 + 9, ['A'] = 1 + 10, ['B'] = 1 + 11, 406 | ['C'] = 1 + 12, ['D'] = 1 + 13, ['E'] = 1 + 14, ['F'] = 1 + 15, 407 | ['a'] = 1 + 10, ['b'] = 1 + 11, ['c'] = 1 + 12, ['d'] = 1 + 13, 408 | ['e'] = 1 + 14, ['f'] = 1 + 15 }; 409 | void 410 | syms_of_character (void) 411 | { 412 | DEFSYM (Qcharacterp, "characterp"); 413 | 414 | staticpro (&Vchar_unify_table); 415 | Vchar_unify_table = Qnil; 416 | } 417 | -------------------------------------------------------------------------------- /src/character.h: -------------------------------------------------------------------------------- 1 | #ifndef EMACS_CHARACTER_H 2 | #define EMACS_CHARACTER_H 3 | 4 | #include "lisp.h" 5 | 6 | enum 7 | { 8 | MAX_CHAR = 0x3FFFFF 9 | }; 10 | enum 11 | { 12 | MAX_UNICODE_CHAR = 0x10FFFF 13 | }; 14 | enum 15 | { 16 | NO_BREAK_SPACE = 0x00A0, 17 | SOFT_HYPHEN = 0x00AD, 18 | ZERO_WIDTH_NON_JOINER = 0x200C, 19 | ZERO_WIDTH_JOINER = 0x200D, 20 | HYPHEN = 0x2010, 21 | NON_BREAKING_HYPHEN = 0x2011, 22 | LEFT_SINGLE_QUOTATION_MARK = 0x2018, 23 | RIGHT_SINGLE_QUOTATION_MARK = 0x2019, 24 | PARAGRAPH_SEPARATOR = 0x2029, 25 | LEFT_POINTING_ANGLE_BRACKET = 0x2329, 26 | RIGHT_POINTING_ANGLE_BRACKET = 0x232A, 27 | LEFT_ANGLE_BRACKET = 0x3008, 28 | RIGHT_ANGLE_BRACKET = 0x3009, 29 | OBJECT_REPLACEMENT_CHARACTER = 0xFFFC, 30 | TAG_SPACE = 0xE0020, 31 | CANCEL_TAG = 0xE007F, 32 | }; 33 | enum 34 | { 35 | MAX_MULTIBYTE_LENGTH = 5 36 | }; 37 | enum 38 | { 39 | MAX_1_BYTE_CHAR = 0x7F 40 | }; 41 | enum 42 | { 43 | MAX_2_BYTE_CHAR = 0x7FF 44 | }; 45 | enum 46 | { 47 | MAX_3_BYTE_CHAR = 0xFFFF 48 | }; 49 | enum 50 | { 51 | MAX_4_BYTE_CHAR = 0x1FFFFF 52 | }; 53 | enum 54 | { 55 | MAX_5_BYTE_CHAR = 0x3FFF7F 56 | }; 57 | 58 | enum 59 | { 60 | MIN_MULTIBYTE_LEADING_CODE = 0xC0 61 | }; 62 | enum 63 | { 64 | MAX_MULTIBYTE_LEADING_CODE = 0xF8 65 | }; 66 | 67 | extern int char_string (unsigned, unsigned char *); 68 | 69 | INLINE bool 70 | SINGLE_BYTE_CHAR_P (intmax_t c) 71 | { 72 | return 0 <= c && c < 0x100; 73 | } 74 | INLINE bool 75 | CHAR_BYTE8_P (int c) 76 | { 77 | return MAX_5_BYTE_CHAR < c; 78 | } 79 | INLINE int 80 | BYTE8_TO_CHAR (int byte) 81 | { 82 | return byte + 0x3FFF00; 83 | } 84 | INLINE int 85 | UNIBYTE_TO_CHAR (int byte) 86 | { 87 | return ASCII_CHAR_P (byte) ? byte : BYTE8_TO_CHAR (byte); 88 | } 89 | INLINE bool 90 | CHAR_VALID_P (intmax_t c) 91 | { 92 | return 0 <= c && c <= MAX_CHAR; 93 | } 94 | INLINE bool 95 | CHARACTERP (Lisp_Object x) 96 | { 97 | return FIXNUMP (x) && CHAR_VALID_P (XFIXNUM (x)); 98 | } 99 | INLINE void 100 | CHECK_CHARACTER (Lisp_Object x) 101 | { 102 | CHECK_TYPE (CHARACTERP (x), Qcharacterp, x); 103 | } 104 | INLINE void 105 | CHECK_CHARACTER_CAR (Lisp_Object x) 106 | { 107 | CHECK_CHARACTER (XCAR (x)); 108 | } 109 | INLINE void 110 | CHECK_CHARACTER_CDR (Lisp_Object x) 111 | { 112 | CHECK_CHARACTER (XCDR (x)); 113 | } 114 | 115 | INLINE int 116 | CHAR_LEADING_CODE (int c) 117 | { 118 | return (c <= MAX_1_BYTE_CHAR ? c 119 | : c <= MAX_2_BYTE_CHAR ? 0xC0 | (c >> 6) 120 | : c <= MAX_3_BYTE_CHAR ? 0xE0 | (c >> 12) 121 | : c <= MAX_4_BYTE_CHAR ? 0xF0 | (c >> 18) 122 | : c <= MAX_5_BYTE_CHAR ? 0xF8 123 | : 0xC0 | ((c >> 6) & 0x01)); 124 | } 125 | 126 | INLINE int 127 | CHAR_STRING (int c, unsigned char *p) 128 | { 129 | eassume (0 <= c); 130 | if (c <= MAX_1_BYTE_CHAR) 131 | { 132 | p[0] = c; 133 | return 1; 134 | } 135 | if (c <= MAX_2_BYTE_CHAR) 136 | { 137 | p[0] = 0xC0 | (c >> 6); 138 | p[1] = 0x80 | (c & 0x3F); 139 | return 2; 140 | } 141 | if (c <= MAX_3_BYTE_CHAR) 142 | { 143 | p[0] = 0xE0 | (c >> 12); 144 | p[1] = 0x80 | ((c >> 6) & 0x3F); 145 | p[2] = 0x80 | (c & 0x3F); 146 | return 3; 147 | } 148 | int len = char_string (c, p); 149 | eassume (0 < len && len <= MAX_MULTIBYTE_LENGTH); 150 | return len; 151 | } 152 | INLINE int 153 | BYTE8_STRING (int b, unsigned char *p) 154 | { 155 | p[0] = 0xC0 | ((b >> 6) & 0x01); 156 | p[1] = 0x80 | (b & 0x3F); 157 | return 2; 158 | } 159 | INLINE bool 160 | CHAR_HEAD_P (int byte) 161 | { 162 | return (byte & 0xC0) != 0x80; 163 | } 164 | INLINE int 165 | BYTES_BY_CHAR_HEAD (int byte) 166 | { 167 | return (!(byte & 0x80) ? 1 168 | : !(byte & 0x20) ? 2 169 | : !(byte & 0x10) ? 3 170 | : !(byte & 0x08) ? 4 171 | : 5); 172 | } 173 | INLINE bool 174 | CHAR_BYTE8_HEAD_P (int byte) 175 | { 176 | return byte == 0xC0 || byte == 0xC1; 177 | } 178 | INLINE int 179 | make_char_multibyte (int c) 180 | { 181 | eassert (SINGLE_BYTE_CHAR_P (c)); 182 | return UNIBYTE_TO_CHAR (c); 183 | } 184 | INLINE int 185 | CHAR_TO_BYTE8 (int c) 186 | { 187 | return CHAR_BYTE8_P (c) ? c - 0x3FFF00 : c & 0xFF; 188 | } 189 | INLINE int 190 | CHAR_TO_BYTE_SAFE (int c) 191 | { 192 | return ASCII_CHAR_P (c) ? c : CHAR_BYTE8_P (c) ? c - 0x3FFF00 : -1; 193 | } 194 | INLINE bool 195 | TRAILING_CODE_P (int byte) 196 | { 197 | return (byte & 0xC0) == 0x80; 198 | } 199 | INLINE int 200 | string_char_and_length (unsigned char const *p, int *length) 201 | { 202 | int c = p[0]; 203 | if (!(c & 0x80)) 204 | { 205 | *length = 1; 206 | return c; 207 | } 208 | eassume (0xC0 <= c); 209 | 210 | int d = (c << 6) + p[1] - ((0xC0 << 6) + 0x80); 211 | if (!(c & 0x20)) 212 | { 213 | *length = 2; 214 | return d + (c < 0xC2 ? 0x3FFF80 : 0); 215 | } 216 | 217 | d = (d << 6) + p[2] - ((0x20 << 12) + 0x80); 218 | if (!(c & 0x10)) 219 | { 220 | *length = 3; 221 | eassume (MAX_2_BYTE_CHAR < d && d <= MAX_3_BYTE_CHAR); 222 | return d; 223 | } 224 | 225 | d = (d << 6) + p[3] - ((0x10 << 18) + 0x80); 226 | if (!(c & 0x08)) 227 | { 228 | *length = 4; 229 | eassume (MAX_3_BYTE_CHAR < d && d <= MAX_4_BYTE_CHAR); 230 | return d; 231 | } 232 | 233 | d = (d << 6) + p[4] - ((0x08 << 24) + 0x80); 234 | *length = 5; 235 | eassume (MAX_4_BYTE_CHAR < d && d <= MAX_5_BYTE_CHAR); 236 | return d; 237 | } 238 | 239 | INLINE int 240 | raw_prev_char_len (unsigned char const *p) 241 | { 242 | for (int len = 1;; len++) 243 | if (CHAR_HEAD_P (p[-len])) 244 | return len; 245 | } 246 | 247 | INLINE int 248 | string_char_advance (unsigned char const **pp) 249 | { 250 | unsigned char const *p = *pp; 251 | int len, c = string_char_and_length (p, &len); 252 | *pp = p + len; 253 | return c; 254 | } 255 | INLINE int 256 | fetch_string_char_advance (Lisp_Object string, ptrdiff_t *charidx, 257 | ptrdiff_t *byteidx) 258 | { 259 | int output; 260 | ptrdiff_t b = *byteidx; 261 | unsigned char *chp = SDATA (string) + b; 262 | if (STRING_MULTIBYTE (string)) 263 | { 264 | int chlen; 265 | output = string_char_and_length (chp, &chlen); 266 | b += chlen; 267 | } 268 | else 269 | { 270 | output = *chp; 271 | b++; 272 | } 273 | (*charidx)++; 274 | *byteidx = b; 275 | return output; 276 | } 277 | 278 | INLINE int 279 | fetch_string_char_advance_no_check (Lisp_Object string, ptrdiff_t *charidx, 280 | ptrdiff_t *byteidx) 281 | { 282 | ptrdiff_t b = *byteidx; 283 | unsigned char *chp = SDATA (string) + b; 284 | int chlen, output = string_char_and_length (chp, &chlen); 285 | (*charidx)++; 286 | *byteidx = b + chlen; 287 | return output; 288 | } 289 | 290 | INLINE int 291 | STRING_CHAR (unsigned char const *p) 292 | { 293 | int len; 294 | return string_char_and_length (p, &len); 295 | } 296 | 297 | ptrdiff_t str_as_unibyte (unsigned char *str, ptrdiff_t bytes); 298 | void parse_str_as_multibyte (const unsigned char *str, ptrdiff_t len, 299 | ptrdiff_t *nchars, ptrdiff_t *nbytes); 300 | ptrdiff_t count_size_as_multibyte (const unsigned char *str, ptrdiff_t len); 301 | ptrdiff_t str_to_multibyte (unsigned char *dst, const unsigned char *src, 302 | ptrdiff_t nchars); 303 | 304 | extern Lisp_Object Vchar_unify_table; 305 | 306 | INLINE int 307 | char_table_translate (Lisp_Object obj, int ch) 308 | { 309 | eassert (CHAR_VALID_P (ch)); 310 | eassert (CHAR_TABLE_P (obj)); 311 | obj = CHAR_TABLE_REF (obj, ch); 312 | return CHARACTERP (obj) ? XFIXNUM (obj) : ch; 313 | } 314 | 315 | extern ptrdiff_t lisp_string_width (Lisp_Object string, ptrdiff_t from, 316 | ptrdiff_t to, ptrdiff_t precision, 317 | ptrdiff_t *nchars, ptrdiff_t *nbytes, 318 | bool auto_comp); 319 | extern Lisp_Object string_escape_byte8 (Lisp_Object); 320 | 321 | extern signed char const hexdigit[]; 322 | 323 | INLINE int 324 | char_hexdigit (int c) 325 | { 326 | return 0 <= c && c <= UCHAR_MAX ? hexdigit[c] - 1 : -1; 327 | } 328 | 329 | #endif 330 | -------------------------------------------------------------------------------- /src/charset.h: -------------------------------------------------------------------------------- 1 | #ifndef EMACS_CHARSET_H 2 | #define EMACS_CHARSET_H 3 | 4 | #include "lisp.h" 5 | 6 | extern Lisp_Object Vcharset_hash_table; 7 | extern Lisp_Object Viso_2022_charset_list; 8 | extern Lisp_Object Vemacs_mule_charset_list; 9 | extern struct charset *charset_table; 10 | 11 | enum define_charset_arg_index 12 | { 13 | charset_arg_name, 14 | charset_arg_dimension, 15 | charset_arg_code_space, 16 | charset_arg_min_code, 17 | charset_arg_max_code, 18 | charset_arg_iso_final, 19 | charset_arg_iso_revision, 20 | charset_arg_emacs_mule_id, 21 | charset_arg_ascii_compatible_p, 22 | charset_arg_supplementary_p, 23 | charset_arg_invalid_code, 24 | charset_arg_code_offset, 25 | charset_arg_map, 26 | charset_arg_subset, 27 | charset_arg_superset, 28 | charset_arg_unify_map, 29 | charset_arg_plist, 30 | charset_arg_max 31 | }; 32 | 33 | enum charset_attr_index 34 | { 35 | charset_id, 36 | 37 | charset_name, 38 | 39 | charset_plist, 40 | 41 | charset_map, 42 | 43 | charset_decoder, 44 | 45 | charset_encoder, 46 | 47 | charset_subset, 48 | 49 | charset_superset, 50 | 51 | charset_unify_map, 52 | 53 | charset_deunifier, 54 | 55 | charset_attr_max 56 | }; 57 | 58 | enum charset_method 59 | { 60 | CHARSET_METHOD_OFFSET, 61 | 62 | CHARSET_METHOD_MAP, 63 | 64 | CHARSET_METHOD_SUBSET, 65 | 66 | CHARSET_METHOD_SUPERSET 67 | }; 68 | 69 | struct charset 70 | { 71 | int id; 72 | 73 | Lisp_Object attributes; 74 | 75 | int dimension; 76 | 77 | int code_space[15]; 78 | 79 | unsigned char *code_space_mask; 80 | 81 | bool_bf code_linear_p : 1; 82 | 83 | bool_bf iso_chars_96 : 1; 84 | 85 | bool_bf ascii_compatible_p : 1; 86 | 87 | bool_bf supplementary_p : 1; 88 | 89 | bool_bf compact_codes_p : 1; 90 | 91 | bool_bf unified_p : 1; 92 | 93 | int iso_final; 94 | 95 | int iso_revision; 96 | 97 | int emacs_mule_id; 98 | 99 | enum charset_method method; 100 | 101 | unsigned min_code, max_code; 102 | 103 | unsigned char_index_offset; 104 | 105 | int min_char, max_char; 106 | 107 | unsigned invalid_code; 108 | 109 | unsigned char fast_map[190]; 110 | 111 | int code_offset; 112 | }; 113 | 114 | #define CHARSET_FROM_ID(id) (charset_table + (id)) 115 | 116 | #define CHARSET_SYMBOL_ATTRIBUTES(symbol) \ 117 | Fgethash (symbol, Vcharset_hash_table, Qnil) 118 | 119 | #define CHARSET_ATTRIBUTES(charset) (charset)->attributes 120 | 121 | #define CHARSET_ATTR_ID(attrs) AREF (attrs, charset_id) 122 | #define CHARSET_ATTR_NAME(attrs) AREF (attrs, charset_name) 123 | #define CHARSET_ATTR_PLIST(attrs) AREF (attrs, charset_plist) 124 | #define CHARSET_ATTR_MAP(attrs) AREF (attrs, charset_map) 125 | #define CHARSET_ATTR_DECODER(attrs) AREF (attrs, charset_decoder) 126 | #define CHARSET_ATTR_ENCODER(attrs) AREF (attrs, charset_encoder) 127 | #define CHARSET_ATTR_SUBSET(attrs) AREF (attrs, charset_subset) 128 | #define CHARSET_ATTR_SUPERSET(attrs) AREF (attrs, charset_superset) 129 | #define CHARSET_ATTR_UNIFY_MAP(attrs) AREF (attrs, charset_unify_map) 130 | #define CHARSET_ATTR_DEUNIFIER(attrs) AREF (attrs, charset_deunifier) 131 | 132 | #define CHARSET_SYMBOL_HASH_INDEX(symbol) \ 133 | hash_lookup (XHASH_TABLE (Vcharset_hash_table), symbol) 134 | 135 | #define CHARSET_ID(charset) ((charset)->id) 136 | #define CHARSET_DIMENSION(charset) ((charset)->dimension) 137 | #define CHARSET_CODE_SPACE(charset) ((charset)->code_space) 138 | #define CHARSET_CODE_LINEAR_P(charset) ((charset)->code_linear_p) 139 | #define CHARSET_ISO_CHARS_96(charset) ((charset)->iso_chars_96) 140 | #define CHARSET_ISO_FINAL(charset) ((charset)->iso_final) 141 | #define CHARSET_ISO_PLANE(charset) ((charset)->iso_plane) 142 | #define CHARSET_ISO_REVISION(charset) ((charset)->iso_revision) 143 | #define CHARSET_EMACS_MULE_ID(charset) ((charset)->emacs_mule_id) 144 | #define CHARSET_ASCII_COMPATIBLE_P(charset) ((charset)->ascii_compatible_p) 145 | #define CHARSET_COMPACT_CODES_P(charset) ((charset)->compact_codes_p) 146 | #define CHARSET_METHOD(charset) ((charset)->method) 147 | #define CHARSET_MIN_CODE(charset) ((charset)->min_code) 148 | #define CHARSET_MAX_CODE(charset) ((charset)->max_code) 149 | #define CHARSET_INVALID_CODE(charset) ((charset)->invalid_code) 150 | #define CHARSET_MIN_CHAR(charset) ((charset)->min_char) 151 | #define CHARSET_MAX_CHAR(charset) ((charset)->max_char) 152 | #define CHARSET_CODE_OFFSET(charset) ((charset)->code_offset) 153 | #define CHARSET_UNIFIED_P(charset) ((charset)->unified_p) 154 | 155 | #define CHARSET_NAME(charset) CHARSET_ATTR_NAME (CHARSET_ATTRIBUTES (charset)) 156 | #define CHARSET_MAP(charset) CHARSET_ATTR_MAP (CHARSET_ATTRIBUTES (charset)) 157 | #define CHARSET_DECODER(charset) \ 158 | CHARSET_ATTR_DECODER (CHARSET_ATTRIBUTES (charset)) 159 | #define CHARSET_ENCODER(charset) \ 160 | CHARSET_ATTR_ENCODER (CHARSET_ATTRIBUTES (charset)) 161 | #define CHARSET_SUBSET(charset) \ 162 | CHARSET_ATTR_SUBSET (CHARSET_ATTRIBUTES (charset)) 163 | #define CHARSET_SUPERSET(charset) \ 164 | CHARSET_ATTR_SUPERSET (CHARSET_ATTRIBUTES (charset)) 165 | #define CHARSET_UNIFY_MAP(charset) \ 166 | CHARSET_ATTR_UNIFY_MAP (CHARSET_ATTRIBUTES (charset)) 167 | #define CHARSET_DEUNIFIER(charset) \ 168 | CHARSET_ATTR_DEUNIFIER (CHARSET_ATTRIBUTES (charset)) 169 | 170 | INLINE void 171 | set_charset_attr (struct charset *charset, enum charset_attr_index idx, 172 | Lisp_Object val) 173 | { 174 | ASET (CHARSET_ATTRIBUTES (charset), idx, val); 175 | } 176 | 177 | #define CHARSETP(obj) (CHARSET_SYMBOL_HASH_INDEX (obj) >= 0) 178 | 179 | #define CHARSET_SYMBOL_ID(symbol) \ 180 | CHARSET_ATTR_ID (CHARSET_SYMBOL_ATTRIBUTES (symbol)) 181 | 182 | #define CHARSET_FAST_MAP_SET(c, fast_map) \ 183 | do \ 184 | { \ 185 | if ((c) < 0x10000) \ 186 | (fast_map)[(c) >> 10] |= 1 << (((c) >> 7) & 7); \ 187 | else \ 188 | (fast_map)[((c) >> 15) + 62] |= 1 << (((c) >> 12) & 7); \ 189 | } \ 190 | while (false) 191 | 192 | #define CHECK_CHARSET_GET_ID(x, id) \ 193 | do \ 194 | { \ 195 | ptrdiff_t idx; \ 196 | \ 197 | if (!SYMBOLP (x) || (idx = CHARSET_SYMBOL_HASH_INDEX (x)) < 0) \ 198 | wrong_type_argument (Qcharsetp, x); \ 199 | id = XFIXNUM (AREF (HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), idx), \ 200 | charset_id)); \ 201 | } \ 202 | while (false) 203 | 204 | #define CHECK_CHARSET_GET_ATTR(x, attr) \ 205 | do \ 206 | { \ 207 | if (!SYMBOLP (x) || NILP (attr = CHARSET_SYMBOL_ATTRIBUTES (x))) \ 208 | wrong_type_argument (Qcharsetp, x); \ 209 | } \ 210 | while (false) 211 | 212 | #define CHECK_CHARSET_GET_CHARSET(x, charset) \ 213 | do \ 214 | { \ 215 | int csid; \ 216 | CHECK_CHARSET_GET_ID (x, csid); \ 217 | charset = CHARSET_FROM_ID (csid); \ 218 | } \ 219 | while (false) 220 | 221 | #define DECODE_CHAR(charset, code) \ 222 | ((ASCII_CHAR_P (code) && (charset)->ascii_compatible_p) ? (code) \ 223 | : ((code) < (charset)->min_code || (code) > (charset)->max_code) ? -1 \ 224 | : (charset)->unified_p ? decode_char (charset, code) \ 225 | : (charset)->method == CHARSET_METHOD_OFFSET \ 226 | ? ((charset)->code_linear_p \ 227 | ? (int) ((code) - (charset)->min_code) + (charset)->code_offset \ 228 | : decode_char (charset, code)) \ 229 | : (charset)->method == CHARSET_METHOD_MAP \ 230 | ? (((charset)->code_linear_p && VECTORP (CHARSET_DECODER (charset))) \ 231 | ? XFIXNUM ( \ 232 | AREF (CHARSET_DECODER (charset), (code) - (charset)->min_code)) \ 233 | : decode_char (charset, code)) \ 234 | : decode_char (charset, code)) 235 | 236 | #define ISO_MAX_DIMENSION 3 237 | #define ISO_MAX_CHARS 2 238 | #define ISO_MAX_FINAL 0x80 239 | extern int iso_charset_table[ISO_MAX_DIMENSION][ISO_MAX_CHARS][ISO_MAX_FINAL]; 240 | 241 | #define ISO_CHARSET_TABLE(dimension, chars_96, final) \ 242 | iso_charset_table[(dimension) - 1][chars_96][final] 243 | 244 | extern int charset_unibyte; 245 | 246 | #endif 247 | -------------------------------------------------------------------------------- /src/coding.h: -------------------------------------------------------------------------------- 1 | #ifndef EMACS_CODING_H 2 | #define EMACS_CODING_H 3 | 4 | #include "lisp.h" 5 | 6 | enum define_coding_system_arg_index 7 | { 8 | coding_arg_name, 9 | coding_arg_mnemonic, 10 | coding_arg_coding_type, 11 | coding_arg_charset_list, 12 | coding_arg_ascii_compatible_p, 13 | coding_arg_decode_translation_table, 14 | coding_arg_encode_translation_table, 15 | coding_arg_post_read_conversion, 16 | coding_arg_pre_write_conversion, 17 | coding_arg_default_char, 18 | coding_arg_for_unibyte, 19 | coding_arg_plist, 20 | coding_arg_eol_type, 21 | coding_arg_max 22 | }; 23 | 24 | enum define_coding_iso2022_arg_index 25 | { 26 | coding_arg_iso2022_initial = coding_arg_max, 27 | coding_arg_iso2022_reg_usage, 28 | coding_arg_iso2022_request, 29 | coding_arg_iso2022_flags, 30 | coding_arg_iso2022_max 31 | }; 32 | 33 | enum define_coding_utf8_arg_index 34 | { 35 | coding_arg_utf8_bom = coding_arg_max, 36 | coding_arg_utf8_max 37 | }; 38 | 39 | enum define_coding_utf16_arg_index 40 | { 41 | coding_arg_utf16_bom = coding_arg_max, 42 | coding_arg_utf16_endian, 43 | coding_arg_utf16_max 44 | }; 45 | 46 | enum define_coding_ccl_arg_index 47 | { 48 | coding_arg_ccl_decoder = coding_arg_max, 49 | coding_arg_ccl_encoder, 50 | coding_arg_ccl_valids, 51 | coding_arg_ccl_max 52 | }; 53 | 54 | enum define_coding_undecided_arg_index 55 | { 56 | coding_arg_undecided_inhibit_null_byte_detection = coding_arg_max, 57 | coding_arg_undecided_inhibit_iso_escape_detection, 58 | coding_arg_undecided_prefer_utf_8, 59 | coding_arg_undecided_max 60 | }; 61 | 62 | enum coding_attr_index 63 | { 64 | coding_attr_base_name, 65 | coding_attr_docstring, 66 | coding_attr_mnemonic, 67 | coding_attr_type, 68 | coding_attr_charset_list, 69 | coding_attr_ascii_compat, 70 | coding_attr_decode_tbl, 71 | coding_attr_encode_tbl, 72 | coding_attr_trans_tbl, 73 | coding_attr_post_read, 74 | coding_attr_pre_write, 75 | coding_attr_default_char, 76 | coding_attr_for_unibyte, 77 | coding_attr_plist, 78 | 79 | coding_attr_category, 80 | coding_attr_safe_charsets, 81 | 82 | coding_attr_charset_valids, 83 | 84 | coding_attr_ccl_decoder, 85 | coding_attr_ccl_encoder, 86 | coding_attr_ccl_valids, 87 | 88 | coding_attr_iso_initial, 89 | coding_attr_iso_usage, 90 | coding_attr_iso_request, 91 | coding_attr_iso_flags, 92 | 93 | coding_attr_utf_bom, 94 | coding_attr_utf_16_endian, 95 | 96 | coding_attr_emacs_mule_full, 97 | 98 | coding_attr_undecided_inhibit_null_byte_detection, 99 | coding_attr_undecided_inhibit_iso_escape_detection, 100 | coding_attr_undecided_prefer_utf_8, 101 | 102 | coding_attr_last_index 103 | }; 104 | 105 | #define CODING_ATTR_BASE_NAME(attrs) AREF (attrs, coding_attr_base_name) 106 | #define CODING_ATTR_TYPE(attrs) AREF (attrs, coding_attr_type) 107 | #define CODING_ATTR_CHARSET_LIST(attrs) AREF (attrs, coding_attr_charset_list) 108 | #define CODING_ATTR_MNEMONIC(attrs) AREF (attrs, coding_attr_mnemonic) 109 | #define CODING_ATTR_DOCSTRING(attrs) AREF (attrs, coding_attr_docstring) 110 | #define CODING_ATTR_ASCII_COMPAT(attrs) AREF (attrs, coding_attr_ascii_compat) 111 | #define CODING_ATTR_DECODE_TBL(attrs) AREF (attrs, coding_attr_decode_tbl) 112 | #define CODING_ATTR_ENCODE_TBL(attrs) AREF (attrs, coding_attr_encode_tbl) 113 | #define CODING_ATTR_TRANS_TBL(attrs) AREF (attrs, coding_attr_trans_tbl) 114 | #define CODING_ATTR_POST_READ(attrs) AREF (attrs, coding_attr_post_read) 115 | #define CODING_ATTR_PRE_WRITE(attrs) AREF (attrs, coding_attr_pre_write) 116 | #define CODING_ATTR_DEFAULT_CHAR(attrs) AREF (attrs, coding_attr_default_char) 117 | #define CODING_ATTR_FOR_UNIBYTE(attrs) AREF (attrs, coding_attr_for_unibyte) 118 | #define CODING_ATTR_PLIST(attrs) AREF (attrs, coding_attr_plist) 119 | #define CODING_ATTR_CATEGORY(attrs) AREF (attrs, coding_attr_category) 120 | #define CODING_ATTR_SAFE_CHARSETS(attrs) AREF (attrs, coding_attr_safe_charsets) 121 | 122 | #define CODING_ID_NAME(id) \ 123 | HASH_KEY (XHASH_TABLE (Vcoding_system_hash_table), id) 124 | 125 | #define CODING_ID_ATTRS(id) \ 126 | AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 0) 127 | 128 | #define CODING_ID_EOL_TYPE(id) \ 129 | AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 2) 130 | 131 | #define CODING_SYSTEM_SPEC(coding_system_symbol) \ 132 | Fgethash (coding_system_symbol, Vcoding_system_hash_table, Qnil) 133 | 134 | #define CODING_SYSTEM_ID(coding_system_symbol) \ 135 | hash_lookup (XHASH_TABLE (Vcoding_system_hash_table), coding_system_symbol) 136 | 137 | #define CHECK_CODING_SYSTEM(x) \ 138 | do \ 139 | { \ 140 | if (CODING_SYSTEM_ID (x) < 0 && NILP (Fcheck_coding_system (x))) \ 141 | wrong_type_argument (Qcoding_system_p, x); \ 142 | } \ 143 | while (false) 144 | 145 | #define CHECK_CODING_SYSTEM_GET_SPEC(x, spec) \ 146 | do \ 147 | { \ 148 | spec = CODING_SYSTEM_SPEC (x); \ 149 | if (NILP (spec)) \ 150 | { \ 151 | Fcheck_coding_system (x); \ 152 | spec = CODING_SYSTEM_SPEC (x); \ 153 | } \ 154 | if (NILP (spec)) \ 155 | wrong_type_argument (Qcoding_system_p, x); \ 156 | } \ 157 | while (false) 158 | 159 | #define CHECK_CODING_SYSTEM_GET_ID(x, id) \ 160 | do \ 161 | { \ 162 | id = CODING_SYSTEM_ID (x); \ 163 | if (id < 0) \ 164 | { \ 165 | Fcheck_coding_system (x); \ 166 | id = CODING_SYSTEM_ID (x); \ 167 | } \ 168 | if (id < 0) \ 169 | wrong_type_argument (Qcoding_system_p, x); \ 170 | } \ 171 | while (false) 172 | 173 | #include "composite.h" 174 | 175 | enum composition_state 176 | { 177 | COMPOSING_NO, 178 | COMPOSING_CHAR, 179 | COMPOSING_RULE, 180 | COMPOSING_COMPONENT_CHAR, 181 | COMPOSING_COMPONENT_RULE 182 | }; 183 | 184 | struct composition_status 185 | { 186 | enum composition_state state; 187 | enum composition_method method; 188 | bool old_form; 189 | int length; 190 | int nchars; 191 | int ncomps; 192 | int carryover[4 + MAX_COMPOSITION_COMPONENTS * 3 - 2 + 2 193 | + MAX_COMPOSITION_COMPONENTS]; 194 | }; 195 | 196 | enum coding_category 197 | { 198 | coding_category_iso_7, 199 | coding_category_iso_7_tight, 200 | coding_category_iso_8_1, 201 | coding_category_iso_8_2, 202 | coding_category_iso_7_else, 203 | coding_category_iso_8_else, 204 | coding_category_utf_8_auto, 205 | coding_category_utf_8_nosig, 206 | coding_category_utf_8_sig, 207 | coding_category_utf_16_auto, 208 | coding_category_utf_16_be, 209 | coding_category_utf_16_le, 210 | coding_category_utf_16_be_nosig, 211 | coding_category_utf_16_le_nosig, 212 | coding_category_charset, 213 | coding_category_sjis, 214 | coding_category_big5, 215 | coding_category_ccl, 216 | coding_category_emacs_mule, 217 | coding_category_raw_text, 218 | coding_category_undecided, 219 | coding_category_max 220 | }; 221 | 222 | enum coding_result_code 223 | { 224 | CODING_RESULT_SUCCESS, 225 | CODING_RESULT_INSUFFICIENT_SRC, 226 | CODING_RESULT_INSUFFICIENT_DST, 227 | CODING_RESULT_INVALID_SRC, 228 | CODING_RESULT_INTERRUPT 229 | }; 230 | 231 | struct iso_2022_spec 232 | { 233 | unsigned flags; 234 | 235 | int current_invocation[2]; 236 | 237 | int current_designation[4]; 238 | 239 | int ctext_extended_segment_len; 240 | 241 | /* True temporarily only when graphic register 2 or 3 is invoked by 242 | single-shift while encoding. */ 243 | bool_bf single_shifting : 1; 244 | 245 | /* True temporarily only when processing at beginning of line. */ 246 | bool_bf bol : 1; 247 | 248 | /* If true, we are now scanning embedded UTF-8 sequence. */ 249 | bool_bf embedded_utf_8 : 1; 250 | 251 | /* The current composition. */ 252 | struct composition_status cmp_status; 253 | }; 254 | 255 | struct emacs_mule_spec 256 | { 257 | struct composition_status cmp_status; 258 | }; 259 | 260 | struct undecided_spec 261 | { 262 | /* Inhibit null byte detection. 1 means always inhibit, 263 | -1 means do not inhibit, 0 means rely on user variable. */ 264 | int inhibit_nbd; 265 | 266 | /* Inhibit ISO escape detection. -1, 0, 1 as above. */ 267 | int inhibit_ied; 268 | 269 | /* Prefer UTF-8 when the input could be other encodings. */ 270 | bool prefer_utf_8; 271 | }; 272 | 273 | enum utf_bom_type 274 | { 275 | utf_detect_bom, 276 | utf_without_bom, 277 | utf_with_bom 278 | }; 279 | 280 | enum utf_16_endian_type 281 | { 282 | utf_16_big_endian, 283 | utf_16_little_endian 284 | }; 285 | 286 | struct utf_16_spec 287 | { 288 | enum utf_bom_type bom; 289 | enum utf_16_endian_type endian; 290 | int surrogate; 291 | }; 292 | 293 | struct coding_detection_info 294 | { 295 | /* Values of these members are bitwise-OR of CATEGORY_MASK_XXXs. */ 296 | /* Which categories are already checked. */ 297 | int checked; 298 | /* Which categories are strongly found. */ 299 | int found; 300 | /* Which categories are rejected. */ 301 | int rejected; 302 | }; 303 | 304 | struct coding_system 305 | { 306 | ptrdiff_t id; 307 | 308 | unsigned common_flags : 14; 309 | 310 | unsigned mode : 5; 311 | 312 | bool_bf src_multibyte : 1; 313 | bool_bf dst_multibyte : 1; 314 | 315 | bool_bf chars_at_source : 1; 316 | 317 | bool_bf raw_destination : 1; 318 | 319 | bool_bf annotated : 1; 320 | 321 | bool_bf insert_before_markers : 1; 322 | 323 | unsigned eol_seen : 3; 324 | 325 | ENUM_BF (coding_result_code) result : 3; 326 | 327 | int max_charset_id; 328 | 329 | union 330 | { 331 | struct iso_2022_spec iso_2022; 332 | struct ccl_spec *ccl; 333 | struct utf_16_spec utf_16; 334 | enum utf_bom_type utf_8_bom; 335 | struct emacs_mule_spec emacs_mule; 336 | struct undecided_spec undecided; 337 | } spec; 338 | 339 | unsigned char *safe_charsets; 340 | 341 | ptrdiff_t head_ascii; 342 | 343 | ptrdiff_t detected_utf8_bytes, detected_utf8_chars; 344 | 345 | ptrdiff_t produced, produced_char, consumed, consumed_char; 346 | 347 | ptrdiff_t src_pos, src_pos_byte, src_chars, src_bytes; 348 | Lisp_Object src_object; 349 | const unsigned char *source; 350 | 351 | ptrdiff_t dst_pos, dst_pos_byte, dst_bytes; 352 | Lisp_Object dst_object; 353 | unsigned char *destination; 354 | 355 | int *charbuf; 356 | int charbuf_size, charbuf_used; 357 | 358 | unsigned char carryover[64]; 359 | int carryover_bytes; 360 | 361 | int default_char; 362 | 363 | #if TODO_NELISP_LATER_AND 364 | bool (*detector) (struct coding_system *, struct coding_detection_info *); 365 | void (*decoder) (struct coding_system *); 366 | bool (*encoder) (struct coding_system *); 367 | #endif 368 | }; 369 | 370 | #define CODING_ANNOTATION_MASK 0x00FF 371 | #define CODING_ANNOTATE_COMPOSITION_MASK 0x0001 372 | #define CODING_ANNOTATE_DIRECTION_MASK 0x0002 373 | #define CODING_ANNOTATE_CHARSET_MASK 0x0003 374 | #define CODING_FOR_UNIBYTE_MASK 0x0100 375 | #define CODING_REQUIRE_FLUSHING_MASK 0x0200 376 | #define CODING_REQUIRE_DECODING_MASK 0x0400 377 | #define CODING_REQUIRE_ENCODING_MASK 0x0800 378 | #define CODING_REQUIRE_DETECTION_MASK 0x1000 379 | 380 | #define CODING_MODE_SAFE_ENCODING 0x10 381 | 382 | INLINE Lisp_Object 383 | encode_file_name (Lisp_Object name) 384 | { 385 | if (STRING_MULTIBYTE (name)) 386 | TODO; 387 | CHECK_STRING_NULL_BYTES (name); 388 | return name; 389 | } 390 | 391 | #define ENCODE_FILE(NAME) encode_file_name (NAME) 392 | 393 | extern char emacs_mule_bytes[256]; 394 | 395 | #endif 396 | -------------------------------------------------------------------------------- /src/composite.h: -------------------------------------------------------------------------------- 1 | #ifndef EMACS_COMPOSITE_H 2 | #define EMACS_COMPOSITE_H 3 | 4 | enum composition_method 5 | { 6 | COMPOSITION_RELATIVE, 7 | 8 | COMPOSITION_WITH_RULE, 9 | 10 | COMPOSITION_WITH_ALTCHARS, 11 | 12 | COMPOSITION_WITH_RULE_ALTCHARS, 13 | 14 | COMPOSITION_NO 15 | }; 16 | 17 | #define MAX_COMPOSITION_COMPONENTS 16 18 | 19 | #endif 20 | -------------------------------------------------------------------------------- /src/dispnew.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | 3 | void 4 | syms_of_display (void) 5 | { 6 | DEFSYM (Qdisplay_table, "display-table"); 7 | 8 | DEFVAR_LISP ("standard-display-table", Vstandard_display_table, 9 | doc: /* Display table to use for buffers that specify none. 10 | It is also used for standard output and error streams. 11 | See `buffer-display-table' for more information. */); 12 | Vstandard_display_table = Qnil; 13 | } 14 | -------------------------------------------------------------------------------- /src/disptab.h: -------------------------------------------------------------------------------- 1 | #ifndef EMACS_DISPTAB_H 2 | #define EMACS_DISPTAB_H 3 | 4 | #define DISP_TABLE_P(obj) \ 5 | (CHAR_TABLE_P (obj) && EQ (XCHAR_TABLE (obj)->purpose, Qdisplay_table) \ 6 | && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (obj)) == DISP_TABLE_EXTRA_SLOTS) 7 | 8 | #define DISP_TABLE_EXTRA_SLOTS 6 9 | 10 | #endif 11 | -------------------------------------------------------------------------------- /src/doc.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | #include "disptab.h" 3 | 4 | static bool 5 | default_to_grave_quoting_style (void) 6 | { 7 | if (!text_quoting_flag) 8 | return true; 9 | if (!DISP_TABLE_P (Vstandard_display_table)) 10 | return false; 11 | TODO; 12 | } 13 | 14 | DEFUN ("text-quoting-style", Ftext_quoting_style, 15 | Stext_quoting_style, 0, 0, 0, 16 | doc: /* Return the current effective text quoting style. 17 | If the variable `text-quoting-style' is `grave', `straight' or 18 | `curve', just return that value. If it is nil (the default), return 19 | `grave' if curved quotes cannot be displayed (for instance, on a 20 | terminal with no support for these characters), otherwise return 21 | `curve'. Any other value is treated as `curve'. 22 | 23 | Note that in contrast to the variable `text-quoting-style', this 24 | function will never return nil. */) 25 | (void) 26 | { 27 | if (NILP (Vtext_quoting_style) ? default_to_grave_quoting_style () 28 | : EQ (Vtext_quoting_style, Qgrave)) 29 | return Qgrave; 30 | 31 | else if (EQ (Vtext_quoting_style, Qstraight)) 32 | return Qstraight; 33 | 34 | else 35 | return Qcurve; 36 | } 37 | 38 | void 39 | syms_of_doc (void) 40 | { 41 | DEFSYM (Qfunction_documentation, "function-documentation"); 42 | DEFSYM (Qgrave, "grave"); 43 | DEFSYM (Qstraight, "straight"); 44 | DEFSYM (Qcurve, "curve"); 45 | 46 | DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style, 47 | doc: /* Style to use for single quotes in help and messages. 48 | 49 | The value of this variable determines substitution of grave accents 50 | and apostrophes in help output (but not for display of Info 51 | manuals) and in functions like `message' and `format-message', but not 52 | in `format'. 53 | 54 | The value should be one of these symbols: 55 | `curve': quote with curved single quotes ‘like this’. 56 | `straight': quote with straight apostrophes \\='like this\\='. 57 | `grave': quote with grave accent and apostrophe \\=`like this\\='; 58 | i.e., do not alter the original quote marks. 59 | nil: like `curve' if curved single quotes are displayable, 60 | and like `grave' otherwise. This is the default. 61 | 62 | You should never read the value of this variable directly from a Lisp 63 | program. Use the function `text-quoting-style' instead, as that will 64 | compute the correct value for the current terminal in the nil case. */); 65 | Vtext_quoting_style = Qnil; 66 | 67 | DEFVAR_BOOL ("internal--text-quoting-flag", text_quoting_flag, 68 | doc: /* If nil, a nil `text-quoting-style' is treated as `grave'. */); 69 | 70 | defsubr (&Stext_quoting_style); 71 | } 72 | -------------------------------------------------------------------------------- /src/emacs.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | 3 | bool running_asynch_code; 4 | bool build_details; 5 | bool noninteractive; 6 | 7 | static const char emacs_version[] = PACKAGE_VERSION; 8 | 9 | void 10 | syms_of_emacs (void) 11 | { 12 | DEFSYM (Qfile_name_handler_alist, "file-name-handler-alist"); 13 | DEFSYM (Qrisky_local_variable, "risky-local-variable"); 14 | 15 | DEFVAR_LISP ("command-line-args", Vcommand_line_args, 16 | doc: /* Args passed by shell to Emacs, as a list of strings. 17 | Many arguments are deleted from the list as they are processed. */); 18 | 19 | DEFVAR_LISP ("dump-mode", Vdump_mode, 20 | doc: /* Non-nil when Emacs is dumping itself. */); 21 | 22 | DEFVAR_LISP ("system-type", Vsystem_type, 23 | doc: /* The value is a symbol indicating the type of operating system you are using. 24 | Special values: 25 | `gnu' compiled for a GNU Hurd system. 26 | `gnu/linux' compiled for a GNU/Linux system. 27 | `gnu/kfreebsd' compiled for a GNU system with a FreeBSD kernel. 28 | `darwin' compiled for Darwin (GNU-Darwin, macOS, ...). 29 | `ms-dos' compiled as an MS-DOS application. 30 | `windows-nt' compiled as a native W32 application. 31 | `cygwin' compiled using the Cygwin library. 32 | `haiku' compiled for a Haiku system. 33 | `android' compiled for Android. 34 | Anything else (in Emacs 26, the possibilities are: aix, berkeley-unix, 35 | hpux, usg-unix-v) indicates some sort of Unix system. */); 36 | Vsystem_type = intern_c_string (SYSTEM_TYPE); 37 | 38 | DEFVAR_LISP ("emacs-version", Vemacs_version, 39 | doc: /* Version numbers of this version of Emacs. 40 | This has the form: MAJOR.MINOR[.MICRO], where MAJOR/MINOR/MICRO are integers. 41 | MICRO is only present in unreleased development versions, 42 | and is not especially meaningful. Prior to Emacs 26.1, an extra final 43 | component .BUILD is present. This is now stored separately in 44 | `emacs-build-number'. */); 45 | Vemacs_version = build_string (emacs_version); 46 | } 47 | -------------------------------------------------------------------------------- /src/fileio.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include "lisp.h" 5 | #include "coding.h" 6 | 7 | void 8 | fclose_unwind (void *arg) 9 | { 10 | FILE *stream = arg; 11 | emacs_fclose (stream); 12 | } 13 | 14 | enum 15 | { 16 | file_name_as_directory_slop = 2 17 | }; 18 | 19 | static ptrdiff_t 20 | file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen, 21 | bool multibyte) 22 | { 23 | UNUSED (multibyte); 24 | if (srclen == 0) 25 | { 26 | dst[0] = '.'; 27 | dst[1] = '/'; 28 | dst[2] = '\0'; 29 | return 2; 30 | } 31 | 32 | memcpy (dst, src, srclen); 33 | if (!IS_DIRECTORY_SEP (dst[srclen - 1])) 34 | dst[srclen++] = DIRECTORY_SEP; 35 | dst[srclen] = 0; 36 | return srclen; 37 | } 38 | 39 | DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, 40 | doc: /* Convert filename NAME to absolute, and canonicalize it. 41 | Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative 42 | \(does not start with slash or tilde); both the directory name and 43 | a directory's file name are accepted. If DEFAULT-DIRECTORY is nil or 44 | missing, the current buffer's value of `default-directory' is used. 45 | NAME should be a string that is a valid file name for the underlying 46 | filesystem. 47 | 48 | File name components that are `.' are removed, and so are file name 49 | components followed by `..', along with the `..' itself; note that 50 | these simplifications are done without checking the resulting file 51 | names in the file system. 52 | 53 | Multiple consecutive slashes are collapsed into a single slash, except 54 | at the beginning of the file name when they are significant (e.g., UNC 55 | file names on MS-Windows.) 56 | 57 | An initial \"~\" in NAME expands to your home directory. 58 | 59 | An initial \"~USER\" in NAME expands to USER's home directory. If 60 | USER doesn't exist, \"~USER\" is not expanded. 61 | 62 | To do other file name substitutions, see `substitute-in-file-name'. 63 | 64 | For technical reasons, this function can return correct but 65 | non-intuitive results for the root directory; for instance, 66 | \(expand-file-name ".." "/") returns "/..". For this reason, use 67 | \(directory-file-name (file-name-directory dirname)) to traverse a 68 | filesystem tree, not (expand-file-name ".." dirname). Note: make 69 | sure DIRNAME in this example doesn't end in a slash, unless it's 70 | the root directory. */) 71 | (Lisp_Object name, Lisp_Object default_directory) 72 | { 73 | TODO_NELISP_LATER; 74 | 75 | ptrdiff_t length, nbytes; 76 | const char *newdir; 77 | const char *newdirlim; 78 | bool multibyte; 79 | char *nm; 80 | char *nmlim; 81 | ptrdiff_t tlen; 82 | char *target; 83 | Lisp_Object result; 84 | USE_SAFE_ALLOCA; 85 | 86 | CHECK_STRING (name); 87 | CHECK_STRING_NULL_BYTES (name); 88 | 89 | Lisp_Object root; 90 | root = build_string ("/"); 91 | if (NILP (default_directory)) 92 | TODO_NELISP_LATER; 93 | if (!STRINGP (default_directory)) 94 | default_directory = root; 95 | { 96 | char *o = SSDATA (default_directory); 97 | if (!NILP (default_directory) && !EQ (default_directory, name) 98 | && !(IS_DIRECTORY_SEP (o[0]))) 99 | { 100 | default_directory = Fexpand_file_name (default_directory, Qnil); 101 | } 102 | } 103 | multibyte = STRING_MULTIBYTE (name); 104 | bool defdir_multibyte = STRING_MULTIBYTE (default_directory); 105 | if (multibyte != defdir_multibyte) 106 | TODO; 107 | SAFE_ALLOCA_STRING (nm, name); 108 | nmlim = nm + SBYTES (name); 109 | 110 | if (IS_DIRECTORY_SEP (nm[0])) 111 | { 112 | bool lose = 0; 113 | char *p = nm; 114 | 115 | while (*p) 116 | { 117 | if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' 118 | && (IS_DIRECTORY_SEP (p[2]) || p[2] == 0 119 | || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)))) 120 | lose = 1; 121 | else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]) 122 | && (p != nm || IS_DIRECTORY_SEP (p[2]))) 123 | lose = 1; 124 | p++; 125 | } 126 | if (!lose) 127 | { 128 | if (strcmp (nm, SSDATA (name)) != 0) 129 | name = make_specified_string (nm, -1, nmlim - nm, multibyte); 130 | SAFE_FREE (); 131 | return name; 132 | } 133 | } 134 | newdir = newdirlim = 0; 135 | if (nm[0] == '~') 136 | TODO; 137 | if (1 && !newdir) 138 | { 139 | newdir = SSDATA (default_directory); 140 | newdirlim = newdir + SBYTES (default_directory); 141 | } 142 | length = newdirlim - newdir; 143 | while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1]) 144 | && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))) 145 | length--; 146 | tlen = length + file_name_as_directory_slop + (nmlim - nm) + 1; 147 | eassert (tlen >= file_name_as_directory_slop + 1); 148 | target = SAFE_ALLOCA (tlen); 149 | *target = 0; 150 | nbytes = 0; 151 | if (newdir) 152 | { 153 | if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0])) 154 | { 155 | memcpy (target, newdir, length); 156 | target[length] = 0; 157 | nbytes = length; 158 | } 159 | else 160 | { 161 | nbytes = file_name_as_directory (target, newdir, length, multibyte); 162 | } 163 | } 164 | 165 | memcpy (target + nbytes, nm, nmlim - nm + 1); 166 | 167 | { 168 | char *p = target; 169 | char *o = target; 170 | 171 | while (*p) 172 | { 173 | if (!IS_DIRECTORY_SEP (*p)) 174 | { 175 | *o++ = *p++; 176 | } 177 | else if (p[1] == '.' && (IS_DIRECTORY_SEP (p[2]) || p[2] == 0)) 178 | { 179 | if (o == target && p[2] == '\0') 180 | *o++ = *p; 181 | p += 2; 182 | } 183 | else if (p[1] == '.' && p[2] == '.' && o != target 184 | && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)) 185 | { 186 | while (o != target && (--o, !IS_DIRECTORY_SEP (*o))) 187 | continue; 188 | if (o == target && IS_ANY_SEP (*o) && p[3] == 0) 189 | ++o; 190 | p += 3; 191 | } 192 | else if (IS_DIRECTORY_SEP (p[1]) 193 | && (p != target || IS_DIRECTORY_SEP (p[2]))) 194 | p++; 195 | else 196 | { 197 | *o++ = *p++; 198 | } 199 | } 200 | 201 | result = make_specified_string (target, -1, o - target, multibyte); 202 | } 203 | SAFE_FREE (); 204 | return result; 205 | } 206 | 207 | Lisp_Object 208 | expand_and_dir_to_file (Lisp_Object filename) 209 | { 210 | Lisp_Object absname = Fexpand_file_name (filename, Qnil); 211 | 212 | if (SCHARS (absname) > 1 213 | && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1)) 214 | && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname) - 2))) 215 | TODO; 216 | return absname; 217 | } 218 | 219 | bool 220 | file_access_p (char const *file, int amode) 221 | { 222 | if (faccessat (AT_FDCWD, file, amode, AT_EACCESS) == 0) 223 | return true; 224 | return false; 225 | } 226 | bool 227 | file_accessible_directory_p (Lisp_Object file) 228 | { 229 | const char *data = SSDATA (file); 230 | ptrdiff_t len = SBYTES (file); 231 | char const *dir; 232 | bool ok; 233 | USE_SAFE_ALLOCA; 234 | 235 | if (!len) 236 | dir = data; 237 | else 238 | { 239 | static char const appended[] = "/./"; 240 | char *buf = SAFE_ALLOCA (len + sizeof appended); 241 | memcpy (buf, data, len); 242 | strcpy (buf + len, &appended[data[len - 1] == '/']); 243 | dir = buf; 244 | } 245 | 246 | ok = file_access_p (dir, F_OK); 247 | SAFE_FREE (); 248 | return ok; 249 | } 250 | bool 251 | file_directory_p (Lisp_Object file) 252 | { 253 | if (file_accessible_directory_p (file)) 254 | return true; 255 | if (errno != EACCES) 256 | return false; 257 | struct stat st; 258 | if (emacs_fstatat (AT_FDCWD, SSDATA (file), &st, 0) != 0) 259 | return errno == EOVERFLOW; 260 | if (S_ISDIR (st.st_mode)) 261 | return true; 262 | errno = ENOTDIR; 263 | return false; 264 | } 265 | 266 | DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, 267 | doc: /* Return t if FILENAME names an existing directory. 268 | Return nil if FILENAME does not name a directory, or if there 269 | was trouble determining whether FILENAME is a directory. 270 | 271 | As a special case, this function will also return t if FILENAME is the 272 | empty string (\"\"). This quirk is due to Emacs interpreting the 273 | empty string (in some cases) as the current directory. 274 | 275 | Symbolic links to directories count as directories. 276 | See `file-symlink-p' to distinguish symlinks. */) 277 | (Lisp_Object filename) 278 | { 279 | Lisp_Object absname = expand_and_dir_to_file (filename); 280 | 281 | #if TODO_NELISP_LATER_AND 282 | Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_directory_p); 283 | if (!NILP (handler)) 284 | return call2 (handler, Qfile_directory_p, absname); 285 | #endif 286 | 287 | return file_directory_p (ENCODE_FILE (absname)) ? Qt : Qnil; 288 | } 289 | 290 | void 291 | syms_of_fileio (void) 292 | { 293 | defsubr (&Sexpand_file_name); 294 | defsubr (&Sfile_directory_p); 295 | } 296 | -------------------------------------------------------------------------------- /src/insdel.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | #include "character.h" 3 | 4 | ptrdiff_t 5 | copy_text (const unsigned char *from_addr, unsigned char *to_addr, 6 | ptrdiff_t nbytes, bool from_multibyte, bool to_multibyte) 7 | { 8 | if (from_multibyte == to_multibyte) 9 | { 10 | memcpy (to_addr, from_addr, nbytes); 11 | return nbytes; 12 | } 13 | else if (from_multibyte) 14 | { 15 | ptrdiff_t nchars = 0; 16 | ptrdiff_t bytes_left = nbytes; 17 | 18 | while (bytes_left > 0) 19 | { 20 | int thislen, c = string_char_and_length (from_addr, &thislen); 21 | if (!ASCII_CHAR_P (c)) 22 | c &= 0xFF; 23 | *to_addr++ = c; 24 | from_addr += thislen; 25 | bytes_left -= thislen; 26 | nchars++; 27 | } 28 | return nchars; 29 | } 30 | else 31 | { 32 | unsigned char *initial_to_addr = to_addr; 33 | 34 | while (nbytes > 0) 35 | { 36 | int c = *from_addr++; 37 | 38 | if (!ASCII_CHAR_P (c)) 39 | { 40 | c = BYTE8_TO_CHAR (c); 41 | to_addr += CHAR_STRING (c, to_addr); 42 | nbytes--; 43 | } 44 | else 45 | *to_addr++ = c, nbytes--; 46 | } 47 | return to_addr - initial_to_addr; 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /src/intervals.c: -------------------------------------------------------------------------------- 1 | #include "intervals.h" 2 | #include "lisp.h" 3 | 4 | static void 5 | set_interval_left (INTERVAL i, INTERVAL left) 6 | { 7 | i->left = left; 8 | } 9 | 10 | static void 11 | set_interval_right (INTERVAL i, INTERVAL right) 12 | { 13 | i->right = right; 14 | } 15 | 16 | static void 17 | copy_interval_parent (INTERVAL d, INTERVAL s) 18 | { 19 | d->up = s->up; 20 | d->up_obj = s->up_obj; 21 | } 22 | 23 | INTERVAL 24 | create_root_interval (Lisp_Object parent) 25 | { 26 | INTERVAL new; 27 | 28 | new = make_interval (); 29 | 30 | if (!STRINGP (parent)) 31 | TODO; 32 | else 33 | { 34 | CHECK_IMPURE (parent, XSTRING (parent)); 35 | new->total_length = SCHARS (parent); 36 | eassert (TOTAL_LENGTH (new) >= 0); 37 | set_string_intervals (parent, new); 38 | new->position = 0; 39 | } 40 | eassert (LENGTH (new) > 0); 41 | 42 | set_interval_object (new, parent); 43 | 44 | return new; 45 | } 46 | 47 | static INTERVAL 48 | rotate_right (INTERVAL A) 49 | { 50 | INTERVAL B = A->left; 51 | INTERVAL c = B->right; 52 | ptrdiff_t old_total = A->total_length; 53 | 54 | eassert (old_total > 0); 55 | eassert (LENGTH (A) > 0); 56 | eassert (LENGTH (B) > 0); 57 | 58 | if (!ROOT_INTERVAL_P (A)) 59 | { 60 | if (AM_LEFT_CHILD (A)) 61 | set_interval_left (INTERVAL_PARENT (A), B); 62 | else 63 | set_interval_right (INTERVAL_PARENT (A), B); 64 | } 65 | copy_interval_parent (B, A); 66 | 67 | set_interval_right (B, A); 68 | set_interval_parent (A, B); 69 | 70 | set_interval_left (A, c); 71 | if (c) 72 | set_interval_parent (c, A); 73 | 74 | A->total_length -= TOTAL_LENGTH (B) - TOTAL_LENGTH0 (c); 75 | eassert (TOTAL_LENGTH (A) > 0); 76 | eassert (LENGTH (A) > 0); 77 | 78 | B->total_length = old_total; 79 | eassert (LENGTH (B) > 0); 80 | 81 | return B; 82 | } 83 | 84 | static INTERVAL 85 | rotate_left (INTERVAL A) 86 | { 87 | INTERVAL B = A->right; 88 | INTERVAL c = B->left; 89 | ptrdiff_t old_total = A->total_length; 90 | 91 | eassert (old_total > 0); 92 | eassert (LENGTH (A) > 0); 93 | eassert (LENGTH (B) > 0); 94 | 95 | if (!ROOT_INTERVAL_P (A)) 96 | { 97 | if (AM_LEFT_CHILD (A)) 98 | set_interval_left (INTERVAL_PARENT (A), B); 99 | else 100 | set_interval_right (INTERVAL_PARENT (A), B); 101 | } 102 | copy_interval_parent (B, A); 103 | 104 | set_interval_left (B, A); 105 | set_interval_parent (A, B); 106 | 107 | set_interval_right (A, c); 108 | if (c) 109 | set_interval_parent (c, A); 110 | 111 | A->total_length -= TOTAL_LENGTH (B) - TOTAL_LENGTH0 (c); 112 | eassert (TOTAL_LENGTH (A) > 0); 113 | eassert (LENGTH (A) > 0); 114 | 115 | B->total_length = old_total; 116 | eassert (LENGTH (B) > 0); 117 | 118 | return B; 119 | } 120 | 121 | static INTERVAL 122 | balance_an_interval (INTERVAL i) 123 | { 124 | register ptrdiff_t old_diff, new_diff; 125 | 126 | eassert (LENGTH (i) > 0); 127 | eassert (TOTAL_LENGTH (i) >= LENGTH (i)); 128 | 129 | while (1) 130 | { 131 | old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i); 132 | if (old_diff > 0) 133 | { 134 | new_diff = i->total_length - i->left->total_length 135 | + RIGHT_TOTAL_LENGTH (i->left) 136 | - LEFT_TOTAL_LENGTH (i->left); 137 | if (eabs (new_diff) >= old_diff) 138 | break; 139 | i = rotate_right (i); 140 | balance_an_interval (i->right); 141 | } 142 | else if (old_diff < 0) 143 | { 144 | new_diff = i->total_length - i->right->total_length 145 | + LEFT_TOTAL_LENGTH (i->right) 146 | - RIGHT_TOTAL_LENGTH (i->right); 147 | if (eabs (new_diff) >= -old_diff) 148 | break; 149 | i = rotate_left (i); 150 | balance_an_interval (i->left); 151 | } 152 | else 153 | break; 154 | } 155 | return i; 156 | } 157 | 158 | static INTERVAL 159 | balance_possible_root_interval (INTERVAL interval) 160 | { 161 | Lisp_Object parent; 162 | bool have_parent = false; 163 | 164 | if (INTERVAL_HAS_OBJECT (interval)) 165 | { 166 | have_parent = true; 167 | GET_INTERVAL_OBJECT (parent, interval); 168 | } 169 | else if (!INTERVAL_HAS_PARENT (interval)) 170 | return interval; 171 | 172 | interval = balance_an_interval (interval); 173 | 174 | if (have_parent) 175 | { 176 | if (BUFFERP (parent)) 177 | TODO; // set_buffer_intervals (XBUFFER (parent), interval); 178 | else if (STRINGP (parent)) 179 | set_string_intervals (parent, interval); 180 | } 181 | 182 | return interval; 183 | } 184 | 185 | INTERVAL 186 | find_interval (register INTERVAL tree, register ptrdiff_t position) 187 | { 188 | register ptrdiff_t relative_position; 189 | 190 | if (!tree) 191 | return NULL; 192 | 193 | relative_position = position; 194 | if (INTERVAL_HAS_OBJECT (tree)) 195 | { 196 | Lisp_Object parent; 197 | GET_INTERVAL_OBJECT (parent, tree); 198 | if (BUFFERP (parent)) 199 | TODO; // relative_position -= BUF_BEG (XBUFFER (parent)); 200 | } 201 | 202 | eassert (relative_position <= TOTAL_LENGTH (tree)); 203 | 204 | tree = balance_possible_root_interval (tree); 205 | 206 | while (1) 207 | { 208 | eassert (tree); 209 | if (relative_position < LEFT_TOTAL_LENGTH (tree)) 210 | { 211 | tree = tree->left; 212 | } 213 | else if (!NULL_RIGHT_CHILD (tree) 214 | && relative_position 215 | >= (TOTAL_LENGTH (tree) - RIGHT_TOTAL_LENGTH (tree))) 216 | { 217 | relative_position 218 | -= (TOTAL_LENGTH (tree) - RIGHT_TOTAL_LENGTH (tree)); 219 | tree = tree->right; 220 | } 221 | else 222 | { 223 | tree->position 224 | = (position - relative_position + LEFT_TOTAL_LENGTH (tree)); 225 | 226 | return tree; 227 | } 228 | } 229 | } 230 | 231 | INTERVAL 232 | next_interval (register INTERVAL interval) 233 | { 234 | register INTERVAL i = interval; 235 | register ptrdiff_t next_position; 236 | 237 | if (!i) 238 | return NULL; 239 | next_position = interval->position + LENGTH (interval); 240 | 241 | if (!NULL_RIGHT_CHILD (i)) 242 | { 243 | i = i->right; 244 | while (!NULL_LEFT_CHILD (i)) 245 | i = i->left; 246 | 247 | i->position = next_position; 248 | return i; 249 | } 250 | 251 | while (!NULL_PARENT (i)) 252 | { 253 | if (AM_LEFT_CHILD (i)) 254 | { 255 | i = INTERVAL_PARENT (i); 256 | i->position = next_position; 257 | return i; 258 | } 259 | 260 | i = INTERVAL_PARENT (i); 261 | } 262 | 263 | return NULL; 264 | } 265 | 266 | INTERVAL 267 | split_interval_right (INTERVAL interval, ptrdiff_t offset) 268 | { 269 | INTERVAL new = make_interval (); 270 | ptrdiff_t position = interval->position; 271 | ptrdiff_t new_length = LENGTH (interval) - offset; 272 | 273 | new->position = position + offset; 274 | set_interval_parent (new, interval); 275 | 276 | if (NULL_RIGHT_CHILD (interval)) 277 | { 278 | set_interval_right (interval, new); 279 | new->total_length = new_length; 280 | eassert (LENGTH (new) > 0); 281 | } 282 | else 283 | { 284 | set_interval_right (new, interval->right); 285 | set_interval_parent (interval->right, new); 286 | set_interval_right (interval, new); 287 | new->total_length = new_length + new->right->total_length; 288 | balance_an_interval (new); 289 | } 290 | 291 | balance_possible_root_interval (interval); 292 | 293 | return new; 294 | } 295 | 296 | INTERVAL 297 | split_interval_left (INTERVAL interval, ptrdiff_t offset) 298 | { 299 | INTERVAL new = make_interval (); 300 | ptrdiff_t new_length = offset; 301 | 302 | new->position = interval->position; 303 | interval->position = interval->position + offset; 304 | set_interval_parent (new, interval); 305 | 306 | if (NULL_LEFT_CHILD (interval)) 307 | { 308 | set_interval_left (interval, new); 309 | new->total_length = new_length; 310 | eassert (LENGTH (new) > 0); 311 | } 312 | else 313 | { 314 | set_interval_left (new, interval->left); 315 | set_interval_parent (new->left, new); 316 | set_interval_left (interval, new); 317 | new->total_length = new_length + new->left->total_length; 318 | balance_an_interval (new); 319 | } 320 | 321 | balance_possible_root_interval (interval); 322 | 323 | return new; 324 | } 325 | 326 | void 327 | copy_properties (INTERVAL source, INTERVAL target) 328 | { 329 | if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target)) 330 | return; 331 | 332 | COPY_INTERVAL_CACHE (source, target); 333 | set_interval_plist (target, Fcopy_sequence (source->plist)); 334 | } 335 | -------------------------------------------------------------------------------- /src/intervals.h: -------------------------------------------------------------------------------- 1 | #ifndef EMACS_INTERVALS_H 2 | #define EMACS_INTERVALS_H 3 | 4 | #include "lisp.h" 5 | #include "buffer.h" 6 | 7 | struct interval 8 | { 9 | ptrdiff_t total_length; 10 | ptrdiff_t position; 11 | struct interval *left; 12 | struct interval *right; 13 | 14 | union 15 | { 16 | struct interval *interval; 17 | Lisp_Object obj; 18 | } up; 19 | bool_bf up_obj : 1; 20 | 21 | bool_bf gcmarkbit : 1; 22 | 23 | bool_bf write_protect : 1; 24 | bool_bf visible : 1; 25 | bool_bf front_sticky : 1; 26 | bool_bf rear_sticky : 1; 27 | Lisp_Object plist; 28 | }; 29 | 30 | #define NULL_RIGHT_CHILD(i) ((i)->right == NULL) 31 | 32 | #define NULL_LEFT_CHILD(i) ((i)->left == NULL) 33 | 34 | #define NULL_PARENT(i) ((i)->up_obj || (i)->up.interval == 0) 35 | 36 | #define AM_LEFT_CHILD(i) (!NULL_PARENT (i) && INTERVAL_PARENT (i)->left == (i)) 37 | 38 | #define ROOT_INTERVAL_P(i) NULL_PARENT (i) 39 | 40 | #define TOTAL_LENGTH(i) ((i)->total_length) 41 | 42 | #define TOTAL_LENGTH0(i) ((i) ? TOTAL_LENGTH (i) : 0) 43 | 44 | #define LENGTH(i) \ 45 | (TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i) - LEFT_TOTAL_LENGTH (i)) 46 | 47 | #define LEFT_TOTAL_LENGTH(i) TOTAL_LENGTH0 ((i)->left) 48 | 49 | #define RIGHT_TOTAL_LENGTH(i) TOTAL_LENGTH0 ((i)->right) 50 | 51 | #define DEFAULT_INTERVAL_P(i) (!i || NILP ((i)->plist)) 52 | 53 | #define INTERVAL_HAS_PARENT(i) (!(i)->up_obj && (i)->up.interval != 0) 54 | #define INTERVAL_HAS_OBJECT(i) ((i)->up_obj) 55 | 56 | INLINE void 57 | set_interval_object (INTERVAL i, Lisp_Object obj) 58 | { 59 | eassert (BUFFERP (obj) || STRINGP (obj)); 60 | i->up_obj = 1; 61 | i->up.obj = obj; 62 | } 63 | 64 | INLINE void 65 | set_interval_parent (INTERVAL i, INTERVAL parent) 66 | { 67 | i->up_obj = false; 68 | i->up.interval = parent; 69 | } 70 | 71 | INLINE void 72 | set_interval_plist (INTERVAL i, Lisp_Object plist) 73 | { 74 | i->plist = plist; 75 | } 76 | 77 | #define INTERVAL_PARENT(i) \ 78 | (eassert ((i) != 0 && !(i)->up_obj), (i)->up.interval) 79 | 80 | #define GET_INTERVAL_OBJECT(d, s) (eassert ((s)->up_obj), (d) = (s)->up.obj) 81 | 82 | #define RESET_INTERVAL(i) \ 83 | do \ 84 | { \ 85 | (i)->total_length = (i)->position = 0; \ 86 | (i)->left = (i)->right = NULL; \ 87 | set_interval_parent (i, NULL); \ 88 | (i)->write_protect = false; \ 89 | (i)->visible = false; \ 90 | (i)->front_sticky = (i)->rear_sticky = false; \ 91 | set_interval_plist (i, Qnil); \ 92 | } \ 93 | while (false) 94 | 95 | #define COPY_INTERVAL_CACHE(from, to) \ 96 | do \ 97 | { \ 98 | (to)->write_protect = (from)->write_protect; \ 99 | (to)->visible = (from)->visible; \ 100 | (to)->front_sticky = (from)->front_sticky; \ 101 | (to)->rear_sticky = (from)->rear_sticky; \ 102 | } \ 103 | while (false) 104 | 105 | extern INTERVAL next_interval (INTERVAL interval); 106 | extern INTERVAL split_interval_right (INTERVAL interval, ptrdiff_t offset); 107 | extern INTERVAL split_interval_left (INTERVAL interval, ptrdiff_t offset); 108 | extern void copy_properties (INTERVAL source, INTERVAL target); 109 | extern INTERVAL create_root_interval (Lisp_Object parent); 110 | extern INTERVAL find_interval (INTERVAL tree, ptrdiff_t position); 111 | 112 | #endif 113 | -------------------------------------------------------------------------------- /src/keyboard.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | #include "lua.h" 3 | #include "termhooks.h" 4 | 5 | EMACS_INT command_loop_level; 6 | 7 | static Lisp_Object 8 | cmd_error (Lisp_Object data) 9 | { 10 | TODO_NELISP_LATER; 11 | tcall_error = true; 12 | Lisp_Object err_symbol = Fcar (data); 13 | Lisp_Object message = Fget (err_symbol, Qerror_message); 14 | Lisp_Object tail = Fcdr_safe (data); 15 | char *errmsg = "nil"; 16 | if (STRINGP (message)) 17 | errmsg = (char *) SDATA (message); 18 | char *extra = ""; 19 | if (SYMBOLP (tail)) 20 | extra = (char *) SDATA (SYMBOL_NAME (tail)); 21 | if (SYMBOLP (Fcar_safe (tail))) 22 | extra = (char *) SDATA (SYMBOL_NAME (Fcar_safe (tail))); 23 | LUAC (5, 1) { lua_pushfstring (L, "(nelisp): %s (%s)", errmsg, extra); } 24 | return make_fixnum (0); 25 | } 26 | 27 | static Lisp_Object 28 | command_loop_1 (void) 29 | { 30 | while (1) 31 | { 32 | mtx_lock (&main_mutex); 33 | cnd_signal (&main_cond); 34 | mtx_unlock (&main_mutex); 35 | cnd_wait (&thread_cond, &thread_mutex); 36 | 37 | eassert (main_func); 38 | main_func (); 39 | main_func = NULL; 40 | } 41 | 42 | __builtin_unreachable (); 43 | } 44 | Lisp_Object 45 | command_loop_2 (Lisp_Object handlers) 46 | { 47 | register Lisp_Object val; 48 | 49 | UNUSED (handlers); 50 | do 51 | val = internal_condition_case (command_loop_1, handlers, cmd_error); 52 | while (!NILP (val)); 53 | 54 | return Qnil; 55 | } 56 | Lisp_Object 57 | command_loop (void) 58 | { 59 | #if TODO_NELISP_LATER_AND 60 | if (command_loop_level > 0 || minibuf_level > 0) 61 | { 62 | Lisp_Object val; 63 | val = internal_catch (Qexit, command_loop_2, Qerror); 64 | executing_kbd_macro = Qnil; 65 | return val; 66 | } 67 | else 68 | #endif 69 | while (1) 70 | { 71 | // internal_catch (Qtop_level, top_level_1, Qnil); 72 | internal_catch (Qtop_level, command_loop_2, Qerror); 73 | // executing_kbd_macro = Qnil; 74 | // 75 | // if (noninteractive) 76 | // Fkill_emacs (Qt, Qnil); 77 | } 78 | } 79 | 80 | Lisp_Object 81 | recursive_edit_1 (void) 82 | { 83 | specpdl_ref count = SPECPDL_INDEX (); 84 | Lisp_Object val; 85 | 86 | if (command_loop_level > 0) 87 | { 88 | TODO; 89 | } 90 | 91 | #if TODO_NELISP_LATER_AND 92 | specbind (Qinhibit_redisplay, Qnil); 93 | redisplaying_p = 0; 94 | specbind (Qundo_auto__undoably_changed_buffers, Qnil); 95 | #endif 96 | 97 | val = command_loop (); 98 | UNUSED (val); 99 | #if TODO_NELISP_LATER_AND 100 | if (EQ (val, Qt)) 101 | quit (); 102 | if (STRINGP (val)) 103 | xsignal1 (Qerror, val); 104 | 105 | if (FUNCTIONP (val)) 106 | call0 (val); 107 | #endif 108 | 109 | return unbind_to (count, Qnil); 110 | } 111 | 112 | DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "", 113 | doc: /* Invoke the editor command loop recursively. 114 | To get out of the recursive edit, a command can throw to `exit' -- for 115 | instance (throw \\='exit nil). 116 | 117 | The following values (last argument to `throw') can be used when 118 | throwing to \\='exit: 119 | 120 | - t causes `recursive-edit' to quit, so that control returns to the 121 | command loop one level up. 122 | 123 | - A string causes `recursive-edit' to signal an error, printing that 124 | string as the error message. 125 | 126 | - A function causes `recursive-edit' to call that function with no 127 | arguments, and then return normally. 128 | 129 | - Any other value causes `recursive-edit' to return normally to the 130 | function that called it. 131 | 132 | This function is called by the editor initialization to begin editing. */) 133 | (void) 134 | { 135 | specpdl_ref count = SPECPDL_INDEX (); 136 | #if TODO_NELISP_LATER_AND 137 | Lisp_Object buffer; 138 | 139 | if (input_blocked_p ()) 140 | return Qnil; 141 | 142 | if (command_loop_level >= 0 143 | && current_buffer != XBUFFER (XWINDOW (selected_window)->contents)) 144 | buffer = Fcurrent_buffer (); 145 | else 146 | buffer = Qnil; 147 | #endif 148 | 149 | command_loop_level++; 150 | #if TODO_NELISP_LATER_AND 151 | update_mode_lines = 17; 152 | record_unwind_protect (recursive_edit_unwind, buffer); 153 | 154 | if (command_loop_level > 0) 155 | temporarily_switch_to_single_kboard (SELECTED_FRAME ()); 156 | #endif 157 | 158 | recursive_edit_1 (); 159 | return unbind_to (count, Qnil); 160 | } 161 | 162 | static int 163 | parse_modifiers_uncached (Lisp_Object symbol, ptrdiff_t *modifier_end) 164 | { 165 | Lisp_Object name; 166 | ptrdiff_t i; 167 | int modifiers; 168 | 169 | CHECK_SYMBOL (symbol); 170 | 171 | modifiers = 0; 172 | name = SYMBOL_NAME (symbol); 173 | 174 | for (i = 0; i < SBYTES (name) - 1;) 175 | { 176 | ptrdiff_t this_mod_end = 0; 177 | int this_mod = 0; 178 | 179 | switch (SREF (name, i)) 180 | { 181 | #define SINGLE_LETTER_MOD(BIT) (this_mod_end = i + 1, this_mod = BIT) 182 | 183 | case 'A': 184 | SINGLE_LETTER_MOD (alt_modifier); 185 | break; 186 | 187 | case 'C': 188 | SINGLE_LETTER_MOD (ctrl_modifier); 189 | break; 190 | 191 | case 'H': 192 | SINGLE_LETTER_MOD (hyper_modifier); 193 | break; 194 | 195 | case 'M': 196 | SINGLE_LETTER_MOD (meta_modifier); 197 | break; 198 | 199 | case 'S': 200 | SINGLE_LETTER_MOD (shift_modifier); 201 | break; 202 | 203 | case 's': 204 | SINGLE_LETTER_MOD (super_modifier); 205 | break; 206 | 207 | #undef SINGLE_LETTER_MOD 208 | 209 | #define MULTI_LETTER_MOD(BIT, NAME, LEN) \ 210 | if (i + LEN + 1 <= SBYTES (name) && !memcmp (SDATA (name) + i, NAME, LEN)) \ 211 | { \ 212 | this_mod_end = i + LEN; \ 213 | this_mod = BIT; \ 214 | } 215 | 216 | case 'd': 217 | MULTI_LETTER_MOD (drag_modifier, "drag", 4); 218 | MULTI_LETTER_MOD (down_modifier, "down", 4); 219 | MULTI_LETTER_MOD (double_modifier, "double", 6); 220 | break; 221 | 222 | case 't': 223 | MULTI_LETTER_MOD (triple_modifier, "triple", 6); 224 | break; 225 | 226 | case 'u': 227 | MULTI_LETTER_MOD (up_modifier, "up", 2); 228 | break; 229 | #undef MULTI_LETTER_MOD 230 | } 231 | 232 | if (this_mod_end == 0) 233 | break; 234 | 235 | if (this_mod_end >= SBYTES (name) || SREF (name, this_mod_end) != '-') 236 | break; 237 | 238 | modifiers |= this_mod; 239 | i = this_mod_end + 1; 240 | } 241 | 242 | if (!(modifiers 243 | & (down_modifier | drag_modifier | double_modifier | triple_modifier)) 244 | && i + 7 == SBYTES (name) && memcmp (SDATA (name) + i, "mouse-", 6) == 0 245 | && ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9')) 246 | modifiers |= click_modifier; 247 | 248 | if (!(modifiers & (double_modifier | triple_modifier)) 249 | && i + 6 < SBYTES (name) && memcmp (SDATA (name) + i, "wheel-", 6) == 0) 250 | modifiers |= click_modifier; 251 | 252 | if (modifier_end) 253 | *modifier_end = i; 254 | 255 | return modifiers; 256 | } 257 | 258 | static Lisp_Object 259 | apply_modifiers_uncached (int modifiers, char *base, int base_len, 260 | int base_len_byte) 261 | { 262 | char new_mods[sizeof "A-C-H-M-S-s-up-down-drag-double-triple-"]; 263 | int mod_len; 264 | 265 | { 266 | char *p = new_mods; 267 | 268 | if (modifiers & alt_modifier) 269 | { 270 | *p++ = 'A'; 271 | *p++ = '-'; 272 | } 273 | if (modifiers & ctrl_modifier) 274 | { 275 | *p++ = 'C'; 276 | *p++ = '-'; 277 | } 278 | if (modifiers & hyper_modifier) 279 | { 280 | *p++ = 'H'; 281 | *p++ = '-'; 282 | } 283 | if (modifiers & meta_modifier) 284 | { 285 | *p++ = 'M'; 286 | *p++ = '-'; 287 | } 288 | if (modifiers & shift_modifier) 289 | { 290 | *p++ = 'S'; 291 | *p++ = '-'; 292 | } 293 | if (modifiers & super_modifier) 294 | { 295 | *p++ = 's'; 296 | *p++ = '-'; 297 | } 298 | if (modifiers & double_modifier) 299 | p = stpcpy (p, "double-"); 300 | if (modifiers & triple_modifier) 301 | p = stpcpy (p, "triple-"); 302 | if (modifiers & up_modifier) 303 | p = stpcpy (p, "up-"); 304 | if (modifiers & down_modifier) 305 | p = stpcpy (p, "down-"); 306 | if (modifiers & drag_modifier) 307 | p = stpcpy (p, "drag-"); 308 | 309 | *p = '\0'; 310 | 311 | mod_len = p - new_mods; 312 | } 313 | 314 | { 315 | Lisp_Object new_name; 316 | 317 | new_name = make_uninit_multibyte_string (mod_len + base_len, 318 | mod_len + base_len_byte); 319 | memcpy (SDATA (new_name), new_mods, mod_len); 320 | memcpy (SDATA (new_name) + mod_len, base, base_len_byte); 321 | 322 | return Fintern (new_name, Qnil); 323 | } 324 | } 325 | 326 | static const char *const modifier_names[] 327 | = { "up", "down", "drag", "click", "double", "triple", 0, 0, 0, 0, 328 | 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 329 | 0, 0, "alt", "super", "hyper", "shift", "control", "meta" }; 330 | #define NUM_MOD_NAMES ARRAYELTS (modifier_names) 331 | 332 | static Lisp_Object modifier_symbols; 333 | 334 | static Lisp_Object 335 | lispy_modifier_list (int modifiers) 336 | { 337 | Lisp_Object modifier_list; 338 | unsigned long i; 339 | 340 | modifier_list = Qnil; 341 | for (i = 0; (1 << i) <= modifiers && i < NUM_MOD_NAMES; i++) 342 | if (modifiers & (1 << i)) 343 | modifier_list = Fcons (AREF (modifier_symbols, i), modifier_list); 344 | 345 | return modifier_list; 346 | } 347 | 348 | #define KEY_TO_CHAR(k) (XFIXNUM (k) & ((1 << CHARACTERBITS) - 1)) 349 | 350 | Lisp_Object 351 | parse_modifiers (Lisp_Object symbol) 352 | { 353 | Lisp_Object elements; 354 | 355 | if (FIXNUMP (symbol)) 356 | return list2i (KEY_TO_CHAR (symbol), XFIXNUM (symbol) & CHAR_MODIFIER_MASK); 357 | else if (!SYMBOLP (symbol)) 358 | return Qnil; 359 | 360 | elements = Fget (symbol, Qevent_symbol_element_mask); 361 | if (CONSP (elements)) 362 | return elements; 363 | else 364 | { 365 | ptrdiff_t end; 366 | int modifiers = parse_modifiers_uncached (symbol, &end); 367 | Lisp_Object unmodified; 368 | Lisp_Object mask; 369 | 370 | unmodified = Fintern (make_string (SSDATA (SYMBOL_NAME (symbol)) + end, 371 | SBYTES (SYMBOL_NAME (symbol)) - end), 372 | Qnil); 373 | 374 | if (modifiers & ~INTMASK) 375 | emacs_abort (); 376 | XSETFASTINT (mask, modifiers); 377 | elements = list2 (unmodified, mask); 378 | 379 | Fput (symbol, Qevent_symbol_element_mask, elements); 380 | Fput (symbol, Qevent_symbol_elements, 381 | Fcons (unmodified, lispy_modifier_list (modifiers))); 382 | 383 | return elements; 384 | } 385 | } 386 | 387 | static Lisp_Object 388 | apply_modifiers (int modifiers, Lisp_Object base) 389 | { 390 | Lisp_Object cache, idx, entry, new_symbol; 391 | 392 | modifiers &= INTMASK; 393 | 394 | if (FIXNUMP (base)) 395 | return make_fixnum (XFIXNUM (base) | modifiers); 396 | 397 | cache = Fget (base, Qmodifier_cache); 398 | XSETFASTINT (idx, (modifiers & ~click_modifier)); 399 | entry = assq_no_quit (idx, cache); 400 | 401 | if (CONSP (entry)) 402 | new_symbol = XCDR (entry); 403 | else 404 | { 405 | new_symbol 406 | = apply_modifiers_uncached (modifiers, SSDATA (SYMBOL_NAME (base)), 407 | SCHARS (SYMBOL_NAME (base)), 408 | SBYTES (SYMBOL_NAME (base))); 409 | 410 | entry = Fcons (idx, new_symbol); 411 | Fput (base, Qmodifier_cache, Fcons (entry, cache)); 412 | } 413 | 414 | if (NILP (Fget (new_symbol, Qevent_kind))) 415 | { 416 | Lisp_Object kind; 417 | 418 | kind = Fget (base, Qevent_kind); 419 | if (!NILP (kind)) 420 | Fput (new_symbol, Qevent_kind, kind); 421 | } 422 | 423 | return new_symbol; 424 | } 425 | 426 | Lisp_Object 427 | reorder_modifiers (Lisp_Object symbol) 428 | { 429 | Lisp_Object parsed; 430 | 431 | parsed = parse_modifiers (symbol); 432 | return apply_modifiers (XFIXNAT (XCAR (XCDR (parsed))), XCAR (parsed)); 433 | } 434 | 435 | void 436 | init_keyboard (void) 437 | { 438 | command_loop_level = -1; 439 | } 440 | 441 | void 442 | syms_of_keyboard (void) 443 | { 444 | DEFSYM (QCfilter, ":filter"); 445 | 446 | DEFSYM (Qevent_kind, "event-kind"); 447 | DEFSYM (Qevent_symbol_elements, "event-symbol-elements"); 448 | DEFSYM (Qevent_symbol_element_mask, "event-symbol-element-mask"); 449 | 450 | DEFSYM (Qmodifier_cache, "modifier-cache"); 451 | 452 | { 453 | int i; 454 | int len = ARRAYELTS (modifier_names); 455 | 456 | modifier_symbols = make_nil_vector (len); 457 | for (i = 0; i < len; i++) 458 | if (modifier_names[i]) 459 | ASET (modifier_symbols, i, intern_c_string (modifier_names[i])); 460 | staticpro (&modifier_symbols); 461 | } 462 | 463 | defsubr (&Srecursive_edit); 464 | 465 | DEFVAR_LISP ("meta-prefix-char", meta_prefix_char, 466 | doc: /* Meta-prefix character code. 467 | Meta-foo as command input turns into this character followed by foo. */); 468 | XSETINT (meta_prefix_char, 033); 469 | } 470 | -------------------------------------------------------------------------------- /src/keyboard.h: -------------------------------------------------------------------------------- 1 | #ifndef EMACS_KEYBOARD_H 2 | #define EMACS_KEYBOARD_H 3 | 4 | #define EVENT_HAS_PARAMETERS(event) CONSP (event) 5 | 6 | #define EVENT_HEAD(event) \ 7 | (EVENT_HAS_PARAMETERS (event) ? XCAR (event) : (event)) 8 | 9 | #endif 10 | -------------------------------------------------------------------------------- /src/keymap.h: -------------------------------------------------------------------------------- 1 | #ifndef KEYMAP_H 2 | #define KEYMAP_H 3 | 4 | #include "lisp.h" 5 | 6 | #define KEYMAPP(m) (!NILP (get_keymap (m, false, false))) 7 | 8 | #endif 9 | -------------------------------------------------------------------------------- /src/lua.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include "lisp.h" 4 | #include "bignum.h" 5 | #include "character.h" 6 | #include "lua.h" 7 | 8 | lua_State *_global_lua_state; 9 | bool unrecoverable_error; 10 | 11 | void 12 | _lcheckstack (lua_State *L, int n) 13 | { 14 | if (!lua_checkstack (L, lua_gettop (L) + n)) 15 | luaL_error (L, "Lua stack overflow"); 16 | } 17 | 18 | Lisp_Object 19 | userdata_to_obj (lua_State *L, int idx) 20 | { 21 | check_obj (L, idx); 22 | 23 | if (lua_islightuserdata (L, idx)) 24 | { 25 | Lisp_Object obj = (Lisp_Object) lua_touserdata (L, idx); 26 | eassert (FIXNUMP (obj)); 27 | return obj; 28 | } 29 | else 30 | { 31 | Lisp_Object obj = *(Lisp_Object *) lua_touserdata (L, idx); 32 | eassert (!FIXNUMP (obj)); 33 | return obj; 34 | } 35 | } 36 | 37 | void 38 | push_obj (lua_State *L, Lisp_Object obj) 39 | { 40 | LUALC (L, 10, 1) 41 | { 42 | if (FIXNUMP (obj)) 43 | { 44 | lua_pushlightuserdata (L, obj); 45 | set_obj_check (L, -1); 46 | return; 47 | } 48 | union 49 | { 50 | Lisp_Object l; 51 | char c[sizeof (Lisp_Object)]; 52 | } u; 53 | u.l = obj; 54 | 55 | lua_getfield (L, LUA_ENVIRONINDEX, "memtbl"); 56 | eassert (lua_istable (L, -1)); 57 | // (-1)memtbl 58 | lua_pushlstring (L, u.c, sizeof (Lisp_Object)); 59 | // (-2)memtbl, (-1)idx 60 | lua_gettable (L, -2); 61 | // (-2)memtbl, (-1)nil/obj 62 | if (lua_isuserdata (L, -1)) 63 | { 64 | // (-2)memtbl, (-1)obj 65 | Lisp_Object *ptr = (Lisp_Object *) lua_touserdata (L, -1); 66 | eassert (*ptr == obj); 67 | lua_remove (L, -2); 68 | // (-1)obj 69 | continue; 70 | } 71 | // (-2)memtbl, (-1)nil 72 | lua_pop (L, 2); 73 | // 74 | Lisp_Object *ptr 75 | = (Lisp_Object *) lua_newuserdata (L, sizeof (Lisp_Object)); 76 | *ptr = obj; 77 | // (-1)obj 78 | lua_getfield (L, LUA_ENVIRONINDEX, "memtbl"); 79 | eassert (lua_istable (L, -1)); 80 | // (-2)obj, (-1)memtbl 81 | lua_pushlstring (L, u.c, sizeof (Lisp_Object)); 82 | // (-3)obj, (-2)memtbl, (-1)idx 83 | lua_pushvalue (L, -3); 84 | // (-4)obj, (-3)memtbl, (-2)idx, (-1)obj 85 | lua_settable (L, -3); 86 | // (-2)obj, (-1)memtbl 87 | lua_pop (L, 1); 88 | // (-1)obj 89 | set_obj_check (L, -1); 90 | } 91 | } 92 | 93 | void 94 | check_nargs (lua_State *L, int nargs) 95 | { 96 | if (_global_lua_state == NULL) 97 | luaL_error (L, "Nelisp is not inited (please run " 98 | "`require('nelisp.c').init()`)"); 99 | if (unrecoverable_error) 100 | luaL_error (L, "Previous error was unrecoverable, please restart Neovim"); 101 | if (nargs != lua_gettop (L)) 102 | luaL_error (L, "Wrong number of arguments: expected %d, got %d", nargs, 103 | lua_gettop (L)); 104 | } 105 | INLINE void 106 | check_isnumber (lua_State *L, int n) 107 | { 108 | if (!lua_isnumber (L, n)) 109 | luaL_error (L, "Wrong argument #%d: expected number, got %s", n, 110 | lua_typename (L, lua_type (L, n))); 111 | } 112 | INLINE void 113 | check_isstring (lua_State *L, int n) 114 | { 115 | if (!lua_isstring (L, n)) 116 | luaL_error (L, "Wrong argument #%d: expected string, got %s", n, 117 | lua_typename (L, lua_type (L, n))); 118 | } 119 | void 120 | check_isobject (lua_State *L, int n) 121 | { 122 | if (!lua_isuserdata (L, n)) 123 | luaL_error (L, "Wrong argument #%d: expected userdata(lisp object), got %s", 124 | n, lua_typename (L, lua_type (L, n))); 125 | check_obj (L, n); 126 | } 127 | 128 | void 129 | check_istable_with_obj (lua_State *L, int n) 130 | { 131 | LUAL (L, 5) 132 | { 133 | if (!lua_istable (L, n)) 134 | luaL_error (L, "Wrong argument #%d: expected table, got %s", n, 135 | lua_typename (L, lua_type (L, n))); 136 | for (lua_pushnil (L); lua_next (L, n); lua_pop (L, 1)) 137 | { 138 | if (!lua_isuserdata (L, -1)) 139 | luaL_error (L, "Expected table of userdata(lisp objects)"); 140 | check_obj (L, -1); 141 | } 142 | } 143 | } 144 | #define Xkeyvalue() \ 145 | X (1, nil, lua_isnil, "nil") \ 146 | X (2, string, lua_isstring, "string") \ 147 | X (4, boolean, lua_isboolean, "boolean") 148 | #define X(mask, name, check, str) kv_mask_##name = mask, 149 | enum kv_mask 150 | { 151 | Xkeyvalue () 152 | }; 153 | #undef X 154 | #define X(mask, name, check, str) str " or " 155 | size_t kv_message_maxlen = sizeof (Xkeyvalue ()); 156 | #undef X 157 | struct kv_t 158 | { 159 | const char *key; 160 | enum kv_mask type; 161 | }; 162 | INLINE void 163 | check_istable_with_keyvalue (lua_State *L, int n, struct kv_t keyvalue[]) 164 | { 165 | LUAL (L, 5) 166 | { 167 | if (!lua_istable (L, n)) 168 | luaL_error (L, "Wrong argument #%d: expected table, got %s", n, 169 | lua_typename (L, lua_type (L, n))); 170 | lua_pushnil (L); 171 | for (struct kv_t *kv = keyvalue; kv->key; kv++) 172 | { 173 | lua_pop (L, 1); 174 | lua_getfield (L, -1, kv->key); 175 | if (lua_isnil (L, -1) && !(kv->type & kv_mask_nil)) 176 | luaL_error (L, "Key `%s` not set", kv->key); 177 | #define X(mask, name, check, str) \ 178 | else if (kv->type & mask && check (L, -1)) continue; 179 | if (false) 180 | ; 181 | Xkeyvalue (); 182 | #undef X 183 | char type[kv_message_maxlen]; 184 | char *p = type; 185 | #define X(mask, name, check, str) \ 186 | if (kv->type & (mask)) \ 187 | { \ 188 | memcpy (p, str, strlen (str)); \ 189 | memcpy (p + strlen (str), " or ", 4); \ 190 | p += strlen (str) + 4; \ 191 | } 192 | Xkeyvalue (); 193 | #undef X 194 | memcpy (p - 4, "\0", 1); 195 | luaL_error (L, "Expected key `%s` be %s", kv->key, type); 196 | } 197 | lua_pop (L, 1); 198 | } 199 | } 200 | 201 | thrd_t main_thread; 202 | 203 | mtx_t main_mutex; 204 | mtx_t thread_mutex; 205 | 206 | cnd_t main_cond; 207 | cnd_t thread_cond; 208 | 209 | bool tcall_error = false; 210 | void (*main_func) (void) = NULL; 211 | 212 | bool in_thread = false; 213 | 214 | void *stack_top = NULL; 215 | 216 | static void (*tcall_func_cb) (lua_State *L); 217 | INLINE void 218 | tcall_func (void) 219 | { 220 | tcall_func_cb (_global_lua_state); 221 | } 222 | void 223 | tcall (lua_State *L, void (*f) (lua_State *L), int change) 224 | { 225 | if (_global_lua_state != L) 226 | TODO; /*use lua_xmove to move between the states*/ 227 | tcall_func_cb = f; 228 | main_func = tcall_func; 229 | 230 | int top = lua_gettop (L); 231 | 232 | in_thread = true; 233 | mtx_lock (&thread_mutex); 234 | cnd_signal (&thread_cond); 235 | mtx_unlock (&thread_mutex); 236 | cnd_wait (&main_cond, &main_mutex); 237 | in_thread = false; 238 | 239 | if (tcall_error) 240 | { 241 | if (!unrecoverable_error) 242 | eassert (top + 1 == lua_gettop (L)); 243 | tcall_error = false; 244 | lua_error (_global_lua_state); 245 | } 246 | 247 | eassert (top + change == lua_gettop (L)); 248 | } 249 | 250 | void 251 | t_number_to_fixnum (lua_State *L) 252 | { 253 | Lisp_Object obj = make_fixnum (lua_tointeger (L, -1)); 254 | push_obj (L, obj); 255 | } 256 | int pub ret (/*nelisp.obj*/) number_to_fixnum (lua_State *L) 257 | { 258 | check_nargs (L, 1); 259 | check_isnumber (L, 1); 260 | tcall (L, t_number_to_fixnum, 1); 261 | return 1; 262 | } 263 | 264 | void 265 | t_number_to_float (lua_State *L) 266 | { 267 | Lisp_Object obj = make_float (lua_tonumber (L, -1)); 268 | push_obj (L, obj); 269 | } 270 | int pub ret (/*nelisp.obj*/) number_to_float (lua_State *L) 271 | { 272 | check_nargs (L, 1); 273 | check_isnumber (L, 1); 274 | tcall (L, t_number_to_float, 1); 275 | return 1; 276 | } 277 | 278 | void 279 | t_fixnum_to_number (lua_State *L) 280 | { 281 | Lisp_Object obj = userdata_to_obj (L, 1); 282 | eassert (FIXNUMP (obj)); 283 | EMACS_INT i = XFIXNUM (obj); 284 | lua_pushinteger (L, i); 285 | } 286 | int pub ret (/*number*/) fixnum_to_number (lua_State *L) 287 | { 288 | check_nargs (L, 1); 289 | check_isobject (L, 1); 290 | Lisp_Object obj = userdata_to_obj (L, 1); 291 | if (!FIXNUMP (obj)) 292 | luaL_error (L, "Expected fixnum"); 293 | tcall (L, t_fixnum_to_number, 1); 294 | return 1; 295 | } 296 | 297 | void 298 | t_float_to_number (lua_State *L) 299 | { 300 | Lisp_Object obj = userdata_to_obj (L, 1); 301 | eassert (FLOATP (obj)); 302 | double i = XFLOAT_DATA (obj); 303 | lua_pushnumber (L, i); 304 | } 305 | int pub ret (/*number*/) float_to_number (lua_State *L) 306 | { 307 | check_nargs (L, 1); 308 | check_isobject (L, 1); 309 | Lisp_Object obj = userdata_to_obj (L, 1); 310 | if (!FLOATP (obj)) 311 | luaL_error (L, "Expected float"); 312 | tcall (L, t_float_to_number, 1); 313 | return 1; 314 | } 315 | 316 | void 317 | t_string_to_unibyte_lstring (lua_State *L) 318 | { 319 | size_t len; 320 | const char *str = lua_tolstring (L, -1, &len); 321 | Lisp_Object obj = make_unibyte_string (str, len); 322 | push_obj (L, obj); 323 | } 324 | int pub ret (/*nelisp.obj*/) string_to_unibyte_lstring (lua_State *L) 325 | { 326 | check_nargs (L, 1); 327 | check_isstring (L, 1); 328 | tcall (L, t_string_to_unibyte_lstring, 1); 329 | return 1; 330 | } 331 | 332 | void 333 | t_unibyte_lstring_to_string (lua_State *L) 334 | { 335 | Lisp_Object obj = userdata_to_obj (L, 1); 336 | eassert (STRINGP (obj) && !STRING_MULTIBYTE (obj)); 337 | const char *str = (const char *) SDATA (obj); 338 | lua_pushlstring (L, str, SBYTES (obj)); 339 | } 340 | int pub ret (/*string*/) unibyte_lstring_to_string (lua_State *L) 341 | { 342 | check_nargs (L, 1); 343 | check_isobject (L, 1); 344 | Lisp_Object obj = userdata_to_obj (L, 1); 345 | if (!STRINGP (obj) || STRING_MULTIBYTE (obj)) 346 | luaL_error (L, "Expected unibyte string"); 347 | tcall (L, t_unibyte_lstring_to_string, 1); 348 | return 1; 349 | } 350 | 351 | void 352 | t_cons_to_table (lua_State *L) 353 | { 354 | Lisp_Object obj = userdata_to_obj (L, 1); 355 | eassert (CONSP (obj)); 356 | Lisp_Object car = XCAR (obj); 357 | Lisp_Object cdr = XCDR (obj); 358 | lua_newtable (L); 359 | // (-1)tbl 360 | push_obj (L, car); 361 | // (-2)tbl,(-1)car 362 | lua_rawseti (L, -2, 1); 363 | // (-1)tbl 364 | push_obj (L, cdr); 365 | // (-2)tbl,(-1)cdr 366 | lua_rawseti (L, -2, 2); 367 | // (-1)tbl 368 | } 369 | int pub ret (/*[nelisp.obj,nelisp.obj]*/) cons_to_table (lua_State *L) 370 | { 371 | check_nargs (L, 1); 372 | check_isobject (L, 1); 373 | Lisp_Object obj = userdata_to_obj (L, 1); 374 | if (!CONSP (obj)) 375 | luaL_error (L, "Expected cons"); 376 | tcall (L, t_cons_to_table, 1); 377 | return 1; 378 | } 379 | 380 | void 381 | t_vector_to_table (lua_State *L) 382 | { 383 | Lisp_Object obj = userdata_to_obj (L, 1); 384 | eassert (VECTORP (obj)); 385 | lua_newtable (L); 386 | // (-1)tbl 387 | ptrdiff_t len = ASIZE (obj); 388 | for (ptrdiff_t i = 0; i < len; i++) 389 | { 390 | // (-1)tbl 391 | push_obj (L, XVECTOR (obj)->contents[i]); 392 | // (-2)tbl,(-1)obj 393 | lua_rawseti (L, -2, i + 1); 394 | // (-1)tbl 395 | }; 396 | // (-1)tbl 397 | } 398 | int pub ret (/*nelisp.obj[]*/) vector_to_table (lua_State *L) 399 | { 400 | check_nargs (L, 1); 401 | check_isobject (L, 1); 402 | Lisp_Object obj = userdata_to_obj (L, 1); 403 | if (!VECTORP (obj)) 404 | luaL_error (L, "Expected vector"); 405 | tcall (L, t_vector_to_table, 1); 406 | return 1; 407 | } 408 | 409 | void 410 | t__get_symbol (lua_State *L) 411 | { 412 | for (unsigned long i = 0; i < ARRAYELTS (lispsym); i++) 413 | { 414 | size_t len; 415 | lua_tolstring (L, -1, &len); 416 | if (memcmp (lua_tolstring (L, -1, &len), defsym_name[i], len + 1) == 0) 417 | { 418 | push_obj (L, builtin_lisp_symbol (i)); 419 | return; 420 | } 421 | } 422 | lua_pushnil (L); 423 | } 424 | int pub ret (/*nelisp.obj*/) _get_symbol (lua_State *L) 425 | { 426 | check_nargs (L, 1); 427 | check_isstring (L, 1); 428 | tcall (L, t__get_symbol, 1); 429 | if (lua_isnil (L, -1)) 430 | luaL_error (L, "Symbol '%s' not found", lua_tostring (L, 1)); 431 | return 1; 432 | } 433 | 434 | void 435 | t_eval (lua_State *L) 436 | { 437 | specpdl_ref count = SPECPDL_INDEX (); 438 | size_t len; 439 | Lisp_Object lex_bound; 440 | const char *str = lua_tolstring (L, -1, &len); 441 | 442 | specbind (Qlexical_binding, Qnil); 443 | 444 | Lisp_Object readcharfun = make_unibyte_string (str, len); 445 | 446 | read_from_string_index = 0; 447 | read_from_string_index_byte = string_char_to_byte (readcharfun, 0); 448 | read_from_string_limit = len; 449 | 450 | if (lisp_file_lexical_cookie (readcharfun) == Cookie_Lex) 451 | Fset (Qlexical_binding, Qt); 452 | 453 | Lisp_Object ret = NULL; 454 | while (1) 455 | { 456 | int c = READCHAR; 457 | if (c == ';') 458 | { 459 | while ((c = READCHAR) != '\n' && c != -1) 460 | ; 461 | continue; 462 | } 463 | if (c < 0) 464 | { 465 | break; 466 | } 467 | if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r' 468 | || c == NO_BREAK_SPACE) 469 | continue; 470 | UNREAD (c); 471 | lex_bound = find_symbol_value (Qlexical_binding); 472 | specbind (Qinternal_interpreter_environment, 473 | (NILP (lex_bound) || BASE_EQ (lex_bound, Qunbound) 474 | ? Qnil 475 | : list1 (Qt))); 476 | Lisp_Object val = read0 (readcharfun, false); 477 | ret = eval_sub (val); 478 | } 479 | if (ret) 480 | push_obj (L, ret); 481 | else 482 | lua_pushnil (L); 483 | unbind_to (count, Qnil); 484 | } 485 | int pub ret (/*nelisp.obj|nil*/) eval (lua_State *L) 486 | { 487 | check_nargs (L, 1); 488 | check_isstring (L, 1); 489 | tcall (L, t_eval, 1); 490 | return 1; 491 | } 492 | 493 | void 494 | t_collectgarbage (lua_State *L) 495 | { 496 | UNUSED (L); 497 | garbage_collect (); 498 | } 499 | int pub 500 | ret () collectgarbage (lua_State *L) 501 | { 502 | check_nargs (L, 0); 503 | tcall (L, t_collectgarbage, 0); 504 | return 0; 505 | } 506 | 507 | static bool 508 | is_directory (const char *dir) 509 | { 510 | struct stat st; 511 | if (stat (dir, &st) != 0) 512 | return false; 513 | return S_ISDIR (st.st_mode); 514 | } 515 | bool inited = false; 516 | int 517 | t_init (void *args) 518 | { 519 | (void) args; 520 | stack_top = &args; 521 | Frecursive_edit (); 522 | eassume (false); 523 | } 524 | int pub 525 | ret () init (lua_State *L) 526 | { 527 | _global_lua_state = L; 528 | check_nargs (L, 1); 529 | check_istable_with_keyvalue (L, 1, 530 | (struct kv_t[]) { 531 | { "runtime_path", kv_mask_string }, 532 | { NULL, 0 } }); 533 | if (inited) 534 | return 0; 535 | inited = true; 536 | 537 | _lcheckstack (L, 10); 538 | lua_getfield (L, -1, "runtime_path"); 539 | size_t len; 540 | const char *dir = lua_tolstring (L, -1, &len); 541 | if (memchr (dir, '\0', len) != NULL) 542 | luaL_error (L, "runtime_path contains a null byte"); 543 | if (!is_directory (dir)) 544 | luaL_error (L, "runtime_path is not a directory"); 545 | 546 | lua_pushvalue (L, -1); 547 | lua_pushliteral (L, "/lisp/"); 548 | lua_concat (L, 2); 549 | size_t len_lisp_dir; 550 | const char *lisp_dir = lua_tolstring (L, -1, &len_lisp_dir); 551 | if (!is_directory (lisp_dir)) 552 | luaL_error (L, "runtime_path directory doesn't have subdirectory `lisp/`"); 553 | 554 | lua_pushvalue (L, -2); 555 | lua_remove (L, -3); 556 | lua_pushliteral (L, "/etc/"); 557 | lua_concat (L, 2); 558 | size_t len_data_dir; 559 | const char *data_dir = lua_tolstring (L, -1, &len_data_dir); 560 | if (!is_directory (data_dir)) 561 | luaL_error (L, "runtime_path directory doesn't have subdirectory `lisp/`"); 562 | 563 | if (!lua_pushthread (L)) 564 | luaL_error (L, "nelisp init needs to be called from main thread"); 565 | // TODO: Maybe we should create a separate lua-thread? 566 | // Is there any reason global_lua_state needs to be main thread? 567 | // Well there's errors. 568 | lua_pop (L, 1); 569 | 570 | init_alloc_once (); 571 | init_eval_once (); 572 | init_obarray_once (); 573 | init_casetab_once (); 574 | init_charset_once (); 575 | init_syntax_once (); 576 | init_coding_once (); 577 | 578 | Vload_path = list1 (make_unibyte_string (lisp_dir, len_lisp_dir)); 579 | Vdata_directory = make_unibyte_string (data_dir, len_data_dir); 580 | 581 | syms_of_lread (); 582 | syms_of_data (); 583 | syms_of_alloc (); 584 | syms_of_eval (); 585 | syms_of_fns (); 586 | syms_of_keyboard (); 587 | syms_of_editfns (); 588 | syms_of_emacs (); 589 | syms_of_fileio (); 590 | syms_of_buffer (); 591 | syms_of_bytecode (); 592 | syms_of_doc (); 593 | syms_of_charset (); 594 | syms_of_chartab (); 595 | syms_of_keymap (); 596 | syms_of_character (); 597 | syms_of_process (); 598 | syms_of_casetab (); 599 | syms_of_search (); 600 | syms_of_xdisp (); 601 | syms_of_print (); 602 | syms_of_timefns (); 603 | syms_of_callproc (); 604 | syms_of_display (); 605 | syms_of_casefiddle (); 606 | syms_of_syntax (); 607 | syms_of_ccl (); 608 | syms_of_coding (); // after charset 609 | syms_of_textprop (); 610 | syms_of_xfaces (); 611 | 612 | init_keyboard (); 613 | init_eval (); 614 | running_asynch_code = false; 615 | init_buffer (); 616 | init_bytecode (); 617 | init_bignum (); 618 | init_lread (); 619 | init_charset (); 620 | 621 | build_details = true; 622 | noninteractive = false; 623 | 624 | bool err = false; 625 | if (mtx_init (&main_mutex, mtx_plain) != thrd_success) 626 | err = true; 627 | if (mtx_init (&thread_mutex, mtx_plain) != thrd_success) 628 | err = true; 629 | if (cnd_init (&main_cond) != thrd_success) 630 | err = true; 631 | if (cnd_init (&thread_cond) != thrd_success) 632 | err = true; 633 | if (err) 634 | { 635 | unrecoverable_error = true; 636 | luaL_error (L, "Failed to init thread"); 637 | } 638 | 639 | in_thread = true; 640 | mtx_lock (&main_mutex); 641 | thrd_create (&main_thread, t_init, NULL); 642 | cnd_wait (&main_cond, &main_mutex); 643 | in_thread = false; 644 | 645 | return 0; 646 | } 647 | -------------------------------------------------------------------------------- /src/lua.h: -------------------------------------------------------------------------------- 1 | #ifndef LUA_H 2 | #define LUA_H 3 | 4 | #include "lisp.h" 5 | 6 | struct _lua_assertchange 7 | { 8 | struct lua_State *state; 9 | int change; 10 | char *file; 11 | int line; 12 | }; 13 | 14 | __attribute__ ((always_inline)) INLINE void 15 | _lua_assertchange (struct _lua_assertchange *assertchange) 16 | { 17 | TODO_NELISP_LATER; 18 | if (lua_gettop (assertchange->state) != assertchange->change) 19 | TODO_ (assertchange->file, assertchange->line); 20 | } 21 | 22 | // Sets the variable `L` to the global lua-state. 23 | // The lua-state stack capacity is grown by stack.top+{n} elements. 24 | // Asserts that the lua-state stack didn't change after run. 25 | #define LUA(n) LUAC (n, 0) 26 | 27 | // {L} is the lua-state to be used. 28 | // The lua-state stack capacity is grown by stack.top+{n} elements. 29 | // Asserts that the lua-state stack didn't change after run. 30 | #define LUAL(L, n) LUALC (L, n, 0) 31 | 32 | // Sets the variable `L` to the global lua-state. 33 | // The lua-state stack capacity is grown by stack.top+{n} elements. 34 | // Asserts that the lua-state stack changed by {change} 35 | #define LUAC(n, change) \ 36 | LUALC (_global_lua_state, n, change) \ 37 | for (lua_State *L = _global_lua_state; run; run = 0) 38 | 39 | // {L} is the lua-state to be used. 40 | // The lua-state stack capacity is grown by stack.top+{n} elements. 41 | // Asserts that the lua-state stack changed by {change} 42 | #define LUALC(L, n, change) \ 43 | for (int _top = (STATIC_ASSERT (n > 0, n_needs_to_be_positive), \ 44 | _lcheckstack (L, n), lua_gettop (L) + change), \ 45 | run = 1; \ 46 | run; run = 0) \ 47 | for (__attribute__ ((unused, \ 48 | cleanup ( \ 49 | _lua_assertchange))) struct _lua_assertchange \ 50 | _assertchange \ 51 | = { L, _top, __FILE__, __LINE__ }; \ 52 | run; run = 0) 53 | 54 | #endif 55 | -------------------------------------------------------------------------------- /src/nvim.c: -------------------------------------------------------------------------------- 1 | #include "nvim.h" 2 | #include "lisp.h" 3 | #include "buffer.h" 4 | #include "lua.h" 5 | 6 | static void 7 | push_vim_api (lua_State *L, const char *name) 8 | { 9 | LUALC (L, 5, 1) 10 | { 11 | lua_getglobal (L, "vim"); 12 | lua_getfield (L, -1, "api"); 13 | lua_remove (L, -2); 14 | lua_getfield (L, -1, name); 15 | lua_remove (L, -2); 16 | eassert (lua_isfunction (L, -1)); 17 | } 18 | } 19 | 20 | static void 21 | push_vim_fn (lua_State *L, const char *name) 22 | { 23 | LUALC (L, 5, 1) 24 | { 25 | lua_getglobal (L, "vim"); 26 | lua_getfield (L, -1, "fn"); 27 | lua_remove (L, -2); 28 | lua_getfield (L, -1, name); 29 | lua_remove (L, -2); 30 | eassert (lua_isfunction (L, -1)); 31 | } 32 | } 33 | 34 | static void 35 | push_vim_b (lua_State *L, long bufid) 36 | { 37 | LUALC (L, 5, 1) 38 | { 39 | lua_getglobal (L, "vim"); 40 | lua_getfield (L, -1, "b"); 41 | lua_remove (L, -2); 42 | lua_pushnumber (L, bufid); 43 | lua_gettable (L, -2); 44 | lua_remove (L, -2); 45 | eassert (lua_istable (L, -1)); 46 | } 47 | } 48 | 49 | static Lisp_Object 50 | create_buffer (long bufid) 51 | { 52 | register Lisp_Object buffer; 53 | register struct buffer *b; 54 | b = allocate_buffer (); 55 | 56 | b->_local_var_alist = Qnil; 57 | b->_last_obj = Qnil; 58 | b->_downcase_table = Vascii_downcase_table; 59 | b->_upcase_table = XCHAR_TABLE (Vascii_downcase_table)->extras[0]; 60 | b->_case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; 61 | b->_case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; 62 | 63 | b->bufid = bufid; 64 | 65 | #if TODO_NELISP_LATER_ELSE 66 | b->_syntax_table = BVAR (&buffer_defaults, syntax_table); 67 | #endif 68 | 69 | XSETBUFFER (buffer, b); 70 | return buffer; 71 | } 72 | 73 | Lisp_Object 74 | nvim_bufid_to_bufobj (long bufid) 75 | { 76 | Lisp_Object obj; 77 | LUA (10) 78 | { 79 | lua_getfield (L, LUA_ENVIRONINDEX, "buftbl"); 80 | eassert (lua_istable (L, -1)); 81 | // buftbl 82 | push_vim_b (L, bufid); 83 | // buftbl, vim.b 84 | lua_getfield (L, -1, "nelisp_reference"); 85 | // buftbl, vim.b, nil/nelisp_reference 86 | if (!lua_isnil (L, -1)) 87 | { 88 | eassert (lua_isfunction (L, -1)); 89 | lua_gettable (L, -3); 90 | // buftbl, vim.b, userdata 91 | obj = userdata_to_obj (L, -1); 92 | lua_pop (L, 1); 93 | goto done; 94 | } 95 | lua_pop (L, 1); 96 | // buftbl, vim.b 97 | luaL_dostring (L, "return function() end"); 98 | // buftbl, vim.b, nelisp_reference 99 | lua_pushvalue (L, -1); 100 | // buftbl, vim.b, nelisp_reference, nelisp_reference 101 | lua_setfield (L, -3, "nelisp_reference"); 102 | // buftbl, vim.b, nelisp_reference 103 | obj = create_buffer (bufid); 104 | push_obj (L, obj); 105 | // buftbl, vim.b, nelisp_reference, obj 106 | lua_settable (L, -4); 107 | done: 108 | // buftbl, vim.b 109 | lua_pop (L, 2); 110 | } 111 | return obj; 112 | } 113 | 114 | Lisp_Object 115 | nvim_name_to_bufobj (Lisp_Object name) 116 | { 117 | long bufid; 118 | CHECK_STRING (name); 119 | LUA (5) 120 | { 121 | push_vim_fn (L, "bufnr"); 122 | lua_pushlstring (L, (char *) SDATA (name), SBYTES (name)); 123 | lua_call (L, 1, 1); 124 | eassert (lua_isnumber (L, -1)); 125 | bufid = lua_tointeger (L, -1); 126 | lua_pop (L, 1); 127 | } 128 | if (bufid == -1) 129 | return Qnil; 130 | return nvim_bufid_to_bufobj (bufid); 131 | } 132 | 133 | Lisp_Object 134 | nvim_create_buf (Lisp_Object name, Lisp_Object inhibit_buffer_hooks) 135 | { 136 | long bufid; 137 | UNUSED (inhibit_buffer_hooks); 138 | CHECK_STRING (name); 139 | eassert (NILP (nvim_name_to_bufobj (name))); 140 | LUA (10) 141 | { 142 | push_vim_api (L, "nvim_create_buf"); 143 | lua_pushboolean (L, true); 144 | lua_pushboolean (L, true); 145 | lua_call (L, 2, 1); 146 | push_vim_api (L, "nvim_buf_set_name"); 147 | lua_pushvalue (L, -2); 148 | lua_pushlstring (L, (char *) SDATA (name), SBYTES (name)); 149 | lua_call (L, 2, 0); 150 | eassert (lua_isnumber (L, -1)); 151 | bufid = lua_tointeger (L, -1); 152 | lua_pop (L, 1); 153 | } 154 | return nvim_bufid_to_bufobj (bufid); 155 | } 156 | 157 | static Lisp_Object 158 | buffer_name (struct buffer *b) 159 | { 160 | long bufid = b->bufid; 161 | Lisp_Object obj = Qnil; 162 | LUA (5) 163 | { 164 | push_vim_api (L, "nvim_buf_is_valid"); 165 | lua_pushnumber (L, bufid); 166 | lua_call (L, 1, 1); 167 | eassert (lua_isboolean (L, -1)); 168 | if (!lua_toboolean (L, -1)) 169 | goto done; 170 | push_vim_fn (L, "bufname"); 171 | lua_pushnumber (L, bufid); 172 | lua_call (L, 1, 1); 173 | eassert (lua_isstring (L, -1)); 174 | TODO_NELISP_LATER; // the returned string should always be the same until 175 | // name changed 176 | size_t len; 177 | const char *name = lua_tolstring (L, -1, &len); 178 | obj = make_string (name, len); 179 | lua_pop (L, 1); 180 | done: 181 | lua_pop (L, 1); 182 | } 183 | return obj; 184 | } 185 | 186 | Lisp_Object 187 | nvim_bvar (struct buffer *b, enum nvim_buffer_var_field field) 188 | { 189 | switch (field) 190 | { 191 | case NVIM_BUFFER_VAR__name: 192 | return buffer_name (b); 193 | #define X(field) \ 194 | case NVIM_BUFFER_VAR_##field: \ 195 | return b->field; 196 | Xbuffer_vars 197 | #undef X 198 | default : emacs_abort (); 199 | } 200 | } 201 | 202 | void 203 | nvim_set_buffer (struct buffer *b) 204 | { 205 | eassert (BUFFER_LIVE_P (b)); 206 | LUA (5) 207 | { 208 | push_vim_api (L, "nvim_set_current_buf"); 209 | lua_pushnumber (L, b->bufid); 210 | lua_call (L, 1, 0); 211 | } 212 | } 213 | 214 | struct buffer * 215 | nvim_current_buffer (void) 216 | { 217 | long bufid; 218 | LUA (5) 219 | { 220 | push_vim_api (L, "nvim_get_current_buf"); 221 | lua_call (L, 0, 1); 222 | eassert (lua_isnumber (L, -1)); 223 | bufid = lua_tointeger (L, -1); 224 | lua_pop (L, 1); 225 | } 226 | return XBUFFER (nvim_bufid_to_bufobj (bufid)); 227 | } 228 | 229 | ptrdiff_t 230 | nvim_get_field_zv (struct buffer *b, bool chars) 231 | { 232 | eassert (BUFFER_LIVE_P (b)); 233 | long bufid = b->bufid; 234 | ptrdiff_t zv; 235 | LUA (10) 236 | { 237 | push_vim_api (L, "nvim_buf_call"); 238 | lua_pushnumber (L, bufid); 239 | push_vim_fn (L, "wordcount"); 240 | lua_call (L, 2, 1); 241 | if (chars) 242 | lua_getfield (L, -1, "chars"); 243 | else 244 | lua_getfield (L, -1, "bytes"); 245 | eassert (lua_isnumber (L, -1)); 246 | zv = lua_tointeger (L, -1); 247 | zv = zv + 1; 248 | lua_pop (L, 2); 249 | } 250 | return zv; 251 | } 252 | 253 | ptrdiff_t 254 | nvim_get_field_begv (struct buffer *b, bool chars) 255 | { 256 | eassert (BUFFER_LIVE_P (b)); 257 | UNUSED (chars); 258 | return 1; 259 | } 260 | 261 | struct pos 262 | { 263 | ptrdiff_t row; 264 | ptrdiff_t col; 265 | }; 266 | 267 | struct pos 268 | nvim_buf_byte1_to_pos0 (ptrdiff_t byte1) 269 | { 270 | // NOTE: if ever changed to accept buffer as argument, need to temp set that 271 | // buffer 272 | struct pos pos; 273 | eassert (byte1 >= 1); 274 | ptrdiff_t byte = byte1 - 1; 275 | if (byte == 0) 276 | { 277 | pos.row = 0; 278 | pos.col = 0; 279 | return pos; 280 | } 281 | LUA (10) 282 | { 283 | push_vim_fn (L, "line2byte"); 284 | push_vim_fn (L, "byte2line"); 285 | lua_pushinteger (L, byte); 286 | lua_call (L, 1, 1); 287 | eassert (lua_isnumber (L, -1)); 288 | eassert (lua_tointeger (L, -1) != -1); 289 | pos.row = lua_tointeger (L, -1); 290 | lua_call (L, 1, 1); 291 | eassert (lua_isnumber (L, -1)); 292 | eassert (lua_tointeger (L, -1) != -1); 293 | pos.col = lua_tointeger (L, -1); 294 | lua_pop (L, 1); 295 | push_vim_fn (L, "getline"); 296 | lua_pushnumber (L, pos.row); 297 | lua_call (L, 1, 1); 298 | eassert (lua_isstring (L, -1)); 299 | ptrdiff_t len = lua_objlen (L, -1); 300 | lua_pop (L, 1); 301 | if (pos.col > len) 302 | { 303 | pos.col = 0; 304 | pos.row++; 305 | } 306 | } 307 | return pos; 308 | } 309 | 310 | void 311 | nvim_buf_memcpy (unsigned char *dst, ptrdiff_t beg1, ptrdiff_t size) 312 | { 313 | eassert (1 <= beg1); 314 | ptrdiff_t end1 = size + beg1; 315 | eassert (end1 <= ZV_BYTE); 316 | 317 | struct pos start_pos = nvim_buf_byte1_to_pos0 (beg1); 318 | struct pos end_pos = nvim_buf_byte1_to_pos0 (end1); 319 | 320 | long bufid = current_buffer->bufid; 321 | LUA (10) 322 | { 323 | lua_getglobal (L, "table"); 324 | lua_getfield (L, -1, "concat"); 325 | lua_remove (L, -2); 326 | push_vim_api (L, "nvim_buf_get_text"); 327 | lua_pushnumber (L, bufid); 328 | lua_pushnumber (L, start_pos.row); 329 | lua_pushnumber (L, start_pos.col); 330 | if (end1 == ZV_BYTE) 331 | { 332 | // neovim automatically adds a newline at the end of the buffer, 333 | // but the api doesn't recognize this extra character, 334 | // so we need to get one less char and then append the newline. 335 | lua_pushnumber (L, end_pos.row - 1); 336 | lua_pushnumber (L, -1); 337 | } 338 | else 339 | { 340 | lua_pushnumber (L, end_pos.row); 341 | lua_pushnumber (L, end_pos.col); 342 | } 343 | lua_newtable (L); 344 | lua_call (L, 6, 1); 345 | eassert (lua_istable (L, -1)); 346 | lua_pushliteral (L, "\n"); 347 | lua_call (L, 2, 1); 348 | if (end1 == ZV_BYTE) 349 | { 350 | lua_pushliteral (L, "\n"); 351 | lua_concat (L, 2); 352 | } 353 | eassert (lua_objlen (L, -1) == (unsigned long) size); 354 | const char *text = lua_tostring (L, -1); 355 | memcpy (dst, text, size); 356 | lua_pop (L, 1); 357 | } 358 | } 359 | -------------------------------------------------------------------------------- /src/nvim.h: -------------------------------------------------------------------------------- 1 | #ifndef NVIM_H 2 | #define NVIM_H 3 | 4 | #include "lisp.h" 5 | 6 | #define Xbuffer_vars \ 7 | X (_local_var_alist) \ 8 | X (_downcase_table) \ 9 | X (_upcase_table) \ 10 | X (_case_canon_table) \ 11 | X (_case_eqv_table) \ 12 | X (_syntax_table) 13 | 14 | struct buffer 15 | { 16 | union vectorlike_header header; 17 | 18 | #define X(field) Lisp_Object field; 19 | Xbuffer_vars 20 | #undef X 21 | 22 | Lisp_Object _last_obj; 23 | 24 | long bufid; 25 | }; 26 | 27 | enum nvim_buffer_var_field 28 | { 29 | NVIM_BUFFER_VAR__name, 30 | #define X(field) NVIM_BUFFER_VAR_##field, 31 | Xbuffer_vars 32 | #undef X 33 | }; 34 | 35 | extern Lisp_Object nvim_name_to_bufobj (Lisp_Object); 36 | extern Lisp_Object nvim_create_buf (Lisp_Object, Lisp_Object); 37 | extern Lisp_Object nvim_bvar (struct buffer *, enum nvim_buffer_var_field); 38 | extern void nvim_set_buffer (struct buffer *); 39 | extern struct buffer *nvim_current_buffer (void); 40 | 41 | extern ptrdiff_t nvim_get_field_zv (struct buffer *b, bool chars); 42 | extern ptrdiff_t nvim_get_field_begv (struct buffer *b, bool chars); 43 | 44 | extern void nvim_buf_memcpy (unsigned char *dst, ptrdiff_t beg, ptrdiff_t size); 45 | 46 | #endif 47 | -------------------------------------------------------------------------------- /src/process.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | 3 | void 4 | syms_of_process (void) 5 | { 6 | DEFSYM (QCname, ":name"); 7 | } 8 | -------------------------------------------------------------------------------- /src/puresize.h: -------------------------------------------------------------------------------- 1 | #ifndef EMACS_PURESIZE_H 2 | #define EMACS_PURESIZE_H 3 | 4 | #include "lisp.h" 5 | 6 | #define SYSTEM_PURESIZE_EXTRA 0 7 | #define SITELOAD_PURESIZE_EXTRA 0 8 | #define BASE_PURESIZE \ 9 | (3400000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) 10 | #define PURESIZE (BASE_PURESIZE * PURESIZE_RATIO * PURESIZE_CHECKING_RATIO) 11 | #define PURESIZE_RATIO 10 / 6 12 | #define PURESIZE_CHECKING_RATIO 1 13 | extern EMACS_INT pure[]; 14 | 15 | #define puresize_h_PURE_P(ptr) \ 16 | ((uintptr_t) (ptr) - (uintptr_t) pure <= PURESIZE) 17 | #define PURE_P(ptr) puresize_h_PURE_P (ptr) 18 | 19 | #endif 20 | -------------------------------------------------------------------------------- /src/regex-emacs.h: -------------------------------------------------------------------------------- 1 | #ifndef EMACS_REGEX_H 2 | #define EMACS_REGEX_H 1 3 | 4 | #include "lisp.h" 5 | 6 | extern Lisp_Object re_match_object; 7 | 8 | struct re_registers 9 | { 10 | ptrdiff_t num_regs; 11 | ptrdiff_t *start; 12 | ptrdiff_t *end; 13 | }; 14 | 15 | struct re_pattern_buffer 16 | { 17 | unsigned char *buffer; 18 | 19 | ptrdiff_t allocated; 20 | 21 | ptrdiff_t used; 22 | 23 | int charset_unibyte; 24 | 25 | char *fastmap; 26 | 27 | Lisp_Object translate; 28 | 29 | ptrdiff_t re_nsub; 30 | 31 | bool_bf can_be_null : 1; 32 | 33 | unsigned regs_allocated : 2; 34 | 35 | bool_bf fastmap_accurate : 1; 36 | 37 | bool_bf used_syntax : 1; 38 | 39 | bool_bf multibyte : 1; 40 | 41 | bool_bf target_multibyte : 1; 42 | }; 43 | 44 | typedef enum 45 | { 46 | RECC_ERROR = 0, 47 | RECC_ALNUM, 48 | RECC_ALPHA, 49 | RECC_WORD, 50 | RECC_GRAPH, 51 | RECC_PRINT, 52 | RECC_LOWER, 53 | RECC_UPPER, 54 | RECC_PUNCT, 55 | RECC_CNTRL, 56 | RECC_DIGIT, 57 | RECC_XDIGIT, 58 | RECC_BLANK, 59 | RECC_SPACE, 60 | RECC_MULTIBYTE, 61 | RECC_NONASCII, 62 | RECC_ASCII, 63 | RECC_UNIBYTE, 64 | RECC_NUM_CLASSES = RECC_UNIBYTE 65 | } re_wctype_t; 66 | 67 | extern const char *re_compile_pattern (const char *pattern, ptrdiff_t length, 68 | bool posix_backtracking, 69 | const char *whitespace_regexp, 70 | struct re_pattern_buffer *buffer); 71 | 72 | extern ptrdiff_t re_search (struct re_pattern_buffer *buffer, 73 | const char *string, ptrdiff_t length, 74 | ptrdiff_t start, ptrdiff_t range, 75 | struct re_registers *regs); 76 | 77 | extern ptrdiff_t re_search_2 (struct re_pattern_buffer *buffer, 78 | const char *string1, ptrdiff_t length1, 79 | const char *string2, ptrdiff_t length2, 80 | ptrdiff_t start, ptrdiff_t range, 81 | struct re_registers *regs, ptrdiff_t stop); 82 | 83 | extern void re_set_registers (struct re_pattern_buffer *buffer, 84 | struct re_registers *regs, ptrdiff_t num_regs, 85 | ptrdiff_t *starts, ptrdiff_t *ends); 86 | 87 | #endif 88 | -------------------------------------------------------------------------------- /src/search.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | #include "buffer.h" 3 | #include "charset.h" 4 | #include "regex-emacs.h" 5 | 6 | #define REGEXP_CACHE_SIZE 20 7 | 8 | struct regexp_cache 9 | { 10 | struct regexp_cache *next; 11 | Lisp_Object regexp, f_whitespace_regexp; 12 | Lisp_Object syntax_table; 13 | struct re_pattern_buffer buf; 14 | char fastmap[0400]; 15 | bool posix; 16 | bool busy; 17 | }; 18 | 19 | static struct regexp_cache searchbufs[REGEXP_CACHE_SIZE]; 20 | 21 | static struct regexp_cache *searchbuf_head; 22 | 23 | Lisp_Object re_match_object; 24 | 25 | static AVOID 26 | matcher_overflow (void) 27 | { 28 | error ("Stack overflow in regexp matcher"); 29 | } 30 | 31 | static void 32 | compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern, 33 | Lisp_Object translate, bool posix) 34 | { 35 | const char *whitespace_regexp; 36 | char *val; 37 | 38 | eassert (!cp->busy); 39 | cp->regexp = Qnil; 40 | cp->buf.translate = translate; 41 | cp->posix = posix; 42 | cp->buf.multibyte = STRING_MULTIBYTE (pattern); 43 | cp->buf.charset_unibyte = charset_unibyte; 44 | if (STRINGP (Vsearch_spaces_regexp)) 45 | cp->f_whitespace_regexp = Vsearch_spaces_regexp; 46 | else 47 | cp->f_whitespace_regexp = Qnil; 48 | 49 | whitespace_regexp 50 | = STRINGP (Vsearch_spaces_regexp) ? SSDATA (Vsearch_spaces_regexp) : NULL; 51 | 52 | val = (char *) re_compile_pattern (SSDATA (pattern), SBYTES (pattern), posix, 53 | whitespace_regexp, &cp->buf); 54 | 55 | cp->syntax_table = cp->buf.used_syntax ? (TODO, Qt) : Qt; 56 | 57 | if (val) 58 | xsignal1 (Qinvalid_regexp, build_string (val)); 59 | 60 | cp->regexp = Fcopy_sequence (pattern); 61 | } 62 | 63 | static struct regexp_cache * 64 | compile_pattern (Lisp_Object pattern, struct re_registers *regp, 65 | Lisp_Object translate, bool posix, bool multibyte) 66 | { 67 | struct regexp_cache *cp, **cpp, **lru_nonbusy; 68 | 69 | for (cpp = &searchbuf_head, lru_nonbusy = NULL;; cpp = &cp->next) 70 | { 71 | cp = *cpp; 72 | if (!cp->busy) 73 | lru_nonbusy = cpp; 74 | if (NILP (cp->regexp)) 75 | goto compile_it; 76 | if (SCHARS (cp->regexp) == SCHARS (pattern) && !cp->busy 77 | && STRING_MULTIBYTE (cp->regexp) == STRING_MULTIBYTE (pattern) 78 | && !NILP (Fstring_equal (cp->regexp, pattern)) 79 | && BASE_EQ (cp->buf.translate, translate) && cp->posix == posix 80 | && (BASE_EQ (cp->syntax_table, Qt) || (TODO, false)) 81 | && !NILP (Fequal (cp->f_whitespace_regexp, Vsearch_spaces_regexp)) 82 | && cp->buf.charset_unibyte == charset_unibyte) 83 | break; 84 | 85 | if (cp->next == 0) 86 | { 87 | if (!lru_nonbusy) 88 | error ("Too much matching reentrancy"); 89 | cpp = lru_nonbusy; 90 | cp = *cpp; 91 | compile_it: 92 | eassert (!cp->busy); 93 | compile_pattern_1 (cp, pattern, translate, posix); 94 | break; 95 | } 96 | } 97 | 98 | *cpp = cp->next; 99 | cp->next = searchbuf_head; 100 | searchbuf_head = cp; 101 | 102 | if (regp) 103 | re_set_registers (&cp->buf, regp, regp->num_regs, regp->start, regp->end); 104 | 105 | cp->buf.target_multibyte = multibyte; 106 | return cp; 107 | } 108 | 109 | static void 110 | unfreeze_pattern (void *arg) 111 | { 112 | struct regexp_cache *searchbuf = arg; 113 | searchbuf->busy = false; 114 | } 115 | 116 | static void 117 | freeze_pattern (struct regexp_cache *searchbuf) 118 | { 119 | eassert (!searchbuf->busy); 120 | record_unwind_protect_ptr (unfreeze_pattern, searchbuf); 121 | searchbuf->busy = true; 122 | } 123 | 124 | static Lisp_Object 125 | string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, 126 | bool posix, bool modify_data) 127 | { 128 | ptrdiff_t val; 129 | EMACS_INT pos; 130 | ptrdiff_t pos_byte, i; 131 | bool modify_match_data = NILP (Vinhibit_changing_match_data) && modify_data; 132 | 133 | if (running_asynch_code) 134 | TODO; // save_search_regs (); 135 | 136 | CHECK_STRING (regexp); 137 | CHECK_STRING (string); 138 | 139 | if (NILP (start)) 140 | pos = 0, pos_byte = 0; 141 | else 142 | { 143 | ptrdiff_t len = SCHARS (string); 144 | 145 | CHECK_FIXNUM (start); 146 | pos = XFIXNUM (start); 147 | if (pos < 0 && -pos <= len) 148 | pos = len + pos; 149 | else if (0 > pos || pos > len) 150 | args_out_of_range (string, start); 151 | pos_byte = string_char_to_byte (string, pos); 152 | } 153 | 154 | set_char_table_extras (BVAR (current_buffer, case_canon_table), 2, 155 | BVAR (current_buffer, case_eqv_table)); 156 | 157 | specpdl_ref count = SPECPDL_INDEX (); 158 | struct regexp_cache *cache_entry 159 | = compile_pattern (regexp, modify_match_data ? &search_regs : NULL, 160 | (!NILP (Vcase_fold_search) 161 | ? BVAR (current_buffer, case_canon_table) 162 | : Qnil), 163 | posix, STRING_MULTIBYTE (string)); 164 | freeze_pattern (cache_entry); 165 | re_match_object = string; 166 | val = re_search (&cache_entry->buf, SSDATA (string), SBYTES (string), 167 | pos_byte, SBYTES (string) - pos_byte, 168 | (modify_match_data ? &search_regs : NULL)); 169 | unbind_to (count, Qnil); 170 | 171 | if (modify_match_data) 172 | last_thing_searched = Qt; 173 | 174 | if (val == -2) 175 | matcher_overflow (); 176 | if (val < 0) 177 | return Qnil; 178 | 179 | if (modify_match_data) 180 | for (i = 0; i < search_regs.num_regs; i++) 181 | if (search_regs.start[i] >= 0) 182 | { 183 | search_regs.start[i] 184 | = string_byte_to_char (string, search_regs.start[i]); 185 | search_regs.end[i] = string_byte_to_char (string, search_regs.end[i]); 186 | } 187 | 188 | return make_fixnum (string_byte_to_char (string, val)); 189 | } 190 | 191 | DEFUN ("string-match", Fstring_match, Sstring_match, 2, 4, 0, 192 | doc: /* Return index of start of first match for REGEXP in STRING, or nil. 193 | Matching ignores case if `case-fold-search' is non-nil. 194 | If third arg START is non-nil, start search at that index in STRING. 195 | 196 | If INHIBIT-MODIFY is non-nil, match data is not changed. 197 | 198 | If INHIBIT-MODIFY is nil or missing, match data is changed, and 199 | `match-end' and `match-beginning' give indices of substrings matched 200 | by parenthesis constructs in the pattern. You can use the function 201 | `match-string' to extract the substrings matched by the parenthesis 202 | constructions in REGEXP. For index of first char beyond the match, do 203 | (match-end 0). */) 204 | (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, 205 | Lisp_Object inhibit_modify) 206 | { 207 | return string_match_1 (regexp, string, start, 0, NILP (inhibit_modify)); 208 | } 209 | 210 | static Lisp_Object 211 | match_limit (Lisp_Object num, bool beginningp) 212 | { 213 | EMACS_INT n; 214 | 215 | CHECK_FIXNUM (num); 216 | n = XFIXNUM (num); 217 | if (n < 0) 218 | args_out_of_range (num, make_fixnum (0)); 219 | if (search_regs.num_regs <= 0) 220 | error ("No match data, because no search succeeded"); 221 | if (n >= search_regs.num_regs || search_regs.start[n] < 0) 222 | return Qnil; 223 | return ( 224 | make_fixnum ((beginningp) ? search_regs.start[n] : search_regs.end[n])); 225 | } 226 | 227 | DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0, 228 | doc: /* Return position of start of text matched by last search. 229 | SUBEXP, a number, specifies the parenthesized subexpression in the last 230 | regexp for which to return the start position. 231 | Value is nil if SUBEXPth subexpression didn't match, or there were fewer 232 | than SUBEXP subexpressions. 233 | SUBEXP zero means the entire text matched by the whole regexp or whole 234 | string. 235 | 236 | Return value is undefined if the last search failed. */) 237 | (Lisp_Object subexp) { return match_limit (subexp, 1); } 238 | 239 | DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0, 240 | doc: /* Return position of end of text matched by last search. 241 | SUBEXP, a number, specifies the parenthesized subexpression in the last 242 | regexp for which to return the start position. 243 | Value is nil if SUBEXPth subexpression didn't match, or there were fewer 244 | than SUBEXP subexpressions. 245 | SUBEXP zero means the entire text matched by the whole regexp or whole 246 | string. 247 | 248 | Return value is undefined if the last search failed. */) 249 | (Lisp_Object subexp) { return match_limit (subexp, 0); } 250 | 251 | DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 3, 0, 252 | doc: /* Return a list of positions that record text matched by the last search. 253 | Element 2N of the returned list is the position of the beginning of the 254 | match of the Nth subexpression; it corresponds to `(match-beginning N)'; 255 | element 2N + 1 is the position of the end of the match of the Nth 256 | subexpression; it corresponds to `(match-end N)'. See `match-beginning' 257 | and `match-end'. 258 | If the last search was on a buffer, all the elements are by default 259 | markers or nil (nil when the Nth pair didn't match); they are integers 260 | or nil if the search was on a string. But if the optional argument 261 | INTEGERS is non-nil, the elements that represent buffer positions are 262 | always integers, not markers, and (if the search was on a buffer) the 263 | buffer itself is appended to the list as one additional element. 264 | 265 | Use `set-match-data' to reinstate the match data from the elements of 266 | this list. 267 | 268 | Note that non-matching optional groups at the end of the regexp are 269 | elided instead of being represented with two `nil's each. For instance: 270 | 271 | (progn 272 | (string-match "^\\(a\\)?\\(b\\)\\(c\\)?$" "b") 273 | (match-data)) 274 | => (0 1 nil nil 0 1) 275 | 276 | If REUSE is a list, store the value in REUSE by destructively modifying it. 277 | If REUSE is long enough to hold all the values, its length remains the 278 | same, and any unused elements are set to nil. If REUSE is not long 279 | enough, it is extended. Note that if REUSE is long enough and INTEGERS 280 | is non-nil, no consing is done to make the return value; this minimizes GC. 281 | 282 | If optional third argument RESEAT is non-nil, any previous markers on the 283 | REUSE list will be modified to point to nowhere. 284 | 285 | Return value is undefined if the last search failed. */) 286 | (Lisp_Object integers, Lisp_Object reuse, Lisp_Object reseat) 287 | { 288 | Lisp_Object tail, prev; 289 | Lisp_Object *data; 290 | ptrdiff_t i, len; 291 | 292 | if (!NILP (reseat)) 293 | for (tail = reuse; CONSP (tail); tail = XCDR (tail)) 294 | if (MARKERP (XCAR (tail))) 295 | { 296 | TODO; 297 | } 298 | 299 | if (NILP (last_thing_searched)) 300 | return Qnil; 301 | 302 | prev = Qnil; 303 | 304 | USE_SAFE_ALLOCA; 305 | SAFE_NALLOCA (data, 1, 2 * search_regs.num_regs + 1); 306 | 307 | len = 0; 308 | for (i = 0; i < search_regs.num_regs; i++) 309 | { 310 | ptrdiff_t start = search_regs.start[i]; 311 | if (start >= 0) 312 | { 313 | if (BASE_EQ (last_thing_searched, Qt) || !NILP (integers)) 314 | { 315 | XSETFASTINT (data[2 * i], start); 316 | XSETFASTINT (data[2 * i + 1], search_regs.end[i]); 317 | } 318 | else if (BUFFERP (last_thing_searched)) 319 | { 320 | TODO; 321 | } 322 | else 323 | emacs_abort (); 324 | 325 | len = 2 * i + 2; 326 | } 327 | else 328 | data[2 * i] = data[2 * i + 1] = Qnil; 329 | } 330 | 331 | if (BUFFERP (last_thing_searched) && !NILP (integers)) 332 | { 333 | data[len] = last_thing_searched; 334 | len++; 335 | } 336 | 337 | if (!CONSP (reuse)) 338 | reuse = Flist (len, data); 339 | else 340 | { 341 | for (i = 0, tail = reuse; CONSP (tail); i++, tail = XCDR (tail)) 342 | { 343 | if (i < len) 344 | XSETCAR (tail, data[i]); 345 | else 346 | XSETCAR (tail, Qnil); 347 | prev = tail; 348 | } 349 | 350 | if (i < len) 351 | XSETCDR (prev, Flist (len - i, data + i)); 352 | } 353 | 354 | SAFE_FREE (); 355 | return reuse; 356 | } 357 | 358 | DEFUN ("set-match-data", Fset_match_data, Sset_match_data, 1, 2, 0, 359 | doc: /* Set internal data on last search match from elements of LIST. 360 | LIST should have been created by calling `match-data' previously. 361 | 362 | If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */) 363 | (register Lisp_Object list, Lisp_Object reseat) 364 | { 365 | ptrdiff_t i; 366 | register Lisp_Object marker; 367 | 368 | if (running_asynch_code) 369 | TODO; // save_search_regs (); 370 | 371 | CHECK_LIST (list); 372 | 373 | last_thing_searched = Qt; 374 | 375 | { 376 | ptrdiff_t length = list_length (list) / 2; 377 | 378 | if (length > search_regs.num_regs) 379 | { 380 | ptrdiff_t num_regs = search_regs.num_regs; 381 | search_regs.start 382 | = xpalloc (search_regs.start, &num_regs, length - num_regs, 383 | min (PTRDIFF_MAX, UINT_MAX), sizeof *search_regs.start); 384 | search_regs.end 385 | = xrealloc (search_regs.end, num_regs * sizeof *search_regs.end); 386 | 387 | for (i = search_regs.num_regs; i < num_regs; i++) 388 | search_regs.start[i] = -1; 389 | 390 | search_regs.num_regs = num_regs; 391 | } 392 | 393 | for (i = 0; CONSP (list); i++) 394 | { 395 | marker = XCAR (list); 396 | if (BUFFERP (marker)) 397 | { 398 | last_thing_searched = marker; 399 | break; 400 | } 401 | if (i >= length) 402 | break; 403 | if (NILP (marker)) 404 | { 405 | search_regs.start[i] = -1; 406 | list = XCDR (list); 407 | } 408 | else 409 | { 410 | Lisp_Object from; 411 | Lisp_Object m; 412 | 413 | m = marker; 414 | if (MARKERP (marker)) 415 | TODO; 416 | 417 | CHECK_FIXNUM_COERCE_MARKER (marker); 418 | from = marker; 419 | 420 | if (!NILP (reseat) && MARKERP (m)) 421 | { 422 | TODO; // unchain_marker (XMARKER (m)); 423 | XSETCAR (list, Qnil); 424 | } 425 | 426 | if ((list = XCDR (list), !CONSP (list))) 427 | break; 428 | 429 | m = marker = XCAR (list); 430 | 431 | if (MARKERP (marker) && (TODO, false)) 432 | XSETFASTINT (marker, 0); 433 | 434 | CHECK_FIXNUM_COERCE_MARKER (marker); 435 | if (PTRDIFF_MIN <= XFIXNUM (from) && XFIXNUM (from) <= PTRDIFF_MAX 436 | && PTRDIFF_MIN <= XFIXNUM (marker) 437 | && XFIXNUM (marker) <= PTRDIFF_MAX) 438 | { 439 | search_regs.start[i] = XFIXNUM (from); 440 | search_regs.end[i] = XFIXNUM (marker); 441 | } 442 | else 443 | { 444 | search_regs.start[i] = -1; 445 | } 446 | 447 | if (!NILP (reseat) && MARKERP (m)) 448 | { 449 | TODO; // unchain_marker (XMARKER (m)); 450 | XSETCAR (list, Qnil); 451 | } 452 | } 453 | list = XCDR (list); 454 | } 455 | 456 | for (; i < search_regs.num_regs; i++) 457 | search_regs.start[i] = -1; 458 | } 459 | 460 | return Qnil; 461 | } 462 | 463 | static void 464 | syms_of_search_for_pdumper (void) 465 | { 466 | for (int i = 0; i < REGEXP_CACHE_SIZE; ++i) 467 | { 468 | searchbufs[i].buf.allocated = 100; 469 | searchbufs[i].buf.buffer = xmalloc (100); 470 | searchbufs[i].buf.fastmap = searchbufs[i].fastmap; 471 | searchbufs[i].regexp = Qnil; 472 | searchbufs[i].f_whitespace_regexp = Qnil; 473 | searchbufs[i].busy = false; 474 | searchbufs[i].syntax_table = Qnil; 475 | searchbufs[i].next 476 | = (i == REGEXP_CACHE_SIZE - 1 ? 0 : &searchbufs[i + 1]); 477 | } 478 | searchbuf_head = &searchbufs[0]; 479 | } 480 | 481 | void 482 | syms_of_search (void) 483 | { 484 | for (int i = 0; i < REGEXP_CACHE_SIZE; ++i) 485 | { 486 | staticpro (&searchbufs[i].regexp); 487 | staticpro (&searchbufs[i].f_whitespace_regexp); 488 | staticpro (&searchbufs[i].syntax_table); 489 | } 490 | 491 | DEFSYM (Qinvalid_regexp, "invalid-regexp"); 492 | 493 | Fput (Qinvalid_regexp, Qerror_conditions, 494 | pure_list (Qinvalid_regexp, Qerror)); 495 | Fput (Qinvalid_regexp, Qerror_message, 496 | build_pure_c_string ("Invalid regexp")); 497 | 498 | re_match_object = Qnil; 499 | staticpro (&re_match_object); 500 | 501 | DEFVAR_LISP ("search-spaces-regexp", Vsearch_spaces_regexp, 502 | doc: /* Regexp to substitute for bunches of spaces in regexp search. 503 | Some commands use this for user-specified regexps. 504 | Spaces that occur inside character classes or repetition operators 505 | or other such regexp constructs are not replaced with this. 506 | A value of nil (which is the normal value) means treat spaces 507 | literally. Note that a value with capturing groups can change the 508 | numbering of existing capture groups in unexpected ways. */); 509 | Vsearch_spaces_regexp = Qnil; 510 | 511 | DEFVAR_LISP ("inhibit-changing-match-data", Vinhibit_changing_match_data, 512 | doc: /* Internal use only. 513 | If non-nil, the primitive searching and matching functions 514 | such as `looking-at', `string-match', `re-search-forward', etc., 515 | do not set the match data. The proper way to use this variable 516 | is to bind it with `let' around a small expression. */); 517 | Vinhibit_changing_match_data = Qnil; 518 | 519 | defsubr (&Sstring_match); 520 | defsubr (&Smatch_beginning); 521 | defsubr (&Smatch_end); 522 | defsubr (&Smatch_data); 523 | defsubr (&Sset_match_data); 524 | syms_of_search_for_pdumper (); 525 | } 526 | -------------------------------------------------------------------------------- /src/syntax.c: -------------------------------------------------------------------------------- 1 | #include "syntax.h" 2 | #include "lisp.h" 3 | #include "character.h" 4 | 5 | #define SYNTAX_WITH_FLAGS(c) syntax_property_with_flags (c, 1) 6 | 7 | static bool 8 | SYNTAX_FLAGS_PREFIX (int flags) 9 | { 10 | return (flags >> 20) & 1; 11 | } 12 | bool 13 | syntax_prefix_flag_p (int c) 14 | { 15 | return SYNTAX_FLAGS_PREFIX (SYNTAX_WITH_FLAGS (c)); 16 | } 17 | 18 | struct gl_state_s gl_state; 19 | 20 | unsigned char const syntax_spec_code[0400] = { 21 | 0377, 0377, 0377, 0377, 0377, 0377, 22 | 0377, 0377, 0377, 0377, 0377, 0377, 23 | 0377, 0377, 0377, 0377, 0377, 0377, 24 | 0377, 0377, 0377, 0377, 0377, 0377, 25 | 0377, 0377, 0377, 0377, 0377, 0377, 26 | 0377, 0377, Swhitespace, Scomment_fence, Sstring, 0377, 27 | Smath, 0377, 0377, Squote_, Sopen, Sclose, 28 | 0377, 0377, 0377, Swhitespace, Spunct, Scharquote, 29 | 0377, 0377, 0377, 0377, 0377, 0377, 30 | 0377, 0377, 0377, 0377, 0377, 0377, 31 | Scomment, 0377, Sendcomment, 0377, Sinherit, 0377, 32 | 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */ 33 | 0377, 0377, 0377, 0377, 0377, 0377, 34 | 0377, 0377, 0377, 0377, 0377, 0377, 35 | 0377, 0377, 0377, Sword, 0377, 0377, 36 | 0377, 0377, Sescape, 0377, 0377, Ssymbol, 37 | 0377, 0377, 0377, 0377, 0377, 0377, 38 | 0377, 0377, /* `, a, ... */ 39 | 0377, 0377, 0377, 0377, 0377, 0377, 40 | 0377, 0377, 0377, 0377, 0377, 0377, 41 | 0377, 0377, 0377, Sword, 0377, 0377, 42 | 0377, 0377, Sstring_fence, 0377, 0377, 0377 43 | }; 44 | 45 | static Lisp_Object Vsyntax_code_object; 46 | 47 | static void 48 | SET_RAW_SYNTAX_ENTRY (Lisp_Object table, int c, Lisp_Object val) 49 | { 50 | CHAR_TABLE_SET (table, c, val); 51 | } 52 | 53 | void 54 | init_syntax_once (void) 55 | { 56 | register int i, c; 57 | Lisp_Object temp; 58 | 59 | DEFSYM (Qsyntax_table, "syntax-table"); 60 | 61 | Vsyntax_code_object = make_nil_vector (Smax_); 62 | for (i = 0; i < Smax_; i++) 63 | ASET (Vsyntax_code_object, i, list1 (make_fixnum (i))); 64 | 65 | Fput (Qsyntax_table, Qchar_table_extra_slots, make_fixnum (0)); 66 | 67 | temp = AREF (Vsyntax_code_object, Swhitespace); 68 | 69 | Vstandard_syntax_table = Fmake_char_table (Qsyntax_table, temp); 70 | 71 | temp = AREF (Vsyntax_code_object, Spunct); 72 | for (i = 0; i <= ' ' - 1; i++) 73 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp); 74 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 0177, temp); 75 | 76 | temp = AREF (Vsyntax_code_object, Swhitespace); 77 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ' ', temp); 78 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\t', temp); 79 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\n', temp); 80 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 015, temp); 81 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 014, temp); 82 | 83 | temp = AREF (Vsyntax_code_object, Sword); 84 | for (i = 'a'; i <= 'z'; i++) 85 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp); 86 | for (i = 'A'; i <= 'Z'; i++) 87 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp); 88 | for (i = '0'; i <= '9'; i++) 89 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp); 90 | 91 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '$', temp); 92 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '%', temp); 93 | 94 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '(', 95 | Fcons (make_fixnum (Sopen), make_fixnum (')'))); 96 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ')', 97 | Fcons (make_fixnum (Sclose), make_fixnum ('('))); 98 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '[', 99 | Fcons (make_fixnum (Sopen), make_fixnum (']'))); 100 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ']', 101 | Fcons (make_fixnum (Sclose), make_fixnum ('['))); 102 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '{', 103 | Fcons (make_fixnum (Sopen), make_fixnum ('}'))); 104 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '}', 105 | Fcons (make_fixnum (Sclose), make_fixnum ('{'))); 106 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '"', 107 | Fcons (make_fixnum (Sstring), Qnil)); 108 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\\', 109 | Fcons (make_fixnum (Sescape), Qnil)); 110 | 111 | temp = AREF (Vsyntax_code_object, Ssymbol); 112 | for (i = 0; i < 10; i++) 113 | { 114 | c = "_-+*/&|<>="[i]; 115 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, c, temp); 116 | } 117 | 118 | temp = AREF (Vsyntax_code_object, Spunct); 119 | for (i = 0; i < 12; i++) 120 | { 121 | c = ".,;:?!#@~^'`"[i]; 122 | SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, c, temp); 123 | } 124 | 125 | temp = AREF (Vsyntax_code_object, Sword); 126 | char_table_set_range (Vstandard_syntax_table, 0x80, MAX_CHAR, temp); 127 | } 128 | 129 | void 130 | syms_of_syntax (void) 131 | { 132 | staticpro (&Vsyntax_code_object); 133 | } 134 | -------------------------------------------------------------------------------- /src/syntax.h: -------------------------------------------------------------------------------- 1 | #ifndef EMACS_SYNTAX_H 2 | #define EMACS_SYNTAX_H 3 | 4 | #include "lisp.h" 5 | #include "buffer.h" 6 | 7 | // #define Vstandard_syntax_table BVAR (&buffer_defaults, syntax_table) 8 | #define Vstandard_syntax_table buffer_defaults._syntax_table 9 | 10 | enum syntaxcode 11 | { 12 | Swhitespace, 13 | Spunct, 14 | Sword, 15 | Ssymbol, 16 | Sopen, 17 | Sclose, 18 | Squote_, 19 | Sstring, 20 | Smath, 21 | Sescape, 22 | Scharquote, 23 | Scomment, 24 | Sendcomment, 25 | Sinherit, 26 | Scomment_fence, 27 | Sstring_fence, 28 | Smax_ 29 | }; 30 | 31 | struct gl_state_s 32 | { 33 | Lisp_Object object; 34 | ptrdiff_t start; 35 | ptrdiff_t stop; 36 | bool use_global; 37 | Lisp_Object global_code; 38 | Lisp_Object current_syntax_table; 39 | Lisp_Object old_prop; 40 | ptrdiff_t b_property; 41 | ptrdiff_t e_property; 42 | bool e_property_truncated; 43 | INTERVAL forward_i; 44 | INTERVAL backward_i; 45 | }; 46 | 47 | extern struct gl_state_s gl_state; 48 | 49 | INLINE Lisp_Object 50 | syntax_property_entry (int c, bool via_property) 51 | { 52 | if (via_property) 53 | return (gl_state.use_global 54 | ? gl_state.global_code 55 | : CHAR_TABLE_REF (gl_state.current_syntax_table, c)); 56 | return CHAR_TABLE_REF (BVAR (current_buffer, syntax_table), c); 57 | } 58 | 59 | INLINE int 60 | syntax_property_with_flags (int c, bool via_property) 61 | { 62 | Lisp_Object ent = syntax_property_entry (c, via_property); 63 | return CONSP (ent) ? XFIXNUM (XCAR (ent)) : Swhitespace; 64 | } 65 | INLINE enum syntaxcode 66 | syntax_property (int c, bool via_property) 67 | { 68 | return syntax_property_with_flags (c, via_property) & 0xff; 69 | } 70 | INLINE enum syntaxcode 71 | SYNTAX (int c) 72 | { 73 | return syntax_property (c, false); 74 | } 75 | 76 | extern bool syntax_prefix_flag_p (int c); 77 | 78 | extern unsigned char const syntax_spec_code[0400]; 79 | 80 | #endif 81 | -------------------------------------------------------------------------------- /src/sysdep.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | #define O_BINARY 0 6 | #define O_TEXT 0 7 | 8 | #include "lisp.h" 9 | 10 | int 11 | sys_faccessat (int fd, const char *pathname, int mode, int flags) 12 | { 13 | return faccessat (fd, pathname, mode, flags); 14 | } 15 | 16 | #define POSIX_CLOSE_RESTART 1 17 | static int 18 | posix_close (int fd, int flag) 19 | { 20 | eassert (flag == POSIX_CLOSE_RESTART); 21 | return close (fd) == 0 || errno == EINTR ? 0 : -1; 22 | } 23 | 24 | int 25 | emacs_close (int fd) 26 | { 27 | int r; 28 | 29 | while (1) 30 | { 31 | r = posix_close (fd, POSIX_CLOSE_RESTART); 32 | 33 | if (r == 0) 34 | return r; 35 | if (!POSIX_CLOSE_RESTART || errno != EINTR) 36 | { 37 | eassert (errno != EBADF || fd < 0); 38 | return errno == EINPROGRESS ? 0 : r; 39 | } 40 | } 41 | } 42 | 43 | int 44 | emacs_openat (int dirfd, char const *file, int oflags, int mode) 45 | { 46 | int fd; 47 | if (!(oflags & O_TEXT)) 48 | oflags |= O_BINARY; 49 | oflags |= O_CLOEXEC; 50 | while ((fd = openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR) 51 | maybe_quit (); 52 | return fd; 53 | } 54 | 55 | int 56 | emacs_open (char const *file, int oflags, int mode) 57 | { 58 | return emacs_openat (AT_FDCWD, file, oflags, mode); 59 | } 60 | 61 | FILE * 62 | emacs_fdopen (int fd, const char *mode) 63 | { 64 | return fdopen (fd, mode); 65 | } 66 | 67 | void 68 | init_system_name (void) 69 | { 70 | if (!build_details) 71 | { 72 | Vsystem_name = Qnil; 73 | return; 74 | } 75 | char *hostname_alloc = NULL; 76 | char *hostname; 77 | char hostname_buf[256]; 78 | ptrdiff_t hostname_size = sizeof hostname_buf; 79 | hostname = hostname_buf; 80 | 81 | for (;;) 82 | { 83 | gethostname (hostname, hostname_size - 1); 84 | hostname[hostname_size - 1] = '\0'; 85 | 86 | if (strlen (hostname) < (unsigned long) hostname_size - 1) 87 | break; 88 | 89 | hostname = hostname_alloc = xpalloc (hostname_alloc, &hostname_size, 1, 90 | min (PTRDIFF_MAX, SIZE_MAX), 1); 91 | } 92 | char *p; 93 | for (p = hostname; *p; p++) 94 | if (*p == ' ' || *p == '\t') 95 | *p = '-'; 96 | if (!(STRINGP (Vsystem_name) && SBYTES (Vsystem_name) == p - hostname 97 | && strcmp (SSDATA (Vsystem_name), hostname) == 0)) 98 | Vsystem_name = build_string (hostname); 99 | xfree (hostname_alloc); 100 | } 101 | -------------------------------------------------------------------------------- /src/termhooks.h: -------------------------------------------------------------------------------- 1 | #ifndef EMACS_TERMHOOKS_H 2 | #define EMACS_TERMHOOKS_H 3 | 4 | #include "lisp.h" 5 | 6 | enum 7 | { 8 | up_modifier = 1, 9 | down_modifier = 2, 10 | drag_modifier = 4, 11 | click_modifier = 8, 12 | double_modifier = 16, 13 | triple_modifier = 32, 14 | alt_modifier = CHAR_ALT, 15 | super_modifier = CHAR_SUPER, 16 | hyper_modifier = CHAR_HYPER, 17 | shift_modifier = CHAR_SHIFT, 18 | ctrl_modifier = CHAR_CTL, 19 | meta_modifier = CHAR_META 20 | }; 21 | 22 | #endif 23 | -------------------------------------------------------------------------------- /src/textprop.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | #include "buffer.h" 3 | #include "intervals.h" 4 | 5 | enum property_set_type 6 | { 7 | TEXT_PROPERTY_REPLACE, 8 | TEXT_PROPERTY_PREPEND, 9 | TEXT_PROPERTY_APPEND 10 | }; 11 | 12 | static void 13 | CHECK_STRING_OR_BUFFER (Lisp_Object x) 14 | { 15 | CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x); 16 | } 17 | 18 | enum 19 | { 20 | soft = false, 21 | hard = true 22 | }; 23 | 24 | INTERVAL 25 | validate_interval_range (Lisp_Object object, Lisp_Object *begin, 26 | Lisp_Object *end, bool force) 27 | { 28 | INTERVAL i; 29 | ptrdiff_t searchpos; 30 | Lisp_Object begin0 = *begin, end0 = *end; 31 | 32 | CHECK_STRING_OR_BUFFER (object); 33 | CHECK_FIXNUM_COERCE_MARKER (*begin); 34 | CHECK_FIXNUM_COERCE_MARKER (*end); 35 | 36 | if (EQ (*begin, *end) && begin != end) 37 | return NULL; 38 | 39 | if (XFIXNUM (*begin) > XFIXNUM (*end)) 40 | { 41 | Lisp_Object n; 42 | n = *begin; 43 | *begin = *end; 44 | *end = n; 45 | } 46 | 47 | if (BUFFERP (object)) 48 | TODO; 49 | else 50 | { 51 | ptrdiff_t len = SCHARS (object); 52 | 53 | if (!(0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end) 54 | && XFIXNUM (*end) <= len)) 55 | args_out_of_range (begin0, end0); 56 | i = string_intervals (object); 57 | 58 | if (len == 0) 59 | return NULL; 60 | 61 | searchpos = XFIXNUM (*begin); 62 | } 63 | 64 | if (!i) 65 | return (force ? create_root_interval (object) : i); 66 | 67 | return find_interval (i, searchpos); 68 | } 69 | 70 | static Lisp_Object 71 | validate_plist (Lisp_Object list) 72 | { 73 | if (NILP (list)) 74 | return Qnil; 75 | 76 | if (CONSP (list)) 77 | { 78 | Lisp_Object tail = list; 79 | do 80 | { 81 | tail = XCDR (tail); 82 | if (!CONSP (tail)) 83 | error ("Odd length text property list"); 84 | tail = XCDR (tail); 85 | maybe_quit (); 86 | } 87 | while (CONSP (tail)); 88 | 89 | return list; 90 | } 91 | 92 | return list2 (list, Qnil); 93 | } 94 | 95 | static bool 96 | interval_has_all_properties (Lisp_Object plist, INTERVAL i) 97 | { 98 | Lisp_Object tail1, tail2; 99 | 100 | for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1))) 101 | { 102 | Lisp_Object sym1 = XCAR (tail1); 103 | bool found = false; 104 | 105 | for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2))) 106 | if (EQ (sym1, XCAR (tail2))) 107 | { 108 | if (!EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2)))) 109 | return false; 110 | 111 | found = true; 112 | break; 113 | } 114 | 115 | if (!found) 116 | return false; 117 | } 118 | 119 | return true; 120 | } 121 | 122 | static bool 123 | add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object, 124 | enum property_set_type set_type, bool destructive) 125 | { 126 | Lisp_Object tail1, tail2, sym1, val1; 127 | bool changed = false; 128 | 129 | tail1 = plist; 130 | sym1 = Qnil; 131 | val1 = Qnil; 132 | 133 | for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1))) 134 | { 135 | bool found = false; 136 | sym1 = XCAR (tail1); 137 | val1 = Fcar (XCDR (tail1)); 138 | 139 | for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2))) 140 | if (EQ (sym1, XCAR (tail2))) 141 | { 142 | Lisp_Object this_cdr; 143 | 144 | this_cdr = XCDR (tail2); 145 | found = true; 146 | 147 | if (EQ (val1, Fcar (this_cdr))) 148 | break; 149 | 150 | if (BUFFERP (object)) 151 | { 152 | TODO; // record_property_change (i->position, LENGTH (i), 153 | // sym1, Fcar (this_cdr), object); 154 | } 155 | 156 | if (set_type == TEXT_PROPERTY_REPLACE) 157 | Fsetcar (this_cdr, val1); 158 | else 159 | { 160 | if (CONSP (Fcar (this_cdr)) 161 | && (!EQ (sym1, Qface) 162 | || NILP (Fkeywordp (Fcar (Fcar (this_cdr)))))) 163 | if (set_type == TEXT_PROPERTY_PREPEND) 164 | Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr))); 165 | else 166 | { 167 | if (destructive) 168 | nconc2 (Fcar (this_cdr), list1 (val1)); 169 | else 170 | Fsetcar (this_cdr, CALLN (Fappend, Fcar (this_cdr), 171 | list1 (val1))); 172 | } 173 | else 174 | { 175 | if (set_type == TEXT_PROPERTY_PREPEND) 176 | Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr))); 177 | else 178 | Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1)); 179 | } 180 | } 181 | changed = true; 182 | break; 183 | } 184 | 185 | if (!found) 186 | { 187 | if (BUFFERP (object)) 188 | { 189 | TODO; // record_property_change (i->position, LENGTH (i), 190 | // sym1, Qnil, object); 191 | } 192 | set_interval_plist (i, Fcons (sym1, Fcons (val1, i->plist))); 193 | changed = true; 194 | } 195 | } 196 | 197 | return changed; 198 | } 199 | 200 | static Lisp_Object 201 | add_text_properties_1 (Lisp_Object start, Lisp_Object end, 202 | Lisp_Object properties, Lisp_Object object, 203 | enum property_set_type set_type, bool destructive) 204 | { 205 | if (BUFFERP (object) && XBUFFER (object) != current_buffer) 206 | TODO; 207 | 208 | INTERVAL i, unchanged; 209 | ptrdiff_t s, len; 210 | bool modified = false; 211 | bool first_time = true; 212 | 213 | properties = validate_plist (properties); 214 | if (NILP (properties)) 215 | return Qnil; 216 | 217 | if (NILP (object)) 218 | XSETBUFFER (object, current_buffer); 219 | 220 | i = validate_interval_range (object, &start, &end, hard); 221 | if (!i) 222 | return Qnil; 223 | 224 | s = XFIXNUM (start); 225 | len = XFIXNUM (end) - s; 226 | 227 | if (interval_has_all_properties (properties, i)) 228 | { 229 | ptrdiff_t got = LENGTH (i) - (s - i->position); 230 | 231 | do 232 | { 233 | if (got >= len) 234 | return Qnil; 235 | len -= got; 236 | i = next_interval (i); 237 | got = LENGTH (i); 238 | } 239 | while (interval_has_all_properties (properties, i)); 240 | } 241 | else if (i->position != s) 242 | { 243 | unchanged = i; 244 | i = split_interval_right (unchanged, s - unchanged->position); 245 | copy_properties (unchanged, i); 246 | } 247 | 248 | if (BUFFERP (object) && first_time) 249 | TODO; 250 | 251 | for (;;) 252 | { 253 | eassert (i != 0); 254 | 255 | if (LENGTH (i) >= len) 256 | { 257 | if (interval_has_all_properties (properties, i)) 258 | { 259 | if (BUFFERP (object)) 260 | TODO; // signal_after_change (XFIXNUM (start), 261 | // XFIXNUM (end) - XFIXNUM (start), 262 | // XFIXNUM (end) - XFIXNUM (start)); 263 | 264 | eassert (modified); 265 | return Qt; 266 | } 267 | 268 | if (LENGTH (i) == len) 269 | { 270 | add_properties (properties, i, object, set_type, destructive); 271 | if (BUFFERP (object)) 272 | TODO; // signal_after_change (XFIXNUM (start), 273 | // XFIXNUM (end) - XFIXNUM (start), 274 | // XFIXNUM (end) - XFIXNUM (start)); 275 | return Qt; 276 | } 277 | 278 | unchanged = i; 279 | i = split_interval_left (unchanged, len); 280 | copy_properties (unchanged, i); 281 | add_properties (properties, i, object, set_type, destructive); 282 | if (BUFFERP (object)) 283 | TODO; // signal_after_change (XFIXNUM (start), 284 | // XFIXNUM (end) - XFIXNUM (start), 285 | // XFIXNUM (end) - XFIXNUM (start)); 286 | return Qt; 287 | } 288 | 289 | len -= LENGTH (i); 290 | modified |= add_properties (properties, i, object, set_type, destructive); 291 | i = next_interval (i); 292 | } 293 | } 294 | 295 | DEFUN ("add-text-properties", Fadd_text_properties, 296 | Sadd_text_properties, 3, 4, 0, 297 | doc: /* Add properties to the text from START to END. 298 | The third argument PROPERTIES is a property list 299 | specifying the property values to add. If the optional fourth argument 300 | OBJECT is a buffer (or nil, which means the current buffer), 301 | START and END are buffer positions (integers or markers). 302 | If OBJECT is a string, START and END are 0-based indices into it. 303 | Return t if any property value actually changed, nil otherwise. */) 304 | (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object) 305 | { 306 | return add_text_properties_1 (start, end, properties, object, 307 | TEXT_PROPERTY_REPLACE, true); 308 | } 309 | 310 | void 311 | syms_of_textprop (void) 312 | { 313 | defsubr (&Sadd_text_properties); 314 | } 315 | -------------------------------------------------------------------------------- /src/thread.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | #include "regex-emacs.h" 3 | 4 | union specbinding *specpdl_ptr; 5 | union specbinding *specpdl_end; 6 | union specbinding *specpdl; 7 | 8 | intmax_t lisp_eval_depth; 9 | struct bc_thread_state bc_; 10 | 11 | struct handler *handlerlist; 12 | struct handler *handlerlist_sentinel; 13 | 14 | struct re_registers search_regs; 15 | 16 | Lisp_Object last_thing_searched; 17 | -------------------------------------------------------------------------------- /src/thread.h: -------------------------------------------------------------------------------- 1 | #ifndef THREAD_H 2 | #define THREAD_H 3 | 4 | #include 5 | 6 | struct bc_thread_state 7 | { 8 | struct bc_frame *fp; 9 | char *stack; 10 | char *stack_end; 11 | }; 12 | 13 | extern union specbinding *specpdl_ptr; 14 | extern union specbinding *specpdl_end; 15 | extern union specbinding *specpdl; 16 | 17 | extern intmax_t lisp_eval_depth; 18 | extern struct bc_thread_state bc_; 19 | 20 | extern struct handler *handlerlist; 21 | extern struct handler *handlerlist_sentinel; 22 | 23 | extern struct re_registers search_regs; 24 | 25 | #ifndef EMACS_LISP_H 26 | # include "lisp.h" 27 | #endif 28 | 29 | extern Lisp_Object last_thing_searched; 30 | 31 | INLINE bool 32 | THREADP (Lisp_Object a) 33 | { 34 | return PSEUDOVECTORP (a, PVEC_THREAD); 35 | } 36 | 37 | INLINE bool 38 | MUTEXP (Lisp_Object a) 39 | { 40 | return PSEUDOVECTORP (a, PVEC_MUTEX); 41 | } 42 | 43 | INLINE bool 44 | CONDVARP (Lisp_Object a) 45 | { 46 | return PSEUDOVECTORP (a, PVEC_CONDVAR); 47 | } 48 | 49 | #endif 50 | -------------------------------------------------------------------------------- /src/timefns.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | #include "bignum.h" 3 | 4 | // Taken from lib/timespec.h 5 | enum 6 | { 7 | TIMESPEC_HZ = 1000000000 8 | }; 9 | // Taken from lib/gettime.c 10 | #include 11 | void 12 | gettime (struct timespec *ts) 13 | { 14 | struct timeval tv; 15 | gettimeofday (&tv, NULL); 16 | *ts = (struct timespec) { .tv_sec = tv.tv_sec, .tv_nsec = tv.tv_usec * 1000 }; 17 | } 18 | struct timespec 19 | current_timespec (void) 20 | { 21 | struct timespec ts; 22 | gettime (&ts); 23 | return ts; 24 | } 25 | // 26 | 27 | #ifndef FASTER_TIMEFNS 28 | # define FASTER_TIMEFNS 1 29 | #endif 30 | 31 | #ifndef CURRENT_TIME_LIST 32 | enum 33 | { 34 | CURRENT_TIME_LIST = true 35 | }; 36 | #endif 37 | 38 | #if FIXNUM_OVERFLOW_P(1000000000) 39 | static Lisp_Object timespec_hz; 40 | #else 41 | # define timespec_hz make_fixnum (TIMESPEC_HZ) 42 | #endif 43 | 44 | enum 45 | { 46 | LO_TIME_BITS = 16 47 | }; 48 | 49 | static Lisp_Object 50 | hi_time (time_t t) 51 | { 52 | return INT_TO_INTEGER (t >> LO_TIME_BITS); 53 | } 54 | 55 | static Lisp_Object 56 | lo_time (time_t t) 57 | { 58 | return make_fixnum (t & ((1 << LO_TIME_BITS) - 1)); 59 | } 60 | 61 | static void 62 | mpz_set_time (mpz_t rop, time_t t) 63 | { 64 | if (EXPR_SIGNED (t)) 65 | mpz_set_intmax (rop, t); 66 | else 67 | mpz_set_uintmax (rop, t); 68 | } 69 | 70 | static void 71 | timespec_mpz (struct timespec t) 72 | { 73 | /* mpz[0] = sec * TIMESPEC_HZ + nsec. */ 74 | mpz_set_ui (mpz[0], t.tv_nsec); 75 | mpz_set_time (mpz[1], t.tv_sec); 76 | mpz_addmul_ui (mpz[0], mpz[1], TIMESPEC_HZ); 77 | } 78 | 79 | static Lisp_Object 80 | timespec_ticks (struct timespec t) 81 | { 82 | intmax_t accum; 83 | if (FASTER_TIMEFNS && !ckd_mul (&accum, t.tv_sec, TIMESPEC_HZ) 84 | && !ckd_add (&accum, accum, t.tv_nsec)) 85 | return make_int (accum); 86 | 87 | timespec_mpz (t); 88 | return make_integer_mpz (); 89 | } 90 | 91 | Lisp_Object 92 | timespec_to_lisp (struct timespec t) 93 | { 94 | return Fcons (timespec_ticks (t), timespec_hz); 95 | } 96 | 97 | Lisp_Object 98 | make_lisp_time (struct timespec t) 99 | { 100 | if (current_time_list) 101 | { 102 | time_t s = t.tv_sec; 103 | int ns = t.tv_nsec; 104 | return list4 (hi_time (s), lo_time (s), make_fixnum (ns / 1000), 105 | make_fixnum (ns % 1000 * 1000)); 106 | } 107 | else 108 | return timespec_to_lisp (t); 109 | } 110 | 111 | DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, 112 | doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. 113 | If the variable `current-time-list' is nil, the time is returned as a 114 | pair of integers (TICKS . HZ), where TICKS counts clock ticks and HZ 115 | is the clock ticks per second. Otherwise, the time is returned as a 116 | list of integers (HIGH LOW USEC PSEC) where HIGH has the most 117 | significant bits of the seconds, LOW has the least significant 16 118 | bits, and USEC and PSEC are the microsecond and picosecond counts. 119 | 120 | You can use `time-convert' to get a particular timestamp form 121 | regardless of the value of `current-time-list'. */) 122 | (void) { return make_lisp_time (current_timespec ()); } 123 | 124 | void 125 | syms_of_timefns (void) 126 | { 127 | DEFVAR_BOOL ("current-time-list", current_time_list, 128 | doc: /* Whether `current-time' should return list or (TICKS . HZ) form. 129 | 130 | This boolean variable is a transition aid. If t, `current-time' and 131 | related functions return timestamps in list form, typically 132 | \(HIGH LOW USEC PSEC); otherwise, they use (TICKS . HZ) form. 133 | Currently this variable defaults to t, for behavior compatible with 134 | previous Emacs versions. Developers are encouraged to test 135 | timestamp-related code with this variable set to nil, as it will 136 | default to nil in a future Emacs version, and will be removed in some 137 | version after that. */); 138 | current_time_list = CURRENT_TIME_LIST; 139 | 140 | defsubr (&Scurrent_time); 141 | } 142 | -------------------------------------------------------------------------------- /src/xdisp.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | #include "lua.h" 3 | 4 | void 5 | message3 (Lisp_Object m) 6 | { 7 | TODO_NELISP_LATER; 8 | if (STRINGP (m)) 9 | { 10 | LUA (5) 11 | { 12 | lua_getglobal (L, "print"); 13 | lua_pushlstring (L, (char *) SDATA (m), SBYTES (m)); 14 | lua_call (L, 1, 0); 15 | } 16 | } 17 | else 18 | TODO; 19 | } 20 | 21 | void 22 | message1 (const char *m) 23 | { 24 | message3 (m ? build_unibyte_string (m) : Qnil); 25 | } 26 | 27 | void 28 | syms_of_xdisp (void) 29 | { 30 | DEFSYM (Qeval, "eval"); 31 | 32 | DEFSYM (Qinhibit_redisplay, "inhibit-redisplay"); 33 | 34 | DEFVAR_INT ("max-redisplay-ticks", max_redisplay_ticks, 35 | doc: /* Maximum number of redisplay ticks before aborting redisplay of a window. 36 | 37 | This enables aborting the display of a window if the amount of 38 | low-level redisplay operations exceeds the value of this variable. 39 | When display of a window is aborted due to this reason, the buffer 40 | shown in that window will not have its windows redisplayed until the 41 | buffer is modified or until you type \\[recenter-top-bottom] with one 42 | of its windows selected. You can also decide to kill the buffer and 43 | visit it in some other way, like under `so-long-mode' or literally. 44 | 45 | The default value is zero, which disables this feature. 46 | The recommended non-zero value is between 100000 and 1000000, 47 | depending on your patience and the speed of your system. */); 48 | max_redisplay_ticks = 0; 49 | } 50 | -------------------------------------------------------------------------------- /src/xfaces.c: -------------------------------------------------------------------------------- 1 | #include "lisp.h" 2 | 3 | void 4 | syms_of_xfaces (void) 5 | { 6 | DEFSYM (Qface, "face"); 7 | } 8 | --------------------------------------------------------------------------------