summaryrefslogtreecommitdiff
path: root/vim
diff options
context:
space:
mode:
authorNick Shipp <nick@shipp.ninja>2017-05-07 09:04:01 -0400
committerNick Shipp <nick@shipp.ninja>2017-05-07 09:04:01 -0400
commitc012f55efda29f09179e921cf148d79deb57616e (patch)
treeff0ad37f22622d51194cab192a2aa4b0106d7ad0 /vim
parent4ca8f6608883d230131f8a9e8b6d6c091c516049 (diff)
Much maturering of vim configs
Diffstat (limited to 'vim')
-rw-r--r--vim/autoload/pathogen.vim289
-rw-r--r--vim/bundle/rust.vim/.gitignore1
-rw-r--r--vim/bundle/rust.vim/LICENSE-APACHE201
-rw-r--r--vim/bundle/rust.vim/LICENSE-MIT25
-rw-r--r--vim/bundle/rust.vim/README.md87
-rw-r--r--vim/bundle/rust.vim/after/syntax/rust.vim34
-rw-r--r--vim/bundle/rust.vim/autoload/rust.vim414
-rw-r--r--vim/bundle/rust.vim/autoload/rustfmt.vim106
-rw-r--r--vim/bundle/rust.vim/compiler/cargo.vim28
-rw-r--r--vim/bundle/rust.vim/compiler/rustc.vim45
-rw-r--r--vim/bundle/rust.vim/doc/rust.txt237
-rw-r--r--vim/bundle/rust.vim/ftdetect/rust.vim1
-rw-r--r--vim/bundle/rust.vim/ftplugin/rust.vim207
-rw-r--r--vim/bundle/rust.vim/indent/rust.vim206
-rw-r--r--vim/bundle/rust.vim/plugin/rust.vim22
-rw-r--r--vim/bundle/rust.vim/syntax/rust.vim294
-rw-r--r--vim/bundle/rust.vim/syntax_checkers/rust/rustc.vim48
-rw-r--r--vim/bundle/slimv/.gitignore1
-rw-r--r--vim/bundle/slimv/.hg_archival.txt6
-rw-r--r--vim/bundle/slimv/.hgtags70
-rw-r--r--vim/bundle/slimv/README.txt152
-rw-r--r--vim/bundle/slimv/doc/paredit.txt461
-rw-r--r--vim/bundle/slimv/doc/slimv.txt2171
-rw-r--r--vim/bundle/slimv/ftdetect/clojure.vim3
-rw-r--r--vim/bundle/slimv/ftplugin/clojure/slimv-clojure.vim200
-rwxr-xr-xvim/bundle/slimv/ftplugin/iterm.applescript66
-rw-r--r--vim/bundle/slimv/ftplugin/lisp/slimv-lisp.vim199
-rw-r--r--vim/bundle/slimv/ftplugin/r/slimv-r.vim60
-rw-r--r--vim/bundle/slimv/ftplugin/scheme/slimv-scheme.vim91
-rw-r--r--vim/bundle/slimv/ftplugin/slimv-clhs.vim2236
-rw-r--r--vim/bundle/slimv/ftplugin/slimv-cljapi.vim759
-rw-r--r--vim/bundle/slimv/ftplugin/slimv-javadoc.vim3820
-rw-r--r--vim/bundle/slimv/ftplugin/slimv.vim3676
-rw-r--r--vim/bundle/slimv/ftplugin/swank.py1373
-rw-r--r--vim/bundle/slimv/indent/clojure.vim23
-rw-r--r--vim/bundle/slimv/indent/lisp.vim30
-rw-r--r--vim/bundle/slimv/indent/scheme.vim23
-rw-r--r--vim/bundle/slimv/plugin/paredit.vim1863
-rw-r--r--vim/bundle/slimv/slime/README.md78
-rw-r--r--vim/bundle/slimv/slime/contrib/README.md14
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-arglists.lisp1615
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-asdf.lisp536
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-c-p-c.lisp298
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-clipboard.lisp71
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-fancy-inspector.lisp1004
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-fuzzy.lisp706
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-hyperdoc.lisp18
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-indentation.lisp140
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-kawa.scm2498
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-larceny.scm176
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-listener-hooks.lisp91
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-macrostep.lisp227
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-media.lisp25
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-mit-scheme.scm882
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-mrepl.lisp162
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-package-fu.lisp65
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-presentation-streams.lisp334
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-presentations.lisp246
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-quicklisp.lisp17
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-r6rs.scm416
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-repl.lisp450
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-sbcl-exts.lisp64
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-snapshot.lisp67
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-sprof.lisp154
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-trace-dialog.lisp264
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-util.lisp63
-rw-r--r--vim/bundle/slimv/slime/metering.lisp1213
-rw-r--r--vim/bundle/slimv/slime/nregex.lisp523
-rw-r--r--vim/bundle/slimv/slime/packages.lisp194
-rw-r--r--vim/bundle/slimv/slime/sbcl-pprint-patch.lisp332
-rw-r--r--vim/bundle/slimv/slime/slime.el7501
-rw-r--r--vim/bundle/slimv/slime/start-swank.lisp39
-rw-r--r--vim/bundle/slimv/slime/swank-loader.lisp366
-rw-r--r--vim/bundle/slimv/slime/swank.asd37
-rw-r--r--vim/bundle/slimv/slime/swank.lisp3743
-rw-r--r--vim/bundle/slimv/slime/swank/abcl.lisp847
-rw-r--r--vim/bundle/slimv/slime/swank/allegro.lisp1053
-rw-r--r--vim/bundle/slimv/slime/swank/backend.lisp1536
-rw-r--r--vim/bundle/slimv/slime/swank/ccl.lisp861
-rw-r--r--vim/bundle/slimv/slime/swank/clasp.lisp730
-rw-r--r--vim/bundle/slimv/slime/swank/clisp.lisp930
-rw-r--r--vim/bundle/slimv/slime/swank/cmucl.lisp2470
-rw-r--r--vim/bundle/slimv/slime/swank/corman.lisp583
-rw-r--r--vim/bundle/slimv/slime/swank/ecl.lisp845
-rw-r--r--vim/bundle/slimv/slime/swank/gray.lisp170
-rw-r--r--vim/bundle/slimv/slime/swank/lispworks.lisp1018
-rw-r--r--vim/bundle/slimv/slime/swank/match.lisp242
-rw-r--r--vim/bundle/slimv/slime/swank/mkcl.lisp933
-rw-r--r--vim/bundle/slimv/slime/swank/rpc.lisp162
-rw-r--r--vim/bundle/slimv/slime/swank/sbcl.lisp2044
-rw-r--r--vim/bundle/slimv/slime/swank/scl.lisp1726
-rw-r--r--vim/bundle/slimv/slime/swank/source-file-cache.lisp136
-rw-r--r--vim/bundle/slimv/slime/swank/source-path-parser.lisp239
-rw-r--r--vim/bundle/slimv/slime/xref.lisp2906
-rw-r--r--vim/bundle/slimv/swank-clojure/COPYING227
-rw-r--r--vim/bundle/slimv/swank-clojure/README.md152
-rw-r--r--vim/bundle/slimv/swank-clojure/leiningen/swank.clj30
-rw-r--r--vim/bundle/slimv/swank-clojure/project.clj9
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/clj_contrib/macroexpand.clj17
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/clj_contrib/pprint.clj34
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/commands.clj14
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/commands/basic.clj601
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/commands/completion.clj103
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/commands/contrib.clj9
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_arglists.clj123
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c.clj21
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c/internal.clj59
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_fuzzy.clj428
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/commands/indent.clj100
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/commands/inspector.clj323
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/commands/xref.clj51
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/core.clj388
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/core/connection.clj68
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/core/hooks.clj4
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/core/protocol.clj50
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/core/server.clj102
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/core/threadmap.clj29
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/dev.clj6
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/loader.clj101
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/rpc.clj159
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/swank.clj92
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/util.clj72
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/util/class_browse.clj149
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/util/clojure.clj33
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/util/concurrent/mbox.clj31
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/util/concurrent/thread.clj50
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/util/hooks.clj12
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/util/io.clj40
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/util/java.clj16
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/util/net/sockets.clj57
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/util/string.clj16
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/util/sys.clj13
-rw-r--r--vim/bundle/slimv/syntax/clojure/slimv-syntax-clojure.vim99
-rw-r--r--vim/bundle/slimv/syntax/lisp/slimv-syntax-lisp.vim21
-rw-r--r--vim/bundle/slimv/syntax/scheme/slimv-syntax-scheme.vim89
-rw-r--r--vim/bundle/tabular/.gitignore1
-rw-r--r--vim/bundle/tabular/LICENSE.md24
-rw-r--r--vim/bundle/tabular/README.md29
-rw-r--r--vim/bundle/tabular/after/plugin/TabularMaps.vim73
-rw-r--r--vim/bundle/tabular/autoload/tabular.vim409
-rw-r--r--vim/bundle/tabular/doc/Tabular.txt260
-rw-r--r--vim/bundle/tabular/plugin/Tabular.vim346
-rw-r--r--vim/bundle/vim-fugitive/.gitignore1
-rw-r--r--vim/bundle/vim-fugitive/CONTRIBUTING.markdown18
-rw-r--r--vim/bundle/vim-fugitive/README.markdown118
-rw-r--r--vim/bundle/vim-fugitive/doc/fugitive.txt357
-rw-r--r--vim/bundle/vim-fugitive/plugin/fugitive.vim3105
-rw-r--r--vim/bundle/vim-racer/.gitignore1
-rw-r--r--vim/bundle/vim-racer/README.md60
-rw-r--r--vim/bundle/vim-racer/autoload/racer.vim265
-rw-r--r--vim/bundle/vim-racer/ftplugin/rust_racer.vim44
-rw-r--r--vim/bundle/vim-racer/rplugin/python3/deoplete/sources/racer.py111
-rw-r--r--vim/bundle/vim-racer/syntax/rustdoc.vim178
-rw-r--r--vim/colors/apprentice.vim2
-rw-r--r--vim/ftplugin/rust.vim12
-rw-r--r--vim/gvimrc2
-rw-r--r--vim/main.vim83
-rw-r--r--vim/vim-surround/.gitignore1
-rw-r--r--vim/vim-surround/README.markdown97
-rw-r--r--vim/vim-surround/doc/surround.txt207
-rw-r--r--vim/vim-surround/plugin/surround.vim598
161 files changed, 73960 insertions, 28 deletions
diff --git a/vim/autoload/pathogen.vim b/vim/autoload/pathogen.vim
new file mode 100644
index 0000000..dbe07f0
--- /dev/null
+++ b/vim/autoload/pathogen.vim
@@ -0,0 +1,289 @@
+" pathogen.vim - path option manipulation
+" Maintainer: Tim Pope <http://tpo.pe/>
+" Version: 2.4
+
+" Install in ~/.vim/autoload (or ~\vimfiles\autoload).
+"
+" For management of individually installed plugins in ~/.vim/bundle (or
+" ~\vimfiles\bundle), adding `execute pathogen#infect()` to the top of your
+" .vimrc is the only other setup necessary.
+"
+" The API is documented inline below.
+
+if exists("g:loaded_pathogen") || &cp
+ finish
+endif
+let g:loaded_pathogen = 1
+
+" Point of entry for basic default usage. Give a relative path to invoke
+" pathogen#interpose() (defaults to "bundle/{}"), or an absolute path to invoke
+" pathogen#surround(). Curly braces are expanded with pathogen#expand():
+" "bundle/{}" finds all subdirectories inside "bundle" inside all directories
+" in the runtime path.
+function! pathogen#infect(...) abort
+ for path in a:0 ? filter(reverse(copy(a:000)), 'type(v:val) == type("")') : ['bundle/{}']
+ if path =~# '^\%({\=[$~\\/]\|{\=\w:[\\/]\).*[{}*]'
+ call pathogen#surround(path)
+ elseif path =~# '^\%([$~\\/]\|\w:[\\/]\)'
+ call s:warn('Change pathogen#infect('.string(path).') to pathogen#infect('.string(path.'/{}').')')
+ call pathogen#surround(path . '/{}')
+ elseif path =~# '[{}*]'
+ call pathogen#interpose(path)
+ else
+ call s:warn('Change pathogen#infect('.string(path).') to pathogen#infect('.string(path.'/{}').')')
+ call pathogen#interpose(path . '/{}')
+ endif
+ endfor
+ call pathogen#cycle_filetype()
+ if pathogen#is_disabled($MYVIMRC)
+ return 'finish'
+ endif
+ return ''
+endfunction
+
+" Split a path into a list.
+function! pathogen#split(path) abort
+ if type(a:path) == type([]) | return a:path | endif
+ if empty(a:path) | return [] | endif
+ let split = split(a:path,'\\\@<!\%(\\\\\)*\zs,')
+ return map(split,'substitute(v:val,''\\\([\\,]\)'',''\1'',"g")')
+endfunction
+
+" Convert a list to a path.
+function! pathogen#join(...) abort
+ if type(a:1) == type(1) && a:1
+ let i = 1
+ let space = ' '
+ else
+ let i = 0
+ let space = ''
+ endif
+ let path = ""
+ while i < a:0
+ if type(a:000[i]) == type([])
+ let list = a:000[i]
+ let j = 0
+ while j < len(list)
+ let escaped = substitute(list[j],'[,'.space.']\|\\[\,'.space.']\@=','\\&','g')
+ let path .= ',' . escaped
+ let j += 1
+ endwhile
+ else
+ let path .= "," . a:000[i]
+ endif
+ let i += 1
+ endwhile
+ return substitute(path,'^,','','')
+endfunction
+
+" Convert a list to a path with escaped spaces for 'path', 'tag', etc.
+function! pathogen#legacyjoin(...) abort
+ return call('pathogen#join',[1] + a:000)
+endfunction
+
+" Turn filetype detection off and back on again if it was already enabled.
+function! pathogen#cycle_filetype() abort
+ if exists('g:did_load_filetypes')
+ filetype off
+ filetype on
+ endif
+endfunction
+
+" Check if a bundle is disabled. A bundle is considered disabled if its
+" basename or full name is included in the list g:pathogen_blacklist or the
+" comma delimited environment variable $VIMBLACKLIST.
+function! pathogen#is_disabled(path) abort
+ if a:path =~# '\~$'
+ return 1
+ endif
+ let sep = pathogen#slash()
+ let blacklist =
+ \ get(g:, 'pathogen_blacklist', get(g:, 'pathogen_disabled', [])) +
+ \ pathogen#split($VIMBLACKLIST)
+ if !empty(blacklist)
+ call map(blacklist, 'substitute(v:val, "[\\/]$", "", "")')
+ endif
+ return index(blacklist, fnamemodify(a:path, ':t')) != -1 || index(blacklist, a:path) != -1
+endfunction
+
+" Prepend the given directory to the runtime path and append its corresponding
+" after directory. Curly braces are expanded with pathogen#expand().
+function! pathogen#surround(path) abort
+ let sep = pathogen#slash()
+ let rtp = pathogen#split(&rtp)
+ let path = fnamemodify(a:path, ':s?[\\/]\=$??')
+ let before = filter(pathogen#expand(path), '!pathogen#is_disabled(v:val)')
+ let after = filter(reverse(pathogen#expand(path, sep.'after')), '!pathogen#is_disabled(v:val[0:-7])')
+ call filter(rtp, 'index(before + after, v:val) == -1')
+ let &rtp = pathogen#join(before, rtp, after)
+ return &rtp
+endfunction
+
+" For each directory in the runtime path, add a second entry with the given
+" argument appended. Curly braces are expanded with pathogen#expand().
+function! pathogen#interpose(name) abort
+ let sep = pathogen#slash()
+ let name = a:name
+ if has_key(s:done_bundles, name)
+ return ""
+ endif
+ let s:done_bundles[name] = 1
+ let list = []
+ for dir in pathogen#split(&rtp)
+ if dir =~# '\<after$'
+ let list += reverse(filter(pathogen#expand(dir[0:-6].name, sep.'after'), '!pathogen#is_disabled(v:val[0:-7])')) + [dir]
+ else
+ let list += [dir] + filter(pathogen#expand(dir.sep.name), '!pathogen#is_disabled(v:val)')
+ endif
+ endfor
+ let &rtp = pathogen#join(pathogen#uniq(list))
+ return 1
+endfunction
+
+let s:done_bundles = {}
+
+" Invoke :helptags on all non-$VIM doc directories in runtimepath.
+function! pathogen#helptags() abort
+ let sep = pathogen#slash()
+ for glob in pathogen#split(&rtp)
+ for dir in map(split(glob(glob), "\n"), 'v:val.sep."/doc/".sep')
+ if (dir)[0 : strlen($VIMRUNTIME)] !=# $VIMRUNTIME.sep && filewritable(dir) == 2 && !empty(split(glob(dir.'*.txt'))) && (!filereadable(dir.'tags') || filewritable(dir.'tags'))
+ silent! execute 'helptags' pathogen#fnameescape(dir)
+ endif
+ endfor
+ endfor
+endfunction
+
+command! -bar Helptags :call pathogen#helptags()
+
+" Execute the given command. This is basically a backdoor for --remote-expr.
+function! pathogen#execute(...) abort
+ for command in a:000
+ execute command
+ endfor
+ return ''
+endfunction
+
+" Section: Unofficial
+
+function! pathogen#is_absolute(path) abort
+ return a:path =~# (has('win32') ? '^\%([\\/]\|\w:\)[\\/]\|^[~$]' : '^[/~$]')
+endfunction
+
+" Given a string, returns all possible permutations of comma delimited braced
+" alternatives of that string. pathogen#expand('/{a,b}/{c,d}') yields
+" ['/a/c', '/a/d', '/b/c', '/b/d']. Empty braces are treated as a wildcard
+" and globbed. Actual globs are preserved.
+function! pathogen#expand(pattern, ...) abort
+ let after = a:0 ? a:1 : ''
+ if a:pattern =~# '{[^{}]\+}'
+ let [pre, pat, post] = split(substitute(a:pattern, '\(.\{-\}\){\([^{}]\+\)}\(.*\)', "\\1\001\\2\001\\3", ''), "\001", 1)
+ let found = map(split(pat, ',', 1), 'pre.v:val.post')
+ let results = []
+ for pattern in found
+ call extend(results, pathogen#expand(pattern))
+ endfor
+ elseif a:pattern =~# '{}'
+ let pat = matchstr(a:pattern, '^.*{}[^*]*\%($\|[\\/]\)')
+ let post = a:pattern[strlen(pat) : -1]
+ let results = map(split(glob(substitute(pat, '{}', '*', 'g')), "\n"), 'v:val.post')
+ else
+ let results = [a:pattern]
+ endif
+ let vf = pathogen#slash() . 'vimfiles'
+ call map(results, 'v:val =~# "\\*" ? v:val.after : isdirectory(v:val.vf.after) ? v:val.vf.after : isdirectory(v:val.after) ? v:val.after : ""')
+ return filter(results, '!empty(v:val)')
+endfunction
+
+" \ on Windows unless shellslash is set, / everywhere else.
+function! pathogen#slash() abort
+ return !exists("+shellslash") || &shellslash ? '/' : '\'
+endfunction
+
+function! pathogen#separator() abort
+ return pathogen#slash()
+endfunction
+
+" Convenience wrapper around glob() which returns a list.
+function! pathogen#glob(pattern) abort
+ let files = split(glob(a:pattern),"\n")
+ return map(files,'substitute(v:val,"[".pathogen#slash()."/]$","","")')
+endfunction
+
+" Like pathogen#glob(), only limit the results to directories.
+function! pathogen#glob_directories(pattern) abort
+ return filter(pathogen#glob(a:pattern),'isdirectory(v:val)')
+endfunction
+
+" Remove duplicates from a list.
+function! pathogen#uniq(list) abort
+ let i = 0
+ let seen = {}
+ while i < len(a:list)
+ if (a:list[i] ==# '' && exists('empty')) || has_key(seen,a:list[i])
+ call remove(a:list,i)
+ elseif a:list[i] ==# ''
+ let i += 1
+ let empty = 1
+ else
+ let seen[a:list[i]] = 1
+ let i += 1
+ endif
+ endwhile
+ return a:list
+endfunction
+
+" Backport of fnameescape().
+function! pathogen#fnameescape(string) abort
+ if exists('*fnameescape')
+ return fnameescape(a:string)
+ elseif a:string ==# '-'
+ return '\-'
+ else
+ return substitute(escape(a:string," \t\n*?[{`$\\%#'\"|!<"),'^[+>]','\\&','')
+ endif
+endfunction
+
+" Like findfile(), but hardcoded to use the runtimepath.
+function! pathogen#runtime_findfile(file,count) abort
+ let rtp = pathogen#join(1,pathogen#split(&rtp))
+ let file = findfile(a:file,rtp,a:count)
+ if file ==# ''
+ return ''
+ else
+ return fnamemodify(file,':p')
+ endif
+endfunction
+
+" Section: Deprecated
+
+function! s:warn(msg) abort
+ echohl WarningMsg
+ echomsg a:msg
+ echohl NONE
+endfunction
+
+" Prepend all subdirectories of path to the rtp, and append all 'after'
+" directories in those subdirectories. Deprecated.
+function! pathogen#runtime_prepend_subdirectories(path) abort
+ call s:warn('Change pathogen#runtime_prepend_subdirectories('.string(a:path).') to pathogen#infect('.string(a:path.'/{}').')')
+ return pathogen#surround(a:path . pathogen#slash() . '{}')
+endfunction
+
+function! pathogen#incubate(...) abort
+ let name = a:0 ? a:1 : 'bundle/{}'
+ call s:warn('Change pathogen#incubate('.(a:0 ? string(a:1) : '').') to pathogen#infect('.string(name).')')
+ return pathogen#interpose(name)
+endfunction
+
+" Deprecated alias for pathogen#interpose().
+function! pathogen#runtime_append_all_bundles(...) abort
+ if a:0
+ call s:warn('Change pathogen#runtime_append_all_bundles('.string(a:1).') to pathogen#infect('.string(a:1.'/{}').')')
+ else
+ call s:warn('Change pathogen#runtime_append_all_bundles() to pathogen#infect()')
+ endif
+ return pathogen#interpose(a:0 ? a:1 . '/{}' : 'bundle/{}')
+endfunction
+
+" vim:set et sw=2 foldmethod=expr foldexpr=getline(v\:lnum)=~'^\"\ Section\:'?'>1'\:getline(v\:lnum)=~#'^fu'?'a1'\:getline(v\:lnum)=~#'^endf'?'s1'\:'=':
diff --git a/vim/bundle/rust.vim/.gitignore b/vim/bundle/rust.vim/.gitignore
new file mode 100644
index 0000000..0a56e3f
--- /dev/null
+++ b/vim/bundle/rust.vim/.gitignore
@@ -0,0 +1 @@
+/doc/tags
diff --git a/vim/bundle/rust.vim/LICENSE-APACHE b/vim/bundle/rust.vim/LICENSE-APACHE
new file mode 100644
index 0000000..16fe87b
--- /dev/null
+++ b/vim/bundle/rust.vim/LICENSE-APACHE
@@ -0,0 +1,201 @@
+ Apache License
+ Version 2.0, January 2004
+ http://www.apache.org/licenses/
+
+TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+1. Definitions.
+
+ "License" shall mean the terms and conditions for use, reproduction,
+ and distribution as defined by Sections 1 through 9 of this document.
+
+ "Licensor" shall mean the copyright owner or entity authorized by
+ the copyright owner that is granting the License.
+
+ "Legal Entity" shall mean the union of the acting entity and all
+ other entities that control, are controlled by, or are under common
+ control with that entity. For the purposes of this definition,
+ "control" means (i) the power, direct or indirect, to cause the
+ direction or management of such entity, whether by contract or
+ otherwise, or (ii) ownership of fifty percent (50%) or more of the
+ outstanding shares, or (iii) beneficial ownership of such entity.
+
+ "You" (or "Your") shall mean an individual or Legal Entity
+ exercising permissions granted by this License.
+
+ "Source" form shall mean the preferred form for making modifications,
+ including but not limited to software source code, documentation
+ source, and configuration files.
+
+ "Object" form shall mean any form resulting from mechanical
+ transformation or translation of a Source form, including but
+ not limited to compiled object code, generated documentation,
+ and conversions to other media types.
+
+ "Work" shall mean the work of authorship, whether in Source or
+ Object form, made available under the License, as indicated by a
+ copyright notice that is included in or attached to the work
+ (an example is provided in the Appendix below).
+
+ "Derivative Works" shall mean any work, whether in Source or Object
+ form, that is based on (or derived from) the Work and for which the
+ editorial revisions, annotations, elaborations, or other modifications
+ represent, as a whole, an original work of authorship. For the purposes
+ of this License, Derivative Works shall not include works that remain
+ separable from, or merely link (or bind by name) to the interfaces of,
+ the Work and Derivative Works thereof.
+
+ "Contribution" shall mean any work of authorship, including
+ the original version of the Work and any modifications or additions
+ to that Work or Derivative Works thereof, that is intentionally
+ submitted to Licensor for inclusion in the Work by the copyright owner
+ or by an individual or Legal Entity authorized to submit on behalf of
+ the copyright owner. For the purposes of this definition, "submitted"
+ means any form of electronic, verbal, or written communication sent
+ to the Licensor or its representatives, including but not limited to
+ communication on electronic mailing lists, source code control systems,
+ and issue tracking systems that are managed by, or on behalf of, the
+ Licensor for the purpose of discussing and improving the Work, but
+ excluding communication that is conspicuously marked or otherwise
+ designated in writing by the copyright owner as "Not a Contribution."
+
+ "Contributor" shall mean Licensor and any individual or Legal Entity
+ on behalf of whom a Contribution has been received by Licensor and
+ subsequently incorporated within the Work.
+
+2. Grant of Copyright License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ copyright license to reproduce, prepare Derivative Works of,
+ publicly display, publicly perform, sublicense, and distribute the
+ Work and such Derivative Works in Source or Object form.
+
+3. Grant of Patent License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ (except as stated in this section) patent license to make, have made,
+ use, offer to sell, sell, import, and otherwise transfer the Work,
+ where such license applies only to those patent claims licensable
+ by such Contributor that are necessarily infringed by their
+ Contribution(s) alone or by combination of their Contribution(s)
+ with the Work to which such Contribution(s) was submitted. If You
+ institute patent litigation against any entity (including a
+ cross-claim or counterclaim in a lawsuit) alleging that the Work
+ or a Contribution incorporated within the Work constitutes direct
+ or contributory patent infringement, then any patent licenses
+ granted to You under this License for that Work shall terminate
+ as of the date such litigation is filed.
+
+4. Redistribution. You may reproduce and distribute copies of the
+ Work or Derivative Works thereof in any medium, with or without
+ modifications, and in Source or Object form, provided that You
+ meet the following conditions:
+
+ (a) You must give any other recipients of the Work or
+ Derivative Works a copy of this License; and
+
+ (b) You must cause any modified files to carry prominent notices
+ stating that You changed the files; and
+
+ (c) You must retain, in the Source form of any Derivative Works
+ that You distribute, all copyright, patent, trademark, and
+ attribution notices from the Source form of the Work,
+ excluding those notices that do not pertain to any part of
+ the Derivative Works; and
+
+ (d) If the Work includes a "NOTICE" text file as part of its
+ distribution, then any Derivative Works that You distribute must
+ include a readable copy of the attribution notices contained
+ within such NOTICE file, excluding those notices that do not
+ pertain to any part of the Derivative Works, in at least one
+ of the following places: within a NOTICE text file distributed
+ as part of the Derivative Works; within the Source form or
+ documentation, if provided along with the Derivative Works; or,
+ within a display generated by the Derivative Works, if and
+ wherever such third-party notices normally appear. The contents
+ of the NOTICE file are for informational purposes only and
+ do not modify the License. You may add Your own attribution
+ notices within Derivative Works that You distribute, alongside
+ or as an addendum to the NOTICE text from the Work, provided
+ that such additional attribution notices cannot be construed
+ as modifying the License.
+
+ You may add Your own copyright statement to Your modifications and
+ may provide additional or different license terms and conditions
+ for use, reproduction, or distribution of Your modifications, or
+ for any such Derivative Works as a whole, provided Your use,
+ reproduction, and distribution of the Work otherwise complies with
+ the conditions stated in this License.
+
+5. Submission of Contributions. Unless You explicitly state otherwise,
+ any Contribution intentionally submitted for inclusion in the Work
+ by You to the Licensor shall be under the terms and conditions of
+ this License, without any additional terms or conditions.
+ Notwithstanding the above, nothing herein shall supersede or modify
+ the terms of any separate license agreement you may have executed
+ with Licensor regarding such Contributions.
+
+6. Trademarks. This License does not grant permission to use the trade
+ names, trademarks, service marks, or product names of the Licensor,
+ except as required for reasonable and customary use in describing the
+ origin of the Work and reproducing the content of the NOTICE file.
+
+7. Disclaimer of Warranty. Unless required by applicable law or
+ agreed to in writing, Licensor provides the Work (and each
+ Contributor provides its Contributions) on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ implied, including, without limitation, any warranties or conditions
+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+ PARTICULAR PURPOSE. You are solely responsible for determining the
+ appropriateness of using or redistributing the Work and assume any
+ risks associated with Your exercise of permissions under this License.
+
+8. Limitation of Liability. In no event and under no legal theory,
+ whether in tort (including negligence), contract, or otherwise,
+ unless required by applicable law (such as deliberate and grossly
+ negligent acts) or agreed to in writing, shall any Contributor be
+ liable to You for damages, including any direct, indirect, special,
+ incidental, or consequential damages of any character arising as a
+ result of this License or out of the use or inability to use the
+ Work (including but not limited to damages for loss of goodwill,
+ work stoppage, computer failure or malfunction, or any and all
+ other commercial damages or losses), even if such Contributor
+ has been advised of the possibility of such damages.
+
+9. Accepting Warranty or Additional Liability. While redistributing
+ the Work or Derivative Works thereof, You may choose to offer,
+ and charge a fee for, acceptance of support, warranty, indemnity,
+ or other liability obligations and/or rights consistent with this
+ License. However, in accepting such obligations, You may act only
+ on Your own behalf and on Your sole responsibility, not on behalf
+ of any other Contributor, and only if You agree to indemnify,
+ defend, and hold each Contributor harmless for any liability
+ incurred by, or claims asserted against, such Contributor by reason
+ of your accepting any such warranty or additional liability.
+
+END OF TERMS AND CONDITIONS
+
+APPENDIX: How to apply the Apache License to your work.
+
+ To apply the Apache License to your work, attach the following
+ boilerplate notice, with the fields enclosed by brackets "[]"
+ replaced with your own identifying information. (Don't include
+ the brackets!) The text should be enclosed in the appropriate
+ comment syntax for the file format. We also recommend that a
+ file or class name and description of purpose be included on the
+ same "printed page" as the copyright notice for easier
+ identification within third-party archives.
+
+Copyright [yyyy] [name of copyright owner]
+
+Licensed under the Apache License, Version 2.0 (the "License");
+you may not use this file except in compliance with the License.
+You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+Unless required by applicable law or agreed to in writing, software
+distributed under the License is distributed on an "AS IS" BASIS,
+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+See the License for the specific language governing permissions and
+limitations under the License.
diff --git a/vim/bundle/rust.vim/LICENSE-MIT b/vim/bundle/rust.vim/LICENSE-MIT
new file mode 100644
index 0000000..e69282e
--- /dev/null
+++ b/vim/bundle/rust.vim/LICENSE-MIT
@@ -0,0 +1,25 @@
+Copyright (c) 2015 The Rust Project Developers
+
+Permission is hereby granted, free of charge, to any
+person obtaining a copy of this software and associated
+documentation files (the "Software"), to deal in the
+Software without restriction, including without
+limitation the rights to use, copy, modify, merge,
+publish, distribute, sublicense, and/or sell copies of
+the Software, and to permit persons to whom the Software
+is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice
+shall be included in all copies or substantial portions
+of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF
+ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED
+TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
+PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT
+SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR
+IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+DEALINGS IN THE SOFTWARE.
diff --git a/vim/bundle/rust.vim/README.md b/vim/bundle/rust.vim/README.md
new file mode 100644
index 0000000..9fe8968
--- /dev/null
+++ b/vim/bundle/rust.vim/README.md
@@ -0,0 +1,87 @@
+# rust.vim
+
+## Description
+
+This is a Vim plugin that provides [Rust][r] file detection, syntax highlighting, formatting,
+[Syntastic][syn] integration, and more.
+
+## Installation
+
+### Using [Vundle][v]
+
+1. Add `Plugin 'rust-lang/rust.vim'` to `~/.vimrc`
+2. `:PluginInstall` or `$ vim +PluginInstall +qall`
+
+*Note:* Vundle will not automatically detect Rust files properly if `filetype
+on` is executed before Vundle. Please check the [quickstart][vqs] for more
+details.
+
+### Using [Pathogen][p]
+
+```shell
+git clone --depth=1 https://github.com/rust-lang/rust.vim.git ~/.vim/bundle/rust.vim
+```
+
+### Using [NeoBundle][nb]
+
+1. Add `NeoBundle 'rust-lang/rust.vim'` to `~/.vimrc`
+2. Re-open vim or execute `:source ~/.vimrc`
+
+### Using [vim-plug][vp]
+
+1. Add `Plug 'rust-lang/rust.vim'` to `~/.vimrc`
+2. `:PlugInstall` or `$ vim +PlugInstall +qall`
+
+## Features
+
+### Error checking with [Syntastic][syn]
+
+`rust.vim` automatically registers `rustc` as a syntax checker
+with [Syntastic][syn]. Check Syntastic's documentation for
+information on how to customize its behaviour.
+
+### Formatting with [rustfmt][rfmt]
+
+The `:RustFmt` command will format your code with
+[rustfmt][rfmt] if installed.
+
+Placing `let g:rustfmt_autosave = 1` in your `~/.vimrc` will
+enable automatic running of `:RustFmt` when you save a buffer.
+
+Do `:help :RustFmt` for further formatting help and customization
+options.
+
+### [Playpen][pp] integration
+
+*Note:* This feature requires [webapi-vim][wav] to be installed.
+
+The `:RustPlay` command will send the current selection, or if
+nothing is selected the current buffer, to the [Rust playpen][pp].
+
+[rfmt]: https://crates.io/crates/rustfmt/
+
+## Help
+
+Further help can be found in the documentation with `:Helptags` then `:help rust`.
+
+Detailed help can be found in the documentation with `:help rust`.
+Helptags (`:help helptags`) need to be generated for this plugin
+in order to navigate the help. Most plugin managers will do this
+automatically, but check their documentation if that is not the case.
+
+## License
+
+Like Rust, rust.vim is primarily distributed under the terms of both the MIT
+license and the Apache License (Version 2.0). See LICENSE-APACHE and
+LICENSE-MIT for details.
+
+[r]: https://www.rust-lang.org
+[v]: https://github.com/gmarik/vundle
+[vqs]: https://github.com/gmarik/vundle#quick-start
+[p]: https://github.com/tpope/vim-pathogen
+[nb]: https://github.com/Shougo/neobundle.vim
+[vp]: https://github.com/junegunn/vim-plug
+[rfmt]: https://github.com/rust-lang-nursery/rustfmt
+[syn]: https://github.com/scrooloose/syntastic
+[wav]: https://github.com/mattn/webapi-vim
+[pp]: https://play.rust-lang.org/
diff --git a/vim/bundle/rust.vim/after/syntax/rust.vim b/vim/bundle/rust.vim/after/syntax/rust.vim
new file mode 100644
index 0000000..b0f7e62
--- /dev/null
+++ b/vim/bundle/rust.vim/after/syntax/rust.vim
@@ -0,0 +1,34 @@
+if !exists('g:rust_conceal') || g:rust_conceal == 0 || !has('conceal') || &enc != 'utf-8'
+ finish
+endif
+
+" For those who don't want to see `::`...
+if exists('g:rust_conceal_mod_path') && g:rust_conceal_mod_path != 0
+ syn match rustNiceOperator "::" conceal cchar=ã†
+endif
+
+syn match rustRightArrowHead contained ">" conceal cchar= 
+syn match rustRightArrowTail contained "-" conceal cchar=⟶
+syn match rustNiceOperator "->" contains=rustRightArrowHead,rustRightArrowTail
+
+syn match rustFatRightArrowHead contained ">" conceal cchar= 
+syn match rustFatRightArrowTail contained "=" conceal cchar=⟹
+syn match rustNiceOperator "=>" contains=rustFatRightArrowHead,rustFatRightArrowTail
+
+syn match rustNiceOperator /\<\@!_\(_*\>\)\@=/ conceal cchar=′
+
+" For those who don't want to see `pub`...
+if exists('g:rust_conceal_pub') && g:rust_conceal_pub != 0
+ syn match rustPublicSigil contained "pu" conceal cchar=*
+ syn match rustPublicRest contained "b" conceal cchar= 
+ syn match rustNiceOperator "pub " contains=rustPublicSigil,rustPublicRest
+endif
+
+hi link rustNiceOperator Operator
+
+if !(exists('g:rust_conceal_mod_path') && g:rust_conceal_mod_path != 0)
+ hi! link Conceal Operator
+
+ " And keep it after a colorscheme change
+ au ColorScheme <buffer> hi! link Conceal Operator
+endif
diff --git a/vim/bundle/rust.vim/autoload/rust.vim b/vim/bundle/rust.vim/autoload/rust.vim
new file mode 100644
index 0000000..477f3c4
--- /dev/null
+++ b/vim/bundle/rust.vim/autoload/rust.vim
@@ -0,0 +1,414 @@
+" Author: Kevin Ballard
+" Description: Helper functions for Rust commands/mappings
+" Last Modified: May 27, 2014
+
+" Jump {{{1
+
+function! rust#Jump(mode, function) range
+ let cnt = v:count1
+ normal! m'
+ if a:mode ==# 'v'
+ norm! gv
+ endif
+ let foldenable = &foldenable
+ set nofoldenable
+ while cnt > 0
+ execute "call <SID>Jump_" . a:function . "()"
+ let cnt = cnt - 1
+ endwhile
+ let &foldenable = foldenable
+endfunction
+
+function! s:Jump_Back()
+ call search('{', 'b')
+ keepjumps normal! w99[{
+endfunction
+
+function! s:Jump_Forward()
+ normal! j0
+ call search('{', 'b')
+ keepjumps normal! w99[{%
+ call search('{')
+endfunction
+
+" Run {{{1
+
+function! rust#Run(bang, args)
+ let args = s:ShellTokenize(a:args)
+ if a:bang
+ let idx = index(l:args, '--')
+ if idx != -1
+ let rustc_args = idx == 0 ? [] : l:args[:idx-1]
+ let args = l:args[idx+1:]
+ else
+ let rustc_args = l:args
+ let args = []
+ endif
+ else
+ let rustc_args = []
+ endif
+
+ let b:rust_last_rustc_args = l:rustc_args
+ let b:rust_last_args = l:args
+
+ call s:WithPath(function("s:Run"), rustc_args, args)
+endfunction
+
+function! s:Run(dict, rustc_args, args)
+ let exepath = a:dict.tmpdir.'/'.fnamemodify(a:dict.path, ':t:r')
+ if has('win32')
+ let exepath .= '.exe'
+ endif
+
+ let relpath = get(a:dict, 'tmpdir_relpath', a:dict.path)
+ let rustc_args = [relpath, '-o', exepath] + a:rustc_args
+
+ let rustc = exists("g:rustc_path") ? g:rustc_path : "rustc"
+
+ let pwd = a:dict.istemp ? a:dict.tmpdir : ''
+ let output = s:system(pwd, shellescape(rustc) . " " . join(map(rustc_args, 'shellescape(v:val)')))
+ if output != ''
+ echohl WarningMsg
+ echo output
+ echohl None
+ endif
+ if !v:shell_error
+ exe '!' . shellescape(exepath) . " " . join(map(a:args, 'shellescape(v:val)'))
+ endif
+endfunction
+
+" Expand {{{1
+
+function! rust#Expand(bang, args)
+ let args = s:ShellTokenize(a:args)
+ if a:bang && !empty(l:args)
+ let pretty = remove(l:args, 0)
+ else
+ let pretty = "expanded"
+ endif
+ call s:WithPath(function("s:Expand"), pretty, args)
+endfunction
+
+function! s:Expand(dict, pretty, args)
+ try
+ let rustc = exists("g:rustc_path") ? g:rustc_path : "rustc"
+
+ if a:pretty =~? '^\%(everybody_loops$\|flowgraph=\)'
+ let flag = '--xpretty'
+ else
+ let flag = '--pretty'
+ endif
+ let relpath = get(a:dict, 'tmpdir_relpath', a:dict.path)
+ let args = [relpath, '-Z', 'unstable-options', l:flag, a:pretty] + a:args
+ let pwd = a:dict.istemp ? a:dict.tmpdir : ''
+ let output = s:system(pwd, shellescape(rustc) . " " . join(map(args, 'shellescape(v:val)')))
+ if v:shell_error
+ echohl WarningMsg
+ echo output
+ echohl None
+ else
+ new
+ silent put =output
+ 1
+ d
+ setl filetype=rust
+ setl buftype=nofile
+ setl bufhidden=hide
+ setl noswapfile
+ " give the buffer a nice name
+ let suffix = 1
+ let basename = fnamemodify(a:dict.path, ':t:r')
+ while 1
+ let bufname = basename
+ if suffix > 1 | let bufname .= ' ('.suffix.')' | endif
+ let bufname .= '.pretty.rs'
+ if bufexists(bufname)
+ let suffix += 1
+ continue
+ endif
+ exe 'silent noautocmd keepalt file' fnameescape(bufname)
+ break
+ endwhile
+ endif
+ endtry
+endfunction
+
+function! rust#CompleteExpand(lead, line, pos)
+ if a:line[: a:pos-1] =~ '^RustExpand!\s*\S*$'
+ " first argument and it has a !
+ let list = ["normal", "expanded", "typed", "expanded,identified", "flowgraph=", "everybody_loops"]
+ if !empty(a:lead)
+ call filter(list, "v:val[:len(a:lead)-1] == a:lead")
+ endif
+ return list
+ endif
+
+ return glob(escape(a:lead, "*?[") . '*', 0, 1)
+endfunction
+
+" Emit {{{1
+
+function! rust#Emit(type, args)
+ let args = s:ShellTokenize(a:args)
+ call s:WithPath(function("s:Emit"), a:type, args)
+endfunction
+
+function! s:Emit(dict, type, args)
+ try
+ let output_path = a:dict.tmpdir.'/output'
+
+ let rustc = exists("g:rustc_path") ? g:rustc_path : "rustc"
+
+ let relpath = get(a:dict, 'tmpdir_relpath', a:dict.path)
+ let args = [relpath, '--emit', a:type, '-o', output_path] + a:args
+ let pwd = a:dict.istemp ? a:dict.tmpdir : ''
+ let output = s:system(pwd, shellescape(rustc) . " " . join(map(args, 'shellescape(v:val)')))
+ if output != ''
+ echohl WarningMsg
+ echo output
+ echohl None
+ endif
+ if !v:shell_error
+ new
+ exe 'silent keepalt read' fnameescape(output_path)
+ 1
+ d
+ if a:type == "llvm-ir"
+ setl filetype=llvm
+ let extension = 'll'
+ elseif a:type == "asm"
+ setl filetype=asm
+ let extension = 's'
+ endif
+ setl buftype=nofile
+ setl bufhidden=hide
+ setl noswapfile
+ if exists('l:extension')
+ " give the buffer a nice name
+ let suffix = 1
+ let basename = fnamemodify(a:dict.path, ':t:r')
+ while 1
+ let bufname = basename
+ if suffix > 1 | let bufname .= ' ('.suffix.')' | endif
+ let bufname .= '.'.extension
+ if bufexists(bufname)
+ let suffix += 1
+ continue
+ endif
+ exe 'silent noautocmd keepalt file' fnameescape(bufname)
+ break
+ endwhile
+ endif
+ endif
+ endtry
+endfunction
+
+" Utility functions {{{1
+
+" Invokes func(dict, ...)
+" Where {dict} is a dictionary with the following keys:
+" 'path' - The path to the file
+" 'tmpdir' - The path to a temporary directory that will be deleted when the
+" function returns.
+" 'istemp' - 1 if the path is a file inside of {dict.tmpdir} or 0 otherwise.
+" If {istemp} is 1 then an additional key is provided:
+" 'tmpdir_relpath' - The {path} relative to the {tmpdir}.
+"
+" {dict.path} may be a path to a file inside of {dict.tmpdir} or it may be the
+" existing path of the current buffer. If the path is inside of {dict.tmpdir}
+" then it is guaranteed to have a '.rs' extension.
+function! s:WithPath(func, ...)
+ let buf = bufnr('')
+ let saved = {}
+ let dict = {}
+ try
+ let saved.write = &write
+ set write
+ let dict.path = expand('%')
+ let pathisempty = empty(dict.path)
+
+ " Always create a tmpdir in case the wrapped command wants it
+ let dict.tmpdir = tempname()
+ call mkdir(dict.tmpdir)
+
+ if pathisempty || !saved.write
+ let dict.istemp = 1
+ " if we're doing this because of nowrite, preserve the filename
+ if !pathisempty
+ let filename = expand('%:t:r').".rs"
+ else
+ let filename = 'unnamed.rs'
+ endif
+ let dict.tmpdir_relpath = filename
+ let dict.path = dict.tmpdir.'/'.filename
+
+ let saved.mod = &mod
+ set nomod
+
+ silent exe 'keepalt write! ' . fnameescape(dict.path)
+ if pathisempty
+ silent keepalt 0file
+ endif
+ else
+ let dict.istemp = 0
+ update
+ endif
+
+ call call(a:func, [dict] + a:000)
+ finally
+ if bufexists(buf)
+ for [opt, value] in items(saved)
+ silent call setbufvar(buf, '&'.opt, value)
+ unlet value " avoid variable type mismatches
+ endfor
+ endif
+ if has_key(dict, 'tmpdir') | silent call s:RmDir(dict.tmpdir) | endif
+ endtry
+endfunction
+
+function! rust#AppendCmdLine(text)
+ call setcmdpos(getcmdpos())
+ let cmd = getcmdline() . a:text
+ return cmd
+endfunction
+
+" Tokenize the string according to sh parsing rules
+function! s:ShellTokenize(text)
+ " states:
+ " 0: start of word
+ " 1: unquoted
+ " 2: unquoted backslash
+ " 3: double-quote
+ " 4: double-quoted backslash
+ " 5: single-quote
+ let l:state = 0
+ let l:current = ''
+ let l:args = []
+ for c in split(a:text, '\zs')
+ if l:state == 0 || l:state == 1 " unquoted
+ if l:c ==# ' '
+ if l:state == 0 | continue | endif
+ call add(l:args, l:current)
+ let l:current = ''
+ let l:state = 0
+ elseif l:c ==# '\'
+ let l:state = 2
+ elseif l:c ==# '"'
+ let l:state = 3
+ elseif l:c ==# "'"
+ let l:state = 5
+ else
+ let l:current .= l:c
+ let l:state = 1
+ endif
+ elseif l:state == 2 " unquoted backslash
+ if l:c !=# "\n" " can it even be \n?
+ let l:current .= l:c
+ endif
+ let l:state = 1
+ elseif l:state == 3 " double-quote
+ if l:c ==# '\'
+ let l:state = 4
+ elseif l:c ==# '"'
+ let l:state = 1
+ else
+ let l:current .= l:c
+ endif
+ elseif l:state == 4 " double-quoted backslash
+ if stridx('$`"\', l:c) >= 0
+ let l:current .= l:c
+ elseif l:c ==# "\n" " is this even possible?
+ " skip it
+ else
+ let l:current .= '\'.l:c
+ endif
+ let l:state = 3
+ elseif l:state == 5 " single-quoted
+ if l:c == "'"
+ let l:state = 1
+ else
+ let l:current .= l:c
+ endif
+ endif
+ endfor
+ if l:state != 0
+ call add(l:args, l:current)
+ endif
+ return l:args
+endfunction
+
+function! s:RmDir(path)
+ " sanity check; make sure it's not empty, /, or $HOME
+ if empty(a:path)
+ echoerr 'Attempted to delete empty path'
+ return 0
+ elseif a:path == '/' || a:path == $HOME
+ echoerr 'Attempted to delete protected path: ' . a:path
+ return 0
+ endif
+ return system("rm -rf " . shellescape(a:path))
+endfunction
+
+" Executes {cmd} with the cwd set to {pwd}, without changing Vim's cwd.
+" If {pwd} is the empty string then it doesn't change the cwd.
+function! s:system(pwd, cmd)
+ let cmd = a:cmd
+ if !empty(a:pwd)
+ let cmd = 'cd ' . shellescape(a:pwd) . ' && ' . cmd
+ endif
+ return system(cmd)
+endfunction
+
+" Playpen Support {{{1
+" Parts of gist.vim by Yasuhiro Matsumoto <mattn.jp@gmail.com> reused
+" gist.vim available under the BSD license, available at
+" http://github.com/mattn/gist-vim
+function! s:has_webapi()
+ if !exists("*webapi#http#post")
+ try
+ call webapi#http#post()
+ catch
+ endtry
+ endif
+ return exists("*webapi#http#post")
+endfunction
+
+function! rust#Play(count, line1, line2, ...) abort
+ redraw
+
+ let l:rust_playpen_url = get(g:, 'rust_playpen_url', 'https://play.rust-lang.org/')
+ let l:rust_shortener_url = get(g:, 'rust_shortener_url', 'https://is.gd/')
+
+ if !s:has_webapi()
+ echohl ErrorMsg | echomsg ':RustPlay depends on webapi.vim (https://github.com/mattn/webapi-vim)' | echohl None
+ return
+ endif
+
+ let bufname = bufname('%')
+ if a:count < 1
+ let content = join(getline(a:line1, a:line2), "\n")
+ else
+ let save_regcont = @"
+ let save_regtype = getregtype('"')
+ silent! normal! gvy
+ let content = @"
+ call setreg('"', save_regcont, save_regtype)
+ endif
+
+ let body = l:rust_playpen_url."?code=".webapi#http#encodeURI(content)
+
+ if strlen(body) > 5000
+ echohl ErrorMsg | echomsg 'Buffer too large, max 5000 encoded characters ('.strlen(body).')' | echohl None
+ return
+ endif
+
+ let payload = "format=simple&url=".webapi#http#encodeURI(body)
+ let res = webapi#http#post(l:rust_shortener_url.'create.php', payload, {})
+ let url = res.content
+
+ redraw | echomsg 'Done: '.url
+endfunction
+
+" }}}1
+
+" vim: set noet sw=4 ts=4:
diff --git a/vim/bundle/rust.vim/autoload/rustfmt.vim b/vim/bundle/rust.vim/autoload/rustfmt.vim
new file mode 100644
index 0000000..e5f9830
--- /dev/null
+++ b/vim/bundle/rust.vim/autoload/rustfmt.vim
@@ -0,0 +1,106 @@
+" Author: Stephen Sugden <stephen@stephensugden.com>
+"
+" Adapted from https://github.com/fatih/vim-go
+
+if !exists("g:rustfmt_autosave")
+ let g:rustfmt_autosave = 0
+endif
+
+if !exists("g:rustfmt_command")
+ let g:rustfmt_command = "rustfmt"
+endif
+
+if !exists("g:rustfmt_options")
+ let g:rustfmt_options = ""
+endif
+
+if !exists("g:rustfmt_fail_silently")
+ let g:rustfmt_fail_silently = 0
+endif
+
+let s:got_fmt_error = 0
+
+function! s:RustfmtCommandRange(filename, line1, line2)
+ let l:arg = {"file": shellescape(a:filename), "range": [a:line1, a:line2]}
+ return printf("%s %s --write-mode=overwrite --file-lines '[%s]'", g:rustfmt_command, g:rustfmt_options, json_encode(l:arg))
+endfunction
+
+function! s:RustfmtCommand(filename)
+ return g:rustfmt_command . " --write-mode=overwrite " . g:rustfmt_options . " " . shellescape(a:filename)
+endfunction
+
+function! s:RunRustfmt(command, curw, tmpname)
+ if exists("*systemlist")
+ let out = systemlist(a:command)
+ else
+ let out = split(system(a:command), '\r\?\n')
+ endif
+
+ if v:shell_error == 0 || v:shell_error == 3
+ " remove undo point caused via BufWritePre
+ try | silent undojoin | catch | endtry
+
+ " Replace current file with temp file, then reload buffer
+ call rename(a:tmpname, expand('%'))
+ silent edit!
+ let &syntax = &syntax
+
+ " only clear location list if it was previously filled to prevent
+ " clobbering other additions
+ if s:got_fmt_error
+ let s:got_fmt_error = 0
+ call setloclist(0, [])
+ lwindow
+ endif
+ elseif g:rustfmt_fail_silently == 0
+ " otherwise get the errors and put them in the location list
+ let errors = []
+
+ for line in out
+ " src/lib.rs:13:5: 13:10 error: expected `,`, or `}`, found `value`
+ let tokens = matchlist(line, '^\(.\{-}\):\(\d\+\):\(\d\+\):\s*\(\d\+:\d\+\s*\)\?\s*error: \(.*\)')
+ if !empty(tokens)
+ call add(errors, {"filename": @%,
+ \"lnum": tokens[2],
+ \"col": tokens[3],
+ \"text": tokens[5]})
+ endif
+ endfor
+
+ if empty(errors)
+ % | " Couldn't detect rustfmt error format, output errors
+ endif
+
+ if !empty(errors)
+ call setloclist(0, errors, 'r')
+ echohl Error | echomsg "rustfmt returned error" | echohl None
+ endif
+
+ let s:got_fmt_error = 1
+ lwindow
+ " We didn't use the temp file, so clean up
+ call delete(a:tmpname)
+ endif
+
+ call winrestview(a:curw)
+endfunction
+
+function! rustfmt#FormatRange(line1, line2)
+ let l:curw = winsaveview()
+ let l:tmpname = expand("%:p:h") . "/." . expand("%:p:t") . ".rustfmt"
+ call writefile(getline(1, '$'), l:tmpname)
+
+ let command = s:RustfmtCommandRange(l:tmpname, a:line1, a:line2)
+
+ call s:RunRustfmt(command, l:curw, l:tmpname)
+endfunction
+
+function! rustfmt#Format()
+ let l:curw = winsaveview()
+ let l:tmpname = expand("%:p:h") . "/." . expand("%:p:t") . ".rustfmt"
+ call writefile(getline(1, '$'), l:tmpname)
+
+ let command = s:RustfmtCommand(l:tmpname)
+
+ call s:RunRustfmt(command, l:curw, l:tmpname)
+endfunction
diff --git a/vim/bundle/rust.vim/compiler/cargo.vim b/vim/bundle/rust.vim/compiler/cargo.vim
new file mode 100644
index 0000000..029c5c7
--- /dev/null
+++ b/vim/bundle/rust.vim/compiler/cargo.vim
@@ -0,0 +1,28 @@
+" Vim compiler file
+" Compiler: Cargo Compiler
+" Maintainer: Damien Radtke <damienradtke@gmail.com>
+" Latest Revision: 2014 Sep 24
+
+if exists('current_compiler')
+ finish
+endif
+runtime compiler/rustc.vim
+let current_compiler = "cargo"
+
+if exists(':CompilerSet') != 2
+ command -nargs=* CompilerSet setlocal <args>
+endif
+
+if exists('g:cargo_makeprg_params')
+ execute 'CompilerSet makeprg=cargo\ '.escape(g:cargo_makeprg_params, ' \|"').'\ $*'
+else
+ CompilerSet makeprg=cargo\ $*
+endif
+
+" Ignore general cargo progress messages
+CompilerSet errorformat+=
+ \%-G%\\s%#Downloading%.%#,
+ \%-G%\\s%#Compiling%.%#,
+ \%-G%\\s%#Finished%.%#,
+ \%-G%\\s%#error:\ Could\ not\ compile\ %.%#,
+ \%-G%\\s%#To\ learn\ more\\,%.%#
diff --git a/vim/bundle/rust.vim/compiler/rustc.vim b/vim/bundle/rust.vim/compiler/rustc.vim
new file mode 100644
index 0000000..ba29133
--- /dev/null
+++ b/vim/bundle/rust.vim/compiler/rustc.vim
@@ -0,0 +1,45 @@
+" Vim compiler file
+" Compiler: Rust Compiler
+" Maintainer: Chris Morgan <me@chrismorgan.info>
+" Latest Revision: 2013 Jul 12
+
+if exists("current_compiler")
+ finish
+endif
+let current_compiler = "rustc"
+
+let s:cpo_save = &cpo
+set cpo&vim
+
+if exists(":CompilerSet") != 2
+ command -nargs=* CompilerSet setlocal <args>
+endif
+
+if exists("g:rustc_makeprg_no_percent") && g:rustc_makeprg_no_percent != 0
+ CompilerSet makeprg=rustc
+else
+ CompilerSet makeprg=rustc\ \%
+endif
+
+" Old errorformat (before nightly 2016/08/10)
+CompilerSet errorformat=
+ \%f:%l:%c:\ %t%*[^:]:\ %m,
+ \%f:%l:%c:\ %*\\d:%*\\d\ %t%*[^:]:\ %m,
+ \%-G%f:%l\ %s,
+ \%-G%*[\ ]^,
+ \%-G%*[\ ]^%*[~],
+ \%-G%*[\ ]...
+
+" New errorformat (after nightly 2016/08/10)
+CompilerSet errorformat+=
+ \%-G,
+ \%-Gerror:\ aborting\ %.%#,
+ \%-Gerror:\ Could\ not\ compile\ %.%#,
+ \%Eerror:\ %m,
+ \%Eerror[E%n]:\ %m,
+ \%Wwarning:\ %m,
+ \%Inote:\ %m,
+ \%C\ %#-->\ %f:%l:%c
+
+let &cpo = s:cpo_save
+unlet s:cpo_save
diff --git a/vim/bundle/rust.vim/doc/rust.txt b/vim/bundle/rust.vim/doc/rust.txt
new file mode 100644
index 0000000..68fc1da
--- /dev/null
+++ b/vim/bundle/rust.vim/doc/rust.txt
@@ -0,0 +1,237 @@
+*rust.txt* Filetype plugin for Rust
+
+==============================================================================
+CONTENTS *rust* *ft-rust*
+
+1. Introduction |rust-intro|
+2. Settings |rust-settings|
+3. Commands |rust-commands|
+4. Mappings |rust-mappings|
+
+==============================================================================
+INTRODUCTION *rust-intro*
+
+This plugin provides syntax and supporting functionality for the Rust
+filetype.
+
+==============================================================================
+SETTINGS *rust-settings*
+
+This plugin has a few variables you can define in your vimrc that change the
+behavior of the plugin.
+
+ *g:rustc_path*
+g:rustc_path~
+ Set this option to the path to rustc for use in the |:RustRun| and
+ |:RustExpand| commands. If unset, "rustc" will be located in $PATH: >
+ let g:rustc_path = $HOME."/bin/rustc"
+<
+
+ *g:rustc_makeprg_no_percent*
+g:rustc_makeprg_no_percent~
+ Set this option to 1 to have 'makeprg' default to "rustc" instead of
+ "rustc %": >
+ let g:rustc_makeprg_no_percent = 1
+<
+
+ *g:rust_conceal*
+g:rust_conceal~
+ Set this option to turn on the basic |conceal| support: >
+ let g:rust_conceal = 1
+<
+
+ *g:rust_conceal_mod_path*
+g:rust_conceal_mod_path~
+ Set this option to turn on |conceal| for the path connecting token
+ "::": >
+ let g:rust_conceal_mod_path = 1
+<
+
+ *g:rust_conceal_pub*
+g:rust_conceal_pub~
+ Set this option to turn on |conceal| for the "pub" token: >
+ let g:rust_conceal_pub = 1
+<
+
+ *g:rust_recommended_style*
+g:rust_recommended_style~
+ Set this option to enable vim indentation and textwidth settings to
+ conform to style conventions of the rust standard library (i.e. use 4
+ spaces for indents and sets 'textwidth' to 99). This option is enabled
+ by default. To disable it: >
+ let g:rust_recommended_style = 0
+<
+
+ *g:rust_fold*
+g:rust_fold~
+ Set this option to turn on |folding|: >
+ let g:rust_fold = 1
+<
+ Value Effect ~
+ 0 No folding
+ 1 Braced blocks are folded. All folds are open by
+ default.
+ 2 Braced blocks are folded. 'foldlevel' is left at the
+ global value (all folds are closed by default).
+
+ *g:rust_bang_comment_leader*
+g:rust_bang_comment_leader~
+ Set this option to 1 to preserve the leader on multi-line doc comments
+ using the /*! syntax: >
+ let g:rust_bang_comment_leader = 1
+<
+
+ *g:ftplugin_rust_source_path*
+g:ftplugin_rust_source_path~
+ Set this option to a path that should be prepended to 'path' for Rust
+ source files: >
+ let g:ftplugin_rust_source_path = $HOME.'/dev/rust'
+<
+
+ *g:rustfmt_command*
+g:rustfmt_command~
+ Set this option to the name of the 'rustfmt' executable in your $PATH. If
+ not specified it defaults to 'rustfmt' : >
+ let g:rustfmt_command = 'rustfmt'
+<
+ *g:rustfmt_autosave*
+g:rustfmt_autosave~
+ Set this option to 1 to run |:RustFmt| automatically when saving a
+ buffer. If not specified it defaults to 0 : >
+ let g:rustfmt_autosave = 0
+<
+ *g:rustfmt_fail_silently*
+g:rustfmt_fail_silently~
+ Set this option to 1 to prevent 'rustfmt' from populating the
+ |location-list| with errors. If not specified it defaults to 0: >
+ let g:rustfmt_fail_silently = 0
+<
+ *g:rustfmt_options*
+g:rustfmt_options~
+ Set this option to a string of options to pass to 'rustfmt'. The
+ write-mode is already set to 'overwrite'. If not specified it
+ defaults to '' : >
+ let g:rustfmt_options = ''
+<
+
+ *g:rust_playpen_url*
+g:rust_playpen_url~
+ Set this option to override the url for the playpen to use: >
+ let g:rust_playpen_url = 'https://play.rust-lang.org/'
+<
+
+ *g:rust_shortener_url*
+g:rust_shortener_url~
+ Set this option to override the url for the url shortener: >
+ let g:rust_shortener_url = 'https://is.gd/'
+<
+
+
+==============================================================================
+COMMANDS *rust-commands*
+
+:RustRun [args] *:RustRun*
+:RustRun! [rustc-args] [--] [args]
+ Compiles and runs the current file. If it has unsaved changes,
+ it will be saved first using |:update|. If the current file is
+ an unnamed buffer, it will be written to a temporary file
+ first. The compiled binary is always placed in a temporary
+ directory, but is run from the current directory.
+
+ The arguments given to |:RustRun| will be passed to the
+ compiled binary.
+
+ If ! is specified, the arguments are passed to rustc instead.
+ A "--" argument will separate the rustc arguments from the
+ arguments passed to the binary.
+
+ If |g:rustc_path| is defined, it is used as the path to rustc.
+ Otherwise it is assumed rustc can be found in $PATH.
+
+:RustExpand [args] *:RustExpand*
+:RustExpand! [TYPE] [args]
+ Expands the current file using --pretty and displays the
+ results in a new split. If the current file has unsaved
+ changes, it will be saved first using |:update|. If the
+ current file is an unnamed buffer, it will be written to a
+ temporary file first.
+
+ The arguments given to |:RustExpand| will be passed to rustc.
+ This is largely intended for specifying various --cfg
+ configurations.
+
+ If ! is specified, the first argument is the expansion type to
+ pass to rustc --pretty. Otherwise it will default to
+ "expanded".
+
+ If |g:rustc_path| is defined, it is used as the path to rustc.
+ Otherwise it is assumed rustc can be found in $PATH.
+
+:RustEmitIr [args] *:RustEmitIr*
+ Compiles the current file to LLVM IR and displays the results
+ in a new split. If the current file has unsaved changes, it
+ will be saved first using |:update|. If the current file is an
+ unnamed buffer, it will be written to a temporary file first.
+
+ The arguments given to |:RustEmitIr| will be passed to rustc.
+
+ If |g:rustc_path| is defined, it is used as the path to rustc.
+ Otherwise it is assumed rustc can be found in $PATH.
+
+:RustEmitAsm [args] *:RustEmitAsm*
+ Compiles the current file to assembly and displays the results
+ in a new split. If the current file has unsaved changes, it
+ will be saved first using |:update|. If the current file is an
+ unnamed buffer, it will be written to a temporary file first.
+
+ The arguments given to |:RustEmitAsm| will be passed to rustc.
+
+ If |g:rustc_path| is defined, it is used as the path to rustc.
+ Otherwise it is assumed rustc can be found in $PATH.
+
+:RustPlay *:RustPlay*
+ This command will only work if you have web-api.vim installed
+ (available at https://github.com/mattn/webapi-vim). It sends the
+ current selection, or if nothing is selected, the entirety of the
+ current buffer to the Rust playpen, and emits a message with the
+ shortened URL to the playpen.
+
+ |g:rust_playpen_url| is the base URL to the playpen, by default
+ "https://play.rust-lang.org/".
+
+ |g:rust_shortener_url| is the base url for the shorterner, by
+ default "https://is.gd/"
+
+:RustFmt *:RustFmt*
+ Runs |g:rustfmt_command| on the current buffer. If
+ |g:rustfmt_options| is set then those will be passed to the
+ executable.
+
+ If |g:rustfmt_fail_silently| is 0 (the default) then it
+ will populate the |location-list| with the errors from
+ |g:rustfmt_command|. If |g:rustfmt_fail_silently| is set to 1
+ then it will not populate the |location-list|.
+
+:RustFmtRange *:RustFmtRange*
+ Runs |g:rustfmt_command| with selected range. See
+ |:RustFmt| for any other information.
+
+==============================================================================
+MAPPINGS *rust-mappings*
+
+This plugin defines mappings for |[[| and |]]| to support hanging indents.
+
+It also has a few other mappings:
+
+ *rust_<D-r>*
+<D-r> Executes |:RustRun| with no arguments.
+ Note: This binding is only available in MacVim.
+
+ *rust_<D-R>*
+<D-R> Populates the command line with |:RustRun|! using the
+ arguments given to the last invocation, but does not
+ execute it.
+ Note: This binding is only available in MacVim.
+
+==============================================================================
+ vim:tw=78:sw=4:noet:ts=8:ft=help:norl:
diff --git a/vim/bundle/rust.vim/ftdetect/rust.vim b/vim/bundle/rust.vim/ftdetect/rust.vim
new file mode 100644
index 0000000..bf685d4
--- /dev/null
+++ b/vim/bundle/rust.vim/ftdetect/rust.vim
@@ -0,0 +1 @@
+au BufRead,BufNewFile *.rs set filetype=rust
diff --git a/vim/bundle/rust.vim/ftplugin/rust.vim b/vim/bundle/rust.vim/ftplugin/rust.vim
new file mode 100644
index 0000000..4e3cd4f
--- /dev/null
+++ b/vim/bundle/rust.vim/ftplugin/rust.vim
@@ -0,0 +1,207 @@
+" Language: Rust
+" Description: Vim syntax file for Rust
+" Maintainer: Chris Morgan <me@chrismorgan.info>
+" Maintainer: Kevin Ballard <kevin@sb.org>
+" Last Change: June 08, 2016
+
+if exists("b:did_ftplugin")
+ finish
+endif
+let b:did_ftplugin = 1
+
+let s:save_cpo = &cpo
+set cpo&vim
+
+augroup rust.vim
+autocmd!
+
+" Variables {{{1
+
+" The rust source code at present seems to typically omit a leader on /*!
+" comments, so we'll use that as our default, but make it easy to switch.
+" This does not affect indentation at all (I tested it with and without
+" leader), merely whether a leader is inserted by default or not.
+if exists("g:rust_bang_comment_leader") && g:rust_bang_comment_leader != 0
+ " Why is the `,s0:/*,mb:\ ,ex:*/` there, you ask? I don't understand why,
+ " but without it, */ gets indented one space even if there were no
+ " leaders. I'm fairly sure that's a Vim bug.
+ setlocal comments=s1:/*,mb:*,ex:*/,s0:/*,mb:\ ,ex:*/,:///,://!,://
+else
+ setlocal comments=s0:/*!,m:\ ,ex:*/,s1:/*,mb:*,ex:*/,:///,://!,://
+endif
+setlocal commentstring=//%s
+setlocal formatoptions-=t formatoptions+=croqnl
+" j was only added in 7.3.541, so stop complaints about its nonexistence
+silent! setlocal formatoptions+=j
+
+" smartindent will be overridden by indentexpr if filetype indent is on, but
+" otherwise it's better than nothing.
+setlocal smartindent nocindent
+
+if !exists("g:rust_recommended_style") || g:rust_recommended_style != 0
+ setlocal tabstop=4 shiftwidth=4 softtabstop=4 expandtab
+ setlocal textwidth=99
+endif
+
+" This includeexpr isn't perfect, but it's a good start
+setlocal includeexpr=substitute(v:fname,'::','/','g')
+
+setlocal suffixesadd=.rs
+
+if exists("g:ftplugin_rust_source_path")
+ let &l:path=g:ftplugin_rust_source_path . ',' . &l:path
+endif
+
+if exists("g:loaded_delimitMate")
+ if exists("b:delimitMate_excluded_regions")
+ let b:rust_original_delimitMate_excluded_regions = b:delimitMate_excluded_regions
+ endif
+
+ let s:delimitMate_extra_excluded_regions = ',rustLifetimeCandidate,rustGenericLifetimeCandidate'
+
+ " For this buffer, when delimitMate issues the `User delimitMate_map`
+ " event in the autocommand system, add the above-defined extra excluded
+ " regions to delimitMate's state, if they have not already been added.
+ autocmd User <buffer>
+ \ if expand('<afile>') ==# 'delimitMate_map' && match(
+ \ delimitMate#Get("excluded_regions"),
+ \ s:delimitMate_extra_excluded_regions) == -1
+ \| let b:delimitMate_excluded_regions =
+ \ delimitMate#Get("excluded_regions")
+ \ . s:delimitMate_extra_excluded_regions
+ \|endif
+
+ " For this buffer, when delimitMate issues the `User delimitMate_unmap`
+ " event in the autocommand system, delete the above-defined extra excluded
+ " regions from delimitMate's state (the deletion being idempotent and
+ " having no effect if the extra excluded regions are not present in the
+ " targeted part of delimitMate's state).
+ autocmd User <buffer>
+ \ if expand('<afile>') ==# 'delimitMate_unmap'
+ \| let b:delimitMate_excluded_regions = substitute(
+ \ delimitMate#Get("excluded_regions"),
+ \ '\C\V' . s:delimitMate_extra_excluded_regions,
+ \ '', 'g')
+ \|endif
+endif
+
+if has("folding") && exists('g:rust_fold') && g:rust_fold != 0
+ let b:rust_set_foldmethod=1
+ setlocal foldmethod=syntax
+ if g:rust_fold == 2
+ setlocal foldlevel<
+ else
+ setlocal foldlevel=99
+ endif
+endif
+
+if has('conceal') && exists('g:rust_conceal') && g:rust_conceal != 0
+ let b:rust_set_conceallevel=1
+ setlocal conceallevel=2
+endif
+
+" Motion Commands {{{1
+
+" Bind motion commands to support hanging indents
+nnoremap <silent> <buffer> [[ :call rust#Jump('n', 'Back')<CR>
+nnoremap <silent> <buffer> ]] :call rust#Jump('n', 'Forward')<CR>
+xnoremap <silent> <buffer> [[ :call rust#Jump('v', 'Back')<CR>
+xnoremap <silent> <buffer> ]] :call rust#Jump('v', 'Forward')<CR>
+onoremap <silent> <buffer> [[ :call rust#Jump('o', 'Back')<CR>
+onoremap <silent> <buffer> ]] :call rust#Jump('o', 'Forward')<CR>
+
+" Commands {{{1
+
+" See |:RustRun| for docs
+command! -nargs=* -complete=file -bang -buffer RustRun call rust#Run(<bang>0, <q-args>)
+
+" See |:RustExpand| for docs
+command! -nargs=* -complete=customlist,rust#CompleteExpand -bang -buffer RustExpand call rust#Expand(<bang>0, <q-args>)
+
+" See |:RustEmitIr| for docs
+command! -nargs=* -buffer RustEmitIr call rust#Emit("llvm-ir", <q-args>)
+
+" See |:RustEmitAsm| for docs
+command! -nargs=* -buffer RustEmitAsm call rust#Emit("asm", <q-args>)
+
+" See |:RustPlay| for docs
+command! -range=% RustPlay :call rust#Play(<count>, <line1>, <line2>, <f-args>)
+
+" See |:RustFmt| for docs
+command! -buffer RustFmt call rustfmt#Format()
+
+" See |:RustFmtRange| for docs
+command! -range -buffer RustFmtRange call rustfmt#FormatRange(<line1>, <line2>)
+
+" Mappings {{{1
+
+" Bind ⌘R in MacVim to :RustRun
+nnoremap <silent> <buffer> <D-r> :RustRun<CR>
+" Bind ⌘⇧R in MacVim to :RustRun! pre-filled with the last args
+nnoremap <buffer> <D-R> :RustRun! <C-r>=join(b:rust_last_rustc_args)<CR><C-\>erust#AppendCmdLine(' -- ' . join(b:rust_last_args))<CR>
+
+if !exists("b:rust_last_rustc_args") || !exists("b:rust_last_args")
+ let b:rust_last_rustc_args = []
+ let b:rust_last_args = []
+endif
+
+" Cleanup {{{1
+
+let b:undo_ftplugin = "
+ \ setlocal formatoptions< comments< commentstring< includeexpr< suffixesadd<
+ \|setlocal tabstop< shiftwidth< softtabstop< expandtab< textwidth<
+ \|if exists('b:rust_original_delimitMate_excluded_regions')
+ \|let b:delimitMate_excluded_regions = b:rust_original_delimitMate_excluded_regions
+ \|unlet b:rust_original_delimitMate_excluded_regions
+ \|else
+ \|unlet! b:delimitMate_excluded_regions
+ \|endif
+ \|if exists('b:rust_set_foldmethod')
+ \|setlocal foldmethod< foldlevel<
+ \|unlet b:rust_set_foldmethod
+ \|endif
+ \|if exists('b:rust_set_conceallevel')
+ \|setlocal conceallevel<
+ \|unlet b:rust_set_conceallevel
+ \|endif
+ \|unlet! b:rust_last_rustc_args b:rust_last_args
+ \|delcommand RustRun
+ \|delcommand RustExpand
+ \|delcommand RustEmitIr
+ \|delcommand RustEmitAsm
+ \|delcommand RustPlay
+ \|nunmap <buffer> <D-r>
+ \|nunmap <buffer> <D-R>
+ \|nunmap <buffer> [[
+ \|nunmap <buffer> ]]
+ \|xunmap <buffer> [[
+ \|xunmap <buffer> ]]
+ \|ounmap <buffer> [[
+ \|ounmap <buffer> ]]
+ \|set matchpairs-=<:>
+ \|unlet b:match_skip
+ \"
+
+" }}}1
+
+" Code formatting on save
+if get(g:, "rustfmt_autosave", 0)
+ autocmd BufWritePre *.rs silent! call rustfmt#Format()
+endif
+
+augroup END
+
+" %-matching. <:> is handy for generics.
+set matchpairs+=<:>
+" There are two minor issues with it; (a) comparison operators in expressions,
+" where a less-than may match a greater-than later on—this is deemed a trivial
+" issue—and (b) `Fn() -> X` syntax. This latter issue is irremediable from the
+" highlighting perspective (built into Vim), but the actual % functionality
+" can be fixed by this use of matchit.vim.
+let b:match_skip = 's:comment\|string\|rustArrow'
+source $VIMRUNTIME/macros/matchit.vim
+
+let &cpo = s:save_cpo
+unlet s:save_cpo
+
+" vim: set noet sw=4 ts=4:
diff --git a/vim/bundle/rust.vim/indent/rust.vim b/vim/bundle/rust.vim/indent/rust.vim
new file mode 100644
index 0000000..774133d
--- /dev/null
+++ b/vim/bundle/rust.vim/indent/rust.vim
@@ -0,0 +1,206 @@
+" Vim indent file
+" Language: Rust
+" Author: Chris Morgan <me@chrismorgan.info>
+" Last Change: 2016 Jul 15
+
+" Only load this indent file when no other was loaded.
+if exists("b:did_indent")
+ finish
+endif
+let b:did_indent = 1
+
+setlocal cindent
+setlocal cinoptions=L0,(0,Ws,J1,j1
+setlocal cinkeys=0{,0},!^F,o,O,0[,0]
+" Don't think cinwords will actually do anything at all... never mind
+setlocal cinwords=for,if,else,while,loop,impl,mod,unsafe,trait,struct,enum,fn,extern
+
+" Some preliminary settings
+setlocal nolisp " Make sure lisp indenting doesn't supersede us
+setlocal autoindent " indentexpr isn't much help otherwise
+" Also do indentkeys, otherwise # gets shoved to column 0 :-/
+setlocal indentkeys=0{,0},!^F,o,O,0[,0]
+
+setlocal indentexpr=GetRustIndent(v:lnum)
+
+" Only define the function once.
+if exists("*GetRustIndent")
+ finish
+endif
+
+" Come here when loading the script the first time.
+
+function! s:get_line_trimmed(lnum)
+ " Get the line and remove a trailing comment.
+ " Use syntax highlighting attributes when possible.
+ " NOTE: this is not accurate; /* */ or a line continuation could trick it
+ let line = getline(a:lnum)
+ let line_len = strlen(line)
+ if has('syntax_items')
+ " If the last character in the line is a comment, do a binary search for
+ " the start of the comment. synID() is slow, a linear search would take
+ " too long on a long line.
+ if synIDattr(synID(a:lnum, line_len, 1), "name") =~ 'Comment\|Todo'
+ let min = 1
+ let max = line_len
+ while min < max
+ let col = (min + max) / 2
+ if synIDattr(synID(a:lnum, col, 1), "name") =~ 'Comment\|Todo'
+ let max = col
+ else
+ let min = col + 1
+ endif
+ endwhile
+ let line = strpart(line, 0, min - 1)
+ endif
+ return substitute(line, "\s*$", "", "")
+ else
+ " Sorry, this is not complete, nor fully correct (e.g. string "//").
+ " Such is life.
+ return substitute(line, "\s*//.*$", "", "")
+ endif
+endfunction
+
+function! s:is_string_comment(lnum, col)
+ if has('syntax_items')
+ for id in synstack(a:lnum, a:col)
+ let synname = synIDattr(id, "name")
+ if synname == "rustString" || synname =~ "^rustComment"
+ return 1
+ endif
+ endfor
+ else
+ " without syntax, let's not even try
+ return 0
+ endif
+endfunction
+
+function GetRustIndent(lnum)
+
+ " Starting assumption: cindent (called at the end) will do it right
+ " normally. We just want to fix up a few cases.
+
+ let line = getline(a:lnum)
+
+ if has('syntax_items')
+ let synname = synIDattr(synID(a:lnum, 1, 1), "name")
+ if synname == "rustString"
+ " If the start of the line is in a string, don't change the indent
+ return -1
+ elseif synname =~ '\(Comment\|Todo\)'
+ \ && line !~ '^\s*/\*' " not /* opening line
+ if synname =~ "CommentML" " multi-line
+ if line !~ '^\s*\*' && getline(a:lnum - 1) =~ '^\s*/\*'
+ " This is (hopefully) the line after a /*, and it has no
+ " leader, so the correct indentation is that of the
+ " previous line.
+ return GetRustIndent(a:lnum - 1)
+ endif
+ endif
+ " If it's in a comment, let cindent take care of it now. This is
+ " for cases like "/*" where the next line should start " * ", not
+ " "* " as the code below would otherwise cause for module scope
+ " Fun fact: " /*\n*\n*/" takes two calls to get right!
+ return cindent(a:lnum)
+ endif
+ endif
+
+ " cindent gets second and subsequent match patterns/struct members wrong,
+ " as it treats the comma as indicating an unfinished statement::
+ "
+ " match a {
+ " b => c,
+ " d => e,
+ " f => g,
+ " };
+
+ " Search backwards for the previous non-empty line.
+ let prevlinenum = prevnonblank(a:lnum - 1)
+ let prevline = s:get_line_trimmed(prevlinenum)
+ while prevlinenum > 1 && prevline !~ '[^[:blank:]]'
+ let prevlinenum = prevnonblank(prevlinenum - 1)
+ let prevline = s:get_line_trimmed(prevlinenum)
+ endwhile
+
+ " Handle where clauses nicely: subsequent values should line up nicely.
+ if prevline[len(prevline) - 1] == ","
+ \ && prevline =~# '^\s*where\s'
+ return indent(prevlinenum) + 6
+ endif
+
+ if prevline[len(prevline) - 1] == ","
+ \ && s:get_line_trimmed(a:lnum) !~ '^\s*[\[\]{}]'
+ \ && prevline !~ '^\s*fn\s'
+ \ && prevline !~ '([^()]\+,$'
+ \ && s:get_line_trimmed(a:lnum) !~ '^\s*\S\+\s*=>'
+ " Oh ho! The previous line ended in a comma! I bet cindent will try to
+ " take this too far... For now, let's normally use the previous line's
+ " indent.
+
+ " One case where this doesn't work out is where *this* line contains
+ " square or curly brackets; then we normally *do* want to be indenting
+ " further.
+ "
+ " Another case where we don't want to is one like a function
+ " definition with arguments spread over multiple lines:
+ "
+ " fn foo(baz: Baz,
+ " baz: Baz) // <-- cindent gets this right by itself
+ "
+ " Another case is similar to the previous, except calling a function
+ " instead of defining it, or any conditional expression that leaves
+ " an open paren:
+ "
+ " foo(baz,
+ " baz);
+ "
+ " if baz && (foo ||
+ " bar) {
+ "
+ " Another case is when the current line is a new match arm.
+ "
+ " There are probably other cases where we don't want to do this as
+ " well. Add them as needed.
+ return indent(prevlinenum)
+ endif
+
+ if !has("patch-7.4.355")
+ " cindent before 7.4.355 doesn't do the module scope well at all; e.g.::
+ "
+ " static FOO : &'static [bool] = [
+ " true,
+ " false,
+ " false,
+ " true,
+ " ];
+ "
+ " uh oh, next statement is indented further!
+
+ " Note that this does *not* apply the line continuation pattern properly;
+ " that's too hard to do correctly for my liking at present, so I'll just
+ " start with these two main cases (square brackets and not returning to
+ " column zero)
+
+ call cursor(a:lnum, 1)
+ if searchpair('{\|(', '', '}\|)', 'nbW',
+ \ 's:is_string_comment(line("."), col("."))') == 0
+ if searchpair('\[', '', '\]', 'nbW',
+ \ 's:is_string_comment(line("."), col("."))') == 0
+ " Global scope, should be zero
+ return 0
+ else
+ " At the module scope, inside square brackets only
+ "if getline(a:lnum)[0] == ']' || search('\[', '', '\]', 'nW') == a:lnum
+ if line =~ "^\\s*]"
+ " It's the closing line, dedent it
+ return 0
+ else
+ return &shiftwidth
+ endif
+ endif
+ endif
+ endif
+
+ " Fall back on cindent, which does it mostly right
+ return cindent(a:lnum)
+endfunction
diff --git a/vim/bundle/rust.vim/plugin/rust.vim b/vim/bundle/rust.vim/plugin/rust.vim
new file mode 100644
index 0000000..4ec4f33
--- /dev/null
+++ b/vim/bundle/rust.vim/plugin/rust.vim
@@ -0,0 +1,22 @@
+" Vim syntastic plugin helper
+" Language: Rust
+" Maintainer: Andrew Gallant <jamslam@gmail.com>
+
+if exists("g:loaded_syntastic_rust_filetype")
+ finish
+endif
+let g:loaded_syntastic_rust_filetype = 1
+let s:save_cpo = &cpo
+set cpo&vim
+
+" This is to let Syntastic know about the Rust filetype.
+" It enables tab completion for the 'SyntasticInfo' command.
+" (This does not actually register the syntax checker.)
+if exists('g:syntastic_extra_filetypes')
+ call add(g:syntastic_extra_filetypes, 'rust')
+else
+ let g:syntastic_extra_filetypes = ['rust']
+endif
+
+let &cpo = s:save_cpo
+unlet s:save_cpo
diff --git a/vim/bundle/rust.vim/syntax/rust.vim b/vim/bundle/rust.vim/syntax/rust.vim
new file mode 100644
index 0000000..8c73462
--- /dev/null
+++ b/vim/bundle/rust.vim/syntax/rust.vim
@@ -0,0 +1,294 @@
+" Vim syntax file
+" Language: Rust
+" Maintainer: Patrick Walton <pcwalton@mozilla.com>
+" Maintainer: Ben Blum <bblum@cs.cmu.edu>
+" Maintainer: Chris Morgan <me@chrismorgan.info>
+" Last Change: Feb 24, 2016
+
+if version < 600
+ syntax clear
+elseif exists("b:current_syntax")
+ finish
+endif
+
+" Syntax definitions {{{1
+" Basic keywords {{{2
+syn keyword rustConditional match if else
+syn keyword rustRepeat for loop while
+syn keyword rustTypedef type nextgroup=rustIdentifier skipwhite skipempty
+syn keyword rustStructure struct enum nextgroup=rustIdentifier skipwhite skipempty
+syn keyword rustUnion union nextgroup=rustIdentifier skipwhite skipempty contained
+syn match rustUnionContextual /\<union\_s\+\%([^[:cntrl:][:space:][:punct:][:digit:]]\|_\)\%([^[:cntrl:][:punct:][:space:]]\|_\)*/ transparent contains=rustUnion
+syn keyword rustOperator as
+
+syn match rustAssert "\<assert\(\w\)*!" contained
+syn match rustPanic "\<panic\(\w\)*!" contained
+syn keyword rustKeyword break
+syn keyword rustKeyword box nextgroup=rustBoxPlacement skipwhite skipempty
+syn keyword rustKeyword continue
+syn keyword rustKeyword extern nextgroup=rustExternCrate,rustObsoleteExternMod skipwhite skipempty
+syn keyword rustKeyword fn nextgroup=rustFuncName skipwhite skipempty
+syn keyword rustKeyword in impl let
+syn keyword rustKeyword pub nextgroup=rustPubScope skipwhite skipempty
+syn keyword rustKeyword return
+syn keyword rustSuper super
+syn keyword rustKeyword unsafe where
+syn keyword rustKeyword use nextgroup=rustModPath skipwhite skipempty
+" FIXME: Scoped impl's name is also fallen in this category
+syn keyword rustKeyword mod trait nextgroup=rustIdentifier skipwhite skipempty
+syn keyword rustStorage move mut ref static const
+syn match rustDefault /\<default\ze\_s\+\(impl\|fn\|type\|const\)\>/
+
+syn keyword rustInvalidBareKeyword crate
+
+syn keyword rustPubScopeCrate crate contained
+syn match rustPubScopeDelim /[()]/ contained
+syn match rustPubScope /([^()]*)/ contained contains=rustPubScopeDelim,rustPubScopeCrate,rustSuper,rustModPath,rustModPathSep,rustSelf transparent
+
+syn keyword rustExternCrate crate contained nextgroup=rustIdentifier,rustExternCrateString skipwhite skipempty
+" This is to get the `bar` part of `extern crate "foo" as bar;` highlighting.
+syn match rustExternCrateString /".*"\_s*as/ contained nextgroup=rustIdentifier skipwhite transparent skipempty contains=rustString,rustOperator
+syn keyword rustObsoleteExternMod mod contained nextgroup=rustIdentifier skipwhite skipempty
+
+syn match rustIdentifier contains=rustIdentifierPrime "\%([^[:cntrl:][:space:][:punct:][:digit:]]\|_\)\%([^[:cntrl:][:punct:][:space:]]\|_\)*" display contained
+syn match rustFuncName "\%([^[:cntrl:][:space:][:punct:][:digit:]]\|_\)\%([^[:cntrl:][:punct:][:space:]]\|_\)*" display contained
+
+syn region rustBoxPlacement matchgroup=rustBoxPlacementParens start="(" end=")" contains=TOP contained
+" Ideally we'd have syntax rules set up to match arbitrary expressions. Since
+" we don't, we'll just define temporary contained rules to handle balancing
+" delimiters.
+syn region rustBoxPlacementBalance start="(" end=")" containedin=rustBoxPlacement transparent
+syn region rustBoxPlacementBalance start="\[" end="\]" containedin=rustBoxPlacement transparent
+" {} are handled by rustFoldBraces
+
+syn region rustMacroRepeat matchgroup=rustMacroRepeatDelimiters start="$(" end=")" contains=TOP nextgroup=rustMacroRepeatCount
+syn match rustMacroRepeatCount ".\?[*+]" contained
+syn match rustMacroVariable "$\w\+"
+
+" Reserved (but not yet used) keywords {{{2
+syn keyword rustReservedKeyword alignof become do offsetof priv pure sizeof typeof unsized yield abstract virtual final override macro
+
+" Built-in types {{{2
+syn keyword rustType isize usize char bool u8 u16 u32 u64 u128 f32
+syn keyword rustType f64 i8 i16 i32 i64 i128 str Self
+
+" Things from the libstd v1 prelude (src/libstd/prelude/v1.rs) {{{2
+" This section is just straight transformation of the contents of the prelude,
+" to make it easy to update.
+
+" Reexported core operators {{{3
+syn keyword rustTrait Copy Send Sized Sync
+syn keyword rustTrait Drop Fn FnMut FnOnce
+
+" Reexported functions {{{3
+" There’s no point in highlighting these; when one writes drop( or drop::< it
+" gets the same highlighting anyway, and if someone writes `let drop = …;` we
+" don’t really want *that* drop to be highlighted.
+"syn keyword rustFunction drop
+
+" Reexported types and traits {{{3
+syn keyword rustTrait Box
+syn keyword rustTrait ToOwned
+syn keyword rustTrait Clone
+syn keyword rustTrait PartialEq PartialOrd Eq Ord
+syn keyword rustTrait AsRef AsMut Into From
+syn keyword rustTrait Default
+syn keyword rustTrait Iterator Extend IntoIterator
+syn keyword rustTrait DoubleEndedIterator ExactSizeIterator
+syn keyword rustEnum Option
+syn keyword rustEnumVariant Some None
+syn keyword rustEnum Result
+syn keyword rustEnumVariant Ok Err
+syn keyword rustTrait SliceConcatExt
+syn keyword rustTrait String ToString
+syn keyword rustTrait Vec
+
+" Other syntax {{{2
+syn keyword rustSelf self
+syn keyword rustBoolean true false
+
+" If foo::bar changes to foo.bar, change this ("::" to "\.").
+" If foo::bar changes to Foo::bar, change this (first "\w" to "\u").
+syn match rustModPath "\w\(\w\)*::[^<]"he=e-3,me=e-3
+syn match rustModPathSep "::"
+
+syn match rustFuncCall "\w\(\w\)*("he=e-1,me=e-1
+syn match rustFuncCall "\w\(\w\)*::<"he=e-3,me=e-3 " foo::<T>();
+
+" This is merely a convention; note also the use of [A-Z], restricting it to
+" latin identifiers rather than the full Unicode uppercase. I have not used
+" [:upper:] as it depends upon 'noignorecase'
+"syn match rustCapsIdent display "[A-Z]\w\(\w\)*"
+
+syn match rustOperator display "\%(+\|-\|/\|*\|=\|\^\|&\||\|!\|>\|<\|%\)=\?"
+" This one isn't *quite* right, as we could have binary-& with a reference
+syn match rustSigil display /&\s\+[&~@*][^)= \t\r\n]/he=e-1,me=e-1
+syn match rustSigil display /[&~@*][^)= \t\r\n]/he=e-1,me=e-1
+" This isn't actually correct; a closure with no arguments can be `|| { }`.
+" Last, because the & in && isn't a sigil
+syn match rustOperator display "&&\|||"
+" This is rustArrowCharacter rather than rustArrow for the sake of matchparen,
+" so it skips the ->; see http://stackoverflow.com/a/30309949 for details.
+syn match rustArrowCharacter display "->"
+syn match rustQuestionMark display "?\([a-zA-Z]\+\)\@!"
+
+syn match rustMacro '\w\(\w\)*!' contains=rustAssert,rustPanic
+syn match rustMacro '#\w\(\w\)*' contains=rustAssert,rustPanic
+
+syn match rustEscapeError display contained /\\./
+syn match rustEscape display contained /\\\([nrt0\\'"]\|x\x\{2}\)/
+syn match rustEscapeUnicode display contained /\\u{\x\{1,6}}/
+syn match rustStringContinuation display contained /\\\n\s*/
+syn region rustString start=+b"+ skip=+\\\\\|\\"+ end=+"+ contains=rustEscape,rustEscapeError,rustStringContinuation
+syn region rustString start=+"+ skip=+\\\\\|\\"+ end=+"+ contains=rustEscape,rustEscapeUnicode,rustEscapeError,rustStringContinuation,@Spell
+syn region rustString start='b\?r\z(#*\)"' end='"\z1' contains=@Spell
+
+syn region rustAttribute start="#!\?\[" end="\]" contains=rustString,rustDerive,rustCommentLine,rustCommentBlock,rustCommentLineDocError,rustCommentBlockDocError
+syn region rustDerive start="derive(" end=")" contained contains=rustDeriveTrait
+" This list comes from src/libsyntax/ext/deriving/mod.rs
+" Some are deprecated (Encodable, Decodable) or to be removed after a new snapshot (Show).
+syn keyword rustDeriveTrait contained Clone Hash RustcEncodable RustcDecodable Encodable Decodable PartialEq Eq PartialOrd Ord Rand Show Debug Default FromPrimitive Send Sync Copy
+
+" Number literals
+syn match rustDecNumber display "\<[0-9][0-9_]*\%([iu]\%(size\|8\|16\|32\|64\|128\)\)\="
+syn match rustHexNumber display "\<0x[a-fA-F0-9_]\+\%([iu]\%(size\|8\|16\|32\|64\|128\)\)\="
+syn match rustOctNumber display "\<0o[0-7_]\+\%([iu]\%(size\|8\|16\|32\|64\|128\)\)\="
+syn match rustBinNumber display "\<0b[01_]\+\%([iu]\%(size\|8\|16\|32\|64\|128\)\)\="
+
+" Special case for numbers of the form "1." which are float literals, unless followed by
+" an identifier, which makes them integer literals with a method call or field access,
+" or by another ".", which makes them integer literals followed by the ".." token.
+" (This must go first so the others take precedence.)
+syn match rustFloat display "\<[0-9][0-9_]*\.\%([^[:cntrl:][:space:][:punct:][:digit:]]\|_\|\.\)\@!"
+" To mark a number as a normal float, it must have at least one of the three things integral values don't have:
+" a decimal point and more numbers; an exponent; and a type suffix.
+syn match rustFloat display "\<[0-9][0-9_]*\%(\.[0-9][0-9_]*\)\%([eE][+-]\=[0-9_]\+\)\=\(f32\|f64\)\="
+syn match rustFloat display "\<[0-9][0-9_]*\%(\.[0-9][0-9_]*\)\=\%([eE][+-]\=[0-9_]\+\)\(f32\|f64\)\="
+syn match rustFloat display "\<[0-9][0-9_]*\%(\.[0-9][0-9_]*\)\=\%([eE][+-]\=[0-9_]\+\)\=\(f32\|f64\)"
+
+" For the benefit of delimitMate
+syn region rustLifetimeCandidate display start=/&'\%(\([^'\\]\|\\\(['nrt0\\\"]\|x\x\{2}\|u{\x\{1,6}}\)\)'\)\@!/ end=/[[:cntrl:][:space:][:punct:]]\@=\|$/ contains=rustSigil,rustLifetime
+syn region rustGenericRegion display start=/<\%('\|[^[cntrl:][:space:][:punct:]]\)\@=')\S\@=/ end=/>/ contains=rustGenericLifetimeCandidate
+syn region rustGenericLifetimeCandidate display start=/\%(<\|,\s*\)\@<='/ end=/[[:cntrl:][:space:][:punct:]]\@=\|$/ contains=rustSigil,rustLifetime
+
+"rustLifetime must appear before rustCharacter, or chars will get the lifetime highlighting
+syn match rustLifetime display "\'\%([^[:cntrl:][:space:][:punct:][:digit:]]\|_\)\%([^[:cntrl:][:punct:][:space:]]\|_\)*"
+syn match rustLabel display "\'\%([^[:cntrl:][:space:][:punct:][:digit:]]\|_\)\%([^[:cntrl:][:punct:][:space:]]\|_\)*:"
+syn match rustCharacterInvalid display contained /b\?'\zs[\n\r\t']\ze'/
+" The groups negated here add up to 0-255 but nothing else (they do not seem to go beyond ASCII).
+syn match rustCharacterInvalidUnicode display contained /b'\zs[^[:cntrl:][:graph:][:alnum:][:space:]]\ze'/
+syn match rustCharacter /b'\([^\\]\|\\\(.\|x\x\{2}\)\)'/ contains=rustEscape,rustEscapeError,rustCharacterInvalid,rustCharacterInvalidUnicode
+syn match rustCharacter /'\([^\\]\|\\\(.\|x\x\{2}\|u{\x\{1,6}}\)\)'/ contains=rustEscape,rustEscapeUnicode,rustEscapeError,rustCharacterInvalid
+
+syn match rustShebang /\%^#![^[].*/
+syn region rustCommentLine start="//" end="$" contains=rustTodo,@Spell
+syn region rustCommentLineDoc start="//\%(//\@!\|!\)" end="$" contains=rustTodo,@Spell
+syn region rustCommentLineDocError start="//\%(//\@!\|!\)" end="$" contains=rustTodo,@Spell contained
+syn region rustCommentBlock matchgroup=rustCommentBlock start="/\*\%(!\|\*[*/]\@!\)\@!" end="\*/" contains=rustTodo,rustCommentBlockNest,@Spell
+syn region rustCommentBlockDoc matchgroup=rustCommentBlockDoc start="/\*\%(!\|\*[*/]\@!\)" end="\*/" contains=rustTodo,rustCommentBlockDocNest,@Spell
+syn region rustCommentBlockDocError matchgroup=rustCommentBlockDocError start="/\*\%(!\|\*[*/]\@!\)" end="\*/" contains=rustTodo,rustCommentBlockDocNestError,@Spell contained
+syn region rustCommentBlockNest matchgroup=rustCommentBlock start="/\*" end="\*/" contains=rustTodo,rustCommentBlockNest,@Spell contained transparent
+syn region rustCommentBlockDocNest matchgroup=rustCommentBlockDoc start="/\*" end="\*/" contains=rustTodo,rustCommentBlockDocNest,@Spell contained transparent
+syn region rustCommentBlockDocNestError matchgroup=rustCommentBlockDocError start="/\*" end="\*/" contains=rustTodo,rustCommentBlockDocNestError,@Spell contained transparent
+" FIXME: this is a really ugly and not fully correct implementation. Most
+" importantly, a case like ``/* */*`` should have the final ``*`` not being in
+" a comment, but in practice at present it leaves comments open two levels
+" deep. But as long as you stay away from that particular case, I *believe*
+" the highlighting is correct. Due to the way Vim's syntax engine works
+" (greedy for start matches, unlike Rust's tokeniser which is searching for
+" the earliest-starting match, start or end), I believe this cannot be solved.
+" Oh you who would fix it, don't bother with things like duplicating the Block
+" rules and putting ``\*\@<!`` at the start of them; it makes it worse, as
+" then you must deal with cases like ``/*/**/*/``. And don't try making it
+" worse with ``\%(/\@<!\*\)\@<!``, either...
+
+syn keyword rustTodo contained TODO FIXME XXX NB NOTE
+
+" Folding rules {{{2
+" Trivial folding rules to begin with.
+" FIXME: use the AST to make really good folding
+syn region rustFoldBraces start="{" end="}" transparent fold
+
+" Default highlighting {{{1
+hi def link rustDecNumber rustNumber
+hi def link rustHexNumber rustNumber
+hi def link rustOctNumber rustNumber
+hi def link rustBinNumber rustNumber
+hi def link rustIdentifierPrime rustIdentifier
+hi def link rustTrait rustType
+hi def link rustDeriveTrait rustTrait
+
+hi def link rustMacroRepeatCount rustMacroRepeatDelimiters
+hi def link rustMacroRepeatDelimiters Macro
+hi def link rustMacroVariable Define
+hi def link rustSigil StorageClass
+hi def link rustEscape Special
+hi def link rustEscapeUnicode rustEscape
+hi def link rustEscapeError Error
+hi def link rustStringContinuation Special
+hi def link rustString String
+hi def link rustCharacterInvalid Error
+hi def link rustCharacterInvalidUnicode rustCharacterInvalid
+hi def link rustCharacter Character
+hi def link rustNumber Number
+hi def link rustBoolean Boolean
+hi def link rustEnum rustType
+hi def link rustEnumVariant rustConstant
+hi def link rustConstant Constant
+hi def link rustSelf Constant
+hi def link rustFloat Float
+hi def link rustArrowCharacter rustOperator
+hi def link rustOperator Operator
+hi def link rustKeyword Keyword
+hi def link rustTypedef Keyword " More precise is Typedef, but it doesn't feel right for Rust
+hi def link rustStructure Keyword " More precise is Structure
+hi def link rustUnion rustStructure
+hi def link rustPubScopeDelim Delimiter
+hi def link rustPubScopeCrate rustKeyword
+hi def link rustSuper rustKeyword
+hi def link rustReservedKeyword Error
+hi def link rustRepeat Conditional
+hi def link rustConditional Conditional
+hi def link rustIdentifier Identifier
+hi def link rustCapsIdent rustIdentifier
+hi def link rustModPath Include
+hi def link rustModPathSep Delimiter
+hi def link rustFunction Function
+hi def link rustFuncName Function
+hi def link rustFuncCall Function
+hi def link rustShebang Comment
+hi def link rustCommentLine Comment
+hi def link rustCommentLineDoc SpecialComment
+hi def link rustCommentLineDocError Error
+hi def link rustCommentBlock rustCommentLine
+hi def link rustCommentBlockDoc rustCommentLineDoc
+hi def link rustCommentBlockDocError Error
+hi def link rustAssert PreCondit
+hi def link rustPanic PreCondit
+hi def link rustMacro Macro
+hi def link rustType Type
+hi def link rustTodo Todo
+hi def link rustAttribute PreProc
+hi def link rustDerive PreProc
+hi def link rustDefault StorageClass
+hi def link rustStorage StorageClass
+hi def link rustObsoleteStorage Error
+hi def link rustLifetime Special
+hi def link rustLabel Label
+hi def link rustInvalidBareKeyword Error
+hi def link rustExternCrate rustKeyword
+hi def link rustObsoleteExternMod Error
+hi def link rustBoxPlacementParens Delimiter
+hi def link rustQuestionMark Special
+
+" Other Suggestions:
+" hi rustAttribute ctermfg=cyan
+" hi rustDerive ctermfg=cyan
+" hi rustAssert ctermfg=yellow
+" hi rustPanic ctermfg=red
+" hi rustMacro ctermfg=magenta
+
+syn sync minlines=200
+syn sync maxlines=500
+
+let b:current_syntax = "rust"
diff --git a/vim/bundle/rust.vim/syntax_checkers/rust/rustc.vim b/vim/bundle/rust.vim/syntax_checkers/rust/rustc.vim
new file mode 100644
index 0000000..006e715
--- /dev/null
+++ b/vim/bundle/rust.vim/syntax_checkers/rust/rustc.vim
@@ -0,0 +1,48 @@
+" Vim syntastic plugin
+" Language: Rust
+" Maintainer: Andrew Gallant <jamslam@gmail.com>
+"
+" See for details on how to add an external Syntastic checker:
+" https://github.com/scrooloose/syntastic/wiki/Syntax-Checker-Guide#external
+
+if exists("g:loaded_syntastic_rust_rustc_checker")
+ finish
+endif
+let g:loaded_syntastic_rust_rustc_checker = 1
+
+let s:save_cpo = &cpo
+set cpo&vim
+
+function! SyntaxCheckers_rust_rustc_GetLocList() dict
+ let makeprg = self.makeprgBuild({})
+
+ " Old errorformat (before nightly 2016/08/10)
+ let errorformat =
+ \ '%E%f:%l:%c: %\d%#:%\d%# %.%\{-}error:%.%\{-} %m,' .
+ \ '%W%f:%l:%c: %\d%#:%\d%# %.%\{-}warning:%.%\{-} %m,' .
+ \ '%C%f:%l %m'
+
+ " New errorformat (after nightly 2016/08/10)
+ let errorformat .=
+ \ ',' .
+ \ '%-G,' .
+ \ '%-Gerror: aborting %.%#,' .
+ \ '%-Gerror: Could not compile %.%#,' .
+ \ '%Eerror: %m,' .
+ \ '%Eerror[E%n]: %m,' .
+ \ '%-Gwarning: the option `Z` is unstable %.%#,' .
+ \ '%Wwarning: %m,' .
+ \ '%Inote: %m,' .
+ \ '%C %#--> %f:%l:%c'
+
+ return SyntasticMake({
+ \ 'makeprg': makeprg,
+ \ 'errorformat': errorformat })
+endfunction
+
+call g:SyntasticRegistry.CreateAndRegisterChecker({
+ \ 'filetype': 'rust',
+ \ 'name': 'rustc'})
+
+let &cpo = s:save_cpo
+unlet s:save_cpo
diff --git a/vim/bundle/slimv/.gitignore b/vim/bundle/slimv/.gitignore
new file mode 100644
index 0000000..926ccaa
--- /dev/null
+++ b/vim/bundle/slimv/.gitignore
@@ -0,0 +1 @@
+doc/tags
diff --git a/vim/bundle/slimv/.hg_archival.txt b/vim/bundle/slimv/.hg_archival.txt
new file mode 100644
index 0000000..87f9307
--- /dev/null
+++ b/vim/bundle/slimv/.hg_archival.txt
@@ -0,0 +1,6 @@
+repo: 312df05857fb28463df0e6cf8f111907e574559f
+node: 0ef5452fbec40a66601e426515230e116a4fd398
+branch: default
+latesttag: 0.9.12
+latesttagdistance: 90
+changessincelatesttag: 116
diff --git a/vim/bundle/slimv/.hgtags b/vim/bundle/slimv/.hgtags
new file mode 100644
index 0000000..96ea127
--- /dev/null
+++ b/vim/bundle/slimv/.hgtags
@@ -0,0 +1,70 @@
+757fcf4f9ec8dd355562e43955d58a1d1e058cd4 0.1
+8f4d3ce88b2f1b17df960b143f7bd54d6b794aa8 0.1.1
+c62731098ea9d3dad0d788c65fa4ff917399bd2c 0.1.2
+2bca8504ba3537d4503d31cb6193ad8c0a0bcef6 0.1.3
+70624b5323657c6b58b6c8a0797fe609070b4d9e 0.1.4
+005fd272660d330ff021a4ca00897e55cdb69d30 0.2.0
+42a1717c1cff96a8798d8df0a03fba991976af27 0.2.1
+09036b7be53d6185d44dab46a3aab5b9b6e26f06 0.2.2
+0ea663fc393c7b01dbeb1f2e5b73d56bab1d5810 0.3.0
+0ea663fc393c7b01dbeb1f2e5b73d56bab1d5810 0.3.0
+0000000000000000000000000000000000000000 0.3.0
+0000000000000000000000000000000000000000 0.3.0
+46b4a0c3ce6b833eec22485419ca241925f051ab 0.3.0
+46b4a0c3ce6b833eec22485419ca241925f051ab 0.3.0
+0000000000000000000000000000000000000000 0.3.0
+fe355cee2ebbaabba06ee189569fd08072be659f 0.4.0
+6b7c608d1be092a040585bc583c3ba0ffc06588f 0.4.1
+f3379999fd93d4dd371a64cdaa5a70164ffc49d5 0.5.2
+522a7b80552b11ca4de218dc4e1aceb012a00ad4 0.5.0
+f3379999fd93d4dd371a64cdaa5a70164ffc49d5 0.5.2
+0000000000000000000000000000000000000000 0.5.2
+f3379999fd93d4dd371a64cdaa5a70164ffc49d5 0.5.1
+0000000000000000000000000000000000000000 0.5.2
+4d82e4dcd9d8c02b7e8f4c90553e29d7925738fe 0.5.2
+f4d0d22d0d985e4e0c378dd6e8f1a96f94277b64 0.5.4
+8ac0c3a2657079283394549bd6e2ab8b8ab0293d 0.5.5
+962b3932c08537ede2c4ca73fb19470702ee1329 0.5.3
+94fb2d92b804c4a93a4088a336d4b63c410d1f17 0.5.6
+0000000000000000000000000000000000000000 0.3.0
+08e87d29ff8aca59efc7b94a10356a8c1b49d77f 0.3.0
+d7b7e75927f8537aa32c85d3f3c6b3fb86830d8b 0.6.0
+b01612a1723b2f13c8a08578e9417ee669480da4 0.6.1
+b01612a1723b2f13c8a08578e9417ee669480da4 0.6.2
+fb43c9f5e6dd07dfc9190a1bf10f63d8f87676f7 0.6.3
+fb43c9f5e6dd07dfc9190a1bf10f63d8f87676f7 0.6.3
+0000000000000000000000000000000000000000 0.6.3
+b01612a1723b2f13c8a08578e9417ee669480da4 0.6.2
+0000000000000000000000000000000000000000 0.6.2
+0000000000000000000000000000000000000000 0.6.2
+fb43c9f5e6dd07dfc9190a1bf10f63d8f87676f7 0.6.2
+0000000000000000000000000000000000000000 0.6.3
+4959f842561eabf8c5cdcfc241019ed7747a4432 0.6.3
+f77d0a6ed18a09c64fd312883d9d3b54052ce2d4 0.7.0
+fdaacef3274ecf2cf12a3040675dfd879a797592 0.7.1
+7c65e28865449e02e9b700d131e9e154300a037c 0.7.2
+d954edf262b2ad25d554c7981104d4e1bf9cdfd4 0.7.3
+0ad03f87ebf52f17b410a4fa1a928768167bd907 0.7.4
+8c508324035a7fb1a0e6696e2e9a1f45366320e9 0.7.5
+6fa96bd1d6d9f15e3c4db1aadae2b11543873ba7 0.7.6
+5c1dd729b5ab0371426d7ca9ed97a5d501cda095 0.7.7
+ee22ddd1ad0ca9935970d515cab286c3e0c75670 0.8.0
+2dcdc990159c5e1b5981bdb6e36e47a898eef119 0.8.1
+19387d57e1960208c96cb4ac5db5ab44494d7723 0.8.2
+806fe91db6004c8eb11974e10e4ae546a8a6dd01 0.8.3
+788b4720a17d7017632e65fd4a964c4e3bbfcb40 0.8.4
+dbc305b7b56b49954b32081f722f3a94e8d6a8cf 0.8.5
+d68ef87e6af6f079e9df7ca913112088da30ad7b 0.8.6
+2fd4e021ba4a846b880ef1a89cfee657a3e66f3f 0.9.0
+0778e2463cc72303949f9e8d2096c901bbea4eb7 0.9.1
+5d61cd8f1d3fa6c81bd1cb63d324be70311d7733 0.9.2
+6d5949774edb4c180d88bcaf2831b16e69454faf 0.9.3
+af724df4e135098fa357debccc13e675543b978c 0.9.4
+e422038c0bc829e7c79ac9500b0c7fd79b78a395 0.9.5
+a7ba9b3a2435f88e3ff71367de22119c67b22958 0.9.6
+02922c38bb8b1cd45ac69fad04965f37d7239f58 0.9.7
+a481ad3fbefea06300c64a73ff856619b7af8334 0.9.8
+28ef6c33a8941f16e849cc0905d93d7c80fab26d 0.9.9
+537dfa6be0cf6f8a5a4e8012cee792652a22e535 0.9.10
+0794ee20d24bd6be62e76ef3e21bff55e46a0403 0.9.11
+638686453739bb51d37690546deef9e5e76dfb83 0.9.12
diff --git a/vim/bundle/slimv/README.txt b/vim/bundle/slimv/README.txt
new file mode 100644
index 0000000..6e36b77
--- /dev/null
+++ b/vim/bundle/slimv/README.txt
@@ -0,0 +1,152 @@
+--------------------------------------------------------------------------------
+slimv.vim
+--------------------------------------------------------------------------------
+
+Superior Lisp Interaction Mode for Vim ("SLIME for Vim")
+
+Vim script
+
+created by
+Tamas Kovacs
+
+--------------------------------------------------------------------------------
+Description
+--------------------------------------------------------------------------------
+
+Slimv is a SWANK client for Vim, similarly to SLIME for Emacs. SWANK is a TCP server for Emacs, which runs a Common Lisp, Clojure or Scheme REPL and provides a socket interface for evaluating, compiling, debugging, profiling lisp code. The SWANK server is embedded in Slimv, but you can also use your own SWANK installation.
+
+Slimv opens the lisp REPL (Read-Eval-Print Loop) inside a Vim buffer. Lisp commands may be entered and executed in the REPL buffer, just as in a regular REPL.
+
+Slimv supports SLIME's debugger, inspector, profiler, cross reference, arglist, indentation, symbol name completion functions. The script also has a Common Lisp Hyperspec lookup feature and it is able to lookup symbols in the Clojure API, as well as in JavaDoc.
+
+Slimv comes with Paredit Mode, which is similar to the functionality of paredit.el in Emacs. Paredit Mode tries to maintain the balanced state of matched characters (parenthesis marks, square and curly braces, double quotes). Matched characters are inserted and removed in pairs, also when working with a block of text (well, mostly). Slimv also implements many paredit.el s-expression handling functions, like Split/Join/Wrap/Splice/Raise. Slurpage and Barfage known from Emacs is also possible but in a different fashion: you don't move the list element in or out of the list, rather you move the opening or closing parenthesis over the element or sub-list.
+
+Please visit the Slimv Tutorial for a more complete introduction:
+http://kovisoft.bitbucket.org/tutorial.html
+
+Please find the most recent development version in the repository:
+https://bitbucket.org/kovisoft/slimv
+
+Here follows a list of Slimv commands, any similarity with SLIME's menu is not coincidental. :)
+
+Edit commands:
+ * Close Form
+ * Complete Symbol
+ * Function Arglist
+ * Paredit Toggle
+
+Evaluation commands:
+ * Eval Defun
+ * Eval Current Expression
+ * Eval Region
+ * Eval Buffer
+ * Interactive Eval
+ * Undefine Function
+
+Debug commands:
+ * Macroexpand-1
+ * Macroexpand All
+ * Toggle Trace
+ * Untrace All
+ * Disassemble
+ * Set Breakpoint
+ * Break on Exception
+ * Inspect
+ * Abort
+ * Quit to Toplevel
+ * Continue
+ * Restart Frame
+ * List Threads
+ * Kill Thread
+ * Debug Thread
+
+Compile commands:
+ * Compile Defun
+ * Compile and Load File
+ * Compile File
+ * Compile Region
+
+Cross Reference commands
+ * Who Calls
+ * Who References
+ * Who Sets
+ * Who Binds
+ * Who Macroexpands
+ * Who Specializes
+ * List Callers
+ * List Callees
+
+Profile commands:
+ * Toggle Profile
+ * Profile by Substring
+ * Unprofile All
+ * Show Profiled
+ * Profile Report
+ * Profile Reset
+
+Documentation commands:
+ * Describe Symbol
+ * Apropos
+ * Hyperspec
+ * Generate Tags
+
+REPL commands:
+ * Connect to Server
+ * Interrupt Lisp Process
+ * Send Input
+ * Close and Send Input
+ * Set Package
+ * Previous Input
+ * Next Input
+ * Clear REPL
+
+For more information see the included documentation.
+
+---------------------------------------------------------------------------------------------
+Installation details
+---------------------------------------------------------------------------------------------
+
+Extract the zip archive into your vimfiles or runtime directory.
+
+Slimv works on Windows, Linux and Mac OS X (via Terminal.app), Cygwin is supported. The script requires the following programs installed on your system:
+ * Vim with Python feature enabled
+ * Python (must be the same Python version that was Vim compiled against)
+ * Lisp (any Common Lisp with SLIME support) or Clojure or MIT Scheme (Linux only)
+
+Vim's Python version can be identified with the :ver command, look for the -DDYNAMIC_PYTHON_DLL=\"pythonXX\" string (if you have it). Another way of determining Vim's Python version:
+
+:python import sys; print(sys.version)
+
+Slimv tries to autodetect your Lisp/Clojure/Slime installation directories. If it fails to determine the correct directories, then you need to enter the command to start the SWANK server into your vimrc file.
+
+Linux example:
+ let g:slimv_swank_cmd = '! xterm -e sbcl --load /usr/share/common-lisp/source/slime/start-swank.lisp &'
+
+Windows example:
+ let g:slimv_swank_cmd = '!start "c:/Program Files/Lisp Cabinet/bin/ccl/wx86cl.exe" -l "c:/Program Files/Lisp Cabinet/site/lisp/slime/start-swank.lisp"'
+
+Mac OS X example:
+ let g:slimv_swank_cmd = '!osascript -e "tell application \"Terminal\" to do script \"sbcl --load ~/.vim/slime/start-swank.lisp\""'
+
+For Clojure use the g:slimv_swank_clojure option, e.g.:
+ let g:slimv_swank_clojure = '! xterm -e lein swank &'
+
+
+- For pure text-based console without XTerm
+
+If you only have `SSH` and can not use `XTerm`, you can use `tmux` or `screen` instead.
+
+Linux example with `tmux`:
+ let g:slimv_swank_cmd = '! tmux new-window -d -n REPL-SBCL "sbcl --load ~/.vim/bundle/slimv/slime/start-swank.lisp"'
+
+Linux example with `screen`:
+ let g:slimv_swank_cmd = '! screen -d -m -t REPL-SBCL sbcl --load ~/.vim/bundle/slimv/slime/start-swank.lisp'
+
+Mac OS X example with `tmux`:
+ let g:slimv_swank_cmd = '!osascript -e "! tmux new-window -d -n REPL-SBCL "sbcl --load ~/.vim/bundle/slimv/slime/start-swank.lisp"'
+
+
+See the included documentation for more complete installation and customization instructions.
+
+
+vim:et:wrap:
diff --git a/vim/bundle/slimv/doc/paredit.txt b/vim/bundle/slimv/doc/paredit.txt
new file mode 100644
index 0000000..b740a11
--- /dev/null
+++ b/vim/bundle/slimv/doc/paredit.txt
@@ -0,0 +1,461 @@
+*paredit.txt* Paredit Last Change: 13 Dec 2016
+
+Paredit Mode for Vim *paredit* *slimv-paredit*
+ Version 0.9.13
+
+The paredit.vim plugin performs structured editing of s-expressions used in
+the Lisp, Clojure, Scheme programming languages. It may come as part of Slimv
+but it is also distributed separately as a standalone plugin.
+
+|paredit-mode| Paredit mode
+|paredit-keys| Paredit keybindings
+|paredit-options| Paredit options
+
+===============================================================================
+PAREDIT MODE *paredit-mode*
+
+Paredit mode is a special editing mode that keeps all matched characters
+(parentheses, square and curly braces, double quotes) balanced, i.e. all opening
+characters have a matching closing character. Most text entering and erasing
+commands try to maintain the balanced state, so no single matched character is
+added or deleted, they are entered or removed in pairs.
+The function takes care of strings and comments, so no parenthesis and square
+bracket balancing is performed inside a string or comment.
+Please note that [] and {} pairs are not balanced for Lisp filetypes, only
+for Clojure and Scheme.
+
+The idea is taken from the paredit mode of Emacs, but not all paredit.el
+editing functions are implemented or behave exactly the same way as they do
+in Emacs.
+
+When you enter a '(' then a matching ')' is automatically inserted.
+If needed, spaces before and/or after the '()' pair are added.
+
+When you press ')' in insert mode then there's no need to insert a closing
+parenthesis mark (it is already there), so the cursor is simply advanced past
+the next closing parenthesis (then the next outer closing parenthesis, etc.).
+The result of this is however that when entering text with paredit mode
+you can use the same keystrokes as without paredit mode and you get the same
+result. Of course you can choose to not enter the closing parenthesis (as
+required without paredit mode), because it is already there.
+
+When you are trying to delete a ')' alone then it is not possible, the cursor
+is simply moved inside the list, where all regular characters can be deleted.
+When the list is finally empty: '()', then the deletion of the opening '('
+makes both parentheses erased at once, so the balanced state is maintained.
+
+All the above holds for [...] and "..." character pairs.
+
+When you are deleting multiple characters at once, e.g. deleting a whole line,
+or deleting till the end of the line, etc, then the deletion logic of a single
+character is iterated. This means that the whole line or the characters till
+the end of the line, etc are not necessarily deleted all. Depending on the
+number of open/close parentheses, square or curly braces, double quotes some
+of them might be kept in order to maintain the balanced state.
+For example if you press D in Normal mode to delete till the end of line
+between the a and b parameters of the following Clojure function definition:
+
+(defn myfunc [a b c] (+ a b c))
+ ^--- press D here
+
+then the closing ] as well as the last closing ) will not be deleted, because
+in the list you have an ( and a [ to be matched, so the result will be:
+
+(defn myfunc [a])
+
+If you are deleting multiple lines, then the above process is performed for
+all lines involved. If a line was not completely cleared, then it is joined
+with the next line and the process continues.
+
+
+Of course not all Vim commands are compatible with the paredit mode (e.g.
+you can yank and paste unbalanced code snippet, or comment out an asymmetrical
+part of the code), and there is also the possibility to edit the source code
+with paredit mode switched off or with another editor to make it unbalanced.
+When paredit mode detects that the underlying code is not balanced, then the
+paredit functionality is suspended until the top level form balance is fixed.
+As soon as all parens are matched, the paredit mode is automatically resumed.
+Paredit needs "syntax on" to identify the syntax elements of the underlying
+code, so if syntax is switched off, then paredit will not be suspended inside
+comments or strings.
+
+
+Slurpage and Barfage known from Emacs is also possible but in a different
+fashion: you don't move the symbols but move the opening or closing parenthesis
+over the symbol or a sub-list. This way you can move any symbol or sub-list
+into or out of the current list. It is not possible to move the parenthesis
+over its pair, so for example if you move the opening parenthesis to the right,
+then it will stop at the matched closing parenthesis.
+
+
+Paredit mode is set by default for .lisp, .cl, .clj, cljs, .scm and .rkt files,
+but it is possible to switch it off by putting the following statement in the
+.vimrc file:
+
+ let g:paredit_mode = 0
+
+You can enable paredit mode for other file types as well. Here is how to set
+it for Arc files in your .vimrc (assuming you have a filetype 'arc' defined):
+
+ au FileType arc call PareditInitBuffer()
+
+Paredit is part of Slimv, but it is also distributed separately as a standalone
+plugin. If you indend to use the SWANK client and/or Slimv's indentation and
+syntax functions, then please install the Slimv plugin. Otherwise you may want
+to install the Paredit plugin thus omitting other unnecessary files.
+
+
+===============================================================================
+PAREDIT KEYBINDINGS *paredit-keys*
+
+Here follows a list of paredit keybindings:
+
+
+Insert Mode:
+
+ ( Inserts '()' and moves the cursor inside. Also adds leading
+ or trailing spaces when needed.
+ Inserts '(' when inside comment or string.
+
+ ) Moves the cursor to the next closing parenthesis mark of
+ the current list. When pressed again then moves to the next
+ outer closing parenthesis, etc, until the closing of the
+ top level form is reached.
+ Inserts ')' when inside comment or string.
+ If |g:paredit_electric_return| is on then it also re-gathers
+ electric returns when appropriate.
+
+ [ Inserts '[]' and moves the cursor inside. Also adds leading
+ or trailing spaces when needed.
+ Inserts '[' when inside comment or string.
+
+ ] Moves the cursor to the next closing square bracket of the
+ current list. When pressed again then moves to the next
+ outer closing square bracket, etc, until the closing of the
+ top level form is reached.
+ Inserts ']' when inside comment or string.
+ If |g:paredit_electric_return| is on then it also re-gathers
+ electric returns when appropriate.
+
+ { Inserts '{}' and moves the cursor inside. Also adds leading
+ or trailing spaces when needed.
+ Inserts '{' when inside comment or string.
+
+ } Moves the cursor to the next closing curly brace of the
+ current list. When pressed again then moves to the next
+ outer closing curly brace, etc, until the closing of the
+ top level form is reached.
+ Inserts '}' when inside comment or string.
+ If |g:paredit_electric_return| is on then it also re-gathers
+ electric returns when appropriate.
+
+ " When outside of string, inserts '""' and moves the cursor
+ inside. When inside string then moves to the closing '"'.
+ Inserts '"' when inside comment. Also insert '"' when inside
+ string and preceded by a '\'.
+
+ <BS> When about to delete a (, ), [, ], or " and there are other
+ characters inside, then just skip it to the left. When
+ about to delete the opening part of the matched character
+ with nothing inside, then the whole empty list is removed.
+
+ <Del> When about to delete a (, ), [, ], or " and there are other
+ characters inside, then just skip it to the right. When
+ about to delete the closing part of the matched character
+ with nothing inside, then the whole empty list is removed.
+
+ <Enter> If |g:paredit_electric_return| is on then insert an
+ "electric return", i.e. create an empty line by inserting
+ two newline characters.
+
+
+Normal Mode:
+
+ ( Finds opening '(' of the current list. Can be pressed
+ repeatedly until the opening of the top level form reached.
+
+ ) Finds closing ')' of the current list. Can be pressed
+ repeatedly until the closing of the top level form reached.
+
+ [[ Go to the start of current/previous defun.
+
+ ]] Go to the start of next defun.
+
+ <Leader>< If standing on a delimiter (parenthesis or square bracket)
+ then moves it to the left by slurping or barfing the
+ s-expression to the left, depending on the direction of the
+ delimiter:
+ Pressing '<' when standing on a ')' makes the s-expression
+ to the left of the ')' going out of the current list.
+ Pressing '<' when standing on a '(' makes the s-expression
+ to the left of the '(' coming into the current list.
+ For example pressing <Leader>< at position marked with |:
+ (aaa bbb|) ---> (aaa|) bbb
+ aaa |(bbb) ---> |(aaa bbb)
+
+ <Leader>> If standing on a delimiter (parenthesis or square bracket)
+ then moves it to the right by slurping or barfing the
+ s-expression to the right, depending on the direction of the
+ delimiter:
+ Pressing '>' when standing on a '(' makes the s-expression
+ to the right of the '(' going out of the current list.
+ Pressing '>' when standing on a ')' makes the s-expression
+ to the right of the ')' coming into the current list.
+ For example pressing <Leader>< at position marked with |:
+ (aaa|) bbb ---> (aaa bbb|)
+ |(aaa bbb) ---> aaa |(bbb)
+
+ <Leader>J Join two subsequent lists or strings. The first one must end
+ before the cursor, the second one must start after the
+ cursor position.
+ For example pressing <Leader>J at position marked with |:
+ (aaa)| (bbb) ---> (aaa |bbb)
+ "aaa"| "bbb" ---> "aaa |bbb"
+
+ <Leader>O Split ("Open") current list or string at the cursor position.
+ Opposite of Join. Key O is selected because for the original
+ Vim mapping J and O are also kind of opposites.
+ For example pressing <Leader>O at position marked with |:
+ (aaa |bbb) ---> (aaa) |(bbb)
+ "aaa|bbb" ---> "aaa" |"bbb"
+
+ <Leader>W Wrap the current symbol in a pair of parentheses. The cursor
+ <Leader>w( is then positioned on the opening parenthesis, as wrapping
+ is usually done because one wants to call a function with
+ the symbol as parameter, so by pressing "a" one can enter
+ the function name right after the newly inserted "(".
+ For example pressing <Leader>W at position marked with |:
+ (aaa b|bb ccc) ---> (aaa |(bbb) ccc)
+
+ <Leader>w[ Wrap the current symbol in a pair of square brackets,
+ similarly to <Leader>W.
+ For example pressing <Leader>w[ at position marked with |:
+ (aaa b|bb ccc) ---> (aaa |[bbb] ccc)
+
+ <Leader>w{ Wrap the current symbol in a pair of curly braces,
+ similarly to <Leader>W.
+ For example pressing <Leader>w{ at position marked with |:
+ (aaa b|bb ccc) ---> (aaa |{bbb} ccc)
+
+ <Leader>w" Wrap the current symbol in a pair of double quotes,
+ similarly to <Leader>W.
+ For example pressing <Leader>w" at position marked with |:
+ (aaa b|bb ccc) ---> (aaa "bbb|" ccc)
+
+ <Leader>S Splice the current list into the containing list, i.e.
+ remove the opening and closing parens. Opposite of wrap.
+ For example pressing <Leader>S at position marked with |:
+ (aaa (b|bb ccc) ddd) ---> (aaa |bbb ccc ddd)
+
+ <Leader><Up> Splice the current list into the containing list by deleting
+ everything backward from the cursor position up to the
+ opening paren.
+ For example pressing <Leader><Up> at position marked with |:
+ (aaa (bbb |ccc) ddd) ---> (aaa |ccc ddd)
+
+ <Leader><Down> Splice the current list into the containing list by deleting
+ everything forward from the cursor position up to the
+ closing paren.
+ For example pressing <Leader><Down> at position marked with |:
+ (aaa (bbb| ccc) ddd) ---> (aaa |bbb ddd)
+
+ <Leader>I Raise the current symbol, i.e. replace the current list with
+ the current symbol by deleting everything else (except the
+ symbol) in the list, including the enclosing pair of parens.
+ For example pressing <Leader>I at position marked with |:
+ (aaa (b|bb ccc) ddd) ---> (aaa |bbb ddd)
+
+ x or <Del> When about to delete a (, ), [, ], or " and there are other
+ characters inside, then just skip it to the right. When
+ about to delete the closing part of the matched character
+ with nothing inside, then the whole empty list is removed.
+ When preceded by a <count> value then delete this many
+ characters.
+
+ X When about to delete a (, ), [, ], or " and there are other
+ characters inside, then just skip it to the left. When
+ about to delete the opening part of the matched character
+ with nothing inside, then the whole empty list is removed.
+
+ D Keep deleting characters towards the end of line,
+ maintaining the balanced state, i.e. keep the number of
+ opening and closing parens the same.
+
+ C Same as 'D' but go to insert mode at the end.
+
+ s Same as 'x' but go to insert mode at the end.
+
+ dd Delete whole line by keeping the balanced state, i.e.
+ keep the number of opening and closing parens the same.
+ When preceded by a <count> value then delete this many
+ lines.
+
+ cc Same as 'dd' but go to insert mode at the end.
+
+ d{motion} Delete text till {motion}. Keeps text balanced, so if the
+ surrounded text contains unpaired matched characters then
+ they are not removed.
+
+ c{motion} Delete text till {motion} and start insert mode. Keeps text
+ balanced just like d{motion}.
+
+ p Put the text after the cursor with all unbalanced matched
+ characters removed.
+
+ P Put the text before the cursor with all unbalanced matched
+ characters removed.
+
+
+Visual Mode:
+
+ ( Finds opening '(' of the current list and selects the whole
+ list. Can be pressed repeatedly until the top level form
+ selected.
+
+ ) Finds closing ')' of the current list and selects the whole
+ list. Can be pressed repeatedly until the top level form
+ selected.
+
+ d Delete the current visual selection. Keeps text balanced,
+ x so the the selection contains unpaired matched characters
+ <Del> then they are not removed.
+
+ c Delete the current visual selection and start insert mode.
+ Keeps text balanced just like the 'd' command.
+
+ <Leader>W Wrap the current visual selection in a pair of parentheses.
+ <Leader>w( The visual selection is kept.
+
+ <Leader>w[ Wrap the current visual selection in a pair of square
+ brackets. The visual selection is kept.
+
+ <Leader>w{ Wrap the current visual selection in a pair of curly braces.
+ The visual selection is kept.
+
+ <Leader>w" Wrap the current visual selection in a pair of double
+ quotes. The visual selection is kept.
+
+
+Please note that if variable |g:paredit_shortmaps| is nonzero then the
+following normal mode mappings don't get a <Leader> prefix, they are mapped
+to existing (but infrequently used) Vim functions and instead the original Vim
+functions are mapped with the <Leader> prefix:
+
+ <, >, J, O, W, S
+
+
+Vim has many built-in mappings for manipulating s-expressions. Here follows a
+list of useful commands, these are not defined by paredit.vim, they are
+available even when paredit mode is switched off.
+
+ % Find the matching pair of the parenthesis the cursor is
+ standing on.
+
+ d% Delete till the matching parenthesis. Normally it is used
+ when the cursor is standing on a parenthesis (works with
+ square or curly braces as well). If not standing on a
+ parenthesis then deletes left till the first opening paren,
+ so this command may also be used to delete an s-expression
+ that is right before the cursor.
+
+ daw Delete a word. Can be used to delete a list element, the
+ cursor may be placed anywhere in the element.
+
+ da( Delete the innermost s-expression. The cursor may be placed
+ anywhere inside the s-expression.
+
+ di( Same as da( but does not delete the enclosing parens.
+
+
+Davide Taviani made a cheetsheet for Paredit, which can be accessed here:
+https://github.com/StudyFlow/paredit.vim-cheatsheet
+
+===============================================================================
+PAREDIT OPTIONS *paredit-options*
+
+|g:paredit_disable_clojure| If defined, paredit is disabled for clojure files.
+
+|g:paredit_disable_hy| If defined, paredit is disabled for hy files.
+
+|g:paredit_disable_lisp| If defined, paredit is disabled for lisp files.
+
+|g:paredit_disable_scheme| If defined, paredit is disabled for scheme files.
+
+|g:paredit_disable_shen| If defined, paredit is disabled for shen files.
+
+|g:paredit_electric_return| If nonzero, electric return feature is enabled.
+
+|g:paredit_smartjump| If nonzero, '(' and ')' also target square brackets
+ and curly braces when editing Clojure or Scheme.
+
+|g:paredit_leader| Custom <Leader> setting for Paredit.
+
+|g:paredit_matchlines| Number of lines to look backward and forward
+ when checking if the current form is balanced.
+
+|g:paredit_mode| If nonzero, paredit mode is switched on.
+
+|g:paredit_shortmaps| If nonzero, paredit is remapping some one-letter
+ Vim commands that are not frequently used.
+
+
+ *g:paredit_disable_clojure*
+ *g:paredit_disable_lisp*
+ *g:paredit_disable_scheme*
+ *g:paredit_disable_shen*
+If defined then paredit is disabled for the given file type. Useful to use
+a different plugin for a specific file type, but keep using paredit for the
+others.
+
+ *g:paredit_electric_return*
+If nonzero then "electric return" feature is enabled. This means that when an
+<Enter> is pressed before a closing paren in insert mode, paredit will actually
+insert two newlines creating an empty line. The extra newline is consumed at
+pressing the next closing paren. This feature allows linewise editing of the
+subform entered in the next (empty) line.
+In other words <Enter> "opens" parenthetical expressions while editing, ')'
+"closes" them.
+Please note that electric return is disabled for the REPL buffer if Slimv
+option |g:slimv_repl_simple_eval| is nonzero. In this case <Enter> is used
+to send the command line to the swank server for evaluation.
+
+Please find a video demonstration of the electric return feature here:
+http://img8.imageshack.us/img8/9479/openparen.gif
+
+ *g:paredit_smartjump*
+If nonzero, this option changes the behavior of '(' and ')' in normal and visual
+modes when editing Clojure or Scheme. Rather than jumping to nearest open or close
+parenthesis, instead the cursor will jump to the nearest '(', '[', or '{' if
+you press '(', and it will jump to the nearest ')', ']', or '}' if you press
+')'. This option makes it much easier to navigate nested Clojure data
+structures. It does nothing if the filetype is not clojure or Scheme.
+
+ *g:paredit_leader*
+This option allows a custom <Leader> setting for the Paredit keybindings.
+By default it has the same value as |mapleader|. If neither g:paredit_leader
+nor mapleader are defined then the default <Leader> is "," in Paredit.
+Example:
+ let g:paredit_leader = '\'
+If this is set in the .vimrc then Wrap will be mapped to \W instead of ,W.
+
+There is a separate |g:slimv_leader| option for the general Slimv keybindings.
+
+ *g:paredit_matchlines*
+Number of lines to look backward and forward when checking if the current
+top level form is balanced in paredit mode. Default is 100.
+
+ *g:paredit_mode*
+If nonzero then paredit mode is switched on, i.e. the plugin tries to keep the
+balanced state of parens. This is the default behaviour.
+
+ *g:paredit_shortmaps*
+If nonzero, paredit is remapping some one-letter normal mode Vim commands that
+are not frequently used. These are <, >, J, O, W, S. The original function of
+these maps then can be reached via <Leader> (which is the "," character
+by default in Paredit).
+Otherwise these paredit functions can be reached via <Leader> maintaining the
+original functions of these keys.
+
+
+===============================================================================
+vim:tw=80:et:wrap:ft=help:norl:
diff --git a/vim/bundle/slimv/doc/slimv.txt b/vim/bundle/slimv/doc/slimv.txt
new file mode 100644
index 0000000..5ad493f
--- /dev/null
+++ b/vim/bundle/slimv/doc/slimv.txt
@@ -0,0 +1,2171 @@
+*slimv.txt* Slimv Last Change: 02 Oct 2016
+
+Slimv *slimv*
+ Version 0.9.13
+
+The Superior Lisp Interaction Mode for Vim.
+This plugin is aimed to help Lisp development by interfacing between Vim and
+the Lisp REPL, similarly to Emacs/SLIME.
+Slimv is actually a SWANK (TCP server for Emacs) client.
+Slimv works on Windows, Linux, and Mac OS X, however the newly introduced
+Paredit mode is operating system independent. Please visit |paredit.txt| for
+additional information on Paredit mode.
+
+|slimv-installation| Installation
+|slimv-configuration| Configuration
+|slimv-swank| SWANK Features implemented in Slimv
+|slimv-repl| Lisp REPL inside Vim
+|slimv-clojure| Clojure support
+|slimv-scheme| Scheme support
+|slimv-package| Package and Namespace handling
+|slimv-hyperspec| Hyperspec Lookup and Completion
+|slimv-paredit| Paredit mode
+|slimv-external| External utilities
+|slimv-faq| Frequently Asked Questions
+|slimv-changelog| Change Log
+|slimv-issues| Known Issues
+|slimv-todo| Todo
+|slimv-credits| Credits
+
+For Vim version 7.0 and above.
+This plugin is only available if 'compatible' is not set.
+
+{Vi does not have any of this}
+
+===============================================================================
+INSTALLATION *slimv-installation*
+
+Prerequisites:
+
+ Required components:
+ - Vim 7.0 or newer installed with Python feature enabled.
+ This can be verified by the :ver command, look for the +python string.
+ It is recommended to have also the +balloon_eval feature for displaying
+ symbol descriptions in tooltip.
+ - Python 2.4 or later installed.
+ Must be the same Python version that was Vim compiled against.
+ This can also be verified by the :ver command, look for the
+ -DDYNAMIC_PYTHON_DLL=\"pythonXX\" string, where XX is the required
+ Python version.
+ - Lisp or Clojure or MIT Scheme (Linux only) installed.
+ Any Lisp implementation is OK that has SLIME support.
+
+ Optional components:
+ - "Exuberant ctags" for tags file generation (if not bundled with Vim
+ already). See |slimv-ctags|.
+ - Slimv also contains SLIME (in fact the SWANK server part of SLIME) and
+ Swank Clojure. If you intend to use your own version of SLIME, then you
+ need to have your own SWANK server installed.
+ For example Clojure users might consider installing Leiningen and run the
+ SWANK server via 'lein swank', or use Cake via 'cake swank'.
+
+To install the script:
+
+ - Install all required components described above.
+ - Download slimv.zip.
+ - Extract the zip archive into your vimfiles or runtime directory.
+ See Vim help file |usr_05.txt| for details on adding a plugin.
+ The archive contains the following files:
+
+ doc/paredit.txt
+ doc/slimv.txt
+ ftdetect/clojure.vim
+ ftplugin/iterm.applescript
+ ftplugin/slimv.vim
+ ftplugin/slimv-clhs.vim
+ ftplugin/slimv-cljapi.vim
+ ftplugin/slimv-javadoc.vim
+ ftplugin/swank.py
+ ftplugin/clojure/slimv-clojure.vim
+ ftplugin/lisp/slimv-lisp.vim
+ ftplugin/r/slimv-r.vim
+ ftplugin/scheme/slimv-scheme.vim
+ indent/clojure.vim
+ indent/lisp.vim
+ indent/scheme.vim
+ plugin/paredit.vim
+ slime/*
+ swank-clojure/*
+ syntax/clojure/slimv-syntax-clojure.vim
+ syntax/lisp/slimv-syntax-lisp.vim
+ syntax/scheme/slimv-syntax-scheme.vim
+
+ You might already have an ftdetect/clojure.vim file if you already use
+ another Clojure filetype plugin. In this case just keep the original file.
+
+ - Start Vim or goto an existing instance of Vim.
+ - Execute the following command:
+>
+ :helptags <your runtime directory>/doc
+
+ (e.g :helptags $VIMRUNTIME/doc)
+<
+ This will generate all the help tags for any file located in the doc
+ directory.
+ - Enter path definitions into your vimrc (if the default values are not
+ valid for your Vim/Lisp installation).
+ See |slimv-configuration| below on how to do this.
+
+
+Uninstallation:
+
+ - Exit all Vim instances and exit from the SWANK server.
+ - Delete the files that were copied to the vimfiles directory during
+ installation (see list of files above).
+
+
+===============================================================================
+CONFIGURATION *slimv-configuration*
+
+|slimv-options| Options
+|slimv-keyboard| Keyboard mappings
+
+-------------------------------------------------------------------------------
+ *slimv-options*
+
+The list below contains an alphabetical collection of Slimv options.
+Below that list follows the detailed explanation on each option.
+For the Paredit options please visit |paredit-options|.
+For the Swank options plese visit |swank-configuration|.
+
+|g:scheme_builtin_swank| Enable MIT scheme's built-in swank server.
+
+|g:slimv_balloon| Specifies if tooltips are on.
+
+|g:slimv_browser_cmd| If nonempty, this command is used to open the
+ Common Lisp Hyperspec.
+
+|g:slimv_browser_cmd_suffix| Optional suffix for |g:slimv_browser_cmd|
+
+|g:slimv_clhs_root| Base URL for the Common Lisp Hyperspec.
+
+|g:slimv_clhs_user_db| User defined extension for Slimv's built-in
+ Common Lisp Hyperspec symbol database.
+
+|g:slimv_clhs_user_root| Base URL for the user defined CLHS extension.
+
+|g:slimv_cljapi_root| Base URL for the Clojure API.
+
+|g:slimv_cljapi_user_db| User defined extension for Slimv's built-in
+ Clojure API symbol database.
+
+|g:slimv_cljapi_user_root| Base URL for the user defined Clojure API
+ extension.
+
+|g:slimv_ctags| OS command to generate tags file.
+
+|g:slimv_disable_clojure| Disable Slimv for Clojure files.
+
+|g:slimv_disable_lisp| Disable Slimv for Lisp files.
+
+|g:slimv_disable_scheme| Disable Slimv for Scheme files.
+
+|g:slimv_echolines| Echo only this number of lines from the form
+ being evaluated.
+
+|g:slimv_impl| The Lisp implementation. Defaults to 'clisp'.
+
+|g:slimv_indent_keylists| Enable special indentation for keyword lists.
+
+|g:slimv_indent_maxlines| Maximum number of lines searched backwards for
+ indenting special forms
+
+|g:slimv_inspect_name| Name of the Inspect buffer.
+
+|g:slimv_javadoc_root| Base URL for the JavaDoc.
+
+|g:slimv_keybindings| Predefined Slimv keybindings. Possible values:
+ 1 = set #1, 2 = set #2, other = no keybindings
+
+|g:slimv_leader| Custom <Leader> setting for Slimv.
+
+|g:slimv_lisp| Path for the Lisp interpreter.
+
+|g:slimv_menu| If nonzero, Slimv menu is added to the Vim menu.
+
+|g:slimv_package| If nonzero, Slimv package/namespace handling is
+ switched on.
+
+|g:slimv_preferred| Name of the preferred lisp implementation.
+
+|g:slimv_python_version| If defined, determines Python version to use,
+ when 3 use :python3 and friends, otherwise
+ :python or :python3 is used as available.
+
+|g:slimv_repl_max_len| Maximum number of lines in the REPL buffer.
+
+|g:slimv_repl_name| Name of the REPL buffer.
+
+|g:slimv_repl_simple_eval| <CR> evaluates form in the REPL buffer.
+
+|g:slimv_repl_split| Open the Lisp REPL buffer in a split window
+ or in a separate buffer.
+
+|g:slimv_repl_syntax| Enable syntax coloring for the REPL buffer.
+
+|g:slimv_repl_wrap| Set wrap mode for the REPL buffer.
+
+|g:slimv_simple_compl| Use simple completion instead of fuzzy completion.
+
+|g:slimv_sldb_name| Name of the SLDB buffer.
+
+|g:slimv_sldb_wrap| Set wrap mode for the SLDB buffer.
+
+|g:slimv_swank_clojure| Command used to start the Clojure SWANK server.
+
+|g:slimv_swank_cmd| Command used to start the Lisp SWANK server.
+
+|g:slimv_swank_scheme| Command used to start the Scheme SWANK server.
+
+|g:slimv_tags_file| Name of tags file used by Slimv.
+
+|g:slimv_threads_name| Name of the Threads buffer.
+
+|g:slimv_timeout| Timeout defined for starting up or connecting
+ to the SWANK server.
+
+|g:slimv_unmap_cr| Do not add special insert mode mapping for <CR>.
+
+|g:slimv_unmap_tab| Do not add special insert mode mapping for <Tab>.
+
+|g:slimv_unmap_space| Do not add special insert mode mapping for <Space>.
+
+|g:slimv_updatetime| Alternative value for 'updatetime' during REPL
+ refresh.
+
+|g:swank_block_size| SWANK connection output buffer size.
+
+|g:swank_host| Host name or IP address of the SWANK server.
+
+|g:swank_port| Port number of the SWANK server.
+
+
+Note: Most options require to restart the Vim session when modified.
+
+Slimv tries to autodetect the Lisp installation directory, however the
+algorithm is not very sophisticated.
+If the installation directories are put in the path, then the autodetection
+should find them (this is usually the case on Linux). Otherwise (on Windows)
+some frequently used directories are searched under C:\ and C:\Program Files.
+For a minimum, Slimv needs to know the path of the existing Lisp installation,
+so if autodetection does not work for you, then set the following global
+variables in your vimrc.
+
+Note: On Windows use the / (slash) character instead of \ (backslash) as the
+ directory separator to avoid any incidental character escaping problems
+ while the paths are beeing passed between the Slimv processes.
+ On Linux this is not an issue.
+
+ *g:slimv_lisp*
+This is the installation path of the Lisp interpreter.
+Example:
+ let g:slimv_lisp = 'C:/MyLispDir/mylisp.exe'
+
+ *g:slimv_impl*
+This is the Lisp implementation used. Slimv tries to autodetect it at script
+startup. If the autodetection fails, set this to the actual Lisp
+implementation.
+Example:
+ let g:slimv_impl = 'sbcl'
+
+ *g:slimv_preferred*
+Name of the preferred lisp implementation. The autodetection mechanism tries to
+choose this one if possible, i.e. if installed and found in the path or in the
+standard installation directories.
+It's typical use is when there are multiple lisps present in the system and
+the autodetection chooses an undesired implementation.
+
+Valid choices are for lisp:
+ 'sbcl', 'clisp', 'cmu', 'ecl', 'allegro', 'lispworks', 'clozure'
+For Scheme:
+ 'mit'
+
+Example:
+ let g:slimv_preferred = 'clisp'
+This means that Slimv will use clisp even if both sbcl and clisp are installed
+and the autodetection would choose sbcl.
+
+ *g:slimv_disable_clojure*
+ *g:slimv_disable_lisp*
+ *g:slimv_disable_scheme*
+If any of these options are set then the Slimv will not be loaded and enabled
+for the corresponding filetype.
+
+Example:
+You want to use Slimv for Lisp but don't want to use it for Scheme:
+ let g:slimv_disable_scheme = 1
+
+ *g:slimv_swank_cmd*
+ *g:slimv_swank_clojure*
+ *g:slimv_swank_scheme*
+Slimv tries to autodetect your Lisp/SWANK installation.
+If the location for the SWANK server is not identified by the script, or you
+want to use a different command for starting the SWANK server, then you may
+want to customize the g:slimv_swank_cmd (general) and g:slimv_swank_clojure
+(Clojure specific) and g:slimv_swank_scheme (Scheme specific) options in your
+.vimrc file.
+Enter a Vim command here that spawns a detached process that runs the SWANK
+server of your choice. It is important to use a Vim command here that returns
+immediately and does not wait for the termination of the detached process,
+so begin the command with !start on Windows...:
+
+ let g:slimv_swank_cmd = '!start "c:\Program Files\Lisp Cabinet\bin\ccl\wx86cl.exe" -l "c:\Program Files\Lisp Cabinet\site\lisp\slime\start-swank.lisp"'
+ let g:slimv_swank_clojure = '!start "c:\clojurebox\swank-clojure\src\start-swank.bat"'
+
+...and end the command with an & on Linux:
+
+ let g:slimv_swank_cmd = '! xterm -e sbcl --load /usr/share/common-lisp/source/slime/start-swank.lisp &'
+ let g:slimv_swank_clojure = '! xterm -e lein swank &'
+
+On OS X the following or similar command may be used (but sometimes the above
+Linux xterm command also works):
+
+ let g:slimv_swank_cmd = '!osascript -e "tell application \"Terminal\" to do script \"sbcl --load ~/.vim/slime/start-swank.lisp\""'
+ let g:slimv_swank_clojure = '!osascript -e "tell application \"Terminal\" to do script \"cake swank\""'
+
+These are examples only, the Lisp command and the path to the SWANK server
+may need to be changed in the command depending on the actual configuration.
+
+It is also possible to run the SWANK server manually prior running Vim.
+Slimv detects if a SWANK server is running and connects to it at the first
+evaluation request.
+
+Note: It is recommended to pass
+ :dont-close t
+for the swank:create-server function call in the SWANK startup procedure.
+This makes a permanent SWANK server that listens continuously. Otherwise
+each time the SWANK connection is lost, the SWANK server needs to be
+restarted again.
+Example startup script:
+
+(load (merge-pathnames "swank-loader.lisp" *load-truename*))
+
+(swank-loader:init :delete nil
+ :reload nil
+ :load-contribs nil)
+
+(swank:create-server :port 4005
+ :coding-system "iso-latin-1-unix"
+ :dont-close t)
+
+
+ *g:swank_block_size*
+By default the SWANK server connection output buffer size is 4 or 8 kbytes.
+All the data sent by the SWANK server is divided into this size blocks, so
+if the SWANK server is sending large amount of data then this may result in
+high number of data blocks sent, which may slow down Slimv. For greater
+performance you may want to increase the block size, e.g. to 64 kbytes:
+ let g:swank_block_size = 65536
+
+ *g:swank_host*
+Host name or IP address of the SWANK server. Default value is 'localhost'.
+The SWANK server may run on a remote machine, but currently only unencrypted
+plain socket communication is supported, no SSH or whatsoever.
+
+Please note that if the SWANK server is on a remote machine then Slimv is
+unable to start it, so you need to run the SWANK server manually.
+Actually there is a workaround for this on Linux: run Vim inside a GNU screen
+session. Slimv will autodetect this and modify the Swank command so that the
+Swank server is run inside a newly opened virtual terminal in screen.
+Slimv also autodetects an existing tmux session, so you can use tmux instead
+of GNU screen for the same purpose.
+
+ *g:swank_port*
+The SWANK server is connected to port 4005 by default. This can be changed
+using the g:swank_port option.
+
+ *g:scheme_builtin_swank*
+
+Since version 9.1.1 MIT scheme has a built-in swank server that can replace
+contrib/swank-mit-scheme.scm coming with Slime. This option enables the
+built-in swank server.
+Please be aware that this is still experimental, so it is not enabled by
+default. Using it may result in strange errors, but in other areas it also
+may be superior to swank-mit-scheme.scm and it is actively maintained.
+
+ *g:slimv_timeout*
+There is a 20 second timeout defined for starting up or connecting to the
+SWANK server. This timeout can be changed via the g:slimv_timeout option.
+Please note that the very first startup of the SWANK server may take more time
+than the subsequent startups, so it is not recommended to make this timeout
+too low.
+
+ *g:slimv_ctags*
+It is possible to generate tags file from within Vim. By default Slimv assumes
+that ctags.exe is stored somewhere along with the standard Vim path designated
+by $vim or $vimruntime. The command for generating tags file is then
+automatically built at script startup.
+If ctags.exe is stored somewhere else, or the default ctags options are
+unsatisfactory, then override this option with the desired command.
+The default ctags command is:
+ "ctags.exe -a --language-force=lisp *.lisp *.clj"
+
+ *g:slimv_tags_file*
+The Find-Definition function gets location information from the SWANK server.
+Slimv uses a dedicated tags file for Find-Definitions. By default this is a
+temporary file but the filename can be overridden via this option. If this
+variable is set to the empty string ('') then the whole Find-Definitions
+function is disabled.
+
+ *g:slimv_keybindings*
+Defines the keybinding set used by Slimv.
+Value 0 means no keybinding at all.
+Value 1 defines the short keybinding with one-key bindings (after <Leader>).
+ Example: Eval-Defun is mapped to ,d
+Value 2 defines the easy keybinding with two-key bindings (after <Leader>).
+ Example: Eval-Defun is mapped to ,ed
+Other values mean no predefined keybinding is wanted.
+<Leader> is set to "," by default in Slimv.
+
+ *g:slimv_unmap_cr*
+ *g:slimv_unmap_tab*
+ *g:slimv_unmap_space*
+If nonzero then Slimv does not add special insert mode mapping for the
+<CR>/<Tab>/<Space> keys in the editor buffer. This might come in handy when
+additional scripts are installed for Vim together with Slimv and there is a
+collision in the mappings for these keys. Of course in this case the related
+Slimv functions will not work when pressing those keys.
+
+Note: in case Paredit is used then the |g:paredit_electric_return| option shall
+also be set to 0 in order to completely disable mappings for <CR>.
+
+ *g:slimv_leader*
+This option allows a custom <Leader> setting for the Slimv keybindings.
+By default it has the same value as |mapleader|, except when |mapleader| is
+<Space> which <Leader> is currently not supported by Slimv.
+If neither g:slimv_leader nor |mapleader| are defined or |mapleader| is <Space>
+then the default <Leader> is "," in Slimv.
+Example:
+ let g:slimv_leader = '\'
+If this is set in the .vimrc then Eval-Defun will be mapped to \d instead of ,d.
+
+There is a separate |g:paredit_leader| option for the Paredit keybindings.
+
+ *g:slimv_menu*
+If nonzero then the Slimv menu is added to the end of the global menu.
+Also the Slimv menu can be shown by pressing <Leader>, (defaults to ,,).
+
+ *g:slimv_browser_cmd*
+Specifies the command to start the browser in order to display the Common Lisp
+Hyperspec or the Clojure API. If the command contains spaces then enclose the
+whole string in double quotes or escape the spaces with a backslash.
+This option is empty by default, which means that the command associated with
+the .html extension (on Windows) or xdg-open (on Linux) is used to start the
+browser. If xdg-open is not installed then the Python webbrowser package is
+used to identify the default browser on Linux.
+
+ *g:slimv_browser_cmd_suffix*
+When using option |g:slimv_browser_cmd| the Hyperspec page URL is appended to
+the browser command. However sometimes it might be needed to add a suffix
+at the end of the browser command.
+Slimv automatically adds the "&" suffix in order to fork the browser and
+return control immediately to Vim. If you don't want to fork the browser
+then set |g:slimv_browser_cmd_suffix| to "". Also use this option if you want
+to have extra parameters or commands in the browser command after the URL,
+but in this case remember to add the "&" when forking is needed.
+
+ *g:slimv_repl_name*
+Name of the REPL buffer. Default is 'REPL'. Space and some other special
+characters need to be escaped (e.g. 'Slimv\ REPL', '\#REPL\#').
+Not all special characters are allowed, e.g. '*' does not work in Windows.
+
+ *g:slimv_sldb_name*
+Name of the SLDB buffer. Default is 'SLDB'. Space and some other special
+characters need to be escaped (e.g. 'Slimv\ Debugger', '\#SLDB\#').
+Not all special characters are allowed, e.g. '*' does not work in Windows.
+
+ *g:slimv_inspect_name*
+Name of the Inspect buffer. Default is 'INSPECT'. Space and some other special
+characters need to be escaped (e.g. 'Slimv\ Incpector', '\#INSPECT\#').
+Not all special characters are allowed, e.g. '*' does not work in Windows.
+
+ *g:slimv_threads_name*
+Name of the Threads buffer. Default is 'THREADS'. Space and some other special
+characters need to be escaped (e.g. 'Slimv\ Threads', '\#THREADS\#').
+Not all special characters are allowed, e.g. '*' does not work in Windows.
+
+ *g:slimv_repl_split*
+Open the Lisp REPL buffer in a split window or in a separate buffer in Vim.
+The default is to use split window. If you prefer having REPL being in a hidden
+buffer then set this option to zero. This way the REPL buffer will be opened
+at the first evaluation, but any subsequent evaluation will be performed
+silently, with the REPL buffer kept hidden.
+
+It is also possible to define the desired split direction. The following
+values may be used for |g:slimv_repl_split|:
+
+ 0: no split
+ 1: horizontal split above (default)
+ 2: horizontal split below
+ 3: vertical split left
+ 4: vertical split right
+
+ *g:slimv_updatetime*
+The REPL buffer is refreshed at every keystroke or when the user doesn't press
+a key for the time specified with 'updatetime'. Slimv alters the value for
+'updatetime' to a lower value when the REPL buffer is changed, so that the
+update frequency gets higher while there is new REPL output. The original
+value for 'updatetime' is restored when there is no REPL output.
+The g:slimv_updatetime option defines the alternative (lower) value for
+'updatetime' during REPL refresh. If you don't want that Slimv changes
+'updatetime', then set g:slimv_updatetime to zero.
+The default value is 200 (=0.2 sec).
+
+ *g:slimv_package*
+If nonzero then Slimv package/namespace handling is switched on. Please find
+details in the |slimv-package| section.
+
+ *g:slimv_repl_max_len*
+Maximum number of lines for the REPL buffer. Only the last this number of lines
+are kept in the REPL buffer, all lines before that are erased, but some opening
+parens and/or double quotes may remain in order to maintain their balanced
+state. The default value for this option is 0, meaning that the number of lines
+is unlimited, i.e. no line is ever erased.
+
+ *g:slimv_repl_simple_eval*
+This option controls the behaviour of insert mode <CR>, <Up>, <Down> in the
+REPL buffer.
+
+If nonzero then:
+ <CR> Evaluates the form entered in the command line
+ <Up> Brings up the previous command from the command line history
+ <Down> Brings up the next command from the command line history
+ <C-CR> Closes and evaluates the form entered in the command line
+
+If the option is zero then:
+ <C-CR> Closes and evaluates the form entered in the command line
+ <C-Up> Brings up the previous command from the command line history
+ <C-Down> Brings up the next command from the command line history
+ <CR> Inserts a newline
+ <Up> Moves the cursor up
+ <Down> Moves the cursor down
+
+ *g:slimv_repl_syntax*
+Enables syntax highlighting for the REPL buffer. It is enabled by default but
+one may want to switch it off for these reasons:
+ 1. The REPL buffer contains s-expressions and their output mixed. The REPL
+ output is generally not related to s-expressions, therefore may confuse
+ syntax coloring.
+ 2. REPL output may contain very long lines, which significantly slows down
+ syntax coloring in Vim. If you don't want to switch REPL syntax coloring
+ completely off then it is recommended to adjust the |synmaxcol| parameter
+ to a relatively low value to increase syntax coloring speed.
+
+ *g:slimv_repl_wrap*
+Set wrap mode for the REPL buffer, which means the lines longer than the
+window width will not be hidden to the right. Instead they will be continued
+in the next display line.
+This is the default behaviour as it is how regular REPL windows work. This
+mode also enables keybindings for cursor movements, so that an <Up> keypress
+will move the cursor one line on the display and not one line in the document.
+
+ *g:slimv_sldb_wrap*
+Set wrap mode for the SLDB buffer, which means the lines longer than the
+window width will not be hidden to the right. Instead they will be continued
+in the next display line. Disabled by default.
+
+ *g:slimv_echolines*
+If a long form is evaluated then echo only this number of lines from the
+beginning of the form. This option prevents filling the REPL buffer with
+mostly unnecessary information. Closing parens are added to the end even if
+the end of the form is not echoed, so paren balance is kept.
+If this option is set to zero then no line is echoed at all, if set to -1
+then all lines are always echoed.
+
+ *g:slimv_indent_keylists*
+If nonzero then Slimv indents keyword lists like that:
+
+(:foo :bar
+ :baz :boo)
+
+instead of the function-style indentation:
+
+(:foo :bar
+ :baz :boo)
+
+This option is switched on by default. There are however some special forms
+(defpackage, defsystem) that are always indented in the function-style, e.g.:
+
+(defpackage :my-package
+ (:use :cl
+ :my-utils))
+
+ *g:slimv_indent_maxlines*
+Maximum number of lines searched backwards for indenting special forms, like
+flet, labels, macrolet. Setting it to a high value may slow down indenting.
+
+ *g:slimv_balloon*
+Specifies if describe tooltips are on (see |swank-describe|).
+
+ *g:slimv_simple_compl*
+If set to 1, swank:simple-completion is used. By default the fuzzy completion
+is active, so that "mvb<TAB>" expands to "multiple-value-bind"
+(see |swank-completions|).
+
+ *g:slimv_clhs_root*
+ *g:slimv_cljapi_root*
+ *g:slimv_javadoc_root*
+Base URL for the Common Lisp Hyperspec, Clojure API, and JavaDoc.
+If the Hyperspec/API is downloaded to the hard disk, then set these variables
+to the base path of the local copy, something like (where file:// specifies
+the file protocol):
+"file:///c:/doc/HyperSpec/" (Windows).
+or
+"file:///usr/local/doc/HyperSpec/" (Linux).
+It is possible to extend the Hyperspec symbol database with user defined
+symbols, see |g:slimv_clhs_user_db| and |g:slimv_cljapi_user_db|.
+
+ *g:slimv_clhs_user_db*
+ *g:slimv_cljapi_user_db*
+ *g:slimv_clhs_user_root*
+ *g:slimv_cljapi_user_root*
+If you want to extend Slimv's built-in Hyperspec/API symbol database, define
+the list of additional symbols in these variables. The format of this list is
+the following: [["symbol1", "url1"], ["symbol2", "url2"], ...].
+If the URL contains a ":" character then it is considered to be a fully
+qualified URL, otherwise it is a relative address to the Hyperspec root
+defined in |g:slimv_clhs_root| or |g:slimv_cljapi_root|.
+It is also possible to define a separate base URL for the user extensions via
+|g:slimv_clhs_user_root| or |g:slimv_cljapi_user_root|.
+
+Example:
+ let g:slimv_clhs_user_root = "http://myhyperspec.com/"
+ let g:slimv_clhs_user_db = [
+ \["my-cool-function", "mycoolfunc.htm"],
+ \["my-super-function", "mysuperfunc.htm"],
+ \["my-awesome-function", "myawesomefunc.htm"]]
+
+Remember to insert a backslash at the beginning of each additional line of a
+multi-line Vim command.
+
+ *g:slimv_template_apropos*
+Lisp form built when issuing the 'apropos' command.
+Example:
+ let g:slimv_template_apropos = '(apropos "%1")'
+
+ *g:slimv_python_version*
+Selects the python version to use.
+When exists and set to 3, the :python3 and :py3file commands are used, when
+exists and not set to 3, the :python and :pyfile commands are used, and when
+it is not defined, has('python') has('python3') determine which are used.
+
+-------------------------------------------------------------------------------
+ *slimv-keyboard*
+
+The default keybindings (|g:slimv_keybindings|=1) and another easy to remember
+built-in keybinding set (|g:slimv_keybindings|=2) for Slimv are the following.
+Please note that the leading ',' key below refers to <Leader>, which is set
+by Slimv to ',' by default (see |g:slimv_leader|).
+In the graphical menu the currently active keyboard shortcuts are displayed
+beside the menu item names, so one can refer to the GUI menu as a quick
+reference for the keymappings.
+Vim defines timeout values for mapped key sequences. If you find that Vim does
+not allow you enough time between pressing ',' and the last key(s) of the
+sequence, then you may want to fine tune these Vim options:
+|timeout|, |ttimeout|, |timeoutlen|, |ttimeoutlen|.
+
+ Set#1 Set#2 Command
+ ---------------------------------------------------
+ ,, ,, Slimv Menu
+
+ Edit commands (Insert mode):
+ <C-X>0 Close Form
+ <Tab> Complete Symbol
+ <Space> Function Arglist
+ <C-]> Find Definitions (Tag Lookup)
+
+ Edit commands (Normal mode):
+ ,) ,tc Close Form
+ ,( ,(t Paredit Toggle
+ ,j ,fd Find Definitions
+
+ Evaluation commands:
+["x],d ["x],ed Eval Defun (current top level form) [put in register x]
+["x],e ["x],ee Eval Current Expression (current subform) [put in reg. x]
+["x],r ["x],er Eval Region (visual selection) [or text from register x]
+ ,b ,eb Eval Buffer
+ ,v ,ei Interactive Eval (evaluates in frame when in SLDB)
+ ,u ,eu Undefine Function
+
+ Debug commands:
+ ,1 ,m1 Macroexpand-1
+ ,m ,ma Macroexpand All
+ ,t ,dt Toggle Trace
+ ,T ,du Untrace All
+ ,B ,db Set Breakpoint
+ ,l ,dd Disassemble
+ ,i ,di Inspect (inspects in frame when in SLDB)
+ ,a ,da Abort
+ ,q ,dq Quit to Toplevel
+ ,n ,dc Continue
+ ,H ,dl List Threads
+ ,K ,dk Kill Thread
+ ,G ,dg Debug Thread
+
+ Compile commands:
+ ,D ,cd Compile Defun
+ ,L ,cl Compile and Load File
+ ,F ,cf Compile File
+["x],R ["x],cr Compile Region [or text from register x]
+
+ Cross Reference commands
+ ,xc ,xc Who Calls
+ ,xr ,xr Who References
+ ,xs ,xs Who Sets
+ ,xb ,xb Who Binds
+ ,xm ,xm Who Macroexpands
+ ,xp ,xp Who Specializes
+ ,xl ,xl List Callers
+ ,xe ,xe List Callees
+
+ Profile commands:
+ ,p ,pp Toggle Profile
+ ,B ,pb Profile by Substring
+ ,U ,pa Unprofile All
+ ,? ,ps Show Profiled
+ ,o ,pr Profile Report
+ ,x ,px Profile Reset
+
+ Documentation commands:
+ ,s ,ds Describe Symbol
+ ,A ,da Apropos
+ ,h ,dh Hyperspec
+ ,] ,dt Generate Tags
+
+ Repl commands:
+ ,c ,rc Connect to Server
+ ,y ,ri Interrupt Lisp Process
+ ,- ,- Clear REPL
+ ,Q ,rq Quit REPL
+
+
+ Set#1 Set#2 Command
+ ---------------------------------------------------
+ ,\ ,\ REPL Menu (separate menu, valid only for the REPL buffer)
+
+ REPL menu commands:
+ ,. ,rs Send Input
+ ,/ ,ro Close and Send Input
+ ,g ,rp Set Package
+ <C-C> <C-C> Interrupt Lisp Process
+ ,<Up> ,rp Previous Input
+ ,<Down> ,rn Next Input
+ ,- ,- Clear REPL
+
+Note:
+Some mappings accept an optional "x prefix (where x is a register name)
+similarly to Vim's p (put) and y (yank) commands. These commands may
+additionally use the given Vim register to store or retrieve text.
+
+Commands "Eval Defun" and "Eval Current Expression" also store the form being
+evaluated in the given register. When using uppercase register name, the
+current form is appended to the contents of the register.
+
+Commands "Eval Region" and "Compile Region" use the contents of the given
+register (instead of the selected region) for evaluation or compilation.
+
+This feature may be used for remembering and recalling a test form used for
+testing parts of the code.
+
+Sample workflow:
+ 1. place the cursor on the test form
+ 2. "a,d stores the test form in register 'a' and evaluates it
+ 3. test fails, bug is in other parts of code, try to fix it
+ 4. send fixed code to the swank server the usual way
+ 5. "a,r recalls the test form from register 'a' and evaluates it
+ 7. repeat steps 3.-5.
+
+It is possible to create a custom mapping that appends a test form after the
+selected s-expression so that they are evaluated together in one step.
+This can be useful for quick testing. In order to evaluate the current form
+together with a test form use function SlimvEvalTestExp(), to evaluate and test
+the current toplevel form use function SlimvEvalTestDefun().
+Create a custom mapping by passing your test form to any of these functions.
+
+Example:
+
+noremap ,f :<C-U>call SlimvEvalTestDefun("(my-test-form)")<CR>
+
+With the above custom mapping pressing ,f makes the current toplevel form
+evaluated followed by (my-test-form).
+
+Instead of appending a test form, it is also possible to wrap the current form
+in a test form. Use the special symbol %1 to define the location where the
+test form shall contain the s-expression to be tested.
+
+Example:
+
+noremap ,wp :<C-U>call SlimvEvalTestExp("(ps:ps %1)")<CR>
+
+The above definition creates a custom mapping to see parenscript output of
+the selected form. Pressing ,wp wraps the current s-expression in a
+(ps:ps ...) test form and sends it to the swank server for evaluation.
+
+
+Also see |slimv-repl| for additional keybindings valid only in the REPL buffer.
+Some menu items or Slimv commands may differ in case Slimv uses the SWANK
+client, please find details in |swank.txt|.
+
+
+===============================================================================
+SWANK FEATURES *slimv-swank*
+
+The following major SLIME (SWANK) features are implemented in Slimv.
+For a complete reference of SWANK functions implemented see |swank-functions|.
+
+|swank-eval| Evaluation
+|swank-interrupt| Interrupt Lisp process
+|swank-restarts| SLDB: Invoke restarts
+|swank-backtrace| SLDB: Display backtrace with locals
+|swank-arglist| Function argument list in status line
+|swank-describe| Describe symbol in tooltip
+|swank-completions| List of possible symbol completions
+|swank-inspect| Inspector
+|swank-threads| Threads
+|swank-trace| Trace function
+|swank-profile| Profiler
+|swank-xref| Cross Reference
+|swank-quickfix| Compiler errors in quickfix list
+|swank-functions| SWANK functions implemented
+
+-------------------------------------------------------------------------------
+EVALUATION *swank-eval*
+
+There are various methods for evaluating an s-expression in the SWANK server.
+It is possible to eval the current top level form, the current subform, the
+visually selected area, or the whole buffer. Consult the "Evaluation commands"
+section in |slimv-keyboard| for the possible functions with their respective
+keyboard shortcuts.
+
+
+If debugger is activated and the cursor is placed on a frame line in the
+Backtrace section, then the Interactive-Eval command evaluates expressions
+in the scope of the given frame ("eval-in-frame").
+
+
+-------------------------------------------------------------------------------
+INTERRUPT LISP PROCESS *swank-interrupt*
+
+It is possible to interrupt a running Lisp or Clojure process by selecting
+the Interrupt-Lisp-Process menu item in the REPL or Slimv/Repl submenu,
+or by pressing the keyboard shortcut <Leader>i.
+It is also possible to map the Ctrl-C shortcut in normal mode to perform the
+interrupt, but this may interfere with the "Copy to clipboard" function
+especially on Windows. Here is how to do it:
+
+ noremap <silent> <C-C> :call SlimvInterrupt()<CR>
+
+When a Lisp process is interrupted, we are dropped in SLDB (SLime DeBugger)
+and the list of restarts (see |swank-restarts|) and calling frame stack
+(see |swank-backtrace|) is displayed.
+It is possible to inspect variables (see |swank-inspect|) and continue
+or break program execution by selecting the appropriate restart.
+It is also possible to change the value of variables or redefine functions
+before resuming execution.
+
+
+-------------------------------------------------------------------------------
+INVOKE RESTARTS *swank-restarts*
+
+In case of an error or when the Lisp process is interrupted Slimv presents
+the Swank debugger (SLDB) buffer. SLDB displays the condition and the list of
+possible restarts, each line startin with the restart identifier, for example:
+
+DIVISION-BY-ZERO detected
+ [Condition of type DIVISION-BY-ZERO]
+
+Restarts:
+ 0: [RETRY] Retry SLIME REPL evaluation request.
+ 1: [*ABORT] Return to SLIME's top level.
+ 2: [ABORT-BREAK] Reset this thread
+ 3: [ABORT] Kill this thread
+
+
+If you press Enter in normal mode on a restart line then the given restart
+is invoked.
+The most frequently used restarts have the following shortcuts defined:
+
+ ,a Abort
+ ,q Quit To Toplevel
+ ,n Continue
+
+
+-------------------------------------------------------------------------------
+DISPLAY BACKTRACE *swank-backtrace*
+
+The Swank debugger (SLDB) is presented in a separate dedicated buffer.
+Below the Restarts section SLDB displays the backtrace for the calling frames,
+each line starting with the frame identifier, for example:
+
+Backtrace:
+ 0: (CCL::%FIXNUM-TRUNCATE #<Unknown Arguments>)
+ 1: (/ 1 0)
+ 2: (NIL #<Unknown Arguments>)
+ 3: (CCL::CALL-CHECK-REGS / 1 0)
+ 4: (CCL::CHEAP-EVAL (/ 1 0))
+ 5: (SWANK::EVAL-REGION "(/ 1 0)")
+
+
+If you press Enter in normal mode on a frame line then frame information
+with the local variable bindings and source location information for that frame
+are displayed in a fold. Pressing Enter again toggles the fold close/open.
+
+If you press Enter on a filename with source location information then Slimv
+opens the given file in a buffer at the specified location.
+
+Some commands have modified behaviour when used on a frame:
+
+ Interactive-Eval Evaluates expressions in the scope of the frame.
+
+ Inspect Inspects objects within the scope of the frame.
+
+
+-------------------------------------------------------------------------------
+FUNCTION ARGUMENT LIST *swank-arglist*
+
+When entering an s-expression in insert mode, each time a space is pressed
+after a non-whitespace character, then SWANK is requested for the function
+argument list for the current function. If the function is known by SWANK
+then the function prototype is displayed in the status line. The arglist is
+condensed in order to fit the status line, so for functions with many
+arguments the whole definition may not be visible. In this case use the
+Describe function for displaying the full function definition.
+
+Note: the function argument list is not displayed when Slimv is not
+connected to the SWANK server.
+
+
+-------------------------------------------------------------------------------
+DESCRIBE SYMBOL *swank-describe*
+
+When you hover your mouse over a function's name then the function description
+is requested from SWANK and displayed in a tooltip, called balloonexpr in
+Vim terms. This functionality requires that Vim is compiled with the
++balloon_eval feature enabled.
+
+If you don't have +balloon_eval or want to get the description for a general
+symbol then it is possible to select the Describe-Symbol menu item from the
+Slimv/Documentation submenu, or press the <Leader>s keyboard shortcut,
+which then displays the symbol description in the Vim message area.
+
+Note: the symbol description is not displayed when Slimv is not connected
+to the SWANK server.
+
+
+-------------------------------------------------------------------------------
+COMPLETIONS *swank-completions*
+
+The Vim omni-completion function requests the possible completions for the
+symbol currently being entered from the SWANK server. The completion list
+is displayed in a popup menu.
+The keyboard shortcut for completion is <Tab>. This brings up the completions
+popup menu if there are multiple choices. In the popup menu subsequent <Tab>
+keypresses select the next possible completion.
+
+Option |g:slimv_simple_compl| determines whether simple or fuzzy completion
+is used. Default is fuzzy completion.
+
+Note: completions are not displayed when Slimv is not connected to the
+SWANK server. In this case the Hyperspec database is used for symbol lookup.
+
+
+-------------------------------------------------------------------------------
+INSPECTOR *swank-inspect*
+
+The Swank Inspector is presented in a separate buffer. In the Inspect buffer
+the Enter key is remapped in normal mode for traversing the inspector output.
+
+When pressing Enter on the top line starting with 'Inspecting' then the
+currently inspected value is reloaded.
+
+When pressing Enter on a line starting with <nn> (where nn is the action
+identifier) then nn-th action is called.
+
+When pressing Enter on a line starting with [nn] (where nn is the part
+identifier) then nn-th part is inspected.
+
+When pressing Enter on the last line starting with [<<] or pressing <Backspace>
+then the inspector is popped up one level, or if this was the topmost level
+then Slimv exits the Inspector.
+Pressing <Leader>q also exits the Inspector.
+
+If the object is too big to be fully displayed, this is signaled by the
+[--more--] and [--all---] texts. When pressing Enter on the line containing
+[--more--] then the next part of the inspected object is queried from the
+swank server and displayed in the Inspect buffer.
+When pressing Enter on the [--all---] line then all parts of the inspected
+object are fetched recursively up to the timeout defined by |g:slimv_timeout|.
+Pressing <Esc> stops the recursive fetching process.
+
+
+If debugger is activated and the cursor is placed on a frame line in the
+Backtrace section, then the Inspect command inspects objects in the given
+frame. It means that it is possible to examine the value of local variables
+within the scope of the given frame ("inspect-in-frame").
+
+
+-------------------------------------------------------------------------------
+THREADS *swank-threads*
+
+The Swank Threads are presented in a separate buffer.
+
+When the cursor is placed on a thread-line and <Backspace> or <Leader>k is
+pressed or the Kill-Thread function is selected then the given thread is killed.
+If multiple thread-lines are selected then all marked threads are killed.
+
+When the cursor is placed on a thread-line and <Leader>d is pressed or the
+Debug-Thread function is selected then the given thread is interrupted and the
+debugger is invoked.
+
+Pressing <Leader>r refreshes the thread list.
+
+Pressing <Leader>q exits the Threads buffer.
+
+-------------------------------------------------------------------------------
+TRACE *swank-trace*
+
+It is possible to tell the SWANK server to trace or untrace functions.
+There are some subtle differences in the trace handling with or
+without SWANK.
+
+For the trace handling without SWANK please check options
+|g:slimv_template_trace| and |g:slimv_template_untrace|.
+
+When using the SWANK server the Trace command toggles tracing for the
+selected function. In this case there is no Untrace command, but there is
+an Untrace-All command, which completely switches off tracing.
+This complies with the SWANK tracing functionality.
+
+
+-------------------------------------------------------------------------------
+PROFILER *swank-profile*
+
+Slimv supports SLIME's profiler. It is possible to toggle profiling on a
+function, on a set of functions whose name contains a given substring, or
+unprofile all functions. You may query the profiler for the list of profiled
+functions. After the profiling session it is possible to display the profiler
+report. Upon selecting Reset all counters are cleared, so that a new
+profiling session may be started.
+
+
+-------------------------------------------------------------------------------
+CROSS REFERENCE *swank-xref*
+
+SLIME's cross reference functionality can be used to list the functions
+calling a specific function, the list of functions called from a specific
+function, and other variable, macro, etc. references.
+Please note that not all Lisp implementations support the xref functionality.
+
+
+-------------------------------------------------------------------------------
+QUICKFIX *swank-quickfix*
+
+The compiler error messages are fed into Vim's quickfix list, as well as
+printed in the REPL buffer. Enter the :cw command to open the quickfix window.
+Use :cn and :cp to jump to the next and previous error location, use :cr to
+rewind to the first error.
+Consult |quickfix| for details on using the quickfix functionality.
+
+
+-------------------------------------------------------------------------------
+SWANK FUNCTIONS *swank-functions*
+
+This section contains a reference for the Emacs/SLIME/SWANK functions
+currently implemented in the Slimv SWANK client.
+
+ :emacs-interrupt
+ :emacs-pong
+ :emacs-return
+ :emacs-return-string
+ :indentation-update
+ swank:compile-file-for-emacs
+ swank:compile-string-for-emacs
+ swank:connection-info
+ swank:create-repl
+ swank:debug-nth-thread
+ swank:describe-function
+ swank:disassemble-form
+ swank:eval-string-in-frame
+ swank:frame-locals-and-catch-tags
+ swank:frame-source-location
+ swank:fuzzy-completions
+ swank:init-inspector
+ swank:inspect-frame-var
+ swank:inspect-in-frame
+ swank:inspect-nth-part
+ swank:inspector-call-nth-action
+ swank:inspector-pop
+ swank:invoke-nth-restart-for-emacs
+ swank:kill-nth-thread
+ swank:list-threads
+ swank:listener-eval
+ swank:load-file
+ swank:operator-arglist
+ swank:profile-by-substring
+ swank:profile-report
+ swank:profile-reset
+ swank:profiled-functions
+ swank:quit-inspector
+ swank:quit-lisp
+ swank:set-package
+ swank:simple-completions
+ swank:sldb-abort
+ swank:sldb-continue
+ swank:swank-macroexpand-1
+ swank:swank-macroexpand-all
+ swank:swank-require
+ swank:swank-toggle-trace
+ swank:throw-to-toplevel
+ swank:toggle-profile-fdefinition
+ swank:undefine-function
+ swank:unprofile-all
+ swank:untrace-all
+ swank:xref
+ swank-backend:frame-call
+ swank-backend:restart-frame
+
+
+===============================================================================
+LISP REPL *slimv-repl*
+
+The Lisp REPL is displayed as a separate terminal window and also inside a
+Vim buffer. The Lisp REPL buffer is opened when the SWANK server is started.
+The REPL buffer is a more or less regular Vim buffer, all Vim keybindings and
+commands can be used here as well.
+
+There are however some subtle differences. The main idea is that the last line
+in the REPL buffer is a "command line", just like in any REPL. The command
+line usually begins with a prompt, something like "[1] > ". The user types the
+command after the prompt in Insert mode. When Enter (<CR>) is pressed, the
+contents of the command line (which can actually be multiple lines, when
+pasted) is sent to the Lisp REPL for evaluation. It is not allowed to
+backspace before the end of the command line prompt.
+Please remember that this evaluation style is working only in Insert mode,
+in Normal mode the function of <CR> is left unchanged.
+Other areas of the REPL buffer can be used to eval Lisp forms, just like
+from the .lisp source code. So it is possible to move the cursor inside a form
+that was previously eval-ed, make some changes, then eval it again.
+Please note, that after evaluation the REPL buffer is refreshed, so the
+changes made to the form are restored at that location, but the changed form
+will be evaluated at the end of the REPL buffer.
+
+Another difference is the command line history, which can be activated by
+pressing <Up> or <Down> in the command line (only in Insert mode).
+When pressing <Up> or <Down> at an empty command prompt then each forms
+previously entered may be recalled from the history. If however some text
+is typed in the command line before pressing <Up> or <Down> then only forms
+beginning with the given searchtext are recalled from the history.
+In other words: text between the prompt and the cursor position is searched
+in command history. Leading whitespaces are ignored both in the searchtext
+and in the matching forms.
+
+Outside of the command line the <Up> and <Down> keys move the cursor,
+as usual.
+
+The keys with modified meanings in the Lisp REPL buffer are listed below:
+
+Insert Mode:
+
+ <CR> Sends the command typed in the last line to the Lisp REPL
+ for evaluation.
+
+ <C-CR> Adds missing closing parentheses at the end of the command,
+ then sends the command to the Lisp REPL for evaluation.
+
+ <BS> In the last line it deletes characters to the left only
+ until the end of the Lisp prompt reached.
+
+ <Up> Brings up the previous command typed and sent to the Lisp
+ REPL when in the command line.
+
+ <Down> Brings up the next command typed and sent to the Lisp REPL
+ when in the command line.
+
+Please note that the behaviour of <CR>, <Up>, <Down> is affected by the value
+of option |g:slimv_repl_simple_eval|.
+
+The Lisp REPL can be closed by the 'Quit REPL' command (mapped to <Leader>Q
+by default). This also closes the lisp process running the SWANK server.
+
+
+===============================================================================
+CLOJURE SUPPORT *slimv-clojure*
+
+Vim has a built-in support for Lisp, however it has no Clojure support by
+default. As Clojure is a Lisp dialect, Slimv simply reuses Vim's Lisp syntax
+and indent plugins for Clojure. If this does not suit your needs, then it is
+possible to download and install a separate Clojure plugin parallel to Slimv.
+
+In order to launch the Clojure REPL the variable |g:slimv_lisp| must be
+properly set up.
+The simplest definition is something like this, which assumes that the
+directory for clojure.jar is in the PATH. Please note that the whole expression
+needs to be enclosed in double quotes, as it will be passed to the server in
+one single command line argument:
+
+ let g:slimv_lisp = '"java -cp clojure.jar;clojure-contrib.jar clojure.main"'
+
+Here follows an example, which starts c:\Clojure\clojure.jar on Windows.
+Remember to escape the backslashes:
+
+ let g:slimv_lisp =
+ \ '"java -cp c:\\Clojure\\clojure.jar;c:\\Clojure\\clojure-contrib.jar clojure.main"'
+
+
+===============================================================================
+SCHEME SUPPORT *slimv-scheme*
+
+Slimv has a limited support for Scheme: currently only MIT Scheme is supported
+via the SWANK client, using a modified version of swank-mit-scheme.scm in the
+slime/contrib directory.
+The Scheme SWANK server also requires the 'netcat' program to create sockets.
+Please read information about the implementation details in the file header of
+swank-mit-scheme.scm.
+There is no Hyperspec information for Scheme at the moment.
+
+
+===============================================================================
+PACKAGE AND NAMESPACE HANDLING *slimv-package*
+
+Slimv has a basic support for handling Lisp packages and Clojure namespaces.
+This means that at every form evaluation Slimv first searches the source file
+for any preceding '(in-package ...)' form for Lisp and '(in-ns ...)' form for
+Clojure. If found then each time the package/namespace definition is evaluated
+first. This way it is possible to randomly re-evaluate forms in a source (or
+multiple sources) that use multiple packages/namespaces, each time the correct
+package/namespace will be used.
+The package/namespace handling can be switched off via the |g:slimv_package|
+option.
+
+
+===============================================================================
+HYPERSPEC AND COMPLETION *slimv-hyperspec*
+
+Slimv contains Common Lisp Hyperspec, Clojure API and JavaDoc symbol databases.
+When you are looking for the definition of a symbol, just place the cursor on
+the symbol and select the 'Hyperspec' function. If the symbol is found in the
+symbol database then the corresponding web page is displayed in the default
+browser. It is also possible to select this function having just the beginning
+of the symbol name, then the first match is presented to the user, and he/she
+is asked to confirm or edit the symbol name before the hyperspec lookup.
+
+It is possible to use a local copy of the Hyperspec, for this you need to
+define its base URL. See |g:slimv_clhs_root|, |g:slimv_cljapi_root| and
+|g:slimv_javadoc_root| for details.
+
+It is also possible to add user defined symbols to the Hyperspec database,
+see |g:slimv_clhs_user_db| and |g:slimv_cljapi_user_db|.
+
+
+The SWANK client requests simple or fuzzy completion from the SWANK server,
+see |swank-completions| for details.
+
+If the SWANK server is not connected, then Slimv uses the Hyperspec symbol
+database for symbol name completion, via Vim's omni-completion feature
+(if it is enabled and 'omnifunc' is not defined already to something else).
+Start to enter the symbol in Insert mode, then at some point press the
+<C-X><C-O> (omni-complete) key combination or select the 'Complete Symbol'
+function. The first match in the symbol database is inserted at the cursor
+position and a list of matching symbols is displayed in a submenu.
+Use <C-N> to select the next match, <C-P> to select the previous match.
+
+See Vim help file |insert.txt| for details on the usage of the various
+completion functions built in Vim.
+
+
+===============================================================================
+EXTERNAL UTILITIES *slimv-external*
+
+This section is about utilities, settings, etc., not related strongly to Slimv,
+but may be used to aim Lisp development. These are mostly built-in Vim features
+or options, and sometimes external Vim plugins.
+Slimv does not want to copy these functionalities, if they exist and work well.
+
+
+1. Syntax highlighting
+
+The syntax highlighting is done via the default lisp.vim syntax plugin.
+For Clojure files one has the following options:
+a. use the Lisp filetype also for Clojure files (that approach is used by Slimv
+ for the REPL buffer if no other filetype is set)
+b. install a Clojure Vim syntax plugin, like VimClojure.
+c. newest Vim versions contain a specific Clojure syntax script.
+
+
+2. Indentation
+
+The indentation is also done via the default lisp.vim indent plugin, or an
+optionally installed Clojure indent plugin, just like for the syntax
+highlighting.
+When the SWANK client is connected to the server, then indentation information
+is fetched from the SWANK server. This allows special indentation methods,
+e.g. when the given macro has an &body argument then it is indented by 2 spaces
+(instead of indenting the second argument below the first one).
+
+There are some built-in Vim reindentation commands that may come very handy
+when editing Lisp files. One can define a custom key mapping for any of them,
+such mappings are not defined by Slimv.
+
+ = Reindent selection, after a text has been selected.
+
+ == Reindent current line.
+
+ vab= or [(v%= Select current list and reindent it.
+
+ 99[(v%= Select top level form and reindent it.
+
+ gg=G Reindent whole file.
+
+
+3. Parenthesis handling
+
+First of all there is paredit mode. If you don't like it, Vim still obtains
+many tools to aid working with parentheses. This is a very important topic
+for a Lisp programmer.
+
+ :inoremap ( ()<Esc>i Automatically insert closing parenthesis mark when
+ an opening one is inserted.
+
+ :inoremap [ []<Esc>i Same as above but for square brackets.
+
+ :set showmatch Briefly jump with the cursor to the matching
+ parenthesis or square bracket when a closing pair
+ is inserted.
+
+ % Go to the matching parenthesis or square bracket.
+
+ :source $VIMRUNTIME/macros/matchit.vim
+ Adds extended matching with "%" to Vim.
+
+ vab or [(v% Select current list.
+ vib Select current list without enclosing parentheses.
+ yab Yank current list.
+ dab Delete current list.
+
+ 99[(v% Select top level form.
+
+ g:lisp_rainbow Colorize differing levels of parenthesization with
+ different highlighting. Currently works only for
+ the 'lisp' filetype, hopefully it will be added
+ soon to the Clojure plugins as well.
+
+
+4. Completion
+
+ CTRL-N The built-in Vim keyword completion is a very handy
+ CTRL-P feature. You start typing a word, and when CTRL-P
+ or CTRL-N is pressed, then Vim looks up the keyword
+ starting with the same letters as typed in up or
+ down direction in the current buffer.
+ This is not the same as the omni-completion
+ feature (see |slimv-hyperspec|). Omni-completion is
+ based on a symbol database and not on the contents
+ of the current buffer.
+
+ :set complete The |'complete'| option controls how keyword
+ completion works.
+
+
+5. Tag lookup
+
+Also see Slimv option |g:slimv_ctags|.
+
+ |ctags| "Exuberant ctags" is a powerful utility for
+ generating tag database for different kind of
+ programming languages, including Lisp. Tag lookup
+ is then done via the CTRL-] (or :tag) command,
+ return to the previous positon with CTRL-T.
+
+ ctags --language-force=lisp *.lisp *.clj
+ This or a similar command may be used to generate
+ tags file from .lisp and .clj files in a directory.
+
+
+===============================================================================
+FAQ *slimv-faq*
+
+- Q: Why is this plugin called 'Slimv'?
+- A: Because it is trying to mimic the popular Emacs extension 'SLIME'.
+ In SLIME 'E' stands for 'Emacs', so here it is replaced with 'V' as Vim.
+ The plugin is actually a SWANK (TCP server for Emacs) client.
+ To tell the truth, first I gave the name 'Slimvim' to the plugin but
+ then I found an (already abandoned) project called 'Slim-Vim' and I did
+ not want to interfere with it.
+
+- Q: Why another 'Superior Lisp Mode' if there is already one (for Emacs)?
+- A: Because many programmers prefer Vim as a program text editor over Emacs,
+ including me. I don't want to start a holy war or whatsoever, I'm just
+ happy if someone else finds this plugin useful.
+
+- Q: But there are other similar projects for Vim. Why having yet another
+ SLIMxxx for Vim?
+- A: To my knowledge, none of the above mentioned Vim scripts/extensions
+ contain all the functionalities of SLIME (nor does Slimv, to tell the
+ truth). There is definitely room for improvement.
+ It would be nice to make Vim as usable as Emacs for Lisp programming.
+ In my opinion the main barrier is the lack of asynchronous buffer update
+ in Vim, but this may change in the future.
+
+- Q: How does Slimv work?
+- A: Slimv is a SWANK client that is able to communicate with a running
+ SWANK server, just as it is done by Emacs with SLIME.
+ The SWANK output is regularly polled via the socket connection and
+ interpreted in the REPL buffer opened in Vim.
+ The SWANK client is located in 'swank.py'.
+
+- Q: But there was a non-swank functionality built in Slimv, where is it now
+ and how can I use it?
+- A: It has been removed since version 0.9.0, because the development focuses
+ on providing a fully functional SWANK client, so the non-swank functionality
+ was not maintained. If you want the old behaviour then fetch plugin
+ version 0.8.6 and set g:slimv_swank to 0 in your vimrc file.
+
+- Q: There is no SWANK server opened when I evaluate a form in Vim.
+- A: There may be many reasons for that. Try to run the SWANK server manually,
+ Slimv detects if a SWANK server is running and is able to connect it.
+ - Check if the port number matches in Slimv and the SWANK server and
+ :dont-close is set to 't'.
+ - Verify the SWANK server command autodetected by Slimv:
+ :echo SlimvSwankCommand()
+ - Also check the following Slimv variables in Vim, maybe they are not
+ correctly autodetected and you need to override them in your .vimrc:
+ :echo g:slimv_lisp
+ :echo g:slimv_swank_cmd (or g:slimv_swank_clojure for Clojure)
+
+- Q: The Slimv plugin is not loaded for a .lisp (or .clj, etc) file.
+- A: Filetype plugins should be enabled, check it via the :filetype command.
+ If needed, put this in your .vimrc file:
+ filetype plugin on
+ filetype indent on
+ You can check the scripts loaded with the :scriptnames command,
+ filetype.vim and ftplugin.vim should be listed in order to load other
+ filetype plugins.
+ The source buffer filetype should be lisp (or clojure, etc), check it via
+ :set ft?
+ The Slimv files should be in Vim's runtime path, check the path via
+ :set rtp?
+ slimv.vim should be in the ftplugin directory in the runtimepath,
+ there should be an ftplugin/lisp subdirectory containing slimv-lisp.vim.
+ Also make sure that no other ftplugin/lisp.vim is loaded that prevents
+ loading of the Slimv scripts.
+
+- Q: I experience weird problems when using the plugin, e.g. incorrect key
+ mappings, strange error messages, indentation missing, etc.
+- A: You may have an installation problem, try to completely remove then
+ reinstall the plugin.
+ It may also cause problems when you have the Slimv repository checked
+ out directly into vimfiles. Checkout the project to somewhere else and
+ copy only the relevant Slimv files to vimfiles.
+ Most problems may be spot by enabling Vim's verbose mode and examining
+ the resulting logfile. Either run Vim this way: 'vim -V20test.log' or
+ enable verbose mode runtime just before the problem happens:
+ :set verbosefile=test.log
+ :set verbose=20
+ It is also possible to save a log of the communication between Slimv and
+ the swank server by setting g:swank_log=1 in the .vimrc.
+
+- Q: Why is SLIME functionality XYZ missing from Slimv?
+- A: Not all SLIME functions are implemented in the SWANK client, however
+ the list of these functions keep growing. Maybe future releases will
+ contain it. All feature requests are welcome.
+
+- Q: What is the version numbering concept?
+- A: <major version>.<minor version>.<bugfix release>, where:
+ major version: Let's talk about it when it reaches 1...
+ minor version: New functionalities added, that are worth mentioning.
+ bugfix release: Only bugfixes or tiny additions.
+
+- Q: Why is the plugin distributed in zip file?
+- A: I want that Windows/Linux/Mac users all can easily extract the plugin
+ files. For this reason the vimball or zip format seems to be a good
+ choice. There is no native .tar, .tar.gz, .tar.bz2 decompressors on
+ Windows (however there exist free tools for the job, like 7zip).
+ I'm relatively new to vimball and it looks like a good candidate, but
+ I have some problems with it:
+ 1. It is uncompressed, and if I want to compress it then I will end up
+ having it zipped.
+ 2. The .vba extension is also used for Visual Basic scripts on Windows
+ and this frequently contains virus, so Windows users may dislike it.
+ And remembering the very first time I met a vba file I was thinking
+ that someone had created a Visual Basic installer for the script.
+ 3. Many Vim users don't know vimball but most of them know zip files.
+
+- Q: Are you a Lisp expert?
+- A: No, not at all. I'm just learning Lisp. Also just learning Vim
+ scripting. And I'm not a Python expert either, however (at the moment)
+ I have more experience with Python than with Lisp.
+
+- Q: What about Clojure?
+- A: I have even less experience with Clojure than with Lisp.
+ But it looks like the Slimv functions can be easily ported for Clojure,
+ and as there are not many (yet) Vim scripts written for Clojure, I gave
+ it a try.
+
+- Q: Why using Python for the client/server code? Why not Lisp?
+- A: It is needed to use one of Vim's embedded languages for maintaining a
+ permanent socket connection from within Vim. There aren't too many choices,
+ and Lisp is not (yet?) embedded into Vim.
+
+===============================================================================
+CHANGE LOG *slimv-changelog*
+
+0.9.13 - Update REPL buffer in the background, no need to bring it into focus.
+ - The evaluation result is also displayed in the status line.
+ - REPL buffer number is remembered upon creation, no need to find it by name.
+
+0.9.12 - Added support for the R language via swank-R (by Philipp Marek).
+ - Test form for SlimvEvalTestExp() may wrap the selected s-expression.
+ - Added Shift+Tab mapping for cycling backwards in the completion
+ popup menu.
+ - User defined REPL buffer name may contain some special characters.
+ - Pass port number to the swank server in SWANK_PORT environent variable
+ on Linux (by Glen Gibb and Federico Churca-Torrusio).
+ - Autodetect wx86cl64.exe (Clozure CL) on 64 bit Windows.
+ - Added applescript support for starting swank through iTerm
+ (by Seth Price).
+ - Add Racket support for delimiter '[]' and '{}' (by Jimmy Lu).
+ - Bugfix: if the user started a normal mode command prefixed with a count,
+ then the count was cleared by the REPL refresh timer.
+ - Bugfix: CursorHold trigger ignore mappings to prevent collisions with
+ other plugins.
+ - Bugfix: preselect function name before starting swank server in the
+ Disassemble command.
+ - Bugfix: do not append '>' at the prompt if it already ends with it.
+ - Bugfix: package name not found when 'noignorecase' was set.
+ - Bugfix: Paredit ,< and ,> when 'whichwrap' contains 'h' and 'l'.
+ - Bugfix: keep multi-line SLDB abort messages commented all throughout
+ (by Federico Churca-Torrusio).
+ - Bugfix: prevent call to frame-call on AllegroCL (by Robert Kerr).
+ - Bugfix: tag lookup (Ctrl+]) added garbage to symbol name.
+ - Bugfix: parsing arrays (and other prefixed forms) returned from the
+ swank server.
+ - Bugfix: prevent accidental multiple registration of slimv autocommands.
+ - Bugfix: disable autocommands for the REPL update, make sure 'updatetime'
+ is not too low.
+
+0.9.11 - Entering some text in REPL command history, then pressing <Up>/<Down>
+ searches for matching lines only.
+ - Changed lisp syntax for #\( and #\) to "string".
+ - Handle three or more windows layout: assign an id to each slimv
+ window, reuse slimv windows.
+ - Support for built-in or third party clojure syntax file.
+ - Indent with tabs when 'noexpandtab' set after file is loaded.
+ - Added options g:paredit_disable_clojure, g:paredit_disable_lisp,
+ g:paredit_disable_scheme.
+ - Added repeat.vim support to many Paredit modification actions
+ (by Logan Campbell).
+ - Returning cursor to start position after Paredit " wrap
+ (by Logan Campbell).
+ - Paredit: do not insert newline if item is selected in completion
+ popup menu by pressing <CR>.
+ - Paredit: delete into the "*" register when option clipboard=unnamed.
+ - Paredit: handle #"" regexp syntax definition also when searching
+ for paren matches.
+ - Defined <Leader>- mapping (Clear-REPL) for all source buffers.
+ - Escape double quotes in text input into (read) in the REPL buffer.
+ - Bugfix: indentation after multi-line string.
+ - Bugfix: Paredit Wrap accomodates strings (thanks to Colin Jones).
+ - Bugfix: fixed error messages when compiling or describing before
+ connected to swank server.
+ - Bugfix: fixed some indentation issues with multi-line arguments
+ involved.
+ - Bugfix: fixing buffer confusion when filename contains 'repl'.
+ - Bugfix: don't move cursor for Paredit v) when selection mode is
+ inclusive (by John Szakmeister).
+ - Bugfix: syntax highlighting in clojure REPL for forms containing
+ ">" in the function name.
+
+0.9.10 - Replaced 'readonly' flag with 'nomodifiable' for SLDB, Inspect,
+ Threads buffers.
+ - Restore window and buffer if SLDB is activated during completion.
+ - Allow using Slimv and VimClojure (or other clojure filetype plugin)
+ together.
+ - Added Restart-Frame command (thanks to Philipp Marek).
+ - Added defn- to clojure keywords (thanks to David Soria Parra).
+ - Paredit initialization on filetype instead of filename extension.
+ - Do not permanently set 'iskeyword' in paredit.vim.
+ - Paredit: added '^' macro prefix.
+ - Paredit: treat #_(...) type of clojure comments as regular forms.
+ - Paredit: handle VimClojure's #"" regexp syntax definition.
+ - It is now possible to remove plugin/paredit.vim.
+ - Bugfix: fixed missing variable error message.
+ - Bugfix: REPL prompt position corruption problems.
+ - Bugfix: cursor positioning problems when displaying arglist.
+ - Bugfix: paredit 'cc', 'Vc' did not delete line.
+ - Bugfix: paredit 'd', 'c', 'vc', 'cW' cursor positioning problems.
+ - Bugfix: paredit 'C' extra whitespace and trailing ".
+ - Bugfix: reset indent after paredit 'cc'.
+ - Bugfix: paredit 'dd', ',>' EOL problem.
+ - Bugfix: paredit indentation when 'indentexpr' takes no argument
+ (thanks to Tim Pope).
+ - Bugfix: keep cursor inside "" when deleting over trailing " via
+ paredit 'cW', 'C', etc.
+ - Bugfix: use &ft instead of SlimvGetFiletype() in paredit.vim.
+
+0.9.9 - Added Paredit functions to Slimv menu (thanks to Conrad Schuler).
+ - Inspector: use the same package when pressing [--more--].
+ - Inspector: speeding up multi-part object processing.
+ - Inspector: save/restore cursor position for previously visited pages.
+ - <Leader>rc was doubly mapped, use <Leader>- for REPL Clear.
+ - Autodetect ritz-swank.
+ - Added Break-on-Exception function for ritz-swank.
+ - Added minibuffer operations, this enables [set value] in Inspector.
+ - Added smartjumping for Clojure (thanks to dgrnbrg on bitbucket.org).
+ - Disable indenting on "set noautoindent".
+ - Pass python output to Vim script in variable instead of redirecting
+ stdout (hopefully solves 64-bit MacVim problems).
+ - Handle [] and {} delimiters in Scheme like in Clojure.
+ - Paredit: ignore (, [, or { when preceded by \.
+ - Bugfix: arglist on <Space> after pressing 'I' in visual block mode.
+ - Bugfix: indentation after multi-line subform.
+ - Bugfix: problems with finding function name for arglist.
+ - Bugfix: corruption when pasting large text into console Vim.
+ - Bugfix: cursor positioning in REPL buffer when virtualedit=all.
+ - Bugfix: multi-line entry name parsing in Inspector.
+
+0.9.8 - Added autodetection for 'ccl'.
+ - Delete empty lines when re-gathering Electric Returns.
+ - Inspector: put multiple items in one line (like in Slime).
+ - Inspector: highlight selectable parts and actions, hide item id-s.
+ - Inspector: display "path" of inspected object.
+ - Don't extend s-expression with prefix when macroexpanding.
+ - Don't evaluate or compile the REPL buffer.
+ - Added device to the path when loading pretty printer patches for SBCL
+ (thanks to Andrew Lyon).
+ - Added option g:slimv_repl_simple_eval and Electric Return for REPL buffer.
+ - Print arglist when pressing Space after closing parens or double quotes,
+ also when pressing Enter.
+ - Added "Clear REPL" entry to the REPL menu (mapped to <Leader>-).
+ - Paredit: special handling of cw, cb, ciw, caw supporting repeat ('.').
+ - Do not describe empty symbol.
+ - Prefer selecting symbol to the left when cursor is on whitespace.
+ - Added "." character to iskeyword for Lisp.
+ - Removed "." when selecting symbol for completion for Clojure.
+ - Increased fuzzy completion limit.
+ - Bugfix: find package/namespace when current form is in a fold.
+ - Bugfix: PareditToggle ckecks if buffer was registered for Paredit.
+ - Bugfix: Electric Return re-gathering at end of line with no virtualedit.
+ - Bugfix: extra character at the end of selection using 'v('
+ - Bugfix: garbage upon pressing ')' or Enter in completion popup.
+ - Bugfix: Paredit 'x' at end of line when 'whichwrap' includes h,l.
+ - Bugfix: arglist sometimes not displayed.
+ - Bugfix: Paredit Wrap when line ends in a multibyte character
+ (thanks to Sung Pae).
+
+0.9.7 - Keep cursor position on expanding [--more--] in the Inspector.
+ - Added [--all---] to Inspector for fetching all parts.
+ - Don't explicitly check for pythonXX.dll, rely on has('python').
+ - Require 'swank-repl' for slime version above 2011-12-04 in case
+ contribs are disabled.
+ - Identify VimClojure REPL prompt position for paredit (thanks to
+ David Greenberg).
+ - Paredit: added <leader><Up> for Splice-killing-backward,
+ <leader><Down> for Splice-killing-forward, <leader>I for Raise.
+ - Paredit: added 'Electric Return' feature and new option
+ g:paredit_electric_return.
+ - Increased the distance to search for the defun start to 200 lines.
+ - Bugfix: positioning the cursor at the end of REPL prompt in insert mode.
+ - Bugfix: handle restart/frame number above 999 (thanks to Philipp Marek).
+ - Bugfix: form selection when cursor is next to the opening paren.
+ - Bugfix: indentation of multi-line strings.
+ - Bugfix: indentation of lines with multi-byte characters.
+ - Bugfix: cursor movement while indenting.
+
+0.9.6 - Perform indenting when <Tab> pressed on whitespace.
+ - Added support for newer swank message length counting in bytes.
+ - Updated Lisp swank server to version 2012-03-06.
+ - Updated Clojure API reference to version 1.3.
+ - Identify .cljs files as Clojure type.
+ - Enable g:slimv_repl_syntax by default.
+ - Restart parenthesis highlighting at each REPL prompt.
+ - Scheme: eval buffer and region in a (begin ...) block.
+ - Added option g:scheme_builtin_swank for enabling MIT scheme's built-in
+ swank server.
+ - Added syntax highlight for Scheme quoted symbol.
+ - Keep SLDB buffer if swank stays in debugger upon selecting a restart.
+ - When reconnecting the swank server wait for disconnection first.
+ - Fixed REPL buffer slowdown caused by re-assigning autocommands.
+ - Fixed detection of string and comment when no syntax loaded.
+ - Fixed Scheme syntax highlight problems in the REPL buffer.
+ - Call :frame-source-location and :frame-call only if swank supports them.
+
+0.9.5 - Use correct SLDB level when invoking restart.
+ - Autodetect tmux session on Linux (thanks to Brett Kosinski).
+ - Enable syntax only once to avoid reload of syntax plugins.
+ - Added option g:slimv_browser_cmd_suffix.
+ - Skip syntax and indent file for disabled filetypes.
+ - Check the presence of X on Linux.
+ - Indentation fixes: keywords, gap after '(', defsystem, defmacro,
+ symbol-macrolet.
+ - Use winsaveview()/winrestview() for remembering current view when
+ moving around (e.g. searching for package).
+ - Find package for arglist and completion.
+ - Ignore mapleader when it's <Space>.
+ - Print SLDB error description also into the REPL buffer.
+ - Evaluate keyword if using Eval-Defun outside of s-expression.
+ - Disable unsupported swank features for Scheme.
+ - Bugfix: Paredit 'cw' at the end of line.
+ - Bugfix: omit REPL prompt from Eval-Defun and Eval-Expression.
+ - Bugfix: printing of '\n' and other escaped characters.
+ - Bugfix: Paredit delete and put corrupted the "0 register.
+
+0.9.4 - Added highlighting of [] and {} for Clojure.
+ - Added options to disable Slimv for specific filetypes:
+ g:slimv_disable_clojure, g:slimv_disable_lisp, g:slimv_disable_scheme.
+ - Added option g:slimv_indent_keylists (thanks to Andrew Smirnoff).
+ - Added "set hidden" for safe switching of modified buffers.
+ - Added Help to Inspect and Threads buffers.
+ - Evaluate register contents if Eval-Region prefixed by ["x].
+ - Store form in register if Eval-Defun or Eval-Exp prefixed by ["x].
+ - Increased timeout for :create-repl.
+ - Stay in REPL buffer if Macroexpand performed in REPL.
+ - Search for either (in-ns) or (ns) for Clojure, remove quote character
+ from namespace name.
+ - Added SlimvEvalTestDefun() and SlimvEvalTestExp() for immediate testing
+ of the form(s) being evaluated.
+ - Bugfix: various indentation issues (function name is a subform,
+ let, let*, do, defpackage, defsystem, and [] for Clojure).
+ - Bugfix: Eval-Range problem in visual mode.
+ - Bugfix: SLDB parsing problem with newlines in description of restarts.
+ - Bugfix: REPL autoscroll incidentally stopping (thanks to Andrew Lyon).
+ - Bugfix: added some index out of range checks (thanks to Philipp Marek).
+
+0.9.3 - Start Swank server in virtual terminal when running in GNU screen
+ on Linux (thanks to Oleg Terenchuk).
+ - Reuse a window for slimv also when there are three or more windows open.
+ - Don't go to end of REPL buffer if user moved the cursor away from EOF.
+ - Use xdg-open for default browser in Linux.
+ - Removed option g:slimv_python.
+ - Added option g:slimv_repl_max_len for limiting the number of lines in
+ the REPL buffer.
+ - Added option g:slimv_preferred to choose preferred lisp implementation.
+ - Query additional parts of big inspected object upon pressing Enter on
+ [--more--].
+ - Thread List is displayed and handled in a separate Threads buffer.
+ - Bugfix: window navigation problems between source/REPL/SLDB/etc.
+ - Bugfix: error messages when Swank server window is closed.
+ - Bugfix: return control to vim after starting browser defined by
+ g:slimv_browser_cmd.
+ - Bugfix: fixed indentation of arguments before &body argument.
+ - Bugfix: autocomplete for dotted package/namespace names.
+ - Bugfix: indentation of aif.
+
+0.9.2 - Added option g:swank_log to enable swank debug log.
+ - Added options g:slimv_repl_name, g:slimv_sldb_name, g:slimv_inspect_name.
+ - Added option g:slimv_indent_maxlines.
+ - Changed Debug-Thread mapping to <leader>dT (g:slimv_keybindings=2)
+ due to conflict with Generate-Tags.
+ - Label thread ID in thread list (by Philipp Marek).
+ - Set balloonexpr for all buffers (thanks to Philipp Marek).
+ - Connect swank server when needed instead of printing an error message
+ (by Philipp Marek).
+ - Set expandtab for lisp and clojure files.
+ - Kill-Thread kills all threads in the selected range (by Philipp Marek).
+ - Bugfix: added missing parts of Set-Breakpoint introduced in 0.9.1.
+ - Bugfix: test source lookup (upon pressing Enter) before testing
+ fold toggle in SLDB (by Philipp Marek).
+ - Bugfix: indentation of flet, labels, macrolet.
+ - Bugfix: Kill-Thread now really kills thread (by Philipp Marek).
+ - Bugfix: inspect gensyms in frame (by Philipp Marek).
+
+0.9.1 - Improved frame number identification in SLDB buffer.
+ - Moved frame source location above frame locals in SLDB.
+ - Fold frame source location if more than 2 lines.
+ - Inspect-In-Frame: preselect symbol under cursor only in variable lines.
+ - Inspect-In-Frame: open Inspector in the other window.
+ - Improved XRef file location parsing.
+ - Use current paragraph when no range set for Eval-Region and
+ Compile-Region.
+ - Added option g:slimv_sldb_wrap, do not set wrap for source buffers.
+ - Added Set-Breakpoint command mapped to <leader>B (thanks to
+ Philipp Marek), changed Profile-By-Substring mapping to <leader>P.
+ - Set Lisp keyword characters also in SLDB buffer.
+ - Bugfix: error messages at Connect-Server.
+ - Bugfix: error message for frame source location without filename.
+ - Bugfix: XRef output sometimes cut.
+
+0.9.0 - Separate buffers for SLDB and Inspector.
+ - Toggle frame information in SLDB buffer by pressing Enter.
+ - Look up source when pressing Enter on filename with location in SLDB.
+ - Added option g:swank_block_size to override Swank output buffer size
+ (thanks to stassats on #lisp and Philipp Marek).
+ - Removed old non-swank functionality.
+ - Removed option g:slimv_repl_open.
+ - Paredit: new mappings [[ and ]] for previous and next defun.
+ - Bugfix: various refresh problems (thanks to Philipp Marek).
+ - Bugfix: disable debug mode when reconnecting Swank (by Philipp Marek).
+ - Bugfix: display multi-line debug condition and frame source location,
+ quote characters in compile (by Philipp Marek).
+ - Bugfix: use proper SLDB level when invoking restart (by Philipp Marek).
+ - Bugfix: restore all lisp keyword characters in iskeyword.
+ - Bugfix: indentation of defgeneric.
+ - Bugfix: use proper filename and location when compiling defun or region.
+ - Bugfix: buffer corruption when re-triggering timer in insert mode.
+ - Bugfix: <End> moved cursor to the right edge of screen in REPL buffer
+ when virtualmode=all.
+
+0.8.6 - Handle cl:in-package, common-lisp:in-package (thanks to Philipp Marek).
+ - Added option g:swank_host to allow connecting to remote Swank server.
+ - Autodetection of Cake for Clojure (thanks to Chris Cahoon).
+ - Set Paredit mode also for .cl and .rkt files.
+ - Recognise domain reversed package names in form com.gigamonkeys.pathnames
+ (thanks to has2k1).
+ - Added curly braces rainbow parenthesis for Clojure.
+ - Added paredit handling of curly braces for Clojure.
+ - Use SlimvIndent also for Clojure.
+ - Handle line number returned in :compilation-result.
+ - Bugfix: removed double newline in :read-string (text input).
+ - Bugfix: when editing with cw in paredit mode, keep ending whitespaces
+ (thanks to Mats Rauhala).
+ - Bugfix: compilation error when Swank does not return file name.
+ - Bugfix: skip dot character when Swank returns a dotted pair (a . b).
+
+0.8.5 - Switch on indent plugins.
+ - Do not complete empty string on <Tab>.
+ - Added Clojure keywords to syntax plugin.
+ - Use -i option to load swank-clojure.
+ - Implementation specific REPL initialization, for Clojure it imports
+ source, apropos, javadoc, etc. (thanks to Ömer Sinan Agacan).
+ - Print Lisp version at REPL startup.
+ - Added List-Threads, Kill-Thread, Debug-Thread (thanks to Philipp Marek).
+ - Write prompt after Toggle-Trace.
+ - Display list of untraced functions for Untrace-All.
+ - When in SLDB, Interactive-Eval evaluates expressions in the frame,
+ Inspect inspects objects in the frame.
+ - Changed g:slimv_echolines logic: set 0 for no lines, -1 for all lines.
+ - Bugfix: removed extra linebreak between chunks of long output.
+ - Bugfix: indentation problems for symbols with package specification
+ (thanks to Philipp Marek).
+ - Bugfix: indentation of Clojure's defn.
+ - Bugfix: plist indentation (thanks to Philipp Marek).
+ - Bugfix: occasional few seconds delay in swank response.
+ - Bugfix: running Swank server on Mac OS X (on behalf of Tobias Pflug).
+
+0.8.4 - Added handling for Unicode characters.
+ - Truncate arglist output to fit in the status line.
+ - Added debugger keybindings: ,a for abort ,q for quit ,n for continue.
+ - Changed keybinding for apropos to ,A
+ - Added compiler error messages to quickfix list.
+ - Map insert mode <Space> and <Tab> only for lisp (and dialects) buffers.
+ - Bugfix: wait for the response to :create-repl before calling
+ :swank-require (thanks to Philipp Marek).
+ - Bugfix: indentation problems with unbalanced parens in comment.
+ - Bugfix: arglist ate the <Space> when virtualedit was off.
+
+0.8.3 - Added top/bottom/left/right directions to g:slimv_repl_split.
+ - Added :Lisp (and an equivalent :Eval) command with completion.
+ - Added g:slimv_leader and g:paredit_leader options.
+ - Added g:slimv_echolines to echo only the first few lines of the
+ form being evaluated.
+ - Added fuzzy completion and option g:slimv_simple_compl (by Philipp Marek).
+ - Indent macros with &body argument by two spaces when connected to swank
+ (thanks to Philipp Marek and Andreas Fredriksson).
+ - Special indentation for flet, labels, macrolet.
+ - Default for Set-Package is current package (thanks to Philipp Marek).
+ - Bugfix: REPL output ordering problems.
+ - Bugfix: problem with inserting Space into visual block.
+ - Bugfix: blinking when g:slimv_repl_syntax is on.
+ - Bugfix: entering incomplete form in REPL command line.
+ - Bugfix: close form when inside comment, string, or with mixed ([.
+
+0.8.2 - Added Paredit and g:lisp_rainbow support for Scheme files.
+ - Added SWANK support for MIT Scheme on Linux.
+ - Added frame call information to SLDB (thanks to Philipp Marek).
+ - Check for unbalanced form before evaluation.
+ - Reconnect SWANK server in Connect-Server if already connected
+ (thanks to Philipp Marek).
+ - Select current form instead of top level form in Macroexpand.
+ - Bugfix: Paredit handling of escaped matched characters, like \" or \(.
+ - Bugfix: cursor positioning problems when debugger activated.
+ - Bugfix: print prompt after Describe.
+
+0.8.1 - Added action handling to Inspector, fixed Inspector output.
+ - Bugfix: read-string mode was stuck.
+ - Bugfix: buffer corruption with two source windows
+ (thanks to Philipp Marek).
+ - Bugfix: eliminate multiple CursorHold autocommands
+ (thanks to Philipp Marek).
+ - Bugfix: completion with special characters in symbol name
+ (thanks to Philipp Marek).
+ - Bugfix: sometimes cursor went to the start of line in insert mode.
+ - Bugfix: syntax error in Untrace All (thanks to Philipp Marek).
+ - Bugfix: removed ' prefix from symbol selection (except for Inspect).
+ - Bugfix: keep cursor position in Describe and Compile-Region.
+
+0.8.0 - Major update: added SWANK client (many thanks to Philipp Marek).
+ - Split documentation into three parts.
+ - Added keymapping hints to GUI menu items.
+ - Renamed Eval-Last-Expression to Eval-Current-Expression.
+ - REPL buffer is not syntax highlighted anymore.
+ - Switch on filetype plugins.
+ - Autodetection for Allegro CL, Lisp Cabinet and Leiningen.
+ - Ask for save before compiling file.
+ - Map <Tab> for symbol name completion.
+ - Bugfix: finding start of keyword in completion.
+ - Bugfix: deleting escaped " inside string.
+ - Bugfix: Up/Down/Enter handling in popup menu.
+
+0.7.7 - Paredit: find next closing paren when using ,< or ,> and not standing
+ on a paren.
+ - Open REPL buffer upon connecting server.
+ - Bugfix: REPL buffer prompt identification was sometimes missing.
+ - Bugfix: switch off REPL refresh mode when REPL buffer is not visible
+ (thanks to Philipp Marek).
+ - Bugfix: convert Python path on Windows to short 8.3 filename format
+ if it contains space (thanks to Razvan Rotaru).
+
+0.7.6 - Cursor potision is kept during evaluation.
+ - Most Slimv commands made silent.
+ - Bugfix: find defun start when cursor is on a comment.
+ - Bugfix: keep newlines in Compile-Region.
+ - Bugfix: infinite loop when selecting form in empty buffer.
+ - Bugfix: error when opening REPL buffer with g:slimv_repl_split=0.
+ - Bugfix: REPL blinking in insert mode when visualbell is on.
+ - Bugfix: added the comma to the list of macro prefix characters
+ (thanks to John Obbele).
+ - Bugfix: long/short Windows filename problem for REPL buffer.
+
+0.7.5 - Added Cygwin compatibility using the Windows Python
+ (thanks to Jerome Baum).
+ - Display client error message when eval was not successful.
+ - Form is passed to client via stdin instead of temp file.
+ - Bugfix: automatic reconnection when server closed and reopened.
+ - Bugfix: delete and yank also via named registers in paredit.vim.
+ - Bugfix: handle double quotes in Compile-Defun and Compile-Region.
+
+0.7.4 - Added autodetection for simple 'clojure' command on Linux.
+ - Removed duplicates from history of commands entered in REPL buffer
+ (those recallable with <Up> and <Down>).
+ - Bugfix: infinite loop during eval when 'in-package' or 'in-ns'
+ was in comment.
+ - Bugfix: Lisp prompt identification problems in REPL buffer.
+ - Bugfix: input line duplication in SBCL on Linux
+ (assigned "*debug-io*" to stdin).
+ - Bugfix: Eval Defun missed last ")" if form contained "'('".
+
+0.7.3 - Added compatibility with Python 3.x.
+ - Bugfix: input lines for REPL were doubled on Linux (thanks to
+ Andrew Hills), however not yet fixed for SBCL.
+ - Bugfix: enclose Slimv path in double quotes if it contains space.
+ - Bugfix: select form when standing on prefix character (e.g. ' or `).
+
+0.7.2 - Added autodetection for /usr/local/bin/clojure on Linux.
+ - Added special characters to Lisp keyword selection (iskeyword).
+ - Run Vim's original ftplugin/lisp.vim for Clojure filetype.
+ - Bugfix: PareditWrap error when g:paredit_shortmaps=1 (thanks to
+ Jon Thacker).
+ - Bugfix: buffer selection problems in case of three of more buffers
+ (thanks to Philipp Marek).
+ - Bugfix: conflicting keybindings for SlimvGenerateTags.
+ - Bugfix: unmap error messages when g:paredit_mode=0.
+
+0.7.1 - Added option g:slimv_browser_cmd for opening hyperspec in a custom
+ webbrowser (on behalf of Andreas Salwasser).
+ - Added paredit handling for d<motion>, c<motion>, p and P commands:
+ keep paren balance when deleting and pasting text.
+ - Paredit Toggle function removes and re-adds paredit keybindings.
+ - Bugfix: D and C deleted till beginning of line if () or [] found.
+ - Bugfix: handle escaped \" characters inside string.
+
+0.7.0 - Added package/namespace support.
+ - New way of refreshing the REPL buffer via autocommands, removed
+ 'RUNNING' mode, cursor stays in the current buffer at evaluation.
+ - Added option g:slimv_updatetime.
+ - Removed options related to the old way of refreshing:
+ g:slimv_repl_return and g:slimv_repl_wait.
+ - Removed debug logging.
+ - Updated Clojure API to version 1.2.
+ - Extended keyword definition when selecting symbols.
+ - Bugfix: defmacro detection problem (again).
+
+0.6.3 - Added option g:slimv_repl_return to return cursor to the editor window
+ from REPL buffer after evaluating an s-expression.
+ - Wrap: if standing on a paren then wrap the whole s-expression.
+ - Wrap selection: exit visual mode after command.
+ - Bugfix: inserting double quotes in paredit mode (like "\"").
+ - Bugfix: dd in paredit mode when unbalanced form is inside comment.
+ - Bugfix: reopen REPL buffer after closing it via :q.
+ - Bugfix: comment and string detection error with noignorecase setting
+ (thanks to Brian Kropf).
+ - Bugfix: wrong positioning when moving parenthesis to the right.
+ - Bugfix: defmacro detection problem (thanks to Philipp Marek).
+ - Bugfix: paredit wrap selection missed last character when 'selection'
+ was not "exclusive".
+
+0.6.2 - Added support for Mac OS X via Terminal.app (on behalf of Vlad Hanciuta).
+ - Added string "clj" as a detector for Clojure (by Vlad Hanciuta).
+ - Bugfix: paredit wrap function missed last character when 'selection'
+ was not "exclusive" (thanks to Marcin Fatyga).
+ - Bugfix: input was stuck inside SBCL debugger
+ (on behalf of Philipp Marek and Dmitry Petukhov).
+ - Bugfix: occasional error messages during REPL buffer update.
+ - Bugfix: REPL menu was sometimes missing.
+ - Bugfix: occasional command line color problems.
+
+0.6.1 - Added Split, Join, Wrap, Splice functions to Paredit Mode.
+ - Added g:paredit_shortmaps to select short/long paredit keymaps.
+ - Bugfix: delete commands put erased characters into yank buffer.
+ - Bugfix: D deletes only characters after the cursor position.
+
+0.6.0 - Added paredit mode.
+ - Set wrap mode for REPL buffer with keybindings.
+
+0.5.6 - Improved REPL buffer response time.
+ - Added debug log flushing frequency.
+ - Bugfix: early exit of REPL refresh mode on some machines.
+
+0.5.5 - Updated Clojure API to 1.1.
+ - Expand tilde-prefix to home directory on Linux.
+ - Autodetect Clojure in the user home directory on Linux.
+
+0.5.4 - Added autodetection for clojure-contrib.jar.
+ - Added autodetection for Clozure CL.
+ - Applied lisp_rainbow to Clojure's [].
+ - Renamed Clojure indent plugin to clojure.vim
+ so that Vim finds and loads it.
+ - Switched on lisp mode explicitly for Clojure filetype.
+
+0.5.3 - Added Interrupt-Lisp-Process command.
+ - Added mapping for the REPL menu.
+ - Added special forms to Clojre API lookup.
+ - Bugfix: put cursor after the last character in insert mode when
+ continuously refreshing REPL buffer.
+ - Fixed some Ctrl-C handling problems.
+
+0.5.2 - Updated Clojure API.
+ - Adapted Clojure autodetection to version 1.0 (clojure-1.0.0.jar).
+ - Complete-Symbol command moved to separate Edit submenu.
+ - Added Close-Form command to the Edit submenu.
+
+0.5.1 - Added symbol name completion based on the Hyperspec database.
+
+0.5.0 - Major project reorganization:
+ Slimv is now a Lisp and Clojure filetype plugin.
+ - Added Common Lisp Hyperspec, Clojure API, and JavaDoc lookup.
+ - Separate menu for REPL buffer, menu items work in every Vim mode.
+ - Fixed mark 's usage bug - thanks to Lorenzo Campedelli.
+
+0.4.1 - Added profiler support for SBCL.
+ - Added commands/menu items: Profiling: Show Profiled,
+ REPL: Send Input, Close and Send Input, Previous Input, Next Input
+ - Display Slimv error messages with ErrorMsg highlight.
+
+0.4.0 - Added SLIME's profiling tool with support from Slimv.
+ - Added command to generate tags file.
+ - Fixed evaluation problems of large buffers on some systems.
+ - Fixed Compile And Load filename problems with '\' on Windows.
+ - Recycle old REPL temporary file at next server startup.
+
+0.3.0 - Added syntax highlighting and automatic indentation for the REPL
+ buffer (needs lisp and/or clojure Vim plugins).
+ - It is possible to enter a multi-line command in the REPL buffer,
+ until the opening and closing parens match.
+ - Insert mode Up and Down keys move cursor when outside of the REPL
+ command line.
+ - Ctrl-C is working inside the REPL buffer (while waiting for output),
+ so Ctrl-X and Ctrl-X Ctrl-X keybindings are removed.
+ - REPL window performance enhancement on Linux.
+
+0.2.2 - Fixed REPL input and output mix-up problems.
+ - Evaluation performance enhancement.
+ - Corrected some more macroexpand problems.
+
+0.2.1 - Added basic Clojure support.
+ - Corrected some macroexpand problems.
+ - Fixed a REPL buffer refresh bug.
+
+0.2.0 - Major update: Lisp REPL displayed in a Vim buffer.
+
+0.1.4 - Corrected the delayed display of last line in REPL window on Linux.
+ - Ctrl-C is propagated to Lisp REPL, so it is possible to interrupt
+ a running program. Does not work however with some Lisp
+ implementations (like SBCL).
+
+0.1.3 - Handle DOS and Unix style newlines produced by various
+ Lisp implementations on Windows.
+ - Do not write debug logfile when debug level is zero.
+ - Removed unused client command line argument: -c
+
+0.1.2 - Windows users do not need pywin32 anymore.
+ - Display buffer is more thread safe.
+
+0.1.1 - Corrected memory fillup problem after a long REPL session.
+
+0.1 - Initial release.
+
+===============================================================================
+ISSUES, LIMITATIONS, KNOWN BUGS *slimv-issues*
+
+- Vim register "s is used for all form selections, so its original content is
+ destroyed.
+- Needs Vim version 7.0 or above, because of the intensive use of lists.
+- Needs the same Python version that Vim is compiled against
+- It is not possible to run separate Lisp and Clojure REPL in the same
+ Slimv session.
+- Recent macvim (OS X) 64-bit versions seem to have a Python 2.7 binding problem
+ causing segmentation faults when Slimv tries to connect to the Swank server.
+ One possible solution is to use the 32-bit version of macvim.
+ Another solution is to rebuild macvim with Python binding changed to 2.6.
+
+
+===============================================================================
+TODO *slimv-todo*
+
+- Add missing SLIME functions to the SWANK client.
+- Allow connecting remote SWANK server (outside of localhost) via SSH.
+- Allow multiple REPL buffers in the same Vim session.
+- Allow multiple inferior lisps (e.g. one REPL to CLISP, another one to SBCL).
+
+===============================================================================
+CREDITS *slimv-credits*
+
+Author: Tamas Kovacs <kovisoft at gmail dot com>
+
+Please send comments, bug reports, suggestions, etc. to the e-mail address
+above.
+
+Slimv is free software, you can redistribute it and/or modify it any way you
+like, except the embedded SLIME and Swank Clojure.
+
+SLIME is distributed under the terms of the GNU General Public License as
+published by the Free Software Foundation. See the included slime/README file
+or http://common-lisp.net/project/slime/ for details.
+
+Swank Clojure is licensed under the Eclipse Public License. See the file
+swank-clojure/COPYING or https://github.com/technomancy/swank-clojure for
+details.
+
+Credit must go out to Bram Moolenaar and all the Vim developers for making
+the world's (one of the) best editor.
+
+Thanks to Eric Marsden, Luke Gorrie, Helmut Eller, Luke Gorrie, Helmut Eller,
+Tobias C. Rittweiler and all the Emacs/SLIME developers for making SLIME.
+Also special thanks to Erik Naggum, Yuji Minejima and others for making the
+Common Lisp Hyperspec lookup packages for SLIME, and thanks to
+Taylor R. Campbell for the Emacs paredit.el script.
+
+Thanks to Jeffrey Chu, Phil Hagelberg, Hugo Duncan for making Swank Clojure,
+and to Helmut Eller for making Scheme Swank server.
+
+Thanks to the Vim community for testing, commenting and patching the script,
+especially to Philipp Marek for his great number of contributions, patches,
+ideas, suggestions on the SWANK integration.
+
+Also thanks to Vlad Hanciuta, Marcin Fatyga, Dmitry Petukhov,
+Daniel Solano Gómez, Brian Kropf, Len Weincier, Andreas Salwasser,
+Jon Thacker, Andrew Hills, Jerome Baum, John Obbele, Andreas Fredriksson,
+Ömer Sinan Agacan, Tobias Pflug, Chris Cahoon, Mats Rauhala, Oleg Terenchuk,
+Andrew Lyon, Andrew Smirnoff, Brett Kosinski, David Greenberg, Sung Pae,
+Conrad Schuler, Tim Pope, David Soria Parra, Colin Jones, Logan Campbell,
+John Szakmeister, Glen Gibb, Federico Churca-Torrusio, Robert Kerr, Jimmy Lu,
+Seth Price for additional notes and contributions.
+
+I would also like to say a big thank you to everyone donating to support
+development. This is a one-element list at the moment: :)
+thanks to Paul Michael Bauer.
+
+Last but not least many thanks to my wife Andrea (for the Italians out there:
+hey, this is a female name in Hungary :) for her support and patience.
+
+===============================================================================
+vim:tw=80:et:wrap:ft=help:norl:
diff --git a/vim/bundle/slimv/ftdetect/clojure.vim b/vim/bundle/slimv/ftdetect/clojure.vim
new file mode 100644
index 0000000..28ddd1b
--- /dev/null
+++ b/vim/bundle/slimv/ftdetect/clojure.vim
@@ -0,0 +1,3 @@
+au BufNewFile,BufRead *.clj setf clojure
+au BufNewFile,BufRead *.cljs setf clojure
+
diff --git a/vim/bundle/slimv/ftplugin/clojure/slimv-clojure.vim b/vim/bundle/slimv/ftplugin/clojure/slimv-clojure.vim
new file mode 100644
index 0000000..3b7b8cc
--- /dev/null
+++ b/vim/bundle/slimv/ftplugin/clojure/slimv-clojure.vim
@@ -0,0 +1,200 @@
+" slimv-clojure.vim:
+" Clojure filetype plugin for Slimv
+" Version: 0.9.13
+" Last Change: 04 May 2014
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if exists("b:slimv_did_ftplugin") || exists("g:slimv_disable_clojure")
+ finish
+endif
+
+" ---------- Begin part loaded once ----------
+if !exists( 'g:slimv_clojure_loaded' )
+
+let g:slimv_clojure_loaded = 1
+
+" Transform filename so that it will not contain spaces
+function! s:TransformFilename( name )
+ if match( a:name, ' ' ) >= 0
+ return fnamemodify( a:name , ':8' )
+ else
+ return a:name
+ endif
+endfunction
+
+" Build a Clojure startup command by adding
+" all clojure*.jar files found to the classpath
+function! s:BuildStartCmd( lisps )
+ let cp = s:TransformFilename( a:lisps[0] )
+ let i = 1
+ while i < len( a:lisps )
+ let cp = cp . ';' . s:TransformFilename( a:lisps[i] )
+ let i = i + 1
+ endwhile
+
+ " Try to find swank-clojure and add it to classpath
+ let swanks = split( globpath( &runtimepath, 'swank-clojure'), '\n' )
+ if len( swanks ) > 0
+ let cp = cp . ';' . s:TransformFilename( swanks[0] )
+ endif
+ return ['java -cp ' . cp . ' clojure.main', 'clojure']
+endfunction
+
+" Try to autodetect Clojure executable
+" Returns list [Clojure executable, Clojure implementation]
+function! SlimvAutodetect( preferred )
+ " Firts try the most basic setup: everything in the path
+ if executable( 'lein' )
+ return ['"lein repl"', 'clojure']
+ endif
+ if executable( 'cake' )
+ return ['"cake repl"', 'clojure']
+ endif
+ if executable( 'clojure' )
+ return ['clojure', 'clojure']
+ endif
+ let lisps = []
+ if executable( 'clojure.jar' )
+ let lisps = ['clojure.jar']
+ endif
+ if executable( 'clojure-contrib.jar' )
+ let lisps = lisps + 'clojure-contrib.jar'
+ endif
+ if len( lisps ) > 0
+ return s:BuildStartCmd( lisps )
+ endif
+
+ " Check if Clojure is bundled with Slimv
+ let lisps = split( globpath( &runtimepath, 'swank-clojure/clojure*.jar'), '\n' )
+ if len( lisps ) > 0
+ return s:BuildStartCmd( lisps )
+ endif
+
+ " Try to find Clojure in the PATH
+ let path = substitute( $PATH, ';', ',', 'g' )
+ let lisps = split( globpath( path, 'clojure*.jar' ), '\n' )
+ if len( lisps ) > 0
+ return s:BuildStartCmd( lisps )
+ endif
+
+ if g:slimv_windows
+ " Try to find Clojure on the standard installation places
+ let lisps = split( globpath( 'c:/*clojure*,c:/*clojure*/lib', 'clojure*.jar' ), '\n' )
+ if len( lisps ) > 0
+ return s:BuildStartCmd( lisps )
+ endif
+ else
+ " Try to find Clojure in the home directory
+ let lisps = split( globpath( '/usr/local/bin/*clojure*', 'clojure*.jar' ), '\n' )
+ if len( lisps ) > 0
+ return s:BuildStartCmd( lisps )
+ endif
+ let lisps = split( globpath( '~/*clojure*', 'clojure*.jar' ), '\n' )
+ if len( lisps ) > 0
+ return s:BuildStartCmd( lisps )
+ endif
+ endif
+
+ return ['', '']
+endfunction
+
+" Try to find out the Clojure implementation
+function! SlimvImplementation()
+ if exists( 'g:slimv_impl' ) && g:slimv_impl != ''
+ " Return Lisp implementation if defined
+ return tolower( g:slimv_impl )
+ endif
+
+ return 'clojure'
+endfunction
+
+" Try to autodetect SWANK and build the command to load the SWANK server
+function! SlimvSwankLoader()
+ " First autodetect Leiningen and Cake
+ if executable( 'lein' )
+ if globpath( '~/.lein/plugins', 'lein-ritz*.jar' ) != ''
+ return '"lein ritz ' . g:swank_port . '"'
+ else
+ return '"lein swank"'
+ endif
+ elseif executable( 'cake' )
+ return '"cake swank"'
+ else
+ " Check if swank-clojure is bundled with Slimv
+ let swanks = split( globpath( &runtimepath, 'swank-clojure/swank/swank.clj'), '\n' )
+ if len( swanks ) == 0
+ return ''
+ endif
+ let sclj = substitute( swanks[0], '\', '/', "g" )
+ return g:slimv_lisp . ' -i "' . sclj . '" -e "(swank.swank/start-repl)" -r'
+ endif
+endfunction
+
+" Filetype specific initialization for the REPL buffer
+function! SlimvInitRepl()
+ set filetype=clojure
+endfunction
+
+" Lookup symbol in the list of Clojure Hyperspec symbol databases
+function! SlimvHyperspecLookup( word, exact, all )
+ if !exists( 'g:slimv_cljapi_loaded' )
+ runtime ftplugin/**/slimv-cljapi.vim
+ endif
+
+ if !exists( 'g:slimv_javadoc_loaded' )
+ runtime ftplugin/**/slimv-javadoc.vim
+ endif
+
+ let symbol = []
+ if exists( 'g:slimv_cljapi_db' )
+ let symbol = SlimvFindSymbol( a:word, a:exact, a:all, g:slimv_cljapi_db, g:slimv_cljapi_root, symbol )
+ endif
+ if exists( 'g:slimv_javadoc_db' )
+ let symbol = SlimvFindSymbol( a:word, a:exact, a:all, g:slimv_javadoc_db, g:slimv_javadoc_root, symbol )
+ endif
+ if exists( 'g:slimv_cljapi_user_db' )
+ " Give a choice for the user to extend the symbol database
+ if exists( 'g:slimv_cljapi_user_root' )
+ let user_root = g:slimv_cljapi_user_root
+ else
+ let user_root = ''
+ endif
+ let symbol = SlimvFindSymbol( a:word, a:exact, a:all, g:slimv_cljapi_user_db, user_root, symbol )
+ endif
+ return symbol
+endfunction
+
+" Implementation specific REPL initialization
+function! SlimvReplInit( lisp_version )
+ " Import functions commonly used in REPL but not present when not running in repl mode
+ if a:lisp_version[0:2] >= '1.3'
+ call SlimvSendSilent( ["(use '[clojure.repl :only (source apropos dir pst doc find-doc)])",
+ \ "(use '[clojure.java.javadoc :only (javadoc)])",
+ \ "(use '[clojure.pprint :only (pp pprint)])"] )
+ elseif a:lisp_version[0:2] >= '1.2'
+ call SlimvSendSilent( ["(use '[clojure.repl :only (source apropos)])",
+ \ "(use '[clojure.java.javadoc :only (javadoc)])",
+ \ "(use '[clojure.pprint :only (pp pprint)])"] )
+ endif
+endfunction
+
+" Source Slimv general part
+runtime ftplugin/**/slimv.vim
+
+endif "!exists( 'g:slimv_clojure_loaded' )
+" ---------- End of part loaded once ----------
+
+runtime ftplugin/**/lisp.vim
+
+" Must be called for each lisp buffer
+call SlimvInitBuffer()
+
+" Don't initiate Slimv again for this buffer
+let b:slimv_did_ftplugin = 1
+
diff --git a/vim/bundle/slimv/ftplugin/iterm.applescript b/vim/bundle/slimv/ftplugin/iterm.applescript
new file mode 100755
index 0000000..28923d8
--- /dev/null
+++ b/vim/bundle/slimv/ftplugin/iterm.applescript
@@ -0,0 +1,66 @@
+#! /usr/bin/osascript
+-- joinList from Geert Vanderkelen @ bit.ly/1gRPYbH
+-- toDo push new terminal to background after creation
+to joinList(aList, delimiter)
+ set retVal to ""
+ set prevDelimiter to AppleScript's text item delimiters
+ set AppleScript's text item delimiters to delimiter
+ set retVal to aList as string
+ set AppleScript's text item delimiters to prevDelimiter
+ return retVal
+end joinList
+
+-- theSplit from iTerm version check example @ https://goo.gl/dSbQYU
+on theSplit(theString, theDelimiter)
+ set oldDelimiters to AppleScript's text item delimiters
+ set AppleScript's text item delimiters to theDelimiter
+ set theArray to every text item of theString
+ set AppleScript's text item delimiters to oldDelimiters
+ return theArray
+end theSplit
+
+-- IsModernVersion from iTerm version check example @ https://goo.gl/dSbQYU
+on IsModernVersion(version)
+ set myArray to my theSplit(version, ".")
+ set major to item 1 of myArray
+ set minor to item 2 of myArray
+ set veryMinor to item 3 of myArray
+
+ if major < 2 then
+ return false
+ end if
+ if major > 2 then
+ return true
+ end if
+ if minor < 9 then
+ return false
+ end if
+ if minor > 9 then
+ return true
+ end if
+ if veryMinor < 20140903 then
+ return false
+ end if
+ return true
+end IsModernVersion
+
+on run arg
+ set thecommand to joinList(arg, " ")
+ tell application "iTerm"
+ activate
+ if my IsModernVersion(version) then
+ set myterm to (create window with default profile)
+ set mysession to current session of myterm
+ else
+ set myterm to (make new teminal)
+ tell myterm
+ set mysession to (launch session "Default")
+ end tell
+ end if
+ tell myterm
+ tell mysession
+ write text thecommand
+ end tell
+ end tell
+ end tell
+end run
diff --git a/vim/bundle/slimv/ftplugin/lisp/slimv-lisp.vim b/vim/bundle/slimv/ftplugin/lisp/slimv-lisp.vim
new file mode 100644
index 0000000..139d28b
--- /dev/null
+++ b/vim/bundle/slimv/ftplugin/lisp/slimv-lisp.vim
@@ -0,0 +1,199 @@
+" slimv-lisp.vim:
+" Lisp filetype plugin for Slimv
+" Version: 0.9.13
+" Last Change: 04 May 2014
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if exists("b:did_ftplugin") || exists("g:slimv_disable_lisp")
+ finish
+endif
+
+" Handle cases when lisp dialects explicitly use the lisp filetype plugins
+if &ft == "clojure" && exists("g:slimv_disable_clojure")
+ finish
+endif
+
+if &ft == "scheme" && exists("g:slimv_disable_scheme")
+ finish
+endif
+
+" ---------- Begin part loaded once ----------
+if !exists( 'g:slimv_lisp_loaded' )
+
+let g:slimv_lisp_loaded = 1
+
+" Descriptor array for various lisp implementations
+" The structure of an array element is:
+" [ executable, implementation, platform, search path]
+" where:
+" executable - may contain wildcards but only if a search path is present
+" platform - 'w' (Windows) or 'l' (Linux = non-Windows), '' for all
+" search path - commma separated list, may contain wildcard characters
+let s:lisp_desc = [
+\ [ 'sbcl', 'sbcl', '', '' ],
+\ [ 'clisp', 'clisp', '', '' ],
+\ [ 'gcl', 'clisp', '', '' ],
+\ [ 'cmucl', 'cmu', '', '' ],
+\ [ 'ecl', 'ecl', '', '' ],
+\ [ 'acl', 'allegro', '', '' ],
+\ [ 'mlisp', 'allegro', '', '' ],
+\ [ 'mlisp8', 'allegro', '', '' ],
+\ [ 'alisp', 'allegro', '', '' ],
+\ [ 'alisp8', 'allegro', '', '' ],
+\ [ 'lwl', 'lispworks', '', '' ],
+\ [ 'ccl', 'clozure', '', '' ],
+\ [ 'wx86cl64', 'clozure', 'w64', '' ],
+\ [ 'wx86cl', 'clozure', 'w', '' ],
+\ [ 'lx86cl', 'clozure', 'l', '' ],
+\ [ '*lisp.exe', 'clisp', 'w',
+\ 'c:/*lisp*,c:/*lisp*/*,c:/*lisp*/bin/*,c:/Program Files/*lisp*,c:/Program Files/*lisp*/*,c:/Program Files/*lisp*/bin/*' ],
+\ [ 'gcl.exe', 'clisp', 'w', 'c:/gcl*,c:/Program Files/gcl*' ],
+\ [ 'cmucl.exe', 'cmu', 'w', 'c:/cmucl*,c:/Program Files/cmucl*' ],
+\ [ '*lisp*.exe', 'allegro', 'w', 'c:/acl*,c:/Program Files/acl*,c:/Program Files/*lisp*/bin/acl*' ],
+\ [ 'ecl.exe', 'ecl', 'w', 'c:/ecl*,c:/Program Files/ecl*' ],
+\ [ 'wx86cl64.exe', 'clozure', 'w64', 'c:/ccl*,c:/Program Files/ccl*,c:/Program Files/*lisp*/bin/ccl*' ],
+\ [ 'wx86cl.exe', 'clozure', 'w', 'c:/ccl*,c:/Program Files/ccl*,c:/Program Files/*lisp*/bin/ccl*' ],
+\ [ 'sbcl.exe', 'sbcl', 'w', 'c:/sbcl*,c:/Program Files/sbcl*,c:/Program Files/*lisp*/bin/sbcl*'] ]
+
+" Try to autodetect Lisp executable
+" Returns list [Lisp executable, Lisp implementation]
+function! SlimvAutodetect( preferred )
+ for lisp in s:lisp_desc
+ if lisp[2] =~ 'w' && !g:slimv_windows
+ " Valid only on Windows
+ elseif lisp[2] == 'w64' && $ProgramW6432 == ''
+ " Valid only on 64 bit Windows
+ elseif lisp[2] == 'l' && g:slimv_windows
+ " Valid only on Linux
+ elseif a:preferred != '' && a:preferred != lisp[1]
+ " Not the preferred implementation
+ elseif lisp[3] != ''
+ " A search path is given
+ let lisps = split( globpath( lisp[3], lisp[0] ), '\n' )
+ if len( lisps ) > 0
+ return [lisps[0], lisp[1]]
+ endif
+ else
+ " Single executable is given without path
+ if executable( lisp[0] )
+ return lisp[0:1]
+ endif
+ endif
+ endfor
+ return ['', '']
+endfunction
+
+" Try to find out the Lisp implementation
+function! SlimvImplementation()
+ if exists( 'g:slimv_impl' ) && g:slimv_impl != ''
+ " Return Lisp implementation if defined
+ return tolower( g:slimv_impl )
+ endif
+
+ let lisp = tolower( g:slimv_lisp )
+ if match( lisp, 'sbcl' ) >= 0
+ return 'sbcl'
+ endif
+ if match( lisp, 'cmu' ) >= 0
+ return 'cmu'
+ endif
+ if match( lisp, 'acl' ) >= 0 || match( lisp, 'alisp' ) >= 0 || match( lisp, 'mlisp' ) >= 0
+ return 'allegro'
+ endif
+ if match( lisp, 'ecl' ) >= 0
+ return 'ecl'
+ endif
+ if match( lisp, 'x86cl' ) >= 0
+ return 'clozure'
+ endif
+ if match( lisp, 'lwl' ) >= 0
+ return 'lispworks'
+ endif
+
+ return 'clisp'
+endfunction
+
+" Try to autodetect SWANK and build the command to load the SWANK server
+function! SlimvSwankLoader()
+ " First check if SWANK is bundled with Slimv
+ let swanks = split( globpath( &runtimepath, 'slime/start-swank.lisp'), '\n' )
+ if len( swanks ) == 0
+ " Try to find SWANK in the standard SLIME installation locations
+ if g:slimv_windows || g:slimv_cygwin
+ let swanks = split( globpath( 'c:/slime/,c:/*lisp*/slime/,c:/*lisp*/site/lisp/slime/,c:/Program Files/*lisp*/site/lisp/slime/', 'start-swank.lisp' ), '\n' )
+ else
+ let swanks = split( globpath( '/usr/share/common-lisp/source/slime/', 'start-swank.lisp' ), '\n' )
+ endif
+ endif
+ if len( swanks ) == 0
+ return ''
+ endif
+
+ " Build proper SWANK loader command for the Lisp implementation used
+ if g:slimv_impl == 'sbcl'
+ return '"' . g:slimv_lisp . '" --load "' . swanks[0] . '"'
+ elseif g:slimv_impl == 'clisp'
+ return '"' . g:slimv_lisp . '" -i "' . swanks[0] . '"'
+ elseif g:slimv_impl == 'allegro'
+ return '"' . g:slimv_lisp . '" -L "' . swanks[0] . '"'
+ elseif g:slimv_impl == 'cmu'
+ return '"' . g:slimv_lisp . '" -load "' . swanks[0] . '"'
+ else
+ return '"' . g:slimv_lisp . '" -l "' . swanks[0] . '"'
+ endif
+endfunction
+
+" Filetype specific initialization for the REPL buffer
+function! SlimvInitRepl()
+ set filetype=lisp
+endfunction
+
+" Lookup symbol in the list of Lisp Hyperspec symbol databases
+function! SlimvHyperspecLookup( word, exact, all )
+ if !exists( 'g:slimv_clhs_loaded' )
+ runtime ftplugin/**/slimv-clhs.vim
+ endif
+
+ let symbol = []
+ if exists( 'g:slimv_clhs_loaded' )
+ let symbol = SlimvFindSymbol( a:word, a:exact, a:all, g:slimv_clhs_clhs, g:slimv_clhs_root, symbol )
+ let symbol = SlimvFindSymbol( a:word, a:exact, a:all, g:slimv_clhs_issues, g:slimv_clhs_root, symbol )
+ let symbol = SlimvFindSymbol( a:word, a:exact, a:all, g:slimv_clhs_chapters, g:slimv_clhs_root, symbol )
+ let symbol = SlimvFindSymbol( a:word, a:exact, a:all, g:slimv_clhs_control_chars, g:slimv_clhs_root, symbol )
+ let symbol = SlimvFindSymbol( a:word, a:exact, a:all, g:slimv_clhs_macro_chars, g:slimv_clhs_root, symbol )
+ let symbol = SlimvFindSymbol( a:word, a:exact, a:all, g:slimv_clhs_loop, g:slimv_clhs_root, symbol )
+ let symbol = SlimvFindSymbol( a:word, a:exact, a:all, g:slimv_clhs_arguments, g:slimv_clhs_root, symbol )
+ let symbol = SlimvFindSymbol( a:word, a:exact, a:all, g:slimv_clhs_glossary, g:slimv_clhs_root, symbol )
+ endif
+ if exists( 'g:slimv_clhs_user_db' )
+ " Give a choice for the user to extend the symbol database
+ if exists( 'g:slimv_clhs_user_root' )
+ let user_root = g:slimv_clhs_user_root
+ else
+ let user_root = ''
+ endif
+ let symbol = SlimvFindSymbol( a:word, a:exact, a:all, g:slimv_clhs_user_db, user_root, symbol )
+ endif
+ return symbol
+endfunction
+
+" Source Slimv general part
+runtime ftplugin/**/slimv.vim
+
+endif "!exists( 'g:slimv_lisp_loaded' )
+" ---------- End of part loaded once ----------
+
+runtime ftplugin/**/lisp.vim
+
+" Must be called for each lisp buffer
+call SlimvInitBuffer()
+
+" Don't load another plugin for this buffer
+let b:did_ftplugin = 1
+
diff --git a/vim/bundle/slimv/ftplugin/r/slimv-r.vim b/vim/bundle/slimv/ftplugin/r/slimv-r.vim
new file mode 100644
index 0000000..a5c8ec9
--- /dev/null
+++ b/vim/bundle/slimv/ftplugin/r/slimv-r.vim
@@ -0,0 +1,60 @@
+" slimv-r.vim:
+" R filetype plugin for Slimv
+" Version: 0.9.13
+" Last Change: 04 May 2014
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if exists("b:did_ftplugin")
+ finish
+endif
+
+" ---------- Begin part loaded once ----------
+if !exists( 'g:slimv_lisp_loaded' )
+
+let g:slimv_lisp_loaded = 1
+
+" Try to autodetect Lisp executable
+" Returns list [Lisp executable, Lisp implementation]
+function! SlimvAutodetect( preferred )
+ return ['R', 'R']
+endfunction
+
+" Try to find out the Lisp implementation
+function! SlimvImplementation()
+ return 'R'
+endfunction
+
+" Try to autodetect SWANK and build the command to load the SWANK server
+function! SlimvSwankLoader()
+endfunction
+
+" Filetype specific initialization for the REPL buffer
+function! SlimvInitRepl()
+ set filetype=r
+endfunction
+
+" Lookup symbol in the list of Lisp Hyperspec symbol databases
+function! SlimvHyperspecLookup( word, exact, all )
+ return [ a:word ]
+endfunction
+
+" Source Slimv general part
+runtime ftplugin/**/slimv.vim
+
+endif "!exists( 'g:slimv_lisp_loaded' )
+" ---------- End of part loaded once ----------
+
+"runtime ftplugin/**/r.vim
+
+" Must be called for each lisp buffer
+call SlimvInitBuffer()
+
+" Don't load another plugin for this buffer
+let b:did_ftplugin = 1
+
diff --git a/vim/bundle/slimv/ftplugin/scheme/slimv-scheme.vim b/vim/bundle/slimv/ftplugin/scheme/slimv-scheme.vim
new file mode 100644
index 0000000..4a71954
--- /dev/null
+++ b/vim/bundle/slimv/ftplugin/scheme/slimv-scheme.vim
@@ -0,0 +1,91 @@
+" slimv-scheme.vim:
+" Scheme filetype plugin for Slimv
+" Version: 0.9.13
+" Last Change: 04 May 2014
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if exists("b:did_ftplugin") || exists("g:slimv_disable_scheme")
+ finish
+endif
+
+" ---------- Begin part loaded once ----------
+if !exists( 'g:slimv_scheme_loaded' )
+
+let g:slimv_scheme_loaded = 1
+
+" Try to autodetect Scheme executable
+" Returns list [Scheme executable, Scheme implementation]
+function! SlimvAutodetect( preferred )
+ " Currently only MIT Scheme on Linux
+ if executable( 'scheme' )
+ " MIT Scheme
+ return ['scheme', 'mit']
+ endif
+
+ return ['', '']
+endfunction
+
+" Try to find out the Scheme implementation
+function! SlimvImplementation()
+ if exists( 'g:slimv_impl' ) && g:slimv_impl != ''
+ " Return Lisp implementation if defined
+ return tolower( g:slimv_impl )
+ endif
+
+ return 'mit'
+endfunction
+
+" Try to autodetect SWANK and build the command to load the SWANK server
+function! SlimvSwankLoader()
+ if g:slimv_impl == 'mit'
+ if exists( 'g:scheme_builtin_swank' ) && g:scheme_builtin_swank
+ " MIT Scheme contains a built-in swank server since version 9.1.1
+ return 'scheme --eval "(let loop () (start-swank) (loop))"'
+ endif
+ let swanks = split( globpath( &runtimepath, 'slime/contrib/swank-mit-scheme.scm'), '\n' )
+ if len( swanks ) == 0
+ return ''
+ endif
+ return '"' . g:slimv_lisp . '" --load "' . swanks[0] . '"'
+ endif
+ return ''
+endfunction
+
+" Filetype specific initialization for the REPL buffer
+function! SlimvInitRepl()
+ set filetype=scheme
+endfunction
+
+" Lookup symbol in the Hyperspec
+function! SlimvHyperspecLookup( word, exact, all )
+ " No Hyperspec support for Scheme at the moment
+ let symbol = []
+ return symbol
+endfunction
+
+" Source Slimv general part
+runtime ftplugin/**/slimv.vim
+
+endif "!exists( 'g:slimv_scheme_loaded' )
+" ---------- End of part loaded once ----------
+
+runtime ftplugin/**/lisp.vim
+
+" The balloonexpr of MIT-Scheme is broken. Disable it.
+let g:slimv_balloon = 0
+
+" The fuzzy completion of MIT-Scheme is broken. Disable it.
+let g:slimv_simple_compl = 1
+
+" Must be called for each lisp buffer
+call SlimvInitBuffer()
+
+" Don't load another plugin for this buffer
+let b:did_ftplugin = 1
+
diff --git a/vim/bundle/slimv/ftplugin/slimv-clhs.vim b/vim/bundle/slimv/ftplugin/slimv-clhs.vim
new file mode 100644
index 0000000..e55c196
--- /dev/null
+++ b/vim/bundle/slimv/ftplugin/slimv-clhs.vim
@@ -0,0 +1,2236 @@
+" slimv-clhs.vim:
+" Common Lisp Hyperspec lookup support for Slimv
+" Version: 0.5.0
+" Last Change: 14 Apr 2009
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+" Commentary: This file is based on SLIME's hyperspec.el created by
+" Erik Naggum (http://common-lisp.net/project/slime/),
+" and the cl-lookup package made by Yuji Minejima
+" (http://homepage1.nifty.com/bmonkey/lisp/index-en.html).
+"
+" =====================================================================
+"
+" Load Once:
+if &cp || exists( 'g:slimv_clhs_loaded' )
+ finish
+endif
+
+let g:slimv_clhs_loaded = 1
+
+" It is possible to lookup the following information:
+" symbol , e.g. "setf"
+" hyperspec-chapters , e.g. [index], [syntax]
+" format-control-characters , e.g. "~C: Character", "~%: Newline"
+" reader-macro-characters , e.g. "(", "#'", "#b", "#+"
+" loop , e.g. loop:with, loop:collect
+" arguments , e.g. :test, :key, :eof-error-p
+" glossary , e.g. {absolute}, {binding}
+
+" Root of the Common Lisp Hyperspec
+if !exists( 'g:slimv_clhs_root' )
+ let g:slimv_clhs_root = 'http://www.lispworks.com/reference/HyperSpec/Body/'
+endif
+
+if !exists( 'g:slimv_clhs_clhs' )
+ let g:slimv_clhs_clhs = [
+ \["&allow-other-keys", "03_da.htm"],
+ \["&aux", "03_da.htm"],
+ \["&body", "03_dd.htm"],
+ \["&environment", "03_dd.htm"],
+ \["&key", "03_da.htm"],
+ \["&optional", "03_da.htm"],
+ \["&rest", "03_da.htm"],
+ \["&whole", "03_dd.htm"],
+ \["*", "a_st.htm"],
+ \["**", "v__stst_.htm"],
+ \["***", "v__stst_.htm"],
+ \["*break-on-signals*", "v_break_.htm"],
+ \["*compile-file-pathname*", "v_cmp_fi.htm"],
+ \["*compile-file-truename*", "v_cmp_fi.htm"],
+ \["*compile-print*", "v_cmp_pr.htm"],
+ \["*compile-verbose*", "v_cmp_pr.htm"],
+ \["*debug-io*", "v_debug_.htm"],
+ \["*debugger-hook*", "v_debugg.htm"],
+ \["*default-pathname-defaults*", "v_defaul.htm"],
+ \["*error-output*", "v_debug_.htm"],
+ \["*features*", "v_featur.htm"],
+ \["*gensym-counter*", "v_gensym.htm"],
+ \["*load-pathname*", "v_ld_pns.htm"],
+ \["*load-print*", "v_ld_prs.htm"],
+ \["*load-truename*", "v_ld_pns.htm"],
+ \["*load-verbose*", "v_ld_prs.htm"],
+ \["*macroexpand-hook*", "v_mexp_h.htm"],
+ \["*modules*", "v_module.htm"],
+ \["*package*", "v_pkg.htm"],
+ \["*print-array*", "v_pr_ar.htm"],
+ \["*print-base*", "v_pr_bas.htm"],
+ \["*print-case*", "v_pr_cas.htm"],
+ \["*print-circle*", "v_pr_cir.htm"],
+ \["*print-escape*", "v_pr_esc.htm"],
+ \["*print-gensym*", "v_pr_gen.htm"],
+ \["*print-length*", "v_pr_lev.htm"],
+ \["*print-level*", "v_pr_lev.htm"],
+ \["*print-lines*", "v_pr_lin.htm"],
+ \["*print-miser-width*", "v_pr_mis.htm"],
+ \["*print-pprint-dispatch*", "v_pr_ppr.htm"],
+ \["*print-pretty*", "v_pr_pre.htm"],
+ \["*print-radix*", "v_pr_bas.htm"],
+ \["*print-readably*", "v_pr_rda.htm"],
+ \["*print-right-margin*", "v_pr_rig.htm"],
+ \["*query-io*", "v_debug_.htm"],
+ \["*random-state*", "v_rnd_st.htm"],
+ \["*read-base*", "v_rd_bas.htm"],
+ \["*read-default-float-format*", "v_rd_def.htm"],
+ \["*read-eval*", "v_rd_eva.htm"],
+ \["*read-suppress*", "v_rd_sup.htm"],
+ \["*readtable*", "v_rdtabl.htm"],
+ \["*standard-input*", "v_debug_.htm"],
+ \["*standard-output*", "v_debug_.htm"],
+ \["*terminal-io*", "v_termin.htm"],
+ \["*trace-output*", "v_debug_.htm"],
+ \["+", "a_pl.htm"],
+ \["++", "v_pl_plp.htm"],
+ \["+++", "v_pl_plp.htm"],
+ \["-", "a__.htm"],
+ \["/", "a_sl.htm"],
+ \["//", "v_sl_sls.htm"],
+ \["///", "v_sl_sls.htm"],
+ \["/=", "f_eq_sle.htm"],
+ \["1+", "f_1pl_1_.htm"],
+ \["1-", "f_1pl_1_.htm"],
+ \["<", "f_eq_sle.htm"],
+ \["<=", "f_eq_sle.htm"],
+ \["=", "f_eq_sle.htm"],
+ \[">", "f_eq_sle.htm"],
+ \[">=", "f_eq_sle.htm"],
+ \["abort", "a_abort.htm"],
+ \["abs", "f_abs.htm"],
+ \["acons", "f_acons.htm"],
+ \["acos", "f_asin_.htm"],
+ \["acosh", "f_sinh_.htm"],
+ \["add-method", "f_add_me.htm"],
+ \["adjoin", "f_adjoin.htm"],
+ \["adjust-array", "f_adjust.htm"],
+ \["adjustable-array-p", "f_adju_1.htm"],
+ \["allocate-instance", "f_alloca.htm"],
+ \["alpha-char-p", "f_alpha_.htm"],
+ \["alphanumericp", "f_alphan.htm"],
+ \["and", "a_and.htm"],
+ \["append", "f_append.htm"],
+ \["apply", "f_apply.htm"],
+ \["apropos", "f_apropo.htm"],
+ \["apropos-list", "f_apropo.htm"],
+ \["aref", "f_aref.htm"],
+ \["arithmetic-error", "e_arithm.htm"],
+ \["arithmetic-error-operands", "f_arithm.htm"],
+ \["arithmetic-error-operation", "f_arithm.htm"],
+ \["array", "t_array.htm"],
+ \["array-dimension", "f_ar_dim.htm"],
+ \["array-dimension-limit", "v_ar_dim.htm"],
+ \["array-dimensions", "f_ar_d_1.htm"],
+ \["array-displacement", "f_ar_dis.htm"],
+ \["array-element-type", "f_ar_ele.htm"],
+ \["array-has-fill-pointer-p", "f_ar_has.htm"],
+ \["array-in-bounds-p", "f_ar_in_.htm"],
+ \["array-rank", "f_ar_ran.htm"],
+ \["array-rank-limit", "v_ar_ran.htm"],
+ \["array-row-major-index", "f_ar_row.htm"],
+ \["array-total-size", "f_ar_tot.htm"],
+ \["array-total-size-limit", "v_ar_tot.htm"],
+ \["arrayp", "f_arrayp.htm"],
+ \["ash", "f_ash.htm"],
+ \["asin", "f_asin_.htm"],
+ \["asinh", "f_sinh_.htm"],
+ \["assert", "m_assert.htm"],
+ \["assoc", "f_assocc.htm"],
+ \["assoc-if", "f_assocc.htm"],
+ \["assoc-if-not", "f_assocc.htm"],
+ \["atan", "f_asin_.htm"],
+ \["atanh", "f_sinh_.htm"],
+ \["atom", "a_atom.htm"],
+ \["base-char", "t_base_c.htm"],
+ \["base-string", "t_base_s.htm"],
+ \["bignum", "t_bignum.htm"],
+ \["bit", "a_bit.htm"],
+ \["bit-and", "f_bt_and.htm"],
+ \["bit-andc1", "f_bt_and.htm"],
+ \["bit-andc2", "f_bt_and.htm"],
+ \["bit-eqv", "f_bt_and.htm"],
+ \["bit-ior", "f_bt_and.htm"],
+ \["bit-nand", "f_bt_and.htm"],
+ \["bit-nor", "f_bt_and.htm"],
+ \["bit-not", "f_bt_and.htm"],
+ \["bit-orc1", "f_bt_and.htm"],
+ \["bit-orc2", "f_bt_and.htm"],
+ \["bit-vector", "t_bt_vec.htm"],
+ \["bit-vector-p", "f_bt_vec.htm"],
+ \["bit-xor", "f_bt_and.htm"],
+ \["block", "s_block.htm"],
+ \["boole", "f_boole.htm"],
+ \["boole-1", "v_b_1_b.htm"],
+ \["boole-2", "v_b_1_b.htm"],
+ \["boole-and", "v_b_1_b.htm"],
+ \["boole-andc1", "v_b_1_b.htm"],
+ \["boole-andc2", "v_b_1_b.htm"],
+ \["boole-c1", "v_b_1_b.htm"],
+ \["boole-c2", "v_b_1_b.htm"],
+ \["boole-clr", "v_b_1_b.htm"],
+ \["boole-eqv", "v_b_1_b.htm"],
+ \["boole-ior", "v_b_1_b.htm"],
+ \["boole-nand", "v_b_1_b.htm"],
+ \["boole-nor", "v_b_1_b.htm"],
+ \["boole-orc1", "v_b_1_b.htm"],
+ \["boole-orc2", "v_b_1_b.htm"],
+ \["boole-set", "v_b_1_b.htm"],
+ \["boole-xor", "v_b_1_b.htm"],
+ \["boolean", "t_ban.htm"],
+ \["both-case-p", "f_upper_.htm"],
+ \["boundp", "f_boundp.htm"],
+ \["break", "f_break.htm"],
+ \["broadcast-stream", "t_broadc.htm"],
+ \["broadcast-stream-streams", "f_broadc.htm"],
+ \["built-in-class", "t_built_.htm"],
+ \["butlast", "f_butlas.htm"],
+ \["byte", "f_by_by.htm"],
+ \["byte-position", "f_by_by.htm"],
+ \["byte-size", "f_by_by.htm"],
+ \["caaaar", "f_car_c.htm"],
+ \["caaadr", "f_car_c.htm"],
+ \["caaar", "f_car_c.htm"],
+ \["caadar", "f_car_c.htm"],
+ \["caaddr", "f_car_c.htm"],
+ \["caadr", "f_car_c.htm"],
+ \["caar", "f_car_c.htm"],
+ \["cadaar", "f_car_c.htm"],
+ \["cadadr", "f_car_c.htm"],
+ \["cadar", "f_car_c.htm"],
+ \["caddar", "f_car_c.htm"],
+ \["cadddr", "f_car_c.htm"],
+ \["caddr", "f_car_c.htm"],
+ \["cadr", "f_car_c.htm"],
+ \["call-arguments-limit", "v_call_a.htm"],
+ \["call-method", "m_call_m.htm"],
+ \["call-next-method", "f_call_n.htm"],
+ \["car", "f_car_c.htm"],
+ \["case", "m_case_.htm"],
+ \["catch", "s_catch.htm"],
+ \["ccase", "m_case_.htm"],
+ \["cdaaar", "f_car_c.htm"],
+ \["cdaadr", "f_car_c.htm"],
+ \["cdaar", "f_car_c.htm"],
+ \["cdadar", "f_car_c.htm"],
+ \["cdaddr", "f_car_c.htm"],
+ \["cdadr", "f_car_c.htm"],
+ \["cdar", "f_car_c.htm"],
+ \["cddaar", "f_car_c.htm"],
+ \["cddadr", "f_car_c.htm"],
+ \["cddar", "f_car_c.htm"],
+ \["cdddar", "f_car_c.htm"],
+ \["cddddr", "f_car_c.htm"],
+ \["cdddr", "f_car_c.htm"],
+ \["cddr", "f_car_c.htm"],
+ \["cdr", "f_car_c.htm"],
+ \["ceiling", "f_floorc.htm"],
+ \["cell-error", "e_cell_e.htm"],
+ \["cell-error-name", "f_cell_e.htm"],
+ \["cerror", "f_cerror.htm"],
+ \["change-class", "f_chg_cl.htm"],
+ \["char", "f_char_.htm"],
+ \["char-code", "f_char_c.htm"],
+ \["char-code-limit", "v_char_c.htm"],
+ \["char-downcase", "f_char_u.htm"],
+ \["char-equal", "f_chareq.htm"],
+ \["char-greaterp", "f_chareq.htm"],
+ \["char-int", "f_char_i.htm"],
+ \["char-lessp", "f_chareq.htm"],
+ \["char-name", "f_char_n.htm"],
+ \["char-not-equal", "f_chareq.htm"],
+ \["char-not-greaterp", "f_chareq.htm"],
+ \["char-not-lessp", "f_chareq.htm"],
+ \["char-upcase", "f_char_u.htm"],
+ \["char/=", "f_chareq.htm"],
+ \["char<", "f_chareq.htm"],
+ \["char<=", "f_chareq.htm"],
+ \["char=", "f_chareq.htm"],
+ \["char>", "f_chareq.htm"],
+ \["char>=", "f_chareq.htm"],
+ \["character", "a_ch.htm"],
+ \["characterp", "f_chp.htm"],
+ \["check-type", "m_check_.htm"],
+ \["cis", "f_cis.htm"],
+ \["class", "t_class.htm"],
+ \["class-name", "f_class_.htm"],
+ \["class-of", "f_clas_1.htm"],
+ \["clear-input", "f_clear_.htm"],
+ \["clear-output", "f_finish.htm"],
+ \["close", "f_close.htm"],
+ \["clrhash", "f_clrhas.htm"],
+ \["code-char", "f_code_c.htm"],
+ \["coerce", "f_coerce.htm"],
+ \["compilation-speed", "d_optimi.htm"],
+ \["compile", "f_cmp.htm"],
+ \["compile-file", "f_cmp_fi.htm"],
+ \["compile-file-pathname", "f_cmp__1.htm"],
+ \["compiled-function", "t_cmpd_f.htm"],
+ \["compiled-function-p", "f_cmpd_f.htm"],
+ \["compiler-macro", "f_docume.htm"],
+ \["compiler-macro-function", "f_cmp_ma.htm"],
+ \["complement", "f_comple.htm"],
+ \["complex", "a_comple.htm"],
+ \["complexp", "f_comp_3.htm"],
+ \["compute-applicable-methods", "f_comput.htm"],
+ \["compute-restarts", "f_comp_1.htm"],
+ \["concatenate", "f_concat.htm"],
+ \["concatenated-stream", "t_concat.htm"],
+ \["concatenated-stream-streams", "f_conc_1.htm"],
+ \["cond", "m_cond.htm"],
+ \["condition", "e_cnd.htm"],
+ \["conjugate", "f_conjug.htm"],
+ \["cons", "a_cons.htm"],
+ \["consp", "f_consp.htm"],
+ \["constantly", "f_cons_1.htm"],
+ \["constantp", "f_consta.htm"],
+ \["continue", "a_contin.htm"],
+ \["control-error", "e_contro.htm"],
+ \["copy-alist", "f_cp_ali.htm"],
+ \["copy-list", "f_cp_lis.htm"],
+ \["copy-pprint-dispatch", "f_cp_ppr.htm"],
+ \["copy-readtable", "f_cp_rdt.htm"],
+ \["copy-seq", "f_cp_seq.htm"],
+ \["copy-structure", "f_cp_stu.htm"],
+ \["copy-symbol", "f_cp_sym.htm"],
+ \["copy-tree", "f_cp_tre.htm"],
+ \["cos", "f_sin_c.htm"],
+ \["cosh", "f_sinh_.htm"],
+ \["count", "f_countc.htm"],
+ \["count-if", "f_countc.htm"],
+ \["count-if-not", "f_countc.htm"],
+ \["ctypecase", "m_tpcase.htm"],
+ \["debug", "d_optimi.htm"],
+ \["decf", "m_incf_.htm"],
+ \["declaim", "m_declai.htm"],
+ \["declaration", "d_declar.htm"],
+ \["declare", "s_declar.htm"],
+ \["decode-float", "f_dec_fl.htm"],
+ \["decode-universal-time", "f_dec_un.htm"],
+ \["defclass", "m_defcla.htm"],
+ \["defconstant", "m_defcon.htm"],
+ \["defgeneric", "m_defgen.htm"],
+ \["define-compiler-macro", "m_define.htm"],
+ \["define-condition", "m_defi_5.htm"],
+ \["define-method-combination", "m_defi_4.htm"],
+ \["define-modify-macro", "m_defi_2.htm"],
+ \["define-setf-expander", "m_defi_3.htm"],
+ \["define-symbol-macro", "m_defi_1.htm"],
+ \["defmacro", "m_defmac.htm"],
+ \["defmethod", "m_defmet.htm"],
+ \["defpackage", "m_defpkg.htm"],
+ \["defparameter", "m_defpar.htm"],
+ \["defsetf", "m_defset.htm"],
+ \["defstruct", "m_defstr.htm"],
+ \["deftype", "m_deftp.htm"],
+ \["defun", "m_defun.htm"],
+ \["defvar", "m_defpar.htm"],
+ \["delete", "f_rm_rm.htm"],
+ \["delete-duplicates", "f_rm_dup.htm"],
+ \["delete-file", "f_del_fi.htm"],
+ \["delete-if", "f_rm_rm.htm"],
+ \["delete-if-not", "f_rm_rm.htm"],
+ \["delete-package", "f_del_pk.htm"],
+ \["denominator", "f_numera.htm"],
+ \["deposit-field", "f_deposi.htm"],
+ \["describe", "f_descri.htm"],
+ \["describe-object", "f_desc_1.htm"],
+ \["destructuring-bind", "m_destru.htm"],
+ \["digit-char", "f_digit_.htm"],
+ \["digit-char-p", "f_digi_1.htm"],
+ \["directory", "f_dir.htm"],
+ \["directory-namestring", "f_namest.htm"],
+ \["disassemble", "f_disass.htm"],
+ \["division-by-zero", "e_divisi.htm"],
+ \["do", "m_do_do.htm"],
+ \["do*", "m_do_do.htm"],
+ \["do-all-symbols", "m_do_sym.htm"],
+ \["do-external-symbols", "m_do_sym.htm"],
+ \["do-symbols", "m_do_sym.htm"],
+ \["documentation", "f_docume.htm"],
+ \["dolist", "m_dolist.htm"],
+ \["dotimes", "m_dotime.htm"],
+ \["double-float", "t_short_.htm"],
+ \["double-float-epsilon", "v_short_.htm"],
+ \["double-float-negative-epsilon", "v_short_.htm"],
+ \["dpb", "f_dpb.htm"],
+ \["dribble", "f_dribbl.htm"],
+ \["dynamic-extent", "d_dynami.htm"],
+ \["ecase", "m_case_.htm"],
+ \["echo-stream", "t_echo_s.htm"],
+ \["echo-stream-input-stream", "f_echo_s.htm"],
+ \["echo-stream-output-stream", "f_echo_s.htm"],
+ \["ed", "f_ed.htm"],
+ \["eighth", "f_firstc.htm"],
+ \["elt", "f_elt.htm"],
+ \["encode-universal-time", "f_encode.htm"],
+ \["end-of-file", "e_end_of.htm"],
+ \["endp", "f_endp.htm"],
+ \["enough-namestring", "f_namest.htm"],
+ \["ensure-directories-exist", "f_ensu_1.htm"],
+ \["ensure-generic-function", "f_ensure.htm"],
+ \["eq", "f_eq.htm"],
+ \["eql", "a_eql.htm"],
+ \["equal", "f_equal.htm"],
+ \["equalp", "f_equalp.htm"],
+ \["error", "a_error.htm"],
+ \["etypecase", "m_tpcase.htm"],
+ \["eval", "f_eval.htm"],
+ \["eval-when", "s_eval_w.htm"],
+ \["evenp", "f_evenpc.htm"],
+ \["every", "f_everyc.htm"],
+ \["exp", "f_exp_e.htm"],
+ \["export", "f_export.htm"],
+ \["expt", "f_exp_e.htm"],
+ \["extended-char", "t_extend.htm"],
+ \["fboundp", "f_fbound.htm"],
+ \["fceiling", "f_floorc.htm"],
+ \["fdefinition", "f_fdefin.htm"],
+ \["ffloor", "f_floorc.htm"],
+ \["fifth", "f_firstc.htm"],
+ \["file-author", "f_file_a.htm"],
+ \["file-error", "e_file_e.htm"],
+ \["file-error-pathname", "f_file_e.htm"],
+ \["file-length", "f_file_l.htm"],
+ \["file-namestring", "f_namest.htm"],
+ \["file-position", "f_file_p.htm"],
+ \["file-stream", "t_file_s.htm"],
+ \["file-string-length", "f_file_s.htm"],
+ \["file-write-date", "f_file_w.htm"],
+ \["fill", "f_fill.htm"],
+ \["fill-pointer", "f_fill_p.htm"],
+ \["find", "f_find_.htm"],
+ \["find-all-symbols", "f_find_a.htm"],
+ \["find-class", "f_find_c.htm"],
+ \["find-if", "f_find_.htm"],
+ \["find-if-not", "f_find_.htm"],
+ \["find-method", "f_find_m.htm"],
+ \["find-package", "f_find_p.htm"],
+ \["find-restart", "f_find_r.htm"],
+ \["find-symbol", "f_find_s.htm"],
+ \["finish-output", "f_finish.htm"],
+ \["first", "f_firstc.htm"],
+ \["fixnum", "t_fixnum.htm"],
+ \["flet", "s_flet_.htm"],
+ \["float", "a_float.htm"],
+ \["float-digits", "f_dec_fl.htm"],
+ \["float-precision", "f_dec_fl.htm"],
+ \["float-radix", "f_dec_fl.htm"],
+ \["float-sign", "f_dec_fl.htm"],
+ \["floating-point-inexact", "e_floa_1.htm"],
+ \["floating-point-invalid-operation", "e_floati.htm"],
+ \["floating-point-overflow", "e_floa_2.htm"],
+ \["floating-point-underflow", "e_floa_3.htm"],
+ \["floatp", "f_floatp.htm"],
+ \["floor", "f_floorc.htm"],
+ \["fmakunbound", "f_fmakun.htm"],
+ \["force-output", "f_finish.htm"],
+ \["format", "f_format.htm"],
+ \["formatter", "m_format.htm"],
+ \["fourth", "f_firstc.htm"],
+ \["fresh-line", "f_terpri.htm"],
+ \["fround", "f_floorc.htm"],
+ \["ftruncate", "f_floorc.htm"],
+ \["ftype", "d_ftype.htm"],
+ \["funcall", "f_funcal.htm"],
+ \["function", "a_fn.htm"],
+ \["function-keywords", "f_fn_kwd.htm"],
+ \["function-lambda-expression", "f_fn_lam.htm"],
+ \["functionp", "f_fnp.htm"],
+ \["gcd", "f_gcd.htm"],
+ \["generic-function", "t_generi.htm"],
+ \["gensym", "f_gensym.htm"],
+ \["gentemp", "f_gentem.htm"],
+ \["get", "f_get.htm"],
+ \["get-decoded-time", "f_get_un.htm"],
+ \["get-dispatch-macro-character", "f_set__1.htm"],
+ \["get-internal-real-time", "f_get_in.htm"],
+ \["get-internal-run-time", "f_get__1.htm"],
+ \["get-macro-character", "f_set_ma.htm"],
+ \["get-output-stream-string", "f_get_ou.htm"],
+ \["get-properties", "f_get_pr.htm"],
+ \["get-setf-expansion", "f_get_se.htm"],
+ \["get-universal-time", "f_get_un.htm"],
+ \["getf", "f_getf.htm"],
+ \["gethash", "f_gethas.htm"],
+ \["go", "s_go.htm"],
+ \["graphic-char-p", "f_graphi.htm"],
+ \["handler-bind", "m_handle.htm"],
+ \["handler-case", "m_hand_1.htm"],
+ \["hash-table", "t_hash_t.htm"],
+ \["hash-table-count", "f_hash_1.htm"],
+ \["hash-table-p", "f_hash_t.htm"],
+ \["hash-table-rehash-size", "f_hash_2.htm"],
+ \["hash-table-rehash-threshold", "f_hash_3.htm"],
+ \["hash-table-size", "f_hash_4.htm"],
+ \["hash-table-test", "f_hash_5.htm"],
+ \["host-namestring", "f_namest.htm"],
+ \["identity", "f_identi.htm"],
+ \["if", "s_if.htm"],
+ \["ignorable", "d_ignore.htm"],
+ \["ignore", "d_ignore.htm"],
+ \["ignore-errors", "m_ignore.htm"],
+ \["imagpart", "f_realpa.htm"],
+ \["import", "f_import.htm"],
+ \["in-package", "m_in_pkg.htm"],
+ \["incf", "m_incf_.htm"],
+ \["initialize-instance", "f_init_i.htm"],
+ \["inline", "d_inline.htm"],
+ \["input-stream-p", "f_in_stm.htm"],
+ \["inspect", "f_inspec.htm"],
+ \["integer", "t_intege.htm"],
+ \["integer-decode-float", "f_dec_fl.htm"],
+ \["integer-length", "f_intege.htm"],
+ \["integerp", "f_inte_1.htm"],
+ \["interactive-stream-p", "f_intera.htm"],
+ \["intern", "f_intern.htm"],
+ \["internal-time-units-per-second", "v_intern.htm"],
+ \["intersection", "f_isec_.htm"],
+ \["invalid-method-error", "f_invali.htm"],
+ \["invoke-debugger", "f_invoke.htm"],
+ \["invoke-restart", "f_invo_1.htm"],
+ \["invoke-restart-interactively", "f_invo_2.htm"],
+ \["isqrt", "f_sqrt_.htm"],
+ \["keyword", "t_kwd.htm"],
+ \["keywordp", "f_kwdp.htm"],
+ \["labels", "s_flet_.htm"],
+ \["lambda", "a_lambda.htm"],
+ \["lambda-list-keywords", "v_lambda.htm"],
+ \["lambda-parameters-limit", "v_lamb_1.htm"],
+ \["last", "f_last.htm"],
+ \["lcm", "f_lcm.htm"],
+ \["ldb", "f_ldb.htm"],
+ \["ldb-test", "f_ldb_te.htm"],
+ \["ldiff", "f_ldiffc.htm"],
+ \["least-negative-double-float", "v_most_1.htm"],
+ \["least-negative-long-float", "v_most_1.htm"],
+ \["least-negative-normalized-double-float", "v_most_1.htm"],
+ \["least-negative-normalized-long-float", "v_most_1.htm"],
+ \["least-negative-normalized-short-float", "v_most_1.htm"],
+ \["least-negative-normalized-single-float", "v_most_1.htm"],
+ \["least-negative-short-float", "v_most_1.htm"],
+ \["least-negative-single-float", "v_most_1.htm"],
+ \["least-positive-double-float", "v_most_1.htm"],
+ \["least-positive-long-float", "v_most_1.htm"],
+ \["least-positive-normalized-double-float", "v_most_1.htm"],
+ \["least-positive-normalized-long-float", "v_most_1.htm"],
+ \["least-positive-normalized-short-float", "v_most_1.htm"],
+ \["least-positive-normalized-single-float", "v_most_1.htm"],
+ \["least-positive-short-float", "v_most_1.htm"],
+ \["least-positive-single-float", "v_most_1.htm"],
+ \["length", "f_length.htm"],
+ \["let", "s_let_l.htm"],
+ \["let*", "s_let_l.htm"],
+ \["lisp-implementation-type", "f_lisp_i.htm"],
+ \["lisp-implementation-version", "f_lisp_i.htm"],
+ \["list", "a_list.htm"],
+ \["list*", "f_list_.htm"],
+ \["list-all-packages", "f_list_a.htm"],
+ \["list-length", "f_list_l.htm"],
+ \["listen", "f_listen.htm"],
+ \["listp", "f_listp.htm"],
+ \["load", "f_load.htm"],
+ \["load-logical-pathname-translations", "f_ld_log.htm"],
+ \["load-time-value", "s_ld_tim.htm"],
+ \["locally", "s_locall.htm"],
+ \["log", "f_log.htm"],
+ \["logand", "f_logand.htm"],
+ \["logandc1", "f_logand.htm"],
+ \["logandc2", "f_logand.htm"],
+ \["logbitp", "f_logbtp.htm"],
+ \["logcount", "f_logcou.htm"],
+ \["logeqv", "f_logand.htm"],
+ \["logical-pathname", "a_logica.htm"],
+ \["logical-pathname-translations", "f_logica.htm"],
+ \["logior", "f_logand.htm"],
+ \["lognand", "f_logand.htm"],
+ \["lognor", "f_logand.htm"],
+ \["lognot", "f_logand.htm"],
+ \["logorc1", "f_logand.htm"],
+ \["logorc2", "f_logand.htm"],
+ \["logtest", "f_logtes.htm"],
+ \["logxor", "f_logand.htm"],
+ \["long-float", "t_short_.htm"],
+ \["long-float-epsilon", "v_short_.htm"],
+ \["long-float-negative-epsilon", "v_short_.htm"],
+ \["long-site-name", "f_short_.htm"],
+ \["loop", "m_loop.htm"],
+ \["loop-finish", "m_loop_f.htm"],
+ \["lower-case-p", "f_upper_.htm"],
+ \["machine-instance", "f_mach_i.htm"],
+ \["machine-type", "f_mach_t.htm"],
+ \["machine-version", "f_mach_v.htm"],
+ \["macro-function", "f_macro_.htm"],
+ \["macroexpand", "f_mexp_.htm"],
+ \["macroexpand-1", "f_mexp_.htm"],
+ \["macrolet", "s_flet_.htm"],
+ \["make-array", "f_mk_ar.htm"],
+ \["make-broadcast-stream", "f_mk_bro.htm"],
+ \["make-concatenated-stream", "f_mk_con.htm"],
+ \["make-condition", "f_mk_cnd.htm"],
+ \["make-dispatch-macro-character", "f_mk_dis.htm"],
+ \["make-echo-stream", "f_mk_ech.htm"],
+ \["make-hash-table", "f_mk_has.htm"],
+ \["make-instance", "f_mk_ins.htm"],
+ \["make-instances-obsolete", "f_mk_i_1.htm"],
+ \["make-list", "f_mk_lis.htm"],
+ \["make-load-form", "f_mk_ld_.htm"],
+ \["make-load-form-saving-slots", "f_mk_l_1.htm"],
+ \["make-method", "m_call_m.htm"],
+ \["make-package", "f_mk_pkg.htm"],
+ \["make-pathname", "f_mk_pn.htm"],
+ \["make-random-state", "f_mk_rnd.htm"],
+ \["make-sequence", "f_mk_seq.htm"],
+ \["make-string", "f_mk_stg.htm"],
+ \["make-string-input-stream", "f_mk_s_1.htm"],
+ \["make-string-output-stream", "f_mk_s_2.htm"],
+ \["make-symbol", "f_mk_sym.htm"],
+ \["make-synonym-stream", "f_mk_syn.htm"],
+ \["make-two-way-stream", "f_mk_two.htm"],
+ \["makunbound", "f_makunb.htm"],
+ \["map", "f_map.htm"],
+ \["map-into", "f_map_in.htm"],
+ \["mapc", "f_mapc_.htm"],
+ \["mapcan", "f_mapc_.htm"],
+ \["mapcar", "f_mapc_.htm"],
+ \["mapcon", "f_mapc_.htm"],
+ \["maphash", "f_maphas.htm"],
+ \["mapl", "f_mapc_.htm"],
+ \["maplist", "f_mapc_.htm"],
+ \["mask-field", "f_mask_f.htm"],
+ \["max", "f_max_m.htm"],
+ \["member", "a_member.htm"],
+ \["member-if", "f_mem_m.htm"],
+ \["member-if-not", "f_mem_m.htm"],
+ \["merge", "f_merge.htm"],
+ \["merge-pathnames", "f_merge_.htm"],
+ \["method", "t_method.htm"],
+ \["method-combination", "a_method.htm"],
+ \["method-combination-error", "f_meth_1.htm"],
+ \["method-qualifiers", "f_method.htm"],
+ \["min", "f_max_m.htm"],
+ \["minusp", "f_minusp.htm"],
+ \["mismatch", "f_mismat.htm"],
+ \["mod", "a_mod.htm"],
+ \["most-negative-double-float", "v_most_1.htm"],
+ \["most-negative-fixnum", "v_most_p.htm"],
+ \["most-negative-long-float", "v_most_1.htm"],
+ \["most-negative-short-float", "v_most_1.htm"],
+ \["most-negative-single-float", "v_most_1.htm"],
+ \["most-positive-double-float", "v_most_1.htm"],
+ \["most-positive-fixnum", "v_most_p.htm"],
+ \["most-positive-long-float", "v_most_1.htm"],
+ \["most-positive-short-float", "v_most_1.htm"],
+ \["most-positive-single-float", "v_most_1.htm"],
+ \["muffle-warning", "a_muffle.htm"],
+ \["multiple-value-bind", "m_multip.htm"],
+ \["multiple-value-call", "s_multip.htm"],
+ \["multiple-value-list", "m_mult_1.htm"],
+ \["multiple-value-prog1", "s_mult_1.htm"],
+ \["multiple-value-setq", "m_mult_2.htm"],
+ \["multiple-values-limit", "v_multip.htm"],
+ \["name-char", "f_name_c.htm"],
+ \["namestring", "f_namest.htm"],
+ \["nbutlast", "f_butlas.htm"],
+ \["nconc", "f_nconc.htm"],
+ \["next-method-p", "f_next_m.htm"],
+ \["nil", "a_nil.htm"],
+ \["nintersection", "f_isec_.htm"],
+ \["ninth", "f_firstc.htm"],
+ \["no-applicable-method", "f_no_app.htm"],
+ \["no-next-method", "f_no_nex.htm"],
+ \["not", "a_not.htm"],
+ \["notany", "f_everyc.htm"],
+ \["notevery", "f_everyc.htm"],
+ \["notinline", "d_inline.htm"],
+ \["nreconc", "f_revapp.htm"],
+ \["nreverse", "f_revers.htm"],
+ \["nset-difference", "f_set_di.htm"],
+ \["nset-exclusive-or", "f_set_ex.htm"],
+ \["nstring-capitalize", "f_stg_up.htm"],
+ \["nstring-downcase", "f_stg_up.htm"],
+ \["nstring-upcase", "f_stg_up.htm"],
+ \["nsublis", "f_sublis.htm"],
+ \["nsubst", "f_substc.htm"],
+ \["nsubst-if", "f_substc.htm"],
+ \["nsubst-if-not", "f_substc.htm"],
+ \["nsubstitute", "f_sbs_s.htm"],
+ \["nsubstitute-if", "f_sbs_s.htm"],
+ \["nsubstitute-if-not", "f_sbs_s.htm"],
+ \["nth", "f_nth.htm"],
+ \["nth-value", "m_nth_va.htm"],
+ \["nthcdr", "f_nthcdr.htm"],
+ \["null", "a_null.htm"],
+ \["number", "t_number.htm"],
+ \["numberp", "f_nump.htm"],
+ \["numerator", "f_numera.htm"],
+ \["nunion", "f_unionc.htm"],
+ \["oddp", "f_evenpc.htm"],
+ \["open", "f_open.htm"],
+ \["open-stream-p", "f_open_s.htm"],
+ \["optimize", "d_optimi.htm"],
+ \["or", "a_or.htm"],
+ \["otherwise", "m_case_.htm"],
+ \["output-stream-p", "f_in_stm.htm"],
+ \["package", "t_pkg.htm"],
+ \["package-error", "e_pkg_er.htm"],
+ \["package-error-package", "f_pkg_er.htm"],
+ \["package-name", "f_pkg_na.htm"],
+ \["package-nicknames", "f_pkg_ni.htm"],
+ \["package-shadowing-symbols", "f_pkg_sh.htm"],
+ \["package-use-list", "f_pkg_us.htm"],
+ \["package-used-by-list", "f_pkg__1.htm"],
+ \["packagep", "f_pkgp.htm"],
+ \["pairlis", "f_pairli.htm"],
+ \["parse-error", "e_parse_.htm"],
+ \["parse-integer", "f_parse_.htm"],
+ \["parse-namestring", "f_pars_1.htm"],
+ \["pathname", "a_pn.htm"],
+ \["pathname-device", "f_pn_hos.htm"],
+ \["pathname-directory", "f_pn_hos.htm"],
+ \["pathname-host", "f_pn_hos.htm"],
+ \["pathname-match-p", "f_pn_mat.htm"],
+ \["pathname-name", "f_pn_hos.htm"],
+ \["pathname-type", "f_pn_hos.htm"],
+ \["pathname-version", "f_pn_hos.htm"],
+ \["pathnamep", "f_pnp.htm"],
+ \["peek-char", "f_peek_c.htm"],
+ \["phase", "f_phase.htm"],
+ \["pi", "v_pi.htm"],
+ \["plusp", "f_minusp.htm"],
+ \["pop", "m_pop.htm"],
+ \["position", "f_pos_p.htm"],
+ \["position-if", "f_pos_p.htm"],
+ \["position-if-not", "f_pos_p.htm"],
+ \["pprint", "f_wr_pr.htm"],
+ \["pprint-dispatch", "f_ppr_di.htm"],
+ \["pprint-exit-if-list-exhausted", "m_ppr_ex.htm"],
+ \["pprint-fill", "f_ppr_fi.htm"],
+ \["pprint-indent", "f_ppr_in.htm"],
+ \["pprint-linear", "f_ppr_fi.htm"],
+ \["pprint-logical-block", "m_ppr_lo.htm"],
+ \["pprint-newline", "f_ppr_nl.htm"],
+ \["pprint-pop", "m_ppr_po.htm"],
+ \["pprint-tab", "f_ppr_ta.htm"],
+ \["pprint-tabular", "f_ppr_fi.htm"],
+ \["prin1", "f_wr_pr.htm"],
+ \["prin1-to-string", "f_wr_to_.htm"],
+ \["princ", "f_wr_pr.htm"],
+ \["princ-to-string", "f_wr_to_.htm"],
+ \["print", "f_wr_pr.htm"],
+ \["print-not-readable", "e_pr_not.htm"],
+ \["print-not-readable-object", "f_pr_not.htm"],
+ \["print-object", "f_pr_obj.htm"],
+ \["print-unreadable-object", "m_pr_unr.htm"],
+ \["probe-file", "f_probe_.htm"],
+ \["proclaim", "f_procla.htm"],
+ \["prog", "m_prog_.htm"],
+ \["prog*", "m_prog_.htm"],
+ \["prog1", "m_prog1c.htm"],
+ \["prog2", "m_prog1c.htm"],
+ \["progn", "s_progn.htm"],
+ \["program-error", "e_progra.htm"],
+ \["progv", "s_progv.htm"],
+ \["provide", "f_provid.htm"],
+ \["psetf", "m_setf_.htm"],
+ \["psetq", "m_psetq.htm"],
+ \["push", "m_push.htm"],
+ \["pushnew", "m_pshnew.htm"],
+ \["quote", "s_quote.htm"],
+ \["random", "f_random.htm"],
+ \["random-state", "t_rnd_st.htm"],
+ \["random-state-p", "f_rnd_st.htm"],
+ \["rassoc", "f_rassoc.htm"],
+ \["rassoc-if", "f_rassoc.htm"],
+ \["rassoc-if-not", "f_rassoc.htm"],
+ \["ratio", "t_ratio.htm"],
+ \["rational", "a_ration.htm"],
+ \["rationalize", "f_ration.htm"],
+ \["rationalp", "f_rati_1.htm"],
+ \["read", "f_rd_rd.htm"],
+ \["read-byte", "f_rd_by.htm"],
+ \["read-char", "f_rd_cha.htm"],
+ \["read-char-no-hang", "f_rd_c_1.htm"],
+ \["read-delimited-list", "f_rd_del.htm"],
+ \["read-from-string", "f_rd_fro.htm"],
+ \["read-line", "f_rd_lin.htm"],
+ \["read-preserving-whitespace", "f_rd_rd.htm"],
+ \["read-sequence", "f_rd_seq.htm"],
+ \["reader-error", "e_rder_e.htm"],
+ \["readtable", "t_rdtabl.htm"],
+ \["readtable-case", "f_rdtabl.htm"],
+ \["readtablep", "f_rdta_1.htm"],
+ \["real", "t_real.htm"],
+ \["realp", "f_realp.htm"],
+ \["realpart", "f_realpa.htm"],
+ \["reduce", "f_reduce.htm"],
+ \["reinitialize-instance", "f_reinit.htm"],
+ \["rem", "f_mod_r.htm"],
+ \["remf", "m_remf.htm"],
+ \["remhash", "f_remhas.htm"],
+ \["remove", "f_rm_rm.htm"],
+ \["remove-duplicates", "f_rm_dup.htm"],
+ \["remove-if", "f_rm_rm.htm"],
+ \["remove-if-not", "f_rm_rm.htm"],
+ \["remove-method", "f_rm_met.htm"],
+ \["remprop", "f_rempro.htm"],
+ \["rename-file", "f_rn_fil.htm"],
+ \["rename-package", "f_rn_pkg.htm"],
+ \["replace", "f_replac.htm"],
+ \["require", "f_provid.htm"],
+ \["rest", "f_rest.htm"],
+ \["restart", "t_rst.htm"],
+ \["restart-bind", "m_rst_bi.htm"],
+ \["restart-case", "m_rst_ca.htm"],
+ \["restart-name", "f_rst_na.htm"],
+ \["return", "m_return.htm"],
+ \["return-from", "s_ret_fr.htm"],
+ \["revappend", "f_revapp.htm"],
+ \["reverse", "f_revers.htm"],
+ \["room", "f_room.htm"],
+ \["rotatef", "m_rotate.htm"],
+ \["round", "f_floorc.htm"],
+ \["row-major-aref", "f_row_ma.htm"],
+ \["rplaca", "f_rplaca.htm"],
+ \["rplacd", "f_rplaca.htm"],
+ \["safety", "d_optimi.htm"],
+ \["satisfies", "t_satisf.htm"],
+ \["sbit", "f_bt_sb.htm"],
+ \["scale-float", "f_dec_fl.htm"],
+ \["schar", "f_char_.htm"],
+ \["search", "f_search.htm"],
+ \["second", "f_firstc.htm"],
+ \["sequence", "t_seq.htm"],
+ \["serious-condition", "e_seriou.htm"],
+ \["set", "f_set.htm"],
+ \["set-difference", "f_set_di.htm"],
+ \["set-dispatch-macro-character", "f_set__1.htm"],
+ \["set-exclusive-or", "f_set_ex.htm"],
+ \["set-macro-character", "f_set_ma.htm"],
+ \["set-pprint-dispatch", "f_set_pp.htm"],
+ \["set-syntax-from-char", "f_set_sy.htm"],
+ \["setf", "a_setf.htm"],
+ \["setq", "s_setq.htm"],
+ \["seventh", "f_firstc.htm"],
+ \["shadow", "f_shadow.htm"],
+ \["shadowing-import", "f_shdw_i.htm"],
+ \["shared-initialize", "f_shared.htm"],
+ \["shiftf", "m_shiftf.htm"],
+ \["short-float", "t_short_.htm"],
+ \["short-float-epsilon", "v_short_.htm"],
+ \["short-float-negative-epsilon", "v_short_.htm"],
+ \["short-site-name", "f_short_.htm"],
+ \["signal", "f_signal.htm"],
+ \["signed-byte", "t_sgn_by.htm"],
+ \["signum", "f_signum.htm"],
+ \["simple-array", "t_smp_ar.htm"],
+ \["simple-base-string", "t_smp_ba.htm"],
+ \["simple-bit-vector", "t_smp_bt.htm"],
+ \["simple-bit-vector-p", "f_smp_bt.htm"],
+ \["simple-condition", "e_smp_cn.htm"],
+ \["simple-condition-format-arguments", "f_smp_cn.htm"],
+ \["simple-condition-format-control", "f_smp_cn.htm"],
+ \["simple-error", "e_smp_er.htm"],
+ \["simple-string", "t_smp_st.htm"],
+ \["simple-string-p", "f_smp_st.htm"],
+ \["simple-type-error", "e_smp_tp.htm"],
+ \["simple-vector", "t_smp_ve.htm"],
+ \["simple-vector-p", "f_smp_ve.htm"],
+ \["simple-warning", "e_smp_wa.htm"],
+ \["sin", "f_sin_c.htm"],
+ \["single-float", "t_short_.htm"],
+ \["single-float-epsilon", "v_short_.htm"],
+ \["single-float-negative-epsilon", "v_short_.htm"],
+ \["sinh", "f_sinh_.htm"],
+ \["sixth", "f_firstc.htm"],
+ \["sleep", "f_sleep.htm"],
+ \["slot-boundp", "f_slt_bo.htm"],
+ \["slot-exists-p", "f_slt_ex.htm"],
+ \["slot-makunbound", "f_slt_ma.htm"],
+ \["slot-missing", "f_slt_mi.htm"],
+ \["slot-unbound", "f_slt_un.htm"],
+ \["slot-value", "f_slt_va.htm"],
+ \["software-type", "f_sw_tpc.htm"],
+ \["software-version", "f_sw_tpc.htm"],
+ \["some", "f_everyc.htm"],
+ \["sort", "f_sort_.htm"],
+ \["space", "d_optimi.htm"],
+ \["special", "d_specia.htm"],
+ \["special-operator-p", "f_specia.htm"],
+ \["speed", "d_optimi.htm"],
+ \["sqrt", "f_sqrt_.htm"],
+ \["stable-sort", "f_sort_.htm"],
+ \["standard", "07_ffb.htm"],
+ \["standard-char", "t_std_ch.htm"],
+ \["standard-char-p", "f_std_ch.htm"],
+ \["standard-class", "t_std_cl.htm"],
+ \["standard-generic-function", "t_std_ge.htm"],
+ \["standard-method", "t_std_me.htm"],
+ \["standard-object", "t_std_ob.htm"],
+ \["step", "m_step.htm"],
+ \["storage-condition", "e_storag.htm"],
+ \["store-value", "a_store_.htm"],
+ \["stream", "t_stream.htm"],
+ \["stream-element-type", "f_stm_el.htm"],
+ \["stream-error", "e_stm_er.htm"],
+ \["stream-error-stream", "f_stm_er.htm"],
+ \["stream-external-format", "f_stm_ex.htm"],
+ \["streamp", "f_stmp.htm"],
+ \["string", "a_string.htm"],
+ \["string-capitalize", "f_stg_up.htm"],
+ \["string-downcase", "f_stg_up.htm"],
+ \["string-equal", "f_stgeq_.htm"],
+ \["string-greaterp", "f_stgeq_.htm"],
+ \["string-left-trim", "f_stg_tr.htm"],
+ \["string-lessp", "f_stgeq_.htm"],
+ \["string-not-equal", "f_stgeq_.htm"],
+ \["string-not-greaterp", "f_stgeq_.htm"],
+ \["string-not-lessp", "f_stgeq_.htm"],
+ \["string-right-trim", "f_stg_tr.htm"],
+ \["string-stream", "t_stg_st.htm"],
+ \["string-trim", "f_stg_tr.htm"],
+ \["string-upcase", "f_stg_up.htm"],
+ \["string/=", "f_stgeq_.htm"],
+ \["string<", "f_stgeq_.htm"],
+ \["string<=", "f_stgeq_.htm"],
+ \["string=", "f_stgeq_.htm"],
+ \["string>", "f_stgeq_.htm"],
+ \["string>=", "f_stgeq_.htm"],
+ \["stringp", "f_stgp.htm"],
+ \["structure", "f_docume.htm"],
+ \["structure-class", "t_stu_cl.htm"],
+ \["structure-object", "t_stu_ob.htm"],
+ \["style-warning", "e_style_.htm"],
+ \["sublis", "f_sublis.htm"],
+ \["subseq", "f_subseq.htm"],
+ \["subsetp", "f_subset.htm"],
+ \["subst", "f_substc.htm"],
+ \["subst-if", "f_substc.htm"],
+ \["subst-if-not", "f_substc.htm"],
+ \["substitute", "f_sbs_s.htm"],
+ \["substitute-if", "f_sbs_s.htm"],
+ \["substitute-if-not", "f_sbs_s.htm"],
+ \["subtypep", "f_subtpp.htm"],
+ \["svref", "f_svref.htm"],
+ \["sxhash", "f_sxhash.htm"],
+ \["symbol", "t_symbol.htm"],
+ \["symbol-function", "f_symb_1.htm"],
+ \["symbol-macrolet", "s_symbol.htm"],
+ \["symbol-name", "f_symb_2.htm"],
+ \["symbol-package", "f_symb_3.htm"],
+ \["symbol-plist", "f_symb_4.htm"],
+ \["symbol-value", "f_symb_5.htm"],
+ \["symbolp", "f_symbol.htm"],
+ \["synonym-stream", "t_syn_st.htm"],
+ \["synonym-stream-symbol", "f_syn_st.htm"],
+ \["t", "a_t.htm"],
+ \["tagbody", "s_tagbod.htm"],
+ \["tailp", "f_ldiffc.htm"],
+ \["tan", "f_sin_c.htm"],
+ \["tanh", "f_sinh_.htm"],
+ \["tenth", "f_firstc.htm"],
+ \["terpri", "f_terpri.htm"],
+ \["the", "s_the.htm"],
+ \["third", "f_firstc.htm"],
+ \["throw", "s_throw.htm"],
+ \["time", "m_time.htm"],
+ \["trace", "m_tracec.htm"],
+ \["translate-logical-pathname", "f_tr_log.htm"],
+ \["translate-pathname", "f_tr_pn.htm"],
+ \["tree-equal", "f_tree_e.htm"],
+ \["truename", "f_tn.htm"],
+ \["truncate", "f_floorc.htm"],
+ \["two-way-stream", "t_two_wa.htm"],
+ \["two-way-stream-input-stream", "f_two_wa.htm"],
+ \["two-way-stream-output-stream", "f_two_wa.htm"],
+ \["type", "a_type.htm"],
+ \["type-error", "e_tp_err.htm"],
+ \["type-error-datum", "f_tp_err.htm"],
+ \["type-error-expected-type", "f_tp_err.htm"],
+ \["type-of", "f_tp_of.htm"],
+ \["typecase", "m_tpcase.htm"],
+ \["typep", "f_typep.htm"],
+ \["unbound-slot", "e_unboun.htm"],
+ \["unbound-slot-instance", "f_unboun.htm"],
+ \["unbound-variable", "e_unbo_1.htm"],
+ \["undefined-function", "e_undefi.htm"],
+ \["unexport", "f_unexpo.htm"],
+ \["unintern", "f_uninte.htm"],
+ \["union", "f_unionc.htm"],
+ \["unless", "m_when_.htm"],
+ \["unread-char", "f_unrd_c.htm"],
+ \["unsigned-byte", "t_unsgn_.htm"],
+ \["untrace", "m_tracec.htm"],
+ \["unuse-package", "f_unuse_.htm"],
+ \["unwind-protect", "s_unwind.htm"],
+ \["update-instance-for-different-class", "f_update.htm"],
+ \["update-instance-for-redefined-class", "f_upda_1.htm"],
+ \["upgraded-array-element-type", "f_upgr_1.htm"],
+ \["upgraded-complex-part-type", "f_upgrad.htm"],
+ \["upper-case-p", "f_upper_.htm"],
+ \["use-package", "f_use_pk.htm"],
+ \["use-value", "a_use_va.htm"],
+ \["user-homedir-pathname", "f_user_h.htm"],
+ \["values", "a_values.htm"],
+ \["values-list", "f_vals_l.htm"],
+ \["variable", "f_docume.htm"],
+ \["vector", "a_vector.htm"],
+ \["vector-pop", "f_vec_po.htm"],
+ \["vector-push", "f_vec_ps.htm"],
+ \["vector-push-extend", "f_vec_ps.htm"],
+ \["vectorp", "f_vecp.htm"],
+ \["warn", "f_warn.htm"],
+ \["warning", "e_warnin.htm"],
+ \["when", "m_when_.htm"],
+ \["wild-pathname-p", "f_wild_p.htm"],
+ \["with-accessors", "m_w_acce.htm"],
+ \["with-compilation-unit", "m_w_comp.htm"],
+ \["with-condition-restarts", "m_w_cnd_.htm"],
+ \["with-hash-table-iterator", "m_w_hash.htm"],
+ \["with-input-from-string", "m_w_in_f.htm"],
+ \["with-open-file", "m_w_open.htm"],
+ \["with-open-stream", "m_w_op_1.htm"],
+ \["with-output-to-string", "m_w_out_.htm"],
+ \["with-package-iterator", "m_w_pkg_.htm"],
+ \["with-simple-restart", "m_w_smp_.htm"],
+ \["with-slots", "m_w_slts.htm"],
+ \["with-standard-io-syntax", "m_w_std_.htm"],
+ \["write", "f_wr_pr.htm"],
+ \["write-byte", "f_wr_by.htm"],
+ \["write-char", "f_wr_cha.htm"],
+ \["write-line", "f_wr_stg.htm"],
+ \["write-sequence", "f_wr_seq.htm"],
+ \["write-string", "f_wr_stg.htm"],
+ \["write-to-string", "f_wr_to_.htm"],
+ \["y-or-n-p", "f_y_or_n.htm"],
+ \["yes-or-no-p", "f_y_or_n.htm"],
+ \["zerop", "f_zerop.htm"]]
+endif
+
+if !exists( 'g:slimv_clhs_issues' )
+ let g:slimv_clhs_issues = [
+ \["&environment-binding-order:first", "iss001.htm"],
+ \["access-error-name", "iss002.htm"],
+ \["adjust-array-displacement", "iss003.htm"],
+ \["adjust-array-fill-pointer", "iss004.htm"],
+ \["adjust-array-not-adjustable:implicit-copy", "iss005.htm"],
+ \["allocate-instance:add", "iss006.htm"],
+ \["allow-local-inline:inline-notinline", "iss007.htm"],
+ \["allow-other-keys-nil:permit", "iss008.htm"],
+ \["aref-1d", "iss009.htm"],
+ \["argument-mismatch-error-again:consistent", "iss010.htm"],
+ \["argument-mismatch-error-moon:fix", "iss011.htm"],
+ \["argument-mismatch-error:more-clarifications", "iss012.htm"],
+ \["arguments-underspecified:specify", "iss013.htm"],
+ \["array-dimension-limit-implications:all-fixnum", "iss014.htm"],
+ \["array-type-element-type-semantics:unify-upgrading", "iss015.htm"],
+ \["assert-error-type:error", "iss016.htm"],
+ \["assoc-rassoc-if-key", "iss017.htm"],
+ \["assoc-rassoc-if-key:yes", "iss018.htm"],
+ \["boa-aux-initialization:error-on-read", "iss019.htm"],
+ \["break-on-warnings-obsolete:remove", "iss020.htm"],
+ \["broadcast-stream-return-values:clarify-minimally", "iss021.htm"],
+ \["butlast-negative:should-signal", "iss022.htm"],
+ \["change-class-initargs:permit", "iss023.htm"],
+ \["char-name-case:x3j13-mar-91", "iss024.htm"],
+ \["character-loose-ends:fix", "iss025.htm"],
+ \["character-proposal:2", "iss026.htm"],
+ \["character-proposal:2-1-1", "iss027.htm"],
+ \["character-proposal:2-1-2", "iss028.htm"],
+ \["character-proposal:2-2-1", "iss029.htm"],
+ \["character-proposal:2-3-1", "iss030.htm"],
+ \["character-proposal:2-3-2", "iss031.htm"],
+ \["character-proposal:2-3-3", "iss032.htm"],
+ \["character-proposal:2-3-4", "iss033.htm"],
+ \["character-proposal:2-3-5", "iss034.htm"],
+ \["character-proposal:2-3-6", "iss035.htm"],
+ \["character-proposal:2-4-1", "iss036.htm"],
+ \["character-proposal:2-4-2", "iss037.htm"],
+ \["character-proposal:2-4-3", "iss038.htm"],
+ \["character-proposal:2-5-2", "iss039.htm"],
+ \["character-proposal:2-5-6", "iss040.htm"],
+ \["character-proposal:2-5-7", "iss041.htm"],
+ \["character-proposal:2-6-1", "iss042.htm"],
+ \["character-proposal:2-6-2", "iss043.htm"],
+ \["character-proposal:2-6-3", "iss044.htm"],
+ \["character-proposal:2-6-5", "iss045.htm"],
+ \["character-vs-char:less-inconsistent-short", "iss046.htm"],
+ \["class-object-specializer:affirm", "iss047.htm"],
+ \["clos-conditions-again:allow-subset", "iss048.htm"],
+ \["clos-conditions:integrate", "iss049.htm"],
+ \["clos-error-checking-order:no-applicable-method-first", "iss050.htm"],
+ \["clos-macro-compilation:minimal", "iss051.htm"],
+ \["close-constructed-stream:argument-stream-only", "iss052.htm"],
+ \["closed-stream-operations:allow-inquiry", "iss053.htm"],
+ \["coercing-setf-name-to-function:all-function-names", "iss054.htm"],
+ \["colon-number", "iss055.htm"],
+ \["common-features:specify", "iss056.htm"],
+ \["common-type:remove", "iss057.htm"],
+ \["compile-argument-problems-again:fix", "iss058.htm"],
+ \["compile-file-handling-of-top-level-forms:clarify", "iss059.htm"],
+ \["compile-file-output-file-defaults:input-file", "iss060.htm"],
+ \["compile-file-package", "iss061.htm"],
+ \["compile-file-pathname-arguments:make-consistent", "iss062.htm"],
+ \["compile-file-symbol-handling:new-require-consistency", "iss063.htm"],
+ \["compiled-function-requirements:tighten", "iss064.htm"],
+ \["compiler-diagnostics:use-handler", "iss065.htm"],
+ \["compiler-let-confusion:eliminate", "iss066.htm"],
+ \["compiler-verbosity:like-load", "iss067.htm"],
+ \["compiler-warning-stream", "iss068.htm"],
+ \["complex-atan-branch-cut:tweak", "iss069.htm"],
+ \["complex-atanh-bogus-formula:tweak-more", "iss070.htm"],
+ \["complex-rational-result:extend", "iss071.htm"],
+ \["compute-applicable-methods:generic", "iss072.htm"],
+ \["concatenate-sequence:signal-error", "iss073.htm"],
+ \["condition-accessors-setfable:no", "iss074.htm"],
+ \["condition-restarts:buggy", "iss075.htm"],
+ \["condition-restarts:permit-association", "iss076.htm"],
+ \["condition-slots:hidden", "iss077.htm"],
+ \["cons-type-specifier:add", "iss078.htm"],
+ \["constant-circular-compilation:yes", "iss079.htm"],
+ \["constant-collapsing:generalize", "iss080.htm"],
+ \["constant-compilable-types:specify", "iss081.htm"],
+ \["constant-function-compilation:no", "iss082.htm"],
+ \["constant-modification:disallow", "iss083.htm"],
+ \["constantp-definition:intentional", "iss084.htm"],
+ \["constantp-environment:add-arg", "iss085.htm"],
+ \["contagion-on-numerical-comparisons:transitive", "iss086.htm"],
+ \["copy-symbol-copy-plist:copy-list", "iss087.htm"],
+ \["copy-symbol-print-name:equal", "iss088.htm"],
+ \["data-io:add-support", "iss089.htm"],
+ \["data-types-hierarchy-underspecified", "iss090.htm"],
+ \["debugger-hook-vs-break:clarify", "iss091.htm"],
+ \["declaration-scope:no-hoisting", "iss092.htm"],
+ \["declare-array-type-element-references:restrictive", "iss093.htm"],
+ \["declare-function-ambiguity:delete-ftype-abbreviation", "iss094.htm"],
+ \["declare-macros:flush", "iss095.htm"],
+ \["declare-type-free:lexical", "iss096.htm"],
+ \["decls-and-doc", "iss097.htm"],
+ \["decode-universal-time-daylight:like-encode", "iss098.htm"],
+ \["defconstant-special:no", "iss099.htm"],
+ \["defgeneric-declare:allow-multiple", "iss100.htm"],
+ \["define-compiler-macro:x3j13-nov89", "iss101.htm"],
+ \["define-condition-syntax:incompatibly-more-like-defclass+emphasize-read-only", "iss102.htm"],
+ \["define-method-combination-behavior:clarify", "iss103.htm"],
+ \["defining-macros-non-top-level:allow", "iss104.htm"],
+ \["defmacro-block-scope:excludes-bindings", "iss105.htm"],
+ \["defmacro-lambda-list:tighten-description", "iss106.htm"],
+ \["defmethod-declaration-scope:corresponds-to-bindings", "iss107.htm"],
+ \["defpackage:addition", "iss108.htm"],
+ \["defstruct-constructor-key-mixture:allow-key", "iss109.htm"],
+ \["defstruct-constructor-options:explicit", "iss110.htm"],
+ \["defstruct-constructor-slot-variables:not-bound", "iss111.htm"],
+ \["defstruct-copier-argument-type:restrict", "iss112.htm"],
+ \["defstruct-copier:argument-type", "iss113.htm"],
+ \["defstruct-default-value-evaluation:iff-needed", "iss114.htm"],
+ \["defstruct-include-deftype:explicitly-undefined", "iss115.htm"],
+ \["defstruct-print-function-again:x3j13-mar-93", "iss116.htm"],
+ \["defstruct-print-function-inheritance:yes", "iss117.htm"],
+ \["defstruct-redefinition:error", "iss118.htm"],
+ \["defstruct-slots-constraints-name:duplicates-error", "iss119.htm"],
+ \["defstruct-slots-constraints-number", "iss120.htm"],
+ \["deftype-destructuring:yes", "iss121.htm"],
+ \["deftype-key:allow", "iss122.htm"],
+ \["defvar-documentation:unevaluated", "iss123.htm"],
+ \["defvar-init-time:not-delayed", "iss124.htm"],
+ \["defvar-initialization:conservative", "iss125.htm"],
+ \["deprecation-position:limited", "iss126.htm"],
+ \["describe-interactive:no", "iss127.htm"],
+ \["describe-underspecified:describe-object", "iss128.htm"],
+ \["destructive-operations:specify", "iss129.htm"],
+ \["destructuring-bind:new-macro", "iss130.htm"],
+ \["disassemble-side-effect:do-not-install", "iss131.htm"],
+ \["displaced-array-predicate:add", "iss132.htm"],
+ \["do-symbols-block-scope:entire-form", "iss133.htm"],
+ \["do-symbols-duplicates", "iss134.htm"],
+ \["documentation-function-bugs:fix", "iss135.htm"],
+ \["documentation-function-tangled:require-argument", "iss136.htm"],
+ \["dotimes-ignore:x3j13-mar91", "iss137.htm"],
+ \["dotted-list-arguments:clarify", "iss138.htm"],
+ \["dotted-macro-forms:allow", "iss139.htm"],
+ \["dribble-technique", "iss140.htm"],
+ \["dynamic-extent-function:extend", "iss141.htm"],
+ \["dynamic-extent:new-declaration", "iss142.htm"],
+ \["equal-structure:maybe-status-quo", "iss143.htm"],
+ \["error-terminology-warning:might", "iss144.htm"],
+ \["eval-other:self-evaluate", "iss145.htm"],
+ \["eval-top-level:load-like-compile-file", "iss146.htm"],
+ \["eval-when-non-top-level:generalize-eval-new-keywords", "iss147.htm"],
+ \["eval-when-obsolete-keywords:x3j13-mar-1993", "iss148.htm"],
+ \["evalhook-step-confusion:fix", "iss149.htm"],
+ \["evalhook-step-confusion:x3j13-nov-89", "iss150.htm"],
+ \["exit-extent-and-condition-system:like-dynamic-bindings", "iss151.htm"],
+ \["exit-extent:minimal", "iss152.htm"],
+ \["expt-ratio:p.211", "iss153.htm"],
+ \["extensions-position:documentation", "iss154.htm"],
+ \["external-format-for-every-file-connection:minimum", "iss155.htm"],
+ \["extra-return-values:no", "iss156.htm"],
+ \["file-open-error:signal-file-error", "iss157.htm"],
+ \["fixnum-non-portable:tighten-definition", "iss158.htm"],
+ \["flet-declarations", "iss159.htm"],
+ \["flet-declarations:allow", "iss160.htm"],
+ \["flet-implicit-block:yes", "iss161.htm"],
+ \["float-underflow:add-variables", "iss162.htm"],
+ \["floating-point-condition-names:x3j13-nov-89", "iss163.htm"],
+ \["format-atsign-colon", "iss164.htm"],
+ \["format-colon-uparrow-scope", "iss165.htm"],
+ \["format-comma-interval", "iss166.htm"],
+ \["format-e-exponent-sign:force-sign", "iss167.htm"],
+ \["format-op-c", "iss168.htm"],
+ \["format-pretty-print:yes", "iss169.htm"],
+ \["format-string-arguments:specify", "iss170.htm"],
+ \["function-call-evaluation-order:more-unspecified", "iss171.htm"],
+ \["function-composition:jan89-x3j13", "iss172.htm"],
+ \["function-definition:jan89-x3j13", "iss173.htm"],
+ \["function-name:large", "iss174.htm"],
+ \["function-type", "iss175.htm"],
+ \["function-type-argument-type-semantics:restrictive", "iss176.htm"],
+ \["function-type-key-name:specify-keyword", "iss177.htm"],
+ \["function-type-rest-list-element:use-actual-argument-type", "iss178.htm"],
+ \["function-type:x3j13-march-88", "iss179.htm"],
+ \["generalize-pretty-printer:unify", "iss180.htm"],
+ \["generic-flet-poorly-designed:delete", "iss181.htm"],
+ \["gensym-name-stickiness:like-teflon", "iss182.htm"],
+ \["gentemp-bad-idea:deprecate", "iss183.htm"],
+ \["get-macro-character-readtable:nil-standard", "iss184.htm"],
+ \["get-setf-method-environment:add-arg", "iss185.htm"],
+ \["hash-table-access:x3j13-mar-89", "iss186.htm"],
+ \["hash-table-key-modification:specify", "iss187.htm"],
+ \["hash-table-package-generators:add-with-wrapper", "iss188.htm"],
+ \["hash-table-rehash-size-integer", "iss189.htm"],
+ \["hash-table-size:intended-entries", "iss190.htm"],
+ \["hash-table-tests:add-equalp", "iss191.htm"],
+ \["ieee-atan-branch-cut:split", "iss192.htm"],
+ \["ignore-use-terminology:value-only", "iss193.htm"],
+ \["import-setf-symbol-package", "iss194.htm"],
+ \["in-package-functionality:mar89-x3j13", "iss195.htm"],
+ \["in-syntax:minimal", "iss196.htm"],
+ \["initialization-function-keyword-checking", "iss197.htm"],
+ \["iso-compatibility:add-substrate", "iss198.htm"],
+ \["jun90-trivial-issues:11", "iss199.htm"],
+ \["jun90-trivial-issues:14", "iss200.htm"],
+ \["jun90-trivial-issues:24", "iss201.htm"],
+ \["jun90-trivial-issues:25", "iss202.htm"],
+ \["jun90-trivial-issues:27", "iss203.htm"],
+ \["jun90-trivial-issues:3", "iss204.htm"],
+ \["jun90-trivial-issues:4", "iss205.htm"],
+ \["jun90-trivial-issues:5", "iss206.htm"],
+ \["jun90-trivial-issues:9", "iss207.htm"],
+ \["keyword-argument-name-package:any", "iss208.htm"],
+ \["last-n", "iss209.htm"],
+ \["lcm-no-arguments:1", "iss210.htm"],
+ \["lexical-construct-global-definition:undefined", "iss211.htm"],
+ \["lisp-package-name:common-lisp", "iss212.htm"],
+ \["lisp-symbol-redefinition-again:more-fixes", "iss213.htm"],
+ \["lisp-symbol-redefinition:mar89-x3j13", "iss214.htm"],
+ \["load-objects:make-load-form", "iss215.htm"],
+ \["load-time-eval:r**2-new-special-form", "iss216.htm"],
+ \["load-time-eval:r**3-new-special-form", "iss217.htm"],
+ \["load-truename:new-pathname-variables", "iss218.htm"],
+ \["locally-top-level:special-form", "iss219.htm"],
+ \["loop-and-discrepancy:no-reiteration", "iss220.htm"],
+ \["loop-for-as-on-typo:fix-typo", "iss221.htm"],
+ \["loop-initform-environment:partial-interleaving-vague", "iss222.htm"],
+ \["loop-miscellaneous-repairs:fix", "iss223.htm"],
+ \["loop-named-block-nil:override", "iss224.htm"],
+ \["loop-present-symbols-typo:flush-wrong-words", "iss225.htm"],
+ \["loop-syntax-overhaul:repair", "iss226.htm"],
+ \["macro-as-function:disallow", "iss227.htm"],
+ \["macro-declarations:make-explicit", "iss228.htm"],
+ \["macro-environment-extent:dynamic", "iss229.htm"],
+ \["macro-function-environment", "iss230.htm"],
+ \["macro-function-environment:yes", "iss231.htm"],
+ \["macro-subforms-top-level-p:add-constraints", "iss232.htm"],
+ \["macroexpand-hook-default:explicitly-vague", "iss233.htm"],
+ \["macroexpand-hook-initial-value:implementation-dependent", "iss234.htm"],
+ \["macroexpand-return-value:true", "iss235.htm"],
+ \["make-load-form-confusion:rewrite", "iss236.htm"],
+ \["make-load-form-saving-slots:no-initforms", "iss237.htm"],
+ \["make-package-use-default:implementation-dependent", "iss238.htm"],
+ \["map-into:add-function", "iss239.htm"],
+ \["mapping-destructive-interaction:explicitly-vague", "iss240.htm"],
+ \["metaclass-of-system-class:unspecified", "iss241.htm"],
+ \["method-combination-arguments:clarify", "iss242.htm"],
+ \["method-initform:forbid-call-next-method", "iss243.htm"],
+ \["muffle-warning-condition-argument", "iss244.htm"],
+ \["multiple-value-setq-order:like-setf-of-values", "iss245.htm"],
+ \["multiple-values-limit-on-variables:undefined", "iss246.htm"],
+ \["nintersection-destruction", "iss247.htm"],
+ \["nintersection-destruction:revert", "iss248.htm"],
+ \["not-and-null-return-value:x3j13-mar-93", "iss249.htm"],
+ \["nth-value:add", "iss250.htm"],
+ \["optimize-debug-info:new-quality", "iss251.htm"],
+ \["package-clutter:reduce", "iss252.htm"],
+ \["package-deletion:new-function", "iss253.htm"],
+ \["package-function-consistency:more-permissive", "iss254.htm"],
+ \["parse-error-stream:split-types", "iss255.htm"],
+ \["pathname-component-case:keyword-argument", "iss256.htm"],
+ \["pathname-component-value:specify", "iss257.htm"],
+ \["pathname-host-parsing:recognize-logical-host-names", "iss258.htm"],
+ \["pathname-logical:add", "iss259.htm"],
+ \["pathname-print-read:sharpsign-p", "iss260.htm"],
+ \["pathname-stream", "iss261.htm"],
+ \["pathname-stream:files-or-synonym", "iss262.htm"],
+ \["pathname-subdirectory-list:new-representation", "iss263.htm"],
+ \["pathname-symbol", "iss264.htm"],
+ \["pathname-syntax-error-time:explicitly-vague", "iss265.htm"],
+ \["pathname-unspecific-component:new-token", "iss266.htm"],
+ \["pathname-wild:new-functions", "iss267.htm"],
+ \["peek-char-read-char-echo:first-read-char", "iss268.htm"],
+ \["plist-duplicates:allow", "iss269.htm"],
+ \["pretty-print-interface", "iss270.htm"],
+ \["princ-readably:x3j13-dec-91", "iss271.htm"],
+ \["print-case-behavior:clarify", "iss272.htm"],
+ \["print-case-print-escape-interaction:vertical-bar-rule-no-upcase", "iss273.htm"],
+ \["print-circle-shared:respect-print-circle", "iss274.htm"],
+ \["print-circle-structure:user-functions-work", "iss275.htm"],
+ \["print-readably-behavior:clarify", "iss276.htm"],
+ \["printer-whitespace:just-one-space", "iss277.htm"],
+ \["proclaim-etc-in-compile-file:new-macro", "iss278.htm"],
+ \["push-evaluation-order:first-item", "iss279.htm"],
+ \["push-evaluation-order:item-first", "iss280.htm"],
+ \["pushnew-store-required:unspecified", "iss281.htm"],
+ \["quote-semantics:no-copying", "iss282.htm"],
+ \["range-of-count-keyword:nil-or-integer", "iss283.htm"],
+ \["range-of-start-and-end-parameters:integer-and-integer-nil", "iss284.htm"],
+ \["read-and-write-bytes:new-functions", "iss285.htm"],
+ \["read-case-sensitivity:readtable-keywords", "iss286.htm"],
+ \["read-modify-write-evaluation-order:delayed-access-stores", "iss287.htm"],
+ \["read-suppress-confusing:generalize", "iss288.htm"],
+ \["reader-error:new-type", "iss289.htm"],
+ \["real-number-type:x3j13-mar-89", "iss290.htm"],
+ \["recursive-deftype:explicitly-vague", "iss291.htm"],
+ \["reduce-argument-extraction", "iss292.htm"],
+ \["remf-destruction-unspecified:x3j13-mar-89", "iss293.htm"],
+ \["require-pathname-defaults-again:x3j13-dec-91", "iss294.htm"],
+ \["require-pathname-defaults-yet-again:restore-argument", "iss295.htm"],
+ \["require-pathname-defaults:eliminate", "iss296.htm"],
+ \["rest-list-allocation:may-share", "iss297.htm"],
+ \["result-lists-shared:specify", "iss298.htm"],
+ \["return-values-unspecified:specify", "iss299.htm"],
+ \["room-default-argument:new-value", "iss300.htm"],
+ \["self-modifying-code:forbid", "iss301.htm"],
+ \["sequence-type-length:must-match", "iss302.htm"],
+ \["setf-apply-expansion:ignore-expander", "iss303.htm"],
+ \["setf-find-class:allow-nil", "iss304.htm"],
+ \["setf-functions-again:minimal-changes", "iss305.htm"],
+ \["setf-get-default:evaluated-but-ignored", "iss306.htm"],
+ \["setf-macro-expansion:last", "iss307.htm"],
+ \["setf-method-vs-setf-method:rename-old-terms", "iss308.htm"],
+ \["setf-multiple-store-variables:allow", "iss309.htm"],
+ \["setf-of-apply:only-aref-and-friends", "iss310.htm"],
+ \["setf-of-values:add", "iss311.htm"],
+ \["setf-sub-methods:delayed-access-stores", "iss312.htm"],
+ \["shadow-already-present", "iss313.htm"],
+ \["shadow-already-present:works", "iss314.htm"],
+ \["sharp-comma-confusion:remove", "iss315.htm"],
+ \["sharp-o-foobar:consequences-undefined", "iss316.htm"],
+ \["sharp-star-delimiter:normal-delimiter", "iss317.htm"],
+ \["sharpsign-plus-minus-package:keyword", "iss318.htm"],
+ \["slot-missing-values:specify", "iss319.htm"],
+ \["slot-value-metaclasses:less-minimal", "iss320.htm"],
+ \["special-form-p-misnomer:rename", "iss321.htm"],
+ \["special-type-shadowing:clarify", "iss322.htm"],
+ \["standard-input-initial-binding:defined-contracts", "iss323.htm"],
+ \["standard-repertoire-gratuitous:rename", "iss324.htm"],
+ \["step-environment:current", "iss325.htm"],
+ \["step-minimal:permit-progn", "iss326.htm"],
+ \["stream-access:add-types-accessors", "iss327.htm"],
+ \["stream-capabilities:interactive-stream-p", "iss328.htm"],
+ \["string-coercion:make-consistent", "iss329.htm"],
+ \["string-output-stream-bashing:undefined", "iss330.htm"],
+ \["structure-read-print-syntax:keywords", "iss331.htm"],
+ \["subseq-out-of-bounds", "iss332.htm"],
+ \["subseq-out-of-bounds:is-an-error", "iss333.htm"],
+ \["subsetting-position:none", "iss334.htm"],
+ \["subtypep-environment:add-arg", "iss335.htm"],
+ \["subtypep-too-vague:clarify-more", "iss336.htm"],
+ \["sxhash-definition:similar-for-sxhash", "iss337.htm"],
+ \["symbol-macrolet-declare:allow", "iss338.htm"],
+ \["symbol-macrolet-semantics:special-form", "iss339.htm"],
+ \["symbol-macrolet-type-declaration:no", "iss340.htm"],
+ \["symbol-macros-and-proclaimed-specials:signals-an-error", "iss341.htm"],
+ \["symbol-print-escape-behavior:clarify", "iss342.htm"],
+ \["syntactic-environment-access:retracted-mar91", "iss343.htm"],
+ \["tagbody-tag-expansion:no", "iss344.htm"],
+ \["tailp-nil:t", "iss345.htm"],
+ \["test-not-if-not:flush-all", "iss346.htm"],
+ \["the-ambiguity:for-declaration", "iss347.htm"],
+ \["the-values:return-number-received", "iss348.htm"],
+ \["time-zone-non-integer:allow", "iss349.htm"],
+ \["type-declaration-abbreviation:allow-all", "iss350.htm"],
+ \["type-of-and-predefined-classes:type-of-handles-floats", "iss351.htm"],
+ \["type-of-and-predefined-classes:unify-and-extend", "iss352.htm"],
+ \["type-of-underconstrained:add-constraints", "iss353.htm"],
+ \["type-specifier-abbreviation:x3j13-jun90-guess", "iss354.htm"],
+ \["undefined-variables-and-functions:compromise", "iss355.htm"],
+ \["uninitialized-elements:consequences-undefined", "iss356.htm"],
+ \["unread-char-after-peek-char:dont-allow", "iss357.htm"],
+ \["unsolicited-messages:not-to-system-user-streams", "iss358.htm"],
+ \["variable-list-asymmetry:symmetrize", "iss359.htm"],
+ \["with-added-methods:delete", "iss360.htm"],
+ \["with-compilation-unit:new-macro", "iss361.htm"],
+ \["with-open-file-does-not-exist:stream-is-nil", "iss362.htm"],
+ \["with-open-file-setq:explicitly-vague", "iss363.htm"],
+ \["with-open-file-stream-extent:dynamic-extent", "iss364.htm"],
+ \["with-output-to-string-append-style:vector-push-extend", "iss365.htm"],
+ \["with-standard-io-syntax-readtable:x3j13-mar-91", "iss366.htm"]]
+endif
+
+if !exists( 'g:slimv_clhs_chapters' )
+ let g:slimv_clhs_chapters = [
+ \["[index]", "../Front/Contents.htm"],
+ \["[introduction]", "01_.htm"],
+ \["[syntax]", "02_.htm"],
+ \["[evaluation and compilation]", "03_.htm"],
+ \["[types and classes]", "04_.htm"],
+ \["[data and control flow]", "05_.htm"],
+ \["[iteration]", "06_.htm"],
+ \["[objects]", "07_.htm"],
+ \["[structures]", "08_.htm"],
+ \["[conditions]", "09_.htm"],
+ \["[symbols]", "10_.htm"],
+ \["[packages]", "11_.htm"],
+ \["[numbers]", "12_.htm"],
+ \["[characters]", "13_.htm"],
+ \["[conses]", "14_.htm"],
+ \["[arrays]", "15_.htm"],
+ \["[strings]", "16_.htm"],
+ \["[sequences]", "17_.htm"],
+ \["[hash tables]", "18_.htm"],
+ \["[filenames]", "19_.htm"],
+ \["[files]", "20_.htm"],
+ \["[streams]", "21_.htm"],
+ \["[printer]", "22_.htm"],
+ \["[reader]", "23_.htm"],
+ \["[system construction]", "24_.htm"],
+ \["[environment]", "25_.htm"],
+ \["[glossary]", "26_.htm"]]
+endif
+
+if !exists( 'g:slimv_clhs_control_chars' )
+ let g:slimv_clhs_control_chars = [
+ \["~C: Character", "22_caa.htm"],
+ \["~%: Newline", "22_cab.htm"],
+ \["~&: Freshline", "22_cac.htm"],
+ \["~|: Page", "22_cad.htm"],
+ \["~~: Tilde", "22_cae.htm"],
+ \["~R: Radix", "22_cba.htm"],
+ \["~D: Decimal", "22_cbb.htm"],
+ \["~B: Binary", "22_cbc.htm"],
+ \["~O: Octal", "22_cbd.htm"],
+ \["~X: Hexadecimal", "22_cbe.htm"],
+ \["~F: Fixed-Format Floating-Point", "22_cca.htm"],
+ \["~E: Exponential Floating-Point", "22_ccb.htm"],
+ \["~G: General Floating-Point", "22_ccc.htm"],
+ \["~$: Monetary Floating-Point", "22_ccd.htm"],
+ \["~A: Aesthetic", "22_cda.htm"],
+ \["~S: Standard", "22_cdb.htm"],
+ \["~W: Write", "22_cdc.htm"],
+ \["~_: Conditional Newline", "22_cea.htm"],
+ \["~<: Logical Block", "22_ceb.htm"],
+ \["~I: Indent", "22_cec.htm"],
+ \["~/: Call Function", "22_ced.htm"],
+ \["~T: Tabulate", "22_cfa.htm"],
+ \["~<: Justification", "22_cfb.htm"],
+ \["~>: End of Justification", "22_cfc.htm"],
+ \["~*: Go-To", "22_cga.htm"],
+ \["~[: Conditional Expression", "22_cgb.htm"],
+ \["~]: End of Conditional Expression", "22_cgc.htm"],
+ \["~{: Iteration", "22_cgd.htm"],
+ \["~}: End of Iteration", "22_cge.htm"],
+ \["~?: Recursive Processing", "22_cgf.htm"],
+ \["~(: Case Conversion", "22_cha.htm"],
+ \["~): End of Case Conversion", "22_chb.htm"],
+ \["~P: Plural", "22_chc.htm"],
+ \["~;: Clause Separator", "22_cia.htm"],
+ \["~^: Escape Upward", "22_cib.htm"],
+ \["~NEWLINE: Ignored Newline", "22_cic.htm"]]
+endif
+
+if !exists( 'g:slimv_clhs_macro_chars' )
+ let g:slimv_clhs_macro_chars = [
+ \["(", "02_da.htm"],
+ \[")", "02_db.htm"],
+ \["'", "02_dc.htm"],
+ \[";", "02_dd.htm"],
+ \['"', "02_de.htm"],
+ \["`", "02_df.htm"],
+ \[",", "02_dg.htm"],
+ \["#", "02_dh.htm"],
+ \["#\\", "02_dha.htm"],
+ \["#'", "02_dhb.htm"],
+ \["#(", "02_dhc.htm"],
+ \["#*", "02_dhd.htm"],
+ \["#:", "02_dhe.htm"],
+ \["#.", "02_dhf.htm"],
+ \["#b", "02_dhg.htm"],
+ \["#o", "02_dhh.htm"],
+ \["#x", "02_dhi.htm"],
+ \["#r", "02_dhj.htm"],
+ \["#c", "02_dhk.htm"],
+ \["#a", "02_dhl.htm"],
+ \["#s", "02_dhm.htm"],
+ \["#p", "02_dhn.htm"],
+ \["#=", "02_dho.htm"],
+ \["##", "02_dhp.htm"],
+ \["#+", "02_dhq.htm"],
+ \["#-", "02_dhr.htm"],
+ \["#|", "02_dhs.htm"],
+ \["#<", "02_dht.htm"]]
+endif
+
+if !exists( 'g:slimv_clhs_loop' )
+ let g:slimv_clhs_loop = [
+ \["loop:with", "06_abb.htm"],
+ \["loop:for-as", "06_aba.htm"],
+ \["loop:for-as-arithmetic", "06_abaa.htm"],
+ \["loop:for-as-in-list", "06_abab.htm"],
+ \["loop:for-as-on-list", "06_abac.htm"],
+ \["loop:for-as-equals-then", "06_abad.htm"],
+ \["loop:for-as-across", "06_abae.htm"],
+ \["loop:for-as-hash", "06_abaf.htm"],
+ \["loop:for-as-package", "06_abag.htm"],
+ \["loop:collect", "06_ac.htm"],
+ \["loop:append", "06_ac.htm"],
+ \["loop:nconc", "06_ac.htm"],
+ \["loop:count", "06_ac.htm"],
+ \["loop:maximize", "06_ac.htm"],
+ \["loop:minimize", "06_ac.htm"],
+ \["loop:sum", "06_ac.htm"],
+ \["loop:repeat", "06_ad.htm"],
+ \["loop:always", "06_ad.htm"],
+ \["loop:never", "06_ad.htm"],
+ \["loop:thereis", "06_ad.htm"],
+ \["loop:while", "06_ad.htm"],
+ \["loop:until", "06_ad.htm"],
+ \["loop:do", "06_ae.htm"],
+ \["loop:return", "06_ae.htm"],
+ \["loop:if", "06_af.htm"],
+ \["loop:when", "06_af.htm"],
+ \["loop:unless", "06_af.htm"],
+ \["loop:else", "06_af.htm"],
+ \["loop:it", "06_af.htm"],
+ \["loop:end", "06_af.htm"],
+ \["loop:named", "06_aga.htm"],
+ \["loop:initially", "06_agb.htm"],
+ \["loop:finally", "06_agb.htm"]]
+endif
+
+if !exists( 'g:slimv_clhs_arguments' )
+ let g:slimv_clhs_arguments = [
+ \[":test", "17_ba.htm"],
+ \[":test-not", "17_ba.htm"],
+ \[":key", "17_bb.htm"],
+ \[":eof-error-p", "23_aca.htm"],
+ \[":recursive-p", "23_acb.htm"],
+ \[":case", "19_bbab.htm"],
+ \["&allow-other-keys", "03_dada.htm"],
+ \[":allow-other-keys", "03_dada.htm"]]
+endif
+
+if !exists( 'g:slimv_clhs_glossary' )
+ let g:slimv_clhs_glossary = [
+ \["{()}", "26_glo_9.htm\\#OPCP"],
+ \["{absolute}", "26_glo_a.htm\\#absolute"],
+ \["{access}", "26_glo_a.htm\\#access"],
+ \["{accessibility}", "26_glo_a.htm\\#accessibility"],
+ \["{accessible}", "26_glo_a.htm\\#accessible"],
+ \["{accessor}", "26_glo_a.htm\\#accessor"],
+ \["{active}", "26_glo_a.htm\\#active"],
+ \["{actual adjustability}", "26_glo_a.htm\\#actual_adjustability"],
+ \["{actual argument}", "26_glo_a.htm\\#actual_argument"],
+ \["{actual array element type}", "26_glo_a.htm\\#actual_array_element_type"],
+ \["{actual complex part type}", "26_glo_a.htm\\#actual_complex_part_type"],
+ \["{actual parameter}", "26_glo_a.htm\\#actual_parameter"],
+ \["{actually adjustable}", "26_glo_a.htm\\#actually_adjustable"],
+ \["{adjustability}", "26_glo_a.htm\\#adjustability"],
+ \["{adjustable}", "26_glo_a.htm\\#adjustable"],
+ \["{after method}", "26_glo_a.htm\\#after_method"],
+ \["{alist}", "26_glo_a.htm\\#alist"],
+ \["{alphabetic}", "26_glo_a.htm\\#alphabetic"],
+ \["{alphanumeric}", "26_glo_a.htm\\#alphanumeric"],
+ \["{ampersand}", "26_glo_a.htm\\#ampersand"],
+ \["{anonymous}", "26_glo_a.htm\\#anonymous"],
+ \["{apparently uninterned}", "26_glo_a.htm\\#apparently_uninterned"],
+ \["{applicable}", "26_glo_a.htm\\#applicable"],
+ \["{applicable handler}", "26_glo_a.htm\\#applicable_handler"],
+ \["{applicable method}", "26_glo_a.htm\\#applicable_method"],
+ \["{applicable restart}", "26_glo_a.htm\\#applicable_restart"],
+ \["{apply}", "26_glo_a.htm\\#apply"],
+ \["{argument}", "26_glo_a.htm\\#argument"],
+ \["{argument evaluation order}", "26_glo_a.htm\\#argument_evaluation_order"],
+ \["{argument precedence order}", "26_glo_a.htm\\#argument_precedence_order"],
+ \["{around method}", "26_glo_a.htm\\#around_method"],
+ \["{array}", "26_glo_a.htm\\#array"],
+ \["{array element type}", "26_glo_a.htm\\#array_element_type"],
+ \["{array total size}", "26_glo_a.htm\\#array_total_size"],
+ \["{assign}", "26_glo_a.htm\\#assign"],
+ \["{association list}", "26_glo_a.htm\\#association_list"],
+ \["{asterisk}", "26_glo_a.htm\\#asterisk"],
+ \["{at-sign}", "26_glo_a.htm\\#at-sign"],
+ \["{atom}", "26_glo_a.htm\\#atom"],
+ \["{atomic}", "26_glo_a.htm\\#atomic"],
+ \["{atomic type specifier}", "26_glo_a.htm\\#atomic_type_specifier"],
+ \["{attribute}", "26_glo_a.htm\\#attribute"],
+ \["{aux variable}", "26_glo_a.htm\\#aux_variable"],
+ \["{auxiliary method}", "26_glo_a.htm\\#auxiliary_method"],
+ \["{backquote}", "26_glo_b.htm\\#backquote"],
+ \["{backslash}", "26_glo_b.htm\\#backslash"],
+ \["{base character}", "26_glo_b.htm\\#base_character"],
+ \["{base string}", "26_glo_b.htm\\#base_string"],
+ \["{before method}", "26_glo_b.htm\\#before_method"],
+ \["{bidirectional}", "26_glo_b.htm\\#bidirectional"],
+ \["{binary}", "26_glo_b.htm\\#binary"],
+ \["{bind}", "26_glo_b.htm\\#bind"],
+ \["{binding}", "26_glo_b.htm\\#binding"],
+ \["{bit}", "26_glo_b.htm\\#bit"],
+ \["{bit array}", "26_glo_b.htm\\#bit_array"],
+ \["{bit vector}", "26_glo_b.htm\\#bit_vector"],
+ \["{bit-wise logical operation specifier}", "26_glo_b.htm\\#bit-wise_logical_operation_specifier"],
+ \["{block}", "26_glo_b.htm\\#block"],
+ \["{block tag}", "26_glo_b.htm\\#block_tag"],
+ \["{boa lambda list}", "26_glo_b.htm\\#boa_lambda_list"],
+ \["{body parameter}", "26_glo_b.htm\\#body_parameter"],
+ \["{boolean}", "26_glo_b.htm\\#boolean"],
+ \["{boolean equivalent}", "26_glo_b.htm\\#boolean_equivalent"],
+ \["{bound}", "26_glo_b.htm\\#bound"],
+ \["{bound declaration}", "26_glo_b.htm\\#bound_declaration"],
+ \["{bounded}", "26_glo_b.htm\\#bounded"],
+ \["{bounding index}", "26_glo_b.htm\\#bounding_index"],
+ \["{bounding index designator}", "26_glo_b.htm\\#bounding_index_designator"],
+ \["{break loop}", "26_glo_b.htm\\#break_loop"],
+ \["{broadcast stream}", "26_glo_b.htm\\#broadcast_stream"],
+ \["{built-in class}", "26_glo_b.htm\\#built-in_class"],
+ \["{built-in type}", "26_glo_b.htm\\#built-in_type"],
+ \["{byte}", "26_glo_b.htm\\#byte"],
+ \["{byte specifier}", "26_glo_b.htm\\#byte_specifier"],
+ \["{cadr}", "26_glo_c.htm\\#cadr"],
+ \["{call}", "26_glo_c.htm\\#call"],
+ \["{captured initialization form}", "26_glo_c.htm\\#captured_initialization_form"],
+ \["{car}", "26_glo_c.htm\\#car"],
+ \["{case}", "26_glo_c.htm\\#case"],
+ \["{case sensitivity mode}", "26_glo_c.htm\\#case_sensitivity_mode"],
+ \["{catch}", "26_glo_c.htm\\#catch"],
+ \["{catch tag}", "26_glo_c.htm\\#catch_tag"],
+ \["{cddr}", "26_glo_c.htm\\#cddr"],
+ \["{cdr}", "26_glo_c.htm\\#cdr"],
+ \["{cell}", "26_glo_c.htm\\#cell"],
+ \["{character}", "26_glo_c.htm\\#character"],
+ \["{character code}", "26_glo_c.htm\\#character_code"],
+ \["{character designator}", "26_glo_c.htm\\#character_designator"],
+ \["{circular}", "26_glo_c.htm\\#circular"],
+ \["{circular list}", "26_glo_c.htm\\#circular_list"],
+ \["{class}", "26_glo_c.htm\\#class"],
+ \["{class designator}", "26_glo_c.htm\\#class_designator"],
+ \["{class precedence list}", "26_glo_c.htm\\#class_precedence_list"],
+ \["{close}", "26_glo_c.htm\\#close"],
+ \["{closed}", "26_glo_c.htm\\#closed"],
+ \["{closure}", "26_glo_c.htm\\#closure"],
+ \["{coalesce}", "26_glo_c.htm\\#coalesce"],
+ \["{code}", "26_glo_c.htm\\#code"],
+ \["{coerce}", "26_glo_c.htm\\#coerce"],
+ \["{colon}", "26_glo_c.htm\\#colon"],
+ \["{comma}", "26_glo_c.htm\\#comma"],
+ \["{compilation}", "26_glo_c.htm\\#compilation"],
+ \["{compilation environment}", "26_glo_c.htm\\#compilation_environment"],
+ \["{compilation unit}", "26_glo_c.htm\\#compilation_unit"],
+ \["{compile}", "26_glo_c.htm\\#compile"],
+ \["{compile time}", "26_glo_c.htm\\#compile_time"],
+ \["{compile time definition}", "26_glo_c.htm\\#compile-time_definition"],
+ \["{compiled code}", "26_glo_c.htm\\#compiled_code"],
+ \["{compiled file}", "26_glo_c.htm\\#compiled_file"],
+ \["{compiled function}", "26_glo_c.htm\\#compiled_function"],
+ \["{compiler}", "26_glo_c.htm\\#compiler"],
+ \["{compiler macro}", "26_glo_c.htm\\#compiler_macro"],
+ \["{compiler macro expansion}", "26_glo_c.htm\\#compiler_macro_expansion"],
+ \["{compiler macro form}", "26_glo_c.htm\\#compiler_macro_form"],
+ \["{compiler macro function}", "26_glo_c.htm\\#compiler_macro_function"],
+ \["{complex}", "26_glo_c.htm\\#complex"],
+ \["{complex float}", "26_glo_c.htm\\#complex_float"],
+ \["{complex part type}", "26_glo_c.htm\\#complex_part_type"],
+ \["{complex rational}", "26_glo_c.htm\\#complex_rational"],
+ \["{complex single float}", "26_glo_c.htm\\#complex_single_float"],
+ \["{composite stream}", "26_glo_c.htm\\#composite_stream"],
+ \["{compound form}", "26_glo_c.htm\\#compound_form"],
+ \["{compound type specifier}", "26_glo_c.htm\\#compound_type_specifier"],
+ \["{concatenated stream}", "26_glo_c.htm\\#concatenated_stream"],
+ \["{condition}", "26_glo_c.htm\\#condition"],
+ \["{condition designator}", "26_glo_c.htm\\#condition_designator"],
+ \["{condition handler}", "26_glo_c.htm\\#condition_handler"],
+ \["{condition reporter}", "26_glo_c.htm\\#condition_reporter"],
+ \["{conditional newline}", "26_glo_c.htm\\#conditional_newline"],
+ \["{conformance}", "26_glo_c.htm\\#conformance"],
+ \["{conforming code}", "26_glo_c.htm\\#conforming_code"],
+ \["{conforming implementation}", "26_glo_c.htm\\#conforming_implementation"],
+ \["{conforming processor}", "26_glo_c.htm\\#conforming_processor"],
+ \["{conforming program}", "26_glo_c.htm\\#conforming_program"],
+ \["{congruent}", "26_glo_c.htm\\#congruent"],
+ \["{cons}", "26_glo_c.htm\\#cons"],
+ \["{constant}", "26_glo_c.htm\\#constant"],
+ \["{constant form}", "26_glo_c.htm\\#constant_form"],
+ \["{constant object}", "26_glo_c.htm\\#constant_object"],
+ \["{constant variable}", "26_glo_c.htm\\#constant_variable"],
+ \["{constituent}", "26_glo_c.htm\\#constituent"],
+ \["{constituent trait}", "26_glo_c.htm\\#constituent_trait"],
+ \["{constructed stream}", "26_glo_c.htm\\#constructed_stream"],
+ \["{contagion}", "26_glo_c.htm\\#contagion"],
+ \["{continuable}", "26_glo_c.htm\\#continuable"],
+ \["{control form}", "26_glo_c.htm\\#control_form"],
+ \["{copy}", "26_glo_c.htm\\#copy"],
+ \["{correctable}", "26_glo_c.htm\\#correctable"],
+ \["{current input base}", "26_glo_c.htm\\#current_input_base"],
+ \["{current logical block}", "26_glo_c.htm\\#current_logical_block"],
+ \["{current output base}", "26_glo_c.htm\\#current_output_base"],
+ \["{current package}", "26_glo_c.htm\\#current_package"],
+ \["{current pprint dispatch table}", "26_glo_c.htm\\#current_pprint_dispatch_table"],
+ \["{current random state}", "26_glo_c.htm\\#current_random_state"],
+ \["{current readtable}", "26_glo_c.htm\\#current_readtable"],
+ \["{data type}", "26_glo_d.htm\\#data_type"],
+ \["{debug I/O}", "26_glo_d.htm\\#debug_iSLo"],
+ \["{debugger}", "26_glo_d.htm\\#debugger"],
+ \["{declaration}", "26_glo_d.htm\\#declaration"],
+ \["{declaration identifier}", "26_glo_d.htm\\#declaration_identifier"],
+ \["{declaration specifier}", "26_glo_d.htm\\#declaration_specifier"],
+ \["{declare}", "26_glo_d.htm\\#declare"],
+ \["{decline}", "26_glo_d.htm\\#decline"],
+ \["{decoded time}", "26_glo_d.htm\\#decoded_time"],
+ \["{default method}", "26_glo_d.htm\\#default_method"],
+ \["{defaulted initialization argument list}", "26_glo_d.htm\\#defaulted_initialization_argument_list"],
+ \["{define-method-combination arguments lambda list}", "26_glo_d.htm\\#define-method-combination_arguments_lambda_list"],
+ \["{define-modify-macro lambda list}", "26_glo_d.htm\\#define-modify-macro_lambda_list"],
+ \["{defined name}", "26_glo_d.htm\\#defined_name"],
+ \["{defining form}", "26_glo_d.htm\\#defining_form"],
+ \["{defsetf lambda list}", "26_glo_d.htm\\#defsetf_lambda_list"],
+ \["{deftype lambda list}", "26_glo_d.htm\\#deftype_lambda_list"],
+ \["{denormalized}", "26_glo_d.htm\\#denormalized"],
+ \["{derived type}", "26_glo_d.htm\\#derived_type"],
+ \["{derived type specifier}", "26_glo_d.htm\\#derived_type_specifier"],
+ \["{designator}", "26_glo_d.htm\\#designator"],
+ \["{destructive}", "26_glo_d.htm\\#destructive"],
+ \["{destructuring lambda list}", "26_glo_d.htm\\#destructuring_lambda_list"],
+ \["{different}", "26_glo_d.htm\\#different"],
+ \["{digit}", "26_glo_d.htm\\#digit"],
+ \["{dimension}", "26_glo_d.htm\\#dimension"],
+ \["{direct instance}", "26_glo_d.htm\\#direct_instance"],
+ \["{direct subclass}", "26_glo_d.htm\\#direct_subclass"],
+ \["{direct superclass}", "26_glo_d.htm\\#direct_superclass"],
+ \["{disestablish}", "26_glo_d.htm\\#disestablish"],
+ \["{disjoint}", "26_glo_d.htm\\#disjoint"],
+ \["{dispatching macro character}", "26_glo_d.htm\\#dispatching_macro_character"],
+ \["{displaced array}", "26_glo_d.htm\\#displaced_array"],
+ \["{distinct}", "26_glo_d.htm\\#distinct"],
+ \["{documentation string}", "26_glo_d.htm\\#documentation_string"],
+ \["{dot}", "26_glo_d.htm\\#dot"],
+ \["{dotted list}", "26_glo_d.htm\\#dotted_list"],
+ \["{dotted pair}", "26_glo_d.htm\\#dotted_pair"],
+ \["{double float}", "26_glo_d.htm\\#double_float"],
+ \["{double-quote}", "26_glo_d.htm\\#double-quote"],
+ \["{dynamic binding}", "26_glo_d.htm\\#dynamic_binding"],
+ \["{dynamic environment}", "26_glo_d.htm\\#dynamic_environment"],
+ \["{dynamic extent}", "26_glo_d.htm\\#dynamic_extent"],
+ \["{dynamic scope}", "26_glo_d.htm\\#dynamic_scope"],
+ \["{dynamic variable}", "26_glo_d.htm\\#dynamic_variable"],
+ \["{echo stream}", "26_glo_e.htm\\#echo_stream"],
+ \["{effective method}", "26_glo_e.htm\\#effective_method"],
+ \["{element}", "26_glo_e.htm\\#element"],
+ \["{element type}", "26_glo_e.htm\\#element_type"],
+ \["{em}", "26_glo_e.htm\\#em"],
+ \["{empty list}", "26_glo_e.htm\\#empty_list"],
+ \["{empty type}", "26_glo_e.htm\\#empty_type"],
+ \["{end of file}", "26_glo_e.htm\\#end_of_file"],
+ \["{environment}", "26_glo_e.htm\\#environment"],
+ \["{environment object}", "26_glo_e.htm\\#environment_object"],
+ \["{environment parameter}", "26_glo_e.htm\\#environment_parameter"],
+ \["{error}", "26_glo_e.htm\\#error"],
+ \["{error output}", "26_glo_e.htm\\#error_output"],
+ \["{escape}", "26_glo_e.htm\\#escape"],
+ \["{establish}", "26_glo_e.htm\\#establish"],
+ \["{evaluate}", "26_glo_e.htm\\#evaluate"],
+ \["{evaluation}", "26_glo_e.htm\\#evaluation"],
+ \["{evaluation environment}", "26_glo_e.htm\\#evaluation_environment"],
+ \["{execute}", "26_glo_e.htm\\#execute"],
+ \["{execution time}", "26_glo_e.htm\\#execution_time"],
+ \["{exhaustive partition}", "26_glo_e.htm\\#exhaustive_partition"],
+ \["{exhaustive union}", "26_glo_e.htm\\#exhaustive_union"],
+ \["{exit point}", "26_glo_e.htm\\#exit_point"],
+ \["{explicit return}", "26_glo_e.htm\\#explicit_return"],
+ \["{explicit use}", "26_glo_e.htm\\#explicit_use"],
+ \["{exponent marker}", "26_glo_e.htm\\#exponent_marker"],
+ \["{export}", "26_glo_e.htm\\#export"],
+ \["{exported}", "26_glo_e.htm\\#exported"],
+ \["{expressed adjustability}", "26_glo_e.htm\\#expressed_adjustability"],
+ \["{expressed array element type}", "26_glo_e.htm\\#expressed_array_element_type"],
+ \["{expressed complex part type}", "26_glo_e.htm\\#expressed_complex_part_type"],
+ \["{expression}", "26_glo_e.htm\\#expression"],
+ \["{expressly adjustable}", "26_glo_e.htm\\#expressly_adjustable"],
+ \["{extended character}", "26_glo_e.htm\\#extended_character"],
+ \["{extended function designator}", "26_glo_e.htm\\#extended_function_designator"],
+ \["{extended lambda list}", "26_glo_e.htm\\#extended_lambda_list"],
+ \["{extension}", "26_glo_e.htm\\#extension"],
+ \["{extent}", "26_glo_e.htm\\#extent"],
+ \["{external file format}", "26_glo_e.htm\\#external_file_format"],
+ \["{external file format designator}", "26_glo_e.htm\\#external_file_format_designator"],
+ \["{external symbol}", "26_glo_e.htm\\#external_symbol"],
+ \["{externalizable object}", "26_glo_e.htm\\#externalizable_object"],
+ \["{false}", "26_glo_f.htm\\#false"],
+ \["{fbound}", "26_glo_f.htm\\#fbound"],
+ \["{feature}", "26_glo_f.htm\\#feature"],
+ \["{feature expression}", "26_glo_f.htm\\#feature_expression"],
+ \["{features list}", "26_glo_f.htm\\#features_list"],
+ \["{file}", "26_glo_f.htm\\#file"],
+ \["{file compiler}", "26_glo_f.htm\\#file_compiler"],
+ \["{file position}", "26_glo_f.htm\\#file_position"],
+ \["{file position designator}", "26_glo_f.htm\\#file_position_designator"],
+ \["{file stream}", "26_glo_f.htm\\#file_stream"],
+ \["{file system}", "26_glo_f.htm\\#file_system"],
+ \["{filename}", "26_glo_f.htm\\#filename"],
+ \["{fill pointer}", "26_glo_f.htm\\#fill_pointer"],
+ \["{finite}", "26_glo_f.htm\\#finite"],
+ \["{fixnum}", "26_glo_f.htm\\#fixnum"],
+ \["{float}", "26_glo_f.htm\\#float"],
+ \["{for-value}", "26_glo_f.htm\\#for-value"],
+ \["{form}", "26_glo_f.htm\\#form"],
+ \["{formal argument}", "26_glo_f.htm\\#formal_argument"],
+ \["{formal parameter}", "26_glo_f.htm\\#formal_parameter"],
+ \["{format}", "26_glo_f.htm\\#format"],
+ \["{format argument}", "26_glo_f.htm\\#format_argument"],
+ \["{format control}", "26_glo_f.htm\\#format_control"],
+ \["{format directive}", "26_glo_f.htm\\#format_directive"],
+ \["{format string}", "26_glo_f.htm\\#format_string"],
+ \["{free declaration}", "26_glo_f.htm\\#free_declaration"],
+ \["{fresh}", "26_glo_f.htm\\#fresh"],
+ \["{freshline}", "26_glo_f.htm\\#freshline"],
+ \["{funbound}", "26_glo_f.htm\\#funbound"],
+ \["{function}", "26_glo_f.htm\\#function"],
+ \["{function block name}", "26_glo_f.htm\\#function_block_name"],
+ \["{function cell}", "26_glo_f.htm\\#function_cell"],
+ \["{function designator}", "26_glo_f.htm\\#function_designator"],
+ \["{function form}", "26_glo_f.htm\\#function_form"],
+ \["{function name}", "26_glo_f.htm\\#function_name"],
+ \["{functional evaluation}", "26_glo_f.htm\\#functional_evaluation"],
+ \["{functional value}", "26_glo_f.htm\\#functional_value"],
+ \["{further compilation}", "26_glo_f.htm\\#further_compilation"],
+ \["{general}", "26_glo_g.htm\\#general"],
+ \["{generalized boolean}", "26_glo_g.htm\\#generalized_boolean"],
+ \["{generalized instance}", "26_glo_g.htm\\#generalized_instance"],
+ \["{generalized reference}", "26_glo_g.htm\\#generalized_reference"],
+ \["{generalized synonym stream}", "26_glo_g.htm\\#generalized_synonym_stream"],
+ \["{generic function}", "26_glo_g.htm\\#generic_function"],
+ \["{generic function lambda list}", "26_glo_g.htm\\#generic_function_lambda_list"],
+ \["{gensym}", "26_glo_g.htm\\#gensym"],
+ \["{global declaration}", "26_glo_g.htm\\#global_declaration"],
+ \["{global environment}", "26_glo_g.htm\\#global_environment"],
+ \["{global variable}", "26_glo_g.htm\\#global_variable"],
+ \["{glyph}", "26_glo_g.htm\\#glyph"],
+ \["{go}", "26_glo_g.htm\\#go"],
+ \["{go point}", "26_glo_g.htm\\#go_point"],
+ \["{go tag}", "26_glo_g.htm\\#go_tag"],
+ \["{graphic}", "26_glo_g.htm\\#graphic"],
+ \["{handle}", "26_glo_h.htm\\#handle"],
+ \["{handler}", "26_glo_h.htm\\#handler"],
+ \["{hash table}", "26_glo_h.htm\\#hash_table"],
+ \["{home package}", "26_glo_h.htm\\#home_package"],
+ \["{I/O customization variable}", "26_glo_i.htm\\#iSLo_customization_variable"],
+ \["{identical}", "26_glo_i.htm\\#identical"],
+ \["{identifier}", "26_glo_i.htm\\#identifier"],
+ \["{immutable}", "26_glo_i.htm\\#immutable"],
+ \["{implementation}", "26_glo_i.htm\\#implementation"],
+ \["{implementation limit}", "26_glo_i.htm\\#implementation_limit"],
+ \["{implementation-defined}", "26_glo_i.htm\\#implementation-defined"],
+ \["{implementation-dependent}", "26_glo_i.htm\\#implementation-dependent"],
+ \["{implementation-independent}", "26_glo_i.htm\\#implementation-independent"],
+ \["{implicit block}", "26_glo_i.htm\\#implicit_block"],
+ \["{implicit compilation}", "26_glo_i.htm\\#implicit_compilation"],
+ \["{implicit progn}", "26_glo_i.htm\\#implicit_progn"],
+ \["{implicit tagbody}", "26_glo_i.htm\\#implicit_tagbody"],
+ \["{import}", "26_glo_i.htm\\#import"],
+ \["{improper list}", "26_glo_i.htm\\#improper_list"],
+ \["{inaccessible}", "26_glo_i.htm\\#inaccessible"],
+ \["{indefinite extent}", "26_glo_i.htm\\#indefinite_extent"],
+ \["{indefinite scope}", "26_glo_i.htm\\#indefinite_scope"],
+ \["{indicator}", "26_glo_i.htm\\#indicator"],
+ \["{indirect instance}", "26_glo_i.htm\\#indirect_instance"],
+ \["{inherit}", "26_glo_i.htm\\#inherit"],
+ \["{initial pprint dispatch table}", "26_glo_i.htm\\#initial_pprint_dispatch_table"],
+ \["{initial readtable}", "26_glo_i.htm\\#initial_readtable"],
+ \["{initialization argument list}", "26_glo_i.htm\\#initialization_argument_list"],
+ \["{initialization form}", "26_glo_i.htm\\#initialization_form"],
+ \["{input}", "26_glo_i.htm\\#input"],
+ \["{instance}", "26_glo_i.htm\\#instance"],
+ \["{integer}", "26_glo_i.htm\\#integer"],
+ \["{interactive stream}", "26_glo_i.htm\\#interactive_stream"],
+ \["{intern}", "26_glo_i.htm\\#intern"],
+ \["{internal symbol}", "26_glo_i.htm\\#internal_symbol"],
+ \["{internal time}", "26_glo_i.htm\\#internal_time"],
+ \["{internal time unit}", "26_glo_i.htm\\#internal_time_unit"],
+ \["{interned}", "26_glo_i.htm\\#interned"],
+ \["{interpreted function}", "26_glo_i.htm\\#interpreted_function"],
+ \["{interpreted implementation}", "26_glo_i.htm\\#interpreted_implementation"],
+ \["{interval designator}", "26_glo_i.htm\\#interval_designator"],
+ \["{invalid}", "26_glo_i.htm\\#invalid"],
+ \["{iteration form}", "26_glo_i.htm\\#iteration_form"],
+ \["{iteration variable}", "26_glo_i.htm\\#iteration_variable"],
+ \["{key}", "26_glo_k.htm\\#key"],
+ \["{keyword}", "26_glo_k.htm\\#keyword"],
+ \["{keyword parameter}", "26_glo_k.htm\\#keyword_parameter"],
+ \["{keyword/value pair}", "26_glo_k.htm\\#keywordSLvalue_pair"],
+ \["{lambda combination}", "26_glo_l.htm\\#lambda_combination"],
+ \["{lambda expression}", "26_glo_l.htm\\#lambda_expression"],
+ \["{lambda form}", "26_glo_l.htm\\#lambda_form"],
+ \["{lambda list}", "26_glo_l.htm\\#lambda_list"],
+ \["{lambda list keyword}", "26_glo_l.htm\\#lambda_list_keyword"],
+ \["{lambda variable}", "26_glo_l.htm\\#lambda_variable"],
+ \["{leaf}", "26_glo_l.htm\\#leaf"],
+ \["{leap seconds}", "26_glo_l.htm\\#leap_seconds"],
+ \["{left-parenthesis}", "26_glo_l.htm\\#left-parenthesis"],
+ \["{length}", "26_glo_l.htm\\#length"],
+ \["{lexical binding}", "26_glo_l.htm\\#lexical_binding"],
+ \["{lexical closure}", "26_glo_l.htm\\#lexical_closure"],
+ \["{lexical environment}", "26_glo_l.htm\\#lexical_environment"],
+ \["{lexical scope}", "26_glo_l.htm\\#lexical_scope"],
+ \["{lexical variable}", "26_glo_l.htm\\#lexical_variable"],
+ \["{lisp image}", "26_glo_l.htm\\#lisp_image"],
+ \["{lisp printer}", "26_glo_l.htm\\#lisp_printer"],
+ \["{lisp read-eval-print loop}", "26_glo_l.htm\\#lisp_read-eval-print_loop"],
+ \["{lisp reader}", "26_glo_l.htm\\#lisp_reader"],
+ \["{list}", "26_glo_l.htm\\#list"],
+ \["{list designator}", "26_glo_l.htm\\#list_designator"],
+ \["{list structure}", "26_glo_l.htm\\#list_structure"],
+ \["{literal}", "26_glo_l.htm\\#literal"],
+ \["{load}", "26_glo_l.htm\\#load"],
+ \["{load time}", "26_glo_l.htm\\#load_time"],
+ \["{load time value}", "26_glo_l.htm\\#load_time_value"],
+ \["{loader}", "26_glo_l.htm\\#loader"],
+ \["{local declaration}", "26_glo_l.htm\\#local_declaration"],
+ \["{local precedence order}", "26_glo_l.htm\\#local_precedence_order"],
+ \["{local slot}", "26_glo_l.htm\\#local_slot"],
+ \["{logical block}", "26_glo_l.htm\\#logical_block"],
+ \["{logical host}", "26_glo_l.htm\\#logical_host"],
+ \["{logical host designator}", "26_glo_l.htm\\#logical_host_designator"],
+ \["{logical pathname}", "26_glo_l.htm\\#logical_pathname"],
+ \["{long float}", "26_glo_l.htm\\#long_float"],
+ \["{loop keyword}", "26_glo_l.htm\\#loop_keyword"],
+ \["{lowercase}", "26_glo_l.htm\\#lowercase"],
+ \["{macro}", "26_glo_m.htm\\#macro"],
+ \["{macro character}", "26_glo_m.htm\\#macro_character"],
+ \["{macro expansion}", "26_glo_m.htm\\#macro_expansion"],
+ \["{macro form}", "26_glo_m.htm\\#macro_form"],
+ \["{macro function}", "26_glo_m.htm\\#macro_function"],
+ \["{macro lambda list}", "26_glo_m.htm\\#macro_lambda_list"],
+ \["{macro name}", "26_glo_m.htm\\#macro_name"],
+ \["{macroexpand hook}", "26_glo_m.htm\\#macroexpand_hook"],
+ \["{mapping}", "26_glo_m.htm\\#mapping"],
+ \["{metaclass}", "26_glo_m.htm\\#metaclass"],
+ \["{metaobject protocol}", "26_glo_m.htm\\#metaobject_protocol"],
+ \["{method}", "26_glo_m.htm\\#method"],
+ \["{method combination}", "26_glo_m.htm\\#method_combination"],
+ \["{method-defining form}", "26_glo_m.htm\\#method-defining_form"],
+ \["{method-defining operator}", "26_glo_m.htm\\#method-defining_operator"],
+ \["{minimal compilation}", "26_glo_m.htm\\#minimal_compilation"],
+ \["{modified lambda list}", "26_glo_m.htm\\#modified_lambda_list"],
+ \["{most recent}", "26_glo_m.htm\\#most_recent"],
+ \["{multiple escape}", "26_glo_m.htm\\#multiple_escape"],
+ \["{multiple values}", "26_glo_m.htm\\#multiple_values"],
+ \["{name}", "26_glo_n.htm\\#name"],
+ \["{named constant}", "26_glo_n.htm\\#named_constant"],
+ \["{namespace}", "26_glo_n.htm\\#namespace"],
+ \["{namestring}", "26_glo_n.htm\\#namestring"],
+ \["{newline}", "26_glo_n.htm\\#newline"],
+ \["{next method}", "26_glo_n.htm\\#next_method"],
+ \["{nickname}", "26_glo_n.htm\\#nickname"],
+ \["{nil}", "26_glo_n.htm\\#nil"],
+ \["{non-atomic}", "26_glo_n.htm\\#non-atomic"],
+ \["{non-constant variable}", "26_glo_n.htm\\#non-constant_variable"],
+ \["{non-correctable}", "26_glo_n.htm\\#non-correctable"],
+ \["{non-empty}", "26_glo_n.htm\\#non-empty"],
+ \["{non-generic function}", "26_glo_n.htm\\#non-generic_function"],
+ \["{non-graphic}", "26_glo_n.htm\\#non-graphic"],
+ \["{non-list}", "26_glo_n.htm\\#non-list"],
+ \["{non-local exit}", "26_glo_n.htm\\#non-local_exit"],
+ \["{non-nil}", "26_glo_n.htm\\#non-nil"],
+ \["{non-null lexical environment}", "26_glo_n.htm\\#non-null_lexical_environment"],
+ \["{non-simple}", "26_glo_n.htm\\#non-simple"],
+ \["{non-terminating}", "26_glo_n.htm\\#non-terminating"],
+ \["{non-top-level form}", "26_glo_n.htm\\#non-top-level_form"],
+ \["{normal return}", "26_glo_n.htm\\#normal_return"],
+ \["{normalized}", "26_glo_n.htm\\#normalized"],
+ \["{null}", "26_glo_n.htm\\#null"],
+ \["{null lexical environment}", "26_glo_n.htm\\#null_lexical_environment"],
+ \["{number}", "26_glo_n.htm\\#number"],
+ \["{numeric}", "26_glo_n.htm\\#numeric"],
+ \["{object}", "26_glo_o.htm\\#object"],
+ \["{object-traversing}", "26_glo_o.htm\\#object-traversing"],
+ \["{open}", "26_glo_o.htm\\#open"],
+ \["{operator}", "26_glo_o.htm\\#operator"],
+ \["{optimize quality}", "26_glo_o.htm\\#optimize_quality"],
+ \["{optional parameter}", "26_glo_o.htm\\#optional_parameter"],
+ \["{ordinary function}", "26_glo_o.htm\\#ordinary_function"],
+ \["{ordinary lambda list}", "26_glo_o.htm\\#ordinary_lambda_list"],
+ \["{otherwise inaccessible part}", "26_glo_o.htm\\#otherwise_inaccessible_part"],
+ \["{output}", "26_glo_o.htm\\#output"],
+ \["{package}", "26_glo_p.htm\\#package"],
+ \["{package cell}", "26_glo_p.htm\\#package_cell"],
+ \["{package designator}", "26_glo_p.htm\\#package_designator"],
+ \["{package marker}", "26_glo_p.htm\\#package_marker"],
+ \["{package prefix}", "26_glo_p.htm\\#package_prefix"],
+ \["{package registry}", "26_glo_p.htm\\#package_registry"],
+ \["{pairwise}", "26_glo_p.htm\\#pairwise"],
+ \["{parallel}", "26_glo_p.htm\\#parallel"],
+ \["{parameter}", "26_glo_p.htm\\#parameter"],
+ \["{parameter specializer}", "26_glo_p.htm\\#parameter_specializer"],
+ \["{parameter specializer name}", "26_glo_p.htm\\#parameter_specializer_name"],
+ \["{pathname}", "26_glo_p.htm\\#pathname"],
+ \["{pathname designator}", "26_glo_p.htm\\#pathname_designator"],
+ \["{physical pathname}", "26_glo_p.htm\\#physical_pathname"],
+ \["{place}", "26_glo_p.htm\\#place"],
+ \["{plist}", "26_glo_p.htm\\#plist"],
+ \["{portable}", "26_glo_p.htm\\#portable"],
+ \["{potential copy}", "26_glo_p.htm\\#potential_copy"],
+ \["{potential number}", "26_glo_p.htm\\#potential_number"],
+ \["{pprint dispatch table}", "26_glo_p.htm\\#pprint_dispatch_table"],
+ \["{predicate}", "26_glo_p.htm\\#predicate"],
+ \["{present}", "26_glo_p.htm\\#present"],
+ \["{pretty print}", "26_glo_p.htm\\#pretty_print"],
+ \["{pretty printer}", "26_glo_p.htm\\#pretty_printer"],
+ \["{pretty printing stream}", "26_glo_p.htm\\#pretty_printing_stream"],
+ \["{primary method}", "26_glo_p.htm\\#primary_method"],
+ \["{primary value}", "26_glo_p.htm\\#primary_value"],
+ \["{principal}", "26_glo_p.htm\\#principal"],
+ \["{print name}", "26_glo_p.htm\\#print_name"],
+ \["{printer control variable}", "26_glo_p.htm\\#printer_control_variable"],
+ \["{printer escaping}", "26_glo_p.htm\\#printer_escaping"],
+ \["{printing}", "26_glo_p.htm\\#printing"],
+ \["{process}", "26_glo_p.htm\\#process"],
+ \["{processor}", "26_glo_p.htm\\#processor"],
+ \["{proclaim}", "26_glo_p.htm\\#proclaim"],
+ \["{proclamation}", "26_glo_p.htm\\#proclamation"],
+ \["{prog tag}", "26_glo_p.htm\\#prog_tag"],
+ \["{program}", "26_glo_p.htm\\#program"],
+ \["{programmer}", "26_glo_p.htm\\#programmer"],
+ \["{programmer code}", "26_glo_p.htm\\#programmer_code"],
+ \["{proper list}", "26_glo_p.htm\\#proper_list"],
+ \["{proper name}", "26_glo_p.htm\\#proper_name"],
+ \["{proper sequence}", "26_glo_p.htm\\#proper_sequence"],
+ \["{proper subtype}", "26_glo_p.htm\\#proper_subtype"],
+ \["{property}", "26_glo_p.htm\\#property"],
+ \["{property indicator}", "26_glo_p.htm\\#property_indicator"],
+ \["{property list}", "26_glo_p.htm\\#property_list"],
+ \["{property value}", "26_glo_p.htm\\#property_value"],
+ \["{purports to conform}", "26_glo_p.htm\\#purports_to_conform"],
+ \["{qualified method}", "26_glo_q.htm\\#qualified_method"],
+ \["{qualifier}", "26_glo_q.htm\\#qualifier"],
+ \["{query I/O}", "26_glo_q.htm\\#query_iSLo"],
+ \["{quoted object}", "26_glo_q.htm\\#quoted_object"],
+ \["{radix}", "26_glo_r.htm\\#radix"],
+ \["{random state}", "26_glo_r.htm\\#random_state"],
+ \["{rank}", "26_glo_r.htm\\#rank"],
+ \["{ratio}", "26_glo_r.htm\\#ratio"],
+ \["{ratio marker}", "26_glo_r.htm\\#ratio_marker"],
+ \["{rational}", "26_glo_r.htm\\#rational"],
+ \["{read}", "26_glo_r.htm\\#read"],
+ \["{readably}", "26_glo_r.htm\\#readably"],
+ \["{reader}", "26_glo_r.htm\\#reader"],
+ \["{reader macro}", "26_glo_r.htm\\#reader_macro"],
+ \["{reader macro function}", "26_glo_r.htm\\#reader_macro_function"],
+ \["{readtable}", "26_glo_r.htm\\#readtable"],
+ \["{readtable case}", "26_glo_r.htm\\#readtable_case"],
+ \["{readtable designator}", "26_glo_r.htm\\#readtable_designator"],
+ \["{recognizable subtype}", "26_glo_r.htm\\#recognizable_subtype"],
+ \["{reference}", "26_glo_r.htm\\#reference"],
+ \["{registered package}", "26_glo_r.htm\\#registered_package"],
+ \["{relative}", "26_glo_r.htm\\#relative"],
+ \["{repertoire}", "26_glo_r.htm\\#repertoire"],
+ \["{report}", "26_glo_r.htm\\#report"],
+ \["{report message}", "26_glo_r.htm\\#report_message"],
+ \["{required parameter}", "26_glo_r.htm\\#required_parameter"],
+ \["{rest list}", "26_glo_r.htm\\#rest_list"],
+ \["{rest parameter}", "26_glo_r.htm\\#rest_parameter"],
+ \["{restart}", "26_glo_r.htm\\#restart"],
+ \["{restart designator}", "26_glo_r.htm\\#restart_designator"],
+ \["{restart function}", "26_glo_r.htm\\#restart_function"],
+ \["{return}", "26_glo_r.htm\\#return"],
+ \["{return value}", "26_glo_r.htm\\#return_value"],
+ \["{right-parenthesis}", "26_glo_r.htm\\#right-parenthesis"],
+ \["{run time}", "26_glo_r.htm\\#run_time"],
+ \["{run-time compiler}", "26_glo_r.htm\\#run-time_compiler"],
+ \["{run-time definition}", "26_glo_r.htm\\#run-time_definition"],
+ \["{run-time environment}", "26_glo_r.htm\\#run-time_environment"],
+ \["{safe}", "26_glo_s.htm\\#safe"],
+ \["{safe call}", "26_glo_s.htm\\#safe_call"],
+ \["{same}", "26_glo_s.htm\\#same"],
+ \["{satisfy the test}", "26_glo_s.htm\\#satisfy_the_test"],
+ \["{scope}", "26_glo_s.htm\\#scope"],
+ \["{script}", "26_glo_s.htm\\#script"],
+ \["{secondary value}", "26_glo_s.htm\\#secondary_value"],
+ \["{section}", "26_glo_s.htm\\#section"],
+ \["{self-evaluating object}", "26_glo_s.htm\\#self-evaluating_object"],
+ \["{semi-standard}", "26_glo_s.htm\\#semi-standard"],
+ \["{semicolon}", "26_glo_s.htm\\#semicolon"],
+ \["{sequence}", "26_glo_s.htm\\#sequence"],
+ \["{sequence function}", "26_glo_s.htm\\#sequence_function"],
+ \["{sequential}", "26_glo_s.htm\\#sequential"],
+ \["{sequentially}", "26_glo_s.htm\\#sequentially"],
+ \["{serious condition}", "26_glo_s.htm\\#serious_condition"],
+ \["{session}", "26_glo_s.htm\\#session"],
+ \["{set}", "26_glo_s.htm\\#set"],
+ \["{setf expander}", "26_glo_s.htm\\#setf_expander"],
+ \["{setf expansion}", "26_glo_s.htm\\#setf_expansion"],
+ \["{setf function}", "26_glo_s.htm\\#setf_function"],
+ \["{setf function name}", "26_glo_s.htm\\#setf_function_name"],
+ \["{shadow}", "26_glo_s.htm\\#shadow"],
+ \["{shadowing symbol}", "26_glo_s.htm\\#shadowing_symbol"],
+ \["{shadowing symbols list}", "26_glo_s.htm\\#shadowing_symbols_list"],
+ \["{shared slot}", "26_glo_s.htm\\#shared_slot"],
+ \["{sharpsign}", "26_glo_s.htm\\#sharpsign"],
+ \["{short float}", "26_glo_s.htm\\#short_float"],
+ \["{sign}", "26_glo_s.htm\\#sign"],
+ \["{signal}", "26_glo_s.htm\\#signal"],
+ \["{signature}", "26_glo_s.htm\\#signature"],
+ \["{similar}", "26_glo_s.htm\\#similar"],
+ \["{similarity}", "26_glo_s.htm\\#similarity"],
+ \["{simple}", "26_glo_s.htm\\#simple"],
+ \["{simple array}", "26_glo_s.htm\\#simple_array"],
+ \["{simple bit array}", "26_glo_s.htm\\#simple_bit_array"],
+ \["{simple bit vector}", "26_glo_s.htm\\#simple_bit_vector"],
+ \["{simple condition}", "26_glo_s.htm\\#simple_condition"],
+ \["{simple general vector}", "26_glo_s.htm\\#simple_general_vector"],
+ \["{simple string}", "26_glo_s.htm\\#simple_string"],
+ \["{simple vector}", "26_glo_s.htm\\#simple_vector"],
+ \["{single escape}", "26_glo_s.htm\\#single_escape"],
+ \["{single float}", "26_glo_s.htm\\#single_float"],
+ \["{single-quote}", "26_glo_s.htm\\#single-quote"],
+ \["{singleton}", "26_glo_s.htm\\#singleton"],
+ \["{situation}", "26_glo_s.htm\\#situation"],
+ \["{slash}", "26_glo_s.htm\\#slash"],
+ \["{slot}", "26_glo_s.htm\\#slot"],
+ \["{slot specifier}", "26_glo_s.htm\\#slot_specifier"],
+ \["{source code}", "26_glo_s.htm\\#source_code"],
+ \["{source file}", "26_glo_s.htm\\#source_file"],
+ \["{space}", "26_glo_s.htm\\#space"],
+ \["{special form}", "26_glo_s.htm\\#special_form"],
+ \["{special operator}", "26_glo_s.htm\\#special_operator"],
+ \["{special variable}", "26_glo_s.htm\\#special_variable"],
+ \["{specialize}", "26_glo_s.htm\\#specialize"],
+ \["{specialized}", "26_glo_s.htm\\#specialized"],
+ \["{specialized lambda list}", "26_glo_s.htm\\#specialized_lambda_list"],
+ \["{spreadable argument list designator}", "26_glo_s.htm\\#spreadable_argument_list_designator"],
+ \["{stack allocate}", "26_glo_s.htm\\#stack_allocate"],
+ \["{stack-allocated}", "26_glo_s.htm\\#stack-allocated"],
+ \["{standard character}", "26_glo_s.htm\\#standard_character"],
+ \["{standard class}", "26_glo_s.htm\\#standard_class"],
+ \["{standard generic function}", "26_glo_s.htm\\#standard_generic_function"],
+ \["{standard input}", "26_glo_s.htm\\#standard_input"],
+ \["{standard method combination}", "26_glo_s.htm\\#standard_method_combination"],
+ \["{standard object}", "26_glo_s.htm\\#standard_object"],
+ \["{standard output}", "26_glo_s.htm\\#standard_output"],
+ \["{standard pprint dispatch table}", "26_glo_s.htm\\#standard_pprint_dispatch_table"],
+ \["{standard readtable}", "26_glo_s.htm\\#standard_readtable"],
+ \["{standard syntax}", "26_glo_s.htm\\#standard_syntax"],
+ \["{standardized}", "26_glo_s.htm\\#standardized"],
+ \["{startup environment}", "26_glo_s.htm\\#startup_environment"],
+ \["{step}", "26_glo_s.htm\\#step"],
+ \["{stream}", "26_glo_s.htm\\#stream"],
+ \["{stream associated with a file}", "26_glo_s.htm\\#stream_associated_with_a_file"],
+ \["{stream designator}", "26_glo_s.htm\\#stream_designator"],
+ \["{stream element type}", "26_glo_s.htm\\#stream_element_type"],
+ \["{stream variable}", "26_glo_s.htm\\#stream_variable"],
+ \["{stream variable designator}", "26_glo_s.htm\\#stream_variable_designator"],
+ \["{string}", "26_glo_s.htm\\#string"],
+ \["{string designator}", "26_glo_s.htm\\#string_designator"],
+ \["{string equal}", "26_glo_s.htm\\#string_equal"],
+ \["{string stream}", "26_glo_s.htm\\#string_stream"],
+ \["{structure}", "26_glo_s.htm\\#structure"],
+ \["{structure class}", "26_glo_s.htm\\#structure_class"],
+ \["{structure name}", "26_glo_s.htm\\#structure_name"],
+ \["{style warning}", "26_glo_s.htm\\#style_warning"],
+ \["{subclass}", "26_glo_s.htm\\#subclass"],
+ \["{subexpression}", "26_glo_s.htm\\#subexpression"],
+ \["{subform}", "26_glo_s.htm\\#subform"],
+ \["{subrepertoire}", "26_glo_s.htm\\#subrepertoire"],
+ \["{subtype}", "26_glo_s.htm\\#subtype"],
+ \["{superclass}", "26_glo_s.htm\\#superclass"],
+ \["{supertype}", "26_glo_s.htm\\#supertype"],
+ \["{supplied-p parameter}", "26_glo_s.htm\\#supplied-p_parameter"],
+ \["{symbol}", "26_glo_s.htm\\#symbol"],
+ \["{symbol macro}", "26_glo_s.htm\\#symbol_macro"],
+ \["{synonym stream}", "26_glo_s.htm\\#synonym_stream"],
+ \["{synonym stream symbol}", "26_glo_s.htm\\#synonym_stream_symbol"],
+ \["{syntax type}", "26_glo_s.htm\\#syntax_type"],
+ \["{system class}", "26_glo_s.htm\\#system_class"],
+ \["{system code}", "26_glo_s.htm\\#system_code"],
+ \["{t}", "26_glo_t.htm\\#t"],
+ \["{tag}", "26_glo_t.htm\\#tag"],
+ \["{tail}", "26_glo_t.htm\\#tail"],
+ \["{target}", "26_glo_t.htm\\#target"],
+ \["{terminal I/O}", "26_glo_t.htm\\#terminal_iSLo"],
+ \["{terminating}", "26_glo_t.htm\\#terminating"],
+ \["{tertiary value}", "26_glo_t.htm\\#tertiary_value"],
+ \["{throw}", "26_glo_t.htm\\#throw"],
+ \["{tilde}", "26_glo_t.htm\\#tilde"],
+ \["{time}", "26_glo_t.htm\\#time"],
+ \["{time zone}", "26_glo_t.htm\\#time_zone"],
+ \["{token}", "26_glo_t.htm\\#token"],
+ \["{top level form}", "26_glo_t.htm\\#top_level_form"],
+ \["{trace output}", "26_glo_t.htm\\#trace_output"],
+ \["{tree}", "26_glo_t.htm\\#tree"],
+ \["{tree structure}", "26_glo_t.htm\\#tree_structure"],
+ \["{true}", "26_glo_t.htm\\#true"],
+ \["{truename}", "26_glo_t.htm\\#truename"],
+ \["{two-way stream}", "26_glo_t.htm\\#two-way_stream"],
+ \["{type}", "26_glo_t.htm\\#type"],
+ \["{type declaration}", "26_glo_t.htm\\#type_declaration"],
+ \["{type equivalent}", "26_glo_t.htm\\#type_equivalent"],
+ \["{type expand}", "26_glo_t.htm\\#type_expand"],
+ \["{type specifier}", "26_glo_t.htm\\#type_specifier"],
+ \["{unbound}", "26_glo_u.htm\\#unbound"],
+ \["{unbound variable}", "26_glo_u.htm\\#unbound_variable"],
+ \["{undefined function}", "26_glo_u.htm\\#undefined_function"],
+ \["{unintern}", "26_glo_u.htm\\#unintern"],
+ \["{uninterned}", "26_glo_u.htm\\#uninterned"],
+ \["{universal time}", "26_glo_u.htm\\#universal_time"],
+ \["{unqualified method}", "26_glo_u.htm\\#unqualified_method"],
+ \["{unregistered package}", "26_glo_u.htm\\#unregistered_package"],
+ \["{unsafe}", "26_glo_u.htm\\#unsafe"],
+ \["{unsafe call}", "26_glo_u.htm\\#unsafe_call"],
+ \["{upgrade}", "26_glo_u.htm\\#upgrade"],
+ \["{upgraded array element type}", "26_glo_u.htm\\#upgraded_array_element_type"],
+ \["{upgraded complex part type}", "26_glo_u.htm\\#upgraded_complex_part_type"],
+ \["{uppercase}", "26_glo_u.htm\\#uppercase"],
+ \["{use}", "26_glo_u.htm\\#use"],
+ \["{use list}", "26_glo_u.htm\\#use_list"],
+ \["{user}", "26_glo_u.htm\\#user"],
+ \["{valid array dimension}", "26_glo_v.htm\\#valid_array_dimension"],
+ \["{valid array index}", "26_glo_v.htm\\#valid_array_index"],
+ \["{valid array row-major index}", "26_glo_v.htm\\#valid_array_row-major_index"],
+ \["{valid fill pointer}", "26_glo_v.htm\\#valid_fill_pointer"],
+ \["{valid logical pathname host}", "26_glo_v.htm\\#valid_logical_pathname_host"],
+ \["{valid pathname device}", "26_glo_v.htm\\#valid_pathname_device"],
+ \["{valid pathname directory}", "26_glo_v.htm\\#valid_pathname_directory"],
+ \["{valid pathname host}", "26_glo_v.htm\\#valid_pathname_host"],
+ \["{valid pathname name}", "26_glo_v.htm\\#valid_pathname_name"],
+ \["{valid pathname type}", "26_glo_v.htm\\#valid_pathname_type"],
+ \["{valid pathname version}", "26_glo_v.htm\\#valid_pathname_version"],
+ \["{valid physical pathname host}", "26_glo_v.htm\\#valid_physical_pathname_host"],
+ \["{valid sequence index}", "26_glo_v.htm\\#valid_sequence_index"],
+ \["{value}", "26_glo_v.htm\\#value"],
+ \["{value cell}", "26_glo_v.htm\\#value_cell"],
+ \["{variable}", "26_glo_v.htm\\#variable"],
+ \["{vector}", "26_glo_v.htm\\#vector"],
+ \["{vertical-bar}", "26_glo_v.htm\\#vertical-bar"],
+ \["{whitespace}", "26_glo_w.htm\\#whitespace"],
+ \["{wild}", "26_glo_w.htm\\#wild"],
+ \["{write}", "26_glo_w.htm\\#write"],
+ \["{writer}", "26_glo_w.htm\\#writer"],
+ \["{yield}", "26_glo_y.htm\\#yield"]]
+endif
+
diff --git a/vim/bundle/slimv/ftplugin/slimv-cljapi.vim b/vim/bundle/slimv/ftplugin/slimv-cljapi.vim
new file mode 100644
index 0000000..971fa4c
--- /dev/null
+++ b/vim/bundle/slimv/ftplugin/slimv-cljapi.vim
@@ -0,0 +1,759 @@
+" slimv-cljapi.vim:
+" Clojure API lookup support for Slimv
+" Version: 0.9.6
+" Last Change: 12 Mar 2012
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if &cp || exists( 'g:slimv_cljapi_loaded' )
+ finish
+endif
+
+let g:slimv_cljapi_loaded = 1
+
+" Root of the Clojure API
+if !exists( 'g:slimv_cljapi_root' )
+ let g:slimv_cljapi_root = 'http://clojure.github.com/clojure/'
+endif
+
+if !exists( 'g:slimv_cljapi_db' )
+ let g:slimv_cljapi_db = [
+ \["*", "clojure.core-api.html\\#clojure.core/*"],
+ \["*'", "clojure.core-api.html\\#clojure.core/*'"],
+ \["*1", "clojure.core-api.html\\#clojure.core/*1"],
+ \["*2", "clojure.core-api.html\\#clojure.core/*2"],
+ \["*3", "clojure.core-api.html\\#clojure.core/*3"],
+ \["*agent*", "clojure.core-api.html\\#clojure.core/*agent*"],
+ \["*clojure-version*", "clojure.core-api.html\\#clojure.core/*clojure-version*"],
+ \["*command-line-args*", "clojure.core-api.html\\#clojure.core/*command-line-args*"],
+ \["*compile-files*", "clojure.core-api.html\\#clojure.core/*compile-files*"],
+ \["*compile-path*", "clojure.core-api.html\\#clojure.core/*compile-path*"],
+ \["*e", "clojure.core-api.html\\#clojure.core/*e"],
+ \["*err*", "clojure.core-api.html\\#clojure.core/*err*"],
+ \["*file*", "clojure.core-api.html\\#clojure.core/*file*"],
+ \["*flush-on-newline*", "clojure.core-api.html\\#clojure.core/*flush-on-newline*"],
+ \["*in*", "clojure.core-api.html\\#clojure.core/*in*"],
+ \["*ns*", "clojure.core-api.html\\#clojure.core/*ns*"],
+ \["*out*", "clojure.core-api.html\\#clojure.core/*out*"],
+ \["*print-dup*", "clojure.core-api.html\\#clojure.core/*print-dup*"],
+ \["*print-length*", "clojure.core-api.html\\#clojure.core/*print-length*"],
+ \["*print-level*", "clojure.core-api.html\\#clojure.core/*print-level*"],
+ \["*print-meta*", "clojure.core-api.html\\#clojure.core/*print-meta*"],
+ \["*print-readably*", "clojure.core-api.html\\#clojure.core/*print-readably*"],
+ \["*read-eval*", "clojure.core-api.html\\#clojure.core/*read-eval*"],
+ \["*unchecked-math*", "clojure.core-api.html\\#clojure.core/*unchecked-math*"],
+ \["*warn-on-reflection*", "clojure.core-api.html\\#clojure.core/*warn-on-reflection*"],
+ \["+", "clojure.core-api.html\\#clojure.core/+"],
+ \["+'", "clojure.core-api.html\\#clojure.core/+'"],
+ \["-", "clojure.core-api.html\\#clojure.core/-"],
+ \["-'", "clojure.core-api.html\\#clojure.core/-'"],
+ \["->", "clojure.core-api.html\\#clojure.core/->"],
+ \["->>", "clojure.core-api.html\\#clojure.core/->>"],
+ \["..", "clojure.core-api.html\\#clojure.core/.."],
+ \["/", "clojure.core-api.html\\#clojure.core//"],
+ \["<", "clojure.core-api.html\\#clojure.core/<"],
+ \["<=", "clojure.core-api.html\\#clojure.core/<="],
+ \["=", "clojure.core-api.html\\#clojure.core/="],
+ \["==", "clojure.core-api.html\\#clojure.core/=="],
+ \[">", "clojure.core-api.html\\#clojure.core/>"],
+ \[">=", "clojure.core-api.html\\#clojure.core/>="],
+ \["accessor", "clojure.core-api.html\\#clojure.core/accessor"],
+ \["aclone", "clojure.core-api.html\\#clojure.core/aclone"],
+ \["add-classpath", "clojure.core-api.html\\#clojure.core/add-classpath"],
+ \["add-watch", "clojure.core-api.html\\#clojure.core/add-watch"],
+ \["agent", "clojure.core-api.html\\#clojure.core/agent"],
+ \["agent-error", "clojure.core-api.html\\#clojure.core/agent-error"],
+ \["agent-errors", "clojure.core-api.html\\#clojure.core/agent-errors"],
+ \["aget", "clojure.core-api.html\\#clojure.core/aget"],
+ \["alength", "clojure.core-api.html\\#clojure.core/alength"],
+ \["alias", "clojure.core-api.html\\#clojure.core/alias"],
+ \["all-ns", "clojure.core-api.html\\#clojure.core/all-ns"],
+ \["alter", "clojure.core-api.html\\#clojure.core/alter"],
+ \["alter-meta!", "clojure.core-api.html\\#clojure.core/alter-meta!"],
+ \["alter-var-root", "clojure.core-api.html\\#clojure.core/alter-var-root"],
+ \["amap", "clojure.core-api.html\\#clojure.core/amap"],
+ \["ancestors", "clojure.core-api.html\\#clojure.core/ancestors"],
+ \["and", "clojure.core-api.html\\#clojure.core/and"],
+ \["apply", "clojure.core-api.html\\#clojure.core/apply"],
+ \["areduce", "clojure.core-api.html\\#clojure.core/areduce"],
+ \["array-map", "clojure.core-api.html\\#clojure.core/array-map"],
+ \["aset", "clojure.core-api.html\\#clojure.core/aset"],
+ \["aset-boolean", "clojure.core-api.html\\#clojure.core/aset-boolean"],
+ \["aset-byte", "clojure.core-api.html\\#clojure.core/aset-byte"],
+ \["aset-char", "clojure.core-api.html\\#clojure.core/aset-char"],
+ \["aset-double", "clojure.core-api.html\\#clojure.core/aset-double"],
+ \["aset-float", "clojure.core-api.html\\#clojure.core/aset-float"],
+ \["aset-int", "clojure.core-api.html\\#clojure.core/aset-int"],
+ \["aset-long", "clojure.core-api.html\\#clojure.core/aset-long"],
+ \["aset-short", "clojure.core-api.html\\#clojure.core/aset-short"],
+ \["assert", "clojure.core-api.html\\#clojure.core/assert"],
+ \["assoc", "clojure.core-api.html\\#clojure.core/assoc"],
+ \["assoc!", "clojure.core-api.html\\#clojure.core/assoc!"],
+ \["assoc-in", "clojure.core-api.html\\#clojure.core/assoc-in"],
+ \["associative?", "clojure.core-api.html\\#clojure.core/associative?"],
+ \["atom", "clojure.core-api.html\\#clojure.core/atom"],
+ \["await", "clojure.core-api.html\\#clojure.core/await"],
+ \["await-for", "clojure.core-api.html\\#clojure.core/await-for"],
+ \["bases", "clojure.core-api.html\\#clojure.core/bases"],
+ \["bean", "clojure.core-api.html\\#clojure.core/bean"],
+ \["bigdec", "clojure.core-api.html\\#clojure.core/bigdec"],
+ \["bigint", "clojure.core-api.html\\#clojure.core/bigint"],
+ \["biginteger", "clojure.core-api.html\\#clojure.core/biginteger"],
+ \["binding", "clojure.core-api.html\\#clojure.core/binding"],
+ \["bit-and", "clojure.core-api.html\\#clojure.core/bit-and"],
+ \["bit-and-not", "clojure.core-api.html\\#clojure.core/bit-and-not"],
+ \["bit-clear", "clojure.core-api.html\\#clojure.core/bit-clear"],
+ \["bit-flip", "clojure.core-api.html\\#clojure.core/bit-flip"],
+ \["bit-not", "clojure.core-api.html\\#clojure.core/bit-not"],
+ \["bit-or", "clojure.core-api.html\\#clojure.core/bit-or"],
+ \["bit-set", "clojure.core-api.html\\#clojure.core/bit-set"],
+ \["bit-shift-left", "clojure.core-api.html\\#clojure.core/bit-shift-left"],
+ \["bit-shift-right", "clojure.core-api.html\\#clojure.core/bit-shift-right"],
+ \["bit-test", "clojure.core-api.html\\#clojure.core/bit-test"],
+ \["bit-xor", "clojure.core-api.html\\#clojure.core/bit-xor"],
+ \["boolean", "clojure.core-api.html\\#clojure.core/boolean"],
+ \["boolean-array", "clojure.core-api.html\\#clojure.core/boolean-array"],
+ \["booleans", "clojure.core-api.html\\#clojure.core/booleans"],
+ \["bound-fn", "clojure.core-api.html\\#clojure.core/bound-fn"],
+ \["bound-fn*", "clojure.core-api.html\\#clojure.core/bound-fn*"],
+ \["bound?", "clojure.core-api.html\\#clojure.core/bound?"],
+ \["butlast", "clojure.core-api.html\\#clojure.core/butlast"],
+ \["byte", "clojure.core-api.html\\#clojure.core/byte"],
+ \["byte-array", "clojure.core-api.html\\#clojure.core/byte-array"],
+ \["bytes", "clojure.core-api.html\\#clojure.core/bytes"],
+ \["case", "clojure.core-api.html\\#clojure.core/case"],
+ \["cast", "clojure.core-api.html\\#clojure.core/cast"],
+ \["char", "clojure.core-api.html\\#clojure.core/char"],
+ \["char-array", "clojure.core-api.html\\#clojure.core/char-array"],
+ \["char-escape-string", "clojure.core-api.html\\#clojure.core/char-escape-string"],
+ \["char-name-string", "clojure.core-api.html\\#clojure.core/char-name-string"],
+ \["char?", "clojure.core-api.html\\#clojure.core/char?"],
+ \["chars", "clojure.core-api.html\\#clojure.core/chars"],
+ \["class", "clojure.core-api.html\\#clojure.core/class"],
+ \["class?", "clojure.core-api.html\\#clojure.core/class?"],
+ \["clear-agent-errors", "clojure.core-api.html\\#clojure.core/clear-agent-errors"],
+ \["clojure-version", "clojure.core-api.html\\#clojure.core/clojure-version"],
+ \["coll?", "clojure.core-api.html\\#clojure.core/coll?"],
+ \["comment", "clojure.core-api.html\\#clojure.core/comment"],
+ \["commute", "clojure.core-api.html\\#clojure.core/commute"],
+ \["comp", "clojure.core-api.html\\#clojure.core/comp"],
+ \["comparator", "clojure.core-api.html\\#clojure.core/comparator"],
+ \["compare", "clojure.core-api.html\\#clojure.core/compare"],
+ \["compare-and-set!", "clojure.core-api.html\\#clojure.core/compare-and-set!"],
+ \["compile", "clojure.core-api.html\\#clojure.core/compile"],
+ \["complement", "clojure.core-api.html\\#clojure.core/complement"],
+ \["concat", "clojure.core-api.html\\#clojure.core/concat"],
+ \["cond", "clojure.core-api.html\\#clojure.core/cond"],
+ \["condp", "clojure.core-api.html\\#clojure.core/condp"],
+ \["conj", "clojure.core-api.html\\#clojure.core/conj"],
+ \["conj!", "clojure.core-api.html\\#clojure.core/conj!"],
+ \["cons", "clojure.core-api.html\\#clojure.core/cons"],
+ \["constantly", "clojure.core-api.html\\#clojure.core/constantly"],
+ \["construct-proxy", "clojure.core-api.html\\#clojure.core/construct-proxy"],
+ \["contains?", "clojure.core-api.html\\#clojure.core/contains?"],
+ \["count", "clojure.core-api.html\\#clojure.core/count"],
+ \["counted?", "clojure.core-api.html\\#clojure.core/counted?"],
+ \["create-ns", "clojure.core-api.html\\#clojure.core/create-ns"],
+ \["create-struct", "clojure.core-api.html\\#clojure.core/create-struct"],
+ \["cycle", "clojure.core-api.html\\#clojure.core/cycle"],
+ \["dec", "clojure.core-api.html\\#clojure.core/dec"],
+ \["dec'", "clojure.core-api.html\\#clojure.core/dec'"],
+ \["decimal?", "clojure.core-api.html\\#clojure.core/decimal?"],
+ \["declare", "clojure.core-api.html\\#clojure.core/declare"],
+ \["definline", "clojure.core-api.html\\#clojure.core/definline"],
+ \["defmacro", "clojure.core-api.html\\#clojure.core/defmacro"],
+ \["defmethod", "clojure.core-api.html\\#clojure.core/defmethod"],
+ \["defmulti", "clojure.core-api.html\\#clojure.core/defmulti"],
+ \["defn", "clojure.core-api.html\\#clojure.core/defn"],
+ \["defn-", "clojure.core-api.html\\#clojure.core/defn-"],
+ \["defonce", "clojure.core-api.html\\#clojure.core/defonce"],
+ \["defprotocol", "clojure.core-api.html\\#clojure.core/defprotocol"],
+ \["defrecord", "clojure.core-api.html\\#clojure.core/defrecord"],
+ \["defstruct", "clojure.core-api.html\\#clojure.core/defstruct"],
+ \["deftype", "clojure.core-api.html\\#clojure.core/deftype"],
+ \["delay", "clojure.core-api.html\\#clojure.core/delay"],
+ \["delay?", "clojure.core-api.html\\#clojure.core/delay?"],
+ \["deliver", "clojure.core-api.html\\#clojure.core/deliver"],
+ \["denominator", "clojure.core-api.html\\#clojure.core/denominator"],
+ \["deref", "clojure.core-api.html\\#clojure.core/deref"],
+ \["derive", "clojure.core-api.html\\#clojure.core/derive"],
+ \["descendants", "clojure.core-api.html\\#clojure.core/descendants"],
+ \["disj", "clojure.core-api.html\\#clojure.core/disj"],
+ \["disj!", "clojure.core-api.html\\#clojure.core/disj!"],
+ \["dissoc", "clojure.core-api.html\\#clojure.core/dissoc"],
+ \["dissoc!", "clojure.core-api.html\\#clojure.core/dissoc!"],
+ \["distinct", "clojure.core-api.html\\#clojure.core/distinct"],
+ \["distinct?", "clojure.core-api.html\\#clojure.core/distinct?"],
+ \["doall", "clojure.core-api.html\\#clojure.core/doall"],
+ \["dorun", "clojure.core-api.html\\#clojure.core/dorun"],
+ \["doseq", "clojure.core-api.html\\#clojure.core/doseq"],
+ \["dosync", "clojure.core-api.html\\#clojure.core/dosync"],
+ \["dotimes", "clojure.core-api.html\\#clojure.core/dotimes"],
+ \["doto", "clojure.core-api.html\\#clojure.core/doto"],
+ \["double", "clojure.core-api.html\\#clojure.core/double"],
+ \["double-array", "clojure.core-api.html\\#clojure.core/double-array"],
+ \["doubles", "clojure.core-api.html\\#clojure.core/doubles"],
+ \["drop", "clojure.core-api.html\\#clojure.core/drop"],
+ \["drop-last", "clojure.core-api.html\\#clojure.core/drop-last"],
+ \["drop-while", "clojure.core-api.html\\#clojure.core/drop-while"],
+ \["empty", "clojure.core-api.html\\#clojure.core/empty"],
+ \["empty?", "clojure.core-api.html\\#clojure.core/empty?"],
+ \["ensure", "clojure.core-api.html\\#clojure.core/ensure"],
+ \["enumeration-seq", "clojure.core-api.html\\#clojure.core/enumeration-seq"],
+ \["error-handler", "clojure.core-api.html\\#clojure.core/error-handler"],
+ \["error-mode", "clojure.core-api.html\\#clojure.core/error-mode"],
+ \["eval", "clojure.core-api.html\\#clojure.core/eval"],
+ \["even?", "clojure.core-api.html\\#clojure.core/even?"],
+ \["every-pred", "clojure.core-api.html\\#clojure.core/every-pred"],
+ \["every?", "clojure.core-api.html\\#clojure.core/every?"],
+ \["extend", "clojure.core-api.html\\#clojure.core/extend"],
+ \["extend-protocol", "clojure.core-api.html\\#clojure.core/extend-protocol"],
+ \["extend-type", "clojure.core-api.html\\#clojure.core/extend-type"],
+ \["extenders", "clojure.core-api.html\\#clojure.core/extenders"],
+ \["extends?", "clojure.core-api.html\\#clojure.core/extends?"],
+ \["false?", "clojure.core-api.html\\#clojure.core/false?"],
+ \["ffirst", "clojure.core-api.html\\#clojure.core/ffirst"],
+ \["file-seq", "clojure.core-api.html\\#clojure.core/file-seq"],
+ \["filter", "clojure.core-api.html\\#clojure.core/filter"],
+ \["find", "clojure.core-api.html\\#clojure.core/find"],
+ \["find-keyword", "clojure.core-api.html\\#clojure.core/find-keyword"],
+ \["find-ns", "clojure.core-api.html\\#clojure.core/find-ns"],
+ \["find-var", "clojure.core-api.html\\#clojure.core/find-var"],
+ \["first", "clojure.core-api.html\\#clojure.core/first"],
+ \["flatten", "clojure.core-api.html\\#clojure.core/flatten"],
+ \["float", "clojure.core-api.html\\#clojure.core/float"],
+ \["float-array", "clojure.core-api.html\\#clojure.core/float-array"],
+ \["float?", "clojure.core-api.html\\#clojure.core/float?"],
+ \["floats", "clojure.core-api.html\\#clojure.core/floats"],
+ \["flush", "clojure.core-api.html\\#clojure.core/flush"],
+ \["fn", "clojure.core-api.html\\#clojure.core/fn"],
+ \["fn?", "clojure.core-api.html\\#clojure.core/fn?"],
+ \["fnext", "clojure.core-api.html\\#clojure.core/fnext"],
+ \["fnil", "clojure.core-api.html\\#clojure.core/fnil"],
+ \["for", "clojure.core-api.html\\#clojure.core/for"],
+ \["force", "clojure.core-api.html\\#clojure.core/force"],
+ \["format", "clojure.core-api.html\\#clojure.core/format"],
+ \["frequencies", "clojure.core-api.html\\#clojure.core/frequencies"],
+ \["future", "clojure.core-api.html\\#clojure.core/future"],
+ \["future-call", "clojure.core-api.html\\#clojure.core/future-call"],
+ \["future-cancel", "clojure.core-api.html\\#clojure.core/future-cancel"],
+ \["future-cancelled?", "clojure.core-api.html\\#clojure.core/future-cancelled?"],
+ \["future-done?", "clojure.core-api.html\\#clojure.core/future-done?"],
+ \["future?", "clojure.core-api.html\\#clojure.core/future?"],
+ \["gen-class", "clojure.core-api.html\\#clojure.core/gen-class"],
+ \["gen-interface", "clojure.core-api.html\\#clojure.core/gen-interface"],
+ \["gensym", "clojure.core-api.html\\#clojure.core/gensym"],
+ \["get", "clojure.core-api.html\\#clojure.core/get"],
+ \["get-in", "clojure.core-api.html\\#clojure.core/get-in"],
+ \["get-method", "clojure.core-api.html\\#clojure.core/get-method"],
+ \["get-proxy-class", "clojure.core-api.html\\#clojure.core/get-proxy-class"],
+ \["get-thread-bindings", "clojure.core-api.html\\#clojure.core/get-thread-bindings"],
+ \["get-validator", "clojure.core-api.html\\#clojure.core/get-validator"],
+ \["group-by", "clojure.core-api.html\\#clojure.core/group-by"],
+ \["hash", "clojure.core-api.html\\#clojure.core/hash"],
+ \["hash-map", "clojure.core-api.html\\#clojure.core/hash-map"],
+ \["hash-set", "clojure.core-api.html\\#clojure.core/hash-set"],
+ \["identical?", "clojure.core-api.html\\#clojure.core/identical?"],
+ \["identity", "clojure.core-api.html\\#clojure.core/identity"],
+ \["if-let", "clojure.core-api.html\\#clojure.core/if-let"],
+ \["if-not", "clojure.core-api.html\\#clojure.core/if-not"],
+ \["ifn?", "clojure.core-api.html\\#clojure.core/ifn?"],
+ \["import", "clojure.core-api.html\\#clojure.core/import"],
+ \["in-ns", "clojure.core-api.html\\#clojure.core/in-ns"],
+ \["inc", "clojure.core-api.html\\#clojure.core/inc"],
+ \["inc'", "clojure.core-api.html\\#clojure.core/inc'"],
+ \["init-proxy", "clojure.core-api.html\\#clojure.core/init-proxy"],
+ \["instance?", "clojure.core-api.html\\#clojure.core/instance?"],
+ \["int", "clojure.core-api.html\\#clojure.core/int"],
+ \["int-array", "clojure.core-api.html\\#clojure.core/int-array"],
+ \["integer?", "clojure.core-api.html\\#clojure.core/integer?"],
+ \["interleave", "clojure.core-api.html\\#clojure.core/interleave"],
+ \["intern", "clojure.core-api.html\\#clojure.core/intern"],
+ \["interpose", "clojure.core-api.html\\#clojure.core/interpose"],
+ \["into", "clojure.core-api.html\\#clojure.core/into"],
+ \["into-array", "clojure.core-api.html\\#clojure.core/into-array"],
+ \["ints", "clojure.core-api.html\\#clojure.core/ints"],
+ \["io!", "clojure.core-api.html\\#clojure.core/io!"],
+ \["isa?", "clojure.core-api.html\\#clojure.core/isa?"],
+ \["iterate", "clojure.core-api.html\\#clojure.core/iterate"],
+ \["iterator-seq", "clojure.core-api.html\\#clojure.core/iterator-seq"],
+ \["juxt", "clojure.core-api.html\\#clojure.core/juxt"],
+ \["keep", "clojure.core-api.html\\#clojure.core/keep"],
+ \["keep-indexed", "clojure.core-api.html\\#clojure.core/keep-indexed"],
+ \["key", "clojure.core-api.html\\#clojure.core/key"],
+ \["keys", "clojure.core-api.html\\#clojure.core/keys"],
+ \["keyword", "clojure.core-api.html\\#clojure.core/keyword"],
+ \["keyword?", "clojure.core-api.html\\#clojure.core/keyword?"],
+ \["last", "clojure.core-api.html\\#clojure.core/last"],
+ \["lazy-cat", "clojure.core-api.html\\#clojure.core/lazy-cat"],
+ \["lazy-seq", "clojure.core-api.html\\#clojure.core/lazy-seq"],
+ \["let", "clojure.core-api.html\\#clojure.core/let"],
+ \["letfn", "clojure.core-api.html\\#clojure.core/letfn"],
+ \["line-seq", "clojure.core-api.html\\#clojure.core/line-seq"],
+ \["list", "clojure.core-api.html\\#clojure.core/list"],
+ \["list*", "clojure.core-api.html\\#clojure.core/list*"],
+ \["list?", "clojure.core-api.html\\#clojure.core/list?"],
+ \["load", "clojure.core-api.html\\#clojure.core/load"],
+ \["load-file", "clojure.core-api.html\\#clojure.core/load-file"],
+ \["load-reader", "clojure.core-api.html\\#clojure.core/load-reader"],
+ \["load-string", "clojure.core-api.html\\#clojure.core/load-string"],
+ \["loaded-libs", "clojure.core-api.html\\#clojure.core/loaded-libs"],
+ \["locking", "clojure.core-api.html\\#clojure.core/locking"],
+ \["long", "clojure.core-api.html\\#clojure.core/long"],
+ \["long-array", "clojure.core-api.html\\#clojure.core/long-array"],
+ \["longs", "clojure.core-api.html\\#clojure.core/longs"],
+ \["loop", "clojure.core-api.html\\#clojure.core/loop"],
+ \["macroexpand", "clojure.core-api.html\\#clojure.core/macroexpand"],
+ \["macroexpand-1", "clojure.core-api.html\\#clojure.core/macroexpand-1"],
+ \["make-array", "clojure.core-api.html\\#clojure.core/make-array"],
+ \["make-hierarchy", "clojure.core-api.html\\#clojure.core/make-hierarchy"],
+ \["map", "clojure.core-api.html\\#clojure.core/map"],
+ \["map-indexed", "clojure.core-api.html\\#clojure.core/map-indexed"],
+ \["map?", "clojure.core-api.html\\#clojure.core/map?"],
+ \["mapcat", "clojure.core-api.html\\#clojure.core/mapcat"],
+ \["max", "clojure.core-api.html\\#clojure.core/max"],
+ \["max-key", "clojure.core-api.html\\#clojure.core/max-key"],
+ \["memfn", "clojure.core-api.html\\#clojure.core/memfn"],
+ \["memoize", "clojure.core-api.html\\#clojure.core/memoize"],
+ \["merge", "clojure.core-api.html\\#clojure.core/merge"],
+ \["merge-with", "clojure.core-api.html\\#clojure.core/merge-with"],
+ \["meta", "clojure.core-api.html\\#clojure.core/meta"],
+ \["methods", "clojure.core-api.html\\#clojure.core/methods"],
+ \["min", "clojure.core-api.html\\#clojure.core/min"],
+ \["min-key", "clojure.core-api.html\\#clojure.core/min-key"],
+ \["mod", "clojure.core-api.html\\#clojure.core/mod"],
+ \["name", "clojure.core-api.html\\#clojure.core/name"],
+ \["namespace", "clojure.core-api.html\\#clojure.core/namespace"],
+ \["namespace-munge", "clojure.core-api.html\\#clojure.core/namespace-munge"],
+ \["neg?", "clojure.core-api.html\\#clojure.core/neg?"],
+ \["newline", "clojure.core-api.html\\#clojure.core/newline"],
+ \["next", "clojure.core-api.html\\#clojure.core/next"],
+ \["nfirst", "clojure.core-api.html\\#clojure.core/nfirst"],
+ \["nil?", "clojure.core-api.html\\#clojure.core/nil?"],
+ \["nnext", "clojure.core-api.html\\#clojure.core/nnext"],
+ \["not", "clojure.core-api.html\\#clojure.core/not"],
+ \["not-any?", "clojure.core-api.html\\#clojure.core/not-any?"],
+ \["not-empty", "clojure.core-api.html\\#clojure.core/not-empty"],
+ \["not-every?", "clojure.core-api.html\\#clojure.core/not-every?"],
+ \["not=", "clojure.core-api.html\\#clojure.core/not="],
+ \["ns", "clojure.core-api.html\\#clojure.core/ns"],
+ \["ns-aliases", "clojure.core-api.html\\#clojure.core/ns-aliases"],
+ \["ns-imports", "clojure.core-api.html\\#clojure.core/ns-imports"],
+ \["ns-interns", "clojure.core-api.html\\#clojure.core/ns-interns"],
+ \["ns-map", "clojure.core-api.html\\#clojure.core/ns-map"],
+ \["ns-name", "clojure.core-api.html\\#clojure.core/ns-name"],
+ \["ns-publics", "clojure.core-api.html\\#clojure.core/ns-publics"],
+ \["ns-refers", "clojure.core-api.html\\#clojure.core/ns-refers"],
+ \["ns-resolve", "clojure.core-api.html\\#clojure.core/ns-resolve"],
+ \["ns-unalias", "clojure.core-api.html\\#clojure.core/ns-unalias"],
+ \["ns-unmap", "clojure.core-api.html\\#clojure.core/ns-unmap"],
+ \["nth", "clojure.core-api.html\\#clojure.core/nth"],
+ \["nthnext", "clojure.core-api.html\\#clojure.core/nthnext"],
+ \["nthrest", "clojure.core-api.html\\#clojure.core/nthrest"],
+ \["num", "clojure.core-api.html\\#clojure.core/num"],
+ \["number?", "clojure.core-api.html\\#clojure.core/number?"],
+ \["numerator", "clojure.core-api.html\\#clojure.core/numerator"],
+ \["object-array", "clojure.core-api.html\\#clojure.core/object-array"],
+ \["odd?", "clojure.core-api.html\\#clojure.core/odd?"],
+ \["or", "clojure.core-api.html\\#clojure.core/or"],
+ \["parents", "clojure.core-api.html\\#clojure.core/parents"],
+ \["partial", "clojure.core-api.html\\#clojure.core/partial"],
+ \["partition", "clojure.core-api.html\\#clojure.core/partition"],
+ \["partition-all", "clojure.core-api.html\\#clojure.core/partition-all"],
+ \["partition-by", "clojure.core-api.html\\#clojure.core/partition-by"],
+ \["pcalls", "clojure.core-api.html\\#clojure.core/pcalls"],
+ \["peek", "clojure.core-api.html\\#clojure.core/peek"],
+ \["persistent!", "clojure.core-api.html\\#clojure.core/persistent!"],
+ \["pmap", "clojure.core-api.html\\#clojure.core/pmap"],
+ \["pop", "clojure.core-api.html\\#clojure.core/pop"],
+ \["pop!", "clojure.core-api.html\\#clojure.core/pop!"],
+ \["pop-thread-bindings", "clojure.core-api.html\\#clojure.core/pop-thread-bindings"],
+ \["pos?", "clojure.core-api.html\\#clojure.core/pos?"],
+ \["pr", "clojure.core-api.html\\#clojure.core/pr"],
+ \["pr-str", "clojure.core-api.html\\#clojure.core/pr-str"],
+ \["prefer-method", "clojure.core-api.html\\#clojure.core/prefer-method"],
+ \["prefers", "clojure.core-api.html\\#clojure.core/prefers"],
+ \["print", "clojure.core-api.html\\#clojure.core/print"],
+ \["print-str", "clojure.core-api.html\\#clojure.core/print-str"],
+ \["printf", "clojure.core-api.html\\#clojure.core/printf"],
+ \["println", "clojure.core-api.html\\#clojure.core/println"],
+ \["println-str", "clojure.core-api.html\\#clojure.core/println-str"],
+ \["prn", "clojure.core-api.html\\#clojure.core/prn"],
+ \["prn-str", "clojure.core-api.html\\#clojure.core/prn-str"],
+ \["promise", "clojure.core-api.html\\#clojure.core/promise"],
+ \["proxy", "clojure.core-api.html\\#clojure.core/proxy"],
+ \["proxy-mappings", "clojure.core-api.html\\#clojure.core/proxy-mappings"],
+ \["proxy-super", "clojure.core-api.html\\#clojure.core/proxy-super"],
+ \["push-thread-bindings", "clojure.core-api.html\\#clojure.core/push-thread-bindings"],
+ \["pvalues", "clojure.core-api.html\\#clojure.core/pvalues"],
+ \["quot", "clojure.core-api.html\\#clojure.core/quot"],
+ \["rand", "clojure.core-api.html\\#clojure.core/rand"],
+ \["rand-int", "clojure.core-api.html\\#clojure.core/rand-int"],
+ \["rand-nth", "clojure.core-api.html\\#clojure.core/rand-nth"],
+ \["range", "clojure.core-api.html\\#clojure.core/range"],
+ \["ratio?", "clojure.core-api.html\\#clojure.core/ratio?"],
+ \["rational?", "clojure.core-api.html\\#clojure.core/rational?"],
+ \["rationalize", "clojure.core-api.html\\#clojure.core/rationalize"],
+ \["re-find", "clojure.core-api.html\\#clojure.core/re-find"],
+ \["re-groups", "clojure.core-api.html\\#clojure.core/re-groups"],
+ \["re-matcher", "clojure.core-api.html\\#clojure.core/re-matcher"],
+ \["re-matches", "clojure.core-api.html\\#clojure.core/re-matches"],
+ \["re-pattern", "clojure.core-api.html\\#clojure.core/re-pattern"],
+ \["re-seq", "clojure.core-api.html\\#clojure.core/re-seq"],
+ \["read", "clojure.core-api.html\\#clojure.core/read"],
+ \["read-line", "clojure.core-api.html\\#clojure.core/read-line"],
+ \["read-string", "clojure.core-api.html\\#clojure.core/read-string"],
+ \["realized?", "clojure.core-api.html\\#clojure.core/realized?"],
+ \["reduce", "clojure.core-api.html\\#clojure.core/reduce"],
+ \["reductions", "clojure.core-api.html\\#clojure.core/reductions"],
+ \["ref", "clojure.core-api.html\\#clojure.core/ref"],
+ \["ref-history-count", "clojure.core-api.html\\#clojure.core/ref-history-count"],
+ \["ref-max-history", "clojure.core-api.html\\#clojure.core/ref-max-history"],
+ \["ref-min-history", "clojure.core-api.html\\#clojure.core/ref-min-history"],
+ \["ref-set", "clojure.core-api.html\\#clojure.core/ref-set"],
+ \["refer", "clojure.core-api.html\\#clojure.core/refer"],
+ \["refer-clojure", "clojure.core-api.html\\#clojure.core/refer-clojure"],
+ \["reify", "clojure.core-api.html\\#clojure.core/reify"],
+ \["release-pending-sends", "clojure.core-api.html\\#clojure.core/release-pending-sends"],
+ \["rem", "clojure.core-api.html\\#clojure.core/rem"],
+ \["remove", "clojure.core-api.html\\#clojure.core/remove"],
+ \["remove-all-methods", "clojure.core-api.html\\#clojure.core/remove-all-methods"],
+ \["remove-method", "clojure.core-api.html\\#clojure.core/remove-method"],
+ \["remove-ns", "clojure.core-api.html\\#clojure.core/remove-ns"],
+ \["remove-watch", "clojure.core-api.html\\#clojure.core/remove-watch"],
+ \["repeat", "clojure.core-api.html\\#clojure.core/repeat"],
+ \["repeatedly", "clojure.core-api.html\\#clojure.core/repeatedly"],
+ \["replace", "clojure.core-api.html\\#clojure.core/replace"],
+ \["replicate", "clojure.core-api.html\\#clojure.core/replicate"],
+ \["require", "clojure.core-api.html\\#clojure.core/require"],
+ \["reset!", "clojure.core-api.html\\#clojure.core/reset!"],
+ \["reset-meta!", "clojure.core-api.html\\#clojure.core/reset-meta!"],
+ \["resolve", "clojure.core-api.html\\#clojure.core/resolve"],
+ \["rest", "clojure.core-api.html\\#clojure.core/rest"],
+ \["restart-agent", "clojure.core-api.html\\#clojure.core/restart-agent"],
+ \["resultset-seq", "clojure.core-api.html\\#clojure.core/resultset-seq"],
+ \["reverse", "clojure.core-api.html\\#clojure.core/reverse"],
+ \["reversible?", "clojure.core-api.html\\#clojure.core/reversible?"],
+ \["rseq", "clojure.core-api.html\\#clojure.core/rseq"],
+ \["rsubseq", "clojure.core-api.html\\#clojure.core/rsubseq"],
+ \["satisfies?", "clojure.core-api.html\\#clojure.core/satisfies?"],
+ \["second", "clojure.core-api.html\\#clojure.core/second"],
+ \["select-keys", "clojure.core-api.html\\#clojure.core/select-keys"],
+ \["send", "clojure.core-api.html\\#clojure.core/send"],
+ \["send-off", "clojure.core-api.html\\#clojure.core/send-off"],
+ \["seq", "clojure.core-api.html\\#clojure.core/seq"],
+ \["seq?", "clojure.core-api.html\\#clojure.core/seq?"],
+ \["seque", "clojure.core-api.html\\#clojure.core/seque"],
+ \["sequence", "clojure.core-api.html\\#clojure.core/sequence"],
+ \["sequential?", "clojure.core-api.html\\#clojure.core/sequential?"],
+ \["set", "clojure.core-api.html\\#clojure.core/set"],
+ \["set-error-handler!", "clojure.core-api.html\\#clojure.core/set-error-handler!"],
+ \["set-error-mode!", "clojure.core-api.html\\#clojure.core/set-error-mode!"],
+ \["set-validator!", "clojure.core-api.html\\#clojure.core/set-validator!"],
+ \["set?", "clojure.core-api.html\\#clojure.core/set?"],
+ \["short", "clojure.core-api.html\\#clojure.core/short"],
+ \["short-array", "clojure.core-api.html\\#clojure.core/short-array"],
+ \["shorts", "clojure.core-api.html\\#clojure.core/shorts"],
+ \["shuffle", "clojure.core-api.html\\#clojure.core/shuffle"],
+ \["shutdown-agents", "clojure.core-api.html\\#clojure.core/shutdown-agents"],
+ \["slurp", "clojure.core-api.html\\#clojure.core/slurp"],
+ \["some", "clojure.core-api.html\\#clojure.core/some"],
+ \["some-fn", "clojure.core-api.html\\#clojure.core/some-fn"],
+ \["sort", "clojure.core-api.html\\#clojure.core/sort"],
+ \["sort-by", "clojure.core-api.html\\#clojure.core/sort-by"],
+ \["sorted-map", "clojure.core-api.html\\#clojure.core/sorted-map"],
+ \["sorted-map-by", "clojure.core-api.html\\#clojure.core/sorted-map-by"],
+ \["sorted-set", "clojure.core-api.html\\#clojure.core/sorted-set"],
+ \["sorted-set-by", "clojure.core-api.html\\#clojure.core/sorted-set-by"],
+ \["sorted?", "clojure.core-api.html\\#clojure.core/sorted?"],
+ \["special-symbol?", "clojure.core-api.html\\#clojure.core/special-symbol?"],
+ \["spit", "clojure.core-api.html\\#clojure.core/spit"],
+ \["split-at", "clojure.core-api.html\\#clojure.core/split-at"],
+ \["split-with", "clojure.core-api.html\\#clojure.core/split-with"],
+ \["str", "clojure.core-api.html\\#clojure.core/str"],
+ \["string?", "clojure.core-api.html\\#clojure.core/string?"],
+ \["struct", "clojure.core-api.html\\#clojure.core/struct"],
+ \["struct-map", "clojure.core-api.html\\#clojure.core/struct-map"],
+ \["subs", "clojure.core-api.html\\#clojure.core/subs"],
+ \["subseq", "clojure.core-api.html\\#clojure.core/subseq"],
+ \["subvec", "clojure.core-api.html\\#clojure.core/subvec"],
+ \["supers", "clojure.core-api.html\\#clojure.core/supers"],
+ \["swap!", "clojure.core-api.html\\#clojure.core/swap!"],
+ \["symbol", "clojure.core-api.html\\#clojure.core/symbol"],
+ \["symbol?", "clojure.core-api.html\\#clojure.core/symbol?"],
+ \["sync", "clojure.core-api.html\\#clojure.core/sync"],
+ \["take", "clojure.core-api.html\\#clojure.core/take"],
+ \["take-last", "clojure.core-api.html\\#clojure.core/take-last"],
+ \["take-nth", "clojure.core-api.html\\#clojure.core/take-nth"],
+ \["take-while", "clojure.core-api.html\\#clojure.core/take-while"],
+ \["test", "clojure.core-api.html\\#clojure.core/test"],
+ \["the-ns", "clojure.core-api.html\\#clojure.core/the-ns"],
+ \["thread-bound?", "clojure.core-api.html\\#clojure.core/thread-bound?"],
+ \["time", "clojure.core-api.html\\#clojure.core/time"],
+ \["to-array", "clojure.core-api.html\\#clojure.core/to-array"],
+ \["to-array-2d", "clojure.core-api.html\\#clojure.core/to-array-2d"],
+ \["trampoline", "clojure.core-api.html\\#clojure.core/trampoline"],
+ \["transient", "clojure.core-api.html\\#clojure.core/transient"],
+ \["tree-seq", "clojure.core-api.html\\#clojure.core/tree-seq"],
+ \["true?", "clojure.core-api.html\\#clojure.core/true?"],
+ \["type", "clojure.core-api.html\\#clojure.core/type"],
+ \["unchecked-add", "clojure.core-api.html\\#clojure.core/unchecked-add"],
+ \["unchecked-add-int", "clojure.core-api.html\\#clojure.core/unchecked-add-int"],
+ \["unchecked-byte", "clojure.core-api.html\\#clojure.core/unchecked-byte"],
+ \["unchecked-char", "clojure.core-api.html\\#clojure.core/unchecked-char"],
+ \["unchecked-dec", "clojure.core-api.html\\#clojure.core/unchecked-dec"],
+ \["unchecked-dec-int", "clojure.core-api.html\\#clojure.core/unchecked-dec-int"],
+ \["unchecked-divide-int", "clojure.core-api.html\\#clojure.core/unchecked-divide-int"],
+ \["unchecked-double", "clojure.core-api.html\\#clojure.core/unchecked-double"],
+ \["unchecked-float", "clojure.core-api.html\\#clojure.core/unchecked-float"],
+ \["unchecked-inc", "clojure.core-api.html\\#clojure.core/unchecked-inc"],
+ \["unchecked-inc-int", "clojure.core-api.html\\#clojure.core/unchecked-inc-int"],
+ \["unchecked-int", "clojure.core-api.html\\#clojure.core/unchecked-int"],
+ \["unchecked-long", "clojure.core-api.html\\#clojure.core/unchecked-long"],
+ \["unchecked-multiply", "clojure.core-api.html\\#clojure.core/unchecked-multiply"],
+ \["unchecked-multiply-int", "clojure.core-api.html\\#clojure.core/unchecked-multiply-int"],
+ \["unchecked-negate", "clojure.core-api.html\\#clojure.core/unchecked-negate"],
+ \["unchecked-negate-int", "clojure.core-api.html\\#clojure.core/unchecked-negate-int"],
+ \["unchecked-remainder-int", "clojure.core-api.html\\#clojure.core/unchecked-remainder-int"],
+ \["unchecked-short", "clojure.core-api.html\\#clojure.core/unchecked-short"],
+ \["unchecked-subtract", "clojure.core-api.html\\#clojure.core/unchecked-subtract"],
+ \["unchecked-subtract-int", "clojure.core-api.html\\#clojure.core/unchecked-subtract-int"],
+ \["underive", "clojure.core-api.html\\#clojure.core/underive"],
+ \["update-in", "clojure.core-api.html\\#clojure.core/update-in"],
+ \["update-proxy", "clojure.core-api.html\\#clojure.core/update-proxy"],
+ \["use", "clojure.core-api.html\\#clojure.core/use"],
+ \["val", "clojure.core-api.html\\#clojure.core/val"],
+ \["vals", "clojure.core-api.html\\#clojure.core/vals"],
+ \["var-get", "clojure.core-api.html\\#clojure.core/var-get"],
+ \["var-set", "clojure.core-api.html\\#clojure.core/var-set"],
+ \["var?", "clojure.core-api.html\\#clojure.core/var?"],
+ \["vary-meta", "clojure.core-api.html\\#clojure.core/vary-meta"],
+ \["vec", "clojure.core-api.html\\#clojure.core/vec"],
+ \["vector", "clojure.core-api.html\\#clojure.core/vector"],
+ \["vector-of", "clojure.core-api.html\\#clojure.core/vector-of"],
+ \["vector?", "clojure.core-api.html\\#clojure.core/vector?"],
+ \["when", "clojure.core-api.html\\#clojure.core/when"],
+ \["when-first", "clojure.core-api.html\\#clojure.core/when-first"],
+ \["when-let", "clojure.core-api.html\\#clojure.core/when-let"],
+ \["when-not", "clojure.core-api.html\\#clojure.core/when-not"],
+ \["while", "clojure.core-api.html\\#clojure.core/while"],
+ \["with-bindings", "clojure.core-api.html\\#clojure.core/with-bindings"],
+ \["with-bindings*", "clojure.core-api.html\\#clojure.core/with-bindings*"],
+ \["with-in-str", "clojure.core-api.html\\#clojure.core/with-in-str"],
+ \["with-local-vars", "clojure.core-api.html\\#clojure.core/with-local-vars"],
+ \["with-meta", "clojure.core-api.html\\#clojure.core/with-meta"],
+ \["with-open", "clojure.core-api.html\\#clojure.core/with-open"],
+ \["with-out-str", "clojure.core-api.html\\#clojure.core/with-out-str"],
+ \["with-precision", "clojure.core-api.html\\#clojure.core/with-precision"],
+ \["with-redefs", "clojure.core-api.html\\#clojure.core/with-redefs"],
+ \["with-redefs-fn", "clojure.core-api.html\\#clojure.core/with-redefs-fn"],
+ \["xml-seq", "clojure.core-api.html\\#clojure.core/xml-seq"],
+ \["zero?", "clojure.core-api.html\\#clojure.core/zero?"],
+ \["zipmap", "clojure.core-api.html\\#clojure.core/zipmap"],
+ \["Diff", "clojure.data-api.html\\#clojure.data/Diff"],
+ \["EqualityPartition", "clojure.data-api.html\\#clojure.data/EqualityPartition"],
+ \["diff", "clojure.data-api.html\\#clojure.data/diff"],
+ \["diff-similar", "clojure.data-api.html\\#clojure.data/diff-similar"],
+ \["equality-partition", "clojure.data-api.html\\#clojure.data/equality-partition"],
+ \["inspect", "clojure.inspector-api.html\\#clojure.inspector/inspect"],
+ \["inspect-table", "clojure.inspector-api.html\\#clojure.inspector/inspect-table"],
+ \["inspect-tree", "clojure.inspector-api.html\\#clojure.inspector/inspect-tree"],
+ \["browse-url", "clojure.java.browse-api.html\\#clojure.java.browse/browse-url"],
+ \["Coercions", "clojure.java.io-api.html\\#clojure.java.io/Coercions"],
+ \["IOFactory", "clojure.java.io-api.html\\#clojure.java.io/IOFactory"],
+ \["as-file", "clojure.java.io-api.html\\#clojure.java.io/as-file"],
+ \["as-relative-path", "clojure.java.io-api.html\\#clojure.java.io/as-relative-path"],
+ \["as-url", "clojure.java.io-api.html\\#clojure.java.io/as-url"],
+ \["copy", "clojure.java.io-api.html\\#clojure.java.io/copy"],
+ \["delete-file", "clojure.java.io-api.html\\#clojure.java.io/delete-file"],
+ \["file", "clojure.java.io-api.html\\#clojure.java.io/file"],
+ \["input-stream", "clojure.java.io-api.html\\#clojure.java.io/input-stream"],
+ \["make-input-stream", "clojure.java.io-api.html\\#clojure.java.io/make-input-stream"],
+ \["make-output-stream", "clojure.java.io-api.html\\#clojure.java.io/make-output-stream"],
+ \["make-parents", "clojure.java.io-api.html\\#clojure.java.io/make-parents"],
+ \["make-reader", "clojure.java.io-api.html\\#clojure.java.io/make-reader"],
+ \["make-writer", "clojure.java.io-api.html\\#clojure.java.io/make-writer"],
+ \["output-stream", "clojure.java.io-api.html\\#clojure.java.io/output-stream"],
+ \["reader", "clojure.java.io-api.html\\#clojure.java.io/reader"],
+ \["resource", "clojure.java.io-api.html\\#clojure.java.io/resource"],
+ \["writer", "clojure.java.io-api.html\\#clojure.java.io/writer"],
+ \["add-local-javadoc", "clojure.java.javadoc-api.html\\#clojure.java.javadoc/add-local-javadoc"],
+ \["add-remote-javadoc", "clojure.java.javadoc-api.html\\#clojure.java.javadoc/add-remote-javadoc"],
+ \["javadoc", "clojure.java.javadoc-api.html\\#clojure.java.javadoc/javadoc"],
+ \["sh", "clojure.java.shell-api.html\\#clojure.java.shell/sh"],
+ \["with-sh-dir", "clojure.java.shell-api.html\\#clojure.java.shell/with-sh-dir"],
+ \["with-sh-env", "clojure.java.shell-api.html\\#clojure.java.shell/with-sh-env"],
+ \["demunge", "clojure.main-api.html\\#clojure.main/demunge"],
+ \["load-script", "clojure.main-api.html\\#clojure.main/load-script"],
+ \["main", "clojure.main-api.html\\#clojure.main/main"],
+ \["repl", "clojure.main-api.html\\#clojure.main/repl"],
+ \["repl-caught", "clojure.main-api.html\\#clojure.main/repl-caught"],
+ \["repl-exception", "clojure.main-api.html\\#clojure.main/repl-exception"],
+ \["repl-prompt", "clojure.main-api.html\\#clojure.main/repl-prompt"],
+ \["repl-read", "clojure.main-api.html\\#clojure.main/repl-read"],
+ \["root-cause", "clojure.main-api.html\\#clojure.main/root-cause"],
+ \["skip-if-eol", "clojure.main-api.html\\#clojure.main/skip-if-eol"],
+ \["skip-whitespace", "clojure.main-api.html\\#clojure.main/skip-whitespace"],
+ \["stack-element-str", "clojure.main-api.html\\#clojure.main/stack-element-str"],
+ \["with-bindings", "clojure.main-api.html\\#clojure.main/with-bindings"],
+ \["*print-base*", "clojure.pprint-api.html\\#clojure.pprint/*print-base*"],
+ \["*print-miser-width*", "clojure.pprint-api.html\\#clojure.pprint/*print-miser-width*"],
+ \["*print-pprint-dispatch*", "clojure.pprint-api.html\\#clojure.pprint/*print-pprint-dispatch*"],
+ \["*print-pretty*", "clojure.pprint-api.html\\#clojure.pprint/*print-pretty*"],
+ \["*print-radix*", "clojure.pprint-api.html\\#clojure.pprint/*print-radix*"],
+ \["*print-right-margin*", "clojure.pprint-api.html\\#clojure.pprint/*print-right-margin*"],
+ \["*print-suppress-namespaces*", "clojure.pprint-api.html\\#clojure.pprint/*print-suppress-namespaces*"],
+ \["cl-format", "clojure.pprint-api.html\\#clojure.pprint/cl-format"],
+ \["formatter", "clojure.pprint-api.html\\#clojure.pprint/formatter"],
+ \["formatter-out", "clojure.pprint-api.html\\#clojure.pprint/formatter-out"],
+ \["fresh-line", "clojure.pprint-api.html\\#clojure.pprint/fresh-line"],
+ \["get-pretty-writer", "clojure.pprint-api.html\\#clojure.pprint/get-pretty-writer"],
+ \["pp", "clojure.pprint-api.html\\#clojure.pprint/pp"],
+ \["pprint", "clojure.pprint-api.html\\#clojure.pprint/pprint"],
+ \["pprint-indent", "clojure.pprint-api.html\\#clojure.pprint/pprint-indent"],
+ \["pprint-logical-block", "clojure.pprint-api.html\\#clojure.pprint/pprint-logical-block"],
+ \["pprint-newline", "clojure.pprint-api.html\\#clojure.pprint/pprint-newline"],
+ \["pprint-tab", "clojure.pprint-api.html\\#clojure.pprint/pprint-tab"],
+ \["print-length-loop", "clojure.pprint-api.html\\#clojure.pprint/print-length-loop"],
+ \["print-table", "clojure.pprint-api.html\\#clojure.pprint/print-table"],
+ \["set-pprint-dispatch", "clojure.pprint-api.html\\#clojure.pprint/set-pprint-dispatch"],
+ \["with-pprint-dispatch", "clojure.pprint-api.html\\#clojure.pprint/with-pprint-dispatch"],
+ \["write", "clojure.pprint-api.html\\#clojure.pprint/write"],
+ \["write-out", "clojure.pprint-api.html\\#clojure.pprint/write-out"],
+ \["TypeReference", "clojure.reflect-api.html\\#clojure.reflect/TypeReference"],
+ \["flag-descriptors", "clojure.reflect-api.html\\#clojure.reflect/flag-descriptors"],
+ \["reflect", "clojure.reflect-api.html\\#clojure.reflect/reflect"],
+ \["resolve-class", "clojure.reflect-api.html\\#clojure.reflect/resolve-class"],
+ \["type-reflect", "clojure.reflect-api.html\\#clojure.reflect/type-reflect"],
+ \["typename", "clojure.reflect-api.html\\#clojure.reflect/typename"],
+ \["apropos", "clojure.repl-api.html\\#clojure.repl/apropos"],
+ \["demunge", "clojure.repl-api.html\\#clojure.repl/demunge"],
+ \["dir", "clojure.repl-api.html\\#clojure.repl/dir"],
+ \["dir-fn", "clojure.repl-api.html\\#clojure.repl/dir-fn"],
+ \["doc", "clojure.repl-api.html\\#clojure.repl/doc"],
+ \["find-doc", "clojure.repl-api.html\\#clojure.repl/find-doc"],
+ \["pst", "clojure.repl-api.html\\#clojure.repl/pst"],
+ \["root-cause", "clojure.repl-api.html\\#clojure.repl/root-cause"],
+ \["set-break-handler!", "clojure.repl-api.html\\#clojure.repl/set-break-handler!"],
+ \["source", "clojure.repl-api.html\\#clojure.repl/source"],
+ \["source-fn", "clojure.repl-api.html\\#clojure.repl/source-fn"],
+ \["stack-element-str", "clojure.repl-api.html\\#clojure.repl/stack-element-str"],
+ \["thread-stopper", "clojure.repl-api.html\\#clojure.repl/thread-stopper"],
+ \["difference", "clojure.set-api.html\\#clojure.set/difference"],
+ \["index", "clojure.set-api.html\\#clojure.set/index"],
+ \["intersection", "clojure.set-api.html\\#clojure.set/intersection"],
+ \["join", "clojure.set-api.html\\#clojure.set/join"],
+ \["map-invert", "clojure.set-api.html\\#clojure.set/map-invert"],
+ \["project", "clojure.set-api.html\\#clojure.set/project"],
+ \["rename", "clojure.set-api.html\\#clojure.set/rename"],
+ \["rename-keys", "clojure.set-api.html\\#clojure.set/rename-keys"],
+ \["select", "clojure.set-api.html\\#clojure.set/select"],
+ \["subset?", "clojure.set-api.html\\#clojure.set/subset?"],
+ \["superset?", "clojure.set-api.html\\#clojure.set/superset?"],
+ \["union", "clojure.set-api.html\\#clojure.set/union"],
+ \["e", "clojure.stacktrace-api.html\\#clojure.stacktrace/e"],
+ \["print-cause-trace", "clojure.stacktrace-api.html\\#clojure.stacktrace/print-cause-trace"],
+ \["print-stack-trace", "clojure.stacktrace-api.html\\#clojure.stacktrace/print-stack-trace"],
+ \["print-throwable", "clojure.stacktrace-api.html\\#clojure.stacktrace/print-throwable"],
+ \["print-trace-element", "clojure.stacktrace-api.html\\#clojure.stacktrace/print-trace-element"],
+ \["root-cause", "clojure.stacktrace-api.html\\#clojure.stacktrace/root-cause"],
+ \["blank?", "clojure.string-api.html\\#clojure.string/blank?"],
+ \["capitalize", "clojure.string-api.html\\#clojure.string/capitalize"],
+ \["escape", "clojure.string-api.html\\#clojure.string/escape"],
+ \["join", "clojure.string-api.html\\#clojure.string/join"],
+ \["lower-case", "clojure.string-api.html\\#clojure.string/lower-case"],
+ \["replace", "clojure.string-api.html\\#clojure.string/replace"],
+ \["replace-first", "clojure.string-api.html\\#clojure.string/replace-first"],
+ \["reverse", "clojure.string-api.html\\#clojure.string/reverse"],
+ \["split", "clojure.string-api.html\\#clojure.string/split"],
+ \["split-lines", "clojure.string-api.html\\#clojure.string/split-lines"],
+ \["trim", "clojure.string-api.html\\#clojure.string/trim"],
+ \["trim-newline", "clojure.string-api.html\\#clojure.string/trim-newline"],
+ \["triml", "clojure.string-api.html\\#clojure.string/triml"],
+ \["trimr", "clojure.string-api.html\\#clojure.string/trimr"],
+ \["upper-case", "clojure.string-api.html\\#clojure.string/upper-case"],
+ \["apply-template", "clojure.template-api.html\\#clojure.template/apply-template"],
+ \["do-template", "clojure.template-api.html\\#clojure.template/do-template"],
+ \["*load-tests*", "clojure.test-api.html\\#clojure.test/*load-tests*"],
+ \["*stack-trace-depth*", "clojure.test-api.html\\#clojure.test/*stack-trace-depth*"],
+ \["are", "clojure.test-api.html\\#clojure.test/are"],
+ \["assert-any", "clojure.test-api.html\\#clojure.test/assert-any"],
+ \["assert-predicate", "clojure.test-api.html\\#clojure.test/assert-predicate"],
+ \["compose-fixtures", "clojure.test-api.html\\#clojure.test/compose-fixtures"],
+ \["deftest", "clojure.test-api.html\\#clojure.test/deftest"],
+ \["deftest-", "clojure.test-api.html\\#clojure.test/deftest-"],
+ \["do-report", "clojure.test-api.html\\#clojure.test/do-report"],
+ \["file-position", "clojure.test-api.html\\#clojure.test/file-position"],
+ \["function?", "clojure.test-api.html\\#clojure.test/function?"],
+ \["get-possibly-unbound-var", "clojure.test-api.html\\#clojure.test/get-possibly-unbound-var"],
+ \["inc-report-counter", "clojure.test-api.html\\#clojure.test/inc-report-counter"],
+ \["is", "clojure.test-api.html\\#clojure.test/is"],
+ \["join-fixtures", "clojure.test-api.html\\#clojure.test/join-fixtures"],
+ \["report", "clojure.test-api.html\\#clojure.test/report"],
+ \["run-all-tests", "clojure.test-api.html\\#clojure.test/run-all-tests"],
+ \["run-tests", "clojure.test-api.html\\#clojure.test/run-tests"],
+ \["set-test", "clojure.test-api.html\\#clojure.test/set-test"],
+ \["successful?", "clojure.test-api.html\\#clojure.test/successful?"],
+ \["test-all-vars", "clojure.test-api.html\\#clojure.test/test-all-vars"],
+ \["test-ns", "clojure.test-api.html\\#clojure.test/test-ns"],
+ \["test-var", "clojure.test-api.html\\#clojure.test/test-var"],
+ \["testing", "clojure.test-api.html\\#clojure.test/testing"],
+ \["testing-contexts-str", "clojure.test-api.html\\#clojure.test/testing-contexts-str"],
+ \["testing-vars-str", "clojure.test-api.html\\#clojure.test/testing-vars-str"],
+ \["try-expr", "clojure.test-api.html\\#clojure.test/try-expr"],
+ \["with-test", "clojure.test-api.html\\#clojure.test/with-test"],
+ \["with-test-out", "clojure.test-api.html\\#clojure.test/with-test-out"],
+ \["clojure.test.junit", "clojure.test-api.html\\#clojure.test.junit"],
+ \["with-junit-output", "clojure.test-api.html\\#clojure.test.junit/with-junit-output"],
+ \["clojure.test.tap", "clojure.test-api.html\\#clojure.test.tap"],
+ \["print-tap-diagnostic", "clojure.test-api.html\\#clojure.test.tap/print-tap-diagnostic"],
+ \["print-tap-fail", "clojure.test-api.html\\#clojure.test.tap/print-tap-fail"],
+ \["print-tap-pass", "clojure.test-api.html\\#clojure.test.tap/print-tap-pass"],
+ \["print-tap-plan", "clojure.test-api.html\\#clojure.test.tap/print-tap-plan"],
+ \["with-tap-output", "clojure.test-api.html\\#clojure.test.tap/with-tap-output"],
+ \["keywordize-keys", "clojure.walk-api.html\\#clojure.walk/keywordize-keys"],
+ \["macroexpand-all", "clojure.walk-api.html\\#clojure.walk/macroexpand-all"],
+ \["postwalk", "clojure.walk-api.html\\#clojure.walk/postwalk"],
+ \["postwalk-demo", "clojure.walk-api.html\\#clojure.walk/postwalk-demo"],
+ \["postwalk-replace", "clojure.walk-api.html\\#clojure.walk/postwalk-replace"],
+ \["prewalk", "clojure.walk-api.html\\#clojure.walk/prewalk"],
+ \["prewalk-demo", "clojure.walk-api.html\\#clojure.walk/prewalk-demo"],
+ \["prewalk-replace", "clojure.walk-api.html\\#clojure.walk/prewalk-replace"],
+ \["stringify-keys", "clojure.walk-api.html\\#clojure.walk/stringify-keys"],
+ \["walk", "clojure.walk-api.html\\#clojure.walk/walk"],
+ \["parse", "clojure.xml-api.html\\#clojure.xml/parse"],
+ \["append-child", "clojure.zip-api.html\\#clojure.zip/append-child"],
+ \["branch?", "clojure.zip-api.html\\#clojure.zip/branch?"],
+ \["children", "clojure.zip-api.html\\#clojure.zip/children"],
+ \["down", "clojure.zip-api.html\\#clojure.zip/down"],
+ \["edit", "clojure.zip-api.html\\#clojure.zip/edit"],
+ \["end?", "clojure.zip-api.html\\#clojure.zip/end?"],
+ \["insert-child", "clojure.zip-api.html\\#clojure.zip/insert-child"],
+ \["insert-left", "clojure.zip-api.html\\#clojure.zip/insert-left"],
+ \["insert-right", "clojure.zip-api.html\\#clojure.zip/insert-right"],
+ \["left", "clojure.zip-api.html\\#clojure.zip/left"],
+ \["leftmost", "clojure.zip-api.html\\#clojure.zip/leftmost"],
+ \["lefts", "clojure.zip-api.html\\#clojure.zip/lefts"],
+ \["make-node", "clojure.zip-api.html\\#clojure.zip/make-node"],
+ \["next", "clojure.zip-api.html\\#clojure.zip/next"],
+ \["node", "clojure.zip-api.html\\#clojure.zip/node"],
+ \["path", "clojure.zip-api.html\\#clojure.zip/path"],
+ \["prev", "clojure.zip-api.html\\#clojure.zip/prev"],
+ \["remove", "clojure.zip-api.html\\#clojure.zip/remove"],
+ \["replace", "clojure.zip-api.html\\#clojure.zip/replace"],
+ \["right", "clojure.zip-api.html\\#clojure.zip/right"],
+ \["rightmost", "clojure.zip-api.html\\#clojure.zip/rightmost"],
+ \["rights", "clojure.zip-api.html\\#clojure.zip/rights"],
+ \["root", "clojure.zip-api.html\\#clojure.zip/root"],
+ \["seq-zip", "clojure.zip-api.html\\#clojure.zip/seq-zip"],
+ \["up", "clojure.zip-api.html\\#clojure.zip/up"],
+ \["vector-zip", "clojure.zip-api.html\\#clojure.zip/vector-zip"],
+ \["xml-zip", "clojure.zip-api.html\\#clojure.zip/xml-zip"],
+ \["zipper", "clojure.zip-api.html\\#clojure.zip/zipper"]]
+endif
+
diff --git a/vim/bundle/slimv/ftplugin/slimv-javadoc.vim b/vim/bundle/slimv/ftplugin/slimv-javadoc.vim
new file mode 100644
index 0000000..91e1c28
--- /dev/null
+++ b/vim/bundle/slimv/ftplugin/slimv-javadoc.vim
@@ -0,0 +1,3820 @@
+" slimv-javadoc.vim:
+" Clojure JavaDoc lookup support for Slimv
+" Version: 0.5.0
+" Last Change: 14 Apr 2009
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if &cp || exists( 'g:slimv_javadoc_loaded' )
+ finish
+endif
+
+let g:slimv_javadoc_loaded = 1
+
+" Root of the JavaDoc
+if !exists( 'g:slimv_javadoc_root' )
+ let g:slimv_javadoc_root = 'http://java.sun.com/javase/6/docs/api/'
+endif
+
+if !exists( 'g:slimv_javadoc_db' )
+ let g:slimv_javadoc_db = [
+ \["AbstractAction", "javax/swing/AbstractAction.html"],
+ \["AbstractAnnotationValueVisitor6", "javax/lang/model/util/AbstractAnnotationValueVisitor6.html"],
+ \["AbstractBorder", "javax/swing/border/AbstractBorder.html"],
+ \["AbstractButton", "javax/swing/AbstractButton.html"],
+ \["AbstractCellEditor", "javax/swing/AbstractCellEditor.html"],
+ \["AbstractCollection", "java/util/AbstractCollection.html"],
+ \["AbstractColorChooserPanel", "javax/swing/colorchooser/AbstractColorChooserPanel.html"],
+ \["AbstractDocument", "javax/swing/text/AbstractDocument.html"],
+ \["AbstractDocument.AttributeContext", "javax/swing/text/AbstractDocument.AttributeContext.html"],
+ \["AbstractDocument.Content", "javax/swing/text/AbstractDocument.Content.html"],
+ \["AbstractDocument.ElementEdit", "javax/swing/text/AbstractDocument.ElementEdit.html"],
+ \["AbstractElementVisitor6", "javax/lang/model/util/AbstractElementVisitor6.html"],
+ \["AbstractExecutorService", "java/util/concurrent/AbstractExecutorService.html"],
+ \["AbstractInterruptibleChannel", "java/nio/channels/spi/AbstractInterruptibleChannel.html"],
+ \["AbstractLayoutCache", "javax/swing/tree/AbstractLayoutCache.html"],
+ \["AbstractLayoutCache.NodeDimensions", "javax/swing/tree/AbstractLayoutCache.NodeDimensions.html"],
+ \["AbstractList", "java/util/AbstractList.html"],
+ \["AbstractListModel", "javax/swing/AbstractListModel.html"],
+ \["AbstractMap", "java/util/AbstractMap.html"],
+ \["AbstractMap.SimpleEntry", "java/util/AbstractMap.SimpleEntry.html"],
+ \["AbstractMap.SimpleImmutableEntry", "java/util/AbstractMap.SimpleImmutableEntry.html"],
+ \["AbstractMarshallerImpl", "javax/xml/bind/helpers/AbstractMarshallerImpl.html"],
+ \["AbstractMethodError", "java/lang/AbstractMethodError.html"],
+ \["AbstractOwnableSynchronizer", "java/util/concurrent/locks/AbstractOwnableSynchronizer.html"],
+ \["AbstractPreferences", "java/util/prefs/AbstractPreferences.html"],
+ \["AbstractProcessor", "javax/annotation/processing/AbstractProcessor.html"],
+ \["AbstractQueue", "java/util/AbstractQueue.html"],
+ \["AbstractQueuedLongSynchronizer", "java/util/concurrent/locks/AbstractQueuedLongSynchronizer.html"],
+ \["AbstractQueuedSynchronizer", "java/util/concurrent/locks/AbstractQueuedSynchronizer.html"],
+ \["AbstractScriptEngine", "javax/script/AbstractScriptEngine.html"],
+ \["AbstractSelectableChannel", "java/nio/channels/spi/AbstractSelectableChannel.html"],
+ \["AbstractSelectionKey", "java/nio/channels/spi/AbstractSelectionKey.html"],
+ \["AbstractSelector", "java/nio/channels/spi/AbstractSelector.html"],
+ \["AbstractSequentialList", "java/util/AbstractSequentialList.html"],
+ \["AbstractSet", "java/util/AbstractSet.html"],
+ \["AbstractSpinnerModel", "javax/swing/AbstractSpinnerModel.html"],
+ \["AbstractTableModel", "javax/swing/table/AbstractTableModel.html"],
+ \["AbstractTypeVisitor6", "javax/lang/model/util/AbstractTypeVisitor6.html"],
+ \["AbstractUndoableEdit", "javax/swing/undo/AbstractUndoableEdit.html"],
+ \["AbstractUnmarshallerImpl", "javax/xml/bind/helpers/AbstractUnmarshallerImpl.html"],
+ \["AbstractWriter", "javax/swing/text/AbstractWriter.html"],
+ \["AccessControlContext", "java/security/AccessControlContext.html"],
+ \["AccessControlException", "java/security/AccessControlException.html"],
+ \["AccessController", "java/security/AccessController.html"],
+ \["AccessException", "java/rmi/AccessException.html"],
+ \["Accessible", "javax/accessibility/Accessible.html"],
+ \["AccessibleAction", "javax/accessibility/AccessibleAction.html"],
+ \["AccessibleAttributeSequence", "javax/accessibility/AccessibleAttributeSequence.html"],
+ \["AccessibleBundle", "javax/accessibility/AccessibleBundle.html"],
+ \["AccessibleComponent", "javax/accessibility/AccessibleComponent.html"],
+ \["AccessibleContext", "javax/accessibility/AccessibleContext.html"],
+ \["AccessibleEditableText", "javax/accessibility/AccessibleEditableText.html"],
+ \["AccessibleExtendedComponent", "javax/accessibility/AccessibleExtendedComponent.html"],
+ \["AccessibleExtendedTable", "javax/accessibility/AccessibleExtendedTable.html"],
+ \["AccessibleExtendedText", "javax/accessibility/AccessibleExtendedText.html"],
+ \["AccessibleHyperlink", "javax/accessibility/AccessibleHyperlink.html"],
+ \["AccessibleHypertext", "javax/accessibility/AccessibleHypertext.html"],
+ \["AccessibleIcon", "javax/accessibility/AccessibleIcon.html"],
+ \["AccessibleKeyBinding", "javax/accessibility/AccessibleKeyBinding.html"],
+ \["AccessibleObject", "java/lang/reflect/AccessibleObject.html"],
+ \["AccessibleRelation", "javax/accessibility/AccessibleRelation.html"],
+ \["AccessibleRelationSet", "javax/accessibility/AccessibleRelationSet.html"],
+ \["AccessibleResourceBundle", "javax/accessibility/AccessibleResourceBundle.html"],
+ \["AccessibleRole", "javax/accessibility/AccessibleRole.html"],
+ \["AccessibleSelection", "javax/accessibility/AccessibleSelection.html"],
+ \["AccessibleState", "javax/accessibility/AccessibleState.html"],
+ \["AccessibleStateSet", "javax/accessibility/AccessibleStateSet.html"],
+ \["AccessibleStreamable", "javax/accessibility/AccessibleStreamable.html"],
+ \["AccessibleTable", "javax/accessibility/AccessibleTable.html"],
+ \["AccessibleTableModelChange", "javax/accessibility/AccessibleTableModelChange.html"],
+ \["AccessibleText", "javax/accessibility/AccessibleText.html"],
+ \["AccessibleTextSequence", "javax/accessibility/AccessibleTextSequence.html"],
+ \["AccessibleValue", "javax/accessibility/AccessibleValue.html"],
+ \["AccountException", "javax/security/auth/login/AccountException.html"],
+ \["AccountExpiredException", "javax/security/auth/login/AccountExpiredException.html"],
+ \["AccountLockedException", "javax/security/auth/login/AccountLockedException.html"],
+ \["AccountNotFoundException", "javax/security/auth/login/AccountNotFoundException.html"],
+ \["Acl", "java/security/acl/Acl.html"],
+ \["AclEntry", "java/security/acl/AclEntry.html"],
+ \["AclNotFoundException", "java/security/acl/AclNotFoundException.html"],
+ \["Action", "javax/swing/Action.html"],
+ \["Action", "javax/xml/ws/Action.html"],
+ \["ActionEvent", "java/awt/event/ActionEvent.html"],
+ \["ActionListener", "java/awt/event/ActionListener.html"],
+ \["ActionMap", "javax/swing/ActionMap.html"],
+ \["ActionMapUIResource", "javax/swing/plaf/ActionMapUIResource.html"],
+ \["Activatable", "java/rmi/activation/Activatable.html"],
+ \["ActivateFailedException", "java/rmi/activation/ActivateFailedException.html"],
+ \["ActivationDataFlavor", "javax/activation/ActivationDataFlavor.html"],
+ \["ActivationDesc", "java/rmi/activation/ActivationDesc.html"],
+ \["ActivationException", "java/rmi/activation/ActivationException.html"],
+ \["ActivationGroup", "java/rmi/activation/ActivationGroup.html"],
+ \["ActivationGroup_Stub", "java/rmi/activation/ActivationGroup_Stub.html"],
+ \["ActivationGroupDesc", "java/rmi/activation/ActivationGroupDesc.html"],
+ \["ActivationGroupDesc.CommandEnvironment", "java/rmi/activation/ActivationGroupDesc.CommandEnvironment.html"],
+ \["ActivationGroupID", "java/rmi/activation/ActivationGroupID.html"],
+ \["ActivationID", "java/rmi/activation/ActivationID.html"],
+ \["ActivationInstantiator", "java/rmi/activation/ActivationInstantiator.html"],
+ \["ActivationMonitor", "java/rmi/activation/ActivationMonitor.html"],
+ \["ActivationSystem", "java/rmi/activation/ActivationSystem.html"],
+ \["Activator", "java/rmi/activation/Activator.html"],
+ \["ACTIVE", "org/omg/PortableInterceptor/ACTIVE.html"],
+ \["ActiveEvent", "java/awt/ActiveEvent.html"],
+ \["ACTIVITY_COMPLETED", "org/omg/CORBA/ACTIVITY_COMPLETED.html"],
+ \["ACTIVITY_REQUIRED", "org/omg/CORBA/ACTIVITY_REQUIRED.html"],
+ \["ActivityCompletedException", "javax/activity/ActivityCompletedException.html"],
+ \["ActivityRequiredException", "javax/activity/ActivityRequiredException.html"],
+ \["AdapterActivator", "org/omg/PortableServer/AdapterActivator.html"],
+ \["AdapterActivatorOperations", "org/omg/PortableServer/AdapterActivatorOperations.html"],
+ \["AdapterAlreadyExists", "org/omg/PortableServer/POAPackage/AdapterAlreadyExists.html"],
+ \["AdapterAlreadyExistsHelper", "org/omg/PortableServer/POAPackage/AdapterAlreadyExistsHelper.html"],
+ \["AdapterInactive", "org/omg/PortableServer/POAManagerPackage/AdapterInactive.html"],
+ \["AdapterInactiveHelper", "org/omg/PortableServer/POAManagerPackage/AdapterInactiveHelper.html"],
+ \["AdapterManagerIdHelper", "org/omg/PortableInterceptor/AdapterManagerIdHelper.html"],
+ \["AdapterNameHelper", "org/omg/PortableInterceptor/AdapterNameHelper.html"],
+ \["AdapterNonExistent", "org/omg/PortableServer/POAPackage/AdapterNonExistent.html"],
+ \["AdapterNonExistentHelper", "org/omg/PortableServer/POAPackage/AdapterNonExistentHelper.html"],
+ \["AdapterStateHelper", "org/omg/PortableInterceptor/AdapterStateHelper.html"],
+ \["AddressHelper", "org/omg/CosNaming/NamingContextExtPackage/AddressHelper.html"],
+ \["Addressing", "javax/xml/ws/soap/Addressing.html"],
+ \["AddressingFeature", "javax/xml/ws/soap/AddressingFeature.html"],
+ \["Adjustable", "java/awt/Adjustable.html"],
+ \["AdjustmentEvent", "java/awt/event/AdjustmentEvent.html"],
+ \["AdjustmentListener", "java/awt/event/AdjustmentListener.html"],
+ \["Adler32", "java/util/zip/Adler32.html"],
+ \["AffineTransform", "java/awt/geom/AffineTransform.html"],
+ \["AffineTransformOp", "java/awt/image/AffineTransformOp.html"],
+ \["AlgorithmMethod", "javax/xml/crypto/AlgorithmMethod.html"],
+ \["AlgorithmParameterGenerator", "java/security/AlgorithmParameterGenerator.html"],
+ \["AlgorithmParameterGeneratorSpi", "java/security/AlgorithmParameterGeneratorSpi.html"],
+ \["AlgorithmParameters", "java/security/AlgorithmParameters.html"],
+ \["AlgorithmParameterSpec", "java/security/spec/AlgorithmParameterSpec.html"],
+ \["AlgorithmParametersSpi", "java/security/AlgorithmParametersSpi.html"],
+ \["AllPermission", "java/security/AllPermission.html"],
+ \["AlphaComposite", "java/awt/AlphaComposite.html"],
+ \["AlreadyBound", "org/omg/CosNaming/NamingContextPackage/AlreadyBound.html"],
+ \["AlreadyBoundException", "java/rmi/AlreadyBoundException.html"],
+ \["AlreadyBoundHelper", "org/omg/CosNaming/NamingContextPackage/AlreadyBoundHelper.html"],
+ \["AlreadyBoundHolder", "org/omg/CosNaming/NamingContextPackage/AlreadyBoundHolder.html"],
+ \["AlreadyConnectedException", "java/nio/channels/AlreadyConnectedException.html"],
+ \["AncestorEvent", "javax/swing/event/AncestorEvent.html"],
+ \["AncestorListener", "javax/swing/event/AncestorListener.html"],
+ \["AnnotatedElement", "java/lang/reflect/AnnotatedElement.html"],
+ \["Annotation", "java/lang/annotation/Annotation.html"],
+ \["Annotation", "java/text/Annotation.html"],
+ \["AnnotationFormatError", "java/lang/annotation/AnnotationFormatError.html"],
+ \["AnnotationMirror", "javax/lang/model/element/AnnotationMirror.html"],
+ \["AnnotationTypeMismatchException", "java/lang/annotation/AnnotationTypeMismatchException.html"],
+ \["AnnotationValue", "javax/lang/model/element/AnnotationValue.html"],
+ \["AnnotationValueVisitor", "javax/lang/model/element/AnnotationValueVisitor.html"],
+ \["Any", "org/omg/CORBA/Any.html"],
+ \["AnyHolder", "org/omg/CORBA/AnyHolder.html"],
+ \["AnySeqHelper", "org/omg/CORBA/AnySeqHelper.html"],
+ \["AnySeqHelper", "org/omg/DynamicAny/AnySeqHelper.html"],
+ \["AnySeqHolder", "org/omg/CORBA/AnySeqHolder.html"],
+ \["AppConfigurationEntry", "javax/security/auth/login/AppConfigurationEntry.html"],
+ \["AppConfigurationEntry.LoginModuleControlFlag", "javax/security/auth/login/AppConfigurationEntry.LoginModuleControlFlag.html"],
+ \["Appendable", "java/lang/Appendable.html"],
+ \["Applet", "java/applet/Applet.html"],
+ \["AppletContext", "java/applet/AppletContext.html"],
+ \["AppletInitializer", "java/beans/AppletInitializer.html"],
+ \["AppletStub", "java/applet/AppletStub.html"],
+ \["ApplicationException", "org/omg/CORBA/portable/ApplicationException.html"],
+ \["Arc2D", "java/awt/geom/Arc2D.html"],
+ \["Arc2D.Double", "java/awt/geom/Arc2D.Double.html"],
+ \["Arc2D.Float", "java/awt/geom/Arc2D.Float.html"],
+ \["Area", "java/awt/geom/Area.html"],
+ \["AreaAveragingScaleFilter", "java/awt/image/AreaAveragingScaleFilter.html"],
+ \["ARG_IN", "org/omg/CORBA/ARG_IN.html"],
+ \["ARG_INOUT", "org/omg/CORBA/ARG_INOUT.html"],
+ \["ARG_OUT", "org/omg/CORBA/ARG_OUT.html"],
+ \["ArithmeticException", "java/lang/ArithmeticException.html"],
+ \["Array", "java/lang/reflect/Array.html"],
+ \["Array", "java/sql/Array.html"],
+ \["ArrayBlockingQueue", "java/util/concurrent/ArrayBlockingQueue.html"],
+ \["ArrayDeque", "java/util/ArrayDeque.html"],
+ \["ArrayIndexOutOfBoundsException", "java/lang/ArrayIndexOutOfBoundsException.html"],
+ \["ArrayList", "java/util/ArrayList.html"],
+ \["Arrays", "java/util/Arrays.html"],
+ \["ArrayStoreException", "java/lang/ArrayStoreException.html"],
+ \["ArrayType", "javax/lang/model/type/ArrayType.html"],
+ \["ArrayType", "javax/management/openmbean/ArrayType.html"],
+ \["AssertionError", "java/lang/AssertionError.html"],
+ \["AsyncBoxView", "javax/swing/text/AsyncBoxView.html"],
+ \["AsyncHandler", "javax/xml/ws/AsyncHandler.html"],
+ \["AsynchronousCloseException", "java/nio/channels/AsynchronousCloseException.html"],
+ \["AtomicBoolean", "java/util/concurrent/atomic/AtomicBoolean.html"],
+ \["AtomicInteger", "java/util/concurrent/atomic/AtomicInteger.html"],
+ \["AtomicIntegerArray", "java/util/concurrent/atomic/AtomicIntegerArray.html"],
+ \["AtomicIntegerFieldUpdater", "java/util/concurrent/atomic/AtomicIntegerFieldUpdater.html"],
+ \["AtomicLong", "java/util/concurrent/atomic/AtomicLong.html"],
+ \["AtomicLongArray", "java/util/concurrent/atomic/AtomicLongArray.html"],
+ \["AtomicLongFieldUpdater", "java/util/concurrent/atomic/AtomicLongFieldUpdater.html"],
+ \["AtomicMarkableReference", "java/util/concurrent/atomic/AtomicMarkableReference.html"],
+ \["AtomicReference", "java/util/concurrent/atomic/AtomicReference.html"],
+ \["AtomicReferenceArray", "java/util/concurrent/atomic/AtomicReferenceArray.html"],
+ \["AtomicReferenceFieldUpdater", "java/util/concurrent/atomic/AtomicReferenceFieldUpdater.html"],
+ \["AtomicStampedReference", "java/util/concurrent/atomic/AtomicStampedReference.html"],
+ \["AttachmentMarshaller", "javax/xml/bind/attachment/AttachmentMarshaller.html"],
+ \["AttachmentPart", "javax/xml/soap/AttachmentPart.html"],
+ \["AttachmentUnmarshaller", "javax/xml/bind/attachment/AttachmentUnmarshaller.html"],
+ \["Attr", "org/w3c/dom/Attr.html"],
+ \["Attribute", "javax/management/Attribute.html"],
+ \["Attribute", "javax/naming/directory/Attribute.html"],
+ \["Attribute", "javax/print/attribute/Attribute.html"],
+ \["Attribute", "javax/xml/stream/events/Attribute.html"],
+ \["AttributeChangeNotification", "javax/management/AttributeChangeNotification.html"],
+ \["AttributeChangeNotificationFilter", "javax/management/AttributeChangeNotificationFilter.html"],
+ \["AttributedCharacterIterator", "java/text/AttributedCharacterIterator.html"],
+ \["AttributedCharacterIterator.Attribute", "java/text/AttributedCharacterIterator.Attribute.html"],
+ \["AttributedString", "java/text/AttributedString.html"],
+ \["AttributeException", "javax/print/AttributeException.html"],
+ \["AttributeInUseException", "javax/naming/directory/AttributeInUseException.html"],
+ \["AttributeList", "javax/management/AttributeList.html"],
+ \["AttributeList", "javax/swing/text/html/parser/AttributeList.html"],
+ \["AttributeList", "org/xml/sax/AttributeList.html"],
+ \["AttributeListImpl", "org/xml/sax/helpers/AttributeListImpl.html"],
+ \["AttributeModificationException", "javax/naming/directory/AttributeModificationException.html"],
+ \["AttributeNotFoundException", "javax/management/AttributeNotFoundException.html"],
+ \["Attributes", "java/util/jar/Attributes.html"],
+ \["Attributes", "javax/naming/directory/Attributes.html"],
+ \["Attributes", "org/xml/sax/Attributes.html"],
+ \["Attributes.Name", "java/util/jar/Attributes.Name.html"],
+ \["Attributes2", "org/xml/sax/ext/Attributes2.html"],
+ \["Attributes2Impl", "org/xml/sax/ext/Attributes2Impl.html"],
+ \["AttributeSet", "javax/print/attribute/AttributeSet.html"],
+ \["AttributeSet", "javax/swing/text/AttributeSet.html"],
+ \["AttributeSet.CharacterAttribute", "javax/swing/text/AttributeSet.CharacterAttribute.html"],
+ \["AttributeSet.ColorAttribute", "javax/swing/text/AttributeSet.ColorAttribute.html"],
+ \["AttributeSet.FontAttribute", "javax/swing/text/AttributeSet.FontAttribute.html"],
+ \["AttributeSet.ParagraphAttribute", "javax/swing/text/AttributeSet.ParagraphAttribute.html"],
+ \["AttributeSetUtilities", "javax/print/attribute/AttributeSetUtilities.html"],
+ \["AttributesImpl", "org/xml/sax/helpers/AttributesImpl.html"],
+ \["AttributeValueExp", "javax/management/AttributeValueExp.html"],
+ \["AudioClip", "java/applet/AudioClip.html"],
+ \["AudioFileFormat", "javax/sound/sampled/AudioFileFormat.html"],
+ \["AudioFileFormat.Type", "javax/sound/sampled/AudioFileFormat.Type.html"],
+ \["AudioFileReader", "javax/sound/sampled/spi/AudioFileReader.html"],
+ \["AudioFileWriter", "javax/sound/sampled/spi/AudioFileWriter.html"],
+ \["AudioFormat", "javax/sound/sampled/AudioFormat.html"],
+ \["AudioFormat.Encoding", "javax/sound/sampled/AudioFormat.Encoding.html"],
+ \["AudioInputStream", "javax/sound/sampled/AudioInputStream.html"],
+ \["AudioPermission", "javax/sound/sampled/AudioPermission.html"],
+ \["AudioSystem", "javax/sound/sampled/AudioSystem.html"],
+ \["AuthenticationException", "javax/naming/AuthenticationException.html"],
+ \["AuthenticationException", "javax/security/sasl/AuthenticationException.html"],
+ \["AuthenticationNotSupportedException", "javax/naming/AuthenticationNotSupportedException.html"],
+ \["Authenticator", "java/net/Authenticator.html"],
+ \["Authenticator.RequestorType", "java/net/Authenticator.RequestorType.html"],
+ \["AuthorizeCallback", "javax/security/sasl/AuthorizeCallback.html"],
+ \["AuthPermission", "javax/security/auth/AuthPermission.html"],
+ \["AuthProvider", "java/security/AuthProvider.html"],
+ \["Autoscroll", "java/awt/dnd/Autoscroll.html"],
+ \["AWTError", "java/awt/AWTError.html"],
+ \["AWTEvent", "java/awt/AWTEvent.html"],
+ \["AWTEventListener", "java/awt/event/AWTEventListener.html"],
+ \["AWTEventListenerProxy", "java/awt/event/AWTEventListenerProxy.html"],
+ \["AWTEventMulticaster", "java/awt/AWTEventMulticaster.html"],
+ \["AWTException", "java/awt/AWTException.html"],
+ \["AWTKeyStroke", "java/awt/AWTKeyStroke.html"],
+ \["AWTPermission", "java/awt/AWTPermission.html"],
+ \["BackingStoreException", "java/util/prefs/BackingStoreException.html"],
+ \["BAD_CONTEXT", "org/omg/CORBA/BAD_CONTEXT.html"],
+ \["BAD_INV_ORDER", "org/omg/CORBA/BAD_INV_ORDER.html"],
+ \["BAD_OPERATION", "org/omg/CORBA/BAD_OPERATION.html"],
+ \["BAD_PARAM", "org/omg/CORBA/BAD_PARAM.html"],
+ \["BAD_POLICY", "org/omg/CORBA/BAD_POLICY.html"],
+ \["BAD_POLICY_TYPE", "org/omg/CORBA/BAD_POLICY_TYPE.html"],
+ \["BAD_POLICY_VALUE", "org/omg/CORBA/BAD_POLICY_VALUE.html"],
+ \["BAD_QOS", "org/omg/CORBA/BAD_QOS.html"],
+ \["BAD_TYPECODE", "org/omg/CORBA/BAD_TYPECODE.html"],
+ \["BadAttributeValueExpException", "javax/management/BadAttributeValueExpException.html"],
+ \["BadBinaryOpValueExpException", "javax/management/BadBinaryOpValueExpException.html"],
+ \["BadKind", "org/omg/CORBA/TypeCodePackage/BadKind.html"],
+ \["BadLocationException", "javax/swing/text/BadLocationException.html"],
+ \["BadPaddingException", "javax/crypto/BadPaddingException.html"],
+ \["BadStringOperationException", "javax/management/BadStringOperationException.html"],
+ \["BandCombineOp", "java/awt/image/BandCombineOp.html"],
+ \["BandedSampleModel", "java/awt/image/BandedSampleModel.html"],
+ \["BaseRowSet", "javax/sql/rowset/BaseRowSet.html"],
+ \["BasicArrowButton", "javax/swing/plaf/basic/BasicArrowButton.html"],
+ \["BasicAttribute", "javax/naming/directory/BasicAttribute.html"],
+ \["BasicAttributes", "javax/naming/directory/BasicAttributes.html"],
+ \["BasicBorders", "javax/swing/plaf/basic/BasicBorders.html"],
+ \["BasicBorders.ButtonBorder", "javax/swing/plaf/basic/BasicBorders.ButtonBorder.html"],
+ \["BasicBorders.FieldBorder", "javax/swing/plaf/basic/BasicBorders.FieldBorder.html"],
+ \["BasicBorders.MarginBorder", "javax/swing/plaf/basic/BasicBorders.MarginBorder.html"],
+ \["BasicBorders.MenuBarBorder", "javax/swing/plaf/basic/BasicBorders.MenuBarBorder.html"],
+ \["BasicBorders.RadioButtonBorder", "javax/swing/plaf/basic/BasicBorders.RadioButtonBorder.html"],
+ \["BasicBorders.RolloverButtonBorder", "javax/swing/plaf/basic/BasicBorders.RolloverButtonBorder.html"],
+ \["BasicBorders.SplitPaneBorder", "javax/swing/plaf/basic/BasicBorders.SplitPaneBorder.html"],
+ \["BasicBorders.ToggleButtonBorder", "javax/swing/plaf/basic/BasicBorders.ToggleButtonBorder.html"],
+ \["BasicButtonListener", "javax/swing/plaf/basic/BasicButtonListener.html"],
+ \["BasicButtonUI", "javax/swing/plaf/basic/BasicButtonUI.html"],
+ \["BasicCheckBoxMenuItemUI", "javax/swing/plaf/basic/BasicCheckBoxMenuItemUI.html"],
+ \["BasicCheckBoxUI", "javax/swing/plaf/basic/BasicCheckBoxUI.html"],
+ \["BasicColorChooserUI", "javax/swing/plaf/basic/BasicColorChooserUI.html"],
+ \["BasicComboBoxEditor", "javax/swing/plaf/basic/BasicComboBoxEditor.html"],
+ \["BasicComboBoxEditor.UIResource", "javax/swing/plaf/basic/BasicComboBoxEditor.UIResource.html"],
+ \["BasicComboBoxRenderer", "javax/swing/plaf/basic/BasicComboBoxRenderer.html"],
+ \["BasicComboBoxRenderer.UIResource", "javax/swing/plaf/basic/BasicComboBoxRenderer.UIResource.html"],
+ \["BasicComboBoxUI", "javax/swing/plaf/basic/BasicComboBoxUI.html"],
+ \["BasicComboPopup", "javax/swing/plaf/basic/BasicComboPopup.html"],
+ \["BasicControl", "javax/naming/ldap/BasicControl.html"],
+ \["BasicDesktopIconUI", "javax/swing/plaf/basic/BasicDesktopIconUI.html"],
+ \["BasicDesktopPaneUI", "javax/swing/plaf/basic/BasicDesktopPaneUI.html"],
+ \["BasicDirectoryModel", "javax/swing/plaf/basic/BasicDirectoryModel.html"],
+ \["BasicEditorPaneUI", "javax/swing/plaf/basic/BasicEditorPaneUI.html"],
+ \["BasicFileChooserUI", "javax/swing/plaf/basic/BasicFileChooserUI.html"],
+ \["BasicFormattedTextFieldUI", "javax/swing/plaf/basic/BasicFormattedTextFieldUI.html"],
+ \["BasicGraphicsUtils", "javax/swing/plaf/basic/BasicGraphicsUtils.html"],
+ \["BasicHTML", "javax/swing/plaf/basic/BasicHTML.html"],
+ \["BasicIconFactory", "javax/swing/plaf/basic/BasicIconFactory.html"],
+ \["BasicInternalFrameTitlePane", "javax/swing/plaf/basic/BasicInternalFrameTitlePane.html"],
+ \["BasicInternalFrameUI", "javax/swing/plaf/basic/BasicInternalFrameUI.html"],
+ \["BasicLabelUI", "javax/swing/plaf/basic/BasicLabelUI.html"],
+ \["BasicListUI", "javax/swing/plaf/basic/BasicListUI.html"],
+ \["BasicLookAndFeel", "javax/swing/plaf/basic/BasicLookAndFeel.html"],
+ \["BasicMenuBarUI", "javax/swing/plaf/basic/BasicMenuBarUI.html"],
+ \["BasicMenuItemUI", "javax/swing/plaf/basic/BasicMenuItemUI.html"],
+ \["BasicMenuUI", "javax/swing/plaf/basic/BasicMenuUI.html"],
+ \["BasicOptionPaneUI", "javax/swing/plaf/basic/BasicOptionPaneUI.html"],
+ \["BasicOptionPaneUI.ButtonAreaLayout", "javax/swing/plaf/basic/BasicOptionPaneUI.ButtonAreaLayout.html"],
+ \["BasicPanelUI", "javax/swing/plaf/basic/BasicPanelUI.html"],
+ \["BasicPasswordFieldUI", "javax/swing/plaf/basic/BasicPasswordFieldUI.html"],
+ \["BasicPermission", "java/security/BasicPermission.html"],
+ \["BasicPopupMenuSeparatorUI", "javax/swing/plaf/basic/BasicPopupMenuSeparatorUI.html"],
+ \["BasicPopupMenuUI", "javax/swing/plaf/basic/BasicPopupMenuUI.html"],
+ \["BasicProgressBarUI", "javax/swing/plaf/basic/BasicProgressBarUI.html"],
+ \["BasicRadioButtonMenuItemUI", "javax/swing/plaf/basic/BasicRadioButtonMenuItemUI.html"],
+ \["BasicRadioButtonUI", "javax/swing/plaf/basic/BasicRadioButtonUI.html"],
+ \["BasicRootPaneUI", "javax/swing/plaf/basic/BasicRootPaneUI.html"],
+ \["BasicScrollBarUI", "javax/swing/plaf/basic/BasicScrollBarUI.html"],
+ \["BasicScrollPaneUI", "javax/swing/plaf/basic/BasicScrollPaneUI.html"],
+ \["BasicSeparatorUI", "javax/swing/plaf/basic/BasicSeparatorUI.html"],
+ \["BasicSliderUI", "javax/swing/plaf/basic/BasicSliderUI.html"],
+ \["BasicSpinnerUI", "javax/swing/plaf/basic/BasicSpinnerUI.html"],
+ \["BasicSplitPaneDivider", "javax/swing/plaf/basic/BasicSplitPaneDivider.html"],
+ \["BasicSplitPaneUI", "javax/swing/plaf/basic/BasicSplitPaneUI.html"],
+ \["BasicStroke", "java/awt/BasicStroke.html"],
+ \["BasicTabbedPaneUI", "javax/swing/plaf/basic/BasicTabbedPaneUI.html"],
+ \["BasicTableHeaderUI", "javax/swing/plaf/basic/BasicTableHeaderUI.html"],
+ \["BasicTableUI", "javax/swing/plaf/basic/BasicTableUI.html"],
+ \["BasicTextAreaUI", "javax/swing/plaf/basic/BasicTextAreaUI.html"],
+ \["BasicTextFieldUI", "javax/swing/plaf/basic/BasicTextFieldUI.html"],
+ \["BasicTextPaneUI", "javax/swing/plaf/basic/BasicTextPaneUI.html"],
+ \["BasicTextUI", "javax/swing/plaf/basic/BasicTextUI.html"],
+ \["BasicTextUI.BasicCaret", "javax/swing/plaf/basic/BasicTextUI.BasicCaret.html"],
+ \["BasicTextUI.BasicHighlighter", "javax/swing/plaf/basic/BasicTextUI.BasicHighlighter.html"],
+ \["BasicToggleButtonUI", "javax/swing/plaf/basic/BasicToggleButtonUI.html"],
+ \["BasicToolBarSeparatorUI", "javax/swing/plaf/basic/BasicToolBarSeparatorUI.html"],
+ \["BasicToolBarUI", "javax/swing/plaf/basic/BasicToolBarUI.html"],
+ \["BasicToolTipUI", "javax/swing/plaf/basic/BasicToolTipUI.html"],
+ \["BasicTreeUI", "javax/swing/plaf/basic/BasicTreeUI.html"],
+ \["BasicViewportUI", "javax/swing/plaf/basic/BasicViewportUI.html"],
+ \["BatchUpdateException", "java/sql/BatchUpdateException.html"],
+ \["BeanContext", "java/beans/beancontext/BeanContext.html"],
+ \["BeanContextChild", "java/beans/beancontext/BeanContextChild.html"],
+ \["BeanContextChildComponentProxy", "java/beans/beancontext/BeanContextChildComponentProxy.html"],
+ \["BeanContextChildSupport", "java/beans/beancontext/BeanContextChildSupport.html"],
+ \["BeanContextContainerProxy", "java/beans/beancontext/BeanContextContainerProxy.html"],
+ \["BeanContextEvent", "java/beans/beancontext/BeanContextEvent.html"],
+ \["BeanContextMembershipEvent", "java/beans/beancontext/BeanContextMembershipEvent.html"],
+ \["BeanContextMembershipListener", "java/beans/beancontext/BeanContextMembershipListener.html"],
+ \["BeanContextProxy", "java/beans/beancontext/BeanContextProxy.html"],
+ \["BeanContextServiceAvailableEvent", "java/beans/beancontext/BeanContextServiceAvailableEvent.html"],
+ \["BeanContextServiceProvider", "java/beans/beancontext/BeanContextServiceProvider.html"],
+ \["BeanContextServiceProviderBeanInfo", "java/beans/beancontext/BeanContextServiceProviderBeanInfo.html"],
+ \["BeanContextServiceRevokedEvent", "java/beans/beancontext/BeanContextServiceRevokedEvent.html"],
+ \["BeanContextServiceRevokedListener", "java/beans/beancontext/BeanContextServiceRevokedListener.html"],
+ \["BeanContextServices", "java/beans/beancontext/BeanContextServices.html"],
+ \["BeanContextServicesListener", "java/beans/beancontext/BeanContextServicesListener.html"],
+ \["BeanContextServicesSupport", "java/beans/beancontext/BeanContextServicesSupport.html"],
+ \["BeanContextServicesSupport.BCSSServiceProvider", "java/beans/beancontext/BeanContextServicesSupport.BCSSServiceProvider.html"],
+ \["BeanContextSupport", "java/beans/beancontext/BeanContextSupport.html"],
+ \["BeanContextSupport.BCSIterator", "java/beans/beancontext/BeanContextSupport.BCSIterator.html"],
+ \["BeanDescriptor", "java/beans/BeanDescriptor.html"],
+ \["BeanInfo", "java/beans/BeanInfo.html"],
+ \["Beans", "java/beans/Beans.html"],
+ \["BevelBorder", "javax/swing/border/BevelBorder.html"],
+ \["Bidi", "java/text/Bidi.html"],
+ \["BigDecimal", "java/math/BigDecimal.html"],
+ \["BigInteger", "java/math/BigInteger.html"],
+ \["BinaryRefAddr", "javax/naming/BinaryRefAddr.html"],
+ \["Binder", "javax/xml/bind/Binder.html"],
+ \["BindException", "java/net/BindException.html"],
+ \["Binding", "javax/naming/Binding.html"],
+ \["Binding", "javax/xml/ws/Binding.html"],
+ \["Binding", "org/omg/CosNaming/Binding.html"],
+ \["BindingHelper", "org/omg/CosNaming/BindingHelper.html"],
+ \["BindingHolder", "org/omg/CosNaming/BindingHolder.html"],
+ \["BindingIterator", "org/omg/CosNaming/BindingIterator.html"],
+ \["BindingIteratorHelper", "org/omg/CosNaming/BindingIteratorHelper.html"],
+ \["BindingIteratorHolder", "org/omg/CosNaming/BindingIteratorHolder.html"],
+ \["BindingIteratorOperations", "org/omg/CosNaming/BindingIteratorOperations.html"],
+ \["BindingIteratorPOA", "org/omg/CosNaming/BindingIteratorPOA.html"],
+ \["BindingListHelper", "org/omg/CosNaming/BindingListHelper.html"],
+ \["BindingListHolder", "org/omg/CosNaming/BindingListHolder.html"],
+ \["BindingProvider", "javax/xml/ws/BindingProvider.html"],
+ \["Bindings", "javax/script/Bindings.html"],
+ \["BindingType", "javax/xml/ws/BindingType.html"],
+ \["BindingType", "org/omg/CosNaming/BindingType.html"],
+ \["BindingTypeHelper", "org/omg/CosNaming/BindingTypeHelper.html"],
+ \["BindingTypeHolder", "org/omg/CosNaming/BindingTypeHolder.html"],
+ \["BitSet", "java/util/BitSet.html"],
+ \["Blob", "java/sql/Blob.html"],
+ \["BlockingDeque", "java/util/concurrent/BlockingDeque.html"],
+ \["BlockingQueue", "java/util/concurrent/BlockingQueue.html"],
+ \["BlockView", "javax/swing/text/html/BlockView.html"],
+ \["BMPImageWriteParam", "javax/imageio/plugins/bmp/BMPImageWriteParam.html"],
+ \["Book", "java/awt/print/Book.html"],
+ \["Boolean", "java/lang/Boolean.html"],
+ \["BooleanControl", "javax/sound/sampled/BooleanControl.html"],
+ \["BooleanControl.Type", "javax/sound/sampled/BooleanControl.Type.html"],
+ \["BooleanHolder", "org/omg/CORBA/BooleanHolder.html"],
+ \["BooleanSeqHelper", "org/omg/CORBA/BooleanSeqHelper.html"],
+ \["BooleanSeqHolder", "org/omg/CORBA/BooleanSeqHolder.html"],
+ \["Border", "javax/swing/border/Border.html"],
+ \["BorderFactory", "javax/swing/BorderFactory.html"],
+ \["BorderLayout", "java/awt/BorderLayout.html"],
+ \["BorderUIResource", "javax/swing/plaf/BorderUIResource.html"],
+ \["BorderUIResource.BevelBorderUIResource", "javax/swing/plaf/BorderUIResource.BevelBorderUIResource.html"],
+ \["BorderUIResource.CompoundBorderUIResource", "javax/swing/plaf/BorderUIResource.CompoundBorderUIResource.html"],
+ \["BorderUIResource.EmptyBorderUIResource", "javax/swing/plaf/BorderUIResource.EmptyBorderUIResource.html"],
+ \["BorderUIResource.EtchedBorderUIResource", "javax/swing/plaf/BorderUIResource.EtchedBorderUIResource.html"],
+ \["BorderUIResource.LineBorderUIResource", "javax/swing/plaf/BorderUIResource.LineBorderUIResource.html"],
+ \["BorderUIResource.MatteBorderUIResource", "javax/swing/plaf/BorderUIResource.MatteBorderUIResource.html"],
+ \["BorderUIResource.TitledBorderUIResource", "javax/swing/plaf/BorderUIResource.TitledBorderUIResource.html"],
+ \["BoundedRangeModel", "javax/swing/BoundedRangeModel.html"],
+ \["Bounds", "org/omg/CORBA/Bounds.html"],
+ \["Bounds", "org/omg/CORBA/TypeCodePackage/Bounds.html"],
+ \["Box", "javax/swing/Box.html"],
+ \["Box.Filler", "javax/swing/Box.Filler.html"],
+ \["BoxedValueHelper", "org/omg/CORBA/portable/BoxedValueHelper.html"],
+ \["BoxLayout", "javax/swing/BoxLayout.html"],
+ \["BoxView", "javax/swing/text/BoxView.html"],
+ \["BreakIterator", "java/text/BreakIterator.html"],
+ \["BreakIteratorProvider", "java/text/spi/BreakIteratorProvider.html"],
+ \["BrokenBarrierException", "java/util/concurrent/BrokenBarrierException.html"],
+ \["Buffer", "java/nio/Buffer.html"],
+ \["BufferCapabilities", "java/awt/BufferCapabilities.html"],
+ \["BufferCapabilities.FlipContents", "java/awt/BufferCapabilities.FlipContents.html"],
+ \["BufferedImage", "java/awt/image/BufferedImage.html"],
+ \["BufferedImageFilter", "java/awt/image/BufferedImageFilter.html"],
+ \["BufferedImageOp", "java/awt/image/BufferedImageOp.html"],
+ \["BufferedInputStream", "java/io/BufferedInputStream.html"],
+ \["BufferedOutputStream", "java/io/BufferedOutputStream.html"],
+ \["BufferedReader", "java/io/BufferedReader.html"],
+ \["BufferedWriter", "java/io/BufferedWriter.html"],
+ \["BufferOverflowException", "java/nio/BufferOverflowException.html"],
+ \["BufferStrategy", "java/awt/image/BufferStrategy.html"],
+ \["BufferUnderflowException", "java/nio/BufferUnderflowException.html"],
+ \["Button", "java/awt/Button.html"],
+ \["ButtonGroup", "javax/swing/ButtonGroup.html"],
+ \["ButtonModel", "javax/swing/ButtonModel.html"],
+ \["ButtonUI", "javax/swing/plaf/ButtonUI.html"],
+ \["Byte", "java/lang/Byte.html"],
+ \["ByteArrayInputStream", "java/io/ByteArrayInputStream.html"],
+ \["ByteArrayOutputStream", "java/io/ByteArrayOutputStream.html"],
+ \["ByteBuffer", "java/nio/ByteBuffer.html"],
+ \["ByteChannel", "java/nio/channels/ByteChannel.html"],
+ \["ByteHolder", "org/omg/CORBA/ByteHolder.html"],
+ \["ByteLookupTable", "java/awt/image/ByteLookupTable.html"],
+ \["ByteOrder", "java/nio/ByteOrder.html"],
+ \["C14NMethodParameterSpec", "javax/xml/crypto/dsig/spec/C14NMethodParameterSpec.html"],
+ \["CachedRowSet", "javax/sql/rowset/CachedRowSet.html"],
+ \["CacheRequest", "java/net/CacheRequest.html"],
+ \["CacheResponse", "java/net/CacheResponse.html"],
+ \["Calendar", "java/util/Calendar.html"],
+ \["Callable", "java/util/concurrent/Callable.html"],
+ \["CallableStatement", "java/sql/CallableStatement.html"],
+ \["Callback", "javax/security/auth/callback/Callback.html"],
+ \["CallbackHandler", "javax/security/auth/callback/CallbackHandler.html"],
+ \["CancelablePrintJob", "javax/print/CancelablePrintJob.html"],
+ \["CancellationException", "java/util/concurrent/CancellationException.html"],
+ \["CancelledKeyException", "java/nio/channels/CancelledKeyException.html"],
+ \["CannotProceed", "org/omg/CosNaming/NamingContextPackage/CannotProceed.html"],
+ \["CannotProceedException", "javax/naming/CannotProceedException.html"],
+ \["CannotProceedHelper", "org/omg/CosNaming/NamingContextPackage/CannotProceedHelper.html"],
+ \["CannotProceedHolder", "org/omg/CosNaming/NamingContextPackage/CannotProceedHolder.html"],
+ \["CannotRedoException", "javax/swing/undo/CannotRedoException.html"],
+ \["CannotUndoException", "javax/swing/undo/CannotUndoException.html"],
+ \["CanonicalizationMethod", "javax/xml/crypto/dsig/CanonicalizationMethod.html"],
+ \["Canvas", "java/awt/Canvas.html"],
+ \["CardLayout", "java/awt/CardLayout.html"],
+ \["Caret", "javax/swing/text/Caret.html"],
+ \["CaretEvent", "javax/swing/event/CaretEvent.html"],
+ \["CaretListener", "javax/swing/event/CaretListener.html"],
+ \["CDATASection", "org/w3c/dom/CDATASection.html"],
+ \["CellEditor", "javax/swing/CellEditor.html"],
+ \["CellEditorListener", "javax/swing/event/CellEditorListener.html"],
+ \["CellRendererPane", "javax/swing/CellRendererPane.html"],
+ \["Certificate", "java/security/cert/Certificate.html"],
+ \["Certificate", "java/security/Certificate.html"],
+ \["Certificate", "javax/security/cert/Certificate.html"],
+ \["Certificate.CertificateRep", "java/security/cert/Certificate.CertificateRep.html"],
+ \["CertificateEncodingException", "java/security/cert/CertificateEncodingException.html"],
+ \["CertificateEncodingException", "javax/security/cert/CertificateEncodingException.html"],
+ \["CertificateException", "java/security/cert/CertificateException.html"],
+ \["CertificateException", "javax/security/cert/CertificateException.html"],
+ \["CertificateExpiredException", "java/security/cert/CertificateExpiredException.html"],
+ \["CertificateExpiredException", "javax/security/cert/CertificateExpiredException.html"],
+ \["CertificateFactory", "java/security/cert/CertificateFactory.html"],
+ \["CertificateFactorySpi", "java/security/cert/CertificateFactorySpi.html"],
+ \["CertificateNotYetValidException", "java/security/cert/CertificateNotYetValidException.html"],
+ \["CertificateNotYetValidException", "javax/security/cert/CertificateNotYetValidException.html"],
+ \["CertificateParsingException", "java/security/cert/CertificateParsingException.html"],
+ \["CertificateParsingException", "javax/security/cert/CertificateParsingException.html"],
+ \["CertPath", "java/security/cert/CertPath.html"],
+ \["CertPath.CertPathRep", "java/security/cert/CertPath.CertPathRep.html"],
+ \["CertPathBuilder", "java/security/cert/CertPathBuilder.html"],
+ \["CertPathBuilderException", "java/security/cert/CertPathBuilderException.html"],
+ \["CertPathBuilderResult", "java/security/cert/CertPathBuilderResult.html"],
+ \["CertPathBuilderSpi", "java/security/cert/CertPathBuilderSpi.html"],
+ \["CertPathParameters", "java/security/cert/CertPathParameters.html"],
+ \["CertPathTrustManagerParameters", "javax/net/ssl/CertPathTrustManagerParameters.html"],
+ \["CertPathValidator", "java/security/cert/CertPathValidator.html"],
+ \["CertPathValidatorException", "java/security/cert/CertPathValidatorException.html"],
+ \["CertPathValidatorResult", "java/security/cert/CertPathValidatorResult.html"],
+ \["CertPathValidatorSpi", "java/security/cert/CertPathValidatorSpi.html"],
+ \["CertSelector", "java/security/cert/CertSelector.html"],
+ \["CertStore", "java/security/cert/CertStore.html"],
+ \["CertStoreException", "java/security/cert/CertStoreException.html"],
+ \["CertStoreParameters", "java/security/cert/CertStoreParameters.html"],
+ \["CertStoreSpi", "java/security/cert/CertStoreSpi.html"],
+ \["ChangedCharSetException", "javax/swing/text/ChangedCharSetException.html"],
+ \["ChangeEvent", "javax/swing/event/ChangeEvent.html"],
+ \["ChangeListener", "javax/swing/event/ChangeListener.html"],
+ \["Channel", "java/nio/channels/Channel.html"],
+ \["ChannelBinding", "org/ietf/jgss/ChannelBinding.html"],
+ \["Channels", "java/nio/channels/Channels.html"],
+ \["Character", "java/lang/Character.html"],
+ \["Character.Subset", "java/lang/Character.Subset.html"],
+ \["Character.UnicodeBlock", "java/lang/Character.UnicodeBlock.html"],
+ \["CharacterCodingException", "java/nio/charset/CharacterCodingException.html"],
+ \["CharacterData", "org/w3c/dom/CharacterData.html"],
+ \["CharacterIterator", "java/text/CharacterIterator.html"],
+ \["Characters", "javax/xml/stream/events/Characters.html"],
+ \["CharArrayReader", "java/io/CharArrayReader.html"],
+ \["CharArrayWriter", "java/io/CharArrayWriter.html"],
+ \["CharBuffer", "java/nio/CharBuffer.html"],
+ \["CharConversionException", "java/io/CharConversionException.html"],
+ \["CharHolder", "org/omg/CORBA/CharHolder.html"],
+ \["CharSeqHelper", "org/omg/CORBA/CharSeqHelper.html"],
+ \["CharSeqHolder", "org/omg/CORBA/CharSeqHolder.html"],
+ \["CharSequence", "java/lang/CharSequence.html"],
+ \["Charset", "java/nio/charset/Charset.html"],
+ \["CharsetDecoder", "java/nio/charset/CharsetDecoder.html"],
+ \["CharsetEncoder", "java/nio/charset/CharsetEncoder.html"],
+ \["CharsetProvider", "java/nio/charset/spi/CharsetProvider.html"],
+ \["Checkbox", "java/awt/Checkbox.html"],
+ \["CheckboxGroup", "java/awt/CheckboxGroup.html"],
+ \["CheckboxMenuItem", "java/awt/CheckboxMenuItem.html"],
+ \["CheckedInputStream", "java/util/zip/CheckedInputStream.html"],
+ \["CheckedOutputStream", "java/util/zip/CheckedOutputStream.html"],
+ \["Checksum", "java/util/zip/Checksum.html"],
+ \["Choice", "java/awt/Choice.html"],
+ \["ChoiceCallback", "javax/security/auth/callback/ChoiceCallback.html"],
+ \["ChoiceFormat", "java/text/ChoiceFormat.html"],
+ \["Chromaticity", "javax/print/attribute/standard/Chromaticity.html"],
+ \["Cipher", "javax/crypto/Cipher.html"],
+ \["CipherInputStream", "javax/crypto/CipherInputStream.html"],
+ \["CipherOutputStream", "javax/crypto/CipherOutputStream.html"],
+ \["CipherSpi", "javax/crypto/CipherSpi.html"],
+ \["Class", "java/lang/Class.html"],
+ \["ClassCastException", "java/lang/ClassCastException.html"],
+ \["ClassCircularityError", "java/lang/ClassCircularityError.html"],
+ \["ClassDefinition", "java/lang/instrument/ClassDefinition.html"],
+ \["ClassDesc", "javax/rmi/CORBA/ClassDesc.html"],
+ \["ClassFileTransformer", "java/lang/instrument/ClassFileTransformer.html"],
+ \["ClassFormatError", "java/lang/ClassFormatError.html"],
+ \["ClassLoader", "java/lang/ClassLoader.html"],
+ \["ClassLoaderRepository", "javax/management/loading/ClassLoaderRepository.html"],
+ \["ClassLoadingMXBean", "java/lang/management/ClassLoadingMXBean.html"],
+ \["ClassNotFoundException", "java/lang/ClassNotFoundException.html"],
+ \["ClientInfoStatus", "java/sql/ClientInfoStatus.html"],
+ \["ClientRequestInfo", "org/omg/PortableInterceptor/ClientRequestInfo.html"],
+ \["ClientRequestInfoOperations", "org/omg/PortableInterceptor/ClientRequestInfoOperations.html"],
+ \["ClientRequestInterceptor", "org/omg/PortableInterceptor/ClientRequestInterceptor.html"],
+ \["ClientRequestInterceptorOperations", "org/omg/PortableInterceptor/ClientRequestInterceptorOperations.html"],
+ \["Clip", "javax/sound/sampled/Clip.html"],
+ \["Clipboard", "java/awt/datatransfer/Clipboard.html"],
+ \["ClipboardOwner", "java/awt/datatransfer/ClipboardOwner.html"],
+ \["Clob", "java/sql/Clob.html"],
+ \["Cloneable", "java/lang/Cloneable.html"],
+ \["CloneNotSupportedException", "java/lang/CloneNotSupportedException.html"],
+ \["Closeable", "java/io/Closeable.html"],
+ \["ClosedByInterruptException", "java/nio/channels/ClosedByInterruptException.html"],
+ \["ClosedChannelException", "java/nio/channels/ClosedChannelException.html"],
+ \["ClosedSelectorException", "java/nio/channels/ClosedSelectorException.html"],
+ \["CMMException", "java/awt/color/CMMException.html"],
+ \["Codec", "org/omg/IOP/Codec.html"],
+ \["CodecFactory", "org/omg/IOP/CodecFactory.html"],
+ \["CodecFactoryHelper", "org/omg/IOP/CodecFactoryHelper.html"],
+ \["CodecFactoryOperations", "org/omg/IOP/CodecFactoryOperations.html"],
+ \["CodecOperations", "org/omg/IOP/CodecOperations.html"],
+ \["CoderMalfunctionError", "java/nio/charset/CoderMalfunctionError.html"],
+ \["CoderResult", "java/nio/charset/CoderResult.html"],
+ \["CODESET_INCOMPATIBLE", "org/omg/CORBA/CODESET_INCOMPATIBLE.html"],
+ \["CodeSets", "org/omg/IOP/CodeSets.html"],
+ \["CodeSigner", "java/security/CodeSigner.html"],
+ \["CodeSource", "java/security/CodeSource.html"],
+ \["CodingErrorAction", "java/nio/charset/CodingErrorAction.html"],
+ \["CollapsedStringAdapter", "javax/xml/bind/annotation/adapters/CollapsedStringAdapter.html"],
+ \["CollationElementIterator", "java/text/CollationElementIterator.html"],
+ \["CollationKey", "java/text/CollationKey.html"],
+ \["Collator", "java/text/Collator.html"],
+ \["CollatorProvider", "java/text/spi/CollatorProvider.html"],
+ \["Collection", "java/util/Collection.html"],
+ \["CollectionCertStoreParameters", "java/security/cert/CollectionCertStoreParameters.html"],
+ \["Collections", "java/util/Collections.html"],
+ \["Color", "java/awt/Color.html"],
+ \["ColorChooserComponentFactory", "javax/swing/colorchooser/ColorChooserComponentFactory.html"],
+ \["ColorChooserUI", "javax/swing/plaf/ColorChooserUI.html"],
+ \["ColorConvertOp", "java/awt/image/ColorConvertOp.html"],
+ \["ColorModel", "java/awt/image/ColorModel.html"],
+ \["ColorSelectionModel", "javax/swing/colorchooser/ColorSelectionModel.html"],
+ \["ColorSpace", "java/awt/color/ColorSpace.html"],
+ \["ColorSupported", "javax/print/attribute/standard/ColorSupported.html"],
+ \["ColorType", "javax/swing/plaf/synth/ColorType.html"],
+ \["ColorUIResource", "javax/swing/plaf/ColorUIResource.html"],
+ \["ComboBoxEditor", "javax/swing/ComboBoxEditor.html"],
+ \["ComboBoxModel", "javax/swing/ComboBoxModel.html"],
+ \["ComboBoxUI", "javax/swing/plaf/ComboBoxUI.html"],
+ \["ComboPopup", "javax/swing/plaf/basic/ComboPopup.html"],
+ \["COMM_FAILURE", "org/omg/CORBA/COMM_FAILURE.html"],
+ \["CommandInfo", "javax/activation/CommandInfo.html"],
+ \["CommandMap", "javax/activation/CommandMap.html"],
+ \["CommandObject", "javax/activation/CommandObject.html"],
+ \["Comment", "javax/xml/stream/events/Comment.html"],
+ \["Comment", "org/w3c/dom/Comment.html"],
+ \["CommonDataSource", "javax/sql/CommonDataSource.html"],
+ \["CommunicationException", "javax/naming/CommunicationException.html"],
+ \["Comparable", "java/lang/Comparable.html"],
+ \["Comparator", "java/util/Comparator.html"],
+ \["Compilable", "javax/script/Compilable.html"],
+ \["CompilationMXBean", "java/lang/management/CompilationMXBean.html"],
+ \["CompiledScript", "javax/script/CompiledScript.html"],
+ \["Compiler", "java/lang/Compiler.html"],
+ \["Completion", "javax/annotation/processing/Completion.html"],
+ \["Completions", "javax/annotation/processing/Completions.html"],
+ \["CompletionService", "java/util/concurrent/CompletionService.html"],
+ \["CompletionStatus", "org/omg/CORBA/CompletionStatus.html"],
+ \["CompletionStatusHelper", "org/omg/CORBA/CompletionStatusHelper.html"],
+ \["Component", "java/awt/Component.html"],
+ \["Component.BaselineResizeBehavior", "java/awt/Component.BaselineResizeBehavior.html"],
+ \["ComponentAdapter", "java/awt/event/ComponentAdapter.html"],
+ \["ComponentColorModel", "java/awt/image/ComponentColorModel.html"],
+ \["ComponentEvent", "java/awt/event/ComponentEvent.html"],
+ \["ComponentIdHelper", "org/omg/IOP/ComponentIdHelper.html"],
+ \["ComponentInputMap", "javax/swing/ComponentInputMap.html"],
+ \["ComponentInputMapUIResource", "javax/swing/plaf/ComponentInputMapUIResource.html"],
+ \["ComponentListener", "java/awt/event/ComponentListener.html"],
+ \["ComponentOrientation", "java/awt/ComponentOrientation.html"],
+ \["ComponentSampleModel", "java/awt/image/ComponentSampleModel.html"],
+ \["ComponentUI", "javax/swing/plaf/ComponentUI.html"],
+ \["ComponentView", "javax/swing/text/ComponentView.html"],
+ \["Composite", "java/awt/Composite.html"],
+ \["CompositeContext", "java/awt/CompositeContext.html"],
+ \["CompositeData", "javax/management/openmbean/CompositeData.html"],
+ \["CompositeDataInvocationHandler", "javax/management/openmbean/CompositeDataInvocationHandler.html"],
+ \["CompositeDataSupport", "javax/management/openmbean/CompositeDataSupport.html"],
+ \["CompositeDataView", "javax/management/openmbean/CompositeDataView.html"],
+ \["CompositeName", "javax/naming/CompositeName.html"],
+ \["CompositeType", "javax/management/openmbean/CompositeType.html"],
+ \["CompositeView", "javax/swing/text/CompositeView.html"],
+ \["CompoundBorder", "javax/swing/border/CompoundBorder.html"],
+ \["CompoundControl", "javax/sound/sampled/CompoundControl.html"],
+ \["CompoundControl.Type", "javax/sound/sampled/CompoundControl.Type.html"],
+ \["CompoundEdit", "javax/swing/undo/CompoundEdit.html"],
+ \["CompoundName", "javax/naming/CompoundName.html"],
+ \["Compression", "javax/print/attribute/standard/Compression.html"],
+ \["ConcurrentHashMap", "java/util/concurrent/ConcurrentHashMap.html"],
+ \["ConcurrentLinkedQueue", "java/util/concurrent/ConcurrentLinkedQueue.html"],
+ \["ConcurrentMap", "java/util/concurrent/ConcurrentMap.html"],
+ \["ConcurrentModificationException", "java/util/ConcurrentModificationException.html"],
+ \["ConcurrentNavigableMap", "java/util/concurrent/ConcurrentNavigableMap.html"],
+ \["ConcurrentSkipListMap", "java/util/concurrent/ConcurrentSkipListMap.html"],
+ \["ConcurrentSkipListSet", "java/util/concurrent/ConcurrentSkipListSet.html"],
+ \["Condition", "java/util/concurrent/locks/Condition.html"],
+ \["Configuration", "javax/security/auth/login/Configuration.html"],
+ \["Configuration.Parameters", "javax/security/auth/login/Configuration.Parameters.html"],
+ \["ConfigurationException", "javax/naming/ConfigurationException.html"],
+ \["ConfigurationSpi", "javax/security/auth/login/ConfigurationSpi.html"],
+ \["ConfirmationCallback", "javax/security/auth/callback/ConfirmationCallback.html"],
+ \["ConnectException", "java/net/ConnectException.html"],
+ \["ConnectException", "java/rmi/ConnectException.html"],
+ \["ConnectIOException", "java/rmi/ConnectIOException.html"],
+ \["Connection", "java/sql/Connection.html"],
+ \["ConnectionEvent", "javax/sql/ConnectionEvent.html"],
+ \["ConnectionEventListener", "javax/sql/ConnectionEventListener.html"],
+ \["ConnectionPendingException", "java/nio/channels/ConnectionPendingException.html"],
+ \["ConnectionPoolDataSource", "javax/sql/ConnectionPoolDataSource.html"],
+ \["Console", "java/io/Console.html"],
+ \["ConsoleHandler", "java/util/logging/ConsoleHandler.html"],
+ \["Constructor", "java/lang/reflect/Constructor.html"],
+ \["ConstructorProperties", "java/beans/ConstructorProperties.html"],
+ \["Container", "java/awt/Container.html"],
+ \["ContainerAdapter", "java/awt/event/ContainerAdapter.html"],
+ \["ContainerEvent", "java/awt/event/ContainerEvent.html"],
+ \["ContainerListener", "java/awt/event/ContainerListener.html"],
+ \["ContainerOrderFocusTraversalPolicy", "java/awt/ContainerOrderFocusTraversalPolicy.html"],
+ \["ContentHandler", "java/net/ContentHandler.html"],
+ \["ContentHandler", "org/xml/sax/ContentHandler.html"],
+ \["ContentHandlerFactory", "java/net/ContentHandlerFactory.html"],
+ \["ContentModel", "javax/swing/text/html/parser/ContentModel.html"],
+ \["Context", "javax/naming/Context.html"],
+ \["Context", "org/omg/CORBA/Context.html"],
+ \["ContextList", "org/omg/CORBA/ContextList.html"],
+ \["ContextNotEmptyException", "javax/naming/ContextNotEmptyException.html"],
+ \["ContextualRenderedImageFactory", "java/awt/image/renderable/ContextualRenderedImageFactory.html"],
+ \["Control", "javax/naming/ldap/Control.html"],
+ \["Control", "javax/sound/sampled/Control.html"],
+ \["Control.Type", "javax/sound/sampled/Control.Type.html"],
+ \["ControlFactory", "javax/naming/ldap/ControlFactory.html"],
+ \["ControllerEventListener", "javax/sound/midi/ControllerEventListener.html"],
+ \["ConvolveOp", "java/awt/image/ConvolveOp.html"],
+ \["CookieHandler", "java/net/CookieHandler.html"],
+ \["CookieHolder", "org/omg/PortableServer/ServantLocatorPackage/CookieHolder.html"],
+ \["CookieManager", "java/net/CookieManager.html"],
+ \["CookiePolicy", "java/net/CookiePolicy.html"],
+ \["CookieStore", "java/net/CookieStore.html"],
+ \["Copies", "javax/print/attribute/standard/Copies.html"],
+ \["CopiesSupported", "javax/print/attribute/standard/CopiesSupported.html"],
+ \["CopyOnWriteArrayList", "java/util/concurrent/CopyOnWriteArrayList.html"],
+ \["CopyOnWriteArraySet", "java/util/concurrent/CopyOnWriteArraySet.html"],
+ \["CountDownLatch", "java/util/concurrent/CountDownLatch.html"],
+ \["CounterMonitor", "javax/management/monitor/CounterMonitor.html"],
+ \["CounterMonitorMBean", "javax/management/monitor/CounterMonitorMBean.html"],
+ \["CRC32", "java/util/zip/CRC32.html"],
+ \["CredentialException", "javax/security/auth/login/CredentialException.html"],
+ \["CredentialExpiredException", "javax/security/auth/login/CredentialExpiredException.html"],
+ \["CredentialNotFoundException", "javax/security/auth/login/CredentialNotFoundException.html"],
+ \["CRL", "java/security/cert/CRL.html"],
+ \["CRLException", "java/security/cert/CRLException.html"],
+ \["CRLSelector", "java/security/cert/CRLSelector.html"],
+ \["CropImageFilter", "java/awt/image/CropImageFilter.html"],
+ \["CSS", "javax/swing/text/html/CSS.html"],
+ \["CSS.Attribute", "javax/swing/text/html/CSS.Attribute.html"],
+ \["CTX_RESTRICT_SCOPE", "org/omg/CORBA/CTX_RESTRICT_SCOPE.html"],
+ \["CubicCurve2D", "java/awt/geom/CubicCurve2D.html"],
+ \["CubicCurve2D.Double", "java/awt/geom/CubicCurve2D.Double.html"],
+ \["CubicCurve2D.Float", "java/awt/geom/CubicCurve2D.Float.html"],
+ \["Currency", "java/util/Currency.html"],
+ \["CurrencyNameProvider", "java/util/spi/CurrencyNameProvider.html"],
+ \["Current", "org/omg/CORBA/Current.html"],
+ \["Current", "org/omg/PortableInterceptor/Current.html"],
+ \["Current", "org/omg/PortableServer/Current.html"],
+ \["CurrentHelper", "org/omg/CORBA/CurrentHelper.html"],
+ \["CurrentHelper", "org/omg/PortableInterceptor/CurrentHelper.html"],
+ \["CurrentHelper", "org/omg/PortableServer/CurrentHelper.html"],
+ \["CurrentHolder", "org/omg/CORBA/CurrentHolder.html"],
+ \["CurrentOperations", "org/omg/CORBA/CurrentOperations.html"],
+ \["CurrentOperations", "org/omg/PortableInterceptor/CurrentOperations.html"],
+ \["CurrentOperations", "org/omg/PortableServer/CurrentOperations.html"],
+ \["Cursor", "java/awt/Cursor.html"],
+ \["Customizer", "java/beans/Customizer.html"],
+ \["CustomMarshal", "org/omg/CORBA/CustomMarshal.html"],
+ \["CustomValue", "org/omg/CORBA/portable/CustomValue.html"],
+ \["CyclicBarrier", "java/util/concurrent/CyclicBarrier.html"],
+ \["Data", "javax/xml/crypto/Data.html"],
+ \["DATA_CONVERSION", "org/omg/CORBA/DATA_CONVERSION.html"],
+ \["DatabaseMetaData", "java/sql/DatabaseMetaData.html"],
+ \["DataBindingException", "javax/xml/bind/DataBindingException.html"],
+ \["DataBuffer", "java/awt/image/DataBuffer.html"],
+ \["DataBufferByte", "java/awt/image/DataBufferByte.html"],
+ \["DataBufferDouble", "java/awt/image/DataBufferDouble.html"],
+ \["DataBufferFloat", "java/awt/image/DataBufferFloat.html"],
+ \["DataBufferInt", "java/awt/image/DataBufferInt.html"],
+ \["DataBufferShort", "java/awt/image/DataBufferShort.html"],
+ \["DataBufferUShort", "java/awt/image/DataBufferUShort.html"],
+ \["DataContentHandler", "javax/activation/DataContentHandler.html"],
+ \["DataContentHandlerFactory", "javax/activation/DataContentHandlerFactory.html"],
+ \["DataFlavor", "java/awt/datatransfer/DataFlavor.html"],
+ \["DataFormatException", "java/util/zip/DataFormatException.html"],
+ \["DatagramChannel", "java/nio/channels/DatagramChannel.html"],
+ \["DatagramPacket", "java/net/DatagramPacket.html"],
+ \["DatagramSocket", "java/net/DatagramSocket.html"],
+ \["DatagramSocketImpl", "java/net/DatagramSocketImpl.html"],
+ \["DatagramSocketImplFactory", "java/net/DatagramSocketImplFactory.html"],
+ \["DataHandler", "javax/activation/DataHandler.html"],
+ \["DataInput", "java/io/DataInput.html"],
+ \["DataInputStream", "java/io/DataInputStream.html"],
+ \["DataInputStream", "org/omg/CORBA/DataInputStream.html"],
+ \["DataLine", "javax/sound/sampled/DataLine.html"],
+ \["DataLine.Info", "javax/sound/sampled/DataLine.Info.html"],
+ \["DataOutput", "java/io/DataOutput.html"],
+ \["DataOutputStream", "java/io/DataOutputStream.html"],
+ \["DataOutputStream", "org/omg/CORBA/DataOutputStream.html"],
+ \["DataSource", "javax/activation/DataSource.html"],
+ \["DataSource", "javax/sql/DataSource.html"],
+ \["DataTruncation", "java/sql/DataTruncation.html"],
+ \["DatatypeConfigurationException", "javax/xml/datatype/DatatypeConfigurationException.html"],
+ \["DatatypeConstants", "javax/xml/datatype/DatatypeConstants.html"],
+ \["DatatypeConstants.Field", "javax/xml/datatype/DatatypeConstants.Field.html"],
+ \["DatatypeConverter", "javax/xml/bind/DatatypeConverter.html"],
+ \["DatatypeConverterInterface", "javax/xml/bind/DatatypeConverterInterface.html"],
+ \["DatatypeFactory", "javax/xml/datatype/DatatypeFactory.html"],
+ \["Date", "java/sql/Date.html"],
+ \["Date", "java/util/Date.html"],
+ \["DateFormat", "java/text/DateFormat.html"],
+ \["DateFormat.Field", "java/text/DateFormat.Field.html"],
+ \["DateFormatProvider", "java/text/spi/DateFormatProvider.html"],
+ \["DateFormatSymbols", "java/text/DateFormatSymbols.html"],
+ \["DateFormatSymbolsProvider", "java/text/spi/DateFormatSymbolsProvider.html"],
+ \["DateFormatter", "javax/swing/text/DateFormatter.html"],
+ \["DateTimeAtCompleted", "javax/print/attribute/standard/DateTimeAtCompleted.html"],
+ \["DateTimeAtCreation", "javax/print/attribute/standard/DateTimeAtCreation.html"],
+ \["DateTimeAtProcessing", "javax/print/attribute/standard/DateTimeAtProcessing.html"],
+ \["DateTimeSyntax", "javax/print/attribute/DateTimeSyntax.html"],
+ \["DebugGraphics", "javax/swing/DebugGraphics.html"],
+ \["DecimalFormat", "java/text/DecimalFormat.html"],
+ \["DecimalFormatSymbols", "java/text/DecimalFormatSymbols.html"],
+ \["DecimalFormatSymbolsProvider", "java/text/spi/DecimalFormatSymbolsProvider.html"],
+ \["DeclaredType", "javax/lang/model/type/DeclaredType.html"],
+ \["DeclHandler", "org/xml/sax/ext/DeclHandler.html"],
+ \["DefaultBoundedRangeModel", "javax/swing/DefaultBoundedRangeModel.html"],
+ \["DefaultButtonModel", "javax/swing/DefaultButtonModel.html"],
+ \["DefaultCaret", "javax/swing/text/DefaultCaret.html"],
+ \["DefaultCellEditor", "javax/swing/DefaultCellEditor.html"],
+ \["DefaultColorSelectionModel", "javax/swing/colorchooser/DefaultColorSelectionModel.html"],
+ \["DefaultComboBoxModel", "javax/swing/DefaultComboBoxModel.html"],
+ \["DefaultDesktopManager", "javax/swing/DefaultDesktopManager.html"],
+ \["DefaultEditorKit", "javax/swing/text/DefaultEditorKit.html"],
+ \["DefaultEditorKit.BeepAction", "javax/swing/text/DefaultEditorKit.BeepAction.html"],
+ \["DefaultEditorKit.CopyAction", "javax/swing/text/DefaultEditorKit.CopyAction.html"],
+ \["DefaultEditorKit.CutAction", "javax/swing/text/DefaultEditorKit.CutAction.html"],
+ \["DefaultEditorKit.DefaultKeyTypedAction", "javax/swing/text/DefaultEditorKit.DefaultKeyTypedAction.html"],
+ \["DefaultEditorKit.InsertBreakAction", "javax/swing/text/DefaultEditorKit.InsertBreakAction.html"],
+ \["DefaultEditorKit.InsertContentAction", "javax/swing/text/DefaultEditorKit.InsertContentAction.html"],
+ \["DefaultEditorKit.InsertTabAction", "javax/swing/text/DefaultEditorKit.InsertTabAction.html"],
+ \["DefaultEditorKit.PasteAction", "javax/swing/text/DefaultEditorKit.PasteAction.html"],
+ \["DefaultFocusManager", "javax/swing/DefaultFocusManager.html"],
+ \["DefaultFocusTraversalPolicy", "java/awt/DefaultFocusTraversalPolicy.html"],
+ \["DefaultFormatter", "javax/swing/text/DefaultFormatter.html"],
+ \["DefaultFormatterFactory", "javax/swing/text/DefaultFormatterFactory.html"],
+ \["DefaultHandler", "org/xml/sax/helpers/DefaultHandler.html"],
+ \["DefaultHandler2", "org/xml/sax/ext/DefaultHandler2.html"],
+ \["DefaultHighlighter", "javax/swing/text/DefaultHighlighter.html"],
+ \["DefaultHighlighter.DefaultHighlightPainter", "javax/swing/text/DefaultHighlighter.DefaultHighlightPainter.html"],
+ \["DefaultKeyboardFocusManager", "java/awt/DefaultKeyboardFocusManager.html"],
+ \["DefaultListCellRenderer", "javax/swing/DefaultListCellRenderer.html"],
+ \["DefaultListCellRenderer.UIResource", "javax/swing/DefaultListCellRenderer.UIResource.html"],
+ \["DefaultListModel", "javax/swing/DefaultListModel.html"],
+ \["DefaultListSelectionModel", "javax/swing/DefaultListSelectionModel.html"],
+ \["DefaultLoaderRepository", "javax/management/DefaultLoaderRepository.html"],
+ \["DefaultLoaderRepository", "javax/management/loading/DefaultLoaderRepository.html"],
+ \["DefaultMenuLayout", "javax/swing/plaf/basic/DefaultMenuLayout.html"],
+ \["DefaultMetalTheme", "javax/swing/plaf/metal/DefaultMetalTheme.html"],
+ \["DefaultMutableTreeNode", "javax/swing/tree/DefaultMutableTreeNode.html"],
+ \["DefaultPersistenceDelegate", "java/beans/DefaultPersistenceDelegate.html"],
+ \["DefaultRowSorter", "javax/swing/DefaultRowSorter.html"],
+ \["DefaultRowSorter.ModelWrapper", "javax/swing/DefaultRowSorter.ModelWrapper.html"],
+ \["DefaultSingleSelectionModel", "javax/swing/DefaultSingleSelectionModel.html"],
+ \["DefaultStyledDocument", "javax/swing/text/DefaultStyledDocument.html"],
+ \["DefaultStyledDocument.AttributeUndoableEdit", "javax/swing/text/DefaultStyledDocument.AttributeUndoableEdit.html"],
+ \["DefaultStyledDocument.ElementSpec", "javax/swing/text/DefaultStyledDocument.ElementSpec.html"],
+ \["DefaultTableCellRenderer", "javax/swing/table/DefaultTableCellRenderer.html"],
+ \["DefaultTableCellRenderer.UIResource", "javax/swing/table/DefaultTableCellRenderer.UIResource.html"],
+ \["DefaultTableColumnModel", "javax/swing/table/DefaultTableColumnModel.html"],
+ \["DefaultTableModel", "javax/swing/table/DefaultTableModel.html"],
+ \["DefaultTextUI", "javax/swing/text/DefaultTextUI.html"],
+ \["DefaultTreeCellEditor", "javax/swing/tree/DefaultTreeCellEditor.html"],
+ \["DefaultTreeCellRenderer", "javax/swing/tree/DefaultTreeCellRenderer.html"],
+ \["DefaultTreeModel", "javax/swing/tree/DefaultTreeModel.html"],
+ \["DefaultTreeSelectionModel", "javax/swing/tree/DefaultTreeSelectionModel.html"],
+ \["DefaultValidationEventHandler", "javax/xml/bind/helpers/DefaultValidationEventHandler.html"],
+ \["DefinitionKind", "org/omg/CORBA/DefinitionKind.html"],
+ \["DefinitionKindHelper", "org/omg/CORBA/DefinitionKindHelper.html"],
+ \["Deflater", "java/util/zip/Deflater.html"],
+ \["DeflaterInputStream", "java/util/zip/DeflaterInputStream.html"],
+ \["DeflaterOutputStream", "java/util/zip/DeflaterOutputStream.html"],
+ \["Delayed", "java/util/concurrent/Delayed.html"],
+ \["DelayQueue", "java/util/concurrent/DelayQueue.html"],
+ \["Delegate", "org/omg/CORBA/portable/Delegate.html"],
+ \["Delegate", "org/omg/CORBA_2_3/portable/Delegate.html"],
+ \["Delegate", "org/omg/PortableServer/portable/Delegate.html"],
+ \["DelegationPermission", "javax/security/auth/kerberos/DelegationPermission.html"],
+ \["Deprecated", "java/lang/Deprecated.html"],
+ \["Deque", "java/util/Deque.html"],
+ \["Descriptor", "javax/management/Descriptor.html"],
+ \["DescriptorAccess", "javax/management/DescriptorAccess.html"],
+ \["DescriptorKey", "javax/management/DescriptorKey.html"],
+ \["DescriptorRead", "javax/management/DescriptorRead.html"],
+ \["DescriptorSupport", "javax/management/modelmbean/DescriptorSupport.html"],
+ \["DESedeKeySpec", "javax/crypto/spec/DESedeKeySpec.html"],
+ \["DesignMode", "java/beans/DesignMode.html"],
+ \["DESKeySpec", "javax/crypto/spec/DESKeySpec.html"],
+ \["Desktop", "java/awt/Desktop.html"],
+ \["Desktop.Action", "java/awt/Desktop.Action.html"],
+ \["DesktopIconUI", "javax/swing/plaf/DesktopIconUI.html"],
+ \["DesktopManager", "javax/swing/DesktopManager.html"],
+ \["DesktopPaneUI", "javax/swing/plaf/DesktopPaneUI.html"],
+ \["Destination", "javax/print/attribute/standard/Destination.html"],
+ \["Destroyable", "javax/security/auth/Destroyable.html"],
+ \["DestroyFailedException", "javax/security/auth/DestroyFailedException.html"],
+ \["Detail", "javax/xml/soap/Detail.html"],
+ \["DetailEntry", "javax/xml/soap/DetailEntry.html"],
+ \["DGC", "java/rmi/dgc/DGC.html"],
+ \["DHGenParameterSpec", "javax/crypto/spec/DHGenParameterSpec.html"],
+ \["DHKey", "javax/crypto/interfaces/DHKey.html"],
+ \["DHParameterSpec", "javax/crypto/spec/DHParameterSpec.html"],
+ \["DHPrivateKey", "javax/crypto/interfaces/DHPrivateKey.html"],
+ \["DHPrivateKeySpec", "javax/crypto/spec/DHPrivateKeySpec.html"],
+ \["DHPublicKey", "javax/crypto/interfaces/DHPublicKey.html"],
+ \["DHPublicKeySpec", "javax/crypto/spec/DHPublicKeySpec.html"],
+ \["Diagnostic", "javax/tools/Diagnostic.html"],
+ \["Diagnostic.Kind", "javax/tools/Diagnostic.Kind.html"],
+ \["DiagnosticCollector", "javax/tools/DiagnosticCollector.html"],
+ \["DiagnosticListener", "javax/tools/DiagnosticListener.html"],
+ \["Dialog", "java/awt/Dialog.html"],
+ \["Dialog.ModalExclusionType", "java/awt/Dialog.ModalExclusionType.html"],
+ \["Dialog.ModalityType", "java/awt/Dialog.ModalityType.html"],
+ \["Dictionary", "java/util/Dictionary.html"],
+ \["DigestException", "java/security/DigestException.html"],
+ \["DigestInputStream", "java/security/DigestInputStream.html"],
+ \["DigestMethod", "javax/xml/crypto/dsig/DigestMethod.html"],
+ \["DigestMethodParameterSpec", "javax/xml/crypto/dsig/spec/DigestMethodParameterSpec.html"],
+ \["DigestOutputStream", "java/security/DigestOutputStream.html"],
+ \["Dimension", "java/awt/Dimension.html"],
+ \["Dimension2D", "java/awt/geom/Dimension2D.html"],
+ \["DimensionUIResource", "javax/swing/plaf/DimensionUIResource.html"],
+ \["DirContext", "javax/naming/directory/DirContext.html"],
+ \["DirectColorModel", "java/awt/image/DirectColorModel.html"],
+ \["DirectoryManager", "javax/naming/spi/DirectoryManager.html"],
+ \["DirObjectFactory", "javax/naming/spi/DirObjectFactory.html"],
+ \["DirStateFactory", "javax/naming/spi/DirStateFactory.html"],
+ \["DirStateFactory.Result", "javax/naming/spi/DirStateFactory.Result.html"],
+ \["DISCARDING", "org/omg/PortableInterceptor/DISCARDING.html"],
+ \["Dispatch", "javax/xml/ws/Dispatch.html"],
+ \["DisplayMode", "java/awt/DisplayMode.html"],
+ \["DnDConstants", "java/awt/dnd/DnDConstants.html"],
+ \["Doc", "javax/print/Doc.html"],
+ \["DocAttribute", "javax/print/attribute/DocAttribute.html"],
+ \["DocAttributeSet", "javax/print/attribute/DocAttributeSet.html"],
+ \["DocFlavor", "javax/print/DocFlavor.html"],
+ \["DocFlavor.BYTE_ARRAY", "javax/print/DocFlavor.BYTE_ARRAY.html"],
+ \["DocFlavor.CHAR_ARRAY", "javax/print/DocFlavor.CHAR_ARRAY.html"],
+ \["DocFlavor.INPUT_STREAM", "javax/print/DocFlavor.INPUT_STREAM.html"],
+ \["DocFlavor.READER", "javax/print/DocFlavor.READER.html"],
+ \["DocFlavor.SERVICE_FORMATTED", "javax/print/DocFlavor.SERVICE_FORMATTED.html"],
+ \["DocFlavor.STRING", "javax/print/DocFlavor.STRING.html"],
+ \["DocFlavor.URL", "javax/print/DocFlavor.URL.html"],
+ \["DocPrintJob", "javax/print/DocPrintJob.html"],
+ \["Document", "javax/swing/text/Document.html"],
+ \["Document", "org/w3c/dom/Document.html"],
+ \["DocumentBuilder", "javax/xml/parsers/DocumentBuilder.html"],
+ \["DocumentBuilderFactory", "javax/xml/parsers/DocumentBuilderFactory.html"],
+ \["Documented", "java/lang/annotation/Documented.html"],
+ \["DocumentEvent", "javax/swing/event/DocumentEvent.html"],
+ \["DocumentEvent", "org/w3c/dom/events/DocumentEvent.html"],
+ \["DocumentEvent.ElementChange", "javax/swing/event/DocumentEvent.ElementChange.html"],
+ \["DocumentEvent.EventType", "javax/swing/event/DocumentEvent.EventType.html"],
+ \["DocumentFilter", "javax/swing/text/DocumentFilter.html"],
+ \["DocumentFilter.FilterBypass", "javax/swing/text/DocumentFilter.FilterBypass.html"],
+ \["DocumentFragment", "org/w3c/dom/DocumentFragment.html"],
+ \["DocumentHandler", "org/xml/sax/DocumentHandler.html"],
+ \["DocumentListener", "javax/swing/event/DocumentListener.html"],
+ \["DocumentName", "javax/print/attribute/standard/DocumentName.html"],
+ \["DocumentParser", "javax/swing/text/html/parser/DocumentParser.html"],
+ \["DocumentType", "org/w3c/dom/DocumentType.html"],
+ \["DomainCombiner", "java/security/DomainCombiner.html"],
+ \["DomainManager", "org/omg/CORBA/DomainManager.html"],
+ \["DomainManagerOperations", "org/omg/CORBA/DomainManagerOperations.html"],
+ \["DOMConfiguration", "org/w3c/dom/DOMConfiguration.html"],
+ \["DOMCryptoContext", "javax/xml/crypto/dom/DOMCryptoContext.html"],
+ \["DOMError", "org/w3c/dom/DOMError.html"],
+ \["DOMErrorHandler", "org/w3c/dom/DOMErrorHandler.html"],
+ \["DOMException", "org/w3c/dom/DOMException.html"],
+ \["DomHandler", "javax/xml/bind/annotation/DomHandler.html"],
+ \["DOMImplementation", "org/w3c/dom/DOMImplementation.html"],
+ \["DOMImplementationList", "org/w3c/dom/DOMImplementationList.html"],
+ \["DOMImplementationLS", "org/w3c/dom/ls/DOMImplementationLS.html"],
+ \["DOMImplementationRegistry", "org/w3c/dom/bootstrap/DOMImplementationRegistry.html"],
+ \["DOMImplementationSource", "org/w3c/dom/DOMImplementationSource.html"],
+ \["DOMLocator", "javax/xml/transform/dom/DOMLocator.html"],
+ \["DOMLocator", "org/w3c/dom/DOMLocator.html"],
+ \["DOMResult", "javax/xml/transform/dom/DOMResult.html"],
+ \["DOMSignContext", "javax/xml/crypto/dsig/dom/DOMSignContext.html"],
+ \["DOMSource", "javax/xml/transform/dom/DOMSource.html"],
+ \["DOMStringList", "org/w3c/dom/DOMStringList.html"],
+ \["DOMStructure", "javax/xml/crypto/dom/DOMStructure.html"],
+ \["DOMURIReference", "javax/xml/crypto/dom/DOMURIReference.html"],
+ \["DOMValidateContext", "javax/xml/crypto/dsig/dom/DOMValidateContext.html"],
+ \["Double", "java/lang/Double.html"],
+ \["DoubleBuffer", "java/nio/DoubleBuffer.html"],
+ \["DoubleHolder", "org/omg/CORBA/DoubleHolder.html"],
+ \["DoubleSeqHelper", "org/omg/CORBA/DoubleSeqHelper.html"],
+ \["DoubleSeqHolder", "org/omg/CORBA/DoubleSeqHolder.html"],
+ \["DragGestureEvent", "java/awt/dnd/DragGestureEvent.html"],
+ \["DragGestureListener", "java/awt/dnd/DragGestureListener.html"],
+ \["DragGestureRecognizer", "java/awt/dnd/DragGestureRecognizer.html"],
+ \["DragSource", "java/awt/dnd/DragSource.html"],
+ \["DragSourceAdapter", "java/awt/dnd/DragSourceAdapter.html"],
+ \["DragSourceContext", "java/awt/dnd/DragSourceContext.html"],
+ \["DragSourceDragEvent", "java/awt/dnd/DragSourceDragEvent.html"],
+ \["DragSourceDropEvent", "java/awt/dnd/DragSourceDropEvent.html"],
+ \["DragSourceEvent", "java/awt/dnd/DragSourceEvent.html"],
+ \["DragSourceListener", "java/awt/dnd/DragSourceListener.html"],
+ \["DragSourceMotionListener", "java/awt/dnd/DragSourceMotionListener.html"],
+ \["Driver", "java/sql/Driver.html"],
+ \["DriverManager", "java/sql/DriverManager.html"],
+ \["DriverPropertyInfo", "java/sql/DriverPropertyInfo.html"],
+ \["DropMode", "javax/swing/DropMode.html"],
+ \["DropTarget", "java/awt/dnd/DropTarget.html"],
+ \["DropTarget.DropTargetAutoScroller", "java/awt/dnd/DropTarget.DropTargetAutoScroller.html"],
+ \["DropTargetAdapter", "java/awt/dnd/DropTargetAdapter.html"],
+ \["DropTargetContext", "java/awt/dnd/DropTargetContext.html"],
+ \["DropTargetDragEvent", "java/awt/dnd/DropTargetDragEvent.html"],
+ \["DropTargetDropEvent", "java/awt/dnd/DropTargetDropEvent.html"],
+ \["DropTargetEvent", "java/awt/dnd/DropTargetEvent.html"],
+ \["DropTargetListener", "java/awt/dnd/DropTargetListener.html"],
+ \["DSAKey", "java/security/interfaces/DSAKey.html"],
+ \["DSAKeyPairGenerator", "java/security/interfaces/DSAKeyPairGenerator.html"],
+ \["DSAParameterSpec", "java/security/spec/DSAParameterSpec.html"],
+ \["DSAParams", "java/security/interfaces/DSAParams.html"],
+ \["DSAPrivateKey", "java/security/interfaces/DSAPrivateKey.html"],
+ \["DSAPrivateKeySpec", "java/security/spec/DSAPrivateKeySpec.html"],
+ \["DSAPublicKey", "java/security/interfaces/DSAPublicKey.html"],
+ \["DSAPublicKeySpec", "java/security/spec/DSAPublicKeySpec.html"],
+ \["DTD", "javax/swing/text/html/parser/DTD.html"],
+ \["DTD", "javax/xml/stream/events/DTD.html"],
+ \["DTDConstants", "javax/swing/text/html/parser/DTDConstants.html"],
+ \["DTDHandler", "org/xml/sax/DTDHandler.html"],
+ \["DuplicateFormatFlagsException", "java/util/DuplicateFormatFlagsException.html"],
+ \["DuplicateName", "org/omg/PortableInterceptor/ORBInitInfoPackage/DuplicateName.html"],
+ \["DuplicateNameHelper", "org/omg/PortableInterceptor/ORBInitInfoPackage/DuplicateNameHelper.html"],
+ \["Duration", "javax/xml/datatype/Duration.html"],
+ \["DynamicImplementation", "org/omg/CORBA/DynamicImplementation.html"],
+ \["DynamicImplementation", "org/omg/PortableServer/DynamicImplementation.html"],
+ \["DynamicMBean", "javax/management/DynamicMBean.html"],
+ \["DynAny", "org/omg/CORBA/DynAny.html"],
+ \["DynAny", "org/omg/DynamicAny/DynAny.html"],
+ \["DynAnyFactory", "org/omg/DynamicAny/DynAnyFactory.html"],
+ \["DynAnyFactoryHelper", "org/omg/DynamicAny/DynAnyFactoryHelper.html"],
+ \["DynAnyFactoryOperations", "org/omg/DynamicAny/DynAnyFactoryOperations.html"],
+ \["DynAnyHelper", "org/omg/DynamicAny/DynAnyHelper.html"],
+ \["DynAnyOperations", "org/omg/DynamicAny/DynAnyOperations.html"],
+ \["DynAnySeqHelper", "org/omg/DynamicAny/DynAnySeqHelper.html"],
+ \["DynArray", "org/omg/CORBA/DynArray.html"],
+ \["DynArray", "org/omg/DynamicAny/DynArray.html"],
+ \["DynArrayHelper", "org/omg/DynamicAny/DynArrayHelper.html"],
+ \["DynArrayOperations", "org/omg/DynamicAny/DynArrayOperations.html"],
+ \["DynEnum", "org/omg/CORBA/DynEnum.html"],
+ \["DynEnum", "org/omg/DynamicAny/DynEnum.html"],
+ \["DynEnumHelper", "org/omg/DynamicAny/DynEnumHelper.html"],
+ \["DynEnumOperations", "org/omg/DynamicAny/DynEnumOperations.html"],
+ \["DynFixed", "org/omg/CORBA/DynFixed.html"],
+ \["DynFixed", "org/omg/DynamicAny/DynFixed.html"],
+ \["DynFixedHelper", "org/omg/DynamicAny/DynFixedHelper.html"],
+ \["DynFixedOperations", "org/omg/DynamicAny/DynFixedOperations.html"],
+ \["DynSequence", "org/omg/CORBA/DynSequence.html"],
+ \["DynSequence", "org/omg/DynamicAny/DynSequence.html"],
+ \["DynSequenceHelper", "org/omg/DynamicAny/DynSequenceHelper.html"],
+ \["DynSequenceOperations", "org/omg/DynamicAny/DynSequenceOperations.html"],
+ \["DynStruct", "org/omg/CORBA/DynStruct.html"],
+ \["DynStruct", "org/omg/DynamicAny/DynStruct.html"],
+ \["DynStructHelper", "org/omg/DynamicAny/DynStructHelper.html"],
+ \["DynStructOperations", "org/omg/DynamicAny/DynStructOperations.html"],
+ \["DynUnion", "org/omg/CORBA/DynUnion.html"],
+ \["DynUnion", "org/omg/DynamicAny/DynUnion.html"],
+ \["DynUnionHelper", "org/omg/DynamicAny/DynUnionHelper.html"],
+ \["DynUnionOperations", "org/omg/DynamicAny/DynUnionOperations.html"],
+ \["DynValue", "org/omg/CORBA/DynValue.html"],
+ \["DynValue", "org/omg/DynamicAny/DynValue.html"],
+ \["DynValueBox", "org/omg/DynamicAny/DynValueBox.html"],
+ \["DynValueBoxOperations", "org/omg/DynamicAny/DynValueBoxOperations.html"],
+ \["DynValueCommon", "org/omg/DynamicAny/DynValueCommon.html"],
+ \["DynValueCommonOperations", "org/omg/DynamicAny/DynValueCommonOperations.html"],
+ \["DynValueHelper", "org/omg/DynamicAny/DynValueHelper.html"],
+ \["DynValueOperations", "org/omg/DynamicAny/DynValueOperations.html"],
+ \["ECField", "java/security/spec/ECField.html"],
+ \["ECFieldF2m", "java/security/spec/ECFieldF2m.html"],
+ \["ECFieldFp", "java/security/spec/ECFieldFp.html"],
+ \["ECGenParameterSpec", "java/security/spec/ECGenParameterSpec.html"],
+ \["ECKey", "java/security/interfaces/ECKey.html"],
+ \["ECParameterSpec", "java/security/spec/ECParameterSpec.html"],
+ \["ECPoint", "java/security/spec/ECPoint.html"],
+ \["ECPrivateKey", "java/security/interfaces/ECPrivateKey.html"],
+ \["ECPrivateKeySpec", "java/security/spec/ECPrivateKeySpec.html"],
+ \["ECPublicKey", "java/security/interfaces/ECPublicKey.html"],
+ \["ECPublicKeySpec", "java/security/spec/ECPublicKeySpec.html"],
+ \["EditorKit", "javax/swing/text/EditorKit.html"],
+ \["Element", "javax/lang/model/element/Element.html"],
+ \["Element", "javax/swing/text/Element.html"],
+ \["Element", "javax/swing/text/html/parser/Element.html"],
+ \["Element", "javax/xml/bind/Element.html"],
+ \["Element", "org/w3c/dom/Element.html"],
+ \["ElementFilter", "javax/lang/model/util/ElementFilter.html"],
+ \["ElementIterator", "javax/swing/text/ElementIterator.html"],
+ \["ElementKind", "javax/lang/model/element/ElementKind.html"],
+ \["ElementKindVisitor6", "javax/lang/model/util/ElementKindVisitor6.html"],
+ \["Elements", "javax/lang/model/util/Elements.html"],
+ \["ElementScanner6", "javax/lang/model/util/ElementScanner6.html"],
+ \["ElementType", "java/lang/annotation/ElementType.html"],
+ \["ElementVisitor", "javax/lang/model/element/ElementVisitor.html"],
+ \["Ellipse2D", "java/awt/geom/Ellipse2D.html"],
+ \["Ellipse2D.Double", "java/awt/geom/Ellipse2D.Double.html"],
+ \["Ellipse2D.Float", "java/awt/geom/Ellipse2D.Float.html"],
+ \["EllipticCurve", "java/security/spec/EllipticCurve.html"],
+ \["EmptyBorder", "javax/swing/border/EmptyBorder.html"],
+ \["EmptyStackException", "java/util/EmptyStackException.html"],
+ \["EncodedKeySpec", "java/security/spec/EncodedKeySpec.html"],
+ \["Encoder", "java/beans/Encoder.html"],
+ \["Encoding", "org/omg/IOP/Encoding.html"],
+ \["ENCODING_CDR_ENCAPS", "org/omg/IOP/ENCODING_CDR_ENCAPS.html"],
+ \["EncryptedPrivateKeyInfo", "javax/crypto/EncryptedPrivateKeyInfo.html"],
+ \["EndDocument", "javax/xml/stream/events/EndDocument.html"],
+ \["EndElement", "javax/xml/stream/events/EndElement.html"],
+ \["Endpoint", "javax/xml/ws/Endpoint.html"],
+ \["EndpointReference", "javax/xml/ws/EndpointReference.html"],
+ \["Entity", "javax/swing/text/html/parser/Entity.html"],
+ \["Entity", "org/w3c/dom/Entity.html"],
+ \["EntityDeclaration", "javax/xml/stream/events/EntityDeclaration.html"],
+ \["EntityReference", "javax/xml/stream/events/EntityReference.html"],
+ \["EntityReference", "org/w3c/dom/EntityReference.html"],
+ \["EntityResolver", "org/xml/sax/EntityResolver.html"],
+ \["EntityResolver2", "org/xml/sax/ext/EntityResolver2.html"],
+ \["Enum", "java/lang/Enum.html"],
+ \["EnumConstantNotPresentException", "java/lang/EnumConstantNotPresentException.html"],
+ \["EnumControl", "javax/sound/sampled/EnumControl.html"],
+ \["EnumControl.Type", "javax/sound/sampled/EnumControl.Type.html"],
+ \["Enumeration", "java/util/Enumeration.html"],
+ \["EnumMap", "java/util/EnumMap.html"],
+ \["EnumSet", "java/util/EnumSet.html"],
+ \["EnumSyntax", "javax/print/attribute/EnumSyntax.html"],
+ \["Environment", "org/omg/CORBA/Environment.html"],
+ \["EOFException", "java/io/EOFException.html"],
+ \["Error", "java/lang/Error.html"],
+ \["ErrorHandler", "org/xml/sax/ErrorHandler.html"],
+ \["ErrorListener", "javax/xml/transform/ErrorListener.html"],
+ \["ErrorManager", "java/util/logging/ErrorManager.html"],
+ \["ErrorType", "javax/lang/model/type/ErrorType.html"],
+ \["EtchedBorder", "javax/swing/border/EtchedBorder.html"],
+ \["Event", "java/awt/Event.html"],
+ \["Event", "org/w3c/dom/events/Event.html"],
+ \["EventContext", "javax/naming/event/EventContext.html"],
+ \["EventDirContext", "javax/naming/event/EventDirContext.html"],
+ \["EventException", "org/w3c/dom/events/EventException.html"],
+ \["EventFilter", "javax/xml/stream/EventFilter.html"],
+ \["EventHandler", "java/beans/EventHandler.html"],
+ \["EventListener", "java/util/EventListener.html"],
+ \["EventListener", "org/w3c/dom/events/EventListener.html"],
+ \["EventListenerList", "javax/swing/event/EventListenerList.html"],
+ \["EventListenerProxy", "java/util/EventListenerProxy.html"],
+ \["EventObject", "java/util/EventObject.html"],
+ \["EventQueue", "java/awt/EventQueue.html"],
+ \["EventReaderDelegate", "javax/xml/stream/util/EventReaderDelegate.html"],
+ \["EventSetDescriptor", "java/beans/EventSetDescriptor.html"],
+ \["EventTarget", "org/w3c/dom/events/EventTarget.html"],
+ \["ExcC14NParameterSpec", "javax/xml/crypto/dsig/spec/ExcC14NParameterSpec.html"],
+ \["Exception", "java/lang/Exception.html"],
+ \["ExceptionDetailMessage", "org/omg/IOP/ExceptionDetailMessage.html"],
+ \["ExceptionInInitializerError", "java/lang/ExceptionInInitializerError.html"],
+ \["ExceptionList", "org/omg/CORBA/ExceptionList.html"],
+ \["ExceptionListener", "java/beans/ExceptionListener.html"],
+ \["Exchanger", "java/util/concurrent/Exchanger.html"],
+ \["ExecutableElement", "javax/lang/model/element/ExecutableElement.html"],
+ \["ExecutableType", "javax/lang/model/type/ExecutableType.html"],
+ \["ExecutionException", "java/util/concurrent/ExecutionException.html"],
+ \["Executor", "java/util/concurrent/Executor.html"],
+ \["ExecutorCompletionService", "java/util/concurrent/ExecutorCompletionService.html"],
+ \["Executors", "java/util/concurrent/Executors.html"],
+ \["ExecutorService", "java/util/concurrent/ExecutorService.html"],
+ \["ExemptionMechanism", "javax/crypto/ExemptionMechanism.html"],
+ \["ExemptionMechanismException", "javax/crypto/ExemptionMechanismException.html"],
+ \["ExemptionMechanismSpi", "javax/crypto/ExemptionMechanismSpi.html"],
+ \["ExpandVetoException", "javax/swing/tree/ExpandVetoException.html"],
+ \["ExportException", "java/rmi/server/ExportException.html"],
+ \["Expression", "java/beans/Expression.html"],
+ \["ExtendedRequest", "javax/naming/ldap/ExtendedRequest.html"],
+ \["ExtendedResponse", "javax/naming/ldap/ExtendedResponse.html"],
+ \["Externalizable", "java/io/Externalizable.html"],
+ \["FactoryConfigurationError", "javax/xml/parsers/FactoryConfigurationError.html"],
+ \["FactoryConfigurationError", "javax/xml/stream/FactoryConfigurationError.html"],
+ \["FailedLoginException", "javax/security/auth/login/FailedLoginException.html"],
+ \["FaultAction", "javax/xml/ws/FaultAction.html"],
+ \["FeatureDescriptor", "java/beans/FeatureDescriptor.html"],
+ \["Fidelity", "javax/print/attribute/standard/Fidelity.html"],
+ \["Field", "java/lang/reflect/Field.html"],
+ \["FieldNameHelper", "org/omg/CORBA/FieldNameHelper.html"],
+ \["FieldNameHelper", "org/omg/DynamicAny/FieldNameHelper.html"],
+ \["FieldPosition", "java/text/FieldPosition.html"],
+ \["FieldView", "javax/swing/text/FieldView.html"],
+ \["File", "java/io/File.html"],
+ \["FileCacheImageInputStream", "javax/imageio/stream/FileCacheImageInputStream.html"],
+ \["FileCacheImageOutputStream", "javax/imageio/stream/FileCacheImageOutputStream.html"],
+ \["FileChannel", "java/nio/channels/FileChannel.html"],
+ \["FileChannel.MapMode", "java/nio/channels/FileChannel.MapMode.html"],
+ \["FileChooserUI", "javax/swing/plaf/FileChooserUI.html"],
+ \["FileDataSource", "javax/activation/FileDataSource.html"],
+ \["FileDescriptor", "java/io/FileDescriptor.html"],
+ \["FileDialog", "java/awt/FileDialog.html"],
+ \["FileFilter", "java/io/FileFilter.html"],
+ \["FileFilter", "javax/swing/filechooser/FileFilter.html"],
+ \["FileHandler", "java/util/logging/FileHandler.html"],
+ \["FileImageInputStream", "javax/imageio/stream/FileImageInputStream.html"],
+ \["FileImageOutputStream", "javax/imageio/stream/FileImageOutputStream.html"],
+ \["FileInputStream", "java/io/FileInputStream.html"],
+ \["FileLock", "java/nio/channels/FileLock.html"],
+ \["FileLockInterruptionException", "java/nio/channels/FileLockInterruptionException.html"],
+ \["FileNameExtensionFilter", "javax/swing/filechooser/FileNameExtensionFilter.html"],
+ \["FilenameFilter", "java/io/FilenameFilter.html"],
+ \["FileNameMap", "java/net/FileNameMap.html"],
+ \["FileNotFoundException", "java/io/FileNotFoundException.html"],
+ \["FileObject", "javax/tools/FileObject.html"],
+ \["FileOutputStream", "java/io/FileOutputStream.html"],
+ \["FilePermission", "java/io/FilePermission.html"],
+ \["Filer", "javax/annotation/processing/Filer.html"],
+ \["FileReader", "java/io/FileReader.html"],
+ \["FilerException", "javax/annotation/processing/FilerException.html"],
+ \["FileSystemView", "javax/swing/filechooser/FileSystemView.html"],
+ \["FileTypeMap", "javax/activation/FileTypeMap.html"],
+ \["FileView", "javax/swing/filechooser/FileView.html"],
+ \["FileWriter", "java/io/FileWriter.html"],
+ \["Filter", "java/util/logging/Filter.html"],
+ \["FilteredImageSource", "java/awt/image/FilteredImageSource.html"],
+ \["FilteredRowSet", "javax/sql/rowset/FilteredRowSet.html"],
+ \["FilterInputStream", "java/io/FilterInputStream.html"],
+ \["FilterOutputStream", "java/io/FilterOutputStream.html"],
+ \["FilterReader", "java/io/FilterReader.html"],
+ \["FilterWriter", "java/io/FilterWriter.html"],
+ \["Finishings", "javax/print/attribute/standard/Finishings.html"],
+ \["FixedHeightLayoutCache", "javax/swing/tree/FixedHeightLayoutCache.html"],
+ \["FixedHolder", "org/omg/CORBA/FixedHolder.html"],
+ \["FlatteningPathIterator", "java/awt/geom/FlatteningPathIterator.html"],
+ \["FlavorEvent", "java/awt/datatransfer/FlavorEvent.html"],
+ \["FlavorException", "javax/print/FlavorException.html"],
+ \["FlavorListener", "java/awt/datatransfer/FlavorListener.html"],
+ \["FlavorMap", "java/awt/datatransfer/FlavorMap.html"],
+ \["FlavorTable", "java/awt/datatransfer/FlavorTable.html"],
+ \["Float", "java/lang/Float.html"],
+ \["FloatBuffer", "java/nio/FloatBuffer.html"],
+ \["FloatControl", "javax/sound/sampled/FloatControl.html"],
+ \["FloatControl.Type", "javax/sound/sampled/FloatControl.Type.html"],
+ \["FloatHolder", "org/omg/CORBA/FloatHolder.html"],
+ \["FloatSeqHelper", "org/omg/CORBA/FloatSeqHelper.html"],
+ \["FloatSeqHolder", "org/omg/CORBA/FloatSeqHolder.html"],
+ \["FlowLayout", "java/awt/FlowLayout.html"],
+ \["FlowView", "javax/swing/text/FlowView.html"],
+ \["FlowView.FlowStrategy", "javax/swing/text/FlowView.FlowStrategy.html"],
+ \["Flushable", "java/io/Flushable.html"],
+ \["FocusAdapter", "java/awt/event/FocusAdapter.html"],
+ \["FocusEvent", "java/awt/event/FocusEvent.html"],
+ \["FocusListener", "java/awt/event/FocusListener.html"],
+ \["FocusManager", "javax/swing/FocusManager.html"],
+ \["FocusTraversalPolicy", "java/awt/FocusTraversalPolicy.html"],
+ \["Font", "java/awt/Font.html"],
+ \["FontFormatException", "java/awt/FontFormatException.html"],
+ \["FontMetrics", "java/awt/FontMetrics.html"],
+ \["FontRenderContext", "java/awt/font/FontRenderContext.html"],
+ \["FontUIResource", "javax/swing/plaf/FontUIResource.html"],
+ \["Format", "java/text/Format.html"],
+ \["Format.Field", "java/text/Format.Field.html"],
+ \["FormatConversionProvider", "javax/sound/sampled/spi/FormatConversionProvider.html"],
+ \["FormatFlagsConversionMismatchException", "java/util/FormatFlagsConversionMismatchException.html"],
+ \["FormatMismatch", "org/omg/IOP/CodecPackage/FormatMismatch.html"],
+ \["FormatMismatchHelper", "org/omg/IOP/CodecPackage/FormatMismatchHelper.html"],
+ \["Formattable", "java/util/Formattable.html"],
+ \["FormattableFlags", "java/util/FormattableFlags.html"],
+ \["Formatter", "java/util/Formatter.html"],
+ \["Formatter", "java/util/logging/Formatter.html"],
+ \["Formatter.BigDecimalLayoutForm", "java/util/Formatter.BigDecimalLayoutForm.html"],
+ \["FormatterClosedException", "java/util/FormatterClosedException.html"],
+ \["FormSubmitEvent", "javax/swing/text/html/FormSubmitEvent.html"],
+ \["FormSubmitEvent.MethodType", "javax/swing/text/html/FormSubmitEvent.MethodType.html"],
+ \["FormView", "javax/swing/text/html/FormView.html"],
+ \["ForwardingFileObject", "javax/tools/ForwardingFileObject.html"],
+ \["ForwardingJavaFileManager", "javax/tools/ForwardingJavaFileManager.html"],
+ \["ForwardingJavaFileObject", "javax/tools/ForwardingJavaFileObject.html"],
+ \["ForwardRequest", "org/omg/PortableInterceptor/ForwardRequest.html"],
+ \["ForwardRequest", "org/omg/PortableServer/ForwardRequest.html"],
+ \["ForwardRequestHelper", "org/omg/PortableInterceptor/ForwardRequestHelper.html"],
+ \["ForwardRequestHelper", "org/omg/PortableServer/ForwardRequestHelper.html"],
+ \["Frame", "java/awt/Frame.html"],
+ \["FREE_MEM", "org/omg/CORBA/FREE_MEM.html"],
+ \["Future", "java/util/concurrent/Future.html"],
+ \["FutureTask", "java/util/concurrent/FutureTask.html"],
+ \["GapContent", "javax/swing/text/GapContent.html"],
+ \["GarbageCollectorMXBean", "java/lang/management/GarbageCollectorMXBean.html"],
+ \["GatheringByteChannel", "java/nio/channels/GatheringByteChannel.html"],
+ \["GaugeMonitor", "javax/management/monitor/GaugeMonitor.html"],
+ \["GaugeMonitorMBean", "javax/management/monitor/GaugeMonitorMBean.html"],
+ \["GeneralPath", "java/awt/geom/GeneralPath.html"],
+ \["GeneralSecurityException", "java/security/GeneralSecurityException.html"],
+ \["Generated", "javax/annotation/Generated.html"],
+ \["GenericArrayType", "java/lang/reflect/GenericArrayType.html"],
+ \["GenericDeclaration", "java/lang/reflect/GenericDeclaration.html"],
+ \["GenericSignatureFormatError", "java/lang/reflect/GenericSignatureFormatError.html"],
+ \["GlyphJustificationInfo", "java/awt/font/GlyphJustificationInfo.html"],
+ \["GlyphMetrics", "java/awt/font/GlyphMetrics.html"],
+ \["GlyphVector", "java/awt/font/GlyphVector.html"],
+ \["GlyphView", "javax/swing/text/GlyphView.html"],
+ \["GlyphView.GlyphPainter", "javax/swing/text/GlyphView.GlyphPainter.html"],
+ \["GradientPaint", "java/awt/GradientPaint.html"],
+ \["GraphicAttribute", "java/awt/font/GraphicAttribute.html"],
+ \["Graphics", "java/awt/Graphics.html"],
+ \["Graphics2D", "java/awt/Graphics2D.html"],
+ \["GraphicsConfigTemplate", "java/awt/GraphicsConfigTemplate.html"],
+ \["GraphicsConfiguration", "java/awt/GraphicsConfiguration.html"],
+ \["GraphicsDevice", "java/awt/GraphicsDevice.html"],
+ \["GraphicsEnvironment", "java/awt/GraphicsEnvironment.html"],
+ \["GrayFilter", "javax/swing/GrayFilter.html"],
+ \["GregorianCalendar", "java/util/GregorianCalendar.html"],
+ \["GridBagConstraints", "java/awt/GridBagConstraints.html"],
+ \["GridBagLayout", "java/awt/GridBagLayout.html"],
+ \["GridBagLayoutInfo", "java/awt/GridBagLayoutInfo.html"],
+ \["GridLayout", "java/awt/GridLayout.html"],
+ \["Group", "java/security/acl/Group.html"],
+ \["GroupLayout", "javax/swing/GroupLayout.html"],
+ \["GroupLayout.Alignment", "javax/swing/GroupLayout.Alignment.html"],
+ \["GSSContext", "org/ietf/jgss/GSSContext.html"],
+ \["GSSCredential", "org/ietf/jgss/GSSCredential.html"],
+ \["GSSException", "org/ietf/jgss/GSSException.html"],
+ \["GSSManager", "org/ietf/jgss/GSSManager.html"],
+ \["GSSName", "org/ietf/jgss/GSSName.html"],
+ \["Guard", "java/security/Guard.html"],
+ \["GuardedObject", "java/security/GuardedObject.html"],
+ \["GZIPInputStream", "java/util/zip/GZIPInputStream.html"],
+ \["GZIPOutputStream", "java/util/zip/GZIPOutputStream.html"],
+ \["Handler", "java/util/logging/Handler.html"],
+ \["Handler", "javax/xml/ws/handler/Handler.html"],
+ \["HandlerBase", "org/xml/sax/HandlerBase.html"],
+ \["HandlerChain", "javax/jws/HandlerChain.html"],
+ \["HandlerResolver", "javax/xml/ws/handler/HandlerResolver.html"],
+ \["HandshakeCompletedEvent", "javax/net/ssl/HandshakeCompletedEvent.html"],
+ \["HandshakeCompletedListener", "javax/net/ssl/HandshakeCompletedListener.html"],
+ \["HasControls", "javax/naming/ldap/HasControls.html"],
+ \["HashAttributeSet", "javax/print/attribute/HashAttributeSet.html"],
+ \["HashDocAttributeSet", "javax/print/attribute/HashDocAttributeSet.html"],
+ \["HashMap", "java/util/HashMap.html"],
+ \["HashPrintJobAttributeSet", "javax/print/attribute/HashPrintJobAttributeSet.html"],
+ \["HashPrintRequestAttributeSet", "javax/print/attribute/HashPrintRequestAttributeSet.html"],
+ \["HashPrintServiceAttributeSet", "javax/print/attribute/HashPrintServiceAttributeSet.html"],
+ \["HashSet", "java/util/HashSet.html"],
+ \["Hashtable", "java/util/Hashtable.html"],
+ \["HeadlessException", "java/awt/HeadlessException.html"],
+ \["HexBinaryAdapter", "javax/xml/bind/annotation/adapters/HexBinaryAdapter.html"],
+ \["HierarchyBoundsAdapter", "java/awt/event/HierarchyBoundsAdapter.html"],
+ \["HierarchyBoundsListener", "java/awt/event/HierarchyBoundsListener.html"],
+ \["HierarchyEvent", "java/awt/event/HierarchyEvent.html"],
+ \["HierarchyListener", "java/awt/event/HierarchyListener.html"],
+ \["Highlighter", "javax/swing/text/Highlighter.html"],
+ \["Highlighter.Highlight", "javax/swing/text/Highlighter.Highlight.html"],
+ \["Highlighter.HighlightPainter", "javax/swing/text/Highlighter.HighlightPainter.html"],
+ \["HMACParameterSpec", "javax/xml/crypto/dsig/spec/HMACParameterSpec.html"],
+ \["Holder", "javax/xml/ws/Holder.html"],
+ \["HOLDING", "org/omg/PortableInterceptor/HOLDING.html"],
+ \["HostnameVerifier", "javax/net/ssl/HostnameVerifier.html"],
+ \["HTML", "javax/swing/text/html/HTML.html"],
+ \["HTML.Attribute", "javax/swing/text/html/HTML.Attribute.html"],
+ \["HTML.Tag", "javax/swing/text/html/HTML.Tag.html"],
+ \["HTML.UnknownTag", "javax/swing/text/html/HTML.UnknownTag.html"],
+ \["HTMLDocument", "javax/swing/text/html/HTMLDocument.html"],
+ \["HTMLDocument.Iterator", "javax/swing/text/html/HTMLDocument.Iterator.html"],
+ \["HTMLEditorKit", "javax/swing/text/html/HTMLEditorKit.html"],
+ \["HTMLEditorKit.HTMLFactory", "javax/swing/text/html/HTMLEditorKit.HTMLFactory.html"],
+ \["HTMLEditorKit.HTMLTextAction", "javax/swing/text/html/HTMLEditorKit.HTMLTextAction.html"],
+ \["HTMLEditorKit.InsertHTMLTextAction", "javax/swing/text/html/HTMLEditorKit.InsertHTMLTextAction.html"],
+ \["HTMLEditorKit.LinkController", "javax/swing/text/html/HTMLEditorKit.LinkController.html"],
+ \["HTMLEditorKit.Parser", "javax/swing/text/html/HTMLEditorKit.Parser.html"],
+ \["HTMLEditorKit.ParserCallback", "javax/swing/text/html/HTMLEditorKit.ParserCallback.html"],
+ \["HTMLFrameHyperlinkEvent", "javax/swing/text/html/HTMLFrameHyperlinkEvent.html"],
+ \["HTMLWriter", "javax/swing/text/html/HTMLWriter.html"],
+ \["HTTPBinding", "javax/xml/ws/http/HTTPBinding.html"],
+ \["HttpCookie", "java/net/HttpCookie.html"],
+ \["HTTPException", "javax/xml/ws/http/HTTPException.html"],
+ \["HttpRetryException", "java/net/HttpRetryException.html"],
+ \["HttpsURLConnection", "javax/net/ssl/HttpsURLConnection.html"],
+ \["HttpURLConnection", "java/net/HttpURLConnection.html"],
+ \["HyperlinkEvent", "javax/swing/event/HyperlinkEvent.html"],
+ \["HyperlinkEvent.EventType", "javax/swing/event/HyperlinkEvent.EventType.html"],
+ \["HyperlinkListener", "javax/swing/event/HyperlinkListener.html"],
+ \["ICC_ColorSpace", "java/awt/color/ICC_ColorSpace.html"],
+ \["ICC_Profile", "java/awt/color/ICC_Profile.html"],
+ \["ICC_ProfileGray", "java/awt/color/ICC_ProfileGray.html"],
+ \["ICC_ProfileRGB", "java/awt/color/ICC_ProfileRGB.html"],
+ \["Icon", "javax/swing/Icon.html"],
+ \["IconUIResource", "javax/swing/plaf/IconUIResource.html"],
+ \["IconView", "javax/swing/text/IconView.html"],
+ \["ID_ASSIGNMENT_POLICY_ID", "org/omg/PortableServer/ID_ASSIGNMENT_POLICY_ID.html"],
+ \["ID_UNIQUENESS_POLICY_ID", "org/omg/PortableServer/ID_UNIQUENESS_POLICY_ID.html"],
+ \["IdAssignmentPolicy", "org/omg/PortableServer/IdAssignmentPolicy.html"],
+ \["IdAssignmentPolicyOperations", "org/omg/PortableServer/IdAssignmentPolicyOperations.html"],
+ \["IdAssignmentPolicyValue", "org/omg/PortableServer/IdAssignmentPolicyValue.html"],
+ \["IdentifierHelper", "org/omg/CORBA/IdentifierHelper.html"],
+ \["Identity", "java/security/Identity.html"],
+ \["IdentityHashMap", "java/util/IdentityHashMap.html"],
+ \["IdentityScope", "java/security/IdentityScope.html"],
+ \["IDLEntity", "org/omg/CORBA/portable/IDLEntity.html"],
+ \["IDLType", "org/omg/CORBA/IDLType.html"],
+ \["IDLTypeHelper", "org/omg/CORBA/IDLTypeHelper.html"],
+ \["IDLTypeOperations", "org/omg/CORBA/IDLTypeOperations.html"],
+ \["IDN", "java/net/IDN.html"],
+ \["IdUniquenessPolicy", "org/omg/PortableServer/IdUniquenessPolicy.html"],
+ \["IdUniquenessPolicyOperations", "org/omg/PortableServer/IdUniquenessPolicyOperations.html"],
+ \["IdUniquenessPolicyValue", "org/omg/PortableServer/IdUniquenessPolicyValue.html"],
+ \["IIOByteBuffer", "javax/imageio/stream/IIOByteBuffer.html"],
+ \["IIOException", "javax/imageio/IIOException.html"],
+ \["IIOImage", "javax/imageio/IIOImage.html"],
+ \["IIOInvalidTreeException", "javax/imageio/metadata/IIOInvalidTreeException.html"],
+ \["IIOMetadata", "javax/imageio/metadata/IIOMetadata.html"],
+ \["IIOMetadataController", "javax/imageio/metadata/IIOMetadataController.html"],
+ \["IIOMetadataFormat", "javax/imageio/metadata/IIOMetadataFormat.html"],
+ \["IIOMetadataFormatImpl", "javax/imageio/metadata/IIOMetadataFormatImpl.html"],
+ \["IIOMetadataNode", "javax/imageio/metadata/IIOMetadataNode.html"],
+ \["IIOParam", "javax/imageio/IIOParam.html"],
+ \["IIOParamController", "javax/imageio/IIOParamController.html"],
+ \["IIOReadProgressListener", "javax/imageio/event/IIOReadProgressListener.html"],
+ \["IIOReadUpdateListener", "javax/imageio/event/IIOReadUpdateListener.html"],
+ \["IIOReadWarningListener", "javax/imageio/event/IIOReadWarningListener.html"],
+ \["IIORegistry", "javax/imageio/spi/IIORegistry.html"],
+ \["IIOServiceProvider", "javax/imageio/spi/IIOServiceProvider.html"],
+ \["IIOWriteProgressListener", "javax/imageio/event/IIOWriteProgressListener.html"],
+ \["IIOWriteWarningListener", "javax/imageio/event/IIOWriteWarningListener.html"],
+ \["IllegalAccessError", "java/lang/IllegalAccessError.html"],
+ \["IllegalAccessException", "java/lang/IllegalAccessException.html"],
+ \["IllegalArgumentException", "java/lang/IllegalArgumentException.html"],
+ \["IllegalBlockingModeException", "java/nio/channels/IllegalBlockingModeException.html"],
+ \["IllegalBlockSizeException", "javax/crypto/IllegalBlockSizeException.html"],
+ \["IllegalCharsetNameException", "java/nio/charset/IllegalCharsetNameException.html"],
+ \["IllegalClassFormatException", "java/lang/instrument/IllegalClassFormatException.html"],
+ \["IllegalComponentStateException", "java/awt/IllegalComponentStateException.html"],
+ \["IllegalFormatCodePointException", "java/util/IllegalFormatCodePointException.html"],
+ \["IllegalFormatConversionException", "java/util/IllegalFormatConversionException.html"],
+ \["IllegalFormatException", "java/util/IllegalFormatException.html"],
+ \["IllegalFormatFlagsException", "java/util/IllegalFormatFlagsException.html"],
+ \["IllegalFormatPrecisionException", "java/util/IllegalFormatPrecisionException.html"],
+ \["IllegalFormatWidthException", "java/util/IllegalFormatWidthException.html"],
+ \["IllegalMonitorStateException", "java/lang/IllegalMonitorStateException.html"],
+ \["IllegalPathStateException", "java/awt/geom/IllegalPathStateException.html"],
+ \["IllegalSelectorException", "java/nio/channels/IllegalSelectorException.html"],
+ \["IllegalStateException", "java/lang/IllegalStateException.html"],
+ \["IllegalThreadStateException", "java/lang/IllegalThreadStateException.html"],
+ \["Image", "java/awt/Image.html"],
+ \["ImageCapabilities", "java/awt/ImageCapabilities.html"],
+ \["ImageConsumer", "java/awt/image/ImageConsumer.html"],
+ \["ImageFilter", "java/awt/image/ImageFilter.html"],
+ \["ImageGraphicAttribute", "java/awt/font/ImageGraphicAttribute.html"],
+ \["ImageIcon", "javax/swing/ImageIcon.html"],
+ \["ImageInputStream", "javax/imageio/stream/ImageInputStream.html"],
+ \["ImageInputStreamImpl", "javax/imageio/stream/ImageInputStreamImpl.html"],
+ \["ImageInputStreamSpi", "javax/imageio/spi/ImageInputStreamSpi.html"],
+ \["ImageIO", "javax/imageio/ImageIO.html"],
+ \["ImageObserver", "java/awt/image/ImageObserver.html"],
+ \["ImageOutputStream", "javax/imageio/stream/ImageOutputStream.html"],
+ \["ImageOutputStreamImpl", "javax/imageio/stream/ImageOutputStreamImpl.html"],
+ \["ImageOutputStreamSpi", "javax/imageio/spi/ImageOutputStreamSpi.html"],
+ \["ImageProducer", "java/awt/image/ImageProducer.html"],
+ \["ImageReader", "javax/imageio/ImageReader.html"],
+ \["ImageReaderSpi", "javax/imageio/spi/ImageReaderSpi.html"],
+ \["ImageReaderWriterSpi", "javax/imageio/spi/ImageReaderWriterSpi.html"],
+ \["ImageReadParam", "javax/imageio/ImageReadParam.html"],
+ \["ImageTranscoder", "javax/imageio/ImageTranscoder.html"],
+ \["ImageTranscoderSpi", "javax/imageio/spi/ImageTranscoderSpi.html"],
+ \["ImageTypeSpecifier", "javax/imageio/ImageTypeSpecifier.html"],
+ \["ImageView", "javax/swing/text/html/ImageView.html"],
+ \["ImageWriteParam", "javax/imageio/ImageWriteParam.html"],
+ \["ImageWriter", "javax/imageio/ImageWriter.html"],
+ \["ImageWriterSpi", "javax/imageio/spi/ImageWriterSpi.html"],
+ \["ImagingOpException", "java/awt/image/ImagingOpException.html"],
+ \["ImmutableDescriptor", "javax/management/ImmutableDescriptor.html"],
+ \["IMP_LIMIT", "org/omg/CORBA/IMP_LIMIT.html"],
+ \["IMPLICIT_ACTIVATION_POLICY_ID", "org/omg/PortableServer/IMPLICIT_ACTIVATION_POLICY_ID.html"],
+ \["ImplicitActivationPolicy", "org/omg/PortableServer/ImplicitActivationPolicy.html"],
+ \["ImplicitActivationPolicyOperations", "org/omg/PortableServer/ImplicitActivationPolicyOperations.html"],
+ \["ImplicitActivationPolicyValue", "org/omg/PortableServer/ImplicitActivationPolicyValue.html"],
+ \["INACTIVE", "org/omg/PortableInterceptor/INACTIVE.html"],
+ \["IncompatibleClassChangeError", "java/lang/IncompatibleClassChangeError.html"],
+ \["IncompleteAnnotationException", "java/lang/annotation/IncompleteAnnotationException.html"],
+ \["InconsistentTypeCode", "org/omg/CORBA/ORBPackage/InconsistentTypeCode.html"],
+ \["InconsistentTypeCode", "org/omg/DynamicAny/DynAnyFactoryPackage/InconsistentTypeCode.html"],
+ \["InconsistentTypeCodeHelper", "org/omg/DynamicAny/DynAnyFactoryPackage/InconsistentTypeCodeHelper.html"],
+ \["IndexColorModel", "java/awt/image/IndexColorModel.html"],
+ \["IndexedPropertyChangeEvent", "java/beans/IndexedPropertyChangeEvent.html"],
+ \["IndexedPropertyDescriptor", "java/beans/IndexedPropertyDescriptor.html"],
+ \["IndexOutOfBoundsException", "java/lang/IndexOutOfBoundsException.html"],
+ \["IndirectionException", "org/omg/CORBA/portable/IndirectionException.html"],
+ \["Inet4Address", "java/net/Inet4Address.html"],
+ \["Inet6Address", "java/net/Inet6Address.html"],
+ \["InetAddress", "java/net/InetAddress.html"],
+ \["InetSocketAddress", "java/net/InetSocketAddress.html"],
+ \["Inflater", "java/util/zip/Inflater.html"],
+ \["InflaterInputStream", "java/util/zip/InflaterInputStream.html"],
+ \["InflaterOutputStream", "java/util/zip/InflaterOutputStream.html"],
+ \["InheritableThreadLocal", "java/lang/InheritableThreadLocal.html"],
+ \["Inherited", "java/lang/annotation/Inherited.html"],
+ \["InitialContext", "javax/naming/InitialContext.html"],
+ \["InitialContextFactory", "javax/naming/spi/InitialContextFactory.html"],
+ \["InitialContextFactoryBuilder", "javax/naming/spi/InitialContextFactoryBuilder.html"],
+ \["InitialDirContext", "javax/naming/directory/InitialDirContext.html"],
+ \["INITIALIZE", "org/omg/CORBA/INITIALIZE.html"],
+ \["InitialLdapContext", "javax/naming/ldap/InitialLdapContext.html"],
+ \["InitParam", "javax/jws/soap/InitParam.html"],
+ \["InlineView", "javax/swing/text/html/InlineView.html"],
+ \["InputContext", "java/awt/im/InputContext.html"],
+ \["InputEvent", "java/awt/event/InputEvent.html"],
+ \["InputMap", "javax/swing/InputMap.html"],
+ \["InputMapUIResource", "javax/swing/plaf/InputMapUIResource.html"],
+ \["InputMethod", "java/awt/im/spi/InputMethod.html"],
+ \["InputMethodContext", "java/awt/im/spi/InputMethodContext.html"],
+ \["InputMethodDescriptor", "java/awt/im/spi/InputMethodDescriptor.html"],
+ \["InputMethodEvent", "java/awt/event/InputMethodEvent.html"],
+ \["InputMethodHighlight", "java/awt/im/InputMethodHighlight.html"],
+ \["InputMethodListener", "java/awt/event/InputMethodListener.html"],
+ \["InputMethodRequests", "java/awt/im/InputMethodRequests.html"],
+ \["InputMismatchException", "java/util/InputMismatchException.html"],
+ \["InputSource", "org/xml/sax/InputSource.html"],
+ \["InputStream", "java/io/InputStream.html"],
+ \["InputStream", "org/omg/CORBA/portable/InputStream.html"],
+ \["InputStream", "org/omg/CORBA_2_3/portable/InputStream.html"],
+ \["InputStreamReader", "java/io/InputStreamReader.html"],
+ \["InputSubset", "java/awt/im/InputSubset.html"],
+ \["InputVerifier", "javax/swing/InputVerifier.html"],
+ \["Insets", "java/awt/Insets.html"],
+ \["InsetsUIResource", "javax/swing/plaf/InsetsUIResource.html"],
+ \["InstanceAlreadyExistsException", "javax/management/InstanceAlreadyExistsException.html"],
+ \["InstanceNotFoundException", "javax/management/InstanceNotFoundException.html"],
+ \["InstantiationError", "java/lang/InstantiationError.html"],
+ \["InstantiationException", "java/lang/InstantiationException.html"],
+ \["Instrument", "javax/sound/midi/Instrument.html"],
+ \["Instrumentation", "java/lang/instrument/Instrumentation.html"],
+ \["InsufficientResourcesException", "javax/naming/InsufficientResourcesException.html"],
+ \["IntBuffer", "java/nio/IntBuffer.html"],
+ \["Integer", "java/lang/Integer.html"],
+ \["IntegerSyntax", "javax/print/attribute/IntegerSyntax.html"],
+ \["Interceptor", "org/omg/PortableInterceptor/Interceptor.html"],
+ \["InterceptorOperations", "org/omg/PortableInterceptor/InterceptorOperations.html"],
+ \["InterfaceAddress", "java/net/InterfaceAddress.html"],
+ \["INTERNAL", "org/omg/CORBA/INTERNAL.html"],
+ \["InternalError", "java/lang/InternalError.html"],
+ \["InternalFrameAdapter", "javax/swing/event/InternalFrameAdapter.html"],
+ \["InternalFrameEvent", "javax/swing/event/InternalFrameEvent.html"],
+ \["InternalFrameFocusTraversalPolicy", "javax/swing/InternalFrameFocusTraversalPolicy.html"],
+ \["InternalFrameListener", "javax/swing/event/InternalFrameListener.html"],
+ \["InternalFrameUI", "javax/swing/plaf/InternalFrameUI.html"],
+ \["InternationalFormatter", "javax/swing/text/InternationalFormatter.html"],
+ \["InterruptedException", "java/lang/InterruptedException.html"],
+ \["InterruptedIOException", "java/io/InterruptedIOException.html"],
+ \["InterruptedNamingException", "javax/naming/InterruptedNamingException.html"],
+ \["InterruptibleChannel", "java/nio/channels/InterruptibleChannel.html"],
+ \["INTF_REPOS", "org/omg/CORBA/INTF_REPOS.html"],
+ \["IntHolder", "org/omg/CORBA/IntHolder.html"],
+ \["IntrospectionException", "java/beans/IntrospectionException.html"],
+ \["IntrospectionException", "javax/management/IntrospectionException.html"],
+ \["Introspector", "java/beans/Introspector.html"],
+ \["INV_FLAG", "org/omg/CORBA/INV_FLAG.html"],
+ \["INV_IDENT", "org/omg/CORBA/INV_IDENT.html"],
+ \["INV_OBJREF", "org/omg/CORBA/INV_OBJREF.html"],
+ \["INV_POLICY", "org/omg/CORBA/INV_POLICY.html"],
+ \["Invalid", "org/omg/CORBA/DynAnyPackage/Invalid.html"],
+ \["INVALID_ACTIVITY", "org/omg/CORBA/INVALID_ACTIVITY.html"],
+ \["INVALID_TRANSACTION", "org/omg/CORBA/INVALID_TRANSACTION.html"],
+ \["InvalidActivityException", "javax/activity/InvalidActivityException.html"],
+ \["InvalidAddress", "org/omg/CosNaming/NamingContextExtPackage/InvalidAddress.html"],
+ \["InvalidAddressHelper", "org/omg/CosNaming/NamingContextExtPackage/InvalidAddressHelper.html"],
+ \["InvalidAddressHolder", "org/omg/CosNaming/NamingContextExtPackage/InvalidAddressHolder.html"],
+ \["InvalidAlgorithmParameterException", "java/security/InvalidAlgorithmParameterException.html"],
+ \["InvalidApplicationException", "javax/management/InvalidApplicationException.html"],
+ \["InvalidAttributeIdentifierException", "javax/naming/directory/InvalidAttributeIdentifierException.html"],
+ \["InvalidAttributesException", "javax/naming/directory/InvalidAttributesException.html"],
+ \["InvalidAttributeValueException", "javax/management/InvalidAttributeValueException.html"],
+ \["InvalidAttributeValueException", "javax/naming/directory/InvalidAttributeValueException.html"],
+ \["InvalidClassException", "java/io/InvalidClassException.html"],
+ \["InvalidDnDOperationException", "java/awt/dnd/InvalidDnDOperationException.html"],
+ \["InvalidKeyException", "java/security/InvalidKeyException.html"],
+ \["InvalidKeyException", "javax/management/openmbean/InvalidKeyException.html"],
+ \["InvalidKeySpecException", "java/security/spec/InvalidKeySpecException.html"],
+ \["InvalidMarkException", "java/nio/InvalidMarkException.html"],
+ \["InvalidMidiDataException", "javax/sound/midi/InvalidMidiDataException.html"],
+ \["InvalidName", "org/omg/CORBA/ORBPackage/InvalidName.html"],
+ \["InvalidName", "org/omg/CosNaming/NamingContextPackage/InvalidName.html"],
+ \["InvalidName", "org/omg/PortableInterceptor/ORBInitInfoPackage/InvalidName.html"],
+ \["InvalidNameException", "javax/naming/InvalidNameException.html"],
+ \["InvalidNameHelper", "org/omg/CosNaming/NamingContextPackage/InvalidNameHelper.html"],
+ \["InvalidNameHelper", "org/omg/PortableInterceptor/ORBInitInfoPackage/InvalidNameHelper.html"],
+ \["InvalidNameHolder", "org/omg/CosNaming/NamingContextPackage/InvalidNameHolder.html"],
+ \["InvalidObjectException", "java/io/InvalidObjectException.html"],
+ \["InvalidOpenTypeException", "javax/management/openmbean/InvalidOpenTypeException.html"],
+ \["InvalidParameterException", "java/security/InvalidParameterException.html"],
+ \["InvalidParameterSpecException", "java/security/spec/InvalidParameterSpecException.html"],
+ \["InvalidPolicy", "org/omg/PortableServer/POAPackage/InvalidPolicy.html"],
+ \["InvalidPolicyHelper", "org/omg/PortableServer/POAPackage/InvalidPolicyHelper.html"],
+ \["InvalidPreferencesFormatException", "java/util/prefs/InvalidPreferencesFormatException.html"],
+ \["InvalidPropertiesFormatException", "java/util/InvalidPropertiesFormatException.html"],
+ \["InvalidRelationIdException", "javax/management/relation/InvalidRelationIdException.html"],
+ \["InvalidRelationServiceException", "javax/management/relation/InvalidRelationServiceException.html"],
+ \["InvalidRelationTypeException", "javax/management/relation/InvalidRelationTypeException.html"],
+ \["InvalidRoleInfoException", "javax/management/relation/InvalidRoleInfoException.html"],
+ \["InvalidRoleValueException", "javax/management/relation/InvalidRoleValueException.html"],
+ \["InvalidSearchControlsException", "javax/naming/directory/InvalidSearchControlsException.html"],
+ \["InvalidSearchFilterException", "javax/naming/directory/InvalidSearchFilterException.html"],
+ \["InvalidSeq", "org/omg/CORBA/DynAnyPackage/InvalidSeq.html"],
+ \["InvalidSlot", "org/omg/PortableInterceptor/InvalidSlot.html"],
+ \["InvalidSlotHelper", "org/omg/PortableInterceptor/InvalidSlotHelper.html"],
+ \["InvalidTargetObjectTypeException", "javax/management/modelmbean/InvalidTargetObjectTypeException.html"],
+ \["InvalidTransactionException", "javax/transaction/InvalidTransactionException.html"],
+ \["InvalidTypeForEncoding", "org/omg/IOP/CodecPackage/InvalidTypeForEncoding.html"],
+ \["InvalidTypeForEncodingHelper", "org/omg/IOP/CodecPackage/InvalidTypeForEncodingHelper.html"],
+ \["InvalidValue", "org/omg/CORBA/DynAnyPackage/InvalidValue.html"],
+ \["InvalidValue", "org/omg/DynamicAny/DynAnyPackage/InvalidValue.html"],
+ \["InvalidValueHelper", "org/omg/DynamicAny/DynAnyPackage/InvalidValueHelper.html"],
+ \["Invocable", "javax/script/Invocable.html"],
+ \["InvocationEvent", "java/awt/event/InvocationEvent.html"],
+ \["InvocationHandler", "java/lang/reflect/InvocationHandler.html"],
+ \["InvocationTargetException", "java/lang/reflect/InvocationTargetException.html"],
+ \["InvokeHandler", "org/omg/CORBA/portable/InvokeHandler.html"],
+ \["IOError", "java/io/IOError.html"],
+ \["IOException", "java/io/IOException.html"],
+ \["IOR", "org/omg/IOP/IOR.html"],
+ \["IORHelper", "org/omg/IOP/IORHelper.html"],
+ \["IORHolder", "org/omg/IOP/IORHolder.html"],
+ \["IORInfo", "org/omg/PortableInterceptor/IORInfo.html"],
+ \["IORInfoOperations", "org/omg/PortableInterceptor/IORInfoOperations.html"],
+ \["IORInterceptor", "org/omg/PortableInterceptor/IORInterceptor.html"],
+ \["IORInterceptor_3_0", "org/omg/PortableInterceptor/IORInterceptor_3_0.html"],
+ \["IORInterceptor_3_0Helper", "org/omg/PortableInterceptor/IORInterceptor_3_0Helper.html"],
+ \["IORInterceptor_3_0Holder", "org/omg/PortableInterceptor/IORInterceptor_3_0Holder.html"],
+ \["IORInterceptor_3_0Operations", "org/omg/PortableInterceptor/IORInterceptor_3_0Operations.html"],
+ \["IORInterceptorOperations", "org/omg/PortableInterceptor/IORInterceptorOperations.html"],
+ \["IRObject", "org/omg/CORBA/IRObject.html"],
+ \["IRObjectOperations", "org/omg/CORBA/IRObjectOperations.html"],
+ \["IstringHelper", "org/omg/CosNaming/IstringHelper.html"],
+ \["ItemEvent", "java/awt/event/ItemEvent.html"],
+ \["ItemListener", "java/awt/event/ItemListener.html"],
+ \["ItemSelectable", "java/awt/ItemSelectable.html"],
+ \["Iterable", "java/lang/Iterable.html"],
+ \["Iterator", "java/util/Iterator.html"],
+ \["IvParameterSpec", "javax/crypto/spec/IvParameterSpec.html"],
+ \["JApplet", "javax/swing/JApplet.html"],
+ \["JarEntry", "java/util/jar/JarEntry.html"],
+ \["JarException", "java/util/jar/JarException.html"],
+ \["JarFile", "java/util/jar/JarFile.html"],
+ \["JarInputStream", "java/util/jar/JarInputStream.html"],
+ \["JarOutputStream", "java/util/jar/JarOutputStream.html"],
+ \["JarURLConnection", "java/net/JarURLConnection.html"],
+ \["JavaCompiler", "javax/tools/JavaCompiler.html"],
+ \["JavaCompiler.CompilationTask", "javax/tools/JavaCompiler.CompilationTask.html"],
+ \["JavaFileManager", "javax/tools/JavaFileManager.html"],
+ \["JavaFileManager.Location", "javax/tools/JavaFileManager.Location.html"],
+ \["JavaFileObject", "javax/tools/JavaFileObject.html"],
+ \["JavaFileObject.Kind", "javax/tools/JavaFileObject.Kind.html"],
+ \["JAXB", "javax/xml/bind/JAXB.html"],
+ \["JAXBContext", "javax/xml/bind/JAXBContext.html"],
+ \["JAXBElement", "javax/xml/bind/JAXBElement.html"],
+ \["JAXBElement.GlobalScope", "javax/xml/bind/JAXBElement.GlobalScope.html"],
+ \["JAXBException", "javax/xml/bind/JAXBException.html"],
+ \["JAXBIntrospector", "javax/xml/bind/JAXBIntrospector.html"],
+ \["JAXBResult", "javax/xml/bind/util/JAXBResult.html"],
+ \["JAXBSource", "javax/xml/bind/util/JAXBSource.html"],
+ \["JButton", "javax/swing/JButton.html"],
+ \["JCheckBox", "javax/swing/JCheckBox.html"],
+ \["JCheckBoxMenuItem", "javax/swing/JCheckBoxMenuItem.html"],
+ \["JColorChooser", "javax/swing/JColorChooser.html"],
+ \["JComboBox", "javax/swing/JComboBox.html"],
+ \["JComboBox.KeySelectionManager", "javax/swing/JComboBox.KeySelectionManager.html"],
+ \["JComponent", "javax/swing/JComponent.html"],
+ \["JdbcRowSet", "javax/sql/rowset/JdbcRowSet.html"],
+ \["JDesktopPane", "javax/swing/JDesktopPane.html"],
+ \["JDialog", "javax/swing/JDialog.html"],
+ \["JEditorPane", "javax/swing/JEditorPane.html"],
+ \["JFileChooser", "javax/swing/JFileChooser.html"],
+ \["JFormattedTextField", "javax/swing/JFormattedTextField.html"],
+ \["JFormattedTextField.AbstractFormatter", "javax/swing/JFormattedTextField.AbstractFormatter.html"],
+ \["JFormattedTextField.AbstractFormatterFactory", "javax/swing/JFormattedTextField.AbstractFormatterFactory.html"],
+ \["JFrame", "javax/swing/JFrame.html"],
+ \["JInternalFrame", "javax/swing/JInternalFrame.html"],
+ \["JInternalFrame.JDesktopIcon", "javax/swing/JInternalFrame.JDesktopIcon.html"],
+ \["JLabel", "javax/swing/JLabel.html"],
+ \["JLayeredPane", "javax/swing/JLayeredPane.html"],
+ \["JList", "javax/swing/JList.html"],
+ \["JList.DropLocation", "javax/swing/JList.DropLocation.html"],
+ \["JMenu", "javax/swing/JMenu.html"],
+ \["JMenuBar", "javax/swing/JMenuBar.html"],
+ \["JMenuItem", "javax/swing/JMenuItem.html"],
+ \["JMException", "javax/management/JMException.html"],
+ \["JMRuntimeException", "javax/management/JMRuntimeException.html"],
+ \["JMX", "javax/management/JMX.html"],
+ \["JMXAddressable", "javax/management/remote/JMXAddressable.html"],
+ \["JMXAuthenticator", "javax/management/remote/JMXAuthenticator.html"],
+ \["JMXConnectionNotification", "javax/management/remote/JMXConnectionNotification.html"],
+ \["JMXConnector", "javax/management/remote/JMXConnector.html"],
+ \["JMXConnectorFactory", "javax/management/remote/JMXConnectorFactory.html"],
+ \["JMXConnectorProvider", "javax/management/remote/JMXConnectorProvider.html"],
+ \["JMXConnectorServer", "javax/management/remote/JMXConnectorServer.html"],
+ \["JMXConnectorServerFactory", "javax/management/remote/JMXConnectorServerFactory.html"],
+ \["JMXConnectorServerMBean", "javax/management/remote/JMXConnectorServerMBean.html"],
+ \["JMXConnectorServerProvider", "javax/management/remote/JMXConnectorServerProvider.html"],
+ \["JMXPrincipal", "javax/management/remote/JMXPrincipal.html"],
+ \["JMXProviderException", "javax/management/remote/JMXProviderException.html"],
+ \["JMXServerErrorException", "javax/management/remote/JMXServerErrorException.html"],
+ \["JMXServiceURL", "javax/management/remote/JMXServiceURL.html"],
+ \["JobAttributes", "java/awt/JobAttributes.html"],
+ \["JobAttributes.DefaultSelectionType", "java/awt/JobAttributes.DefaultSelectionType.html"],
+ \["JobAttributes.DestinationType", "java/awt/JobAttributes.DestinationType.html"],
+ \["JobAttributes.DialogType", "java/awt/JobAttributes.DialogType.html"],
+ \["JobAttributes.MultipleDocumentHandlingType", "java/awt/JobAttributes.MultipleDocumentHandlingType.html"],
+ \["JobAttributes.SidesType", "java/awt/JobAttributes.SidesType.html"],
+ \["JobHoldUntil", "javax/print/attribute/standard/JobHoldUntil.html"],
+ \["JobImpressions", "javax/print/attribute/standard/JobImpressions.html"],
+ \["JobImpressionsCompleted", "javax/print/attribute/standard/JobImpressionsCompleted.html"],
+ \["JobImpressionsSupported", "javax/print/attribute/standard/JobImpressionsSupported.html"],
+ \["JobKOctets", "javax/print/attribute/standard/JobKOctets.html"],
+ \["JobKOctetsProcessed", "javax/print/attribute/standard/JobKOctetsProcessed.html"],
+ \["JobKOctetsSupported", "javax/print/attribute/standard/JobKOctetsSupported.html"],
+ \["JobMediaSheets", "javax/print/attribute/standard/JobMediaSheets.html"],
+ \["JobMediaSheetsCompleted", "javax/print/attribute/standard/JobMediaSheetsCompleted.html"],
+ \["JobMediaSheetsSupported", "javax/print/attribute/standard/JobMediaSheetsSupported.html"],
+ \["JobMessageFromOperator", "javax/print/attribute/standard/JobMessageFromOperator.html"],
+ \["JobName", "javax/print/attribute/standard/JobName.html"],
+ \["JobOriginatingUserName", "javax/print/attribute/standard/JobOriginatingUserName.html"],
+ \["JobPriority", "javax/print/attribute/standard/JobPriority.html"],
+ \["JobPrioritySupported", "javax/print/attribute/standard/JobPrioritySupported.html"],
+ \["JobSheets", "javax/print/attribute/standard/JobSheets.html"],
+ \["JobState", "javax/print/attribute/standard/JobState.html"],
+ \["JobStateReason", "javax/print/attribute/standard/JobStateReason.html"],
+ \["JobStateReasons", "javax/print/attribute/standard/JobStateReasons.html"],
+ \["Joinable", "javax/sql/rowset/Joinable.html"],
+ \["JoinRowSet", "javax/sql/rowset/JoinRowSet.html"],
+ \["JOptionPane", "javax/swing/JOptionPane.html"],
+ \["JPanel", "javax/swing/JPanel.html"],
+ \["JPasswordField", "javax/swing/JPasswordField.html"],
+ \["JPEGHuffmanTable", "javax/imageio/plugins/jpeg/JPEGHuffmanTable.html"],
+ \["JPEGImageReadParam", "javax/imageio/plugins/jpeg/JPEGImageReadParam.html"],
+ \["JPEGImageWriteParam", "javax/imageio/plugins/jpeg/JPEGImageWriteParam.html"],
+ \["JPEGQTable", "javax/imageio/plugins/jpeg/JPEGQTable.html"],
+ \["JPopupMenu", "javax/swing/JPopupMenu.html"],
+ \["JPopupMenu.Separator", "javax/swing/JPopupMenu.Separator.html"],
+ \["JProgressBar", "javax/swing/JProgressBar.html"],
+ \["JRadioButton", "javax/swing/JRadioButton.html"],
+ \["JRadioButtonMenuItem", "javax/swing/JRadioButtonMenuItem.html"],
+ \["JRootPane", "javax/swing/JRootPane.html"],
+ \["JScrollBar", "javax/swing/JScrollBar.html"],
+ \["JScrollPane", "javax/swing/JScrollPane.html"],
+ \["JSeparator", "javax/swing/JSeparator.html"],
+ \["JSlider", "javax/swing/JSlider.html"],
+ \["JSpinner", "javax/swing/JSpinner.html"],
+ \["JSpinner.DateEditor", "javax/swing/JSpinner.DateEditor.html"],
+ \["JSpinner.DefaultEditor", "javax/swing/JSpinner.DefaultEditor.html"],
+ \["JSpinner.ListEditor", "javax/swing/JSpinner.ListEditor.html"],
+ \["JSpinner.NumberEditor", "javax/swing/JSpinner.NumberEditor.html"],
+ \["JSplitPane", "javax/swing/JSplitPane.html"],
+ \["JTabbedPane", "javax/swing/JTabbedPane.html"],
+ \["JTable", "javax/swing/JTable.html"],
+ \["JTable.DropLocation", "javax/swing/JTable.DropLocation.html"],
+ \["JTable.PrintMode", "javax/swing/JTable.PrintMode.html"],
+ \["JTableHeader", "javax/swing/table/JTableHeader.html"],
+ \["JTextArea", "javax/swing/JTextArea.html"],
+ \["JTextComponent", "javax/swing/text/JTextComponent.html"],
+ \["JTextComponent.DropLocation", "javax/swing/text/JTextComponent.DropLocation.html"],
+ \["JTextComponent.KeyBinding", "javax/swing/text/JTextComponent.KeyBinding.html"],
+ \["JTextField", "javax/swing/JTextField.html"],
+ \["JTextPane", "javax/swing/JTextPane.html"],
+ \["JToggleButton", "javax/swing/JToggleButton.html"],
+ \["JToggleButton.ToggleButtonModel", "javax/swing/JToggleButton.ToggleButtonModel.html"],
+ \["JToolBar", "javax/swing/JToolBar.html"],
+ \["JToolBar.Separator", "javax/swing/JToolBar.Separator.html"],
+ \["JToolTip", "javax/swing/JToolTip.html"],
+ \["JTree", "javax/swing/JTree.html"],
+ \["JTree.DropLocation", "javax/swing/JTree.DropLocation.html"],
+ \["JTree.DynamicUtilTreeNode", "javax/swing/JTree.DynamicUtilTreeNode.html"],
+ \["JTree.EmptySelectionModel", "javax/swing/JTree.EmptySelectionModel.html"],
+ \["JViewport", "javax/swing/JViewport.html"],
+ \["JWindow", "javax/swing/JWindow.html"],
+ \["KerberosKey", "javax/security/auth/kerberos/KerberosKey.html"],
+ \["KerberosPrincipal", "javax/security/auth/kerberos/KerberosPrincipal.html"],
+ \["KerberosTicket", "javax/security/auth/kerberos/KerberosTicket.html"],
+ \["Kernel", "java/awt/image/Kernel.html"],
+ \["Key", "java/security/Key.html"],
+ \["KeyAdapter", "java/awt/event/KeyAdapter.html"],
+ \["KeyAgreement", "javax/crypto/KeyAgreement.html"],
+ \["KeyAgreementSpi", "javax/crypto/KeyAgreementSpi.html"],
+ \["KeyAlreadyExistsException", "javax/management/openmbean/KeyAlreadyExistsException.html"],
+ \["KeyboardFocusManager", "java/awt/KeyboardFocusManager.html"],
+ \["KeyEvent", "java/awt/event/KeyEvent.html"],
+ \["KeyEventDispatcher", "java/awt/KeyEventDispatcher.html"],
+ \["KeyEventPostProcessor", "java/awt/KeyEventPostProcessor.html"],
+ \["KeyException", "java/security/KeyException.html"],
+ \["KeyFactory", "java/security/KeyFactory.html"],
+ \["KeyFactorySpi", "java/security/KeyFactorySpi.html"],
+ \["KeyGenerator", "javax/crypto/KeyGenerator.html"],
+ \["KeyGeneratorSpi", "javax/crypto/KeyGeneratorSpi.html"],
+ \["KeyInfo", "javax/xml/crypto/dsig/keyinfo/KeyInfo.html"],
+ \["KeyInfoFactory", "javax/xml/crypto/dsig/keyinfo/KeyInfoFactory.html"],
+ \["KeyListener", "java/awt/event/KeyListener.html"],
+ \["KeyManagementException", "java/security/KeyManagementException.html"],
+ \["KeyManager", "javax/net/ssl/KeyManager.html"],
+ \["KeyManagerFactory", "javax/net/ssl/KeyManagerFactory.html"],
+ \["KeyManagerFactorySpi", "javax/net/ssl/KeyManagerFactorySpi.html"],
+ \["Keymap", "javax/swing/text/Keymap.html"],
+ \["KeyName", "javax/xml/crypto/dsig/keyinfo/KeyName.html"],
+ \["KeyPair", "java/security/KeyPair.html"],
+ \["KeyPairGenerator", "java/security/KeyPairGenerator.html"],
+ \["KeyPairGeneratorSpi", "java/security/KeyPairGeneratorSpi.html"],
+ \["KeyRep", "java/security/KeyRep.html"],
+ \["KeyRep.Type", "java/security/KeyRep.Type.html"],
+ \["KeySelector", "javax/xml/crypto/KeySelector.html"],
+ \["KeySelector.Purpose", "javax/xml/crypto/KeySelector.Purpose.html"],
+ \["KeySelectorException", "javax/xml/crypto/KeySelectorException.html"],
+ \["KeySelectorResult", "javax/xml/crypto/KeySelectorResult.html"],
+ \["KeySpec", "java/security/spec/KeySpec.html"],
+ \["KeyStore", "java/security/KeyStore.html"],
+ \["KeyStore.Builder", "java/security/KeyStore.Builder.html"],
+ \["KeyStore.CallbackHandlerProtection", "java/security/KeyStore.CallbackHandlerProtection.html"],
+ \["KeyStore.Entry", "java/security/KeyStore.Entry.html"],
+ \["KeyStore.LoadStoreParameter", "java/security/KeyStore.LoadStoreParameter.html"],
+ \["KeyStore.PasswordProtection", "java/security/KeyStore.PasswordProtection.html"],
+ \["KeyStore.PrivateKeyEntry", "java/security/KeyStore.PrivateKeyEntry.html"],
+ \["KeyStore.ProtectionParameter", "java/security/KeyStore.ProtectionParameter.html"],
+ \["KeyStore.SecretKeyEntry", "java/security/KeyStore.SecretKeyEntry.html"],
+ \["KeyStore.TrustedCertificateEntry", "java/security/KeyStore.TrustedCertificateEntry.html"],
+ \["KeyStoreBuilderParameters", "javax/net/ssl/KeyStoreBuilderParameters.html"],
+ \["KeyStoreException", "java/security/KeyStoreException.html"],
+ \["KeyStoreSpi", "java/security/KeyStoreSpi.html"],
+ \["KeyStroke", "javax/swing/KeyStroke.html"],
+ \["KeyValue", "javax/xml/crypto/dsig/keyinfo/KeyValue.html"],
+ \["Label", "java/awt/Label.html"],
+ \["LabelUI", "javax/swing/plaf/LabelUI.html"],
+ \["LabelView", "javax/swing/text/LabelView.html"],
+ \["LanguageCallback", "javax/security/auth/callback/LanguageCallback.html"],
+ \["LastOwnerException", "java/security/acl/LastOwnerException.html"],
+ \["LayeredHighlighter", "javax/swing/text/LayeredHighlighter.html"],
+ \["LayeredHighlighter.LayerPainter", "javax/swing/text/LayeredHighlighter.LayerPainter.html"],
+ \["LayoutFocusTraversalPolicy", "javax/swing/LayoutFocusTraversalPolicy.html"],
+ \["LayoutManager", "java/awt/LayoutManager.html"],
+ \["LayoutManager2", "java/awt/LayoutManager2.html"],
+ \["LayoutPath", "java/awt/font/LayoutPath.html"],
+ \["LayoutQueue", "javax/swing/text/LayoutQueue.html"],
+ \["LayoutStyle", "javax/swing/LayoutStyle.html"],
+ \["LayoutStyle.ComponentPlacement", "javax/swing/LayoutStyle.ComponentPlacement.html"],
+ \["LDAPCertStoreParameters", "java/security/cert/LDAPCertStoreParameters.html"],
+ \["LdapContext", "javax/naming/ldap/LdapContext.html"],
+ \["LdapName", "javax/naming/ldap/LdapName.html"],
+ \["LdapReferralException", "javax/naming/ldap/LdapReferralException.html"],
+ \["Lease", "java/rmi/dgc/Lease.html"],
+ \["Level", "java/util/logging/Level.html"],
+ \["LexicalHandler", "org/xml/sax/ext/LexicalHandler.html"],
+ \["LIFESPAN_POLICY_ID", "org/omg/PortableServer/LIFESPAN_POLICY_ID.html"],
+ \["LifespanPolicy", "org/omg/PortableServer/LifespanPolicy.html"],
+ \["LifespanPolicyOperations", "org/omg/PortableServer/LifespanPolicyOperations.html"],
+ \["LifespanPolicyValue", "org/omg/PortableServer/LifespanPolicyValue.html"],
+ \["LimitExceededException", "javax/naming/LimitExceededException.html"],
+ \["Line", "javax/sound/sampled/Line.html"],
+ \["Line.Info", "javax/sound/sampled/Line.Info.html"],
+ \["Line2D", "java/awt/geom/Line2D.html"],
+ \["Line2D.Double", "java/awt/geom/Line2D.Double.html"],
+ \["Line2D.Float", "java/awt/geom/Line2D.Float.html"],
+ \["LinearGradientPaint", "java/awt/LinearGradientPaint.html"],
+ \["LineBorder", "javax/swing/border/LineBorder.html"],
+ \["LineBreakMeasurer", "java/awt/font/LineBreakMeasurer.html"],
+ \["LineEvent", "javax/sound/sampled/LineEvent.html"],
+ \["LineEvent.Type", "javax/sound/sampled/LineEvent.Type.html"],
+ \["LineListener", "javax/sound/sampled/LineListener.html"],
+ \["LineMetrics", "java/awt/font/LineMetrics.html"],
+ \["LineNumberInputStream", "java/io/LineNumberInputStream.html"],
+ \["LineNumberReader", "java/io/LineNumberReader.html"],
+ \["LineUnavailableException", "javax/sound/sampled/LineUnavailableException.html"],
+ \["LinkageError", "java/lang/LinkageError.html"],
+ \["LinkedBlockingDeque", "java/util/concurrent/LinkedBlockingDeque.html"],
+ \["LinkedBlockingQueue", "java/util/concurrent/LinkedBlockingQueue.html"],
+ \["LinkedHashMap", "java/util/LinkedHashMap.html"],
+ \["LinkedHashSet", "java/util/LinkedHashSet.html"],
+ \["LinkedList", "java/util/LinkedList.html"],
+ \["LinkException", "javax/naming/LinkException.html"],
+ \["LinkLoopException", "javax/naming/LinkLoopException.html"],
+ \["LinkRef", "javax/naming/LinkRef.html"],
+ \["List", "java/awt/List.html"],
+ \["List", "java/util/List.html"],
+ \["ListCellRenderer", "javax/swing/ListCellRenderer.html"],
+ \["ListDataEvent", "javax/swing/event/ListDataEvent.html"],
+ \["ListDataListener", "javax/swing/event/ListDataListener.html"],
+ \["ListenerNotFoundException", "javax/management/ListenerNotFoundException.html"],
+ \["ListIterator", "java/util/ListIterator.html"],
+ \["ListModel", "javax/swing/ListModel.html"],
+ \["ListResourceBundle", "java/util/ListResourceBundle.html"],
+ \["ListSelectionEvent", "javax/swing/event/ListSelectionEvent.html"],
+ \["ListSelectionListener", "javax/swing/event/ListSelectionListener.html"],
+ \["ListSelectionModel", "javax/swing/ListSelectionModel.html"],
+ \["ListUI", "javax/swing/plaf/ListUI.html"],
+ \["ListView", "javax/swing/text/html/ListView.html"],
+ \["LoaderHandler", "java/rmi/server/LoaderHandler.html"],
+ \["Locale", "java/util/Locale.html"],
+ \["LocaleNameProvider", "java/util/spi/LocaleNameProvider.html"],
+ \["LocaleServiceProvider", "java/util/spi/LocaleServiceProvider.html"],
+ \["LocalObject", "org/omg/CORBA/LocalObject.html"],
+ \["LocateRegistry", "java/rmi/registry/LocateRegistry.html"],
+ \["Location", "javax/xml/stream/Location.html"],
+ \["LOCATION_FORWARD", "org/omg/PortableInterceptor/LOCATION_FORWARD.html"],
+ \["Locator", "org/xml/sax/Locator.html"],
+ \["Locator2", "org/xml/sax/ext/Locator2.html"],
+ \["Locator2Impl", "org/xml/sax/ext/Locator2Impl.html"],
+ \["LocatorImpl", "org/xml/sax/helpers/LocatorImpl.html"],
+ \["Lock", "java/util/concurrent/locks/Lock.html"],
+ \["LockInfo", "java/lang/management/LockInfo.html"],
+ \["LockSupport", "java/util/concurrent/locks/LockSupport.html"],
+ \["Logger", "java/util/logging/Logger.html"],
+ \["LoggingMXBean", "java/util/logging/LoggingMXBean.html"],
+ \["LoggingPermission", "java/util/logging/LoggingPermission.html"],
+ \["LogicalHandler", "javax/xml/ws/handler/LogicalHandler.html"],
+ \["LogicalMessage", "javax/xml/ws/LogicalMessage.html"],
+ \["LogicalMessageContext", "javax/xml/ws/handler/LogicalMessageContext.html"],
+ \["LoginContext", "javax/security/auth/login/LoginContext.html"],
+ \["LoginException", "javax/security/auth/login/LoginException.html"],
+ \["LoginModule", "javax/security/auth/spi/LoginModule.html"],
+ \["LogManager", "java/util/logging/LogManager.html"],
+ \["LogRecord", "java/util/logging/LogRecord.html"],
+ \["LogStream", "java/rmi/server/LogStream.html"],
+ \["Long", "java/lang/Long.html"],
+ \["LongBuffer", "java/nio/LongBuffer.html"],
+ \["LongHolder", "org/omg/CORBA/LongHolder.html"],
+ \["LongLongSeqHelper", "org/omg/CORBA/LongLongSeqHelper.html"],
+ \["LongLongSeqHolder", "org/omg/CORBA/LongLongSeqHolder.html"],
+ \["LongSeqHelper", "org/omg/CORBA/LongSeqHelper.html"],
+ \["LongSeqHolder", "org/omg/CORBA/LongSeqHolder.html"],
+ \["LookAndFeel", "javax/swing/LookAndFeel.html"],
+ \["LookupOp", "java/awt/image/LookupOp.html"],
+ \["LookupTable", "java/awt/image/LookupTable.html"],
+ \["LSException", "org/w3c/dom/ls/LSException.html"],
+ \["LSInput", "org/w3c/dom/ls/LSInput.html"],
+ \["LSLoadEvent", "org/w3c/dom/ls/LSLoadEvent.html"],
+ \["LSOutput", "org/w3c/dom/ls/LSOutput.html"],
+ \["LSParser", "org/w3c/dom/ls/LSParser.html"],
+ \["LSParserFilter", "org/w3c/dom/ls/LSParserFilter.html"],
+ \["LSProgressEvent", "org/w3c/dom/ls/LSProgressEvent.html"],
+ \["LSResourceResolver", "org/w3c/dom/ls/LSResourceResolver.html"],
+ \["LSSerializer", "org/w3c/dom/ls/LSSerializer.html"],
+ \["LSSerializerFilter", "org/w3c/dom/ls/LSSerializerFilter.html"],
+ \["Mac", "javax/crypto/Mac.html"],
+ \["MacSpi", "javax/crypto/MacSpi.html"],
+ \["MailcapCommandMap", "javax/activation/MailcapCommandMap.html"],
+ \["MalformedInputException", "java/nio/charset/MalformedInputException.html"],
+ \["MalformedLinkException", "javax/naming/MalformedLinkException.html"],
+ \["MalformedObjectNameException", "javax/management/MalformedObjectNameException.html"],
+ \["MalformedParameterizedTypeException", "java/lang/reflect/MalformedParameterizedTypeException.html"],
+ \["MalformedURLException", "java/net/MalformedURLException.html"],
+ \["ManagementFactory", "java/lang/management/ManagementFactory.html"],
+ \["ManagementPermission", "java/lang/management/ManagementPermission.html"],
+ \["ManageReferralControl", "javax/naming/ldap/ManageReferralControl.html"],
+ \["ManagerFactoryParameters", "javax/net/ssl/ManagerFactoryParameters.html"],
+ \["Manifest", "java/util/jar/Manifest.html"],
+ \["Manifest", "javax/xml/crypto/dsig/Manifest.html"],
+ \["Map", "java/util/Map.html"],
+ \["Map.Entry", "java/util/Map.Entry.html"],
+ \["MappedByteBuffer", "java/nio/MappedByteBuffer.html"],
+ \["MARSHAL", "org/omg/CORBA/MARSHAL.html"],
+ \["MarshalException", "java/rmi/MarshalException.html"],
+ \["MarshalException", "javax/xml/bind/MarshalException.html"],
+ \["MarshalException", "javax/xml/crypto/MarshalException.html"],
+ \["MarshalledObject", "java/rmi/MarshalledObject.html"],
+ \["Marshaller", "javax/xml/bind/Marshaller.html"],
+ \["Marshaller.Listener", "javax/xml/bind/Marshaller.Listener.html"],
+ \["MaskFormatter", "javax/swing/text/MaskFormatter.html"],
+ \["Matcher", "java/util/regex/Matcher.html"],
+ \["MatchResult", "java/util/regex/MatchResult.html"],
+ \["Math", "java/lang/Math.html"],
+ \["MathContext", "java/math/MathContext.html"],
+ \["MatteBorder", "javax/swing/border/MatteBorder.html"],
+ \["MBeanAttributeInfo", "javax/management/MBeanAttributeInfo.html"],
+ \["MBeanConstructorInfo", "javax/management/MBeanConstructorInfo.html"],
+ \["MBeanException", "javax/management/MBeanException.html"],
+ \["MBeanFeatureInfo", "javax/management/MBeanFeatureInfo.html"],
+ \["MBeanInfo", "javax/management/MBeanInfo.html"],
+ \["MBeanNotificationInfo", "javax/management/MBeanNotificationInfo.html"],
+ \["MBeanOperationInfo", "javax/management/MBeanOperationInfo.html"],
+ \["MBeanParameterInfo", "javax/management/MBeanParameterInfo.html"],
+ \["MBeanPermission", "javax/management/MBeanPermission.html"],
+ \["MBeanRegistration", "javax/management/MBeanRegistration.html"],
+ \["MBeanRegistrationException", "javax/management/MBeanRegistrationException.html"],
+ \["MBeanServer", "javax/management/MBeanServer.html"],
+ \["MBeanServerBuilder", "javax/management/MBeanServerBuilder.html"],
+ \["MBeanServerConnection", "javax/management/MBeanServerConnection.html"],
+ \["MBeanServerDelegate", "javax/management/MBeanServerDelegate.html"],
+ \["MBeanServerDelegateMBean", "javax/management/MBeanServerDelegateMBean.html"],
+ \["MBeanServerFactory", "javax/management/MBeanServerFactory.html"],
+ \["MBeanServerForwarder", "javax/management/remote/MBeanServerForwarder.html"],
+ \["MBeanServerInvocationHandler", "javax/management/MBeanServerInvocationHandler.html"],
+ \["MBeanServerNotification", "javax/management/MBeanServerNotification.html"],
+ \["MBeanServerNotificationFilter", "javax/management/relation/MBeanServerNotificationFilter.html"],
+ \["MBeanServerPermission", "javax/management/MBeanServerPermission.html"],
+ \["MBeanTrustPermission", "javax/management/MBeanTrustPermission.html"],
+ \["Media", "javax/print/attribute/standard/Media.html"],
+ \["MediaName", "javax/print/attribute/standard/MediaName.html"],
+ \["MediaPrintableArea", "javax/print/attribute/standard/MediaPrintableArea.html"],
+ \["MediaSize", "javax/print/attribute/standard/MediaSize.html"],
+ \["MediaSize.Engineering", "javax/print/attribute/standard/MediaSize.Engineering.html"],
+ \["MediaSize.ISO", "javax/print/attribute/standard/MediaSize.ISO.html"],
+ \["MediaSize.JIS", "javax/print/attribute/standard/MediaSize.JIS.html"],
+ \["MediaSize.NA", "javax/print/attribute/standard/MediaSize.NA.html"],
+ \["MediaSize.Other", "javax/print/attribute/standard/MediaSize.Other.html"],
+ \["MediaSizeName", "javax/print/attribute/standard/MediaSizeName.html"],
+ \["MediaTracker", "java/awt/MediaTracker.html"],
+ \["MediaTray", "javax/print/attribute/standard/MediaTray.html"],
+ \["Member", "java/lang/reflect/Member.html"],
+ \["MemoryCacheImageInputStream", "javax/imageio/stream/MemoryCacheImageInputStream.html"],
+ \["MemoryCacheImageOutputStream", "javax/imageio/stream/MemoryCacheImageOutputStream.html"],
+ \["MemoryHandler", "java/util/logging/MemoryHandler.html"],
+ \["MemoryImageSource", "java/awt/image/MemoryImageSource.html"],
+ \["MemoryManagerMXBean", "java/lang/management/MemoryManagerMXBean.html"],
+ \["MemoryMXBean", "java/lang/management/MemoryMXBean.html"],
+ \["MemoryNotificationInfo", "java/lang/management/MemoryNotificationInfo.html"],
+ \["MemoryPoolMXBean", "java/lang/management/MemoryPoolMXBean.html"],
+ \["MemoryType", "java/lang/management/MemoryType.html"],
+ \["MemoryUsage", "java/lang/management/MemoryUsage.html"],
+ \["Menu", "java/awt/Menu.html"],
+ \["MenuBar", "java/awt/MenuBar.html"],
+ \["MenuBarUI", "javax/swing/plaf/MenuBarUI.html"],
+ \["MenuComponent", "java/awt/MenuComponent.html"],
+ \["MenuContainer", "java/awt/MenuContainer.html"],
+ \["MenuDragMouseEvent", "javax/swing/event/MenuDragMouseEvent.html"],
+ \["MenuDragMouseListener", "javax/swing/event/MenuDragMouseListener.html"],
+ \["MenuElement", "javax/swing/MenuElement.html"],
+ \["MenuEvent", "javax/swing/event/MenuEvent.html"],
+ \["MenuItem", "java/awt/MenuItem.html"],
+ \["MenuItemUI", "javax/swing/plaf/MenuItemUI.html"],
+ \["MenuKeyEvent", "javax/swing/event/MenuKeyEvent.html"],
+ \["MenuKeyListener", "javax/swing/event/MenuKeyListener.html"],
+ \["MenuListener", "javax/swing/event/MenuListener.html"],
+ \["MenuSelectionManager", "javax/swing/MenuSelectionManager.html"],
+ \["MenuShortcut", "java/awt/MenuShortcut.html"],
+ \["MessageContext", "javax/xml/ws/handler/MessageContext.html"],
+ \["MessageContext.Scope", "javax/xml/ws/handler/MessageContext.Scope.html"],
+ \["MessageDigest", "java/security/MessageDigest.html"],
+ \["MessageDigestSpi", "java/security/MessageDigestSpi.html"],
+ \["MessageFactory", "javax/xml/soap/MessageFactory.html"],
+ \["MessageFormat", "java/text/MessageFormat.html"],
+ \["MessageFormat.Field", "java/text/MessageFormat.Field.html"],
+ \["MessageProp", "org/ietf/jgss/MessageProp.html"],
+ \["Messager", "javax/annotation/processing/Messager.html"],
+ \["MetaEventListener", "javax/sound/midi/MetaEventListener.html"],
+ \["MetalBorders", "javax/swing/plaf/metal/MetalBorders.html"],
+ \["MetalBorders.ButtonBorder", "javax/swing/plaf/metal/MetalBorders.ButtonBorder.html"],
+ \["MetalBorders.Flush3DBorder", "javax/swing/plaf/metal/MetalBorders.Flush3DBorder.html"],
+ \["MetalBorders.InternalFrameBorder", "javax/swing/plaf/metal/MetalBorders.InternalFrameBorder.html"],
+ \["MetalBorders.MenuBarBorder", "javax/swing/plaf/metal/MetalBorders.MenuBarBorder.html"],
+ \["MetalBorders.MenuItemBorder", "javax/swing/plaf/metal/MetalBorders.MenuItemBorder.html"],
+ \["MetalBorders.OptionDialogBorder", "javax/swing/plaf/metal/MetalBorders.OptionDialogBorder.html"],
+ \["MetalBorders.PaletteBorder", "javax/swing/plaf/metal/MetalBorders.PaletteBorder.html"],
+ \["MetalBorders.PopupMenuBorder", "javax/swing/plaf/metal/MetalBorders.PopupMenuBorder.html"],
+ \["MetalBorders.RolloverButtonBorder", "javax/swing/plaf/metal/MetalBorders.RolloverButtonBorder.html"],
+ \["MetalBorders.ScrollPaneBorder", "javax/swing/plaf/metal/MetalBorders.ScrollPaneBorder.html"],
+ \["MetalBorders.TableHeaderBorder", "javax/swing/plaf/metal/MetalBorders.TableHeaderBorder.html"],
+ \["MetalBorders.TextFieldBorder", "javax/swing/plaf/metal/MetalBorders.TextFieldBorder.html"],
+ \["MetalBorders.ToggleButtonBorder", "javax/swing/plaf/metal/MetalBorders.ToggleButtonBorder.html"],
+ \["MetalBorders.ToolBarBorder", "javax/swing/plaf/metal/MetalBorders.ToolBarBorder.html"],
+ \["MetalButtonUI", "javax/swing/plaf/metal/MetalButtonUI.html"],
+ \["MetalCheckBoxIcon", "javax/swing/plaf/metal/MetalCheckBoxIcon.html"],
+ \["MetalCheckBoxUI", "javax/swing/plaf/metal/MetalCheckBoxUI.html"],
+ \["MetalComboBoxButton", "javax/swing/plaf/metal/MetalComboBoxButton.html"],
+ \["MetalComboBoxEditor", "javax/swing/plaf/metal/MetalComboBoxEditor.html"],
+ \["MetalComboBoxEditor.UIResource", "javax/swing/plaf/metal/MetalComboBoxEditor.UIResource.html"],
+ \["MetalComboBoxIcon", "javax/swing/plaf/metal/MetalComboBoxIcon.html"],
+ \["MetalComboBoxUI", "javax/swing/plaf/metal/MetalComboBoxUI.html"],
+ \["MetalDesktopIconUI", "javax/swing/plaf/metal/MetalDesktopIconUI.html"],
+ \["MetalFileChooserUI", "javax/swing/plaf/metal/MetalFileChooserUI.html"],
+ \["MetalIconFactory", "javax/swing/plaf/metal/MetalIconFactory.html"],
+ \["MetalIconFactory.FileIcon16", "javax/swing/plaf/metal/MetalIconFactory.FileIcon16.html"],
+ \["MetalIconFactory.FolderIcon16", "javax/swing/plaf/metal/MetalIconFactory.FolderIcon16.html"],
+ \["MetalIconFactory.PaletteCloseIcon", "javax/swing/plaf/metal/MetalIconFactory.PaletteCloseIcon.html"],
+ \["MetalIconFactory.TreeControlIcon", "javax/swing/plaf/metal/MetalIconFactory.TreeControlIcon.html"],
+ \["MetalIconFactory.TreeFolderIcon", "javax/swing/plaf/metal/MetalIconFactory.TreeFolderIcon.html"],
+ \["MetalIconFactory.TreeLeafIcon", "javax/swing/plaf/metal/MetalIconFactory.TreeLeafIcon.html"],
+ \["MetalInternalFrameTitlePane", "javax/swing/plaf/metal/MetalInternalFrameTitlePane.html"],
+ \["MetalInternalFrameUI", "javax/swing/plaf/metal/MetalInternalFrameUI.html"],
+ \["MetalLabelUI", "javax/swing/plaf/metal/MetalLabelUI.html"],
+ \["MetalLookAndFeel", "javax/swing/plaf/metal/MetalLookAndFeel.html"],
+ \["MetalMenuBarUI", "javax/swing/plaf/metal/MetalMenuBarUI.html"],
+ \["MetalPopupMenuSeparatorUI", "javax/swing/plaf/metal/MetalPopupMenuSeparatorUI.html"],
+ \["MetalProgressBarUI", "javax/swing/plaf/metal/MetalProgressBarUI.html"],
+ \["MetalRadioButtonUI", "javax/swing/plaf/metal/MetalRadioButtonUI.html"],
+ \["MetalRootPaneUI", "javax/swing/plaf/metal/MetalRootPaneUI.html"],
+ \["MetalScrollBarUI", "javax/swing/plaf/metal/MetalScrollBarUI.html"],
+ \["MetalScrollButton", "javax/swing/plaf/metal/MetalScrollButton.html"],
+ \["MetalScrollPaneUI", "javax/swing/plaf/metal/MetalScrollPaneUI.html"],
+ \["MetalSeparatorUI", "javax/swing/plaf/metal/MetalSeparatorUI.html"],
+ \["MetalSliderUI", "javax/swing/plaf/metal/MetalSliderUI.html"],
+ \["MetalSplitPaneUI", "javax/swing/plaf/metal/MetalSplitPaneUI.html"],
+ \["MetalTabbedPaneUI", "javax/swing/plaf/metal/MetalTabbedPaneUI.html"],
+ \["MetalTextFieldUI", "javax/swing/plaf/metal/MetalTextFieldUI.html"],
+ \["MetalTheme", "javax/swing/plaf/metal/MetalTheme.html"],
+ \["MetalToggleButtonUI", "javax/swing/plaf/metal/MetalToggleButtonUI.html"],
+ \["MetalToolBarUI", "javax/swing/plaf/metal/MetalToolBarUI.html"],
+ \["MetalToolTipUI", "javax/swing/plaf/metal/MetalToolTipUI.html"],
+ \["MetalTreeUI", "javax/swing/plaf/metal/MetalTreeUI.html"],
+ \["MetaMessage", "javax/sound/midi/MetaMessage.html"],
+ \["Method", "java/lang/reflect/Method.html"],
+ \["MethodDescriptor", "java/beans/MethodDescriptor.html"],
+ \["MGF1ParameterSpec", "java/security/spec/MGF1ParameterSpec.html"],
+ \["MidiChannel", "javax/sound/midi/MidiChannel.html"],
+ \["MidiDevice", "javax/sound/midi/MidiDevice.html"],
+ \["MidiDevice.Info", "javax/sound/midi/MidiDevice.Info.html"],
+ \["MidiDeviceProvider", "javax/sound/midi/spi/MidiDeviceProvider.html"],
+ \["MidiEvent", "javax/sound/midi/MidiEvent.html"],
+ \["MidiFileFormat", "javax/sound/midi/MidiFileFormat.html"],
+ \["MidiFileReader", "javax/sound/midi/spi/MidiFileReader.html"],
+ \["MidiFileWriter", "javax/sound/midi/spi/MidiFileWriter.html"],
+ \["MidiMessage", "javax/sound/midi/MidiMessage.html"],
+ \["MidiSystem", "javax/sound/midi/MidiSystem.html"],
+ \["MidiUnavailableException", "javax/sound/midi/MidiUnavailableException.html"],
+ \["MimeHeader", "javax/xml/soap/MimeHeader.html"],
+ \["MimeHeaders", "javax/xml/soap/MimeHeaders.html"],
+ \["MimeType", "javax/activation/MimeType.html"],
+ \["MimeTypeParameterList", "javax/activation/MimeTypeParameterList.html"],
+ \["MimeTypeParseException", "java/awt/datatransfer/MimeTypeParseException.html"],
+ \["MimeTypeParseException", "javax/activation/MimeTypeParseException.html"],
+ \["MimetypesFileTypeMap", "javax/activation/MimetypesFileTypeMap.html"],
+ \["MinimalHTMLWriter", "javax/swing/text/html/MinimalHTMLWriter.html"],
+ \["MirroredTypeException", "javax/lang/model/type/MirroredTypeException.html"],
+ \["MirroredTypesException", "javax/lang/model/type/MirroredTypesException.html"],
+ \["MissingFormatArgumentException", "java/util/MissingFormatArgumentException.html"],
+ \["MissingFormatWidthException", "java/util/MissingFormatWidthException.html"],
+ \["MissingResourceException", "java/util/MissingResourceException.html"],
+ \["Mixer", "javax/sound/sampled/Mixer.html"],
+ \["Mixer.Info", "javax/sound/sampled/Mixer.Info.html"],
+ \["MixerProvider", "javax/sound/sampled/spi/MixerProvider.html"],
+ \["MLet", "javax/management/loading/MLet.html"],
+ \["MLetContent", "javax/management/loading/MLetContent.html"],
+ \["MLetMBean", "javax/management/loading/MLetMBean.html"],
+ \["ModelMBean", "javax/management/modelmbean/ModelMBean.html"],
+ \["ModelMBeanAttributeInfo", "javax/management/modelmbean/ModelMBeanAttributeInfo.html"],
+ \["ModelMBeanConstructorInfo", "javax/management/modelmbean/ModelMBeanConstructorInfo.html"],
+ \["ModelMBeanInfo", "javax/management/modelmbean/ModelMBeanInfo.html"],
+ \["ModelMBeanInfoSupport", "javax/management/modelmbean/ModelMBeanInfoSupport.html"],
+ \["ModelMBeanNotificationBroadcaster", "javax/management/modelmbean/ModelMBeanNotificationBroadcaster.html"],
+ \["ModelMBeanNotificationInfo", "javax/management/modelmbean/ModelMBeanNotificationInfo.html"],
+ \["ModelMBeanOperationInfo", "javax/management/modelmbean/ModelMBeanOperationInfo.html"],
+ \["ModificationItem", "javax/naming/directory/ModificationItem.html"],
+ \["Modifier", "java/lang/reflect/Modifier.html"],
+ \["Modifier", "javax/lang/model/element/Modifier.html"],
+ \["Monitor", "javax/management/monitor/Monitor.html"],
+ \["MonitorInfo", "java/lang/management/MonitorInfo.html"],
+ \["MonitorMBean", "javax/management/monitor/MonitorMBean.html"],
+ \["MonitorNotification", "javax/management/monitor/MonitorNotification.html"],
+ \["MonitorSettingException", "javax/management/monitor/MonitorSettingException.html"],
+ \["MouseAdapter", "java/awt/event/MouseAdapter.html"],
+ \["MouseDragGestureRecognizer", "java/awt/dnd/MouseDragGestureRecognizer.html"],
+ \["MouseEvent", "java/awt/event/MouseEvent.html"],
+ \["MouseEvent", "org/w3c/dom/events/MouseEvent.html"],
+ \["MouseInfo", "java/awt/MouseInfo.html"],
+ \["MouseInputAdapter", "javax/swing/event/MouseInputAdapter.html"],
+ \["MouseInputListener", "javax/swing/event/MouseInputListener.html"],
+ \["MouseListener", "java/awt/event/MouseListener.html"],
+ \["MouseMotionAdapter", "java/awt/event/MouseMotionAdapter.html"],
+ \["MouseMotionListener", "java/awt/event/MouseMotionListener.html"],
+ \["MouseWheelEvent", "java/awt/event/MouseWheelEvent.html"],
+ \["MouseWheelListener", "java/awt/event/MouseWheelListener.html"],
+ \["MTOM", "javax/xml/ws/soap/MTOM.html"],
+ \["MTOMFeature", "javax/xml/ws/soap/MTOMFeature.html"],
+ \["MultiButtonUI", "javax/swing/plaf/multi/MultiButtonUI.html"],
+ \["MulticastSocket", "java/net/MulticastSocket.html"],
+ \["MultiColorChooserUI", "javax/swing/plaf/multi/MultiColorChooserUI.html"],
+ \["MultiComboBoxUI", "javax/swing/plaf/multi/MultiComboBoxUI.html"],
+ \["MultiDesktopIconUI", "javax/swing/plaf/multi/MultiDesktopIconUI.html"],
+ \["MultiDesktopPaneUI", "javax/swing/plaf/multi/MultiDesktopPaneUI.html"],
+ \["MultiDoc", "javax/print/MultiDoc.html"],
+ \["MultiDocPrintJob", "javax/print/MultiDocPrintJob.html"],
+ \["MultiDocPrintService", "javax/print/MultiDocPrintService.html"],
+ \["MultiFileChooserUI", "javax/swing/plaf/multi/MultiFileChooserUI.html"],
+ \["MultiInternalFrameUI", "javax/swing/plaf/multi/MultiInternalFrameUI.html"],
+ \["MultiLabelUI", "javax/swing/plaf/multi/MultiLabelUI.html"],
+ \["MultiListUI", "javax/swing/plaf/multi/MultiListUI.html"],
+ \["MultiLookAndFeel", "javax/swing/plaf/multi/MultiLookAndFeel.html"],
+ \["MultiMenuBarUI", "javax/swing/plaf/multi/MultiMenuBarUI.html"],
+ \["MultiMenuItemUI", "javax/swing/plaf/multi/MultiMenuItemUI.html"],
+ \["MultiOptionPaneUI", "javax/swing/plaf/multi/MultiOptionPaneUI.html"],
+ \["MultiPanelUI", "javax/swing/plaf/multi/MultiPanelUI.html"],
+ \["MultiPixelPackedSampleModel", "java/awt/image/MultiPixelPackedSampleModel.html"],
+ \["MultipleComponentProfileHelper", "org/omg/IOP/MultipleComponentProfileHelper.html"],
+ \["MultipleComponentProfileHolder", "org/omg/IOP/MultipleComponentProfileHolder.html"],
+ \["MultipleDocumentHandling", "javax/print/attribute/standard/MultipleDocumentHandling.html"],
+ \["MultipleGradientPaint", "java/awt/MultipleGradientPaint.html"],
+ \["MultipleGradientPaint.ColorSpaceType", "java/awt/MultipleGradientPaint.ColorSpaceType.html"],
+ \["MultipleGradientPaint.CycleMethod", "java/awt/MultipleGradientPaint.CycleMethod.html"],
+ \["MultipleMaster", "java/awt/font/MultipleMaster.html"],
+ \["MultiPopupMenuUI", "javax/swing/plaf/multi/MultiPopupMenuUI.html"],
+ \["MultiProgressBarUI", "javax/swing/plaf/multi/MultiProgressBarUI.html"],
+ \["MultiRootPaneUI", "javax/swing/plaf/multi/MultiRootPaneUI.html"],
+ \["MultiScrollBarUI", "javax/swing/plaf/multi/MultiScrollBarUI.html"],
+ \["MultiScrollPaneUI", "javax/swing/plaf/multi/MultiScrollPaneUI.html"],
+ \["MultiSeparatorUI", "javax/swing/plaf/multi/MultiSeparatorUI.html"],
+ \["MultiSliderUI", "javax/swing/plaf/multi/MultiSliderUI.html"],
+ \["MultiSpinnerUI", "javax/swing/plaf/multi/MultiSpinnerUI.html"],
+ \["MultiSplitPaneUI", "javax/swing/plaf/multi/MultiSplitPaneUI.html"],
+ \["MultiTabbedPaneUI", "javax/swing/plaf/multi/MultiTabbedPaneUI.html"],
+ \["MultiTableHeaderUI", "javax/swing/plaf/multi/MultiTableHeaderUI.html"],
+ \["MultiTableUI", "javax/swing/plaf/multi/MultiTableUI.html"],
+ \["MultiTextUI", "javax/swing/plaf/multi/MultiTextUI.html"],
+ \["MultiToolBarUI", "javax/swing/plaf/multi/MultiToolBarUI.html"],
+ \["MultiToolTipUI", "javax/swing/plaf/multi/MultiToolTipUI.html"],
+ \["MultiTreeUI", "javax/swing/plaf/multi/MultiTreeUI.html"],
+ \["MultiViewportUI", "javax/swing/plaf/multi/MultiViewportUI.html"],
+ \["MutableAttributeSet", "javax/swing/text/MutableAttributeSet.html"],
+ \["MutableComboBoxModel", "javax/swing/MutableComboBoxModel.html"],
+ \["MutableTreeNode", "javax/swing/tree/MutableTreeNode.html"],
+ \["MutationEvent", "org/w3c/dom/events/MutationEvent.html"],
+ \["MXBean", "javax/management/MXBean.html"],
+ \["Name", "javax/lang/model/element/Name.html"],
+ \["Name", "javax/naming/Name.html"],
+ \["Name", "javax/xml/soap/Name.html"],
+ \["NameAlreadyBoundException", "javax/naming/NameAlreadyBoundException.html"],
+ \["NameCallback", "javax/security/auth/callback/NameCallback.html"],
+ \["NameClassPair", "javax/naming/NameClassPair.html"],
+ \["NameComponent", "org/omg/CosNaming/NameComponent.html"],
+ \["NameComponentHelper", "org/omg/CosNaming/NameComponentHelper.html"],
+ \["NameComponentHolder", "org/omg/CosNaming/NameComponentHolder.html"],
+ \["NamedNodeMap", "org/w3c/dom/NamedNodeMap.html"],
+ \["NamedValue", "org/omg/CORBA/NamedValue.html"],
+ \["NameDynAnyPair", "org/omg/DynamicAny/NameDynAnyPair.html"],
+ \["NameDynAnyPairHelper", "org/omg/DynamicAny/NameDynAnyPairHelper.html"],
+ \["NameDynAnyPairSeqHelper", "org/omg/DynamicAny/NameDynAnyPairSeqHelper.html"],
+ \["NameHelper", "org/omg/CosNaming/NameHelper.html"],
+ \["NameHolder", "org/omg/CosNaming/NameHolder.html"],
+ \["NameList", "org/w3c/dom/NameList.html"],
+ \["NameNotFoundException", "javax/naming/NameNotFoundException.html"],
+ \["NameParser", "javax/naming/NameParser.html"],
+ \["Namespace", "javax/xml/stream/events/Namespace.html"],
+ \["NamespaceChangeListener", "javax/naming/event/NamespaceChangeListener.html"],
+ \["NamespaceContext", "javax/xml/namespace/NamespaceContext.html"],
+ \["NamespaceSupport", "org/xml/sax/helpers/NamespaceSupport.html"],
+ \["NameValuePair", "org/omg/CORBA/NameValuePair.html"],
+ \["NameValuePair", "org/omg/DynamicAny/NameValuePair.html"],
+ \["NameValuePairHelper", "org/omg/CORBA/NameValuePairHelper.html"],
+ \["NameValuePairHelper", "org/omg/DynamicAny/NameValuePairHelper.html"],
+ \["NameValuePairSeqHelper", "org/omg/DynamicAny/NameValuePairSeqHelper.html"],
+ \["Naming", "java/rmi/Naming.html"],
+ \["NamingContext", "org/omg/CosNaming/NamingContext.html"],
+ \["NamingContextExt", "org/omg/CosNaming/NamingContextExt.html"],
+ \["NamingContextExtHelper", "org/omg/CosNaming/NamingContextExtHelper.html"],
+ \["NamingContextExtHolder", "org/omg/CosNaming/NamingContextExtHolder.html"],
+ \["NamingContextExtOperations", "org/omg/CosNaming/NamingContextExtOperations.html"],
+ \["NamingContextExtPOA", "org/omg/CosNaming/NamingContextExtPOA.html"],
+ \["NamingContextHelper", "org/omg/CosNaming/NamingContextHelper.html"],
+ \["NamingContextHolder", "org/omg/CosNaming/NamingContextHolder.html"],
+ \["NamingContextOperations", "org/omg/CosNaming/NamingContextOperations.html"],
+ \["NamingContextPOA", "org/omg/CosNaming/NamingContextPOA.html"],
+ \["NamingEnumeration", "javax/naming/NamingEnumeration.html"],
+ \["NamingEvent", "javax/naming/event/NamingEvent.html"],
+ \["NamingException", "javax/naming/NamingException.html"],
+ \["NamingExceptionEvent", "javax/naming/event/NamingExceptionEvent.html"],
+ \["NamingListener", "javax/naming/event/NamingListener.html"],
+ \["NamingManager", "javax/naming/spi/NamingManager.html"],
+ \["NamingSecurityException", "javax/naming/NamingSecurityException.html"],
+ \["NavigableMap", "java/util/NavigableMap.html"],
+ \["NavigableSet", "java/util/NavigableSet.html"],
+ \["NavigationFilter", "javax/swing/text/NavigationFilter.html"],
+ \["NavigationFilter.FilterBypass", "javax/swing/text/NavigationFilter.FilterBypass.html"],
+ \["NClob", "java/sql/NClob.html"],
+ \["NegativeArraySizeException", "java/lang/NegativeArraySizeException.html"],
+ \["NestingKind", "javax/lang/model/element/NestingKind.html"],
+ \["NetPermission", "java/net/NetPermission.html"],
+ \["NetworkInterface", "java/net/NetworkInterface.html"],
+ \["NO_IMPLEMENT", "org/omg/CORBA/NO_IMPLEMENT.html"],
+ \["NO_MEMORY", "org/omg/CORBA/NO_MEMORY.html"],
+ \["NO_PERMISSION", "org/omg/CORBA/NO_PERMISSION.html"],
+ \["NO_RESOURCES", "org/omg/CORBA/NO_RESOURCES.html"],
+ \["NO_RESPONSE", "org/omg/CORBA/NO_RESPONSE.html"],
+ \["NoClassDefFoundError", "java/lang/NoClassDefFoundError.html"],
+ \["NoConnectionPendingException", "java/nio/channels/NoConnectionPendingException.html"],
+ \["NoContext", "org/omg/PortableServer/CurrentPackage/NoContext.html"],
+ \["NoContextHelper", "org/omg/PortableServer/CurrentPackage/NoContextHelper.html"],
+ \["Node", "javax/xml/soap/Node.html"],
+ \["Node", "org/w3c/dom/Node.html"],
+ \["NodeChangeEvent", "java/util/prefs/NodeChangeEvent.html"],
+ \["NodeChangeListener", "java/util/prefs/NodeChangeListener.html"],
+ \["NodeList", "org/w3c/dom/NodeList.html"],
+ \["NodeSetData", "javax/xml/crypto/NodeSetData.html"],
+ \["NoInitialContextException", "javax/naming/NoInitialContextException.html"],
+ \["NON_EXISTENT", "org/omg/PortableInterceptor/NON_EXISTENT.html"],
+ \["NoninvertibleTransformException", "java/awt/geom/NoninvertibleTransformException.html"],
+ \["NonReadableChannelException", "java/nio/channels/NonReadableChannelException.html"],
+ \["NonWritableChannelException", "java/nio/channels/NonWritableChannelException.html"],
+ \["NoPermissionException", "javax/naming/NoPermissionException.html"],
+ \["NormalizedStringAdapter", "javax/xml/bind/annotation/adapters/NormalizedStringAdapter.html"],
+ \["Normalizer", "java/text/Normalizer.html"],
+ \["Normalizer.Form", "java/text/Normalizer.Form.html"],
+ \["NoRouteToHostException", "java/net/NoRouteToHostException.html"],
+ \["NoServant", "org/omg/PortableServer/POAPackage/NoServant.html"],
+ \["NoServantHelper", "org/omg/PortableServer/POAPackage/NoServantHelper.html"],
+ \["NoSuchAlgorithmException", "java/security/NoSuchAlgorithmException.html"],
+ \["NoSuchAttributeException", "javax/naming/directory/NoSuchAttributeException.html"],
+ \["NoSuchElementException", "java/util/NoSuchElementException.html"],
+ \["NoSuchFieldError", "java/lang/NoSuchFieldError.html"],
+ \["NoSuchFieldException", "java/lang/NoSuchFieldException.html"],
+ \["NoSuchMechanismException", "javax/xml/crypto/NoSuchMechanismException.html"],
+ \["NoSuchMethodError", "java/lang/NoSuchMethodError.html"],
+ \["NoSuchMethodException", "java/lang/NoSuchMethodException.html"],
+ \["NoSuchObjectException", "java/rmi/NoSuchObjectException.html"],
+ \["NoSuchPaddingException", "javax/crypto/NoSuchPaddingException.html"],
+ \["NoSuchProviderException", "java/security/NoSuchProviderException.html"],
+ \["NotActiveException", "java/io/NotActiveException.html"],
+ \["Notation", "org/w3c/dom/Notation.html"],
+ \["NotationDeclaration", "javax/xml/stream/events/NotationDeclaration.html"],
+ \["NotBoundException", "java/rmi/NotBoundException.html"],
+ \["NotCompliantMBeanException", "javax/management/NotCompliantMBeanException.html"],
+ \["NotContextException", "javax/naming/NotContextException.html"],
+ \["NotEmpty", "org/omg/CosNaming/NamingContextPackage/NotEmpty.html"],
+ \["NotEmptyHelper", "org/omg/CosNaming/NamingContextPackage/NotEmptyHelper.html"],
+ \["NotEmptyHolder", "org/omg/CosNaming/NamingContextPackage/NotEmptyHolder.html"],
+ \["NotFound", "org/omg/CosNaming/NamingContextPackage/NotFound.html"],
+ \["NotFoundHelper", "org/omg/CosNaming/NamingContextPackage/NotFoundHelper.html"],
+ \["NotFoundHolder", "org/omg/CosNaming/NamingContextPackage/NotFoundHolder.html"],
+ \["NotFoundReason", "org/omg/CosNaming/NamingContextPackage/NotFoundReason.html"],
+ \["NotFoundReasonHelper", "org/omg/CosNaming/NamingContextPackage/NotFoundReasonHelper.html"],
+ \["NotFoundReasonHolder", "org/omg/CosNaming/NamingContextPackage/NotFoundReasonHolder.html"],
+ \["NotIdentifiableEvent", "javax/xml/bind/NotIdentifiableEvent.html"],
+ \["NotIdentifiableEventImpl", "javax/xml/bind/helpers/NotIdentifiableEventImpl.html"],
+ \["Notification", "javax/management/Notification.html"],
+ \["NotificationBroadcaster", "javax/management/NotificationBroadcaster.html"],
+ \["NotificationBroadcasterSupport", "javax/management/NotificationBroadcasterSupport.html"],
+ \["NotificationEmitter", "javax/management/NotificationEmitter.html"],
+ \["NotificationFilter", "javax/management/NotificationFilter.html"],
+ \["NotificationFilterSupport", "javax/management/NotificationFilterSupport.html"],
+ \["NotificationListener", "javax/management/NotificationListener.html"],
+ \["NotificationResult", "javax/management/remote/NotificationResult.html"],
+ \["NotOwnerException", "java/security/acl/NotOwnerException.html"],
+ \["NotSerializableException", "java/io/NotSerializableException.html"],
+ \["NotYetBoundException", "java/nio/channels/NotYetBoundException.html"],
+ \["NotYetConnectedException", "java/nio/channels/NotYetConnectedException.html"],
+ \["NoType", "javax/lang/model/type/NoType.html"],
+ \["NullCipher", "javax/crypto/NullCipher.html"],
+ \["NullPointerException", "java/lang/NullPointerException.html"],
+ \["NullType", "javax/lang/model/type/NullType.html"],
+ \["Number", "java/lang/Number.html"],
+ \["NumberFormat", "java/text/NumberFormat.html"],
+ \["NumberFormat.Field", "java/text/NumberFormat.Field.html"],
+ \["NumberFormatException", "java/lang/NumberFormatException.html"],
+ \["NumberFormatProvider", "java/text/spi/NumberFormatProvider.html"],
+ \["NumberFormatter", "javax/swing/text/NumberFormatter.html"],
+ \["NumberOfDocuments", "javax/print/attribute/standard/NumberOfDocuments.html"],
+ \["NumberOfInterveningJobs", "javax/print/attribute/standard/NumberOfInterveningJobs.html"],
+ \["NumberUp", "javax/print/attribute/standard/NumberUp.html"],
+ \["NumberUpSupported", "javax/print/attribute/standard/NumberUpSupported.html"],
+ \["NumericShaper", "java/awt/font/NumericShaper.html"],
+ \["NVList", "org/omg/CORBA/NVList.html"],
+ \["OAEPParameterSpec", "javax/crypto/spec/OAEPParameterSpec.html"],
+ \["OBJ_ADAPTER", "org/omg/CORBA/OBJ_ADAPTER.html"],
+ \["Object", "java/lang/Object.html"],
+ \["Object", "org/omg/CORBA/Object.html"],
+ \["OBJECT_NOT_EXIST", "org/omg/CORBA/OBJECT_NOT_EXIST.html"],
+ \["ObjectAlreadyActive", "org/omg/PortableServer/POAPackage/ObjectAlreadyActive.html"],
+ \["ObjectAlreadyActiveHelper", "org/omg/PortableServer/POAPackage/ObjectAlreadyActiveHelper.html"],
+ \["ObjectChangeListener", "javax/naming/event/ObjectChangeListener.html"],
+ \["ObjectFactory", "javax/naming/spi/ObjectFactory.html"],
+ \["ObjectFactoryBuilder", "javax/naming/spi/ObjectFactoryBuilder.html"],
+ \["ObjectHelper", "org/omg/CORBA/ObjectHelper.html"],
+ \["ObjectHolder", "org/omg/CORBA/ObjectHolder.html"],
+ \["ObjectIdHelper", "org/omg/PortableInterceptor/ObjectIdHelper.html"],
+ \["ObjectIdHelper", "org/omg/PortableInterceptor/ORBInitInfoPackage/ObjectIdHelper.html"],
+ \["ObjectImpl", "org/omg/CORBA/portable/ObjectImpl.html"],
+ \["ObjectImpl", "org/omg/CORBA_2_3/portable/ObjectImpl.html"],
+ \["ObjectInput", "java/io/ObjectInput.html"],
+ \["ObjectInputStream", "java/io/ObjectInputStream.html"],
+ \["ObjectInputStream.GetField", "java/io/ObjectInputStream.GetField.html"],
+ \["ObjectInputValidation", "java/io/ObjectInputValidation.html"],
+ \["ObjectInstance", "javax/management/ObjectInstance.html"],
+ \["ObjectName", "javax/management/ObjectName.html"],
+ \["ObjectNotActive", "org/omg/PortableServer/POAPackage/ObjectNotActive.html"],
+ \["ObjectNotActiveHelper", "org/omg/PortableServer/POAPackage/ObjectNotActiveHelper.html"],
+ \["ObjectOutput", "java/io/ObjectOutput.html"],
+ \["ObjectOutputStream", "java/io/ObjectOutputStream.html"],
+ \["ObjectOutputStream.PutField", "java/io/ObjectOutputStream.PutField.html"],
+ \["ObjectReferenceFactory", "org/omg/PortableInterceptor/ObjectReferenceFactory.html"],
+ \["ObjectReferenceFactoryHelper", "org/omg/PortableInterceptor/ObjectReferenceFactoryHelper.html"],
+ \["ObjectReferenceFactoryHolder", "org/omg/PortableInterceptor/ObjectReferenceFactoryHolder.html"],
+ \["ObjectReferenceTemplate", "org/omg/PortableInterceptor/ObjectReferenceTemplate.html"],
+ \["ObjectReferenceTemplateHelper", "org/omg/PortableInterceptor/ObjectReferenceTemplateHelper.html"],
+ \["ObjectReferenceTemplateHolder", "org/omg/PortableInterceptor/ObjectReferenceTemplateHolder.html"],
+ \["ObjectReferenceTemplateSeqHelper", "org/omg/PortableInterceptor/ObjectReferenceTemplateSeqHelper.html"],
+ \["ObjectReferenceTemplateSeqHolder", "org/omg/PortableInterceptor/ObjectReferenceTemplateSeqHolder.html"],
+ \["ObjectStreamClass", "java/io/ObjectStreamClass.html"],
+ \["ObjectStreamConstants", "java/io/ObjectStreamConstants.html"],
+ \["ObjectStreamException", "java/io/ObjectStreamException.html"],
+ \["ObjectStreamField", "java/io/ObjectStreamField.html"],
+ \["ObjectView", "javax/swing/text/html/ObjectView.html"],
+ \["ObjID", "java/rmi/server/ObjID.html"],
+ \["Observable", "java/util/Observable.html"],
+ \["Observer", "java/util/Observer.html"],
+ \["OceanTheme", "javax/swing/plaf/metal/OceanTheme.html"],
+ \["OctetSeqHelper", "org/omg/CORBA/OctetSeqHelper.html"],
+ \["OctetSeqHolder", "org/omg/CORBA/OctetSeqHolder.html"],
+ \["OctetStreamData", "javax/xml/crypto/OctetStreamData.html"],
+ \["Oid", "org/ietf/jgss/Oid.html"],
+ \["OMGVMCID", "org/omg/CORBA/OMGVMCID.html"],
+ \["Oneway", "javax/jws/Oneway.html"],
+ \["OpenDataException", "javax/management/openmbean/OpenDataException.html"],
+ \["OpenMBeanAttributeInfo", "javax/management/openmbean/OpenMBeanAttributeInfo.html"],
+ \["OpenMBeanAttributeInfoSupport", "javax/management/openmbean/OpenMBeanAttributeInfoSupport.html"],
+ \["OpenMBeanConstructorInfo", "javax/management/openmbean/OpenMBeanConstructorInfo.html"],
+ \["OpenMBeanConstructorInfoSupport", "javax/management/openmbean/OpenMBeanConstructorInfoSupport.html"],
+ \["OpenMBeanInfo", "javax/management/openmbean/OpenMBeanInfo.html"],
+ \["OpenMBeanInfoSupport", "javax/management/openmbean/OpenMBeanInfoSupport.html"],
+ \["OpenMBeanOperationInfo", "javax/management/openmbean/OpenMBeanOperationInfo.html"],
+ \["OpenMBeanOperationInfoSupport", "javax/management/openmbean/OpenMBeanOperationInfoSupport.html"],
+ \["OpenMBeanParameterInfo", "javax/management/openmbean/OpenMBeanParameterInfo.html"],
+ \["OpenMBeanParameterInfoSupport", "javax/management/openmbean/OpenMBeanParameterInfoSupport.html"],
+ \["OpenType", "java/awt/font/OpenType.html"],
+ \["OpenType", "javax/management/openmbean/OpenType.html"],
+ \["OperatingSystemMXBean", "java/lang/management/OperatingSystemMXBean.html"],
+ \["Operation", "java/rmi/server/Operation.html"],
+ \["OperationNotSupportedException", "javax/naming/OperationNotSupportedException.html"],
+ \["OperationsException", "javax/management/OperationsException.html"],
+ \["Option", "javax/swing/text/html/Option.html"],
+ \["OptionalDataException", "java/io/OptionalDataException.html"],
+ \["OptionChecker", "javax/tools/OptionChecker.html"],
+ \["OptionPaneUI", "javax/swing/plaf/OptionPaneUI.html"],
+ \["ORB", "org/omg/CORBA/ORB.html"],
+ \["ORB", "org/omg/CORBA_2_3/ORB.html"],
+ \["ORBIdHelper", "org/omg/PortableInterceptor/ORBIdHelper.html"],
+ \["ORBInitializer", "org/omg/PortableInterceptor/ORBInitializer.html"],
+ \["ORBInitializerOperations", "org/omg/PortableInterceptor/ORBInitializerOperations.html"],
+ \["ORBInitInfo", "org/omg/PortableInterceptor/ORBInitInfo.html"],
+ \["ORBInitInfoOperations", "org/omg/PortableInterceptor/ORBInitInfoOperations.html"],
+ \["OrientationRequested", "javax/print/attribute/standard/OrientationRequested.html"],
+ \["OutOfMemoryError", "java/lang/OutOfMemoryError.html"],
+ \["OutputDeviceAssigned", "javax/print/attribute/standard/OutputDeviceAssigned.html"],
+ \["OutputKeys", "javax/xml/transform/OutputKeys.html"],
+ \["OutputStream", "java/io/OutputStream.html"],
+ \["OutputStream", "org/omg/CORBA/portable/OutputStream.html"],
+ \["OutputStream", "org/omg/CORBA_2_3/portable/OutputStream.html"],
+ \["OutputStreamWriter", "java/io/OutputStreamWriter.html"],
+ \["OverlappingFileLockException", "java/nio/channels/OverlappingFileLockException.html"],
+ \["OverlayLayout", "javax/swing/OverlayLayout.html"],
+ \["Override", "java/lang/Override.html"],
+ \["Owner", "java/security/acl/Owner.html"],
+ \["Pack200", "java/util/jar/Pack200.html"],
+ \["Pack200.Packer", "java/util/jar/Pack200.Packer.html"],
+ \["Pack200.Unpacker", "java/util/jar/Pack200.Unpacker.html"],
+ \["Package", "java/lang/Package.html"],
+ \["PackageElement", "javax/lang/model/element/PackageElement.html"],
+ \["PackedColorModel", "java/awt/image/PackedColorModel.html"],
+ \["Pageable", "java/awt/print/Pageable.html"],
+ \["PageAttributes", "java/awt/PageAttributes.html"],
+ \["PageAttributes.ColorType", "java/awt/PageAttributes.ColorType.html"],
+ \["PageAttributes.MediaType", "java/awt/PageAttributes.MediaType.html"],
+ \["PageAttributes.OrientationRequestedType", "java/awt/PageAttributes.OrientationRequestedType.html"],
+ \["PageAttributes.OriginType", "java/awt/PageAttributes.OriginType.html"],
+ \["PageAttributes.PrintQualityType", "java/awt/PageAttributes.PrintQualityType.html"],
+ \["PagedResultsControl", "javax/naming/ldap/PagedResultsControl.html"],
+ \["PagedResultsResponseControl", "javax/naming/ldap/PagedResultsResponseControl.html"],
+ \["PageFormat", "java/awt/print/PageFormat.html"],
+ \["PageRanges", "javax/print/attribute/standard/PageRanges.html"],
+ \["PagesPerMinute", "javax/print/attribute/standard/PagesPerMinute.html"],
+ \["PagesPerMinuteColor", "javax/print/attribute/standard/PagesPerMinuteColor.html"],
+ \["Paint", "java/awt/Paint.html"],
+ \["PaintContext", "java/awt/PaintContext.html"],
+ \["PaintEvent", "java/awt/event/PaintEvent.html"],
+ \["Panel", "java/awt/Panel.html"],
+ \["PanelUI", "javax/swing/plaf/PanelUI.html"],
+ \["Paper", "java/awt/print/Paper.html"],
+ \["ParagraphView", "javax/swing/text/html/ParagraphView.html"],
+ \["ParagraphView", "javax/swing/text/ParagraphView.html"],
+ \["Parameter", "org/omg/Dynamic/Parameter.html"],
+ \["ParameterBlock", "java/awt/image/renderable/ParameterBlock.html"],
+ \["ParameterDescriptor", "java/beans/ParameterDescriptor.html"],
+ \["ParameterizedType", "java/lang/reflect/ParameterizedType.html"],
+ \["ParameterMetaData", "java/sql/ParameterMetaData.html"],
+ \["ParameterMode", "org/omg/CORBA/ParameterMode.html"],
+ \["ParameterModeHelper", "org/omg/CORBA/ParameterModeHelper.html"],
+ \["ParameterModeHolder", "org/omg/CORBA/ParameterModeHolder.html"],
+ \["ParseConversionEvent", "javax/xml/bind/ParseConversionEvent.html"],
+ \["ParseConversionEventImpl", "javax/xml/bind/helpers/ParseConversionEventImpl.html"],
+ \["ParseException", "java/text/ParseException.html"],
+ \["ParsePosition", "java/text/ParsePosition.html"],
+ \["Parser", "javax/swing/text/html/parser/Parser.html"],
+ \["Parser", "org/xml/sax/Parser.html"],
+ \["ParserAdapter", "org/xml/sax/helpers/ParserAdapter.html"],
+ \["ParserConfigurationException", "javax/xml/parsers/ParserConfigurationException.html"],
+ \["ParserDelegator", "javax/swing/text/html/parser/ParserDelegator.html"],
+ \["ParserFactory", "org/xml/sax/helpers/ParserFactory.html"],
+ \["PartialResultException", "javax/naming/PartialResultException.html"],
+ \["PasswordAuthentication", "java/net/PasswordAuthentication.html"],
+ \["PasswordCallback", "javax/security/auth/callback/PasswordCallback.html"],
+ \["PasswordView", "javax/swing/text/PasswordView.html"],
+ \["Patch", "javax/sound/midi/Patch.html"],
+ \["Path2D", "java/awt/geom/Path2D.html"],
+ \["Path2D.Double", "java/awt/geom/Path2D.Double.html"],
+ \["Path2D.Float", "java/awt/geom/Path2D.Float.html"],
+ \["PathIterator", "java/awt/geom/PathIterator.html"],
+ \["Pattern", "java/util/regex/Pattern.html"],
+ \["PatternSyntaxException", "java/util/regex/PatternSyntaxException.html"],
+ \["PBEKey", "javax/crypto/interfaces/PBEKey.html"],
+ \["PBEKeySpec", "javax/crypto/spec/PBEKeySpec.html"],
+ \["PBEParameterSpec", "javax/crypto/spec/PBEParameterSpec.html"],
+ \["PDLOverrideSupported", "javax/print/attribute/standard/PDLOverrideSupported.html"],
+ \["Permission", "java/security/acl/Permission.html"],
+ \["Permission", "java/security/Permission.html"],
+ \["PermissionCollection", "java/security/PermissionCollection.html"],
+ \["Permissions", "java/security/Permissions.html"],
+ \["PERSIST_STORE", "org/omg/CORBA/PERSIST_STORE.html"],
+ \["PersistenceDelegate", "java/beans/PersistenceDelegate.html"],
+ \["PersistentMBean", "javax/management/PersistentMBean.html"],
+ \["PGPData", "javax/xml/crypto/dsig/keyinfo/PGPData.html"],
+ \["PhantomReference", "java/lang/ref/PhantomReference.html"],
+ \["Pipe", "java/nio/channels/Pipe.html"],
+ \["Pipe.SinkChannel", "java/nio/channels/Pipe.SinkChannel.html"],
+ \["Pipe.SourceChannel", "java/nio/channels/Pipe.SourceChannel.html"],
+ \["PipedInputStream", "java/io/PipedInputStream.html"],
+ \["PipedOutputStream", "java/io/PipedOutputStream.html"],
+ \["PipedReader", "java/io/PipedReader.html"],
+ \["PipedWriter", "java/io/PipedWriter.html"],
+ \["PixelGrabber", "java/awt/image/PixelGrabber.html"],
+ \["PixelInterleavedSampleModel", "java/awt/image/PixelInterleavedSampleModel.html"],
+ \["PKCS8EncodedKeySpec", "java/security/spec/PKCS8EncodedKeySpec.html"],
+ \["PKIXBuilderParameters", "java/security/cert/PKIXBuilderParameters.html"],
+ \["PKIXCertPathBuilderResult", "java/security/cert/PKIXCertPathBuilderResult.html"],
+ \["PKIXCertPathChecker", "java/security/cert/PKIXCertPathChecker.html"],
+ \["PKIXCertPathValidatorResult", "java/security/cert/PKIXCertPathValidatorResult.html"],
+ \["PKIXParameters", "java/security/cert/PKIXParameters.html"],
+ \["PlainDocument", "javax/swing/text/PlainDocument.html"],
+ \["PlainView", "javax/swing/text/PlainView.html"],
+ \["POA", "org/omg/PortableServer/POA.html"],
+ \["POAHelper", "org/omg/PortableServer/POAHelper.html"],
+ \["POAManager", "org/omg/PortableServer/POAManager.html"],
+ \["POAManagerOperations", "org/omg/PortableServer/POAManagerOperations.html"],
+ \["POAOperations", "org/omg/PortableServer/POAOperations.html"],
+ \["Point", "java/awt/Point.html"],
+ \["Point2D", "java/awt/geom/Point2D.html"],
+ \["Point2D.Double", "java/awt/geom/Point2D.Double.html"],
+ \["Point2D.Float", "java/awt/geom/Point2D.Float.html"],
+ \["PointerInfo", "java/awt/PointerInfo.html"],
+ \["Policy", "java/security/Policy.html"],
+ \["Policy", "javax/security/auth/Policy.html"],
+ \["Policy", "org/omg/CORBA/Policy.html"],
+ \["Policy.Parameters", "java/security/Policy.Parameters.html"],
+ \["PolicyError", "org/omg/CORBA/PolicyError.html"],
+ \["PolicyErrorCodeHelper", "org/omg/CORBA/PolicyErrorCodeHelper.html"],
+ \["PolicyErrorHelper", "org/omg/CORBA/PolicyErrorHelper.html"],
+ \["PolicyErrorHolder", "org/omg/CORBA/PolicyErrorHolder.html"],
+ \["PolicyFactory", "org/omg/PortableInterceptor/PolicyFactory.html"],
+ \["PolicyFactoryOperations", "org/omg/PortableInterceptor/PolicyFactoryOperations.html"],
+ \["PolicyHelper", "org/omg/CORBA/PolicyHelper.html"],
+ \["PolicyHolder", "org/omg/CORBA/PolicyHolder.html"],
+ \["PolicyListHelper", "org/omg/CORBA/PolicyListHelper.html"],
+ \["PolicyListHolder", "org/omg/CORBA/PolicyListHolder.html"],
+ \["PolicyNode", "java/security/cert/PolicyNode.html"],
+ \["PolicyOperations", "org/omg/CORBA/PolicyOperations.html"],
+ \["PolicyQualifierInfo", "java/security/cert/PolicyQualifierInfo.html"],
+ \["PolicySpi", "java/security/PolicySpi.html"],
+ \["PolicyTypeHelper", "org/omg/CORBA/PolicyTypeHelper.html"],
+ \["Polygon", "java/awt/Polygon.html"],
+ \["PooledConnection", "javax/sql/PooledConnection.html"],
+ \["Popup", "javax/swing/Popup.html"],
+ \["PopupFactory", "javax/swing/PopupFactory.html"],
+ \["PopupMenu", "java/awt/PopupMenu.html"],
+ \["PopupMenuEvent", "javax/swing/event/PopupMenuEvent.html"],
+ \["PopupMenuListener", "javax/swing/event/PopupMenuListener.html"],
+ \["PopupMenuUI", "javax/swing/plaf/PopupMenuUI.html"],
+ \["Port", "javax/sound/sampled/Port.html"],
+ \["Port.Info", "javax/sound/sampled/Port.Info.html"],
+ \["PortableRemoteObject", "javax/rmi/PortableRemoteObject.html"],
+ \["PortableRemoteObjectDelegate", "javax/rmi/CORBA/PortableRemoteObjectDelegate.html"],
+ \["PortInfo", "javax/xml/ws/handler/PortInfo.html"],
+ \["PortUnreachableException", "java/net/PortUnreachableException.html"],
+ \["Position", "javax/swing/text/Position.html"],
+ \["Position.Bias", "javax/swing/text/Position.Bias.html"],
+ \["PostConstruct", "javax/annotation/PostConstruct.html"],
+ \["PreDestroy", "javax/annotation/PreDestroy.html"],
+ \["Predicate", "javax/sql/rowset/Predicate.html"],
+ \["PreferenceChangeEvent", "java/util/prefs/PreferenceChangeEvent.html"],
+ \["PreferenceChangeListener", "java/util/prefs/PreferenceChangeListener.html"],
+ \["Preferences", "java/util/prefs/Preferences.html"],
+ \["PreferencesFactory", "java/util/prefs/PreferencesFactory.html"],
+ \["PreparedStatement", "java/sql/PreparedStatement.html"],
+ \["PresentationDirection", "javax/print/attribute/standard/PresentationDirection.html"],
+ \["PrimitiveType", "javax/lang/model/type/PrimitiveType.html"],
+ \["Principal", "java/security/Principal.html"],
+ \["Principal", "org/omg/CORBA/Principal.html"],
+ \["PrincipalHolder", "org/omg/CORBA/PrincipalHolder.html"],
+ \["Printable", "java/awt/print/Printable.html"],
+ \["PrintConversionEvent", "javax/xml/bind/PrintConversionEvent.html"],
+ \["PrintConversionEventImpl", "javax/xml/bind/helpers/PrintConversionEventImpl.html"],
+ \["PrinterAbortException", "java/awt/print/PrinterAbortException.html"],
+ \["PrinterException", "java/awt/print/PrinterException.html"],
+ \["PrinterGraphics", "java/awt/print/PrinterGraphics.html"],
+ \["PrinterInfo", "javax/print/attribute/standard/PrinterInfo.html"],
+ \["PrinterIOException", "java/awt/print/PrinterIOException.html"],
+ \["PrinterIsAcceptingJobs", "javax/print/attribute/standard/PrinterIsAcceptingJobs.html"],
+ \["PrinterJob", "java/awt/print/PrinterJob.html"],
+ \["PrinterLocation", "javax/print/attribute/standard/PrinterLocation.html"],
+ \["PrinterMakeAndModel", "javax/print/attribute/standard/PrinterMakeAndModel.html"],
+ \["PrinterMessageFromOperator", "javax/print/attribute/standard/PrinterMessageFromOperator.html"],
+ \["PrinterMoreInfo", "javax/print/attribute/standard/PrinterMoreInfo.html"],
+ \["PrinterMoreInfoManufacturer", "javax/print/attribute/standard/PrinterMoreInfoManufacturer.html"],
+ \["PrinterName", "javax/print/attribute/standard/PrinterName.html"],
+ \["PrinterResolution", "javax/print/attribute/standard/PrinterResolution.html"],
+ \["PrinterState", "javax/print/attribute/standard/PrinterState.html"],
+ \["PrinterStateReason", "javax/print/attribute/standard/PrinterStateReason.html"],
+ \["PrinterStateReasons", "javax/print/attribute/standard/PrinterStateReasons.html"],
+ \["PrinterURI", "javax/print/attribute/standard/PrinterURI.html"],
+ \["PrintEvent", "javax/print/event/PrintEvent.html"],
+ \["PrintException", "javax/print/PrintException.html"],
+ \["PrintGraphics", "java/awt/PrintGraphics.html"],
+ \["PrintJob", "java/awt/PrintJob.html"],
+ \["PrintJobAdapter", "javax/print/event/PrintJobAdapter.html"],
+ \["PrintJobAttribute", "javax/print/attribute/PrintJobAttribute.html"],
+ \["PrintJobAttributeEvent", "javax/print/event/PrintJobAttributeEvent.html"],
+ \["PrintJobAttributeListener", "javax/print/event/PrintJobAttributeListener.html"],
+ \["PrintJobAttributeSet", "javax/print/attribute/PrintJobAttributeSet.html"],
+ \["PrintJobEvent", "javax/print/event/PrintJobEvent.html"],
+ \["PrintJobListener", "javax/print/event/PrintJobListener.html"],
+ \["PrintQuality", "javax/print/attribute/standard/PrintQuality.html"],
+ \["PrintRequestAttribute", "javax/print/attribute/PrintRequestAttribute.html"],
+ \["PrintRequestAttributeSet", "javax/print/attribute/PrintRequestAttributeSet.html"],
+ \["PrintService", "javax/print/PrintService.html"],
+ \["PrintServiceAttribute", "javax/print/attribute/PrintServiceAttribute.html"],
+ \["PrintServiceAttributeEvent", "javax/print/event/PrintServiceAttributeEvent.html"],
+ \["PrintServiceAttributeListener", "javax/print/event/PrintServiceAttributeListener.html"],
+ \["PrintServiceAttributeSet", "javax/print/attribute/PrintServiceAttributeSet.html"],
+ \["PrintServiceLookup", "javax/print/PrintServiceLookup.html"],
+ \["PrintStream", "java/io/PrintStream.html"],
+ \["PrintWriter", "java/io/PrintWriter.html"],
+ \["PriorityBlockingQueue", "java/util/concurrent/PriorityBlockingQueue.html"],
+ \["PriorityQueue", "java/util/PriorityQueue.html"],
+ \["PRIVATE_MEMBER", "org/omg/CORBA/PRIVATE_MEMBER.html"],
+ \["PrivateClassLoader", "javax/management/loading/PrivateClassLoader.html"],
+ \["PrivateCredentialPermission", "javax/security/auth/PrivateCredentialPermission.html"],
+ \["PrivateKey", "java/security/PrivateKey.html"],
+ \["PrivateMLet", "javax/management/loading/PrivateMLet.html"],
+ \["PrivilegedAction", "java/security/PrivilegedAction.html"],
+ \["PrivilegedActionException", "java/security/PrivilegedActionException.html"],
+ \["PrivilegedExceptionAction", "java/security/PrivilegedExceptionAction.html"],
+ \["Process", "java/lang/Process.html"],
+ \["ProcessBuilder", "java/lang/ProcessBuilder.html"],
+ \["ProcessingEnvironment", "javax/annotation/processing/ProcessingEnvironment.html"],
+ \["ProcessingInstruction", "javax/xml/stream/events/ProcessingInstruction.html"],
+ \["ProcessingInstruction", "org/w3c/dom/ProcessingInstruction.html"],
+ \["Processor", "javax/annotation/processing/Processor.html"],
+ \["ProfileDataException", "java/awt/color/ProfileDataException.html"],
+ \["ProfileIdHelper", "org/omg/IOP/ProfileIdHelper.html"],
+ \["ProgressBarUI", "javax/swing/plaf/ProgressBarUI.html"],
+ \["ProgressMonitor", "javax/swing/ProgressMonitor.html"],
+ \["ProgressMonitorInputStream", "javax/swing/ProgressMonitorInputStream.html"],
+ \["Properties", "java/util/Properties.html"],
+ \["PropertyChangeEvent", "java/beans/PropertyChangeEvent.html"],
+ \["PropertyChangeListener", "java/beans/PropertyChangeListener.html"],
+ \["PropertyChangeListenerProxy", "java/beans/PropertyChangeListenerProxy.html"],
+ \["PropertyChangeSupport", "java/beans/PropertyChangeSupport.html"],
+ \["PropertyDescriptor", "java/beans/PropertyDescriptor.html"],
+ \["PropertyEditor", "java/beans/PropertyEditor.html"],
+ \["PropertyEditorManager", "java/beans/PropertyEditorManager.html"],
+ \["PropertyEditorSupport", "java/beans/PropertyEditorSupport.html"],
+ \["PropertyException", "javax/xml/bind/PropertyException.html"],
+ \["PropertyPermission", "java/util/PropertyPermission.html"],
+ \["PropertyResourceBundle", "java/util/PropertyResourceBundle.html"],
+ \["PropertyVetoException", "java/beans/PropertyVetoException.html"],
+ \["ProtectionDomain", "java/security/ProtectionDomain.html"],
+ \["ProtocolException", "java/net/ProtocolException.html"],
+ \["ProtocolException", "javax/xml/ws/ProtocolException.html"],
+ \["Provider", "java/security/Provider.html"],
+ \["Provider", "javax/xml/ws/Provider.html"],
+ \["Provider", "javax/xml/ws/spi/Provider.html"],
+ \["Provider.Service", "java/security/Provider.Service.html"],
+ \["ProviderException", "java/security/ProviderException.html"],
+ \["Proxy", "java/lang/reflect/Proxy.html"],
+ \["Proxy", "java/net/Proxy.html"],
+ \["Proxy.Type", "java/net/Proxy.Type.html"],
+ \["ProxySelector", "java/net/ProxySelector.html"],
+ \["PSource", "javax/crypto/spec/PSource.html"],
+ \["PSource.PSpecified", "javax/crypto/spec/PSource.PSpecified.html"],
+ \["PSSParameterSpec", "java/security/spec/PSSParameterSpec.html"],
+ \["PUBLIC_MEMBER", "org/omg/CORBA/PUBLIC_MEMBER.html"],
+ \["PublicKey", "java/security/PublicKey.html"],
+ \["PushbackInputStream", "java/io/PushbackInputStream.html"],
+ \["PushbackReader", "java/io/PushbackReader.html"],
+ \["QName", "javax/xml/namespace/QName.html"],
+ \["QuadCurve2D", "java/awt/geom/QuadCurve2D.html"],
+ \["QuadCurve2D.Double", "java/awt/geom/QuadCurve2D.Double.html"],
+ \["QuadCurve2D.Float", "java/awt/geom/QuadCurve2D.Float.html"],
+ \["Query", "javax/management/Query.html"],
+ \["QueryEval", "javax/management/QueryEval.html"],
+ \["QueryExp", "javax/management/QueryExp.html"],
+ \["Queue", "java/util/Queue.html"],
+ \["QueuedJobCount", "javax/print/attribute/standard/QueuedJobCount.html"],
+ \["RadialGradientPaint", "java/awt/RadialGradientPaint.html"],
+ \["Random", "java/util/Random.html"],
+ \["RandomAccess", "java/util/RandomAccess.html"],
+ \["RandomAccessFile", "java/io/RandomAccessFile.html"],
+ \["Raster", "java/awt/image/Raster.html"],
+ \["RasterFormatException", "java/awt/image/RasterFormatException.html"],
+ \["RasterOp", "java/awt/image/RasterOp.html"],
+ \["RC2ParameterSpec", "javax/crypto/spec/RC2ParameterSpec.html"],
+ \["RC5ParameterSpec", "javax/crypto/spec/RC5ParameterSpec.html"],
+ \["Rdn", "javax/naming/ldap/Rdn.html"],
+ \["Readable", "java/lang/Readable.html"],
+ \["ReadableByteChannel", "java/nio/channels/ReadableByteChannel.html"],
+ \["Reader", "java/io/Reader.html"],
+ \["ReadOnlyBufferException", "java/nio/ReadOnlyBufferException.html"],
+ \["ReadWriteLock", "java/util/concurrent/locks/ReadWriteLock.html"],
+ \["RealmCallback", "javax/security/sasl/RealmCallback.html"],
+ \["RealmChoiceCallback", "javax/security/sasl/RealmChoiceCallback.html"],
+ \["REBIND", "org/omg/CORBA/REBIND.html"],
+ \["Receiver", "javax/sound/midi/Receiver.html"],
+ \["Rectangle", "java/awt/Rectangle.html"],
+ \["Rectangle2D", "java/awt/geom/Rectangle2D.html"],
+ \["Rectangle2D.Double", "java/awt/geom/Rectangle2D.Double.html"],
+ \["Rectangle2D.Float", "java/awt/geom/Rectangle2D.Float.html"],
+ \["RectangularShape", "java/awt/geom/RectangularShape.html"],
+ \["ReentrantLock", "java/util/concurrent/locks/ReentrantLock.html"],
+ \["ReentrantReadWriteLock", "java/util/concurrent/locks/ReentrantReadWriteLock.html"],
+ \["ReentrantReadWriteLock.ReadLock", "java/util/concurrent/locks/ReentrantReadWriteLock.ReadLock.html"],
+ \["ReentrantReadWriteLock.WriteLock", "java/util/concurrent/locks/ReentrantReadWriteLock.WriteLock.html"],
+ \["Ref", "java/sql/Ref.html"],
+ \["RefAddr", "javax/naming/RefAddr.html"],
+ \["Reference", "java/lang/ref/Reference.html"],
+ \["Reference", "javax/naming/Reference.html"],
+ \["Reference", "javax/xml/crypto/dsig/Reference.html"],
+ \["Referenceable", "javax/naming/Referenceable.html"],
+ \["ReferenceQueue", "java/lang/ref/ReferenceQueue.html"],
+ \["ReferenceType", "javax/lang/model/type/ReferenceType.html"],
+ \["ReferenceUriSchemesSupported", "javax/print/attribute/standard/ReferenceUriSchemesSupported.html"],
+ \["ReferralException", "javax/naming/ReferralException.html"],
+ \["ReflectionException", "javax/management/ReflectionException.html"],
+ \["ReflectPermission", "java/lang/reflect/ReflectPermission.html"],
+ \["Refreshable", "javax/security/auth/Refreshable.html"],
+ \["RefreshFailedException", "javax/security/auth/RefreshFailedException.html"],
+ \["Region", "javax/swing/plaf/synth/Region.html"],
+ \["RegisterableService", "javax/imageio/spi/RegisterableService.html"],
+ \["Registry", "java/rmi/registry/Registry.html"],
+ \["RegistryHandler", "java/rmi/registry/RegistryHandler.html"],
+ \["RejectedExecutionException", "java/util/concurrent/RejectedExecutionException.html"],
+ \["RejectedExecutionHandler", "java/util/concurrent/RejectedExecutionHandler.html"],
+ \["Relation", "javax/management/relation/Relation.html"],
+ \["RelationException", "javax/management/relation/RelationException.html"],
+ \["RelationNotFoundException", "javax/management/relation/RelationNotFoundException.html"],
+ \["RelationNotification", "javax/management/relation/RelationNotification.html"],
+ \["RelationService", "javax/management/relation/RelationService.html"],
+ \["RelationServiceMBean", "javax/management/relation/RelationServiceMBean.html"],
+ \["RelationServiceNotRegisteredException", "javax/management/relation/RelationServiceNotRegisteredException.html"],
+ \["RelationSupport", "javax/management/relation/RelationSupport.html"],
+ \["RelationSupportMBean", "javax/management/relation/RelationSupportMBean.html"],
+ \["RelationType", "javax/management/relation/RelationType.html"],
+ \["RelationTypeNotFoundException", "javax/management/relation/RelationTypeNotFoundException.html"],
+ \["RelationTypeSupport", "javax/management/relation/RelationTypeSupport.html"],
+ \["RemarshalException", "org/omg/CORBA/portable/RemarshalException.html"],
+ \["Remote", "java/rmi/Remote.html"],
+ \["RemoteCall", "java/rmi/server/RemoteCall.html"],
+ \["RemoteException", "java/rmi/RemoteException.html"],
+ \["RemoteObject", "java/rmi/server/RemoteObject.html"],
+ \["RemoteObjectInvocationHandler", "java/rmi/server/RemoteObjectInvocationHandler.html"],
+ \["RemoteRef", "java/rmi/server/RemoteRef.html"],
+ \["RemoteServer", "java/rmi/server/RemoteServer.html"],
+ \["RemoteStub", "java/rmi/server/RemoteStub.html"],
+ \["RenderableImage", "java/awt/image/renderable/RenderableImage.html"],
+ \["RenderableImageOp", "java/awt/image/renderable/RenderableImageOp.html"],
+ \["RenderableImageProducer", "java/awt/image/renderable/RenderableImageProducer.html"],
+ \["RenderContext", "java/awt/image/renderable/RenderContext.html"],
+ \["RenderedImage", "java/awt/image/RenderedImage.html"],
+ \["RenderedImageFactory", "java/awt/image/renderable/RenderedImageFactory.html"],
+ \["Renderer", "javax/swing/Renderer.html"],
+ \["RenderingHints", "java/awt/RenderingHints.html"],
+ \["RenderingHints.Key", "java/awt/RenderingHints.Key.html"],
+ \["RepaintManager", "javax/swing/RepaintManager.html"],
+ \["ReplicateScaleFilter", "java/awt/image/ReplicateScaleFilter.html"],
+ \["RepositoryIdHelper", "org/omg/CORBA/RepositoryIdHelper.html"],
+ \["Request", "org/omg/CORBA/Request.html"],
+ \["REQUEST_PROCESSING_POLICY_ID", "org/omg/PortableServer/REQUEST_PROCESSING_POLICY_ID.html"],
+ \["RequestInfo", "org/omg/PortableInterceptor/RequestInfo.html"],
+ \["RequestInfoOperations", "org/omg/PortableInterceptor/RequestInfoOperations.html"],
+ \["RequestingUserName", "javax/print/attribute/standard/RequestingUserName.html"],
+ \["RequestProcessingPolicy", "org/omg/PortableServer/RequestProcessingPolicy.html"],
+ \["RequestProcessingPolicyOperations", "org/omg/PortableServer/RequestProcessingPolicyOperations.html"],
+ \["RequestProcessingPolicyValue", "org/omg/PortableServer/RequestProcessingPolicyValue.html"],
+ \["RequestWrapper", "javax/xml/ws/RequestWrapper.html"],
+ \["RequiredModelMBean", "javax/management/modelmbean/RequiredModelMBean.html"],
+ \["RescaleOp", "java/awt/image/RescaleOp.html"],
+ \["ResolutionSyntax", "javax/print/attribute/ResolutionSyntax.html"],
+ \["Resolver", "javax/naming/spi/Resolver.html"],
+ \["ResolveResult", "javax/naming/spi/ResolveResult.html"],
+ \["Resource", "javax/annotation/Resource.html"],
+ \["Resource.AuthenticationType", "javax/annotation/Resource.AuthenticationType.html"],
+ \["ResourceBundle", "java/util/ResourceBundle.html"],
+ \["ResourceBundle.Control", "java/util/ResourceBundle.Control.html"],
+ \["Resources", "javax/annotation/Resources.html"],
+ \["RespectBinding", "javax/xml/ws/RespectBinding.html"],
+ \["RespectBindingFeature", "javax/xml/ws/RespectBindingFeature.html"],
+ \["Response", "javax/xml/ws/Response.html"],
+ \["ResponseCache", "java/net/ResponseCache.html"],
+ \["ResponseHandler", "org/omg/CORBA/portable/ResponseHandler.html"],
+ \["ResponseWrapper", "javax/xml/ws/ResponseWrapper.html"],
+ \["Result", "javax/xml/transform/Result.html"],
+ \["ResultSet", "java/sql/ResultSet.html"],
+ \["ResultSetMetaData", "java/sql/ResultSetMetaData.html"],
+ \["Retention", "java/lang/annotation/Retention.html"],
+ \["RetentionPolicy", "java/lang/annotation/RetentionPolicy.html"],
+ \["RetrievalMethod", "javax/xml/crypto/dsig/keyinfo/RetrievalMethod.html"],
+ \["ReverbType", "javax/sound/sampled/ReverbType.html"],
+ \["RGBImageFilter", "java/awt/image/RGBImageFilter.html"],
+ \["RMIClassLoader", "java/rmi/server/RMIClassLoader.html"],
+ \["RMIClassLoaderSpi", "java/rmi/server/RMIClassLoaderSpi.html"],
+ \["RMIClientSocketFactory", "java/rmi/server/RMIClientSocketFactory.html"],
+ \["RMIConnection", "javax/management/remote/rmi/RMIConnection.html"],
+ \["RMIConnectionImpl", "javax/management/remote/rmi/RMIConnectionImpl.html"],
+ \["RMIConnectionImpl_Stub", "javax/management/remote/rmi/RMIConnectionImpl_Stub.html"],
+ \["RMIConnector", "javax/management/remote/rmi/RMIConnector.html"],
+ \["RMIConnectorServer", "javax/management/remote/rmi/RMIConnectorServer.html"],
+ \["RMICustomMaxStreamFormat", "org/omg/IOP/RMICustomMaxStreamFormat.html"],
+ \["RMIFailureHandler", "java/rmi/server/RMIFailureHandler.html"],
+ \["RMIIIOPServerImpl", "javax/management/remote/rmi/RMIIIOPServerImpl.html"],
+ \["RMIJRMPServerImpl", "javax/management/remote/rmi/RMIJRMPServerImpl.html"],
+ \["RMISecurityException", "java/rmi/RMISecurityException.html"],
+ \["RMISecurityManager", "java/rmi/RMISecurityManager.html"],
+ \["RMIServer", "javax/management/remote/rmi/RMIServer.html"],
+ \["RMIServerImpl", "javax/management/remote/rmi/RMIServerImpl.html"],
+ \["RMIServerImpl_Stub", "javax/management/remote/rmi/RMIServerImpl_Stub.html"],
+ \["RMIServerSocketFactory", "java/rmi/server/RMIServerSocketFactory.html"],
+ \["RMISocketFactory", "java/rmi/server/RMISocketFactory.html"],
+ \["Robot", "java/awt/Robot.html"],
+ \["Role", "javax/management/relation/Role.html"],
+ \["RoleInfo", "javax/management/relation/RoleInfo.html"],
+ \["RoleInfoNotFoundException", "javax/management/relation/RoleInfoNotFoundException.html"],
+ \["RoleList", "javax/management/relation/RoleList.html"],
+ \["RoleNotFoundException", "javax/management/relation/RoleNotFoundException.html"],
+ \["RoleResult", "javax/management/relation/RoleResult.html"],
+ \["RoleStatus", "javax/management/relation/RoleStatus.html"],
+ \["RoleUnresolved", "javax/management/relation/RoleUnresolved.html"],
+ \["RoleUnresolvedList", "javax/management/relation/RoleUnresolvedList.html"],
+ \["RootPaneContainer", "javax/swing/RootPaneContainer.html"],
+ \["RootPaneUI", "javax/swing/plaf/RootPaneUI.html"],
+ \["RoundEnvironment", "javax/annotation/processing/RoundEnvironment.html"],
+ \["RoundingMode", "java/math/RoundingMode.html"],
+ \["RoundRectangle2D", "java/awt/geom/RoundRectangle2D.html"],
+ \["RoundRectangle2D.Double", "java/awt/geom/RoundRectangle2D.Double.html"],
+ \["RoundRectangle2D.Float", "java/awt/geom/RoundRectangle2D.Float.html"],
+ \["RowFilter", "javax/swing/RowFilter.html"],
+ \["RowFilter.ComparisonType", "javax/swing/RowFilter.ComparisonType.html"],
+ \["RowFilter.Entry", "javax/swing/RowFilter.Entry.html"],
+ \["RowId", "java/sql/RowId.html"],
+ \["RowIdLifetime", "java/sql/RowIdLifetime.html"],
+ \["RowMapper", "javax/swing/tree/RowMapper.html"],
+ \["RowSet", "javax/sql/RowSet.html"],
+ \["RowSetEvent", "javax/sql/RowSetEvent.html"],
+ \["RowSetInternal", "javax/sql/RowSetInternal.html"],
+ \["RowSetListener", "javax/sql/RowSetListener.html"],
+ \["RowSetMetaData", "javax/sql/RowSetMetaData.html"],
+ \["RowSetMetaDataImpl", "javax/sql/rowset/RowSetMetaDataImpl.html"],
+ \["RowSetReader", "javax/sql/RowSetReader.html"],
+ \["RowSetWarning", "javax/sql/rowset/RowSetWarning.html"],
+ \["RowSetWriter", "javax/sql/RowSetWriter.html"],
+ \["RowSorter", "javax/swing/RowSorter.html"],
+ \["RowSorter.SortKey", "javax/swing/RowSorter.SortKey.html"],
+ \["RowSorterEvent", "javax/swing/event/RowSorterEvent.html"],
+ \["RowSorterEvent.Type", "javax/swing/event/RowSorterEvent.Type.html"],
+ \["RowSorterListener", "javax/swing/event/RowSorterListener.html"],
+ \["RSAKey", "java/security/interfaces/RSAKey.html"],
+ \["RSAKeyGenParameterSpec", "java/security/spec/RSAKeyGenParameterSpec.html"],
+ \["RSAMultiPrimePrivateCrtKey", "java/security/interfaces/RSAMultiPrimePrivateCrtKey.html"],
+ \["RSAMultiPrimePrivateCrtKeySpec", "java/security/spec/RSAMultiPrimePrivateCrtKeySpec.html"],
+ \["RSAOtherPrimeInfo", "java/security/spec/RSAOtherPrimeInfo.html"],
+ \["RSAPrivateCrtKey", "java/security/interfaces/RSAPrivateCrtKey.html"],
+ \["RSAPrivateCrtKeySpec", "java/security/spec/RSAPrivateCrtKeySpec.html"],
+ \["RSAPrivateKey", "java/security/interfaces/RSAPrivateKey.html"],
+ \["RSAPrivateKeySpec", "java/security/spec/RSAPrivateKeySpec.html"],
+ \["RSAPublicKey", "java/security/interfaces/RSAPublicKey.html"],
+ \["RSAPublicKeySpec", "java/security/spec/RSAPublicKeySpec.html"],
+ \["RTFEditorKit", "javax/swing/text/rtf/RTFEditorKit.html"],
+ \["RuleBasedCollator", "java/text/RuleBasedCollator.html"],
+ \["Runnable", "java/lang/Runnable.html"],
+ \["RunnableFuture", "java/util/concurrent/RunnableFuture.html"],
+ \["RunnableScheduledFuture", "java/util/concurrent/RunnableScheduledFuture.html"],
+ \["Runtime", "java/lang/Runtime.html"],
+ \["RunTime", "org/omg/SendingContext/RunTime.html"],
+ \["RuntimeErrorException", "javax/management/RuntimeErrorException.html"],
+ \["RuntimeException", "java/lang/RuntimeException.html"],
+ \["RuntimeMBeanException", "javax/management/RuntimeMBeanException.html"],
+ \["RuntimeMXBean", "java/lang/management/RuntimeMXBean.html"],
+ \["RunTimeOperations", "org/omg/SendingContext/RunTimeOperations.html"],
+ \["RuntimeOperationsException", "javax/management/RuntimeOperationsException.html"],
+ \["RuntimePermission", "java/lang/RuntimePermission.html"],
+ \["SAAJMetaFactory", "javax/xml/soap/SAAJMetaFactory.html"],
+ \["SAAJResult", "javax/xml/soap/SAAJResult.html"],
+ \["SampleModel", "java/awt/image/SampleModel.html"],
+ \["Sasl", "javax/security/sasl/Sasl.html"],
+ \["SaslClient", "javax/security/sasl/SaslClient.html"],
+ \["SaslClientFactory", "javax/security/sasl/SaslClientFactory.html"],
+ \["SaslException", "javax/security/sasl/SaslException.html"],
+ \["SaslServer", "javax/security/sasl/SaslServer.html"],
+ \["SaslServerFactory", "javax/security/sasl/SaslServerFactory.html"],
+ \["Savepoint", "java/sql/Savepoint.html"],
+ \["SAXException", "org/xml/sax/SAXException.html"],
+ \["SAXNotRecognizedException", "org/xml/sax/SAXNotRecognizedException.html"],
+ \["SAXNotSupportedException", "org/xml/sax/SAXNotSupportedException.html"],
+ \["SAXParseException", "org/xml/sax/SAXParseException.html"],
+ \["SAXParser", "javax/xml/parsers/SAXParser.html"],
+ \["SAXParserFactory", "javax/xml/parsers/SAXParserFactory.html"],
+ \["SAXResult", "javax/xml/transform/sax/SAXResult.html"],
+ \["SAXSource", "javax/xml/transform/sax/SAXSource.html"],
+ \["SAXTransformerFactory", "javax/xml/transform/sax/SAXTransformerFactory.html"],
+ \["Scanner", "java/util/Scanner.html"],
+ \["ScatteringByteChannel", "java/nio/channels/ScatteringByteChannel.html"],
+ \["ScheduledExecutorService", "java/util/concurrent/ScheduledExecutorService.html"],
+ \["ScheduledFuture", "java/util/concurrent/ScheduledFuture.html"],
+ \["ScheduledThreadPoolExecutor", "java/util/concurrent/ScheduledThreadPoolExecutor.html"],
+ \["Schema", "javax/xml/validation/Schema.html"],
+ \["SchemaFactory", "javax/xml/validation/SchemaFactory.html"],
+ \["SchemaFactoryLoader", "javax/xml/validation/SchemaFactoryLoader.html"],
+ \["SchemaOutputResolver", "javax/xml/bind/SchemaOutputResolver.html"],
+ \["SchemaViolationException", "javax/naming/directory/SchemaViolationException.html"],
+ \["ScriptContext", "javax/script/ScriptContext.html"],
+ \["ScriptEngine", "javax/script/ScriptEngine.html"],
+ \["ScriptEngineFactory", "javax/script/ScriptEngineFactory.html"],
+ \["ScriptEngineManager", "javax/script/ScriptEngineManager.html"],
+ \["ScriptException", "javax/script/ScriptException.html"],
+ \["Scrollable", "javax/swing/Scrollable.html"],
+ \["Scrollbar", "java/awt/Scrollbar.html"],
+ \["ScrollBarUI", "javax/swing/plaf/ScrollBarUI.html"],
+ \["ScrollPane", "java/awt/ScrollPane.html"],
+ \["ScrollPaneAdjustable", "java/awt/ScrollPaneAdjustable.html"],
+ \["ScrollPaneConstants", "javax/swing/ScrollPaneConstants.html"],
+ \["ScrollPaneLayout", "javax/swing/ScrollPaneLayout.html"],
+ \["ScrollPaneLayout.UIResource", "javax/swing/ScrollPaneLayout.UIResource.html"],
+ \["ScrollPaneUI", "javax/swing/plaf/ScrollPaneUI.html"],
+ \["SealedObject", "javax/crypto/SealedObject.html"],
+ \["SearchControls", "javax/naming/directory/SearchControls.html"],
+ \["SearchResult", "javax/naming/directory/SearchResult.html"],
+ \["SecretKey", "javax/crypto/SecretKey.html"],
+ \["SecretKeyFactory", "javax/crypto/SecretKeyFactory.html"],
+ \["SecretKeyFactorySpi", "javax/crypto/SecretKeyFactorySpi.html"],
+ \["SecretKeySpec", "javax/crypto/spec/SecretKeySpec.html"],
+ \["SecureCacheResponse", "java/net/SecureCacheResponse.html"],
+ \["SecureClassLoader", "java/security/SecureClassLoader.html"],
+ \["SecureRandom", "java/security/SecureRandom.html"],
+ \["SecureRandomSpi", "java/security/SecureRandomSpi.html"],
+ \["Security", "java/security/Security.html"],
+ \["SecurityException", "java/lang/SecurityException.html"],
+ \["SecurityManager", "java/lang/SecurityManager.html"],
+ \["SecurityPermission", "java/security/SecurityPermission.html"],
+ \["Segment", "javax/swing/text/Segment.html"],
+ \["SelectableChannel", "java/nio/channels/SelectableChannel.html"],
+ \["SelectionKey", "java/nio/channels/SelectionKey.html"],
+ \["Selector", "java/nio/channels/Selector.html"],
+ \["SelectorProvider", "java/nio/channels/spi/SelectorProvider.html"],
+ \["Semaphore", "java/util/concurrent/Semaphore.html"],
+ \["SeparatorUI", "javax/swing/plaf/SeparatorUI.html"],
+ \["Sequence", "javax/sound/midi/Sequence.html"],
+ \["SequenceInputStream", "java/io/SequenceInputStream.html"],
+ \["Sequencer", "javax/sound/midi/Sequencer.html"],
+ \["Sequencer.SyncMode", "javax/sound/midi/Sequencer.SyncMode.html"],
+ \["SerialArray", "javax/sql/rowset/serial/SerialArray.html"],
+ \["SerialBlob", "javax/sql/rowset/serial/SerialBlob.html"],
+ \["SerialClob", "javax/sql/rowset/serial/SerialClob.html"],
+ \["SerialDatalink", "javax/sql/rowset/serial/SerialDatalink.html"],
+ \["SerialException", "javax/sql/rowset/serial/SerialException.html"],
+ \["Serializable", "java/io/Serializable.html"],
+ \["SerializablePermission", "java/io/SerializablePermission.html"],
+ \["SerialJavaObject", "javax/sql/rowset/serial/SerialJavaObject.html"],
+ \["SerialRef", "javax/sql/rowset/serial/SerialRef.html"],
+ \["SerialStruct", "javax/sql/rowset/serial/SerialStruct.html"],
+ \["Servant", "org/omg/PortableServer/Servant.html"],
+ \["SERVANT_RETENTION_POLICY_ID", "org/omg/PortableServer/SERVANT_RETENTION_POLICY_ID.html"],
+ \["ServantActivator", "org/omg/PortableServer/ServantActivator.html"],
+ \["ServantActivatorHelper", "org/omg/PortableServer/ServantActivatorHelper.html"],
+ \["ServantActivatorOperations", "org/omg/PortableServer/ServantActivatorOperations.html"],
+ \["ServantActivatorPOA", "org/omg/PortableServer/ServantActivatorPOA.html"],
+ \["ServantAlreadyActive", "org/omg/PortableServer/POAPackage/ServantAlreadyActive.html"],
+ \["ServantAlreadyActiveHelper", "org/omg/PortableServer/POAPackage/ServantAlreadyActiveHelper.html"],
+ \["ServantLocator", "org/omg/PortableServer/ServantLocator.html"],
+ \["ServantLocatorHelper", "org/omg/PortableServer/ServantLocatorHelper.html"],
+ \["ServantLocatorOperations", "org/omg/PortableServer/ServantLocatorOperations.html"],
+ \["ServantLocatorPOA", "org/omg/PortableServer/ServantLocatorPOA.html"],
+ \["ServantManager", "org/omg/PortableServer/ServantManager.html"],
+ \["ServantManagerOperations", "org/omg/PortableServer/ServantManagerOperations.html"],
+ \["ServantNotActive", "org/omg/PortableServer/POAPackage/ServantNotActive.html"],
+ \["ServantNotActiveHelper", "org/omg/PortableServer/POAPackage/ServantNotActiveHelper.html"],
+ \["ServantObject", "org/omg/CORBA/portable/ServantObject.html"],
+ \["ServantRetentionPolicy", "org/omg/PortableServer/ServantRetentionPolicy.html"],
+ \["ServantRetentionPolicyOperations", "org/omg/PortableServer/ServantRetentionPolicyOperations.html"],
+ \["ServantRetentionPolicyValue", "org/omg/PortableServer/ServantRetentionPolicyValue.html"],
+ \["ServerCloneException", "java/rmi/server/ServerCloneException.html"],
+ \["ServerError", "java/rmi/ServerError.html"],
+ \["ServerException", "java/rmi/ServerException.html"],
+ \["ServerIdHelper", "org/omg/PortableInterceptor/ServerIdHelper.html"],
+ \["ServerNotActiveException", "java/rmi/server/ServerNotActiveException.html"],
+ \["ServerRef", "java/rmi/server/ServerRef.html"],
+ \["ServerRequest", "org/omg/CORBA/ServerRequest.html"],
+ \["ServerRequestInfo", "org/omg/PortableInterceptor/ServerRequestInfo.html"],
+ \["ServerRequestInfoOperations", "org/omg/PortableInterceptor/ServerRequestInfoOperations.html"],
+ \["ServerRequestInterceptor", "org/omg/PortableInterceptor/ServerRequestInterceptor.html"],
+ \["ServerRequestInterceptorOperations", "org/omg/PortableInterceptor/ServerRequestInterceptorOperations.html"],
+ \["ServerRuntimeException", "java/rmi/ServerRuntimeException.html"],
+ \["ServerSocket", "java/net/ServerSocket.html"],
+ \["ServerSocketChannel", "java/nio/channels/ServerSocketChannel.html"],
+ \["ServerSocketFactory", "javax/net/ServerSocketFactory.html"],
+ \["Service", "javax/xml/ws/Service.html"],
+ \["Service.Mode", "javax/xml/ws/Service.Mode.html"],
+ \["ServiceConfigurationError", "java/util/ServiceConfigurationError.html"],
+ \["ServiceContext", "org/omg/IOP/ServiceContext.html"],
+ \["ServiceContextHelper", "org/omg/IOP/ServiceContextHelper.html"],
+ \["ServiceContextHolder", "org/omg/IOP/ServiceContextHolder.html"],
+ \["ServiceContextListHelper", "org/omg/IOP/ServiceContextListHelper.html"],
+ \["ServiceContextListHolder", "org/omg/IOP/ServiceContextListHolder.html"],
+ \["ServiceDelegate", "javax/xml/ws/spi/ServiceDelegate.html"],
+ \["ServiceDetail", "org/omg/CORBA/ServiceDetail.html"],
+ \["ServiceDetailHelper", "org/omg/CORBA/ServiceDetailHelper.html"],
+ \["ServiceIdHelper", "org/omg/IOP/ServiceIdHelper.html"],
+ \["ServiceInformation", "org/omg/CORBA/ServiceInformation.html"],
+ \["ServiceInformationHelper", "org/omg/CORBA/ServiceInformationHelper.html"],
+ \["ServiceInformationHolder", "org/omg/CORBA/ServiceInformationHolder.html"],
+ \["ServiceLoader", "java/util/ServiceLoader.html"],
+ \["ServiceMode", "javax/xml/ws/ServiceMode.html"],
+ \["ServiceNotFoundException", "javax/management/ServiceNotFoundException.html"],
+ \["ServicePermission", "javax/security/auth/kerberos/ServicePermission.html"],
+ \["ServiceRegistry", "javax/imageio/spi/ServiceRegistry.html"],
+ \["ServiceRegistry.Filter", "javax/imageio/spi/ServiceRegistry.Filter.html"],
+ \["ServiceUI", "javax/print/ServiceUI.html"],
+ \["ServiceUIFactory", "javax/print/ServiceUIFactory.html"],
+ \["ServiceUnavailableException", "javax/naming/ServiceUnavailableException.html"],
+ \["Set", "java/util/Set.html"],
+ \["SetOfIntegerSyntax", "javax/print/attribute/SetOfIntegerSyntax.html"],
+ \["SetOverrideType", "org/omg/CORBA/SetOverrideType.html"],
+ \["SetOverrideTypeHelper", "org/omg/CORBA/SetOverrideTypeHelper.html"],
+ \["Severity", "javax/print/attribute/standard/Severity.html"],
+ \["Shape", "java/awt/Shape.html"],
+ \["ShapeGraphicAttribute", "java/awt/font/ShapeGraphicAttribute.html"],
+ \["SheetCollate", "javax/print/attribute/standard/SheetCollate.html"],
+ \["Short", "java/lang/Short.html"],
+ \["ShortBuffer", "java/nio/ShortBuffer.html"],
+ \["ShortBufferException", "javax/crypto/ShortBufferException.html"],
+ \["ShortHolder", "org/omg/CORBA/ShortHolder.html"],
+ \["ShortLookupTable", "java/awt/image/ShortLookupTable.html"],
+ \["ShortMessage", "javax/sound/midi/ShortMessage.html"],
+ \["ShortSeqHelper", "org/omg/CORBA/ShortSeqHelper.html"],
+ \["ShortSeqHolder", "org/omg/CORBA/ShortSeqHolder.html"],
+ \["Sides", "javax/print/attribute/standard/Sides.html"],
+ \["Signature", "java/security/Signature.html"],
+ \["SignatureException", "java/security/SignatureException.html"],
+ \["SignatureMethod", "javax/xml/crypto/dsig/SignatureMethod.html"],
+ \["SignatureMethodParameterSpec", "javax/xml/crypto/dsig/spec/SignatureMethodParameterSpec.html"],
+ \["SignatureProperties", "javax/xml/crypto/dsig/SignatureProperties.html"],
+ \["SignatureProperty", "javax/xml/crypto/dsig/SignatureProperty.html"],
+ \["SignatureSpi", "java/security/SignatureSpi.html"],
+ \["SignedInfo", "javax/xml/crypto/dsig/SignedInfo.html"],
+ \["SignedObject", "java/security/SignedObject.html"],
+ \["Signer", "java/security/Signer.html"],
+ \["SimpleAnnotationValueVisitor6", "javax/lang/model/util/SimpleAnnotationValueVisitor6.html"],
+ \["SimpleAttributeSet", "javax/swing/text/SimpleAttributeSet.html"],
+ \["SimpleBeanInfo", "java/beans/SimpleBeanInfo.html"],
+ \["SimpleBindings", "javax/script/SimpleBindings.html"],
+ \["SimpleDateFormat", "java/text/SimpleDateFormat.html"],
+ \["SimpleDoc", "javax/print/SimpleDoc.html"],
+ \["SimpleElementVisitor6", "javax/lang/model/util/SimpleElementVisitor6.html"],
+ \["SimpleFormatter", "java/util/logging/SimpleFormatter.html"],
+ \["SimpleJavaFileObject", "javax/tools/SimpleJavaFileObject.html"],
+ \["SimpleScriptContext", "javax/script/SimpleScriptContext.html"],
+ \["SimpleTimeZone", "java/util/SimpleTimeZone.html"],
+ \["SimpleType", "javax/management/openmbean/SimpleType.html"],
+ \["SimpleTypeVisitor6", "javax/lang/model/util/SimpleTypeVisitor6.html"],
+ \["SinglePixelPackedSampleModel", "java/awt/image/SinglePixelPackedSampleModel.html"],
+ \["SingleSelectionModel", "javax/swing/SingleSelectionModel.html"],
+ \["Size2DSyntax", "javax/print/attribute/Size2DSyntax.html"],
+ \["SizeLimitExceededException", "javax/naming/SizeLimitExceededException.html"],
+ \["SizeRequirements", "javax/swing/SizeRequirements.html"],
+ \["SizeSequence", "javax/swing/SizeSequence.html"],
+ \["Skeleton", "java/rmi/server/Skeleton.html"],
+ \["SkeletonMismatchException", "java/rmi/server/SkeletonMismatchException.html"],
+ \["SkeletonNotFoundException", "java/rmi/server/SkeletonNotFoundException.html"],
+ \["SliderUI", "javax/swing/plaf/SliderUI.html"],
+ \["SOAPBinding", "javax/jws/soap/SOAPBinding.html"],
+ \["SOAPBinding", "javax/xml/ws/soap/SOAPBinding.html"],
+ \["SOAPBinding.ParameterStyle", "javax/jws/soap/SOAPBinding.ParameterStyle.html"],
+ \["SOAPBinding.Style", "javax/jws/soap/SOAPBinding.Style.html"],
+ \["SOAPBinding.Use", "javax/jws/soap/SOAPBinding.Use.html"],
+ \["SOAPBody", "javax/xml/soap/SOAPBody.html"],
+ \["SOAPBodyElement", "javax/xml/soap/SOAPBodyElement.html"],
+ \["SOAPConnection", "javax/xml/soap/SOAPConnection.html"],
+ \["SOAPConnectionFactory", "javax/xml/soap/SOAPConnectionFactory.html"],
+ \["SOAPConstants", "javax/xml/soap/SOAPConstants.html"],
+ \["SOAPElement", "javax/xml/soap/SOAPElement.html"],
+ \["SOAPElementFactory", "javax/xml/soap/SOAPElementFactory.html"],
+ \["SOAPEnvelope", "javax/xml/soap/SOAPEnvelope.html"],
+ \["SOAPException", "javax/xml/soap/SOAPException.html"],
+ \["SOAPFactory", "javax/xml/soap/SOAPFactory.html"],
+ \["SOAPFault", "javax/xml/soap/SOAPFault.html"],
+ \["SOAPFaultElement", "javax/xml/soap/SOAPFaultElement.html"],
+ \["SOAPFaultException", "javax/xml/ws/soap/SOAPFaultException.html"],
+ \["SOAPHandler", "javax/xml/ws/handler/soap/SOAPHandler.html"],
+ \["SOAPHeader", "javax/xml/soap/SOAPHeader.html"],
+ \["SOAPHeaderElement", "javax/xml/soap/SOAPHeaderElement.html"],
+ \["SOAPMessage", "javax/xml/soap/SOAPMessage.html"],
+ \["SOAPMessageContext", "javax/xml/ws/handler/soap/SOAPMessageContext.html"],
+ \["SOAPMessageHandler", "javax/jws/soap/SOAPMessageHandler.html"],
+ \["SOAPMessageHandlers", "javax/jws/soap/SOAPMessageHandlers.html"],
+ \["SOAPPart", "javax/xml/soap/SOAPPart.html"],
+ \["Socket", "java/net/Socket.html"],
+ \["SocketAddress", "java/net/SocketAddress.html"],
+ \["SocketChannel", "java/nio/channels/SocketChannel.html"],
+ \["SocketException", "java/net/SocketException.html"],
+ \["SocketFactory", "javax/net/SocketFactory.html"],
+ \["SocketHandler", "java/util/logging/SocketHandler.html"],
+ \["SocketImpl", "java/net/SocketImpl.html"],
+ \["SocketImplFactory", "java/net/SocketImplFactory.html"],
+ \["SocketOptions", "java/net/SocketOptions.html"],
+ \["SocketPermission", "java/net/SocketPermission.html"],
+ \["SocketSecurityException", "java/rmi/server/SocketSecurityException.html"],
+ \["SocketTimeoutException", "java/net/SocketTimeoutException.html"],
+ \["SoftBevelBorder", "javax/swing/border/SoftBevelBorder.html"],
+ \["SoftReference", "java/lang/ref/SoftReference.html"],
+ \["SortControl", "javax/naming/ldap/SortControl.html"],
+ \["SortedMap", "java/util/SortedMap.html"],
+ \["SortedSet", "java/util/SortedSet.html"],
+ \["SortingFocusTraversalPolicy", "javax/swing/SortingFocusTraversalPolicy.html"],
+ \["SortKey", "javax/naming/ldap/SortKey.html"],
+ \["SortOrder", "javax/swing/SortOrder.html"],
+ \["SortResponseControl", "javax/naming/ldap/SortResponseControl.html"],
+ \["Soundbank", "javax/sound/midi/Soundbank.html"],
+ \["SoundbankReader", "javax/sound/midi/spi/SoundbankReader.html"],
+ \["SoundbankResource", "javax/sound/midi/SoundbankResource.html"],
+ \["Source", "javax/xml/transform/Source.html"],
+ \["SourceDataLine", "javax/sound/sampled/SourceDataLine.html"],
+ \["SourceLocator", "javax/xml/transform/SourceLocator.html"],
+ \["SourceVersion", "javax/lang/model/SourceVersion.html"],
+ \["SpinnerDateModel", "javax/swing/SpinnerDateModel.html"],
+ \["SpinnerListModel", "javax/swing/SpinnerListModel.html"],
+ \["SpinnerModel", "javax/swing/SpinnerModel.html"],
+ \["SpinnerNumberModel", "javax/swing/SpinnerNumberModel.html"],
+ \["SpinnerUI", "javax/swing/plaf/SpinnerUI.html"],
+ \["SplashScreen", "java/awt/SplashScreen.html"],
+ \["SplitPaneUI", "javax/swing/plaf/SplitPaneUI.html"],
+ \["Spring", "javax/swing/Spring.html"],
+ \["SpringLayout", "javax/swing/SpringLayout.html"],
+ \["SpringLayout.Constraints", "javax/swing/SpringLayout.Constraints.html"],
+ \["SQLClientInfoException", "java/sql/SQLClientInfoException.html"],
+ \["SQLData", "java/sql/SQLData.html"],
+ \["SQLDataException", "java/sql/SQLDataException.html"],
+ \["SQLException", "java/sql/SQLException.html"],
+ \["SQLFeatureNotSupportedException", "java/sql/SQLFeatureNotSupportedException.html"],
+ \["SQLInput", "java/sql/SQLInput.html"],
+ \["SQLInputImpl", "javax/sql/rowset/serial/SQLInputImpl.html"],
+ \["SQLIntegrityConstraintViolationException", "java/sql/SQLIntegrityConstraintViolationException.html"],
+ \["SQLInvalidAuthorizationSpecException", "java/sql/SQLInvalidAuthorizationSpecException.html"],
+ \["SQLNonTransientConnectionException", "java/sql/SQLNonTransientConnectionException.html"],
+ \["SQLNonTransientException", "java/sql/SQLNonTransientException.html"],
+ \["SQLOutput", "java/sql/SQLOutput.html"],
+ \["SQLOutputImpl", "javax/sql/rowset/serial/SQLOutputImpl.html"],
+ \["SQLPermission", "java/sql/SQLPermission.html"],
+ \["SQLRecoverableException", "java/sql/SQLRecoverableException.html"],
+ \["SQLSyntaxErrorException", "java/sql/SQLSyntaxErrorException.html"],
+ \["SQLTimeoutException", "java/sql/SQLTimeoutException.html"],
+ \["SQLTransactionRollbackException", "java/sql/SQLTransactionRollbackException.html"],
+ \["SQLTransientConnectionException", "java/sql/SQLTransientConnectionException.html"],
+ \["SQLTransientException", "java/sql/SQLTransientException.html"],
+ \["SQLWarning", "java/sql/SQLWarning.html"],
+ \["SQLXML", "java/sql/SQLXML.html"],
+ \["SSLContext", "javax/net/ssl/SSLContext.html"],
+ \["SSLContextSpi", "javax/net/ssl/SSLContextSpi.html"],
+ \["SSLEngine", "javax/net/ssl/SSLEngine.html"],
+ \["SSLEngineResult", "javax/net/ssl/SSLEngineResult.html"],
+ \["SSLEngineResult.HandshakeStatus", "javax/net/ssl/SSLEngineResult.HandshakeStatus.html"],
+ \["SSLEngineResult.Status", "javax/net/ssl/SSLEngineResult.Status.html"],
+ \["SSLException", "javax/net/ssl/SSLException.html"],
+ \["SSLHandshakeException", "javax/net/ssl/SSLHandshakeException.html"],
+ \["SSLKeyException", "javax/net/ssl/SSLKeyException.html"],
+ \["SSLParameters", "javax/net/ssl/SSLParameters.html"],
+ \["SSLPeerUnverifiedException", "javax/net/ssl/SSLPeerUnverifiedException.html"],
+ \["SSLPermission", "javax/net/ssl/SSLPermission.html"],
+ \["SSLProtocolException", "javax/net/ssl/SSLProtocolException.html"],
+ \["SslRMIClientSocketFactory", "javax/rmi/ssl/SslRMIClientSocketFactory.html"],
+ \["SslRMIServerSocketFactory", "javax/rmi/ssl/SslRMIServerSocketFactory.html"],
+ \["SSLServerSocket", "javax/net/ssl/SSLServerSocket.html"],
+ \["SSLServerSocketFactory", "javax/net/ssl/SSLServerSocketFactory.html"],
+ \["SSLSession", "javax/net/ssl/SSLSession.html"],
+ \["SSLSessionBindingEvent", "javax/net/ssl/SSLSessionBindingEvent.html"],
+ \["SSLSessionBindingListener", "javax/net/ssl/SSLSessionBindingListener.html"],
+ \["SSLSessionContext", "javax/net/ssl/SSLSessionContext.html"],
+ \["SSLSocket", "javax/net/ssl/SSLSocket.html"],
+ \["SSLSocketFactory", "javax/net/ssl/SSLSocketFactory.html"],
+ \["Stack", "java/util/Stack.html"],
+ \["StackOverflowError", "java/lang/StackOverflowError.html"],
+ \["StackTraceElement", "java/lang/StackTraceElement.html"],
+ \["StandardEmitterMBean", "javax/management/StandardEmitterMBean.html"],
+ \["StandardJavaFileManager", "javax/tools/StandardJavaFileManager.html"],
+ \["StandardLocation", "javax/tools/StandardLocation.html"],
+ \["StandardMBean", "javax/management/StandardMBean.html"],
+ \["StartDocument", "javax/xml/stream/events/StartDocument.html"],
+ \["StartElement", "javax/xml/stream/events/StartElement.html"],
+ \["StartTlsRequest", "javax/naming/ldap/StartTlsRequest.html"],
+ \["StartTlsResponse", "javax/naming/ldap/StartTlsResponse.html"],
+ \["State", "org/omg/PortableServer/POAManagerPackage/State.html"],
+ \["StateEdit", "javax/swing/undo/StateEdit.html"],
+ \["StateEditable", "javax/swing/undo/StateEditable.html"],
+ \["StateFactory", "javax/naming/spi/StateFactory.html"],
+ \["Statement", "java/beans/Statement.html"],
+ \["Statement", "java/sql/Statement.html"],
+ \["StatementEvent", "javax/sql/StatementEvent.html"],
+ \["StatementEventListener", "javax/sql/StatementEventListener.html"],
+ \["StAXResult", "javax/xml/transform/stax/StAXResult.html"],
+ \["StAXSource", "javax/xml/transform/stax/StAXSource.html"],
+ \["Streamable", "org/omg/CORBA/portable/Streamable.html"],
+ \["StreamableValue", "org/omg/CORBA/portable/StreamableValue.html"],
+ \["StreamCorruptedException", "java/io/StreamCorruptedException.html"],
+ \["StreamFilter", "javax/xml/stream/StreamFilter.html"],
+ \["StreamHandler", "java/util/logging/StreamHandler.html"],
+ \["StreamPrintService", "javax/print/StreamPrintService.html"],
+ \["StreamPrintServiceFactory", "javax/print/StreamPrintServiceFactory.html"],
+ \["StreamReaderDelegate", "javax/xml/stream/util/StreamReaderDelegate.html"],
+ \["StreamResult", "javax/xml/transform/stream/StreamResult.html"],
+ \["StreamSource", "javax/xml/transform/stream/StreamSource.html"],
+ \["StreamTokenizer", "java/io/StreamTokenizer.html"],
+ \["StrictMath", "java/lang/StrictMath.html"],
+ \["String", "java/lang/String.html"],
+ \["StringBuffer", "java/lang/StringBuffer.html"],
+ \["StringBufferInputStream", "java/io/StringBufferInputStream.html"],
+ \["StringBuilder", "java/lang/StringBuilder.html"],
+ \["StringCharacterIterator", "java/text/StringCharacterIterator.html"],
+ \["StringContent", "javax/swing/text/StringContent.html"],
+ \["StringHolder", "org/omg/CORBA/StringHolder.html"],
+ \["StringIndexOutOfBoundsException", "java/lang/StringIndexOutOfBoundsException.html"],
+ \["StringMonitor", "javax/management/monitor/StringMonitor.html"],
+ \["StringMonitorMBean", "javax/management/monitor/StringMonitorMBean.html"],
+ \["StringNameHelper", "org/omg/CosNaming/NamingContextExtPackage/StringNameHelper.html"],
+ \["StringReader", "java/io/StringReader.html"],
+ \["StringRefAddr", "javax/naming/StringRefAddr.html"],
+ \["StringSelection", "java/awt/datatransfer/StringSelection.html"],
+ \["StringSeqHelper", "org/omg/CORBA/StringSeqHelper.html"],
+ \["StringSeqHolder", "org/omg/CORBA/StringSeqHolder.html"],
+ \["StringTokenizer", "java/util/StringTokenizer.html"],
+ \["StringValueExp", "javax/management/StringValueExp.html"],
+ \["StringValueHelper", "org/omg/CORBA/StringValueHelper.html"],
+ \["StringWriter", "java/io/StringWriter.html"],
+ \["Stroke", "java/awt/Stroke.html"],
+ \["Struct", "java/sql/Struct.html"],
+ \["StructMember", "org/omg/CORBA/StructMember.html"],
+ \["StructMemberHelper", "org/omg/CORBA/StructMemberHelper.html"],
+ \["Stub", "javax/rmi/CORBA/Stub.html"],
+ \["StubDelegate", "javax/rmi/CORBA/StubDelegate.html"],
+ \["StubNotFoundException", "java/rmi/StubNotFoundException.html"],
+ \["Style", "javax/swing/text/Style.html"],
+ \["StyleConstants", "javax/swing/text/StyleConstants.html"],
+ \["StyleConstants.CharacterConstants", "javax/swing/text/StyleConstants.CharacterConstants.html"],
+ \["StyleConstants.ColorConstants", "javax/swing/text/StyleConstants.ColorConstants.html"],
+ \["StyleConstants.FontConstants", "javax/swing/text/StyleConstants.FontConstants.html"],
+ \["StyleConstants.ParagraphConstants", "javax/swing/text/StyleConstants.ParagraphConstants.html"],
+ \["StyleContext", "javax/swing/text/StyleContext.html"],
+ \["StyledDocument", "javax/swing/text/StyledDocument.html"],
+ \["StyledEditorKit", "javax/swing/text/StyledEditorKit.html"],
+ \["StyledEditorKit.AlignmentAction", "javax/swing/text/StyledEditorKit.AlignmentAction.html"],
+ \["StyledEditorKit.BoldAction", "javax/swing/text/StyledEditorKit.BoldAction.html"],
+ \["StyledEditorKit.FontFamilyAction", "javax/swing/text/StyledEditorKit.FontFamilyAction.html"],
+ \["StyledEditorKit.FontSizeAction", "javax/swing/text/StyledEditorKit.FontSizeAction.html"],
+ \["StyledEditorKit.ForegroundAction", "javax/swing/text/StyledEditorKit.ForegroundAction.html"],
+ \["StyledEditorKit.ItalicAction", "javax/swing/text/StyledEditorKit.ItalicAction.html"],
+ \["StyledEditorKit.StyledTextAction", "javax/swing/text/StyledEditorKit.StyledTextAction.html"],
+ \["StyledEditorKit.UnderlineAction", "javax/swing/text/StyledEditorKit.UnderlineAction.html"],
+ \["StyleSheet", "javax/swing/text/html/StyleSheet.html"],
+ \["StyleSheet.BoxPainter", "javax/swing/text/html/StyleSheet.BoxPainter.html"],
+ \["StyleSheet.ListPainter", "javax/swing/text/html/StyleSheet.ListPainter.html"],
+ \["Subject", "javax/security/auth/Subject.html"],
+ \["SubjectDelegationPermission", "javax/management/remote/SubjectDelegationPermission.html"],
+ \["SubjectDomainCombiner", "javax/security/auth/SubjectDomainCombiner.html"],
+ \["SUCCESSFUL", "org/omg/PortableInterceptor/SUCCESSFUL.html"],
+ \["SupportedAnnotationTypes", "javax/annotation/processing/SupportedAnnotationTypes.html"],
+ \["SupportedOptions", "javax/annotation/processing/SupportedOptions.html"],
+ \["SupportedSourceVersion", "javax/annotation/processing/SupportedSourceVersion.html"],
+ \["SupportedValuesAttribute", "javax/print/attribute/SupportedValuesAttribute.html"],
+ \["SuppressWarnings", "java/lang/SuppressWarnings.html"],
+ \["SwingConstants", "javax/swing/SwingConstants.html"],
+ \["SwingPropertyChangeSupport", "javax/swing/event/SwingPropertyChangeSupport.html"],
+ \["SwingUtilities", "javax/swing/SwingUtilities.html"],
+ \["SwingWorker", "javax/swing/SwingWorker.html"],
+ \["SwingWorker.StateValue", "javax/swing/SwingWorker.StateValue.html"],
+ \["SYNC_WITH_TRANSPORT", "org/omg/Messaging/SYNC_WITH_TRANSPORT.html"],
+ \["SyncFactory", "javax/sql/rowset/spi/SyncFactory.html"],
+ \["SyncFactoryException", "javax/sql/rowset/spi/SyncFactoryException.html"],
+ \["SyncFailedException", "java/io/SyncFailedException.html"],
+ \["SynchronousQueue", "java/util/concurrent/SynchronousQueue.html"],
+ \["SyncProvider", "javax/sql/rowset/spi/SyncProvider.html"],
+ \["SyncProviderException", "javax/sql/rowset/spi/SyncProviderException.html"],
+ \["SyncResolver", "javax/sql/rowset/spi/SyncResolver.html"],
+ \["SyncScopeHelper", "org/omg/Messaging/SyncScopeHelper.html"],
+ \["SynthConstants", "javax/swing/plaf/synth/SynthConstants.html"],
+ \["SynthContext", "javax/swing/plaf/synth/SynthContext.html"],
+ \["Synthesizer", "javax/sound/midi/Synthesizer.html"],
+ \["SynthGraphicsUtils", "javax/swing/plaf/synth/SynthGraphicsUtils.html"],
+ \["SynthLookAndFeel", "javax/swing/plaf/synth/SynthLookAndFeel.html"],
+ \["SynthPainter", "javax/swing/plaf/synth/SynthPainter.html"],
+ \["SynthStyle", "javax/swing/plaf/synth/SynthStyle.html"],
+ \["SynthStyleFactory", "javax/swing/plaf/synth/SynthStyleFactory.html"],
+ \["SysexMessage", "javax/sound/midi/SysexMessage.html"],
+ \["System", "java/lang/System.html"],
+ \["SYSTEM_EXCEPTION", "org/omg/PortableInterceptor/SYSTEM_EXCEPTION.html"],
+ \["SystemColor", "java/awt/SystemColor.html"],
+ \["SystemException", "org/omg/CORBA/SystemException.html"],
+ \["SystemFlavorMap", "java/awt/datatransfer/SystemFlavorMap.html"],
+ \["SystemTray", "java/awt/SystemTray.html"],
+ \["TabableView", "javax/swing/text/TabableView.html"],
+ \["TabbedPaneUI", "javax/swing/plaf/TabbedPaneUI.html"],
+ \["TabExpander", "javax/swing/text/TabExpander.html"],
+ \["TableCellEditor", "javax/swing/table/TableCellEditor.html"],
+ \["TableCellRenderer", "javax/swing/table/TableCellRenderer.html"],
+ \["TableColumn", "javax/swing/table/TableColumn.html"],
+ \["TableColumnModel", "javax/swing/table/TableColumnModel.html"],
+ \["TableColumnModelEvent", "javax/swing/event/TableColumnModelEvent.html"],
+ \["TableColumnModelListener", "javax/swing/event/TableColumnModelListener.html"],
+ \["TableHeaderUI", "javax/swing/plaf/TableHeaderUI.html"],
+ \["TableModel", "javax/swing/table/TableModel.html"],
+ \["TableModelEvent", "javax/swing/event/TableModelEvent.html"],
+ \["TableModelListener", "javax/swing/event/TableModelListener.html"],
+ \["TableRowSorter", "javax/swing/table/TableRowSorter.html"],
+ \["TableStringConverter", "javax/swing/table/TableStringConverter.html"],
+ \["TableUI", "javax/swing/plaf/TableUI.html"],
+ \["TableView", "javax/swing/text/TableView.html"],
+ \["TabSet", "javax/swing/text/TabSet.html"],
+ \["TabStop", "javax/swing/text/TabStop.html"],
+ \["TabularData", "javax/management/openmbean/TabularData.html"],
+ \["TabularDataSupport", "javax/management/openmbean/TabularDataSupport.html"],
+ \["TabularType", "javax/management/openmbean/TabularType.html"],
+ \["TAG_ALTERNATE_IIOP_ADDRESS", "org/omg/IOP/TAG_ALTERNATE_IIOP_ADDRESS.html"],
+ \["TAG_CODE_SETS", "org/omg/IOP/TAG_CODE_SETS.html"],
+ \["TAG_INTERNET_IOP", "org/omg/IOP/TAG_INTERNET_IOP.html"],
+ \["TAG_JAVA_CODEBASE", "org/omg/IOP/TAG_JAVA_CODEBASE.html"],
+ \["TAG_MULTIPLE_COMPONENTS", "org/omg/IOP/TAG_MULTIPLE_COMPONENTS.html"],
+ \["TAG_ORB_TYPE", "org/omg/IOP/TAG_ORB_TYPE.html"],
+ \["TAG_POLICIES", "org/omg/IOP/TAG_POLICIES.html"],
+ \["TAG_RMI_CUSTOM_MAX_STREAM_FORMAT", "org/omg/IOP/TAG_RMI_CUSTOM_MAX_STREAM_FORMAT.html"],
+ \["TagElement", "javax/swing/text/html/parser/TagElement.html"],
+ \["TaggedComponent", "org/omg/IOP/TaggedComponent.html"],
+ \["TaggedComponentHelper", "org/omg/IOP/TaggedComponentHelper.html"],
+ \["TaggedComponentHolder", "org/omg/IOP/TaggedComponentHolder.html"],
+ \["TaggedProfile", "org/omg/IOP/TaggedProfile.html"],
+ \["TaggedProfileHelper", "org/omg/IOP/TaggedProfileHelper.html"],
+ \["TaggedProfileHolder", "org/omg/IOP/TaggedProfileHolder.html"],
+ \["Target", "java/lang/annotation/Target.html"],
+ \["TargetDataLine", "javax/sound/sampled/TargetDataLine.html"],
+ \["TargetedNotification", "javax/management/remote/TargetedNotification.html"],
+ \["TCKind", "org/omg/CORBA/TCKind.html"],
+ \["Templates", "javax/xml/transform/Templates.html"],
+ \["TemplatesHandler", "javax/xml/transform/sax/TemplatesHandler.html"],
+ \["Text", "javax/xml/soap/Text.html"],
+ \["Text", "org/w3c/dom/Text.html"],
+ \["TextAction", "javax/swing/text/TextAction.html"],
+ \["TextArea", "java/awt/TextArea.html"],
+ \["TextAttribute", "java/awt/font/TextAttribute.html"],
+ \["TextComponent", "java/awt/TextComponent.html"],
+ \["TextEvent", "java/awt/event/TextEvent.html"],
+ \["TextField", "java/awt/TextField.html"],
+ \["TextHitInfo", "java/awt/font/TextHitInfo.html"],
+ \["TextInputCallback", "javax/security/auth/callback/TextInputCallback.html"],
+ \["TextLayout", "java/awt/font/TextLayout.html"],
+ \["TextLayout.CaretPolicy", "java/awt/font/TextLayout.CaretPolicy.html"],
+ \["TextListener", "java/awt/event/TextListener.html"],
+ \["TextMeasurer", "java/awt/font/TextMeasurer.html"],
+ \["TextOutputCallback", "javax/security/auth/callback/TextOutputCallback.html"],
+ \["TextSyntax", "javax/print/attribute/TextSyntax.html"],
+ \["TextUI", "javax/swing/plaf/TextUI.html"],
+ \["TexturePaint", "java/awt/TexturePaint.html"],
+ \["Thread", "java/lang/Thread.html"],
+ \["Thread.State", "java/lang/Thread.State.html"],
+ \["Thread.UncaughtExceptionHandler", "java/lang/Thread.UncaughtExceptionHandler.html"],
+ \["THREAD_POLICY_ID", "org/omg/PortableServer/THREAD_POLICY_ID.html"],
+ \["ThreadDeath", "java/lang/ThreadDeath.html"],
+ \["ThreadFactory", "java/util/concurrent/ThreadFactory.html"],
+ \["ThreadGroup", "java/lang/ThreadGroup.html"],
+ \["ThreadInfo", "java/lang/management/ThreadInfo.html"],
+ \["ThreadLocal", "java/lang/ThreadLocal.html"],
+ \["ThreadMXBean", "java/lang/management/ThreadMXBean.html"],
+ \["ThreadPolicy", "org/omg/PortableServer/ThreadPolicy.html"],
+ \["ThreadPolicyOperations", "org/omg/PortableServer/ThreadPolicyOperations.html"],
+ \["ThreadPolicyValue", "org/omg/PortableServer/ThreadPolicyValue.html"],
+ \["ThreadPoolExecutor", "java/util/concurrent/ThreadPoolExecutor.html"],
+ \["ThreadPoolExecutor.AbortPolicy", "java/util/concurrent/ThreadPoolExecutor.AbortPolicy.html"],
+ \["ThreadPoolExecutor.CallerRunsPolicy", "java/util/concurrent/ThreadPoolExecutor.CallerRunsPolicy.html"],
+ \["ThreadPoolExecutor.DiscardOldestPolicy", "java/util/concurrent/ThreadPoolExecutor.DiscardOldestPolicy.html"],
+ \["ThreadPoolExecutor.DiscardPolicy", "java/util/concurrent/ThreadPoolExecutor.DiscardPolicy.html"],
+ \["Throwable", "java/lang/Throwable.html"],
+ \["Tie", "javax/rmi/CORBA/Tie.html"],
+ \["TileObserver", "java/awt/image/TileObserver.html"],
+ \["Time", "java/sql/Time.html"],
+ \["TimeLimitExceededException", "javax/naming/TimeLimitExceededException.html"],
+ \["TIMEOUT", "org/omg/CORBA/TIMEOUT.html"],
+ \["TimeoutException", "java/util/concurrent/TimeoutException.html"],
+ \["Timer", "java/util/Timer.html"],
+ \["Timer", "javax/management/timer/Timer.html"],
+ \["Timer", "javax/swing/Timer.html"],
+ \["TimerMBean", "javax/management/timer/TimerMBean.html"],
+ \["TimerNotification", "javax/management/timer/TimerNotification.html"],
+ \["TimerTask", "java/util/TimerTask.html"],
+ \["Timestamp", "java/security/Timestamp.html"],
+ \["Timestamp", "java/sql/Timestamp.html"],
+ \["TimeUnit", "java/util/concurrent/TimeUnit.html"],
+ \["TimeZone", "java/util/TimeZone.html"],
+ \["TimeZoneNameProvider", "java/util/spi/TimeZoneNameProvider.html"],
+ \["TitledBorder", "javax/swing/border/TitledBorder.html"],
+ \["Tool", "javax/tools/Tool.html"],
+ \["ToolBarUI", "javax/swing/plaf/ToolBarUI.html"],
+ \["Toolkit", "java/awt/Toolkit.html"],
+ \["ToolProvider", "javax/tools/ToolProvider.html"],
+ \["ToolTipManager", "javax/swing/ToolTipManager.html"],
+ \["ToolTipUI", "javax/swing/plaf/ToolTipUI.html"],
+ \["TooManyListenersException", "java/util/TooManyListenersException.html"],
+ \["Track", "javax/sound/midi/Track.html"],
+ \["TRANSACTION_MODE", "org/omg/CORBA/TRANSACTION_MODE.html"],
+ \["TRANSACTION_REQUIRED", "org/omg/CORBA/TRANSACTION_REQUIRED.html"],
+ \["TRANSACTION_ROLLEDBACK", "org/omg/CORBA/TRANSACTION_ROLLEDBACK.html"],
+ \["TRANSACTION_UNAVAILABLE", "org/omg/CORBA/TRANSACTION_UNAVAILABLE.html"],
+ \["TransactionalWriter", "javax/sql/rowset/spi/TransactionalWriter.html"],
+ \["TransactionRequiredException", "javax/transaction/TransactionRequiredException.html"],
+ \["TransactionRolledbackException", "javax/transaction/TransactionRolledbackException.html"],
+ \["TransactionService", "org/omg/IOP/TransactionService.html"],
+ \["Transferable", "java/awt/datatransfer/Transferable.html"],
+ \["TransferHandler", "javax/swing/TransferHandler.html"],
+ \["TransferHandler.DropLocation", "javax/swing/TransferHandler.DropLocation.html"],
+ \["TransferHandler.TransferSupport", "javax/swing/TransferHandler.TransferSupport.html"],
+ \["Transform", "javax/xml/crypto/dsig/Transform.html"],
+ \["TransformAttribute", "java/awt/font/TransformAttribute.html"],
+ \["Transformer", "javax/xml/transform/Transformer.html"],
+ \["TransformerConfigurationException", "javax/xml/transform/TransformerConfigurationException.html"],
+ \["TransformerException", "javax/xml/transform/TransformerException.html"],
+ \["TransformerFactory", "javax/xml/transform/TransformerFactory.html"],
+ \["TransformerFactoryConfigurationError", "javax/xml/transform/TransformerFactoryConfigurationError.html"],
+ \["TransformerHandler", "javax/xml/transform/sax/TransformerHandler.html"],
+ \["TransformException", "javax/xml/crypto/dsig/TransformException.html"],
+ \["TransformParameterSpec", "javax/xml/crypto/dsig/spec/TransformParameterSpec.html"],
+ \["TransformService", "javax/xml/crypto/dsig/TransformService.html"],
+ \["TRANSIENT", "org/omg/CORBA/TRANSIENT.html"],
+ \["Transmitter", "javax/sound/midi/Transmitter.html"],
+ \["Transparency", "java/awt/Transparency.html"],
+ \["TRANSPORT_RETRY", "org/omg/PortableInterceptor/TRANSPORT_RETRY.html"],
+ \["TrayIcon", "java/awt/TrayIcon.html"],
+ \["TrayIcon.MessageType", "java/awt/TrayIcon.MessageType.html"],
+ \["TreeCellEditor", "javax/swing/tree/TreeCellEditor.html"],
+ \["TreeCellRenderer", "javax/swing/tree/TreeCellRenderer.html"],
+ \["TreeExpansionEvent", "javax/swing/event/TreeExpansionEvent.html"],
+ \["TreeExpansionListener", "javax/swing/event/TreeExpansionListener.html"],
+ \["TreeMap", "java/util/TreeMap.html"],
+ \["TreeModel", "javax/swing/tree/TreeModel.html"],
+ \["TreeModelEvent", "javax/swing/event/TreeModelEvent.html"],
+ \["TreeModelListener", "javax/swing/event/TreeModelListener.html"],
+ \["TreeNode", "javax/swing/tree/TreeNode.html"],
+ \["TreePath", "javax/swing/tree/TreePath.html"],
+ \["TreeSelectionEvent", "javax/swing/event/TreeSelectionEvent.html"],
+ \["TreeSelectionListener", "javax/swing/event/TreeSelectionListener.html"],
+ \["TreeSelectionModel", "javax/swing/tree/TreeSelectionModel.html"],
+ \["TreeSet", "java/util/TreeSet.html"],
+ \["TreeUI", "javax/swing/plaf/TreeUI.html"],
+ \["TreeWillExpandListener", "javax/swing/event/TreeWillExpandListener.html"],
+ \["TrustAnchor", "java/security/cert/TrustAnchor.html"],
+ \["TrustManager", "javax/net/ssl/TrustManager.html"],
+ \["TrustManagerFactory", "javax/net/ssl/TrustManagerFactory.html"],
+ \["TrustManagerFactorySpi", "javax/net/ssl/TrustManagerFactorySpi.html"],
+ \["Type", "java/lang/reflect/Type.html"],
+ \["TypeCode", "org/omg/CORBA/TypeCode.html"],
+ \["TypeCodeHolder", "org/omg/CORBA/TypeCodeHolder.html"],
+ \["TypeConstraintException", "javax/xml/bind/TypeConstraintException.html"],
+ \["TypeElement", "javax/lang/model/element/TypeElement.html"],
+ \["TypeInfo", "org/w3c/dom/TypeInfo.html"],
+ \["TypeInfoProvider", "javax/xml/validation/TypeInfoProvider.html"],
+ \["TypeKind", "javax/lang/model/type/TypeKind.html"],
+ \["TypeKindVisitor6", "javax/lang/model/util/TypeKindVisitor6.html"],
+ \["TypeMirror", "javax/lang/model/type/TypeMirror.html"],
+ \["TypeMismatch", "org/omg/CORBA/DynAnyPackage/TypeMismatch.html"],
+ \["TypeMismatch", "org/omg/DynamicAny/DynAnyPackage/TypeMismatch.html"],
+ \["TypeMismatch", "org/omg/IOP/CodecPackage/TypeMismatch.html"],
+ \["TypeMismatchHelper", "org/omg/DynamicAny/DynAnyPackage/TypeMismatchHelper.html"],
+ \["TypeMismatchHelper", "org/omg/IOP/CodecPackage/TypeMismatchHelper.html"],
+ \["TypeNotPresentException", "java/lang/TypeNotPresentException.html"],
+ \["TypeParameterElement", "javax/lang/model/element/TypeParameterElement.html"],
+ \["Types", "java/sql/Types.html"],
+ \["Types", "javax/lang/model/util/Types.html"],
+ \["TypeVariable", "java/lang/reflect/TypeVariable.html"],
+ \["TypeVariable", "javax/lang/model/type/TypeVariable.html"],
+ \["TypeVisitor", "javax/lang/model/type/TypeVisitor.html"],
+ \["UID", "java/rmi/server/UID.html"],
+ \["UIDefaults", "javax/swing/UIDefaults.html"],
+ \["UIDefaults.ActiveValue", "javax/swing/UIDefaults.ActiveValue.html"],
+ \["UIDefaults.LazyInputMap", "javax/swing/UIDefaults.LazyInputMap.html"],
+ \["UIDefaults.LazyValue", "javax/swing/UIDefaults.LazyValue.html"],
+ \["UIDefaults.ProxyLazyValue", "javax/swing/UIDefaults.ProxyLazyValue.html"],
+ \["UIEvent", "org/w3c/dom/events/UIEvent.html"],
+ \["UIManager", "javax/swing/UIManager.html"],
+ \["UIManager.LookAndFeelInfo", "javax/swing/UIManager.LookAndFeelInfo.html"],
+ \["UIResource", "javax/swing/plaf/UIResource.html"],
+ \["ULongLongSeqHelper", "org/omg/CORBA/ULongLongSeqHelper.html"],
+ \["ULongLongSeqHolder", "org/omg/CORBA/ULongLongSeqHolder.html"],
+ \["ULongSeqHelper", "org/omg/CORBA/ULongSeqHelper.html"],
+ \["ULongSeqHolder", "org/omg/CORBA/ULongSeqHolder.html"],
+ \["UndeclaredThrowableException", "java/lang/reflect/UndeclaredThrowableException.html"],
+ \["UndoableEdit", "javax/swing/undo/UndoableEdit.html"],
+ \["UndoableEditEvent", "javax/swing/event/UndoableEditEvent.html"],
+ \["UndoableEditListener", "javax/swing/event/UndoableEditListener.html"],
+ \["UndoableEditSupport", "javax/swing/undo/UndoableEditSupport.html"],
+ \["UndoManager", "javax/swing/undo/UndoManager.html"],
+ \["UnexpectedException", "java/rmi/UnexpectedException.html"],
+ \["UnicastRemoteObject", "java/rmi/server/UnicastRemoteObject.html"],
+ \["UnionMember", "org/omg/CORBA/UnionMember.html"],
+ \["UnionMemberHelper", "org/omg/CORBA/UnionMemberHelper.html"],
+ \["UNKNOWN", "org/omg/CORBA/UNKNOWN.html"],
+ \["UNKNOWN", "org/omg/PortableInterceptor/UNKNOWN.html"],
+ \["UnknownAnnotationValueException", "javax/lang/model/element/UnknownAnnotationValueException.html"],
+ \["UnknownElementException", "javax/lang/model/element/UnknownElementException.html"],
+ \["UnknownEncoding", "org/omg/IOP/CodecFactoryPackage/UnknownEncoding.html"],
+ \["UnknownEncodingHelper", "org/omg/IOP/CodecFactoryPackage/UnknownEncodingHelper.html"],
+ \["UnknownError", "java/lang/UnknownError.html"],
+ \["UnknownException", "org/omg/CORBA/portable/UnknownException.html"],
+ \["UnknownFormatConversionException", "java/util/UnknownFormatConversionException.html"],
+ \["UnknownFormatFlagsException", "java/util/UnknownFormatFlagsException.html"],
+ \["UnknownGroupException", "java/rmi/activation/UnknownGroupException.html"],
+ \["UnknownHostException", "java/net/UnknownHostException.html"],
+ \["UnknownHostException", "java/rmi/UnknownHostException.html"],
+ \["UnknownObjectException", "java/rmi/activation/UnknownObjectException.html"],
+ \["UnknownServiceException", "java/net/UnknownServiceException.html"],
+ \["UnknownTypeException", "javax/lang/model/type/UnknownTypeException.html"],
+ \["UnknownUserException", "org/omg/CORBA/UnknownUserException.html"],
+ \["UnknownUserExceptionHelper", "org/omg/CORBA/UnknownUserExceptionHelper.html"],
+ \["UnknownUserExceptionHolder", "org/omg/CORBA/UnknownUserExceptionHolder.html"],
+ \["UnmappableCharacterException", "java/nio/charset/UnmappableCharacterException.html"],
+ \["UnmarshalException", "java/rmi/UnmarshalException.html"],
+ \["UnmarshalException", "javax/xml/bind/UnmarshalException.html"],
+ \["Unmarshaller", "javax/xml/bind/Unmarshaller.html"],
+ \["Unmarshaller.Listener", "javax/xml/bind/Unmarshaller.Listener.html"],
+ \["UnmarshallerHandler", "javax/xml/bind/UnmarshallerHandler.html"],
+ \["UnmodifiableClassException", "java/lang/instrument/UnmodifiableClassException.html"],
+ \["UnmodifiableSetException", "javax/print/attribute/UnmodifiableSetException.html"],
+ \["UnrecoverableEntryException", "java/security/UnrecoverableEntryException.html"],
+ \["UnrecoverableKeyException", "java/security/UnrecoverableKeyException.html"],
+ \["Unreferenced", "java/rmi/server/Unreferenced.html"],
+ \["UnresolvedAddressException", "java/nio/channels/UnresolvedAddressException.html"],
+ \["UnresolvedPermission", "java/security/UnresolvedPermission.html"],
+ \["UnsatisfiedLinkError", "java/lang/UnsatisfiedLinkError.html"],
+ \["UnsolicitedNotification", "javax/naming/ldap/UnsolicitedNotification.html"],
+ \["UnsolicitedNotificationEvent", "javax/naming/ldap/UnsolicitedNotificationEvent.html"],
+ \["UnsolicitedNotificationListener", "javax/naming/ldap/UnsolicitedNotificationListener.html"],
+ \["UNSUPPORTED_POLICY", "org/omg/CORBA/UNSUPPORTED_POLICY.html"],
+ \["UNSUPPORTED_POLICY_VALUE", "org/omg/CORBA/UNSUPPORTED_POLICY_VALUE.html"],
+ \["UnsupportedAddressTypeException", "java/nio/channels/UnsupportedAddressTypeException.html"],
+ \["UnsupportedAudioFileException", "javax/sound/sampled/UnsupportedAudioFileException.html"],
+ \["UnsupportedCallbackException", "javax/security/auth/callback/UnsupportedCallbackException.html"],
+ \["UnsupportedCharsetException", "java/nio/charset/UnsupportedCharsetException.html"],
+ \["UnsupportedClassVersionError", "java/lang/UnsupportedClassVersionError.html"],
+ \["UnsupportedDataTypeException", "javax/activation/UnsupportedDataTypeException.html"],
+ \["UnsupportedEncodingException", "java/io/UnsupportedEncodingException.html"],
+ \["UnsupportedFlavorException", "java/awt/datatransfer/UnsupportedFlavorException.html"],
+ \["UnsupportedLookAndFeelException", "javax/swing/UnsupportedLookAndFeelException.html"],
+ \["UnsupportedOperationException", "java/lang/UnsupportedOperationException.html"],
+ \["URI", "java/net/URI.html"],
+ \["URIDereferencer", "javax/xml/crypto/URIDereferencer.html"],
+ \["URIException", "javax/print/URIException.html"],
+ \["URIParameter", "java/security/URIParameter.html"],
+ \["URIReference", "javax/xml/crypto/URIReference.html"],
+ \["URIReferenceException", "javax/xml/crypto/URIReferenceException.html"],
+ \["URIResolver", "javax/xml/transform/URIResolver.html"],
+ \["URISyntax", "javax/print/attribute/URISyntax.html"],
+ \["URISyntaxException", "java/net/URISyntaxException.html"],
+ \["URL", "java/net/URL.html"],
+ \["URLClassLoader", "java/net/URLClassLoader.html"],
+ \["URLConnection", "java/net/URLConnection.html"],
+ \["URLDataSource", "javax/activation/URLDataSource.html"],
+ \["URLDecoder", "java/net/URLDecoder.html"],
+ \["URLEncoder", "java/net/URLEncoder.html"],
+ \["URLStreamHandler", "java/net/URLStreamHandler.html"],
+ \["URLStreamHandlerFactory", "java/net/URLStreamHandlerFactory.html"],
+ \["URLStringHelper", "org/omg/CosNaming/NamingContextExtPackage/URLStringHelper.html"],
+ \["USER_EXCEPTION", "org/omg/PortableInterceptor/USER_EXCEPTION.html"],
+ \["UserDataHandler", "org/w3c/dom/UserDataHandler.html"],
+ \["UserException", "org/omg/CORBA/UserException.html"],
+ \["UShortSeqHelper", "org/omg/CORBA/UShortSeqHelper.html"],
+ \["UShortSeqHolder", "org/omg/CORBA/UShortSeqHolder.html"],
+ \["UTFDataFormatException", "java/io/UTFDataFormatException.html"],
+ \["Util", "javax/rmi/CORBA/Util.html"],
+ \["UtilDelegate", "javax/rmi/CORBA/UtilDelegate.html"],
+ \["Utilities", "javax/swing/text/Utilities.html"],
+ \["UUID", "java/util/UUID.html"],
+ \["ValidationEvent", "javax/xml/bind/ValidationEvent.html"],
+ \["ValidationEventCollector", "javax/xml/bind/util/ValidationEventCollector.html"],
+ \["ValidationEventHandler", "javax/xml/bind/ValidationEventHandler.html"],
+ \["ValidationEventImpl", "javax/xml/bind/helpers/ValidationEventImpl.html"],
+ \["ValidationEventLocator", "javax/xml/bind/ValidationEventLocator.html"],
+ \["ValidationEventLocatorImpl", "javax/xml/bind/helpers/ValidationEventLocatorImpl.html"],
+ \["ValidationException", "javax/xml/bind/ValidationException.html"],
+ \["Validator", "javax/xml/bind/Validator.html"],
+ \["Validator", "javax/xml/validation/Validator.html"],
+ \["ValidatorHandler", "javax/xml/validation/ValidatorHandler.html"],
+ \["ValueBase", "org/omg/CORBA/portable/ValueBase.html"],
+ \["ValueBaseHelper", "org/omg/CORBA/ValueBaseHelper.html"],
+ \["ValueBaseHolder", "org/omg/CORBA/ValueBaseHolder.html"],
+ \["ValueExp", "javax/management/ValueExp.html"],
+ \["ValueFactory", "org/omg/CORBA/portable/ValueFactory.html"],
+ \["ValueHandler", "javax/rmi/CORBA/ValueHandler.html"],
+ \["ValueHandlerMultiFormat", "javax/rmi/CORBA/ValueHandlerMultiFormat.html"],
+ \["ValueInputStream", "org/omg/CORBA/portable/ValueInputStream.html"],
+ \["ValueMember", "org/omg/CORBA/ValueMember.html"],
+ \["ValueMemberHelper", "org/omg/CORBA/ValueMemberHelper.html"],
+ \["ValueOutputStream", "org/omg/CORBA/portable/ValueOutputStream.html"],
+ \["VariableElement", "javax/lang/model/element/VariableElement.html"],
+ \["VariableHeightLayoutCache", "javax/swing/tree/VariableHeightLayoutCache.html"],
+ \["Vector", "java/util/Vector.html"],
+ \["VerifyError", "java/lang/VerifyError.html"],
+ \["VersionSpecHelper", "org/omg/CORBA/VersionSpecHelper.html"],
+ \["VetoableChangeListener", "java/beans/VetoableChangeListener.html"],
+ \["VetoableChangeListenerProxy", "java/beans/VetoableChangeListenerProxy.html"],
+ \["VetoableChangeSupport", "java/beans/VetoableChangeSupport.html"],
+ \["View", "javax/swing/text/View.html"],
+ \["ViewFactory", "javax/swing/text/ViewFactory.html"],
+ \["ViewportLayout", "javax/swing/ViewportLayout.html"],
+ \["ViewportUI", "javax/swing/plaf/ViewportUI.html"],
+ \["VirtualMachineError", "java/lang/VirtualMachineError.html"],
+ \["Visibility", "java/beans/Visibility.html"],
+ \["VisibilityHelper", "org/omg/CORBA/VisibilityHelper.html"],
+ \["VM_ABSTRACT", "org/omg/CORBA/VM_ABSTRACT.html"],
+ \["VM_CUSTOM", "org/omg/CORBA/VM_CUSTOM.html"],
+ \["VM_NONE", "org/omg/CORBA/VM_NONE.html"],
+ \["VM_TRUNCATABLE", "org/omg/CORBA/VM_TRUNCATABLE.html"],
+ \["VMID", "java/rmi/dgc/VMID.html"],
+ \["VoiceStatus", "javax/sound/midi/VoiceStatus.html"],
+ \["Void", "java/lang/Void.html"],
+ \["VolatileImage", "java/awt/image/VolatileImage.html"],
+ \["W3CDomHandler", "javax/xml/bind/annotation/W3CDomHandler.html"],
+ \["W3CEndpointReference", "javax/xml/ws/wsaddressing/W3CEndpointReference.html"],
+ \["W3CEndpointReferenceBuilder", "javax/xml/ws/wsaddressing/W3CEndpointReferenceBuilder.html"],
+ \["WCharSeqHelper", "org/omg/CORBA/WCharSeqHelper.html"],
+ \["WCharSeqHolder", "org/omg/CORBA/WCharSeqHolder.html"],
+ \["WeakHashMap", "java/util/WeakHashMap.html"],
+ \["WeakReference", "java/lang/ref/WeakReference.html"],
+ \["WebEndpoint", "javax/xml/ws/WebEndpoint.html"],
+ \["WebFault", "javax/xml/ws/WebFault.html"],
+ \["WebMethod", "javax/jws/WebMethod.html"],
+ \["WebParam", "javax/jws/WebParam.html"],
+ \["WebParam.Mode", "javax/jws/WebParam.Mode.html"],
+ \["WebResult", "javax/jws/WebResult.html"],
+ \["WebRowSet", "javax/sql/rowset/WebRowSet.html"],
+ \["WebService", "javax/jws/WebService.html"],
+ \["WebServiceClient", "javax/xml/ws/WebServiceClient.html"],
+ \["WebServiceContext", "javax/xml/ws/WebServiceContext.html"],
+ \["WebServiceException", "javax/xml/ws/WebServiceException.html"],
+ \["WebServiceFeature", "javax/xml/ws/WebServiceFeature.html"],
+ \["WebServiceFeatureAnnotation", "javax/xml/ws/spi/WebServiceFeatureAnnotation.html"],
+ \["WebServicePermission", "javax/xml/ws/WebServicePermission.html"],
+ \["WebServiceProvider", "javax/xml/ws/WebServiceProvider.html"],
+ \["WebServiceRef", "javax/xml/ws/WebServiceRef.html"],
+ \["WebServiceRefs", "javax/xml/ws/WebServiceRefs.html"],
+ \["WildcardType", "java/lang/reflect/WildcardType.html"],
+ \["WildcardType", "javax/lang/model/type/WildcardType.html"],
+ \["Window", "java/awt/Window.html"],
+ \["WindowAdapter", "java/awt/event/WindowAdapter.html"],
+ \["WindowConstants", "javax/swing/WindowConstants.html"],
+ \["WindowEvent", "java/awt/event/WindowEvent.html"],
+ \["WindowFocusListener", "java/awt/event/WindowFocusListener.html"],
+ \["WindowListener", "java/awt/event/WindowListener.html"],
+ \["WindowStateListener", "java/awt/event/WindowStateListener.html"],
+ \["WrappedPlainView", "javax/swing/text/WrappedPlainView.html"],
+ \["Wrapper", "java/sql/Wrapper.html"],
+ \["WritableByteChannel", "java/nio/channels/WritableByteChannel.html"],
+ \["WritableRaster", "java/awt/image/WritableRaster.html"],
+ \["WritableRenderedImage", "java/awt/image/WritableRenderedImage.html"],
+ \["WriteAbortedException", "java/io/WriteAbortedException.html"],
+ \["Writer", "java/io/Writer.html"],
+ \["WrongAdapter", "org/omg/PortableServer/POAPackage/WrongAdapter.html"],
+ \["WrongAdapterHelper", "org/omg/PortableServer/POAPackage/WrongAdapterHelper.html"],
+ \["WrongPolicy", "org/omg/PortableServer/POAPackage/WrongPolicy.html"],
+ \["WrongPolicyHelper", "org/omg/PortableServer/POAPackage/WrongPolicyHelper.html"],
+ \["WrongTransaction", "org/omg/CORBA/WrongTransaction.html"],
+ \["WrongTransactionHelper", "org/omg/CORBA/WrongTransactionHelper.html"],
+ \["WrongTransactionHolder", "org/omg/CORBA/WrongTransactionHolder.html"],
+ \["WStringSeqHelper", "org/omg/CORBA/WStringSeqHelper.html"],
+ \["WStringSeqHolder", "org/omg/CORBA/WStringSeqHolder.html"],
+ \["WStringValueHelper", "org/omg/CORBA/WStringValueHelper.html"],
+ \["X500Principal", "javax/security/auth/x500/X500Principal.html"],
+ \["X500PrivateCredential", "javax/security/auth/x500/X500PrivateCredential.html"],
+ \["X509Certificate", "java/security/cert/X509Certificate.html"],
+ \["X509Certificate", "javax/security/cert/X509Certificate.html"],
+ \["X509CertSelector", "java/security/cert/X509CertSelector.html"],
+ \["X509CRL", "java/security/cert/X509CRL.html"],
+ \["X509CRLEntry", "java/security/cert/X509CRLEntry.html"],
+ \["X509CRLSelector", "java/security/cert/X509CRLSelector.html"],
+ \["X509Data", "javax/xml/crypto/dsig/keyinfo/X509Data.html"],
+ \["X509EncodedKeySpec", "java/security/spec/X509EncodedKeySpec.html"],
+ \["X509ExtendedKeyManager", "javax/net/ssl/X509ExtendedKeyManager.html"],
+ \["X509Extension", "java/security/cert/X509Extension.html"],
+ \["X509IssuerSerial", "javax/xml/crypto/dsig/keyinfo/X509IssuerSerial.html"],
+ \["X509KeyManager", "javax/net/ssl/X509KeyManager.html"],
+ \["X509TrustManager", "javax/net/ssl/X509TrustManager.html"],
+ \["XAConnection", "javax/sql/XAConnection.html"],
+ \["XADataSource", "javax/sql/XADataSource.html"],
+ \["XAException", "javax/transaction/xa/XAException.html"],
+ \["XAResource", "javax/transaction/xa/XAResource.html"],
+ \["Xid", "javax/transaction/xa/Xid.html"],
+ \["XmlAccessOrder", "javax/xml/bind/annotation/XmlAccessOrder.html"],
+ \["XmlAccessorOrder", "javax/xml/bind/annotation/XmlAccessorOrder.html"],
+ \["XmlAccessorType", "javax/xml/bind/annotation/XmlAccessorType.html"],
+ \["XmlAccessType", "javax/xml/bind/annotation/XmlAccessType.html"],
+ \["XmlAdapter", "javax/xml/bind/annotation/adapters/XmlAdapter.html"],
+ \["XmlAnyAttribute", "javax/xml/bind/annotation/XmlAnyAttribute.html"],
+ \["XmlAnyElement", "javax/xml/bind/annotation/XmlAnyElement.html"],
+ \["XmlAttachmentRef", "javax/xml/bind/annotation/XmlAttachmentRef.html"],
+ \["XmlAttribute", "javax/xml/bind/annotation/XmlAttribute.html"],
+ \["XMLConstants", "javax/xml/XMLConstants.html"],
+ \["XMLCryptoContext", "javax/xml/crypto/XMLCryptoContext.html"],
+ \["XMLDecoder", "java/beans/XMLDecoder.html"],
+ \["XmlElement", "javax/xml/bind/annotation/XmlElement.html"],
+ \["XmlElement.DEFAULT", "javax/xml/bind/annotation/XmlElement.DEFAULT.html"],
+ \["XmlElementDecl", "javax/xml/bind/annotation/XmlElementDecl.html"],
+ \["XmlElementDecl.GLOBAL", "javax/xml/bind/annotation/XmlElementDecl.GLOBAL.html"],
+ \["XmlElementRef", "javax/xml/bind/annotation/XmlElementRef.html"],
+ \["XmlElementRef.DEFAULT", "javax/xml/bind/annotation/XmlElementRef.DEFAULT.html"],
+ \["XmlElementRefs", "javax/xml/bind/annotation/XmlElementRefs.html"],
+ \["XmlElements", "javax/xml/bind/annotation/XmlElements.html"],
+ \["XmlElementWrapper", "javax/xml/bind/annotation/XmlElementWrapper.html"],
+ \["XMLEncoder", "java/beans/XMLEncoder.html"],
+ \["XmlEnum", "javax/xml/bind/annotation/XmlEnum.html"],
+ \["XmlEnumValue", "javax/xml/bind/annotation/XmlEnumValue.html"],
+ \["XMLEvent", "javax/xml/stream/events/XMLEvent.html"],
+ \["XMLEventAllocator", "javax/xml/stream/util/XMLEventAllocator.html"],
+ \["XMLEventConsumer", "javax/xml/stream/util/XMLEventConsumer.html"],
+ \["XMLEventFactory", "javax/xml/stream/XMLEventFactory.html"],
+ \["XMLEventReader", "javax/xml/stream/XMLEventReader.html"],
+ \["XMLEventWriter", "javax/xml/stream/XMLEventWriter.html"],
+ \["XMLFilter", "org/xml/sax/XMLFilter.html"],
+ \["XMLFilterImpl", "org/xml/sax/helpers/XMLFilterImpl.html"],
+ \["XMLFormatter", "java/util/logging/XMLFormatter.html"],
+ \["XMLGregorianCalendar", "javax/xml/datatype/XMLGregorianCalendar.html"],
+ \["XmlID", "javax/xml/bind/annotation/XmlID.html"],
+ \["XmlIDREF", "javax/xml/bind/annotation/XmlIDREF.html"],
+ \["XmlInlineBinaryData", "javax/xml/bind/annotation/XmlInlineBinaryData.html"],
+ \["XMLInputFactory", "javax/xml/stream/XMLInputFactory.html"],
+ \["XmlJavaTypeAdapter", "javax/xml/bind/annotation/adapters/XmlJavaTypeAdapter.html"],
+ \["XmlJavaTypeAdapter.DEFAULT", "javax/xml/bind/annotation/adapters/XmlJavaTypeAdapter.DEFAULT.html"],
+ \["XmlJavaTypeAdapters", "javax/xml/bind/annotation/adapters/XmlJavaTypeAdapters.html"],
+ \["XmlList", "javax/xml/bind/annotation/XmlList.html"],
+ \["XmlMimeType", "javax/xml/bind/annotation/XmlMimeType.html"],
+ \["XmlMixed", "javax/xml/bind/annotation/XmlMixed.html"],
+ \["XmlNs", "javax/xml/bind/annotation/XmlNs.html"],
+ \["XmlNsForm", "javax/xml/bind/annotation/XmlNsForm.html"],
+ \["XMLObject", "javax/xml/crypto/dsig/XMLObject.html"],
+ \["XMLOutputFactory", "javax/xml/stream/XMLOutputFactory.html"],
+ \["XMLParseException", "javax/management/modelmbean/XMLParseException.html"],
+ \["XmlReader", "javax/sql/rowset/spi/XmlReader.html"],
+ \["XMLReader", "org/xml/sax/XMLReader.html"],
+ \["XMLReaderAdapter", "org/xml/sax/helpers/XMLReaderAdapter.html"],
+ \["XMLReaderFactory", "org/xml/sax/helpers/XMLReaderFactory.html"],
+ \["XmlRegistry", "javax/xml/bind/annotation/XmlRegistry.html"],
+ \["XMLReporter", "javax/xml/stream/XMLReporter.html"],
+ \["XMLResolver", "javax/xml/stream/XMLResolver.html"],
+ \["XmlRootElement", "javax/xml/bind/annotation/XmlRootElement.html"],
+ \["XmlSchema", "javax/xml/bind/annotation/XmlSchema.html"],
+ \["XmlSchemaType", "javax/xml/bind/annotation/XmlSchemaType.html"],
+ \["XmlSchemaType.DEFAULT", "javax/xml/bind/annotation/XmlSchemaType.DEFAULT.html"],
+ \["XmlSchemaTypes", "javax/xml/bind/annotation/XmlSchemaTypes.html"],
+ \["XmlSeeAlso", "javax/xml/bind/annotation/XmlSeeAlso.html"],
+ \["XMLSignature", "javax/xml/crypto/dsig/XMLSignature.html"],
+ \["XMLSignature.SignatureValue", "javax/xml/crypto/dsig/XMLSignature.SignatureValue.html"],
+ \["XMLSignatureException", "javax/xml/crypto/dsig/XMLSignatureException.html"],
+ \["XMLSignatureFactory", "javax/xml/crypto/dsig/XMLSignatureFactory.html"],
+ \["XMLSignContext", "javax/xml/crypto/dsig/XMLSignContext.html"],
+ \["XMLStreamConstants", "javax/xml/stream/XMLStreamConstants.html"],
+ \["XMLStreamException", "javax/xml/stream/XMLStreamException.html"],
+ \["XMLStreamReader", "javax/xml/stream/XMLStreamReader.html"],
+ \["XMLStreamWriter", "javax/xml/stream/XMLStreamWriter.html"],
+ \["XMLStructure", "javax/xml/crypto/XMLStructure.html"],
+ \["XmlTransient", "javax/xml/bind/annotation/XmlTransient.html"],
+ \["XmlType", "javax/xml/bind/annotation/XmlType.html"],
+ \["XmlType.DEFAULT", "javax/xml/bind/annotation/XmlType.DEFAULT.html"],
+ \["XMLValidateContext", "javax/xml/crypto/dsig/XMLValidateContext.html"],
+ \["XmlValue", "javax/xml/bind/annotation/XmlValue.html"],
+ \["XmlWriter", "javax/sql/rowset/spi/XmlWriter.html"],
+ \["XPath", "javax/xml/xpath/XPath.html"],
+ \["XPathConstants", "javax/xml/xpath/XPathConstants.html"],
+ \["XPathException", "javax/xml/xpath/XPathException.html"],
+ \["XPathExpression", "javax/xml/xpath/XPathExpression.html"],
+ \["XPathExpressionException", "javax/xml/xpath/XPathExpressionException.html"],
+ \["XPathFactory", "javax/xml/xpath/XPathFactory.html"],
+ \["XPathFactoryConfigurationException", "javax/xml/xpath/XPathFactoryConfigurationException.html"],
+ \["XPathFilter2ParameterSpec", "javax/xml/crypto/dsig/spec/XPathFilter2ParameterSpec.html"],
+ \["XPathFilterParameterSpec", "javax/xml/crypto/dsig/spec/XPathFilterParameterSpec.html"],
+ \["XPathFunction", "javax/xml/xpath/XPathFunction.html"],
+ \["XPathFunctionException", "javax/xml/xpath/XPathFunctionException.html"],
+ \["XPathFunctionResolver", "javax/xml/xpath/XPathFunctionResolver.html"],
+ \["XPathType", "javax/xml/crypto/dsig/spec/XPathType.html"],
+ \["XPathType.Filter", "javax/xml/crypto/dsig/spec/XPathType.Filter.html"],
+ \["XPathVariableResolver", "javax/xml/xpath/XPathVariableResolver.html"],
+ \["XSLTTransformParameterSpec", "javax/xml/crypto/dsig/spec/XSLTTransformParameterSpec.html"],
+ \["ZipEntry", "java/util/zip/ZipEntry.html"],
+ \["ZipError", "java/util/zip/ZipError.html"],
+ \["ZipException", "java/util/zip/ZipException.html"],
+ \["ZipFile", "java/util/zip/ZipFile.html"],
+ \["ZipInputStream", "java/util/zip/ZipInputStream.html"],
+ \["ZipOutputStream", "java/util/zip/ZipOutputStream.html"],
+ \["ZoneView", "javax/swing/text/ZoneView.html"],
+ \["_BindingIteratorImplBase", "org/omg/CosNaming/_BindingIteratorImplBase.html"],
+ \["_BindingIteratorStub", "org/omg/CosNaming/_BindingIteratorStub.html"],
+ \["_DynAnyFactoryStub", "org/omg/DynamicAny/_DynAnyFactoryStub.html"],
+ \["_DynAnyStub", "org/omg/DynamicAny/_DynAnyStub.html"],
+ \["_DynArrayStub", "org/omg/DynamicAny/_DynArrayStub.html"],
+ \["_DynEnumStub", "org/omg/DynamicAny/_DynEnumStub.html"],
+ \["_DynFixedStub", "org/omg/DynamicAny/_DynFixedStub.html"],
+ \["_DynSequenceStub", "org/omg/DynamicAny/_DynSequenceStub.html"],
+ \["_DynStructStub", "org/omg/DynamicAny/_DynStructStub.html"],
+ \["_DynUnionStub", "org/omg/DynamicAny/_DynUnionStub.html"],
+ \["_DynValueStub", "org/omg/DynamicAny/_DynValueStub.html"],
+ \["_IDLTypeStub", "org/omg/CORBA/_IDLTypeStub.html"],
+ \["_NamingContextExtStub", "org/omg/CosNaming/_NamingContextExtStub.html"],
+ \["_NamingContextImplBase", "org/omg/CosNaming/_NamingContextImplBase.html"],
+ \["_NamingContextStub", "org/omg/CosNaming/_NamingContextStub.html"],
+ \["_PolicyStub", "org/omg/CORBA/_PolicyStub.html"],
+ \["_Remote_Stub", "org/omg/stub/java/rmi/_Remote_Stub.html"],
+ \["_ServantActivatorStub", "org/omg/PortableServer/_ServantActivatorStub.html"],
+ \["_ServantLocatorStub", "org/omg/PortableServer/_ServantLocatorStub.html"]]
+endif
+
diff --git a/vim/bundle/slimv/ftplugin/slimv.vim b/vim/bundle/slimv/ftplugin/slimv.vim
new file mode 100644
index 0000000..bd94155
--- /dev/null
+++ b/vim/bundle/slimv/ftplugin/slimv.vim
@@ -0,0 +1,3676 @@
+" slimv.vim: The Superior Lisp Interaction Mode for VIM
+" Version: 0.9.13
+" Last Change: 18 Jan 2017
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if &cp || exists( 'g:slimv_loaded' )
+ finish
+endif
+
+let g:slimv_loaded = 1
+
+let g:slimv_windows = 0
+let g:slimv_cygwin = 0
+let g:slimv_osx = 0
+
+if has( 'win32' ) || has( 'win95' ) || has( 'win64' ) || has( 'win16' )
+ let g:slimv_windows = 1
+elseif has( 'win32unix' )
+ let g:slimv_cygwin = 1
+elseif has( 'macunix' )
+ let g:slimv_osx = 1
+endif
+
+if ( !exists( 'g:slimv_python_version' ) && has( 'python3' ) ) ||
+\ ( exists( 'g:slimv_python_version' ) && g:slimv_python_version == 3 )
+ let s:py_cmd = 'python3 ' "note space
+ let s:pyfile_cmd = 'py3file '
+else
+ let s:py_cmd = 'python ' "note space
+ let s:pyfile_cmd = 'pyfile '
+endif
+
+
+" =====================================================================
+" Functions used by global variable definitions
+" =====================================================================
+
+" Convert Cygwin path to Windows path, if needed
+function! s:Cygpath( path )
+ let path = a:path
+ if g:slimv_cygwin
+ let path = system( 'cygpath -w ' . path )
+ let path = substitute( path, "\n", "", "g" )
+ let path = substitute( path, "\\", "/", "g" )
+ endif
+ return path
+endfunction
+
+" Find swank.py in the Vim ftplugin directory (if not given in vimrc)
+if !exists( 'g:swank_path' )
+ let plugins = split( globpath( &runtimepath, 'ftplugin/**/swank.py'), '\n' )
+ if len( plugins ) > 0
+ let g:swank_path = s:Cygpath( plugins[0] )
+ else
+ let g:swank_path = 'swank.py'
+ endif
+endif
+
+" Get the filetype (Lisp dialect) used by Slimv
+function! SlimvGetFiletype()
+ if &ft != ''
+ " Return Vim filetype if defined
+ return &ft
+ endif
+
+ if match( tolower( g:slimv_lisp ), 'clojure' ) >= 0 || match( tolower( g:slimv_lisp ), 'clj' ) >= 0
+ " Must be Clojure
+ return 'clojure'
+ endif
+
+ " We have no clue, guess its lisp
+ return 'lisp'
+endfunction
+
+" Try to autodetect SWANK and build the command to start the SWANK server
+function! SlimvSwankCommand()
+ if exists( 'g:slimv_swank_clojure' ) && SlimvGetFiletype() =~ '.*clojure.*'
+ return g:slimv_swank_clojure
+ endif
+ if exists( 'g:slimv_swank_scheme' ) && SlimvGetFiletype() == 'scheme'
+ return g:slimv_swank_scheme
+ endif
+ if exists( 'g:slimv_swank_cmd' )
+ return g:slimv_swank_cmd
+ endif
+
+ if g:slimv_lisp == ''
+ let g:slimv_lisp = input( 'Enter Lisp path (or fill g:slimv_lisp in your vimrc): ', '', 'file' )
+ endif
+
+ let cmd = SlimvSwankLoader()
+ if cmd != ''
+ if g:slimv_windows || g:slimv_cygwin
+ return '!start /MIN ' . cmd
+ elseif g:slimv_osx
+ let result = system('osascript -e "exists application \"iterm\""')
+ if result[:-2] == 'true'
+ let path2as = globpath( &runtimepath, 'ftplugin/**/iterm.applescript')
+ return '!' . path2as . ' ' . cmd
+ else
+ " doubles quotes within 'cmd' need to become '\\\"'
+ return '!osascript -e "tell application \"Terminal\" to do script \"' . escape(escape(cmd, '"'), '\"') . '\""'
+ endif
+ elseif $STY != ''
+ " GNU screen under Linux
+ return "! screen -X eval 'title swank' 'screen " . cmd . "' 'select swank'"
+ elseif $TMUX != ''
+ " tmux under Linux
+ return "! tmux new-window -d -n swank '" . cmd . "'"
+ elseif $DISPLAY == ''
+ " No X, no terminal multiplexer. Cannot run swank server.
+ call SlimvErrorWait( 'No X server. Run Vim from screen/tmux or start SWANK server manually.' )
+ return ''
+ else
+ " Must be Linux
+ return '! SWANK_PORT=' . g:swank_port . ' xterm -iconic -e ' . cmd . ' &'
+ endif
+ endif
+ return ''
+endfunction
+
+" =====================================================================
+" Global variable definitions
+" =====================================================================
+
+" Host name or IP address of the SWANK server
+if !exists( 'g:swank_host' )
+ let g:swank_host = 'localhost'
+endif
+
+" TCP port number to use for the SWANK server
+if !exists( 'g:swank_port' )
+ let g:swank_port = 4005
+endif
+
+" Find Lisp (if not given in vimrc)
+if !exists( 'g:slimv_lisp' )
+ let lisp = ['', '']
+ if exists( 'g:slimv_preferred' )
+ let lisp = SlimvAutodetect( tolower(g:slimv_preferred) )
+ endif
+ if lisp[0] == ''
+ let lisp = SlimvAutodetect( '' )
+ endif
+ let g:slimv_lisp = lisp[0]
+ if !exists( 'g:slimv_impl' )
+ let g:slimv_impl = lisp[1]
+ endif
+endif
+
+" Try to find out the Lisp implementation
+" if not autodetected and not given in vimrc
+if !exists( 'g:slimv_impl' )
+ let g:slimv_impl = SlimvImplementation()
+endif
+
+" REPL buffer name
+if !exists( 'g:slimv_repl_name' )
+ let g:slimv_repl_name = 'REPL'
+endif
+
+" SLDB buffer name
+if !exists( 'g:slimv_sldb_name' )
+ let g:slimv_sldb_name = 'SLDB'
+endif
+
+" INSPECT buffer name
+if !exists( 'g:slimv_inspect_name' )
+ let g:slimv_inspect_name = 'INSPECT'
+endif
+
+" THREADS buffer name
+if !exists( 'g:slimv_threads_name' )
+ let g:slimv_threads_name = 'THREADS'
+endif
+
+" Shall we open REPL buffer in split window?
+if !exists( 'g:slimv_repl_split' )
+ let g:slimv_repl_split = 1
+endif
+
+" Wrap long lines in REPL buffer
+if !exists( 'g:slimv_repl_wrap' )
+ let g:slimv_repl_wrap = 1
+endif
+
+" Wrap long lines in SLDB buffer
+if !exists( 'g:slimv_sldb_wrap' )
+ let g:slimv_sldb_wrap = 0
+endif
+
+" Maximum number of lines echoed from the evaluated form
+if !exists( 'g:slimv_echolines' )
+ let g:slimv_echolines = 4
+endif
+
+" Syntax highlighting for the REPL buffer
+if !exists( 'g:slimv_repl_syntax' )
+ let g:slimv_repl_syntax = 1
+endif
+
+" Specifies the behaviour of insert mode <CR>, <Up>, <Down> in the REPL buffer:
+" 1: <CR> evaluates, <Up>/<Down> brings up command history
+" 0: <C-CR> evaluates, <C-Up>/<C-Down> brings up command history,
+" <CR> opens new line, <Up>/<Down> moves cursor up/down
+if !exists( 'g:slimv_repl_simple_eval' )
+ let g:slimv_repl_simple_eval = 1
+endif
+
+" Alternative value (in msec) for 'updatetime' while the REPL buffer is changing
+if !exists( 'g:slimv_updatetime' )
+ let g:slimv_updatetime = 500
+endif
+
+" Slimv keybinding set (0 = no keybindings)
+if !exists( 'g:slimv_keybindings' )
+ let g:slimv_keybindings = 1
+endif
+
+" Append Slimv menu to the global menu (0 = no menu)
+if !exists( 'g:slimv_menu' )
+ let g:slimv_menu = 1
+endif
+
+" Build the ctags command capable of generating lisp tags file
+" The command can be run with execute 'silent !' . g:slimv_ctags
+if !exists( 'g:slimv_ctags' )
+ let ctags = split( globpath( '$vim,$vimruntime', 'ctags.exe' ), '\n' )
+ if len( ctags ) > 0
+ " Remove -a option to regenerate every time
+ let g:slimv_ctags = '"' . ctags[0] . '" -a --language-force=lisp *.lisp *.clj'
+ endif
+endif
+
+" Name of tags file used by slimv for find-definitions
+" If this is the empty string then no tags file is used
+if !exists( 'g:slimv_tags_file' )
+ let g:slimv_tags_file = tempname()
+endif
+
+" Prepend tags file to the tags list
+if g:slimv_tags_file != ''
+ if &tags == ''
+ let &tags=g:slimv_tags_file
+ else
+ let &tags=g:slimv_tags_file . ',' . &tags
+ endif
+endif
+
+" Package/namespace handling
+if !exists( 'g:slimv_package' )
+ let g:slimv_package = 1
+endif
+
+" General timeout for various startup and connection events (seconds)
+if !exists( 'g:slimv_timeout' )
+ let g:slimv_timeout = 20
+endif
+
+" Use balloonexpr to display symbol description
+if !exists( 'g:slimv_balloon' )
+ let g:slimv_balloon = 1
+endif
+
+" Shall we use simple or fuzzy completion?
+if !exists( 'g:slimv_simple_compl' )
+ let g:slimv_simple_compl = 0
+endif
+
+" Custom <Leader> for the Slimv plugin
+if !exists( 'g:slimv_leader' )
+ if exists( 'mapleader' ) && mapleader != ' '
+ let g:slimv_leader = mapleader
+ else
+ let g:slimv_leader = ','
+ endif
+endif
+
+" Maximum number of lines searched backwards for indenting special forms
+if !exists( 'g:slimv_indent_maxlines' )
+ let g:slimv_indent_maxlines = 50
+endif
+
+" Special indentation for keyword lists
+if !exists( 'g:slimv_indent_keylists' )
+ let g:slimv_indent_keylists = 1
+endif
+
+" Maximum length of the REPL buffer
+if !exists( 'g:slimv_repl_max_len' )
+ let g:slimv_repl_max_len = 0
+endif
+
+" =====================================================================
+" Template definitions
+" =====================================================================
+
+if !exists( 'g:slimv_template_apropos' )
+ if SlimvGetFiletype() =~ '.*clojure.*'
+ let g:slimv_template_apropos = '(find-doc "%1")'
+ else
+ let g:slimv_template_apropos = '(apropos "%1")'
+ endif
+endif
+
+
+" =====================================================================
+" Other non-global script variables
+" =====================================================================
+
+let s:indent = '' " Most recent indentation info
+let s:last_update = 0 " The last update time for the REPL buffer
+let s:save_updatetime = &updatetime " The original value for 'updatetime'
+let s:save_showmode = &showmode " The original value for 'showmode'
+let s:python_initialized = 0 " Is the embedded Python initialized?
+let s:swank_version = '' " SWANK server version string
+let s:swank_connected = 0 " Is the SWANK server connected?
+let s:swank_package = '' " Package to use at the next SWANK eval
+let s:swank_package_form = '' " The entire form that was used to set current package
+let s:swank_form = '' " Form to send to SWANK
+let s:refresh_disabled = 0 " Set this variable temporarily to avoid recursive REPL rehresh calls
+let s:sldb_level = -1 " Are we in the SWANK debugger? -1 == no, else SLDB level
+let s:break_on_exception = 0 " Enable debugger break on exceptions (for ritz-swank)
+let s:compiled_file = '' " Name of the compiled file
+let s:win_id = 0 " Counter for generating unique window id
+let s:repl_buf = -1 " Buffer number for the REPL buffer
+let s:current_buf = -1 " Swank action was requested from this buffer
+let s:current_win = 0 " Swank action was requested from this window
+let s:read_string_mode = 0 " Read string mode indicator
+let s:arglist_line = 0 " Arglist was requested in this line ...
+let s:arglist_col = 0 " ... and column
+let s:inspect_path = [] " Inspection path of the current object
+let s:skip_sc = 'synIDattr(synID(line("."), col("."), 0), "name") =~ "[Ss]tring\\|[Cc]omment"'
+ " Skip matches inside string or comment
+let s:skip_q = 'getline(".")[col(".")-2] == "\\"' " Skip escaped double quote characters in matches
+let s:frame_def = '^\s\{0,2}\d\{1,}:' " Regular expression to match SLDB restart or frame identifier
+let s:spec_indent = 'flet\|labels\|macrolet\|symbol-macrolet'
+ " List of symbols need special indenting
+let s:spec_param = 'defmacro' " List of symbols with special parameter list
+let s:binding_form = 'let\|let\*' " List of symbols with binding list
+
+" =====================================================================
+" General utility functions
+" =====================================================================
+
+" Check that current SWANK version is same or newer than the given parameter
+function! s:SinceVersion( ver )
+ " Before ver 2.18 SWANK version string was a date of form YYYY-MM-DD
+ if len( a:ver ) >= 8
+ " Checking for old style version string YYYY-MM-DD
+ if len( s:swank_version ) < 8
+ " Current version is new style -> must be newer than the one we are checking for
+ return 1
+ endif
+ else
+ " Checking for new style version string X.XX
+ if len( s:swank_version ) >= 8
+ " Current version is old style -> must be older than the one we are checking for
+ return 0
+ endif
+ endif
+ if s:swank_version >= a:ver
+ return 1
+ else
+ return 0
+ endif
+endfunction
+
+" Display an error message
+function! SlimvError( msg )
+ echohl ErrorMsg
+ echo a:msg
+ echohl None
+endfunction
+
+" Display an error message and a question, return user response
+function! SlimvErrorAsk( msg, question )
+ echohl ErrorMsg
+ let answer = input( a:msg . a:question )
+ echo ""
+ echohl None
+ return answer
+endfunction
+
+" Display an error message and wait for ENTER
+function! SlimvErrorWait( msg )
+ call SlimvErrorAsk( a:msg, " Press ENTER to continue." )
+endfunction
+
+" Shorten long messages to fit status line
+function! SlimvShortEcho( msg )
+ let saved=&shortmess
+ set shortmess+=T
+ exe "normal :echomsg a:msg\n"
+ let &shortmess=saved
+endfunction
+
+" Go to the end of buffer, make sure the cursor is positioned
+" after the last character of the buffer when in insert mode
+function s:EndOfBuffer()
+ normal! G$
+ if &virtualedit != 'all'
+ call cursor( line('$'), 99999 )
+ endif
+endfunction
+
+" Position the cursor at the end of the REPL buffer
+" Optionally mark this position in Vim mark 's'
+function! SlimvEndOfReplBuffer( force )
+ if line( '.' ) >= b:repl_prompt_line - 1 || a:force
+ " Go to the end of file only if the user did not move up from here
+ call s:EndOfBuffer()
+ endif
+endfunction
+
+" Remember the end of the REPL buffer: user may enter commands here
+" Also remember the prompt, because the user may overwrite it
+function! SlimvMarkBufferEnd( force )
+ if exists( 'b:slimv_repl_buffer' )
+ setlocal nomodified
+ call SlimvEndOfReplBuffer( a:force )
+ let b:repl_prompt_line = line( '$' )
+ let b:repl_prompt_col = len( getline('$') ) + 1
+ let b:repl_prompt = getline( b:repl_prompt_line )
+ endif
+endfunction
+
+" Get REPL prompt line. Fix stored prompt position when corrupted
+" (e.g. some lines were deleted from the REPL buffer)
+function! s:GetPromptLine()
+ if b:repl_prompt_line > line( '$' )
+ " Stored prompt line is corrupt
+ let b:repl_prompt_line = line( '$' )
+ let b:repl_prompt_col = len( getline('$') ) + 1
+ let b:repl_prompt = getline( b:repl_prompt_line )
+ endif
+ return b:repl_prompt_line
+endfunction
+
+" Generate unique window id for the current window
+function s:MakeWindowId()
+ if g:slimv_repl_split && !exists('w:id')
+ let s:win_id = s:win_id + 1
+ let w:id = s:win_id
+ endif
+endfunction
+
+" Find and switch to window with the specified window id
+function s:SwitchToWindow( id )
+ for winnr in range( 1, winnr('$') )
+ if getwinvar( winnr, 'id' ) is a:id
+ execute winnr . "wincmd w"
+ endif
+ endfor
+endfunction
+
+" Save caller buffer identification
+function! SlimvBeginUpdate()
+ call s:MakeWindowId()
+ let s:current_buf = bufnr( "%" )
+ let s:current_win = getwinvar( winnr(), 'id' )
+endfunction
+
+" Switch to the buffer/window that was active before a swank action
+function! SlimvRestoreFocus( hide_current_buf )
+ if exists("b:previous_buf")
+ let new_buf = b:previous_buf
+ let new_win = b:previous_win
+ else
+ let new_buf = s:current_buf
+ let new_win = s:current_win
+ endif
+ let buf = bufnr( "%" )
+ let win = getwinvar( winnr(), 'id' )
+ if a:hide_current_buf
+ set nobuflisted
+ b #
+ endif
+ if winnr('$') > 1 && new_win != '' && new_win != win
+ " Switch to the caller window
+ call s:SwitchToWindow( new_win )
+ endif
+ if new_buf >= 0 && buf != new_buf
+ " Switch to the caller buffer
+ execute "buf " . new_buf
+ endif
+endfunction
+
+" Handle response coming from the SWANK listener
+function! SlimvSwankResponse()
+ let s:swank_ok_result = ''
+ let s:refresh_disabled = 1
+ silent execute s:py_cmd . 'swank_output(1)'
+ let s:refresh_disabled = 0
+ let s:swank_action = ''
+ let s:swank_result = ''
+ silent execute s:py_cmd . 'swank_response("")'
+
+ if s:swank_action == ':describe-symbol' && s:swank_result != ''
+ echo substitute(s:swank_result,'^\n*','','')
+ elseif s:swank_ok_result != ''
+ " Display the :ok result also in status bar in case the REPL buffer is not shown
+ let s:swank_ok_result = substitute(s:swank_ok_result,"\<LF>",'','g')
+ if s:swank_ok_result == ''
+ call SlimvShortEcho( '=> OK' )
+ else
+ call SlimvShortEcho( '=> ' . s:swank_ok_result )
+ endif
+ endif
+ if s:swank_actions_pending
+ let s:last_update = -1
+ elseif s:last_update < 0
+ " Remember the time when all actions are processed
+ let s:last_update = localtime()
+ endif
+ if s:swank_actions_pending == 0 && s:last_update >= 0 && s:last_update < localtime() - 2
+ " All SWANK output handled long ago, restore original update frequency
+ let &updatetime = s:save_updatetime
+ else
+ " SWANK output still pending, keep higher update frequency
+ let &updatetime = g:slimv_updatetime
+ endif
+endfunction
+
+" Execute the given command and write its output at the end of the REPL buffer
+function! SlimvCommand( cmd )
+ silent execute a:cmd
+ if g:slimv_updatetime < &updatetime
+ " Update more frequently until all swank responses processed
+ let &updatetime = g:slimv_updatetime
+ let s:last_update = -1
+ endif
+endfunction
+
+" Execute the given SWANK command, wait for and return the response
+function! SlimvCommandGetResponse( name, cmd, timeout )
+ let s:refresh_disabled = 1
+ call SlimvCommand( a:cmd )
+ let s:swank_action = ''
+ let s:swank_result = ''
+ let starttime = localtime()
+ let cmd_timeout = a:timeout
+ if cmd_timeout == 0
+ let cmd_timeout = 3
+ endif
+ while s:swank_action == '' && localtime()-starttime < cmd_timeout
+ execute s:py_cmd . "swank_output( 0 )"
+ silent execute s:py_cmd . 'swank_response("' . a:name . '")'
+ endwhile
+ let s:refresh_disabled = 0
+ return s:swank_result
+endfunction
+
+" Reload the contents of the REPL buffer from the output file if changed
+function! SlimvRefreshReplBuffer()
+ if s:refresh_disabled
+ " Refresh is unwanted at the moment, probably another refresh is going on
+ return
+ endif
+
+ if s:repl_buf == -1
+ " REPL buffer not loaded
+ return
+ endif
+
+ if s:swank_connected
+ call SlimvSwankResponse()
+ endif
+
+ if exists("s:input_prompt") && s:input_prompt != ''
+ let answer = input( s:input_prompt )
+ unlet s:input_prompt
+ echo ""
+ call SlimvCommand( s:py_cmd . 'swank_return("' . answer . '")' )
+ endif
+endfunction
+
+" This function re-triggers the CursorHold event
+" after refreshing the REPL buffer
+function! SlimvTimer()
+ if v:count > 0
+ " Skip refreshing if the user started a command prefixed with a count
+ return
+ endif
+ " We don't want autocommands trigger during the quick switch to/from the REPL buffer
+ noautocmd call SlimvRefreshReplBuffer()
+ if mode() == 'i' || mode() == 'I' || mode() == 'r' || mode() == 'R'
+ if bufname('%') != g:slimv_sldb_name && bufname('%') != g:slimv_inspect_name && bufname('%') != g:slimv_threads_name
+ " Put '<Insert>' twice into the typeahead buffer, which should not do anything
+ " just switch to replace/insert mode then back to insert/replace mode
+ " But don't do this for readonly buffers
+ call feedkeys("\<insert>\<insert>")
+ endif
+ else
+ " Put an incomplete 'f' command and an Esc into the typeahead buffer
+ call feedkeys("f\e", 'n')
+ endif
+endfunction
+
+" Switch refresh mode on:
+" refresh REPL buffer on frequent Vim events
+function! SlimvRefreshModeOn()
+ augroup SlimvCursorHold
+ au!
+ execute "au CursorHold * :call SlimvTimer()"
+ execute "au CursorHoldI * :call SlimvTimer()"
+ augroup END
+endfunction
+
+" Switch refresh mode off
+function! SlimvRefreshModeOff()
+ augroup SlimvCursorHold
+ au!
+ augroup END
+endfunction
+
+" Called when entering REPL buffer
+function! SlimvReplEnter()
+ call SlimvAddReplMenu()
+ augroup SlimvReplChanged
+ au!
+ execute "au FileChangedRO " . g:slimv_repl_name . " :call SlimvRefreshModeOff()"
+ augroup END
+ call SlimvRefreshModeOn()
+endfunction
+
+" Called when leaving REPL buffer
+function! SlimvReplLeave()
+ try
+ " Check if REPL menu exists, then remove it
+ aunmenu REPL
+ execute ':unmap ' . g:slimv_leader . '\'
+ catch /.*/
+ " REPL menu not found, we cannot remove it
+ endtry
+ if g:slimv_repl_split
+ call SlimvRefreshModeOn()
+ else
+ call SlimvRefreshModeOff()
+ endif
+endfunction
+
+" Refresh cursor position in the REPL buffer after new lines appended
+function! SlimvReplSetCursorPos( force )
+ " We do not want these autocommands to fire, the buffer switch will be temporary
+ let savemark = getpos("'`'")
+ let save_ei = &eventignore
+ set eventignore=BufEnter,BufLeave,BufWinEnter
+ let win = winnr()
+ windo call SlimvMarkBufferEnd( a:force )
+ execute win . "wincmd w"
+ let &eventignore = save_ei
+ call setpos("'`", savemark)
+endfunction
+
+" View the given file in a top/bottom/left/right split window
+function! s:SplitView( filename )
+ " Check if we have at least two windows used by slimv (have a window id assigned)
+ let winnr1 = 0
+ let winnr2 = 0
+ for winnr in range( 1, winnr('$') )
+ if getwinvar( winnr, 'id' ) != ''
+ let winnr2 = winnr1
+ let winnr1 = winnr
+ endif
+ endfor
+ if winnr1 > 0 && winnr2 > 0
+ " We have already at least two windows used by slimv
+ let winid = getwinvar( winnr(), 'id' )
+ if bufnr("%") == s:current_buf && winid == s:current_win
+ " Keep the current window on screen, use the other window for the new buffer
+ if winnr1 != winnr()
+ execute winnr1 . "wincmd w"
+ else
+ execute winnr2 . "wincmd w"
+ endif
+ endif
+ execute "silent view! " . a:filename
+ else
+ " Generate unique window id for the old window if not yet done
+ call s:MakeWindowId()
+ " No windows yet, need to split
+ if g:slimv_repl_split == 1
+ execute "silent topleft sview! " . a:filename
+ elseif g:slimv_repl_split == 2
+ execute "silent botright sview! " . a:filename
+ elseif g:slimv_repl_split == 3
+ execute "silent topleft vertical sview! " . a:filename
+ elseif g:slimv_repl_split == 4
+ execute "silent botright vertical sview! " . a:filename
+ else
+ execute "silent view! " . a:filename
+ endif
+ " Generate unique window id for the new window as well
+ call s:MakeWindowId()
+ endif
+ stopinsert
+endfunction
+
+" Open a buffer with the given name if not yet open, and switch to it
+function! SlimvOpenBuffer( name )
+ let buf = bufnr( '^' . a:name . '$' )
+ if buf == -1
+ " Create a new buffer
+ call s:SplitView( a:name )
+ else
+ if g:slimv_repl_split
+ " Buffer is already created. Check if it is open in a window
+ let win = bufwinnr( buf )
+ if win == -1
+ " Create windows
+ call s:SplitView( a:name )
+ else
+ " Switch to the buffer's window
+ if winnr() != win
+ execute win . "wincmd w"
+ endif
+ endif
+ else
+ execute "buffer " . buf
+ stopinsert
+ endif
+ endif
+ if s:current_buf != bufnr( "%" )
+ " Keep track of the previous buffer and window
+ let b:previous_buf = s:current_buf
+ let b:previous_win = s:current_win
+ endif
+ setlocal buftype=nofile
+ setlocal noswapfile
+ setlocal modifiable
+endfunction
+
+" Go to the end of the screen line
+function s:EndOfScreenLine()
+ if len(getline('.')) < &columns
+ " g$ moves the cursor to the rightmost column if virtualedit=all
+ normal! $
+ else
+ normal! g$
+ endif
+endfunction
+
+" Set special syntax rules for the REPL buffer
+function! SlimvSetSyntaxRepl()
+ if SlimvGetFiletype() == 'scheme'
+ syn cluster replListCluster contains=@schemeListCluster,lispList
+ else
+ syn cluster replListCluster contains=@lispListCluster
+ endif
+
+if exists("g:lisp_rainbow") && g:lisp_rainbow != 0
+
+ if &bg == "dark"
+ hi def hlLevel0 ctermfg=red guifg=red1
+ hi def hlLevel1 ctermfg=yellow guifg=orange1
+ hi def hlLevel2 ctermfg=green guifg=yellow1
+ hi def hlLevel3 ctermfg=cyan guifg=greenyellow
+ hi def hlLevel4 ctermfg=magenta guifg=green1
+ hi def hlLevel5 ctermfg=red guifg=springgreen1
+ hi def hlLevel6 ctermfg=yellow guifg=cyan1
+ hi def hlLevel7 ctermfg=green guifg=slateblue1
+ hi def hlLevel8 ctermfg=cyan guifg=magenta1
+ hi def hlLevel9 ctermfg=magenta guifg=purple1
+ else
+ hi def hlLevel0 ctermfg=red guifg=red3
+ hi def hlLevel1 ctermfg=darkyellow guifg=orangered3
+ hi def hlLevel2 ctermfg=darkgreen guifg=orange2
+ hi def hlLevel3 ctermfg=blue guifg=yellow3
+ hi def hlLevel4 ctermfg=darkmagenta guifg=olivedrab4
+ hi def hlLevel5 ctermfg=red guifg=green4
+ hi def hlLevel6 ctermfg=darkyellow guifg=paleturquoise3
+ hi def hlLevel7 ctermfg=darkgreen guifg=deepskyblue4
+ hi def hlLevel8 ctermfg=blue guifg=darkslateblue
+ hi def hlLevel9 ctermfg=darkmagenta guifg=darkviolet
+ endif
+
+ if SlimvGetFiletype() =~ '.*\(clojure\|scheme\|racket\).*'
+
+ syn region lispParen9 matchgroup=hlLevel9 start="`\=(" matchgroup=hlLevel9 end=")" matchgroup=replPrompt end="^\S\+>" contains=TOP,@Spell
+ syn region lispParen0 matchgroup=hlLevel8 start="`\=(" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen0,lispParen1,lispParen2,lispParen3,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen1 matchgroup=hlLevel7 start="`\=(" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen1,lispParen2,lispParen3,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen2 matchgroup=hlLevel6 start="`\=(" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen2,lispParen3,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen3 matchgroup=hlLevel5 start="`\=(" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen3,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen4 matchgroup=hlLevel4 start="`\=(" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen5 matchgroup=hlLevel3 start="`\=(" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen6 matchgroup=hlLevel2 start="`\=(" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen7 matchgroup=hlLevel1 start="`\=(" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen7,lispParen8,NoInParens
+ syn region lispParen8 matchgroup=hlLevel0 start="`\=(" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen8,NoInParens
+
+ syn region lispParen9 matchgroup=hlLevel9 start="`\=\[" matchgroup=hlLevel9 end="\]" matchgroup=replPrompt end="^\S\+>" contains=TOP,@Spell
+ syn region lispParen0 matchgroup=hlLevel8 start="`\=\[" end="\]" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen0,lispParen1,lispParen2,lispParen3,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen1 matchgroup=hlLevel7 start="`\=\[" end="\]" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen1,lispParen2,lispParen3,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen2 matchgroup=hlLevel6 start="`\=\[" end="\]" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen2,lispParen3,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen3 matchgroup=hlLevel5 start="`\=\[" end="\]" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen3,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen4 matchgroup=hlLevel4 start="`\=\[" end="\]" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen5 matchgroup=hlLevel3 start="`\=\[" end="\]" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen6 matchgroup=hlLevel2 start="`\=\[" end="\]" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen7 matchgroup=hlLevel1 start="`\=\[" end="\]" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen7,lispParen8,NoInParens
+ syn region lispParen8 matchgroup=hlLevel0 start="`\=\[" end="\]" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen8,NoInParens
+
+ syn region lispParen9 matchgroup=hlLevel9 start="`\={" matchgroup=hlLevel9 end="}" matchgroup=replPrompt end="^\S\+>" contains=TOP,@Spell
+ syn region lispParen0 matchgroup=hlLevel8 start="`\={" end="}" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen0,lispParen1,lispParen2,lispParen3,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen1 matchgroup=hlLevel7 start="`\={" end="}" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen1,lispParen2,lispParen3,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen2 matchgroup=hlLevel6 start="`\={" end="}" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen2,lispParen3,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen3 matchgroup=hlLevel5 start="`\={" end="}" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen3,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen4 matchgroup=hlLevel4 start="`\={" end="}" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen4,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen5 matchgroup=hlLevel3 start="`\={" end="}" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen5,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen6 matchgroup=hlLevel2 start="`\={" end="}" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen6,lispParen7,lispParen8,NoInParens
+ syn region lispParen7 matchgroup=hlLevel1 start="`\={" end="}" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen7,lispParen8,NoInParens
+ syn region lispParen8 matchgroup=hlLevel0 start="`\={" end="}" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=TOP,lispParen8,NoInParens
+
+ else
+
+ syn region lispParen0 matchgroup=hlLevel0 start="`\=(" skip="|.\{-}|" end=")" matchgroup=replPrompt end="^\S\+>" contains=@replListCluster,lispParen1,replPrompt
+ syn region lispParen1 contained matchgroup=hlLevel1 start="`\=(" skip="|.\{-}|" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=@replListCluster,lispParen2
+ syn region lispParen2 contained matchgroup=hlLevel2 start="`\=(" skip="|.\{-}|" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=@replListCluster,lispParen3
+ syn region lispParen3 contained matchgroup=hlLevel3 start="`\=(" skip="|.\{-}|" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=@replListCluster,lispParen4
+ syn region lispParen4 contained matchgroup=hlLevel4 start="`\=(" skip="|.\{-}|" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=@replListCluster,lispParen5
+ syn region lispParen5 contained matchgroup=hlLevel5 start="`\=(" skip="|.\{-}|" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=@replListCluster,lispParen6
+ syn region lispParen6 contained matchgroup=hlLevel6 start="`\=(" skip="|.\{-}|" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=@replListCluster,lispParen7
+ syn region lispParen7 contained matchgroup=hlLevel7 start="`\=(" skip="|.\{-}|" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=@replListCluster,lispParen8
+ syn region lispParen8 contained matchgroup=hlLevel8 start="`\=(" skip="|.\{-}|" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=@replListCluster,lispParen9
+ syn region lispParen9 contained matchgroup=hlLevel9 start="`\=(" skip="|.\{-}|" end=")" matchgroup=replPrompt end="^\S\+>"me=s-1,re=s-1 contains=@replListCluster,lispParen0
+
+ endif
+
+else
+
+ if SlimvGetFiletype() !~ '.*clojure.*'
+ syn region lispList matchgroup=Delimiter start="(" skip="|.\{-}|" end=")" matchgroup=replPrompt end="^\S\+>" contains=@replListCluster
+ syn region lispBQList matchgroup=PreProc start="`(" skip="|.\{-}|" end=")" matchgroup=replPrompt end="^\S\+>" contains=@replListCluster
+ endif
+
+endif
+
+ syn match replPrompt /^[^(]\S\+>/
+ syn match replPrompt /^(\S\+)>/
+ hi def link replPrompt Type
+endfunction
+
+" Open a new REPL buffer
+function! SlimvOpenReplBuffer()
+ call SlimvOpenBuffer( g:slimv_repl_name )
+ setlocal noreadonly
+ let s:repl_buf = bufnr( "%" )
+ let b:slimv_repl_buffer = 1
+ call SlimvInitRepl()
+ if g:slimv_repl_syntax
+ call SlimvSetSyntaxRepl()
+ else
+ set syntax=
+ endif
+
+ " Prompt and its line and column number in the REPL buffer
+ if !exists( 'b:repl_prompt' )
+ let b:repl_prompt = ''
+ let b:repl_prompt_line = 1
+ let b:repl_prompt_col = 1
+ endif
+
+ " Add keybindings valid only for the REPL buffer
+ inoremap <buffer> <silent> <C-CR> <End><C-O>:call SlimvSendCommand(1)<CR><End>
+ inoremap <buffer> <silent> <C-C> <C-O>:call SlimvInterrupt()<CR>
+ inoremap <buffer> <silent> <expr> <C-W> SlimvHandleCW()
+
+ if g:slimv_repl_simple_eval
+ inoremap <buffer> <silent> <CR> <C-R>=pumvisible() ? "\<lt>C-Y>" : "\<lt>End>\<lt>C-O>:call SlimvSendCommand(0)\<lt>CR>\<lt>End>"<CR>
+ inoremap <buffer> <silent> <Up> <C-R>=pumvisible() ? "\<lt>Up>" : SlimvHandleUp()<CR>
+ inoremap <buffer> <silent> <Down> <C-R>=pumvisible() ? "\<lt>Down>" : SlimvHandleDown()<CR>
+ else
+ inoremap <buffer> <silent> <CR> <C-R>=pumvisible() ? "\<lt>C-Y>" : SlimvHandleEnterRepl()<CR><C-R>=SlimvArglistOnEnter()<CR>
+ inoremap <buffer> <silent> <C-Up> <C-R>=pumvisible() ? "\<lt>Up>" : SlimvHandleUp()<CR>
+ inoremap <buffer> <silent> <C-Down> <C-R>=pumvisible() ? "\<lt>Down>" : SlimvHandleDown()<CR>
+ endif
+
+ if exists( 'g:paredit_loaded' )
+ inoremap <buffer> <silent> <expr> <BS> PareditBackspace(1)
+ else
+ inoremap <buffer> <silent> <expr> <BS> SlimvHandleBS()
+ endif
+
+ if g:slimv_keybindings == 1
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'. :call SlimvSendCommand(0)<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'/ :call SlimvSendCommand(1)<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'<Up> :call SlimvPreviousCommand()<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'<Down> :call SlimvNextCommand()<CR>'
+ elseif g:slimv_keybindings == 2
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'rs :call SlimvSendCommand(0)<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'ro :call SlimvSendCommand(1)<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'rp :call SlimvPreviousCommand()<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'rn :call SlimvNextCommand()<CR>'
+ endif
+
+ if g:slimv_repl_wrap
+ inoremap <buffer> <silent> <Home> <C-O>g<Home>
+ inoremap <buffer> <silent> <End> <C-O>:call <SID>EndOfScreenLine()<CR>
+ noremap <buffer> <silent> <Up> gk
+ noremap <buffer> <silent> <Down> gj
+ noremap <buffer> <silent> <Home> g<Home>
+ noremap <buffer> <silent> <End> :call <SID>EndOfScreenLine()<CR>
+ noremap <buffer> <silent> k gk
+ noremap <buffer> <silent> j gj
+ noremap <buffer> <silent> 0 g0
+ noremap <buffer> <silent> $ :call <SID>EndOfScreenLine()<CR>
+ setlocal wrap
+ endif
+
+ hi SlimvNormal term=none cterm=none gui=none
+ hi SlimvCursor term=reverse cterm=reverse gui=reverse
+
+ augroup SlimvReplAutoCmd
+ au!
+ " Add autocommands specific to the REPL buffer
+ execute "au FileChangedShell " . g:slimv_repl_name . " :call SlimvRefreshReplBuffer()"
+ execute "au FocusGained " . g:slimv_repl_name . " :call SlimvRefreshReplBuffer()"
+ execute "au BufEnter " . g:slimv_repl_name . " :call SlimvReplEnter()"
+ execute "au BufLeave " . g:slimv_repl_name . " :call SlimvReplLeave()"
+ execute "au BufWinEnter " . g:slimv_repl_name . " :call SlimvMarkBufferEnd(1)"
+ execute "au TabEnter *" . " :call SlimvReplSetCursorPos(1)"
+ augroup END
+
+ call SlimvRefreshReplBuffer()
+endfunction
+
+" Clear the contents of the REPL buffer, keeping the last prompt only
+function! SlimvClearReplBuffer()
+ let this_buf = bufnr( "%" )
+ if s:repl_buf == -1
+ call SlimvError( "There is no REPL buffer." )
+ return
+ endif
+ if this_buf != s:repl_buf
+ let oldpos = winsaveview()
+ execute "buf " . s:repl_buf
+ endif
+ if b:repl_prompt_line > 1
+ execute "normal! gg0d" . (b:repl_prompt_line-1) . "GG$"
+ let b:repl_prompt_line = 1
+ endif
+ if this_buf != s:repl_buf
+ execute "buf " . this_buf
+ call winrestview( oldpos )
+ endif
+endfunction
+
+" Open a new Inspect buffer
+function SlimvOpenInspectBuffer()
+ call SlimvOpenBuffer( g:slimv_inspect_name )
+ let b:range_start = 0
+ let b:range_end = 0
+ let b:help = SlimvHelpInspect()
+
+ " Add keybindings valid only for the Inspect buffer
+ noremap <buffer> <silent> <F1> :call SlimvToggleHelp()<CR>
+ noremap <buffer> <silent> <CR> :call SlimvHandleEnterInspect()<CR>
+ noremap <buffer> <silent> <Backspace> :call SlimvSendSilent(['[-1]'])<CR>
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'q :call SlimvQuitInspect(1)<CR>'
+
+ if version < 703
+ " conceal mechanism is defined since Vim 7.3
+ syn region inspectItem matchgroup=Ignore start="{\[\d\+\]\s*" end="\[]}"
+ syn region inspectAction matchgroup=Ignore start="{<\d\+>\s*" end="<>}"
+ else
+ syn region inspectItem matchgroup=Ignore start="{\[\d\+\]\s*" end="\[]}" concealends
+ syn region inspectAction matchgroup=Ignore start="{<\d\+>\s*" end="<>}" concealends
+ setlocal conceallevel=3 concealcursor=nc
+ endif
+
+ hi def link inspectItem Special
+ hi def link inspectAction String
+
+ syn match Special /^\[<<\].*$/
+ syn match Special /^\[--....--\]$/
+endfunction
+
+" Open a new Threads buffer
+function SlimvOpenThreadsBuffer()
+ call SlimvOpenBuffer( g:slimv_threads_name )
+ let b:help = SlimvHelpThreads()
+
+ " Add keybindings valid only for the Threads buffer
+ "noremap <buffer> <silent> <CR> :call SlimvHandleEnterThreads()<CR>
+ noremap <buffer> <silent> <F1> :call SlimvToggleHelp()<CR>
+ noremap <buffer> <silent> <Backspace> :call SlimvKillThread()<CR>
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'r :call SlimvListThreads()<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'d :call SlimvDebugThread()<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'k :call SlimvKillThread()<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'q :call SlimvQuitThreads()<CR>'
+endfunction
+
+" Open a new SLDB buffer
+function SlimvOpenSldbBuffer()
+ call SlimvOpenBuffer( g:slimv_sldb_name )
+
+ " Add keybindings valid only for the SLDB buffer
+ noremap <buffer> <silent> <CR> :call SlimvHandleEnterSldb()<CR>
+ if g:slimv_keybindings == 1
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'a :call SlimvDebugAbort()<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'q :call SlimvDebugQuit()<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'n :call SlimvDebugContinue()<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'N :call SlimvDebugRestartFrame()<CR>'
+ elseif g:slimv_keybindings == 2
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'da :call SlimvDebugAbort()<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'dq :call SlimvDebugQuit()<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'dn :call SlimvDebugContinue()<CR>'
+ execute 'noremap <buffer> <silent> ' . g:slimv_leader.'dr :call SlimvDebugRestartFrame()<CR>'
+ endif
+
+ " Set folding parameters
+ setlocal foldmethod=marker
+ setlocal foldmarker={{{,}}}
+ setlocal foldtext=substitute(getline(v:foldstart),'{{{','','')
+ call s:SetKeyword()
+ if g:slimv_sldb_wrap
+ setlocal wrap
+ endif
+
+ if version < 703
+ " conceal mechanism is defined since Vim 7.3
+ syn match Ignore /{{{/
+ syn match Ignore /}}}/
+ else
+ setlocal conceallevel=3 concealcursor=nc
+ syn match Comment /{{{/ conceal
+ syn match Comment /}}}/ conceal
+ endif
+ syn match Type /^\s\{0,2}\d\{1,3}:/
+ syn match Type /^\s\+in "\(.*\)" \(line\|byte\) \(\d\+\)$/
+endfunction
+
+" End updating an otherwise readonly buffer
+function SlimvEndUpdate()
+ setlocal nomodifiable
+ setlocal nomodified
+endfunction
+
+" Quit Inspector
+function SlimvQuitInspect( force )
+ " Clear the contents of the Inspect buffer
+ if exists( 'b:inspect_pos' )
+ unlet b:inspect_pos
+ endif
+ setlocal modifiable
+ silent! %d _
+ call SlimvEndUpdate()
+ if a:force
+ call SlimvCommand( s:py_cmd . 'swank_quit_inspector()' )
+ endif
+ call SlimvRestoreFocus(1)
+endfunction
+
+" Quit Threads
+function SlimvQuitThreads()
+ " Clear the contents of the Threads buffer
+ setlocal modifiable
+ silent! %d _
+ call SlimvEndUpdate()
+ call SlimvRestoreFocus(1)
+endfunction
+
+" Quit Sldb
+function SlimvQuitSldb()
+ " Clear the contents of the Sldb buffer
+ setlocal modifiable
+ silent! %d _
+ call SlimvEndUpdate()
+ call SlimvRestoreFocus(1)
+endfunction
+
+" Create help text for Inspect buffer
+function SlimvHelpInspect()
+ let help = []
+ call add( help, '<F1> : toggle this help' )
+ call add( help, '<Enter> : open object or select action under cursor' )
+ call add( help, '<Backspace> : go back to previous object' )
+ call add( help, g:slimv_leader . 'q : quit' )
+ return help
+endfunction
+
+" Create help text for Threads buffer
+function SlimvHelpThreads()
+ let help = []
+ call add( help, '<F1> : toggle this help' )
+ call add( help, '<Backspace> : kill thread' )
+ call add( help, g:slimv_leader . 'k : kill thread' )
+ call add( help, g:slimv_leader . 'd : debug thread' )
+ call add( help, g:slimv_leader . 'r : refresh' )
+ call add( help, g:slimv_leader . 'q : quit' )
+ return help
+endfunction
+
+" Write help text to current buffer at given line
+function SlimvHelp( line )
+ setlocal modifiable
+ if exists( 'b:help_shown' )
+ let help = b:help
+ else
+ let help = ['Press <F1> for Help']
+ endif
+ let b:help_line = a:line
+ call append( b:help_line, help )
+endfunction
+
+" Toggle help
+function SlimvToggleHelp()
+ if exists( 'b:help_shown' )
+ let lines = len( b:help )
+ unlet b:help_shown
+ else
+ let lines = 1
+ let b:help_shown = 1
+ endif
+ setlocal modifiable
+ execute ":" . (b:help_line+1) . "," . (b:help_line+lines) . "d"
+ call SlimvHelp( b:help_line )
+ call SlimvEndUpdate()
+endfunction
+
+" Open SLDB buffer and place cursor on the given frame
+function SlimvGotoFrame( frame )
+ call SlimvOpenSldbBuffer()
+ let bcktrpos = search( '^Backtrace:', 'bcnw' )
+ let line = getline( '.' )
+ let item = matchstr( line, '^\s*' . a:frame . ':' )
+ if item != '' && line('.') > bcktrpos
+ " Already standing on the frame
+ return
+ endif
+
+ " Must locate the frame starting from the 'Backtrace:' string
+ call search( '^Backtrace:', 'bcw' )
+ call search( '^\s*' . a:frame . ':', 'w' )
+endfunction
+
+" Set 'iskeyword' option depending on file type
+function! s:SetKeyword()
+ if SlimvGetFiletype() =~ '.*\(clojure\|scheme\|racket\).*'
+ setlocal iskeyword+=+,-,*,/,%,<,=,>,:,$,?,!,@-@,94,~,#,\|,&
+ else
+ setlocal iskeyword+=+,-,*,/,%,<,=,>,:,$,?,!,@-@,94,~,#,\|,&,.,{,},[,]
+ endif
+endfunction
+
+" Select symbol under cursor and return it
+function! SlimvSelectSymbol()
+ call s:SetKeyword()
+ let oldpos = winsaveview()
+ if col('.') > 1 && getline('.')[col('.')-1] =~ '\s'
+ normal! h
+ endif
+ let symbol = expand('<cword>')
+ call winrestview( oldpos )
+ return symbol
+endfunction
+
+" Select symbol with possible prefixes under cursor and return it
+function! SlimvSelectSymbolExt()
+ let save_iskeyword = &iskeyword
+ call s:SetKeyword()
+ setlocal iskeyword+='
+ let symbol = expand('<cword>')
+ let &iskeyword = save_iskeyword
+ return symbol
+endfunction
+
+" Select bottom level form the cursor is inside and copy it to register 's'
+function! SlimvSelectForm( extended )
+ if SlimvGetFiletype() == 'r'
+ silent! normal va(
+ silent! normal "sY
+ return 1
+ endif
+ " Search the opening '(' if we are standing on a special form prefix character
+ let c = col( '.' ) - 1
+ let firstchar = getline( '.' )[c]
+ while c < len( getline( '.' ) ) && match( "'`#", getline( '.' )[c] ) >= 0
+ normal! l
+ let c = c + 1
+ endwhile
+ normal! va(
+ let p1 = getpos('.')
+ normal! o
+ let p2 = getpos('.')
+ if firstchar != '(' && p1[1] == p2[1] && (p1[2] == p2[2] || p1[2] == p2[2]+1)
+ " Empty selection and no paren found, select current word instead
+ normal! aw
+ elseif a:extended || firstchar != '('
+ " Handle '() or #'() etc. type special syntax forms (but stop at prompt)
+ let c = col( '.' ) - 2
+ while c >= 0 && match( ' \t()>', getline( '.' )[c] ) < 0
+ normal! h
+ let c = c - 1
+ endwhile
+ endif
+ silent normal! "sy
+ let sel = SlimvGetSelection()
+ if sel == ''
+ call SlimvError( "Form is empty." )
+ return 0
+ elseif sel == '(' || sel == '[' || sel == '{'
+ call SlimvError( "Form is unbalanced." )
+ return 0
+ else
+ return 1
+ endif
+endfunction
+
+" Find starting '(' of a top level form
+function! SlimvFindDefunStart()
+ let l = line( '.' )
+ let matchb = max( [l-200, 1] )
+ if SlimvGetFiletype() == 'r'
+ while searchpair( '(', '', ')', 'bW', s:skip_sc, matchb ) || searchpair( '{', '', '}', 'bW', s:skip_sc, matchb ) || searchpair( '\[', '', '\]', 'bW', s:skip_sc, matchb )
+ endwhile
+ else
+ while searchpair( '(', '', ')', 'bW', s:skip_sc, matchb )
+ endwhile
+ endif
+endfunction
+
+" Select top level form the cursor is inside and copy it to register 's'
+function! SlimvSelectDefun()
+ call SlimvFindDefunStart()
+ if SlimvGetFiletype() == 'r'
+ " The cursor must be on the enclosing paren character
+ silent! normal v%"sY
+ return 1
+ else
+ return SlimvSelectForm( 1 )
+ endif
+endfunction
+
+" Return the contents of register 's'
+function! SlimvGetSelection()
+ return getreg( 's' )
+endfunction
+
+" Find language specific package/namespace definition backwards
+" Set it as the current package for the next swank action
+function! SlimvFindPackage()
+ if !g:slimv_package || SlimvGetFiletype() == 'scheme'
+ return
+ endif
+ let oldpos = winsaveview()
+ let save_ic = &ignorecase
+ set ignorecase
+ if SlimvGetFiletype() =~ '.*clojure.*'
+ let string = '\(in-ns\|ns\)'
+ else
+ let string = '\(cl:\|common-lisp:\|\)in-package'
+ endif
+ let found = 0
+ let searching = search( '(\s*' . string . '\s', 'bcW' )
+ while searching
+ " Search for the previos occurrence
+ if synIDattr( synID( line('.'), col('.'), 0), 'name' ) !~ '[Ss]tring\|[Cc]omment'
+ " It is not inside a comment or string
+ let found = 1
+ break
+ endif
+ let searching = search( '(\s*' . string . '\s', 'bW' )
+ endwhile
+ if found
+ " Find the package name with all folds open
+ normal! zn
+ silent normal! w
+ let l:package_command = expand('<cword>')
+ silent normal! w
+ let l:packagename_tokens = split(expand('<cWORD>'),')\|\s')
+ normal! zN
+ if l:packagename_tokens != []
+ " Remove quote character from package name
+ let s:swank_package = substitute( l:packagename_tokens[0], "'", '', '' )
+ let s:swank_package_form = "(" . l:package_command . " " . l:packagename_tokens[0] . ")\n"
+ else
+ let s:swank_package = ''
+ let s:swank_package_form = ''
+ endif
+ endif
+ let &ignorecase = save_ic
+ call winrestview( oldpos )
+endfunction
+
+" Execute the given SWANK command with current package defined
+function! SlimvCommandUsePackage( cmd )
+ call SlimvFindPackage()
+ let s:refresh_disabled = 1
+ call SlimvCommand( a:cmd )
+ let s:swank_package = ''
+ let s:swank_package_form = ''
+ let s:refresh_disabled = 0
+ call SlimvRefreshReplBuffer()
+endfunction
+
+" Initialize embedded Python and connect to SWANK server
+function! SlimvConnectSwank()
+ if !s:python_initialized
+ if ( s:py_cmd == 'python3 ' && ! has('python3') ) ||
+ \ ( s:py_cmd == 'python ' && ! has('python' ) )
+ call SlimvErrorWait( 'Vim is compiled without the Python feature or Python is not installed. Unable to run SWANK client.' )
+ return 0
+ endif
+ execute s:py_cmd . 'import vim'
+ execute s:pyfile_cmd . g:swank_path
+ let s:python_initialized = 1
+ endif
+
+
+ if !s:swank_connected
+ let s:swank_version = ''
+ let s:lisp_version = ''
+ if g:swank_host == ''
+ let g:swank_host = input( 'Swank server host name: ', 'localhost' )
+ endif
+ execute s:py_cmd . 'swank_connect("' . g:swank_host . '", ' . g:swank_port . ', "result" )'
+ if result != '' && ( g:swank_host == 'localhost' || g:swank_host == '127.0.0.1' )
+ " SWANK server is not running, start server if possible
+ let swank = SlimvSwankCommand()
+ if swank != ''
+ redraw
+ echon "\rStarting SWANK server..."
+ silent execute swank
+ let starttime = localtime()
+ while result != '' && localtime()-starttime < g:slimv_timeout
+ sleep 500m
+ execute s:py_cmd . 'swank_connect("' . g:swank_host . '", ' . g:swank_port . ', "result" )'
+ endwhile
+ redraw!
+ endif
+ endif
+ if result != ''
+ " Display connection error message
+ call SlimvErrorWait( result )
+ return 0
+ endif
+
+ " Connected to SWANK server
+ redraw
+ echon "\rGetting SWANK connection info..."
+ let starttime = localtime()
+ while s:swank_version == '' && localtime()-starttime < g:slimv_timeout
+ call SlimvSwankResponse()
+ endwhile
+
+ " Require some contribs
+ let contribs = 'swank-presentations swank-fancy-inspector swank-c-p-c swank-arglists'
+ if SlimvGetFiletype() == 'lisp'
+ let contribs = 'swank-asdf swank-package-fu ' . contribs
+ endif
+ if g:slimv_simple_compl == 0
+ let contribs = contribs . ' swank-fuzzy'
+ endif
+ execute s:py_cmd . "swank_require('(" . contribs . ")')"
+ call SlimvSwankResponse()
+ if s:SinceVersion( '2011-12-04' )
+ execute s:py_cmd . "swank_require('swank-repl')"
+ call SlimvSwankResponse()
+ endif
+ if s:SinceVersion( '2008-12-23' )
+ call SlimvCommandGetResponse( ':create-repl', s:py_cmd . 'swank_create_repl()', g:slimv_timeout )
+ endif
+ let s:swank_connected = 1
+ redraw
+ echon "\rConnected to SWANK server on port " . g:swank_port . "."
+ if exists( "g:swank_block_size" ) && SlimvGetFiletype() == 'lisp'
+ " Override SWANK connection output buffer size
+ if s:SinceVersion( '2014-09-08' )
+ let cmd = "(progn (setf (slot-value (swank::connection.user-output swank::*emacs-connection*) 'swank/gray::buffer)"
+ else
+ let cmd = "(progn (setf (slot-value (swank::connection.user-output swank::*emacs-connection*) 'swank-backend::buffer)"
+ endif
+ let cmd = cmd . " (make-string " . g:swank_block_size . ")) nil)"
+ call SlimvSend( [cmd], 0, 1 )
+ endif
+ if exists( "*SlimvReplInit" )
+ " Perform implementation specific REPL initialization if supplied
+ call SlimvReplInit( s:lisp_version )
+ endif
+ endif
+
+ return s:swank_connected
+endfunction
+
+" Send argument to Lisp server for evaluation
+function! SlimvSend( args, echoing, output )
+ if ! SlimvConnectSwank()
+ return
+ endif
+
+ " Send the lines to the client for evaluation
+ let text = join( a:args, "\n" ) . "\n"
+
+ let s:refresh_disabled = 1
+ let s:swank_form = text
+ if a:echoing && g:slimv_echolines != 0
+ if g:slimv_echolines > 0
+ let nlpos = match( s:swank_form, "\n", 0, g:slimv_echolines )
+ if nlpos > 0
+ " Echo only the first g:slimv_echolines number of lines
+ let trimmed = strpart( s:swank_form, nlpos )
+ let s:swank_form = strpart( s:swank_form, 0, nlpos )
+ let ending = s:CloseForm( s:swank_form )
+ if ending != 'ERROR'
+ if substitute( trimmed, '\s\|\n', '', 'g' ) == ''
+ " Only whitespaces are trimmed
+ let s:swank_form = s:swank_form . ending . "\n"
+ else
+ " Valuable characters trimmed, indicate it by printing "..."
+ let s:swank_form = s:swank_form . " ..." . ending . "\n"
+ endif
+ endif
+ endif
+ endif
+ if a:output
+ silent execute s:py_cmd . 'append_repl("s:swank_form", 1)'
+ endif
+ let s:swank_form = text
+ elseif a:output
+ " Open a new line for the output
+ silent execute s:py_cmd . " append_repl('\\n', 0)"
+ endif
+ call SlimvCommand( s:py_cmd . 'swank_input("s:swank_form")' )
+ let s:swank_package = ''
+ let s:swank_package_form = ''
+ let s:refresh_disabled = 0
+ call SlimvRefreshModeOn()
+ call SlimvRefreshReplBuffer()
+endfunction
+
+" Eval arguments in Lisp REPL
+function! SlimvEval( args )
+ call SlimvSend( a:args, 1, 1 )
+endfunction
+
+" Send argument silently to SWANK
+function! SlimvSendSilent( args )
+ call SlimvSend( a:args, 0, 0 )
+endfunction
+
+" Set command line after the prompt
+function! SlimvSetCommandLine( cmd )
+ let line = getline( "." )
+ if line( "." ) == s:GetPromptLine()
+ " The prompt is in the line marked by b:repl_prompt_line
+ let promptlen = len( b:repl_prompt )
+ else
+ let promptlen = 0
+ endif
+ if len( line ) > promptlen
+ let line = strpart( line, 0, promptlen )
+ endif
+
+ if s:GetPromptLine() < line( '$' )
+ " Delete extra lines after the prompt
+ let c = col( '.' )
+ execute (s:GetPromptLine()+1) . ',' . (line('$')) . 'd_'
+ call cursor( line('.'), c )
+ endif
+
+ let lines = split( a:cmd, '\n' )
+ if len(lines) > 0
+ let line = line . lines[0]
+ endif
+ call setline( ".", line )
+ if len(lines) > 1
+ call append( s:GetPromptLine(), lines[1:] )
+ endif
+ set nomodified
+endfunction
+
+" Add command list to the command history
+function! SlimvAddHistory( cmd )
+ if !exists( 'g:slimv_cmdhistory' )
+ let g:slimv_cmdhistory = []
+ endif
+ let i = 0
+ let form = join( a:cmd, "\n" )
+ " Trim leading and trailing whitespaces from the command
+ let form = substitute( form, '^\s*\(.*[^ ]\)\s*', '\1', 'g' )
+ if len( form ) > 1 || len( g:slimv_cmdhistory ) == 0 || form != g:slimv_cmdhistory[-1]
+ " Add command only if differs from the last one
+ call add( g:slimv_cmdhistory, form )
+ endif
+ let g:slimv_cmdhistorypos = len( g:slimv_cmdhistory )
+endfunction
+
+" Recall command from the command history at the marked position
+function! SlimvRecallHistory( direction )
+ let searchtext = ''
+ let l = line( '.' )
+ let c = col( '.' )
+ let set_cursor_pos = 0
+ if line( '.' ) == s:GetPromptLine() && c > b:repl_prompt_col
+ " Search for lines beginning with the text up to the cursor position
+ let searchtext = strpart( getline('.'), b:repl_prompt_col-1, c-b:repl_prompt_col )
+ let searchtext = substitute( searchtext, '^\s*$', '', 'g' )
+ let searchtext = substitute( searchtext, '^\s*\(.*[^ ]\)', '\1', 'g' )
+ endif
+ let historypos = g:slimv_cmdhistorypos
+ let g:slimv_cmdhistorypos = g:slimv_cmdhistorypos + a:direction
+ while g:slimv_cmdhistorypos >= 0 && g:slimv_cmdhistorypos < len( g:slimv_cmdhistory )
+ let cmd = g:slimv_cmdhistory[g:slimv_cmdhistorypos]
+ if len(cmd) >= len(searchtext) && strpart(cmd, 0, len(searchtext)) == searchtext
+ call SlimvSetCommandLine( g:slimv_cmdhistory[g:slimv_cmdhistorypos] )
+ return
+ endif
+ let g:slimv_cmdhistorypos = g:slimv_cmdhistorypos + a:direction
+ endwhile
+ if searchtext == ''
+ call SlimvSetCommandLine( "" )
+ else
+ let g:slimv_cmdhistorypos = historypos
+ endif
+endfunction
+
+" Return missing parens, double quotes, etc to properly close form
+function! s:CloseForm( form )
+ let end = ''
+ let i = 0
+ while i < len( a:form )
+ if a:form[i] == '"'
+ " Inside a string
+ let end = '"' . end
+ let i += 1
+ while i < len( a:form )
+ if a:form[i] == '\'
+ " Ignore next character
+ let i += 2
+ elseif a:form[i] == '"'
+ let end = end[1:]
+ break
+ else
+ let i += 1
+ endif
+ endwhile
+ elseif a:form[i] == ';'
+ " Inside a comment
+ let end = "\n" . end
+ let cend = match(a:form, "\n", i)
+ if cend == -1
+ break
+ endif
+ let i = cend
+ let end = end[1:]
+ else
+ " We are outside of strings and comments, now we shall count parens
+ if a:form[i] == '('
+ let end = ')' . end
+ elseif a:form[i] == '[' && SlimvGetFiletype() =~ '.*\(clojure\|scheme\|racket\).*'
+ let end = ']' . end
+ elseif a:form[i] == '{' && SlimvGetFiletype() =~ '.*\(clojure\|scheme\|racket\).*'
+ let end = '}' . end
+ elseif a:form[i] == ')' || ((a:form[i] == ']' || a:form[i] == '}') && SlimvGetFiletype() =~ '.*\(clojure\|scheme\|racket\).*')
+ if len( end ) == 0 || end[0] != a:form[i]
+ " Oops, too many closing parens or invalid closing paren
+ return 'ERROR'
+ endif
+ let end = end[1:]
+ endif
+ endif
+ let i += 1
+ endwhile
+ return end
+endfunction
+
+" Some multi-byte characters screw up the built-in lispindent()
+" This function is a wrapper that tries to fix it
+" TODO: implement custom indent procedure and omit lispindent()
+function SlimvLispindent( lnum )
+ set lisp
+ let li = lispindent( a:lnum )
+ set nolisp
+ let backline = max([a:lnum-g:slimv_indent_maxlines, 1])
+ let oldpos = getpos( '.' )
+ call cursor( oldpos[1], 1 )
+ " Find containing form
+ let [lhead, chead] = searchpairpos( '(', '', ')', 'bW', s:skip_sc, backline )
+ if lhead == 0
+ " No containing form, lispindent() is OK
+ call cursor( oldpos[1], oldpos[2] )
+ return li
+ endif
+ " Find outer form
+ let [lparent, cparent] = searchpairpos( '(', '', ')', 'bW', s:skip_sc, backline )
+ call cursor( oldpos[1], oldpos[2] )
+ if lparent == 0 || lhead != lparent
+ " No outer form or starting above inner form, lispindent() is OK
+ return li
+ endif
+ " Count extra bytes before the function header
+ let header = strpart( getline( lparent ), 0 )
+ let total_extra = 0
+ let extra = 0
+ let c = 0
+ while a:lnum > 0 && c < chead-1
+ let bytes = byteidx( header, c+1 ) - byteidx( header, c )
+ if bytes > 1
+ let total_extra = total_extra + bytes - 1
+ if c >= cparent && extra < 10
+ " Extra bytes in the outer function header
+ let extra = extra + bytes - 1
+ endif
+ endif
+ let c = c + 1
+ endwhile
+ if total_extra == 0
+ " No multi-byte character, lispindent() is OK
+ return li
+ endif
+ " In some cases ending spaces add up to lispindent() if there are multi-byte characters
+ let ending_sp = len( matchstr( getline( lparent ), ' *$' ) )
+ " Determine how wrong lispindent() is based on the number of extra bytes
+ " These values were determined empirically
+ if lparent == a:lnum - 1
+ " Function header is in the previous line
+ if extra == 0 && total_extra > 1
+ let ending_sp = ending_sp + 1
+ endif
+ return li + [0, 1, 0, -3, -3, -3, -5, -5, -7, -7, -8][extra] - ending_sp
+ else
+ " Function header is in an upper line
+ if extra == 0 || total_extra == extra
+ let ending_sp = 0
+ endif
+ return li + [0, 1, 0, -2, -2, -3, -3, -3, -3, -3, -3][extra] - ending_sp
+ endif
+endfunction
+
+" Return Lisp source code indentation at the given line
+" Does not keep the cursor position
+function! SlimvIndentUnsafe( lnum )
+ if &autoindent == 0 || a:lnum <= 1
+ " Start of the file
+ return 0
+ endif
+ let pnum = prevnonblank(a:lnum - 1)
+ if pnum == 0
+ " Hit the start of the file, use zero indent.
+ return 0
+ endif
+ let oldpos = getpos( '.' )
+ let linenum = a:lnum
+
+ " Handle multi-line string
+ let plen = len( getline( pnum ) )
+ if synIDattr( synID( pnum, plen, 0), 'name' ) =~ '[Ss]tring' && getline(pnum)[plen-1] != '"'
+ " Previous non-blank line ends with an unclosed string, so this is a multi-line string
+ let [l, c] = searchpairpos( '"', '', '"', 'bnW', s:skip_q )
+ if l == pnum && c > 0
+ " Indent to the opening double quote (if found)
+ return c
+ else
+ return SlimvLispindent( linenum )
+ endif
+ endif
+ if synIDattr( synID( pnum, 1, 0), 'name' ) =~ '[Ss]tring' && getline(pnum)[0] != '"'
+ " Previous non-blank line is the last line of a multi-line string
+ call cursor( pnum, 1 )
+ " First find the end of the multi-line string (omit \" characters)
+ let [lend, cend] = searchpos( '[^\\]"', 'nW' )
+ if lend > 0 && strpart(getline(lend), cend+1) =~ '(\|)\|\[\|\]\|{\|}'
+ " Structural change after the string, no special handling
+ else
+ " Find the start of the multi-line string (omit \" characters)
+ let [l, c] = searchpairpos( '"', '', '"', 'bnW', s:skip_q )
+ if l > 0 && strpart(getline(l), 0, c-1) =~ '^\s*$'
+ " Nothing else before the string: indent to the opening "
+ return c - 1
+ endif
+ if l > 0
+ " Pretend that we are really after the first line of the multi-line string
+ let pnum = l
+ let linenum = l + 1
+ endif
+ endif
+ call cursor( oldpos[1], oldpos[2] )
+ endif
+
+ " Handle special indentation style for flet, labels, etc.
+ " When searching for containing forms, don't go back
+ " more than g:slimv_indent_maxlines lines.
+ let backline = max([pnum-g:slimv_indent_maxlines, 1])
+ let indent_keylists = g:slimv_indent_keylists
+
+ " Check if the previous line actually ends with a multi-line subform
+ let parent = pnum
+ let [l, c] = searchpos( ')', 'bW' )
+ if l == pnum
+ let [l, c] = searchpairpos( '(', '', ')', 'bW', s:skip_sc, backline )
+ if l > 0
+ " Make sure it is not a top level form and the containing form starts in the same line
+ let [l2, c2] = searchpairpos( '(', '', ')', 'bW', s:skip_sc, backline )
+ if l2 == l
+ " Remember the first line of the multi-line form
+ let parent = l
+ endif
+ endif
+ endif
+
+ " Find beginning of the innermost containing form
+ call cursor( oldpos[1], 1 )
+ let [l, c] = searchpairpos( '(', '', ')', 'bW', s:skip_sc, backline )
+ if l > 0
+ if SlimvGetFiletype() =~ '.*\(clojure\|scheme\|racket\).*'
+ " Is this a clojure form with [] binding list?
+ call cursor( oldpos[1], oldpos[2] )
+ let [lb, cb] = searchpairpos( '\[', '', '\]', 'bW', s:skip_sc, backline )
+ if lb >= l && (lb > l || cb > c)
+ return cb
+ endif
+ endif
+ " Is this a form with special indentation?
+ let line = strpart( getline(l), c-1 )
+ if match( line, '\c^(\s*\('.s:spec_indent.'\)\>' ) >= 0
+ " Search for the binding list and jump to its end
+ if search( '(' ) > 0
+ call searchpair( '(', '', ')', '', s:skip_sc )
+ if line('.') == pnum
+ " We are indenting the first line after the end of the binding list
+ return c + 1
+ endif
+ endif
+ elseif l == pnum
+ " If the containing form starts above this line then find the
+ " second outer containing form (possible start of the binding list)
+ let [l2, c2] = searchpairpos( '(', '', ')', 'bW', s:skip_sc, backline )
+ if l2 > 0
+ let line2 = strpart( getline(l2), c2-1 )
+ if match( line2, '\c^(\s*\('.s:spec_param.'\)\>' ) >= 0
+ if search( '(' ) > 0
+ if line('.') == l && col('.') == c
+ " This is the parameter list of a special form
+ return c
+ endif
+ endif
+ endif
+ if SlimvGetFiletype() !~ '.*clojure.*'
+ if l2 == l && match( line2, '\c^(\s*\('.s:binding_form.'\)\>' ) >= 0
+ " Is this a lisp form with binding list?
+ return c
+ endif
+ if match( line2, '\c^(\s*cond\>' ) >= 0 && match( line, '\c^(\s*t\>' ) >= 0
+ " Is this the 't' case for a 'cond' form?
+ return c
+ endif
+ if match( line2, '\c^(\s*defpackage\>' ) >= 0
+ let indent_keylists = 0
+ endif
+ endif
+ " Go one level higher and check if we reached a special form
+ let [l3, c3] = searchpairpos( '(', '', ')', 'bW', s:skip_sc, backline )
+ if l3 > 0
+ " Is this a form with special indentation?
+ let line3 = strpart( getline(l3), c3-1 )
+ if match( line3, '\c^(\s*\('.s:spec_indent.'\)\>' ) >= 0
+ " This is the first body-line of a binding
+ return c + 1
+ endif
+ if match( line3, '\c^(\s*defsystem\>' ) >= 0
+ let indent_keylists = 0
+ endif
+ " Finally go to the topmost level to check for some forms with special keyword indenting
+ let [l4, c4] = searchpairpos( '(', '', ')', 'brW', s:skip_sc, backline )
+ if l4 > 0
+ let line4 = strpart( getline(l4), c4-1 )
+ if match( line4, '\c^(\s*defsystem\>' ) >= 0
+ let indent_keylists = 0
+ endif
+ endif
+ endif
+ endif
+ endif
+ endif
+
+ " Restore all cursor movements
+ call cursor( oldpos[1], oldpos[2] )
+
+ " Check if the current form started in the previous nonblank line
+ if l == parent
+ " Found opening paren in the previous line
+ let line = getline(l)
+ let form = strpart( line, c )
+ " Determine the length of the function part up to the 1st argument
+ let funclen = matchend( form, '\s*\S*\s*' ) + 1
+ " Contract strings, remove comments
+ let form = substitute( form, '".\{-}[^\\]"', '""', 'g' )
+ let form = substitute( form, ';.*$', '', 'g' )
+ " Contract subforms by replacing them with a single character
+ let f = ''
+ while form != f
+ let f = form
+ let form = substitute( form, '([^()]*)', '0', 'g' )
+ let form = substitute( form, '([^()]*$', '0', 'g' )
+ let form = substitute( form, '\[[^\[\]]*\]', '0', 'g' )
+ let form = substitute( form, '\[[^\[\]]*$', '0', 'g' )
+ let form = substitute( form, '{[^{}]*}', '0', 'g' )
+ let form = substitute( form, '{[^{}]*$', '0', 'g' )
+ endwhile
+ " Find out the function name
+ let func = matchstr( form, '\<\k*\>' )
+ " If it's a keyword, keep the indentation straight
+ if indent_keylists && strpart(func, 0, 1) == ':'
+ if form =~ '^:\S*\s\+\S'
+ " This keyword has an associated value in the same line
+ return c
+ else
+ " The keyword stands alone in its line with no associated value
+ return c + 1
+ endif
+ endif
+ if SlimvGetFiletype() =~ '.*clojure.*'
+ " Fix clojure specific indentation issues not handled by the default lisp.vim
+ if match( func, 'defn$' ) >= 0
+ return c + 1
+ endif
+ else
+ if match( func, 'defgeneric$' ) >= 0 || match( func, 'defsystem$' ) >= 0 || match( func, 'aif$' ) >= 0
+ return c + 1
+ endif
+ endif
+ " Remove package specification
+ let func = substitute(func, '^.*:', '', '')
+ if func != '' && s:swank_connected
+ " Look how many arguments are on the same line
+ " If an argument is actually a multi-line subform, then replace it with a single character
+ let form = substitute( form, "([^()]*$", '0', 'g' )
+ let form = substitute( form, "[()\\[\\]{}#'`,]", '', 'g' )
+ let args_here = len( split( form ) ) - 1
+ " Get swank indent info
+ let s:indent = ''
+ silent execute s:py_cmd . 'get_indent_info("' . func . '")'
+ if s:indent != '' && s:indent == args_here
+ " The next one is an &body argument, so indent by 2 spaces from the opening '('
+ return c + 1
+ endif
+ let llen = len( line )
+ if synIDattr( synID( l, llen, 0), 'name' ) =~ '[Ss]tring' && line[llen-1] != '"'
+ " Parent line ends with a multi-line string
+ " lispindent() fails to handle it correctly
+ if s:indent == '' && args_here > 0
+ " No &body argument, ignore lispindent() and indent to the 1st argument
+ return c + funclen - 1
+ endif
+ endif
+ endif
+ endif
+
+ " Use default Lisp indenting
+ let li = SlimvLispindent(linenum)
+ let line = strpart( getline(linenum-1), li-1 )
+ let gap = matchend( line, '^(\s\+\S' )
+ if gap >= 0
+ " Align to the gap between the opening paren and the first atom
+ return li + gap - 2
+ endif
+ return li
+endfunction
+
+" Indentation routine, keeps original cursor position
+function! SlimvIndent( lnum )
+ let oldpos = getpos( '.' )
+ let indent = SlimvIndentUnsafe( a:lnum )
+ call cursor( oldpos[1], oldpos[2] )
+ return indent
+endfunction
+
+" Convert indent value to spaces or a mix of tabs and spaces
+" depending on the value of 'expandtab'
+function! s:MakeIndent( indent )
+ if &expandtab
+ return repeat( ' ', a:indent )
+ else
+ return repeat( "\<Tab>", a:indent / &tabstop ) . repeat( ' ', a:indent % &tabstop )
+ endif
+endfunction
+
+" Send command line to REPL buffer
+" Arguments: close = add missing closing parens
+function! SlimvSendCommand( close )
+ call SlimvRefreshModeOn()
+ let lastline = s:GetPromptLine()
+ let lastcol = b:repl_prompt_col
+ if lastline > 0
+ if line( "." ) >= lastline
+ " Trim the prompt from the beginning of the command line
+ " The user might have overwritten some parts of the prompt
+ let cmdline = getline( lastline )
+ let c = 0
+ while c < lastcol - 1 && cmdline[c] == b:repl_prompt[c]
+ let c = c + 1
+ endwhile
+ let cmd = [ strpart( getline( lastline ), c ) ]
+
+ " Build a possible multi-line command
+ let l = lastline + 1
+ while l <= line("$")
+ call add( cmd, strpart( getline( l ), 0) )
+ let l = l + 1
+ endwhile
+
+ " Count the number of opening and closing braces
+ let end = s:CloseForm( join( cmd, "\n" ) )
+ if end == 'ERROR'
+ " Too many closing parens
+ call SlimvErrorWait( "Too many or invalid closing parens found." )
+ return
+ endif
+ let echoing = 0
+ if a:close && end != ''
+ " Close form if necessary and evaluate it
+ let cmd[len(cmd)-1] = cmd[len(cmd)-1] . end
+ let end = ''
+ let echoing = 1
+ endif
+ if end == ''
+ " Expression finished, let's evaluate it
+ " but first add it to the history
+ call SlimvAddHistory( cmd )
+ " Evaluate, but echo only when form is actually closed here
+ call SlimvSend( cmd, echoing, 1 )
+ else
+ " Expression is not finished yet, indent properly and wait for completion
+ " Indentation works only if lisp indentation is switched on
+ call SlimvArglist()
+ let l = line('.') + 1
+ call append( '.', '' )
+ call setline( l, s:MakeIndent( SlimvIndent(l) ) )
+ normal! j$
+ endif
+ endif
+ else
+ silent execute s:py_cmd . " append_repl('Slimv error: previous EOF mark not found, re-enter last form:\\n', 0)"
+ endif
+endfunction
+
+" Close current top level form by adding the missing parens
+function! SlimvCloseForm()
+ let l2 = line( '.' )
+ call SlimvFindDefunStart()
+ let l1 = line( '.' )
+ let form = []
+ let l = l1
+ while l <= l2
+ call add( form, getline( l ) )
+ let l = l + 1
+ endwhile
+ let end = s:CloseForm( join( form, "\n" ) )
+ if end == 'ERROR'
+ " Too many closing parens
+ call SlimvErrorWait( "Too many or invalid closing parens found." )
+ elseif end != ''
+ " Add missing parens
+ if end[0] == "\n"
+ call append( l2, end[1:] )
+ else
+ call setline( l2, getline( l2 ) . end )
+ endif
+ endif
+ normal! %
+endfunction
+
+" Handle insert mode 'Enter' keypress
+function! SlimvHandleEnter()
+ let s:arglist_line = line('.')
+ let s:arglist_col = col('.')
+ if pumvisible()
+ " Pressing <CR> in a pop up selects entry.
+ return "\<C-Y>"
+ else
+ if exists( 'g:paredit_mode' ) && g:paredit_mode && g:paredit_electric_return
+ " Apply electric return
+ return PareditEnter()
+ else
+ " No electric return handling, just enter a newline
+ return "\<CR>"
+ endif
+ endif
+endfunction
+
+" Display arglist after pressing Enter
+function! SlimvArglistOnEnter()
+ let retval = ""
+ if s:arglist_line > 0
+ if col('.') > len(getline('.'))
+ " Stay at the end of line
+ let retval = "\<End>"
+ endif
+ let l = line('.')
+ if getline(l) == ''
+ " Add spaces to make the correct indentation
+ call setline( l, s:MakeIndent( SlimvIndent(l) ) )
+ normal! $
+ endif
+ call SlimvArglist( s:arglist_line, s:arglist_col )
+ endif
+ let s:arglist_line = 0
+ let s:arglist_col = 0
+
+ " This function is called from <C-R>= mappings, return additional keypress
+ return retval
+endfunction
+
+" Handle insert mode 'Tab' keypress by doing completion or indentation
+function! SlimvHandleTab()
+ if pumvisible()
+ " Completions menu is active, go to next match
+ return "\<C-N>"
+ endif
+ let c = col('.')
+ if c > 1 && getline('.')[c-2] =~ '\k'
+ " At the end of a keyword, bring up completions
+ return "\<C-X>\<C-O>"
+ endif
+ let indent = SlimvIndent(line('.'))
+ if c-1 < indent && getline('.') !~ '\S\+'
+ " We are left from the autoindent position, do an autoindent
+ call setline( line('.'), s:MakeIndent( indent ) )
+ return "\<End>"
+ endif
+ " No keyword to complete, no need for autoindent, just enter a <Tab>
+ return "\<Tab>"
+endfunction
+
+" Handle insert mode 'Backspace' keypress in the REPL buffer
+function! SlimvHandleBS()
+ if line( "." ) == s:GetPromptLine() && col( "." ) <= b:repl_prompt_col
+ " No BS allowed before the previous EOF mark
+ return ""
+ else
+ return "\<BS>"
+ endif
+endfunction
+
+" Handle insert mode Ctrl-W keypress in the REPL buffer
+function! SlimvHandleCW()
+ if line( "." ) == s:GetPromptLine()
+ let trim_prompt = substitute( b:repl_prompt, '\s\+$', '', 'g' )
+ let promptlen = len( trim_prompt )
+ if col( "." ) > promptlen
+ let after_prompt = strpart( getline("."), promptlen-1, col(".")-promptlen )
+ else
+ let after_prompt = ''
+ endif
+ let word = matchstr( after_prompt, '^.*\s\S' )
+ if len( word ) == 0
+ " No word found after prompt, C-W not allowed
+ return ""
+ endif
+ endif
+ return "\<C-W>"
+endfunction
+
+" Recall previous command from command history
+function! s:PreviousCommand()
+ if exists( 'g:slimv_cmdhistory' ) && g:slimv_cmdhistorypos > 0
+ call SlimvRecallHistory( -1 )
+ endif
+endfunction
+
+" Recall next command from command history
+function! s:NextCommand()
+ if exists( 'g:slimv_cmdhistory' ) && g:slimv_cmdhistorypos < len( g:slimv_cmdhistory )
+ call SlimvRecallHistory( 1 )
+ else
+ call SlimvSetCommandLine( "" )
+ endif
+endfunction
+
+" Handle insert mode 'Up' keypress in the REPL buffer
+function! SlimvHandleUp()
+ let save_ve = &virtualedit
+ set virtualedit=onemore
+ if line( "." ) >= s:GetPromptLine()
+ call s:PreviousCommand()
+ else
+ normal! gk
+ endif
+ let &virtualedit=save_ve
+ return ''
+endfunction
+
+" Handle insert mode 'Down' keypress in the REPL buffer
+function! SlimvHandleDown()
+ let save_ve = &virtualedit
+ set virtualedit=onemore
+ if line( "." ) >= s:GetPromptLine()
+ call s:NextCommand()
+ else
+ normal! gj
+ endif
+ let &virtualedit=save_ve
+ return ''
+endfunction
+
+" Make a fold at the cursor point in the current buffer
+function SlimvMakeFold()
+ setlocal modifiable
+ normal! o }}}kA {{{0
+ setlocal nomodifiable
+endfunction
+
+" Handle insert mode 'Enter' keypress in the REPL buffer
+function! SlimvHandleEnterRepl()
+ " Trim the prompt from the beginning of the command line
+ " The user might have overwritten some parts of the prompt
+ let lastline = s:GetPromptLine()
+ let lastcol = b:repl_prompt_col
+ let cmdline = getline( lastline )
+ let c = 0
+ while c < lastcol - 1 && cmdline[c] == b:repl_prompt[c]
+ let c = c + 1
+ endwhile
+
+ " Copy command line up to the cursor position
+ if line(".") == lastline
+ let cmd = [ strpart( cmdline, c, col(".") - c - 1 ) ]
+ else
+ let cmd = [ strpart( cmdline, c ) ]
+ endif
+
+ " Build a possible multi-line command up to the cursor line/position
+ let l = lastline + 1
+ while l <= line(".")
+ if line(".") == l
+ call add( cmd, strpart( getline( l ), 0, col(".") - 1) )
+ else
+ call add( cmd, strpart( getline( l ), 0) )
+ endif
+ let l = l + 1
+ endwhile
+
+ " Count the number of opening and closing braces in the command before the cursor
+ let end = s:CloseForm( join( cmd, "\n" ) )
+ if end != 'ERROR' && end != ''
+ " Command part before cursor is unbalanced, insert newline
+ let s:arglist_line = line('.')
+ let s:arglist_col = col('.')
+ if pumvisible()
+ " Pressing <CR> in a pop up selects entry.
+ return "\<C-Y>"
+ else
+ if exists( 'g:paredit_mode' ) && g:paredit_mode && g:paredit_electric_return && lastline > 0 && line( "." ) >= lastline
+ " Apply electric return
+ return PareditEnter()
+ else
+ " No electric return handling, just enter a newline
+ return "\<CR>"
+ endif
+ endif
+ else
+ " Send current command line for evaluation
+ if &virtualedit != 'all'
+ call cursor( 0, 99999 )
+ endif
+ call SlimvSendCommand(0)
+ endif
+ return ''
+endfunction
+
+" Handle normal mode 'Enter' keypress in the SLDB buffer
+function! SlimvHandleEnterSldb()
+ let line = getline('.')
+ if s:sldb_level >= 0
+ " Check if Enter was pressed in a section printed by the SWANK debugger
+ " The source specification is within a fold, so it has to be tested first
+ let mlist = matchlist( line, '^\s\+in "\=\(.*\)"\= \(line\|byte\) \(\d\+\)$' )
+ if len(mlist)
+ if g:slimv_repl_split
+ " Switch back to other window
+ execute "wincmd p"
+ endif
+ " Jump to the file at the specified position
+ if mlist[2] == 'line'
+ exec ":edit +" . mlist[3] . " " . mlist[1]
+ else
+ exec ":edit +" . mlist[3] . "go " . mlist[1]
+ endif
+ return
+ endif
+ if foldlevel('.')
+ " With a fold just toggle visibility
+ normal za
+ return
+ endif
+ let item = matchstr( line, s:frame_def )
+ if item != ''
+ let item = substitute( item, '\s\|:', '', 'g' )
+ if search( '^Backtrace:', 'bnW' ) > 0
+ " Display item-th frame
+ call SlimvMakeFold()
+ silent execute s:py_cmd . 'swank_frame_locals("' . item . '")'
+ if SlimvGetFiletype() != 'scheme' && g:slimv_impl != 'clisp'
+ " Not implemented for CLISP or scheme
+ silent execute s:py_cmd . 'swank_frame_source_loc("' . item . '")'
+ endif
+ if SlimvGetFiletype() == 'lisp' && g:slimv_impl != 'clisp' && g:slimv_impl != 'allegro'
+ " Not implemented for CLISP or other lisp dialects
+ silent execute s:py_cmd . 'swank_frame_call("' . item . '")'
+ endif
+ call SlimvRefreshReplBuffer()
+ return
+ endif
+ if search( '^Restarts:', 'bnW' ) > 0
+ " Apply item-th restart
+ call SlimvQuitSldb()
+ silent execute s:py_cmd . 'swank_invoke_restart("' . s:sldb_level . '", "' . item . '")'
+ call SlimvRefreshReplBuffer()
+ return
+ endif
+ endif
+ endif
+
+ " No special treatment, perform the original function
+ execute "normal! \<CR>"
+endfunction
+
+" Restore Inspector cursor position if the referenced title has already been visited
+function SlimvSetInspectPos( title )
+ if exists( 'b:inspect_pos' ) && has_key( b:inspect_pos, a:title )
+ call winrestview( b:inspect_pos[a:title] )
+ else
+ normal! gg0
+ endif
+endfunction
+
+" Handle normal mode 'Enter' keypress in the Inspector buffer
+function! SlimvHandleEnterInspect()
+ let line = getline('.')
+ if line[0:9] == 'Inspecting'
+ " Reload inspected item
+ call SlimvSendSilent( ['[0]'] )
+ return
+ endif
+
+ " Find the closest [dd] or <dd> token to the left of the cursor
+ let [l, c] = searchpos( '{\[\d\+\]', 'bncW' )
+ let [l2, c2] = searchpos( '{<\d\+>', 'bncW' )
+ if l < line('.') || (l2 == line('.') && c2 > c)
+ let l = l2
+ let c = c2
+ endif
+
+ if l < line('.')
+ " No preceding token found, find the closest [dd] or <dd> to the right
+ let [l, c] = searchpos( '{\[\d\+\]', 'ncW' )
+ let [l2, c2] = searchpos( '{<\d\+>', 'ncW' )
+ if l == 0 || l > line('.') || (l2 == line('.') && c2 < c)
+ let l = l2
+ let c = c2
+ endif
+ endif
+
+ if l == line( '.' )
+ " Keep the relevant part of the line
+ let line = strpart( line, c )
+ endif
+
+ if exists( 'b:inspect_title' ) && b:inspect_title != ''
+ " Save cursor position in case we'll return to this page later on
+ if !exists( 'b:inspect_pos' )
+ let b:inspect_pos = {}
+ endif
+ let b:inspect_pos[b:inspect_title] = winsaveview()
+ endif
+
+ if line[0] == '['
+ if line =~ '^\[--more--\]$'
+ " More data follows, fetch next part
+ call SlimvCommand( s:py_cmd . 'swank_inspector_range()' )
+ call SlimvRefreshReplBuffer()
+ return
+ elseif line =~ '^\[--all---\]$'
+ " More data follows, fetch all parts
+ echon "\rFetching all entries, please wait..."
+ let b:inspect_more = -1
+ call SlimvCommand( s:py_cmd . 'swank_inspector_range()' )
+ call SlimvRefreshReplBuffer()
+ let starttime = localtime()
+ while b:inspect_more < 0 && localtime()-starttime < g:slimv_timeout
+ " Wait for the first swank_inspector_range() call to finish
+ call SlimvRefreshReplBuffer()
+ endwhile
+ let starttime = localtime()
+ while b:inspect_more > 0 && localtime()-starttime < g:slimv_timeout
+ " There are more parts to fetch (1 entry is usually 4 parts)
+ echon "\rFetching all entries, please wait [" . (b:inspect_more / 4) . "]"
+ call SlimvCommand( s:py_cmd . 'swank_inspector_range()' )
+ call SlimvRefreshReplBuffer()
+ if getchar(1)
+ " User is impatient, stop fetching
+ break
+ endif
+ endwhile
+ if b:inspect_more > 0
+ echon "\rFetch exhausted. Select [--all---] to resume."
+ else
+ echon "\rSuccessfully fetched all entries."
+ endif
+ return
+ elseif line[0:3] == '[<<]'
+ " Pop back up in the inspector
+ let item = '-1'
+ else
+ " Inspect n-th part
+ let item = matchstr( line, '\d\+' )
+ if item != ''
+ " Add item name to the object path
+ let entry = matchstr(line, '\[\d\+\]\s*\zs.\{-}\ze\s*\[\]}')
+ if entry == ''
+ let entry = matchstr(line, '\[\d\+\]\s*\zs.*')
+ endif
+ if entry == ''
+ let entry = 'Unknown object'
+ endif
+ if len( entry ) > 40
+ " Crop if too long
+ let entry = strpart( entry, 0, 37 ) . '...'
+ endif
+ let s:inspect_path = s:inspect_path + [entry]
+ endif
+ endif
+ if item != ''
+ call SlimvSendSilent( ['[' . item . ']'] )
+ return
+ endif
+ endif
+
+ if line[0] == '<'
+ " Inspector n-th action
+ let item = matchstr( line, '\d\+' )
+ if item != ''
+ call SlimvSendSilent( ['<' . item . '>'] )
+ return
+ endif
+ endif
+
+ " No special treatment, perform the original function
+ execute "normal! \<CR>"
+endfunction
+
+" Go to command line and recall previous command from command history
+function! SlimvPreviousCommand()
+ let save_ve = &virtualedit
+ set virtualedit=onemore
+ call SlimvEndOfReplBuffer(0)
+ if line( "." ) >= s:GetPromptLine()
+ call s:PreviousCommand()
+ endif
+ let &virtualedit=save_ve
+endfunction
+
+" Go to command line and recall next command from command history
+function! SlimvNextCommand()
+ let save_ve = &virtualedit
+ set virtualedit=onemore
+ call SlimvEndOfReplBuffer(0)
+ if line( "." ) >= s:GetPromptLine()
+ call s:NextCommand()
+ endif
+ let &virtualedit=save_ve
+endfunction
+
+" Handle interrupt (Ctrl-C) keypress in the REPL buffer
+function! SlimvInterrupt()
+ call SlimvCommand( s:py_cmd . 'swank_interrupt()' )
+ call SlimvRefreshReplBuffer()
+endfunction
+
+" Select a specific restart in debugger
+function! SlimvDebugCommand( name, cmd )
+ if SlimvConnectSwank()
+ if s:sldb_level >= 0
+ if bufname('%') != g:slimv_sldb_name
+ call SlimvOpenSldbBuffer()
+ endif
+ call SlimvCommand( s:py_cmd . '' . a:cmd . '()' )
+ call SlimvRefreshReplBuffer()
+ if s:sldb_level < 0
+ " Swank exited the debugger
+ if bufname('%') != g:slimv_sldb_name
+ call SlimvOpenSldbBuffer()
+ endif
+ call SlimvQuitSldb()
+ else
+ echomsg 'Debugger re-activated by the SWANK server.'
+ endif
+ else
+ call SlimvError( "Debugger is not activated." )
+ endif
+ endif
+endfunction
+
+" Various debugger restarts
+function! SlimvDebugAbort()
+ call SlimvDebugCommand( ":sldb-abort", "swank_invoke_abort" )
+endfunction
+
+function! SlimvDebugQuit()
+ call SlimvDebugCommand( ":throw-to-toplevel", "swank_throw_toplevel" )
+endfunction
+
+function! SlimvDebugContinue()
+ call SlimvDebugCommand( ":sldb-continue", "swank_invoke_continue" )
+endfunction
+
+" Restart execution of the frame with the same arguments
+function! SlimvDebugRestartFrame()
+ let frame = s:DebugFrame()
+ if frame != ''
+ call SlimvCommand( s:py_cmd . 'swank_restart_frame("' . frame . '")' )
+ call SlimvRefreshReplBuffer()
+ endif
+endfunction
+
+" List current Lisp threads
+function! SlimvListThreads()
+ if SlimvConnectSwank()
+ call SlimvCommand( s:py_cmd . 'swank_list_threads()' )
+ call SlimvRefreshReplBuffer()
+ endif
+endfunction
+
+" Kill thread(s) selected from the Thread List
+function! SlimvKillThread() range
+ if SlimvConnectSwank()
+ if a:firstline == a:lastline
+ let line = getline('.')
+ let item = matchstr( line, '\d\+' )
+ if bufname('%') != g:slimv_threads_name
+ " We are not in the Threads buffer, not sure which thread to kill
+ let item = input( 'Thread to kill: ', item )
+ endif
+ if item != ''
+ call SlimvCommand( s:py_cmd . 'swank_kill_thread(' . item . ')' )
+ call SlimvRefreshReplBuffer()
+ endif
+ echomsg 'Thread ' . item . ' is killed.'
+ else
+ for line in getline(a:firstline, a:lastline)
+ let item = matchstr( line, '\d\+' )
+ if item != ''
+ call SlimvCommand( s:py_cmd . 'swank_kill_thread(' . item . ')' )
+ endif
+ endfor
+ call SlimvRefreshReplBuffer()
+ endif
+ call SlimvListThreads()
+ endif
+endfunction
+
+" Debug thread selected from the Thread List
+function! SlimvDebugThread()
+ if SlimvConnectSwank()
+ let line = getline('.')
+ let item = matchstr( line, '\d\+' )
+ let item = input( 'Thread to debug: ', item )
+ if item != ''
+ call SlimvCommand( s:py_cmd . 'swank_debug_thread(' . item . ')' )
+ call SlimvRefreshReplBuffer()
+ endif
+ endif
+endfunction
+
+function! SlimvRFunction()
+ " search backwards for the alphanums before a '('
+ let l = line('.')
+ let c = col('.') - 1
+ let line = (getline('.'))[0:c]
+ let list = matchlist(line, '\([a-zA-Z0-9_.]\+\)\s*(')
+ if !len(list)
+ return ""
+ endif
+ let valid = filter(reverse(list), 'v:val != ""')
+ return valid[0]
+endfunction
+
+" Display function argument list
+" Optional argument is the number of characters typed after the keyword
+function! SlimvArglist( ... )
+ let retval = ''
+ let save_ve = &virtualedit
+ set virtualedit=all
+ if a:0
+ " Symbol position supplied
+ let l = a:1
+ let c = a:2 - 1
+ let line = getline(l)
+ else
+ " Check symbol at cursor position
+ let l = line('.')
+ let line = getline(l)
+ let c = col('.') - 1
+ if c >= len(line)
+ " Stay at the end of line
+ let c = len(line) - 1
+ let retval = "\<End>"
+ endif
+ if line[c-1] == ' '
+ " Is this the space we have just inserted in a mapping?
+ let c = c - 1
+ endif
+ endif
+ call s:SetKeyword()
+ if s:swank_connected && !s:read_string_mode && c > 0 && line[c-1] =~ '\k\|)\|\]\|}\|"'
+ " Display only if entering the first space after a keyword
+ let arg = ''
+ if SlimvGetFiletype() == 'r'
+ let arg = SlimvRFunction()
+ else
+ let matchb = max( [l-200, 1] )
+ let [l0, c0] = searchpairpos( '(', '', ')', 'nbW', s:skip_sc, matchb )
+ if l0 > 0
+ " Found opening paren, let's find out the function name
+ while arg == '' && l0 <= l
+ let funcline = substitute( getline(l0), ';.*$', '', 'g' )
+ let arg = matchstr( funcline, '\<\k*\>', c0 )
+ let l0 = l0 + 1
+ let c0 = 0
+ endwhile
+ endif
+ endif
+
+ if arg != ''
+ " Ask function argument list from SWANK
+ call SlimvFindPackage()
+ let msg = SlimvCommandGetResponse( ':operator-arglist', s:py_cmd . 'swank_op_arglist("' . arg . '")', 0 )
+ if msg != ''
+ " Print argument list in status line with newlines removed.
+ " Disable showmode until the next ESC to prevent
+ " immeditate overwriting by the "-- INSERT --" text.
+ set noshowmode
+ let msg = substitute( msg, "\n", "", "g" )
+ redraw
+ if SlimvGetFiletype() == 'r'
+ call SlimvShortEcho( arg . '(' . msg . ')' )
+ elseif match( msg, "\\V" . arg ) != 1 " Use \V ('very nomagic') for exact string match instead of regex
+ " Function name is not received from REPL
+ call SlimvShortEcho( "(" . arg . ' ' . msg[1:] )
+ else
+ call SlimvShortEcho( msg )
+ endif
+ endif
+ endif
+ endif
+
+ " This function is also called from <C-R>= mappings, return additional keypress
+ let &virtualedit=save_ve
+ return retval
+endfunction
+
+" Start and connect swank server
+function! SlimvConnectServer()
+ if s:swank_connected
+ execute s:py_cmd . "swank_disconnect()"
+ let s:swank_connected = 0
+ " Give swank server some time for disconnecting
+ sleep 500m
+ endif
+ if SlimvConnectSwank()
+ let repl_win = bufwinnr( s:repl_buf )
+ if s:repl_buf == -1 || ( g:slimv_repl_split && repl_win == -1 )
+ call SlimvOpenReplBuffer()
+ endif
+ endif
+endfunction
+
+" Get the last region (visual block)
+function! SlimvGetRegion(first, last)
+ let oldpos = winsaveview()
+ if a:first < a:last || ( a:first == line( "'<" ) && a:last == line( "'>" ) )
+ let lines = getline( a:first, a:last )
+ else
+ " No range was selected, select current paragraph
+ normal! vap
+ execute "normal! \<Esc>"
+ call winrestview( oldpos )
+ let lines = getline( "'<", "'>" )
+ if lines == [] || lines == ['']
+ call SlimvError( "No range selected." )
+ return []
+ endif
+ endif
+ let firstcol = col( "'<" ) - 1
+ let lastcol = col( "'>" ) - 2
+ if lastcol >= 0
+ let lines[len(lines)-1] = lines[len(lines)-1][ : lastcol]
+ else
+ let lines[len(lines)-1] = ''
+ endif
+ let lines[0] = lines[0][firstcol : ]
+
+ " Find and set package/namespace definition preceding the region
+ call SlimvFindPackage()
+ call winrestview( oldpos )
+ return lines
+endfunction
+
+" Eval buffer lines in the given range
+function! SlimvEvalRegion() range
+ if v:register == '"' || v:register == '+'
+ let lines = SlimvGetRegion(a:firstline, a:lastline)
+ else
+ " Register was passed, so eval register contents instead
+ let reg = getreg( v:register )
+ let ending = ""
+ if SlimvGetFiletype() != 'r'
+ let ending = s:CloseForm( reg )
+ if ending == 'ERROR'
+ call SlimvError( 'Too many or invalid closing parens in register "' . v:register )
+ return
+ endif
+ endif
+ let lines = [reg . ending]
+ endif
+ if lines != []
+ if SlimvGetFiletype() == 'scheme'
+ " Swank-scheme requires us to pass a single s-expression
+ " so embed buffer lines in a (begin ...) block
+ let lines = ['(begin'] + lines + [')']
+ endif
+ call SlimvEval( lines )
+ endif
+endfunction
+
+" Eval contents of the 's' register, optionally store it in another register
+" Also optionally append a test form for quick testing (not stored in 'outreg')
+" If the test form contains '%1' then it 'wraps' the selection around the '%1'
+function! SlimvEvalSelection( outreg, testform )
+ let sel = SlimvGetSelection()
+ if a:outreg != '"' && a:outreg != '+'
+ " Register was passed, so store current selection in register
+ call setreg( a:outreg, s:swank_package_form . sel)
+ endif
+ let lines = [sel]
+ if a:testform != ''
+ if match( a:testform, '%1' ) >= 0
+ " We need to wrap the selection in the testform
+ if match( sel, "\n" ) < 0
+ " The selection is a single line, keep the wrapped form in one line
+ let sel = substitute( a:testform, '%1', sel, 'g' )
+ let lines = [sel]
+ else
+ " The selection is multiple lines, wrap it by adding new lines
+ let lines = [strpart( a:testform, 0, match( a:testform, '%1' ) ),
+ \ sel,
+ \ strpart( a:testform, matchend( a:testform, '%1' ) )]
+ endif
+ else
+ " Append optional test form at the tail
+ let lines = lines + [a:testform]
+ endif
+ endif
+ if exists( 'b:slimv_repl_buffer' )
+ " If this is the REPL buffer then go to EOF
+ call s:EndOfBuffer()
+ endif
+ call SlimvEval( lines )
+endfunction
+
+" Eval Lisp form.
+" Form given in the template is passed to Lisp without modification.
+function! SlimvEvalForm( template )
+ let lines = [a:template]
+ call SlimvEval( lines )
+endfunction
+
+" Eval Lisp form, with the given parameter substituted in the template.
+" %1 string is substituted with par1
+function! SlimvEvalForm1( template, par1 )
+ let p1 = escape( a:par1, '&' )
+ let temp1 = substitute( a:template, '%1', p1, 'g' )
+ let lines = [temp1]
+ call SlimvEval( lines )
+endfunction
+
+" Eval Lisp form, with the given parameters substituted in the template.
+" %1 string is substituted with par1
+" %2 string is substituted with par2
+function! SlimvEvalForm2( template, par1, par2 )
+ let p1 = escape( a:par1, '&' )
+ let p2 = escape( a:par2, '&' )
+ let temp1 = substitute( a:template, '%1', p1, 'g' )
+ let temp2 = substitute( temp1, '%2', p2, 'g' )
+ let lines = [temp2]
+ call SlimvEval( lines )
+endfunction
+
+
+" =====================================================================
+" Special functions
+" =====================================================================
+
+" Evaluate and test top level form at the cursor pos
+function! SlimvEvalTestDefun( testform )
+ let outreg = v:register
+ let oldpos = winsaveview()
+ if !SlimvSelectDefun()
+ return
+ endif
+ call SlimvFindPackage()
+ call winrestview( oldpos )
+ call SlimvEvalSelection( outreg, a:testform )
+endfunction
+
+" Evaluate top level form at the cursor pos
+function! SlimvEvalDefun()
+ call SlimvEvalTestDefun( '' )
+endfunction
+
+" Evaluate the whole buffer
+function! SlimvEvalBuffer()
+ if exists( 'b:slimv_repl_buffer' )
+ call SlimvError( "Cannot evaluate the REPL buffer." )
+ return
+ endif
+ let lines = getline( 1, '$' )
+ if SlimvGetFiletype() == 'scheme'
+ " Swank-scheme requires us to pass a single s-expression
+ " so embed buffer lines in a (begin ...) block
+ let lines = ['(begin'] + lines + [')']
+ endif
+ call SlimvEval( lines )
+endfunction
+
+" Return frame number if we are in the Backtrace section of the debugger
+function! s:DebugFrame()
+ if s:swank_connected && s:sldb_level >= 0
+ " Check if we are in SLDB
+ let sldb_buf = bufnr( '^' . g:slimv_sldb_name . '$' )
+ if sldb_buf != -1 && sldb_buf == bufnr( "%" )
+ let bcktrpos = search( '^Backtrace:', 'bcnw' )
+ let framepos = line( '.' )
+ if matchstr( getline('.'), s:frame_def ) == ''
+ let framepos = search( s:frame_def, 'bcnw' )
+ endif
+ if framepos > 0 && bcktrpos > 0 && framepos > bcktrpos
+ let line = getline( framepos )
+ let item = matchstr( line, s:frame_def )
+ if item != ''
+ return substitute( item, '\s\|:', '', 'g' )
+ endif
+ endif
+ endif
+ endif
+ return ''
+endfunction
+
+" Evaluate and test current s-expression at the cursor pos
+function! SlimvEvalTestExp( testform )
+ let outreg = v:register
+ let oldpos = winsaveview()
+ if !SlimvSelectForm( 1 )
+ return
+ endif
+ call SlimvFindPackage()
+ call winrestview( oldpos )
+ call SlimvEvalSelection( outreg, a:testform )
+endfunction
+
+" Evaluate current s-expression at the cursor pos
+function! SlimvEvalExp()
+ call SlimvEvalTestExp( '' )
+endfunction
+
+" Evaluate expression entered interactively
+function! SlimvInteractiveEval()
+ let frame = s:DebugFrame()
+ if frame != ''
+ " We are in the debugger, eval expression in the frame the cursor stands on
+ let e = input( 'Eval in frame ' . frame . ': ' )
+ if e != ''
+ let result = SlimvCommandGetResponse( ':eval-string-in-frame', s:py_cmd . 'swank_eval_in_frame("' . e . '", ' . frame . ')', 0 )
+ if result != ''
+ redraw
+ echo result
+ endif
+ endif
+ else
+ let e = input( 'Eval: ' )
+ if e != ''
+ call SlimvEval([e])
+ endif
+ endif
+endfunction
+
+" Undefine function
+function! SlimvUndefineFunction()
+ if s:swank_connected
+ call SlimvCommand( s:py_cmd . 'swank_undefine_function("' . SlimvSelectSymbol() . '")' )
+ call SlimvRefreshReplBuffer()
+ endif
+endfunction
+
+" ---------------------------------------------------------------------
+
+" Macroexpand-1 the current top level form
+function! SlimvMacroexpand()
+ if SlimvConnectSwank()
+ if !SlimvSelectForm( 0 )
+ return
+ endif
+ let s:swank_form = SlimvGetSelection()
+ if exists( 'b:slimv_repl_buffer' )
+ " If this is the REPL buffer then go to EOF
+ call s:EndOfBuffer()
+ endif
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_macroexpand("s:swank_form")' )
+ endif
+endfunction
+
+" Macroexpand the current top level form
+function! SlimvMacroexpandAll()
+ if SlimvConnectSwank()
+ if !SlimvSelectForm( 0 )
+ return
+ endif
+ let s:swank_form = SlimvGetSelection()
+ if exists( 'b:slimv_repl_buffer' )
+ " If this is the REPL buffer then go to EOF
+ call s:EndOfBuffer()
+ endif
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_macroexpand_all("s:swank_form")' )
+ endif
+endfunction
+
+" Toggle debugger break on exceptions
+" Only for ritz-swank 0.4.0 and above
+function! SlimvBreakOnException()
+ if SlimvGetFiletype() =~ '.*clojure.*' && s:SinceVersion( '2010-11-13' )
+ " swank-clojure is abandoned at protocol version 20100404, so it must be ritz-swank
+ if SlimvConnectSwank()
+ let s:break_on_exception = ! s:break_on_exception
+ call SlimvCommand( s:py_cmd . 'swank_break_on_exception(' . s:break_on_exception . ')' )
+ call SlimvRefreshReplBuffer()
+ echomsg 'Break On Exception ' . (s:break_on_exception ? 'enabled.' : 'disabled.')
+ endif
+ else
+ call SlimvError( "This function is implemented only for ritz-swank." )
+ endif
+endfunction
+
+" Set a breakpoint on the beginning of a function
+function! SlimvBreak()
+ if SlimvConnectSwank()
+ let s = input( 'Set breakpoint: ', SlimvSelectSymbol() )
+ if s != ''
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_set_break("' . s . '")' )
+ redraw!
+ endif
+ endif
+endfunction
+
+" Switch trace on for the selected function (toggle for swank)
+function! SlimvTrace()
+ if SlimvGetFiletype() == 'scheme'
+ call SlimvError( "Tracing is not supported by swank-scheme." )
+ return
+ endif
+ if SlimvConnectSwank()
+ let s = input( '(Un)trace: ', SlimvSelectSymbol() )
+ if s != ''
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_toggle_trace("' . s . '")' )
+ redraw!
+ endif
+ endif
+endfunction
+
+" Switch trace off for the selected function (or all functions for swank)
+function! SlimvUntrace()
+ if SlimvGetFiletype() == 'scheme'
+ call SlimvError( "Tracing is not supported by swank-scheme." )
+ return
+ endif
+ if SlimvConnectSwank()
+ let s:refresh_disabled = 1
+ call SlimvCommand( s:py_cmd . 'swank_untrace_all()' )
+ let s:refresh_disabled = 0
+ call SlimvRefreshReplBuffer()
+ endif
+endfunction
+
+" Disassemble the selected function
+function! SlimvDisassemble()
+ let symbol = SlimvSelectSymbol()
+ if SlimvConnectSwank()
+ let s = input( 'Disassemble: ', symbol )
+ if s != ''
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_disassemble("' . s . '")' )
+ endif
+ endif
+endfunction
+
+" Inspect symbol under cursor
+function! SlimvInspect()
+ if !SlimvConnectSwank()
+ return
+ endif
+ let s:inspect_path = []
+ let frame = s:DebugFrame()
+ if frame != ''
+ " Inspect selected for a frame in the debugger's Backtrace section
+ let line = getline( '.' )
+ if matchstr( line, s:frame_def ) != ''
+ " This is the base frame line in form ' 1: xxxxx'
+ let sym = ''
+ elseif matchstr( line, '^\s\+in "\(.*\)" \(line\|byte\)' ) != ''
+ " This is the source location line
+ let sym = ''
+ elseif matchstr( line, '^\s\+No source line information' ) != ''
+ " This is the no source location line
+ let sym = ''
+ elseif matchstr( line, '^\s\+Locals:' ) != ''
+ " This is the 'Locals' line
+ let sym = ''
+ else
+ let sym = SlimvSelectSymbolExt()
+ endif
+ let s = input( 'Inspect in frame ' . frame . ' (evaluated): ', sym )
+ if s != ''
+ let s:inspect_path = [s]
+ call SlimvCommand( s:py_cmd . 'swank_inspect_in_frame("' . s . '", ' . frame . ')' )
+ call SlimvRefreshReplBuffer()
+ endif
+ else
+ let s = input( 'Inspect: ', SlimvSelectSymbolExt() )
+ if s != ''
+ let s:inspect_path = [s]
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_inspect("' . s . '")' )
+ endif
+ endif
+endfunction
+
+" Cross reference: who calls
+function! SlimvXrefBase( text, cmd )
+ if SlimvConnectSwank()
+ let s = input( a:text, SlimvSelectSymbol() )
+ if s != ''
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_xref("' . s . '", "' . a:cmd . '")' )
+ endif
+ endif
+endfunction
+
+" Cross reference: who calls
+function! SlimvXrefCalls()
+ call SlimvXrefBase( 'Who calls: ', ':calls' )
+endfunction
+
+" Cross reference: who references
+function! SlimvXrefReferences()
+ call SlimvXrefBase( 'Who references: ', ':references' )
+endfunction
+
+" Cross reference: who sets
+function! SlimvXrefSets()
+ call SlimvXrefBase( 'Who sets: ', ':sets' )
+endfunction
+
+" Cross reference: who binds
+function! SlimvXrefBinds()
+ call SlimvXrefBase( 'Who binds: ', ':binds' )
+endfunction
+
+" Cross reference: who macroexpands
+function! SlimvXrefMacroexpands()
+ call SlimvXrefBase( 'Who macroexpands: ', ':macroexpands' )
+endfunction
+
+" Cross reference: who specializes
+function! SlimvXrefSpecializes()
+ call SlimvXrefBase( 'Who specializes: ', ':specializes' )
+endfunction
+
+" Cross reference: list callers
+function! SlimvXrefCallers()
+ call SlimvXrefBase( 'List callers: ', ':callers' )
+endfunction
+
+" Cross reference: list callees
+function! SlimvXrefCallees()
+ call SlimvXrefBase( 'List callees: ', ':callees' )
+endfunction
+
+" ---------------------------------------------------------------------
+
+" Switch or toggle profiling on for the selected function
+function! SlimvProfile()
+ if SlimvConnectSwank()
+ let s = input( '(Un)profile: ', SlimvSelectSymbol() )
+ if s != ''
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_toggle_profile("' . s . '")' )
+ redraw!
+ endif
+ endif
+endfunction
+
+" Switch profiling on based on substring
+function! SlimvProfileSubstring()
+ if SlimvConnectSwank()
+ let s = input( 'Profile by matching substring: ', SlimvSelectSymbol() )
+ if s != ''
+ let p = input( 'Package (RET for all packages): ' )
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_profile_substring("' . s . '","' . p . '")' )
+ redraw!
+ endif
+ endif
+endfunction
+
+" Switch profiling completely off
+function! SlimvUnprofileAll()
+ if SlimvConnectSwank()
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_unprofile_all()' )
+ endif
+endfunction
+
+" Display list of profiled functions
+function! SlimvShowProfiled()
+ if SlimvConnectSwank()
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_profiled_functions()' )
+ endif
+endfunction
+
+" Report profiling results
+function! SlimvProfileReport()
+ if SlimvConnectSwank()
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_profile_report()' )
+ endif
+endfunction
+
+" Reset profiling counters
+function! SlimvProfileReset()
+ if SlimvConnectSwank()
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_profile_reset()' )
+ endif
+endfunction
+
+" ---------------------------------------------------------------------
+
+" Compile the current top-level form
+function! SlimvCompileDefun()
+ let oldpos = winsaveview()
+ if !SlimvSelectDefun()
+ call winrestview( oldpos )
+ return
+ endif
+ if SlimvConnectSwank()
+ let s:swank_form = SlimvGetSelection()
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_compile_string("s:swank_form")' )
+ endif
+ call winrestview( oldpos )
+endfunction
+
+" Compile and load whole file
+function! SlimvCompileLoadFile()
+ if exists( 'b:slimv_repl_buffer' )
+ call SlimvError( "Cannot compile the REPL buffer." )
+ return
+ endif
+ let filename = fnamemodify( bufname(''), ':p' )
+ let filename = substitute( filename, '\\', '/', 'g' )
+ if &modified
+ let answer = SlimvErrorAsk( '', "Save file before compiling [Y/n]?" )
+ if answer[0] != 'n' && answer[0] != 'N'
+ write
+ endif
+ endif
+ if SlimvConnectSwank()
+ let s:compiled_file = ''
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_compile_file("' . filename . '")' )
+ let starttime = localtime()
+ while s:compiled_file == '' && localtime()-starttime < g:slimv_timeout
+ call SlimvSwankResponse()
+ endwhile
+ if s:compiled_file != ''
+ let s:compiled_file = substitute( s:compiled_file, '\\', '/', 'g' )
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_load_file("' . s:compiled_file . '")' )
+ let s:compiled_file = ''
+ endif
+ endif
+endfunction
+
+" Compile whole file
+function! SlimvCompileFile()
+ if exists( 'b:slimv_repl_buffer' )
+ call SlimvError( "Cannot compile the REPL buffer." )
+ return
+ endif
+ let filename = fnamemodify( bufname(''), ':p' )
+ let filename = substitute( filename, '\\', '/', 'g' )
+ if &modified
+ let answer = SlimvErrorAsk( '', "Save file before compiling [Y/n]?" )
+ if answer[0] != 'n' && answer[0] != 'N'
+ write
+ endif
+ endif
+ if SlimvConnectSwank()
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_compile_file("' . filename . '")' )
+ endif
+endfunction
+
+" Compile buffer lines in the given range
+function! SlimvCompileRegion() range
+ if v:register == '"' || v:register == '+'
+ let lines = SlimvGetRegion(a:firstline, a:lastline)
+ else
+ " Register was passed, so compile register contents instead
+ let reg = getreg( v:register )
+ let ending = s:CloseForm( reg )
+ if ending == 'ERROR'
+ call SlimvError( 'Too many or invalid closing parens in register "' . v:register )
+ return
+ endif
+ let lines = [reg . ending]
+ endif
+ if lines == []
+ return
+ endif
+ let region = join( lines, "\n" )
+ if SlimvConnectSwank()
+ let s:swank_form = region
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_compile_string("s:swank_form")' )
+ endif
+endfunction
+
+" ---------------------------------------------------------------------
+
+" Describe the selected symbol
+function! SlimvDescribeSymbol()
+ if SlimvConnectSwank()
+ let symbol = SlimvSelectSymbol()
+ if symbol == ''
+ call SlimvError( "No symbol under cursor." )
+ return
+ endif
+ call SlimvCommandUsePackage( s:py_cmd . 'swank_describe_symbol("' . symbol . '")' )
+ endif
+endfunction
+
+" Display symbol description in balloonexpr
+function! SlimvDescribe(arg)
+ let arg=a:arg
+ if a:arg == ''
+ let arg = expand('<cword>')
+ endif
+ " We don't want to try connecting here ... the error message would just
+ " confuse the balloon logic
+ if !s:swank_connected || s:read_string_mode
+ return ''
+ endif
+ call SlimvFindPackage()
+ let arglist = SlimvCommandGetResponse( ':operator-arglist', s:py_cmd . 'swank_op_arglist("' . arg . '")', 0 )
+ if arglist == ''
+ " Not able to fetch arglist, assuming function is not defined
+ " Skip calling describe, otherwise SWANK goes into the debugger
+ return ''
+ endif
+ let msg = SlimvCommandGetResponse( ':describe-function', s:py_cmd . 'swank_describe_function("' . arg . '")', 0 )
+ if msg == ''
+ " No describe info, display arglist
+ if match( arglist, arg ) != 1
+ " Function name is not received from REPL
+ return "(" . arg . ' ' . arglist[1:]
+ else
+ return arglist
+ endif
+ else
+ return substitute(msg,'^\n*','','')
+ endif
+endfunction
+
+" Apropos of the selected symbol
+function! SlimvApropos()
+ call SlimvEvalForm1( g:slimv_template_apropos, SlimvSelectSymbol() )
+endfunction
+
+" Generate tags file using ctags
+function! SlimvGenerateTags()
+ if exists( 'g:slimv_ctags' ) && g:slimv_ctags != ''
+ execute 'silent !' . g:slimv_ctags
+ else
+ call SlimvError( "Copy ctags to the Vim path or define g:slimv_ctags." )
+ endif
+endfunction
+
+" ---------------------------------------------------------------------
+
+" Find word in the CLHS symbol database, with exact or partial match.
+" Return either the first symbol found with the associated URL,
+" or the list of all symbols found without the associated URL.
+function! SlimvFindSymbol( word, exact, all, db, root, init )
+ if a:word == ''
+ return []
+ endif
+ if !a:all && a:init != []
+ " Found something already at a previous db lookup, no need to search this db
+ return a:init
+ endif
+ let lst = a:init
+ let i = 0
+ let w = tolower( a:word )
+ if a:exact
+ while i < len( a:db )
+ " Try to find an exact match
+ if a:db[i][0] == w
+ " No reason to check a:all here
+ return [a:db[i][0], a:root . a:db[i][1]]
+ endif
+ let i = i + 1
+ endwhile
+ else
+ while i < len( a:db )
+ " Try to find the symbol starting with the given word
+ let w2 = escape( w, '~' )
+ if match( a:db[i][0], w2 ) == 0
+ if a:all
+ call add( lst, a:db[i][0] )
+ else
+ return [a:db[i][0], a:root . a:db[i][1]]
+ endif
+ endif
+ let i = i + 1
+ endwhile
+ endif
+
+ " Return whatever found so far
+ return lst
+endfunction
+
+" Lookup word in Common Lisp Hyperspec
+function! SlimvLookup( word )
+ " First try an exact match
+ let w = a:word
+ let symbol = []
+ while symbol == []
+ let symbol = SlimvHyperspecLookup( w, 1, 0 )
+ if symbol == []
+ " Symbol not found, try a match on beginning of symbol name
+ let symbol = SlimvHyperspecLookup( w, 0, 0 )
+ if symbol == []
+ " We are out of luck, can't find anything
+ let msg = 'Symbol ' . w . ' not found. Hyperspec lookup word: '
+ let val = ''
+ else
+ let msg = 'Hyperspec lookup word: '
+ let val = symbol[0]
+ endif
+ " Ask user if this is that he/she meant
+ let w = input( msg, val )
+ if w == ''
+ " OK, user does not want to continue
+ return
+ endif
+ let symbol = []
+ endif
+ endwhile
+ if symbol != [] && len(symbol) > 1
+ " Symbol found, open HS page in browser
+ if match( symbol[1], ':' ) < 0 && exists( 'g:slimv_hs_root' )
+ let page = g:slimv_hs_root . symbol[1]
+ else
+ " URL is already a fully qualified address
+ let page = symbol[1]
+ endif
+ if exists( "g:slimv_browser_cmd" )
+ " We have an given command to start the browser
+ if !exists( "g:slimv_browser_cmd_suffix" )
+ " Fork the browser by default
+ let g:slimv_browser_cmd_suffix = '&'
+ endif
+ silent execute '! ' . g:slimv_browser_cmd . ' ' . page . ' ' . g:slimv_browser_cmd_suffix
+ else
+ if g:slimv_windows
+ " Run the program associated with the .html extension
+ silent execute '! start ' . page
+ else
+ " On Linux it's not easy to determine the default browser
+ if executable( 'xdg-open' )
+ silent execute '! xdg-open ' . page . ' &'
+ else
+ " xdg-open not installed, ask help from Python webbrowser package
+ let pycmd = "import webbrowser; webbrowser.open('" . page . "')"
+ silent execute '! python -c "' . pycmd . '"'
+ endif
+ endif
+ endif
+ " This is needed especially when using text browsers
+ redraw!
+ endif
+endfunction
+
+" Lookup current symbol in the Common Lisp Hyperspec
+function! SlimvHyperspec()
+ call SlimvLookup( SlimvSelectSymbol() )
+endfunction
+
+" Complete symbol name starting with 'base'
+function! SlimvComplete( base )
+ " Find all symbols starting with "a:base"
+ if a:base == ''
+ return []
+ endif
+ if s:swank_connected && !s:read_string_mode
+ " Save current buffer and window in case a swank command causes a buffer change
+ let buf = bufnr( "%" )
+ if winnr('$') < 2
+ let win = 0
+ else
+ let win = winnr()
+ endif
+
+ call SlimvFindPackage()
+ if g:slimv_simple_compl
+ let msg = SlimvCommandGetResponse( ':simple-completions', s:py_cmd . 'swank_completions("' . a:base . '")', 0 )
+ else
+ let msg = SlimvCommandGetResponse( ':fuzzy-completions', s:py_cmd . 'swank_fuzzy_completions("' . a:base . '")', 0 )
+ endif
+
+ " Restore window and buffer, because it is not allowed to change buffer here
+ if win > 0 && winnr() != win
+ execute win . "wincmd w"
+ let msg = ''
+ endif
+ if bufnr( "%" ) != buf
+ execute "buf " . buf
+ let msg = ''
+ endif
+
+ if msg != ''
+ " We have a completion list from SWANK
+ let res = split( msg, '\n' )
+ return res
+ endif
+ endif
+
+ " No completion yet, try to fetch it from the Hyperspec database
+ let res = []
+ let symbol = SlimvHyperspecLookup( a:base, 0, 1 )
+ if symbol == []
+ return []
+ endif
+ call sort( symbol )
+ for m in symbol
+ if m =~ '^' . a:base
+ call add( res, m )
+ endif
+ endfor
+ return res
+endfunction
+
+" Complete function that uses the Hyperspec database
+function! SlimvOmniComplete( findstart, base )
+ if a:findstart
+ " Locate the start of the symbol name
+ call s:SetKeyword()
+ let upto = strpart( getline( '.' ), 0, col( '.' ) - 1)
+ return match(upto, '\k\+$')
+ else
+ return SlimvComplete( a:base )
+ endif
+endfunction
+
+" Define complete function only if none is defined yet
+if &omnifunc == ''
+ set omnifunc=SlimvOmniComplete
+endif
+
+" Complete function for user-defined commands
+function! SlimvCommandComplete( arglead, cmdline, cursorpos )
+ " Locate the start of the symbol name
+ call s:SetKeyword()
+ let upto = strpart( a:cmdline, 0, a:cursorpos )
+ let base = matchstr(upto, '\k\+$')
+ let ext = matchstr(upto, '\S*\k\+$')
+ let compl = SlimvComplete( base )
+ if len(compl) > 0 && base != ext
+ " Command completion replaces whole word between spaces, so we
+ " need to add any prefix present in front of the keyword, like '('
+ let prefix = strpart( ext, 0, len(ext) - len(base) )
+ let i = 0
+ while i < len(compl)
+ let compl[i] = prefix . compl[i]
+ let i = i + 1
+ endwhile
+ endif
+ return compl
+endfunction
+
+" Create a tags file containing the definitions
+" of the given symbol, then perform a tag lookup
+function! SlimvFindDefinitionsForEmacs( symbol )
+ if g:slimv_tags_file == ''
+ let msg = ''
+ else
+ let msg = SlimvCommandGetResponse( ':find-definitions-for-emacs', s:py_cmd . 'swank_find_definitions_for_emacs("' . a:symbol . '")', 0 )
+ endif
+ try
+ if msg != ''
+ exec ":tjump " . msg
+ else
+ exec ":tjump " . a:symbol
+ endif
+ catch /^Vim\%((\a\+)\)\=:E426/
+ call SlimvError( "\r" . v:exception )
+ endtry
+endfunction
+
+" Lookup definition(s) of the symbol under cursor
+function! SlimvFindDefinitions()
+ if SlimvConnectSwank()
+ let symbol = SlimvSelectSymbol()
+ if symbol == ''
+ call SlimvError( "No symbol under cursor." )
+ return
+ endif
+ call SlimvFindPackage()
+ call SlimvFindDefinitionsForEmacs( symbol )
+ endif
+endfunction
+
+" Lookup definition(s) of symbol entered in prompt
+function! SlimvFindDefinitionsPrompt()
+ if SlimvConnectSwank()
+ let symbol = input( 'Find Definitions For: ', SlimvSelectSymbol() )
+ call SlimvFindDefinitionsForEmacs( symbol )
+ endif
+endfunction
+
+" Set current package
+function! SlimvSetPackage()
+ if SlimvConnectSwank()
+ call SlimvFindPackage()
+ let pkg = input( 'Package: ', s:swank_package )
+ if pkg != ''
+ let s:refresh_disabled = 1
+ call SlimvCommand( s:py_cmd . 'swank_set_package("' . pkg . '")' )
+ let s:refresh_disabled = 0
+ call SlimvRefreshReplBuffer()
+ endif
+ endif
+endfunction
+
+" Close lisp process running the swank server
+" and quit REPL buffer
+function! SlimvQuitRepl()
+ if s:swank_connected
+ call SlimvCommand( s:py_cmd . 'swank_quit_lisp()' )
+ let s:swank_connected = 0
+ let buf = bufnr( '^' . g:slimv_repl_name . '$' )
+ if buf != -1
+ if g:slimv_repl_split
+ " REPL buffer exists, check if it is open in a window
+ let win = bufwinnr( buf )
+ if win != -1
+ " Switch to the REPL window and close it
+ if winnr() != win
+ execute win . "wincmd w"
+ endif
+ execute "wincmd c"
+ endif
+ endif
+ execute "bd " . buf
+ endif
+ endif
+endfunction
+
+" =====================================================================
+" Slimv keybindings
+" =====================================================================
+
+" <Leader> timeouts in 1000 msec by default, if this is too short,
+" then increase 'timeoutlen'
+
+" Map keyboard keyset dependant shortcut to command and also add it to menu
+function! s:MenuMap( name, shortcut1, shortcut2, command )
+ if g:slimv_keybindings == 1
+ " Short (one-key) keybinding set
+ let shortcut = a:shortcut1
+ elseif g:slimv_keybindings == 2
+ " Easy to remember (two-key) keybinding set
+ let shortcut = a:shortcut2
+ else
+ " No bindings
+ let shortcut = ''
+ endif
+
+ if shortcut != ''
+ execute "noremap <silent> " . shortcut . " " . a:command
+ if a:name != '' && g:slimv_menu == 1
+ silent execute "amenu " . a:name . "<Tab>" . shortcut . " " . a:command
+ endif
+ elseif a:name != '' && g:slimv_menu == 1
+ silent execute "amenu " . a:name . " " . a:command
+ endif
+endfunction
+
+" Initialize buffer by adding buffer specific mappings
+function! SlimvInitBuffer()
+ " Map space to display function argument list in status line
+ if SlimvGetFiletype() == 'r'
+ inoremap <silent> <buffer> ( (<C-R>=SlimvArglist()<CR>
+ else
+ if !exists("g:slimv_unmap_space") || g:slimv_unmap_space == 0
+ inoremap <silent> <buffer> <Space> <Space><C-R>=SlimvArglist()<CR>
+ endif
+ if !exists("g:slimv_unmap_cr") || g:slimv_unmap_cr == 0
+ inoremap <silent> <buffer> <CR> <C-R>=pumvisible() ? "\<lt>C-Y>" : SlimvHandleEnter()<CR><C-R>=SlimvArglistOnEnter()<CR>
+ endif
+ endif
+ "noremap <silent> <buffer> <C-C> :call SlimvInterrupt()<CR>
+ augroup SlimvInsertLeave
+ au!
+ au InsertEnter * :let s:save_showmode=&showmode
+ au InsertLeave * :let &showmode=s:save_showmode
+ augroup END
+ inoremap <silent> <buffer> <C-X>0 <C-O>:call SlimvCloseForm()<CR>
+ if !exists("g:slimv_unmap_tab") || g:slimv_unmap_tab == 0
+ inoremap <silent> <buffer> <Tab> <C-R>=SlimvHandleTab()<CR>
+ endif
+ inoremap <silent> <buffer> <S-Tab> <C-R>=pumvisible() ? "\<lt>C-P>" : "\<lt>S-Tab>"<CR>
+ if g:slimv_tags_file != ''
+ nnoremap <silent> <buffer> <C-]> :call SlimvFindDefinitions()<CR>
+ endif
+
+ " Setup balloonexp to display symbol description
+ if g:slimv_balloon && has( 'balloon_eval' )
+ "setlocal balloondelay=100
+ setlocal ballooneval
+ setlocal balloonexpr=SlimvDescribe(v:beval_text)
+ endif
+ " This is needed for safe switching of modified buffers
+ set hidden
+ call s:MakeWindowId()
+endfunction
+
+" Edit commands
+call s:MenuMap( 'Slim&v.Edi&t.Close-&Form', g:slimv_leader.')', g:slimv_leader.'tc', ':<C-U>call SlimvCloseForm()<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.&Complete-Symbol<Tab>Tab', '', '', '<Ins><C-X><C-O>' )
+call s:MenuMap( 'Slim&v.Edi&t.Find-&Definitions\.\.\.', g:slimv_leader.'j', g:slimv_leader.'fd', ':call SlimvFindDefinitionsPrompt()<CR>' )
+
+if exists( 'g:paredit_loaded' )
+call s:MenuMap( 'Slim&v.Edi&t.&Paredit-Toggle', g:slimv_leader.'(', g:slimv_leader.'(t', ':<C-U>call PareditToggle()<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.-PareditSep-', '', '', ':' )
+
+if g:paredit_shortmaps
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-&Wrap<Tab>' .'W', '', '', ':<C-U>call PareditWrap("(",")")<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-Spli&ce<Tab>' .'S', '', '', ':<C-U>call PareditSplice()<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-&Split<Tab>' .'O', '', '', ':<C-U>call PareditSplit()<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-&Join<Tab>' .'J', '', '', ':<C-U>call PareditJoin()<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-Ra&ise<Tab>' .g:slimv_leader.'I', '', '', ':<C-U>call PareditRaise()<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-Move&Left<Tab>' .'<', '', '', ':<C-U>call PareditMoveLeft()<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-Move&Right<Tab>' .'>', '', '', ':<C-U>call PareditMoveRight()<CR>' )
+else
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-&Wrap<Tab>' .g:slimv_leader.'W', '', '', ':<C-U>call PareditWrap("(",")")<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-Spli&ce<Tab>' .g:slimv_leader.'S', '', '', ':<C-U>call PareditSplice()<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-&Split<Tab>' .g:slimv_leader.'O', '', '', ':<C-U>call PareditSplit()<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-&Join<Tab>' .g:slimv_leader.'J', '', '', ':<C-U>call PareditJoin()<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-Ra&ise<Tab>' .g:slimv_leader.'I', '', '', ':<C-U>call PareditRaise()<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-Move&Left<Tab>' .g:slimv_leader.'<', '', '', ':<C-U>call PareditMoveLeft()<CR>' )
+call s:MenuMap( 'Slim&v.Edi&t.Paredit-Move&Right<Tab>' .g:slimv_leader.'>', '', '', ':<C-U>call PareditMoveRight()<CR>' )
+endif "g:paredit_shortmaps
+endif "g:paredit_loaded
+
+" Evaluation commands
+call s:MenuMap( 'Slim&v.&Evaluation.Eval-&Defun', g:slimv_leader.'d', g:slimv_leader.'ed', ':<C-U>call SlimvEvalDefun()<CR>' )
+call s:MenuMap( 'Slim&v.&Evaluation.Eval-Current-&Exp', g:slimv_leader.'e', g:slimv_leader.'ee', ':<C-U>call SlimvEvalExp()<CR>' )
+call s:MenuMap( 'Slim&v.&Evaluation.Eval-&Region', g:slimv_leader.'r', g:slimv_leader.'er', ':call SlimvEvalRegion()<CR>' )
+call s:MenuMap( 'Slim&v.&Evaluation.Eval-&Buffer', g:slimv_leader.'b', g:slimv_leader.'eb', ':<C-U>call SlimvEvalBuffer()<CR>' )
+call s:MenuMap( 'Slim&v.&Evaluation.Interacti&ve-Eval\.\.\.', g:slimv_leader.'v', g:slimv_leader.'ei', ':call SlimvInteractiveEval()<CR>' )
+call s:MenuMap( 'Slim&v.&Evaluation.&Undefine-Function', g:slimv_leader.'u', g:slimv_leader.'eu', ':call SlimvUndefineFunction()<CR>' )
+
+" Debug commands
+call s:MenuMap( 'Slim&v.De&bugging.Macroexpand-&1', g:slimv_leader.'1', g:slimv_leader.'m1', ':<C-U>call SlimvMacroexpand()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.&Macroexpand-All', g:slimv_leader.'m', g:slimv_leader.'ma', ':<C-U>call SlimvMacroexpandAll()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.Toggle-&Trace\.\.\.', g:slimv_leader.'t', g:slimv_leader.'dt', ':call SlimvTrace()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.U&ntrace-All', g:slimv_leader.'T', g:slimv_leader.'du', ':call SlimvUntrace()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.Set-&Breakpoint', g:slimv_leader.'B', g:slimv_leader.'db', ':call SlimvBreak()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.Break-on-&Exception', g:slimv_leader.'E', g:slimv_leader.'de', ':call SlimvBreakOnException()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.Disassemb&le\.\.\.', g:slimv_leader.'l', g:slimv_leader.'dd', ':call SlimvDisassemble()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.&Inspect\.\.\.', g:slimv_leader.'i', g:slimv_leader.'di', ':call SlimvInspect()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.-SldbSep-', '', '', ':' )
+call s:MenuMap( 'Slim&v.De&bugging.&Abort', g:slimv_leader.'a', g:slimv_leader.'da', ':call SlimvDebugAbort()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.&Quit-to-Toplevel', g:slimv_leader.'q', g:slimv_leader.'dq', ':call SlimvDebugQuit()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.&Continue', g:slimv_leader.'n', g:slimv_leader.'dc', ':call SlimvDebugContinue()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.&Restart-Frame', g:slimv_leader.'N', g:slimv_leader.'dr', ':call SlimvDebugRestartFrame()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.-ThreadSep-', '', '', ':' )
+call s:MenuMap( 'Slim&v.De&bugging.List-T&hreads', g:slimv_leader.'H', g:slimv_leader.'dl', ':call SlimvListThreads()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.&Kill-Thread\.\.\.', g:slimv_leader.'K', g:slimv_leader.'dk', ':call SlimvKillThread()<CR>' )
+call s:MenuMap( 'Slim&v.De&bugging.&Debug-Thread\.\.\.', g:slimv_leader.'G', g:slimv_leader.'dT', ':call SlimvDebugThread()<CR>' )
+
+" Compile commands
+call s:MenuMap( 'Slim&v.&Compilation.Compile-&Defun', g:slimv_leader.'D', g:slimv_leader.'cd', ':<C-U>call SlimvCompileDefun()<CR>' )
+call s:MenuMap( 'Slim&v.&Compilation.Compile-&Load-File', g:slimv_leader.'L', g:slimv_leader.'cl', ':<C-U>call SlimvCompileLoadFile()<CR>' )
+call s:MenuMap( 'Slim&v.&Compilation.Compile-&File', g:slimv_leader.'F', g:slimv_leader.'cf', ':<C-U>call SlimvCompileFile()<CR>' )
+call s:MenuMap( 'Slim&v.&Compilation.Compile-&Region', g:slimv_leader.'R', g:slimv_leader.'cr', ':call SlimvCompileRegion()<CR>' )
+
+" Xref commands
+call s:MenuMap( 'Slim&v.&Xref.Who-&Calls', g:slimv_leader.'xc', g:slimv_leader.'xc', ':call SlimvXrefCalls()<CR>' )
+call s:MenuMap( 'Slim&v.&Xref.Who-&References', g:slimv_leader.'xr', g:slimv_leader.'xr', ':call SlimvXrefReferences()<CR>' )
+call s:MenuMap( 'Slim&v.&Xref.Who-&Sets', g:slimv_leader.'xs', g:slimv_leader.'xs', ':call SlimvXrefSets()<CR>' )
+call s:MenuMap( 'Slim&v.&Xref.Who-&Binds', g:slimv_leader.'xb', g:slimv_leader.'xb', ':call SlimvXrefBinds()<CR>' )
+call s:MenuMap( 'Slim&v.&Xref.Who-&Macroexpands', g:slimv_leader.'xm', g:slimv_leader.'xm', ':call SlimvXrefMacroexpands()<CR>' )
+call s:MenuMap( 'Slim&v.&Xref.Who-S&pecializes', g:slimv_leader.'xp', g:slimv_leader.'xp', ':call SlimvXrefSpecializes()<CR>' )
+call s:MenuMap( 'Slim&v.&Xref.&List-Callers', g:slimv_leader.'xl', g:slimv_leader.'xl', ':call SlimvXrefCallers()<CR>' )
+call s:MenuMap( 'Slim&v.&Xref.List-Call&ees', g:slimv_leader.'xe', g:slimv_leader.'xe', ':call SlimvXrefCallees()<CR>' )
+
+" Profile commands
+call s:MenuMap( 'Slim&v.&Profiling.Toggle-&Profile\.\.\.', g:slimv_leader.'p', g:slimv_leader.'pp', ':<C-U>call SlimvProfile()<CR>' )
+call s:MenuMap( 'Slim&v.&Profiling.Profile-&By-Substring\.\.\.',g:slimv_leader.'P', g:slimv_leader.'pb', ':<C-U>call SlimvProfileSubstring()<CR>' )
+call s:MenuMap( 'Slim&v.&Profiling.Unprofile-&All', g:slimv_leader.'U', g:slimv_leader.'pa', ':<C-U>call SlimvUnprofileAll()<CR>' )
+call s:MenuMap( 'Slim&v.&Profiling.&Show-Profiled', g:slimv_leader.'?', g:slimv_leader.'ps', ':<C-U>call SlimvShowProfiled()<CR>' )
+call s:MenuMap( 'Slim&v.&Profiling.-ProfilingSep-', '', '', ':' )
+call s:MenuMap( 'Slim&v.&Profiling.Profile-Rep&ort', g:slimv_leader.'o', g:slimv_leader.'pr', ':<C-U>call SlimvProfileReport()<CR>' )
+call s:MenuMap( 'Slim&v.&Profiling.Profile-&Reset', g:slimv_leader.'X', g:slimv_leader.'px', ':<C-U>call SlimvProfileReset()<CR>' )
+
+" Documentation commands
+call s:MenuMap( 'Slim&v.&Documentation.Describe-&Symbol', g:slimv_leader.'s', g:slimv_leader.'ds', ':call SlimvDescribeSymbol()<CR>' )
+call s:MenuMap( 'Slim&v.&Documentation.&Apropos', g:slimv_leader.'A', g:slimv_leader.'dp', ':call SlimvApropos()<CR>' )
+call s:MenuMap( 'Slim&v.&Documentation.&Hyperspec', g:slimv_leader.'h', g:slimv_leader.'dh', ':call SlimvHyperspec()<CR>' )
+call s:MenuMap( 'Slim&v.&Documentation.Generate-&Tags', g:slimv_leader.']', g:slimv_leader.'dg', ':call SlimvGenerateTags()<CR>' )
+
+" REPL commands
+call s:MenuMap( 'Slim&v.&Repl.&Connect-Server', g:slimv_leader.'c', g:slimv_leader.'rc', ':call SlimvConnectServer()<CR>' )
+call s:MenuMap( '', g:slimv_leader.'g', g:slimv_leader.'rp', ':call SlimvSetPackage()<CR>' )
+call s:MenuMap( 'Slim&v.&Repl.Interrup&t-Lisp-Process', g:slimv_leader.'y', g:slimv_leader.'ri', ':call SlimvInterrupt()<CR>' )
+call s:MenuMap( 'Slim&v.&Repl.Clear-&REPL', g:slimv_leader.'-', g:slimv_leader.'-', ':call SlimvClearReplBuffer()<CR>' )
+call s:MenuMap( 'Slim&v.&Repl.&Quit-REPL', g:slimv_leader.'Q', g:slimv_leader.'rq', ':call SlimvQuitRepl()<CR>' )
+
+
+" =====================================================================
+" Slimv menu
+" =====================================================================
+
+if g:slimv_menu == 1
+ " Works only if 'wildcharm' is <Tab>
+ if &wildcharm == 0
+ set wildcharm=<Tab>
+ endif
+ if &wildcharm != 0
+ execute ':map ' . g:slimv_leader.', :emenu Slimv.' . nr2char( &wildcharm )
+ endif
+endif
+
+" Add REPL menu. This menu exist only for the REPL buffer.
+function! SlimvAddReplMenu()
+ if &wildcharm != 0
+ execute ':map ' . g:slimv_leader.'\ :emenu REPL.' . nr2char( &wildcharm )
+ endif
+
+ amenu &REPL.Send-&Input :call SlimvSendCommand(0)<CR>
+ amenu &REPL.Cl&ose-Send-Input :call SlimvSendCommand(1)<CR>
+ amenu &REPL.Set-Packa&ge :call SlimvSetPackage()<CR>
+ amenu &REPL.Interrup&t-Lisp-Process <Esc>:<C-U>call SlimvInterrupt()<CR>
+ amenu &REPL.-REPLSep- :
+ amenu &REPL.&Previous-Input :call SlimvPreviousCommand()<CR>
+ amenu &REPL.&Next-Input :call SlimvNextCommand()<CR>
+ amenu &REPL.Clear-&REPL :call SlimvClearReplBuffer()<CR>
+endfunction
+
+" =====================================================================
+" Slimv commands
+" =====================================================================
+
+command! -complete=customlist,SlimvCommandComplete -nargs=* Lisp call SlimvEval([<q-args>])
+command! -complete=customlist,SlimvCommandComplete -nargs=* Eval call SlimvEval([<q-args>])
+
+" Switch on syntax highlighting
+if !exists("g:syntax_on")
+ syntax on
+endif
+
diff --git a/vim/bundle/slimv/ftplugin/swank.py b/vim/bundle/slimv/ftplugin/swank.py
new file mode 100644
index 0000000..359cd68
--- /dev/null
+++ b/vim/bundle/slimv/ftplugin/swank.py
@@ -0,0 +1,1373 @@
+#!/usr/bin/env python)
+
+###############################################################################
+#
+# SWANK client for Slimv
+# swank.py: SWANK client code for slimv.vim plugin
+# Version: 0.9.13
+# Last Change: 16 Jan 2017
+# Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+# License: This file is placed in the public domain.
+# No warranty, express or implied.
+# *** *** Use At-Your-Own-Risk! *** ***
+#
+###############################################################################
+
+from __future__ import print_function
+
+import socket
+import time
+import select
+import string
+import sys
+
+input_port = 4005
+output_port = 4006
+lenbytes = 6 # Message length is encoded in this number of bytes
+maxmessages = 50 # Maximum number of messages to receive in one listening session
+recv_timeout = 0.001 # socket recv timeout in seconds
+listen_retries = 10 # number of retries if no response in swank_listen()
+sock = None # Swank socket object
+id = 0 # Message id
+debug = False
+log = False # Set this to True in order to enable logging
+logfile = 'swank.log' # Logfile name in case logging is on
+pid = '0' # Process id
+current_thread = '0'
+use_unicode = True # Use unicode message length counting
+debug_active = False # Swank debugger is active
+debug_activated = False # Swank debugger was activated
+read_string = None # Thread and tag in Swank read string mode
+empty_last_line = True # Swank output ended with a new line
+prompt = 'SLIMV' # Command prompt
+package = 'COMMON-LISP-USER' # Current package
+actions = dict() # Swank actions (like ':write-string'), by message id
+indent_info = dict() # Data of :indentation-update
+frame_locals = dict() # Map frame variable names to their index
+inspect_lines = 0 # Number of lines in the Inspector (excluding help text)
+inspect_newline = True # Start a new line in the Inspector (for multi-part objects)
+inspect_package = '' # Package used for the current Inspector
+swank_version = '' # Swank version string in format YYYY-MM-DD
+swank_param = '' # Additional parameter for the swank listener
+
+
+###############################################################################
+# Basic utility functions
+###############################################################################
+
+def logprint(text):
+ if log:
+ f = open(logfile, "a")
+ f.write(text + '\n')
+ f.close()
+
+def logtime(text):
+ logprint(text + ' ' + str(time.clock()))
+
+###############################################################################
+# Simple Lisp s-expression parser
+###############################################################################
+
+# Possible error codes
+PARSERR_NOSTARTBRACE = -1 # s-expression does not start with a '('
+PARSERR_NOCLOSEBRACE = -2 # s-expression does not end with a '('
+PARSERR_NOCLOSESTRING = -3 # string is not closed with double quote
+PARSERR_MISSINGLITERAL = -4 # literal is missing after the escape character
+PARSERR_EMPTY = -5 # s-expression is empty
+
+
+def parse_comment( sexpr ):
+ """Parses a ';' Lisp comment till the end of line, returns comment length
+ """
+ pos = sexpr.find( '\n' )
+ if pos >= 0:
+ return pos + 1
+ return len( sexpr )
+
+def parse_keyword( sexpr ):
+ """Parses a Lisp keyword, returns keyword length
+ """
+ for pos in range( len( sexpr ) ):
+ if sexpr[pos] in string.whitespace + ')]':
+ return pos
+ return pos
+
+def parse_sub_sexpr( sexpr, opening, closing ):
+ """Parses a Lisp sub -expression, returns parsed string length
+ and a Python list built from the s-expression,
+ expression can be a Clojure style list surrounded by braces
+ """
+ result = []
+ l = len( sexpr )
+ for pos in range( l ):
+ # Find first opening '(' or '['
+ if sexpr[pos] == opening:
+ break
+ if not sexpr[pos] in string.whitespace:
+ # S-expression does not start with '(' or '['
+ return [PARSERR_NOSTARTBRACE, result]
+ else:
+ # Empty s-expression
+ return [PARSERR_EMPTY, result]
+
+ pos = pos + 1
+ quote_cnt = 0
+ while pos < l:
+ literal = 0
+ if sexpr[pos] == '\\':
+ literal = 1
+ pos = pos + 1
+ if pos == l:
+ return [PARSERR_MISSINGLITERAL, result]
+ if not literal and sexpr[pos] == '"':
+ # We toggle a string
+ quote_cnt = 1 - quote_cnt
+ if quote_cnt == 1:
+ quote_pos = pos
+ else:
+ result = result + [sexpr[quote_pos:pos+1]]
+ elif quote_cnt == 0:
+ # We are not in a string
+ if not literal and sexpr[pos] == '(':
+ # Parse sub expression
+ [slen, subresult] = parse_sub_sexpr( sexpr[pos:], '(', ')' )
+ if slen < 0:
+ # Sub expression parsing error
+ return [slen, result]
+ result = result + [subresult]
+ pos = pos + slen - 1
+ elif not literal and sexpr[pos] == '[':
+ # Parse sub expression
+ [slen, subresult] = parse_sub_sexpr( sexpr[pos:], '[', ']' )
+ if slen < 0:
+ # Sub expression parsing error
+ return [slen, result]
+ result = result + [subresult]
+ pos = pos + slen - 1
+ elif not literal and sexpr[pos] == closing:
+ # End of this sub expression
+ return [pos + 1, result]
+ elif not literal and sexpr[pos] != closing and sexpr[pos] in ')]':
+ # Wrong closing brace/bracket
+ return [PARSERR_NOCLOSEBRACE, result]
+ elif not literal and sexpr[pos] == ';':
+ # Skip coment
+ pos = pos + parse_comment( sexpr[pos:] ) - 1
+ elif not literal and sexpr[pos] in "#'`@~,^":
+ # Skip prefix characters
+ while pos+1 < l and sexpr[pos+1] not in string.whitespace + '([':
+ pos = pos + 1
+ elif not sexpr[pos] in string.whitespace + '\\':
+ # Parse keyword but ignore dot in dotted notation (a . b)
+ klen = parse_keyword( sexpr[pos:] )
+ if klen > 1 or sexpr[pos] != '.':
+ result = result + [sexpr[pos:pos+klen]]
+ pos = pos + klen - 1
+ pos = pos + 1
+
+ if quote_cnt != 0:
+ # Last string is not closed
+ return [PARSERR_NOCLOSESTRING, result]
+ # Closing ')' or ']' not found
+ return [PARSERR_NOCLOSEBRACE, result]
+
+def parse_sexpr( sexpr ):
+ """Parses a Lisp s-expression, returns parsed string length
+ and a Python list built from the s-expression
+ """
+ return parse_sub_sexpr( sexpr, '(', ')' )
+
+
+###############################################################################
+# Swank server interface
+###############################################################################
+
+class swank_action:
+ def __init__ (self, id, name, data):
+ self.id = id
+ self.name = name
+ self.data = data
+ self.result = ''
+ self.pending = True
+
+def get_prompt():
+ global prompt
+ if prompt.rstrip()[-1] == '>':
+ return prompt + ' '
+ else:
+ return prompt + '> '
+
+def unquote(s):
+ if len(s) < 2:
+ return s
+ if s[0] == '"' and s[-1] == '"':
+ slist = []
+ esc = False
+ for c in s[1:-1]:
+ if not esc and c == '\\':
+ esc = True
+ elif esc and c == 'n':
+ esc = False
+ slist.append('\n')
+ else:
+ esc = False
+ slist.append(c)
+ return "".join(slist)
+ else:
+ return s
+
+def requote(s):
+ t = s.replace('\\', '\\\\')
+ t = t.replace('"', '\\"')
+ return '"' + t + '"'
+
+def new_line(new_text):
+ global empty_last_line
+
+ if new_text != '':
+ if new_text[-1] != '\n':
+ return '\n'
+ elif not empty_last_line:
+ return '\n'
+ return ''
+
+def make_keys(lst):
+ keys = {}
+ for i in range(len(lst)):
+ if i < len(lst)-1 and lst[i][0] == ':':
+ keys[lst[i]] = unquote( lst[i+1] )
+ return keys
+
+def parse_plist(lst, keyword):
+ for i in range(0, len(lst), 2):
+ if keyword == lst[i]:
+ return unquote(lst[i+1])
+ return ''
+
+def parse_filepos(fname, loc):
+ lnum = 1
+ cnum = 1
+ pos = loc
+ try:
+ f = open(fname, "r")
+ except:
+ return [0, 0]
+ for line in f:
+ if pos < len(line):
+ cnum = pos
+ break
+ pos = pos - len(line)
+ lnum = lnum + 1
+ f.close()
+ return [lnum, cnum]
+
+def format_filename(fname):
+ fname = vim.eval('fnamemodify(' + fname + ', ":~:.")')
+ if fname.find(' ') >= 0:
+ fname = '"' + fname + '"'
+ return fname
+
+def parse_location(lst):
+ fname = ''
+ line = ''
+ pos = ''
+ if lst[0] == ':location':
+ if type(lst[1]) == str:
+ return unquote(lst[1])
+ for l in lst[1:]:
+ if l[0] == ':file':
+ fname = l[1]
+ if l[0] == ':line':
+ line = l[1]
+ if l[0] == ':position':
+ pos = l[1]
+ if fname == '':
+ fname = 'Unknown file'
+ if line != '':
+ return 'in ' + format_filename(fname) + ' line ' + line
+ if pos != '':
+ [lnum, cnum] = parse_filepos(unquote(fname), int(pos))
+ if lnum > 0:
+ return 'in ' + format_filename(fname) + ' line ' + str(lnum)
+ else:
+ return 'in ' + format_filename(fname) + ' byte ' + pos
+ return 'no source line information'
+
+def unicode_len(text):
+ if use_unicode:
+ if sys.version_info[0] > 2:
+ return len(str(text))
+ else:
+ return len(unicode(text, "utf-8"))
+ else:
+ if sys.version_info[0] > 2:
+ return len(text.encode('utf-8'))
+ else:
+ return len(text)
+
+def swank_send(text):
+ global sock
+
+ logtime('[---Sent---]')
+ logprint(text)
+ l = "%06x" % unicode_len(text)
+ t = l + text
+ if debug:
+ print( 'Sending:', t)
+ try:
+ if sys.version_info[0] > 2:
+ sock.send(t.encode('utf-8'))
+ else:
+ sock.send(t)
+ except socket.error:
+ vim.command("let s:swank_result='Socket error when sending to SWANK server.\n'")
+ swank_disconnect()
+
+def swank_recv_len(timeout):
+ global sock
+
+ rec = ''
+ sock.setblocking(0)
+ ready = select.select([sock], [], [], timeout)
+ if ready[0]:
+ l = lenbytes
+ sock.setblocking(1)
+ try:
+ data = sock.recv(l)
+ except socket.error:
+ vim.command("let s:swank_result='Socket error when receiving from SWANK server.\n'")
+ swank_disconnect()
+ return rec
+ while data and len(rec) < lenbytes:
+ if sys.version_info[0] > 2:
+ rec = rec + data.decode('utf-8')
+ else:
+ rec = rec + data
+ l = l - len(data)
+ if l > 0:
+ try:
+ data = sock.recv(l)
+ except socket.error:
+ vim.command("let s:swank_result='Socket error when receiving from SWANK server.\n'")
+ swank_disconnect()
+ return rec
+ return rec
+
+def swank_recv(msglen, timeout):
+ global sock
+
+ if msglen > 0:
+ sock.setblocking(0)
+ ready = select.select([sock], [], [], timeout)
+ if ready[0]:
+ sock.setblocking(1)
+ rec = ''
+ while True:
+ # Each codepoint has at least 1 byte; so we start with the
+ # number of bytes, and read more if needed.
+ try:
+ needed = msglen - unicode_len(rec)
+ except UnicodeDecodeError:
+ # Add single bytes until we've got valid UTF-8 again
+ needed = max(msglen - len(rec), 1)
+ if needed == 0:
+ return rec
+ try:
+ data = sock.recv(needed)
+ except socket.error:
+ vim.command("let s:swank_result='Socket error when receiving from SWANK server.\n'")
+ swank_disconnect()
+ return rec
+ if len(data) == 0:
+ vim.command("let s:swank_result='Socket error when receiving from SWANK server.\n'")
+ swank_disconnect()
+ return rec
+ if sys.version_info[0] > 2:
+ rec = rec + data.decode('utf-8')
+ else:
+ rec = rec + data
+ rec = ''
+
+def swank_parse_inspect_content(pcont):
+ """
+ Parse the swank inspector content
+ """
+ global inspect_lines
+ global inspect_newline
+
+ if type(pcont[0]) != list:
+ return
+ vim.command('setlocal modifiable')
+ buf = vim.current.buffer
+ help_lines = int( vim.eval('exists("b:help_shown") ? len(b:help) : 1') )
+ pos = help_lines + inspect_lines
+ buf[pos:] = []
+ istate = pcont[1]
+ start = pcont[2]
+ end = pcont[3]
+ lst = []
+ for el in pcont[0]:
+ logprint(str(el))
+ newline = False
+ if type(el) == list:
+ if el[0] == ':action':
+ text = '{<' + unquote(el[2]) + '> ' + unquote(el[1]) + ' <>}'
+ else:
+ text = '{[' + unquote(el[2]) + '] ' + unquote(el[1]) + ' []}'
+ lst.append(text)
+ else:
+ text = unquote(el)
+ lst.append(text)
+ if text == "\n":
+ newline = True
+ lines = "".join(lst).split("\n")
+ if inspect_newline or pos > len(buf):
+ buf.append(lines)
+ else:
+ buf[pos-1] = buf[pos-1] + lines[0]
+ buf.append(lines[1:])
+ inspect_lines = len(buf) - help_lines
+ inspect_newline = newline
+ if int(istate) > int(end):
+ # Swank returns end+1000 if there are more entries to request
+ buf.append(['', "[--more--]", "[--all---]"])
+ inspect_path = vim.eval('s:inspect_path')
+ if len(inspect_path) > 1:
+ buf.append(['', '[<<] Return to ' + ' -> '.join(inspect_path[:-1])])
+ else:
+ buf.append(['', '[<<] Exit Inspector'])
+ if int(istate) > int(end):
+ # There are more entries to request
+ # Save current range for the next request
+ vim.command("let b:range_start=" + start)
+ vim.command("let b:range_end=" + end)
+ vim.command("let b:inspect_more=" + end)
+ else:
+ # No ore entries left
+ vim.command("let b:inspect_more=0")
+ vim.command('call SlimvEndUpdate()')
+
+def swank_parse_inspect(struct):
+ """
+ Parse the swank inspector output
+ """
+ global inspect_lines
+ global inspect_newline
+
+ vim.command('call SlimvBeginUpdate()')
+ vim.command('call SlimvOpenInspectBuffer()')
+ vim.command('setlocal modifiable')
+ buf = vim.current.buffer
+ title = parse_plist(struct, ':title')
+ vim.command('let b:inspect_title="' + title + '"')
+ buf[:] = ['Inspecting ' + title, '--------------------', '']
+ vim.command('normal! 3G0')
+ vim.command('call SlimvHelp(2)')
+ pcont = parse_plist(struct, ':content')
+ inspect_lines = 3
+ inspect_newline = True
+ swank_parse_inspect_content(pcont)
+ vim.command('call SlimvSetInspectPos("' + title + '")')
+
+def swank_parse_debug(struct):
+ """
+ Parse the SLDB output
+ """
+ vim.command('call SlimvBeginUpdate()')
+ vim.command('call SlimvOpenSldbBuffer()')
+ vim.command('setlocal modifiable')
+ buf = vim.current.buffer
+ [thread, level, condition, restarts, frames, conts] = struct[1:7]
+ buf[:] = [l for l in (unquote(condition[0]) + "\n" + unquote(condition[1])).splitlines()]
+ buf.append(['', 'Restarts:'])
+ for i in range( len(restarts) ):
+ r0 = unquote( restarts[i][0] )
+ r1 = unquote( restarts[i][1] )
+ r1 = r1.replace("\n", " ")
+ buf.append([str(i).rjust(3) + ': [' + r0 + '] ' + r1])
+ buf.append(['', 'Backtrace:'])
+ for f in frames:
+ frame = str(f[0])
+ ftext = unquote( f[1] )
+ ftext = ftext.replace('\n', '')
+ ftext = ftext.replace('\\\\n', '')
+ buf.append([frame.rjust(3) + ': ' + ftext])
+ vim.command('call SlimvEndUpdate()')
+ vim.command("call search('^Restarts:', 'w')")
+ vim.command('stopinsert')
+ # This text will be printed into the REPL buffer
+ return unquote(condition[0]) + "\n" + unquote(condition[1]) + "\n"
+
+def swank_parse_xref(struct):
+ """
+ Parse the swank xref output
+ """
+ buf = ''
+ for e in struct:
+ buf = buf + unquote(e[0]) + ' - ' + parse_location(e[1]) + '\n'
+ return buf
+
+def swank_parse_compile(struct):
+ """
+ Parse compiler output
+ """
+ buf = ''
+ warnings = struct[1]
+ time = struct[3]
+ filename = ''
+ if len(struct) > 5:
+ filename = struct[5]
+ if filename == '' or filename[0] != '"':
+ filename = '"' + filename + '"'
+ vim.command('let s:compiled_file=' + filename + '')
+ vim.command("let qflist = []")
+ if type(warnings) == list:
+ buf = '\n' + str(len(warnings)) + ' compiler notes:\n\n'
+ for w in warnings:
+ msg = parse_plist(w, ':message')
+ severity = parse_plist(w, ':severity')
+ if severity[0] == ':':
+ severity = severity[1:]
+ location = parse_plist(w, ':location')
+ if location[0] == ':error':
+ # "no error location available"
+ buf = buf + ' ' + unquote(location[1]) + '\n'
+ buf = buf + ' ' + severity + ': ' + msg + '\n\n'
+ else:
+ fname = unquote(location[1][1])
+ pos = location[2][1]
+ if location[3] != 'nil':
+ snippet = unquote(location[3][1]).replace('\r', '')
+ buf = buf + snippet + '\n'
+ buf = buf + fname + ':' + pos + '\n'
+ buf = buf + ' ' + severity + ': ' + msg + '\n\n'
+ if location[2][0] == ':line':
+ lnum = pos
+ cnum = 1
+ else:
+ [lnum, cnum] = parse_filepos(fname, int(pos))
+ msg = msg.replace("'", "' . \"'\" . '")
+ qfentry = "{'filename':'"+fname+"','lnum':'"+str(lnum)+"','col':'"+str(cnum)+"','text':'"+msg+"'}"
+ logprint(qfentry)
+ vim.command("call add(qflist, " + qfentry + ")")
+ else:
+ buf = '\nCompilation finished. (No warnings) [' + time + ' secs]\n\n'
+ vim.command("call setqflist(qflist)")
+ return buf
+
+def swank_parse_list_threads(tl):
+ vim.command('call SlimvBeginUpdate()')
+ vim.command('call SlimvOpenThreadsBuffer()')
+ vim.command('setlocal modifiable')
+ buf = vim.current.buffer
+ buf[:] = ['Threads in pid '+pid, '--------------------']
+ vim.command('call SlimvHelp(2)')
+ buf.append(['', 'Idx ID Status Name Priority', \
+ '---- ---- -------------------- -------------------- ---------'])
+ vim.command('normal! G0')
+ lst = tl[1]
+ headers = lst.pop(0)
+ logprint(str(lst))
+ idx = 0
+ for t in lst:
+ priority = ''
+ if len(t) > 3:
+ priority = unquote(t[3])
+ buf.append(["%3d: %3d %-22s %-22s %s" % (idx, int(t[0]), unquote(t[2]), unquote(t[1]), priority)])
+ idx = idx + 1
+ vim.command('normal! j')
+ vim.command('call SlimvEndUpdate()')
+
+def swank_parse_frame_call(struct, action):
+ """
+ Parse frame call output
+ """
+ vim.command('call SlimvGotoFrame(' + action.data + ')')
+ vim.command('setlocal modifiable')
+ buf = vim.current.buffer
+ win = vim.current.window
+ line = win.cursor[0]
+ if type(struct) == list:
+ buf[line:line] = [struct[1][1]]
+ else:
+ buf[line:line] = ['No frame call information']
+ vim.command('call SlimvEndUpdate()')
+
+def swank_parse_frame_source(struct, action):
+ """
+ Parse frame source output
+ http://comments.gmane.org/gmane.lisp.slime.devel/9961 ;-(
+ 'Well, let's say a missing feature: source locations are currently not available for code loaded as source.'
+ """
+ vim.command('call SlimvGotoFrame(' + action.data + ')')
+ vim.command('setlocal modifiable')
+ buf = vim.current.buffer
+ win = vim.current.window
+ line = win.cursor[0]
+ if type(struct) == list and len(struct) == 4:
+ if struct[1] == 'nil':
+ [lnum, cnum] = [int(struct[2][1]), 1]
+ fname = 'Unknown file'
+ else:
+ [lnum, cnum] = parse_filepos(unquote(struct[1][1]), int(struct[2][1]))
+ fname = format_filename(struct[1][1])
+ if lnum > 0:
+ s = ' in ' + fname + ' line ' + str(lnum)
+ else:
+ s = ' in ' + fname + ' byte ' + struct[2][1]
+ slines = s.splitlines()
+ if len(slines) > 2:
+ # Make a fold (closed) if there are too many lines
+ slines[ 0] = slines[ 0] + '{{{'
+ slines[-1] = slines[-1] + '}}}'
+ buf[line:line] = slines
+ vim.command(str(line+1) + 'foldclose')
+ else:
+ buf[line:line] = slines
+ else:
+ buf[line:line] = [' No source line information']
+ vim.command('call SlimvEndUpdate()')
+
+def swank_parse_locals(struct, action):
+ """
+ Parse frame locals output
+ """
+ frame_num = action.data
+ vim.command('call SlimvGotoFrame(' + frame_num + ')')
+ vim.command('setlocal modifiable')
+ buf = vim.current.buffer
+ win = vim.current.window
+ line = win.cursor[0]
+ if type(struct) == list:
+ lines = ' Locals:'
+ num = 0
+ for f in struct:
+ name = parse_plist(f, ':name')
+ id = parse_plist(f, ':id')
+ value = parse_plist(f, ':value')
+ lines = lines + '\n ' + name + ' = ' + value
+ # Remember variable index in frame
+ frame_locals[str(frame_num) + " " + name] = num
+ num = num + 1
+ else:
+ lines = ' No locals'
+ buf[line:line] = lines.split("\n")
+ vim.command('call SlimvEndUpdate()')
+
+def swank_listen():
+ global output_port
+ global use_unicode
+ global debug_active
+ global debug_activated
+ global read_string
+ global empty_last_line
+ global current_thread
+ global prompt
+ global package
+ global pid
+ global swank_version
+ global swank_param
+
+ retval = ''
+ msgcount = 0
+ #logtime('[- Listen--]')
+ timeout = recv_timeout
+ while msgcount < maxmessages:
+ rec = swank_recv_len(timeout)
+ if rec == '':
+ break
+ timeout = 0.0
+ msgcount = msgcount + 1
+ if debug:
+ print('swank_recv_len received', rec)
+ msglen = int(rec, 16)
+ if debug:
+ print('Received length:', msglen)
+ if msglen > 0:
+ # length already received so it must be followed by data
+ # use a higher timeout
+ rec = swank_recv(msglen, 1.0)
+ logtime('[-Received-]')
+ logprint(rec)
+ [s, r] = parse_sexpr( rec )
+ if debug:
+ print('Parsed:', r)
+ if len(r) > 0:
+ r_id = r[-1]
+ message = r[0].lower()
+ if debug:
+ print('Message:', message)
+
+ if message == ':open-dedicated-output-stream':
+ output_port = int( r[1].lower(), 10 )
+ if debug:
+ print(':open-dedicated-output-stream result:', output_port)
+ break
+
+ elif message == ':presentation-start':
+ retval = retval + new_line(retval)
+
+ elif message == ':write-string':
+ # REPL has new output to display
+ if len(r) > 2 and r[2] == ':repl-result':
+ retval = retval + new_line(retval)
+ retval = retval + unquote(r[1])
+ add_prompt = True
+ for k,a in actions.items():
+ if a.pending and a.name.find('eval') >= 0:
+ add_prompt = False
+ break
+ if add_prompt:
+ retval = retval + new_line(retval) + get_prompt()
+
+ elif message == ':read-string':
+ # REPL requests entering a string
+ read_string = r[1:3]
+ vim.command('let s:read_string_mode=1')
+
+ elif message == ':read-from-minibuffer':
+ # REPL requests entering a string in the command line
+ read_string = r[1:3]
+ vim.command('let s:read_string_mode=1')
+ vim.command("let s:input_prompt='%s'" % unquote(r[3]).replace("'", "''"))
+
+ elif message == ':indentation-update':
+ for el in r[1]:
+ indent_info[ unquote(el[0]) ] = el[1]
+
+ elif message == ':new-package':
+ package = unquote( r[1] )
+ prompt = unquote( r[2] )
+
+ elif message == ':return':
+ read_string = None
+ vim.command('let s:read_string_mode=0')
+ if len(r) > 1:
+ result = r[1][0].lower()
+ else:
+ result = ""
+ if type(r_id) == str and r_id in actions:
+ action = actions[r_id]
+ action.pending = False
+ else:
+ action = None
+ if log:
+ logtime('[Actionlist]')
+ for k,a in sorted(actions.items()):
+ if a.pending:
+ pending = 'pending '
+ else:
+ pending = 'finished'
+ logprint("%s: %s %s %s" % (k, str(pending), a.name, a.result))
+
+ if result == ':ok':
+ params = r[1][1]
+ logprint('params: ' + str(params))
+ if params == []:
+ params = 'nil'
+ if type(params) == str:
+ element = params.lower()
+ to_ignore = [':frame-call', ':quit-inspector', ':kill-thread', ':debug-thread']
+ to_nodisp = [':describe-symbol']
+ to_prompt = [':undefine-function', ':swank-macroexpand-1', ':swank-macroexpand-all', ':disassemble-form', \
+ ':load-file', ':toggle-profile-fdefinition', ':profile-by-substring', ':swank-toggle-trace', 'sldb-break']
+ if action and action.name in to_ignore:
+ # Just ignore the output for this message
+ pass
+ elif element == 'nil' and action and action.name == ':inspector-pop':
+ # Quit inspector
+ vim.command('call SlimvQuitInspect(0)')
+ elif element != 'nil' and action and action.name in to_nodisp:
+ # Do not display output, just store it in actions
+ action.result = unquote(params)
+ else:
+ retval = retval + new_line(retval)
+ if element != 'nil':
+ retval = retval + unquote(params)
+ if action:
+ action.result = retval
+ vim.command("let s:swank_ok_result='%s'" % retval.replace("'", "''").replace("\0", "^@"))
+ if element == 'nil' or (action and action.name in to_prompt):
+ # No more output from REPL, write new prompt
+ retval = retval + new_line(retval) + get_prompt()
+
+ elif type(params) == list and params:
+ element = ''
+ if type(params[0]) == str:
+ element = params[0].lower()
+ if element == ':present':
+ # No more output from REPL, write new prompt
+ retval = retval + new_line(retval) + unquote(params[1][0][0]) + '\n' + get_prompt()
+ elif element == ':values':
+ retval = retval + new_line(retval)
+ if type(params[1]) == list:
+ retval = retval + unquote(params[1][0]) + '\n'
+ else:
+ retval = retval + unquote(params[1]) + '\n' + get_prompt()
+ elif element == ':suppress-output':
+ pass
+ elif element == ':pid':
+ conn_info = make_keys(params)
+ pid = conn_info[':pid']
+ swank_version = conn_info.get(':version', 'nil')
+ if len(swank_version) == 8:
+ # Convert version to YYYY-MM-DD format
+ swank_version = swank_version[0:4] + '-' + swank_version[4:6] + '-' + swank_version[6:8]
+ imp = make_keys( conn_info[':lisp-implementation'] )
+ pkg = make_keys( conn_info[':package'] )
+ package = pkg[':name']
+ prompt = pkg[':prompt']
+ vim.command('let s:swank_version="' + swank_version + '"')
+ if len(swank_version) < 8 or swank_version >= '2011-11-08':
+ # Recent swank servers count bytes instead of unicode characters
+ use_unicode = False
+ vim.command('let s:lisp_version="' + imp[':version'] + '"')
+ retval = retval + new_line(retval)
+ retval = retval + imp[':type'] + ' ' + imp[':version'] + ' Port: ' + str(input_port) + ' Pid: ' + pid + '\n; SWANK ' + swank_version
+ retval = retval + '\n' + get_prompt()
+ logprint(' Package:' + package + ' Prompt:' + prompt)
+ elif element == ':name':
+ keys = make_keys(params)
+ retval = retval + new_line(retval)
+ retval = retval + ' ' + keys[':name'] + ' = ' + keys[':value'] + '\n'
+ elif element == ':title':
+ swank_parse_inspect(params)
+ elif element == ':compilation-result':
+ retval = retval + new_line(retval) + swank_parse_compile(params) + get_prompt()
+ else:
+ if action.name == ':simple-completions':
+ if type(params[0]) == list and len(params[0]) > 0 and type(params[0][0]) == str and params[0][0] != 'nil':
+ compl = "\n".join(params[0])
+ retval = retval + compl.replace('"', '')
+ elif action.name == ':fuzzy-completions':
+ if type(params[0]) == list and type(params[0][0]) == list:
+ compl = "\n".join(map(lambda x: x[0], params[0]))
+ retval = retval + compl.replace('"', '')
+ elif action.name == ':find-definitions-for-emacs':
+ if type(params[0]) == list and type(params[0][1]) == list and params[0][1][0] == ':location':
+ tags_file = vim.eval("g:slimv_tags_file")
+ temp = open(tags_file, 'w')
+ myitems = [[elem[1][1][1], elem[1][2][1]] for elem in params]
+ for i in myitems:
+ temp.write(swank_param)
+ temp.write('\t')
+ temp.write(i[0].replace('"', ''))
+ temp.write('\t')
+ temp.write(":go %s" % i[1])
+ temp.write('\n')
+ temp.close()
+ retval = swank_param
+ elif action.name == ':list-threads':
+ swank_parse_list_threads(r[1])
+ elif action.name == ':xref':
+ retval = retval + '\n' + swank_parse_xref(r[1][1])
+ retval = retval + new_line(retval) + get_prompt()
+ elif action.name == ':set-package':
+ package = unquote(params[0])
+ prompt = unquote(params[1])
+ retval = retval + '\n' + get_prompt()
+ elif action.name == ':untrace-all':
+ retval = retval + '\nUntracing:'
+ for f in params:
+ retval = retval + '\n' + ' ' + f
+ retval = retval + '\n' + get_prompt()
+ elif action.name == ':frame-call':
+ swank_parse_frame_call(params, action)
+ elif action.name == ':frame-source-location':
+ swank_parse_frame_source(params, action)
+ elif action.name == ':frame-locals-and-catch-tags':
+ swank_parse_locals(params[0], action)
+ elif action.name == ':profiled-functions':
+ retval = retval + '\n' + 'Profiled functions:\n'
+ for f in params:
+ retval = retval + ' ' + f + '\n'
+ retval = retval + get_prompt()
+ elif action.name == ':inspector-range':
+ swank_parse_inspect_content(params)
+ if action:
+ action.result = retval
+
+ elif result == ':abort':
+ debug_active = False
+ vim.command('let s:sldb_level=-1')
+ if len(r[1]) > 1:
+ retval = retval + '; Evaluation aborted on ' + unquote(r[1][1]).replace('\n', '\n;') + '\n' + get_prompt()
+ else:
+ retval = retval + '; Evaluation aborted\n' + get_prompt()
+
+ elif message == ':inspect':
+ swank_parse_inspect(r[1])
+
+ elif message == ':debug':
+ retval = retval + swank_parse_debug(r)
+
+ elif message == ':debug-activate':
+ debug_active = True
+ debug_activated = True
+ current_thread = r[1]
+ sldb_level = r[2]
+ vim.command('let s:sldb_level=' + sldb_level)
+ frame_locals.clear()
+
+ elif message == ':debug-return':
+ debug_active = False
+ vim.command('let s:sldb_level=-1')
+ retval = retval + '; Quit to level ' + r[2] + '\n' + get_prompt()
+
+ elif message == ':ping':
+ [thread, tag] = r[1:3]
+ swank_send('(:emacs-pong ' + thread + ' ' + tag + ')')
+ if retval != '':
+ empty_last_line = (retval[-1] == '\n')
+ return retval
+
+def swank_rex(action, cmd, package, thread, data=''):
+ """
+ Send an :emacs-rex command to SWANK
+ """
+ global id
+ id = id + 1
+ key = str(id)
+ actions[key] = swank_action(key, action, data)
+ form = '(:emacs-rex ' + cmd + ' ' + package + ' ' + thread + ' ' + str(id) + ')\n'
+ swank_send(form)
+
+def get_package():
+ """
+ Package set by slimv.vim or nil
+ """
+ pkg = vim.eval("s:swank_package")
+ if pkg == '':
+ return 'nil'
+ else:
+ return requote(pkg)
+
+def get_swank_package():
+ """
+ Package set by slimv.vim or current swank package
+ """
+ pkg = vim.eval("s:swank_package")
+ if pkg == '':
+ return requote(package)
+ else:
+ return requote(pkg)
+
+def get_indent_info(name):
+ indent = ''
+ if name in indent_info:
+ indent = indent_info[name]
+ vc = ":let s:indent='" + indent + "'"
+ vim.command(vc)
+
+###############################################################################
+# Various SWANK messages
+###############################################################################
+
+def swank_connection_info():
+ global log
+ actions.clear()
+ indent_info.clear()
+ frame_locals.clear()
+ debug_activated = False
+ if vim.eval('exists("g:swank_log") && g:swank_log') != '0':
+ log = True
+ swank_rex(':connection-info', '(swank:connection-info)', 'nil', 't')
+
+def swank_create_repl():
+ global swank_version
+ if len(swank_version) < 8 or swank_version >= '2014-10-01':
+ swank_rex(':create-repl', '(swank-repl:create-repl nil)', get_swank_package(), 't')
+ else:
+ swank_rex(':create-repl', '(swank:create-repl nil)', get_swank_package(), 't')
+
+def swank_eval(exp):
+ if len(swank_version) < 8 or swank_version >= '2014-10-01':
+ cmd = '(swank-repl:listener-eval ' + requote(exp) + ')'
+ else:
+ cmd = '(swank:listener-eval ' + requote(exp) + ')'
+ swank_rex(':listener-eval', cmd, get_swank_package(), ':repl-thread')
+
+def swank_eval_in_frame(exp, n):
+ pkg = get_swank_package()
+ if len(swank_version) < 8 or swank_version >= '2011-11-21':
+ cmd = '(swank:eval-string-in-frame ' + requote(exp) + ' ' + str(n) + ' ' + pkg + ')'
+ else:
+ cmd = '(swank:eval-string-in-frame ' + requote(exp) + ' ' + str(n) + ')'
+ swank_rex(':eval-string-in-frame', cmd, pkg, current_thread, str(n))
+
+def swank_pprint_eval(exp):
+ cmd = '(swank:pprint-eval ' + requote(exp) + ')'
+ swank_rex(':pprint-eval', cmd, get_swank_package(), ':repl-thread')
+
+def swank_interrupt():
+ swank_send('(:emacs-interrupt :repl-thread)')
+
+def swank_invoke_restart(level, restart):
+ cmd = '(swank:invoke-nth-restart-for-emacs ' + level + ' ' + restart + ')'
+ swank_rex(':invoke-nth-restart-for-emacs', cmd, 'nil', current_thread, restart)
+
+def swank_throw_toplevel():
+ swank_rex(':throw-to-toplevel', '(swank:throw-to-toplevel)', 'nil', current_thread)
+
+def swank_invoke_abort():
+ swank_rex(':sldb-abort', '(swank:sldb-abort)', 'nil', current_thread)
+
+def swank_invoke_continue():
+ swank_rex(':sldb-continue', '(swank:sldb-continue)', 'nil', current_thread)
+
+def swank_require(contrib):
+ cmd = "(swank:swank-require '" + contrib + ')'
+ swank_rex(':swank-require', cmd, 'nil', 't')
+
+def swank_frame_call(frame):
+ cmd = '(swank-backend:frame-call ' + frame + ')'
+ swank_rex(':frame-call', cmd, 'nil', current_thread, frame)
+
+def swank_frame_source_loc(frame):
+ cmd = '(swank:frame-source-location ' + frame + ')'
+ swank_rex(':frame-source-location', cmd, 'nil', current_thread, frame)
+
+def swank_frame_locals(frame):
+ cmd = '(swank:frame-locals-and-catch-tags ' + frame + ')'
+ swank_rex(':frame-locals-and-catch-tags', cmd, 'nil', current_thread, frame)
+
+def swank_restart_frame(frame):
+ cmd = '(swank-backend:restart-frame ' + frame + ')'
+ swank_rex(':restart-frame', cmd, 'nil', current_thread, frame)
+
+def swank_set_package(pkg):
+ cmd = '(swank:set-package "' + pkg + '")'
+ swank_rex(':set-package', cmd, get_package(), ':repl-thread')
+
+def swank_describe_symbol(fn):
+ cmd = '(swank:describe-symbol "' + fn + '")'
+ swank_rex(':describe-symbol', cmd, get_package(), 't')
+
+def swank_describe_function(fn):
+ cmd = '(swank:describe-function "' + fn + '")'
+ swank_rex(':describe-function', cmd, get_package(), 't')
+
+def swank_op_arglist(op):
+ pkg = get_swank_package()
+ cmd = '(swank:operator-arglist "' + op + '" ' + pkg + ')'
+ swank_rex(':operator-arglist', cmd, pkg, 't')
+
+def swank_completions(symbol):
+ cmd = '(swank:simple-completions "' + symbol + '" ' + get_swank_package() + ')'
+ swank_rex(':simple-completions', cmd, 'nil', 't')
+
+def swank_fuzzy_completions(symbol):
+ cmd = '(swank:fuzzy-completions "' + symbol + '" ' + get_swank_package() + ' :limit 2000 :time-limit-in-msec 2000)'
+ swank_rex(':fuzzy-completions', cmd, 'nil', 't')
+
+def swank_undefine_function(fn):
+ cmd = '(swank:undefine-function "' + fn + '")'
+ swank_rex(':undefine-function', cmd, get_package(), 't')
+
+def swank_return_string(s):
+ global read_string
+ swank_send('(:emacs-return-string ' + read_string[0] + ' ' + read_string[1] + ' ' + requote(s) + ')')
+ read_string = None
+ vim.command('let s:read_string_mode=0')
+
+def swank_return(s):
+ global read_string
+ if s != '':
+ swank_send('(:emacs-return ' + read_string[0] + ' ' + read_string[1] + ' "' + s + '")')
+ read_string = None
+ vim.command('let s:read_string_mode=0')
+
+def swank_inspect(symbol):
+ global inspect_package
+ cmd = '(swank:init-inspector "' + symbol + '")'
+ inspect_package = get_swank_package()
+ swank_rex(':init-inspector', cmd, inspect_package, 't')
+
+def swank_inspect_nth_part(n):
+ cmd = '(swank:inspect-nth-part ' + str(n) + ')'
+ swank_rex(':inspect-nth-part', cmd, get_swank_package(), 't', str(n))
+
+def swank_inspector_nth_action(n):
+ cmd = '(swank:inspector-call-nth-action ' + str(n) + ')'
+ swank_rex(':inspector-call-nth-action', cmd, 'nil', 't', str(n))
+
+def swank_inspector_pop():
+ # Remove the last entry from the inspect path
+ vim.command('let s:inspect_path = s:inspect_path[:-2]')
+ swank_rex(':inspector-pop', '(swank:inspector-pop)', 'nil', 't')
+
+def swank_inspect_in_frame(symbol, n):
+ key = str(n) + " " + symbol
+ if key in frame_locals:
+ cmd = '(swank:inspect-frame-var ' + str(n) + " " + str(frame_locals[key]) + ')'
+ else:
+ cmd = '(swank:inspect-in-frame "' + symbol + '" ' + str(n) + ')'
+ swank_rex(':inspect-in-frame', cmd, get_swank_package(), current_thread, str(n))
+
+def swank_inspector_range():
+ start = int(vim.eval("b:range_start"))
+ end = int(vim.eval("b:range_end"))
+ cmd = '(swank:inspector-range ' + str(end) + " " + str(end+(end-start)) + ')'
+ swank_rex(':inspector-range', cmd, inspect_package, 't')
+
+def swank_quit_inspector():
+ global inspect_package
+ swank_rex(':quit-inspector', '(swank:quit-inspector)', 'nil', 't')
+ inspect_package = ''
+
+def swank_break_on_exception(flag):
+ if flag:
+ swank_rex(':break-on-exception', '(swank:break-on-exception "true")', 'nil', current_thread)
+ else:
+ swank_rex(':break-on-exception', '(swank:break-on-exception "false")', 'nil', current_thread)
+
+def swank_set_break(symbol):
+ cmd = '(swank:sldb-break "' + symbol + '")'
+ swank_rex(':sldb-break', cmd, get_package(), 't')
+
+def swank_toggle_trace(symbol):
+ cmd = '(swank:swank-toggle-trace "' + symbol + '")'
+ swank_rex(':swank-toggle-trace', cmd, get_package(), 't')
+
+def swank_untrace_all():
+ swank_rex(':untrace-all', '(swank:untrace-all)', 'nil', 't')
+
+def swank_macroexpand(formvar):
+ form = vim.eval(formvar)
+ cmd = '(swank:swank-macroexpand-1 ' + requote(form) + ')'
+ swank_rex(':swank-macroexpand-1', cmd, get_package(), 't')
+
+def swank_macroexpand_all(formvar):
+ form = vim.eval(formvar)
+ cmd = '(swank:swank-macroexpand-all ' + requote(form) + ')'
+ swank_rex(':swank-macroexpand-all', cmd, get_package(), 't')
+
+def swank_disassemble(symbol):
+ cmd = '(swank:disassemble-form "' + "'" + symbol + '")'
+ swank_rex(':disassemble-form', cmd, get_package(), 't')
+
+def swank_xref(fn, type):
+ cmd = "(swank:xref '" + type + " '" + '"' + fn + '")'
+ swank_rex(':xref', cmd, get_package(), 't')
+
+def swank_compile_string(formvar):
+ form = vim.eval(formvar)
+ filename = vim.eval("substitute( expand('%:p'), '\\', '/', 'g' )")
+ line = vim.eval("line('.')")
+ pos = vim.eval("line2byte(line('.'))")
+ if vim.eval("&fileformat") == 'dos':
+ # Remove 0x0D, keep 0x0A characters
+ pos = str(int(pos) - int(line) + 1)
+ cmd = '(swank:compile-string-for-emacs ' + requote(form) + ' nil ' + "'((:position " + str(pos) + ") (:line " + str(line) + " 1)) " + requote(filename) + ' nil)'
+ swank_rex(':compile-string-for-emacs', cmd, get_package(), 't')
+
+def swank_compile_file(name):
+ cmd = '(swank:compile-file-for-emacs ' + requote(name) + ' t)'
+ swank_rex(':compile-file-for-emacs', cmd, get_package(), 't')
+
+def swank_load_file(name):
+ cmd = '(swank:load-file ' + requote(name) + ')'
+ swank_rex(':load-file', cmd, get_package(), 't')
+
+def swank_toggle_profile(symbol):
+ cmd = '(swank:toggle-profile-fdefinition "' + symbol + '")'
+ swank_rex(':toggle-profile-fdefinition', cmd, get_package(), 't')
+
+def swank_profile_substring(s, package):
+ if package == '':
+ p = 'nil'
+ else:
+ p = requote(package)
+ cmd = '(swank:profile-by-substring ' + requote(s) + ' ' + p + ')'
+ swank_rex(':profile-by-substring', cmd, get_package(), 't')
+
+def swank_unprofile_all():
+ swank_rex(':unprofile-all', '(swank:unprofile-all)', 'nil', 't')
+
+def swank_profiled_functions():
+ swank_rex(':profiled-functions', '(swank:profiled-functions)', 'nil', 't')
+
+def swank_profile_report():
+ swank_rex(':profile-report', '(swank:profile-report)', 'nil', 't')
+
+def swank_profile_reset():
+ swank_rex(':profile-reset', '(swank:profile-reset)', 'nil', 't')
+
+def swank_list_threads():
+ cmd = '(swank:list-threads)'
+ swank_rex(':list-threads', cmd, get_swank_package(), 't')
+
+def swank_kill_thread(index):
+ cmd = '(swank:kill-nth-thread ' + str(index) + ')'
+ swank_rex(':kill-thread', cmd, get_swank_package(), 't', str(index))
+
+def swank_find_definitions_for_emacs(str):
+ global swank_param
+ swank_param = str
+ cmd = '(swank:find-definitions-for-emacs "' + str + '")'
+ swank_rex(':find-definitions-for-emacs', cmd, get_package(), ':repl-thread')
+
+def swank_debug_thread(index):
+ cmd = '(swank:debug-nth-thread ' + str(index) + ')'
+ swank_rex(':debug-thread', cmd, get_swank_package(), 't', str(index))
+
+def swank_quit_lisp():
+ swank_rex(':quit-lisp', '(swank:quit-lisp)', 'nil', 't')
+ swank_disconnect()
+
+###############################################################################
+# Generic SWANK connection handling
+###############################################################################
+
+def swank_connect(host, port, resultvar):
+ """
+ Create socket to swank server and request connection info
+ """
+ global sock
+ global input_port
+
+ if not sock:
+ try:
+ input_port = port
+ swank_server = (host, input_port)
+ sock = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
+ sock.connect(swank_server)
+ swank_connection_info()
+ vim.command('let ' + resultvar + '=""')
+ return sock
+ except socket.error:
+ vim.command('let ' + resultvar + '="SWANK server is not running."')
+ sock = None
+ return sock
+ vim.command('let ' + resultvar + '=""')
+
+def swank_disconnect():
+ """
+ Disconnect from swank server
+ """
+ global sock
+ try:
+ # Try to close socket but don't care if doesn't succeed
+ sock.close()
+ finally:
+ sock = None
+ vim.command('let s:swank_connected = 0')
+ vim.command("let s:swank_result='Connection to SWANK server is closed.\n'")
+
+def swank_input(formvar):
+ global empty_last_line
+
+ empty_last_line = True
+ form = vim.eval(formvar)
+ if read_string:
+ # We are in :read-string mode, pass string entered to REPL
+ swank_return_string(form)
+ elif form[0] == '[':
+ if form[1] == '-':
+ swank_inspector_pop()
+ else:
+ swank_inspect_nth_part(form[1:-2])
+ elif form[0] == '<':
+ swank_inspector_nth_action(form[1:-2])
+ else:
+ # Normal s-expression evaluation
+ swank_eval(form)
+
+def actions_pending():
+ count = 0
+ for k,a in sorted(actions.items()):
+ if a.pending:
+ count = count + 1
+ vc = ":let s:swank_actions_pending=" + str(count)
+ vim.command(vc)
+ return count
+
+def append_repl(text, varname_given):
+ """
+ Append text at the end of the REPL buffer
+ Does not bring REPL buffer into focus if loaded but not displayed in any window
+ """
+ repl_buf = int(vim.eval("s:repl_buf"))
+ if repl_buf < 0 or int(vim.eval("buflisted(%d) && bufloaded(%d)" % (repl_buf, repl_buf))) == 0:
+ # No REPL buffer exists
+ vim.command('call SlimvBeginUpdate()')
+ vim.command('call SlimvOpenReplBuffer()')
+ vim.command('call SlimvRestoreFocus(0)')
+ repl_buf = int(vim.eval("s:repl_buf"))
+ for buf in vim.buffers:
+ if buf.number == repl_buf:
+ break
+ if repl_buf > 0 and buf.number == repl_buf:
+ if varname_given:
+ lines = vim.eval(text).split("\n")
+ else:
+ lines = text.split("\n")
+ if lines[0] != '':
+ # Concatenate first line to the last line of the buffer
+ nlines = len(buf)
+ buf[nlines-1] = buf[nlines-1] + lines[0]
+ if len(lines) > 1:
+ # Append all subsequent lines
+ buf.append(lines[1:])
+
+ # Keep only the last g:slimv_repl_max_len lines
+ repl_max_len = int(vim.eval("g:slimv_repl_max_len"))
+ repl_prompt_line = int(vim.eval("getbufvar(%d, 'repl_prompt_line')" % repl_buf))
+ lastline = len(buf)
+ prompt_offset = lastline - repl_prompt_line
+ if repl_max_len > 0 and lastline > repl_max_len:
+ form = "\n".join(buf[0:(lastline-repl_max_len)])
+ ending = vim.eval("substitute(s:CloseForm('%s'), '\\n', '', 'g')" % form.replace("'", "''"))
+ # Delete extra lines
+ buf[0:(lastline - repl_max_len)] = []
+ if ending.find(')') >= 0 or ending.find(']') >= 0 or ending.find(']') >= 0:
+ # Reverse the ending and replace matched characters with their pairs
+ start = ending[::-1]
+ start = start.replace(')', '(').replace(']', '[').replace('}', '{').replace("\n", '')
+ # Re-balance the beginning of the buffer
+ buf[0:0] = [start + " .... ; output shortened"]
+ vim.command("call setbufvar(%d, 'repl_prompt_line', %d)" % (repl_buf, len(buf) - prompt_offset))
+
+ # Move cursor at the end of REPL buffer in case it was originally after the prompt
+ vim.command('call SlimvReplSetCursorPos(0)')
+
+def swank_output(echo):
+ global sock
+ global debug_active
+ global debug_activated
+
+ if not sock:
+ return "SWANK server is not connected."
+ count = 0
+ #logtime('[- Output--]')
+ debug_activated = False
+ result = swank_listen()
+ pending = actions_pending()
+ while sock and result == '' and pending > 0 and count < listen_retries:
+ result = swank_listen()
+ pending = actions_pending()
+ count = count + 1
+ if echo and result != '':
+ # Append SWANK output to REPL buffer
+ append_repl(result, 0)
+ if debug_activated and debug_active:
+ # Debugger was activated in this run
+ vim.command('call SlimvOpenSldbBuffer()')
+ vim.command('call SlimvEndUpdate()')
+ vim.command("call search('^Restarts:', 'w')")
+
+def swank_response(name):
+ #logtime('[-Response-]')
+ for k,a in sorted(actions.items()):
+ if not a.pending and (name == '' or name == a.name):
+ vc = ":let s:swank_action='" + a.name + "'"
+ vim.command(vc)
+ vim.command("let s:swank_result='%s'" % a.result.replace("'", "''"))
+ actions.pop(a.id)
+ actions_pending()
+ return
+ vc = ":let s:swank_action=''"
+ vc = ":let s:swank_result=''"
+ vim.command(vc)
+ actions_pending()
+
diff --git a/vim/bundle/slimv/indent/clojure.vim b/vim/bundle/slimv/indent/clojure.vim
new file mode 100644
index 0000000..3b9e4fe
--- /dev/null
+++ b/vim/bundle/slimv/indent/clojure.vim
@@ -0,0 +1,23 @@
+" clojure.vim:
+" Clojure indent plugin for Slimv
+" Version: 0.9.5
+" Last Change: 21 Feb 2012
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if exists("b:did_indent") || exists("g:slimv_disable_clojure")
+ finish
+endif
+
+runtime indent/**/lisp.vim
+
+setlocal nolisp
+setlocal autoindent
+setlocal expandtab
+setlocal indentexpr=SlimvIndent(v:lnum)
+
diff --git a/vim/bundle/slimv/indent/lisp.vim b/vim/bundle/slimv/indent/lisp.vim
new file mode 100644
index 0000000..9723d69
--- /dev/null
+++ b/vim/bundle/slimv/indent/lisp.vim
@@ -0,0 +1,30 @@
+" lisp.vim:
+" Lisp indent plugin for Slimv
+" Version: 0.9.5
+" Last Change: 21 Feb 2012
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if exists("b:did_indent")
+ finish
+endif
+
+" Handle cases when lisp dialects explicitly use the lisp indent plugins
+if &ft == "clojure" && exists("g:slimv_disable_clojure")
+ finish
+endif
+
+if &ft == "scheme" && exists("g:slimv_disable_scheme")
+ finish
+endif
+
+setlocal nolisp
+setlocal autoindent
+setlocal expandtab
+setlocal indentexpr=SlimvIndent(v:lnum)
+
diff --git a/vim/bundle/slimv/indent/scheme.vim b/vim/bundle/slimv/indent/scheme.vim
new file mode 100644
index 0000000..90be432
--- /dev/null
+++ b/vim/bundle/slimv/indent/scheme.vim
@@ -0,0 +1,23 @@
+" scheme.vim:
+" Scheme indent plugin for Slimv
+" Version: 0.9.5
+" Last Change: 21 Feb 2012
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if exists("b:did_indent") || exists("g:slimv_disable_scheme")
+ finish
+endif
+
+let b:did_indent = 1
+
+setlocal nolisp
+setlocal autoindent
+setlocal expandtab
+setlocal indentexpr=SlimvIndent(v:lnum)
+
diff --git a/vim/bundle/slimv/plugin/paredit.vim b/vim/bundle/slimv/plugin/paredit.vim
new file mode 100644
index 0000000..befc118
--- /dev/null
+++ b/vim/bundle/slimv/plugin/paredit.vim
@@ -0,0 +1,1863 @@
+" paredit.vim:
+" Paredit mode for Slimv
+" Version: 0.9.13
+" Last Change: 15 Jan 2017
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if &cp || exists( 'g:paredit_loaded' )
+ finish
+endif
+
+let g:paredit_loaded = 1
+
+" Needed to load filetype and indent plugins
+filetype plugin on
+filetype indent on
+
+" =====================================================================
+" Global variable definitions
+" =====================================================================
+
+" Paredit mode selector
+if !exists( 'g:paredit_mode' )
+ let g:paredit_mode = 1
+endif
+
+" Match delimiter this number of lines before and after cursor position
+if !exists( 'g:paredit_matchlines' )
+ let g:paredit_matchlines = 100
+endif
+
+" Use short keymaps, i.e. J instead of <Leader>J
+if !exists( 'g:paredit_shortmaps' )
+ let g:paredit_shortmaps = 0
+endif
+
+" Use smart jumping to the nearest paren, curly brace, or square bracket in
+" clojure
+if !exists( 'g:paredit_smartjump' )
+ let g:paredit_smartjump = 0
+endif
+
+" Custom <Leader> for the Paredit plugin
+if !exists( 'g:paredit_leader' )
+ if exists( 'mapleader' )
+ let g:paredit_leader = '<leader>'
+ else
+ let g:paredit_leader = ','
+ endif
+endif
+
+" Use 'Electric Return', i.e. add double newlines if enter pressed before a closing paren
+if !exists( 'g:paredit_electric_return' )
+ let g:paredit_electric_return = 1
+endif
+
+" =====================================================================
+" Other variable definitions
+" =====================================================================
+
+" Valid macro prefix characters
+let s:any_macro_prefix = "'" . '\|`\|#\|@\|\~\|,\|\^'
+
+" Repeat count for some remapped edit functions (like 'd')
+let s:repeat = 0
+
+let s:yank_pos = []
+
+" Filetypes with [] and {} pairs balanced as well
+let s:fts_balancing_all_brackets = '.*\(clojure\|hy\|scheme\|racket\|shen\).*'
+
+" =====================================================================
+" General utility functions
+" =====================================================================
+" Buffer specific initialization
+function! PareditInitBuffer()
+ let b:paredit_init = 1
+ " in case they are accidentally removed
+ " Also define regular expressions to identify special characters used by paredit
+ if &ft =~ s:fts_balancing_all_brackets
+ let b:any_matched_char = '(\|)\|\[\|\]\|{\|}\|\"'
+ let b:any_matched_pair = '()\|\[\]\|{}\|\"\"'
+ let b:any_opening_char = '(\|\[\|{'
+ let b:any_closing_char = ')\|\]\|}'
+ let b:any_openclose_char = '(\|)\|\[\|\]\|{\|}'
+ let b:any_wsopen_char = '\s\|(\|\[\|{'
+ let b:any_wsclose_char = '\s\|)\|\]\|}'
+ else
+ let b:any_matched_char = '(\|)\|\"'
+ let b:any_matched_pair = '()\|\"\"'
+ let b:any_opening_char = '('
+ let b:any_closing_char = ')'
+ let b:any_openclose_char = '(\|)'
+ let b:any_wsopen_char = '\s\|('
+ let b:any_wsclose_char = '\s\|)'
+ endif
+
+ if g:paredit_mode
+ " Paredit mode is on: add buffer specific keybindings
+ inoremap <buffer> <expr> ( PareditInsertOpening('(',')')
+ inoremap <buffer> <silent> ) <C-R>=PareditInsertClosing('(',')')<CR>
+ inoremap <buffer> <expr> " PareditInsertQuotes()
+ inoremap <buffer> <expr> <BS> PareditBackspace(0)
+ inoremap <buffer> <expr> <C-h> PareditBackspace(0)
+ inoremap <buffer> <expr> <Del> PareditDel()
+ if &ft =~ s:fts_balancing_all_brackets && g:paredit_smartjump
+ noremap <buffer> <silent> ( :<C-U>call PareditSmartJumpOpening(0)<CR>
+ noremap <buffer> <silent> ) :<C-U>call PareditSmartJumpClosing(0)<CR>
+ vnoremap <buffer> <silent> ( <Esc>:<C-U>call PareditSmartJumpOpening(1)<CR>
+ vnoremap <buffer> <silent> ) <Esc>:<C-U>call PareditSmartJumpClosing(1)<CR>
+ else
+ noremap <buffer> <silent> ( :<C-U>call PareditFindOpening('(',')',0)<CR>
+ noremap <buffer> <silent> ) :<C-U>call PareditFindClosing('(',')',0)<CR>
+ vnoremap <buffer> <silent> ( <Esc>:<C-U>call PareditFindOpening('(',')',1)<CR>
+ vnoremap <buffer> <silent> ) <Esc>:<C-U>call PareditFindClosing('(',')',1)<CR>
+ endif
+ noremap <buffer> <silent> [[ :<C-U>call PareditFindDefunBck()<CR>
+ noremap <buffer> <silent> ]] :<C-U>call PareditFindDefunFwd()<CR>
+
+ call RepeatableNNoRemap('x', ':<C-U>call PareditEraseFwd()')
+ nnoremap <buffer> <silent> <Del> :<C-U>call PareditEraseFwd()<CR>
+ call RepeatableNNoRemap('X', ':<C-U>call PareditEraseBck()')
+ nnoremap <buffer> <silent> s :<C-U>call PareditEraseFwd()<CR>i
+ call RepeatableNNoRemap('D', 'v$:<C-U>call PareditDelete(visualmode(),1)')
+ nnoremap <buffer> <silent> C v$:<C-U>call PareditChange(visualmode(),1)<CR>
+ nnoremap <buffer> <silent> d :<C-U>call PareditSetDelete(v:count)<CR>g@
+ vnoremap <buffer> <silent> d :<C-U>call PareditDelete(visualmode(),1)<CR>
+ vnoremap <buffer> <silent> x :<C-U>call PareditDelete(visualmode(),1)<CR>
+ vnoremap <buffer> <silent> <Del> :<C-U>call PareditDelete(visualmode(),1)<CR>
+ nnoremap <buffer> <silent> c :set opfunc=PareditChange<CR>g@
+ vnoremap <buffer> <silent> c :<C-U>call PareditChange(visualmode(),1)<CR>
+ call RepeatableNNoRemap('dd', ':<C-U>call PareditDeleteLines()')
+ nnoremap <buffer> <silent> cc :<C-U>call PareditChangeLines()<CR>
+ nnoremap <buffer> <silent> cw :<C-U>call PareditChangeSpec('cw',1)<CR>
+ nnoremap <buffer> <silent> cW :set opfunc=PareditChange<CR>g@E
+ nnoremap <buffer> <silent> cb :<C-U>call PareditChangeSpec('cb',0)<CR>
+ nnoremap <buffer> <silent> ciw :<C-U>call PareditChangeSpec('ciw',1)<CR>
+ nnoremap <buffer> <silent> caw :<C-U>call PareditChangeSpec('caw',1)<CR>
+ call RepeatableNNoRemap('p', ':<C-U>call PareditPut("p")')
+ call RepeatableNNoRemap('P', ':<C-U>call PareditPut("P")')
+ call RepeatableNNoRemap(g:paredit_leader . 'w(', ':<C-U>call PareditWrap("(",")")')
+ execute 'vnoremap <buffer> <silent> ' . g:paredit_leader.'w( :<C-U>call PareditWrapSelection("(",")")<CR>'
+ call RepeatableNNoRemap(g:paredit_leader . 'w"', ':<C-U>call PareditWrap('."'".'"'."','".'"'."')")
+ execute 'vnoremap <buffer> <silent> ' . g:paredit_leader.'w" :<C-U>call PareditWrapSelection('."'".'"'."','".'"'."')<CR>"
+ " Spliec s-expression killing backward/forward
+ execute 'nmap <buffer> <silent> ' . g:paredit_leader.'<Up> d[(:<C-U>call PareditSplice()<CR>'
+ execute 'nmap <buffer> <silent> ' . g:paredit_leader.'<Down> d])%:<C-U>call PareditSplice()<CR>'
+ call RepeatableNNoRemap(g:paredit_leader . 'I', ':<C-U>call PareditRaise()')
+ if &ft =~ s:fts_balancing_all_brackets
+ inoremap <buffer> <expr> [ PareditInsertOpening('[',']')
+ inoremap <buffer> <silent> ] <C-R>=PareditInsertClosing('[',']')<CR>
+ inoremap <buffer> <expr> { PareditInsertOpening('{','}')
+ inoremap <buffer> <silent> } <C-R>=PareditInsertClosing('{','}')<CR>
+ call RepeatableNNoRemap(g:paredit_leader . 'w[', ':<C-U>call PareditWrap("[","]")')
+ execute 'vnoremap <buffer> <silent> ' . g:paredit_leader.'w[ :<C-U>call PareditWrapSelection("[","]")<CR>'
+ call RepeatableNNoRemap(g:paredit_leader . 'w{', ':<C-U>call PareditWrap("{","}")')
+ execute 'vnoremap <buffer> <silent> ' . g:paredit_leader.'w{ :<C-U>call PareditWrapSelection("{","}")<CR>'
+ endif
+
+ if g:paredit_shortmaps
+ " Shorter keymaps: old functionality of KEY is remapped to <Leader>KEY
+ call RepeatableNNoRemap('<', ':<C-U>call PareditMoveLeft()')
+ call RepeatableNNoRemap('>', ':<C-U>call PareditMoveRight()')
+ call RepeatableNNoRemap('O', ':<C-U>call PareditSplit()')
+ call RepeatableNNoRemap('J', ':<C-U>call PareditJoin()')
+ call RepeatableNNoRemap('W', ':<C-U>call PareditWrap("(",")")')
+ vnoremap <buffer> <silent> W :<C-U>call PareditWrapSelection('(',')')<CR>
+ call RepeatableNNoRemap('S', ':<C-U>call PareditSplice()')
+ execute 'nnoremap <buffer> <silent> ' . g:paredit_leader.'< :<C-U>normal! <<CR>'
+ execute 'nnoremap <buffer> <silent> ' . g:paredit_leader.'> :<C-U>normal! ><CR>'
+ execute 'nnoremap <buffer> <silent> ' . g:paredit_leader.'O :<C-U>normal! O<CR>'
+ execute 'nnoremap <buffer> <silent> ' . g:paredit_leader.'J :<C-U>normal! J<CR>'
+ execute 'nnoremap <buffer> <silent> ' . g:paredit_leader.'W :<C-U>normal! W<CR>'
+ execute 'vnoremap <buffer> <silent> ' . g:paredit_leader.'W :<C-U>normal! W<CR>'
+ execute 'nnoremap <buffer> <silent> ' . g:paredit_leader.'S :<C-U>normal! S<CR>'
+ else
+ " Longer keymaps with <Leader> prefix
+ nnoremap <buffer> <silent> S V:<C-U>call PareditChange(visualmode(),1)<CR>
+ call RepeatableNNoRemap(g:paredit_leader . '<', ':<C-U>call PareditMoveLeft()')
+ call RepeatableNNoRemap(g:paredit_leader . '>', ':<C-U>call PareditMoveRight()')
+ call RepeatableNNoRemap(g:paredit_leader . 'O', ':<C-U>call PareditSplit()')
+ call RepeatableNNoRemap(g:paredit_leader . 'J', ':<C-U>call PareditJoin()')
+ call RepeatableNNoRemap(g:paredit_leader . 'W', ':<C-U>call PareditWrap("(",")")')
+ execute 'vnoremap <buffer> <silent> ' . g:paredit_leader.'W :<C-U>call PareditWrapSelection("(",")")<CR>'
+ call RepeatableNNoRemap(g:paredit_leader . 'S', ':<C-U>call PareditSplice()')
+ endif
+
+ if g:paredit_electric_return && mapcheck( "<CR>", "i" ) == ""
+ " Do not override any possible mapping for <Enter>
+ inoremap <buffer> <expr> <CR> PareditEnter()
+ endif
+ else
+ " Paredit mode is off: remove keybindings
+ silent! iunmap <buffer> (
+ silent! iunmap <buffer> )
+ silent! iunmap <buffer> "
+ silent! iunmap <buffer> <BS>
+ silent! iunmap <buffer> <C-h>
+ silent! iunmap <buffer> <Del>
+ silent! unmap <buffer> (
+ silent! unmap <buffer> )
+ silent! unmap <buffer> [[
+ silent! unmap <buffer> ]]
+ silent! unmap <buffer> x
+ silent! unmap <buffer> <Del>
+ silent! unmap <buffer> X
+ silent! unmap <buffer> s
+ silent! unmap <buffer> D
+ silent! unmap <buffer> C
+ silent! unmap <buffer> d
+ silent! unmap <buffer> c
+ silent! unmap <buffer> dd
+ silent! unmap <buffer> cc
+ silent! unmap <buffer> cw
+ silent! unmap <buffer> cW
+ silent! unmap <buffer> cb
+ silent! unmap <buffer> ciw
+ silent! unmap <buffer> caw
+ if &ft =~ s:fts_balancing_all_brackets
+ silent! iunmap <buffer> [
+ silent! iunmap <buffer> ]
+ silent! iunmap <buffer> {
+ silent! iunmap <buffer> }
+ endif
+ if mapcheck( "<CR>", "i" ) == "PareditEnter()"
+ " Remove only if we have added this mapping
+ silent! iunmap <buffer> <CR>
+ endif
+ endif
+endfunction
+
+" Run the command normally but append a call to repeat#set afterwards
+function! RepeatableMap(map_type, keys, command)
+ let escaped_keys = substitute(a:keys, '["<]', '\\\0', "g")
+ execute a:map_type . ' <silent> <buffer> ' .
+ \ a:keys . ' ' . a:command .
+ \ '\|silent! call repeat#set("' . escaped_keys . '")<CR>'
+endfunction
+
+function! RepeatableNMap(keys, command)
+ call RepeatableMap('nmap', a:keys, a:command)
+endfunction
+
+function! RepeatableNNoRemap(keys, command)
+ call RepeatableMap('nnoremap', a:keys, a:command)
+endfunction
+
+" Include all prefix and special characters in 'iskeyword'
+function! s:SetKeyword()
+ let old_value = &iskeyword
+ if &ft =~ s:fts_balancing_all_brackets
+ setlocal iskeyword+=+,-,*,/,%,<,=,>,:,$,?,!,@-@,94,~,#,\|,&
+ else
+ setlocal iskeyword+=+,-,*,/,%,<,=,>,:,$,?,!,@-@,94,~,#,\|,&,.,{,},[,]
+ endif
+ return old_value
+endfunction
+
+" General Paredit operator function
+function! PareditOpfunc( func, type, visualmode )
+ let sel_save = &selection
+ let ve_save = &virtualedit
+ set virtualedit=all
+ let regname = v:register
+ let save_0 = getreg( '0' )
+
+ if a:visualmode " Invoked from Visual mode, use '< and '> marks.
+ silent exe "normal! `<" . a:type . "`>"
+ elseif a:type == 'line'
+ let &selection = "inclusive"
+ silent exe "normal! '[V']"
+ elseif a:type == 'block'
+ let &selection = "inclusive"
+ silent exe "normal! `[\<C-V>`]"
+ else
+ let &selection = "inclusive"
+ silent exe "normal! `[v`]"
+ endif
+
+ if !g:paredit_mode || (a:visualmode && (a:type == 'block' || a:type == "\<C-V>"))
+ " Block mode is too difficult to handle at the moment
+ silent exe "normal! d"
+ let putreg = getreg( '"' )
+ else
+ silent exe "normal! y"
+ let putreg = getreg( '"' )
+ if a:func == 'd'
+ " Register "0 is corrupted by the above 'y' command
+ call setreg( '0', save_0 )
+ elseif a:visualmode && &selection == "inclusive" && len(getline("'>")) < col("'>") && len(putreg) > 0
+ " Remove extra space added at the end of line when selection=inclusive, all, or onemore
+ let putreg = putreg[:-2]
+ endif
+
+ " Find and keep unbalanced matched characters in the region
+ let instring = s:InsideString( line("'<"), col("'<") )
+ if col("'>") > 1 && !s:InsideString( line("'<"), col("'<") - 1 )
+ " We are at the beginning of the string
+ let instring = 0
+ endif
+ let matched = s:GetMatchedChars( putreg, instring, s:InsideComment( line("'<"), col("'<") ) )
+ let matched = s:Unbalanced( matched )
+ let matched = substitute( matched, '\s', '', 'g' )
+
+ if matched == ''
+ if a:func == 'c' && (a:type == 'v' || a:type == 'V' || a:type == 'char')
+ silent exe "normal! gvc"
+ else
+ silent exe "normal! gvd"
+ endif
+ else
+ silent exe "normal! gvc" . matched
+ silent exe "normal! l"
+ let offs = len(matched)
+ if matched[0] =~ b:any_closing_char
+ let offs = offs + 1
+ endif
+ if a:func == 'd'
+ let offs = offs - 1
+ elseif instring && matched == '"'
+ " Keep cursor inside the double quotes
+ let offs = offs + 1
+ endif
+ if offs > 0
+ silent exe "normal! " . string(offs) . "h"
+ endif
+ endif
+ endif
+
+ let &selection = sel_save
+ let &virtualedit = ve_save
+ if a:func == 'd' && regname == '"'
+ " Do not currupt the '"' register and hence the "0 register
+ call setreg( '1', putreg )
+ else
+ call setreg( regname, putreg )
+ endif
+endfunction
+
+" Set delete mode also saving repeat count
+function! PareditSetDelete( count )
+ let s:repeat = a:count
+ set opfunc=PareditDelete
+endfunction
+
+" General delete operator handling
+function! PareditDelete( type, ... )
+ call PareditOpfunc( 'd', a:type, a:0 )
+ if s:repeat > 1
+ call feedkeys( (s:repeat-1) . "." )
+ endif
+ let s:repeat = 0
+endfunction
+
+" General change operator handling
+function! PareditChange( type, ... )
+ let ve_save = &virtualedit
+ set virtualedit=all
+ call PareditOpfunc( 'c', a:type, a:0 )
+ if len(getline('.')) == 0
+ let v:lnum = line('.')
+ let expr = &indentexpr
+ if expr == ''
+ " No special 'indentexpr', call default lisp indent
+ let expr = 'lispindent(v:lnum)'
+ endif
+ execute "call setline( v:lnum, repeat( ' ', " . expr . " ) )"
+ call cursor(v:lnum, len(getline(v:lnum))+1)
+ else
+ normal! l
+ endif
+ startinsert
+ let &virtualedit = ve_save
+endfunction
+
+" Delete v:count number of lines
+function! PareditDeleteLines()
+ if v:count > 1
+ silent exe "normal! V" . (v:count-1) . "j\<Esc>"
+ else
+ silent exe "normal! V\<Esc>"
+ endif
+ call PareditDelete(visualmode(),1)
+endfunction
+
+" Change v:count number of lines
+function! PareditChangeLines()
+ if v:count > 1
+ silent exe "normal! V" . (v:count-1) . "j\<Esc>"
+ else
+ silent exe "normal! V\<Esc>"
+ endif
+ call PareditChange(visualmode(),1)
+endfunction
+
+" Handle special change command, e.g. cw
+" Check if we may revert to its original Vim function
+" This way '.' can be used to repeat the command
+function! PareditChangeSpec( cmd, dir )
+ let line = getline( '.' )
+ if a:dir == 0
+ " Changing backwards
+ let c = col( '.' ) - 2
+ while c >= 0 && line[c] =~ b:any_matched_char
+ " Shouldn't delete a matched character, just move left
+ call feedkeys( 'h', 'n')
+ let c = c - 1
+ endwhile
+ if c < 0 && line[0] =~ b:any_matched_char
+ " Can't help, still on matched character, insert instead
+ call feedkeys( 'i', 'n')
+ return
+ endif
+ else
+ " Changing forward
+ let c = col( '.' ) - 1
+ while c < len(line) && line[c] =~ b:any_matched_char
+ " Shouldn't delete a matched character, just move right
+ call feedkeys( 'l', 'n')
+ let c = c + 1
+ endwhile
+ if c == len(line)
+ " Can't help, still on matched character, append instead
+ call feedkeys( 'a', 'n')
+ return
+ endif
+ endif
+
+ " Safe to use Vim's built-in change function
+ call feedkeys( a:cmd, 'n')
+endfunction
+
+" Paste text from put register in a balanced way
+function! PareditPut( cmd )
+ let regname = v:register
+ let reg_save = getreg( regname )
+ let putreg = reg_save
+
+ " Find unpaired matched characters by eliminating paired ones
+ let matched = s:GetMatchedChars( putreg, s:InsideString(), s:InsideComment() )
+ let matched = s:Unbalanced( matched )
+
+ if matched !~ '\S\+'
+ " Register contents is balanced, perform default put function
+ silent exe "normal! " . (v:count>1 ? v:count : '') . (regname=='"' ? '' : '"'.regname) . a:cmd
+ return
+ endif
+
+ " Replace all unpaired matched characters with a space in order to keep balance
+ let i = 0
+ while i < len( putreg )
+ if matched[i] !~ '\s'
+ let putreg = strpart( putreg, 0, i ) . ' ' . strpart( putreg, i+1 )
+ endif
+ let i = i + 1
+ endwhile
+
+ " Store balanced text in put register and call the appropriate put command
+ call setreg( regname, putreg )
+ silent exe "normal! " . (v:count>1 ? v:count : '') . (regname=='"' ? '' : '"'.regname) . a:cmd
+ call setreg( regname, reg_save )
+endfunction
+
+" Toggle paredit mode
+function! PareditToggle()
+ " Don't disable paredit if it was not initialized yet for the current buffer
+ if exists( 'b:paredit_init') || g:paredit_mode == 0
+ let g:paredit_mode = 1 - g:paredit_mode
+ endif
+ echo g:paredit_mode ? 'Paredit mode on' : 'Paredit mode off'
+ call PareditInitBuffer()
+endfunction
+
+" Does the current syntax item match the given regular expression?
+function! s:SynIDMatch( regexp, line, col, match_eol )
+ let col = a:col
+ if a:match_eol && col > len( getline( a:line ) )
+ let col = col - 1
+ endif
+ return synIDattr( synID( a:line, col, 0), 'name' ) =~ a:regexp
+endfunction
+
+" Expression used to check whether we should skip a match with searchpair()
+function! s:SkipExpr()
+ let l = line('.')
+ let c = col('.')
+ if synIDattr(synID(l, c, 0), "name") =~ "[Ss]tring\\|[Cc]omment\\|[Ss]pecial\\|clojureRegexp\\|clojurePattern"
+ " Skip parens inside strings, comments, special elements
+ return 1
+ endif
+ if getline(l)[c-2] == "\\" && getline(l)[c-3] != "\\"
+ " Skip parens escaped by '\'
+ return 1
+ endif
+ return 0
+endfunction
+
+" Is the current cursor position inside a comment?
+function! s:InsideComment( ... )
+ let l = a:0 ? a:1 : line('.')
+ let c = a:0 ? a:2 : col('.')
+ if &syntax == ''
+ " No help from syntax engine,
+ " remove strings and search for ';' up to the cursor position
+ let line = strpart( getline(l), 0, c - 1 )
+ let line = substitute( line, '\\"', '', 'g' )
+ let line = substitute( line, '"[^"]*"', '', 'g' )
+ return match( line, ';' ) >= 0
+ endif
+ if s:SynIDMatch( 'clojureComment', l, c, 1 )
+ if strpart( getline(l), c-1, 2 ) == '#_' || strpart( getline(l), c-2, 2 ) == '#_'
+ " This is a commented out clojure form of type #_(...), treat it as regular form
+ return 0
+ endif
+ endif
+ return s:SynIDMatch( '[Cc]omment', l, c, 1 )
+endfunction
+
+" Is the current cursor position inside a string?
+function! s:InsideString( ... )
+ let l = a:0 ? a:1 : line('.')
+ let c = a:0 ? a:2 : col('.')
+ if &syntax == ''
+ " No help from syntax engine,
+ " count quote characters up to the cursor position
+ let line = strpart( getline(l), 0, c - 1 )
+ let line = substitute( line, '\\"', '', 'g' )
+ let quotes = substitute( line, '[^"]', '', 'g' )
+ return len(quotes) % 2
+ endif
+ " VimClojure and vim-clojure-static define special syntax for regexps
+ return s:SynIDMatch( '[Ss]tring\|clojureRegexp\|clojurePattern', l, c, 0 )
+endfunction
+
+" Is this a Slimv or VimClojure REPL buffer?
+function! s:IsReplBuffer()
+ if exists( 'b:slimv_repl_buffer' ) || exists( 'b:vimclojure_repl' )
+ return 1
+ else
+ return 0
+ endif
+endfunction
+
+" Get Slimv or VimClojure REPL buffer last command prompt position
+" Return [0, 0] if this is not the REPL buffer
+function! s:GetReplPromptPos()
+ if !s:IsReplBuffer()
+ return [0, 0]
+ endif
+ if exists( 'b:vimclojure_repl')
+ let cur_pos = getpos( '.' )
+ call cursor( line( '$' ), 1)
+ call cursor( line( '.' ), col( '$') )
+ call search( b:vimclojure_namespace . '=>', 'bcW' )
+ let target_pos = getpos( '.' )[1:2]
+ call setpos( '.', cur_pos )
+ return target_pos
+ else
+ return [ b:repl_prompt_line, b:repl_prompt_col ]
+ endif
+endfunction
+
+" Is the current top level form balanced, i.e all opening delimiters
+" have a matching closing delimiter
+function! s:IsBalanced()
+ let l = line( '.' )
+ let c = col( '.' )
+ let line = getline( '.' )
+ if c > len(line)
+ let c = len(line)
+ endif
+ let matchb = max( [l-g:paredit_matchlines, 1] )
+ let matchf = min( [l+g:paredit_matchlines, line('$')] )
+ let [prompt, cp] = s:GetReplPromptPos()
+ if s:IsReplBuffer() && l >= prompt && matchb < prompt
+ " Do not go before the last command prompt in the REPL buffer
+ let matchb = prompt
+ endif
+ if line[c-1] == '('
+ let p1 = searchpair( '(', '', ')', 'brnmWc', 's:SkipExpr()', matchb )
+ let p2 = searchpair( '(', '', ')', 'rnmW' , 's:SkipExpr()', matchf )
+ elseif line[c-1] == ')'
+ let p1 = searchpair( '(', '', ')', 'brnmW' , 's:SkipExpr()', matchb )
+ let p2 = searchpair( '(', '', ')', 'rnmWc', 's:SkipExpr()', matchf )
+ else
+ let p1 = searchpair( '(', '', ')', 'brnmW' , 's:SkipExpr()', matchb )
+ let p2 = searchpair( '(', '', ')', 'rnmW' , 's:SkipExpr()', matchf )
+ endif
+ if p1 != p2
+ " Number of opening and closing parens differ
+ return 0
+ endif
+
+ if &ft =~ s:fts_balancing_all_brackets
+ if line[c-1] == '['
+ let b1 = searchpair( '\[', '', '\]', 'brnmWc', 's:SkipExpr()', matchb )
+ let b2 = searchpair( '\[', '', '\]', 'rnmW' , 's:SkipExpr()', matchf )
+ elseif line[c-1] == ']'
+ let b1 = searchpair( '\[', '', '\]', 'brnmW' , 's:SkipExpr()', matchb )
+ let b2 = searchpair( '\[', '', '\]', 'rnmWc', 's:SkipExpr()', matchf )
+ else
+ let b1 = searchpair( '\[', '', '\]', 'brnmW' , 's:SkipExpr()', matchb )
+ let b2 = searchpair( '\[', '', '\]', 'rnmW' , 's:SkipExpr()', matchf )
+ endif
+ if b1 != b2
+ " Number of opening and closing brackets differ
+ return 0
+ endif
+ if line[c-1] == '{'
+ let b1 = searchpair( '{', '', '}', 'brnmWc', 's:SkipExpr()', matchb )
+ let b2 = searchpair( '{', '', '}', 'rnmW' , 's:SkipExpr()', matchf )
+ elseif line[c-1] == '}'
+ let b1 = searchpair( '{', '', '}', 'brnmW' , 's:SkipExpr()', matchb )
+ let b2 = searchpair( '{', '', '}', 'rnmWc', 's:SkipExpr()', matchf )
+ else
+ let b1 = searchpair( '{', '', '}', 'brnmW' , 's:SkipExpr()', matchb )
+ let b2 = searchpair( '{', '', '}', 'rnmW' , 's:SkipExpr()', matchf )
+ endif
+ if b1 != b2
+ " Number of opening and closing curly braces differ
+ return 0
+ endif
+ endif
+ return 1
+endfunction
+
+" Filter out all non-matched characters from the region
+function! s:GetMatchedChars( lines, start_in_string, start_in_comment )
+ let inside_string = a:start_in_string
+ let inside_comment = a:start_in_comment
+ let matched = repeat( ' ', len( a:lines ) )
+ let i = 0
+ while i < len( a:lines )
+ if inside_string
+ " We are inside a string, skip parens, wait for closing '"'
+ " but skip escaped \" characters
+ if a:lines[i] == '"' && a:lines[i-1] != '\'
+ let matched = strpart( matched, 0, i ) . a:lines[i] . strpart( matched, i+1 )
+ let inside_string = 0
+ endif
+ elseif inside_comment
+ " We are inside a comment, skip parens, wait for end of line
+ if a:lines[i] == "\n"
+ let inside_comment = 0
+ endif
+ elseif i > 0 && a:lines[i-1] == '\' && (i < 2 || a:lines[i-2] != '\')
+ " This is an escaped character, ignore it
+ else
+ " We are outside of strings and comments, now we shall count parens
+ if a:lines[i] == '"'
+ let matched = strpart( matched, 0, i ) . a:lines[i] . strpart( matched, i+1 )
+ let inside_string = 1
+ endif
+ if a:lines[i] == ';'
+ let inside_comment = 1
+ endif
+ if a:lines[i] =~ b:any_openclose_char
+ let matched = strpart( matched, 0, i ) . a:lines[i] . strpart( matched, i+1 )
+ endif
+ endif
+ let i = i + 1
+ endwhile
+ return matched
+endfunction
+
+" Find unpaired matched characters by eliminating paired ones
+function! s:Unbalanced( matched )
+ let matched = a:matched
+ let tmp = matched
+ while 1
+ let matched = tmp
+ let tmp = substitute( tmp, '(\(\s*\))', ' \1 ', 'g')
+ if &ft =~ s:fts_balancing_all_brackets
+ let tmp = substitute( tmp, '\[\(\s*\)\]', ' \1 ', 'g')
+ let tmp = substitute( tmp, '{\(\s*\)}', ' \1 ', 'g')
+ endif
+ let tmp = substitute( tmp, '"\(\s*\)"', ' \1 ', 'g')
+ if tmp == matched
+ " All paired chars eliminated
+ let tmp = substitute( tmp, ')\(\s*\)(', ' \1 ', 'g')
+ if &ft =~ s:fts_balancing_all_brackets
+ let tmp = substitute( tmp, '\]\(\s*\)\[', ' \1 ', 'g')
+ let tmp = substitute( tmp, '}\(\s*\){', ' \1 ', 'g')
+ endif
+ if tmp == matched
+ " Also no more inverse pairs can be eliminated
+ break
+ endif
+ endif
+ endwhile
+ return matched
+endfunction
+
+" Find opening matched character
+function! PareditFindOpening( open, close, select )
+ let open = escape( a:open , '[]' )
+ let close = escape( a:close, '[]' )
+ call searchpair( open, '', close, 'bW', 's:SkipExpr()' )
+ if a:select
+ call searchpair( open, '', close, 'W', 's:SkipExpr()' )
+ let save_ve = &ve
+ set ve=all
+ normal! lvh
+ let &ve = save_ve
+ call searchpair( open, '', close, 'bW', 's:SkipExpr()' )
+ if &selection == 'inclusive'
+ " Trim last character from the selection, it will be included anyway
+ normal! oho
+ endif
+ endif
+endfunction
+
+" Find closing matched character
+function! PareditFindClosing( open, close, select )
+ let open = escape( a:open , '[]' )
+ let close = escape( a:close, '[]' )
+ if a:select
+ let line = getline( '.' )
+ if line[col('.')-1] != a:open
+ normal! h
+ endif
+ call searchpair( open, '', close, 'W', 's:SkipExpr()' )
+ call searchpair( open, '', close, 'bW', 's:SkipExpr()' )
+ normal! v
+ call searchpair( open, '', close, 'W', 's:SkipExpr()' )
+ if &selection != 'inclusive'
+ normal! l
+ endif
+ else
+ call searchpair( open, '', close, 'W', 's:SkipExpr()' )
+ endif
+endfunction
+
+" Returns the nearest opening character to the cursor
+" Used for smart jumping in Clojure
+function! PareditSmartJumpOpening( select )
+ let [paren_line, paren_col] = searchpairpos('(', '', ')', 'bWn', 's:SkipExpr()')
+ let [bracket_line, bracket_col] = searchpairpos('\[', '', '\]', 'bWn', 's:SkipExpr()')
+ let [brace_line, brace_col] = searchpairpos('{', '', '}', 'bWn', 's:SkipExpr()')
+ let paren_score = paren_line * 10000 + paren_col
+ let bracket_score = bracket_line * 10000 + bracket_col
+ let brace_score = brace_line * 10000 + brace_col
+ if (brace_score > paren_score || paren_score == 0) && (brace_score > bracket_score || bracket_score == 0) && brace_score != 0
+ call PareditFindOpening('{','}', a:select)
+ elseif (bracket_score > paren_score || paren_score == 0) && bracket_score != 0
+ call PareditFindOpening('[',']', a:select)
+ else
+ call PareditFindOpening('(',')', a:select)
+ endif
+endfunction
+
+" Returns the nearest opening character to the cursor
+" Used for smart jumping in Clojure
+function! PareditSmartJumpClosing( select )
+ let [paren_line, paren_col] = searchpairpos('(', '', ')', 'Wn', 's:SkipExpr()')
+ let [bracket_line, bracket_col] = searchpairpos('\[', '', '\]', 'Wn', 's:SkipExpr()')
+ let [brace_line, brace_col] = searchpairpos('{', '', '}', 'Wn', 's:SkipExpr()')
+ let paren_score = paren_line * 10000 + paren_col
+ let bracket_score = bracket_line * 10000 + bracket_col
+ let brace_score = brace_line * 10000 + brace_col
+ if (brace_score < paren_score || paren_score == 0) && (brace_score < bracket_score || bracket_score == 0) && brace_score != 0
+ call PareditFindClosing('{','}', a:select)
+ elseif (bracket_score < paren_score || paren_score == 0) && bracket_score != 0
+ call PareditFindClosing('[',']', a:select)
+ else
+ call PareditFindClosing('(',')', a:select)
+ endif
+endfunction
+
+" Find defun start backwards
+function! PareditFindDefunBck()
+ let l = line( '.' )
+ let matchb = max( [l-g:paredit_matchlines, 1] )
+ let oldpos = getpos( '.' )
+ let newpos = searchpairpos( '(', '', ')', 'brW', 's:SkipExpr()', matchb )
+ if newpos[0] == 0
+ " Already standing on a defun, find the end of the previous one
+ let newpos = searchpos( ')', 'bW' )
+ while newpos[0] != 0 && (s:InsideComment() || s:InsideString())
+ let newpos = searchpos( ')', 'W' )
+ endwhile
+ if newpos[0] == 0
+ " No ')' found, don't move cursor
+ call setpos( '.', oldpos )
+ else
+ " Find opening paren
+ let pairpos = searchpairpos( '(', '', ')', 'brW', 's:SkipExpr()', matchb )
+ if pairpos[0] == 0
+ " ')' has no matching pair
+ call setpos( '.', oldpos )
+ endif
+ endif
+ endif
+endfunction
+
+" Find defun start forward
+function! PareditFindDefunFwd()
+ let l = line( '.' )
+ let matchf = min( [l+g:paredit_matchlines, line('$')] )
+ let oldpos = getpos( '.' )
+ call searchpair( '(', '', ')', 'brW', 's:SkipExpr()', matchf )
+ normal! %
+ let newpos = searchpos( '(', 'W' )
+ while newpos[0] != 0 && (s:InsideComment() || s:InsideString())
+ let newpos = searchpos( '(', 'W' )
+ endwhile
+ if newpos[0] == 0
+ " No '(' found, don't move cursor
+ call setpos( '.', oldpos )
+ endif
+endfunction
+
+" Insert opening type of a paired character, like ( or [.
+function! PareditInsertOpening( open, close )
+ if !g:paredit_mode || s:InsideComment() || s:InsideString() || !s:IsBalanced()
+ return a:open
+ endif
+ let line = getline( '.' )
+ let pos = col( '.' ) - 1
+ if pos > 0 && line[pos-1] == '\' && (pos < 2 || line[pos-2] != '\')
+ " About to enter a \( or \[
+ return a:open
+ elseif line[pos] !~ b:any_wsclose_char && pos < len( line )
+ " Add a space after if needed
+ let retval = a:open . a:close . " \<Left>\<Left>"
+ else
+ let retval = a:open . a:close . "\<Left>"
+ endif
+ if pos > 0 && line[pos-1] !~ b:any_wsopen_char && line[pos-1] !~ s:any_macro_prefix
+ " Add a space before if needed
+ let retval = " " . retval
+ endif
+ return retval
+endfunction
+
+" Re-gather electric returns up
+function! s:ReGatherUp()
+ if g:paredit_electric_return && getline('.') =~ '^\s*)'
+ " Re-gather electric returns in the current line for ')'
+ normal! k
+ while getline( line('.') ) =~ '^\s*$'
+ " Delete all empty lines
+ normal! ddk
+ endwhile
+ normal! Jl
+ elseif g:paredit_electric_return && getline('.') =~ '^\s*\(\]\|}\)' && &ft =~ s:fts_balancing_all_brackets
+ " Re-gather electric returns in the current line for ']' and '}'
+ normal! k
+ while getline( line('.') ) =~ '^\s*$'
+ " Delete all empty lines
+ normal! ddk
+ endwhile
+ call setline( line('.'), substitute( line, '\s*$', '', 'g' ) )
+ normal! Jxl
+ endif
+ " Already have the desired character, move right
+ normal! l
+endfunction
+
+" Insert closing type of a paired character, like ) or ].
+function! PareditInsertClosing( open, close )
+ let retval = ""
+ if pumvisible()
+ let retval = "\<C-Y>"
+ endif
+ let save_ve = &ve
+ set ve=all
+ let line = getline( '.' )
+ let pos = col( '.' ) - 1
+ if !g:paredit_mode || s:InsideComment() || s:InsideString() || !s:IsBalanced()
+ call setline( line('.'), line[0 : pos-1] . a:close . line[pos : -1] )
+ normal! l
+ let &ve = save_ve
+ return retval
+ endif
+ if pos > 0 && line[pos-1] == '\' && (pos < 2 || line[pos-2] != '\')
+ " About to enter a \) or \]
+ call setline( line('.'), line[0 : pos-1] . a:close . line[pos : -1] )
+ normal! l
+ let &ve = save_ve
+ return retval
+ elseif line[pos] == a:close
+ call s:ReGatherUp()
+ let &ve = save_ve
+ return retval
+ endif
+ let open = escape( a:open , '[]' )
+ let close = escape( a:close, '[]' )
+ let newpos = searchpairpos( open, '', close, 'nW', 's:SkipExpr()' )
+ if g:paredit_electric_return && newpos[0] > line('.')
+ " Closing paren is in a line below, check if there are electric returns to re-gather
+ while getline('.') =~ '^\s*$'
+ " Delete all empty lines above the cursor
+ normal! ddk
+ endwhile
+ let oldpos = getpos( '.' )
+ normal! j
+ while getline('.') =~ '^\s*$'
+ " Delete all empty lines below the cursor
+ normal! dd
+ endwhile
+ let nextline = substitute( getline('.'), '\s', '', 'g' )
+ call setpos( '.', oldpos )
+ if len(nextline) > 0 && nextline[0] == ')'
+ " Re-gather electric returns in the line of the closing ')'
+ call setline( line('.'), substitute( getline('.'), '\s*$', '', 'g' ) )
+ normal! Jl
+ let &ve = save_ve
+ return retval
+ endif
+ if len(nextline) > 0 && nextline[0] =~ '\]\|}' && &ft =~ s:fts_balancing_all_brackets
+ " Re-gather electric returns in the line of the closing ']' or '}'
+ call setline( line('.'), substitute( line, '\s*$', '', 'g' ) )
+ normal! Jxl
+ let &ve = save_ve
+ return retval
+ endif
+ elseif g:paredit_electric_return && line =~ '^\s*)'
+ " Re-gather electric returns in the current line
+ call s:ReGatherUp()
+ let &ve = save_ve
+ return retval
+ endif
+ if searchpair( open, '', close, 'W', 's:SkipExpr()' ) > 0
+ normal! l
+ endif
+ "TODO: indent after going to closing character
+ let &ve = save_ve
+ return retval
+endfunction
+
+" Insert an (opening or closing) double quote
+function! PareditInsertQuotes()
+ if !g:paredit_mode || s:InsideComment()
+ return '"'
+ endif
+ let line = getline( '.' )
+ let pos = col( '.' ) - 1
+ if pos > 0 && line[pos-1] == '\' && (pos < 2 || line[pos-2] != '\')
+ " About to enter a \"
+ return '"'
+ elseif s:InsideString()
+ "TODO: skip comments in search(...)
+ if line[pos] == '"'
+ " Standing on a ", just move to the right
+ return "\<Right>"
+ elseif search('[^\\]"\|^"', 'nW') == 0
+ " We don't have any closing ", insert one
+ return '"'
+ else
+ " Move to the closing "
+ return "\<C-O>:call search('" . '[^\\]"\|^"' . "','eW')\<CR>\<Right>"
+ endif
+ else
+ " Outside of string: insert a pair of ""
+ return '""' . "\<Left>"
+ endif
+endfunction
+
+" Handle <Enter> keypress, insert electric return if applicable
+function! PareditEnter()
+ if pumvisible()
+ " Pressing <CR> in a pop up selects entry.
+ return "\<C-Y>"
+ else
+ let line = getline( '.' )
+ let pos = col( '.' ) - 1
+ if g:paredit_electric_return && pos > 0 && line[pos] =~ b:any_closing_char && !s:InsideString() && s:IsBalanced()
+ " Electric Return
+ return "\<CR>\<CR>\<Up>"
+ else
+ " Regular Return
+ return "\<CR>"
+ endif
+ endif
+endfunction
+
+" Handle <BS> keypress
+function! PareditBackspace( repl_mode )
+ let [lp, cp] = s:GetReplPromptPos()
+ if a:repl_mode && line( "." ) == lp && col( "." ) <= cp
+ " No BS allowed before the previous EOF mark in the REPL
+ " i.e. don't delete Lisp prompt
+ return ""
+ endif
+
+ if !g:paredit_mode || s:InsideComment()
+ return "\<BS>"
+ endif
+
+ let line = getline( '.' )
+ let pos = col( '.' ) - 1
+
+ if pos == 0
+ " We are at the beginning of the line
+ return "\<BS>"
+ elseif s:InsideString() && line[pos-1] =~ b:any_openclose_char
+ " Deleting a paren inside a string
+ return "\<BS>"
+ elseif pos > 1 && line[pos-1] =~ b:any_matched_char && line[pos-2] == '\' && (pos < 3 || line[pos-3] != '\')
+ " Deleting an escaped matched character
+ return "\<BS>\<BS>"
+ elseif line[pos-1] !~ b:any_matched_char
+ " Deleting a non-special character
+ return "\<BS>"
+ elseif line[pos-1] != '"' && !s:IsBalanced()
+ " Current top-form is unbalanced, can't retain paredit mode
+ return "\<BS>"
+ endif
+
+ if line[pos-1:pos] =~ b:any_matched_pair
+ " Deleting an empty character-pair
+ return "\<Right>\<BS>\<BS>"
+ else
+ " Character-pair is not empty, don't delete just move inside
+ return "\<Left>"
+ endif
+endfunction
+
+" Handle <Del> keypress
+function! PareditDel()
+ if !g:paredit_mode || s:InsideComment()
+ return "\<Del>"
+ endif
+
+ let line = getline( '.' )
+ let pos = col( '.' ) - 1
+
+ if pos == len(line)
+ " We are at the end of the line
+ return "\<Del>"
+ elseif line[pos] == '\' && line[pos+1] =~ b:any_matched_char && (pos < 1 || line[pos-1] != '\')
+ " Deleting an escaped matched character
+ return "\<Del>\<Del>"
+ elseif line[pos] !~ b:any_matched_char
+ " Erasing a non-special character
+ return "\<Del>"
+ elseif line[pos] != '"' && !s:IsBalanced()
+ " Current top-form is unbalanced, can't retain paredit mode
+ return "\<Del>"
+ elseif pos == 0
+ return "\<Right>"
+ endif
+
+ if line[pos-1:pos] =~ b:any_matched_pair
+ " Erasing an empty character-pair
+ return "\<Left>\<Del>\<Del>"
+ else
+ " Character-pair is not empty, don't erase just move inside
+ return "\<Right>"
+ endif
+endfunction
+
+" Initialize yank position list
+function! s:InitYankPos()
+ call setreg( &clipboard == 'unnamed' ? '*' : '"', '' )
+ let s:yank_pos = []
+endfunction
+
+" Add position to the yank list
+function! s:AddYankPos( pos )
+ let s:yank_pos = [a:pos] + s:yank_pos
+endfunction
+
+" Remove the head of yank position list and return it
+function! s:RemoveYankPos()
+ if len(s:yank_pos) > 0
+ let pos = s:yank_pos[0]
+ let s:yank_pos = s:yank_pos[1:]
+ return pos
+ else
+ return 0
+ endif
+endfunction
+
+" Forward erasing a character in normal mode, do not check if current form balanced
+function! s:EraseFwd( count, startcol )
+ let line = getline( '.' )
+ let pos = col( '.' ) - 1
+ let reg = ''
+ let ve_save = &virtualedit
+ set virtualedit=all
+ let c = a:count
+ while c > 0
+ if line[pos] == '\' && line[pos+1] =~ b:any_matched_char && (pos < 1 || line[pos-1] != '\')
+ " Erasing an escaped matched character
+ let reg = reg . line[pos : pos+1]
+ let line = strpart( line, 0, pos ) . strpart( line, pos+2 )
+ elseif s:InsideComment() && line[pos] == ';' && a:startcol >= 0
+ " Erasing the whole comment, only when erasing a block of characters
+ let reg = reg . strpart( line, pos )
+ let line = strpart( line, 0, pos )
+ elseif s:InsideComment() || ( s:InsideString() && line[pos] != '"' )
+ " Erasing any character inside string or comment
+ let reg = reg . line[pos]
+ let line = strpart( line, 0, pos ) . strpart( line, pos+1 )
+ elseif pos > 0 && line[pos-1:pos] =~ b:any_matched_pair
+ if pos > a:startcol
+ " Erasing an empty character-pair
+ let p2 = s:RemoveYankPos()
+ let reg = strpart( reg, 0, p2 ) . line[pos-1] . strpart( reg, p2 )
+ let reg = reg . line[pos]
+ let line = strpart( line, 0, pos-1 ) . strpart( line, pos+1 )
+ let pos = pos - 1
+ normal! h
+ else
+ " Can't erase character-pair: it would move the cursor before startcol
+ let pos = pos + 1
+ normal! l
+ endif
+ elseif line[pos] =~ b:any_matched_char
+ " Character-pair is not empty, don't erase just move inside
+ call s:AddYankPos( len(reg) )
+ let pos = pos + 1
+ normal! l
+ elseif pos < len(line) && pos >= a:startcol
+ " Erasing a non-special character
+ let chars = split(strpart(line, pos), '\zs')
+ if len(chars) > 0
+ " Identify the character to be erased and it's length
+ " The length may be >1 if this is a multi-byte character
+ let ch = chars[0]
+ let reg = reg . ch
+ let line = strpart( line, 0, pos ) . strpart( line, pos+len(ch) )
+ endif
+ endif
+ let c = c - 1
+ endwhile
+ let &virtualedit = ve_save
+ call setline( '.', line )
+ call setreg( &clipboard == 'unnamed' ? '*' : '"', reg )
+endfunction
+
+" Backward erasing a character in normal mode, do not check if current form balanced
+function! s:EraseBck( count )
+ let line = getline( '.' )
+ let pos = col( '.' ) - 1
+ let reg = ''
+ let c = a:count
+ while c > 0 && pos > 0
+ if pos > 1 && line[pos-2] == '\' && line[pos-1] =~ b:any_matched_char && (pos < 3 || line[pos-3] != '\')
+ " Erasing an escaped matched character
+ let reg = reg . line[pos-2 : pos-1]
+ let line = strpart( line, 0, pos-2 ) . strpart( line, pos )
+ normal! h
+ let pos = pos - 1
+ elseif s:InsideComment() || ( s:InsideString() && line[pos-1] != '"' )
+ let reg = reg . line[pos-1]
+ let line = strpart( line, 0, pos-1 ) . strpart( line, pos )
+ elseif line[pos-1:pos] =~ b:any_matched_pair
+ " Erasing an empty character-pair
+ let p2 = s:RemoveYankPos()
+ let reg = strpart( reg, 0, p2 ) . line[pos-1] . strpart( reg, p2 )
+ let reg = reg . line[pos]
+ let line = strpart( line, 0, pos-1 ) . strpart( line, pos+1 )
+ elseif line[pos-1] =~ b:any_matched_char
+ " Character-pair is not empty, don't erase
+ call s:AddYankPos( len(reg) )
+ else
+ " Erasing a non-special character
+ let chars = split(strpart(line, 0, pos), '\zs')
+ if len(chars) > 0
+ " Identify the character to be erased and it's length
+ " The length may be >1 if this is a multi-byte character
+ let ch = chars[-1]
+ let reg = reg . ch
+ let line = strpart( line, 0, pos-len(ch) ) . strpart( line, pos )
+ let pos = pos - len(ch) + 1
+ endif
+ endif
+ normal! h
+ let pos = pos - 1
+ let c = c - 1
+ endwhile
+ call setline( '.', line )
+ call setreg( &clipboard == 'unnamed' ? '*' : '"', reg )
+endfunction
+
+" Forward erasing a character in normal mode
+function! PareditEraseFwd()
+ if !g:paredit_mode || !s:IsBalanced()
+ if v:count > 0
+ silent execute 'normal! ' . v:count . 'x'
+ else
+ normal! x
+ endif
+ return
+ endif
+
+ call s:InitYankPos()
+ call s:EraseFwd( v:count1, -1 )
+endfunction
+
+" Backward erasing a character in normal mode
+function! PareditEraseBck()
+ if !g:paredit_mode || !s:IsBalanced()
+ if v:count > 0
+ silent execute 'normal! ' . v:count . 'X'
+ else
+ normal! X
+ endif
+ return
+ endif
+
+ call s:InitYankPos()
+ call s:EraseBck( v:count1 )
+endfunction
+
+" Find beginning of previous element (atom or sub-expression) in a form
+" skip_whitespc: skip whitespaces before the previous element
+function! s:PrevElement( skip_whitespc )
+ let [l0, c0] = [line( '.' ), col( '.' )]
+ let symbol_pos = [0, 0]
+ let symbol_end = [0, 0]
+
+ " Move to the beginning of the prefix if any
+ let line = getline( '.' )
+ let c = col('.') - 1
+ if c > 0 && line[c-1] =~ s:any_macro_prefix
+ normal! h
+ endif
+
+ let moved = 0
+ while 1
+ " Go to previous character
+ if !moved
+ let [l1, c1] = [line( '.' ), col( '.' )]
+ let save_ww = &whichwrap
+ set whichwrap=
+ normal! h
+ let &whichwrap = save_ww
+ endif
+ let moved = 0
+ let [l, c] = [line( '.' ), col( '.' )]
+
+ if [l, c] == [l1, c1]
+ " Beginning of line reached
+ if symbol_pos != [0, 0]
+ let symbol_end = [l, c]
+ if !a:skip_whitespc && !s:InsideString()
+ " Newline before previous symbol
+ call setpos( '.', [0, l0, c0, 0] )
+ return [l, c]
+ endif
+ endif
+ normal! k$
+ let [l, c] = [line( '.' ), col( '.' )]
+ if [l, c] == [l1, c1]
+ " Beginning of file reached: stop
+ call setpos( '.', [0, l0, c0, 0] )
+ return [0, 0]
+ endif
+ let moved = 1
+ elseif s:InsideComment()
+ " Skip comments
+ else
+ let line = getline( '.' )
+ if s:InsideString() && !(a:skip_whitespc && line[c] =~ '\s' && symbol_end != [0, 0])
+ let symbol_pos = [l, c]
+ elseif symbol_pos == [0, 0]
+ if line[c-1] =~ b:any_closing_char
+ " Skip to the beginning of this sub-expression
+ let symbol_pos = [l, c]
+ normal! %
+ let line2 = getline( '.' )
+ let c2 = col('.') - 1
+ if c2 > 0 && line2[c2-1] =~ s:any_macro_prefix
+ normal! h
+ endif
+ elseif line[c-1] =~ b:any_opening_char
+ " Opening delimiter found: stop
+ call setpos( '.', [0, l0, c0, 0] )
+ return [0, 0]
+ elseif line[c-1] =~ '\S'
+ " Previous symbol starting
+ let symbol_pos = [l, c]
+ endif
+ else
+ if line[c-1] =~ b:any_opening_char || (a:skip_whitespc && line[c-1] =~ '\S' && symbol_end != [0, 0])
+ " Previous symbol beginning reached, opening delimiter or second previous symbol starting
+ call setpos( '.', [0, l0, c0, 0] )
+ return [l, c+1]
+ elseif line[c-1] =~ '\s' || symbol_pos[0] != l
+ " Whitespace before previous symbol
+ let symbol_end = [l, c]
+ if !a:skip_whitespc
+ call setpos( '.', [0, l0, c0, 0] )
+ return [l, c+1]
+ endif
+ endif
+ endif
+ endif
+ endwhile
+endfunction
+
+" Find end of next element (atom or sub-expression) in a form
+" skip_whitespc: skip whitespaces after the next element
+function! s:NextElement( skip_whitespc )
+ let [l0, c0] = [line( '.' ), col( '.' )]
+ let symbol_pos = [0, 0]
+ let symbol_end = [0, 0]
+
+ while 1
+ " Go to next character
+ let [l1, c1] = [line( '.' ), col( '.' )]
+ let save_ww = &whichwrap
+ set whichwrap=
+ normal! l
+ let &whichwrap = save_ww
+ let [l, c] = [line( '.' ), col( '.' )]
+
+ " Skip comments
+ while [l, c] == [l1, c1] || s:InsideComment()
+ if symbol_pos != [0, 0]
+ let symbol_end = [l, c]
+ if !a:skip_whitespc && !s:InsideString()
+ " Next symbol ended with comment
+ call setpos( '.', [0, l0, c0, 0] )
+ return [l, c + ([l, c] == [l1, c1])]
+ endif
+ endif
+ normal! 0j0
+ let [l, c] = [line( '.' ), col( '.' )]
+ if [l, c] == [l1, c1]
+ " End of file reached: stop
+ call setpos( '.', [0, l0, c0, 0] )
+ return [0, 0]
+ endif
+ endwhile
+
+ let line = getline( '.' )
+ if s:InsideString() && !(a:skip_whitespc && line[c-2] =~ '\s' && symbol_end != [0, 0])
+ let symbol_pos = [l, c]
+ elseif symbol_pos == [0, 0]
+ if line[c-1] =~ s:any_macro_prefix && line[c] =~ b:any_opening_char
+ " Skip to the end of this prefixed sub-expression
+ let symbol_pos = [l, c]
+ normal! l%
+ elseif line[c-1] =~ b:any_opening_char
+ " Skip to the end of this sub-expression
+ let symbol_pos = [l, c]
+ normal! %
+ elseif line[c-1] =~ b:any_closing_char
+ " Closing delimiter found: stop
+ call setpos( '.', [0, l0, c0, 0] )
+ return [0, 0]
+ elseif line[c-1] =~ '\S'
+ " Next symbol starting
+ let symbol_pos = [l, c]
+ endif
+ else
+ if line[c-1] =~ b:any_closing_char || (a:skip_whitespc && line[c-1] =~ '\S' && symbol_end != [0, 0])
+ " Next symbol ended, closing delimiter or second next symbol starting
+ call setpos( '.', [0, l0, c0, 0] )
+ return [l, c]
+ elseif line[c-1] =~ '\s' || symbol_pos[0] != l
+ " Next symbol ending with whitespace
+ let symbol_end = [l, c]
+ if !a:skip_whitespc
+ call setpos( '.', [0, l0, c0, 0] )
+ return [l, c]
+ endif
+ endif
+ endif
+ endwhile
+endfunction
+
+" Move character from [l0, c0] to [l1, c1]
+" Set position to [l1, c1]
+function! s:MoveChar( l0, c0, l1, c1 )
+ let line = getline( a:l0 )
+ let c = line[a:c0-1]
+ if a:l1 == a:l0
+ " Move character inside line
+ if a:c1 > a:c0
+ let line = strpart( line, 0, a:c0-1 ) . strpart( line, a:c0, a:c1-a:c0-1 ) . c . strpart( line, a:c1-1 )
+ call setline( a:l0, line )
+ call setpos( '.', [0, a:l1, a:c1-1, 0] )
+ else
+ let line = strpart( line, 0, a:c1-1 ) . c . strpart( line, a:c1-1, a:c0-a:c1 ) . strpart( line, a:c0 )
+ call setline( a:l0, line )
+ call setpos( '.', [0, a:l1, a:c1, 0] )
+ endif
+ else
+ " Move character to another line
+ let line = strpart( line, 0, a:c0-1 ) . strpart( line, a:c0 )
+ call setline( a:l0, line )
+ let line1 = getline( a:l1 )
+ if a:c1 > 1
+ let line1 = strpart( line1, 0, a:c1-1 ) . c . strpart( line1, a:c1-1 )
+ call setline( a:l1, line1 )
+ call setpos( '.', [0, a:l1, a:c1, 0] )
+ else
+ let line1 = c . line1
+ call setline( a:l1, line1 )
+ call setpos( '.', [0, a:l1, 1, 0] )
+ endif
+ endif
+endfunction
+
+" Find a paren nearby to move
+function! s:FindParenNearby()
+ let line = getline( '.' )
+ let c0 = col( '.' )
+ if line[c0-1] !~ b:any_openclose_char
+ " OK, we are not standing on a paren to move, but check if there is one nearby
+ if (c0 < 2 || line[c0-2] !~ b:any_openclose_char) && line[c0] =~ b:any_openclose_char
+ normal! l
+ elseif c0 > 1 && line[c0-2] =~ b:any_openclose_char && line[c0] !~ b:any_openclose_char
+ normal! h
+ endif
+ endif
+
+ " Skip macro prefix character
+ let c0 = col( '.' )
+ if line[c0-1] =~ s:any_macro_prefix && line[c0] =~ b:any_opening_char
+ normal! l
+ endif
+
+ " If still not standing on a paren then find the next closing one
+ if line[c0-1] !~ b:any_openclose_char
+ call search(b:any_closing_char, 'W')
+ endif
+endfunction
+
+" Reindent current form
+function! PareditReindentForm()
+ let l = line('.')
+ let c = col('.')
+ let old_indent = len(matchstr(getline(l), '^\s*'))
+ normal! =ib
+ let new_indent = len(matchstr(getline(l), '^\s*'))
+ call cursor( l, c + new_indent - old_indent )
+endfunction
+
+" Move delimiter one atom or s-expression to the left
+function! PareditMoveLeft()
+ call s:FindParenNearby()
+
+ let line = getline( '.' )
+ let l0 = line( '.' )
+ let c0 = col( '.' )
+
+ if line[c0-1] =~ b:any_opening_char
+ let closing = 0
+ elseif line[c0-1] =~ b:any_closing_char
+ let closing = 1
+ else
+ " Can move only delimiters
+ return
+ endif
+
+ let [lp, cp] = s:GetReplPromptPos()
+ let [l1, c1] = s:PrevElement( closing )
+ if [l1, c1] == [0, 0]
+ " No previous element found
+ return
+ elseif [lp, cp] != [0, 0] && l0 >= lp && (l1 < lp || (l1 == lp && c1 < cp))
+ " Do not go before the last command prompt in the REPL buffer
+ return
+ endif
+ if !closing && c0 > 0 && line[c0-2] =~ s:any_macro_prefix
+ call s:MoveChar( l0, c0-1, l1, c1 )
+ call s:MoveChar( l0, c0 - (l0 != l1), l1, c1+1 )
+ let len = 2
+ else
+ call s:MoveChar( l0, c0, l1, c1 )
+ let len = 1
+ endif
+ let line = getline( '.' )
+ let c = col( '.' ) - 1
+ if closing && c+1 < len(line) && line[c+1] !~ b:any_wsclose_char
+ " Insert a space after if needed
+ execute "normal! a "
+ normal! h
+ endif
+ let line = getline( '.' )
+ let c = col( '.' ) - 1
+ if !closing && c > 0 && line[c-len] !~ b:any_wsopen_char
+ " Insert a space before if needed
+ if len > 1
+ execute "normal! hi "
+ normal! ll
+ else
+ execute "normal! i "
+ normal! l
+ endif
+ endif
+ call PareditReindentForm()
+endfunction
+
+" Move delimiter one atom or s-expression to the right
+function! PareditMoveRight()
+ call s:FindParenNearby()
+
+ "TODO: move ')' in '() xxx' leaves space
+ let line = getline( '.' )
+ let l0 = line( '.' )
+ let c0 = col( '.' )
+
+ if line[c0-1] =~ b:any_opening_char
+ let opening = 1
+ elseif line[c0-1] =~ b:any_closing_char
+ let opening = 0
+ else
+ " Can move only delimiters
+ return
+ endif
+
+ let [lp, cp] = s:GetReplPromptPos()
+ let [l1, c1] = s:NextElement( opening )
+ if [l1, c1] == [0, 0]
+ " No next element found
+ return
+ elseif [lp, cp] != [0, 0] && l0 < lp && l1 >= lp
+ " Do not go after the last command prompt in the REPL buffer
+ return
+ endif
+ if opening && c0 > 1 && line[c0-2] =~ s:any_macro_prefix
+ call s:MoveChar( l0, c0-1, l1, c1 )
+ call s:MoveChar( l0, c0-1, l1, c1 + (l0 != l1) )
+ let len = 2
+ else
+ call s:MoveChar( l0, c0, l1, c1 )
+ let len = 1
+ endif
+ let line = getline( '.' )
+ let c = col( '.' ) - 1
+ if opening && c > 0 && line[c-len] !~ b:any_wsopen_char
+ " Insert a space before if needed
+ if len > 1
+ execute "normal! hi "
+ normal! ll
+ else
+ execute "normal! i "
+ normal! l
+ endif
+ endif
+ let line = getline( '.' )
+ let c = col( '.' ) - 1
+ if !opening && c+1 < len(line) && line[c+1] !~ b:any_wsclose_char
+ " Insert a space after if needed
+ execute "normal! a "
+ normal! h
+ endif
+ call PareditReindentForm()
+endfunction
+
+" Find closing of the innermost structure: (...) or [...] or {...}
+" Return a list where first element is the closing character,
+" second and third is its position (line, column)
+function! s:FindClosing()
+ let l = line( '.' )
+ let c = col( '.' )
+ let paren = ''
+ let l2 = 0
+ let c2 = 0
+
+ call PareditFindClosing( '(', ')', 0 )
+ let lp = line( '.' )
+ let cp = col( '.' )
+ if [lp, cp] != [l, c]
+ " Do we have a closing ')'?
+ let paren = ')'
+ let l2 = lp
+ let c2 = cp
+ endif
+ call setpos( '.', [0, l, c, 0] )
+
+ if &ft =~ s:fts_balancing_all_brackets
+ call PareditFindClosing( '[', ']', 0 )
+ let lp = line( '.' )
+ let cp = col( '.' )
+ if [lp, cp] != [l, c] && (lp < l2 || (lp == l2 && cp < c2))
+ " Do we have a ']' closer?
+ let paren = ']'
+ let l2 = lp
+ let c2 = cp
+ endif
+ call setpos( '.', [0, l, c, 0] )
+
+ call PareditFindClosing( '{', '}', 0 )
+ let lp = line( '.' )
+ let cp = col( '.' )
+ if [lp, cp] != [l, c] && (lp < l2 || (lp == l2 && cp < c2))
+ " Do we have a '}' even closer?
+ let paren = '}'
+ let l2 = lp
+ let c2 = cp
+ endif
+ call setpos( '.', [0, l, c, 0] )
+ endif
+
+ return [paren, l2, c2]
+endfunction
+
+" Split list or string at the cursor position
+" Current symbol will be split into the second part
+function! PareditSplit()
+ if !g:paredit_mode || s:InsideComment()
+ return
+ endif
+
+ if s:InsideString()
+ normal! i" "
+ else
+ " Go back to the beginning of the current symbol
+ let c = col('.') - 1
+ if getline('.')[c] =~ '\S'
+ if c == 0 || (c > 0 && getline('.')[c-1] =~ b:any_wsopen_char)
+ " OK, we are standing on the first character of the symbol
+ else
+ normal! b
+ endif
+ endif
+
+ " First find which kind of paren is the innermost
+ let [p, l, c] = s:FindClosing()
+ if p !~ b:any_closing_char
+ " Not found any kind of parens
+ return
+ endif
+
+ " Delete all whitespaces around cursor position
+ while getline('.')[col('.')-1] =~ '\s'
+ normal! x
+ endwhile
+ while col('.') > 1 && getline('.')[col('.')-2] =~ '\s'
+ normal! X
+ endwhile
+
+ if p == ')'
+ normal! i) (
+ elseif p == '}'
+ normal! i} {
+ else
+ normal! i] [
+ endif
+ endif
+endfunction
+
+" Join two neighboring lists or strings
+function! PareditJoin()
+ if !g:paredit_mode || s:InsideComment() || s:InsideString()
+ return
+ endif
+
+ "TODO: skip parens in comments
+ let [l0, c0] = searchpos(b:any_matched_char, 'nbW')
+ let [l1, c1] = searchpos(b:any_matched_char, 'ncW')
+ if [l0, c0] == [0, 0] || [l1, c1] == [0, 0]
+ return
+ endif
+ let line0 = getline( l0 )
+ let line1 = getline( l1 )
+ let p0 = line0[c0-1]
+ let p1 = line1[c1-1]
+ if (p0 == ')' && p1 == '(') || (p0 == ']' && p1 == '[') || (p0 == '}' && p1 == '{') || (p0 == '"' && p1 == '"')
+ if l0 == l1
+ " First list ends on the same line where the second list begins
+ let line0 = strpart( line0, 0, c0-1 ) . ' ' . strpart( line0, c1 )
+ call setline( l0, line0 )
+ else
+ " First list ends on a line different from where the second list begins
+ let line0 = strpart( line0, 0, c0-1 )
+ let line1 = strpart( line1, 0, c1-1 ) . strpart( line1, c1 )
+ call setline( l0, line0 )
+ call setline( l1, line1 )
+ endif
+ endif
+endfunction
+
+" Wrap current visual block in parens of the given kind
+function! s:WrapSelection( open, close )
+ let l0 = line( "'<" )
+ let l1 = line( "'>" )
+ let c0 = col( "'<" )
+ let c1 = col( "'>" )
+ if &selection == 'inclusive'
+ let c1 = c1 + strlen(matchstr(getline(l1)[c1-1 :], '.'))
+ endif
+ if [l0, c0] == [0, 0] || [l1, c1] == [0, 0]
+ " No selection
+ return
+ endif
+ if l0 > l1 || (l0 == l1 && c0 > c1)
+ " Swap both ends of selection to make [l0, c0] < [l1, c1]
+ let [ltmp, ctmp] = [l0, c0]
+ let [l0, c0] = [l1, c1]
+ let [l1, c1] = [ltmp, ctmp]
+ endif
+ let save_ve = &ve
+ set ve=all
+ call setpos( '.', [0, l0, c0, 0] )
+ execute "normal! i" . a:open
+ call setpos( '.', [0, l1, c1 + (l0 == l1), 0] )
+ execute "normal! i" . a:close
+ let &ve = save_ve
+endfunction
+
+" Wrap current visual block in parens of the given kind
+" Keep visual mode
+function! PareditWrapSelection( open, close )
+ call s:WrapSelection( a:open, a:close )
+ " Always leave the cursor to the opening char's pos after
+ " wrapping selection.
+ if getline('.')[col('.')-1] =~ b:any_closing_char
+ normal! %
+ endif
+endfunction
+
+" Wrap current symbol in parens of the given kind
+" If standing on a paren then wrap the whole s-expression
+" Stand on the opening paren (if not wrapping in "")
+function! PareditWrap( open, close )
+ let isk_save = s:SetKeyword()
+ let sel_save = &selection
+ let line = line('.')
+ let column = col('.')
+ let line_content = getline(line)
+ let current_char = line_content[column - 1]
+
+ if a:open != '"' && current_char =~ b:any_openclose_char
+ execute "normal! " . "v%\<Esc>"
+ else
+ let inside_comment = s:InsideComment(line, column)
+
+ if current_char == '"' && !inside_comment
+ let escaped_quote = line_content[column - 2] == "\\"
+ if escaped_quote
+ execute "normal! " . "vh\<Esc>"
+ else
+ let is_starting_quote = 1
+ if column == 1 && line > 1
+ let endOfPreviousLine = col([line - 1, '$'])
+ if s:InsideString(line - 1, endOfPreviousLine - 1)
+ let previous_line_content = getline(line - 1)
+ if previous_line_content[endOfPreviousLine - 2] != '"'
+ let is_starting_quote = 0
+ elseif previous_line_content[endOfPreviousLine - 3] == "\\"
+ let is_starting_quote = 0
+ endif
+ endif
+ elseif s:InsideString(line, column - 1)
+ if line_content[column - 2] != '"'
+ let is_starting_quote = 0
+ elseif line_content[column - 3] == "\\"
+ let is_starting_quote = 0
+ endif
+ endif
+ let &selection="inclusive"
+ normal! v
+ if is_starting_quote
+ call search( '\\\@<!"', 'W', 's:SkipExpr()' )
+ else
+ call search( '\\\@<!"', 'bW', 's:SkipExpr()' )
+ endif
+ execute "normal! " . "\<Esc>"
+ endif
+ else
+ execute "normal! " . "viw\<Esc>"
+ endif
+ endif
+ call s:WrapSelection( a:open, a:close )
+ if a:open != '"'
+ normal! %
+ else
+ call cursor(line, column + 1)
+ endif
+ let &selection = sel_save
+ let &iskeyword = isk_save
+endfunction
+
+" Splice current list into the containing list
+function! PareditSplice()
+ if !g:paredit_mode
+ return
+ endif
+
+ " First find which kind of paren is the innermost
+ let [p, l, c] = s:FindClosing()
+ if p !~ b:any_closing_char
+ " Not found any kind of parens
+ return
+ endif
+
+ call setpos( '.', [0, l, c, 0] )
+ normal! %
+ let l = line( '.' )
+ let c = col( '.' )
+ normal! %x
+ call setpos( '.', [0, l, c, 0] )
+ normal! x
+ if c > 1 && getline('.')[c-2] =~ s:any_macro_prefix
+ normal! X
+ endif
+endfunction
+
+" Raise: replace containing form with the current symbol or sub-form
+function! PareditRaise()
+ let isk_save = s:SetKeyword()
+ let ch = getline('.')[col('.')-1]
+ if ch =~ b:any_openclose_char
+ " Jump to the closing char in order to find the outer
+ " closing char.
+ if ch =~ b:any_opening_char
+ normal! %
+ endif
+
+ let [p, l, c] = s:FindClosing()
+ if p =~ b:any_closing_char
+ " Raise sub-form and re-indent
+ exe "normal! y%d%da" . p
+ if getline('.')[col('.')-1] == ' '
+ normal! "0p=%
+ else
+ normal! "0P=%
+ endif
+ elseif ch =~ b:any_opening_char
+ " Restore position if there is no appropriate
+ " closing char.
+ normal! %
+ endif
+ else
+ let [p, l, c] = s:FindClosing()
+ if p =~ b:any_closing_char
+ " Raise symbol
+ exe "normal! yiwda" . p
+ normal! "0Pb
+ endif
+ endif
+ let &iskeyword = isk_save
+endfunction
+
+" =====================================================================
+" Autocommands
+" =====================================================================
+
+if !exists("g:paredit_disable_lisp")
+ au FileType lisp call PareditInitBuffer()
+endif
+
+if !exists("g:paredit_disable_clojure")
+ au FileType *clojure* call PareditInitBuffer()
+endif
+
+if !exists("g:paredit_disable_hy")
+ au FileType hy call PareditInitBuffer()
+endif
+
+if !exists("g:paredit_disable_scheme")
+ au FileType scheme call PareditInitBuffer()
+ au FileType racket call PareditInitBuffer()
+endif
+
+if !exists("g:paredit_disable_shen")
+ au FileType shen call PareditInitBuffer()
+endif
diff --git a/vim/bundle/slimv/slime/README.md b/vim/bundle/slimv/slime/README.md
new file mode 100644
index 0000000..7ef8cd3
--- /dev/null
+++ b/vim/bundle/slimv/slime/README.md
@@ -0,0 +1,78 @@
+[![Build Status](https://img.shields.io/travis/slime/slime/master.svg)](https://travis-ci.org/slime/slime) [![MELPA](http://melpa.org/packages/slime-badge.svg?)](http://melpa.org/#/slime) [![MELPA Stable](http://stable.melpa.org/packages/slime-badge.svg?)](http://stable.melpa.org/#/slime)
+
+Overview
+--------
+
+SLIME is the Superior Lisp Interaction Mode for Emacs.
+
+SLIME extends Emacs with support for interactive programming in Common
+Lisp. The features are centered around slime-mode, an Emacs minor-mode that
+complements the standard lisp-mode. While lisp-mode supports editing Lisp
+source files, slime-mode adds support for interacting with a running Common
+Lisp process for compilation, debugging, documentation lookup, and so on.
+
+For much more information, consult [the manual][1].
+
+
+Quick setup instructions
+------------------------
+
+ 1. [Set up the MELPA repository][2], if you haven't already, and install
+ SLIME using `M-x package-install RET slime RET`.
+
+ 2. Add the following lines to your `~/.emacs` file, filling in in
+ the appropriate filenames:
+
+ ```el
+ ;; Set your lisp system and, optionally, some contribs
+ (setq inferior-lisp-program "/opt/sbcl/bin/sbcl")
+ (setq slime-contribs '(slime-fancy))
+ ```
+
+ 3. Use `M-x slime` to fire up and connect to an inferior Lisp. SLIME will
+ now automatically be available in your Lisp source buffers.
+
+If you'd like to contribute to SLIME, you will want to instead follow
+the manual's instructions on [how to install SLIME via Git][7].
+
+
+Contribs
+--------
+
+SLIME comes with additional contributed packages or "contribs".
+Contribs can be selected via the `slime-contribs` list.
+
+The most-often used contrib is `slime-fancy`, which primarily installs a
+popular set of other contributed packages. It includes a better REPL, and
+many more nice features.
+
+
+License
+-------
+
+SLIME is free software. All files, unless explicitly stated otherwise, are
+public domain.
+
+
+Contact
+-------
+
+If you have problems, first have a look at the list of
+[known issues and workarounds][6].
+
+Questions and comments are best directed to the mailing list at
+`slime-devel@common-lisp.net`, but you have to [subscribe][3] first. The
+mailing list archive is also available on [Gmane][4].
+
+See the [CONTRIBUTING.md][5] file for instructions on how to contribute.
+
+
+
+
+[1]: http://common-lisp.net/project/slime/doc/html/
+[2]: http://melpa.org/#/getting-started
+[3]: http://www.common-lisp.net/project/slime/#mailinglist
+[4]: http://news.gmane.org/gmane.lisp.slime.devel
+[5]: https://github.com/slime/slime/blob/master/CONTRIBUTING.md
+[6]: https://github.com/slime/slime/issues?labels=workaround&state=closed
+[7]: http://common-lisp.net/project/slime/doc/html/Installation.html#Installing-from-Git
diff --git a/vim/bundle/slimv/slime/contrib/README.md b/vim/bundle/slimv/slime/contrib/README.md
new file mode 100644
index 0000000..94fd02f
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/README.md
@@ -0,0 +1,14 @@
+This directory contains source code which may be useful to some Slime
+users. `*.el` files are Emacs Lisp source and `*.lisp` files contain
+Common Lisp source code. If not otherwise stated in the file itself,
+the files are placed in the Public Domain.
+
+The components in this directory are more or less detached from the
+rest of Slime. They are essentially "add-ons". But Slime can also be
+used without them. The code is maintained by the respective authors.
+
+See the top level README.md for how to use packages in this directory.
+
+Finally, the contrib `slime-fancy` is specially noteworthy, as it
+represents a meta-contrib that'll load a bunch of commonly used
+contribs. Look into `slime-fancy.el` to find out which.
diff --git a/vim/bundle/slimv/slime/contrib/swank-arglists.lisp b/vim/bundle/slimv/slime/contrib/swank-arglists.lisp
new file mode 100644
index 0000000..a9357ec
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-arglists.lisp
@@ -0,0 +1,1615 @@
+;;; swank-arglists.lisp --- arglist related code ??
+;;
+;; Authors: Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>
+;; Tobias C. Rittweiler <tcr@freebits.de>
+;; and others
+;;
+;; License: Public Domain
+;;
+
+(in-package :swank)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (swank-require :swank-c-p-c))
+
+;;;; Utilities
+
+(defun compose (&rest functions)
+ "Compose FUNCTIONS right-associatively, returning a function"
+ #'(lambda (x)
+ (reduce #'funcall functions :initial-value x :from-end t)))
+
+(defun length= (seq n)
+ "Test for whether SEQ contains N number of elements. I.e. it's equivalent
+ to (= (LENGTH SEQ) N), but besides being more concise, it may also be more
+ efficiently implemented."
+ (etypecase seq
+ (list (do ((i n (1- i))
+ (list seq (cdr list)))
+ ((or (<= i 0) (null list))
+ (and (zerop i) (null list)))))
+ (sequence (= (length seq) n))))
+
+(declaim (inline memq))
+(defun memq (item list)
+ (member item list :test #'eq))
+
+(defun exactly-one-p (&rest values)
+ "If exactly one value in VALUES is non-NIL, this value is returned.
+Otherwise NIL is returned."
+ (let ((found nil))
+ (dolist (v values)
+ (when v (if found
+ (return-from exactly-one-p nil)
+ (setq found v))))
+ found))
+
+(defun valid-operator-symbol-p (symbol)
+ "Is SYMBOL the name of a function, a macro, or a special-operator?"
+ (or (fboundp symbol)
+ (macro-function symbol)
+ (special-operator-p symbol)
+ (member symbol '(declare declaim))))
+
+(defun function-exists-p (form)
+ (and (valid-function-name-p form)
+ (fboundp form)
+ t))
+
+(defmacro multiple-value-or (&rest forms)
+ (if (null forms)
+ nil
+ (let ((first (first forms))
+ (rest (rest forms)))
+ `(let* ((values (multiple-value-list ,first))
+ (primary-value (first values)))
+ (if primary-value
+ (values-list values)
+ (multiple-value-or ,@rest))))))
+
+(defun arglist-available-p (arglist)
+ (not (eql arglist :not-available)))
+
+(defmacro with-available-arglist ((var &rest more-vars) form &body body)
+ `(multiple-value-bind (,var ,@more-vars) ,form
+ (if (eql ,var :not-available)
+ :not-available
+ (progn ,@body))))
+
+
+;;;; Arglist Definition
+
+(defstruct (arglist (:conc-name arglist.) (:predicate arglist-p))
+ provided-args ; list of the provided actual arguments
+ required-args ; list of the required arguments
+ optional-args ; list of the optional arguments
+ key-p ; whether &key appeared
+ keyword-args ; list of the keywords
+ rest ; name of the &rest or &body argument (if any)
+ body-p ; whether the rest argument is a &body
+ allow-other-keys-p ; whether &allow-other-keys appeared
+ aux-args ; list of &aux variables
+ any-p ; whether &any appeared
+ any-args ; list of &any arguments [*]
+ known-junk ; &whole, &environment
+ unknown-junk) ; unparsed stuff
+
+;;;
+;;; [*] The &ANY lambda keyword is an extension to ANSI Common Lisp,
+;;; and is only used to describe certain arglists that cannot be
+;;; described in another way.
+;;;
+;;; &ANY is very similiar to &KEY but while &KEY is based upon
+;;; the idea of a plist (key1 value1 key2 value2), &ANY is a
+;;; cross between &OPTIONAL, &KEY and *FEATURES* lists:
+;;;
+;;; a) (&ANY :A :B :C) means that you can provide any (non-null)
+;;; set consisting of the keywords `:A', `:B', or `:C' in
+;;; the arglist. E.g. (:A) or (:C :B :A).
+;;;
+;;; (This is not restricted to keywords only, but any self-evaluating
+;;; expression is allowed.)
+;;;
+;;; b) (&ANY (key1 v1) (key2 v2) (key3 v3)) means that you can
+;;; provide any (non-null) set consisting of lists where
+;;; the CAR of the list is one of `key1', `key2', or `key3'.
+;;; E.g. ((key1 100) (key3 42)), or ((key3 66) (key2 23))
+;;;
+;;;
+;;; For example, a) let us describe the situations of EVAL-WHEN as
+;;;
+;;; (EVAL-WHEN (&ANY :compile-toplevel :load-toplevel :execute) &BODY body)
+;;;
+;;; and b) let us describe the optimization qualifiers that are valid
+;;; in the declaration specifier `OPTIMIZE':
+;;;
+;;; (DECLARE (OPTIMIZE &ANY (compilation-speed 1) (safety 1) ...))
+;;;
+
+;; This is a wrapper object around anything that came from Slime and
+;; could not reliably be read.
+(defstruct (arglist-dummy
+ (:conc-name #:arglist-dummy.)
+ (:constructor make-arglist-dummy (string-representation)))
+ string-representation)
+
+(defun empty-arg-p (dummy)
+ (and (arglist-dummy-p dummy)
+ (zerop (length (arglist-dummy.string-representation dummy)))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter +lambda-list-keywords+
+ '(&provided &required &optional &rest &key &any)))
+
+(defmacro do-decoded-arglist (decoded-arglist &body clauses)
+ (assert (loop for clause in clauses
+ thereis (member (car clause) +lambda-list-keywords+)))
+ (flet ((parse-clauses (clauses)
+ (let* ((size (length +lambda-list-keywords+))
+ (initial (make-hash-table :test #'eq :size size))
+ (main (make-hash-table :test #'eq :size size))
+ (final (make-hash-table :test #'eq :size size)))
+ (loop for clause in clauses
+ for lambda-list-keyword = (first clause)
+ for clause-parameter = (second clause)
+ do
+ (case clause-parameter
+ (:initially
+ (setf (gethash lambda-list-keyword initial) clause))
+ (:finally
+ (setf (gethash lambda-list-keyword final) clause))
+ (t
+ (setf (gethash lambda-list-keyword main) clause)))
+ finally
+ (return (values initial main final)))))
+ (generate-main-clause (clause arglist)
+ (dcase clause
+ ((&provided (&optional arg) . body)
+ (let ((gensym (gensym "PROVIDED-ARG+")))
+ `(dolist (,gensym (arglist.provided-args ,arglist))
+ (declare (ignorable ,gensym))
+ (let (,@(when arg `((,arg ,gensym))))
+ ,@body))))
+ ((&required (&optional arg) . body)
+ (let ((gensym (gensym "REQUIRED-ARG+")))
+ `(dolist (,gensym (arglist.required-args ,arglist))
+ (declare (ignorable ,gensym))
+ (let (,@(when arg `((,arg ,gensym))))
+ ,@body))))
+ ((&optional (&optional arg init) . body)
+ (let ((optarg (gensym "OPTIONAL-ARG+")))
+ `(dolist (,optarg (arglist.optional-args ,arglist))
+ (declare (ignorable ,optarg))
+ (let (,@(when arg
+ `((,arg (optional-arg.arg-name ,optarg))))
+ ,@(when init
+ `((,init (optional-arg.default-arg ,optarg)))))
+ ,@body))))
+ ((&key (&optional keyword arg init) . body)
+ (let ((keyarg (gensym "KEY-ARG+")))
+ `(dolist (,keyarg (arglist.keyword-args ,arglist))
+ (declare (ignorable ,keyarg))
+ (let (,@(when keyword
+ `((,keyword (keyword-arg.keyword ,keyarg))))
+ ,@(when arg
+ `((,arg (keyword-arg.arg-name ,keyarg))))
+ ,@(when init
+ `((,init (keyword-arg.default-arg ,keyarg)))))
+ ,@body))))
+ ((&rest (&optional arg body-p) . body)
+ `(when (arglist.rest ,arglist)
+ (let (,@(when arg `((,arg (arglist.rest ,arglist))))
+ ,@(when body-p `((,body-p (arglist.body-p ,arglist)))))
+ ,@body)))
+ ((&any (&optional arg) . body)
+ (let ((gensym (gensym "REQUIRED-ARG+")))
+ `(dolist (,gensym (arglist.any-args ,arglist))
+ (declare (ignorable ,gensym))
+ (let (,@(when arg `((,arg ,gensym))))
+ ,@body)))))))
+ (let ((arglist (gensym "DECODED-ARGLIST+")))
+ (multiple-value-bind (initially-clauses main-clauses finally-clauses)
+ (parse-clauses clauses)
+ `(let ((,arglist ,decoded-arglist))
+ (block do-decoded-arglist
+ ,@(loop for keyword in '(&provided &required
+ &optional &rest &key &any)
+ append (cddr (gethash keyword initially-clauses))
+ collect (let ((clause (gethash keyword main-clauses)))
+ (when clause
+ (generate-main-clause clause arglist)))
+ append (cddr (gethash keyword finally-clauses)))))))))
+
+;;;; Arglist Printing
+
+(defun undummy (x)
+ (if (typep x 'arglist-dummy)
+ (arglist-dummy.string-representation x)
+ (prin1-to-string x)))
+
+(defun print-decoded-arglist (arglist &key operator provided-args highlight)
+ (let ((first-space-after-operator (and operator t)))
+ (macrolet ((space ()
+ ;; Kludge: When OPERATOR is not given, we don't want to
+ ;; print a space for the first argument.
+ `(if (not operator)
+ (setq operator t)
+ (progn (write-char #\space)
+ (if first-space-after-operator
+ (setq first-space-after-operator nil)
+ (pprint-newline :fill)))))
+ (with-highlighting ((&key index) &body body)
+ `(if (eql ,index (car highlight))
+ (progn (princ "===> ") ,@body (princ " <==="))
+ (progn ,@body)))
+ (print-arglist-recursively (argl &key index)
+ `(if (eql ,index (car highlight))
+ (print-decoded-arglist ,argl :highlight (cdr highlight))
+ (print-decoded-arglist ,argl))))
+ (let ((index 0))
+ (pprint-logical-block (nil nil :prefix "(" :suffix ")")
+ (when operator
+ (print-arg operator)
+ (pprint-indent :current 1)) ; 1 due to possibly added space
+ (do-decoded-arglist (remove-given-args arglist provided-args)
+ (&provided (arg)
+ (space)
+ (print-arg arg :literal-strings t)
+ (incf index))
+ (&required (arg)
+ (space)
+ (if (arglist-p arg)
+ (print-arglist-recursively arg :index index)
+ (with-highlighting (:index index)
+ (print-arg arg)))
+ (incf index))
+ (&optional :initially
+ (when (arglist.optional-args arglist)
+ (space)
+ (princ '&optional)))
+ (&optional (arg init-value)
+ (space)
+ (if (arglist-p arg)
+ (print-arglist-recursively arg :index index)
+ (with-highlighting (:index index)
+ (if (null init-value)
+ (print-arg arg)
+ (format t "~:@<~A ~A~@:>"
+ (undummy arg) (undummy init-value)))))
+ (incf index))
+ (&key :initially
+ (when (arglist.key-p arglist)
+ (space)
+ (princ '&key)))
+ (&key (keyword arg init)
+ (space)
+ (if (arglist-p arg)
+ (pprint-logical-block (nil nil :prefix "(" :suffix ")")
+ (prin1 keyword) (space)
+ (print-arglist-recursively arg :index keyword))
+ (with-highlighting (:index keyword)
+ (cond ((and init (keywordp keyword))
+ (format t "~:@<~A ~A~@:>" keyword (undummy init)))
+ (init
+ (format t "~:@<(~A ..) ~A~@:>"
+ (undummy keyword) (undummy init)))
+ ((not (keywordp keyword))
+ (format t "~:@<(~S ..)~@:>" keyword))
+ (t
+ (princ keyword))))))
+ (&key :finally
+ (when (arglist.allow-other-keys-p arglist)
+ (space)
+ (princ '&allow-other-keys)))
+ (&any :initially
+ (when (arglist.any-p arglist)
+ (space)
+ (princ '&any)))
+ (&any (arg)
+ (space)
+ (print-arg arg))
+ (&rest (args bodyp)
+ (space)
+ (princ (if bodyp '&body '&rest))
+ (space)
+ (if (arglist-p args)
+ (print-arglist-recursively args :index index)
+ (with-highlighting (:index index)
+ (print-arg args))))
+ ;; FIXME: add &UNKNOWN-JUNK?
+ ))))))
+
+(defun print-arg (arg &key literal-strings)
+ (let ((arg (if (arglist-dummy-p arg)
+ (arglist-dummy.string-representation arg)
+ arg)))
+ (if (or
+ (and literal-strings
+ (stringp arg))
+ (keywordp arg))
+ (prin1 arg)
+ (princ arg))))
+
+(defun print-decoded-arglist-as-template (decoded-arglist &key
+ (prefix "(") (suffix ")"))
+ (let ((first-p t))
+ (flet ((space ()
+ (unless first-p
+ (write-char #\space))
+ (setq first-p nil))
+ (print-arg-or-pattern (arg)
+ (etypecase arg
+ (symbol (if (keywordp arg) (prin1 arg) (princ arg)))
+ (string (princ arg))
+ (list (princ arg))
+ (arglist-dummy (princ
+ (arglist-dummy.string-representation arg)))
+ (arglist (print-decoded-arglist-as-template arg)))
+ (pprint-newline :fill)))
+ (pprint-logical-block (nil nil :prefix prefix :suffix suffix)
+ (do-decoded-arglist decoded-arglist
+ (&provided ()) ; do nothing; provided args are in the buffer already.
+ (&required (arg)
+ (space) (print-arg-or-pattern arg))
+ (&optional (arg)
+ (space) (princ "[") (print-arg-or-pattern arg) (princ "]"))
+ (&key (keyword arg)
+ (space)
+ (prin1 (if (keywordp keyword) keyword `',keyword))
+ (space)
+ (print-arg-or-pattern arg)
+ (pprint-newline :linear))
+ (&any (arg)
+ (space) (print-arg-or-pattern arg))
+ (&rest (args)
+ (when (or (not (arglist.keyword-args decoded-arglist))
+ (arglist.allow-other-keys-p decoded-arglist))
+ (space)
+ (format t "~A..." args))))))))
+
+(defvar *arglist-pprint-bindings*
+ '((*print-case* . :downcase)
+ (*print-pretty* . t)
+ (*print-circle* . nil)
+ (*print-readably* . nil)
+ (*print-level* . 10)
+ (*print-length* . 20)
+ (*print-escape* . nil)))
+
+(defvar *arglist-show-packages* t)
+
+(defmacro with-arglist-io-syntax (&body body)
+ (let ((package (gensym)))
+ `(let ((,package *package*))
+ (with-standard-io-syntax
+ (let ((*package* (if *arglist-show-packages*
+ *package*
+ ,package)))
+ (with-bindings *arglist-pprint-bindings*
+ ,@body))))))
+
+(defun decoded-arglist-to-string (decoded-arglist
+ &key operator highlight
+ print-right-margin)
+ (with-output-to-string (*standard-output*)
+ (with-arglist-io-syntax
+ (let ((*print-right-margin* print-right-margin))
+ (print-decoded-arglist decoded-arglist
+ :operator operator
+ :highlight highlight)))))
+
+(defun decoded-arglist-to-template-string (decoded-arglist
+ &key (prefix "(") (suffix ")"))
+ (with-output-to-string (*standard-output*)
+ (with-arglist-io-syntax
+ (print-decoded-arglist-as-template decoded-arglist
+ :prefix prefix
+ :suffix suffix))))
+
+;;;; Arglist Decoding / Encoding
+
+(defun decode-required-arg (arg)
+ "ARG can be a symbol or a destructuring pattern."
+ (etypecase arg
+ (symbol arg)
+ (arglist-dummy arg)
+ (list (decode-arglist arg))))
+
+(defun encode-required-arg (arg)
+ (etypecase arg
+ (symbol arg)
+ (arglist (encode-arglist arg))))
+
+(defstruct (keyword-arg
+ (:conc-name keyword-arg.)
+ (:constructor %make-keyword-arg))
+ keyword
+ arg-name
+ default-arg)
+
+(defun canonicalize-default-arg (form)
+ (if (equalp ''nil form)
+ nil
+ form))
+
+(defun make-keyword-arg (keyword arg-name default-arg)
+ (%make-keyword-arg :keyword keyword
+ :arg-name arg-name
+ :default-arg (canonicalize-default-arg default-arg)))
+
+(defun decode-keyword-arg (arg)
+ "Decode a keyword item of formal argument list.
+Return three values: keyword, argument name, default arg."
+ (flet ((intern-as-keyword (arg)
+ (intern (etypecase arg
+ (symbol (symbol-name arg))
+ (arglist-dummy (arglist-dummy.string-representation arg)))
+ keyword-package)))
+ (cond ((or (symbolp arg) (arglist-dummy-p arg))
+ (make-keyword-arg (intern-as-keyword arg) arg nil))
+ ((and (consp arg)
+ (consp (car arg)))
+ (make-keyword-arg (caar arg)
+ (decode-required-arg (cadar arg))
+ (cadr arg)))
+ ((consp arg)
+ (make-keyword-arg (intern-as-keyword (car arg))
+ (car arg) (cadr arg)))
+ (t
+ (error "Bad keyword item of formal argument list")))))
+
+(defun encode-keyword-arg (arg)
+ (cond
+ ((arglist-p (keyword-arg.arg-name arg))
+ ;; Destructuring pattern
+ (let ((keyword/name (list (keyword-arg.keyword arg)
+ (encode-required-arg
+ (keyword-arg.arg-name arg)))))
+ (if (keyword-arg.default-arg arg)
+ (list keyword/name
+ (keyword-arg.default-arg arg))
+ (list keyword/name))))
+ ((eql (intern (symbol-name (keyword-arg.arg-name arg))
+ keyword-package)
+ (keyword-arg.keyword arg))
+ (if (keyword-arg.default-arg arg)
+ (list (keyword-arg.arg-name arg)
+ (keyword-arg.default-arg arg))
+ (keyword-arg.arg-name arg)))
+ (t
+ (let ((keyword/name (list (keyword-arg.keyword arg)
+ (keyword-arg.arg-name arg))))
+ (if (keyword-arg.default-arg arg)
+ (list keyword/name
+ (keyword-arg.default-arg arg))
+ (list keyword/name))))))
+
+(progn
+ (assert (equalp (decode-keyword-arg 'x)
+ (make-keyword-arg :x 'x nil)))
+ (assert (equalp (decode-keyword-arg '(x t))
+ (make-keyword-arg :x 'x t)))
+ (assert (equalp (decode-keyword-arg '((:x y)))
+ (make-keyword-arg :x 'y nil)))
+ (assert (equalp (decode-keyword-arg '((:x y) t))
+ (make-keyword-arg :x 'y t))))
+
+;;; FIXME suppliedp?
+(defstruct (optional-arg
+ (:conc-name optional-arg.)
+ (:constructor %make-optional-arg))
+ arg-name
+ default-arg)
+
+(defun make-optional-arg (arg-name default-arg)
+ (%make-optional-arg :arg-name arg-name
+ :default-arg (canonicalize-default-arg default-arg)))
+
+(defun decode-optional-arg (arg)
+ "Decode an optional item of a formal argument list.
+Return an OPTIONAL-ARG structure."
+ (etypecase arg
+ (symbol (make-optional-arg arg nil))
+ (arglist-dummy (make-optional-arg arg nil))
+ (list (make-optional-arg (decode-required-arg (car arg))
+ (cadr arg)))))
+
+(defun encode-optional-arg (optional-arg)
+ (if (or (optional-arg.default-arg optional-arg)
+ (arglist-p (optional-arg.arg-name optional-arg)))
+ (list (encode-required-arg
+ (optional-arg.arg-name optional-arg))
+ (optional-arg.default-arg optional-arg))
+ (optional-arg.arg-name optional-arg)))
+
+(progn
+ (assert (equalp (decode-optional-arg 'x)
+ (make-optional-arg 'x nil)))
+ (assert (equalp (decode-optional-arg '(x t))
+ (make-optional-arg 'x t))))
+
+(define-modify-macro nreversef () nreverse "Reverse the list in PLACE.")
+
+(defun decode-arglist (arglist)
+ "Parse the list ARGLIST and return an ARGLIST structure."
+ (etypecase arglist
+ ((eql :not-available) (return-from decode-arglist
+ :not-available))
+ (list))
+ (loop
+ with mode = nil
+ with result = (make-arglist)
+ for arg = (if (consp arglist)
+ (pop arglist)
+ (progn
+ (prog1 arglist
+ (setf mode '&rest
+ arglist nil))))
+ do (cond
+ ((eql mode '&unknown-junk)
+ ;; don't leave this mode -- we don't know how the arglist
+ ;; after unknown lambda-list keywords is interpreted
+ (push arg (arglist.unknown-junk result)))
+ ((eql arg '&allow-other-keys)
+ (setf (arglist.allow-other-keys-p result) t))
+ ((eql arg '&key)
+ (setf (arglist.key-p result) t
+ mode arg))
+ ((memq arg '(&optional &rest &body &aux))
+ (setq mode arg))
+ ((memq arg '(&whole &environment))
+ (setq mode arg)
+ (push arg (arglist.known-junk result)))
+ ((and (symbolp arg)
+ (string= (symbol-name arg) (string '#:&any))) ; may be interned
+ (setf (arglist.any-p result) t) ; in any *package*.
+ (setq mode '&any))
+ ((memq arg lambda-list-keywords)
+ (setq mode '&unknown-junk)
+ (push arg (arglist.unknown-junk result)))
+ (t
+ (ecase mode
+ (&key
+ (push (decode-keyword-arg arg)
+ (arglist.keyword-args result)))
+ (&optional
+ (push (decode-optional-arg arg)
+ (arglist.optional-args result)))
+ (&body
+ (setf (arglist.body-p result) t
+ (arglist.rest result) arg))
+ (&rest
+ (setf (arglist.rest result) arg))
+ (&aux
+ (push (decode-optional-arg arg)
+ (arglist.aux-args result)))
+ ((nil)
+ (push (decode-required-arg arg)
+ (arglist.required-args result)))
+ ((&whole &environment)
+ (setf mode nil)
+ (push arg (arglist.known-junk result)))
+ (&any
+ (push arg (arglist.any-args result))))))
+ until (null arglist)
+ finally (nreversef (arglist.required-args result))
+ finally (nreversef (arglist.optional-args result))
+ finally (nreversef (arglist.keyword-args result))
+ finally (nreversef (arglist.aux-args result))
+ finally (nreversef (arglist.any-args result))
+ finally (nreversef (arglist.known-junk result))
+ finally (nreversef (arglist.unknown-junk result))
+ finally (assert (or (and (not (arglist.key-p result))
+ (not (arglist.any-p result)))
+ (exactly-one-p (arglist.key-p result)
+ (arglist.any-p result))))
+ finally (return result)))
+
+(defun encode-arglist (decoded-arglist)
+ (append (mapcar #'encode-required-arg
+ (arglist.required-args decoded-arglist))
+ (when (arglist.optional-args decoded-arglist)
+ '(&optional))
+ (mapcar #'encode-optional-arg
+ (arglist.optional-args decoded-arglist))
+ (when (arglist.key-p decoded-arglist)
+ '(&key))
+ (mapcar #'encode-keyword-arg
+ (arglist.keyword-args decoded-arglist))
+ (when (arglist.allow-other-keys-p decoded-arglist)
+ '(&allow-other-keys))
+ (when (arglist.any-args decoded-arglist)
+ `(&any ,@(arglist.any-args decoded-arglist)))
+ (cond ((not (arglist.rest decoded-arglist))
+ '())
+ ((arglist.body-p decoded-arglist)
+ `(&body ,(arglist.rest decoded-arglist)))
+ (t
+ `(&rest ,(arglist.rest decoded-arglist))))
+ (when (arglist.aux-args decoded-arglist)
+ `(&aux ,(arglist.aux-args decoded-arglist)))
+ (arglist.known-junk decoded-arglist)
+ (arglist.unknown-junk decoded-arglist)))
+
+;;;; Arglist Enrichment
+
+(defun arglist-keywords (lambda-list)
+ "Return the list of keywords in ARGLIST.
+As a secondary value, return whether &allow-other-keys appears."
+ (let ((decoded-arglist (decode-arglist lambda-list)))
+ (values (arglist.keyword-args decoded-arglist)
+ (arglist.allow-other-keys-p decoded-arglist))))
+
+
+(defun methods-keywords (methods)
+ "Collect all keywords in the arglists of METHODS.
+As a secondary value, return whether &allow-other-keys appears somewhere."
+ (let ((keywords '())
+ (allow-other-keys nil))
+ (dolist (method methods)
+ (multiple-value-bind (kw aok)
+ (arglist-keywords
+ (swank-mop:method-lambda-list method))
+ (setq keywords (remove-duplicates (append keywords kw)
+ :key #'keyword-arg.keyword)
+ allow-other-keys (or allow-other-keys aok))))
+ (values keywords allow-other-keys)))
+
+(defun generic-function-keywords (generic-function)
+ "Collect all keywords in the methods of GENERIC-FUNCTION.
+As a secondary value, return whether &allow-other-keys appears somewhere."
+ (methods-keywords
+ (swank-mop:generic-function-methods generic-function)))
+
+(defun applicable-methods-keywords (generic-function arguments)
+ "Collect all keywords in the methods of GENERIC-FUNCTION that are
+applicable for argument of CLASSES. As a secondary value, return
+whether &allow-other-keys appears somewhere."
+ (methods-keywords
+ (multiple-value-bind (amuc okp)
+ (swank-mop:compute-applicable-methods-using-classes
+ generic-function (mapcar #'class-of arguments))
+ (if okp
+ amuc
+ (compute-applicable-methods generic-function arguments)))))
+
+(defgeneric extra-keywords (operator &rest args)
+ (:documentation "Return a list of extra keywords of OPERATOR (a
+symbol) when applied to the (unevaluated) ARGS.
+As a secondary value, return whether other keys are allowed.
+As a tertiary value, return the initial sublist of ARGS that was needed
+to determine the extra keywords."))
+
+;;; We make sure that symbol-from-KEYWORD-using keywords come before
+;;; symbol-from-arbitrary-package-using keywords. And we sort the
+;;; latter according to how their home-packages relate to *PACKAGE*.
+;;;
+;;; Rationale is to show those key parameters first which make most
+;;; sense in the current context. And in particular: to put
+;;; implementation-internal stuff last.
+;;;
+;;; This matters tremendeously on Allegro in combination with
+;;; AllegroCache as that does some evil tinkering with initargs,
+;;; obfuscating the arglist of MAKE-INSTANCE.
+;;;
+
+(defmethod extra-keywords :around (op &rest args)
+ (declare (ignorable op args))
+ (multiple-value-bind (keywords aok enrichments) (call-next-method)
+ (values (sort-extra-keywords keywords) aok enrichments)))
+
+(defun make-package-comparator (reference-packages)
+ "Returns a two-argument test function which compares packages
+according to their used-by relation with REFERENCE-PACKAGES. Packages
+will be sorted first which appear first in the PACKAGE-USE-LIST of the
+reference packages."
+ (let ((package-use-table (make-hash-table :test 'eq)))
+ ;; Walk the package dependency graph breadth-fist, and fill
+ ;; PACKAGE-USE-TABLE accordingly.
+ (loop with queue = (copy-list reference-packages)
+ with bfn = 0 ; Breadth-First Number
+ for p = (pop queue)
+ unless (gethash p package-use-table)
+ do (setf (gethash p package-use-table) (shiftf bfn (1+ bfn)))
+ and do (setf queue (nconc queue (copy-list (package-use-list p))))
+ while queue)
+ #'(lambda (p1 p2)
+ (let ((bfn1 (gethash p1 package-use-table))
+ (bfn2 (gethash p2 package-use-table)))
+ (cond ((and bfn1 bfn2) (<= bfn1 bfn2))
+ (bfn1 bfn1)
+ (bfn2 nil) ; p2 is used, p1 not
+ (t (string<= (package-name p1) (package-name p2))))))))
+
+(defun sort-extra-keywords (kwds)
+ (stable-sort kwds (make-package-comparator (list keyword-package *package*))
+ :key (compose #'symbol-package #'keyword-arg.keyword)))
+
+(defun keywords-of-operator (operator)
+ "Return a list of KEYWORD-ARGs that OPERATOR accepts.
+This function is useful for writing EXTRA-KEYWORDS methods for
+user-defined functions which are declared &ALLOW-OTHER-KEYS and which
+forward keywords to OPERATOR."
+ (with-available-arglist (arglist) (arglist-from-form (ensure-list operator))
+ (values (arglist.keyword-args arglist)
+ (arglist.allow-other-keys-p arglist))))
+
+(defmethod extra-keywords (operator &rest args)
+ ;; default method
+ (declare (ignore args))
+ (let ((symbol-function (symbol-function operator)))
+ (if (typep symbol-function 'generic-function)
+ (generic-function-keywords symbol-function)
+ nil)))
+
+(defun class-from-class-name-form (class-name-form)
+ (when (and (listp class-name-form)
+ (= (length class-name-form) 2)
+ (eq (car class-name-form) 'quote))
+ (let* ((class-name (cadr class-name-form))
+ (class (find-class class-name nil)))
+ (when (and class
+ (not (swank-mop:class-finalized-p class)))
+ ;; Try to finalize the class, which can fail if
+ ;; superclasses are not defined yet
+ (ignore-errors (swank-mop:finalize-inheritance class)))
+ class)))
+
+(defun extra-keywords/slots (class)
+ (multiple-value-bind (slots allow-other-keys-p)
+ (if (swank-mop:class-finalized-p class)
+ (values (swank-mop:class-slots class) nil)
+ (values (swank-mop:class-direct-slots class) t))
+ (let ((slot-init-keywords
+ (loop for slot in slots append
+ (mapcar (lambda (initarg)
+ (make-keyword-arg
+ initarg
+ (swank-mop:slot-definition-name slot)
+ (and (swank-mop:slot-definition-initfunction slot)
+ (swank-mop:slot-definition-initform slot))))
+ (swank-mop:slot-definition-initargs slot)))))
+ (values slot-init-keywords allow-other-keys-p))))
+
+(defun extra-keywords/make-instance (operator &rest args)
+ (declare (ignore operator))
+ (unless (null args)
+ (let* ((class-name-form (car args))
+ (class (class-from-class-name-form class-name-form)))
+ (when class
+ (multiple-value-bind (slot-init-keywords class-aokp)
+ (extra-keywords/slots class)
+ (multiple-value-bind (allocate-instance-keywords ai-aokp)
+ (applicable-methods-keywords
+ #'allocate-instance (list class))
+ (multiple-value-bind (initialize-instance-keywords ii-aokp)
+ (ignore-errors
+ (applicable-methods-keywords
+ #'initialize-instance
+ (list (swank-mop:class-prototype class))))
+ (multiple-value-bind (shared-initialize-keywords si-aokp)
+ (ignore-errors
+ (applicable-methods-keywords
+ #'shared-initialize
+ (list (swank-mop:class-prototype class) t)))
+ (values (append slot-init-keywords
+ allocate-instance-keywords
+ initialize-instance-keywords
+ shared-initialize-keywords)
+ (or class-aokp ai-aokp ii-aokp si-aokp)
+ (list class-name-form))))))))))
+
+(defun extra-keywords/change-class (operator &rest args)
+ (declare (ignore operator))
+ (unless (null args)
+ (let* ((class-name-form (car args))
+ (class (class-from-class-name-form class-name-form)))
+ (when class
+ (multiple-value-bind (slot-init-keywords class-aokp)
+ (extra-keywords/slots class)
+ (declare (ignore class-aokp))
+ (multiple-value-bind (shared-initialize-keywords si-aokp)
+ (ignore-errors
+ (applicable-methods-keywords
+ #'shared-initialize
+ (list (swank-mop:class-prototype class) t)))
+ ;; FIXME: much as it would be nice to include the
+ ;; applicable keywords from
+ ;; UPDATE-INSTANCE-FOR-DIFFERENT-CLASS, I don't really see
+ ;; how to do it: so we punt, always declaring
+ ;; &ALLOW-OTHER-KEYS.
+ (declare (ignore si-aokp))
+ (values (append slot-init-keywords shared-initialize-keywords)
+ t
+ (list class-name-form))))))))
+
+(defmethod extra-keywords ((operator (eql 'make-instance))
+ &rest args)
+ (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+ (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'make-condition))
+ &rest args)
+ (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+ (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'error))
+ &rest args)
+ (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+ (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'signal))
+ &rest args)
+ (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+ (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'warn))
+ &rest args)
+ (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+ (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'cerror))
+ &rest args)
+ (multiple-value-bind (keywords aok determiners)
+ (apply #'extra-keywords/make-instance operator
+ (cdr args))
+ (if keywords
+ (values keywords aok
+ (cons (car args) determiners))
+ (call-next-method))))
+
+(defmethod extra-keywords ((operator (eql 'change-class))
+ &rest args)
+ (multiple-value-bind (keywords aok determiners)
+ (apply #'extra-keywords/change-class operator (cdr args))
+ (if keywords
+ (values keywords aok
+ (cons (car args) determiners))
+ (call-next-method))))
+
+(defun enrich-decoded-arglist-with-keywords (decoded-arglist keywords
+ allow-other-keys-p)
+ "Modify DECODED-ARGLIST using KEYWORDS and ALLOW-OTHER-KEYS-P."
+ (when keywords
+ (setf (arglist.key-p decoded-arglist) t)
+ (setf (arglist.keyword-args decoded-arglist)
+ (remove-duplicates
+ (append (arglist.keyword-args decoded-arglist)
+ keywords)
+ :key #'keyword-arg.keyword)))
+ (setf (arglist.allow-other-keys-p decoded-arglist)
+ (or (arglist.allow-other-keys-p decoded-arglist)
+ allow-other-keys-p)))
+
+(defun enrich-decoded-arglist-with-extra-keywords (decoded-arglist form)
+ "Determine extra keywords from the function call FORM, and modify
+DECODED-ARGLIST to include them. As a secondary return value, return
+the initial sublist of ARGS that was needed to determine the extra
+keywords. As a tertiary return value, return whether any enrichment
+was done."
+ (multiple-value-bind (extra-keywords extra-aok determining-args)
+ (apply #'extra-keywords form)
+ ;; enrich the list of keywords with the extra keywords
+ (enrich-decoded-arglist-with-keywords decoded-arglist
+ extra-keywords extra-aok)
+ (values decoded-arglist
+ determining-args
+ (or extra-keywords extra-aok))))
+
+(defgeneric compute-enriched-decoded-arglist (operator-form argument-forms)
+ (:documentation
+ "Return three values: DECODED-ARGLIST, DETERMINING-ARGS, and
+ANY-ENRICHMENT, just like enrich-decoded-arglist-with-extra-keywords.
+If the arglist is not available, return :NOT-AVAILABLE."))
+
+(defmethod compute-enriched-decoded-arglist (operator-form argument-forms)
+ (with-available-arglist (decoded-arglist)
+ (decode-arglist (arglist operator-form))
+ (enrich-decoded-arglist-with-extra-keywords decoded-arglist
+ (cons operator-form
+ argument-forms))))
+
+(defmethod compute-enriched-decoded-arglist
+ ((operator-form (eql 'with-open-file)) argument-forms)
+ (declare (ignore argument-forms))
+ (multiple-value-bind (decoded-arglist determining-args)
+ (call-next-method)
+ (let ((first-arg (first (arglist.required-args decoded-arglist)))
+ (open-arglist (compute-enriched-decoded-arglist 'open nil)))
+ (when (and (arglist-p first-arg) (arglist-p open-arglist))
+ (enrich-decoded-arglist-with-keywords
+ first-arg
+ (arglist.keyword-args open-arglist)
+ nil)))
+ (values decoded-arglist determining-args t)))
+
+(defmethod compute-enriched-decoded-arglist ((operator-form (eql 'apply))
+ argument-forms)
+ (let ((function-name-form (car argument-forms)))
+ (when (and (listp function-name-form)
+ (length= function-name-form 2)
+ (memq (car function-name-form) '(quote function)))
+ (let ((function-name (cadr function-name-form)))
+ (when (valid-operator-symbol-p function-name)
+ (let ((function-arglist
+ (compute-enriched-decoded-arglist function-name
+ (cdr argument-forms))))
+ (return-from compute-enriched-decoded-arglist
+ (values
+ (make-arglist :required-args
+ (list 'function)
+ :optional-args
+ (append
+ (mapcar #'(lambda (arg)
+ (make-optional-arg arg nil))
+ (arglist.required-args function-arglist))
+ (arglist.optional-args function-arglist))
+ :key-p
+ (arglist.key-p function-arglist)
+ :keyword-args
+ (arglist.keyword-args function-arglist)
+ :rest
+ 'args
+ :allow-other-keys-p
+ (arglist.allow-other-keys-p function-arglist))
+ (list function-name-form)
+ t)))))))
+ (call-next-method))
+
+(defmethod compute-enriched-decoded-arglist
+ ((operator-form (eql 'multiple-value-call)) argument-forms)
+ (compute-enriched-decoded-arglist 'apply argument-forms))
+
+(defun delete-given-args (decoded-arglist args)
+ "Delete given ARGS from DECODED-ARGLIST."
+ (macrolet ((pop-or-return (list)
+ `(if (null ,list)
+ (return-from do-decoded-arglist)
+ (pop ,list))))
+ (do-decoded-arglist decoded-arglist
+ (&provided ()
+ (assert (eq (pop-or-return args)
+ (pop (arglist.provided-args decoded-arglist)))))
+ (&required ()
+ (pop-or-return args)
+ (pop (arglist.required-args decoded-arglist)))
+ (&optional ()
+ (pop-or-return args)
+ (pop (arglist.optional-args decoded-arglist)))
+ (&key (keyword)
+ ;; N.b. we consider a keyword to be given only when the keyword
+ ;; _and_ a value has been given for it.
+ (loop for (key value) on args by #'cddr
+ when (and (eq keyword key) value)
+ do (setf (arglist.keyword-args decoded-arglist)
+ (remove keyword (arglist.keyword-args decoded-arglist)
+ :key #'keyword-arg.keyword))))))
+ decoded-arglist)
+
+(defun remove-given-args (decoded-arglist args)
+ ;; FIXME: We actually needa deep copy here.
+ (delete-given-args (copy-arglist decoded-arglist) args))
+
+;;;; Arglist Retrieval
+
+(defun arglist-from-form (form)
+ (if (null form)
+ :not-available
+ (arglist-dispatch (car form) (cdr form))))
+
+(export 'arglist-dispatch)
+(defgeneric arglist-dispatch (operator arguments)
+ ;; Default method
+ (:method (operator arguments)
+ (unless (and (symbolp operator) (valid-operator-symbol-p operator))
+ (return-from arglist-dispatch :not-available))
+
+ (multiple-value-bind (decoded-arglist determining-args)
+ (compute-enriched-decoded-arglist operator arguments)
+ (with-available-arglist (arglist) decoded-arglist
+ ;; replace some formal args by determining actual args
+ (setf arglist (delete-given-args arglist determining-args))
+ (setf (arglist.provided-args arglist) determining-args)
+ arglist))))
+
+(defmethod arglist-dispatch ((operator (eql 'defmethod)) arguments)
+ (match (cons operator arguments)
+ (('defmethod (#'function-exists-p gf-name) . rest)
+ (let ((gf (fdefinition gf-name)))
+ (when (typep gf 'generic-function)
+ (with-available-arglist (arglist) (decode-arglist (arglist gf))
+ (let ((qualifiers (loop for x in rest
+ until (or (listp x) (empty-arg-p x))
+ collect x)))
+ (return-from arglist-dispatch
+ (make-arglist :provided-args (cons gf-name qualifiers)
+ :required-args (list arglist)
+ :rest "body" :body-p t)))))))
+ (_)) ; Fall through
+ (call-next-method))
+
+(defmethod arglist-dispatch ((operator (eql 'define-compiler-macro)) arguments)
+ (match (cons operator arguments)
+ (('define-compiler-macro (#'function-exists-p gf-name) . _)
+ (let ((gf (fdefinition gf-name)))
+ (with-available-arglist (arglist) (decode-arglist (arglist gf))
+ (return-from arglist-dispatch
+ (make-arglist :provided-args (list gf-name)
+ :required-args (list arglist)
+ :rest "body" :body-p t)))))
+ (_)) ; Fall through
+ (call-next-method))
+
+
+(defmethod arglist-dispatch ((operator (eql 'eval-when)) arguments)
+ (declare (ignore arguments))
+ (let ((eval-when-args '(:compile-toplevel :load-toplevel :execute)))
+ (make-arglist
+ :required-args (list (make-arglist :any-p t :any-args eval-when-args))
+ :rest '#:body :body-p t)))
+
+
+(defmethod arglist-dispatch ((operator (eql 'declare)) arguments)
+ (let* ((declaration (cons operator (last arguments)))
+ (typedecl-arglist (arglist-for-type-declaration declaration)))
+ (if (arglist-available-p typedecl-arglist)
+ typedecl-arglist
+ (match declaration
+ (('declare ((#'consp typespec) . decl-args))
+ (with-available-arglist (typespec-arglist)
+ (decoded-arglist-for-type-specifier typespec)
+ (make-arglist
+ :required-args (list (make-arglist
+ :required-args (list typespec-arglist)
+ :rest '#:variables)))))
+ (('declare (decl-identifier . decl-args))
+ (decoded-arglist-for-declaration decl-identifier decl-args))
+ (_ (make-arglist :rest '#:declaration-specifiers))))))
+
+(defmethod arglist-dispatch ((operator (eql 'declaim)) arguments)
+ (arglist-dispatch 'declare arguments))
+
+
+(defun arglist-for-type-declaration (declaration)
+ (flet ((%arglist-for-type-declaration (identifier typespec rest-var-name)
+ (with-available-arglist (typespec-arglist)
+ (decoded-arglist-for-type-specifier typespec)
+ (make-arglist
+ :required-args (list (make-arglist
+ :provided-args (list identifier)
+ :required-args (list typespec-arglist)
+ :rest rest-var-name))))))
+ (match declaration
+ (('declare ('type (#'consp typespec) . decl-args))
+ (%arglist-for-type-declaration 'type typespec '#:variables))
+ (('declare ('ftype (#'consp typespec) . decl-args))
+ (%arglist-for-type-declaration 'ftype typespec '#:function-names))
+ (('declare ((#'consp typespec) . decl-args))
+ (with-available-arglist (typespec-arglist)
+ (decoded-arglist-for-type-specifier typespec)
+ (make-arglist
+ :required-args (list (make-arglist
+ :required-args (list typespec-arglist)
+ :rest '#:variables)))))
+ (_ :not-available))))
+
+(defun decoded-arglist-for-declaration (decl-identifier decl-args)
+ (declare (ignore decl-args))
+ (with-available-arglist (arglist)
+ (decode-arglist (declaration-arglist decl-identifier))
+ (setf (arglist.provided-args arglist) (list decl-identifier))
+ (make-arglist :required-args (list arglist))))
+
+(defun decoded-arglist-for-type-specifier (type-specifier)
+ (etypecase type-specifier
+ (arglist-dummy :not-available)
+ (cons (decoded-arglist-for-type-specifier (car type-specifier)))
+ (symbol
+ (with-available-arglist (arglist)
+ (decode-arglist (type-specifier-arglist type-specifier))
+ (setf (arglist.provided-args arglist) (list type-specifier))
+ arglist))))
+
+;;; Slimefuns
+
+;;; We work on a RAW-FORM, or BUFFER-FORM, which represent the form at
+;;; user's point in Emacs. A RAW-FORM looks like
+;;;
+;;; ("FOO" ("BAR" ...) "QUUX" ("ZURP" SWANK::%CURSOR-MARKER%))
+;;;
+;;; The expression before the cursor marker is the expression where
+;;; user's cursor points at. An explicit marker is necessary to
+;;; disambiguate between
+;;;
+;;; ("IF" ("PRED")
+;;; ("F" "X" "Y" %CURSOR-MARKER%))
+;;;
+;;; and
+;;; ("IF" ("PRED")
+;;; ("F" "X" "Y") %CURSOR-MARKER%)
+
+;;; Notice that for a form like (FOO (BAR |) QUUX), where | denotes
+;;; user's point, the following should be sent ("FOO" ("BAR" ""
+;;; %CURSOR-MARKER%)). Only the forms up to point should be
+;;; considered.
+
+(defslimefun autodoc (raw-form &key print-right-margin)
+ "Return a list of two elements.
+First, a string representing the arglist for the deepest subform in
+RAW-FORM that does have an arglist. The highlighted parameter is
+wrapped in ===> X <===.
+
+Second, a boolean value telling whether the returned string can be cached."
+ (handler-bind ((serious-condition
+ #'(lambda (c)
+ (unless (debug-on-swank-error)
+ (let ((*print-right-margin* print-right-margin))
+ (return-from autodoc
+ (format nil "Arglist Error: \"~A\"" c)))))))
+ (with-buffer-syntax ()
+ (multiple-value-bind (form arglist obj-at-cursor form-path)
+ (find-subform-with-arglist (parse-raw-form raw-form))
+ (cond ((boundp-and-interesting obj-at-cursor)
+ (list (print-variable-to-string obj-at-cursor) nil))
+ (t
+ (list
+ (with-available-arglist (arglist) arglist
+ (decoded-arglist-to-string
+ arglist
+ :print-right-margin print-right-margin
+ :operator (car form)
+ :highlight (form-path-to-arglist-path form-path
+ form
+ arglist)))
+ t)))))))
+
+(defun boundp-and-interesting (symbol)
+ (and symbol
+ (symbolp symbol)
+ (boundp symbol)
+ (not (memq symbol '(cl:t cl:nil)))
+ (not (keywordp symbol))))
+
+(defun print-variable-to-string (symbol)
+ "Return a short description of VARIABLE-NAME, or NIL."
+ (let ((*print-pretty* t) (*print-level* 4)
+ (*print-length* 10) (*print-lines* 1)
+ (*print-readably* nil)
+ (value (symbol-value symbol)))
+ (call/truncated-output-to-string
+ 75 (lambda (s)
+ (without-printing-errors (:object value :stream s)
+ (format s "~A ~A~S" symbol *echo-area-prefix* value))))))
+
+
+(defslimefun complete-form (raw-form)
+ "Read FORM-STRING in the current buffer package, then complete it
+ by adding a template for the missing arguments."
+ ;; We do not catch errors here because COMPLETE-FORM is an
+ ;; interactive command, not automatically run in the background like
+ ;; ARGLIST-FOR-ECHO-AREA.
+ (with-buffer-syntax ()
+ (multiple-value-bind (arglist provided-args)
+ (find-immediately-containing-arglist (parse-raw-form raw-form))
+ (with-available-arglist (arglist) arglist
+ (decoded-arglist-to-template-string
+ (delete-given-args arglist
+ (remove-if #'empty-arg-p provided-args
+ :from-end t :count 1))
+ :prefix "" :suffix "")))))
+
+(defslimefun completions-for-keyword (keyword-string raw-form)
+ "Return a list of possible completions for KEYWORD-STRING relative
+to the context provided by RAW-FORM."
+ (with-buffer-syntax ()
+ (let ((arglist (find-immediately-containing-arglist
+ (parse-raw-form raw-form))))
+ (when (arglist-available-p arglist)
+ ;; It would be possible to complete keywords only if we are in
+ ;; a keyword position, but it is not clear if we want that.
+ (let* ((keywords
+ (append (mapcar #'keyword-arg.keyword
+ (arglist.keyword-args arglist))
+ (remove-if-not #'keywordp (arglist.any-args arglist))))
+ (keyword-name
+ (tokenize-symbol keyword-string))
+ (matching-keywords
+ (find-matching-symbols-in-list
+ keyword-name keywords (make-compound-prefix-matcher #\-)))
+ (converter (completion-output-symbol-converter keyword-string))
+ (strings
+ (mapcar converter
+ (mapcar #'symbol-name matching-keywords)))
+ (completion-set
+ (format-completion-set strings nil "")))
+ (list completion-set
+ (longest-compound-prefix completion-set)))))))
+
+(defparameter +cursor-marker+ '%cursor-marker%)
+
+(defun find-subform-with-arglist (form)
+ "Returns four values:
+
+ The appropriate subform of `form' which is closest to the
+ +CURSOR-MARKER+ and whose operator is valid and has an
+ arglist. The +CURSOR-MARKER+ is removed from that subform.
+
+ Second value is the arglist. Local function and macro definitions
+ appearing in `form' into account.
+
+ Third value is the object in front of +CURSOR-MARKER+.
+
+ Fourth value is a form path to that object."
+ (labels
+ ((yield-success (form local-ops)
+ (multiple-value-bind (form obj-at-cursor form-path)
+ (extract-cursor-marker form)
+ (values form
+ (let ((entry (assoc (car form) local-ops :test #'op=)))
+ (if entry
+ (decode-arglist (cdr entry))
+ (arglist-from-form form)))
+ obj-at-cursor
+ form-path)))
+ (yield-failure ()
+ (values nil :not-available))
+ (operator-p (operator local-ops)
+ (or (and (symbolp operator) (valid-operator-symbol-p operator))
+ (assoc operator local-ops :test #'op=)))
+ (op= (op1 op2)
+ (cond ((and (symbolp op1) (symbolp op2))
+ (eq op1 op2))
+ ((and (arglist-dummy-p op1) (arglist-dummy-p op2))
+ (string= (arglist-dummy.string-representation op1)
+ (arglist-dummy.string-representation op2)))))
+ (grovel-form (form local-ops)
+ "Descend FORM top-down, always taking the rightest branch,
+ until +CURSOR-MARKER+."
+ (assert (listp form))
+ (destructuring-bind (operator . args) form
+ ;; N.b. the user's cursor is at the rightmost, deepest
+ ;; subform right before +CURSOR-MARKER+.
+ (let ((last-subform (car (last form)))
+ (new-ops))
+ (cond
+ ((eq last-subform +cursor-marker+)
+ (if (operator-p operator local-ops)
+ (yield-success form local-ops)
+ (yield-failure)))
+ ((not (operator-p operator local-ops))
+ (grovel-form last-subform local-ops))
+ ;; Make sure to pick up the arglists of local
+ ;; function/macro definitions.
+ ((setq new-ops (extract-local-op-arglists operator args))
+ (multiple-value-or (grovel-form last-subform
+ (nconc new-ops local-ops))
+ (yield-success form local-ops)))
+ ;; Some typespecs clash with function names, so we make
+ ;; sure to bail out early.
+ ((member operator '(cl:declare cl:declaim))
+ (yield-success form local-ops))
+ ;; Mostly uninteresting, hence skip.
+ ((memq operator '(cl:quote cl:function))
+ (yield-failure))
+ (t
+ (multiple-value-or (grovel-form last-subform local-ops)
+ (yield-success form local-ops))))))))
+ (if (null form)
+ (yield-failure)
+ (grovel-form form '()))))
+
+(defun extract-cursor-marker (form)
+ "Returns three values: normalized `form' without +CURSOR-MARKER+,
+the object in front of +CURSOR-MARKER+, and a form path to that
+object."
+ (labels ((grovel (form last path)
+ (let ((result-form))
+ (loop for (car . cdr) on form do
+ (cond ((eql car +cursor-marker+)
+ (decf (first path))
+ (return-from grovel
+ (values (nreconc result-form cdr)
+ last
+ (nreverse path))))
+ ((consp car)
+ (multiple-value-bind (new-car new-last new-path)
+ (grovel car last (cons 0 path))
+ (when new-path ; CAR contained cursor-marker?
+ (return-from grovel
+ (values (nreconc
+ (cons new-car result-form) cdr)
+ new-last
+ new-path))))))
+ (push car result-form)
+ (setq last car)
+ (incf (first path))
+ finally
+ (return-from grovel
+ (values (nreverse result-form) nil nil))))))
+ (grovel form nil (list 0))))
+
+(defgeneric extract-local-op-arglists (operator args)
+ (:documentation
+ "If the form `(OPERATOR ,@ARGS) is a local operator binding form,
+ return a list of pairs (OP . ARGLIST) for each locally bound op.")
+ (:method (operator args)
+ (declare (ignore operator args))
+ nil)
+ ;; FLET
+ (:method ((operator (eql 'cl:flet)) args)
+ (let ((defs (first args))
+ (body (rest args)))
+ (cond ((null body) nil) ; `(flet ((foo (x) |'
+ ((atom defs) nil) ; `(flet ,foo (|'
+ (t (%collect-op/argl-alist defs)))))
+ ;; LABELS
+ (:method ((operator (eql 'cl:labels)) args)
+ ;; Notice that we only have information to "look backward" and
+ ;; show arglists of previously occuring local functions.
+ (destructuring-bind (defs . body) args
+ (unless (or (atom defs) (null body)) ; `(labels ,foo (|'
+ (let ((current-def (car (last defs))))
+ (cond ((atom current-def) nil) ; `(labels ((foo (x) ...)|'
+ ((not (null body))
+ (extract-local-op-arglists 'cl:flet args))
+ (t
+ (let ((def.body (cddr current-def)))
+ (when def.body
+ (%collect-op/argl-alist defs)))))))))
+ ;; MACROLET
+ (:method ((operator (eql 'cl:macrolet)) args)
+ (extract-local-op-arglists 'cl:labels args)))
+
+(defun %collect-op/argl-alist (defs)
+ (setq defs (remove-if-not #'(lambda (x)
+ ;; Well-formed FLET/LABELS def?
+ (and (consp x) (second x)))
+ defs))
+ (loop for (name arglist . nil) in defs
+ collect (cons name arglist)))
+
+(defun find-immediately-containing-arglist (form)
+ "Returns the arglist of the subform _immediately_ containing
++CURSOR-MARKER+ in `form'. Notice, however, that +CURSOR-MARKER+ may
+be in a nested arglist \(e.g. `(WITH-OPEN-FILE (<here>'\), and the
+arglist of the appropriate parent form \(WITH-OPEN-FILE\) will be
+returned in that case."
+ (flet ((try (form-path form arglist)
+ (let* ((arglist-path (form-path-to-arglist-path form-path
+ form
+ arglist))
+ (argl (apply #'arglist-ref
+ arglist
+ arglist-path))
+ (args (apply #'provided-arguments-ref
+ (cdr form)
+ arglist
+ arglist-path)))
+ (when (and (arglist-p argl) (listp args))
+ (values argl args)))))
+ (multiple-value-bind (form arglist obj form-path)
+ (find-subform-with-arglist form)
+ (declare (ignore obj))
+ (with-available-arglist (arglist) arglist
+ ;; First try the form the cursor is in (in case of a normal
+ ;; form), then try the surrounding form (in case of a nested
+ ;; macro form).
+ (multiple-value-or (try form-path form arglist)
+ (try (butlast form-path) form arglist)
+ :not-available)))))
+
+(defun form-path-to-arglist-path (form-path form arglist)
+ "Convert a form path to an arglist path consisting of arglist
+indices."
+ (labels ((convert (path args arglist)
+ (if (null path)
+ nil
+ (let* ((idx (car path))
+ (idx* (arglist-index idx args arglist))
+ (arglist* (and idx* (arglist-ref arglist idx*)))
+ (args* (and idx* (provided-arguments-ref args
+ arglist
+ idx*))))
+ ;; The FORM-PATH may be more detailed than ARGLIST;
+ ;; consider (defun foo (x y) ...), a form path may
+ ;; point into the function's lambda-list, but the
+ ;; arglist of DEFUN won't contain as much information.
+ ;; So we only recurse if possible.
+ (cond ((null idx*)
+ nil)
+ ((arglist-p arglist*)
+ (cons idx* (convert (cdr path) args* arglist*)))
+ (t
+ (list idx*)))))))
+ (convert
+ ;; FORM contains irrelevant operator. Adjust FORM-PATH.
+ (cond ((null form-path) nil)
+ ((equal form-path '(0)) nil)
+ (t
+ (destructuring-bind (car . cdr) form-path
+ (cons (1- car) cdr))))
+ (cdr form)
+ arglist)))
+
+(defun arglist-index (provided-argument-index provided-arguments arglist)
+ "Return the arglist index into `arglist' for the parameter belonging
+to the argument (NTH `provided-argument-index' `provided-arguments')."
+ (let ((positional-args# (positional-args-number arglist))
+ (arg-index provided-argument-index))
+ (with-struct (arglist. key-p rest) arglist
+ (cond
+ ((< arg-index positional-args#) ; required + optional
+ arg-index)
+ ((and (not key-p) (not rest)) ; more provided than allowed
+ nil)
+ ((not key-p) ; rest + body
+ (assert (arglist.rest arglist))
+ positional-args#)
+ (t ; key
+ ;; Find last provided &key parameter
+ (let* ((argument (nth arg-index provided-arguments))
+ (provided-keys (subseq provided-arguments positional-args#)))
+ (loop for (key value) on provided-keys by #'cddr
+ when (eq value argument)
+ return (match key
+ (('quote symbol) symbol)
+ (_ key)))))))))
+
+(defun arglist-ref (arglist &rest indices)
+ "Returns the parameter in ARGLIST along the INDICIES path. Numbers
+represent positional parameters (required, optional), keywords
+represent key parameters."
+ (flet ((ref-positional-arg (arglist index)
+ (check-type index (integer 0 *))
+ (with-struct (arglist. provided-args required-args
+ optional-args rest)
+ arglist
+ (loop for args in (list provided-args required-args
+ (mapcar #'optional-arg.arg-name
+ optional-args))
+ for args# = (length args)
+ if (< index args#)
+ return (nth index args)
+ else
+ do (decf index args#)
+ finally (return (or rest nil)))))
+ (ref-keyword-arg (arglist keyword)
+ ;; keyword argument may be any symbol,
+ ;; not only from the KEYWORD package.
+ (let ((keyword (match keyword
+ (('quote symbol) symbol)
+ (_ keyword))))
+ (do-decoded-arglist arglist
+ (&key (kw arg) (when (eq kw keyword)
+ (return-from ref-keyword-arg arg)))))
+ nil))
+ (dolist (index indices)
+ (assert (arglist-p arglist))
+ (setq arglist (if (numberp index)
+ (ref-positional-arg arglist index)
+ (ref-keyword-arg arglist index))))
+ arglist))
+
+(defun provided-arguments-ref (provided-args arglist &rest indices)
+ "Returns the argument in PROVIDED-ARGUMENT along the INDICES path
+relative to ARGLIST."
+ (check-type arglist arglist)
+ (flet ((ref (provided-args arglist index)
+ (if (numberp index)
+ (nth index provided-args)
+ (let ((provided-keys (subseq provided-args
+ (positional-args-number arglist))))
+ (loop for (key value) on provided-keys
+ when (eq key index)
+ return value)))))
+ (dolist (idx indices)
+ (setq provided-args (ref provided-args arglist idx))
+ (setq arglist (arglist-ref arglist idx)))
+ provided-args))
+
+(defun positional-args-number (arglist)
+ (+ (length (arglist.provided-args arglist))
+ (length (arglist.required-args arglist))
+ (length (arglist.optional-args arglist))))
+
+(defun parse-raw-form (raw-form)
+ "Parse a RAW-FORM into a Lisp form. I.e. substitute strings by
+symbols if already interned. For strings not already interned, use
+ARGLIST-DUMMY."
+ (unless (null raw-form)
+ (loop for element in raw-form
+ collect (etypecase element
+ (string (read-conversatively element))
+ (list (parse-raw-form element))
+ (symbol (prog1 element
+ ;; Comes after list, so ELEMENT can't be NIL.
+ (assert (eq element +cursor-marker+))))))))
+
+(defun read-conversatively (string)
+ "Tries to find the symbol that's represented by STRING.
+
+If it can't, this either means that STRING does not represent a
+symbol, or that the symbol behind STRING would have to be freshly
+interned. Because this function is supposed to be called from the
+automatic arglist display stuff from Slime, interning freshly
+symbols is a big no-no.
+
+In such a case (that no symbol could be found), an object of type
+ARGLIST-DUMMY is returned instead, which works as a placeholder
+datum for subsequent logics to rely on."
+ (let* ((string (string-left-trim '(#\Space #\Tab #\Newline) string))
+ (length (length string))
+ (type (cond ((zerop length) nil)
+ ((eql (aref string 0) #\')
+ :quoted-symbol)
+ ((search "#'" string :end2 (min length 2))
+ :sharpquoted-symbol)
+ ((char= (char string 0) (char string (1- length))
+ #\")
+ :string)
+ (t
+ :symbol))))
+ (multiple-value-bind (symbol found?)
+ (case type
+ (:symbol (parse-symbol string))
+ (:quoted-symbol (parse-symbol (subseq string 1)))
+ (:sharpquoted-symbol (parse-symbol (subseq string 2)))
+ (:string (values string t))
+ (t (values string nil)))
+ (if found?
+ (ecase type
+ (:symbol symbol)
+ (:quoted-symbol `(quote ,symbol))
+ (:sharpquoted-symbol `(function ,symbol))
+ (:string (if (> length 1)
+ (subseq string 1 (1- length))
+ string)))
+ (make-arglist-dummy string)))))
+
+(defun test-print-arglist ()
+ (flet ((test (arglist &rest strings)
+ (let* ((*package* (find-package :swank))
+ (actual (decoded-arglist-to-string
+ (decode-arglist arglist)
+ :print-right-margin 1000)))
+ (unless (loop for string in strings
+ thereis (string= actual string))
+ (warn "Test failed: ~S => ~S~% Expected: ~A"
+ arglist actual
+ (if (cdr strings)
+ (format nil "One of: ~{~S~^, ~}" strings)
+ (format nil "~S" (first strings))))))))
+ (test '(function cons) "(function cons)")
+ (test '(quote cons) "(quote cons)")
+ (test '(&key (function #'+))
+ "(&key (function #'+))" "(&key (function (function +)))")
+ (test '(&whole x y z) "(y z)")
+ (test '(x &aux y z) "(x)")
+ (test '(x &environment env y) "(x y)")
+ (test '(&key ((function f))) "(&key ((function ..)))")
+ (test
+ '(eval-when (&any :compile-toplevel :load-toplevel :execute) &body body)
+ "(eval-when (&any :compile-toplevel :load-toplevel :execute) &body body)")
+ (test '(declare (optimize &any (speed 1) (safety 1)))
+ "(declare (optimize &any (speed 1) (safety 1)))")))
+
+(defun test-arglist-ref ()
+ (macrolet ((soft-assert (form)
+ `(unless ,form
+ (warn "Assertion failed: ~S~%" ',form))))
+ (let ((sample (decode-arglist '(x &key ((:k (y z)))))))
+ (soft-assert (eq (arglist-ref sample 0) 'x))
+ (soft-assert (eq (arglist-ref sample :k 0) 'y))
+ (soft-assert (eq (arglist-ref sample :k 1) 'z))
+
+ (soft-assert (eq (provided-arguments-ref '(a :k (b c)) sample 0)
+ 'a))
+ (soft-assert (eq (provided-arguments-ref '(a :k (b c)) sample :k 0)
+ 'b))
+ (soft-assert (eq (provided-arguments-ref '(a :k (b c)) sample :k 1)
+ 'c)))))
+
+(test-print-arglist)
+(test-arglist-ref)
+
+(provide :swank-arglists)
diff --git a/vim/bundle/slimv/slime/contrib/swank-asdf.lisp b/vim/bundle/slimv/slime/contrib/swank-asdf.lisp
new file mode 100644
index 0000000..2bcedd0
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-asdf.lisp
@@ -0,0 +1,536 @@
+;;; swank-asdf.lisp -- ASDF support
+;;
+;; Authors: Daniel Barlow <dan@telent.net>
+;; Marco Baringer <mb@bese.it>
+;; Edi Weitz <edi@agharta.de>
+;; Francois-Rene Rideau <tunes@google.com>
+;; and others
+;; License: Public Domain
+;;
+
+(in-package :swank)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+;;; The best way to load ASDF is from an init file of an
+;;; implementation. If ASDF is not loaded at the time swank-asdf is
+;;; loaded, it will be tried first with (require "asdf"), if that
+;;; doesn't help and *asdf-path* is set, it will be loaded from that
+;;; file.
+;;; To set *asdf-path* put the following into ~/.swank.lisp:
+;;; (defparameter swank::*asdf-path* #p"/path/to/asdf/asdf.lisp")
+ (defvar *asdf-path* nil
+ "Path to asdf.lisp file, to be loaded in case (require \"asdf\") fails."))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (unless (member :asdf *features*)
+ (ignore-errors (funcall 'require "asdf"))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (unless (member :asdf *features*)
+ (handler-bind ((warning #'muffle-warning))
+ (when *asdf-path*
+ (load *asdf-path* :if-does-not-exist nil)))))
+
+;; If still not found, error out.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (unless (member :asdf *features*)
+ (error "Could not load ASDF.
+Please update your implementation or
+install a recent release of ASDF and in your ~~/.swank.lisp specify:
+ (defparameter swank::*asdf-path* #p\"/path/containing/asdf/asdf.lisp\")")))
+
+;;; If ASDF is too old, punt.
+;; As of January 2014, Quicklisp has been providing 2.26 for a year
+;; (and previously had 2.014.6 for over a year), whereas
+;; all SLIME-supported implementations provide ASDF3 (i.e. 2.27 or later)
+;; except LispWorks (stuck with 2.019) and SCL (which hasn't been released
+;; in years and doesn't provide ASDF at all, but is fully supported by ASDF).
+;; If your implementation doesn't provide ASDF, or provides an old one,
+;; install an upgrade yourself and configure *asdf-path*.
+;; It's just not worth the hassle supporting something
+;; that doesn't even have COERCE-PATHNAME.
+;;
+;; NB: this version check is duplicated in swank-loader.lisp so that we don't
+;; try to load this contrib when ASDF is too old since that will abort the SLIME
+;; connection.
+#-asdf3
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (unless (or #+asdf3 t #+asdf2
+ (asdf:version-satisfies (asdf:asdf-version) "2.14.6"))
+ (error "Your ASDF is too old. ~
+ The oldest version supported by swank-asdf is 2.014.6.")))
+;;; Import functionality from ASDF that isn't available in all ASDF versions.
+;;; Please do NOT depend on any of the below as reference:
+;;; they are sometimes stripped down versions, for compatibility only.
+;;; Indeed, they are supposed to work on *OLDER*, not *NEWER* versions of ASDF.
+;;;
+;;; The way I got these is usually by looking at the current definition,
+;;; using git blame in one screen to locate which commit last modified it,
+;;; and git log in another to determine which release that made it in.
+;;; It is OK for some of the below definitions to be or become obsolete,
+;;; as long as it will make do with versions older than the tagged version:
+;;; if ASDF is more recent, its more recent version will win.
+;;;
+;;; If your software is hacking ASDF, use its internals.
+;;; If you want ASDF utilities in user software, please use ASDF-UTILS.
+
+(defun asdf-at-least (version)
+ (asdf:version-satisfies (asdf:asdf-version) version))
+
+(defmacro asdefs (version &rest defs)
+ (flet ((defun* (version name aname rest)
+ `(progn
+ (defun ,name ,@rest)
+ (declaim (notinline ,name))
+ (when (asdf-at-least ,version)
+ (setf (fdefinition ',name) (fdefinition ',aname)))))
+ (defmethod* (version aname rest)
+ `(unless (asdf-at-least ,version)
+ (defmethod ,aname ,@rest)))
+ (defvar* (name aname rest)
+ `(progn
+ (define-symbol-macro ,name ,aname)
+ (defvar ,aname ,@rest))))
+ `(progn
+ ,@(loop :for (def name . args) :in defs
+ :for aname = (intern (string name) :asdf)
+ :collect
+ (ecase def
+ ((defun) (defun* version name aname args))
+ ((defmethod) (defmethod* version aname args))
+ ((defvar) (defvar* name aname args)))))))
+
+(asdefs "2.15"
+ (defvar *wild* #-cormanlisp :wild #+cormanlisp "*")
+
+ (defun collect-asds-in-directory (directory collect)
+ (map () collect (directory-asd-files directory)))
+
+ (defun register-asd-directory (directory &key recurse exclude collect)
+ (if (not recurse)
+ (collect-asds-in-directory directory collect)
+ (collect-sub*directories-asd-files
+ directory :exclude exclude :collect collect))))
+
+(asdefs "2.16"
+ (defun load-sysdef (name pathname)
+ (declare (ignore name))
+ (let ((package (asdf::make-temporary-package)))
+ (unwind-protect
+ (let ((*package* package)
+ (*default-pathname-defaults*
+ (asdf::pathname-directory-pathname
+ (translate-logical-pathname pathname))))
+ (asdf::asdf-message
+ "~&; Loading system definition from ~A into ~A~%" ;
+ pathname package)
+ (load pathname))
+ (delete-package package))))
+
+ (defun directory* (pathname-spec &rest keys &key &allow-other-keys)
+ (apply 'directory pathname-spec
+ (append keys
+ '#.(or #+allegro
+ '(:directories-are-files nil
+ :follow-symbolic-links nil)
+ #+clozure
+ '(:follow-links nil)
+ #+clisp
+ '(:circle t :if-does-not-exist :ignore)
+ #+(or cmu scl)
+ '(:follow-links nil :truenamep nil)
+ #+sbcl
+ (when (find-symbol "RESOLVE-SYMLINKS" '#:sb-impl)
+ '(:resolve-symlinks nil)))))))
+(asdefs "2.17"
+ (defun collect-sub*directories-asd-files
+ (directory &key
+ (exclude asdf::*default-source-registry-exclusions*)
+ collect)
+ (asdf::collect-sub*directories
+ directory
+ (constantly t)
+ (lambda (x) (not (member (car (last (pathname-directory x)))
+ exclude :test #'equal)))
+ (lambda (dir) (collect-asds-in-directory dir collect))))
+
+ (defun system-source-directory (system-designator)
+ (asdf::pathname-directory-pathname
+ (asdf::system-source-file system-designator)))
+
+ (defun filter-logical-directory-results (directory entries merger)
+ (if (typep directory 'logical-pathname)
+ (loop for f in entries
+ when
+ (if (typep f 'logical-pathname)
+ f
+ (let ((u (ignore-errors (funcall merger f))))
+ (and u
+ (equal (ignore-errors (truename u))
+ (truename f))
+ u)))
+ collect it)
+ entries))
+
+ (defun directory-asd-files (directory)
+ (directory-files directory asdf::*wild-asd*)))
+
+(asdefs "2.19"
+ (defun subdirectories (directory)
+ (let* ((directory (asdf::ensure-directory-pathname directory))
+ #-(or abcl cormanlisp xcl)
+ (wild (asdf::merge-pathnames*
+ #-(or abcl allegro cmu lispworks sbcl scl xcl)
+ asdf::*wild-directory*
+ #+(or abcl allegro cmu lispworks sbcl scl xcl) "*.*"
+ directory))
+ (dirs
+ #-(or abcl cormanlisp xcl)
+ (ignore-errors
+ (directory* wild . #.(or #+clozure '(:directories t :files nil)
+ #+mcl '(:directories t))))
+ #+(or abcl xcl) (system:list-directory directory)
+ #+cormanlisp (cl::directory-subdirs directory))
+ #+(or abcl allegro cmu lispworks sbcl scl xcl)
+ (dirs (loop for x in dirs
+ for d = #+(or abcl xcl) (extensions:probe-directory x)
+ #+allegro (excl:probe-directory x)
+ #+(or cmu sbcl scl) (asdf::directory-pathname-p x)
+ #+lispworks (lw:file-directory-p x)
+ when d collect #+(or abcl allegro xcl) d
+ #+(or cmu lispworks sbcl scl) x)))
+ (filter-logical-directory-results
+ directory dirs
+ (let ((prefix (or (normalize-pathname-directory-component
+ (pathname-directory directory))
+ ;; because allegro 8.x returns NIL for #p"FOO:"
+ '(:absolute))))
+ (lambda (d)
+ (let ((dir (normalize-pathname-directory-component
+ (pathname-directory d))))
+ (and (consp dir) (consp (cdr dir))
+ (make-pathname
+ :defaults directory :name nil :type nil :version nil
+ :directory
+ (append prefix
+ (make-pathname-component-logical
+ (last dir))))))))))))
+
+(asdefs "2.21"
+ (defun component-loaded-p (c)
+ (and (gethash 'load-op (asdf::component-operation-times
+ (asdf::find-component c nil))) t))
+
+ (defun normalize-pathname-directory-component (directory)
+ (cond
+ #-(or cmu sbcl scl)
+ ((stringp directory) `(:absolute ,directory) directory)
+ ((or (null directory)
+ (and (consp directory)
+ (member (first directory) '(:absolute :relative))))
+ directory)
+ (t
+ (error "Unrecognized pathname directory component ~S" directory))))
+
+ (defun make-pathname-component-logical (x)
+ (typecase x
+ ((eql :unspecific) nil)
+ #+clisp (string (string-upcase x))
+ #+clisp (cons (mapcar 'make-pathname-component-logical x))
+ (t x)))
+
+ (defun make-pathname-logical (pathname host)
+ (make-pathname
+ :host host
+ :directory (make-pathname-component-logical (pathname-directory pathname))
+ :name (make-pathname-component-logical (pathname-name pathname))
+ :type (make-pathname-component-logical (pathname-type pathname))
+ :version (make-pathname-component-logical (pathname-version pathname)))))
+
+(asdefs "2.22"
+ (defun directory-files (directory &optional (pattern asdf::*wild-file*))
+ (let ((dir (pathname directory)))
+ (when (typep dir 'logical-pathname)
+ (when (wild-pathname-p dir)
+ (error "Invalid wild pattern in logical directory ~S" directory))
+ (unless (member (pathname-directory pattern)
+ '(() (:relative)) :test 'equal)
+ (error "Invalid file pattern ~S for logical directory ~S"
+ pattern directory))
+ (setf pattern (make-pathname-logical pattern (pathname-host dir))))
+ (let ((entries (ignore-errors
+ (directory* (asdf::merge-pathnames* pattern dir)))))
+ (filter-logical-directory-results
+ directory entries
+ (lambda (f)
+ (make-pathname :defaults dir
+ :name (make-pathname-component-logical
+ (pathname-name f))
+ :type (make-pathname-component-logical
+ (pathname-type f))
+ :version (make-pathname-component-logical
+ (pathname-version f)))))))))
+
+(asdefs "2.26.149"
+ (defmethod component-relative-pathname ((system asdf:system))
+ (asdf::coerce-pathname
+ (and (slot-boundp system 'asdf::relative-pathname)
+ (slot-value system 'asdf::relative-pathname))
+ :type :directory
+ :defaults (system-source-directory system)))
+ (defun load-asd (pathname &key name &allow-other-keys)
+ (asdf::load-sysdef (or name (string-downcase (pathname-name pathname)))
+ pathname)))
+
+
+;;; Taken from ASDF 1.628
+(defmacro while-collecting ((&rest collectors) &body body)
+ `(asdf::while-collecting ,collectors ,@body))
+
+;;; Now for SLIME-specific stuff
+
+(defun asdf-operation (operation)
+ (or (asdf::find-symbol* operation :asdf)
+ (error "Couldn't find ASDF operation ~S" operation)))
+
+(defun map-system-components (fn system)
+ (map-component-subcomponents fn (asdf:find-system system)))
+
+(defun map-component-subcomponents (fn component)
+ (when component
+ (funcall fn component)
+ (when (typep component 'asdf:module)
+ (dolist (c (asdf:module-components component))
+ (map-component-subcomponents fn c)))))
+
+;;; Maintaining a pathname to component table
+
+(defvar *pathname-component* (make-hash-table :test 'equal))
+
+(defun clear-pathname-component-table ()
+ (clrhash *pathname-component*))
+
+(defun register-system-pathnames (system)
+ (map-system-components 'register-component-pathname system))
+
+(defun recompute-pathname-component-table ()
+ (clear-pathname-component-table)
+ (asdf::map-systems 'register-system-pathnames))
+
+(defun pathname-component (x)
+ (gethash (pathname x) *pathname-component*))
+
+(defmethod asdf:component-pathname :around ((component asdf:component))
+ (let ((p (call-next-method)))
+ (when (pathnamep p)
+ (setf (gethash p *pathname-component*) component))
+ p))
+
+(defun register-component-pathname (component)
+ (asdf:component-pathname component))
+
+(recompute-pathname-component-table)
+
+;;; This is a crude hack, see ASDF's LP #481187.
+(defslimefun who-depends-on (system)
+ (flet ((system-dependencies (op system)
+ (mapcar (lambda (dep)
+ (asdf::coerce-name (if (consp dep) (second dep) dep)))
+ (cdr (assoc op (asdf:component-depends-on op system))))))
+ (let ((system-name (asdf::coerce-name system))
+ (result))
+ (asdf::map-systems
+ (lambda (system)
+ (when (member system-name
+ (system-dependencies 'asdf:load-op system)
+ :test #'string=)
+ (push (asdf:component-name system) result))))
+ result)))
+
+(defmethod xref-doit ((type (eql :depends-on)) thing)
+ (when (typep thing '(or string symbol))
+ (loop for dependency in (who-depends-on thing)
+ for asd-file = (asdf:system-definition-pathname dependency)
+ when asd-file
+ collect (list dependency
+ (swank/backend:make-location
+ `(:file ,(namestring asd-file))
+ `(:position 1)
+ `(:snippet ,(format nil "(defsystem :~A" dependency)
+ :align t))))))
+
+(defslimefun operate-on-system-for-emacs (system-name operation &rest keywords)
+ "Compile and load SYSTEM using ASDF.
+Record compiler notes signalled as `compiler-condition's."
+ (collect-notes
+ (lambda ()
+ (apply #'operate-on-system system-name operation keywords))))
+
+(defun operate-on-system (system-name operation-name &rest keyword-args)
+ "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.
+The KEYWORD-ARGS are passed on to the operation.
+Example:
+\(operate-on-system \"cl-ppcre\" 'compile-op :force t)"
+ (handler-case
+ (with-compilation-hooks ()
+ (apply #'asdf:operate (asdf-operation operation-name)
+ system-name keyword-args)
+ t)
+ ((or asdf:compile-error #+asdf3 asdf/lisp-build:compile-file-error)
+ () nil)))
+
+(defun unique-string-list (&rest lists)
+ (sort (delete-duplicates (apply #'append lists) :test #'string=) #'string<))
+
+(defslimefun list-all-systems-in-central-registry ()
+ "Returns a list of all systems in ASDF's central registry
+AND in its source-registry. (legacy name)"
+ (unique-string-list
+ (mapcar
+ #'pathname-name
+ (while-collecting (c)
+ (loop for dir in asdf:*central-registry*
+ for defaults = (eval dir)
+ when defaults
+ do (collect-asds-in-directory defaults #'c))
+ (asdf:ensure-source-registry)
+ (if (or #+asdf3 t
+ #-asdf3 (asdf:version-satisfies (asdf:asdf-version) "2.15"))
+ (loop :for k :being :the :hash-keys :of asdf::*source-registry*
+ :do (c k))
+ #-asdf3
+ (dolist (entry (asdf::flatten-source-registry))
+ (destructuring-bind (directory &key recurse exclude) entry
+ (register-asd-directory
+ directory
+ :recurse recurse :exclude exclude :collect #'c))))))))
+
+(defslimefun list-all-systems-known-to-asdf ()
+ "Returns a list of all systems ASDF knows already."
+ (while-collecting (c)
+ (asdf::map-systems (lambda (system) (c (asdf:component-name system))))))
+
+(defslimefun list-asdf-systems ()
+ "Returns the systems in ASDF's central registry and those which ASDF
+already knows."
+ (unique-string-list
+ (list-all-systems-known-to-asdf)
+ (list-all-systems-in-central-registry)))
+
+(defun asdf-component-source-files (component)
+ (while-collecting (c)
+ (labels ((f (x)
+ (typecase x
+ (asdf:source-file (c (asdf:component-pathname x)))
+ (asdf:module (map () #'f (asdf:module-components x))))))
+ (f component))))
+
+(defun asdf-component-output-files (component)
+ (while-collecting (c)
+ (labels ((f (x)
+ (typecase x
+ (asdf:source-file
+ (map () #'c
+ (asdf:output-files (make-instance 'asdf:compile-op) x)))
+ (asdf:module (map () #'f (asdf:module-components x))))))
+ (f component))))
+
+(defslimefun asdf-system-files (name)
+ (let* ((system (asdf:find-system name))
+ (files (mapcar #'namestring
+ (cons
+ (asdf:system-definition-pathname system)
+ (asdf-component-source-files system))))
+ (main-file (find name files
+ :test #'equalp :key #'pathname-name :start 1)))
+ (if main-file
+ (cons main-file (remove main-file files
+ :test #'equal :count 1))
+ files)))
+
+(defslimefun asdf-system-loaded-p (name)
+ (component-loaded-p name))
+
+(defslimefun asdf-system-directory (name)
+ (namestring (asdf:system-source-directory name)))
+
+(defun pathname-system (pathname)
+ (let ((component (pathname-component pathname)))
+ (when component
+ (asdf:component-name (asdf:component-system component)))))
+
+(defslimefun asdf-determine-system (file buffer-package-name)
+ (or
+ (and file
+ (pathname-system file))
+ (and file
+ (progn
+ ;; If not found, let's rebuild the table first
+ (recompute-pathname-component-table)
+ (pathname-system file)))
+ ;; If we couldn't find an already defined system,
+ ;; try finding a system that's named like BUFFER-PACKAGE-NAME.
+ (loop with package = (guess-buffer-package buffer-package-name)
+ for name in (package-names package)
+ for system = (asdf:find-system (asdf::coerce-name name) nil)
+ when (and system
+ (or (not file)
+ (pathname-system file)))
+ return (asdf:component-name system))))
+
+(defslimefun delete-system-fasls (name)
+ (let ((removed-count
+ (loop for file in (asdf-component-output-files
+ (asdf:find-system name))
+ when (probe-file file)
+ count it
+ and
+ do (delete-file file))))
+ (format nil "~d file~:p ~:*~[were~;was~:;were~] removed" removed-count)))
+
+(defvar *recompile-system* nil)
+
+(defmethod asdf:operation-done-p :around
+ ((operation asdf:compile-op)
+ component)
+ (unless (eql *recompile-system*
+ (asdf:component-system component))
+ (call-next-method)))
+
+(defslimefun reload-system (name)
+ (let ((*recompile-system* (asdf:find-system name)))
+ (operate-on-system-for-emacs name 'asdf:load-op)))
+
+;; Doing list-all-systems-in-central-registry might be quite slow
+;; since it accesses a file-system, so run it once at the background
+;; to initialize caches.
+(when (eql *communication-style* :spawn)
+ (spawn (lambda ()
+ (ignore-errors (list-all-systems-in-central-registry)))
+ :name "init-asdf-fs-caches"))
+
+;;; Hook for compile-file-for-emacs
+
+(defun try-compile-file-with-asdf (pathname load-p &rest options)
+ (declare (ignore options))
+ (let ((component (pathname-component pathname)))
+ (when component
+ ;;(format t "~&Compiling ASDF component ~S~%" component)
+ (let ((op (make-instance 'asdf:compile-op)))
+ (with-compilation-hooks ()
+ (asdf:perform op component))
+ (when load-p
+ (asdf:perform (make-instance 'asdf:load-op) component))
+ (values t t nil (first (asdf:output-files op component)))))))
+
+(defun try-compile-asd-file (pathname load-p &rest options)
+ (declare (ignore load-p options))
+ (when (equalp (pathname-type pathname) "asd")
+ (load-asd pathname)
+ (values t t nil pathname)))
+
+(pushnew 'try-compile-asd-file *compile-file-for-emacs-hook*)
+
+;;; (pushnew 'try-compile-file-with-asdf *compile-file-for-emacs-hook*)
+
+(provide :swank-asdf)
diff --git a/vim/bundle/slimv/slime/contrib/swank-c-p-c.lisp b/vim/bundle/slimv/slime/contrib/swank-c-p-c.lisp
new file mode 100644
index 0000000..6a766fb
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-c-p-c.lisp
@@ -0,0 +1,298 @@
+;;; swank-c-p-c.lisp -- ILISP style Compound Prefix Completion
+;;
+;; Author: Luke Gorrie <luke@synap.se>
+;; Edi Weitz <edi@agharta.de>
+;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>
+;; Tobias C. Rittweiler <tcr@freebits.de>
+;; and others
+;;
+;; License: Public Domain
+;;
+
+
+(in-package :swank)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (swank-require :swank-util))
+
+(defslimefun completions (string default-package-name)
+ "Return a list of completions for a symbol designator STRING.
+
+The result is the list (COMPLETION-SET COMPLETED-PREFIX), where
+COMPLETION-SET is the list of all matching completions, and
+COMPLETED-PREFIX is the best (partial) completion of the input
+string.
+
+Simple compound matching is supported on a per-hyphen basis:
+
+ (completions \"m-v-\" \"COMMON-LISP\")
+ ==> ((\"multiple-value-bind\" \"multiple-value-call\"
+ \"multiple-value-list\" \"multiple-value-prog1\"
+ \"multiple-value-setq\" \"multiple-values-limit\")
+ \"multiple-value\")
+
+\(For more advanced compound matching, see FUZZY-COMPLETIONS.)
+
+If STRING is package qualified the result list will also be
+qualified. If string is non-qualified the result strings are
+also not qualified and are considered relative to
+DEFAULT-PACKAGE-NAME.
+
+The way symbols are matched depends on the symbol designator's
+format. The cases are as follows:
+ FOO - Symbols with matching prefix and accessible in the buffer package.
+ PKG:FOO - Symbols with matching prefix and external in package PKG.
+ PKG::FOO - Symbols with matching prefix and accessible in package PKG.
+"
+ (multiple-value-bind (name package-name package internal-p)
+ (parse-completion-arguments string default-package-name)
+ (let* ((symbol-set (symbol-completion-set
+ name package-name package internal-p
+ (make-compound-prefix-matcher #\-)))
+ (package-set (package-completion-set
+ name package-name package internal-p
+ (make-compound-prefix-matcher '(#\. #\-))))
+ (completion-set
+ (format-completion-set (nconc symbol-set package-set)
+ internal-p package-name)))
+ (when completion-set
+ (list completion-set (longest-compound-prefix completion-set))))))
+
+
+;;;;; Find completion set
+
+(defun symbol-completion-set (name package-name package internal-p matchp)
+ "Return the set of completion-candidates as strings."
+ (mapcar (completion-output-symbol-converter name)
+ (and package
+ (mapcar #'symbol-name
+ (find-matching-symbols name
+ package
+ (and (not internal-p)
+ package-name)
+ matchp)))))
+
+(defun package-completion-set (name package-name package internal-p matchp)
+ (declare (ignore package internal-p))
+ (mapcar (completion-output-package-converter name)
+ (and (not package-name)
+ (find-matching-packages name matchp))))
+
+(defun find-matching-symbols (string package external test)
+ "Return a list of symbols in PACKAGE matching STRING.
+TEST is called with two strings. If EXTERNAL is true, only external
+symbols are returned."
+ (let ((completions '())
+ (converter (completion-output-symbol-converter string)))
+ (flet ((symbol-matches-p (symbol)
+ (and (or (not external)
+ (symbol-external-p symbol package))
+ (funcall test string
+ (funcall converter (symbol-name symbol))))))
+ (do-symbols* (symbol package)
+ (when (symbol-matches-p symbol)
+ (push symbol completions))))
+ completions))
+
+(defun find-matching-symbols-in-list (string list test)
+ "Return a list of symbols in LIST matching STRING.
+TEST is called with two strings."
+ (let ((completions '())
+ (converter (completion-output-symbol-converter string)))
+ (flet ((symbol-matches-p (symbol)
+ (funcall test string
+ (funcall converter (symbol-name symbol)))))
+ (dolist (symbol list)
+ (when (symbol-matches-p symbol)
+ (push symbol completions))))
+ (remove-duplicates completions)))
+
+(defun find-matching-packages (name matcher)
+ "Return a list of package names matching NAME with MATCHER.
+MATCHER is a two-argument predicate."
+ (let ((converter (completion-output-package-converter name)))
+ (remove-if-not (lambda (x)
+ (funcall matcher name (funcall converter x)))
+ (mapcar (lambda (pkgname)
+ (concatenate 'string pkgname ":"))
+ (loop for package in (list-all-packages)
+ nconcing (package-names package))))))
+
+
+;; PARSE-COMPLETION-ARGUMENTS return table:
+;;
+;; user behaviour | NAME | PACKAGE-NAME | PACKAGE
+;; ----------------+--------+--------------+-----------------------------------
+;; asdf [tab] | "asdf" | NIL | #<PACKAGE "DEFAULT-PACKAGE-NAME">
+;; | | | or *BUFFER-PACKAGE*
+;; asdf: [tab] | "" | "asdf" | #<PACKAGE "ASDF">
+;; | | |
+;; asdf:foo [tab] | "foo" | "asdf" | #<PACKAGE "ASDF">
+;; | | |
+;; as:fo [tab] | "fo" | "as" | NIL
+;; | | |
+;; : [tab] | "" | "" | #<PACKAGE "KEYWORD">
+;; | | |
+;; :foo [tab] | "foo" | "" | #<PACKAGE "KEYWORD">
+;;
+(defun parse-completion-arguments (string default-package-name)
+ "Parse STRING as a symbol designator.
+Return these values:
+ SYMBOL-NAME
+ PACKAGE-NAME, or nil if the designator does not include an explicit package.
+ PACKAGE, generally the package to complete in. (However, if PACKAGE-NAME is
+ NIL, return the respective package of DEFAULT-PACKAGE-NAME instead;
+ if PACKAGE is non-NIL but a package cannot be found under that name,
+ return NIL.)
+ INTERNAL-P, if the symbol is qualified with `::'."
+ (multiple-value-bind (name package-name internal-p)
+ (tokenize-symbol string)
+ (flet ((default-package ()
+ (or (guess-package default-package-name) *buffer-package*)))
+ (let ((package (cond
+ ((not package-name)
+ (default-package))
+ ((equal package-name "")
+ (guess-package (symbol-name :keyword)))
+ ((find-locally-nicknamed-package
+ package-name (default-package)))
+ (t
+ (guess-package package-name)))))
+ (values name package-name package internal-p)))))
+
+(defun completion-output-case-converter (input &optional with-escaping-p)
+ "Return a function to convert strings for the completion output.
+INPUT is used to guess the preferred case."
+ (ecase (readtable-case *readtable*)
+ (:upcase (cond ((or with-escaping-p
+ (and (plusp (length input))
+ (not (some #'lower-case-p input))))
+ #'identity)
+ (t #'string-downcase)))
+ (:invert (lambda (output)
+ (multiple-value-bind (lower upper) (determine-case output)
+ (cond ((and lower upper) output)
+ (lower (string-upcase output))
+ (upper (string-downcase output))
+ (t output)))))
+ (:downcase (cond ((or with-escaping-p
+ (and (zerop (length input))
+ (not (some #'upper-case-p input))))
+ #'identity)
+ (t #'string-upcase)))
+ (:preserve #'identity)))
+
+(defun completion-output-package-converter (input)
+ "Return a function to convert strings for the completion output.
+INPUT is used to guess the preferred case."
+ (completion-output-case-converter input))
+
+(defun completion-output-symbol-converter (input)
+ "Return a function to convert strings for the completion output.
+INPUT is used to guess the preferred case. Escape symbols when needed."
+ (let ((case-converter (completion-output-case-converter input))
+ (case-converter-with-escaping (completion-output-case-converter input t)))
+ (lambda (str)
+ (if (or (multiple-value-bind (lowercase uppercase)
+ (determine-case str)
+ ;; In these readtable cases, symbols with letters from
+ ;; the wrong case need escaping
+ (case (readtable-case *readtable*)
+ (:upcase lowercase)
+ (:downcase uppercase)
+ (t nil)))
+ (some (lambda (el)
+ (or (member el '(#\: #\Space #\Newline #\Tab))
+ (multiple-value-bind (macrofun nonterminating)
+ (get-macro-character el)
+ (and macrofun
+ (not nonterminating)))))
+ str))
+ (concatenate 'string "|" (funcall case-converter-with-escaping str) "|")
+ (funcall case-converter str)))))
+
+
+(defun determine-case (string)
+ "Return two booleans LOWER and UPPER indicating whether STRING
+contains lower or upper case characters."
+ (values (some #'lower-case-p string)
+ (some #'upper-case-p string)))
+
+
+;;;;; Compound-prefix matching
+
+(defun make-compound-prefix-matcher (delimiter &key (test #'char=))
+ "Returns a matching function that takes a `prefix' and a
+`target' string and which returns T if `prefix' is a
+compound-prefix of `target', and otherwise NIL.
+
+Viewing each of `prefix' and `target' as a series of substrings
+delimited by DELIMITER, if each substring of `prefix' is a prefix
+of the corresponding substring in `target' then we call `prefix'
+a compound-prefix of `target'.
+
+DELIMITER may be a character, or a list of characters."
+ (let ((delimiters (etypecase delimiter
+ (character (list delimiter))
+ (cons (assert (every #'characterp delimiter))
+ delimiter))))
+ (lambda (prefix target)
+ (declare (type simple-string prefix target))
+ (loop with tpos = 0
+ for ch across prefix
+ always (and (< tpos (length target))
+ (let ((delimiter (car (member ch delimiters :test test))))
+ (if delimiter
+ (setf tpos (position delimiter target :start tpos))
+ (funcall test ch (aref target tpos)))))
+ do (incf tpos)))))
+
+
+;;;;; Extending the input string by completion
+
+(defun longest-compound-prefix (completions &optional (delimiter #\-))
+ "Return the longest compound _prefix_ for all COMPLETIONS."
+ (flet ((tokenizer (string) (tokenize-completion string delimiter)))
+ (untokenize-completion
+ (loop for token-list in (transpose-lists (mapcar #'tokenizer completions))
+ if (notevery #'string= token-list (rest token-list))
+ ;; Note that we possibly collect the "" here as well, so that
+ ;; UNTOKENIZE-COMPLETION will append a delimiter for us.
+ collect (longest-common-prefix token-list)
+ and do (loop-finish)
+ else collect (first token-list))
+ delimiter)))
+
+(defun tokenize-completion (string delimiter)
+ "Return all substrings of STRING delimited by DELIMITER."
+ (loop with end
+ for start = 0 then (1+ end)
+ until (> start (length string))
+ do (setq end (or (position delimiter string :start start) (length string)))
+ collect (subseq string start end)))
+
+(defun untokenize-completion (tokens &optional (delimiter #\-))
+ (format nil (format nil "~~{~~A~~^~a~~}" delimiter) tokens))
+
+(defun transpose-lists (lists)
+ "Turn a list-of-lists on its side.
+If the rows are of unequal length, truncate uniformly to the shortest.
+
+For example:
+\(transpose-lists '((ONE TWO THREE) (1 2)))
+ => ((ONE 1) (TWO 2))"
+ (cond ((null lists) '())
+ ((some #'null lists) '())
+ (t (cons (mapcar #'car lists)
+ (transpose-lists (mapcar #'cdr lists))))))
+
+
+;;;; Completion for character names
+
+(defslimefun completions-for-character (prefix)
+ (let* ((matcher (make-compound-prefix-matcher #\_ :test #'char-equal))
+ (completion-set (character-completion-set prefix matcher))
+ (completions (sort completion-set #'string<)))
+ (list completions (longest-compound-prefix completions #\_))))
+
+(provide :swank-c-p-c)
diff --git a/vim/bundle/slimv/slime/contrib/swank-clipboard.lisp b/vim/bundle/slimv/slime/contrib/swank-clipboard.lisp
new file mode 100644
index 0000000..52b1085
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-clipboard.lisp
@@ -0,0 +1,71 @@
+;;; swank-clipboard.lisp --- Object clipboard
+;;
+;; Written by Helmut Eller in 2008.
+;; License: Public Domain
+
+(defpackage :swank-clipboard
+ (:use :cl)
+ (:import-from :swank :defslimefun :with-buffer-syntax :dcase)
+ (:export :add :delete-entry :entries :entry-to-ref :ref))
+
+(in-package :swank-clipboard)
+
+(defstruct clipboard entries (counter 0))
+
+(defvar *clipboard* (make-clipboard))
+
+(defslimefun add (datum)
+ (let ((value (dcase datum
+ ((:string string package)
+ (with-buffer-syntax (package)
+ (eval (read-from-string string))))
+ ((:inspector part)
+ (swank:inspector-nth-part part))
+ ((:sldb frame var)
+ (swank/backend:frame-var-value frame var)))))
+ (clipboard-add value)
+ (format nil "Added: ~a"
+ (entry-to-string (1- (length (clipboard-entries *clipboard*)))))))
+
+(defslimefun entries ()
+ (loop for (ref . value) in (clipboard-entries *clipboard*)
+ collect `(,ref . ,(to-line value))))
+
+(defslimefun delete-entry (entry)
+ (let ((msg (format nil "Deleted: ~a" (entry-to-string entry))))
+ (clipboard-delete-entry entry)
+ msg))
+
+(defslimefun entry-to-ref (entry)
+ (destructuring-bind (ref . value) (clipboard-entry entry)
+ (list ref (to-line value 5))))
+
+(defun clipboard-add (value)
+ (setf (clipboard-entries *clipboard*)
+ (append (clipboard-entries *clipboard*)
+ (list (cons (incf (clipboard-counter *clipboard*))
+ value)))))
+
+(defun clipboard-ref (ref)
+ (let ((tail (member ref (clipboard-entries *clipboard*) :key #'car)))
+ (cond (tail (cdr (car tail)))
+ (t (error "Invalid clipboard ref: ~s" ref)))))
+
+(defun clipboard-entry (entry)
+ (elt (clipboard-entries *clipboard*) entry))
+
+(defun clipboard-delete-entry (index)
+ (let* ((list (clipboard-entries *clipboard*))
+ (tail (nthcdr index list)))
+ (setf (clipboard-entries *clipboard*)
+ (append (ldiff list tail) (cdr tail)))))
+
+(defun entry-to-string (entry)
+ (destructuring-bind (ref . value) (clipboard-entry entry)
+ (format nil "#@~d(~a)" ref (to-line value))))
+
+(defun to-line (object &optional (width 75))
+ (with-output-to-string (*standard-output*)
+ (write object :right-margin width :lines 1)))
+
+(provide :swank-clipboard)
diff --git a/vim/bundle/slimv/slime/contrib/swank-fancy-inspector.lisp b/vim/bundle/slimv/slime/contrib/swank-fancy-inspector.lisp
new file mode 100644
index 0000000..3e46df9
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-fancy-inspector.lisp
@@ -0,0 +1,1004 @@
+;;; swank-fancy-inspector.lisp --- Fancy inspector for CLOS objects
+;;
+;; Author: Marco Baringer <mb@bese.it> and others
+;; License: Public Domain
+;;
+
+(in-package :swank)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (swank-require :swank-util))
+
+(defmethod emacs-inspect ((symbol symbol))
+ (let ((package (symbol-package symbol)))
+ (multiple-value-bind (_symbol status)
+ (and package (find-symbol (string symbol) package))
+ (declare (ignore _symbol))
+ (append
+ (label-value-line "Its name is" (symbol-name symbol))
+ ;;
+ ;; Value
+ (cond ((boundp symbol)
+ (append
+ (label-value-line (if (constantp symbol)
+ "It is a constant of value"
+ "It is a global variable bound to")
+ (symbol-value symbol) :newline nil)
+ ;; unbinding constants might be not a good idea, but
+ ;; implementations usually provide a restart.
+ `(" " (:action "[unbind]"
+ ,(lambda () (makunbound symbol))))
+ '((:newline))))
+ (t '("It is unbound." (:newline))))
+ (docstring-ispec "Documentation" symbol 'variable)
+ (multiple-value-bind (expansion definedp) (macroexpand symbol)
+ (if definedp
+ (label-value-line "It is a symbol macro with expansion"
+ expansion)))
+ ;;
+ ;; Function
+ (if (fboundp symbol)
+ (append (if (macro-function symbol)
+ `("It a macro with macro-function: "
+ (:value ,(macro-function symbol)))
+ `("It is a function: "
+ (:value ,(symbol-function symbol))))
+ `(" " (:action "[unbind]"
+ ,(lambda () (fmakunbound symbol))))
+ `((:newline)))
+ `("It has no function value." (:newline)))
+ (docstring-ispec "Function documentation" symbol 'function)
+ (when (compiler-macro-function symbol)
+ (append
+ (label-value-line "It also names the compiler macro"
+ (compiler-macro-function symbol) :newline nil)
+ `(" " (:action "[remove]"
+ ,(lambda ()
+ (setf (compiler-macro-function symbol) nil)))
+ (:newline))))
+ (docstring-ispec "Compiler macro documentation"
+ symbol 'compiler-macro)
+ ;;
+ ;; Package
+ (if package
+ `("It is " ,(string-downcase (string status))
+ " to the package: "
+ (:value ,package ,(package-name package))
+ ,@(if (eq :internal status)
+ `(" "
+ (:action "[export]"
+ ,(lambda () (export symbol package)))))
+ " "
+ (:action "[unintern]"
+ ,(lambda () (unintern symbol package)))
+ (:newline))
+ '("It is a non-interned symbol." (:newline)))
+ ;;
+ ;; Plist
+ (label-value-line "Property list" (symbol-plist symbol))
+ ;;
+ ;; Class
+ (if (find-class symbol nil)
+ `("It names the class "
+ (:value ,(find-class symbol) ,(string symbol))
+ " "
+ (:action "[remove]"
+ ,(lambda () (setf (find-class symbol) nil)))
+ (:newline)))
+ ;;
+ ;; More package
+ (if (find-package symbol)
+ (label-value-line "It names the package" (find-package symbol)))
+ (inspect-type-specifier symbol)))))
+
+#-sbcl
+(defun inspect-type-specifier (symbol)
+ (declare (ignore symbol)))
+
+#+sbcl
+(defun inspect-type-specifier (symbol)
+ (let* ((kind (sb-int:info :type :kind symbol))
+ (fun (case kind
+ (:defined
+ (or (sb-int:info :type :expander symbol) t))
+ (:primitive
+ (or #.(if (swank/sbcl::sbcl-version>= 1 3 1)
+ '(let ((x (sb-int:info :type :expander symbol)))
+ (if (consp x)
+ (car x)
+ x))
+ '(sb-int:info :type :translator symbol))
+ t)))))
+ (when fun
+ (append
+ (list
+ (format nil "It names a ~@[primitive~* ~]type-specifier."
+ (eq kind :primitive))
+ '(:newline))
+ (docstring-ispec "Type-specifier documentation" symbol 'type)
+ (unless (eq t fun)
+ (let ((arglist (arglist fun)))
+ (append
+ `("Type-specifier lambda-list: "
+ ;; Could use ~:s, but inspector-princ does a bit more,
+ ;; and not all NILs in the arglist should be printed that way.
+ ,(if arglist
+ (inspector-princ arglist)
+ "()")
+ (:newline))
+ (multiple-value-bind (expansion ok)
+ (handler-case (sb-ext:typexpand-1 symbol)
+ (error () (values nil nil)))
+ (when ok
+ (list "Type-specifier expansion: "
+ (princ-to-string expansion)))))))))))
+
+(defun docstring-ispec (label object kind)
+ "Return a inspector spec if OBJECT has a docstring of kind KIND."
+ (let ((docstring (documentation object kind)))
+ (cond ((not docstring) nil)
+ ((< (+ (length label) (length docstring))
+ 75)
+ (list label ": " docstring '(:newline)))
+ (t
+ (list label ":" '(:newline) " " docstring '(:newline))))))
+
+(unless (find-method #'emacs-inspect '() (list (find-class 'function)) nil)
+ (defmethod emacs-inspect ((f function))
+ (inspect-function f)))
+
+(defun inspect-function (f)
+ (append
+ (label-value-line "Name" (function-name f))
+ `("Its argument list is: "
+ ,(inspector-princ (arglist f)) (:newline))
+ (docstring-ispec "Documentation" f t)
+ (if (function-lambda-expression f)
+ (label-value-line "Lambda Expression"
+ (function-lambda-expression f)))))
+
+(defun method-specializers-for-inspect (method)
+ "Return a \"pretty\" list of the method's specializers. Normal
+ specializers are replaced by the name of the class, eql
+ specializers are replaced by `(eql ,object)."
+ (mapcar (lambda (spec)
+ (typecase spec
+ (swank-mop:eql-specializer
+ `(eql ,(swank-mop:eql-specializer-object spec)))
+ #-sbcl
+ (t
+ (swank-mop:class-name spec))
+ #+sbcl
+ (t
+ ;; SBCL has extended specializers
+ (let ((gf (sb-mop:method-generic-function method)))
+ (cond (gf
+ (sb-pcl:unparse-specializer-using-class gf spec))
+ ((typep spec 'class)
+ (class-name spec))
+ (t
+ spec))))))
+ (swank-mop:method-specializers method)))
+
+(defun method-for-inspect-value (method)
+ "Returns a \"pretty\" list describing METHOD. The first element
+ of the list is the name of generic-function method is
+ specialiazed on, the second element is the method qualifiers,
+ the rest of the list is the method's specialiazers (as per
+ method-specializers-for-inspect)."
+ (append (list (swank-mop:generic-function-name
+ (swank-mop:method-generic-function method)))
+ (swank-mop:method-qualifiers method)
+ (method-specializers-for-inspect method)))
+
+(defmethod emacs-inspect ((object standard-object))
+ (let ((class (class-of object)))
+ `("Class: " (:value ,class) (:newline)
+ ,@(all-slots-for-inspector object))))
+
+(defvar *gf-method-getter* 'methods-by-applicability
+ "This function is called to get the methods of a generic function.
+The default returns the method sorted by applicability.
+See `methods-by-applicability'.")
+
+(defun specializer< (specializer1 specializer2)
+ "Return true if SPECIALIZER1 is more specific than SPECIALIZER2."
+ (let ((s1 specializer1) (s2 specializer2) )
+ (cond ((typep s1 'swank-mop:eql-specializer)
+ (not (typep s2 'swank-mop:eql-specializer)))
+ ((typep s1 'class)
+ (flet ((cpl (class)
+ (and (swank-mop:class-finalized-p class)
+ (swank-mop:class-precedence-list class))))
+ (member s2 (cpl s1)))))))
+
+(defun methods-by-applicability (gf)
+ "Return methods ordered by most specific argument types.
+
+`method-specializer<' is used for sorting."
+ ;; FIXME: argument-precedence-order and qualifiers are ignored.
+ (labels ((method< (meth1 meth2)
+ (loop for s1 in (swank-mop:method-specializers meth1)
+ for s2 in (swank-mop:method-specializers meth2)
+ do (cond ((specializer< s2 s1) (return nil))
+ ((specializer< s1 s2) (return t))))))
+ (stable-sort (copy-seq (swank-mop:generic-function-methods gf))
+ #'method<)))
+
+(defun abbrev-doc (doc &optional (maxlen 80))
+ "Return the first sentence of DOC, but not more than MAXLAN characters."
+ (subseq doc 0 (min (1+ (or (position #\. doc) (1- maxlen)))
+ maxlen
+ (length doc))))
+
+(defstruct (inspector-checklist (:conc-name checklist.)
+ (:constructor %make-checklist (buttons)))
+ (buttons nil :type (or null simple-vector))
+ (count 0))
+
+(defun make-checklist (n)
+ (%make-checklist (make-array n :initial-element nil)))
+
+(defun reinitialize-checklist (checklist)
+ ;; Along this counter the buttons are created, so we have to
+ ;; initialize it to 0 everytime the inspector page is redisplayed.
+ (setf (checklist.count checklist) 0)
+ checklist)
+
+(defun make-checklist-button (checklist)
+ (let ((buttons (checklist.buttons checklist))
+ (i (checklist.count checklist)))
+ (incf (checklist.count checklist))
+ `(:action ,(if (svref buttons i)
+ "[X]"
+ "[ ]")
+ ,#'(lambda ()
+ (setf (svref buttons i) (not (svref buttons i))))
+ :refreshp t)))
+
+(defmacro do-checklist ((idx checklist) &body body)
+ "Iterate over all set buttons in CHECKLIST."
+ (let ((buttons (gensym "buttons")))
+ `(let ((,buttons (checklist.buttons ,checklist)))
+ (dotimes (,idx (length ,buttons))
+ (when (svref ,buttons ,idx)
+ ,@body)))))
+
+(defun box (thing) (cons :box thing))
+(defun ref (box)
+ (assert (eq (car box) :box))
+ (cdr box))
+(defun (setf ref) (value box)
+ (assert (eq (car box) :box))
+ (setf (cdr box) value))
+
+(defvar *inspector-slots-default-order* :alphabetically
+ "Accepted values: :alphabetically and :unsorted")
+
+(defvar *inspector-slots-default-grouping* :all
+ "Accepted values: :inheritance and :all")
+
+(defgeneric all-slots-for-inspector (object))
+
+(defmethod all-slots-for-inspector ((object standard-object))
+ (let* ((class (class-of object))
+ (direct-slots (swank-mop:class-direct-slots class))
+ (effective-slots (swank-mop:class-slots class))
+ (longest-slot-name-length
+ (loop for slot :in effective-slots
+ maximize (length (symbol-name
+ (swank-mop:slot-definition-name slot)))))
+ (checklist
+ (reinitialize-checklist
+ (ensure-istate-metadata object :checklist
+ (make-checklist (length effective-slots)))))
+ (grouping-kind
+ ;; We box the value so we can re-set it.
+ (ensure-istate-metadata object :grouping-kind
+ (box *inspector-slots-default-grouping*)))
+ (sort-order
+ (ensure-istate-metadata object :sort-order
+ (box *inspector-slots-default-order*)))
+ (sort-predicate (ecase (ref sort-order)
+ (:alphabetically #'string<)
+ (:unsorted (constantly nil))))
+ (sorted-slots (sort (copy-seq effective-slots)
+ sort-predicate
+ :key #'swank-mop:slot-definition-name))
+ (effective-slots
+ (ecase (ref grouping-kind)
+ (:all sorted-slots)
+ (:inheritance (stable-sort-by-inheritance sorted-slots
+ class sort-predicate)))))
+ `("--------------------"
+ (:newline)
+ " Group slots by inheritance "
+ (:action ,(ecase (ref grouping-kind)
+ (:all "[ ]")
+ (:inheritance "[X]"))
+ ,(lambda ()
+ ;; We have to do this as the order of slots will
+ ;; be sorted differently.
+ (fill (checklist.buttons checklist) nil)
+ (setf (ref grouping-kind)
+ (ecase (ref grouping-kind)
+ (:all :inheritance)
+ (:inheritance :all))))
+ :refreshp t)
+ (:newline)
+ " Sort slots alphabetically "
+ (:action ,(ecase (ref sort-order)
+ (:unsorted "[ ]")
+ (:alphabetically "[X]"))
+ ,(lambda ()
+ (fill (checklist.buttons checklist) nil)
+ (setf (ref sort-order)
+ (ecase (ref sort-order)
+ (:unsorted :alphabetically)
+ (:alphabetically :unsorted))))
+ :refreshp t)
+ (:newline)
+ ,@ (case (ref grouping-kind)
+ (:all
+ `((:newline)
+ "All Slots:"
+ (:newline)
+ ,@(make-slot-listing checklist object class
+ effective-slots direct-slots
+ longest-slot-name-length)))
+ (:inheritance
+ (list-all-slots-by-inheritance checklist object class
+ effective-slots direct-slots
+ longest-slot-name-length)))
+ (:newline)
+ (:action "[set value]"
+ ,(lambda ()
+ (do-checklist (idx checklist)
+ (query-and-set-slot class object
+ (nth idx effective-slots))))
+ :refreshp t)
+ " "
+ (:action "[make unbound]"
+ ,(lambda ()
+ (do-checklist (idx checklist)
+ (swank-mop:slot-makunbound-using-class
+ class object (nth idx effective-slots))))
+ :refreshp t)
+ (:newline))))
+
+(defun list-all-slots-by-inheritance (checklist object class effective-slots
+ direct-slots longest-slot-name-length)
+ (flet ((slot-home-class (slot)
+ (slot-home-class-using-class slot class)))
+ (let ((current-slots '()))
+ (append
+ (loop for slot in effective-slots
+ for previous-home-class = (slot-home-class slot) then home-class
+ for home-class = previous-home-class then (slot-home-class slot)
+ if (eq home-class previous-home-class)
+ do (push slot current-slots)
+ else
+ collect '(:newline)
+ and collect (format nil "~A:" (class-name previous-home-class))
+ and collect '(:newline)
+ and append (make-slot-listing checklist object class
+ (nreverse current-slots)
+ direct-slots
+ longest-slot-name-length)
+ and do (setf current-slots (list slot)))
+ (and current-slots
+ `((:newline)
+ ,(format nil "~A:"
+ (class-name (slot-home-class-using-class
+ (car current-slots) class)))
+ (:newline)
+ ,@(make-slot-listing checklist object class
+ (nreverse current-slots) direct-slots
+ longest-slot-name-length)))))))
+
+(defun make-slot-listing (checklist object class effective-slots direct-slots
+ longest-slot-name-length)
+ (flet ((padding-for (slot-name)
+ (make-string (- longest-slot-name-length (length slot-name))
+ :initial-element #\Space)))
+ (loop
+ for effective-slot :in effective-slots
+ for direct-slot = (find (swank-mop:slot-definition-name effective-slot)
+ direct-slots
+ :key #'swank-mop:slot-definition-name)
+ for slot-name = (inspector-princ
+ (swank-mop:slot-definition-name effective-slot))
+ collect (make-checklist-button checklist)
+ collect " "
+ collect `(:value ,(if direct-slot
+ (list direct-slot effective-slot)
+ effective-slot)
+ ,slot-name)
+ collect (padding-for slot-name)
+ collect " = "
+ collect (slot-value-for-inspector class object effective-slot)
+ collect '(:newline))))
+
+(defgeneric slot-value-for-inspector (class object slot)
+ (:method (class object slot)
+ (let ((boundp (swank-mop:slot-boundp-using-class class object slot)))
+ (if boundp
+ `(:value ,(swank-mop:slot-value-using-class class object slot))
+ "#<unbound>"))))
+
+(defun slot-home-class-using-class (slot class)
+ (let ((slot-name (swank-mop:slot-definition-name slot)))
+ (loop for class in (reverse (swank-mop:class-precedence-list class))
+ thereis (and (member slot-name (swank-mop:class-direct-slots class)
+ :key #'swank-mop:slot-definition-name
+ :test #'eq)
+ class))))
+
+(defun stable-sort-by-inheritance (slots class predicate)
+ (stable-sort slots predicate
+ :key #'(lambda (s)
+ (class-name (slot-home-class-using-class s class)))))
+
+(defun query-and-set-slot (class object slot)
+ (let* ((slot-name (swank-mop:slot-definition-name slot))
+ (value-string (read-from-minibuffer-in-emacs
+ (format nil "Set slot ~S to (evaluated) : "
+ slot-name))))
+ (when (and value-string (not (string= value-string "")))
+ (with-simple-restart (abort "Abort setting slot ~S" slot-name)
+ (setf (swank-mop:slot-value-using-class class object slot)
+ (eval (read-from-string value-string)))))))
+
+
+(defmethod emacs-inspect ((gf standard-generic-function))
+ (flet ((lv (label value) (label-value-line label value)))
+ (append
+ (lv "Name" (swank-mop:generic-function-name gf))
+ (lv "Arguments" (swank-mop:generic-function-lambda-list gf))
+ (docstring-ispec "Documentation" gf t)
+ (lv "Method class" (swank-mop:generic-function-method-class gf))
+ (lv "Method combination"
+ (swank-mop:generic-function-method-combination gf))
+ `("Methods: " (:newline))
+ (loop for method in (funcall *gf-method-getter* gf) append
+ `((:value ,method ,(inspector-princ
+ ;; drop the name of the GF
+ (cdr (method-for-inspect-value method))))
+ " "
+ (:action "[remove method]"
+ ,(let ((m method)) ; LOOP reassigns method
+ (lambda ()
+ (remove-method gf m))))
+ (:newline)))
+ `((:newline))
+ (all-slots-for-inspector gf))))
+
+(defmethod emacs-inspect ((method standard-method))
+ `(,@(if (swank-mop:method-generic-function method)
+ `("Method defined on the generic function "
+ (:value ,(swank-mop:method-generic-function method)
+ ,(inspector-princ
+ (swank-mop:generic-function-name
+ (swank-mop:method-generic-function method)))))
+ '("Method without a generic function"))
+ (:newline)
+ ,@(docstring-ispec "Documentation" method t)
+ "Lambda List: " (:value ,(swank-mop:method-lambda-list method))
+ (:newline)
+ "Specializers: " (:value ,(swank-mop:method-specializers method)
+ ,(inspector-princ
+ (method-specializers-for-inspect method)))
+ (:newline)
+ "Qualifiers: " (:value ,(swank-mop:method-qualifiers method))
+ (:newline)
+ "Method function: " (:value ,(swank-mop:method-function method))
+ (:newline)
+ ,@(all-slots-for-inspector method)))
+
+(defun specializer-direct-methods (class)
+ (sort (copy-seq (swank-mop:specializer-direct-methods class))
+ #'string<
+ :key
+ (lambda (x)
+ (symbol-name
+ (let ((name (swank-mop::generic-function-name
+ (swank-mop::method-generic-function x))))
+ (if (symbolp name)
+ name
+ (second name)))))))
+
+(defmethod emacs-inspect ((class standard-class))
+ `("Name: "
+ (:value ,(class-name class))
+ (:newline)
+ "Super classes: "
+ ,@(common-seperated-spec (swank-mop:class-direct-superclasses class))
+ (:newline)
+ "Direct Slots: "
+ ,@(common-seperated-spec
+ (swank-mop:class-direct-slots class)
+ (lambda (slot)
+ `(:value ,slot ,(inspector-princ
+ (swank-mop:slot-definition-name slot)))))
+ (:newline)
+ "Effective Slots: "
+ ,@(if (swank-mop:class-finalized-p class)
+ (common-seperated-spec
+ (swank-mop:class-slots class)
+ (lambda (slot)
+ `(:value ,slot ,(inspector-princ
+ (swank-mop:slot-definition-name slot)))))
+ `("#<N/A (class not finalized)> "
+ (:action "[finalize]"
+ ,(lambda () (swank-mop:finalize-inheritance class)))))
+ (:newline)
+ ,@(let ((doc (documentation class t)))
+ (when doc
+ `("Documentation:" (:newline) ,(inspector-princ doc) (:newline))))
+ "Sub classes: "
+ ,@(common-seperated-spec (swank-mop:class-direct-subclasses class)
+ (lambda (sub)
+ `(:value ,sub
+ ,(inspector-princ (class-name sub)))))
+ (:newline)
+ "Precedence List: "
+ ,@(if (swank-mop:class-finalized-p class)
+ (common-seperated-spec
+ (swank-mop:class-precedence-list class)
+ (lambda (class)
+ `(:value ,class ,(inspector-princ (class-name class)))))
+ '("#<N/A (class not finalized)>"))
+ (:newline)
+ ,@(when (swank-mop:specializer-direct-methods class)
+ `("It is used as a direct specializer in the following methods:"
+ (:newline)
+ ,@(loop
+ for method in (specializer-direct-methods class)
+ collect " "
+ collect `(:value ,method
+ ,(inspector-princ
+ (method-for-inspect-value method)))
+ collect '(:newline)
+ if (documentation method t)
+ collect " Documentation: " and
+ collect (abbrev-doc (documentation method t)) and
+ collect '(:newline))))
+ "Prototype: " ,(if (swank-mop:class-finalized-p class)
+ `(:value ,(swank-mop:class-prototype class))
+ '"#<N/A (class not finalized)>")
+ (:newline)
+ ,@(all-slots-for-inspector class)))
+
+(defmethod emacs-inspect ((slot swank-mop:standard-slot-definition))
+ `("Name: "
+ (:value ,(swank-mop:slot-definition-name slot))
+ (:newline)
+ ,@(when (swank-mop:slot-definition-documentation slot)
+ `("Documentation:" (:newline)
+ (:value ,(swank-mop:slot-definition-documentation
+ slot))
+ (:newline)))
+ "Init args: "
+ (:value ,(swank-mop:slot-definition-initargs slot))
+ (:newline)
+ "Init form: "
+ ,(if (swank-mop:slot-definition-initfunction slot)
+ `(:value ,(swank-mop:slot-definition-initform slot))
+ "#<unspecified>")
+ (:newline)
+ "Init function: "
+ (:value ,(swank-mop:slot-definition-initfunction slot))
+ (:newline)
+ ,@(all-slots-for-inspector slot)))
+
+
+;; Wrapper structure over the list of symbols of a package that should
+;; be displayed with their respective classification flags. This is
+;; because we need a unique type to dispatch on in EMACS-INSPECT.
+;; Used by the Inspector for packages.
+(defstruct (%package-symbols-container
+ (:conc-name %container.)
+ (:constructor %%make-package-symbols-container))
+ title ;; A string; the title of the inspector page in Emacs.
+ description ;; A list of renderable objects; used as description.
+ symbols ;; A list of symbols. Supposed to be sorted alphabetically.
+ grouping-kind) ;; Either :SYMBOL or :CLASSIFICATION. Cf. MAKE-SYMBOLS-LISTING
+
+
+(defun %make-package-symbols-container (&key title description symbols)
+ (%%make-package-symbols-container :title title :description description
+ :symbols symbols :grouping-kind :symbol))
+
+(defgeneric make-symbols-listing (grouping-kind symbols))
+
+(defmethod make-symbols-listing ((grouping-kind (eql :symbol)) symbols)
+ "Returns an object renderable by Emacs' inspector side that
+alphabetically lists all the symbols in SYMBOLS together with a
+concise string representation of what each symbol
+represents (see SYMBOL-CLASSIFICATION-STRING)"
+ (let ((max-length (loop for s in symbols
+ maximizing (length (symbol-name s))))
+ (distance 10)) ; empty distance between name and classification
+ (flet ((string-representations (symbol)
+ (let* ((name (symbol-name symbol))
+ (length (length name))
+ (padding (- max-length length)))
+ (values
+ (concatenate 'string
+ name
+ (make-string (+ padding distance)
+ :initial-element #\Space))
+ (symbol-classification-string symbol)))))
+ `("" ; 8 is (length "Symbols:")
+ "Symbols:" ,(make-string (+ -8 max-length distance)
+ :initial-element #\Space)
+ "Flags:"
+ (:newline)
+ ,(concatenate 'string ; underlining dashes
+ (make-string (+ max-length distance -1)
+ :initial-element #\-)
+ " "
+ (symbol-classification-string '#:foo))
+ (:newline)
+ ,@(loop for symbol in symbols appending
+ (multiple-value-bind (symbol-string classification-string)
+ (string-representations symbol)
+ `((:value ,symbol ,symbol-string) ,classification-string
+ (:newline)
+ )))))))
+
+(defmethod make-symbols-listing ((grouping-kind (eql :classification)) symbols)
+ "For each possible classification (cf. CLASSIFY-SYMBOL), group
+all the symbols in SYMBOLS to all of their respective
+classifications. (If a symbol is, for instance, boundp and a
+generic-function, it'll appear both below the BOUNDP group and
+the GENERIC-FUNCTION group.) As macros and special-operators are
+specified to be FBOUNDP, there is no general FBOUNDP group,
+instead there are the three explicit FUNCTION, MACRO and
+SPECIAL-OPERATOR groups."
+ (let ((table (make-hash-table :test #'eq))
+ (+default-classification+ :misc))
+ (flet ((normalize-classifications (classifications)
+ (cond ((null classifications) `(,+default-classification+))
+ ;; Convert an :FBOUNDP in CLASSIFICATIONS to
+ ;; :FUNCTION if possible.
+ ((and (member :fboundp classifications)
+ (not (member :macro classifications))
+ (not (member :special-operator classifications)))
+ (substitute :function :fboundp classifications))
+ (t (remove :fboundp classifications)))))
+ (loop for symbol in symbols do
+ (loop for classification in
+ (normalize-classifications (classify-symbol symbol))
+ ;; SYMBOLS are supposed to be sorted alphabetically;
+ ;; this property is preserved here except for reversing.
+ do (push symbol (gethash classification table)))))
+ (let* ((classifications (loop for k being each hash-key in table
+ collect k))
+ (classifications (sort classifications
+ ;; Sort alphabetically, except
+ ;; +DEFAULT-CLASSIFICATION+ which
+ ;; sort to the end.
+ (lambda (a b)
+ (cond ((eql a +default-classification+)
+ nil)
+ ((eql b +default-classification+)
+ t)
+ (t (string< a b)))))))
+ (loop for classification in classifications
+ for symbols = (gethash classification table)
+ appending`(,(symbol-name classification)
+ (:newline)
+ ,(make-string 64 :initial-element #\-)
+ (:newline)
+ ,@(mapcan (lambda (symbol)
+ `((:value ,symbol ,(symbol-name symbol))
+ (:newline)))
+ ;; restore alphabetic order.
+ (nreverse symbols))
+ (:newline))))))
+
+(defmethod emacs-inspect ((%container %package-symbols-container))
+ (with-struct (%container. title description symbols grouping-kind) %container
+ `(,title (:newline) (:newline)
+ ,@description
+ (:newline)
+ " " ,(ecase grouping-kind
+ (:symbol
+ `(:action "[Group by classification]"
+ ,(lambda ()
+ (setf grouping-kind :classification))
+ :refreshp t))
+ (:classification
+ `(:action "[Group by symbol]"
+ ,(lambda () (setf grouping-kind :symbol))
+ :refreshp t)))
+ (:newline) (:newline)
+ ,@(make-symbols-listing grouping-kind symbols))))
+
+(defun display-link (type symbols length &key title description)
+ (if (null symbols)
+ (format nil "0 ~A symbols." type)
+ `(:value ,(%make-package-symbols-container :title title
+ :description description
+ :symbols symbols)
+ ,(format nil "~D ~A symbol~P." length type length))))
+
+(defmethod emacs-inspect ((package package))
+ (let ((package-name (package-name package))
+ (package-nicknames (package-nicknames package))
+ (package-use-list (package-use-list package))
+ (package-used-by-list (package-used-by-list package))
+ (shadowed-symbols (package-shadowing-symbols package))
+ (present-symbols '()) (present-symbols-length 0)
+ (internal-symbols '()) (internal-symbols-length 0)
+ (inherited-symbols '()) (inherited-symbols-length 0)
+ (external-symbols '()) (external-symbols-length 0))
+
+ (do-symbols* (sym package)
+ (let ((status (symbol-status sym package)))
+ (when (eq status :inherited)
+ (push sym inherited-symbols) (incf inherited-symbols-length)
+ (go :continue))
+ (push sym present-symbols) (incf present-symbols-length)
+ (cond ((eq status :internal)
+ (push sym internal-symbols) (incf internal-symbols-length))
+ (t
+ (push sym external-symbols) (incf external-symbols-length))))
+ :continue)
+
+ (setf package-nicknames (sort (copy-list package-nicknames)
+ #'string<)
+ package-use-list (sort (copy-list package-use-list)
+ #'string< :key #'package-name)
+ package-used-by-list (sort (copy-list package-used-by-list)
+ #'string< :key #'package-name)
+ shadowed-symbols (sort (copy-list shadowed-symbols)
+ #'string<))
+ ;;; SORT + STRING-LESSP conses on at least SBCL 0.9.18.
+ (setf present-symbols (sort present-symbols #'string<)
+ internal-symbols (sort internal-symbols #'string<)
+ external-symbols (sort external-symbols #'string<)
+ inherited-symbols (sort inherited-symbols #'string<))
+ `("" ;; dummy to preserve indentation.
+ "Name: " (:value ,package-name) (:newline)
+
+ "Nick names: " ,@(common-seperated-spec package-nicknames) (:newline)
+
+ ,@(when (documentation package t)
+ `("Documentation:" (:newline)
+ ,(documentation package t) (:newline)))
+
+ "Use list: " ,@(common-seperated-spec
+ package-use-list
+ (lambda (package)
+ `(:value ,package ,(package-name package))))
+ (:newline)
+
+ "Used by list: " ,@(common-seperated-spec
+ package-used-by-list
+ (lambda (package)
+ `(:value ,package ,(package-name package))))
+ (:newline)
+
+ ,(display-link "present" present-symbols present-symbols-length
+ :title
+ (format nil "All present symbols of package \"~A\""
+ package-name)
+ :description
+ '("A symbol is considered present in a package if it's"
+ (:newline)
+ "\"accessible in that package directly, rather than"
+ (:newline)
+ "being inherited from another package.\""
+ (:newline)
+ "(CLHS glossary entry for `present')"
+ (:newline)))
+
+ (:newline)
+ ,(display-link "external" external-symbols external-symbols-length
+ :title
+ (format nil "All external symbols of package \"~A\""
+ package-name)
+ :description
+ '("A symbol is considered external of a package if it's"
+ (:newline)
+ "\"part of the `external interface' to the package and"
+ (:newline)
+ "[is] inherited by any other package that uses the"
+ (:newline)
+ "package.\" (CLHS glossary entry of `external')"
+ (:newline)))
+ (:newline)
+ ,(display-link "internal" internal-symbols internal-symbols-length
+ :title
+ (format nil "All internal symbols of package \"~A\""
+ package-name)
+ :description
+ '("A symbol is considered internal of a package if it's"
+ (:newline)
+ "present and not external---that is if the package is"
+ (:newline)
+ "the home package of the symbol, or if the symbol has"
+ (:newline)
+ "been explicitly imported into the package."
+ (:newline)
+ (:newline)
+ "Notice that inherited symbols will thus not be listed,"
+ (:newline)
+ "which deliberately deviates from the CLHS glossary"
+ (:newline)
+ "entry of `internal' because it's assumed to be more"
+ (:newline)
+ "useful this way."
+ (:newline)))
+ (:newline)
+ ,(display-link "inherited" inherited-symbols inherited-symbols-length
+ :title
+ (format nil "All inherited symbols of package \"~A\""
+ package-name)
+ :description
+ '("A symbol is considered inherited in a package if it"
+ (:newline)
+ "was made accessible via USE-PACKAGE."
+ (:newline)))
+ (:newline)
+ ,(display-link "shadowed" shadowed-symbols (length shadowed-symbols)
+ :title
+ (format nil "All shadowed symbols of package \"~A\""
+ package-name)
+ :description nil))))
+
+
+(defmethod emacs-inspect ((pathname pathname))
+ `(,(if (wild-pathname-p pathname)
+ "A wild pathname."
+ "A pathname.")
+ (:newline)
+ ,@(label-value-line*
+ ("Namestring" (namestring pathname))
+ ("Host" (pathname-host pathname))
+ ("Device" (pathname-device pathname))
+ ("Directory" (pathname-directory pathname))
+ ("Name" (pathname-name pathname))
+ ("Type" (pathname-type pathname))
+ ("Version" (pathname-version pathname)))
+ ,@ (unless (or (wild-pathname-p pathname)
+ (not (probe-file pathname)))
+ (label-value-line "Truename" (truename pathname)))))
+
+(defmethod emacs-inspect ((pathname logical-pathname))
+ (append
+ (label-value-line*
+ ("Namestring" (namestring pathname))
+ ("Physical pathname: " (translate-logical-pathname pathname)))
+ `("Host: "
+ (:value ,(pathname-host pathname))
+ " ("
+ (:value ,(logical-pathname-translations
+ (pathname-host pathname)))
+ " other translations)"
+ (:newline))
+ (label-value-line*
+ ("Directory" (pathname-directory pathname))
+ ("Name" (pathname-name pathname))
+ ("Type" (pathname-type pathname))
+ ("Version" (pathname-version pathname))
+ ("Truename" (if (not (wild-pathname-p pathname))
+ (probe-file pathname))))))
+
+(defmethod emacs-inspect ((n number))
+ `("Value: " ,(princ-to-string n)))
+
+(defun format-iso8601-time (time-value &optional include-timezone-p)
+ "Formats a universal time TIME-VALUE in ISO 8601 format, with
+ the time zone included if INCLUDE-TIMEZONE-P is non-NIL"
+ ;; Taken from http://www.pvv.ntnu.no/~nsaa/ISO8601.html
+ ;; Thanks, Nikolai Sandved and Thomas Russ!
+ (flet ((format-iso8601-timezone (zone)
+ (if (zerop zone)
+ "Z"
+ (multiple-value-bind (h m) (truncate (abs zone) 1.0)
+ ;; Tricky. Sign of time zone is reversed in ISO 8601
+ ;; relative to Common Lisp convention!
+ (format nil "~:[+~;-~]~2,'0D:~2,'0D"
+ (> zone 0) h (round (* 60 m)))))))
+ (multiple-value-bind (second minute hour day month year dow dst zone)
+ (decode-universal-time time-value)
+ (declare (ignore dow))
+ (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D~:[~*~;~A~]"
+ year month day hour minute second
+ include-timezone-p (format-iso8601-timezone (if dst
+ (+ zone 1)
+ zone))))))
+
+(defmethod emacs-inspect ((i integer))
+ (append
+ `(,(format nil "Value: ~D = #x~8,'0X = #o~O = #b~,,' ,8:B~@[ = ~E~]"
+ i i i i (ignore-errors (coerce i 'float)))
+ (:newline))
+ (when (< -1 i char-code-limit)
+ (label-value-line "Code-char" (code-char i)))
+ (label-value-line "Integer-length" (integer-length i))
+ (ignore-errors
+ (label-value-line "Universal-time" (format-iso8601-time i t)))))
+
+(defmethod emacs-inspect ((c complex))
+ (label-value-line*
+ ("Real part" (realpart c))
+ ("Imaginary part" (imagpart c))))
+
+(defmethod emacs-inspect ((r ratio))
+ (label-value-line*
+ ("Numerator" (numerator r))
+ ("Denominator" (denominator r))
+ ("As float" (float r))))
+
+(defmethod emacs-inspect ((f float))
+ (cond
+ ((> f most-positive-long-float)
+ (list "Positive infinity."))
+ ((< f most-negative-long-float)
+ (list "Negative infinity."))
+ ((not (= f f))
+ (list "Not a Number."))
+ (t
+ (multiple-value-bind (significand exponent sign) (decode-float f)
+ (append
+ `("Scientific: " ,(format nil "~E" f) (:newline)
+ "Decoded: "
+ (:value ,sign) " * "
+ (:value ,significand) " * "
+ (:value ,(float-radix f)) "^"
+ (:value ,exponent) (:newline))
+ (label-value-line "Digits" (float-digits f))
+ (label-value-line "Precision" (float-precision f)))))))
+
+(defun make-pathname-ispec (pathname position)
+ `("Pathname: "
+ (:value ,pathname)
+ (:newline) " "
+ ,@(when position
+ `((:action "[visit file and show current position]"
+ ,(lambda ()
+ (ed-in-emacs `(,pathname :position ,position :bytep t)))
+ :refreshp nil)
+ (:newline)))))
+
+(defun make-file-stream-ispec (stream)
+ ;; SBCL's socket stream are file-stream but are not associated to
+ ;; any pathname.
+ (let ((pathname (ignore-errors (pathname stream))))
+ (when pathname
+ (make-pathname-ispec pathname (and (open-stream-p stream)
+ (file-position stream))))))
+
+(defmethod emacs-inspect ((stream file-stream))
+ (multiple-value-bind (content)
+ (call-next-method)
+ (append (make-file-stream-ispec stream) content)))
+
+(defmethod emacs-inspect ((condition stream-error))
+ (multiple-value-bind (content)
+ (call-next-method)
+ (let ((stream (stream-error-stream condition)))
+ (append (when (typep stream 'file-stream)
+ (make-file-stream-ispec stream))
+ content))))
+
+(defun common-seperated-spec (list &optional (callback (lambda (v)
+ `(:value ,v))))
+ (butlast
+ (loop
+ for i in list
+ collect (funcall callback i)
+ collect ", ")))
+
+(defun inspector-princ (list)
+ "Like princ-to-string, but don't rewrite (function foo) as #'foo.
+Do NOT pass circular lists to this function."
+ (let ((*print-pprint-dispatch* (copy-pprint-dispatch)))
+ (set-pprint-dispatch '(cons (member function)) nil)
+ (princ-to-string list)))
+
+(provide :swank-fancy-inspector)
diff --git a/vim/bundle/slimv/slime/contrib/swank-fuzzy.lisp b/vim/bundle/slimv/slime/contrib/swank-fuzzy.lisp
new file mode 100644
index 0000000..bfd274f
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-fuzzy.lisp
@@ -0,0 +1,706 @@
+;;; swank-fuzzy.lisp --- fuzzy symbol completion
+;;
+;; Authors: Brian Downing <bdowning@lavos.net>
+;; Tobias C. Rittweiler <tcr@freebits.de>
+;; and others
+;;
+;; License: Public Domain
+;;
+
+
+(in-package :swank)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (swank-require :swank-util)
+ (swank-require :swank-c-p-c))
+
+(defvar *fuzzy-duplicate-symbol-filter* :nearest-package
+ "Specifies how fuzzy-matching handles \"duplicate\" symbols.
+Possible values are :NEAREST-PACKAGE, :HOME-PACKAGE, :ALL, or a custom
+function. See Fuzzy Completion in the manual for details.")
+
+(export '*fuzzy-duplicate-symbol-filter*)
+
+;;; For nomenclature of the fuzzy completion section, please read
+;;; through the following docstring.
+
+(defslimefun fuzzy-completions (string default-package-name
+ &key limit time-limit-in-msec)
+"Returns a list of two values:
+
+ An (optionally limited to LIMIT best results) list of fuzzy
+ completions for a symbol designator STRING. The list will be
+ sorted by score, most likely match first.
+
+ A flag that indicates whether or not TIME-LIMIT-IN-MSEC has
+ been exhausted during computation. If that parameter's value is
+ NIL or 0, no time limit is assumed.
+
+The main result is a list of completion objects, where a completion
+object is:
+
+ (COMPLETED-STRING SCORE (&rest CHUNKS) CLASSIFICATION-STRING)
+
+where a CHUNK is a description of a matched substring:
+
+ (OFFSET SUBSTRING)
+
+and FLAGS is short string describing properties of the symbol (see
+SYMBOL-CLASSIFICATION-STRING).
+
+E.g., completing \"mvb\" in a package that uses COMMON-LISP would
+return something like:
+
+ ((\"multiple-value-bind\" 26.588236 ((0 \"m\") (9 \"v\") (15 \"b\"))
+ (:FBOUNDP :MACRO))
+ ...)
+
+If STRING is package qualified the result list will also be
+qualified. If string is non-qualified the result strings are
+also not qualified and are considered relative to
+DEFAULT-PACKAGE-NAME.
+
+Which symbols are candidates for matching depends on the symbol
+designator's format. The cases are as follows:
+ FOO - Symbols accessible in the buffer package.
+ PKG:FOO - Symbols external in package PKG.
+ PKG::FOO - Symbols accessible in package PKG."
+ ;; For Emacs we allow both NIL and 0 as value of TIME-LIMIT-IN-MSEC
+ ;; to denote an infinite time limit. Internally, we only use NIL for
+ ;; that purpose, to be able to distinguish between "no time limit
+ ;; alltogether" and "current time limit already exhausted." So we've
+ ;; got to canonicalize its value at first:
+ (let* ((no-time-limit-p (or (not time-limit-in-msec)
+ (zerop time-limit-in-msec)))
+ (time-limit (if no-time-limit-p nil time-limit-in-msec)))
+ (multiple-value-bind (completion-set interrupted-p)
+ (fuzzy-completion-set string default-package-name :limit limit
+ :time-limit-in-msec time-limit)
+ ;; We may send this as elisp [] arrays to spare a coerce here,
+ ;; but then the network serialization were slower by handling arrays.
+ ;; Instead we limit the number of completions that is transferred
+ ;; (the limit is set from Emacs.)
+ (list (coerce completion-set 'list) interrupted-p))))
+
+
+;;; A Fuzzy Matching -- Not to be confused with a fuzzy completion
+;;; object that will be sent back to Emacs, as described above.
+
+(defstruct (fuzzy-matching (:conc-name fuzzy-matching.)
+ (:predicate fuzzy-matching-p)
+ (:constructor make-fuzzy-matching
+ (symbol package-name score package-chunks
+ symbol-chunks &key (symbol-p t))))
+ symbol ; The symbol that has been found to match.
+ symbol-p ; To deffirentiate between completeing
+ ; package: and package:nil
+ package-name ; The name of the package where SYMBOL was found in.
+ ; (This is not necessarily the same as the home-package
+ ; of SYMBOL, because the SYMBOL can be internal to
+ ; lots of packages; also think of package nicknames.)
+ score ; The higher the better SYMBOL is a match.
+ package-chunks ; Chunks pertaining to the package identifier of SYMBOL.
+ symbol-chunks) ; Chunks pertaining to SYMBOL's name.
+
+(defun %fuzzy-extract-matching-info (fuzzy-matching user-input-string)
+ (multiple-value-bind (_ user-package-name __ input-internal-p)
+ (parse-completion-arguments user-input-string nil)
+ (declare (ignore _ __))
+ (with-struct (fuzzy-matching. score symbol package-name package-chunks
+ symbol-chunks symbol-p)
+ fuzzy-matching
+ (let (symbol-name real-package-name internal-p)
+ (cond (symbol-p ; symbol fuzzy matching?
+ (setf symbol-name (symbol-name symbol))
+ (setf internal-p input-internal-p)
+ (setf real-package-name (cond ((keywordp symbol) "")
+ ((not user-package-name) nil)
+ (t package-name))))
+ (t ; package fuzzy matching?
+ (setf symbol-name "")
+ (setf real-package-name package-name)
+ ;; If no explicit package name was given by the user
+ ;; (e.g. input was "asdf"), we want to append only
+ ;; one colon ":" to the package names.
+ (setf internal-p (if user-package-name input-internal-p nil))))
+ (values symbol-name
+ real-package-name
+ (if user-package-name internal-p nil)
+ (completion-output-symbol-converter user-input-string)
+ (completion-output-package-converter user-input-string))))))
+
+(defun fuzzy-format-matching (fuzzy-matching user-input-string)
+ "Returns the completion (\"foo:bar\") that's represented by FUZZY-MATCHING."
+ (multiple-value-bind (symbol-name package-name internal-p
+ symbol-converter package-converter)
+ (%fuzzy-extract-matching-info fuzzy-matching user-input-string)
+ (setq symbol-name (and symbol-name
+ (funcall symbol-converter symbol-name)))
+ (setq package-name (and package-name
+ (funcall package-converter package-name)))
+ (let ((result (untokenize-symbol package-name internal-p symbol-name)))
+ ;; We return the length of the possibly added prefix as second value.
+ (values result (search symbol-name result)))))
+
+(defun fuzzy-convert-matching-for-emacs (fuzzy-matching user-input-string)
+ "Converts a result from the fuzzy completion core into something
+that emacs is expecting. Converts symbols to strings, fixes case
+issues, and adds information (as a string) describing if the symbol is
+bound, fbound, a class, a macro, a generic-function, a
+special-operator, or a package."
+ (with-struct (fuzzy-matching. symbol score package-chunks symbol-chunks
+ symbol-p)
+ fuzzy-matching
+ (multiple-value-bind (name added-length)
+ (fuzzy-format-matching fuzzy-matching user-input-string)
+ (list name
+ (format nil "~,2f" score)
+ (append package-chunks
+ (mapcar (lambda (chunk)
+ ;; Fix up chunk positions to account for possible
+ ;; added package identifier.
+ (let ((offset (first chunk))
+ (string (second chunk)))
+ (list (+ added-length offset) string)))
+ symbol-chunks))
+ (if symbol-p
+ (symbol-classification-string symbol)
+ "-------p")))))
+
+(defun fuzzy-completion-set (string default-package-name
+ &key limit time-limit-in-msec)
+ "Returns two values: an array of completion objects, sorted by
+their score, that is how well they are a match for STRING
+according to the fuzzy completion algorithm. If LIMIT is set,
+only the top LIMIT results will be returned. Additionally, a flag
+is returned that indicates whether or not TIME-LIMIT-IN-MSEC was
+exhausted."
+ (check-type limit (or null (integer 0 #.(1- most-positive-fixnum))))
+ (check-type time-limit-in-msec
+ (or null (integer 0 #.(1- most-positive-fixnum))))
+ (multiple-value-bind (matchings interrupted-p)
+ (fuzzy-generate-matchings string default-package-name time-limit-in-msec)
+ (when (and limit
+ (> limit 0)
+ (< limit (length matchings)))
+ (if (array-has-fill-pointer-p matchings)
+ (setf (fill-pointer matchings) limit)
+ (setf matchings (make-array limit :displaced-to matchings))))
+ (map-into matchings #'(lambda (m)
+ (fuzzy-convert-matching-for-emacs m string))
+ matchings)
+ (values matchings interrupted-p)))
+
+
+(defun fuzzy-generate-matchings (string default-package-name
+ time-limit-in-msec)
+ "Does all the hard work for FUZZY-COMPLETION-SET. If
+TIME-LIMIT-IN-MSEC is NIL, an infinite time limit is assumed."
+ (multiple-value-bind (parsed-symbol-name parsed-package-name
+ package internal-p)
+ (parse-completion-arguments string default-package-name)
+ (flet ((fix-up (matchings parent-package-matching)
+ ;; The components of each matching in MATCHINGS have been computed
+ ;; relatively to PARENT-PACKAGE-MATCHING. Make them absolute.
+ (let* ((p parent-package-matching)
+ (p.name (fuzzy-matching.package-name p))
+ (p.score (fuzzy-matching.score p))
+ (p.chunks (fuzzy-matching.package-chunks p)))
+ (map-into
+ matchings
+ (lambda (m)
+ (let ((m.score (fuzzy-matching.score m)))
+ (setf (fuzzy-matching.package-name m) p.name)
+ (setf (fuzzy-matching.package-chunks m) p.chunks)
+ (setf (fuzzy-matching.score m)
+ (if (equal parsed-symbol-name "")
+ ;; Make package matchings be sorted before all
+ ;; the relative symbol matchings while preserving
+ ;; over all orderness.
+ (/ p.score 100)
+ (+ p.score m.score)))
+ m))
+ matchings)))
+ (find-symbols (designator package time-limit &optional filter)
+ (fuzzy-find-matching-symbols designator package
+ :time-limit-in-msec time-limit
+ :external-only (not internal-p)
+ :filter (or filter #'identity)))
+ (find-packages (designator time-limit)
+ (fuzzy-find-matching-packages designator
+ :time-limit-in-msec time-limit))
+ (maybe-find-local-package (name)
+ (or (find-locally-nicknamed-package name *buffer-package*)
+ (find-package name))))
+ (let ((time-limit time-limit-in-msec) (symbols) (packages) (results)
+ (dedup-table (make-hash-table :test #'equal)))
+ (cond ((not parsed-package-name) ; E.g. STRING = "asd"
+ ;; We don't know if user is searching for a package or a symbol
+ ;; within his current package. So we try to find either.
+ (setf (values packages time-limit)
+ (find-packages parsed-symbol-name time-limit))
+ (setf (values symbols time-limit)
+ (find-symbols parsed-symbol-name package time-limit)))
+ ((string= parsed-package-name "") ; E.g. STRING = ":" or ":foo"
+ (setf (values symbols time-limit)
+ (find-symbols parsed-symbol-name package time-limit)))
+ (t ; E.g. STRING = "asd:" or "asd:foo"
+ ;; Find fuzzy matchings of the denoted package identifier part.
+ ;; After that, find matchings for the denoted symbol identifier
+ ;; relative to all the packages found.
+ (multiple-value-bind (symbol-packages rest-time-limit)
+ (find-packages parsed-package-name time-limit-in-msec)
+ ;; We want to traverse the found packages in the order of
+ ;; their score, since those with higher score presumably
+ ;; represent better choices. (This is important because some
+ ;; packages may never be looked at if time limit exhausts
+ ;; during traversal.)
+ (setf symbol-packages
+ (sort symbol-packages #'fuzzy-matching-greaterp))
+ (loop
+ for package-matching across symbol-packages
+ for package = (maybe-find-local-package
+ (fuzzy-matching.package-name
+ package-matching))
+ while (or (not time-limit) (> rest-time-limit 0)) do
+ (multiple-value-bind (matchings remaining-time)
+ ;; The duplication filter removes all those symbols
+ ;; which are present in more than one package
+ ;; match. See *FUZZY-DUPLICATE-SYMBOL-FILTER*
+ (find-symbols parsed-symbol-name package rest-time-limit
+ (%make-duplicate-symbols-filter
+ package-matching symbol-packages dedup-table))
+ (setf matchings (fix-up matchings package-matching))
+ (setf symbols (concatenate 'vector symbols matchings))
+ (setf rest-time-limit remaining-time)
+ (let ((guessed-sort-duration
+ (%guess-sort-duration (length symbols))))
+ (when (and rest-time-limit
+ (<= rest-time-limit guessed-sort-duration))
+ (decf rest-time-limit guessed-sort-duration)
+ (loop-finish))))
+ finally
+ (setf time-limit rest-time-limit)
+ (when (equal parsed-symbol-name "") ; E.g. STRING = "asd:"
+ (setf packages symbol-packages))))))
+ ;; Sort by score; thing with equal score, sort alphabetically.
+ ;; (Especially useful when PARSED-SYMBOL-NAME is empty, and all
+ ;; possible completions are to be returned.)
+ (setf results (concatenate 'vector symbols packages))
+ (setf results (sort results #'fuzzy-matching-greaterp))
+ (values results (and time-limit (<= time-limit 0)))))))
+
+(defun %guess-sort-duration (length)
+ ;; These numbers are pretty much arbitrary, except that they're
+ ;; vaguely correct on my machine with SBCL. Yes, this is an ugly
+ ;; kludge, but it's better than before (where this didn't exist at
+ ;; all, which essentially meant, that this was taken to be 0.)
+ (if (zerop length)
+ 0
+ (let ((comparasions (* 3.8 (* length (log length 2)))))
+ (* 1000 (* comparasions (expt 10 -7)))))) ; msecs
+
+(defun %make-duplicate-symbols-filter (current-package-matching fuzzy-package-matchings dedup-table)
+ ;; Returns a filter function based on *FUZZY-DUPLICATE-SYMBOL-FILTER*.
+ (case *fuzzy-duplicate-symbol-filter*
+ (:home-package
+ ;; Return a filter function that takes a symbol, and which returns T
+ ;; if and only if /no/ matching in FUZZY-PACKAGE-MATCHINGS represents
+ ;; the home-package of the symbol passed.
+ (let ((packages (mapcar #'(lambda (m)
+ (find-package (fuzzy-matching.package-name m)))
+ (remove current-package-matching
+ (coerce fuzzy-package-matchings 'list)))))
+ #'(lambda (symbol)
+ (not (member (symbol-package symbol) packages)))))
+ (:nearest-package
+ ;; Keep only the first occurence of the symbol.
+ #'(lambda (symbol)
+ (unless (gethash (symbol-name symbol) dedup-table)
+ (setf (gethash (symbol-name symbol) dedup-table) t))))
+ (:all
+ ;; No filter
+ #'identity)
+ (t
+ (typecase *fuzzy-duplicate-symbol-filter*
+ (function
+ ;; Custom filter
+ (funcall *fuzzy-duplicate-symbol-filter*
+ (fuzzy-matching.package-name current-package-matching)
+ (map 'list #'fuzzy-matching.package-name fuzzy-package-matchings)
+ dedup-table))
+ (t
+ ;; Bad filter value
+ (warn "bad *FUZZY-DUPLICATE-SYMBOL-FILTER* value: ~s"
+ *fuzzy-duplicate-symbol-filter*)
+ #'identity)))))
+
+(defun fuzzy-matching-greaterp (m1 m2)
+ "Returns T if fuzzy-matching M1 should be sorted before M2.
+Basically just the scores of the two matchings are compared, and
+the match with higher score wins. For the case that the score is
+equal, the one which comes alphabetically first wins."
+ (declare (type fuzzy-matching m1 m2))
+ (let ((score1 (fuzzy-matching.score m1))
+ (score2 (fuzzy-matching.score m2)))
+ (cond ((> score1 score2) t)
+ ((< score1 score2) nil) ; total order
+ (t
+ (let ((name1 (symbol-name (fuzzy-matching.symbol m1)))
+ (name2 (symbol-name (fuzzy-matching.symbol m2))))
+ (string< name1 name2))))))
+
+(declaim (ftype (function () (integer 0)) get-real-time-msecs))
+(defun get-real-time-in-msecs ()
+ (let ((units-per-msec (max 1 (floor internal-time-units-per-second 1000))))
+ (values (floor (get-internal-real-time) units-per-msec))))
+
+(defun fuzzy-find-matching-symbols
+ (string package &key (filter #'identity) external-only time-limit-in-msec)
+ "Returns two values: a vector of fuzzy matchings for matching
+symbols in PACKAGE, using the fuzzy completion algorithm, and the
+remaining time limit.
+
+Only those symbols are considered of which FILTER does return T.
+
+If EXTERNAL-ONLY is true, only external symbols are considered. A
+TIME-LIMIT-IN-MSEC of NIL is considered no limit; if it's zero or
+negative, perform a NOP."
+ (let ((time-limit-p (and time-limit-in-msec t))
+ (time-limit (or time-limit-in-msec 0))
+ (rtime-at-start (get-real-time-in-msecs))
+ (package-name (package-name package))
+ (count 0))
+ (declare (type boolean time-limit-p))
+ (declare (type integer time-limit rtime-at-start))
+ (declare (type (integer 0 #.(1- most-positive-fixnum)) count))
+
+ (flet ((recompute-remaining-time (old-remaining-time)
+ (cond ((not time-limit-p)
+ ;; propagate NIL back as infinite time limit
+ (values nil nil))
+ ((> count 0) ; ease up on getting internal time like crazy
+ (setf count (mod (1+ count) 128))
+ (values nil old-remaining-time))
+ (t (let* ((elapsed-time (- (get-real-time-in-msecs)
+ rtime-at-start))
+ (remaining (- time-limit elapsed-time)))
+ (values (<= remaining 0) remaining)))))
+ (perform-fuzzy-match (string symbol-name)
+ (let* ((converter (completion-output-symbol-converter string))
+ (converted-symbol-name (funcall converter symbol-name)))
+ (compute-highest-scoring-completion string
+ converted-symbol-name))))
+ (let ((completions (make-array 256 :adjustable t :fill-pointer 0))
+ (rest-time-limit time-limit))
+ (do-symbols* (symbol package)
+ (multiple-value-bind (exhausted? remaining-time)
+ (recompute-remaining-time rest-time-limit)
+ (setf rest-time-limit remaining-time)
+ (cond (exhausted? (return))
+ ((not (and (or (not external-only)
+ (symbol-external-p symbol package))
+ (funcall filter symbol))))
+ ((string= "" string) ; "" matches always
+ (vector-push-extend
+ (make-fuzzy-matching symbol package-name
+ 0.0 '() '())
+ completions))
+ (t
+ (multiple-value-bind (match-result score)
+ (perform-fuzzy-match string (symbol-name symbol))
+ (when match-result
+ (vector-push-extend
+ (make-fuzzy-matching symbol package-name score
+ '() match-result)
+ completions)))))))
+ (values completions rest-time-limit)))))
+
+(defun fuzzy-find-matching-packages (name &key time-limit-in-msec)
+ "Returns a vector of fuzzy matchings for each package that is
+similiar to NAME, and the remaining time limit.
+Cf. FUZZY-FIND-MATCHING-SYMBOLS."
+ (let ((time-limit-p (and time-limit-in-msec t))
+ (time-limit (or time-limit-in-msec 0))
+ (rtime-at-start (get-real-time-in-msecs))
+ (converter (completion-output-package-converter name))
+ (completions (make-array 32 :adjustable t :fill-pointer 0)))
+ (declare (type boolean time-limit-p))
+ (declare (type integer time-limit rtime-at-start))
+ (declare (type function converter))
+ (flet ((match-package (names)
+ (loop with max-pkg-name = ""
+ with max-result = nil
+ with max-score = 0
+ for package-name in names
+ for converted-name = (funcall converter package-name)
+ do
+ (multiple-value-bind (result score)
+ (compute-highest-scoring-completion name
+ converted-name)
+ (when (and result (> score max-score))
+ (setf max-pkg-name package-name)
+ (setf max-result result)
+ (setf max-score score)))
+ finally
+ (when max-result
+ (vector-push-extend
+ (make-fuzzy-matching nil max-pkg-name
+ max-score max-result '()
+ :symbol-p nil)
+ completions)))))
+ (cond ((and time-limit-p (<= time-limit 0))
+ (values #() time-limit))
+ (t
+ (loop for (nick) in (package-local-nicknames *buffer-package*)
+ do
+ (match-package (list nick)))
+ (loop for package in (list-all-packages)
+ do
+ ;; Find best-matching package-nickname:
+ (match-package (package-names package))
+ finally
+ (return
+ (values completions
+ (and time-limit-p
+ (let ((elapsed-time (- (get-real-time-in-msecs)
+ rtime-at-start)))
+ (- time-limit elapsed-time)))))))))))
+
+
+(defslimefun fuzzy-completion-selected (original-string completion)
+ "This function is called by Slime when a fuzzy completion is
+selected by the user. It is for future expansion to make
+testing, say, a machine learning algorithm for completion scoring
+easier.
+
+ORIGINAL-STRING is the string the user completed from, and
+COMPLETION is the completion object (see docstring for
+SWANK:FUZZY-COMPLETIONS) corresponding to the completion that the
+user selected."
+ (declare (ignore original-string completion))
+ nil)
+
+
+;;;;; Fuzzy completion core
+
+(defparameter *fuzzy-recursion-soft-limit* 30
+ "This is a soft limit for recursion in
+RECURSIVELY-COMPUTE-MOST-COMPLETIONS. Without this limit,
+completing a string such as \"ZZZZZZ\" with a symbol named
+\"ZZZZZZZZZZZZZZZZZZZZZZZ\" will result in explosive recursion to
+find all the ways it can match.
+
+Most natural language searches and symbols do not have this
+problem -- this is only here as a safeguard.")
+(declaim (fixnum *fuzzy-recursion-soft-limit*))
+
+(defvar *all-chunks* '())
+(declaim (type list *all-chunks*))
+
+(defun compute-highest-scoring-completion (short full)
+ "Finds the highest scoring way to complete the abbreviation
+SHORT onto the string FULL, using CHAR= as a equality function for
+letters. Returns two values: The first being the completion
+chunks of the highest scorer, and the second being the score."
+ (let* ((scored-results
+ (mapcar #'(lambda (result)
+ (cons (score-completion result short full) result))
+ (compute-most-completions short full)))
+ (winner (first (sort scored-results #'> :key #'first))))
+ (values (rest winner) (first winner))))
+
+(defun compute-most-completions (short full)
+ "Finds most possible ways to complete FULL with the letters in SHORT.
+Calls RECURSIVELY-COMPUTE-MOST-COMPLETIONS recursively. Returns
+a list of (&rest CHUNKS), where each CHUNKS is a description of
+how a completion matches."
+ (let ((*all-chunks* nil))
+ (recursively-compute-most-completions short full 0 0 nil nil nil t)
+ *all-chunks*))
+
+(defun recursively-compute-most-completions
+ (short full
+ short-index initial-full-index
+ chunks current-chunk current-chunk-pos
+ recurse-p)
+ "Recursively (if RECURSE-P is true) find /most/ possible ways
+to fuzzily map the letters in SHORT onto FULL, using CHAR= to
+determine if two letters match.
+
+A chunk is a list of elements that have matched consecutively.
+When consecutive matches stop, it is coerced into a string,
+paired with the starting position of the chunk, and pushed onto
+CHUNKS.
+
+Whenever a letter matches, if RECURSE-P is true,
+RECURSIVELY-COMPUTE-MOST-COMPLETIONS calls itself with a position
+one index ahead, to find other possibly higher scoring
+possibilities. If there are less than
+*FUZZY-RECURSION-SOFT-LIMIT* results in *ALL-CHUNKS* currently,
+this call will also recurse.
+
+Once a word has been completely matched, the chunks are pushed
+onto the special variable *ALL-CHUNKS* and the function returns."
+ (declare (optimize speed)
+ (type fixnum short-index initial-full-index)
+ (type list current-chunk)
+ (simple-string short full))
+ (flet ((short-cur ()
+ "Returns the next letter from the abbreviation, or NIL
+ if all have been used."
+ (if (= short-index (length short))
+ nil
+ (aref short short-index)))
+ (add-to-chunk (char pos)
+ "Adds the CHAR at POS in FULL to the current chunk,
+ marking the start position if it is empty."
+ (unless current-chunk
+ (setf current-chunk-pos pos))
+ (push char current-chunk))
+ (collect-chunk ()
+ "Collects the current chunk to CHUNKS and prepares for
+ a new chunk."
+ (when current-chunk
+ (let ((current-chunk-as-string
+ (nreverse
+ (make-array (length current-chunk)
+ :element-type 'character
+ :initial-contents current-chunk))))
+ (push (list current-chunk-pos current-chunk-as-string) chunks)
+ (setf current-chunk nil
+ current-chunk-pos nil)))))
+ ;; If there's an outstanding chunk coming in collect it. Since
+ ;; we're recursively called on skipping an input character, the
+ ;; chunk can't possibly continue on.
+ (when current-chunk (collect-chunk))
+ (do ((pos initial-full-index (1+ pos)))
+ ((= pos (length full)))
+ (let ((cur-char (aref full pos)))
+ (if (and (short-cur)
+ (char= cur-char (short-cur)))
+ (progn
+ (when recurse-p
+ ;; Try other possibilities, limiting insanely deep
+ ;; recursion somewhat.
+ (recursively-compute-most-completions
+ short full short-index (1+ pos)
+ chunks current-chunk current-chunk-pos
+ (not (> (length *all-chunks*)
+ *fuzzy-recursion-soft-limit*))))
+ (incf short-index)
+ (add-to-chunk cur-char pos))
+ (collect-chunk))))
+ (collect-chunk)
+ ;; If we've exhausted the short characters we have a match.
+ (if (short-cur)
+ nil
+ (let ((rev-chunks (reverse chunks)))
+ (push rev-chunks *all-chunks*)
+ rev-chunks))))
+
+
+;;;;; Fuzzy completion scoring
+
+(defvar *fuzzy-completion-symbol-prefixes* "*+-%&?<"
+ "Letters that are likely to be at the beginning of a symbol.
+Letters found after one of these prefixes will be scored as if
+they were at the beginning of ths symbol.")
+(defvar *fuzzy-completion-symbol-suffixes* "*+->"
+ "Letters that are likely to be at the end of a symbol.
+Letters found before one of these suffixes will be scored as if
+they were at the end of the symbol.")
+(defvar *fuzzy-completion-word-separators* "-/."
+ "Letters that separate different words in symbols. Letters
+after one of these symbols will be scores more highly than other
+letters.")
+
+(defun score-completion (completion short full)
+ "Scores the completion chunks COMPLETION as a completion from
+the abbreviation SHORT to the full string FULL. COMPLETION is a
+list like:
+ ((0 \"mul\") (9 \"v\") (15 \"b\"))
+Which, if SHORT were \"mulvb\" and full were \"multiple-value-bind\",
+would indicate that it completed as such (completed letters
+capitalized):
+ MULtiple-Value-Bind
+
+Letters are given scores based on their position in the string.
+Letters at the beginning of a string or after a prefix letter at
+the beginning of a string are scored highest. Letters after a
+word separator such as #\- are scored next highest. Letters at
+the end of a string or before a suffix letter at the end of a
+string are scored medium, and letters anywhere else are scored
+low.
+
+If a letter is directly after another matched letter, and its
+intrinsic value in that position is less than a percentage of the
+previous letter's value, it will use that percentage instead.
+
+Finally, a small scaling factor is applied to favor shorter
+matches, all other things being equal."
+ (labels ((at-beginning-p (pos)
+ (= pos 0))
+ (after-prefix-p (pos)
+ (and (= pos 1)
+ (find (aref full 0) *fuzzy-completion-symbol-prefixes*)))
+ (word-separator-p (pos)
+ (find (aref full pos) *fuzzy-completion-word-separators*))
+ (after-word-separator-p (pos)
+ (find (aref full (1- pos)) *fuzzy-completion-word-separators*))
+ (at-end-p (pos)
+ (= pos (1- (length full))))
+ (before-suffix-p (pos)
+ (and (= pos (- (length full) 2))
+ (find (aref full (1- (length full)))
+ *fuzzy-completion-symbol-suffixes*)))
+ (score-or-percentage-of-previous (base-score pos chunk-pos)
+ (if (zerop chunk-pos)
+ base-score
+ (max base-score
+ (+ (* (score-char (1- pos) (1- chunk-pos)) 0.85)
+ (expt 1.2 chunk-pos)))))
+ (score-char (pos chunk-pos)
+ (score-or-percentage-of-previous
+ (cond ((at-beginning-p pos) 10)
+ ((after-prefix-p pos) 10)
+ ((word-separator-p pos) 1)
+ ((after-word-separator-p pos) 8)
+ ((at-end-p pos) 6)
+ ((before-suffix-p pos) 6)
+ (t 1))
+ pos chunk-pos))
+ (score-chunk (chunk)
+ (loop for chunk-pos below (length (second chunk))
+ for pos from (first chunk)
+ summing (score-char pos chunk-pos))))
+ (let* ((chunk-scores (mapcar #'score-chunk completion))
+ (length-score (/ 10.0 (1+ (- (length full) (length short))))))
+ (values
+ (+ (reduce #'+ chunk-scores) length-score)
+ (list (mapcar #'list chunk-scores completion) length-score)))))
+
+(defun highlight-completion (completion full)
+ "Given a chunk definition COMPLETION and the string FULL,
+HIGHLIGHT-COMPLETION will create a string that demonstrates where
+the completion matched in the string. Matches will be
+capitalized, while the rest of the string will be lower-case."
+ (let ((highlit (nstring-downcase (copy-seq full))))
+ (dolist (chunk completion)
+ (setf highlit (nstring-upcase highlit
+ :start (first chunk)
+ :end (+ (first chunk)
+ (length (second chunk))))))
+ highlit))
+
+(defun format-fuzzy-completion-set (winners)
+ "Given a list of completion objects such as on returned by
+FUZZY-COMPLETION-SET, format the list into user-readable output
+for interactive debugging purpose."
+ (let ((max-len
+ (loop for winner in winners maximizing (length (first winner)))))
+ (loop for (sym score result) in winners do
+ (format t "~&~VA score ~8,2F ~A"
+ max-len (highlight-completion result sym) score result))))
+
+(provide :swank-fuzzy)
diff --git a/vim/bundle/slimv/slime/contrib/swank-hyperdoc.lisp b/vim/bundle/slimv/slime/contrib/swank-hyperdoc.lisp
new file mode 100644
index 0000000..1e34a1d
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-hyperdoc.lisp
@@ -0,0 +1,18 @@
+(in-package :swank)
+
+(defslimefun hyperdoc (string)
+ (let ((hyperdoc-package (find-package :hyperdoc)))
+ (when hyperdoc-package
+ (multiple-value-bind (symbol foundp symbol-name package)
+ (parse-symbol string *buffer-package*)
+ (declare (ignore symbol))
+ (when foundp
+ (funcall (find-symbol (string :lookup) hyperdoc-package)
+ (package-name (if (member package (cons *buffer-package*
+ (package-use-list
+ *buffer-package*)))
+ *buffer-package*
+ package))
+ symbol-name))))))
+
+(provide :swank-hyperdoc)
diff --git a/vim/bundle/slimv/slime/contrib/swank-indentation.lisp b/vim/bundle/slimv/slime/contrib/swank-indentation.lisp
new file mode 100644
index 0000000..67e638d
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-indentation.lisp
@@ -0,0 +1,140 @@
+(in-package :swank)
+
+(defvar *application-hints-tables* '()
+ "A list of hash tables mapping symbols to indentation hints (lists
+of symbols and numbers as per cl-indent.el). Applications can add hash
+tables to the list to change the auto indentation slime sends to
+emacs.")
+
+(defun has-application-indentation-hint-p (symbol)
+ (let ((default (load-time-value (gensym))))
+ (dolist (table *application-hints-tables*)
+ (let ((indentation (gethash symbol table default)))
+ (unless (eq default indentation)
+ (return-from has-application-indentation-hint-p
+ (values indentation t))))))
+ (values nil nil))
+
+(defun application-indentation-hint (symbol)
+ (let ((indentation (has-application-indentation-hint-p symbol)))
+ (labels ((walk (indentation-spec)
+ (etypecase indentation-spec
+ (null nil)
+ (number indentation-spec)
+ (symbol (string-downcase indentation-spec))
+ (cons (cons (walk (car indentation-spec))
+ (walk (cdr indentation-spec)))))))
+ (walk indentation))))
+
+;;; override swank version of this function
+(defun symbol-indentation (symbol)
+ "Return a form describing the indentation of SYMBOL.
+
+The form is to be used as the `common-lisp-indent-function' property
+in Emacs."
+ (cond
+ ((has-application-indentation-hint-p symbol)
+ (application-indentation-hint symbol))
+ ((and (macro-function symbol)
+ (not (known-to-emacs-p symbol)))
+ (let ((arglist (arglist symbol)))
+ (etypecase arglist
+ ((member :not-available)
+ nil)
+ (list
+ (macro-indentation arglist)))))
+ (t nil)))
+
+;;; More complex version.
+(defun macro-indentation (arglist)
+ (labels ((frob (list &optional base)
+ (if (every (lambda (x)
+ (member x '(nil "&rest") :test #'equal))
+ list)
+ ;; If there was nothing interesting, don't return anything.
+ nil
+ ;; Otherwise substitute leading NIL's with 4 or 1.
+ (let ((ok t))
+ (substitute-if (if base
+ 4
+ 1)
+ (lambda (x)
+ (if (and ok (not x))
+ t
+ (setf ok nil)))
+ list))))
+ (walk (list level &optional firstp)
+ (when (consp list)
+ (let ((head (car list)))
+ (if (consp head)
+ (let ((indent (frob (walk head (+ level 1) t))))
+ (cons (list* "&whole" (if (zerop level)
+ 4
+ 1)
+ indent) (walk (cdr list) level)))
+ (case head
+ ;; &BODY is &BODY, this is clear.
+ (&body
+ '("&body"))
+ ;; &KEY is tricksy. If it's at the base level, we want
+ ;; to indent them normally:
+ ;;
+ ;; (foo bar quux
+ ;; :quux t
+ ;; :zot nil)
+ ;;
+ ;; If it's at a destructuring level, we want indent of 1:
+ ;;
+ ;; (with-foo (var arg
+ ;; :foo t
+ ;; :quux nil)
+ ;; ...)
+ (&key
+ (if (zerop level)
+ '("&rest" nil)
+ '("&rest" 1)))
+ ;; &REST is tricksy. If it's at the front of
+ ;; destructuring, we want to indent by 1, otherwise
+ ;; normally:
+ ;;
+ ;; (foo (bar quux
+ ;; zot)
+ ;; ...)
+ ;;
+ ;; but
+ ;;
+ ;; (foo bar quux
+ ;; zot)
+ (&rest
+ (if (and (plusp level) firstp)
+ '("&rest" 1)
+ '("&rest" nil)))
+ ;; &WHOLE and &ENVIRONMENT are skipped as if they weren't there
+ ;; at all.
+ ((&whole &environment)
+ (walk (cddr list) level firstp))
+ ;; &OPTIONAL is indented normally -- and the &OPTIONAL marker
+ ;; itself is not counted.
+ (&optional
+ (walk (cdr list) level))
+ ;; Indent normally, walk the tail -- but
+ ;; unknown lambda-list keywords terminate the walk.
+ (otherwise
+ (unless (member head lambda-list-keywords)
+ (cons nil (walk (cdr list) level))))))))))
+ (frob (walk arglist 0 t) t)))
+
+#+nil
+(progn
+ (assert (equal '(4 4 ("&whole" 4 "&rest" 1) "&body")
+ (macro-indentation '(bar quux (&rest slots) &body body))))
+ (assert (equal nil
+ (macro-indentation '(a b c &rest more))))
+ (assert (equal '(4 4 4 "&body")
+ (macro-indentation '(a b c &body more))))
+ (assert (equal '(("&whole" 4 1 1 "&rest" 1) "&body")
+ (macro-indentation '((name zot &key foo bar) &body body))))
+ (assert (equal nil
+ (macro-indentation '(x y &key z)))))
+
+(provide :swank-indentation)
diff --git a/vim/bundle/slimv/slime/contrib/swank-kawa.scm b/vim/bundle/slimv/slime/contrib/swank-kawa.scm
new file mode 100644
index 0000000..843037b
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-kawa.scm
@@ -0,0 +1,2498 @@
+;;;; swank-kawa.scm --- Swank server for Kawa
+;;;
+;;; Copyright (C) 2007 Helmut Eller
+;;;
+;;; This file is licensed under the terms of the GNU General Public
+;;; License as distributed with Emacs (press C-h C-c for details).
+
+;;;; Installation
+;;
+;; 1. You need Kawa (version 2.x) and a JVM with debugger support.
+;;
+;; 2. Compile this file and create swank-kawa.jar with:
+;; java -cp kawa.jar:$JAVA_HOME/lib/tools.jar \
+;; -Xss2M kawa.repl --r7rs -d classes -C swank-kawa.scm &&
+;; jar cf swank-kawa.jar -C classes .
+;;
+;; 3. Add something like this to your .emacs:
+#|
+;; Kawa, Swank, and the debugger classes (tools.jar) must be in the
+;; classpath. You also need to start the debug agent.
+(setq slime-lisp-implementations
+ '((kawa
+ ("java"
+ ;; needed jar files
+ "-cp" "kawa-2.0.1.jar:swank-kawa.jar:/opt/jdk1.8.0/lib/tools.jar"
+ ;; channel for debugger
+ "-agentlib:jdwp=transport=dt_socket,server=y,suspend=n"
+ ;; depending on JVM, compiler may need more stack
+ "-Xss2M"
+ ;; kawa without GUI
+ "kawa.repl" "-s")
+ :init kawa-slime-init)))
+
+(defun kawa-slime-init (file _)
+ (setq slime-protocol-version 'ignore)
+ (format "%S\n"
+ `(begin (import (swank-kawa))
+ (start-swank ,file)
+ ;; Optionally add source paths of your code so
+ ;; that M-. works better:
+ ;;(set! swank-java-source-path
+ ;; (append
+ ;; '(,(expand-file-name "~/lisp/slime/contrib/")
+ ;; "/scratch/kawa")
+ ;; swank-java-source-path))
+ )))
+
+;; Optionally define a command to start it.
+(defun kawa ()
+ (interactive)
+ (slime 'kawa))
+
+|#
+;; 4. Start everything with M-- M-x slime kawa
+;;
+;;
+
+
+;;; Code:
+
+(define-library (swank macros)
+ (export df fun seq set fin esc
+ ! !! !s @ @s
+ when unless while dotimes dolist for packing with pushf == assert
+ mif mcase mlet mlet* typecase ignore-errors
+ ferror
+ )
+ (import (scheme base)
+ (only (kawa base)
+ syntax
+ quasisyntax
+ syntax-case
+ define-syntax-case
+ identifier?
+
+ invoke
+ invoke-static
+ field
+ static-field
+ instance?
+ try-finally
+ try-catch
+ primitive-throw
+
+ format
+ reverse!
+ as
+ ))
+ (begin "
+("
+
+(define (ferror fstring #!rest args)
+ (let ((err (<java.lang.Error>
+ (as <java.lang.String> (apply format fstring args)))))
+ (primitive-throw err)))
+
+(define (rewrite-lambda-list args)
+ (syntax-case args ()
+ (() #`())
+ ((rest x ...) (eq? #'rest #!rest) args)
+ ((optional x ...) (eq? #'optional #!optional) args)
+ ((var args ...) (identifier? #'var)
+ #`(var #,@(rewrite-lambda-list #'(args ...))))
+ (((var type) args ...) (identifier? #'var)
+ #`((var :: type) #,@(rewrite-lambda-list #'(args ...))))))
+
+(define-syntax df
+ (lambda (stx)
+ (syntax-case stx (=>)
+ ((df name (args ... => return-type) body ...)
+ #`(define (name #,@(rewrite-lambda-list #'(args ...))) :: return-type
+ (seq body ...)))
+ ((df name (args ...) body ...)
+ #`(define (name #,@(rewrite-lambda-list #'(args ...)))
+ (seq body ...))))))
+
+(define-syntax fun
+ (lambda (stx)
+ (syntax-case stx (=>)
+ ((fun (args ... => return-type) body ...)
+ #`(lambda #,(rewrite-lambda-list #'(args ...)) :: return-type
+ (seq body ...)))
+ ((fun (args ...) body ...)
+ #`(lambda #,(rewrite-lambda-list #'(args ...))
+ (seq body ...))))))
+
+(define-syntax fin
+ (syntax-rules ()
+ ((fin body handler ...)
+ (try-finally body (seq handler ...)))))
+
+(define-syntax seq
+ (syntax-rules ()
+ ((seq)
+ (begin #!void))
+ ((seq body ...)
+ (begin body ...))))
+
+(define-syntax esc
+ (syntax-rules ()
+ ((esc abort body ...)
+ (let* ((key (<symbol>))
+ (abort (lambda (val) (throw key val))))
+ (catch key
+ (lambda () body ...)
+ (lambda (key val) val))))))
+
+(define-syntax !
+ (syntax-rules ()
+ ((! name obj args ...)
+ (invoke obj 'name args ...))))
+
+(define-syntax !!
+ (syntax-rules ()
+ ((!! name1 name2 obj args ...)
+ (! name1 (! name2 obj args ...)))))
+
+(define-syntax !s
+ (syntax-rules ()
+ ((! class name args ...)
+ (invoke-static class 'name args ...))))
+
+(define-syntax @
+ (syntax-rules ()
+ ((@ name obj)
+ (field obj 'name))))
+
+(define-syntax @s
+ (syntax-rules (quote)
+ ((@s class name)
+ (static-field class (quote name)))))
+
+(define-syntax while
+ (syntax-rules ()
+ ((while exp body ...)
+ (do () ((not exp)) body ...))))
+
+(define-syntax dotimes
+ (syntax-rules ()
+ ((dotimes (i n result) body ...)
+ (let ((max :: <int> n))
+ (do ((i :: <int> 0 (as <int> (+ i 1))))
+ ((= i max) result)
+ body ...)))
+ ((dotimes (i n) body ...)
+ (dotimes (i n #f) body ...))))
+
+(define-syntax dolist
+ (syntax-rules ()
+ ((dolist (e list) body ... )
+ (for ((e list)) body ...))))
+
+(define-syntax for
+ (syntax-rules ()
+ ((for ((var iterable)) body ...)
+ (let ((iter (! iterator iterable)))
+ (while (! has-next iter)
+ ((lambda (var) body ...)
+ (! next iter)))))))
+
+(define-syntax packing
+ (syntax-rules ()
+ ((packing (var) body ...)
+ (let ((var :: <list> '()))
+ (let ((var (lambda (v) (set! var (cons v var)))))
+ body ...)
+ (reverse! var)))))
+
+;;(define-syntax loop
+;; (syntax-rules (for = then collect until)
+;; ((loop for var = init then step until test collect exp)
+;; (packing (pack)
+;; (do ((var init step))
+;; (test)
+;; (pack exp))))
+;; ((loop while test collect exp)
+;; (packing (pack) (while test (pack exp))))))
+
+(define-syntax with
+ (syntax-rules ()
+ ((with (vars ... (f args ...)) body ...)
+ (f args ... (lambda (vars ...) body ...)))))
+
+(define-syntax pushf
+ (syntax-rules ()
+ ((pushf value var)
+ (set! var (cons value var)))))
+
+(define-syntax ==
+ (syntax-rules ()
+ ((== x y)
+ (eq? x y))))
+
+(define-syntax set
+ (syntax-rules ()
+ ((set x y)
+ (let ((tmp y))
+ (set! x tmp)
+ tmp))
+ ((set x y more ...)
+ (begin (set! x y) (set more ...)))))
+
+(define-syntax assert
+ (syntax-rules ()
+ ((assert test)
+ (seq
+ (when (not test)
+ (error "Assertion failed" 'test))
+ 'ok))
+ ((assert test fstring args ...)
+ (seq
+ (when (not test)
+ (error "Assertion failed" 'test (format #f fstring args ...)))
+ 'ok))))
+
+(define-syntax mif
+ (syntax-rules (quote unquote _)
+ ((mif ('x value) then else)
+ (if (equal? 'x value) then else))
+ ((mif (,x value) then else)
+ (if (eq? x value) then else))
+ ((mif (() value) then else)
+ (if (eq? value '()) then else))
+ #| This variant produces no lambdas but breaks the compiler
+ ((mif ((p . ps) value) then else)
+ (let ((tmp value)
+ (fail? :: <int> 0)
+ (result #!null))
+ (if (instance? tmp <pair>)
+ (let ((tmp :: <pair> tmp))
+ (mif (p (! get-car tmp))
+ (mif (ps (! get-cdr tmp))
+ (set! result then)
+ (set! fail? -1))
+ (set! fail? -1)))
+ (set! fail? -1))
+ (if (= fail? 0) result else)))
+ |#
+ ((mif ((p . ps) value) then else)
+ (let ((fail (lambda () else))
+ (tmp value))
+ (if (instance? tmp <pair>)
+ (let ((tmp :: <pair> tmp))
+ (mif (p (! get-car tmp))
+ (mif (ps (! get-cdr tmp))
+ then
+ (fail))
+ (fail)))
+ (fail))))
+ ((mif (_ value) then else)
+ then)
+ ((mif (var value) then else)
+ (let ((var value)) then))
+ ((mif (pattern value) then)
+ (mif (pattern value) then (values)))))
+
+(define-syntax mcase
+ (syntax-rules ()
+ ((mcase exp (pattern body ...) more ...)
+ (let ((tmp exp))
+ (mif (pattern tmp)
+ (begin body ...)
+ (mcase tmp more ...))))
+ ((mcase exp) (ferror "mcase failed ~s\n~a" 'exp exp))))
+
+(define-syntax mlet
+ (syntax-rules ()
+ ((mlet (pattern value) body ...)
+ (let ((tmp value))
+ (mif (pattern tmp)
+ (begin body ...)
+ (error "mlet failed" tmp))))))
+
+(define-syntax mlet*
+ (syntax-rules ()
+ ((mlet* () body ...) (begin body ...))
+ ((mlet* ((pattern value) ms ...) body ...)
+ (mlet (pattern value) (mlet* (ms ...) body ...)))))
+
+(define-syntax typecase%
+ (syntax-rules (eql or satisfies)
+ ((typecase% var (#t body ...) more ...)
+ (seq body ...))
+ ((typecase% var ((eql value) body ...) more ...)
+ (cond ((eqv? var 'value) body ...)
+ (else (typecase% var more ...))))
+ ((typecase% var ((satisfies predicate) body ...) more ...)
+ (cond ((predicate var) body ...)
+ (else (typecase% var more ...))))
+ ((typecase% var ((or type) body ...) more ...)
+ (typecase% var (type body ...) more ...))
+ ((typecase% var ((or type ...) body ...) more ...)
+ (let ((f (lambda (var) body ...)))
+ (typecase% var
+ (type (f var)) ...
+ (#t (typecase% var more ...)))))
+ ((typecase% var (type body ...) more ...)
+ (cond ((instance? var type)
+ (let ((var :: type (as type var)))
+ body ...))
+ (else (typecase% var more ...))))
+ ((typecase% var)
+ (error "typecase% failed" var
+ (! getClass (as <object> var))))))
+
+(define-syntax typecase
+ (lambda (stx)
+ (syntax-case stx ()
+ ((_ exp more ...) (identifier? (syntax exp))
+ #`(typecase% exp more ...))
+ ((_ exp more ...)
+ #`(let ((tmp exp))
+ (typecase% tmp more ...))))))
+
+(define-syntax ignore-errors
+ (syntax-rules ()
+ ((ignore-errors body ...)
+ (try-catch (seq body ...)
+ (v <java.lang.Error> #f)
+ (v <java.lang.Exception> #f)))))
+
+))
+
+(define-library (swank-kawa)
+ (export start-swank
+ create-swank-server
+ swank-java-source-path
+ break)
+ (import (scheme base)
+ (scheme file)
+ (scheme repl)
+ (scheme read)
+ (scheme write)
+ (scheme eval)
+ (scheme process-context)
+ (swank macros)
+ (only (kawa base)
+
+ define-alias
+ define-variable
+
+ define-simple-class
+ this
+
+ invoke-special
+ instance?
+ as
+
+ primitive-throw
+ try-finally
+ try-catch
+ synchronized
+
+ call-with-input-string
+ call-with-output-string
+ force-output
+ format
+
+ make-process
+ command-parse
+
+ runnable
+
+ scheme-implementation-version
+ reverse!
+ )
+ (rnrs hashtables)
+ (only (gnu kawa slib syntaxutils) expand)
+ (only (kawa regex) regex-match))
+ (begin "
+("
+
+
+;;(define-syntax dc
+;; (syntax-rules ()
+;; ((dc name () %% (props ...) prop more ...)
+;; (dc name () %% (props ... (prop <object>)) more ...))
+;; ;;((dc name () %% (props ...) (prop type) more ...)
+;; ;; (dc name () %% (props ... (prop type)) more ...))
+;; ((dc name () %% ((prop type) ...))
+;; (define-simple-class name ()
+;; ((*init* (prop :: type) ...)
+;; (set (field (this) 'prop) prop) ...)
+;; (prop :type type) ...))
+;; ((dc name () props ...)
+;; (dc name () %% () props ...))))
+
+
+;;;; Aliases
+
+(define-alias <server-socket> java.net.ServerSocket)
+(define-alias <socket> java.net.Socket)
+(define-alias <in> java.io.InputStreamReader)
+(define-alias <out> java.io.OutputStreamWriter)
+(define-alias <in-port> gnu.kawa.io.InPort)
+(define-alias <out-port> gnu.kawa.io.OutPort)
+(define-alias <file> java.io.File)
+(define-alias <str> java.lang.String)
+(define-alias <builder> java.lang.StringBuilder)
+(define-alias <throwable> java.lang.Throwable)
+(define-alias <source-error> gnu.text.SourceError)
+(define-alias <module-info> gnu.expr.ModuleInfo)
+(define-alias <iterable> java.lang.Iterable)
+(define-alias <thread> java.lang.Thread)
+(define-alias <queue> java.util.concurrent.LinkedBlockingQueue)
+(define-alias <exchanger> java.util.concurrent.Exchanger)
+(define-alias <timeunit> java.util.concurrent.TimeUnit)
+(define-alias <vm> com.sun.jdi.VirtualMachine)
+(define-alias <mirror> com.sun.jdi.Mirror)
+(define-alias <value> com.sun.jdi.Value)
+(define-alias <thread-ref> com.sun.jdi.ThreadReference)
+(define-alias <obj-ref> com.sun.jdi.ObjectReference)
+(define-alias <array-ref> com.sun.jdi.ArrayReference)
+(define-alias <str-ref> com.sun.jdi.StringReference)
+(define-alias <meth-ref> com.sun.jdi.Method)
+(define-alias <class-type> com.sun.jdi.ClassType)
+(define-alias <ref-type> com.sun.jdi.ReferenceType)
+(define-alias <frame> com.sun.jdi.StackFrame)
+(define-alias <field> com.sun.jdi.Field)
+(define-alias <local-var> com.sun.jdi.LocalVariable)
+(define-alias <location> com.sun.jdi.Location)
+(define-alias <absent-exc> com.sun.jdi.AbsentInformationException)
+(define-alias <event> com.sun.jdi.event.Event)
+(define-alias <exception-event> com.sun.jdi.event.ExceptionEvent)
+(define-alias <step-event> com.sun.jdi.event.StepEvent)
+(define-alias <breakpoint-event> com.sun.jdi.event.BreakpointEvent)
+(define-alias <env> gnu.mapping.Environment)
+
+(define-simple-class <chan> ()
+ (owner :: <thread> #:init (!s java.lang.Thread currentThread))
+ (peer :: <chan>)
+ (queue :: <queue> #:init (<queue>))
+ (lock #:init (<object>)))
+
+
+;;;; Entry Points
+
+(df create-swank-server (port-number)
+ (setup-server port-number announce-port))
+
+(df start-swank (port-file)
+ (let ((announce (fun ((socket <server-socket>))
+ (with (f (call-with-output-file port-file))
+ (format f "~d\n" (! get-local-port socket))))))
+ (spawn (fun ()
+ (setup-server 0 announce)))))
+
+(df setup-server ((port-number <int>) announce)
+ (! set-name (current-thread) "swank")
+ (let ((s (<server-socket> port-number)))
+ (announce s)
+ (let ((c (! accept s)))
+ (! close s)
+ (log "connection: ~s\n" c)
+ (fin (dispatch-events c)
+ (log "closing socket: ~a\n" s)
+ (! close c)))))
+
+(df announce-port ((socket <server-socket>))
+ (log "Listening on port: ~d\n" (! get-local-port socket)))
+
+
+;;;; Event dispatcher
+
+(define-variable *the-vm* #f)
+(define-variable *last-exception* #f)
+(define-variable *last-stacktrace* #f)
+(df %vm (=> <vm>) *the-vm*)
+
+;; FIXME: this needs factorization. But I guess the whole idea of
+;; using bidirectional channels just sucks. Mailboxes owned by a
+;; single thread to which everybody can send are much easier to use.
+
+(df dispatch-events ((s <socket>))
+ (mlet* ((charset "iso-8859-1")
+ (ins (<in> (! getInputStream s) charset))
+ (outs (<out> (! getOutputStream s) charset))
+ ((in . _) (spawn/chan/catch (fun (c) (reader ins c))))
+ ((out . _) (spawn/chan/catch (fun (c) (writer outs c))))
+ ((dbg . _) (spawn/chan/catch vm-monitor))
+ (user-env (interaction-environment))
+ (x (seq
+ (! set-flag user-env #t #|<env>:THREAD_SAFE|# 8)
+ (! set-flag user-env #f #|<env>:DIRECT_INHERITED_ON_SET|# 16)
+ #f))
+ ((listener . _)
+ (spawn/chan (fun (c) (listener c user-env))))
+ (inspector #f)
+ (threads '())
+ (repl-thread #f)
+ (extra '())
+ (vm (let ((vm #f)) (fun () (or vm (rpc dbg `(get-vm)))))))
+ (while #t
+ (mlet ((c . event) (recv* (append (list in out dbg listener)
+ (if inspector (list inspector) '())
+ (map car threads)
+ extra)))
+ ;;(log "event: ~s\n" event)
+ (mcase (list c event)
+ ((_ (':emacs-rex ('|swank:debugger-info-for-emacs| from to)
+ pkg thread id))
+ (send dbg `(debug-info ,thread ,from ,to ,id)))
+ ((_ (':emacs-rex ('|swank:throw-to-toplevel|) pkg thread id))
+ (send dbg `(throw-to-toplevel ,thread ,id)))
+ ((_ (':emacs-rex ('|swank:sldb-continue|) pkg thread id))
+ (send dbg `(thread-continue ,thread ,id)))
+ ((_ (':emacs-rex ('|swank:frame-source-location| frame)
+ pkg thread id))
+ (send dbg `(frame-src-loc ,thread ,frame ,id)))
+ ((_ (':emacs-rex ('|swank:frame-locals-and-catch-tags| frame)
+ pkg thread id))
+ (send dbg `(frame-details ,thread ,frame ,id)))
+ ((_ (':emacs-rex ('|swank:sldb-disassemble| frame)
+ pkg thread id))
+ (send dbg `(disassemble-frame ,thread ,frame ,id)))
+ ((_ (':emacs-rex ('|swank:backtrace| from to) pkg thread id))
+ (send dbg `(thread-frames ,thread ,from ,to ,id)))
+ ((_ (':emacs-rex ('|swank:list-threads|) pkg thread id))
+ (send dbg `(list-threads ,id)))
+ ((_ (':emacs-rex ('|swank:debug-nth-thread| n) _ _ _))
+ (send dbg `(debug-nth-thread ,n)))
+ ((_ (':emacs-rex ('|swank:quit-thread-browser|) _ _ id))
+ (send dbg `(quit-thread-browser ,id)))
+ ((_ (':emacs-rex ('|swank:init-inspector| str . _) pkg _ id))
+ (set inspector (make-inspector user-env (vm)))
+ (send inspector `(init ,str ,id)))
+ ((_ (':emacs-rex ('|swank:inspect-frame-var| frame var)
+ pkg thread id))
+ (mlet ((im . ex) (chan))
+ (set inspector (make-inspector user-env (vm)))
+ (send dbg `(get-local ,ex ,thread ,frame ,var))
+ (send inspector `(init-mirror ,im ,id))))
+ ((_ (':emacs-rex ('|swank:inspect-current-condition|) pkg thread id))
+ (mlet ((im . ex) (chan))
+ (set inspector (make-inspector user-env (vm)))
+ (send dbg `(get-exception ,ex ,thread))
+ (send inspector `(init-mirror ,im ,id))))
+ ((_ (':emacs-rex ('|swank:inspect-nth-part| n) pkg _ id))
+ (send inspector `(inspect-part ,n ,id)))
+ ((_ (':emacs-rex ('|swank:inspector-pop|) pkg _ id))
+ (send inspector `(pop ,id)))
+ ((_ (':emacs-rex ('|swank:quit-inspector|) pkg _ id))
+ (send inspector `(quit ,id)))
+ ((_ (':emacs-interrupt id))
+ (let* ((vm (vm))
+ (t (find-thread id (map cdr threads) repl-thread vm)))
+ (send dbg `(interrupt-thread ,t))))
+ ((_ (':emacs-rex form _ _ id))
+ (send listener `(,form ,id)))
+ ((_ ('get-vm c))
+ (send dbg `(get-vm ,c)))
+ ((_ ('get-channel c))
+ (mlet ((im . ex) (chan))
+ (pushf im extra)
+ (send c ex)))
+ ((_ ('forward x))
+ (send out x))
+ ((_ ('set-listener x))
+ (set repl-thread x))
+ ((_ ('publish-vm vm))
+ (set *the-vm* vm))
+ )))))
+
+(df find-thread (id threads listener (vm <vm>))
+ (cond ((== id ':repl-thread) listener)
+ ((== id 't) listener
+ ;;(if (null? threads)
+ ;; listener
+ ;; (vm-mirror vm (car threads)))
+ )
+ (#t
+ (let ((f (find-if threads
+ (fun (t :: <thread>)
+ (= id (! uniqueID
+ (as <thread-ref> (vm-mirror vm t)))))
+ #f)))
+ (cond (f (vm-mirror vm f))
+ (#t listener))))))
+
+
+;;;; Reader thread
+
+(df reader ((in <in>) (c <chan>))
+ (! set-name (current-thread) "swank-net-reader")
+ (let ((rt (!s gnu.kawa.lispexpr.ReadTable createInitial))) ; ':' not special
+ (while #t
+ (send c (decode-message in rt)))))
+
+(df decode-message ((in <in>) (rt <gnu.kawa.lispexpr.ReadTable>) => <list>)
+ (let* ((header (read-chunk in 6))
+ (len (!s java.lang.Integer parseInt header 16)))
+ (call-with-input-string (read-chunk in len)
+ (fun ((port <input-port>))
+ (%read port rt)))))
+
+(df read-chunk ((in <in>) (len <int>) => <str>)
+ (let ((chars (<char[]> #:length len)))
+ (let loop ((offset :: <int> 0))
+ (cond ((= offset len) (<str> chars))
+ (#t (let ((count (! read in chars offset (- len offset))))
+ (assert (not (= count -1)) "partial packet")
+ (loop (+ offset count))))))))
+
+;;; FIXME: not thread safe
+(df %read ((port <in-port>) (table <gnu.kawa.lispexpr.ReadTable>))
+ (let ((old (!s gnu.kawa.lispexpr.ReadTable getCurrent)))
+ (try-finally
+ (seq (!s gnu.kawa.lispexpr.ReadTable setCurrent table)
+ (read port))
+ (!s gnu.kawa.lispexpr.ReadTable setCurrent old))))
+
+
+;;;; Writer thread
+
+(df writer ((out <out>) (c <chan>))
+ (! set-name (current-thread) "swank-net-writer")
+ (while #t
+ (encode-message out (recv c))))
+
+(df encode-message ((out <out>) (message <list>))
+ (let ((builder (<builder> (as <int> 512))))
+ (print-for-emacs message builder)
+ (! write out (! toString (format "~6,'0x" (! length builder))))
+ (! write out builder)
+ (! flush out)))
+
+(df print-for-emacs (obj (out <builder>))
+ (let ((pr (fun (o) (! append out (! toString (format "~s" o)))))
+ (++ (fun ((s <string>)) (! append out (! toString s)))))
+ (cond ((null? obj) (++ "nil"))
+ ((string? obj) (pr obj))
+ ((number? obj) (pr obj))
+ ;;((keyword? obj) (++ ":") (! append out (to-str obj)))
+ ((symbol? obj) (pr obj))
+ ((pair? obj)
+ (++ "(")
+ (let loop ((obj obj))
+ (print-for-emacs (car obj) out)
+ (let ((cdr (cdr obj)))
+ (cond ((null? cdr) (++ ")"))
+ ((pair? cdr) (++ " ") (loop cdr))
+ (#t (++ " . ") (print-for-emacs cdr out) (++ ")"))))))
+ (#t (error "Unprintable object" obj)))))
+
+;;;; SLIME-EVAL
+
+(df eval-for-emacs ((form <list>) env (id <int>) (c <chan>))
+ ;;(! set-uncaught-exception-handler (current-thread)
+ ;; (<ucex-handler> (fun (t e) (reply-abort c id))))
+ (reply c (%eval form env) id))
+
+(define-variable *slime-funs*)
+(set *slime-funs* (tab))
+
+(df %eval (form env)
+ (apply (lookup-slimefun (car form) *slime-funs*) env (cdr form)))
+
+(df lookup-slimefun ((name <symbol>) tab)
+ ;; name looks like '|swank:connection-info|
+ (or (get tab name #f)
+ (ferror "~a not implemented" name)))
+
+(df %defslimefun ((name <symbol>) (fun <procedure>))
+ (let ((string (symbol->string name)))
+ (cond ((regex-match #/:/ string)
+ (put *slime-funs* name fun))
+ (#t
+ (let ((qname (string->symbol (string-append "swank:" string))))
+ (put *slime-funs* qname fun))))))
+
+(define-syntax defslimefun
+ (syntax-rules ()
+ ((defslimefun name (args ...) body ...)
+ (seq
+ (df name (args ...) body ...)
+ (%defslimefun 'name name)))))
+
+(defslimefun connection-info ((env <env>))
+ (let ((prop (fun (name) (!s java.lang.System getProperty name))))
+ `(:pid
+ 0
+ :style :spawn
+ :lisp-implementation (:type "Kawa" :name "kawa"
+ :version ,(scheme-implementation-version))
+ :machine (:instance ,(prop "java.vm.name") :type ,(prop "os.name")
+ :version ,(prop "java.runtime.version"))
+ :features ()
+ :package (:name "??" :prompt ,(! getName env))
+ :encoding (:coding-systems ("iso-8859-1"))
+ )))
+
+
+;;;; Listener
+
+(df listener ((c <chan>) (env <env>))
+ (! set-name (current-thread) "swank-listener")
+ (log "listener: ~s ~s ~s ~s\n"
+ (current-thread) (! hashCode (current-thread)) c env)
+ (let ((out (make-swank-outport (rpc c `(get-channel)))))
+ (set (current-output-port) out)
+ (let ((vm (as <vm> (rpc c `(get-vm)))))
+ (send c `(set-listener ,(vm-mirror vm (current-thread))))
+ (request-uncaught-exception-events vm)
+ ;;stack snaphost are too expensive
+ ;;(request-caught-exception-events vm)
+ )
+ (rpc c `(get-vm))
+ (listener-loop c env out)))
+
+(define-simple-class <listener-abort> (<throwable>)
+ ((*init*)
+ (invoke-special <throwable> (this) '*init* ))
+ ((abort) :: void
+ (primitive-throw (this))))
+
+(df listener-loop ((c <chan>) (env <env>) port)
+ (while (not (nul? c))
+ ;;(log "listener-loop: ~s ~s\n" (current-thread) c)
+ (mlet ((form id) (recv c))
+ (let ((restart (fun ()
+ (close-port port)
+ (reply-abort c id)
+ (send (car (spawn/chan
+ (fun (cc)
+ (listener (recv cc) env))))
+ c)
+ (set c #!null))))
+ (! set-uncaught-exception-handler (current-thread)
+ (<ucex-handler> (fun (t e) (restart))))
+ (try-catch
+ (let* ((val (%eval form env)))
+ (force-output)
+ (reply c val id))
+ (ex <java.lang.Exception> (invoke-debugger ex) (restart))
+ (ex <java.lang.Error> (invoke-debugger ex) (restart))
+ (ex <listener-abort>
+ (let ((flag (!s java.lang.Thread interrupted)))
+ (log "listener-abort: ~s ~a\n" ex flag))
+ (restart))
+ )))))
+
+(df invoke-debugger (condition)
+ ;;(log "should now invoke debugger: ~a" condition)
+ (try-catch
+ (break condition)
+ (ex <listener-abort> (seq))))
+
+(defslimefun |swank-repl:create-repl| (env #!rest _)
+ (list "user" "user"))
+
+(defslimefun interactive-eval (env str)
+ (values-for-echo-area (eval (read-from-string str) env)))
+
+(defslimefun interactive-eval-region (env (s <string>))
+ (with (port (call-with-input-string s))
+ (values-for-echo-area
+ (let next ((result (values)))
+ (let ((form (read port)))
+ (cond ((== form #!eof) result)
+ (#t (next (eval form env)))))))))
+
+(defslimefun |swank-repl:listener-eval| (env string)
+ (let* ((form (read-from-string string))
+ (list (values-to-list (eval form env))))
+ `(:values ,@(map pprint-to-string list))))
+
+(defslimefun pprint-eval (env string)
+ (let* ((form (read-from-string string))
+ (l (values-to-list (eval form env))))
+ (apply cat (map pprint-to-string l))))
+
+(df call-with-abort (f)
+ (try-catch (f) (ex <throwable> (exception-message ex))))
+
+(df exception-message ((ex <throwable>))
+ (typecase ex
+ (<kawa.lang.NamedException> (! to-string ex))
+ (<throwable> (format "~a: ~a"
+ (class-name-sans-package ex)
+ (! getMessage ex)))))
+
+(df values-for-echo-area (values)
+ (let ((values (values-to-list values)))
+ (cond ((null? values) "; No value")
+ (#t (format "~{~a~^, ~}" (map pprint-to-string values))))))
+
+;;;; Compilation
+
+(defslimefun compile-file-for-emacs (env (filename <str>) load?
+ #!optional options)
+ (let ((jar (cat (path-sans-extension (filepath filename)) ".jar")))
+ (wrap-compilation
+ (fun ((m <gnu.text.SourceMessages>))
+ (!s kawa.lang.CompileFile read filename m))
+ jar (if (lisp-bool load?) env #f) #f)))
+
+(df wrap-compilation (f jar env delete?)
+ (let ((start-time (current-time))
+ (messages (<gnu.text.SourceMessages>)))
+ (try-catch
+ (let ((c (as <gnu.expr.Compilation> (f messages))))
+ (set (@ explicit c) #t)
+ (! compile-to-archive c (! get-module c) jar))
+ (ex <throwable>
+ (log "error during compilation: ~a\n~a" ex (! getStackTrace ex))
+ (! error messages (as <char> #\f)
+ (to-str (exception-message ex)) #!null)
+ #f))
+ (log "compilation done.\n")
+ (let ((success? (zero? (! get-error-count messages))))
+ (when (and env success?)
+ (log "loading ...\n")
+ (eval `(load ,jar) env)
+ (log "loading ... done.\n"))
+ (when delete?
+ (ignore-errors (delete-file jar) #f))
+ (let ((end-time (current-time)))
+ (list ':compilation-result
+ (compiler-notes-for-emacs messages)
+ (if success? 't 'nil)
+ (/ (- end-time start-time) 1000.0))))))
+
+(defslimefun compile-string-for-emacs (env string buffer offset dir)
+ (wrap-compilation
+ (fun ((m <gnu.text.SourceMessages>))
+ (let ((c (as <gnu.expr.Compilation>
+ (call-with-input-string
+ string
+ (fun ((p <in-port>))
+ (! set-path p
+ (format "~s"
+ `(buffer ,buffer offset ,offset str ,string)))
+ (!s kawa.lang.CompileFile read p m))))))
+ (let ((o (@ currentOptions c)))
+ (! set o "warn-invoke-unknown-method" #t)
+ (! set o "warn-undefined-variable" #t))
+ (let ((m (! getModule c)))
+ (! set-name m (format "<emacs>:~a/~a" buffer (current-time))))
+ c))
+ "/tmp/kawa-tmp.zip" env #t))
+
+(df compiler-notes-for-emacs ((messages <gnu.text.SourceMessages>))
+ (packing (pack)
+ (do ((e (! get-errors messages) (@ next e)))
+ ((nul? e))
+ (pack (source-error>elisp e)))))
+
+(df source-error>elisp ((e <source-error>) => <list>)
+ (list ':message (to-string (@ message e))
+ ':severity (case (integer->char (@ severity e))
+ ((#\e #\f) ':error)
+ ((#\w) ':warning)
+ (else ':note))
+ ':location (error-loc>elisp e)))
+
+(df error-loc>elisp ((e <source-error>))
+ (cond ((nul? (@ filename e)) `(:error "No source location"))
+ ((! starts-with (@ filename e) "(buffer ")
+ (mlet (('buffer b 'offset ('quote ((:position o) _)) 'str s)
+ (read-from-string (@ filename e)))
+ (let ((off (line>offset (1- (@ line e)) s))
+ (col (1- (@ column e))))
+ `(:location (:buffer ,b) (:position ,(+ o off col)) nil))))
+ (#t
+ `(:location (:file ,(to-string (@ filename e)))
+ (:line ,(@ line e) ,(1- (@ column e)))
+ nil))))
+
+(df line>offset ((line <int>) (s <str>) => <int>)
+ (let ((offset :: <int> 0))
+ (dotimes (i line)
+ (set offset (! index-of s (as <char> #\newline) offset))
+ (assert (>= offset 0))
+ (set offset (as <int> (+ offset 1))))
+ (log "line=~a offset=~a\n" line offset)
+ offset))
+
+(defslimefun load-file (env filename)
+ (format "Loaded: ~a => ~s" filename (eval `(load ,filename) env)))
+
+;;;; Completion
+
+(defslimefun simple-completions (env (pattern <str>) _)
+ (let* ((env (as <gnu.mapping.InheritingEnvironment> env))
+ (matches (packing (pack)
+ (let ((iter (! enumerate-all-locations env)))
+ (while (! has-next iter)
+ (let ((l (! next-location iter)))
+ (typecase l
+ (<gnu.mapping.NamedLocation>
+ (let ((name (!! get-name get-key-symbol l)))
+ (when (! starts-with name pattern)
+ (pack name)))))))))))
+ `(,matches ,(cond ((null? matches) pattern)
+ (#t (fold+ common-prefix matches))))))
+
+(df common-prefix ((s1 <str>) (s2 <str>) => <str>)
+ (let ((limit (min (! length s1) (! length s2))))
+ (let loop ((i 0))
+ (cond ((or (= i limit)
+ (not (== (! char-at s1 i)
+ (! char-at s2 i))))
+ (! substring s1 0 i))
+ (#t (loop (1+ i)))))))
+
+(df fold+ (f list)
+ (let loop ((s (car list))
+ (l (cdr list)))
+ (cond ((null? l) s)
+ (#t (loop (f s (car l)) (cdr l))))))
+
+;;; Quit
+
+(defslimefun quit-lisp (env)
+ (exit))
+
+;;(defslimefun set-default-directory (env newdir))
+
+
+;;;; Dummy defs
+
+(defslimefun buffer-first-change (#!rest y) '())
+(defslimefun swank-require (#!rest y) '())
+(defslimefun frame-package-name (#!rest y) '())
+
+;;;; arglist
+
+(defslimefun operator-arglist (env name #!rest _)
+ (mcase (try-catch `(ok ,(eval (read-from-string name) env))
+ (ex <throwable> 'nil))
+ (('ok obj)
+ (mcase (arglist obj)
+ ('#f 'nil)
+ ((args rtype)
+ (format "(~a~{~^ ~a~})~a" name
+ (map (fun (e)
+ (if (equal (cadr e) "java.lang.Object") (car e) e))
+ args)
+ (if (equal rtype "java.lang.Object")
+ ""
+ (format " => ~a" rtype))))))
+ (_ 'nil)))
+
+(df arglist (obj)
+ (typecase obj
+ (<gnu.expr.ModuleMethod>
+ (let* ((mref (module-method>meth-ref obj)))
+ (list (mapi (! arguments mref)
+ (fun ((v <local-var>))
+ (list (! name v) (! typeName v))))
+ (! returnTypeName mref))))
+ (<object> #f)))
+
+;;;; M-.
+
+(defslimefun find-definitions-for-emacs (env name)
+ (mcase (try-catch `(ok ,(eval (read-from-string name) env))
+ (ex <throwable> `(error ,(exception-message ex))))
+ (('ok obj) (mapi (all-definitions obj)
+ (fun (d)
+ `(,(format "~a" d) ,(src-loc>elisp (src-loc d))))))
+ (('error msg) `((,name (:error ,msg))))))
+
+(define-simple-class <swank-location> (<location>)
+ (file #:init #f)
+ (line #:init #f)
+ ((*init* file name)
+ (set (@ file (this)) file)
+ (set (@ line (this)) line))
+ ((lineNumber) :: <int> (or line (absent)))
+ ((lineNumber (s :: <str>)) :: int (! lineNumber (this)))
+ ((method) :: <meth-ref> (absent))
+ ((sourcePath) :: <str> (or file (absent)))
+ ((sourcePath (s :: <str>)) :: <str> (! sourcePath (this)))
+ ((sourceName) :: <str> (absent))
+ ((sourceName (s :: <str>)) :: <str> (! sourceName (this)))
+ ((declaringType) :: <ref-type> (absent))
+ ((codeIndex) :: <long> -1)
+ ((virtualMachine) :: <vm> *the-vm*)
+ ((compareTo o) :: <int>
+ (typecase o
+ (<location> (- (! codeIndex (this)) (! codeIndex o))))))
+
+(df absent () (primitive-throw (<absent-exc>)))
+
+(df all-definitions (o)
+ (typecase o
+ (<gnu.expr.ModuleMethod> (list o))
+ (<gnu.expr.PrimProcedure> (list o))
+ (<gnu.expr.GenericProc> (append (mappend all-definitions (gf-methods o))
+ (let ((s (! get-setter o)))
+ (if s (all-definitions s) '()))))
+ (<java.lang.Class> (list o))
+ (<gnu.mapping.Procedure> (all-definitions (! get-class o)))
+ (<kawa.lang.Macro> (list o))
+ (<gnu.bytecode.ObjectType> (all-definitions (! getReflectClass o)))
+ (<java.lang.Object> '())
+ ))
+
+(df gf-methods ((f <gnu.expr.GenericProc>))
+ (let* ((o :: <obj-ref> (vm-mirror *the-vm* f))
+ (f (! field-by-name (! reference-type o) "methods"))
+ (ms (vm-demirror *the-vm* (! get-value o f))))
+ (filter (array-to-list ms) (fun (x) (not (nul? x))))))
+
+(df src-loc (o => <location>)
+ (typecase o
+ (<gnu.expr.PrimProcedure> (src-loc (@ method o)))
+ (<gnu.expr.ModuleMethod> (module-method>src-loc o))
+ (<gnu.expr.GenericProc> (<swank-location> #f #f))
+ (<java.lang.Class> (class>src-loc o))
+ (<kawa.lang.Macro> (<swank-location> #f #f))
+ (<gnu.bytecode.Method> (bytemethod>src-loc o))))
+
+(df module-method>src-loc ((f <gnu.expr.ModuleMethod>))
+ (! location (module-method>meth-ref f)))
+
+(df module-method>meth-ref ((f <gnu.expr.ModuleMethod>) => <meth-ref>)
+ (let* ((module (! reference-type
+ (as <obj-ref> (vm-mirror *the-vm* (@ module f)))))
+ (1st-method-by-name (fun (name)
+ (let ((i (! methods-by-name module name)))
+ (cond ((! is-empty i) #f)
+ (#t (1st i)))))))
+ (as <meth-ref> (or (1st-method-by-name (! get-name f))
+ (let ((mangled (mangled-name f)))
+ (or (1st-method-by-name mangled)
+ (1st-method-by-name (cat mangled "$V"))
+ (1st-method-by-name (cat mangled "$X"))))))))
+
+(df mangled-name ((f <gnu.expr.ModuleMethod>))
+ (let* ((name0 (! get-name f))
+ (name (cond ((nul? name0) (format "lambda~d" (@ selector f)))
+ (#t (!s gnu.expr.Compilation mangleName name0)))))
+ name))
+
+(df class>src-loc ((c <java.lang.Class>) => <location>)
+ (let* ((type (class>ref-type c))
+ (locs (! all-line-locations type)))
+ (cond ((not (! isEmpty locs)) (1st locs))
+ (#t (<swank-location> (1st (! source-paths type "Java"))
+ #f)))))
+
+(df class>ref-type ((class <java.lang.Class>) => <ref-type>)
+ (! reflectedType (as <com.sun.jdi.ClassObjectReference>
+ (vm-mirror *the-vm* class))))
+
+(df class>class-type ((class <java.lang.Class>) => <class-type>)
+ (as <class-type> (class>ref-type class)))
+
+(df bytemethod>src-loc ((m <gnu.bytecode.Method>) => <location>)
+ (let* ((cls (class>class-type (! get-reflect-class
+ (! get-declaring-class m))))
+ (name (! get-name m))
+ (sig (! get-signature m))
+ (meth (! concrete-method-by-name cls name sig)))
+ (! location meth)))
+
+(df src-loc>elisp ((l <location>))
+ (df src-loc>list ((l <location>))
+ (list (ignore-errors (! source-name l "Java"))
+ (ignore-errors (! source-path l "Java"))
+ (ignore-errors (! line-number l "Java"))))
+ (mcase (src-loc>list l)
+ ((name path line)
+ (cond ((not path)
+ `(:error ,(call-with-abort (fun () (! source-path l)))))
+ ((! starts-with (as <str> path) "(buffer ")
+ (mlet (('buffer b 'offset o 'str s) (read-from-string path))
+ `(:location (:buffer ,b)
+ (:position ,(+ o (line>offset line s)))
+ nil)))
+ (#t
+ `(:location ,(or (find-file-in-path name (source-path))
+ (find-file-in-path path (source-path))
+ (ferror "Can't find source-path: ~s ~s ~a"
+ path name (source-path)))
+ (:line ,(or line -1)) ()))))))
+
+(df src-loc>str ((l <location>))
+ (cond ((nul? l) "<null-location>")
+ (#t (format "~a ~a ~a"
+ (or (ignore-errors (! source-path l))
+ (ignore-errors (! source-name l))
+ (ignore-errors (!! name declaring-type l)))
+ (ignore-errors (!! name method l))
+ (ignore-errors (! lineNumber l))))))
+
+;;;;;; class-path hacking
+
+;; (find-file-in-path "kawa/lib/kawa/hashtable.scm" (source-path))
+
+(df find-file-in-path ((filename <str>) (path <list>))
+ (let ((f (<file> filename)))
+ (cond ((! isAbsolute f) `(:file ,filename))
+ (#t (let ((result #f))
+ (find-if path (fun (dir)
+ (let ((x (find-file-in-dir f dir)))
+ (set result x)))
+ #f)
+ result)))))
+
+(df find-file-in-dir ((file <file>) (dir <str>))
+ (let ((filename :: <str> (! getPath file)))
+ (or (let ((child (<file> (<file> dir) filename)))
+ (and (! exists child)
+ `(:file ,(! getPath child))))
+ (try-catch
+ (and (not (nul? (! getEntry (<java.util.zip.ZipFile> dir) filename)))
+ `(:zip ,dir ,filename))
+ (ex <throwable> #f)))))
+
+(define swank-java-source-path
+ (let* ((jre-home :: <str> (!s <java.lang.System> getProperty "java.home"))
+ (parent :: <str> (! get-parent (<file> jre-home))))
+ (list (! get-path (<file> parent "src.zip")))))
+
+(df source-path ()
+ (mlet ((base) (search-path-prop "user.dir"))
+ (append
+ (list base)
+ (map (fun ((s <str>))
+ (let ((f (<file> s))
+ (base :: <str> (as <str> base)))
+ (cond ((! isAbsolute f) s)
+ (#t (! getPath (<file> base s))))))
+ (class-path))
+ swank-java-source-path)))
+
+(df class-path ()
+ (append (search-path-prop "java.class.path")
+ (search-path-prop "sun.boot.class.path")))
+
+(df search-path-prop ((name <str>))
+ (array-to-list (! split (!s java.lang.System getProperty name)
+ (@s <file> pathSeparator))))
+
+;;;; Disassemble
+
+(defslimefun disassemble-form (env form)
+ (mcase (read-from-string form)
+ (('quote name)
+ (let ((f (eval name env)))
+ (typecase f
+ (<gnu.expr.ModuleMethod>
+ (disassemble-to-string (module-method>meth-ref f))))))))
+
+(df disassemble-to-string ((mr <meth-ref>) => <str>)
+ (with-sink #f (fun (out) (disassemble-meth-ref mr out))))
+
+(df disassemble-meth-ref ((mr <meth-ref>) (out <java.io.PrintWriter>))
+ (let* ((t (! declaring-type mr)))
+ (disas-header mr out)
+ (disas-code (! constant-pool t)
+ (! constant-pool-count t)
+ (! bytecodes mr)
+ out)))
+
+(df disas-header ((mr <meth-ref>) (out <java.io.PrintWriter>))
+ (let* ((++ (fun ((str <str>)) (! write out str)))
+ (? (fun (flag str) (if flag (++ str)))))
+ (? (! is-static mr) "static ")
+ (? (! is-final mr) "final ")
+ (? (! is-private mr) "private ")
+ (? (! is-protected mr) "protected ")
+ (? (! is-public mr) "public ")
+ (++ (! name mr)) (++ (! signature mr)) (++ "\n")))
+
+(df disas-code ((cpool <byte[]>) (cpoolcount <int>) (bytecode <byte[]>)
+ (out <java.io.PrintWriter>))
+ (let* ((ct (<gnu.bytecode.ClassType> "foo"))
+ (met (! addMethod ct "bar" 0))
+ (ca (<gnu.bytecode.CodeAttr> met))
+ (constants (let* ((bs (<java.io.ByteArrayOutputStream>))
+ (s (<java.io.DataOutputStream> bs)))
+ (! write-short s cpoolcount)
+ (! write s cpool)
+ (! flush s)
+ (! toByteArray bs))))
+ (vm-set-slot *the-vm* ct "constants"
+ (<gnu.bytecode.ConstantPool>
+ (<java.io.DataInputStream>
+ (<java.io.ByteArrayInputStream>
+ constants))))
+ (! setCode ca bytecode)
+ (let ((w (<gnu.bytecode.ClassTypeWriter> ct out 0)))
+ (! print ca w)
+ (! flush w))))
+
+(df with-sink (sink (f <function>))
+ (cond ((instance? sink <java.io.PrintWriter>) (f sink))
+ ((== sink #t) (f (as <java.io.PrintWriter> (current-output-port))))
+ ((== sink #f)
+ (let* ((buffer (<java.io.StringWriter>))
+ (out (<java.io.PrintWriter> buffer)))
+ (f out)
+ (! flush out)
+ (! toString buffer)))
+ (#t (ferror "Invalid sink designator: ~s" sink))))
+
+(df test-disas ((c <str>) (m <str>))
+ (let* ((vm (as <vm> *the-vm*))
+ (c (as <ref-type> (1st (! classes-by-name vm c))))
+ (m (as <meth-ref> (1st (! methods-by-name c m)))))
+ (with-sink #f (fun (out) (disassemble-meth-ref m out)))))
+
+;; (test-disas "java.lang.Class" "toString")
+
+
+;;;; Macroexpansion
+
+(defslimefun swank-expand-1 (env s) (%swank-macroexpand s env))
+(defslimefun swank-expand (env s) (%swank-macroexpand s env))
+(defslimefun swank-expand-all (env s) (%swank-macroexpand s env))
+
+(df %swank-macroexpand (string env)
+ (pprint-to-string (%macroexpand (read-from-string string) env)))
+
+(df %macroexpand (sexp env) (expand sexp #:env env))
+
+
+;;;; Inspector
+
+(define-simple-class <inspector-state> ()
+ (object #:init #!null)
+ (parts :: <java.util.ArrayList> #:init (<java.util.ArrayList>) )
+ (stack :: <list> #:init '())
+ (content :: <list> #:init '()))
+
+(df make-inspector (env (vm <vm>) => <chan>)
+ (car (spawn/chan (fun (c) (inspector c env vm)))))
+
+(df inspector ((c <chan>) env (vm <vm>))
+ (! set-name (current-thread) "inspector")
+ (let ((state :: <inspector-state> (<inspector-state>))
+ (open #t))
+ (while open
+ (mcase (recv c)
+ (('init str id)
+ (set state (<inspector-state>))
+ (let ((obj (try-catch (eval (read-from-string str) env)
+ (ex <throwable> ex))))
+ (reply c (inspect-object obj state vm) id)))
+ (('init-mirror cc id)
+ (set state (<inspector-state>))
+ (let* ((mirror (recv cc))
+ (obj (vm-demirror vm mirror)))
+ (reply c (inspect-object obj state vm) id)))
+ (('inspect-part n id)
+ (let ((part (! get (@ parts state) n)))
+ (reply c (inspect-object part state vm) id)))
+ (('pop id)
+ (reply c (inspector-pop state vm) id))
+ (('quit id)
+ (reply c 'nil id)
+ (set open #f))))))
+
+(df inspect-object (obj (state <inspector-state>) (vm <vm>))
+ (set (@ object state) obj)
+ (set (@ parts state) (<java.util.ArrayList>))
+ (pushf obj (@ stack state))
+ (set (@ content state) (inspector-content
+ `("class: " (:value ,(! getClass obj)) "\n"
+ ,@(inspect obj vm))
+ state))
+ (cond ((nul? obj) (list ':title "#!null" ':id 0 ':content `()))
+ (#t
+ (list ':title (pprint-to-string obj)
+ ':id (assign-index obj state)
+ ':content (let ((c (@ content state)))
+ (content-range c 0 (len c)))))))
+
+(df inspect (obj vm)
+ (let ((obj (as <obj-ref> (vm-mirror vm obj))))
+ (typecase obj
+ (<array-ref> (inspect-array-ref vm obj))
+ (<obj-ref> (inspect-obj-ref vm obj)))))
+
+(df inspect-array-ref ((vm <vm>) (obj <array-ref>))
+ (packing (pack)
+ (let ((i 0))
+ (for (((v :: <value>) (! getValues obj)))
+ (pack (format "~d: " i))
+ (pack `(:value ,(vm-demirror vm v)))
+ (pack "\n")
+ (set i (1+ i))))))
+
+(df inspect-obj-ref ((vm <vm>) (obj <obj-ref>))
+ (let* ((type (! referenceType obj))
+ (fields (! allFields type))
+ (values (! getValues obj fields))
+ (ifields '()) (sfields '()) (imeths '()) (smeths '())
+ (frob (lambda (lists) (apply append (reverse lists)))))
+ (for (((f :: <field>) fields))
+ (let* ((val (as <value> (! get values f)))
+ (l `(,(! name f) ": " (:value ,(vm-demirror vm val)) "\n")))
+ (if (! is-static f)
+ (pushf l sfields)
+ (pushf l ifields))))
+ (for (((m :: <meth-ref>) (! allMethods type)))
+ (let ((l `(,(! name m) ,(! signature m) "\n")))
+ (if (! is-static m)
+ (pushf l smeths)
+ (pushf l imeths))))
+ `(,@(frob ifields)
+ "--- static fields ---\n" ,@(frob sfields)
+ "--- methods ---\n" ,@(frob imeths)
+ "--- static methods ---\n" ,@(frob smeths))))
+
+(df inspector-content (content (state <inspector-state>))
+ (map (fun (part)
+ (mcase part
+ ((':value val)
+ `(:value ,(pprint-to-string val) ,(assign-index val state)))
+ (x (to-string x))))
+ content))
+
+(df assign-index (obj (state <inspector-state>) => <int>)
+ (! add (@ parts state) obj)
+ (1- (! size (@ parts state))))
+
+(df content-range (l start end)
+ (let* ((len (length l)) (end (min len end)))
+ (list (subseq l start end) len start end)))
+
+(df inspector-pop ((state <inspector-state>) vm)
+ (cond ((<= 2 (len (@ stack state)))
+ (let ((obj (cadr (@ stack state))))
+ (set (@ stack state) (cddr (@ stack state)))
+ (inspect-object obj state vm)))
+ (#t 'nil)))
+
+;;;; IO redirection
+
+(define-simple-class <swank-writer> (<java.io.Writer>)
+ (q :: <queue> #:init (<queue> (as <int> 100)))
+ ((*init*) (invoke-special <java.io.Writer> (this) '*init*))
+ ((write (buffer :: <char[]>) (from :: <int>) (to :: <int>)) :: <void>
+ (synchronized (this)
+ (assert (not (== q #!null)))
+ (! put q `(write ,(<str> buffer from to)))))
+ ((close) :: <void>
+ (synchronized (this)
+ (! put q 'close)
+ (set! q #!null)))
+ ((flush) :: <void>
+ (synchronized (this)
+ (assert (not (== q #!null)))
+ (let ((ex (<exchanger>)))
+ (! put q `(flush ,ex))
+ (! exchange ex #!null)))))
+
+(df swank-writer ((in <chan>) (q <queue>))
+ (! set-name (current-thread) "swank-redirect-thread")
+ (let* ((out (as <chan> (recv in)))
+ (builder (<builder>))
+ (flush (fun ()
+ (unless (zero? (! length builder))
+ (send out `(forward (:write-string ,(<str> builder))))
+ (! setLength builder 0))))
+ (closed #f))
+ (while (not closed)
+ (mcase (! poll q (as long 200) (@s <timeunit> MILLISECONDS))
+ ('#!null (flush))
+ (('write s)
+ (! append builder (as <str> s))
+ (when (> (! length builder) 4000)
+ (flush)))
+ (('flush ex)
+ (flush)
+ (! exchange (as <exchanger> ex) #!null))
+ ('close
+ (set closed #t)
+ (flush))))))
+
+(df make-swank-outport ((out <chan>))
+ (let ((w (<swank-writer>)))
+ (mlet ((in . _) (spawn/chan (fun (c) (swank-writer c (@ q w)))))
+ (send in out))
+ (<out-port> w #t #t)))
+
+
+;;;; Monitor
+
+;;(define-simple-class <monitorstate> ()
+;; (threadmap type: (tab)))
+
+(df vm-monitor ((c <chan>))
+ (! set-name (current-thread) "swank-vm-monitor")
+ (let ((vm (vm-attach)))
+ (log-vm-props vm)
+ (request-breakpoint vm)
+ (mlet* (((ev . _) (spawn/chan/catch
+ (fun (c)
+ (let ((q (! eventQueue vm)))
+ (while #t
+ (send c `(vm-event ,(to-list (! remove q)))))))))
+ (to-string (vm-to-string vm))
+ (state (tab)))
+ (send c `(publish-vm ,vm))
+ (while #t
+ (mcase (recv* (list c ev))
+ ((_ . ('get-vm cc))
+ (send cc vm))
+ ((,c . ('debug-info thread from to id))
+ (reply c (debug-info thread from to state) id))
+ ((,c . ('throw-to-toplevel thread id))
+ (set state (throw-to-toplevel thread id c state)))
+ ((,c . ('thread-continue thread id))
+ (set state (thread-continue thread id c state)))
+ ((,c . ('frame-src-loc thread frame id))
+ (reply c (frame-src-loc thread frame state) id))
+ ((,c . ('frame-details thread frame id))
+ (reply c (list (frame-locals thread frame state) '()) id))
+ ((,c . ('disassemble-frame thread frame id))
+ (reply c (disassemble-frame thread frame state) id))
+ ((,c . ('thread-frames thread from to id))
+ (reply c (thread-frames thread from to state) id))
+ ((,c . ('list-threads id))
+ (reply c (list-threads vm state) id))
+ ((,c . ('interrupt-thread ref))
+ (set state (interrupt-thread ref state c)))
+ ((,c . ('debug-nth-thread n))
+ (let ((t (nth (get state 'all-threads #f) n)))
+ ;;(log "thread ~d : ~a\n" n t)
+ (set state (interrupt-thread t state c))))
+ ((,c . ('quit-thread-browser id))
+ (reply c 't id)
+ (set state (del state 'all-threads)))
+ ((,ev . ('vm-event es))
+ ;;(log "vm-events: len=~a\n" (len es))
+ (for (((e :: <event>) (as <list> es)))
+ (set state (process-vm-event e c state))))
+ ((_ . ('get-exception from tid))
+ (mlet ((_ _ es) (get state tid #f))
+ (send from (let ((e (car es)))
+ (typecase e
+ (<exception-event> (! exception e))
+ (<event> e))))))
+ ((_ . ('get-local rc tid frame var))
+ (send rc (frame-local-var tid frame var state)))
+ )))))
+
+(df reply ((c <chan>) value id)
+ (send c `(forward (:return (:ok ,value) ,id))))
+
+(df reply-abort ((c <chan>) id)
+ (send c `(forward (:return (:abort nil) ,id))))
+
+(df process-vm-event ((e <event>) (c <chan>) state)
+ ;;(log "vm-event: ~s\n" e)
+ (typecase e
+ (<exception-event>
+ ;;(log "exception: ~s\n" (! exception e))
+ ;;(log "exception-message: ~s\n"
+ ;; (exception-message (vm-demirror *the-vm* (! exception e))))
+ ;;(log "exception-location: ~s\n" (src-loc>str (! location e)))
+ ;;(log "exception-catch-location: ~s\n" (src-loc>str (! catch-location e)))
+ (cond ((! notifyUncaught (as <com.sun.jdi.request.ExceptionRequest>
+ (! request e)))
+ (process-exception e c state))
+ (#t
+ (let* ((t (! thread e))
+ (r (! request e))
+ (ex (! exception e)))
+ (unless (eq? *last-exception* ex)
+ (set *last-exception* ex)
+ (set *last-stacktrace* (copy-stack t)))
+ (! resume t))
+ state)))
+ (<step-event>
+ (let* ((r (! request e))
+ (k (! get-property r 'continuation)))
+ (! disable r)
+ (log "k: ~s\n" k)
+ (k e))
+ state)
+ (<breakpoint-event>
+ (log "breakpoint event: ~a\n" e)
+ (debug-thread (! thread e) e state c))
+ ))
+
+(df process-exception ((e <exception-event>) (c <chan>) state)
+ (let* ((tref (! thread e))
+ (tid (! uniqueID tref))
+ (s (get state tid #f)))
+ (mcase s
+ ('#f
+ ;; XXX redundant in debug-thread
+ (let* ((level 1)
+ (state (put state tid (list tref level (list e)))))
+ (send c `(forward (:debug ,tid ,level
+ ,@(debug-info tid 0 15 state))))
+ (send c `(forward (:debug-activate ,tid ,level)))
+ state))
+ ((_ level exs)
+ (send c `(forward (:debug-activate ,(! uniqueID tref) ,level)))
+ (put state tid (list tref (1+ level) (cons e exs)))))))
+
+(define-simple-class <faked-frame> ()
+ (loc :: <location>)
+ (args)
+ (names)
+ (values :: <java.util.Map>)
+ (self)
+ ((*init* (loc :: <location>) args names (values :: <java.util.Map>) self)
+ (set (@ loc (this)) loc)
+ (set (@ args (this)) args)
+ (set (@ names (this)) names)
+ (set (@ values (this)) values)
+ (set (@ self (this)) self))
+ ((toString) :: <str>
+ (format "#<ff ~a>" (src-loc>str loc))))
+
+(df copy-stack ((t <thread-ref>))
+ (packing (pack)
+ (iter (! frames t)
+ (fun ((f <frame>))
+ (let ((vars (ignore-errors (! visibleVariables f))))
+ (pack (<faked-frame>
+ (or (ignore-errors (! location f)) #!null)
+ (ignore-errors (! getArgumentValues f))
+ (or vars #!null)
+ (or (and vars (ignore-errors (! get-values f vars)))
+ #!null)
+ (ignore-errors (! thisObject f)))))))))
+
+(define-simple-class <interrupt-event> (<event>)
+ (thread :: <thread-ref>)
+ ((*init* (thread :: <thread-ref>)) (set (@ thread (this)) thread))
+ ((request) :: <com.sun.jdi.request.EventRequest> #!null)
+ ((virtualMachine) :: <vm> (! virtualMachine thread)))
+
+(df break (#!optional condition)
+ ((breakpoint condition)))
+
+;; We set a breakpoint on this function. It returns a function which
+;; specifies what the debuggee should do next (the actual return value
+;; is set via JDI). Lets hope that the compiler doesn't optimize this
+;; away.
+(df breakpoint (condition => <function>)
+ (fun () #!null))
+
+;; Enable breakpoints event on the breakpoint function.
+(df request-breakpoint ((vm <vm>))
+ (let* ((swank-classes (! classesByName vm "swank-kawa"))
+ (swank-classes-legacy (! classesByName vm "swank$Mnkawa"))
+ (class :: <class-type> (1st (if (= (length swank-classes) 0)
+ swank-classes-legacy
+ swank-classes)))
+ (meth :: <meth-ref> (1st (! methodsByName class "breakpoint")))
+ (erm (! eventRequestManager vm))
+ (req (! createBreakpointRequest erm (! location meth))))
+ (! setSuspendPolicy req (@ SUSPEND_EVENT_THREAD req))
+ (! put-property req 'swank #t)
+ (! put-property req 'argname "condition")
+ (! enable req)))
+
+(df log-vm-props ((vm <vm>))
+ (letrec-syntax ((p (syntax-rules ()
+ ((p name) (log "~s: ~s\n" 'name (! name vm)))))
+ (p* (syntax-rules ()
+ ((p* n ...) (seq (p n) ...)))))
+ (p* canBeModified
+ canRedefineClasses
+ canAddMethod
+ canUnrestrictedlyRedefineClasses
+ canGetBytecodes
+ canGetConstantPool
+ canGetSyntheticAttribute
+ canGetSourceDebugExtension
+ canPopFrames
+ canForceEarlyReturn
+ canGetMethodReturnValues
+ canGetInstanceInfo
+ )))
+
+;;;;; Debugger
+
+(df debug-thread ((tref <thread-ref>) (ev <event>) state (c <chan>))
+ (unless (! is-suspended tref)
+ (! suspend tref))
+ (let* ((id (! uniqueID tref))
+ (level 1)
+ (state (put state id (list tref level (list ev)))))
+ (send c `(forward (:debug ,id ,level ,@(debug-info id 0 10 state))))
+ (send c `(forward (:debug-activate ,id ,level)))
+ state))
+
+(df interrupt-thread ((tref <thread-ref>) state (c <chan>))
+ (debug-thread tref (<interrupt-event> tref) state c))
+
+(df debug-info ((tid <int>) (from <int>) to state)
+ (mlet ((thread-ref level evs) (get state tid #f))
+ (let* ((tref (as <thread-ref> thread-ref))
+ (vm (! virtualMachine tref))
+ (ev (as <event> (car evs)))
+ (ex (typecase ev
+ (<breakpoint-event> (breakpoint-condition ev))
+ (<exception-event> (! exception ev))
+ (<interrupt-event> (<java.lang.Exception> "Interrupt"))))
+ (desc (typecase ex
+ (<obj-ref>
+ ;;(log "ex: ~a ~a\n" ex (vm-demirror vm ex))
+ (! toString (vm-demirror vm ex)))
+ (<java.lang.Throwable> (! toString ex))))
+ (type (format " [type ~a]"
+ (typecase ex
+ (<obj-ref> (! name (! referenceType ex)))
+ (<object> (!! getName getClass ex)))))
+ (bt (thread-frames tid from to state)))
+ `((,desc ,type nil) (("quit" "terminate current thread")) ,bt ()))))
+
+(df breakpoint-condition ((e <breakpoint-event>) => <obj-ref>)
+ (let ((frame (! frame (! thread e) 0)))
+ (1st (! get-argument-values frame))))
+
+(df thread-frames ((tid <int>) (from <int>) to state)
+ (mlet ((thread level evs) (get state tid #f))
+ (let* ((thread (as <thread-ref> thread))
+ (fcount (! frameCount thread))
+ (stacktrace (event-stacktrace (car evs)))
+ (missing (cond ((zero? (len stacktrace)) 0)
+ (#t (- (len stacktrace) fcount))))
+ (fstart (max (- from missing) 0))
+ (flen (max (- to from missing) 0))
+ (frames (! frames thread fstart (min flen (- fcount fstart)))))
+ (packing (pack)
+ (let ((i from))
+ (dotimes (_ (max (- missing from) 0))
+ (pack (list i (format "~a" (stacktrace i))))
+ (set i (1+ i)))
+ (iter frames (fun ((f <frame>))
+ (let ((s (frame-to-string f)))
+ (pack (list i s))
+ (set i (1+ i))))))))))
+
+(df event-stacktrace ((ev <event>))
+ (let ((nothing (fun () (<java.lang.StackTraceElement[]>)))
+ (vm (! virtualMachine ev)))
+ (typecase ev
+ (<breakpoint-event>
+ (let ((condition (vm-demirror vm (breakpoint-condition ev))))
+ (cond ((instance? condition <throwable>)
+ (throwable-stacktrace vm condition))
+ (#t (nothing)))))
+ (<exception-event>
+ (throwable-stacktrace vm (vm-demirror vm (! exception ev))))
+ (<event> (nothing)))))
+
+(df throwable-stacktrace ((vm <vm>) (ex <throwable>))
+ (cond ((== ex (ignore-errors (vm-demirror vm *last-exception*)))
+ *last-stacktrace*)
+ (#t
+ (! getStackTrace ex))))
+
+(df frame-to-string ((f <frame>))
+ (let ((loc (! location f))
+ (vm (! virtualMachine f)))
+ (format "~a (~a)" (!! name method loc)
+ (call-with-abort
+ (fun () (format "~{~a~^ ~}"
+ (mapi (! getArgumentValues f)
+ (fun (arg)
+ (pprint-to-string
+ (vm-demirror vm arg))))))))))
+
+(df frame-src-loc ((tid <int>) (n <int>) state)
+ (try-catch
+ (mlet* (((frame vm) (nth-frame tid n state))
+ (vm (as <vm> vm)))
+ (src-loc>elisp
+ (typecase frame
+ (<frame> (! location frame))
+ (<faked-frame> (@ loc frame))
+ (<java.lang.StackTraceElement>
+ (let* ((classname (! getClassName frame))
+ (classes (! classesByName vm classname))
+ (t (as <ref-type> (1st classes))))
+ (1st (! locationsOfLine t (! getLineNumber frame))))))))
+ (ex <throwable>
+ (let ((msg (! getMessage ex)))
+ `(:error ,(if (== msg #!null)
+ (! toString ex)
+ msg))))))
+
+(df nth-frame ((tid <int>) (n <int>) state)
+ (mlet ((tref level evs) (get state tid #f))
+ (let* ((thread (as <thread-ref> tref))
+ (fcount (! frameCount thread))
+ (stacktrace (event-stacktrace (car evs)))
+ (missing (cond ((zero? (len stacktrace)) 0)
+ (#t (- (len stacktrace) fcount))))
+ (vm (! virtualMachine thread))
+ (frame (cond ((< n missing)
+ (stacktrace n))
+ (#t (! frame thread (- n missing))))))
+ (list frame vm))))
+
+;;;;; Locals
+
+(df frame-locals ((tid <int>) (n <int>) state)
+ (mlet ((thread _ _) (get state tid #f))
+ (let* ((thread (as <thread-ref> thread))
+ (vm (! virtualMachine thread))
+ (p (fun (x) (pprint-to-string
+ (call-with-abort (fun () (vm-demirror vm x)))))))
+ (map (fun (x)
+ (mlet ((name value) x)
+ (list ':name name ':value (p value) ':id 0)))
+ (%frame-locals tid n state)))))
+
+(df frame-local-var ((tid <int>) (frame <int>) (var <int>) state => <mirror>)
+ (cadr (nth (%frame-locals tid frame state) var)))
+
+(df %frame-locals ((tid <int>) (n <int>) state)
+ (mlet ((frame _) (nth-frame tid n state))
+ (typecase frame
+ (<frame>
+ (let* ((visible (try-catch (! visibleVariables frame)
+ (ex <com.sun.jdi.AbsentInformationException>
+ '())))
+ (map (! getValues frame visible))
+ (p (fun (x) x)))
+ (packing (pack)
+ (let ((self (ignore-errors (! thisObject frame))))
+ (when self
+ (pack (list "this" (p self)))))
+ (iter (! entrySet map)
+ (fun ((e <java.util.Map$Entry>))
+ (let ((var (as <local-var> (! getKey e)))
+ (val (as <value> (! getValue e))))
+ (pack (list (! name var) (p val)))))))))
+ (<faked-frame>
+ (packing (pack)
+ (when (@ self frame)
+ (pack (list "this" (@ self frame))))
+ (iter (! entrySet (@ values frame))
+ (fun ((e <java.util.Map$Entry>))
+ (let ((var (as <local-var> (! getKey e)))
+ (val (as <value> (! getValue e))))
+ (pack (list (! name var) val)))))))
+ (<java.lang.StackTraceElement> '()))))
+
+(df disassemble-frame ((tid <int>) (frame <int>) state)
+ (mlet ((frame _) (nth-frame tid frame state))
+ (typecase frame
+ (<java.lang.StackTraceElement> "<??>")
+ (<frame>
+ (let* ((l (! location frame))
+ (m (! method l))
+ (c (! declaringType l)))
+ (disassemble-to-string m))))))
+
+;;;;; Restarts
+
+;; FIXME: factorize
+(df throw-to-toplevel ((tid <int>) (id <int>) (c <chan>) state)
+ (mlet ((tref level exc) (get state tid #f))
+ (let* ((t (as <thread-ref> tref))
+ (ev (car exc)))
+ (typecase ev
+ (<exception-event> ; actually uncaughtException
+ (! resume t)
+ (reply-abort c id)
+ ;;(send-debug-return c tid state)
+ (do ((level level (1- level))
+ (exc exc (cdr exc)))
+ ((null? exc))
+ (send c `(forward (:debug-return ,tid ,level nil))))
+ (del state tid))
+ (<breakpoint-event>
+ ;; XXX race condition?
+ (log "resume from from break (suspendCount: ~d)\n" (! suspendCount t))
+ (let ((vm (! virtualMachine t))
+ (k (fun () (primitive-throw (<listener-abort>)))))
+ (reply-abort c id)
+ (! force-early-return t (vm-mirror vm k))
+ (! resume t)
+ (do ((level level (1- level))
+ (exc exc (cdr exc)))
+ ((null? exc))
+ (send c `(forward (:debug-return ,tid ,level nil))))
+ (del state tid)))
+ (<interrupt-event>
+ (log "resume from from interrupt\n")
+ (let ((vm (! virtualMachine t)))
+ (! stop t (vm-mirror vm (<listener-abort>)))
+ (! resume t)
+ (reply-abort c id)
+ (do ((level level (1- level))
+ (exc exc (cdr exc)))
+ ((null? exc))
+ (send c `(forward (:debug-return ,tid ,level nil))))
+ (del state tid))
+ )))))
+
+(df thread-continue ((tid <int>) (id <int>) (c <chan>) state)
+ (mlet ((tref level exc) (get state tid #f))
+ (log "thread-continue: ~a ~a ~a \n" tref level exc)
+ (let* ((t (as <thread-ref> tref)))
+ (! resume t))
+ (reply-abort c id)
+ (do ((level level (1- level))
+ (exc exc (cdr exc)))
+ ((null? exc))
+ (send c `(forward (:debug-return ,tid ,level nil))))
+ (del state tid)))
+
+(df thread-step ((t <thread-ref>) k)
+ (let* ((vm (! virtual-machine t))
+ (erm (! eventRequestManager vm))
+ (<sr> <com.sun.jdi.request.StepRequest>)
+ (req (! createStepRequest erm t
+ (@s <sr> STEP_MIN)
+ (@s <sr> STEP_OVER))))
+ (! setSuspendPolicy req (@ SUSPEND_EVENT_THREAD req))
+ (! addCountFilter req 1)
+ (! put-property req 'continuation k)
+ (! enable req)))
+
+(df eval-in-thread ((t <thread-ref>) sexp
+ #!optional (env :: <env> (!s <env> current)))
+ (let* ((vm (! virtualMachine t))
+ (sc :: <class-type>
+ (1st (! classes-by-name vm "kawa.standard.Scheme")))
+ (ev :: <meth-ref>
+ (1st (! methods-by-name sc "eval"
+ (cat "(Ljava/lang/Object;Lgnu/mapping/Environment;)"
+ "Ljava/lang/Object;")))))
+ (! invokeMethod sc t ev (list sexp env)
+ (@s <class-type> INVOKE_SINGLE_THREADED))))
+
+;;;;; Threads
+
+(df list-threads (vm :: <vm> state)
+ (let* ((threads (! allThreads vm)))
+ (put state 'all-threads threads)
+ (packing (pack)
+ (pack '(\:id \:name \:status \:priority))
+ (iter threads (fun ((t <thread-ref>))
+ (pack (list (! uniqueID t)
+ (! name t)
+ (let ((s (thread-status t)))
+ (if (! is-suspended t)
+ (cat "SUSPENDED/" s)
+ s))
+ 0)))))))
+
+(df thread-status (t :: <thread-ref>)
+ (let ((s (! status t)))
+ (cond ((= s (@s <thread-ref> THREAD_STATUS_UNKNOWN)) "UNKNOWN")
+ ((= s (@s <thread-ref> THREAD_STATUS_ZOMBIE)) "ZOMBIE")
+ ((= s (@s <thread-ref> THREAD_STATUS_RUNNING)) "RUNNING")
+ ((= s (@s <thread-ref> THREAD_STATUS_SLEEPING)) "SLEEPING")
+ ((= s (@s <thread-ref> THREAD_STATUS_MONITOR)) "MONITOR")
+ ((= s (@s <thread-ref> THREAD_STATUS_WAIT)) "WAIT")
+ ((= s (@s <thread-ref> THREAD_STATUS_NOT_STARTED)) "NOT_STARTED")
+ (#t "<bug>"))))
+
+;;;;; Bootstrap
+
+(df vm-attach (=> <vm>)
+ (attach (getpid) 20))
+
+(df attach (pid timeout)
+ (log "attaching: ~a ~a\n" pid timeout)
+ (let* ((<ac> <com.sun.jdi.connect.AttachingConnector>)
+ (<arg> <com.sun.jdi.connect.Connector$Argument>)
+ (vmm (!s com.sun.jdi.Bootstrap virtualMachineManager))
+ (pa (as <ac>
+ (or
+ (find-if (! attaching-connectors vmm)
+ (fun (x :: <ac>)
+ (! equals (! name x) "com.sun.jdi.ProcessAttach"))
+ #f)
+ (error "ProcessAttach connector not found"))))
+ (args (! default-arguments pa)))
+ (! set-value (as <arg> (! get args (to-str "pid"))) pid)
+ (when timeout
+ (! set-value (as <arg> (! get args (to-str "timeout"))) timeout))
+ (log "attaching2: ~a ~a\n" pa args)
+ (! attach pa args)))
+
+(df getpid ()
+ (let ((p (make-process (command-parse "echo $PPID") #!null)))
+ (! waitFor p)
+ (! read-line (<java.io.BufferedReader> (<in> (! get-input-stream p))))))
+
+(df request-uncaught-exception-events ((vm <vm>))
+ (let* ((erm (! eventRequestManager vm))
+ (req (! createExceptionRequest erm #!null #f #t)))
+ (! setSuspendPolicy req (@ SUSPEND_EVENT_THREAD req))
+ (! addThreadFilter req (vm-mirror vm (current-thread)))
+ (! enable req)))
+
+
+(df request-caught-exception-events ((vm <vm>))
+ (let* ((erm (! eventRequestManager vm))
+ (req (! createExceptionRequest erm #!null #t #f)))
+ (! setSuspendPolicy req (@ SUSPEND_EVENT_THREAD req))
+ (! addThreadFilter req (vm-mirror vm (current-thread)))
+ (! addClassExclusionFilter req "java.lang.ClassLoader")
+ (! addClassExclusionFilter req "java.net.URLClassLoader")
+ (! addClassExclusionFilter req "java.net.URLClassLoader$1")
+ (! enable req)))
+
+(df set-stacktrace-recording ((vm <vm>) (flag <boolean>))
+ (for (((e :: <com.sun.jdi.request.ExceptionRequest>)
+ (!! exceptionRequests eventRequestManager vm)))
+ (when (! notify-caught e)
+ (! setEnabled e flag))))
+
+;; (set-stacktrace-recording *the-vm* #f)
+
+(df vm-to-string ((vm <vm>))
+ (let* ((obj (as <ref-type> (1st (! classesByName vm "java.lang.Object"))))
+ (met (as <meth-ref> (1st (! methodsByName obj "toString")))))
+ (fun ((o <obj-ref>) (t <thread-ref>))
+ (! value
+ (as <str-ref>
+ (! invokeMethod o t met '()
+ (@s <obj-ref> INVOKE_SINGLE_THREADED)))))))
+
+(define-simple-class <swank-global-variable> ()
+ (var #:allocation 'static))
+
+(define-variable *global-get-mirror* #!null)
+(define-variable *global-set-mirror* #!null)
+(define-variable *global-get-raw* #!null)
+(define-variable *global-set-raw* #!null)
+
+(df init-global-field ((vm <vm>))
+ (when (nul? *global-get-mirror*)
+ (set (@s <swank-global-variable> var) #!null) ; prepare class
+ (let* ((swank-global-variable-classes
+ (! classes-by-name vm "swank-global-variable"))
+ (swank-global-variable-classes-legacy
+ (! classes-by-name vm "swank$Mnglobal$Mnvariable"))
+ (c (as <com.sun.jdi.ClassType>
+ (1st (if (= (length swank-global-variable-classes) 0)
+ swank-global-variable-classes-legacy
+ swank-global-variable-classes))))
+ (f (! fieldByName c "var")))
+ (set *global-get-mirror* (fun () (! getValue c f)))
+ (set *global-set-mirror* (fun ((v <obj-ref>)) (! setValue c f v))))
+ (set *global-get-raw* (fun () '() (@s <swank-global-variable> var)))
+ (set *global-set-raw* (fun (x)
+ (set (@s <swank-global-variable> var) x)))))
+
+(df vm-mirror ((vm <vm>) obj)
+ (synchronized vm
+ (init-global-field vm)
+ (*global-set-raw* obj)
+ (*global-get-mirror*)))
+
+(df vm-demirror ((vm <vm>) (v <value>))
+ (synchronized vm
+ (if (== v #!null)
+ #!null
+ (typecase v
+ (<obj-ref> (init-global-field vm)
+ (*global-set-mirror* v)
+ (*global-get-raw*))
+ (<com.sun.jdi.IntegerValue> (! value v))
+ (<com.sun.jdi.LongValue> (! value v))
+ (<com.sun.jdi.CharValue> (! value v))
+ (<com.sun.jdi.ByteValue> (! value v))
+ (<com.sun.jdi.BooleanValue> (! value v))
+ (<com.sun.jdi.ShortValue> (! value v))
+ (<com.sun.jdi.FloatValue> (! value v))
+ (<com.sun.jdi.DoubleValue> (! value v))))))
+
+(df vm-set-slot ((vm <vm>) (o <object>) (name <str>) value)
+ (let* ((o (as <obj-ref> (vm-mirror vm o)))
+ (t (! reference-type o))
+ (f (! field-by-name t name)))
+ (! set-value o f (vm-mirror vm value))))
+
+(define-simple-class <ucex-handler>
+ (<java.lang.Thread$UncaughtExceptionHandler>)
+ (f :: <gnu.mapping.Procedure>)
+ ((*init* (f :: <gnu.mapping.Procedure>)) (set (@ f (this)) f))
+ ((uncaughtException (t :: <thread>) (e :: <throwable>))
+ :: <void>
+ (! println (@s java.lang.System err) (to-str "uhexc:::"))
+ (! apply2 f t e)
+ #!void))
+
+;;;; Channels
+
+(df spawn (f)
+ (let ((thread (<thread> (%%runnable f))))
+ (! start thread)
+ thread))
+
+
+;; gnu.mapping.RunnableClosure uses the try{...}catch(Throwable){...}
+;; idiom which defeats all attempts to use a break-on-error-style
+;; debugger. Previously I had my own version of RunnableClosure
+;; without that deficiency but something in upstream changed and it no
+;; longer worked. Now we use the normal RunnableClosure and at the
+;; cost of taking stack snapshots on every throw.
+(df %%runnable (f => <java.lang.Runnable>)
+ ;;(<runnable> f)
+ ;;(<gnu.mapping.RunnableClosure> f)
+ ;;(runnable f)
+ (%runnable f)
+ )
+
+(df %runnable (f => <java.lang.Runnable>)
+ (runnable
+ (fun ()
+ (try-catch (f)
+ (ex <throwable>
+ (log "exception in thread ~s: ~s" (current-thread)
+ ex)
+ (! printStackTrace ex))))))
+
+(df chan ()
+ (let ((lock (<object>))
+ (im (<chan>))
+ (ex (<chan>)))
+ (set (@ lock im) lock)
+ (set (@ lock ex) lock)
+ (set (@ peer im) ex)
+ (set (@ peer ex) im)
+ (cons im ex)))
+
+(df immutable? (obj)
+ (or (== obj #!null)
+ (symbol? obj)
+ (number? obj)
+ (char? obj)
+ (instance? obj <str>)
+ (null? obj)))
+
+(df send ((c <chan>) value => <void>)
+ (df pass (obj)
+ (cond ((immutable? obj) obj)
+ ((string? obj) (! to-string obj))
+ ((pair? obj)
+ (let loop ((r (list (pass (car obj))))
+ (o (cdr obj)))
+ (cond ((null? o) (reverse! r))
+ ((pair? o) (loop (cons (pass (car o)) r) (cdr o)))
+ (#t (append (reverse! r) (pass o))))))
+ ((instance? obj <chan>)
+ (let ((o :: <chan> obj))
+ (assert (== (@ owner o) (current-thread)))
+ (synchronized (@ lock c)
+ (set (@ owner o) (@ owner (@ peer c))))
+ o))
+ ((or (instance? obj <env>)
+ (instance? obj <mirror>))
+ ;; those can be shared, for pragmatic reasons
+ obj
+ )
+ (#t (error "can't send" obj (class-name-sans-package obj)))))
+ ;;(log "send: ~s ~s -> ~s\n" value (@ owner c) (@ owner (@ peer c)))
+ (assert (== (@ owner c) (current-thread)))
+ ;;(log "lock: ~s send\n" (@ owner (@ peer c)))
+ (synchronized (@ owner (@ peer c))
+ (! put (@ queue (@ peer c)) (pass value))
+ (! notify (@ owner (@ peer c))))
+ ;;(log "unlock: ~s send\n" (@ owner (@ peer c)))
+ )
+
+(df recv ((c <chan>))
+ (cdr (recv/timeout (list c) 0)))
+
+(df recv* ((cs <iterable>))
+ (recv/timeout cs 0))
+
+(df recv/timeout ((cs <iterable>) (timeout <long>))
+ (let ((self (current-thread))
+ (end (if (zero? timeout)
+ 0
+ (+ (current-time) timeout))))
+ ;;(log "lock: ~s recv\n" self)
+ (synchronized self
+ (let loop ()
+ ;;(log "receive-loop: ~s\n" self)
+ (let ((ready (find-if cs
+ (fun ((c <chan>))
+ (not (! is-empty (@ queue c))))
+ #f)))
+ (cond (ready
+ ;;(log "unlock: ~s recv\n" self)
+ (cons ready (! take (@ queue (as <chan> ready)))))
+ ((zero? timeout)
+ ;;(log "wait: ~s recv\n" self)
+ (! wait self) (loop))
+ (#t
+ (let ((now (current-time)))
+ (cond ((<= end now)
+ 'timeout)
+ (#t
+ ;;(log "wait: ~s recv\n" self)
+ (! wait self (- end now))
+ (loop)))))))))))
+
+(df rpc ((c <chan>) msg)
+ (mlet* (((im . ex) (chan))
+ ((op . args) msg))
+ (send c `(,op ,ex . ,args))
+ (recv im)))
+
+(df spawn/chan (f)
+ (mlet ((im . ex) (chan))
+ (let ((thread (<thread> (%%runnable (fun () (f ex))))))
+ (set (@ owner ex) thread)
+ (! start thread)
+ (cons im thread))))
+
+(df spawn/chan/catch (f)
+ (spawn/chan
+ (fun (c)
+ (try-catch
+ (f c)
+ (ex <throwable>
+ (send c `(error ,(! toString ex)
+ ,(class-name-sans-package ex)
+ ,(map (fun (e) (! to-string e))
+ (array-to-list (! get-stack-trace ex))))))))))
+
+;;;; Logging
+
+(define swank-log-port (current-error-port))
+(df log (fstr #!rest args)
+ (synchronized swank-log-port
+ (apply format swank-log-port fstr args)
+ (force-output swank-log-port))
+ #!void)
+
+;;;; Random helpers
+
+(df 1+ (x) (+ x 1))
+(df 1- (x) (- x 1))
+
+(df len (x => <int>)
+ (typecase x
+ (<list> (length x))
+ (<str> (! length x))
+ (<string> (string-length x))
+ (<vector> (vector-length x))
+ (<java.util.List> (! size x))
+ (<object[]> (@ length x))))
+
+;;(df put (tab key value) (hash-table-set! tab key value) tab)
+;;(df get (tab key default) (hash-table-ref/default tab key default))
+;;(df del (tab key) (hash-table-delete! tab key) tab)
+;;(df tab () (make-hash-table))
+
+(df put (tab key value) (hashtable-set! tab key value) tab)
+(df get (tab key default) (hashtable-ref tab key default))
+(df del (tab key) (hashtable-delete! tab key) tab)
+(df tab () (make-eqv-hashtable))
+
+(df equal (x y => <boolean>) (equal? x y))
+
+(df current-thread (=> <thread>) (!s java.lang.Thread currentThread))
+(df current-time (=> <long>) (!s java.lang.System currentTimeMillis))
+
+(df nul? (x) (== x #!null))
+
+(df read-from-string (str)
+ (call-with-input-string str read))
+
+;;(df print-to-string (obj) (call-with-output-string (fun (p) (write obj p))))
+
+(df pprint-to-string (obj)
+ (let* ((w (<java.io.StringWriter>))
+ (p (<out-port> w #t #f)))
+ (try-catch (print-object obj p)
+ (ex <throwable>
+ (format p "#<error while printing ~a ~a>"
+ ex (class-name-sans-package ex))))
+ (! flush p)
+ (to-string (! getBuffer w))))
+
+(df print-object (obj stream)
+ (typecase obj
+ #;
+ ((or (eql #!null) (eql #!eof)
+ <list> <number> <character> <string> <vector> <procedure> <boolean>)
+ (write obj stream))
+ (#t
+ #;(print-unreadable-object obj stream)
+ (write obj stream)
+ )))
+
+(df print-unreadable-object ((o <object>) stream)
+ (let* ((string (! to-string o))
+ (class (! get-class o))
+ (name (! get-name class))
+ (simplename (! get-simple-name class)))
+ (cond ((! starts-with string "#<")
+ (format stream "~a" string))
+ ((or (! starts-with string name)
+ (! starts-with string simplename))
+ (format stream "#<~a>" string))
+ (#t
+ (format stream "#<~a ~a>" name string)))))
+
+(define cat string-append)
+
+(df values-to-list (values)
+ (typecase values
+ (<gnu.mapping.Values> (array-to-list (! getValues values)))
+ (<object> (list values))))
+
+;; (to-list (as-list (values 1 2 2)))
+
+(df array-to-list ((array <object[]>) => <list>)
+ (packing (pack)
+ (dotimes (i (@ length array))
+ (pack (array i)))))
+
+(df lisp-bool (obj)
+ (cond ((== obj 'nil) #f)
+ ((== obj 't) #t)
+ (#t (error "Can't map lisp boolean" obj))))
+
+(df path-sans-extension ((p path) => <string>)
+ (let ((ex (! get-extension p))
+ (str (! to-string p)))
+ (to-string (cond ((not ex) str)
+ (#t (! substring str 0 (- (len str) (len ex) 1)))))))
+
+(df class-name-sans-package ((obj <object>))
+ (cond ((nul? obj) "<#!null>")
+ (#t
+ (try-catch
+ (let* ((c (! get-class obj))
+ (n (! get-simple-name c)))
+ (cond ((equal n "") (! get-name c))
+ (#t n)))
+ (e <java.lang.Throwable>
+ (format "#<~a: ~a>" e (! get-message e)))))))
+
+(df list-env (#!optional (env :: <env> (!s <env> current)))
+ (let ((enum (! enumerateAllLocations env)))
+ (packing (pack)
+ (while (! hasMoreElements enum)
+ (pack (! nextLocation enum))))))
+
+(df list-file (filename)
+ (with (port (call-with-input-file filename))
+ (let* ((lang (!s gnu.expr.Language getDefaultLanguage))
+ (messages (<gnu.text.SourceMessages>))
+ (comp (! parse lang (as <in-port> port) messages 0)))
+ (! get-module comp))))
+
+(df list-decls (file)
+ (let* ((module (as <gnu.expr.ModuleExp> (list-file file))))
+ (do ((decl :: <gnu.expr.Declaration>
+ (! firstDecl module) (! nextDecl decl)))
+ ((nul? decl))
+ (format #t "~a ~a:~d:~d\n" decl
+ (! getFileName decl)
+ (! getLineNumber decl)
+ (! getColumnNumber decl)
+ ))))
+
+(df %time (f)
+ (define-alias <mf> <java.lang.management.ManagementFactory>)
+ (define-alias <gc> <java.lang.management.GarbageCollectorMXBean>)
+ (let* ((gcs (!s <mf> getGarbageCollectorMXBeans))
+ (mem (!s <mf> getMemoryMXBean))
+ (jit (!s <mf> getCompilationMXBean))
+ (oldjit (! getTotalCompilationTime jit))
+ (oldgc (packing (pack)
+ (iter gcs (fun ((gc <gc>))
+ (pack (cons gc
+ (list (! getCollectionCount gc)
+ (! getCollectionTime gc))))))))
+ (heap (!! getUsed getHeapMemoryUsage mem))
+ (nonheap (!! getUsed getNonHeapMemoryUsage mem))
+ (start (!s java.lang.System nanoTime))
+ (values (f))
+ (end (!s java.lang.System nanoTime))
+ (newheap (!! getUsed getHeapMemoryUsage mem))
+ (newnonheap (!! getUsed getNonHeapMemoryUsage mem)))
+ (format #t "~&")
+ (let ((njit (! getTotalCompilationTime jit)))
+ (format #t "; JIT compilation: ~:d ms (~:d)\n" (- njit oldjit) njit))
+ (iter gcs (fun ((gc <gc>))
+ (mlet ((_ count time) (assoc gc oldgc))
+ (format #t "; GC ~a: ~:d ms (~d)\n"
+ (! getName gc)
+ (- (! getCollectionTime gc) time)
+ (- (! getCollectionCount gc) count)))))
+ (format #t "; Heap: ~@:d (~:d)\n" (- newheap heap) newheap)
+ (format #t "; Non-Heap: ~@:d (~:d)\n" (- newnonheap nonheap) newnonheap)
+ (format #t "; Elapsed time: ~:d us\n" (/ (- end start) 1000))
+ values))
+
+(define-syntax time
+ (syntax-rules ()
+ ((time form)
+ (%time (lambda () form)))))
+
+(df gc ()
+ (let* ((mem (!s java.lang.management.ManagementFactory getMemoryMXBean))
+ (oheap (!! getUsed getHeapMemoryUsage mem))
+ (onheap (!! getUsed getNonHeapMemoryUsage mem))
+ (_ (! gc mem))
+ (heap (!! getUsed getHeapMemoryUsage mem))
+ (nheap (!! getUsed getNonHeapMemoryUsage mem)))
+ (format #t "; heap: ~@:d (~:d) non-heap: ~@:d (~:d)\n"
+ (- heap oheap) heap (- onheap nheap) nheap)))
+
+(df room ()
+ (let* ((pools (!s java.lang.management.ManagementFactory
+ getMemoryPoolMXBeans))
+ (mem (!s java.lang.management.ManagementFactory getMemoryMXBean))
+ (heap (!! getUsed getHeapMemoryUsage mem))
+ (nheap (!! getUsed getNonHeapMemoryUsage mem)))
+ (iter pools (fun ((p <java.lang.management.MemoryPoolMXBean>))
+ (format #t "~&; ~a~1,16t: ~10:d\n"
+ (! getName p)
+ (!! getUsed getUsage p))))
+ (format #t "; Heap~1,16t: ~10:d\n" heap)
+ (format #t "; Non-Heap~1,16t: ~10:d\n" nheap)))
+
+;; (df javap (class #!key method signature)
+;; (let* ((<is> <java.io.ByteArrayInputStream>)
+;; (bytes
+;; (typecase class
+;; (<string> (read-bytes (<java.io.FileInputStream> (to-str class))))
+;; (<byte[]> class)
+;; (<symbol> (read-class-file class))))
+;; (cdata (<sun.tools.javap.ClassData> (<is> bytes)))
+;; (p (<sun.tools.javap.JavapPrinter>
+;; (<is> bytes)
+;; (current-output-port)
+;; (<sun.tools.javap.JavapEnvironment>))))
+;; (cond (method
+;; (dolist ((m <sun.tools.javap.MethodData>)
+;; (array-to-list (! getMethods cdata)))
+;; (when (and (equal (to-str method) (! getName m))
+;; (or (not signature)
+;; (equal signature (! getInternalSig m))))
+;; (! printMethodSignature p m (! getAccess m))
+;; (! printExceptions p m)
+;; (newline)
+;; (! printVerboseHeader p m)
+;; (! printcodeSequence p m))))
+;; (#t (p:print)))
+;; (values)))
+
+(df read-bytes ((is <java.io.InputStream>) => <byte[]>)
+ (let ((os (<java.io.ByteArrayOutputStream>)))
+ (let loop ()
+ (let ((c (! read is)))
+ (cond ((= c -1))
+ (#t (! write os c) (loop)))))
+ (! to-byte-array os)))
+
+(df read-class-file ((name <symbol>) => <byte[]>)
+ (let ((f (cat (! replace (to-str name) (as <char> #\.) (as <char> #\/))
+ ".class")))
+ (mcase (find-file-in-path f (class-path))
+ ('#f (ferror "Can't find classfile for ~s" name))
+ ((:zip zipfile entry)
+ (let* ((z (<java.util.zip.ZipFile> (as <str> zipfile)))
+ (e (! getEntry z (as <str> entry))))
+ (read-bytes (! getInputStream z e))))
+ ((:file s) (read-bytes (<java.io.FileInputStream> (as <str> s)))))))
+
+(df all-instances ((vm <vm>) (classname <str>))
+ (mappend (fun ((c <class-type>)) (to-list (! instances c (as long 9999))))
+ (%all-subclasses vm classname)))
+
+(df %all-subclasses ((vm <vm>) (classname <str>))
+ (mappend (fun ((c <class-type>)) (cons c (to-list (! subclasses c))))
+ (to-list (! classes-by-name vm classname))))
+
+(df with-output-to-string (thunk => <str>)
+ (call-with-output-string
+ (fun (s) (parameterize ((current-output-port s)) (thunk)))))
+
+(df find-if ((i <iterable>) test default)
+ (let ((iter (! iterator i))
+ (found #f))
+ (while (and (not found) (! has-next iter))
+ (let ((e (! next iter)))
+ (when (test e)
+ (set found #t)
+ (set default e))))
+ default))
+
+(df filter ((i <iterable>) test => <list>)
+ (packing (pack)
+ (for ((e i))
+ (when (test e)
+ (pack e)))))
+
+(df iter ((i <iterable>) f)
+ (for ((e i)) (f e)))
+
+(df mapi ((i <iterable>) f => <list>)
+ (packing (pack) (for ((e i)) (pack (f e)))))
+
+(df nth ((i <iterable>) (n <int>))
+ (let ((iter (! iterator i)))
+ (dotimes (i n)
+ (! next iter))
+ (! next iter)))
+
+(df 1st ((i <iterable>)) (!! next iterator i))
+
+(df to-list ((i <iterable>) => <list>)
+ (packing (pack) (for ((e i)) (pack e))))
+
+(df as-list ((o <java.lang.Object[]>) => <java.util.List>)
+ (!s java.util.Arrays asList o))
+
+(df mappend (f list)
+ (apply append (map f list)))
+
+(df subseq (s from to)
+ (typecase s
+ (<list> (apply list (! sub-list s from to)))
+ (<vector> (apply vector (! sub-list s from to)))
+ (<str> (! substring s from to))
+ (<byte[]> (let* ((len (as <int> (- to from)))
+ (t (<byte[]> #:length len)))
+ (!s java.lang.System arraycopy s from t 0 len)
+ t))))
+
+(df to-string (obj => <string>)
+ (typecase obj
+ (<str> (<gnu.lists.FString> obj))
+ ((satisfies string?) obj)
+ ((satisfies symbol?) (symbol->string obj))
+ (<java.lang.StringBuffer> (<gnu.lists.FString> obj))
+ (<java.lang.StringBuilder> (<gnu.lists.FString> obj))
+ (#t (error "Not a string designator" obj
+ (class-name-sans-package obj)))))
+
+(df to-str (obj => <str>)
+ (cond ((instance? obj <str>) obj)
+ ((string? obj) (! toString obj))
+ ((symbol? obj) (! getName (as <gnu.mapping.Symbol> obj)))
+ (#t (error "Not a string designator" obj
+ (class-name-sans-package obj)))))
+
+))
+
+;; Local Variables:
+;; mode: goo
+;; compile-command: "\
+;; rm -rf classes && \
+;; JAVA_OPTS=-Xss2M kawa --r7rs -d classes -C swank-kawa.scm && \
+;; jar cf swank-kawa.jar -C classes ."
+;; End:
diff --git a/vim/bundle/slimv/slime/contrib/swank-larceny.scm b/vim/bundle/slimv/slime/contrib/swank-larceny.scm
new file mode 100644
index 0000000..e4d730d
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-larceny.scm
@@ -0,0 +1,176 @@
+;; swank-larceny.scm --- Swank server for Larceny
+;;
+;; License: Public Domain
+;; Author: Helmut Eller
+;;
+;; In a shell execute:
+;; larceny -r6rs -program swank-larceny.scm
+;; and then `M-x slime-connect' in Emacs.
+
+(library (swank os)
+ (export getpid make-server-socket accept local-port close-socket)
+ (import (rnrs)
+ (primitives foreign-procedure
+ ffi/handle->address
+ ffi/string->asciiz
+ sizeof:pointer
+ sizeof:int
+ %set-pointer
+ %get-int))
+
+ (define getpid (foreign-procedure "getpid" '() 'int))
+ (define fork (foreign-procedure "fork" '() 'int))
+ (define close (foreign-procedure "close" '(int) 'int))
+ (define dup2 (foreign-procedure "dup2" '(int int) 'int))
+
+ (define bytevector-content-offset$ sizeof:pointer)
+
+ (define execvp% (foreign-procedure "execvp" '(string boxed) 'int))
+ (define (execvp file . args)
+ (let* ((nargs (length args))
+ (argv (make-bytevector (* (+ nargs 1)
+ sizeof:pointer))))
+ (do ((offset 0 (+ offset sizeof:pointer))
+ (as args (cdr as)))
+ ((null? as))
+ (%set-pointer argv
+ offset
+ (+ (ffi/handle->address (ffi/string->asciiz (car as)))
+ bytevector-content-offset$)))
+ (%set-pointer argv (* nargs sizeof:pointer) 0)
+ (execvp% file argv)))
+
+ (define pipe% (foreign-procedure "pipe" '(boxed) 'int))
+ (define (pipe)
+ (let ((array (make-bytevector (* sizeof:int 2))))
+ (let ((r (pipe% array)))
+ (values r (%get-int array 0) (%get-int array sizeof:int)))))
+
+ (define (fork/exec file . args)
+ (let ((pid (fork)))
+ (cond ((= pid 0)
+ (apply execvp file args))
+ (#t pid))))
+
+ (define (start-process file . args)
+ (let-values (((r1 down-out down-in) (pipe))
+ ((r2 up-out up-in) (pipe))
+ ((r3 err-out err-in) (pipe)))
+ (assert (= 0 r1))
+ (assert (= 0 r2))
+ (assert (= 0 r3))
+ (let ((pid (fork)))
+ (case pid
+ ((-1)
+ (error "Failed to fork a subprocess."))
+ ((0)
+ (close up-out)
+ (close err-out)
+ (close down-in)
+ (dup2 down-out 0)
+ (dup2 up-in 1)
+ (dup2 err-in 2)
+ (apply execvp file args)
+ (exit 1))
+ (else
+ (close down-out)
+ (close up-in)
+ (close err-in)
+ (list pid
+ (make-fd-io-stream up-out down-in)
+ (make-fd-io-stream err-out err-out)))))))
+
+ (define (make-fd-io-stream in out)
+ (let ((write (lambda (bv start count) (fd-write out bv start count)))
+ (read (lambda (bv start count) (fd-read in bv start count)))
+ (closeit (lambda () (close in) (close out))))
+ (make-custom-binary-input/output-port
+ "fd-stream" read write #f #f closeit)))
+
+ (define write% (foreign-procedure "write" '(int ulong int) 'int))
+ (define (fd-write fd bytevector start count)
+ (write% fd
+ (+ (ffi/handle->address bytevector)
+ bytevector-content-offset$
+ start)
+ count))
+
+ (define read% (foreign-procedure "read" '(int ulong int) 'int))
+ (define (fd-read fd bytevector start count)
+ ;;(printf "fd-read: ~a ~s ~a ~a\n" fd bytevector start count)
+ (read% fd
+ (+ (ffi/handle->address bytevector)
+ bytevector-content-offset$
+ start)
+ count))
+
+ (define (make-server-socket port)
+ (let* ((args `("/bin/bash" "bash"
+ "-c"
+ ,(string-append
+ "netcat -s 127.0.0.1 -q 0 -l -v "
+ (if port
+ (string-append "-p " (number->string port))
+ ""))))
+ (nc (apply start-process args))
+ (err (transcoded-port (list-ref nc 2)
+ (make-transcoder (latin-1-codec))))
+ (line (get-line err))
+ (pos (last-index-of line '#\])))
+ (cond (pos
+ (let* ((tail (substring line (+ pos 1) (string-length line)))
+ (port (get-datum (open-string-input-port tail))))
+ (list (car nc) (cadr nc) err port)))
+ (#t (error "netcat failed: " line)))))
+
+ (define (accept socket codec)
+ (let* ((line (get-line (caddr socket)))
+ (pos (last-index-of line #\])))
+ (cond (pos
+ (close-port (caddr socket))
+ (let ((stream (cadr socket)))
+ (let ((io (transcoded-port stream (make-transcoder codec))))
+ (values io io))))
+ (else (error "accept failed: " line)))))
+
+ (define (local-port socket)
+ (list-ref socket 3))
+
+ (define (last-index-of str chr)
+ (let loop ((i (string-length str)))
+ (cond ((<= i 0) #f)
+ (#t (let ((i (- i 1)))
+ (cond ((char=? (string-ref str i) chr)
+ i)
+ (#t
+ (loop i))))))))
+
+ (define (close-socket socket)
+ ;;(close-port (cadr socket))
+ #f
+ )
+
+ )
+
+(library (swank sys)
+ (export implementation-name eval-in-interaction-environment)
+ (import (rnrs)
+ (primitives system-features
+ aeryn-evaluator))
+
+ (define (implementation-name) "larceny")
+
+ ;; see $LARCENY/r6rsmode.sch:
+ ;; Larceny's ERR5RS and R6RS modes.
+ ;; Code names:
+ ;; Aeryn ERR5RS
+ ;; D'Argo R6RS-compatible
+ ;; Spanky R6RS-conforming (not yet implemented)
+ (define (eval-in-interaction-environment form)
+ (aeryn-evaluator form))
+
+ )
+
+(import (rnrs) (rnrs eval) (larceny load))
+(load "swank-r6rs.scm")
+(eval '(start-server #f) (environment '(swank)))
diff --git a/vim/bundle/slimv/slime/contrib/swank-listener-hooks.lisp b/vim/bundle/slimv/slime/contrib/swank-listener-hooks.lisp
new file mode 100644
index 0000000..f289c90
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-listener-hooks.lisp
@@ -0,0 +1,91 @@
+;;; swank-listener-hooks.lisp --- listener with special hooks
+;;
+;; Author: Alan Ruttenberg <alanr-l@mumble.net>
+
+;; Provides *slime-repl-eval-hooks* special variable which
+;; can be used for easy interception of SLIME REPL form evaluation
+;; for purposes such as integration with application event loop.
+
+(in-package :swank)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (swank-require :swank-repl))
+
+(defvar *slime-repl-advance-history* nil
+ "In the dynamic scope of a single form typed at the repl, is set to nil to
+ prevent the repl from advancing the history - * ** *** etc.")
+
+(defvar *slime-repl-suppress-output* nil
+ "In the dynamic scope of a single form typed at the repl, is set to nil to
+ prevent the repl from printing the result of the evalation.")
+
+(defvar *slime-repl-eval-hook-pass* (gensym "PASS")
+ "Token to indicate that a repl hook declines to evaluate the form")
+
+(defvar *slime-repl-eval-hooks* nil
+ "A list of functions. When the repl is about to eval a form, first try running each of
+ these hooks. The first hook which returns a value which is not *slime-repl-eval-hook-pass*
+ is considered a replacement for calling eval. If there are no hooks, or all
+ pass, then eval is used.")
+
+(export '*slime-repl-eval-hooks*)
+
+(defslimefun repl-eval-hook-pass ()
+ "call when repl hook declines to evaluate the form"
+ (throw *slime-repl-eval-hook-pass* *slime-repl-eval-hook-pass*))
+
+(defslimefun repl-suppress-output ()
+ "In the dynamic scope of a single form typed at the repl, call to
+ prevent the repl from printing the result of the evalation."
+ (setq *slime-repl-suppress-output* t))
+
+(defslimefun repl-suppress-advance-history ()
+ "In the dynamic scope of a single form typed at the repl, call to
+ prevent the repl from advancing the history - * ** *** etc."
+ (setq *slime-repl-advance-history* nil))
+
+(defun %eval-region (string)
+ (with-input-from-string (stream string)
+ (let (- values)
+ (loop
+ (let ((form (read stream nil stream)))
+ (when (eq form stream)
+ (fresh-line)
+ (finish-output)
+ (return (values values -)))
+ (setq - form)
+ (if *slime-repl-eval-hooks*
+ (setq values (run-repl-eval-hooks form))
+ (setq values (multiple-value-list (eval form))))
+ (finish-output))))))
+
+(defun run-repl-eval-hooks (form)
+ (loop for hook in *slime-repl-eval-hooks*
+ for res = (catch *slime-repl-eval-hook-pass*
+ (multiple-value-list (funcall hook form)))
+ until (not (eq res *slime-repl-eval-hook-pass*))
+ finally (return
+ (if (eq res *slime-repl-eval-hook-pass*)
+ (multiple-value-list (eval form))
+ res))))
+
+(defun %listener-eval (string)
+ (clear-user-input)
+ (with-buffer-syntax ()
+ (swank-repl::track-package
+ (lambda ()
+ (let ((*slime-repl-suppress-output* :unset)
+ (*slime-repl-advance-history* :unset))
+ (multiple-value-bind (values last-form) (%eval-region string)
+ (unless (or (and (eq values nil) (eq last-form nil))
+ (eq *slime-repl-advance-history* nil))
+ (setq *** ** ** * * (car values)
+ /// // // / / values))
+ (setq +++ ++ ++ + + last-form)
+ (unless (eq *slime-repl-suppress-output* t)
+ (funcall swank-repl::*send-repl-results-function* values)))))))
+ nil)
+
+(setq swank-repl::*listener-eval-function* '%listener-eval)
+
+(provide :swank-listener-hooks)
diff --git a/vim/bundle/slimv/slime/contrib/swank-macrostep.lisp b/vim/bundle/slimv/slime/contrib/swank-macrostep.lisp
new file mode 100644
index 0000000..77dfa3f
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-macrostep.lisp
@@ -0,0 +1,227 @@
+;;; swank-macrostep.lisp -- fancy macro-expansion via macrostep.el
+;;
+;; Authors: Luís Oliveira <luismbo@gmail.com>
+;; Jon Oddie <j.j.oddie@gmail.com>
+;;
+;; License: Public Domain
+
+(defpackage swank-macrostep
+ (:use cl swank)
+ (:import-from swank
+ #:*macroexpand-printer-bindings*
+ #:with-buffer-syntax
+ #:with-bindings
+ #:to-string
+ #:macroexpand-all
+ #:compiler-macroexpand-1
+ #:defslimefun
+ #:collect-macro-forms)
+ (:export #:macrostep-expand-1
+ #:macro-form-p))
+
+(in-package #:swank-macrostep)
+
+(defslimefun macrostep-expand-1 (string compiler-macros? context)
+ (with-buffer-syntax ()
+ (let ((form (read-from-string string)))
+ (multiple-value-bind (expansion error-message)
+ (expand-form-once form compiler-macros? context)
+ (if error-message
+ `(:error ,error-message)
+ (multiple-value-bind (macros compiler-macros)
+ (collect-macro-forms-in-context expansion context)
+ (let* ((all-macros (append macros compiler-macros))
+ (pretty-expansion (pprint-to-string expansion))
+ (positions (collect-form-positions expansion
+ pretty-expansion
+ all-macros))
+ (subform-info
+ (loop
+ for form in all-macros
+ for (start end) in positions
+ when (and start end)
+ collect (let ((op-name (to-string (first form)))
+ (op-type
+ (if (member form macros)
+ :macro
+ :compiler-macro)))
+ (list op-name
+ op-type
+ start)))))
+ `(:ok ,pretty-expansion ,subform-info))))))))
+
+(defun expand-form-once (form compiler-macros? context)
+ (multiple-value-bind (expansion expanded?)
+ (macroexpand-1-in-context form context)
+ (if expanded?
+ (values expansion nil)
+ (if (not compiler-macros?)
+ (values nil "Not a macro form")
+ (multiple-value-bind (expansion expanded?)
+ (compiler-macroexpand-1 form)
+ (if expanded?
+ (values expansion nil)
+ (values nil "Not a macro or compiler-macro form")))))))
+
+(defslimefun macro-form-p (string compiler-macros? context)
+ (with-buffer-syntax ()
+ (let ((form
+ (handler-case
+ (read-from-string string)
+ (error (condition)
+ (unless (debug-on-swank-error)
+ (return-from macro-form-p
+ `(:error ,(format nil "Read error: ~A" condition))))))))
+ `(:ok ,(macro-form-type form compiler-macros? context)))))
+
+(defun macro-form-type (form compiler-macros? context)
+ (cond
+ ((or (not (consp form))
+ (not (symbolp (car form))))
+ nil)
+ ((multiple-value-bind (expansion expanded?)
+ (macroexpand-1-in-context form context)
+ (declare (ignore expansion))
+ expanded?)
+ :macro)
+ ((and compiler-macros?
+ (multiple-value-bind (expansion expanded?)
+ (compiler-macroexpand-1 form)
+ (declare (ignore expansion))
+ expanded?))
+ :compiler-macro)
+ (t
+ nil)))
+
+
+;;;; Hacks to support macro-expansion within local context
+
+(defparameter *macrostep-tag* (gensym))
+
+(defparameter *macrostep-placeholder* '*macrostep-placeholder*)
+
+(define-condition expansion-in-context-failed (simple-error)
+ ())
+
+(defmacro throw-expansion (form &environment env)
+ (throw *macrostep-tag* (macroexpand-1 form env)))
+
+(defmacro throw-collected-macro-forms (form &environment env)
+ (throw *macrostep-tag* (collect-macro-forms form env)))
+
+(defun macroexpand-1-in-context (form context)
+ (handler-case
+ (macroexpand-and-catch
+ `(throw-expansion ,form) context)
+ (error ()
+ (macroexpand-1 form))))
+
+(defun collect-macro-forms-in-context (form context)
+ (handler-case
+ (macroexpand-and-catch
+ `(throw-collected-macro-forms ,form) context)
+ (error ()
+ (collect-macro-forms form))))
+
+(defun macroexpand-and-catch (form context)
+ (catch *macrostep-tag*
+ (macroexpand-all (enclose-form-in-context form context))
+ (error 'expansion-in-context-failed)))
+
+(defun enclose-form-in-context (form context)
+ (with-buffer-syntax ()
+ (destructuring-bind (prefix suffix) context
+ (let* ((placeholder-form
+ (read-from-string
+ (concatenate
+ 'string
+ prefix (prin1-to-string *macrostep-placeholder*) suffix)))
+ (substituted-form (subst form *macrostep-placeholder*
+ placeholder-form)))
+ (if (not (equal placeholder-form substituted-form))
+ substituted-form
+ (error 'expansion-in-context-failed))))))
+
+
+;;;; Tracking Pretty Printer
+
+(defun marker-char-p (char)
+ (<= #xe000 (char-code char) #xe8ff))
+
+(defun make-marker-char (id)
+ ;; using the private-use characters U+E000..U+F8FF as markers, so
+ ;; that's our upper limit for how many we can use.
+ (assert (<= 0 id #x8ff))
+ (code-char (+ #xe000 id)))
+
+(defun marker-char-id (char)
+ (assert (marker-char-p char))
+ (- (char-code char) #xe000))
+
+(defparameter +whitespace+ (mapcar #'code-char '(9 13 10 32)))
+
+(defun whitespacep (char)
+ (member char +whitespace+))
+
+(defun pprint-to-string (object &optional pprint-dispatch)
+ (let ((*print-pprint-dispatch* (or pprint-dispatch *print-pprint-dispatch*)))
+ (with-bindings *macroexpand-printer-bindings*
+ (to-string object))))
+
+#-clisp
+(defun collect-form-positions (expansion printed-expansion forms)
+ (loop for (start end)
+ in (collect-marker-positions
+ (pprint-to-string expansion (make-tracking-pprint-dispatch forms))
+ (length forms))
+ collect (when (and start end)
+ (list (find-non-whitespace-position printed-expansion start)
+ (find-non-whitespace-position printed-expansion end)))))
+
+;; The pprint-dispatch table constructed by
+;; MAKE-TRACKING-PPRINT-DISPATCH causes an infinite loop and stack
+;; overflow under CLISP version 2.49. Make the COLLECT-FORM-POSITIONS
+;; entry point a no-op in thi case, so that basic macro-expansion will
+;; still work (without detection of inner macro forms)
+#+clisp
+(defun collect-form-positions (expansion printed-expansion forms)
+ nil)
+
+(defun make-tracking-pprint-dispatch (forms)
+ (let ((original-table *print-pprint-dispatch*)
+ (table (copy-pprint-dispatch)))
+ (flet ((maybe-write-marker (position stream)
+ (when position
+ (write-char (make-marker-char position) stream))))
+ (set-pprint-dispatch 'cons
+ (lambda (stream cons)
+ (let ((pos (position cons forms)))
+ (maybe-write-marker pos stream)
+ ;; delegate printing to the original table.
+ (funcall (pprint-dispatch cons original-table)
+ stream
+ cons)
+ (maybe-write-marker pos stream)))
+ most-positive-fixnum
+ table))
+ table))
+
+(defun collect-marker-positions (string position-count)
+ (let ((positions (make-array position-count :initial-element nil)))
+ (loop with p = 0
+ for char across string
+ unless (whitespacep char)
+ do (if (marker-char-p char)
+ (push p (aref positions (marker-char-id char)))
+ (incf p)))
+ (map 'list #'reverse positions)))
+
+(defun find-non-whitespace-position (string position)
+ (loop with non-whitespace-position = -1
+ for i from 0 and char across string
+ unless (whitespacep char)
+ do (incf non-whitespace-position)
+ until (eql non-whitespace-position position)
+ finally (return i)))
+
+(provide :swank-macrostep)
diff --git a/vim/bundle/slimv/slime/contrib/swank-media.lisp b/vim/bundle/slimv/slime/contrib/swank-media.lisp
new file mode 100644
index 0000000..3d5ef7c
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-media.lisp
@@ -0,0 +1,25 @@
+;;; swank-media.lisp --- insert other media (images)
+;;
+;; Authors: Christophe Rhodes <csr21@cantab.net>
+;;
+;; Licence: GPLv2 or later
+;;
+
+(in-package :swank)
+
+;; this file is empty of functionality. The slime-media contrib
+;; allows swank to return messages other than :write-string as repl
+;; results; this is used in the R implementation of swank to display R
+;; objects with graphical representations (such as trellis objects) as
+;; image presentations in the swank repl. In R, this is done by
+;; having a hook function for the preparation of the repl results, in
+;; addition to the already-existing hook for sending the repl results
+;; (*send-repl-results-function*, used by swank-presentations.lisp).
+;; The swank-media.R contrib implementation defines a generic function
+;; for use as this hook, along with methods for commonly-encountered
+;; graphical R objects. (This strategy is harder in CL, where methods
+;; can only be defined if their specializers already exist; in R's S3
+;; object system, methods are ordinary functions with a special naming
+;; convention)
+
+(provide :swank-media)
diff --git a/vim/bundle/slimv/slime/contrib/swank-mit-scheme.scm b/vim/bundle/slimv/slime/contrib/swank-mit-scheme.scm
new file mode 100644
index 0000000..98af388
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-mit-scheme.scm
@@ -0,0 +1,882 @@
+;;; swank-mit-scheme.scm --- SLIME server for MIT Scheme
+;;
+;; Copyright (C) 2008 Helmut Eller
+;;
+;; This file is licensed under the terms of the GNU General Public
+;; License as distributed with Emacs (press C-h C-c for details).
+
+;;;; Installation:
+#|
+
+1. You need MIT Scheme 9.2
+
+2. The Emacs side needs some fiddling. I have the following in
+ my .emacs:
+
+(setq slime-lisp-implementations
+ '((mit-scheme ("mit-scheme") :init mit-scheme-init)))
+
+(defun mit-scheme-init (file encoding)
+ (format "%S\n\n"
+ `(begin
+ (load-option 'format)
+ (load-option 'sos)
+ (eval
+ '(create-package-from-description
+ (make-package-description '(swank) (list (list))
+ (vector) (vector) (vector) false))
+ (->environment '(package)))
+ (load ,(expand-file-name
+ ".../contrib/swank-mit-scheme.scm" ; <-- insert your path
+ slime-path)
+ (->environment '(swank)))
+ (eval '(start-swank ,file) (->environment '(swank))))))
+
+(defun mit-scheme ()
+ (interactive)
+ (slime 'mit-scheme))
+
+(defun find-mit-scheme-package ()
+ (save-excursion
+ (let ((case-fold-search t))
+ (and (re-search-backward "^[;]+ package: \\((.+)\\).*$" nil t)
+ (match-string-no-properties 1)))))
+
+(setq slime-find-buffer-package-function 'find-mit-scheme-package)
+(add-hook 'scheme-mode-hook (lambda () (slime-mode 1)))
+
+ The `mit-scheme-init' function first loads the SOS and FORMAT
+ libraries, then creates a package "(swank)", and loads this file
+ into that package. Finally it starts the server.
+
+ `find-mit-scheme-package' tries to figure out which package the
+ buffer belongs to, assuming that ";;; package: (FOO)" appears
+ somewhere in the file. Luckily, this assumption is true for many of
+ MIT Scheme's own files. Alternatively, you could add Emacs style
+ -*- slime-buffer-package: "(FOO)" -*- file variables.
+
+4. Start everything with `M-x mit-scheme'.
+
+|#
+
+;;; package: (swank)
+
+;; Modified for Slimv:
+;; - load options
+;; - remove extension in compile-file-for-emacs
+(load-option 'format)
+(load-option 'sos)
+
+(if (< (car (get-subsystem-version "Release"))
+ '9)
+ (error "This file requires MIT Scheme Release 9"))
+
+(define (swank port)
+ (accept-connections (or port 4005) #f))
+
+;; ### hardcoded port number for now. netcat-openbsd doesn't print
+;; the listener port anymore.
+(define (start-swank port-file)
+ (accept-connections 4055 port-file)
+ )
+
+;;;; Networking
+
+(define (accept-connections port port-file)
+ (let ((sock (open-tcp-server-socket port (host-address-loopback))))
+ (format #t "Listening on port: ~s~%" port)
+ (if port-file (write-port-file port port-file))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda () (serve (tcp-server-connection-accept sock #t #f)))
+ (lambda () (close-tcp-server-socket sock)))))
+
+(define (write-port-file portnumber filename)
+ (call-with-output-file filename (lambda (p) (write portnumber p))))
+
+(define *top-level-restart* #f)
+(define (serve socket)
+ (with-simple-restart
+ 'disconnect "Close connection."
+ (lambda ()
+ (with-keyboard-interrupt-handler
+ (lambda () (main-loop socket))))))
+
+(define (disconnect)
+ (format #t "Disconnecting ...~%")
+ (invoke-restart (find-restart 'disconnect)))
+
+(define (main-loop socket)
+ (do () (#f)
+ (with-simple-restart
+ 'abort "Return to SLIME top-level."
+ (lambda ()
+ (fluid-let ((*top-level-restart* (find-restart 'abort)))
+ (dispatch (read-packet socket) socket 0))))))
+
+(define (with-keyboard-interrupt-handler fun)
+ (define (set-^G-handler exp)
+ (eval `(vector-set! keyboard-interrupt-vector (char->ascii #\G) ,exp)
+ (->environment '(runtime interrupt-handler))))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda ()
+ (set-^G-handler
+ `(lambda (char) (with-simple-restart
+ 'continue "Continue from interrupt."
+ (lambda () (error "Keyboard Interrupt.")))))
+ (fun))
+ (lambda ()
+ (set-^G-handler '^G-interrupt-handler))))
+
+
+;;;; Reading/Writing of SLIME packets
+
+(define (read-packet in)
+ "Read an S-expression from STREAM using the SLIME protocol."
+ (let* ((len (read-length in))
+ (buffer (make-string len)))
+ (fill-buffer! in buffer)
+ (read-from-string buffer)))
+
+(define (write-packet message out)
+ (let* ((string (write-to-string message)))
+ (log-event "WRITE: [~a]~s~%" (string-length string) string)
+ (write-length (string-length string) out)
+ (write-string string out)
+ (flush-output out)))
+
+(define (fill-buffer! in buffer)
+ (read-string! buffer in))
+
+(define (read-length in)
+ (if (eof-object? (peek-char in)) (disconnect))
+ (do ((len 6 (1- len))
+ (sum 0 (+ (* sum 16) (char->hex-digit (read-char in)))))
+ ((zero? len) sum)))
+
+(define (ldb size position integer)
+ "LoaD a Byte of SIZE bits at bit position POSITION from INTEGER."
+ (fix:and (fix:lsh integer (- position))
+ (1- (fix:lsh 1 size))))
+
+(define (write-length len out)
+ (do ((pos 20 (- pos 4)))
+ ((< pos 0))
+ (write-hex-digit (ldb 4 pos len) out)))
+
+(define (write-hex-digit n out)
+ (write-char (hex-digit->char n) out))
+
+(define (hex-digit->char n)
+ (digit->char n 16))
+
+(define (char->hex-digit c)
+ (char->digit c 16))
+
+
+;;;; Event dispatching
+
+(define (dispatch request socket level)
+ (log-event "READ: ~s~%" request)
+ (case (car request)
+ ((:emacs-rex) (apply emacs-rex socket level (cdr request)))))
+
+(define (swank-package)
+ (or (name->package '(swank))
+ (name->package '(user))))
+
+(define *buffer-package* #f)
+(define (find-buffer-package name)
+ (if (elisp-false? name)
+ #f
+ (let ((v (ignore-errors
+ (lambda () (name->package (read-from-string name))))))
+ (and (package? v) v))))
+
+(define swank-env (->environment (swank-package)))
+(define (user-env buffer-package)
+ (cond ((string? buffer-package)
+ (let ((p (find-buffer-package buffer-package)))
+ (if (not p) (error "Invalid package name: " buffer-package))
+ (package/environment p)))
+ (else (nearest-repl/environment))))
+
+;; quote keywords
+(define (hack-quotes list)
+ (map (lambda (x)
+ (cond ((symbol? x) `(quote ,x))
+ (#t x)))
+ list))
+
+(define (emacs-rex socket level sexp package thread id)
+ (let ((ok? #f) (result #f) (condition #f))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda ()
+ (bind-condition-handler
+ (list condition-type:serious-condition)
+ (lambda (c) (set! condition c) (invoke-sldb socket (1+ level) c))
+ (lambda ()
+ (fluid-let ((*buffer-package* package))
+ (set! result
+ (eval (cons* (car sexp) socket (hack-quotes (cdr sexp)))
+ swank-env))
+ (set! ok? #t)))))
+ (lambda ()
+ (write-packet `(:return
+ ,(if ok? `(:ok ,result)
+ `(:abort
+ ,(if condition
+ (format #f "~a"
+ (condition/type condition))
+ "<unknown reason>")))
+ ,id)
+ socket)))))
+
+(define (swank:connection-info _)
+ (let ((p (environment->package (user-env #f))))
+ `(:pid ,(unix/current-pid)
+ :package (:name ,(write-to-string (package/name p))
+ :prompt ,(write-to-string (package/name p)))
+ :lisp-implementation
+ (:type "MIT Scheme" :version ,(get-subsystem-version-string "release"))
+ :encoding (:coding-systems ("iso-8859-1"))
+ )))
+
+(define (swank:quit-lisp _)
+ (%exit))
+
+
+;;;; Evaluation
+
+(define (swank-repl:listener-eval socket string)
+ ;;(call-with-values (lambda () (eval-region string socket))
+ ;; (lambda values `(:values . ,(map write-to-string values))))
+ `(:values ,(write-to-string (eval-region string socket))))
+
+(define (eval-region string socket)
+ (let ((sexp (read-from-string string)))
+ (if (eof-object? exp)
+ (values)
+ (with-output-to-repl socket
+ (lambda () (eval sexp (user-env *buffer-package*)))))))
+
+(define (with-output-to-repl socket fun)
+ (let ((p (make-port repl-port-type socket)))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda () (with-output-to-port p fun))
+ (lambda () (flush-output p)))))
+
+(define (swank:interactive-eval socket string)
+ ;;(call-with-values (lambda () (eval-region string)) format-for-echo-area)
+ (format-values (eval-region string socket))
+ )
+
+(define (format-values . values)
+ (if (null? values)
+ "; No value"
+ (with-string-output-port
+ (lambda (out)
+ (write-string "=> " out)
+ (do ((vs values (cdr vs))) ((null? vs))
+ (write (car vs) out)
+ (if (not (null? (cdr vs)))
+ (write-string ", " out)))))))
+
+(define (swank:pprint-eval _ string)
+ (pprint-to-string (eval (read-from-string string)
+ (user-env *buffer-package*))))
+
+(define (swank:interactive-eval-region socket string)
+ (format-values (eval-region string socket)))
+
+(define (swank:set-package _ package)
+ (set-repl/environment! (nearest-repl)
+ (->environment (read-from-string package)))
+ (let* ((p (environment->package (user-env #f)))
+ (n (write-to-string (package/name p))))
+ (list n n)))
+
+
+(define (repl-write-substring port string start end)
+ (cond ((< start end)
+ (write-packet `(:write-string ,(substring string start end))
+ (port/state port))))
+ (- end start))
+
+(define (repl-write-char port char)
+ (write-packet `(:write-string ,(string char))
+ (port/state port)))
+
+(define repl-port-type
+ (make-port-type `((write-substring ,repl-write-substring)
+ (write-char ,repl-write-char)) #f))
+
+(define (swank-repl:create-repl socket . _)
+ (let* ((env (user-env #f))
+ (name (format #f "~a" (package/name (environment->package env)))))
+ (list name name)))
+
+
+;;;; Compilation
+
+(define (swank:compile-string-for-emacs _ string . x)
+ (apply
+ (lambda (errors seconds)
+ `(:compilation-result ,errors t ,seconds nil nil))
+ (call-compiler
+ (lambda ()
+ (let* ((sexps (snarf-string string))
+ (env (user-env *buffer-package*))
+ (scode (syntax `(begin ,@sexps) env))
+ (compiled-expression (compile-scode scode #t)))
+ (scode-eval compiled-expression env))))))
+
+(define (snarf-string string)
+ (with-input-from-string string
+ (lambda ()
+ (let loop ()
+ (let ((e (read)))
+ (if (eof-object? e) '() (cons e (loop))))))))
+
+(define (call-compiler fun)
+ (let ((time #f))
+ (with-timings fun
+ (lambda (run-time gc-time real-time)
+ (set! time real-time)))
+ (list 'nil (internal-time/ticks->seconds time))))
+
+(define (swank:compiler-notes-for-emacs _) nil)
+
+(define (swank:compile-file-for-emacs socket file load?)
+ (apply
+ (lambda (errors seconds)
+ (list ':compilation-result errors 't seconds load?
+ (->namestring (pathname-name file))))
+ (call-compiler
+ (lambda () (with-output-to-repl socket (lambda () (compile-file file)))))))
+
+(define (swank:load-file socket file)
+ (with-output-to-repl socket
+ (lambda ()
+ (pprint-to-string
+ (load file (user-env *buffer-package*))))))
+
+(define (swank:disassemble-form _ string)
+ (let ((sexp (let ((sexp (read-from-string string)))
+ (cond ((and (pair? sexp) (eq? (car sexp) 'quote))
+ (cadr sexp))
+ (#t sexp)))))
+ (with-output-to-string
+ (lambda ()
+ (compiler:disassemble
+ (eval sexp (user-env *buffer-package*)))))))
+
+(define (swank:disassemble-symbol _ string)
+ (with-output-to-string
+ (lambda ()
+ (compiler:disassemble
+ (eval (read-from-string string)
+ (user-env *buffer-package*))))))
+
+
+;;;; Macroexpansion
+
+(define (swank:swank-macroexpand-all _ string)
+ (with-output-to-string
+ (lambda ()
+ (pp (syntax (read-from-string string)
+ (user-env *buffer-package*))))))
+(define swank:swank-macroexpand-1 swank:swank-macroexpand-all)
+(define swank:swank-macroexpand swank:swank-macroexpand-all)
+
+
+;;; Arglist
+
+(define (swank:operator-arglist socket name pack)
+ (let ((v (ignore-errors
+ (lambda ()
+ (string-trim-right
+ (with-output-to-string
+ (lambda ()
+ (carefully-pa
+ (eval (read-from-string name) (user-env pack))))))))))
+ (if (condition? v) 'nil v)))
+
+(define (carefully-pa o)
+ (cond ((arity-dispatched-procedure? o)
+ ;; MIT Scheme crashes for (pa /)
+ (display "arity-dispatched-procedure"))
+ ((procedure? o) (pa o))
+ (else (error "Not a procedure"))))
+
+
+;;; Some unimplemented stuff.
+(define (swank:buffer-first-change . _) nil)
+(define (swank:filename-to-modulename . _) nil)
+(define (swank:swank-require . _) nil)
+
+;; M-. is beyond my capabilities.
+(define (swank:find-definitions-for-emacs . _) nil)
+
+
+;;; Debugger
+
+(define-structure (sldb-state (conc-name sldb-state.)) condition restarts)
+
+(define *sldb-state* #f)
+(define (invoke-sldb socket level condition)
+ (fluid-let ((*sldb-state* (make-sldb-state condition (bound-restarts))))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda ()
+ (write-packet `(:debug 0 ,level ,@(sldb-info *sldb-state* 0 20))
+ socket)
+ (sldb-loop level socket))
+ (lambda ()
+ (write-packet `(:debug-return 0 ,level nil) socket)))))
+
+(define (sldb-loop level socket)
+ (write-packet `(:debug-activate 0 ,level) socket)
+ (with-simple-restart
+ 'abort (format #f "Return to SLDB level ~a." level)
+ (lambda () (dispatch (read-packet socket) socket level)))
+ (sldb-loop level socket))
+
+(define (sldb-info state start end)
+ (let ((c (sldb-state.condition state))
+ (rs (sldb-state.restarts state)))
+ (list (list (condition/report-string c)
+ (format #f " [~a]" (%condition-type/name (condition/type c)))
+ nil)
+ (sldb-restarts rs)
+ (sldb-backtrace c start end)
+ ;;'((0 "dummy frame"))
+ '())))
+
+(define %condition-type/name
+ (eval '%condition-type/name (->environment '(runtime error-handler))))
+
+(define (sldb-restarts restarts)
+ (map (lambda (r)
+ (list (symbol->string (restart/name r))
+ (with-string-output-port
+ (lambda (p) (write-restart-report r p)))))
+ restarts))
+
+(define (swank:throw-to-toplevel . _)
+ (invoke-restart *top-level-restart*))
+
+(define (swank:sldb-abort . _)
+ (abort (sldb-state.restarts *sldb-state*)))
+
+(define (swank:sldb-continue . _)
+ (continue (sldb-state.restarts *sldb-state*)))
+
+(define (swank:invoke-nth-restart-for-emacs _ _sldb-level n)
+ (invoke-restart (list-ref (sldb-state.restarts *sldb-state*) n)))
+
+(define (swank:debugger-info-for-emacs _ from to)
+ (sldb-info *sldb-state* from to))
+
+(define (swank:backtrace _ from to)
+ (sldb-backtrace (sldb-state.condition *sldb-state*) from to))
+
+(define (sldb-backtrace condition from to)
+ (sldb-backtrace-aux (condition/continuation condition) from to))
+
+(define (sldb-backtrace-aux k from to)
+ (let ((l (map frame>string (substream (continuation>frames k) from to))))
+ (let loop ((i from) (l l))
+ (if (null? l)
+ '()
+ (cons (list i (car l)) (loop (1+ i) (cdr l)))))))
+
+;; Stack parser fails for this:
+;; (map (lambda (x) x) "/tmp/x.x")
+
+(define (continuation>frames k)
+ (let loop ((frame (continuation->stack-frame k)))
+ (cond ((not frame) (stream))
+ (else
+ (let ((next (ignore-errors
+ (lambda () (stack-frame/next-subproblem frame)))))
+ (cons-stream frame
+ (if (condition? next)
+ (stream next)
+ (loop next))))))))
+
+(define (frame>string frame)
+ (if (condition? frame)
+ (format #f "Bogus frame: ~a ~a" frame
+ (condition/report-string frame))
+ (with-string-output-port (lambda (p) (print-frame frame p)))))
+
+(define (print-frame frame port)
+ (define (invalid-subexpression? subexpression)
+ (or (debugging-info/undefined-expression? subexpression)
+ (debugging-info/unknown-expression? subexpression)))
+ (define (invalid-expression? expression)
+ (or (debugging-info/undefined-expression? expression)
+ (debugging-info/compiled-code? expression)))
+ (with-values (lambda () (stack-frame/debugging-info frame))
+ (lambda (expression environment subexpression)
+ (cond ((debugging-info/compiled-code? expression)
+ (write-string ";unknown compiled code" port))
+ ((not (debugging-info/undefined-expression? expression))
+ (fluid-let ((*unparse-primitives-by-name?* #t))
+ (write
+ (unsyntax (if (invalid-subexpression? subexpression)
+ expression
+ subexpression))
+ port)))
+ ((debugging-info/noise? expression)
+ (write-string ";" port)
+ (write-string ((debugging-info/noise expression) #f)
+ port))
+ (else
+ (write-string ";undefined expression" port))))))
+
+(define (substream s from to)
+ (let loop ((i 0) (l '()) (s s))
+ (cond ((or (= i to) (stream-null? s)) (reverse l))
+ ((< i from) (loop (1+ i) l (stream-cdr s)))
+ (else (loop (1+ i) (cons (stream-car s) l) (stream-cdr s))))))
+
+(define (swank:frame-locals-and-catch-tags _ frame)
+ (list (map frame-var>elisp (frame-vars (sldb-get-frame frame)))
+ '()))
+
+(define (frame-vars frame)
+ (with-values (lambda () (stack-frame/debugging-info frame))
+ (lambda (expression environment subexpression)
+ (cond ((environment? environment)
+ (environment>frame-vars environment))
+ (else '())))))
+
+(define (environment>frame-vars environment)
+ (let loop ((e environment))
+ (cond ((environment->package e) '())
+ (else (append (environment-bindings e)
+ (if (environment-has-parent? e)
+ (loop (environment-parent e))
+ '()))))))
+
+(define (frame-var>elisp b)
+ (list ':name (write-to-string (car b))
+ ':value (cond ((null? (cdr b)) "{unavailable}")
+ (else (>line (cadr b))))
+ ':id 0))
+
+(define (sldb-get-frame index)
+ (stream-ref (continuation>frames
+ (condition/continuation
+ (sldb-state.condition *sldb-state*)))
+ index))
+
+(define (frame-var-value frame var)
+ (let ((binding (list-ref (frame-vars frame) var)))
+ (cond ((cdr binding) (cadr binding))
+ (else unspecific))))
+
+(define (swank:inspect-frame-var _ frame var)
+ (reset-inspector)
+ (inspect-object (frame-var-value (sldb-get-frame frame) var)))
+
+
+;;;; Completion
+
+(define (swank:simple-completions _ string package)
+ (let ((strings (all-completions string (user-env package) string-prefix?)))
+ (list (sort strings string<?)
+ (longest-common-prefix strings))))
+
+(define (all-completions pattern env match?)
+ (let ((ss (map %symbol->string (environment-names env))))
+ (keep-matching-items ss (lambda (s) (match? pattern s)))))
+
+;; symbol->string is too slow
+(define %symbol->string symbol-name)
+
+(define (environment-names env)
+ (append (environment-bound-names env)
+ (if (environment-has-parent? env)
+ (environment-names (environment-parent env))
+ '())))
+
+(define (longest-common-prefix strings)
+ (define (common-prefix s1 s2)
+ (substring s1 0 (string-match-forward s1 s2)))
+ (reduce common-prefix "" strings))
+
+
+;;;; Apropos
+
+(define (swank:apropos-list-for-emacs _ name #!optional
+ external-only case-sensitive package)
+ (let* ((pkg (and (string? package)
+ (find-package (read-from-string package))))
+ (parent (and (not (default-object? external-only))
+ (elisp-false? external-only)))
+ (ss (append-map (lambda (p)
+ (map (lambda (s) (cons p s))
+ (apropos-list name p (and pkg parent))))
+ (if pkg (list pkg) (all-packages))))
+ (ss (sublist ss 0 (min (length ss) 200))))
+ (map (lambda (e)
+ (let ((p (car e)) (s (cdr e)))
+ (list ':designator (format #f "~a ~a" s (package/name p))
+ ':variable (>line
+ (ignore-errors
+ (lambda () (package-lookup p s)))))))
+ ss)))
+
+(define (swank:list-all-package-names . _)
+ (map (lambda (p) (write-to-string (package/name p)))
+ (all-packages)))
+
+(define (all-packages)
+ (define (package-and-children package)
+ (append (list package)
+ (append-map package-and-children (package/children package))))
+ (package-and-children system-global-package))
+
+
+;;;; Inspector
+
+(define-structure (inspector-state (conc-name istate.))
+ object parts next previous content)
+
+(define istate #f)
+
+(define (reset-inspector)
+ (set! istate #f))
+
+(define (swank:init-inspector _ string)
+ (reset-inspector)
+ (inspect-object (eval (read-from-string string)
+ (user-env *buffer-package*))))
+
+(define (inspect-object o)
+ (let ((previous istate)
+ (content (inspect o))
+ (parts (make-eqv-hash-table)))
+ (set! istate (make-inspector-state o parts #f previous content))
+ (if previous (set-istate.next! previous istate))
+ (istate>elisp istate)))
+
+(define (istate>elisp istate)
+ (list ':title (>line (istate.object istate))
+ ':id (assign-index (istate.object istate) (istate.parts istate))
+ ':content (prepare-range (istate.parts istate)
+ (istate.content istate)
+ 0 500)))
+
+(define (assign-index o parts)
+ (let ((i (hash-table/count parts)))
+ (hash-table/put! parts i o)
+ i))
+
+(define (prepare-range parts content from to)
+ (let* ((cs (substream content from to))
+ (ps (prepare-parts cs parts)))
+ (list ps
+ (if (< (length cs) (- to from))
+ (+ from (length cs))
+ (+ to 1000))
+ from to)))
+
+(define (prepare-parts ps parts)
+ (define (line label value)
+ `(,(format #f "~a: " label)
+ (:value ,(>line value) ,(assign-index value parts))
+ "\n"))
+ (append-map (lambda (p)
+ (cond ((string? p) (list p))
+ ((symbol? p) (list (symbol->string p)))
+ (#t
+ (case (car p)
+ ((line) (apply line (cdr p)))
+ (else (error "Invalid part:" p))))))
+ ps))
+
+(define (swank:inspect-nth-part _ index)
+ (inspect-object (hash-table/get (istate.parts istate) index 'no-such-part)))
+
+(define (swank:quit-inspector _)
+ (reset-inspector))
+
+(define (swank:inspector-pop _)
+ (cond ((istate.previous istate)
+ (set! istate (istate.previous istate))
+ (istate>elisp istate))
+ (else 'nil)))
+
+(define (swank:inspector-next _)
+ (cond ((istate.next istate)
+ (set! istate (istate.next istate))
+ (istate>elisp istate))
+ (else 'nil)))
+
+(define (swank:inspector-range _ from to)
+ (prepare-range (istate.parts istate)
+ (istate.content istate)
+ from to))
+
+(define-syntax stream*
+ (syntax-rules ()
+ ((stream* tail) tail)
+ ((stream* e1 e2 ...) (cons-stream e1 (stream* e2 ...)))))
+
+(define (iline label value) `(line ,label ,value))
+
+(define-generic inspect (o))
+
+(define-method inspect ((o <object>))
+ (cond ((environment? o) (inspect-environment o))
+ ((vector? o) (inspect-vector o))
+ ((procedure? o) (inspect-procedure o))
+ ((compiled-code-block? o) (inspect-code-block o))
+ ;;((system-pair? o) (inspect-system-pair o))
+ ((probably-scode? o) (inspect-scode o))
+ (else (inspect-fallback o))))
+
+(define (inspect-fallback o)
+ (let* ((class (object-class o))
+ (slots (class-slots class)))
+ (stream*
+ (iline "Class" class)
+ (let loop ((slots slots))
+ (cond ((null? slots) (stream))
+ (else
+ (let ((n (slot-name (car slots))))
+ (stream* (iline n (slot-value o n))
+ (loop (cdr slots))))))))))
+
+(define-method inspect ((o <pair>))
+ (if (or (pair? (cdr o)) (null? (cdr o)))
+ (inspect-list o)
+ (inspect-cons o)))
+
+(define (inspect-cons o)
+ (stream (iline "car" (car o))
+ (iline "cdr" (cdr o))))
+
+(define (inspect-list o)
+ (let loop ((i 0) (o o))
+ (cond ((null? o) (stream))
+ ((or (pair? (cdr o)) (null? (cdr o)))
+ (stream* (iline i (car o))
+ (loop (1+ i) (cdr o))))
+ (else
+ (stream (iline i (car o))
+ (iline "tail" (cdr o)))))))
+
+(define (inspect-environment o)
+ (stream*
+ (iline "(package)" (environment->package o))
+ (let loop ((bs (environment-bindings o)))
+ (cond ((null? bs)
+ (if (environment-has-parent? o)
+ (stream (iline "(<parent>)" (environment-parent o)))
+ (stream)))
+ (else
+ (let* ((b (car bs)) (s (car b)))
+ (cond ((null? (cdr b))
+ (stream* s " {" (environment-reference-type o s) "}\n"
+ (loop (cdr bs))))
+ (else
+ (stream* (iline s (cadr b))
+ (loop (cdr bs)))))))))))
+
+(define (inspect-vector o)
+ (let ((len (vector-length o)))
+ (let loop ((i 0))
+ (cond ((= i len) (stream))
+ (else (stream* (iline i (vector-ref o i))
+ (loop (1+ i))))))))
+
+(define (inspect-procedure o)
+ (cond ((primitive-procedure? o)
+ (stream (iline "name" (primitive-procedure-name o))
+ (iline "arity" (primitive-procedure-arity o))
+ (iline "doc" (primitive-procedure-documentation o))))
+ ((compound-procedure? o)
+ (stream (iline "arity" (procedure-arity o))
+ (iline "lambda" (procedure-lambda o))
+ (iline "env" (ignore-errors
+ (lambda () (procedure-environment o))))))
+ (else
+ (stream
+ (iline "block" (compiled-entry/block o))
+ (with-output-to-string (lambda () (compiler:disassemble o)))))))
+
+(define (inspect-code-block o)
+ (stream-append
+ (let loop ((i (compiled-code-block/constants-start o)))
+ (cond ((>= i (compiled-code-block/constants-end o)) (stream))
+ (else
+ (stream*
+ (iline i (system-vector-ref o i))
+ (loop (+ i compiled-code-block/bytes-per-object))))))
+ (stream (iline "debuginfo" (compiled-code-block/debugging-info o))
+ (iline "env" (compiled-code-block/environment o))
+ (with-output-to-string (lambda () (compiler:disassemble o))))))
+
+(define (inspect-scode o)
+ (stream (pprint-to-string o)))
+
+(define (probably-scode? o)
+ (define tests (list access? assignment? combination? comment?
+ conditional? definition? delay? disjunction? lambda?
+ quotation? sequence? the-environment? variable?))
+ (let loop ((tests tests))
+ (cond ((null? tests) #f)
+ (((car tests) o))
+ (else (loop (cdr tests))))))
+
+(define (inspect-system-pair o)
+ (stream (iline "car" (system-pair-car o))
+ (iline "cdr" (system-pair-cdr o))))
+
+
+;;;; Auxilary functions
+
+(define nil '())
+(define t 't)
+(define (elisp-false? o) (member o '(nil ())))
+(define (elisp-true? o) (not (elisp-false? o)))
+(define (>line o)
+ (let ((r (write-to-string o 100)))
+ (cond ((not (car r)) (cdr r))
+ (else (string-append (cdr r) " ..")))))
+;; Must compile >line otherwise we can't write unassigend-reference-traps.
+(set! >line (compile-procedure >line))
+(define (read-from-string s) (with-input-from-string s read))
+(define (pprint-to-string o)
+ (with-string-output-port
+ (lambda (p)
+ (fluid-let ((*unparser-list-breadth-limit* 10)
+ (*unparser-list-depth-limit* 4)
+ (*unparser-string-length-limit* 100))
+ (pp o p)))))
+;(define (1+ n) (+ n 1))
+(define (1- n) (- n 1))
+(define (package-lookup package name)
+ (let ((p (if (package? package) package (find-package package))))
+ (environment-lookup (package/environment p) name)))
+(define log-port (current-output-port))
+(define (log-event fstring . args)
+ ;;(apply format log-port fstring args)
+ #f
+ )
+
+;; Modified for Slimv:
+;; - restart swank server in a loop
+(let loop ()
+ (swank 4005)
+ (loop))
+
+;;; swank-mit-scheme.scm ends here
diff --git a/vim/bundle/slimv/slime/contrib/swank-mrepl.lisp b/vim/bundle/slimv/slime/contrib/swank-mrepl.lisp
new file mode 100644
index 0000000..cc8ce81
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-mrepl.lisp
@@ -0,0 +1,162 @@
+;;; swank-mrepl.lisp
+;;
+;; Licence: public domain
+
+(in-package :swank)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (let ((api '(
+ *emacs-connection*
+ channel
+ channel-id
+ define-channel-method
+ defslimefun
+ dcase
+ log-event
+ process-requests
+ send-to-remote-channel
+ use-threads-p
+ wait-for-event
+ with-bindings
+ with-connection
+ with-top-level-restart
+ with-slime-interrupts
+ )))
+ (eval `(defpackage #:swank-api
+ (:use)
+ (:import-from #:swank . ,api)
+ (:export . ,api)))))
+
+(defpackage :swank-mrepl
+ (:use :cl :swank-api)
+ (:export #:create-mrepl))
+
+(in-package :swank-mrepl)
+
+(defclass listener-channel (channel)
+ ((remote :initarg :remote)
+ (env :initarg :env)
+ (mode :initform :eval)
+ (tag :initform nil)))
+
+(defun package-prompt (package)
+ (reduce (lambda (x y) (if (<= (length x) (length y)) x y))
+ (cons (package-name package) (package-nicknames package))))
+
+(defslimefun create-mrepl (remote)
+ (let* ((pkg *package*)
+ (conn *emacs-connection*)
+ (thread (if (use-threads-p)
+ (spawn-listener-thread conn)
+ nil))
+ (ch (make-instance 'listener-channel :remote remote :thread thread)))
+ (setf (slot-value ch 'env) (initial-listener-env ch))
+ (when thread
+ (swank/backend:send thread `(:serve-channel ,ch)))
+ (list (channel-id ch)
+ (swank/backend:thread-id (or thread (swank/backend:current-thread)))
+ (package-name pkg)
+ (package-prompt pkg))))
+
+(defun initial-listener-env (listener)
+ `((*package* . ,*package*)
+ (*standard-output* . ,(make-listener-output-stream listener))
+ (*standard-input* . ,(make-listener-input-stream listener))))
+
+(defun spawn-listener-thread (connection)
+ (swank/backend:spawn
+ (lambda ()
+ (with-connection (connection)
+ (dcase (swank/backend:receive)
+ ((:serve-channel c)
+ (loop
+ (with-top-level-restart (connection (drop-unprocessed-events c))
+ (process-requests nil)))))))
+ :name "mrepl thread"))
+
+(defun drop-unprocessed-events (channel)
+ (with-slots (mode) channel
+ (let ((old-mode mode))
+ (setf mode :drop)
+ (unwind-protect
+ (process-requests t)
+ (setf mode old-mode)))
+ (send-prompt channel)))
+
+(define-channel-method :process ((c listener-channel) string)
+ (log-event ":process ~s~%" string)
+ (with-slots (mode remote) c
+ (ecase mode
+ (:eval (mrepl-eval c string))
+ (:read (mrepl-read c string))
+ (:drop))))
+
+(defun mrepl-eval (channel string)
+ (with-slots (remote env) channel
+ (let ((aborted t))
+ (with-bindings env
+ (unwind-protect
+ (let ((result (with-slime-interrupts (read-eval-print string))))
+ (send-to-remote-channel remote `(:write-result ,result))
+ (setq aborted nil))
+ (setf env (loop for (sym) in env
+ collect (cons sym (symbol-value sym))))
+ (cond (aborted
+ (send-to-remote-channel remote `(:evaluation-aborted)))
+ (t
+ (send-prompt channel))))))))
+
+(defun send-prompt (channel)
+ (with-slots (env remote) channel
+ (let ((pkg (or (cdr (assoc '*package* env)) *package*))
+ (out (cdr (assoc '*standard-output* env)))
+ (in (cdr (assoc '*standard-input* env))))
+ (when out (force-output out))
+ (when in (clear-input in))
+ (send-to-remote-channel remote `(:prompt ,(package-name pkg)
+ ,(package-prompt pkg))))))
+
+(defun mrepl-read (channel string)
+ (with-slots (tag) channel
+ (assert tag)
+ (throw tag string)))
+
+(defun read-eval-print (string)
+ (with-input-from-string (in string)
+ (setq / ())
+ (loop
+ (let* ((form (read in nil in)))
+ (cond ((eq form in) (return))
+ (t (setq / (multiple-value-list (eval (setq + form))))))))
+ (force-output)
+ (if /
+ (format nil "~{~s~%~}" /)
+ "; No values")))
+
+(defun make-listener-output-stream (channel)
+ (let ((remote (slot-value channel 'remote)))
+ (swank/backend:make-output-stream
+ (lambda (string)
+ (send-to-remote-channel remote `(:write-string ,string))))))
+
+(defun make-listener-input-stream (channel)
+ (swank/backend:make-input-stream (lambda () (read-input channel))))
+
+(defun set-mode (channel new-mode)
+ (with-slots (mode remote) channel
+ (unless (eq mode new-mode)
+ (send-to-remote-channel remote `(:set-read-mode ,new-mode)))
+ (setf mode new-mode)))
+
+(defun read-input (channel)
+ (with-slots (mode tag remote) channel
+ (force-output)
+ (let ((old-mode mode)
+ (old-tag tag))
+ (setf tag (cons nil nil))
+ (set-mode channel :read)
+ (unwind-protect
+ (catch tag (process-requests nil))
+ (setf tag old-tag)
+ (set-mode channel old-mode)))))
+
+(provide :swank-mrepl)
diff --git a/vim/bundle/slimv/slime/contrib/swank-package-fu.lisp b/vim/bundle/slimv/slime/contrib/swank-package-fu.lisp
new file mode 100644
index 0000000..a22807a
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-package-fu.lisp
@@ -0,0 +1,65 @@
+
+(in-package :swank)
+
+(defslimefun package= (string1 string2)
+ (let* ((pkg1 (guess-package string1))
+ (pkg2 (guess-package string2)))
+ (and pkg1 pkg2 (eq pkg1 pkg2))))
+
+(defslimefun export-symbol-for-emacs (symbol-str package-str)
+ (let ((package (guess-package package-str)))
+ (when package
+ (let ((*buffer-package* package))
+ (export `(,(from-string symbol-str)) package)))))
+
+(defslimefun unexport-symbol-for-emacs (symbol-str package-str)
+ (let ((package (guess-package package-str)))
+ (when package
+ (let ((*buffer-package* package))
+ (unexport `(,(from-string symbol-str)) package)))))
+
+#+sbcl
+(defun list-structure-symbols (name)
+ (let ((dd (sb-kernel:find-defstruct-description name )))
+ (list* name
+ (sb-kernel:dd-default-constructor dd)
+ (sb-kernel:dd-predicate-name dd)
+ (sb-kernel::dd-copier-name dd)
+ (mapcar #'sb-kernel:dsd-accessor-name
+ (sb-kernel:dd-slots dd)))))
+
+#+ccl
+(defun list-structure-symbols (name)
+ (let ((definition (gethash name ccl::%defstructs%)))
+ (list* name
+ (ccl::sd-constructor definition)
+ (ccl::sd-refnames definition))))
+
+(defun list-class-symbols (name)
+ (let* ((class (find-class name))
+ (slots (swank-mop:class-direct-slots class)))
+ (labels ((extract-symbol (name)
+ (if (and (consp name) (eql (car name) 'setf))
+ (cadr name)
+ name))
+ (slot-accessors (slot)
+ (nintersection (copy-list (swank-mop:slot-definition-readers slot))
+ (copy-list (swank-mop:slot-definition-readers slot))
+ :key #'extract-symbol)))
+ (list* (class-name class)
+ (mapcan #'slot-accessors slots)))))
+
+(defslimefun export-structure (name package)
+ (let ((*package* (guess-package package)))
+ (when *package*
+ (let* ((name (from-string name))
+ (symbols (cond #+(or sbcl ccl)
+ ((or (not (find-class name nil))
+ (subtypep name 'structure-object))
+ (list-structure-symbols name))
+ (t
+ (list-class-symbols name)))))
+ (export symbols)
+ symbols))))
+
+(provide :swank-package-fu)
diff --git a/vim/bundle/slimv/slime/contrib/swank-presentation-streams.lisp b/vim/bundle/slimv/slime/contrib/swank-presentation-streams.lisp
new file mode 100644
index 0000000..a83d62e
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-presentation-streams.lisp
@@ -0,0 +1,334 @@
+;;; swank-presentation-streams.lisp --- Streams that allow attaching object identities
+;;; to portions of output
+;;;
+;;; Authors: Alan Ruttenberg <alanr-l@mumble.net>
+;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>
+;;; Helmut Eller <heller@common-lisp.net>
+;;;
+;;; License: This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+
+(in-package :swank)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (swank-require :swank-presentations))
+
+;; This file contains a mechanism for printing to the slime repl so
+;; that the printed result remembers what object it is associated
+;; with. This extends the recording of REPL results.
+;;
+;; There are two methods:
+;;
+;; 1. Depends on the ilisp bridge code being installed and ready to
+;; intercept messages in the printed stream. We encode the
+;; information with a message saying that we are starting to print
+;; an object corresponding to a given id and another when we are
+;; done. The process filter notices these and adds the necessary
+;; text properties to the output.
+;;
+;; 2. Use separate protocol messages :presentation-start and
+;; :presentation-end for sending presentations.
+;;
+;; We only do this if we know we are printing to a slime stream,
+;; checked with the method slime-stream-p. Initially this checks for
+;; the knows slime streams looking at *connections*. In cmucl, sbcl, and
+;; openmcl it also checks if it is a pretty-printing stream which
+;; ultimately prints to a slime stream.
+;;
+;; Method 1 seems to be faster, but the printed escape sequences can
+;; disturb the column counting, and thus the layout in pretty-printing.
+;; We use method 1 when a dedicated output stream is used.
+;;
+;; Method 2 is cleaner and works with pretty printing if the pretty
+;; printers support "annotations". We use method 2 when no dedicated
+;; output stream is used.
+
+;; Control
+(defvar *enable-presenting-readable-objects* t
+ "set this to enable automatically printing presentations for some
+subset of readable objects, such as pathnames." )
+
+;; doing it
+
+(defmacro presenting-object (object stream &body body)
+ "What you use in your code. Wrap this around some printing and that text will
+be sensitive and remember what object it is in the repl"
+ `(presenting-object-1 ,object ,stream #'(lambda () ,@body)))
+
+(defmacro presenting-object-if (predicate object stream &body body)
+ "What you use in your code. Wrap this around some printing and that text will
+be sensitive and remember what object it is in the repl if predicate is true"
+ (let ((continue (gensym)))
+ `(let ((,continue #'(lambda () ,@body)))
+ (if ,predicate
+ (presenting-object-1 ,object ,stream ,continue)
+ (funcall ,continue)))))
+
+;;; Get pretty printer patches for SBCL at load (not compile) time.
+#+#:disable-dangerous-patching ; #+sbcl
+(eval-when (:load-toplevel)
+ (handler-bind ((simple-error
+ (lambda (c)
+ (declare (ignore c))
+ (let ((clobber-it (find-restart 'sb-kernel::clobber-it)))
+ (when clobber-it (invoke-restart clobber-it))))))
+ (sb-ext:without-package-locks
+ (swank/sbcl::with-debootstrapping
+ (load (make-pathname
+ :name "sbcl-pprint-patch"
+ :type "lisp"
+ :directory (pathname-directory
+ swank-loader:*source-directory*)))))))
+
+(let ((last-stream nil)
+ (last-answer nil))
+ (defun slime-stream-p (stream)
+ "Check if stream is one of the slime streams, since if it isn't we
+don't want to present anything.
+Two special return values:
+:DEDICATED -- Output ends up on a dedicated output stream
+:REPL-RESULT -- Output ends up on the :repl-results target.
+"
+ (if (eq last-stream stream)
+ last-answer
+ (progn
+ (setq last-stream stream)
+ (if (eq stream t)
+ (setq stream *standard-output*))
+ (setq last-answer
+ (or #+openmcl
+ (and (typep stream 'ccl::xp-stream)
+ ;(slime-stream-p (ccl::xp-base-stream (slot-value stream 'ccl::xp-structure)))
+ (slime-stream-p (ccl::%svref (slot-value stream 'ccl::xp-structure) 1)))
+ #+cmu
+ (or (and (typep stream 'lisp::indenting-stream)
+ (slime-stream-p (lisp::indenting-stream-stream stream)))
+ (and (typep stream 'pretty-print::pretty-stream)
+ (fboundp 'pretty-print::enqueue-annotation)
+ (let ((slime-stream-p
+ (slime-stream-p (pretty-print::pretty-stream-target stream))))
+ (and ;; Printing through CMUCL pretty
+ ;; streams is only cleanly
+ ;; possible if we are using the
+ ;; bridge-less protocol with
+ ;; annotations, because the bridge
+ ;; escape sequences disturb the
+ ;; pretty printer layout.
+ (not (eql slime-stream-p :dedicated-output))
+ ;; If OK, return the return value
+ ;; we got from slime-stream-p on
+ ;; the target stream (could be
+ ;; :repl-result):
+ slime-stream-p))))
+ #+sbcl
+ (let ()
+ (declare (notinline sb-pretty::pretty-stream-target))
+ (and (typep stream (find-symbol "PRETTY-STREAM" 'sb-pretty))
+ (find-symbol "ENQUEUE-ANNOTATION" 'sb-pretty)
+ (not *use-dedicated-output-stream*)
+ (slime-stream-p (sb-pretty::pretty-stream-target stream))))
+ #+allegro
+ (and (typep stream 'excl:xp-simple-stream)
+ (slime-stream-p (excl::stream-output-handle stream)))
+ (loop for connection in *connections*
+ thereis (or (and (eq stream (connection.dedicated-output connection))
+ :dedicated)
+ (eq stream (connection.socket-io connection))
+ (eq stream (connection.user-output connection))
+ (eq stream (connection.user-io connection))
+ (and (eq stream (connection.repl-results connection))
+ :repl-result)))))))))
+
+(defun can-present-readable-objects (&optional stream)
+ (declare (ignore stream))
+ *enable-presenting-readable-objects*)
+
+;; If we are printing to an XP (pretty printing) stream, printing the
+;; escape sequences directly would mess up the layout because column
+;; counting is disturbed. Use "annotations" instead.
+#+allegro
+(defun write-annotation (stream function arg)
+ (if (typep stream 'excl:xp-simple-stream)
+ (excl::schedule-annotation stream function arg)
+ (funcall function arg stream nil)))
+#+cmu
+(defun write-annotation (stream function arg)
+ (if (and (typep stream 'pp:pretty-stream)
+ (fboundp 'pp::enqueue-annotation))
+ (pp::enqueue-annotation stream function arg)
+ (funcall function arg stream nil)))
+#+sbcl
+(defun write-annotation (stream function arg)
+ (let ((enqueue-annotation
+ (find-symbol "ENQUEUE-ANNOTATION" 'sb-pretty)))
+ (if (and enqueue-annotation
+ (typep stream (find-symbol "PRETTY-STREAM" 'sb-pretty)))
+ (funcall enqueue-annotation stream function arg)
+ (funcall function arg stream nil))))
+#-(or allegro cmu sbcl)
+(defun write-annotation (stream function arg)
+ (funcall function arg stream nil))
+
+(defstruct presentation-record
+ (id)
+ (printed-p)
+ (target))
+
+(defun presentation-start (record stream truncatep)
+ (unless truncatep
+ ;; Don't start new presentations when nothing is going to be
+ ;; printed due to *print-lines*.
+ (let ((pid (presentation-record-id record))
+ (target (presentation-record-target record)))
+ (case target
+ (:dedicated
+ ;; Use bridge protocol
+ (write-string "<" stream)
+ (prin1 pid stream)
+ (write-string "" stream))
+ (t
+ (finish-output stream)
+ (send-to-emacs `(:presentation-start ,pid ,target)))))
+ (setf (presentation-record-printed-p record) t)))
+
+(defun presentation-end (record stream truncatep)
+ (declare (ignore truncatep))
+ ;; Always end old presentations that were started.
+ (when (presentation-record-printed-p record)
+ (let ((pid (presentation-record-id record))
+ (target (presentation-record-target record)))
+ (case target
+ (:dedicated
+ ;; Use bridge protocol
+ (write-string ">" stream)
+ (prin1 pid stream)
+ (write-string "" stream))
+ (t
+ (finish-output stream)
+ (send-to-emacs `(:presentation-end ,pid ,target)))))))
+
+(defun presenting-object-1 (object stream continue)
+ "Uses the bridge mechanism with two messages >id and <id. The first one
+says that I am starting to print an object with this id. The second says I am finished"
+ ;; this declare special is to let the compiler know that *record-repl-results* will eventually be
+ ;; a global special, even if it isn't when this file is compiled/loaded.
+ (declare (special *record-repl-results*))
+ (let ((slime-stream-p
+ (and *record-repl-results* (slime-stream-p stream))))
+ (if slime-stream-p
+ (let* ((pid (swank::save-presented-object object))
+ (record (make-presentation-record :id pid :printed-p nil
+ :target (if (eq slime-stream-p :repl-result)
+ :repl-result
+ nil))))
+ (write-annotation stream #'presentation-start record)
+ (multiple-value-prog1
+ (funcall continue)
+ (write-annotation stream #'presentation-end record)))
+ (funcall continue))))
+
+(defun present-repl-results-via-presentation-streams (values)
+ ;; Override a function in swank.lisp, so that
+ ;; nested presentations work in the REPL result.
+ (let ((repl-results (connection.repl-results *emacs-connection*)))
+ (flet ((send (value)
+ (presenting-object value repl-results
+ (prin1 value repl-results))
+ (terpri repl-results)))
+ (if (null values)
+ (progn
+ (princ "; No value" repl-results)
+ (terpri repl-results))
+ (mapc #'send values)))
+ (finish-output repl-results)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+#+openmcl
+(in-package :ccl)
+
+#+openmcl
+(defun monkey-patch-stream-printing ()
+ (let ((*warn-if-redefine-kernel* nil)
+ (*warn-if-redefine* nil))
+ (defun %print-unreadable-object (object stream type id thunk)
+ (cond ((null stream) (setq stream *standard-output*))
+ ((eq stream t) (setq stream *terminal-io*)))
+ (swank::presenting-object object stream
+ (write-unreadable-start object stream)
+ (when type
+ (princ (type-of object) stream)
+ (stream-write-char stream #\space))
+ (when thunk
+ (funcall thunk))
+ (if id
+ (%write-address object stream #\>)
+ (pp-end-block stream ">"))
+ nil))
+ (defmethod print-object :around ((pathname pathname) stream)
+ (swank::presenting-object-if
+ (swank::can-present-readable-objects stream)
+ pathname stream (call-next-method))))
+ (ccl::def-load-pointers clear-presentations ()
+ (swank::clear-presentation-tables)))
+
+(in-package :swank)
+
+#+cmu
+(progn
+ (fwrappers:define-fwrapper presenting-unreadable-wrapper (object stream type identity body)
+ (presenting-object object stream
+ (fwrappers:call-next-function)))
+
+ (fwrappers:define-fwrapper presenting-pathname-wrapper (pathname stream depth)
+ (presenting-object-if (can-present-readable-objects stream) pathname stream
+ (fwrappers:call-next-function)))
+
+ (defun monkey-patch-stream-printing ()
+ (fwrappers::fwrap 'lisp::%print-pathname #'presenting-pathname-wrapper)
+ (fwrappers::fwrap 'lisp::%print-unreadable-object #'presenting-unreadable-wrapper)))
+
+#+sbcl
+(progn
+ (defvar *saved-%print-unreadable-object*
+ (fdefinition 'sb-impl::%print-unreadable-object))
+
+ (defun monkey-patch-stream-printing ()
+ (sb-ext:without-package-locks
+ (when (eq (fdefinition 'sb-impl::%print-unreadable-object)
+ *saved-%print-unreadable-object*)
+ (setf (fdefinition 'sb-impl::%print-unreadable-object)
+ (lambda (object stream type identity &optional body)
+ (presenting-object object stream
+ (funcall *saved-%print-unreadable-object*
+ object stream type identity body)))))
+ (defmethod print-object :around ((object pathname) stream)
+ (presenting-object object stream
+ (call-next-method))))))
+
+#+allegro
+(progn
+ (excl:def-fwrapper presenting-unreadable-wrapper (object stream type identity continuation)
+ (swank::presenting-object object stream (excl:call-next-fwrapper)))
+ (excl:def-fwrapper presenting-pathname-wrapper (pathname stream depth)
+ (presenting-object-if (can-present-readable-objects stream) pathname stream
+ (excl:call-next-fwrapper)))
+ (defun monkey-patch-stream-printing ()
+ (excl:fwrap 'excl::print-unreadable-object-1
+ 'print-unreadable-present 'presenting-unreadable-wrapper)
+ (excl:fwrap 'excl::pathname-printer
+ 'print-pathname-present 'presenting-pathname-wrapper)))
+
+#-(or allegro sbcl cmu openmcl)
+(defun monkey-patch-stream-printing ()
+ (values))
+
+;; Hook into SWANK.
+
+(defslimefun init-presentation-streams ()
+ (monkey-patch-stream-printing)
+ ;; FIXME: import/use swank-repl to avoid package qualifier.
+ (setq swank-repl:*send-repl-results-function*
+ 'present-repl-results-via-presentation-streams))
+
+(provide :swank-presentation-streams)
diff --git a/vim/bundle/slimv/slime/contrib/swank-presentations.lisp b/vim/bundle/slimv/slime/contrib/swank-presentations.lisp
new file mode 100644
index 0000000..11326af
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-presentations.lisp
@@ -0,0 +1,246 @@
+;;; swank-presentations.lisp --- imitate LispM's presentations
+;;
+;; Authors: Alan Ruttenberg <alanr-l@mumble.net>
+;; Luke Gorrie <luke@synap.se>
+;; Helmut Eller <heller@common-lisp.net>
+;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>
+;;
+;; License: This code has been placed in the Public Domain. All warranties
+;; are disclaimed.
+;;
+
+(in-package :swank)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (swank-require :swank-repl))
+
+;;;; Recording and accessing results of computations
+
+(defvar *record-repl-results* t
+ "Non-nil means that REPL results are saved for later lookup.")
+
+(defvar *object-to-presentation-id*
+ (make-weak-key-hash-table :test 'eq)
+ "Store the mapping of objects to numeric identifiers")
+
+(defvar *presentation-id-to-object*
+ (make-weak-value-hash-table :test 'eql)
+ "Store the mapping of numeric identifiers to objects")
+
+(defun clear-presentation-tables ()
+ (clrhash *object-to-presentation-id*)
+ (clrhash *presentation-id-to-object*))
+
+(defvar *presentation-counter* 0 "identifier counter")
+
+(defvar *nil-surrogate* (make-symbol "nil-surrogate"))
+
+;; XXX thread safety? [2006-09-13] mb: not in the slightest (fwiw the
+;; rest of slime isn't thread safe either), do we really care?
+(defun save-presented-object (object)
+ "Save OBJECT and return the assigned id.
+If OBJECT was saved previously return the old id."
+ (let ((object (if (null object) *nil-surrogate* object)))
+ ;; We store *nil-surrogate* instead of nil, to distinguish it from
+ ;; an object that was garbage collected.
+ (or (gethash object *object-to-presentation-id*)
+ (let ((id (incf *presentation-counter*)))
+ (setf (gethash id *presentation-id-to-object*) object)
+ (setf (gethash object *object-to-presentation-id*) id)
+ id))))
+
+(defslimefun lookup-presented-object (id)
+ "Retrieve the object corresponding to ID.
+The secondary value indicates the absence of an entry."
+ (etypecase id
+ (integer
+ ;;
+ (multiple-value-bind (object foundp)
+ (gethash id *presentation-id-to-object*)
+ (cond
+ ((eql object *nil-surrogate*)
+ ;; A stored nil object
+ (values nil t))
+ ((null object)
+ ;; Object that was replaced by nil in the weak hash table
+ ;; when the object was garbage collected.
+ (values nil nil))
+ (t
+ (values object foundp)))))
+ (cons
+ (dcase id
+ ((:frame-var thread-id frame index)
+ (declare (ignore thread-id)) ; later
+ (handler-case
+ (frame-var-value frame index)
+ (t (condition)
+ (declare (ignore condition))
+ (values nil nil))
+ (:no-error (value)
+ (values value t))))
+ ((:inspected-part part-index)
+ (inspector-nth-part part-index))))))
+
+(defslimefun lookup-presented-object-or-lose (id)
+ "Get the result of the previous REPL evaluation with ID."
+ (multiple-value-bind (object foundp) (lookup-presented-object id)
+ (cond (foundp object)
+ (t (error "Attempt to access unrecorded object (id ~D)." id)))))
+
+(defslimefun lookup-and-save-presented-object-or-lose (id)
+ "Get the object associated with ID and save it in the presentation tables."
+ (let ((obj (lookup-presented-object-or-lose id)))
+ (save-presented-object obj)))
+
+(defslimefun clear-repl-results ()
+ "Forget the results of all previous REPL evaluations."
+ (clear-presentation-tables)
+ t)
+
+(defun present-repl-results (values)
+ ;; Override a function in swank.lisp, so that
+ ;; presentations are associated with every REPL result.
+ (flet ((send (value)
+ (let ((id (and *record-repl-results*
+ (save-presented-object value))))
+ (send-to-emacs `(:presentation-start ,id :repl-result))
+ (send-to-emacs `(:write-string ,(prin1-to-string value)
+ :repl-result))
+ (send-to-emacs `(:presentation-end ,id :repl-result))
+ (send-to-emacs `(:write-string ,(string #\Newline)
+ :repl-result)))))
+ (fresh-line)
+ (finish-output)
+ (if (null values)
+ (send-to-emacs `(:write-string "; No value" :repl-result))
+ (mapc #'send values))))
+
+
+;;;; Presentation menu protocol
+;;
+;; To define a menu for a type of object, define a method
+;; menu-choices-for-presentation on that object type. This function
+;; should return a list of two element lists where the first element is
+;; the name of the menu action and the second is a function that will be
+;; called if the menu is chosen. The function will be called with 3
+;; arguments:
+;;
+;; choice: The string naming the action from above
+;;
+;; object: The object
+;;
+;; id: The presentation id of the object
+;;
+;; You might want append (when (next-method-p) (call-next-method)) to
+;; pick up the Menu actions of superclasses.
+;;
+
+(defvar *presentation-active-menu* nil)
+
+(defun menu-choices-for-presentation-id (id)
+ (multiple-value-bind (ob presentp) (lookup-presented-object id)
+ (cond ((not presentp) 'not-present)
+ (t
+ (let ((menu-and-actions (menu-choices-for-presentation ob)))
+ (setq *presentation-active-menu* (cons id menu-and-actions))
+ (mapcar 'car menu-and-actions))))))
+
+(defun swank-ioify (thing)
+ (cond ((keywordp thing) thing)
+ ((and (symbolp thing)(not (find #\: (symbol-name thing))))
+ (intern (symbol-name thing) 'swank-io-package))
+ ((consp thing) (cons (swank-ioify (car thing))
+ (swank-ioify (cdr thing))))
+ (t thing)))
+
+(defun execute-menu-choice-for-presentation-id (id count item)
+ (let ((ob (lookup-presented-object id)))
+ (assert (equal id (car *presentation-active-menu*)) ()
+ "Bug: Execute menu call for id ~a but menu has id ~a"
+ id (car *presentation-active-menu*))
+ (let ((action (second (nth (1- count) (cdr *presentation-active-menu*)))))
+ (swank-ioify (funcall action item ob id)))))
+
+
+(defgeneric menu-choices-for-presentation (object)
+ (:method (ob) (declare (ignore ob)) nil)) ; default method
+
+;; Pathname
+(defmethod menu-choices-for-presentation ((ob pathname))
+ (let* ((file-exists (ignore-errors (probe-file ob)))
+ (lisp-type (make-pathname :type "lisp"))
+ (source-file (and (not (member (pathname-type ob) '("lisp" "cl")
+ :test 'equal))
+ (let ((source (merge-pathnames lisp-type ob)))
+ (and (ignore-errors (probe-file source))
+ source))))
+ (fasl-file (and file-exists
+ (equal (ignore-errors
+ (namestring
+ (truename
+ (compile-file-pathname
+ (merge-pathnames lisp-type ob)))))
+ (namestring (truename ob))))))
+ (remove nil
+ (list*
+ (and (and file-exists (not fasl-file))
+ (list "Edit this file"
+ (lambda(choice object id)
+ (declare (ignore choice id))
+ (ed-in-emacs (namestring (truename object)))
+ nil)))
+ (and file-exists
+ (list "Dired containing directory"
+ (lambda (choice object id)
+ (declare (ignore choice id))
+ (ed-in-emacs (namestring
+ (truename
+ (merge-pathnames
+ (make-pathname :name "" :type "")
+ object))))
+ nil)))
+ (and fasl-file
+ (list "Load this fasl file"
+ (lambda (choice object id)
+ (declare (ignore choice id object))
+ (load ob)
+ nil)))
+ (and fasl-file
+ (list "Delete this fasl file"
+ (lambda (choice object id)
+ (declare (ignore choice id object))
+ (let ((nt (namestring (truename ob))))
+ (when (y-or-n-p-in-emacs "Delete ~a? " nt)
+ (delete-file nt)))
+ nil)))
+ (and source-file
+ (list "Edit lisp source file"
+ (lambda (choice object id)
+ (declare (ignore choice id object))
+ (ed-in-emacs (namestring (truename source-file)))
+ nil)))
+ (and source-file
+ (list "Load lisp source file"
+ (lambda(choice object id)
+ (declare (ignore choice id object))
+ (load source-file)
+ nil)))
+ (and (next-method-p) (call-next-method))))))
+
+(defmethod menu-choices-for-presentation ((ob function))
+ (list (list "Disassemble"
+ (lambda (choice object id)
+ (declare (ignore choice id))
+ (disassemble object)))))
+
+(defslimefun inspect-presentation (id reset-p)
+ (let ((what (lookup-presented-object-or-lose id)))
+ (when reset-p
+ (reset-inspector))
+ (inspect-object what)))
+
+(defslimefun init-presentations ()
+ ;; FIXME: import/use swank-repl to avoid package qualifier.
+ (setq swank-repl:*send-repl-results-function* 'present-repl-results))
+
+(provide :swank-presentations)
diff --git a/vim/bundle/slimv/slime/contrib/swank-quicklisp.lisp b/vim/bundle/slimv/slime/contrib/swank-quicklisp.lisp
new file mode 100644
index 0000000..3654599
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-quicklisp.lisp
@@ -0,0 +1,17 @@
+;;; swank-quicklisp.lisp -- Quicklisp support
+;;
+;; Authors: Matthew Kennedy <burnsidemk@gmail.com>
+;; License: Public Domain
+;;
+
+(in-package :swank)
+
+(defslimefun list-quicklisp-systems ()
+ "Returns the Quicklisp systems list."
+ (if (member :quicklisp *features*)
+ (let ((ql-dist-name (find-symbol "NAME" "QL-DIST"))
+ (ql-system-list (find-symbol "SYSTEM-LIST" "QL")))
+ (mapcar ql-dist-name (funcall ql-system-list)))
+ (error "Could not find Quicklisp already loaded.")))
+
+(provide :swank-quicklisp)
diff --git a/vim/bundle/slimv/slime/contrib/swank-r6rs.scm b/vim/bundle/slimv/slime/contrib/swank-r6rs.scm
new file mode 100644
index 0000000..4e48050
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-r6rs.scm
@@ -0,0 +1,416 @@
+;; swank-r6rs.sls --- Shareable code between swank-ikarus and swank-larceny
+;;
+;; Licence: public domain
+;; Author: Helmut Eller
+;;
+;; This is a Swank server barely capable enough to process simple eval
+;; requests from Emacs before dying. No fancy features like
+;; backtraces, module redefintion, M-. etc. are implemented. Don't
+;; even think about pc-to-source mapping.
+;;
+;; Despite standard modules, this file uses (swank os) and (swank sys)
+;; which define implementation dependend functionality. There are
+;; multiple modules in this files, which is probably not standardized.
+;;
+
+;; Naive FORMAT implementation which supports: ~a ~s ~d ~x ~c
+(library (swank format)
+ (export format printf fprintf)
+ (import (rnrs))
+
+ (define (format f . args)
+ (call-with-string-output-port
+ (lambda (port) (apply fprintf port f args))))
+
+ (define (printf f . args)
+ (let ((port (current-output-port)))
+ (apply fprintf port f args)
+ (flush-output-port port)))
+
+ (define (fprintf port f . args)
+ (let ((len (string-length f)))
+ (let loop ((i 0) (args args))
+ (cond ((= i len) (assert (null? args)))
+ ((and (char=? (string-ref f i) #\~)
+ (< (+ i 1) len))
+ (dispatch-format (string-ref f (+ i 1)) port (car args))
+ (loop (+ i 2) (cdr args)))
+ (else
+ (put-char port (string-ref f i))
+ (loop (+ i 1) args))))))
+
+ (define (dispatch-format char port arg)
+ (let ((probe (assoc char format-dispatch-table)))
+ (cond (probe ((cdr probe) arg port))
+ (else (error "invalid format char: " char)))))
+
+ (define format-dispatch-table
+ `((#\a . ,display)
+ (#\s . ,write)
+ (#\d . ,(lambda (arg port) (put-string port (number->string arg 10))))
+ (#\x . ,(lambda (arg port) (put-string port (number->string arg 16))))
+ (#\c . ,(lambda (arg port) (put-char port arg))))))
+
+
+;; CL-style restarts to let us continue after errors.
+(library (swank restarts)
+ (export with-simple-restart compute-restarts invoke-restart restart-name
+ write-restart-report)
+ (import (rnrs))
+
+ (define *restarts* '())
+
+ (define-record-type restart
+ (fields name reporter continuation))
+
+ (define (with-simple-restart name reporter thunk)
+ (call/cc
+ (lambda (k)
+ (let ((old-restarts *restarts*)
+ (restart (make-restart name (coerce-to-reporter reporter) k)))
+ (dynamic-wind
+ (lambda () (set! *restarts* (cons restart old-restarts)))
+ thunk
+ (lambda () (set! *restarts* old-restarts)))))))
+
+ (define (compute-restarts) *restarts*)
+
+ (define (invoke-restart restart . args)
+ (apply (restart-continuation restart) args))
+
+ (define (write-restart-report restart port)
+ ((restart-reporter restart) port))
+
+ (define (coerce-to-reporter obj)
+ (cond ((string? obj) (lambda (port) (put-string port obj)))
+ (#t (assert (procedure? obj)) obj)))
+
+ )
+
+;; This module encodes & decodes messages from the wire and queues them.
+(library (swank event-queue)
+ (export make-event-queue wait-for-event enqueue-event
+ read-event write-event)
+ (import (rnrs)
+ (rnrs mutable-pairs)
+ (swank format))
+
+ (define-record-type event-queue
+ (fields (mutable q) wait-fun)
+ (protocol (lambda (init)
+ (lambda (wait-fun)
+ (init '() wait-fun)))))
+
+ (define (wait-for-event q pattern)
+ (or (poll q pattern)
+ (begin
+ ((event-queue-wait-fun q) q)
+ (wait-for-event q pattern))))
+
+ (define (poll q pattern)
+ (let loop ((lag #f)
+ (l (event-queue-q q)))
+ (cond ((null? l) #f)
+ ((event-match? (car l) pattern)
+ (cond (lag
+ (set-cdr! lag (cdr l))
+ (car l))
+ (else
+ (event-queue-q-set! q (cdr l))
+ (car l))))
+ (else (loop l (cdr l))))))
+
+ (define (event-match? event pattern)
+ (cond ((or (number? pattern)
+ (member pattern '(t nil)))
+ (equal? event pattern))
+ ((symbol? pattern) #t)
+ ((pair? pattern)
+ (case (car pattern)
+ ((quote) (equal? event (cadr pattern)))
+ ((or) (exists (lambda (p) (event-match? event p)) (cdr pattern)))
+ (else (and (pair? event)
+ (event-match? (car event) (car pattern))
+ (event-match? (cdr event) (cdr pattern))))))
+ (else (error "Invalid pattern: " pattern))))
+
+ (define (enqueue-event q event)
+ (event-queue-q-set! q
+ (append (event-queue-q q)
+ (list event))))
+
+ (define (write-event event port)
+ (let ((payload (call-with-string-output-port
+ (lambda (port) (write event port)))))
+ (write-length (string-length payload) port)
+ (put-string port payload)
+ (flush-output-port port)))
+
+ (define (write-length len port)
+ (do ((i 24 (- i 4)))
+ ((= i 0))
+ (put-string port
+ (number->string (bitwise-bit-field len (- i 4) i)
+ 16))))
+
+ (define (read-event port)
+ (let* ((header (string-append (get-string-n port 2)
+ (get-string-n port 2)
+ (get-string-n port 2)))
+ (_ (printf "header: ~s\n" header))
+ (len (string->number header 16))
+ (_ (printf "len: ~s\n" len))
+ (payload (get-string-n port len)))
+ (printf "payload: ~s\n" payload)
+ (read (open-string-input-port payload))))
+
+ )
+
+;; Entry points for SLIME commands.
+(library (swank rpc)
+ (export connection-info interactive-eval
+ ;;compile-string-for-emacs
+ throw-to-toplevel sldb-abort
+ operator-arglist buffer-first-change
+ create-repl listener-eval)
+ (import (rnrs)
+ (rnrs eval)
+ (only (rnrs r5rs) scheme-report-environment)
+ (swank os)
+ (swank format)
+ (swank restarts)
+ (swank sys)
+ )
+
+ (define (connection-info . _)
+ `(,@'()
+ :pid ,(getpid)
+ :package (:name ">" :prompt ">")
+ :lisp-implementation (,@'()
+ :name ,(implementation-name)
+ :type "R6RS-Scheme")))
+
+ (define (interactive-eval string)
+ (call-with-values
+ (lambda ()
+ (eval-in-interaction-environment (read-from-string string)))
+ (case-lambda
+ (() "; no value")
+ ((value) (format "~s" value))
+ (values (format "values: ~s" values)))))
+
+ (define (throw-to-toplevel) (invoke-restart-by-name-or-nil 'toplevel))
+
+ (define (sldb-abort) (invoke-restart-by-name-or-nil 'abort))
+
+ (define (invoke-restart-by-name-or-nil name)
+ (let ((r (find (lambda (r) (eq? (restart-name r) name))
+ (compute-restarts))))
+ (if r (invoke-restart r) 'nil)))
+
+ (define (create-repl target)
+ (list "" ""))
+
+ (define (listener-eval string)
+ (call-with-values (lambda () (eval-region string))
+ (lambda values `(:values ,@(map (lambda (v) (format "~s" v)) values)))))
+
+ (define (eval-region string)
+ (let ((sexp (read-from-string string)))
+ (if (eof-object? exp)
+ (values)
+ (eval-in-interaction-environment sexp))))
+
+ (define (read-from-string string)
+ (call-with-port (open-string-input-port string) read))
+
+ (define (operator-arglist . _) 'nil)
+ (define (buffer-first-change . _) 'nil)
+
+ )
+
+;; The server proper. Does the TCP stuff and exception handling.
+(library (swank)
+ (export start-server)
+ (import (rnrs)
+ (rnrs eval)
+ (swank os)
+ (swank format)
+ (swank event-queue)
+ (swank restarts))
+
+ (define-record-type connection
+ (fields in-port out-port event-queue))
+
+ (define (start-server port)
+ (accept-connections (or port 4005) #f))
+
+ (define (start-server/port-file port-file)
+ (accept-connections #f port-file))
+
+ (define (accept-connections port port-file)
+ (let ((sock (make-server-socket port)))
+ (printf "Listening on port: ~s\n" (local-port sock))
+ (when port-file
+ (write-port-file (local-port sock) port-file))
+ (let-values (((in out) (accept sock (latin-1-codec))))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda ()
+ (close-socket sock)
+ (serve in out))
+ (lambda ()
+ (close-port in)
+ (close-port out))))))
+
+ (define (write-port-file port port-file)
+ (call-with-output-file
+ (lambda (file)
+ (write port file))))
+
+ (define (serve in out)
+ (let ((err (current-error-port))
+ (q (make-event-queue
+ (lambda (q)
+ (let ((e (read-event in)))
+ (printf "read: ~s\n" e)
+ (enqueue-event q e))))))
+ (dispatch-loop (make-connection in out q))))
+
+ (define-record-type sldb-state
+ (fields level condition continuation next))
+
+ (define (dispatch-loop conn)
+ (let ((event (wait-for-event (connection-event-queue conn) 'x)))
+ (case (car event)
+ ((:emacs-rex)
+ (with-simple-restart
+ 'toplevel "Return to SLIME's toplevel"
+ (lambda ()
+ (apply emacs-rex conn #f (cdr event)))))
+ (else (error "Unhandled event: ~s" event))))
+ (dispatch-loop conn))
+
+ (define (recover thunk on-error-thunk)
+ (let ((ok #f))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda ()
+ (call-with-values thunk
+ (lambda vals
+ (set! ok #t)
+ (apply values vals))))
+ (lambda ()
+ (unless ok
+ (on-error-thunk))))))
+
+ ;; Couldn't resist to exploit the prefix feature.
+ (define rpc-entries (environment '(prefix (swank rpc) swank:)))
+
+ (define (emacs-rex conn sldb-state form package thread tag)
+ (let ((out (connection-out-port conn)))
+ (recover
+ (lambda ()
+ (with-exception-handler
+ (lambda (condition)
+ (call/cc
+ (lambda (k)
+ (sldb-exception-handler conn condition k sldb-state))))
+ (lambda ()
+ (let ((value (apply (eval (car form) rpc-entries) (cdr form))))
+ (write-event `(:return (:ok ,value) ,tag) out)))))
+ (lambda ()
+ (write-event `(:return (:abort) ,tag) out)))))
+
+ (define (sldb-exception-handler connection condition k sldb-state)
+ (when (serious-condition? condition)
+ (let ((level (if sldb-state (+ (sldb-state-level sldb-state) 1) 1))
+ (out (connection-out-port connection)))
+ (write-event `(:debug 0 ,level ,@(debugger-info condition connection))
+ out)
+ (dynamic-wind
+ (lambda () #f)
+ (lambda ()
+ (sldb-loop connection
+ (make-sldb-state level condition k sldb-state)))
+ (lambda () (write-event `(:debug-return 0 ,level nil) out))))))
+
+ (define (sldb-loop connection state)
+ (apply emacs-rex connection state
+ (cdr (wait-for-event (connection-event-queue connection)
+ '(':emacs-rex . _))))
+ (sldb-loop connection state))
+
+ (define (debugger-info condition connection)
+ (list `(,(call-with-string-output-port
+ (lambda (port) (print-condition condition port)))
+ ,(format " [type ~s]" (if (record? condition)
+ (record-type-name (record-rtd condition))
+ ))
+ ())
+ (map (lambda (r)
+ (list (format "~a" (restart-name r))
+ (call-with-string-output-port
+ (lambda (port)
+ (write-restart-report r port)))))
+ (compute-restarts))
+ '()
+ '()))
+
+ (define (print-condition obj port)
+ (cond ((condition? obj)
+ (let ((list (simple-conditions obj)))
+ (case (length list)
+ ((0)
+ (display "Compuond condition with zero components" port))
+ ((1)
+ (assert (eq? obj (car list)))
+ (print-simple-condition (car list) port))
+ (else
+ (display "Compound condition:\n" port)
+ (for-each (lambda (c)
+ (display " " port)
+ (print-simple-condition c port)
+ (newline port))
+ list)))))
+ (#t
+ (fprintf port "Non-condition object: ~s" obj))))
+
+ (define (print-simple-condition condition port)
+ (fprintf port "~a" (record-type-name (record-rtd condition)))
+ (case (count-record-fields condition)
+ ((0) #f)
+ ((1)
+ (fprintf port ": ")
+ (do-record-fields condition (lambda (name value) (write value port))))
+ (else
+ (fprintf port ":")
+ (do-record-fields condition (lambda (name value)
+ (fprintf port "\n~a: ~s" name value))))))
+
+ ;; Call FUN with RECORD's rtd and parent rtds.
+ (define (do-record-rtds record fun)
+ (do ((rtd (record-rtd record) (record-type-parent rtd)))
+ ((not rtd))
+ (fun rtd)))
+
+ ;; Call FUN with RECORD's field names and values.
+ (define (do-record-fields record fun)
+ (do-record-rtds
+ record
+ (lambda (rtd)
+ (let* ((names (record-type-field-names rtd))
+ (len (vector-length names)))
+ (do ((i 0 (+ 1 i)))
+ ((= i len))
+ (fun (vector-ref names i) ((record-accessor rtd i) record)))))))
+
+ ;; Return the number of fields in RECORD
+ (define (count-record-fields record)
+ (let ((i 0))
+ (do-record-rtds
+ record (lambda (rtd)
+ (set! i (+ i (vector-length (record-type-field-names rtd))))))
+ i))
+
+ )
diff --git a/vim/bundle/slimv/slime/contrib/swank-repl.lisp b/vim/bundle/slimv/slime/contrib/swank-repl.lisp
new file mode 100644
index 0000000..0bed5f4
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-repl.lisp
@@ -0,0 +1,450 @@
+;;; swank-repl.lisp --- Server side part of the Lisp listener.
+;;
+;; License: public domain
+(in-package swank)
+
+(defpackage swank-repl
+ (:use cl swank/backend)
+ (:export *send-repl-results-function*)
+ (:import-from
+ swank
+
+ *default-worker-thread-bindings*
+
+ *loopback-interface*
+
+ add-hook
+ *connection-closed-hook*
+
+ eval-region
+ with-buffer-syntax
+
+ connection
+ connection.socket-io
+ connection.repl-results
+ connection.user-input
+ connection.user-output
+ connection.user-io
+ connection.trace-output
+ connection.dedicated-output
+ connection.env
+
+ multithreaded-connection
+ mconn.active-threads
+ mconn.repl-thread
+ mconn.auto-flush-thread
+ use-threads-p
+
+ *emacs-connection*
+ default-connection
+ with-connection
+
+ send-to-emacs
+ *communication-style*
+ handle-requests
+ wait-for-event
+ make-tag
+ thread-for-evaluation
+ socket-quest
+
+ authenticate-client
+ encode-message
+
+ auto-flush-loop
+ clear-user-input
+
+ current-thread-id
+ cat
+ with-struct*
+ with-retry-restart
+ with-bindings
+
+ package-string-for-prompt
+ find-external-format-or-lose
+
+ defslimefun
+
+ ;; FIXME: those should be exported from swank-repl only, but how to
+ ;; do that whithout breaking init files?
+ *use-dedicated-output-stream*
+ *dedicated-output-stream-port*
+ *globally-redirect-io*
+
+ ))
+
+(in-package swank-repl)
+
+(defvar *use-dedicated-output-stream* nil
+ "When T swank will attempt to create a second connection to Emacs
+which is used just to send output.")
+
+(defvar *dedicated-output-stream-port* 0
+ "Which port we should use for the dedicated output stream.")
+
+(defvar *dedicated-output-stream-buffering*
+ (if (eq *communication-style* :spawn) t nil)
+ "The buffering scheme that should be used for the output stream.
+Valid values are nil, t, :line")
+
+(defvar *globally-redirect-io* nil
+ "When non-nil globally redirect all standard streams to Emacs.")
+
+(defun open-streams (connection properties)
+ "Return the 5 streams for IO redirection:
+DEDICATED-OUTPUT INPUT OUTPUT IO REPL-RESULTS"
+ (let* ((input-fn
+ (lambda ()
+ (with-connection (connection)
+ (with-simple-restart (abort-read
+ "Abort reading input from Emacs.")
+ (read-user-input-from-emacs)))))
+ (dedicated-output (if *use-dedicated-output-stream*
+ (open-dedicated-output-stream
+ connection
+ (getf properties :coding-system))))
+ (in (make-input-stream input-fn))
+ (out (or dedicated-output
+ (make-output-stream (make-output-function connection))))
+ (io (make-two-way-stream in out))
+ (repl-results (make-output-stream-for-target connection
+ :repl-result)))
+ (typecase connection
+ (multithreaded-connection
+ (setf (mconn.auto-flush-thread connection)
+ (spawn (lambda () (auto-flush-loop out))
+ :name "auto-flush-thread"))))
+ (values dedicated-output in out io repl-results)))
+
+(defun make-output-function (connection)
+ "Create function to send user output to Emacs."
+ (lambda (string)
+ (with-connection (connection)
+ (send-to-emacs `(:write-string ,string)))))
+
+(defun make-output-function-for-target (connection target)
+ "Create a function to send user output to a specific TARGET in Emacs."
+ (lambda (string)
+ (with-connection (connection)
+ (with-simple-restart
+ (abort "Abort sending output to Emacs.")
+ (send-to-emacs `(:write-string ,string ,target))))))
+
+(defun make-output-stream-for-target (connection target)
+ "Create a stream that sends output to a specific TARGET in Emacs."
+ (make-output-stream (make-output-function-for-target connection target)))
+
+(defun open-dedicated-output-stream (connection coding-system)
+ "Open a dedicated output connection to the Emacs on SOCKET-IO.
+Return an output stream suitable for writing program output.
+
+This is an optimized way for Lisp to deliver output to Emacs."
+ (let ((socket (socket-quest *dedicated-output-stream-port* nil))
+ (ef (find-external-format-or-lose coding-system)))
+ (unwind-protect
+ (let ((port (local-port socket)))
+ (encode-message `(:open-dedicated-output-stream ,port
+ ,coding-system)
+ (connection.socket-io connection))
+ (let ((dedicated (accept-connection
+ socket
+ :external-format ef
+ :buffering *dedicated-output-stream-buffering*
+ :timeout 30)))
+ (authenticate-client dedicated)
+ (close-socket socket)
+ (setf socket nil)
+ dedicated))
+ (when socket
+ (close-socket socket)))))
+
+(defmethod thread-for-evaluation ((connection multithreaded-connection)
+ (id (eql :find-existing)))
+ (or (car (mconn.active-threads connection))
+ (find-repl-thread connection)))
+
+(defmethod thread-for-evaluation ((connection multithreaded-connection)
+ (id (eql :repl-thread)))
+ (find-repl-thread connection))
+
+(defun find-repl-thread (connection)
+ (cond ((not (use-threads-p))
+ (current-thread))
+ (t
+ (let ((thread (mconn.repl-thread connection)))
+ (cond ((not thread) nil)
+ ((thread-alive-p thread) thread)
+ (t
+ (setf (mconn.repl-thread connection)
+ (spawn-repl-thread connection "new-repl-thread"))))))))
+
+(defun spawn-repl-thread (connection name)
+ (spawn (lambda ()
+ (with-bindings *default-worker-thread-bindings*
+ (repl-loop connection)))
+ :name name))
+
+(defun repl-loop (connection)
+ (handle-requests connection))
+
+;;;;; Redirection during requests
+;;;
+;;; We always redirect the standard streams to Emacs while evaluating
+;;; an RPC. This is done with simple dynamic bindings.
+
+(defslimefun create-repl (target &key coding-system)
+ (assert (eq target nil))
+ (let ((conn *emacs-connection*))
+ (initialize-streams-for-connection conn `(:coding-system ,coding-system))
+ (with-struct* (connection. @ conn)
+ (setf (@ env)
+ `((*standard-input* . ,(@ user-input))
+ ,@(unless *globally-redirect-io*
+ `((*standard-output* . ,(@ user-output))
+ (*trace-output* . ,(or (@ trace-output) (@ user-output)))
+ (*error-output* . ,(@ user-output))
+ (*debug-io* . ,(@ user-io))
+ (*query-io* . ,(@ user-io))
+ (*terminal-io* . ,(@ user-io))))))
+ (maybe-redirect-global-io conn)
+ (add-hook *connection-closed-hook* 'update-redirection-after-close)
+ (typecase conn
+ (multithreaded-connection
+ (setf (mconn.repl-thread conn)
+ (spawn-repl-thread conn "repl-thread"))))
+ (list (package-name *package*)
+ (package-string-for-prompt *package*)))))
+
+(defun initialize-streams-for-connection (connection properties)
+ (multiple-value-bind (dedicated in out io repl-results)
+ (open-streams connection properties)
+ (setf (connection.dedicated-output connection) dedicated
+ (connection.user-io connection) io
+ (connection.user-output connection) out
+ (connection.user-input connection) in
+ (connection.repl-results connection) repl-results)
+ connection))
+
+(defun read-user-input-from-emacs ()
+ (let ((tag (make-tag)))
+ (force-output)
+ (send-to-emacs `(:read-string ,(current-thread-id) ,tag))
+ (let ((ok nil))
+ (unwind-protect
+ (prog1 (caddr (wait-for-event `(:emacs-return-string ,tag value)))
+ (setq ok t))
+ (unless ok
+ (send-to-emacs `(:read-aborted ,(current-thread-id) ,tag)))))))
+
+;;;;; Listener eval
+
+(defvar *listener-eval-function* 'repl-eval)
+
+(defvar *listener-saved-value* nil)
+
+(defslimefun listener-save-value (slimefun &rest args)
+ "Apply SLIMEFUN to ARGS and save the value.
+The saved value should be visible to all threads and retrieved via
+LISTENER-GET-VALUE."
+ (setq *listener-saved-value* (apply slimefun args))
+ t)
+
+(defslimefun listener-get-value ()
+ "Get the last value saved by LISTENER-SAVE-VALUE.
+The value should be produced as if it were requested through
+LISTENER-EVAL directly, so that spacial variables *, etc are set."
+ (listener-eval (let ((*package* (find-package :keyword)))
+ (write-to-string '*listener-saved-value*))))
+
+(defslimefun listener-eval (string &key (window-width nil window-width-p))
+ (if window-width-p
+ (let ((*print-right-margin* window-width))
+ (funcall *listener-eval-function* string))
+ (funcall *listener-eval-function* string)))
+
+(defslimefun clear-repl-variables ()
+ (let ((variables '(*** ** * /// // / +++ ++ +)))
+ (loop for variable in variables
+ do (setf (symbol-value variable) nil))))
+
+(defvar *send-repl-results-function* 'send-repl-results-to-emacs)
+
+(defun repl-eval (string)
+ (clear-user-input)
+ (with-buffer-syntax ()
+ (with-retry-restart (:msg "Retry SLIME REPL evaluation request.")
+ (track-package
+ (lambda ()
+ (multiple-value-bind (values last-form) (eval-region string)
+ (setq *** ** ** * * (car values)
+ /// // // / / values
+ +++ ++ ++ + + last-form)
+ (funcall *send-repl-results-function* values))))))
+ nil)
+
+(defun track-package (fun)
+ (let ((p *package*))
+ (unwind-protect (funcall fun)
+ (unless (eq *package* p)
+ (send-to-emacs (list :new-package (package-name *package*)
+ (package-string-for-prompt *package*)))))))
+
+(defun send-repl-results-to-emacs (values)
+ (finish-output)
+ (if (null values)
+ (send-to-emacs `(:write-string "; No value" :repl-result))
+ (dolist (v values)
+ (send-to-emacs `(:write-string ,(cat (prin1-to-string v) #\newline)
+ :repl-result)))))
+
+(defslimefun redirect-trace-output (target)
+ (setf (connection.trace-output *emacs-connection*)
+ (make-output-stream-for-target *emacs-connection* target))
+ nil)
+
+
+
+;;;; IO to Emacs
+;;;
+;;; This code handles redirection of the standard I/O streams
+;;; (`*standard-output*', etc) into Emacs. The `connection' structure
+;;; contains the appropriate streams, so all we have to do is make the
+;;; right bindings.
+
+;;;;; Global I/O redirection framework
+;;;
+;;; Optionally, the top-level global bindings of the standard streams
+;;; can be assigned to be redirected to Emacs. When Emacs connects we
+;;; redirect the streams into the connection, and they keep going into
+;;; that connection even if more are established. If the connection
+;;; handling the streams closes then another is chosen, or if there
+;;; are no connections then we revert to the original (real) streams.
+;;;
+;;; It is slightly tricky to assign the global values of standard
+;;; streams because they are often shadowed by dynamic bindings. We
+;;; solve this problem by introducing an extra indirection via synonym
+;;; streams, so that *STANDARD-INPUT* is a synonym stream to
+;;; *CURRENT-STANDARD-INPUT*, etc. We never shadow the "current"
+;;; variables, so they can always be assigned to affect a global
+;;; change.
+
+;;;;; Global redirection setup
+
+(defvar *saved-global-streams* '()
+ "A plist to save and restore redirected stream objects.
+E.g. the value for '*standard-output* holds the stream object
+for *standard-output* before we install our redirection.")
+
+(defun setup-stream-indirection (stream-var &optional stream)
+ "Setup redirection scaffolding for a global stream variable.
+Supposing (for example) STREAM-VAR is *STANDARD-INPUT*, this macro:
+
+1. Saves the value of *STANDARD-INPUT* in `*SAVED-GLOBAL-STREAMS*'.
+
+2. Creates *CURRENT-STANDARD-INPUT*, initially with the same value as
+*STANDARD-INPUT*.
+
+3. Assigns *STANDARD-INPUT* to a synonym stream pointing to
+*CURRENT-STANDARD-INPUT*.
+
+This has the effect of making *CURRENT-STANDARD-INPUT* contain the
+effective global value for *STANDARD-INPUT*. This way we can assign
+the effective global value even when *STANDARD-INPUT* is shadowed by a
+dynamic binding."
+ (let ((current-stream-var (prefixed-var '#:current stream-var))
+ (stream (or stream (symbol-value stream-var))))
+ ;; Save the real stream value for the future.
+ (setf (getf *saved-global-streams* stream-var) stream)
+ ;; Define a new variable for the effective stream.
+ ;; This can be reassigned.
+ (proclaim `(special ,current-stream-var))
+ (set current-stream-var stream)
+ ;; Assign the real binding as a synonym for the current one.
+ (let ((stream (make-synonym-stream current-stream-var)))
+ (set stream-var stream)
+ (set-default-initial-binding stream-var `(quote ,stream)))))
+
+(defun prefixed-var (prefix variable-symbol)
+ "(PREFIXED-VAR \"FOO\" '*BAR*) => SWANK::*FOO-BAR*"
+ (let ((basename (subseq (symbol-name variable-symbol) 1)))
+ (intern (format nil "*~A-~A" (string prefix) basename) :swank)))
+
+(defvar *standard-output-streams*
+ '(*standard-output* *error-output* *trace-output*)
+ "The symbols naming standard output streams.")
+
+(defvar *standard-input-streams*
+ '(*standard-input*)
+ "The symbols naming standard input streams.")
+
+(defvar *standard-io-streams*
+ '(*debug-io* *query-io* *terminal-io*)
+ "The symbols naming standard io streams.")
+
+(defun init-global-stream-redirection ()
+ (when *globally-redirect-io*
+ (cond (*saved-global-streams*
+ (warn "Streams already redirected."))
+ (t
+ (mapc #'setup-stream-indirection
+ (append *standard-output-streams*
+ *standard-input-streams*
+ *standard-io-streams*))))))
+
+(defun globally-redirect-io-to-connection (connection)
+ "Set the standard I/O streams to redirect to CONNECTION.
+Assigns *CURRENT-<STREAM>* for all standard streams."
+ (dolist (o *standard-output-streams*)
+ (set (prefixed-var '#:current o)
+ (connection.user-output connection)))
+ ;; FIXME: If we redirect standard input to Emacs then we get the
+ ;; regular Lisp top-level trying to read from our REPL.
+ ;;
+ ;; Perhaps the ideal would be for the real top-level to run in a
+ ;; thread with local bindings for all the standard streams. Failing
+ ;; that we probably would like to inhibit it from reading while
+ ;; Emacs is connected.
+ ;;
+ ;; Meanwhile we just leave *standard-input* alone.
+ #+NIL
+ (dolist (i *standard-input-streams*)
+ (set (prefixed-var '#:current i)
+ (connection.user-input connection)))
+ (dolist (io *standard-io-streams*)
+ (set (prefixed-var '#:current io)
+ (connection.user-io connection))))
+
+(defun revert-global-io-redirection ()
+ "Set *CURRENT-<STREAM>* to *REAL-<STREAM>* for all standard streams."
+ (dolist (stream-var (append *standard-output-streams*
+ *standard-input-streams*
+ *standard-io-streams*))
+ (set (prefixed-var '#:current stream-var)
+ (getf *saved-global-streams* stream-var))))
+
+;;;;; Global redirection hooks
+
+(defvar *global-stdio-connection* nil
+ "The connection to which standard I/O streams are globally redirected.
+NIL if streams are not globally redirected.")
+
+(defun maybe-redirect-global-io (connection)
+ "Consider globally redirecting to CONNECTION."
+ (when (and *globally-redirect-io* (null *global-stdio-connection*)
+ (connection.user-io connection))
+ (unless *saved-global-streams*
+ (init-global-stream-redirection))
+ (setq *global-stdio-connection* connection)
+ (globally-redirect-io-to-connection connection)))
+
+(defun update-redirection-after-close (closed-connection)
+ "Update redirection after a connection closes."
+ (check-type closed-connection connection)
+ (when (eq *global-stdio-connection* closed-connection)
+ (if (and (default-connection) *globally-redirect-io*)
+ ;; Redirect to another connection.
+ (globally-redirect-io-to-connection (default-connection))
+ ;; No more connections, revert to the real streams.
+ (progn (revert-global-io-redirection)
+ (setq *global-stdio-connection* nil)))))
+
+(provide :swank-repl)
diff --git a/vim/bundle/slimv/slime/contrib/swank-sbcl-exts.lisp b/vim/bundle/slimv/slime/contrib/swank-sbcl-exts.lisp
new file mode 100644
index 0000000..29235cd
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-sbcl-exts.lisp
@@ -0,0 +1,64 @@
+;;; swank-sbcl-exts.lisp --- Misc extensions for SBCL
+;;
+;; Authors: Tobias C. Rittweiler <tcr@freebits.de>
+;;
+;; License: Public Domain
+;;
+
+(in-package :swank)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (swank-require :swank-arglists))
+
+;; We need to do this so users can place `slime-sbcl-exts' into their
+;; ~/.emacs, and still use any implementation they want.
+#+sbcl
+(progn
+
+;;; Display arglist of instructions.
+;;;
+(defmethod compute-enriched-decoded-arglist ((operator-form (eql 'sb-assem:inst))
+ argument-forms)
+ (flet ((decode-instruction-arglist (instr-name instr-arglist)
+ (let ((decoded-arglist (decode-arglist instr-arglist)))
+ ;; The arglist of INST is (instruction ...INSTR-ARGLIST...).
+ (push 'sb-assem::instruction (arglist.required-args decoded-arglist))
+ (values decoded-arglist
+ (list instr-name)
+ t))))
+ (if (null argument-forms)
+ (call-next-method)
+ (destructuring-bind (instruction &rest args) argument-forms
+ (declare (ignore args))
+ (let* ((instr-name
+ (typecase instruction
+ (arglist-dummy
+ (string-upcase (arglist-dummy.string-representation instruction)))
+ (symbol
+ (string-downcase instruction))))
+ (instr-fn
+ #+#.(swank/backend:with-symbol 'inst-emitter-symbol 'sb-assem)
+ (sb-assem::inst-emitter-symbol instr-name)
+ #+(and
+ (not #.(swank/backend:with-symbol 'inst-emitter-symbol 'sb-assem))
+ #.(swank/backend:with-symbol '*assem-instructions* 'sb-assem))
+ (gethash instr-name sb-assem:*assem-instructions*)))
+ (cond ((not instr-fn)
+ (call-next-method))
+ ((functionp instr-fn)
+ (with-available-arglist (arglist) (arglist instr-fn)
+ (decode-instruction-arglist instr-name arglist)))
+ (t
+ (assert (symbolp instr-fn))
+ (with-available-arglist (arglist) (arglist instr-fn)
+ ;; SB-ASSEM:INST invokes a symbolic INSTR-FN with
+ ;; current segment and current vop implicitly.
+ (decode-instruction-arglist instr-name
+ (if (get instr-fn :macro)
+ arglist
+ (cddr arglist)))))))))))
+
+
+) ; PROGN
+
+(provide :swank-sbcl-exts)
diff --git a/vim/bundle/slimv/slime/contrib/swank-snapshot.lisp b/vim/bundle/slimv/slime/contrib/swank-snapshot.lisp
new file mode 100644
index 0000000..8edb789
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-snapshot.lisp
@@ -0,0 +1,67 @@
+
+(defpackage swank-snapshot
+ (:use cl)
+ (:export restore-snapshot save-snapshot background-save-snapshot)
+ (:import-from swank defslimefun))
+(in-package swank-snapshot)
+
+(defslimefun save-snapshot (image-file)
+ (swank/backend:save-image image-file
+ (let ((c swank::*emacs-connection*))
+ (lambda () (resurrect c))))
+ (format nil "Dumped lisp to ~A" image-file))
+
+(defslimefun restore-snapshot (image-file)
+ (let* ((conn swank::*emacs-connection*)
+ (stream (swank::connection.socket-io conn))
+ (clone (swank/backend:dup (swank/backend:socket-fd stream)))
+ (style (swank::connection.communication-style conn))
+ (repl (if (swank::connection.user-io conn) t))
+ (args (list "--swank-fd" (format nil "~d" clone)
+ "--swank-style" (format nil "~s" style)
+ "--swank-repl" (format nil "~s" repl))))
+ (swank::close-connection conn nil nil)
+ (swank/backend:exec-image image-file args)))
+
+(defslimefun background-save-snapshot (image-file)
+ (let ((connection swank::*emacs-connection*))
+ (flet ((complete (success)
+ (let ((swank::*emacs-connection* connection))
+ (swank::background-message
+ "Dumping lisp image ~A ~:[failed!~;succeeded.~]"
+ image-file success)))
+ (awaken ()
+ (resurrect connection)))
+ (swank/backend:background-save-image image-file
+ :restart-function #'awaken
+ :completion-function #'complete)
+ (format nil "Started dumping lisp to ~A..." image-file))))
+
+(in-package :swank)
+
+(defun swank-snapshot::resurrect (old-connection)
+ (setq *log-output* nil)
+ (init-log-output)
+ (clear-event-history)
+ (setq *connections* (delete old-connection *connections*))
+ (format *error-output* "args: ~s~%" (command-line-args))
+ (let* ((fd (read-command-line-arg "--swank-fd"))
+ (style (read-command-line-arg "--swank-style"))
+ (repl (read-command-line-arg "--swank-repl"))
+ (* (format *error-output* "fd=~s style=~s~%" fd style))
+ (stream (make-fd-stream fd nil))
+ (connection (make-connection nil stream style)))
+ (let ((*emacs-connection* connection))
+ (when repl (swank::create-repl nil))
+ (background-message "~A" "Lisp image restored"))
+ (serve-requests connection)
+ (simple-repl)))
+
+(defun read-command-line-arg (name)
+ (let* ((args (command-line-args))
+ (pos (position name args :test #'equal)))
+ (read-from-string (elt args (1+ pos)))))
+
+(in-package :swank-snapshot)
+
+(provide :swank-snapshot)
diff --git a/vim/bundle/slimv/slime/contrib/swank-sprof.lisp b/vim/bundle/slimv/slime/contrib/swank-sprof.lisp
new file mode 100644
index 0000000..675240f
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-sprof.lisp
@@ -0,0 +1,154 @@
+;;; swank-sprof.lisp
+;;
+;; Authors: Juho Snellman
+;;
+;; License: MIT
+;;
+
+(in-package :swank)
+
+#+sbcl
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (require :sb-sprof))
+
+#+sbcl(progn
+
+(defvar *call-graph* nil)
+(defvar *node-numbers* nil)
+(defvar *number-nodes* nil)
+
+(defun frame-name (name)
+ (if (consp name)
+ (case (first name)
+ ((sb-c::xep sb-c::tl-xep
+ sb-c::&more-processor
+ sb-c::top-level-form
+ sb-c::&optional-processor)
+ (second name))
+ (sb-pcl::fast-method
+ (cdr name))
+ ((flet labels lambda)
+ (let* ((in (member :in name)))
+ (if (stringp (cadr in))
+ (append (ldiff name in) (cddr in))
+ name)))
+ (t
+ name))
+ name))
+
+(defun pretty-name (name)
+ (let ((*package* (find-package :common-lisp-user))
+ (*print-right-margin* most-positive-fixnum))
+ (format nil "~S" (frame-name name))))
+
+(defun samples-percent (count)
+ (sb-sprof::samples-percent *call-graph* count))
+
+(defun node-values (node)
+ (values (pretty-name (sb-sprof::node-name node))
+ (samples-percent (sb-sprof::node-count node))
+ (samples-percent (sb-sprof::node-accrued-count node))))
+
+(defun filter-swank-nodes (nodes)
+ (let ((swank-packages (load-time-value
+ (mapcar #'find-package
+ '(swank swank/rpc swank/mop
+ swank/match swank/backend)))))
+ (remove-if (lambda (node)
+ (let ((name (sb-sprof::node-name node)))
+ (and (symbolp name)
+ (member (symbol-package name) swank-packages
+ :test #'eq))))
+ nodes)))
+
+(defun serialize-call-graph (&key exclude-swank)
+ (let ((nodes (sb-sprof::call-graph-flat-nodes *call-graph*)))
+ (when exclude-swank
+ (setf nodes (filter-swank-nodes nodes)))
+ (setf nodes (sort (copy-list nodes) #'>
+ ;; :key #'sb-sprof::node-count)))
+ :key #'sb-sprof::node-accrued-count))
+ (setf *number-nodes* (make-hash-table))
+ (setf *node-numbers* (make-hash-table))
+ (loop for node in nodes
+ for i from 1
+ with total = 0
+ collect (multiple-value-bind (name self cumulative)
+ (node-values node)
+ (setf (gethash node *node-numbers*) i
+ (gethash i *number-nodes*) node)
+ (incf total self)
+ (list i name self cumulative total)) into list
+ finally (return
+ (let ((rest (- 100 total)))
+ (return (append list
+ `((nil "Elsewhere" ,rest nil nil)))))))))
+
+(defslimefun swank-sprof-get-call-graph (&key exclude-swank)
+ (when (setf *call-graph* (sb-sprof:report :type nil))
+ (serialize-call-graph :exclude-swank exclude-swank)))
+
+(defslimefun swank-sprof-expand-node (index)
+ (let* ((node (gethash index *number-nodes*)))
+ (labels ((caller-count (v)
+ (loop for e in (sb-sprof::vertex-edges v) do
+ (when (eq (sb-sprof::edge-vertex e) node)
+ (return-from caller-count (sb-sprof::call-count e))))
+ 0)
+ (serialize-node (node count)
+ (etypecase node
+ (sb-sprof::cycle
+ (list (sb-sprof::cycle-index node)
+ (sb-sprof::cycle-name node)
+ (samples-percent count)))
+ (sb-sprof::node
+ (let ((name (node-values node)))
+ (list (gethash node *node-numbers*)
+ name
+ (samples-percent count)))))))
+ (list :callers (loop for node in
+ (sort (copy-list (sb-sprof::node-callers node)) #'>
+ :key #'caller-count)
+ collect (serialize-node node
+ (caller-count node)))
+ :calls (let ((edges (sort (copy-list (sb-sprof::vertex-edges node))
+ #'>
+ :key #'sb-sprof::call-count)))
+ (loop for edge in edges
+ collect
+ (serialize-node (sb-sprof::edge-vertex edge)
+ (sb-sprof::call-count edge))))))))
+
+(defslimefun swank-sprof-disassemble (index)
+ (let* ((node (gethash index *number-nodes*))
+ (debug-info (sb-sprof::node-debug-info node)))
+ (with-output-to-string (s)
+ (typecase debug-info
+ (sb-impl::code-component
+ (sb-disassem::disassemble-memory (sb-vm::code-instructions debug-info)
+ (sb-vm::%code-code-size debug-info)
+ :stream s))
+ (sb-di::compiled-debug-fun
+ (let ((component (sb-di::compiled-debug-fun-component debug-info)))
+ (sb-disassem::disassemble-code-component component :stream s)))
+ (t `(:error "No disassembly available"))))))
+
+(defslimefun swank-sprof-source-location (index)
+ (let* ((node (gethash index *number-nodes*))
+ (debug-info (sb-sprof::node-debug-info node)))
+ (or (when (typep debug-info 'sb-di::compiled-debug-fun)
+ (let* ((component (sb-di::compiled-debug-fun-component debug-info))
+ (function (sb-kernel::%code-entry-points component)))
+ (when function
+ (find-source-location function))))
+ `(:error "No source location available"))))
+
+(defslimefun swank-sprof-start (&key (mode :cpu))
+ (sb-sprof:start-profiling :mode mode))
+
+(defslimefun swank-sprof-stop ()
+ (sb-sprof:stop-profiling))
+
+)
+
+(provide :swank-sprof)
diff --git a/vim/bundle/slimv/slime/contrib/swank-trace-dialog.lisp b/vim/bundle/slimv/slime/contrib/swank-trace-dialog.lisp
new file mode 100644
index 0000000..5cf95fd
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-trace-dialog.lisp
@@ -0,0 +1,264 @@
+(defpackage :swank-trace-dialog
+ (:use :cl)
+ (:import-from :swank :defslimefun :from-string :to-string)
+ (:export #:clear-trace-tree
+ #:dialog-toggle-trace
+ #:dialog-trace
+ #:dialog-traced-p
+ #:dialog-untrace
+ #:dialog-untrace-all
+ #:inspect-trace-part
+ #:report-partial-tree
+ #:report-specs
+ #:report-total
+ #:report-trace-detail
+ #:report-specs
+ #:trace-format
+ #:still-inside
+ #:exited-non-locally
+ #:*record-backtrace*
+ #:*traces-per-report*
+ #:*dialog-trace-follows-trace*
+ #:find-trace-part
+ #:find-trace))
+
+(in-package :swank-trace-dialog)
+
+(defparameter *record-backtrace* nil
+ "Record a backtrace of the last 20 calls for each trace.
+
+Beware that this may have a drastic performance impact on your
+program.")
+
+(defparameter *traces-per-report* 150
+ "Number of traces to report to emacs in each batch.")
+
+
+;;;; `trace-entry' model
+;;;;
+(defvar *traces* (make-array 1000 :fill-pointer 0
+ :adjustable t))
+
+(defvar *trace-lock* (swank/backend:make-lock :name "swank-trace-dialog lock"))
+
+(defvar *current-trace-by-thread* (make-hash-table))
+
+(defclass trace-entry ()
+ ((id :reader id-of)
+ (children :accessor children-of :initform nil)
+ (backtrace :accessor backtrace-of :initform (when *record-backtrace*
+ (useful-backtrace)))
+
+ (spec :initarg :spec :accessor spec-of
+ :initform (error "must provide a spec"))
+ (args :initarg :args :accessor args-of
+ :initform (error "must provide args"))
+ (parent :initarg :parent :reader parent-of
+ :initform (error "must provide a parent, even if nil"))
+ (retlist :initarg :retlist :accessor retlist-of
+ :initform 'still-inside)))
+
+(defmethod initialize-instance :after ((entry trace-entry) &rest initargs)
+ (declare (ignore initargs))
+ (if (parent-of entry)
+ (nconc (children-of (parent-of entry)) (list entry)))
+ (swank/backend:call-with-lock-held
+ *trace-lock*
+ #'(lambda ()
+ (setf (slot-value entry 'id) (fill-pointer *traces*))
+ (vector-push-extend entry *traces*))))
+
+(defmethod print-object ((entry trace-entry) stream)
+ (print-unreadable-object (entry stream)
+ (format stream "~a: ~a" (id-of entry) (spec-of entry))))
+
+(defun completed-p (trace) (not (eq (retlist-of trace) 'still-inside)))
+
+(defun find-trace (id)
+ (when (<= 0 id (1- (length *traces*)))
+ (aref *traces* id)))
+
+(defun find-trace-part (id part-id type)
+ (let* ((trace (find-trace id))
+ (l (and trace
+ (ecase type
+ (:arg (args-of trace))
+ (:retval (swank::ensure-list (retlist-of trace)))))))
+ (values (nth part-id l)
+ (< part-id (length l)))))
+
+(defun useful-backtrace ()
+ (swank/backend:call-with-debugging-environment
+ #'(lambda ()
+ (loop for i from 0
+ for frame in (swank/backend:compute-backtrace 0 20)
+ collect (list i (swank::frame-to-string frame))))))
+
+(defun current-trace ()
+ (gethash (swank/backend:current-thread) *current-trace-by-thread*))
+
+(defun (setf current-trace) (trace)
+ (setf (gethash (swank/backend:current-thread) *current-trace-by-thread*)
+ trace))
+
+
+;;;; Control of traced specs
+;;;
+(defvar *traced-specs* '())
+
+(defslimefun dialog-trace (spec)
+ (flet ((before-hook (args)
+ (setf (current-trace) (make-instance 'trace-entry
+ :spec spec
+ :args args
+ :parent (current-trace))))
+ (after-hook (retlist)
+ (let ((trace (current-trace)))
+ (when trace
+ ;; the current trace might have been wiped away if the
+ ;; user cleared the tree in the meantime. no biggie,
+ ;; don't do anything.
+ ;;
+ (setf (retlist-of trace) retlist
+ (current-trace) (parent-of trace))))))
+ (when (dialog-traced-p spec)
+ (warn "~a is apparently already traced! Untracing and retracing." spec)
+ (dialog-untrace spec))
+ (swank/backend:wrap spec 'trace-dialog
+ :before #'before-hook
+ :after #'after-hook)
+ (pushnew spec *traced-specs*)
+ (format nil "~a is now traced for trace dialog" spec)))
+
+(defslimefun dialog-untrace (spec)
+ (swank/backend:unwrap spec 'trace-dialog)
+ (setq *traced-specs* (remove spec *traced-specs* :test #'equal))
+ (format nil "~a is now untraced for trace dialog" spec))
+
+(defslimefun dialog-toggle-trace (spec)
+ (if (dialog-traced-p spec)
+ (dialog-untrace spec)
+ (dialog-trace spec)))
+
+(defslimefun dialog-traced-p (spec)
+ (find spec *traced-specs* :test #'equal))
+
+(defslimefun dialog-untrace-all ()
+ (untrace)
+ (mapcar #'dialog-untrace *traced-specs*))
+
+(defparameter *dialog-trace-follows-trace* nil)
+
+(setq swank:*after-toggle-trace-hook*
+ #'(lambda (spec traced-p)
+ (when *dialog-trace-follows-trace*
+ (cond (traced-p
+ (dialog-trace spec)
+ "traced for trace dialog as well")
+ (t
+ (dialog-untrace spec)
+ "untraced for the trace dialog as well")))))
+
+
+;;;; A special kind of trace call
+;;;
+(defun trace-format (format-spec &rest format-args)
+ "Make a string from FORMAT-SPEC and FORMAT-ARGS and as a trace."
+ (let* ((line (apply #'format nil format-spec format-args)))
+ (make-instance 'trace-entry :spec line
+ :args format-args
+ :parent (current-trace)
+ :retlist nil)))
+
+
+;;;; Reporting to emacs
+;;;
+(defparameter *visitor-idx* 0)
+
+(defparameter *visitor-key* nil)
+
+(defvar *unfinished-traces* '())
+
+(defun describe-trace-for-emacs (trace)
+ `(,(id-of trace)
+ ,(and (parent-of trace) (id-of (parent-of trace)))
+ ,(spec-of trace)
+ ,(loop for arg in (args-of trace)
+ for i from 0
+ collect (list i (swank::to-line arg)))
+ ,(loop for retval in (swank::ensure-list (retlist-of trace))
+ for i from 0
+ collect (list i (swank::to-line retval)))))
+
+(defslimefun report-partial-tree (key)
+ (unless (equal key *visitor-key*)
+ (setq *visitor-idx* 0
+ *visitor-key* key))
+ (let* ((recently-finished
+ (loop with i = 0
+ for trace in *unfinished-traces*
+ while (< i *traces-per-report*)
+ when (completed-p trace)
+ collect trace
+ and do
+ (incf i)
+ (setq *unfinished-traces*
+ (remove trace *unfinished-traces*))))
+ (new (loop for i
+ from (length recently-finished)
+ below *traces-per-report*
+ while (< *visitor-idx* (length *traces*))
+ for trace = (aref *traces* *visitor-idx*)
+ collect trace
+ unless (completed-p trace)
+ do (push trace *unfinished-traces*)
+ do (incf *visitor-idx*))))
+ (list
+ (mapcar #'describe-trace-for-emacs
+ (append recently-finished new))
+ (- (length *traces*) *visitor-idx*)
+ key)))
+
+(defslimefun report-trace-detail (trace-id)
+ (swank::call-with-bindings
+ swank::*inspector-printer-bindings*
+ #'(lambda ()
+ (let ((trace (find-trace trace-id)))
+ (when trace
+ (append
+ (describe-trace-for-emacs trace)
+ (list (backtrace-of trace)
+ (swank::to-line trace))))))))
+
+(defslimefun report-specs ()
+ (sort (copy-list *traced-specs*)
+ #'string<
+ :key #'princ-to-string))
+
+(defslimefun report-total ()
+ (length *traces*))
+
+(defslimefun clear-trace-tree ()
+ (setf *current-trace-by-thread* (clrhash *current-trace-by-thread*)
+ *visitor-key* nil
+ *unfinished-traces* nil)
+ (swank/backend:call-with-lock-held
+ *trace-lock*
+ #'(lambda () (setf (fill-pointer *traces*) 0)))
+ nil)
+
+;; HACK: `swank::*inspector-history*' is unbound by default and needs
+;; a reset in that case so that it won't error `swank::inspect-object'
+;; before any other object is inspected in the slime session.
+;;
+(unless (boundp 'swank::*inspector-history*)
+ (swank::reset-inspector))
+
+(defslimefun inspect-trace-part (trace-id part-id type)
+ (multiple-value-bind (obj found)
+ (find-trace-part trace-id part-id type)
+ (if found
+ (swank::inspect-object obj)
+ (error "No object found with ~a, ~a and ~a" trace-id part-id type))))
+
+(provide :swank-trace-dialog)
diff --git a/vim/bundle/slimv/slime/contrib/swank-util.lisp b/vim/bundle/slimv/slime/contrib/swank-util.lisp
new file mode 100644
index 0000000..72743ba
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-util.lisp
@@ -0,0 +1,63 @@
+;;; swank-util.lisp --- stuff of questionable utility
+;;
+;; License: public domain
+
+(in-package :swank)
+
+(defmacro do-symbols* ((var &optional (package '*package*) result-form)
+ &body body)
+ "Just like do-symbols, but makes sure a symbol is visited only once."
+ (let ((seen-ht (gensym "SEEN-HT")))
+ `(let ((,seen-ht (make-hash-table :test #'eq)))
+ (do-symbols (,var ,package ,result-form)
+ (unless (gethash ,var ,seen-ht)
+ (setf (gethash ,var ,seen-ht) t)
+ (tagbody ,@body))))))
+
+(defun classify-symbol (symbol)
+ "Returns a list of classifiers that classify SYMBOL according to its
+underneath objects (e.g. :BOUNDP if SYMBOL constitutes a special
+variable.) The list may contain the following classification
+keywords: :BOUNDP, :FBOUNDP, :CONSTANT, :GENERIC-FUNCTION,
+:TYPESPEC, :CLASS, :MACRO, :SPECIAL-OPERATOR, and/or :PACKAGE"
+ (check-type symbol symbol)
+ (flet ((type-specifier-p (s)
+ (or (documentation s 'type)
+ (not (eq (type-specifier-arglist s) :not-available)))))
+ (let (result)
+ (when (boundp symbol) (push (if (constantp symbol)
+ :constant :boundp) result))
+ (when (fboundp symbol) (push :fboundp result))
+ (when (type-specifier-p symbol) (push :typespec result))
+ (when (find-class symbol nil) (push :class result))
+ (when (macro-function symbol) (push :macro result))
+ (when (special-operator-p symbol) (push :special-operator result))
+ (when (find-package symbol) (push :package result))
+ (when (and (fboundp symbol)
+ (typep (ignore-errors (fdefinition symbol))
+ 'generic-function))
+ (push :generic-function result))
+ result)))
+
+(defun symbol-classification-string (symbol)
+ "Return a string in the form -f-c---- where each letter stands for
+boundp fboundp generic-function class macro special-operator package"
+ (let ((letters "bfgctmsp")
+ (result (copy-seq "--------")))
+ (flet ((flip (letter)
+ (setf (char result (position letter letters))
+ letter)))
+ (when (boundp symbol) (flip #\b))
+ (when (fboundp symbol)
+ (flip #\f)
+ (when (typep (ignore-errors (fdefinition symbol))
+ 'generic-function)
+ (flip #\g)))
+ (when (type-specifier-p symbol) (flip #\t))
+ (when (find-class symbol nil) (flip #\c) )
+ (when (macro-function symbol) (flip #\m))
+ (when (special-operator-p symbol) (flip #\s))
+ (when (find-package symbol) (flip #\p))
+ result)))
+
+(provide :swank-util)
diff --git a/vim/bundle/slimv/slime/metering.lisp b/vim/bundle/slimv/slime/metering.lisp
new file mode 100644
index 0000000..b87d280
--- /dev/null
+++ b/vim/bundle/slimv/slime/metering.lisp
@@ -0,0 +1,1213 @@
+;;; -*- Mode: LISP; Package: monitor; Syntax: Common-lisp; Base: 10.; -*-
+;;; Tue Jan 25 18:32:28 1994 by Mark Kantrowitz <mkant@GLINDA.OZ.CS.CMU.EDU>
+
+;;; ****************************************************************
+;;; Metering System ************************************************
+;;; ****************************************************************
+;;;
+;;; The Metering System is a portable Common Lisp code profiling tool.
+;;; It gathers timing and consing statistics for specified functions
+;;; while a program is running.
+;;;
+;;; The Metering System is a combination of
+;;; o the Monitor package written by Chris McConnell
+;;; o the Profile package written by Skef Wholey and Rob MacLachlan
+;;; The two systems were merged and extended by Mark Kantrowitz.
+;;;
+;;; Address: Carnegie Mellon University
+;;; School of Computer Science
+;;; Pittsburgh, PA 15213
+;;;
+;;; This code is in the public domain and is distributed without warranty
+;;; of any kind.
+;;;
+;;; This copy is from SLIME, http://www.common-lisp.net/project/slime/
+;;;
+;;;
+
+;;; ********************************
+;;; Change Log *********************
+;;; ********************************
+;;;
+;;; 26-JUN-90 mk Merged functionality of Monitor and Profile packages.
+;;; 26-JUN-90 mk Now handles both inclusive and exclusive statistics
+;;; with respect to nested calls. (Allows it to subtract
+;;; total monitoring overhead for each function, not just
+;;; the time spent monitoring the function itself.)
+;;; 26-JUN-90 mk The table is now saved so that one may manipulate
+;;; the data (sorting it, etc.) even after the original
+;;; source of the data has been cleared.
+;;; 25-SEP-90 mk Added get-cons functions for Lucid 3.0, MACL 1.3.2
+;;; required-arguments functions for Lucid 3.0,
+;;; Franz Allegro CL, and MACL 1.3.2.
+;;; 25-JAN-91 mk Now uses fdefinition if available.
+;;; 25-JAN-91 mk Replaced (and :allegro (not :coral)) with :excl.
+;;; Much better solution for the fact that both call
+;;; themselves :allegro.
+;;; 5-JUL-91 mk Fixed warning to occur only when file is loaded
+;;; uncompiled.
+;;; 5-JUL-91 mk When many unmonitored functions, print out number
+;;; instead of whole list.
+;;; 24-MAR-92 mk Updated for CLtL2 compatibility. space measuring
+;;; doesn't work in MCL, but fixed so that timing
+;;; statistics do.
+;;; 26-MAR-92 mk Updated for Lispworks. Replaced :ccl with
+;;; (and :ccl (not :lispworks)).
+;;; 27-MAR-92 mk Added get-cons for Allegro-V4.0.
+;;; 01-JAN-93 mk v2.0 Support for MCL 2.0, CMU CL 16d, Allegro V3.1/4.0/4.1,
+;;; Lucid 4.0, ibcl
+;;; 25-JAN-94 mk v2.1 Patches for CLISP from Bruno Haible.
+;;; 01-APR-05 lgorrie Removed support for all Lisps except CLISP and OpenMCL.
+;;; Purely to cut down on stale code (e.g. #+cltl2) in this
+;;; version that is bundled with SLIME.
+;;; 22-Aug-08 stas Define TIME-TYPE for Clozure CL.
+;;; 07-Aug-12 heller Break lines at 80 columns
+;;;
+
+;;; ********************************
+;;; To Do **************************
+;;; ********************************
+;;;
+;;; - Need get-cons for Allegro, AKCL.
+;;; - Speed up monitoring code. Replace use of hash tables with an embedded
+;;; offset in an array so that it will be faster than using gethash.
+;;; (i.e., svref/closure reference is usually faster than gethash).
+;;; - Beware of (get-internal-run-time) overflowing. Yikes!
+;;; - Check robustness with respect to profiled functions.
+;;; - Check logic of computing inclusive and exclusive time and consing.
+;;; Especially wrt incf/setf comment below. Should be incf, so we
+;;; sum recursive calls.
+;;; - Add option to record caller statistics -- this would list who
+;;; called which functions and how often.
+;;; - switches to turn timing/CONSING statistics collection on/off.
+
+
+;;; ********************************
+;;; Notes **************************
+;;; ********************************
+;;;
+;;; METERING has been tested (successfully) in the following lisps:
+;;; CMU Common Lisp (16d, Python Compiler 1.0 ) :new-compiler
+;;; CMU Common Lisp (M2.9 15-Aug-90, Compiler M1.8 15-Aug-90)
+;;; Macintosh Allegro Common Lisp (1.3.2)
+;;; Macintosh Common Lisp (2.0)
+;;; ExCL (Franz Allegro CL 3.1.12 [DEC 3100] 11/19/90) :allegro-v3.1
+;;; ExCL (Franz Allegro CL 4.0.1 [Sun4] 2/8/91) :allegro-v4.0
+;;; ExCL (Franz Allegro CL 4.1 [SPARC R1] 8/28/92 14:06) :allegro-v4.1
+;;; ExCL (Franz ACL 5.0.1 [Linux/X86] 6/29/99 16:11) :allegro-v5.0.1
+;;; Lucid CL (Version 2.1 6-DEC-87)
+;;; Lucid Common Lisp (3.0)
+;;; Lucid Common Lisp (4.0.1 HP-700 12-Aug-91)
+;;; AKCL (1.86, June 30, 1987 or later)
+;;; Ibuki Common Lisp (Version 2, release 01.027)
+;;; CLISP (January 1994)
+;;;
+;;; METERING needs to be tested in the following lisps:
+;;; Symbolics Common Lisp (8.0)
+;;; KCL (June 3, 1987 or later)
+;;; TI (Release 4.1 or later)
+;;; Golden Common Lisp (3.1 IBM-PC)
+;;; VAXLisp (2.0, 3.1)
+;;; Procyon Common Lisp
+
+
+;;; ****************************************************************
+;;; Documentation **************************************************
+;;; ****************************************************************
+;;;
+;;; This system runs in any valid Common Lisp. Four small
+;;; implementation-dependent changes can be made to improve performance
+;;; and prettiness. In the section labelled "Implementation Dependent
+;;; Changes" below, you should tailor the functions REQUIRED-ARGUMENTS,
+;;; GET-CONS, GET-TIME, and TIME-UNITS-PER-SECOND to your implementation
+;;; for the best results. If GET-CONS is not specified for your
+;;; implementation, no consing information will be reported. The other
+;;; functions will default to working forms, albeit inefficient, in
+;;; non-CMU implementations. If you tailor these functions for a particular
+;;; version of Common Lisp, we'd appreciate receiving the code.
+;;;
+
+;;; ****************************************************************
+;;; Usage Notes ****************************************************
+;;; ****************************************************************
+;;;
+;;; SUGGESTED USAGE:
+;;;
+;;; Start by monitoring big pieces of the program, then carefully choose
+;;; which functions close to, but not in, the inner loop are to be
+;;; monitored next. Don't monitor functions that are called by other
+;;; monitored functions: you will only confuse yourself.
+;;;
+;;; If the per-call time reported is less than 1/10th of a second, then
+;;; consider the clock resolution and profiling overhead before you believe
+;;; the time. It may be that you will need to run your program many times
+;;; in order to average out to a higher resolution.
+;;;
+;;; The easiest way to use this package is to load it and execute either
+;;; (swank-monitor:with-monitoring (names*) ()
+;;; your-forms*)
+;;; or
+;;; (swank-monitor:monitor-form your-form)
+;;; The former allows you to specify which functions will be monitored; the
+;;; latter monitors all functions in the current package. Both automatically
+;;; produce a table of statistics. Other variants can be constructed from
+;;; the monitoring primitives, which are described below, along with a
+;;; fuller description of these two macros.
+;;;
+;;; For best results, compile this file before using.
+;;;
+;;;
+;;; CLOCK RESOLUTION:
+;;;
+;;; Unless you are very lucky, the length of your machine's clock "tick" is
+;;; probably much longer than the time it takes a simple function to run.
+;;; For example, on the IBM RT, the clock resolution is 1/50th of a second.
+;;; This means that if a function is only called a few times, then only the
+;;; first couple of decimal places are really meaningful.
+;;;
+;;;
+;;; MONITORING OVERHEAD:
+;;;
+;;; The added monitoring code takes time to run every time that the monitored
+;;; function is called, which can disrupt the attempt to collect timing
+;;; information. In order to avoid serious inflation of the times for functions
+;;; that take little time to run, an estimate of the overhead due to monitoring
+;;; is subtracted from the times reported for each function.
+;;;
+;;; Although this correction works fairly well, it is not totally accurate,
+;;; resulting in times that become increasingly meaningless for functions
+;;; with short runtimes. For example, subtracting the estimated overhead
+;;; may result in negative times for some functions. This is only a concern
+;;; when the estimated profiling overhead is many times larger than
+;;; reported total CPU time.
+;;;
+;;; If you monitor functions that are called by monitored functions, in
+;;; :inclusive mode the monitoring overhead for the inner function is
+;;; subtracted from the CPU time for the outer function. [We do this by
+;;; counting for each function not only the number of calls to *this*
+;;; function, but also the number of monitored calls while it was running.]
+;;; In :exclusive mode this is not necessary, since we subtract the
+;;; monitoring time of inner functions, overhead & all.
+;;;
+;;; Otherwise, the estimated monitoring overhead is not represented in the
+;;; reported total CPU time. The sum of total CPU time and the estimated
+;;; monitoring overhead should be close to the total CPU time for the
+;;; entire monitoring run (as determined by TIME).
+;;;
+;;; A timing overhead factor is computed at load time. This will be incorrect
+;;; if the monitoring code is run in a different environment than this file
+;;; was loaded in. For example, saving a core image on a high performance
+;;; machine and running it on a low performance one will result in the use
+;;; of an erroneously small overhead factor.
+;;;
+;;;
+;;; If your times vary widely, possible causes are:
+;;; - Garbage collection. Try turning it off, then running your code.
+;;; Be warned that monitoring code will probably cons when it does
+;;; (get-internal-run-time).
+;;; - Swapping. If you have enough memory, execute your form once
+;;; before monitoring so that it will be swapped into memory. Otherwise,
+;;; get a bigger machine!
+;;; - Resolution of internal-time-units-per-second. If this value is
+;;; too low, then the timings become wild. You can try executing more
+;;; of whatever your test is, but that will only work if some of your
+;;; paths do not match the timer resolution.
+;;; internal-time-units-per-second is so coarse -- on a Symbolics it is
+;;; 977, in MACL it is 60.
+;;;
+;;;
+
+;;; ****************************************************************
+;;; Interface ******************************************************
+;;; ****************************************************************
+;;;
+;;; WITH-MONITORING (&rest functions) [Macro]
+;;; (&optional (nested :exclusive)
+;;; (threshold 0.01)
+;;; (key :percent-time))
+;;; &body body
+;;; The named functions will be set up for monitoring, the body forms executed,
+;;; a table of results printed, and the functions unmonitored. The nested,
+;;; threshold, and key arguments are passed to report-monitoring below.
+;;;
+;;; MONITOR-FORM form [Macro]
+;;; &optional (nested :exclusive)
+;;; (threshold 0.01)
+;;; (key :percent-time)
+;;; All functions in the current package are set up for monitoring while
+;;; the form is executed, and automatically unmonitored after a table of
+;;; results has been printed. The nested, threshold, and key arguments
+;;; are passed to report-monitoring below.
+;;;
+;;; *MONITORED-FUNCTIONS* [Variable]
+;;; This holds a list of all functions that are currently being monitored.
+;;;
+;;; MONITOR &rest names [Macro]
+;;; The named functions will be set up for monitoring by augmenting
+;;; their function definitions with code that gathers statistical information
+;;; about code performance. As with the TRACE macro, the function names are
+;;; not evaluated. Calls the function SWANK-MONITOR::MONITORING-ENCAPSULATE on each
+;;; function name. If no names are specified, returns a list of all
+;;; monitored functions.
+;;;
+;;; If name is not a symbol, it is evaled to return the appropriate
+;;; closure. This allows you to monitor closures stored anywhere like
+;;; in a variable, array or structure. Most other monitoring packages
+;;; can't handle this.
+;;;
+;;; MONITOR-ALL &optional (package *package*) [Function]
+;;; Monitors all functions in the specified package, which defaults to
+;;; the current package.
+;;;
+;;; UNMONITOR &rest names [Macro]
+;;; Removes monitoring code from the named functions. If no names are
+;;; specified, all currently monitored functions are unmonitored.
+;;;
+;;; RESET-MONITORING-INFO name [Function]
+;;; Resets the monitoring statistics for the specified function.
+;;;
+;;; RESET-ALL-MONITORING [Function]
+;;; Resets the monitoring statistics for all monitored functions.
+;;;
+;;; MONITORED name [Function]
+;;; Predicate to test whether a function is monitored.
+;;;
+;;; REPORT-MONITORING &optional names [Function]
+;;; (nested :exclusive)
+;;; (threshold 0.01)
+;;; (key :percent-time)
+;;; Creates a table of monitoring information for the specified list
+;;; of names, and displays the table using display-monitoring-results.
+;;; If names is :all or nil, uses all currently monitored functions.
+;;; Takes the following arguments:
+;;; - NESTED specifies whether nested calls of monitored functions
+;;; are included in the times for monitored functions.
+;;; o If :inclusive, the per-function information is for the entire
+;;; duration of the monitored function, including any calls to
+;;; other monitored functions. If functions A and B are monitored,
+;;; and A calls B, then the accumulated time and consing for A will
+;;; include the time and consing of B. Note: if a function calls
+;;; itself recursively, the time spent in the inner call(s) may
+;;; be counted several times.
+;;; o If :exclusive, the information excludes time attributed to
+;;; calls to other monitored functions. This is the default.
+;;; - THRESHOLD specifies that only functions which have been executed
+;;; more than threshold percent of the time will be reported. Defaults
+;;; to 1%. If a threshold of 0 is specified, all functions are listed,
+;;; even those with 0 or negative running times (see note on overhead).
+;;; - KEY specifies that the table be sorted by one of the following
+;;; sort keys:
+;;; :function alphabetically by function name
+;;; :percent-time by percent of total execution time
+;;; :percent-cons by percent of total consing
+;;; :calls by number of times the function was called
+;;; :time-per-call by average execution time per function
+;;; :cons-per-call by average consing per function
+;;; :time same as :percent-time
+;;; :cons same as :percent-cons
+;;;
+;;; REPORT &key (names :all) [Function]
+;;; (nested :exclusive)
+;;; (threshold 0.01)
+;;; (sort-key :percent-time)
+;;; (ignore-no-calls nil)
+;;;
+;;; Same as REPORT-MONITORING but we use a nicer keyword interface.
+;;;
+;;; DISPLAY-MONITORING-RESULTS &optional (threshold 0.01) [Function]
+;;; (key :percent-time)
+;;; Prints a table showing for each named function:
+;;; - the total CPU time used in that function for all calls
+;;; - the total number of bytes consed in that function for all calls
+;;; - the total number of calls
+;;; - the average amount of CPU time per call
+;;; - the average amount of consing per call
+;;; - the percent of total execution time spent executing that function
+;;; - the percent of total consing spent consing in that function
+;;; Summary totals of the CPU time, consing, and calls columns are printed.
+;;; An estimate of the monitoring overhead is also printed. May be run
+;;; even after unmonitoring all the functions, to play with the data.
+;;;
+;;; SAMPLE TABLE:
+#|
+ Cons
+ % % Per Total Total
+Function Time Cons Calls Sec/Call Call Time Cons
+----------------------------------------------------------------------
+FIND-ROLE: 0.58 0.00 136 0.003521 0 0.478863 0
+GROUP-ROLE: 0.35 0.00 365 0.000802 0 0.292760 0
+GROUP-PROJECTOR: 0.05 0.00 102 0.000408 0 0.041648 0
+FEATURE-P: 0.02 0.00 570 0.000028 0 0.015680 0
+----------------------------------------------------------------------
+TOTAL: 1173 0.828950 0
+Estimated total monitoring overhead: 0.88 seconds
+|#
+
+;;; ****************************************************************
+;;; METERING *******************************************************
+;;; ****************************************************************
+
+;;; ********************************
+;;; Warn people using the wrong Lisp
+;;; ********************************
+
+#-(or clisp openmcl)
+(warn "metering.lisp does not support your Lisp implementation!")
+
+;;; ********************************
+;;; Packages ***********************
+;;; ********************************
+
+;;; For CLtL2 compatible lisps
+
+(defpackage "SWANK-MONITOR" (:use "COMMON-LISP")
+ (:export "*MONITORED-FUNCTIONS*"
+ "MONITOR" "MONITOR-ALL" "UNMONITOR" "MONITOR-FORM"
+ "WITH-MONITORING"
+ "RESET-MONITORING-INFO" "RESET-ALL-MONITORING"
+ "MONITORED"
+ "REPORT-MONITORING"
+ "DISPLAY-MONITORING-RESULTS"
+ "MONITORING-ENCAPSULATE" "MONITORING-UNENCAPSULATE"
+ "REPORT"))
+(in-package "SWANK-MONITOR")
+
+;;; Warn user if they're loading the source instead of compiling it first.
+(eval-when (eval)
+ (warn "This file should be compiled before loading for best results."))
+
+;;; ********************************
+;;; Version ************************
+;;; ********************************
+
+(defparameter *metering-version* "v2.1 25-JAN-94"
+ "Current version number/date for Metering.")
+
+
+;;; ****************************************************************
+;;; Implementation Dependent Definitions ***************************
+;;; ****************************************************************
+
+;;; ********************************
+;;; Timing Functions ***************
+;;; ********************************
+;;; The get-time function is called to find the total number of ticks since
+;;; the beginning of time. time-units-per-second allows us to convert units
+;;; to seconds.
+
+#-(or clisp openmcl)
+(eval-when (compile eval)
+ (warn
+ "You may want to supply implementation-specific get-time functions."))
+
+(defconstant time-units-per-second internal-time-units-per-second)
+
+#+openmcl
+(progn
+ (deftype time-type () 'unsigned-byte)
+ (deftype consing-type () 'unsigned-byte))
+
+(defmacro get-time ()
+ `(the time-type (get-internal-run-time)))
+
+;;; NOTE: In Macintosh Common Lisp, CCL::GCTIME returns the number of
+;;; milliseconds spent during GC. We could subtract this from
+;;; the value returned by get-internal-run-time to eliminate
+;;; the effect of GC on the timing values, but we prefer to let
+;;; the user run without GC on. If the application is so big that
+;;; it requires GC to complete, then the GC times are part of the
+;;; cost of doing business, and will average out in the long run.
+;;; If it seems really important to a user that GC times not be
+;;; counted, then uncomment the following three lines and read-time
+;;; conditionalize the definition of get-time above with #-:openmcl.
+;#+openmcl
+;(defmacro get-time ()
+; `(the time-type (- (get-internal-run-time) (ccl:gctime))))
+
+;;; ********************************
+;;; Consing Functions **************
+;;; ********************************
+;;; The get-cons macro is called to find the total number of bytes
+;;; consed since the beginning of time.
+
+#+clisp
+(defun get-cons ()
+ (multiple-value-bind (real1 real2 run1 run2 gc1 gc2 space1 space2 gccount)
+ (sys::%%time)
+ (declare (ignore real1 real2 run1 run2 gc1 gc2 gccount))
+ (dpb space1 (byte 24 24) space2)))
+
+;;; Macintosh Common Lisp 2.0
+;;; Note that this includes bytes that were allocated during GC.
+;;; We could subtract this out by advising GC like we did under
+;;; MCL 1.3.2, but I'd rather users ran without GC. If they can't
+;;; run without GC, then the bytes consed during GC are a cost of
+;;; running their program. Metering the code a few times will
+;;; avoid the consing values being too lopsided. If a user really really
+;;; wants to subtract out the consing during GC, replace the following
+;;; two lines with the commented out code.
+#+openmcl
+(defmacro get-cons () `(the consing-type (ccl::total-bytes-allocated)))
+
+#-(or clisp openmcl)
+(progn
+ (eval-when (compile eval)
+ (warn "No consing will be reported unless a get-cons function is ~
+ defined."))
+
+ (defmacro get-cons () '(the consing-type 0)))
+
+;; actually, neither `get-cons' nor `get-time' are used as is,
+;; but only in the following macro `with-time/cons'
+#-:clisp
+(defmacro with-time/cons ((delta-time delta-cons) form &body post-process)
+ (let ((start-cons (gensym "START-CONS-"))
+ (start-time (gensym "START-TIME-")))
+ `(let ((,start-time (get-time)) (,start-cons (get-cons)))
+ (declare (type time-type ,start-time)
+ (type consing-type ,start-cons))
+ (multiple-value-prog1 ,form
+ (let ((,delta-time (- (get-time) ,start-time))
+ (,delta-cons (- (get-cons) ,start-cons)))
+ ,@post-process)))))
+
+#+clisp
+(progn
+ (defmacro delta4 (nv1 nv2 ov1 ov2 by)
+ `(- (dpb (- ,nv1 ,ov1) (byte ,by ,by) ,nv2) ,ov2))
+
+ (let ((del (find-symbol "DELTA4" "SYS")))
+ (when del (setf (fdefinition 'delta4) (fdefinition del))))
+
+ (if (< internal-time-units-per-second 1000000)
+ ;; TIME_1: AMIGA, OS/2, UNIX_TIMES
+ (defmacro delta4-time (new-time1 new-time2 old-time1 old-time2)
+ `(delta4 ,new-time1 ,new-time2 ,old-time1 ,old-time2 16))
+ ;; TIME_2: other UNIX, WIN32
+ (defmacro delta4-time (new-time1 new-time2 old-time1 old-time2)
+ `(+ (* (- ,new-time1 ,old-time1) internal-time-units-per-second)
+ (- ,new-time2 ,old-time2))))
+
+ (defmacro delta4-cons (new-cons1 new-cons2 old-cons1 old-cons2)
+ `(delta4 ,new-cons1 ,new-cons2 ,old-cons1 ,old-cons2 24))
+
+ ;; avoid consing: when the application conses a lot,
+ ;; get-cons may return a bignum, so we really should not use it.
+ (defmacro with-time/cons ((delta-time delta-cons) form &body post-process)
+ (let ((beg-cons1 (gensym "BEG-CONS1-")) (end-cons1 (gensym "END-CONS1-"))
+ (beg-cons2 (gensym "BEG-CONS2-")) (end-cons2 (gensym "END-CONS2-"))
+ (beg-time1 (gensym "BEG-TIME1-")) (end-time1 (gensym "END-TIME1-"))
+ (beg-time2 (gensym "BEG-TIME2-")) (end-time2 (gensym "END-TIME2-"))
+ (re1 (gensym)) (re2 (gensym)) (gc1 (gensym)) (gc2 (gensym)))
+ `(multiple-value-bind (,re1 ,re2 ,beg-time1 ,beg-time2
+ ,gc1 ,gc2 ,beg-cons1 ,beg-cons2)
+ (sys::%%time)
+ (declare (ignore ,re1 ,re2 ,gc1 ,gc2))
+ (multiple-value-prog1 ,form
+ (multiple-value-bind (,re1 ,re2 ,end-time1 ,end-time2
+ ,gc1 ,gc2 ,end-cons1 ,end-cons2)
+ (sys::%%time)
+ (declare (ignore ,re1 ,re2 ,gc1 ,gc2))
+ (let ((,delta-time (delta4-time ,end-time1 ,end-time2
+ ,beg-time1 ,beg-time2))
+ (,delta-cons (delta4-cons ,end-cons1 ,end-cons2
+ ,beg-cons1 ,beg-cons2)))
+ ,@post-process)))))))
+
+;;; ********************************
+;;; Required Arguments *************
+;;; ********************************
+;;;
+;;; Required (Fixed) vs Optional Args
+;;;
+;;; To avoid unnecessary consing in the "encapsulation" code, we find out the
+;;; number of required arguments, and use &rest to capture only non-required
+;;; arguments. The function Required-Arguments returns two values: the first
+;;; is the number of required arguments, and the second is T iff there are any
+;;; non-required arguments (e.g. &optional, &rest, &key).
+
+;;; Lucid, Allegro, and Macintosh Common Lisp
+#+openmcl
+(defun required-arguments (name)
+ (let* ((function (symbol-function name))
+ (args (ccl:arglist function))
+ (pos (position-if #'(lambda (x)
+ (and (symbolp x)
+ (let ((name (symbol-name x)))
+ (and (>= (length name) 1)
+ (char= (schar name 0)
+ #\&)))))
+ args)))
+ (if pos
+ (values pos t)
+ (values (length args) nil))))
+
+#+clisp
+(defun required-arguments (name)
+ (multiple-value-bind (name req-num opt-num rest-p key-p keywords allow-p)
+ (sys::function-signature name t)
+ (if name ; no error
+ (values req-num (or (/= 0 opt-num) rest-p key-p keywords allow-p))
+ (values 0 t))))
+
+#-(or clisp openmcl)
+(progn
+ (eval-when (compile eval)
+ (warn
+ "You may want to add an implementation-specific ~
+Required-Arguments function."))
+ (eval-when (load eval)
+ (defun required-arguments (name)
+ (declare (ignore name))
+ (values 0 t))))
+
+#|
+;;;Examples
+(defun square (x) (* x x))
+(defun square2 (x &optional y) (* x x y))
+(defun test (x y &optional (z 3)) 3)
+(defun test2 (x y &optional (z 3) &rest fred) 3)
+
+(required-arguments 'square) => 1 nil
+(required-arguments 'square2) => 1 t
+(required-arguments 'test) => 2 t
+(required-arguments 'test2) => 2 t
+|#
+
+
+;;; ****************************************************************
+;;; Main METERING Code *********************************************
+;;; ****************************************************************
+
+;;; ********************************
+;;; Global Variables ***************
+;;; ********************************
+(defvar *MONITOR-TIME-OVERHEAD* nil
+ "The amount of time an empty monitored function costs.")
+(defvar *MONITOR-CONS-OVERHEAD* nil
+ "The amount of cons an empty monitored function costs.")
+
+(defvar *TOTAL-TIME* 0
+ "Total amount of time monitored so far.")
+(defvar *TOTAL-CONS* 0
+ "Total amount of consing monitored so far.")
+(defvar *TOTAL-CALLS* 0
+ "Total number of calls monitored so far.")
+(proclaim '(type time-type *total-time*))
+(proclaim '(type consing-type *total-cons*))
+(proclaim '(fixnum *total-calls*))
+
+;;; ********************************
+;;; Accessor Functions *************
+;;; ********************************
+;;; Perhaps the SYMBOLP should be FBOUNDP? I.e., what about variables
+;;; containing closures.
+(defmacro PLACE-FUNCTION (function-place)
+ "Return the function found at FUNCTION-PLACE. Evals FUNCTION-PLACE
+if it isn't a symbol, to allow monitoring of closures located in
+variables/arrays/structures."
+ ;; Note that (fboundp 'fdefinition) returns T even if fdefinition
+ ;; is a macro, which is what we want.
+ (if (fboundp 'fdefinition)
+ `(if (fboundp ,function-place)
+ (fdefinition ,function-place)
+ (eval ,function-place))
+ `(if (symbolp ,function-place)
+ (symbol-function ,function-place)
+ (eval ,function-place))))
+
+(defsetf PLACE-FUNCTION (function-place) (function)
+ "Set the function in FUNCTION-PLACE to FUNCTION."
+ (if (fboundp 'fdefinition)
+ ;; If we're conforming to CLtL2, use fdefinition here.
+ `(if (fboundp ,function-place)
+ (setf (fdefinition ,function-place) ,function)
+ (eval '(setf ,function-place ',function)))
+ `(if (symbolp ,function-place)
+ (setf (symbol-function ,function-place) ,function)
+ (eval '(setf ,function-place ',function)))))
+
+#|
+;;; before using fdefinition
+(defun PLACE-FUNCTION (function-place)
+ "Return the function found at FUNCTION-PLACE. Evals FUNCTION-PLACE
+if it isn't a symbol, to allow monitoring of closures located in
+variables/arrays/structures."
+ (if (symbolp function-place)
+ (symbol-function function-place)
+ (eval function-place)))
+
+(defsetf PLACE-FUNCTION (function-place) (function)
+ "Set the function in FUNCTION-PLACE to FUNCTION."
+ `(if (symbolp ,function-place)
+ (setf (symbol-function ,function-place) ,function)
+ (eval '(setf ,function-place ',function))))
+|#
+
+(defun PLACE-FBOUNDP (function-place)
+ "Test to see if FUNCTION-PLACE is a function."
+ ;; probably should be
+ #|(or (and (symbolp function-place)(fboundp function-place))
+ (functionp (place-function function-place)))|#
+ (if (symbolp function-place)
+ (fboundp function-place)
+ (functionp (place-function function-place))))
+
+(defun PLACE-MACROP (function-place)
+ "Test to see if FUNCTION-PLACE is a macro."
+ (when (symbolp function-place)
+ (macro-function function-place)))
+
+;;; ********************************
+;;; Measurement Tables *************
+;;; ********************************
+(defvar *monitored-functions* nil
+ "List of monitored symbols.")
+
+;;; We associate a METERING-FUNCTIONS structure with each monitored function
+;;; name or other closure. This holds the functions that we call to manipulate
+;;; the closure which implements the encapsulation.
+;;;
+(defstruct metering-functions
+ (name nil)
+ (old-definition nil :type function)
+ (new-definition nil :type function)
+ (read-metering nil :type function)
+ (reset-metering nil :type function))
+
+;;; In general using hash tables in time-critical programs is a bad idea,
+;;; because when one has to grow the table and rehash everything, the
+;;; timing becomes grossly inaccurate. In this case it is not an issue
+;;; because all inserting of entries in the hash table occurs before the
+;;; timing commences. The only circumstance in which this could be a
+;;; problem is if the lisp rehashes on the next reference to the table,
+;;; instead of when the entry which forces a rehash was inserted.
+;;;
+;;; Note that a similar kind of problem can occur with GC, which is why
+;;; one should turn off GC when monitoring code.
+;;;
+(defvar *monitor* (make-hash-table :test #'equal)
+ "Hash table in which METERING-FUNCTIONS structures are stored.")
+(defun get-monitor-info (name)
+ (gethash name *monitor*))
+(defsetf get-monitor-info (name) (info)
+ `(setf (gethash ,name *monitor*) ,info))
+
+(defun MONITORED (function-place)
+ "Test to see if a FUNCTION-PLACE is monitored."
+ (and (place-fboundp function-place) ; this line necessary?
+ (get-monitor-info function-place)))
+
+(defun reset-monitoring-info (name)
+ "Reset the monitoring info for the specified function."
+ (let ((finfo (get-monitor-info name)))
+ (when finfo
+ (funcall (metering-functions-reset-metering finfo)))))
+(defun reset-all-monitoring ()
+ "Reset monitoring info for all functions."
+ (setq *total-time* 0
+ *total-cons* 0
+ *total-calls* 0)
+ (dolist (symbol *monitored-functions*)
+ (when (monitored symbol)
+ (reset-monitoring-info symbol))))
+
+(defun monitor-info-values (name &optional (nested :exclusive) warn)
+ "Returns monitoring information values for the named function,
+adjusted for overhead."
+ (let ((finfo (get-monitor-info name)))
+ (if finfo
+ (multiple-value-bind (inclusive-time inclusive-cons
+ exclusive-time exclusive-cons
+ calls nested-calls)
+ (funcall (metering-functions-read-metering finfo))
+ (unless (or (null warn)
+ (eq (place-function name)
+ (metering-functions-new-definition finfo)))
+ (warn "Funtion ~S has been redefined, so times may be inaccurate.~@
+ MONITOR it again to record calls to the new definition."
+ name))
+ (case nested
+ (:exclusive (values calls
+ nested-calls
+ (- exclusive-time
+ (* calls *monitor-time-overhead*))
+ (- exclusive-cons
+ (* calls *monitor-cons-overhead*))))
+ ;; In :inclusive mode, subtract overhead for all the
+ ;; called functions as well. Nested-calls includes the
+ ;; calls of the function as well. [Necessary 'cause of
+ ;; functions which call themselves recursively.]
+ (:inclusive (values calls
+ nested-calls
+ (- inclusive-time
+ (* nested-calls ;(+ calls)
+ *monitor-time-overhead*))
+ (- inclusive-cons
+ (* nested-calls ;(+ calls)
+ *monitor-cons-overhead*))))))
+ (values 0 0 0 0))))
+
+;;; ********************************
+;;; Encapsulate ********************
+;;; ********************************
+(eval-when (compile load eval)
+;; Returns a lambda expression for a function that, when called with the
+;; function name, will set up that function for metering.
+;;
+;; A function is monitored by replacing its definition with a closure
+;; created by the following function. The closure records the monitoring
+;; data, and updates the data with each call of the function.
+;;
+;; Other closures are used to read and reset the data.
+(defun make-monitoring-encapsulation (min-args optionals-p)
+ (let (required-args)
+ (dotimes (i min-args) (push (gensym) required-args))
+ `(lambda (name)
+ (let ((inclusive-time 0)
+ (inclusive-cons 0)
+ (exclusive-time 0)
+ (exclusive-cons 0)
+ (calls 0)
+ (nested-calls 0)
+ (old-definition (place-function name)))
+ (declare (type time-type inclusive-time)
+ (type time-type exclusive-time)
+ (type consing-type inclusive-cons)
+ (type consing-type exclusive-cons)
+ (fixnum calls)
+ (fixnum nested-calls))
+ (pushnew name *monitored-functions*)
+
+ (setf (place-function name)
+ #'(lambda (,@required-args
+ ,@(when optionals-p
+ `(&rest optional-args)))
+ (let ((prev-total-time *total-time*)
+ (prev-total-cons *total-cons*)
+ (prev-total-calls *total-calls*)
+ ;; (old-time inclusive-time)
+ ;; (old-cons inclusive-cons)
+ ;; (old-nested-calls nested-calls)
+ )
+ (declare (type time-type prev-total-time)
+ (type consing-type prev-total-cons)
+ (fixnum prev-total-calls))
+ (with-time/cons (delta-time delta-cons)
+ ;; form
+ ,(if optionals-p
+ `(apply old-definition
+ ,@required-args optional-args)
+ `(funcall old-definition ,@required-args))
+ ;; post-processing:
+ ;; Calls
+ (incf calls)
+ (incf *total-calls*)
+ ;; nested-calls includes this call
+ (incf nested-calls (the fixnum
+ (- *total-calls*
+ prev-total-calls)))
+ ;; (setf nested-calls (+ old-nested-calls
+ ;; (- *total-calls*
+ ;; prev-total-calls)))
+ ;; Time
+ ;; Problem with inclusive time is that it
+ ;; currently doesn't add values from recursive
+ ;; calls to the same function. Change the
+ ;; setf to an incf to fix this?
+ (incf inclusive-time (the time-type delta-time))
+ ;; (setf inclusive-time (+ delta-time old-time))
+ (incf exclusive-time (the time-type
+ (+ delta-time
+ (- prev-total-time
+ *total-time*))))
+ (setf *total-time* (the time-type
+ (+ delta-time
+ prev-total-time)))
+ ;; Consing
+ (incf inclusive-cons (the consing-type delta-cons))
+ ;; (setf inclusive-cons (+ delta-cons old-cons))
+ (incf exclusive-cons (the consing-type
+ (+ delta-cons
+ (- prev-total-cons
+ *total-cons*))))
+ (setf *total-cons*
+ (the consing-type
+ (+ delta-cons prev-total-cons)))))))
+ (setf (get-monitor-info name)
+ (make-metering-functions
+ :name name
+ :old-definition old-definition
+ :new-definition (place-function name)
+ :read-metering #'(lambda ()
+ (values inclusive-time
+ inclusive-cons
+ exclusive-time
+ exclusive-cons
+ calls
+ nested-calls))
+ :reset-metering #'(lambda ()
+ (setq inclusive-time 0
+ inclusive-cons 0
+ exclusive-time 0
+ exclusive-cons 0
+ calls 0
+ nested-calls 0)
+ t)))))))
+);; End of EVAL-WHEN
+
+;;; For efficiency reasons, we precompute the encapsulation functions
+;;; for a variety of combinations of argument structures
+;;; (min-args . optional-p). These are stored in the following hash table
+;;; along with any new ones we encounter. Since we're now precomputing
+;;; closure functions for common argument signatures, this eliminates
+;;; the former need to call COMPILE for each monitored function.
+(eval-when (compile eval)
+ (defconstant precomputed-encapsulations 8))
+
+(defvar *existing-encapsulations* (make-hash-table :test #'equal))
+(defun find-encapsulation (min-args optionals-p)
+ (or (gethash (cons min-args optionals-p) *existing-encapsulations*)
+ (setf (gethash (cons min-args optionals-p) *existing-encapsulations*)
+ (compile nil
+ (make-monitoring-encapsulation min-args optionals-p)))))
+
+(macrolet ((frob ()
+ (let ((res ()))
+ (dotimes (i precomputed-encapsulations)
+ (push `(setf (gethash '(,i . nil) *existing-encapsulations*)
+ #',(make-monitoring-encapsulation i nil))
+ res)
+ (push `(setf (gethash '(,i . t) *existing-encapsulations*)
+ #',(make-monitoring-encapsulation i t))
+ res))
+ `(progn ,@res))))
+ (frob))
+
+(defun monitoring-encapsulate (name &optional warn)
+ "Monitor the function Name. If already monitored, unmonitor first."
+ ;; Saves the current definition of name and inserts a new function which
+ ;; returns the result of evaluating body.
+ (cond ((not (place-fboundp name)) ; not a function
+ (when warn
+ (warn "Ignoring undefined function ~S." name)))
+ ((place-macrop name) ; a macro
+ (when warn
+ (warn "Ignoring macro ~S." name)))
+ (t ; tis a function
+ (when (get-monitor-info name) ; monitored
+ (when warn
+ (warn "~S already monitored, so unmonitoring it first." name))
+ (monitoring-unencapsulate name))
+ (multiple-value-bind (min-args optionals-p)
+ (required-arguments name)
+ (funcall (find-encapsulation min-args optionals-p) name)))))
+
+(defun monitoring-unencapsulate (name &optional warn)
+ "Removes monitoring encapsulation code from around Name."
+ (let ((finfo (get-monitor-info name)))
+ (when finfo ; monitored
+ (remprop name 'metering-functions)
+ (setq *monitored-functions*
+ (remove name *monitored-functions* :test #'equal))
+ (if (eq (place-function name)
+ (metering-functions-new-definition finfo))
+ (setf (place-function name)
+ (metering-functions-old-definition finfo))
+ (when warn
+ (warn "Preserving current definition of redefined function ~S."
+ name))))))
+
+;;; ********************************
+;;; Main Monitoring Functions ******
+;;; ********************************
+(defmacro MONITOR (&rest names)
+ "Monitor the named functions. As in TRACE, the names are not evaluated.
+ If a function is already monitored, then unmonitor and remonitor (useful
+ to notice function redefinition). If a name is undefined, give a warning
+ and ignore it. See also unmonitor, report-monitoring,
+ display-monitoring-results and reset-time."
+ `(progn
+ ,@(mapcar #'(lambda (name) `(monitoring-encapsulate ',name)) names)
+ *monitored-functions*))
+
+(defmacro UNMONITOR (&rest names)
+ "Remove the monitoring on the named functions.
+ Names defaults to the list of all currently monitored functions."
+ `(dolist (name ,(if names `',names '*monitored-functions*) (values))
+ (monitoring-unencapsulate name)))
+
+(defun MONITOR-ALL (&optional (package *package*))
+ "Monitor all functions in the specified package."
+ (let ((package (if (packagep package)
+ package
+ (find-package package))))
+ (do-symbols (symbol package)
+ (when (eq (symbol-package symbol) package)
+ (monitoring-encapsulate symbol)))))
+
+(defmacro MONITOR-FORM (form
+ &optional (nested :exclusive) (threshold 0.01)
+ (key :percent-time))
+ "Monitor the execution of all functions in the current package
+during the execution of FORM. All functions that are executed above
+THRESHOLD % will be reported."
+ `(unwind-protect
+ (progn
+ (monitor-all)
+ (reset-all-monitoring)
+ (prog1
+ (time ,form)
+ (report-monitoring :all ,nested ,threshold ,key :ignore-no-calls)))
+ (unmonitor)))
+
+(defmacro WITH-MONITORING ((&rest functions)
+ (&optional (nested :exclusive)
+ (threshold 0.01)
+ (key :percent-time))
+ &body body)
+ "Monitor the specified functions during the execution of the body."
+ `(unwind-protect
+ (progn
+ (dolist (fun ',functions)
+ (monitoring-encapsulate fun))
+ (reset-all-monitoring)
+ ,@body
+ (report-monitoring :all ,nested ,threshold ,key))
+ (unmonitor)))
+
+;;; ********************************
+;;; Overhead Calculations **********
+;;; ********************************
+(defconstant overhead-iterations 5000
+ "Number of iterations over which the timing overhead is averaged.")
+
+;;; Perhaps this should return something to frustrate clever compilers.
+(defun STUB-FUNCTION (x)
+ (declare (ignore x))
+ nil)
+(proclaim '(notinline stub-function))
+
+(defun SET-MONITOR-OVERHEAD ()
+ "Determines the average overhead of monitoring by monitoring the execution
+of an empty function many times."
+ (setq *monitor-time-overhead* 0
+ *monitor-cons-overhead* 0)
+ (stub-function nil)
+ (monitor stub-function)
+ (reset-all-monitoring)
+ (let ((overhead-function (symbol-function 'stub-function)))
+ (dotimes (x overhead-iterations)
+ (funcall overhead-function overhead-function)))
+; (dotimes (x overhead-iterations)
+; (stub-function nil))
+ (let ((fiter (float overhead-iterations)))
+ (multiple-value-bind (calls nested-calls time cons)
+ (monitor-info-values 'stub-function)
+ (declare (ignore calls nested-calls))
+ (setq *monitor-time-overhead* (/ time fiter)
+ *monitor-cons-overhead* (/ cons fiter))))
+ (unmonitor stub-function))
+(set-monitor-overhead)
+
+;;; ********************************
+;;; Report Data ********************
+;;; ********************************
+(defvar *monitor-results* nil
+ "A table of monitoring statistics is stored here.")
+(defvar *no-calls* nil
+ "A list of monitored functions which weren't called.")
+(defvar *estimated-total-overhead* 0)
+;; (proclaim '(type time-type *estimated-total-overhead*))
+
+(defstruct (monitoring-info
+ (:conc-name m-info-)
+ (:constructor make-monitoring-info
+ (name calls time cons
+ percent-time percent-cons
+ time-per-call cons-per-call)))
+ name
+ calls
+ time
+ cons
+ percent-time
+ percent-cons
+ time-per-call
+ cons-per-call)
+
+(defun REPORT (&key (names :all)
+ (nested :exclusive)
+ (threshold 0.01)
+ (sort-key :percent-time)
+ (ignore-no-calls nil))
+ "Same as REPORT-MONITORING but with a nicer keyword interface"
+ (declare (type (member :function :percent-time :time :percent-cons
+ :cons :calls :time-per-call :cons-per-call)
+ sort-key)
+ (type (member :inclusive :exclusive) nested))
+ (report-monitoring names nested threshold sort-key ignore-no-calls))
+
+(defun REPORT-MONITORING (&optional names
+ (nested :exclusive)
+ (threshold 0.01)
+ (key :percent-time)
+ ignore-no-calls)
+ "Report the current monitoring state.
+The percentage of the total time spent executing unmonitored code
+in each function (:exclusive mode), or total time (:inclusive mode)
+will be printed together with the number of calls and
+the unmonitored time per call. Functions that have been executed
+below THRESHOLD % of the time will not be reported. To report on all
+functions set NAMES to be either NIL or :ALL."
+ (when (or (null names) (eq names :all)) (setq names *monitored-functions*))
+
+ (let ((total-time 0)
+ (total-cons 0)
+ (total-calls 0))
+ ;; Compute overall time and consing.
+ (dolist (name names)
+ (multiple-value-bind (calls nested-calls time cons)
+ (monitor-info-values name nested :warn)
+ (declare (ignore nested-calls))
+ (incf total-calls calls)
+ (incf total-time time)
+ (incf total-cons cons)))
+ ;; Total overhead.
+ (setq *estimated-total-overhead*
+ (/ (* *monitor-time-overhead* total-calls)
+ time-units-per-second))
+ ;; Assemble data for only the specified names (all monitored functions)
+ (if (zerop total-time)
+ (format *trace-output* "Not enough execution time to monitor.")
+ (progn
+ (setq *monitor-results* nil *no-calls* nil)
+ (dolist (name names)
+ (multiple-value-bind (calls nested-calls time cons)
+ (monitor-info-values name nested)
+ (declare (ignore nested-calls))
+ (when (minusp time) (setq time 0.0))
+ (when (minusp cons) (setq cons 0.0))
+ (if (zerop calls)
+ (push (if (symbolp name)
+ (symbol-name name)
+ (format nil "~S" name))
+ *no-calls*)
+ (push (make-monitoring-info
+ (format nil "~S" name) ; name
+ calls ; calls
+ (/ time (float time-units-per-second)) ; time in secs
+ (round cons) ; consing
+ (/ time (float total-time)) ; percent-time
+ (if (zerop total-cons) 0
+ (/ cons (float total-cons))) ; percent-cons
+ (/ (/ time (float calls)) ; time-per-call
+ time-units-per-second) ; sec/call
+ (round (/ cons (float calls)))) ; cons-per-call
+ *monitor-results*))))
+ (display-monitoring-results threshold key ignore-no-calls)))))
+
+(defun display-monitoring-results (&optional (threshold 0.01)
+ (key :percent-time)
+ (ignore-no-calls t))
+ (let ((max-length 8) ; Function header size
+ (max-cons-length 8)
+ (total-time 0.0)
+ (total-consed 0)
+ (total-calls 0)
+ (total-percent-time 0)
+ (total-percent-cons 0))
+ (sort-results key)
+ (dolist (result *monitor-results*)
+ (when (or (zerop threshold)
+ (> (m-info-percent-time result) threshold))
+ (setq max-length
+ (max max-length
+ (length (m-info-name result))))
+ (setq max-cons-length
+ (max max-cons-length
+ (m-info-cons-per-call result)))))
+ (incf max-length 2)
+ (setf max-cons-length (+ 2 (ceiling (log max-cons-length 10))))
+ (format *trace-output*
+ "~%~%~
+ ~VT ~VA~
+ ~% ~VT % % ~VA ~
+Total Total~
+ ~%Function~VT Time Cons Calls Sec/Call ~VA ~
+Time Cons~
+ ~%~V,,,'-A"
+ max-length
+ max-cons-length "Cons"
+ max-length
+ max-cons-length "Per"
+ max-length
+ max-cons-length "Call"
+ (+ max-length 62 (max 0 (- max-cons-length 5))) "-")
+ (dolist (result *monitor-results*)
+ (when (or (zerop threshold)
+ (> (m-info-percent-time result) threshold))
+ (format *trace-output*
+ "~%~A:~VT~6,2F ~6,2F ~7D ~,6F ~VD ~8,3F ~10D"
+ (m-info-name result)
+ max-length
+ (* 100 (m-info-percent-time result))
+ (* 100 (m-info-percent-cons result))
+ (m-info-calls result)
+ (m-info-time-per-call result)
+ max-cons-length
+ (m-info-cons-per-call result)
+ (m-info-time result)
+ (m-info-cons result))
+ (incf total-time (m-info-time result))
+ (incf total-consed (m-info-cons result))
+ (incf total-calls (m-info-calls result))
+ (incf total-percent-time (m-info-percent-time result))
+ (incf total-percent-cons (m-info-percent-cons result))))
+ (format *trace-output*
+ "~%~V,,,'-A~
+ ~%TOTAL:~VT~6,2F ~6,2F ~7D ~9@T ~VA ~8,3F ~10D~
+ ~%Estimated monitoring overhead: ~5,2F seconds~
+ ~%Estimated total monitoring overhead: ~5,2F seconds"
+ (+ max-length 62 (max 0 (- max-cons-length 5))) "-"
+ max-length
+ (* 100 total-percent-time)
+ (* 100 total-percent-cons)
+ total-calls
+ max-cons-length " "
+ total-time total-consed
+ (/ (* *monitor-time-overhead* total-calls)
+ time-units-per-second)
+ *estimated-total-overhead*)
+ (when (and (not ignore-no-calls) *no-calls*)
+ (setq *no-calls* (sort *no-calls* #'string<))
+ (let ((num-no-calls (length *no-calls*)))
+ (if (> num-no-calls 20)
+ (format *trace-output*
+ "~%~@(~r~) monitored functions were not called. ~
+ ~%See the variable swank-monitor::*no-calls* for a list."
+ num-no-calls)
+ (format *trace-output*
+ "~%The following monitored functions were not called:~
+ ~%~{~<~%~:; ~A~>~}~%"
+ *no-calls*))))
+ (values)))
+
+(defun sort-results (&optional (key :percent-time))
+ (setq *monitor-results*
+ (case key
+ (:function (sort *monitor-results* #'string>
+ :key #'m-info-name))
+ ((:percent-time :time) (sort *monitor-results* #'>
+ :key #'m-info-time))
+ ((:percent-cons :cons) (sort *monitor-results* #'>
+ :key #'m-info-cons))
+ (:calls (sort *monitor-results* #'>
+ :key #'m-info-calls))
+ (:time-per-call (sort *monitor-results* #'>
+ :key #'m-info-time-per-call))
+ (:cons-per-call (sort *monitor-results* #'>
+ :key #'m-info-cons-per-call)))))
+
+;;; *END OF FILE*
+
+
diff --git a/vim/bundle/slimv/slime/nregex.lisp b/vim/bundle/slimv/slime/nregex.lisp
new file mode 100644
index 0000000..43586ef
--- /dev/null
+++ b/vim/bundle/slimv/slime/nregex.lisp
@@ -0,0 +1,523 @@
+;;;
+;;; This code was written by:
+;;;
+;;; Lawrence E. Freil <lef@freil.com>
+;;; National Science Center Foundation
+;;; Augusta, Georgia 30909
+;;;
+;;; This program was released into the public domain on 2005-08-31.
+;;; (See the slime-devel mailing list archive for details.)
+;;;
+;;; nregex.lisp - My 4/8/92 attempt at a Lisp based regular expression
+;;; parser.
+;;;
+;;; This regular expression parser operates by taking a
+;;; regular expression and breaking it down into a list
+;;; consisting of lisp expressions and flags. The list
+;;; of lisp expressions is then taken in turned into a
+;;; lambda expression that can be later applied to a
+;;; string argument for parsing.
+;;;;
+;;;; Modifications made 6 March 2001 By Chris Double (chris@double.co.nz)
+;;;; to get working with Corman Lisp 1.42, add package statement and export
+;;;; relevant functions.
+;;;;
+
+(in-package :cl-user)
+
+;; Renamed to slime-nregex avoid name clashes with other versions of
+;; this file. -- he
+
+;;;; CND - 6/3/2001
+(defpackage slime-nregex
+ (:use #:common-lisp)
+ (:export
+ #:regex
+ #:regex-compile
+ ))
+
+;;;; CND - 6/3/2001
+(in-package :slime-nregex)
+
+;;;
+;;; First we create a copy of macros to help debug the beast
+(eval-when (:compile-toplevel :load-toplevel :execute)
+(defvar *regex-debug* nil) ; Set to nil for no debugging code
+)
+
+(defmacro info (message &rest args)
+ (if *regex-debug*
+ `(format *standard-output* ,message ,@args)))
+
+;;;
+;;; Declare the global variables for storing the paren index list.
+;;;
+(defvar *regex-groups* (make-array 10))
+(defvar *regex-groupings* 0)
+
+;;;
+;;; Declare a simple interface for testing. You probably wouldn't want
+;;; to use this interface unless you were just calling this once.
+;;;
+(defun regex (expression string)
+ "Usage: (regex <expression> <string)
+ This function will call regex-compile on the expression and then apply
+ the string to the returned lambda list."
+ (let ((findit (cond ((stringp expression)
+ (regex-compile expression))
+ ((listp expression)
+ expression)))
+ (result nil))
+ (if (not (funcall (if (functionp findit)
+ findit
+ (eval `(function ,findit))) string))
+ (return-from regex nil))
+ (if (= *regex-groupings* 0)
+ (return-from regex t))
+ (dotimes (i *regex-groupings*)
+ (push (funcall 'subseq
+ string
+ (car (aref *regex-groups* i))
+ (cadr (aref *regex-groups* i)))
+ result))
+ (reverse result)))
+
+;;;
+;;; Declare some simple macros to make the code more readable.
+;;;
+(defvar *regex-special-chars* "?*+.()[]\\${}")
+
+(defmacro add-exp (list)
+ "Add an item to the end of expression"
+ `(setf expression (append expression ,list)))
+
+;;;
+;;; Define a function that will take a quoted character and return
+;;; what the real character should be plus how much of the source
+;;; string was used. If the result is a set of characters, return an
+;;; array of bits indicating which characters should be set. If the
+;;; expression is one of the sub-group matches return a
+;;; list-expression that will provide the match.
+;;;
+(defun regex-quoted (char-string &optional (invert nil))
+ "Usage: (regex-quoted <char-string> &optional invert)
+ Returns either the quoted character or a simple bit vector of bits set for
+ the matching values"
+ (let ((first (char char-string 0))
+ (result (char char-string 0))
+ (used-length 1))
+ (cond ((eql first #\n)
+ (setf result #\NewLine))
+ ((eql first #\c)
+ (setf result #\Return))
+ ((eql first #\t)
+ (setf result #\Tab))
+ ((eql first #\d)
+ (setf result #*0000000000000000000000000000000000000000000000001111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000))
+ ((eql first #\D)
+ (setf result #*1111111111111111111111111111111111111111111111110000000000111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
+ ((eql first #\w)
+ (setf result #*0000000000000000000000000000000000000000000000001111111111000000011111111111111111111111111000010111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000))
+ ((eql first #\W)
+ (setf result #*1111111111111111111111111111111111111111111111110000000000111111100000000000000000000000000111101000000000000000000000000001111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
+ ((eql first #\b)
+ (setf result #*0000000001000000000000000000000011000000000010100000000000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000))
+ ((eql first #\B)
+ (setf result #*1111111110111111111111111111111100111111111101011111111111011111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
+ ((eql first #\s)
+ (setf result #*0000000001100000000000000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000))
+ ((eql first #\S)
+ (setf result #*1111111110011111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
+ ((and (>= (char-code first) (char-code #\0))
+ (<= (char-code first) (char-code #\9)))
+ (if (and (> (length char-string) 2)
+ (and (>= (char-code (char char-string 1)) (char-code #\0))
+ (<= (char-code (char char-string 1)) (char-code #\9))
+ (>= (char-code (char char-string 2)) (char-code #\0))
+ (<= (char-code (char char-string 2)) (char-code #\9))))
+ ;;
+ ;; It is a single character specified in octal
+ ;;
+ (progn
+ (setf result (do ((x 0 (1+ x))
+ (return 0))
+ ((= x 2) return)
+ (setf return (+ (* return 8)
+ (- (char-code (char char-string x))
+ (char-code #\0))))))
+ (setf used-length 3))
+ ;;
+ ;; We have a group number replacement.
+ ;;
+ (let ((group (- (char-code first) (char-code #\0))))
+ (setf result `((let ((nstring (subseq string (car (aref *regex-groups* ,group))
+ (cadr (aref *regex-groups* ,group)))))
+ (if (< length (+ index (length nstring)))
+ (return-from compare nil))
+ (if (not (string= string nstring
+ :start1 index
+ :end1 (+ index (length nstring))))
+ (return-from compare nil)
+ (incf index (length nstring)))))))))
+ (t
+ (setf result first)))
+ (if (and (vectorp result) invert)
+ (bit-xor result #*1111111110011111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 t))
+ (values result used-length)))
+
+;;;
+;;; Now for the main regex compiler routine.
+;;;
+(defun regex-compile (source &key (anchored nil))
+ "Usage: (regex-compile <expression> [ :anchored (t/nil) ])
+ This function take a regular expression (supplied as source) and
+ compiles this into a lambda list that a string argument can then
+ be applied to. It is also possible to compile this lambda list
+ for better performance or to save it as a named function for later
+ use"
+ (info "Now entering regex-compile with \"~A\"~%" source)
+ ;;
+ ;; This routine works in two parts.
+ ;; The first pass take the regular expression and produces a list of
+ ;; operators and lisp expressions for the entire regular expression.
+ ;; The second pass takes this list and produces the lambda expression.
+ (let ((expression '()) ; holder for expressions
+ (group 1) ; Current group index
+ (group-stack nil) ; Stack of current group endings
+ (result nil) ; holder for built expression.
+ (fast-first nil)) ; holder for quick unanchored scan
+ ;;
+ ;; If the expression was an empty string then it alway
+ ;; matches (so lets leave early)
+ ;;
+ (if (= (length source) 0)
+ (return-from regex-compile
+ '(lambda (&rest args)
+ (declare (ignore args))
+ t)))
+ ;;
+ ;; If the first character is a caret then set the anchored
+ ;; flags and remove if from the expression string.
+ ;;
+ (cond ((eql (char source 0) #\^)
+ (setf source (subseq source 1))
+ (setf anchored t)))
+ ;;
+ ;; If the first sequence is .* then also set the anchored flags.
+ ;; (This is purely for optimization, it will work without this).
+ ;;
+ (if (>= (length source) 2)
+ (if (string= source ".*" :start1 0 :end1 2)
+ (setf anchored t)))
+ ;;
+ ;; Also, If this is not an anchored search and the first character is
+ ;; a literal, then do a quick scan to see if it is even in the string.
+ ;; If not then we can issue a quick nil,
+ ;; otherwise we can start the search at the matching character to skip
+ ;; the checks of the non-matching characters anyway.
+ ;;
+ ;; If I really wanted to speed up this section of code it would be
+ ;; easy to recognize the case of a fairly long multi-character literal
+ ;; and generate a Boyer-Moore search for the entire literal.
+ ;;
+ ;; I generate the code to do a loop because on CMU Lisp this is about
+ ;; twice as fast a calling position.
+ ;;
+ (if (and (not anchored)
+ (not (position (char source 0) *regex-special-chars*))
+ (not (and (> (length source) 1)
+ (position (char source 1) *regex-special-chars*))))
+ (setf fast-first `((if (not (dotimes (i length nil)
+ (if (eql (char string i)
+ ,(char source 0))
+ (return (setf start i)))))
+ (return-from final-return nil)))))
+ ;;
+ ;; Generate the very first expression to save the starting index
+ ;; so that group 0 will be the entire string matched always
+ ;;
+ (add-exp '((setf (aref *regex-groups* 0)
+ (list index nil))))
+ ;;
+ ;; Loop over each character in the regular expression building the
+ ;; expression list as we go.
+ ;;
+ (do ((eindex 0 (1+ eindex)))
+ ((= eindex (length source)))
+ (let ((current (char source eindex)))
+ (info "Now processing character ~A index = ~A~%" current eindex)
+ (case current
+ ((#\.)
+ ;;
+ ;; Generate code for a single wild character
+ ;;
+ (add-exp '((if (>= index length)
+ (return-from compare nil)
+ (incf index)))))
+ ((#\$)
+ ;;
+ ;; If this is the last character of the expression then
+ ;; anchor the end of the expression, otherwise let it slide
+ ;; as a standard character (even though it should be quoted).
+ ;;
+ (if (= eindex (1- (length source)))
+ (add-exp '((if (not (= index length))
+ (return-from compare nil))))
+ (add-exp '((if (not (and (< index length)
+ (eql (char string index) #\$)))
+ (return-from compare nil)
+ (incf index))))))
+ ((#\*)
+ (add-exp '(ASTRISK)))
+
+ ((#\+)
+ (add-exp '(PLUS)))
+
+ ((#\?)
+ (add-exp '(QUESTION)))
+
+ ((#\()
+ ;;
+ ;; Start a grouping.
+ ;;
+ (incf group)
+ (push group group-stack)
+ (add-exp `((setf (aref *regex-groups* ,(1- group))
+ (list index nil))))
+ (add-exp `(,group)))
+ ((#\))
+ ;;
+ ;; End a grouping
+ ;;
+ (let ((group (pop group-stack)))
+ (add-exp `((setf (cadr (aref *regex-groups* ,(1- group)))
+ index)))
+ (add-exp `(,(- group)))))
+ ((#\[)
+ ;;
+ ;; Start of a range operation.
+ ;; Generate a bit-vector that has one bit per possible character
+ ;; and then on each character or range, set the possible bits.
+ ;;
+ ;; If the first character is carat then invert the set.
+ (let* ((invert (eql (char source (1+ eindex)) #\^))
+ (bitstring (make-array 256 :element-type 'bit
+ :initial-element
+ (if invert 1 0)))
+ (set-char (if invert 0 1)))
+ (if invert (incf eindex))
+ (do ((x (1+ eindex) (1+ x)))
+ ((eql (char source x) #\]) (setf eindex x))
+ (info "Building range with character ~A~%" (char source x))
+ (cond ((and (eql (char source (1+ x)) #\-)
+ (not (eql (char source (+ x 2)) #\])))
+ (if (>= (char-code (char source x))
+ (char-code (char source (+ 2 x))))
+ (error "Invalid range \"~A-~A\". Ranges must be in acending order"
+ (char source x) (char source (+ 2 x))))
+ (do ((j (char-code (char source x)) (1+ j)))
+ ((> j (char-code (char source (+ 2 x))))
+ (incf x 2))
+ (info "Setting bit for char ~A code ~A~%" (code-char j) j)
+ (setf (sbit bitstring j) set-char)))
+ (t
+ (cond ((not (eql (char source x) #\]))
+ (let ((char (char source x)))
+ ;;
+ ;; If the character is quoted then find out what
+ ;; it should have been
+ ;;
+ (if (eql (char source x) #\\ )
+ (let ((length))
+ (multiple-value-setq (char length)
+ (regex-quoted (subseq source x) invert))
+ (incf x length)))
+ (info "Setting bit for char ~A code ~A~%" char (char-code char))
+ (if (not (vectorp char))
+ (setf (sbit bitstring (char-code (char source x))) set-char)
+ (bit-ior bitstring char t))))))))
+ (add-exp `((let ((range ,bitstring))
+ (if (>= index length)
+ (return-from compare nil))
+ (if (= 1 (sbit range (char-code (char string index))))
+ (incf index)
+ (return-from compare nil)))))))
+ ((#\\ )
+ ;;
+ ;; Intreprete the next character as a special, range, octal, group or
+ ;; just the character itself.
+ ;;
+ (let ((length)
+ (value))
+ (multiple-value-setq (value length)
+ (regex-quoted (subseq source (1+ eindex)) nil))
+ (cond ((listp value)
+ (add-exp value))
+ ((characterp value)
+ (add-exp `((if (not (and (< index length)
+ (eql (char string index)
+ ,value)))
+ (return-from compare nil)
+ (incf index)))))
+ ((vectorp value)
+ (add-exp `((let ((range ,value))
+ (if (>= index length)
+ (return-from compare nil))
+ (if (= 1 (sbit range (char-code (char string index))))
+ (incf index)
+ (return-from compare nil)))))))
+ (incf eindex length)))
+ (t
+ ;;
+ ;; We have a literal character.
+ ;; Scan to see how many we have and if it is more than one
+ ;; generate a string= verses as single eql.
+ ;;
+ (let* ((lit "")
+ (term (dotimes (litindex (- (length source) eindex) nil)
+ (let ((litchar (char source (+ eindex litindex))))
+ (if (position litchar *regex-special-chars*)
+ (return litchar)
+ (progn
+ (info "Now adding ~A index ~A to lit~%" litchar
+ litindex)
+ (setf lit (concatenate 'string lit
+ (string litchar)))))))))
+ (if (= (length lit) 1)
+ (add-exp `((if (not (and (< index length)
+ (eql (char string index) ,current)))
+ (return-from compare nil)
+ (incf index))))
+ ;;
+ ;; If we have a multi-character literal then we must
+ ;; check to see if the next character (if there is one)
+ ;; is an astrisk or a plus or a question mark. If so then we must not use this
+ ;; character in the big literal.
+ (progn
+ (if (or (eql term #\*)
+ (eql term #\+)
+ (eql term #\?))
+ (setf lit (subseq lit 0 (1- (length lit)))))
+ (add-exp `((if (< length (+ index ,(length lit)))
+ (return-from compare nil))
+ (if (not (string= string ,lit :start1 index
+ :end1 (+ index ,(length lit))))
+ (return-from compare nil)
+ (incf index ,(length lit)))))))
+ (incf eindex (1- (length lit))))))))
+ ;;
+ ;; Plug end of list to return t. If we made it this far then
+ ;; We have matched!
+ (add-exp '((setf (cadr (aref *regex-groups* 0))
+ index)))
+ (add-exp '((return-from final-return t)))
+ ;;
+;;; (print expression)
+ ;;
+ ;; Now take the expression list and turn it into a lambda expression
+ ;; replacing the special flags with lisp code.
+ ;; For example: A BEGIN needs to be replace by an expression that
+ ;; saves the current index, then evaluates everything till it gets to
+ ;; the END then save the new index if it didn't fail.
+ ;; On an ASTRISK I need to take the previous expression and wrap
+ ;; it in a do that will evaluate the expression till an error
+ ;; occurs and then another do that encompases the remainder of the
+ ;; regular expression and iterates decrementing the index by one
+ ;; of the matched expression sizes and then returns nil. After
+ ;; the last expression insert a form that does a return t so that
+ ;; if the entire nested sub-expression succeeds then the loop
+ ;; is broken manually.
+ ;;
+ (setf result (copy-tree nil))
+ ;;
+ ;; Reversing the current expression makes building up the
+ ;; lambda list easier due to the nexting of expressions when
+ ;; and astrisk has been encountered.
+ (setf expression (reverse expression))
+ (do ((elt 0 (1+ elt)))
+ ((>= elt (length expression)))
+ (let ((piece (nth elt expression)))
+ ;;
+ ;; Now check for PLUS, if so then ditto the expression and then let the
+ ;; ASTRISK below handle the rest.
+ ;;
+ (cond ((eql piece 'PLUS)
+ (cond ((listp (nth (1+ elt) expression))
+ (setf result (append (list (nth (1+ elt) expression))
+ result)))
+ ;;
+ ;; duplicate the entire group
+ ;; NOTE: This hasn't been implemented yet!!
+ (t
+ (error "GROUP repeat hasn't been implemented yet~%")))))
+ (cond ((listp piece) ;Just append the list
+ (setf result (append (list piece) result)))
+ ((eql piece 'QUESTION) ; Wrap it in a block that won't fail
+ (cond ((listp (nth (1+ elt) expression))
+ (setf result
+ (append `((progn (block compare
+ ,(nth (1+ elt)
+ expression))
+ t))
+ result))
+ (incf elt))
+ ;;
+ ;; This is a QUESTION on an entire group which
+ ;; hasn't been implemented yet!!!
+ ;;
+ (t
+ (error "Optional groups not implemented yet~%"))))
+ ((or (eql piece 'ASTRISK) ; Do the wild thing!
+ (eql piece 'PLUS))
+ (cond ((listp (nth (1+ elt) expression))
+ ;;
+ ;; This is a single character wild card so
+ ;; do the simple form.
+ ;;
+ (setf result
+ `((let ((oindex index))
+ (block compare
+ (do ()
+ (nil)
+ ,(nth (1+ elt) expression)))
+ (do ((start index (1- start)))
+ ((< start oindex) nil)
+ (let ((index start))
+ (block compare
+ ,@result))))))
+ (incf elt))
+ (t
+ ;;
+ ;; This is a subgroup repeated so I must build
+ ;; the loop using several values.
+ ;;
+ ))
+ )
+ (t t)))) ; Just ignore everything else.
+ ;;
+ ;; Now wrap the result in a lambda list that can then be
+ ;; invoked or compiled, however the user wishes.
+ ;;
+ (if anchored
+ (setf result
+ `(lambda (string &key (start 0) (end (length string)))
+ (setf *regex-groupings* ,group)
+ (block final-return
+ (block compare
+ (let ((index start)
+ (length end))
+ ,@result)))))
+ (setf result
+ `(lambda (string &key (start 0) (end (length string)))
+ (setf *regex-groupings* ,group)
+ (block final-return
+ (let ((length end))
+ ,@fast-first
+ (do ((marker start (1+ marker)))
+ ((> marker end) nil)
+ (let ((index marker))
+ (if (block compare
+ ,@result)
+ (return t)))))))))))
+
+;; (provide 'nregex)
diff --git a/vim/bundle/slimv/slime/packages.lisp b/vim/bundle/slimv/slime/packages.lisp
new file mode 100644
index 0000000..df7b929
--- /dev/null
+++ b/vim/bundle/slimv/slime/packages.lisp
@@ -0,0 +1,194 @@
+(defpackage swank/backend
+ (:use cl)
+ (:nicknames swank-backend)
+ (:export *debug-swank-backend*
+ *log-output*
+ sldb-condition
+ compiler-condition
+ original-condition
+ message
+ source-context
+ condition
+ severity
+ with-compilation-hooks
+ make-location
+ location
+ location-p
+ location-buffer
+ location-position
+ location-hints
+ position-p
+ position-pos
+ print-output-to-string
+ quit-lisp
+ references
+ unbound-slot-filler
+ declaration-arglist
+ type-specifier-arglist
+ with-struct
+ when-let
+ defimplementation
+ converting-errors-to-error-location
+ make-error-location
+ deinit-log-output
+ ;; interrupt macro for the backend
+ *pending-slime-interrupts*
+ check-slime-interrupts
+ *interrupt-queued-handler*
+ ;; inspector related symbols
+ emacs-inspect
+ label-value-line
+ label-value-line*
+ boolean-to-feature-expression
+ with-symbol
+ choose-symbol
+ ;; package helper for backend
+ import-to-swank-mop
+ import-swank-mop-symbols
+ ;;
+ default-directory
+ set-default-directory
+ frame-source-location
+ restart-frame
+ gdb-initial-commands
+ sldb-break-on-return
+ buffer-first-change
+
+ profiled-functions
+ unprofile-all
+ profile-report
+ profile-reset
+ profile-package
+
+ with-collected-macro-forms))
+
+(defpackage swank/rpc
+ (:use :cl)
+ (:export
+ read-message
+ swank-reader-error
+ swank-reader-error.packet
+ swank-reader-error.cause
+ write-message))
+
+(defpackage swank/match
+ (:use cl)
+ (:export match))
+
+;; FIXME: rename to sawnk/mop
+(defpackage swank-mop
+ (:use)
+ (:export
+ ;; classes
+ standard-generic-function
+ standard-slot-definition
+ standard-method
+ standard-class
+ eql-specializer
+ eql-specializer-object
+ ;; standard-class readers
+ class-default-initargs
+ class-direct-default-initargs
+ class-direct-slots
+ class-direct-subclasses
+ class-direct-superclasses
+ class-finalized-p
+ class-name
+ class-precedence-list
+ class-prototype
+ class-slots
+ specializer-direct-methods
+ ;; generic function readers
+ generic-function-argument-precedence-order
+ generic-function-declarations
+ generic-function-lambda-list
+ generic-function-methods
+ generic-function-method-class
+ generic-function-method-combination
+ generic-function-name
+ ;; method readers
+ method-generic-function
+ method-function
+ method-lambda-list
+ method-specializers
+ method-qualifiers
+ ;; slot readers
+ slot-definition-allocation
+ slot-definition-documentation
+ slot-definition-initargs
+ slot-definition-initform
+ slot-definition-initfunction
+ slot-definition-name
+ slot-definition-type
+ slot-definition-readers
+ slot-definition-writers
+ slot-boundp-using-class
+ slot-value-using-class
+ slot-makunbound-using-class
+ ;; generic function protocol
+ compute-applicable-methods-using-classes
+ finalize-inheritance))
+
+(defpackage swank
+ (:use cl swank/backend swank/match swank/rpc)
+ (:export #:startup-multiprocessing
+ #:start-server
+ #:create-server
+ #:stop-server
+ #:restart-server
+ #:ed-in-emacs
+ #:inspect-in-emacs
+ #:print-indentation-lossage
+ #:invoke-slime-debugger
+ #:swank-debugger-hook
+ #:emacs-inspect
+ ;;#:inspect-slot-for-emacs
+ ;; These are user-configurable variables:
+ #:*communication-style*
+ #:*dont-close*
+ #:*fasl-pathname-function*
+ #:*log-events*
+ #:*use-dedicated-output-stream*
+ #:*dedicated-output-stream-port*
+ #:*configure-emacs-indentation*
+ #:*readtable-alist*
+ #:*globally-redirect-io*
+ #:*global-debugger*
+ #:*sldb-quit-restart*
+ #:*backtrace-printer-bindings*
+ #:*default-worker-thread-bindings*
+ #:*macroexpand-printer-bindings*
+ #:*swank-pprint-bindings*
+ #:*record-repl-results*
+ #:*inspector-verbose*
+ ;; This is SETFable.
+ #:debug-on-swank-error
+ ;; These are re-exported directly from the backend:
+ #:buffer-first-change
+ #:frame-source-location
+ #:gdb-initial-commands
+ #:restart-frame
+ #:sldb-step
+ #:sldb-break
+ #:sldb-break-on-return
+ #:profiled-functions
+ #:profile-report
+ #:profile-reset
+ #:unprofile-all
+ #:profile-package
+ #:default-directory
+ #:set-default-directory
+ #:quit-lisp
+ #:eval-for-emacs
+ #:eval-in-emacs
+ #:y-or-n-p-in-emacs
+ #:*find-definitions-right-trim*
+ #:*find-definitions-left-trim*
+ #:*after-toggle-trace-hook*
+ #:unredable-result
+ #:unredable-result-p
+ #:unredable-result-string
+ #:parse-string
+ #:from-string
+ #:to-string
+ #:*swank-debugger-condition*))
diff --git a/vim/bundle/slimv/slime/sbcl-pprint-patch.lisp b/vim/bundle/slimv/slime/sbcl-pprint-patch.lisp
new file mode 100644
index 0000000..dfdc0bb
--- /dev/null
+++ b/vim/bundle/slimv/slime/sbcl-pprint-patch.lisp
@@ -0,0 +1,332 @@
+;; Pretty printer patch for SBCL, which adds the "annotations" feature
+;; required for sending presentations through pretty-printing streams.
+;;
+;; The section marked "Changed functions" and the DEFSTRUCT
+;; PRETTY-STREAM are based on SBCL's pprint.lisp.
+;;
+;; Public domain.
+
+(in-package "SB!PRETTY")
+
+(defstruct (annotation (:include queued-op))
+ (handler (constantly nil) :type function)
+ (record))
+
+
+(defstruct (pretty-stream (:include sb!kernel:ansi-stream
+ (out #'pretty-out)
+ (sout #'pretty-sout)
+ (misc #'pretty-misc))
+ (:constructor make-pretty-stream (target))
+ (:copier nil))
+ ;; Where the output is going to finally go.
+ (target (missing-arg) :type stream)
+ ;; Line length we should format to. Cached here so we don't have to keep
+ ;; extracting it from the target stream.
+ (line-length (or *print-right-margin*
+ (sb!impl::line-length target)
+ default-line-length)
+ :type column)
+ ;; A simple string holding all the text that has been output but not yet
+ ;; printed.
+ (buffer (make-string initial-buffer-size) :type (simple-array character (*)))
+ ;; The index into BUFFER where more text should be put.
+ (buffer-fill-pointer 0 :type index)
+ ;; Whenever we output stuff from the buffer, we shift the remaining noise
+ ;; over. This makes it difficult to keep references to locations in
+ ;; the buffer. Therefore, we have to keep track of the total amount of
+ ;; stuff that has been shifted out of the buffer.
+ (buffer-offset 0 :type posn)
+ ;; The column the first character in the buffer will appear in. Normally
+ ;; zero, but if we end up with a very long line with no breaks in it we
+ ;; might have to output part of it. Then this will no longer be zero.
+ (buffer-start-column (or (sb!impl::charpos target) 0) :type column)
+ ;; The line number we are currently on. Used for *PRINT-LINES*
+ ;; abbreviations and to tell when sections have been split across
+ ;; multiple lines.
+ (line-number 0 :type index)
+ ;; the value of *PRINT-LINES* captured at object creation time. We
+ ;; use this, instead of the dynamic *PRINT-LINES*, to avoid
+ ;; weirdness like
+ ;; (let ((*print-lines* 50))
+ ;; (pprint-logical-block ..
+ ;; (dotimes (i 10)
+ ;; (let ((*print-lines* 8))
+ ;; (print (aref possiblybigthings i) prettystream)))))
+ ;; terminating the output of the entire logical blockafter 8 lines.
+ (print-lines *print-lines* :type (or index null) :read-only t)
+ ;; Stack of logical blocks in effect at the buffer start.
+ (blocks (list (make-logical-block)) :type list)
+ ;; Buffer holding the per-line prefix active at the buffer start.
+ ;; Indentation is included in this. The length of this is stored
+ ;; in the logical block stack.
+ (prefix (make-string initial-buffer-size) :type (simple-array character (*)))
+ ;; Buffer holding the total remaining suffix active at the buffer start.
+ ;; The characters are right-justified in the buffer to make it easier
+ ;; to output the buffer. The length is stored in the logical block
+ ;; stack.
+ (suffix (make-string initial-buffer-size) :type (simple-array character (*)))
+ ;; Queue of pending operations. When empty, HEAD=TAIL=NIL. Otherwise,
+ ;; TAIL holds the first (oldest) cons and HEAD holds the last (newest)
+ ;; cons. Adding things to the queue is basically (setf (cdr head) (list
+ ;; new)) and removing them is basically (pop tail) [except that care must
+ ;; be taken to handle the empty queue case correctly.]
+ (queue-tail nil :type list)
+ (queue-head nil :type list)
+ ;; Block-start queue entries in effect at the queue head.
+ (pending-blocks nil :type list)
+ ;; Queue of annotations to the buffer
+ (annotations-tail nil :type list)
+ (annotations-head nil :type list))
+
+
+(defmacro enqueue (stream type &rest args)
+ (let ((constructor (intern (concatenate 'string
+ "MAKE-"
+ (symbol-name type))
+ "SB-PRETTY")))
+ (once-only ((stream stream)
+ (entry `(,constructor :posn
+ (index-posn
+ (pretty-stream-buffer-fill-pointer
+ ,stream)
+ ,stream)
+ ,@args))
+ (op `(list ,entry))
+ (head `(pretty-stream-queue-head ,stream)))
+ `(progn
+ (if ,head
+ (setf (cdr ,head) ,op)
+ (setf (pretty-stream-queue-tail ,stream) ,op))
+ (setf (pretty-stream-queue-head ,stream) ,op)
+ ,entry))))
+
+;;;
+;;; New helper functions
+;;;
+
+(defun enqueue-annotation (stream handler record)
+ (enqueue stream annotation :handler handler
+ :record record))
+
+(defun re-enqueue-annotation (stream annotation)
+ (let* ((annotation-cons (list annotation))
+ (head (pretty-stream-annotations-head stream)))
+ (if head
+ (setf (cdr head) annotation-cons)
+ (setf (pretty-stream-annotations-tail stream) annotation-cons))
+ (setf (pretty-stream-annotations-head stream) annotation-cons)
+ nil))
+
+(defun re-enqueue-annotations (stream end)
+ (loop for tail = (pretty-stream-queue-tail stream) then (cdr tail)
+ while (and tail (not (eql (car tail) end)))
+ when (annotation-p (car tail))
+ do (re-enqueue-annotation stream (car tail))))
+
+(defun dequeue-annotation (stream &key end-posn)
+ (let ((next-annotation (car (pretty-stream-annotations-tail stream))))
+ (when next-annotation
+ (when (or (not end-posn)
+ (<= (annotation-posn next-annotation) end-posn))
+ (pop (pretty-stream-annotations-tail stream))
+ (unless (pretty-stream-annotations-tail stream)
+ (setf (pretty-stream-annotations-head stream) nil))
+ next-annotation))))
+
+(defun invoke-annotation (stream annotation truncatep)
+ (let ((target (pretty-stream-target stream)))
+ (funcall (annotation-handler annotation)
+ (annotation-record annotation)
+ target
+ truncatep)))
+
+(defun output-buffer-with-annotations (stream end)
+ (let ((target (pretty-stream-target stream))
+ (buffer (pretty-stream-buffer stream))
+ (end-posn (index-posn end stream))
+ (start 0))
+ (loop
+ for annotation = (dequeue-annotation stream :end-posn end-posn)
+ while annotation
+ do
+ (let ((annotation-index (posn-index (annotation-posn annotation)
+ stream)))
+ (when (> annotation-index start)
+ (write-string buffer target :start start
+ :end annotation-index)
+ (setf start annotation-index))
+ (invoke-annotation stream annotation nil)))
+ (when (> end start)
+ (write-string buffer target :start start :end end))))
+
+(defun flush-annotations (stream end truncatep)
+ (let ((end-posn (index-posn end stream)))
+ (loop
+ for annotation = (dequeue-annotation stream :end-posn end-posn)
+ while annotation
+ do (invoke-annotation stream annotation truncatep))))
+
+;;;
+;;; Changed functions
+;;;
+
+(defun maybe-output (stream force-newlines-p)
+ (declare (type pretty-stream stream))
+ (let ((tail (pretty-stream-queue-tail stream))
+ (output-anything nil))
+ (loop
+ (unless tail
+ (setf (pretty-stream-queue-head stream) nil)
+ (return))
+ (let ((next (pop tail)))
+ (etypecase next
+ (newline
+ (when (ecase (newline-kind next)
+ ((:literal :mandatory :linear) t)
+ (:miser (misering-p stream))
+ (:fill
+ (or (misering-p stream)
+ (> (pretty-stream-line-number stream)
+ (logical-block-section-start-line
+ (first (pretty-stream-blocks stream))))
+ (ecase (fits-on-line-p stream
+ (newline-section-end next)
+ force-newlines-p)
+ ((t) nil)
+ ((nil) t)
+ (:dont-know
+ (return))))))
+ (setf output-anything t)
+ (output-line stream next)))
+ (indentation
+ (unless (misering-p stream)
+ (set-indentation stream
+ (+ (ecase (indentation-kind next)
+ (:block
+ (logical-block-start-column
+ (car (pretty-stream-blocks stream))))
+ (:current
+ (posn-column
+ (indentation-posn next)
+ stream)))
+ (indentation-amount next)))))
+ (block-start
+ (ecase (fits-on-line-p stream (block-start-section-end next)
+ force-newlines-p)
+ ((t)
+ ;; Just nuke the whole logical block and make it look like one
+ ;; nice long literal. (But don't nuke annotations.)
+ (let ((end (block-start-block-end next)))
+ (expand-tabs stream end)
+ (re-enqueue-annotations stream end)
+ (setf tail (cdr (member end tail)))))
+ ((nil)
+ (really-start-logical-block
+ stream
+ (posn-column (block-start-posn next) stream)
+ (block-start-prefix next)
+ (block-start-suffix next)))
+ (:dont-know
+ (return))))
+ (block-end
+ (really-end-logical-block stream))
+ (tab
+ (expand-tabs stream next))
+ (annotation
+ (re-enqueue-annotation stream next))))
+ (setf (pretty-stream-queue-tail stream) tail))
+ output-anything))
+
+(defun output-line (stream until)
+ (declare (type pretty-stream stream)
+ (type newline until))
+ (let* ((target (pretty-stream-target stream))
+ (buffer (pretty-stream-buffer stream))
+ (kind (newline-kind until))
+ (literal-p (eq kind :literal))
+ (amount-to-consume (posn-index (newline-posn until) stream))
+ (amount-to-print
+ (if literal-p
+ amount-to-consume
+ (let ((last-non-blank
+ (position #\space buffer :end amount-to-consume
+ :from-end t :test #'char/=)))
+ (if last-non-blank
+ (1+ last-non-blank)
+ 0)))))
+ (output-buffer-with-annotations stream amount-to-print)
+ (flush-annotations stream amount-to-consume nil)
+ (let ((line-number (pretty-stream-line-number stream)))
+ (incf line-number)
+ (when (and (not *print-readably*)
+ (pretty-stream-print-lines stream)
+ (>= line-number (pretty-stream-print-lines stream)))
+ (write-string " .." target)
+ (flush-annotations stream
+ (pretty-stream-buffer-fill-pointer stream)
+ t)
+ (let ((suffix-length (logical-block-suffix-length
+ (car (pretty-stream-blocks stream)))))
+ (unless (zerop suffix-length)
+ (let* ((suffix (pretty-stream-suffix stream))
+ (len (length suffix)))
+ (write-string suffix target
+ :start (- len suffix-length)
+ :end len))))
+ (throw 'line-limit-abbreviation-happened t))
+ (setf (pretty-stream-line-number stream) line-number)
+ (write-char #\newline target)
+ (setf (pretty-stream-buffer-start-column stream) 0)
+ (let* ((fill-ptr (pretty-stream-buffer-fill-pointer stream))
+ (block (first (pretty-stream-blocks stream)))
+ (prefix-len
+ (if literal-p
+ (logical-block-per-line-prefix-end block)
+ (logical-block-prefix-length block)))
+ (shift (- amount-to-consume prefix-len))
+ (new-fill-ptr (- fill-ptr shift))
+ (new-buffer buffer)
+ (buffer-length (length buffer)))
+ (when (> new-fill-ptr buffer-length)
+ (setf new-buffer
+ (make-string (max (* buffer-length 2)
+ (+ buffer-length
+ (floor (* (- new-fill-ptr buffer-length)
+ 5)
+ 4)))))
+ (setf (pretty-stream-buffer stream) new-buffer))
+ (replace new-buffer buffer
+ :start1 prefix-len :start2 amount-to-consume :end2 fill-ptr)
+ (replace new-buffer (pretty-stream-prefix stream)
+ :end1 prefix-len)
+ (setf (pretty-stream-buffer-fill-pointer stream) new-fill-ptr)
+ (incf (pretty-stream-buffer-offset stream) shift)
+ (unless literal-p
+ (setf (logical-block-section-column block) prefix-len)
+ (setf (logical-block-section-start-line block) line-number))))))
+
+(defun output-partial-line (stream)
+ (let* ((fill-ptr (pretty-stream-buffer-fill-pointer stream))
+ (tail (pretty-stream-queue-tail stream))
+ (count
+ (if tail
+ (posn-index (queued-op-posn (car tail)) stream)
+ fill-ptr))
+ (new-fill-ptr (- fill-ptr count))
+ (buffer (pretty-stream-buffer stream)))
+ (when (zerop count)
+ (error "Output-partial-line called when nothing can be output."))
+ (output-buffer-with-annotations stream count)
+ (incf (pretty-stream-buffer-start-column stream) count)
+ (replace buffer buffer :end1 new-fill-ptr :start2 count :end2 fill-ptr)
+ (setf (pretty-stream-buffer-fill-pointer stream) new-fill-ptr)
+ (incf (pretty-stream-buffer-offset stream) count)))
+
+(defun force-pretty-output (stream)
+ (maybe-output stream nil)
+ (expand-tabs stream nil)
+ (re-enqueue-annotations stream nil)
+ (output-buffer-with-annotations stream
+ (pretty-stream-buffer-fill-pointer stream)))
+ \ No newline at end of file
diff --git a/vim/bundle/slimv/slime/slime.el b/vim/bundle/slimv/slime/slime.el
new file mode 100644
index 0000000..feca7e8
--- /dev/null
+++ b/vim/bundle/slimv/slime/slime.el
@@ -0,0 +1,7501 @@
+;;; slime.el --- Superior Lisp Interaction Mode for Emacs -*-lexical-binding:t-*-
+
+;; URL: https://github.com/slime/slime
+;; Package-Requires: ((cl-lib "0.5") (macrostep "0.9"))
+;; Keywords: languages, lisp, slime
+;; Version: 2.18
+
+;;;; License and Commentary
+
+;; Copyright (C) 2003 Eric Marsden, Luke Gorrie, Helmut Eller
+;; Copyright (C) 2004,2005,2006 Luke Gorrie, Helmut Eller
+;; Copyright (C) 2007,2008,2009 Helmut Eller, Tobias C. Rittweiler
+;;
+;; For a detailed list of contributors, see the manual.
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public
+;; License along with this program; if not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; SLIME is the ``Superior Lisp Interaction Mode for Emacs.''
+;;
+;; SLIME extends Emacs with support for interactive programming in
+;; Common Lisp. The features are centered around slime-mode, an Emacs
+;; minor-mode that complements the standard lisp-mode. While lisp-mode
+;; supports editing Lisp source files, slime-mode adds support for
+;; interacting with a running Common Lisp process for compilation,
+;; debugging, documentation lookup, and so on.
+;;
+;; The slime-mode programming environment follows the example of
+;; Emacs's native Emacs Lisp environment. We have also included good
+;; ideas from similar systems (such as ILISP) and some new ideas of
+;; our own.
+;;
+;; SLIME is constructed from two parts: a user-interface written in
+;; Emacs Lisp, and a supporting server program written in Common
+;; Lisp. The two sides are connected together with a socket and
+;; communicate using an RPC-like protocol.
+;;
+;; The Lisp server is primarily written in portable Common Lisp. The
+;; required implementation-specific functionality is specified by a
+;; well-defined interface and implemented separately for each Lisp
+;; implementation. This makes SLIME readily portable.
+
+;;; Code:
+
+
+;;;; Dependencies and setup
+(eval-and-compile
+ (require 'cl-lib nil t)
+ ;; For emacs 23, look for bundled version
+ (require 'cl-lib "lib/cl-lib"))
+
+(eval-when-compile (require 'cl)) ; defsetf, lexical-let
+
+(eval-and-compile
+ (if (< emacs-major-version 23)
+ (error "Slime requires an Emacs version of 23, or above")))
+
+(require 'hyperspec "lib/hyperspec")
+(require 'thingatpt)
+(require 'comint)
+(require 'pp)
+(require 'easymenu)
+(require 'outline)
+(require 'arc-mode)
+(require 'etags)
+(require 'compile)
+
+(eval-when-compile
+ (require 'apropos)
+ (require 'gud)
+ (require 'lisp-mnt))
+
+(declare-function lm-version "lisp-mnt")
+
+(defvar slime-path nil
+ "Directory containing the Slime package.
+This is used to load the supporting Common Lisp library, Swank.
+The default value is automatically computed from the location of
+the Emacs Lisp package.")
+(setq slime-path (file-name-directory load-file-name))
+
+(defvar slime-version nil
+ "The version of SLIME that you're using.")
+(setq slime-version
+ (eval-when-compile
+ (lm-version
+ (cl-find "slime.el"
+ (remove nil
+ (list load-file-name
+ (when (boundp 'byte-compile-current-file)
+ byte-compile-current-file)))
+ :key #'file-name-nondirectory
+ :test #'string-equal))))
+
+(defvar slime-lisp-modes '(lisp-mode))
+(defvar slime-contribs nil
+ "A list of contrib packages to load with SLIME.")
+(define-obsolete-variable-alias 'slime-setup-contribs
+'slime-contribs "2.3.2")
+
+(defun slime-setup (&optional contribs)
+ "Setup Emacs so that lisp-mode buffers always use SLIME.
+CONTRIBS is a list of contrib packages to load. If `nil', use
+`slime-contribs'. "
+ (interactive)
+ (when (member 'lisp-mode slime-lisp-modes)
+ (add-hook 'lisp-mode-hook 'slime-lisp-mode-hook))
+ (when contribs
+ (setq slime-contribs contribs))
+ (slime--setup-contribs))
+
+(defvar slime-required-modules '())
+
+(defun slime--setup-contribs ()
+ "Load and initialize contribs."
+ (dolist (c slime-contribs)
+ (unless (featurep c)
+ (require c)
+ (let ((init (intern (format "%s-init" c))))
+ (when (fboundp init)
+ (funcall init))))))
+
+(defun slime-lisp-mode-hook ()
+ (slime-mode 1)
+ (set (make-local-variable 'lisp-indent-function)
+ 'common-lisp-indent-function))
+
+(defvar slime-protocol-version nil)
+(setq slime-protocol-version slime-version)
+
+
+;;;; Customize groups
+;;
+;;;;; slime
+
+(defgroup slime nil
+ "Interaction with the Superior Lisp Environment."
+ :prefix "slime-"
+ :group 'applications)
+
+;;;;; slime-ui
+
+(defgroup slime-ui nil
+ "Interaction with the Superior Lisp Environment."
+ :prefix "slime-"
+ :group 'slime)
+
+(defcustom slime-truncate-lines t
+ "Set `truncate-lines' in popup buffers.
+This applies to buffers that present lines as rows of data, such as
+debugger backtraces and apropos listings."
+ :type 'boolean
+ :group 'slime-ui)
+
+(defcustom slime-kill-without-query-p nil
+ "If non-nil, kill SLIME processes without query when quitting Emacs.
+This applies to the *inferior-lisp* buffer and the network connections."
+ :type 'boolean
+ :group 'slime-ui)
+
+;;;;; slime-lisp
+
+(defgroup slime-lisp nil
+ "Lisp server configuration."
+ :prefix "slime-"
+ :group 'slime)
+
+(defcustom slime-backend "swank-loader.lisp"
+ "The name of the Lisp file that loads the Swank server.
+This name is interpreted relative to the directory containing
+slime.el, but could also be set to an absolute filename."
+ :type 'string
+ :group 'slime-lisp)
+
+(defcustom slime-connected-hook nil
+ "List of functions to call when SLIME connects to Lisp."
+ :type 'hook
+ :group 'slime-lisp)
+
+(defcustom slime-enable-evaluate-in-emacs nil
+ "*If non-nil, the inferior Lisp can evaluate arbitrary forms in Emacs.
+The default is nil, as this feature can be a security risk."
+ :type '(boolean)
+ :group 'slime-lisp)
+
+(defcustom slime-lisp-host "127.0.0.1"
+ "The default hostname (or IP address) to connect to."
+ :type 'string
+ :group 'slime-lisp)
+
+(defcustom slime-port 4005
+ "Port to use as the default for `slime-connect'."
+ :type 'integer
+ :group 'slime-lisp)
+
+(defvar slime-connect-host-history (list slime-lisp-host))
+(defvar slime-connect-port-history (list (prin1-to-string slime-port)))
+
+(defvar slime-net-valid-coding-systems
+ '((iso-latin-1-unix nil "iso-latin-1-unix")
+ (iso-8859-1-unix nil "iso-latin-1-unix")
+ (binary nil "iso-latin-1-unix")
+ (utf-8-unix t "utf-8-unix")
+ (emacs-mule-unix t "emacs-mule-unix")
+ (euc-jp-unix t "euc-jp-unix"))
+ "A list of valid coding systems.
+Each element is of the form: (NAME MULTIBYTEP CL-NAME)")
+
+(defun slime-find-coding-system (name)
+ "Return the coding system for the symbol NAME.
+The result is either an element in `slime-net-valid-coding-systems'
+of nil."
+ (let ((probe (assq name slime-net-valid-coding-systems)))
+ (when (and probe (if (fboundp 'check-coding-system)
+ (ignore-errors (check-coding-system (car probe)))
+ (eq (car probe) 'binary)))
+ probe)))
+
+(defcustom slime-net-coding-system
+ (car (cl-find-if 'slime-find-coding-system
+ slime-net-valid-coding-systems :key 'car))
+ "Coding system used for network connections.
+See also `slime-net-valid-coding-systems'."
+ :type (cons 'choice
+ (mapcar (lambda (x)
+ (list 'const (car x)))
+ slime-net-valid-coding-systems))
+ :group 'slime-lisp)
+
+;;;;; slime-mode
+
+(defgroup slime-mode nil
+ "Settings for slime-mode Lisp source buffers."
+ :prefix "slime-"
+ :group 'slime)
+
+(defcustom slime-find-definitions-function 'slime-find-definitions-rpc
+ "Function to find definitions for a name.
+The function is called with the definition name, a string, as its
+argument."
+ :type 'function
+ :group 'slime-mode
+ :options '(slime-find-definitions-rpc
+ slime-etags-definitions
+ (lambda (name)
+ (append (slime-find-definitions-rpc name)
+ (slime-etags-definitions name)))
+ (lambda (name)
+ (or (slime-find-definitions-rpc name)
+ (and tags-table-list
+ (slime-etags-definitions name))))))
+
+;; FIXME: remove one day
+(defcustom slime-complete-symbol-function 'nil
+ "Obsolete. Use `slime-completion-at-point-functions' instead."
+ :group 'slime-mode
+ :type '(choice (const :tag "Compound" slime-complete-symbol*)
+ (const :tag "Fuzzy" slime-fuzzy-complete-symbol)))
+
+(make-obsolete-variable 'slime-complete-symbol-function
+ 'slime-completion-at-point-functions
+ "2015-10-18")
+
+(defcustom slime-completion-at-point-functions
+ '(slime-filename-completion
+ slime-simple-completion-at-point)
+ "List of functions to perform completion.
+Works like `completion-at-point-functions'.
+`slime--completion-at-point' uses this variable."
+ :group 'slime-mode)
+
+;;;;; slime-mode-faces
+
+(defgroup slime-mode-faces nil
+ "Faces in slime-mode source code buffers."
+ :prefix "slime-"
+ :group 'slime-mode)
+
+(defface slime-error-face
+ `((((class color) (background light))
+ (:underline "red"))
+ (((class color) (background dark))
+ (:underline "red"))
+ (t (:underline t)))
+ "Face for errors from the compiler."
+ :group 'slime-mode-faces)
+
+(defface slime-warning-face
+ `((((class color) (background light))
+ (:underline "orange"))
+ (((class color) (background dark))
+ (:underline "coral"))
+ (t (:underline t)))
+ "Face for warnings from the compiler."
+ :group 'slime-mode-faces)
+
+(defface slime-style-warning-face
+ `((((class color) (background light))
+ (:underline "brown"))
+ (((class color) (background dark))
+ (:underline "gold"))
+ (t (:underline t)))
+ "Face for style-warnings from the compiler."
+ :group 'slime-mode-faces)
+
+(defface slime-note-face
+ `((((class color) (background light))
+ (:underline "brown4"))
+ (((class color) (background dark))
+ (:underline "light goldenrod"))
+ (t (:underline t)))
+ "Face for notes from the compiler."
+ :group 'slime-mode-faces)
+
+(defface slime-highlight-face
+ '((t (:inherit highlight :underline nil)))
+ "Face for compiler notes while selected."
+ :group 'slime-mode-faces)
+
+;;;;; sldb
+
+(defgroup slime-debugger nil
+ "Backtrace options and fontification."
+ :prefix "sldb-"
+ :group 'slime)
+
+(defmacro define-sldb-faces (&rest faces)
+ "Define the set of SLDB faces.
+Each face specifiation is (NAME DESCRIPTION &optional PROPERTIES).
+NAME is a symbol; the face will be called sldb-NAME-face.
+DESCRIPTION is a one-liner for the customization buffer.
+PROPERTIES specifies any default face properties."
+ `(progn ,@(cl-loop for face in faces
+ collect `(define-sldb-face ,@face))))
+
+(defmacro define-sldb-face (name description &optional default)
+ (let ((facename (intern (format "sldb-%s-face" (symbol-name name)))))
+ `(defface ,facename
+ (list (list t ,default))
+ ,(format "Face for %s." description)
+ :group 'slime-debugger)))
+
+(define-sldb-faces
+ (topline "the top line describing the error")
+ (condition "the condition class"
+ '(:inherit font-lock-warning-face))
+ (section "the labels of major sections in the debugger buffer"
+ '(:inherit header-line))
+ (frame-label "backtrace frame numbers"
+ '(:inherit shadow))
+ (restart-type "restart names."
+ '(:inherit font-lock-keyword-face))
+ (restart "restart descriptions")
+ (restart-number "restart numbers (correspond to keystrokes to invoke)"
+ '(:bold t))
+ (frame-line "function names and arguments in the backtrace")
+ (restartable-frame-line
+ "frames which are surely restartable"
+ '(:foreground "lime green"))
+ (non-restartable-frame-line
+ "frames which are surely not restartable")
+ (detailed-frame-line
+ "function names and arguments in a detailed (expanded) frame")
+ (local-name "local variable names"
+ '(:inherit font-lock-variable-name-face))
+ (local-value "local variable values")
+ (catch-tag "catch tags"
+ '(:inherit highlight)))
+
+
+;;;; Minor modes
+
+;;;;; slime-mode
+
+(defvar slime-mode-indirect-map (make-sparse-keymap)
+ "Empty keymap which has `slime-mode-map' as it's parent.
+This is a hack so that we can reinitilize the real slime-mode-map
+more easily. See `slime-init-keymaps'.")
+
+(defvar slime-buffer-connection)
+(defvar slime-dispatching-connection)
+(defvar slime-current-thread)
+
+(defun slime--on ()
+ (slime-setup-completion))
+
+(defun slime--off ()
+ (remove-hook 'completion-at-point-functions #'slime--completion-at-point t))
+
+(define-minor-mode slime-mode
+ "\\<slime-mode-map>\
+SLIME: The Superior Lisp Interaction Mode for Emacs (minor-mode).
+
+Commands to compile the current buffer's source file and visually
+highlight any resulting compiler notes and warnings:
+\\[slime-compile-and-load-file] - Compile and load the current buffer's file.
+\\[slime-compile-file] - Compile (but not load) the current buffer's file.
+\\[slime-compile-defun] - Compile the top-level form at point.
+
+Commands for visiting compiler notes:
+\\[slime-next-note] - Goto the next form with a compiler note.
+\\[slime-previous-note] - Goto the previous form with a compiler note.
+\\[slime-remove-notes] - Remove compiler-note annotations in buffer.
+
+Finding definitions:
+\\[slime-edit-definition]
+- Edit the definition of the function called at point.
+\\[slime-pop-find-definition-stack]
+- Pop the definition stack to go back from a definition.
+
+Documentation commands:
+\\[slime-describe-symbol] - Describe symbol.
+\\[slime-apropos] - Apropos search.
+\\[slime-disassemble-symbol] - Disassemble a function.
+
+Evaluation commands:
+\\[slime-eval-defun] - Evaluate top-level from containing point.
+\\[slime-eval-last-expression] - Evaluate sexp before point.
+\\[slime-pprint-eval-last-expression] \
+- Evaluate sexp before point, pretty-print result.
+
+Full set of commands:
+\\{slime-mode-map}"
+ :keymap slime-mode-indirect-map
+ :lighter (:eval (slime-modeline-string))
+ (cond (slime-mode (slime--on))
+ (t (slime--off))))
+
+
+;;;;;; Modeline
+
+(defun slime-modeline-string ()
+ "Return the string to display in the modeline.
+\"Slime\" only appears if we aren't connected. If connected,
+include package-name, connection-name, and possibly some state
+information."
+ (let ((conn (slime-current-connection)))
+ ;; Bail out early in case there's no connection, so we won't
+ ;; implicitly invoke `slime-connection' which may query the user.
+ (if (not conn)
+ (and slime-mode " Slime")
+ (let ((local (eq conn slime-buffer-connection))
+ (pkg (slime-current-package)))
+ (concat " "
+ (if local "{" "[")
+ (if pkg (slime-pretty-package-name pkg) "?")
+ " "
+ ;; ignore errors for closed connections
+ (ignore-errors (slime-connection-name conn))
+ (slime-modeline-state-string conn)
+ (if local "}" "]"))))))
+
+(defun slime-pretty-package-name (name)
+ "Return a pretty version of a package name NAME."
+ (cond ((string-match "^#?:\\(.*\\)$" name)
+ (match-string 1 name))
+ ((string-match "^\"\\(.*\\)\"$" name)
+ (match-string 1 name))
+ (t name)))
+
+(defun slime-modeline-state-string (conn)
+ "Return a string possibly describing CONN's state."
+ (cond ((not (eq (process-status conn) 'open))
+ (format " %s" (process-status conn)))
+ ((let ((pending (length (slime-rex-continuations conn)))
+ (sldbs (length (sldb-buffers conn))))
+ (cond ((and (zerop sldbs) (zerop pending)) nil)
+ ((zerop sldbs) (format " %s" pending))
+ (t (format " %s/%s" pending sldbs)))))))
+
+(defun slime--recompute-modelines ()
+ (force-mode-line-update t))
+
+
+;;;;; Key bindings
+
+(defvar slime-parent-map nil
+ "Parent keymap for shared between all Slime related modes.")
+
+(defvar slime-parent-bindings
+ '(("\M-." slime-edit-definition)
+ ("\M-," slime-pop-find-definition-stack)
+ ("\M-_" slime-edit-uses) ; for German layout
+ ("\M-?" slime-edit-uses) ; for USian layout
+ ("\C-x4." slime-edit-definition-other-window)
+ ("\C-x5." slime-edit-definition-other-frame)
+ ("\C-x\C-e" slime-eval-last-expression)
+ ("\C-\M-x" slime-eval-defun)
+ ;; Include PREFIX keys...
+ ("\C-c" slime-prefix-map)))
+
+(defvar slime-prefix-map nil
+ "Keymap for commands prefixed with `slime-prefix-key'.")
+
+(defvar slime-prefix-bindings
+ '(("\C-r" slime-eval-region)
+ (":" slime-interactive-eval)
+ ("\C-e" slime-interactive-eval)
+ ("E" slime-edit-value)
+ ("\C-l" slime-load-file)
+ ("\C-b" slime-interrupt)
+ ("\M-d" slime-disassemble-symbol)
+ ("\C-t" slime-toggle-trace-fdefinition)
+ ("I" slime-inspect)
+ ("\C-xt" slime-list-threads)
+ ("\C-xn" slime-next-connection)
+ ("\C-xp" slime-prev-connection)
+ ("\C-xc" slime-list-connections)
+ ("<" slime-list-callers)
+ (">" slime-list-callees)
+ ;; Include DOC keys...
+ ("\C-d" slime-doc-map)
+ ;; Include XREF WHO-FOO keys...
+ ("\C-w" slime-who-map)
+ ))
+
+(defvar slime-editing-map nil
+ "These keys are useful for buffers where the user can insert and
+edit s-exprs, e.g. for source buffers and the REPL.")
+
+(defvar slime-editing-keys
+ `(;; Arglist display & completion
+ (" " slime-space)
+ ;; Evaluating
+ ;;("\C-x\M-e" slime-eval-last-expression-display-output :inferior t)
+ ("\C-c\C-p" slime-pprint-eval-last-expression)
+ ;; Macroexpand
+ ("\C-c\C-m" slime-expand-1)
+ ("\C-c\M-m" slime-macroexpand-all)
+ ;; Misc
+ ("\C-c\C-u" slime-undefine-function)
+ (,(kbd "C-M-.") slime-next-location)
+ (,(kbd "C-M-,") slime-previous-location)
+ ;; Obsolete, redundant bindings
+ ("\C-c\C-i" completion-at-point)
+ ;;("\M-*" pop-tag-mark) ; almost to clever
+ ))
+
+(defvar slime-mode-map nil
+ "Keymap for slime-mode.")
+
+(defvar slime-keys
+ '( ;; Compiler notes
+ ("\M-p" slime-previous-note)
+ ("\M-n" slime-next-note)
+ ("\C-c\M-c" slime-remove-notes)
+ ("\C-c\C-k" slime-compile-and-load-file)
+ ("\C-c\M-k" slime-compile-file)
+ ("\C-c\C-c" slime-compile-defun)))
+
+(defun slime-nop ()
+ "The null command. Used to shadow currently-unused keybindings."
+ (interactive)
+ (call-interactively 'undefined))
+
+(defvar slime-doc-map nil
+ "Keymap for documentation commands. Bound to a prefix key.")
+
+(defvar slime-doc-bindings
+ '((?a slime-apropos)
+ (?z slime-apropos-all)
+ (?p slime-apropos-package)
+ (?d slime-describe-symbol)
+ (?f slime-describe-function)
+ (?h slime-documentation-lookup)
+ (?~ common-lisp-hyperspec-format)
+ (?g common-lisp-hyperspec-glossary-term)
+ (?# common-lisp-hyperspec-lookup-reader-macro)))
+
+(defvar slime-who-map nil
+ "Keymap for who-xref commands. Bound to a prefix key.")
+
+(defvar slime-who-bindings
+ '((?c slime-who-calls)
+ (?w slime-calls-who)
+ (?r slime-who-references)
+ (?b slime-who-binds)
+ (?s slime-who-sets)
+ (?m slime-who-macroexpands)
+ (?a slime-who-specializes)))
+
+(defun slime-init-keymaps ()
+ "(Re)initialize the keymaps for `slime-mode'."
+ (interactive)
+ (slime-init-keymap 'slime-doc-map t t slime-doc-bindings)
+ (slime-init-keymap 'slime-who-map t t slime-who-bindings)
+ (slime-init-keymap 'slime-prefix-map t nil slime-prefix-bindings)
+ (slime-init-keymap 'slime-parent-map nil nil slime-parent-bindings)
+ (slime-init-keymap 'slime-editing-map nil nil slime-editing-keys)
+ (set-keymap-parent slime-editing-map slime-parent-map)
+ (slime-init-keymap 'slime-mode-map nil nil slime-keys)
+ (set-keymap-parent slime-mode-map slime-editing-map)
+ (set-keymap-parent slime-mode-indirect-map slime-mode-map))
+
+(defun slime-init-keymap (keymap-name prefixp bothp bindings)
+ (set keymap-name (make-sparse-keymap))
+ (when prefixp (define-prefix-command keymap-name))
+ (slime-bind-keys (eval keymap-name) bothp bindings))
+
+(defun slime-bind-keys (keymap bothp bindings)
+ "Add BINDINGS to KEYMAP.
+If BOTHP is true also add bindings with control modifier."
+ (cl-loop for (key command) in bindings do
+ (cond (bothp
+ (define-key keymap `[,key] command)
+ (unless (equal key ?h) ; But don't bind C-h
+ (define-key keymap `[(control ,key)] command)))
+ (t (define-key keymap key command)))))
+
+(slime-init-keymaps)
+
+(define-minor-mode slime-editing-mode
+ "Minor mode which makes slime-editing-map available.
+\\{slime-editing-map}"
+ nil
+ nil
+ slime-editing-map)
+
+
+;;;; Framework'ey bits
+;;;
+;;; This section contains some standard SLIME idioms: basic macros,
+;;; ways of showing messages to the user, etc. All the code in this
+;;; file should use these functions when applicable.
+;;;
+;;;;; Syntactic sugar
+
+(defmacro slime-dcase (value &rest patterns)
+ (declare (indent 1))
+ "Dispatch VALUE to one of PATTERNS.
+A cross between `case' and `destructuring-bind'.
+The pattern syntax is:
+ ((HEAD . ARGS) . BODY)
+The list of patterns is searched for a HEAD `eq' to the car of
+VALUE. If one is found, the BODY is executed with ARGS bound to the
+corresponding values in the CDR of VALUE."
+ (let ((operator (cl-gensym "op-"))
+ (operands (cl-gensym "rand-"))
+ (tmp (cl-gensym "tmp-")))
+ `(let* ((,tmp ,value)
+ (,operator (car ,tmp))
+ (,operands (cdr ,tmp)))
+ (cl-case ,operator
+ ,@(mapcar (lambda (clause)
+ (if (eq (car clause) t)
+ `(t ,@(cdr clause))
+ (cl-destructuring-bind ((op &rest rands) &rest body)
+ clause
+ `(,op (cl-destructuring-bind ,rands ,operands
+ . ,(or body
+ '((ignore)) ; suppress some warnings
+ ))))))
+ patterns)
+ ,@(if (eq (caar (last patterns)) t)
+ '()
+ `((t (error "slime-dcase failed: %S" ,tmp))))))))
+
+(defmacro slime-define-keys (keymap &rest key-command)
+ "Define keys in KEYMAP. Each KEY-COMMAND is a list of (KEY COMMAND)."
+ (declare (indent 1))
+ `(progn . ,(mapcar (lambda (k-c) `(define-key ,keymap . ,k-c))
+ key-command)))
+
+(cl-defmacro with-struct ((conc-name &rest slots) struct &body body)
+ "Like with-slots but works only for structs.
+\(fn (CONC-NAME &rest SLOTS) STRUCT &body BODY)"
+ (declare (indent 2))
+ (let ((struct-var (cl-gensym "struct"))
+ (reader (lambda (slot)
+ (intern (concat (symbol-name conc-name)
+ (symbol-name slot))))))
+ `(let ((,struct-var ,struct))
+ (cl-symbol-macrolet
+ ,(mapcar (lambda (slot)
+ (cl-etypecase slot
+ (symbol `(,slot (,(funcall reader slot) ,struct-var)))
+ (cons `(,(cl-first slot)
+ (,(funcall reader (cl-second slot))
+ ,struct-var)))))
+ slots)
+ . ,body))))
+
+;;;;; Very-commonly-used functions
+
+(defvar slime-message-function 'message)
+
+;; Interface
+(defun slime-buffer-name (type &optional hidden)
+ (cl-assert (keywordp type))
+ (concat (if hidden " " "")
+ (format "*slime-%s*" (substring (symbol-name type) 1))))
+
+;; Interface
+(defun slime-message (format &rest args)
+ "Like `message' but with special support for multi-line messages.
+Single-line messages use the echo area."
+ (apply slime-message-function format args))
+
+(defun slime-display-warning (message &rest args)
+ (display-warning '(slime warning) (apply #'format message args)))
+
+(defvar slime-background-message-function 'slime-display-oneliner)
+
+;; Interface
+(defun slime-background-message (format-string &rest format-args)
+ "Display a message in passing.
+This is like `slime-message', but less distracting because it
+will never pop up a buffer or display multi-line messages.
+It should be used for \"background\" messages such as argument lists."
+ (apply slime-background-message-function format-string format-args))
+
+(defun slime-display-oneliner (format-string &rest format-args)
+ (let* ((msg (apply #'format format-string format-args)))
+ (unless (minibuffer-window-active-p (minibuffer-window))
+ (message "%s" (slime-oneliner msg)))))
+
+(defun slime-oneliner (string)
+ "Return STRING truncated to fit in a single echo-area line."
+ (substring string 0 (min (length string)
+ (or (cl-position ?\n string) most-positive-fixnum)
+ (1- (window-width (minibuffer-window))))))
+
+;; Interface
+(defun slime-set-truncate-lines ()
+ "Apply `slime-truncate-lines' to the current buffer."
+ (when slime-truncate-lines
+ (set (make-local-variable 'truncate-lines) t)))
+
+;; Interface
+(defun slime-read-package-name (prompt &optional initial-value)
+ "Read a package name from the minibuffer, prompting with PROMPT."
+ (let ((completion-ignore-case t))
+ (completing-read prompt (slime-bogus-completion-alist
+ (slime-eval
+ `(swank:list-all-package-names t)))
+ nil t initial-value)))
+
+;; Interface
+(defun slime-read-symbol-name (prompt &optional query)
+ "Either read a symbol name or choose the one at point.
+The user is prompted if a prefix argument is in effect, if there is no
+symbol at point, or if QUERY is non-nil."
+ (cond ((or current-prefix-arg query (not (slime-symbol-at-point)))
+ (slime-read-from-minibuffer prompt (slime-symbol-at-point)))
+ (t (slime-symbol-at-point))))
+
+;; Interface
+(defmacro slime-propertize-region (props &rest body)
+ "Execute BODY and add PROPS to all the text it inserts.
+More precisely, PROPS are added to the region between the point's
+positions before and after executing BODY."
+ (declare (indent 1) (debug (sexp &rest form)))
+ (let ((start (cl-gensym)))
+ `(let ((,start (point)))
+ (prog1 (progn ,@body)
+ (add-text-properties ,start (point) ,props)))))
+
+(defun slime-add-face (face string)
+ (declare (indent 1))
+ (add-text-properties 0 (length string) (list 'face face) string)
+ string)
+
+;; Interface
+(defsubst slime-insert-propertized (props &rest args)
+ "Insert all ARGS and then add text-PROPS to the inserted text."
+ (slime-propertize-region props (apply #'insert args)))
+
+(defmacro slime-with-rigid-indentation (level &rest body)
+ "Execute BODY and then rigidly indent its text insertions.
+Assumes all insertions are made at point."
+ (declare (indent 1))
+ (let ((start (cl-gensym)) (l (cl-gensym)))
+ `(let ((,start (point)) (,l ,(or level '(current-column))))
+ (prog1 (progn ,@body)
+ (slime-indent-rigidly ,start (point) ,l)))))
+
+(defun slime-indent-rigidly (start end column)
+ ;; Similar to `indent-rigidly' but doesn't inherit text props.
+ (let ((indent (make-string column ?\ )))
+ (save-excursion
+ (goto-char end)
+ (beginning-of-line)
+ (while (and (<= start (point))
+ (progn
+ (insert-before-markers indent)
+ (zerop (forward-line -1))))))))
+
+(defun slime-insert-indented (&rest strings)
+ "Insert all arguments rigidly indented."
+ (slime-with-rigid-indentation nil
+ (apply #'insert strings)))
+
+(defun slime-property-bounds (prop)
+ "Return two the positions of the previous and next changes to PROP.
+PROP is the name of a text property."
+ (cl-assert (get-text-property (point) prop))
+ (let ((end (next-single-char-property-change (point) prop)))
+ (list (previous-single-char-property-change end prop) end)))
+
+(defun slime-curry (fun &rest args)
+ "Partially apply FUN to ARGS. The result is a new function.
+This idiom is preferred over `lexical-let'."
+ `(lambda (&rest more) (apply ',fun (append ',args more))))
+
+(defun slime-rcurry (fun &rest args)
+ "Like `slime-curry' but ARGS on the right are applied."
+ `(lambda (&rest more) (apply ',fun (append more ',args))))
+
+
+;;;;; Temporary popup buffers
+
+;; keep compiler quiet
+(defvar slime-buffer-package)
+(defvar slime-buffer-connection)
+
+;; Interface
+(cl-defmacro slime-with-popup-buffer ((name &key package connection select
+ mode)
+ &body body)
+ "Similar to `with-output-to-temp-buffer'.
+Bind standard-output and initialize some buffer-local variables.
+Restore window configuration when closed.
+
+NAME is the name of the buffer to be created.
+PACKAGE is the value `slime-buffer-package'.
+CONNECTION is the value for `slime-buffer-connection',
+ if nil, no explicit connection is associated with
+ the buffer. If t, the current connection is taken.
+MODE is the name of a major mode which will be enabled.
+"
+ (declare (indent 1))
+ (let ((package-sym (cl-gensym "package-"))
+ (connection-sym (cl-gensym "connection-")))
+ `(let ((,package-sym ,(if (eq package t)
+ `(slime-current-package)
+ package))
+ (,connection-sym ,(if (eq connection t)
+ `(slime-current-connection)
+ connection)))
+ (with-current-buffer (get-buffer-create ,name)
+ (let ((inhibit-read-only t)
+ (standard-output (current-buffer)))
+ (erase-buffer)
+ (funcall (or ,mode 'fundamental-mode))
+ (setq slime-buffer-package ,package-sym
+ slime-buffer-connection ,connection-sym)
+ (set-syntax-table lisp-mode-syntax-table)
+ ,@body
+ (slime-popup-buffer-mode 1)
+ (funcall (if ,select 'pop-to-buffer 'display-buffer)
+ (current-buffer))
+ (current-buffer))))))
+
+(defvar slime-popup-buffer-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "q") 'quit-window)
+ ;;("\C-c\C-z" . slime-switch-to-output-buffer)
+ (define-key map (kbd "M-.") 'slime-edit-definition)
+ map))
+
+(define-minor-mode slime-popup-buffer-mode
+ "Mode for displaying read only stuff"
+ nil nil nil
+ (setq buffer-read-only t))
+
+(add-to-list 'minor-mode-alist
+ `(slime-popup-buffer-mode
+ (:eval (unless slime-mode
+ (slime-modeline-string)))))
+
+(set-keymap-parent slime-popup-buffer-mode-map slime-parent-map)
+
+;;;;; Filename translation
+;;;
+;;; Filenames passed between Emacs and Lisp should be translated using
+;;; these functions. This way users who run Emacs and Lisp on separate
+;;; machines have a chance to integrate file operations somehow.
+
+(defvar slime-to-lisp-filename-function #'convert-standard-filename
+ "Function to translate Emacs filenames to CL namestrings.")
+(defvar slime-from-lisp-filename-function #'identity
+ "Function to translate CL namestrings to Emacs filenames.")
+
+(defun slime-to-lisp-filename (filename)
+ "Translate the string FILENAME to a Lisp filename."
+ (funcall slime-to-lisp-filename-function filename))
+
+(defun slime-from-lisp-filename (filename)
+ "Translate the Lisp filename FILENAME to an Emacs filename."
+ (funcall slime-from-lisp-filename-function filename))
+
+
+;;;; Starting SLIME
+;;;
+;;; This section covers starting an inferior-lisp, compiling and
+;;; starting the server, initiating a network connection.
+
+;;;;; Entry points
+
+;; We no longer load inf-lisp, but we use this variable for backward
+;; compatibility.
+(defvar inferior-lisp-program "lisp"
+ "*Program name for invoking an inferior Lisp with for Inferior Lisp mode.")
+
+(defvar slime-lisp-implementations nil
+ "*A list of known Lisp implementations.
+The list should have the form:
+ ((NAME (PROGRAM PROGRAM-ARGS...) &key KEYWORD-ARGS) ...)
+
+NAME is a symbol for the implementation.
+PROGRAM and PROGRAM-ARGS are strings used to start the Lisp process.
+For KEYWORD-ARGS see `slime-start'.
+
+Here's an example:
+ ((cmucl (\"/opt/cmucl/bin/lisp\" \"-quiet\") :init slime-init-command)
+ (acl (\"acl7\") :coding-system emacs-mule))")
+
+(defvar slime-default-lisp nil
+ "*The name of the default Lisp implementation.
+See `slime-lisp-implementations'")
+
+;; dummy definitions for the compiler
+(defvar slime-net-processes)
+(defvar slime-default-connection)
+
+(defun slime (&optional command coding-system)
+ "Start an inferior^_superior Lisp and connect to its Swank server."
+ (interactive)
+ (slime-setup)
+ (let ((inferior-lisp-program (or command inferior-lisp-program))
+ (slime-net-coding-system (or coding-system slime-net-coding-system)))
+ (slime-start* (cond ((and command (symbolp command))
+ (slime-lisp-options command))
+ (t (slime-read-interactive-args))))))
+
+(defvar slime-inferior-lisp-program-history '()
+ "History list of command strings. Used by `slime'.")
+
+(defun slime-read-interactive-args ()
+ "Return the list of args which should be passed to `slime-start'.
+
+The rules for selecting the arguments are rather complicated:
+
+- In the most common case, i.e. if there's no prefix-arg in
+ effect and if `slime-lisp-implementations' is nil, use
+ `inferior-lisp-program' as fallback.
+
+- If the table `slime-lisp-implementations' is non-nil use the
+ implementation with name `slime-default-lisp' or if that's nil
+ the first entry in the table.
+
+- If the prefix-arg is `-', prompt for one of the registered
+ lisps.
+
+- If the prefix-arg is positive, read the command to start the
+ process."
+ (let ((table slime-lisp-implementations))
+ (cond ((not current-prefix-arg) (slime-lisp-options))
+ ((eq current-prefix-arg '-)
+ (let ((key (completing-read
+ "Lisp name: " (mapcar (lambda (x)
+ (list (symbol-name (car x))))
+ table)
+ nil t)))
+ (slime-lookup-lisp-implementation table (intern key))))
+ (t
+ (cl-destructuring-bind (program &rest program-args)
+ (split-string-and-unquote
+ (read-shell-command "Run lisp: " inferior-lisp-program
+ 'slime-inferior-lisp-program-history))
+ (let ((coding-system
+ (if (eq 16 (prefix-numeric-value current-prefix-arg))
+ (read-coding-system "set slime-coding-system: "
+ slime-net-coding-system)
+ slime-net-coding-system)))
+ (list :program program :program-args program-args
+ :coding-system coding-system)))))))
+
+(defun slime-lisp-options (&optional name)
+ (let ((table slime-lisp-implementations))
+ (cl-assert (or (not name) table))
+ (cond (table (slime-lookup-lisp-implementation slime-lisp-implementations
+ (or name slime-default-lisp
+ (car (car table)))))
+ (t (cl-destructuring-bind (program &rest args)
+ (split-string inferior-lisp-program)
+ (list :program program :program-args args))))))
+
+(defun slime-lookup-lisp-implementation (table name)
+ (let ((arguments (cl-rest (assoc name table))))
+ (unless arguments
+ (error "Could not find lisp implementation with the name '%S'" name))
+ (when (and (= (length arguments) 1)
+ (functionp (cl-first arguments)))
+ (setf arguments (funcall (cl-first arguments))))
+ (cl-destructuring-bind ((prog &rest args) &rest keys) arguments
+ (cl-list* :name name :program prog :program-args args keys))))
+
+(cl-defun slime-start (&key (program inferior-lisp-program) program-args
+ directory
+ (coding-system slime-net-coding-system)
+ (init 'slime-init-command)
+ name
+ (buffer "*inferior-lisp*")
+ init-function
+ env)
+ "Start a Lisp process and connect to it.
+This function is intended for programmatic use if `slime' is not
+flexible enough.
+
+PROGRAM and PROGRAM-ARGS are the filename and argument strings
+ for the subprocess.
+INIT is a function that should return a string to load and start
+ Swank. The function will be called with the PORT-FILENAME and ENCODING as
+ arguments. INIT defaults to `slime-init-command'.
+CODING-SYSTEM a symbol for the coding system. The default is
+ slime-net-coding-system
+ENV environment variables for the subprocess (see `process-environment').
+INIT-FUNCTION function to call right after the connection is established.
+BUFFER the name of the buffer to use for the subprocess.
+NAME a symbol to describe the Lisp implementation
+DIRECTORY change to this directory before starting the process.
+"
+ (let ((args (list :program program :program-args program-args :buffer buffer
+ :coding-system coding-system :init init :name name
+ :init-function init-function :env env)))
+ (slime-check-coding-system coding-system)
+ (when (slime-bytecode-stale-p)
+ (slime-urge-bytecode-recompile))
+ (let ((proc (slime-maybe-start-lisp program program-args env
+ directory buffer)))
+ (slime-inferior-connect proc args)
+ (pop-to-buffer (process-buffer proc)))))
+
+(defun slime-start* (options)
+ (apply #'slime-start options))
+
+(defun slime-connect (host port &optional _coding-system interactive-p)
+ "Connect to a running Swank server. Return the connection."
+ (interactive (list (read-from-minibuffer
+ "Host: " (cl-first slime-connect-host-history)
+ nil nil '(slime-connect-host-history . 1))
+ (string-to-number
+ (read-from-minibuffer
+ "Port: " (cl-first slime-connect-port-history)
+ nil nil '(slime-connect-port-history . 1)))
+ nil t))
+ (slime-setup)
+ (when (and interactive-p
+ slime-net-processes
+ (y-or-n-p "Close old connections first? "))
+ (slime-disconnect-all))
+ (message "Connecting to Swank on port %S.." port)
+ (let* ((process (slime-net-connect host port))
+ (slime-dispatching-connection process))
+ (slime-setup-connection process)))
+
+;; FIXME: seems redundant
+(defun slime-start-and-init (options fun)
+ (let* ((rest (plist-get options :init-function))
+ (init (cond (rest `(lambda () (funcall ',rest) (funcall ',fun)))
+ (t fun))))
+ (slime-start* (plist-put (cl-copy-list options) :init-function init))))
+
+;;;;; Start inferior lisp
+;;;
+;;; Here is the protocol for starting SLIME:
+;;;
+;;; 0. Emacs recompiles/reloads slime.elc if it exists and is stale.
+;;; 1. Emacs starts an inferior Lisp process.
+;;; 2. Emacs tells Lisp (via stdio) to load and start Swank.
+;;; 3. Lisp recompiles the Swank if needed.
+;;; 4. Lisp starts the Swank server and writes its TCP port to a temp file.
+;;; 5. Emacs reads the temp file to get the port and then connects.
+;;; 6. Emacs prints a message of warm encouragement for the hacking ahead.
+;;;
+;;; Between steps 2-5 Emacs polls for the creation of the temp file so
+;;; that it can make the connection. This polling may continue for a
+;;; fair while if Swank needs recompilation.
+
+(defvar slime-connect-retry-timer nil
+ "Timer object while waiting for an inferior-lisp to start.")
+
+;;; Recompiling bytecode:
+
+(defun slime-bytecode-stale-p ()
+ "Return true if slime.elc is older than slime.el."
+ (let ((libfile (locate-library "slime")))
+ (when libfile
+ (let* ((basename (file-name-sans-extension libfile))
+ (sourcefile (concat basename ".el"))
+ (bytefile (concat basename ".elc")))
+ (and (file-exists-p bytefile)
+ (file-newer-than-file-p sourcefile bytefile))))))
+
+(defun slime-recompile-bytecode ()
+ "Recompile and reload slime."
+ (interactive)
+ (let ((sourcefile (concat (file-name-sans-extension (locate-library "slime"))
+ ".el")))
+ (byte-compile-file sourcefile t)))
+
+(defun slime-urge-bytecode-recompile ()
+ "Urge the user to recompile slime.elc.
+Return true if we have been given permission to continue."
+ (when (y-or-n-p "slime.elc is older than source. Recompile first? ")
+ (slime-recompile-bytecode)))
+
+(defun slime-abort-connection ()
+ "Abort connection the current connection attempt."
+ (interactive)
+ (cond (slime-connect-retry-timer
+ (slime-cancel-connect-retry-timer)
+ (message "Cancelled connection attempt."))
+ (t (error "Not connecting"))))
+
+;;; Starting the inferior Lisp and loading Swank:
+
+(defun slime-maybe-start-lisp (program program-args env directory buffer)
+ "Return a new or existing inferior lisp process."
+ (cond ((not (comint-check-proc buffer))
+ (slime-start-lisp program program-args env directory buffer))
+ ((slime-reinitialize-inferior-lisp-p program program-args env buffer)
+ (let ((conn (cl-find (get-buffer-process buffer)
+ slime-net-processes
+ :key #'slime-inferior-process)))
+ (when conn
+ (slime-net-close conn)))
+ (get-buffer-process buffer))
+ (t (slime-start-lisp program program-args env directory
+ (generate-new-buffer-name buffer)))))
+
+(defun slime-reinitialize-inferior-lisp-p (program program-args env buffer)
+ (let ((args (slime-inferior-lisp-args (get-buffer-process buffer))))
+ (and (equal (plist-get args :program) program)
+ (equal (plist-get args :program-args) program-args)
+ (equal (plist-get args :env) env)
+ (not (y-or-n-p "Create an additional *inferior-lisp*? ")))))
+
+(defvar slime-inferior-process-start-hook nil
+ "Hook called whenever a new process gets started.")
+
+(defun slime-start-lisp (program program-args env directory buffer)
+ "Does the same as `inferior-lisp' but less ugly.
+Return the created process."
+ (with-current-buffer (get-buffer-create buffer)
+ (when directory
+ (cd (expand-file-name directory)))
+ (comint-mode)
+ (let ((process-environment (append env process-environment))
+ (process-connection-type nil))
+ (comint-exec (current-buffer) "inferior-lisp" program nil program-args))
+ (lisp-mode-variables t)
+ (let ((proc (get-buffer-process (current-buffer))))
+ (slime-set-query-on-exit-flag proc)
+ (run-hooks 'slime-inferior-process-start-hook)
+ proc)))
+
+(defun slime-inferior-connect (process args)
+ "Start a Swank server in the inferior Lisp and connect."
+ (slime-delete-swank-port-file 'quiet)
+ (slime-start-swank-server process args)
+ (slime-read-port-and-connect process))
+
+(defvar slime-inferior-lisp-args nil
+ "A buffer local variable in the inferior proccess.
+See `slime-start'.")
+
+(defun slime-start-swank-server (process args)
+ "Start a Swank server on the inferior lisp."
+ (cl-destructuring-bind (&key coding-system init &allow-other-keys) args
+ (with-current-buffer (process-buffer process)
+ (make-local-variable 'slime-inferior-lisp-args)
+ (setq slime-inferior-lisp-args args)
+ (let ((str (funcall init (slime-swank-port-file) coding-system)))
+ (goto-char (process-mark process))
+ (insert-before-markers str)
+ (process-send-string process str)))))
+
+(defun slime-inferior-lisp-args (process)
+ "Return the initial process arguments.
+See `slime-start'."
+ (with-current-buffer (process-buffer process)
+ slime-inferior-lisp-args))
+
+;; XXX load-server & start-server used to be separated. maybe that was better.
+(defun slime-init-command (port-filename _coding-system)
+ "Return a string to initialize Lisp."
+ (let ((loader (if (file-name-absolute-p slime-backend)
+ slime-backend
+ (concat slime-path slime-backend))))
+ ;; Return a single form to avoid problems with buffered input.
+ (format "%S\n\n"
+ `(progn
+ (load ,(slime-to-lisp-filename (expand-file-name loader))
+ :verbose t)
+ (funcall (read-from-string "swank-loader:init"))
+ (funcall (read-from-string "swank:start-server")
+ ,(slime-to-lisp-filename port-filename))))))
+
+(defun slime-swank-port-file ()
+ "Filename where the SWANK server writes its TCP port number."
+ (expand-file-name (format "slime.%S" (emacs-pid)) (slime-temp-directory)))
+
+(defun slime-temp-directory ()
+ (cond ((fboundp 'temp-directory) (temp-directory))
+ ((boundp 'temporary-file-directory) temporary-file-directory)
+ (t "/tmp/")))
+
+(defun slime-delete-swank-port-file (&optional quiet)
+ (condition-case data
+ (delete-file (slime-swank-port-file))
+ (error
+ (cl-ecase quiet
+ ((nil) (signal (car data) (cdr data)))
+ (quiet)
+ (message (message "Unable to delete swank port file %S"
+ (slime-swank-port-file)))))))
+
+(defun slime-read-port-and-connect (inferior-process)
+ (slime-attempt-connection inferior-process nil 1))
+
+(defun slime-attempt-connection (process retries attempt)
+ ;; A small one-state machine to attempt a connection with
+ ;; timer-based retries.
+ (slime-cancel-connect-retry-timer)
+ (let ((file (slime-swank-port-file)))
+ (unless (active-minibuffer-window)
+ (message "Polling %S .. %d (Abort with `M-x slime-abort-connection'.)"
+ file attempt))
+ (cond ((and (file-exists-p file)
+ (> (nth 7 (file-attributes file)) 0)) ; file size
+ (let ((port (slime-read-swank-port))
+ (args (slime-inferior-lisp-args process)))
+ (slime-delete-swank-port-file 'message)
+ (let ((c (slime-connect slime-lisp-host port
+ (plist-get args :coding-system))))
+ (slime-set-inferior-process c process))))
+ ((and retries (zerop retries))
+ (message "Gave up connecting to Swank after %d attempts." attempt))
+ ((eq (process-status process) 'exit)
+ (message "Failed to connect to Swank: inferior process exited."))
+ (t
+ (when (and (file-exists-p file)
+ (zerop (nth 7 (file-attributes file))))
+ (message "(Zero length port file)")
+ ;; the file may be in the filesystem but not yet written
+ (unless retries (setq retries 3)))
+ (cl-assert (not slime-connect-retry-timer))
+ (setq slime-connect-retry-timer
+ (run-with-timer
+ 0.3 nil
+ #'slime-timer-call #'slime-attempt-connection
+ process (and retries (1- retries))
+ (1+ attempt)))))))
+
+(defun slime-timer-call (fun &rest args)
+ "Call function FUN with ARGS, reporting all errors.
+
+The default condition handler for timer functions (see
+`timer-event-handler') ignores errors."
+ (condition-case data
+ (apply fun args)
+ ((debug error)
+ (debug nil (list "Error in timer" fun args data)))))
+
+(defun slime-cancel-connect-retry-timer ()
+ (when slime-connect-retry-timer
+ (cancel-timer slime-connect-retry-timer)
+ (setq slime-connect-retry-timer nil)))
+
+(defun slime-read-swank-port ()
+ "Read the Swank server port number from the `slime-swank-port-file'."
+ (save-excursion
+ (with-temp-buffer
+ (insert-file-contents (slime-swank-port-file))
+ (goto-char (point-min))
+ (let ((port (read (current-buffer))))
+ (cl-assert (integerp port))
+ port))))
+
+(defun slime-toggle-debug-on-swank-error ()
+ (interactive)
+ (if (slime-eval `(swank:toggle-debug-on-swank-error))
+ (message "Debug on SWANK error enabled.")
+ (message "Debug on SWANK error disabled.")))
+
+;;; Words of encouragement
+
+(defun slime-user-first-name ()
+ (let ((name (if (string= (user-full-name) "")
+ (user-login-name)
+ (user-full-name))))
+ (string-match "^[^ ]*" name)
+ (capitalize (match-string 0 name))))
+
+(defvar slime-words-of-encouragement
+ `("Let the hacking commence!"
+ "Hacks and glory await!"
+ "Hack and be merry!"
+ "Your hacking starts... NOW!"
+ "May the source be with you!"
+ "Take this REPL, brother, and may it serve you well."
+ "Lemonodor-fame is but a hack away!"
+ ,(format "%s, this could be the start of a beautiful program."
+ (slime-user-first-name)))
+ "Scientifically-proven optimal words of hackerish encouragement.")
+
+(defun slime-random-words-of-encouragement ()
+ "Return a string of hackerish encouragement."
+ (eval (nth (random (length slime-words-of-encouragement))
+ slime-words-of-encouragement)))
+
+
+;;;; Networking
+;;;
+;;; This section covers the low-level networking: establishing
+;;; connections and encoding/decoding protocol messages.
+;;;
+;;; Each SLIME protocol message beings with a 6-byte header followed
+;;; by an S-expression as text. The sexp must be readable both by
+;;; Emacs and by Common Lisp, so if it contains any embedded code
+;;; fragments they should be sent as strings:
+;;;
+;;; The set of meaningful protocol messages are not specified
+;;; here. They are defined elsewhere by the event-dispatching
+;;; functions in this file and in swank.lisp.
+
+(defvar slime-net-processes nil
+ "List of processes (sockets) connected to Lisps.")
+
+(defvar slime-net-process-close-hooks '()
+ "List of functions called when a slime network connection closes.
+The functions are called with the process as their argument.")
+
+(defun slime-secret ()
+ "Find the magic secret from the user's home directory.
+Return nil if the file doesn't exist or is empty; otherwise the
+first line of the file."
+ (condition-case _err
+ (with-temp-buffer
+ (insert-file-contents "~/.slime-secret")
+ (goto-char (point-min))
+ (buffer-substring (point-min) (line-end-position)))
+ (file-error nil)))
+
+;;; Interface
+(defun slime-net-connect (host port)
+ "Establish a connection with a CL."
+ (let* ((inhibit-quit nil)
+ (proc (open-network-stream "SLIME Lisp" nil host port))
+ (buffer (slime-make-net-buffer " *cl-connection*")))
+ (push proc slime-net-processes)
+ (set-process-buffer proc buffer)
+ (set-process-filter proc 'slime-net-filter)
+ (set-process-sentinel proc 'slime-net-sentinel)
+ (slime-set-query-on-exit-flag proc)
+ (when (fboundp 'set-process-coding-system)
+ (set-process-coding-system proc 'binary 'binary))
+ (let ((secret (slime-secret)))
+ (when secret
+ (slime-net-send secret proc)))
+ proc))
+
+(defun slime-make-net-buffer (name)
+ "Make a buffer suitable for a network process."
+ (let ((buffer (generate-new-buffer name)))
+ (with-current-buffer buffer
+ (buffer-disable-undo)
+ (set (make-local-variable 'kill-buffer-query-functions) nil))
+ buffer))
+
+(defun slime-set-query-on-exit-flag (process)
+ "Set PROCESS's query-on-exit-flag to `slime-kill-without-query-p'."
+ (when slime-kill-without-query-p
+ ;; avoid byte-compiler warnings
+ (let ((fun (if (fboundp 'set-process-query-on-exit-flag)
+ 'set-process-query-on-exit-flag
+ 'process-kill-without-query)))
+ (funcall fun process nil))))
+
+;;;;; Coding system madness
+
+(defun slime-check-coding-system (coding-system)
+ "Signal an error if CODING-SYSTEM isn't a valid coding system."
+ (interactive)
+ (let ((props (slime-find-coding-system coding-system)))
+ (unless props
+ (error "Invalid slime-net-coding-system: %s. %s"
+ coding-system (mapcar #'car slime-net-valid-coding-systems)))
+ (when (and (cl-second props) (boundp 'default-enable-multibyte-characters))
+ (cl-assert default-enable-multibyte-characters))
+ t))
+
+(defun slime-coding-system-mulibyte-p (coding-system)
+ (cl-second (slime-find-coding-system coding-system)))
+
+(defun slime-coding-system-cl-name (coding-system)
+ (cl-third (slime-find-coding-system coding-system)))
+
+;;; Interface
+(defun slime-net-send (sexp proc)
+ "Send a SEXP to Lisp over the socket PROC.
+This is the lowest level of communication. The sexp will be READ and
+EVAL'd by Lisp."
+ (let* ((payload (encode-coding-string
+ (concat (slime-prin1-to-string sexp) "\n")
+ 'utf-8-unix))
+ (string (concat (slime-net-encode-length (length payload))
+ payload)))
+ (slime-log-event sexp)
+ (process-send-string proc string)))
+
+(defun slime-safe-encoding-p (coding-system string)
+ "Return true iff CODING-SYSTEM can safely encode STRING."
+ (or (let ((candidates (find-coding-systems-string string))
+ (base (coding-system-base coding-system)))
+ (or (equal candidates '(undecided))
+ (memq base candidates)))
+ (and (not (multibyte-string-p string))
+ (not (slime-coding-system-mulibyte-p coding-system)))))
+
+(defun slime-net-close (process &optional debug)
+ (setq slime-net-processes (remove process slime-net-processes))
+ (when (eq process slime-default-connection)
+ (setq slime-default-connection nil))
+ (cond (debug
+ (set-process-sentinel process 'ignore)
+ (set-process-filter process 'ignore)
+ (delete-process process))
+ (t
+ (run-hook-with-args 'slime-net-process-close-hooks process)
+ ;; killing the buffer also closes the socket
+ (kill-buffer (process-buffer process)))))
+
+(defun slime-net-sentinel (process message)
+ (message "Lisp connection closed unexpectedly: %s" message)
+ (slime-net-close process))
+
+;;; Socket input is handled by `slime-net-filter', which decodes any
+;;; complete messages and hands them off to the event dispatcher.
+
+(defun slime-net-filter (process string)
+ "Accept output from the socket and process all complete messages."
+ (with-current-buffer (process-buffer process)
+ (goto-char (point-max))
+ (insert string))
+ (slime-process-available-input process))
+
+(defun slime-process-available-input (process)
+ "Process all complete messages that have arrived from Lisp."
+ (with-current-buffer (process-buffer process)
+ (while (slime-net-have-input-p)
+ (let ((event (slime-net-read-or-lose process))
+ (ok nil))
+ (slime-log-event event)
+ (unwind-protect
+ (save-current-buffer
+ (slime-dispatch-event event process)
+ (setq ok t))
+ (unless ok
+ (slime-run-when-idle 'slime-process-available-input process)))))))
+
+(defun slime-net-have-input-p ()
+ "Return true if a complete message is available."
+ (goto-char (point-min))
+ (and (>= (buffer-size) 6)
+ (>= (- (buffer-size) 6) (slime-net-decode-length))))
+
+(defun slime-run-when-idle (function &rest args)
+ "Call FUNCTION as soon as Emacs is idle."
+ (apply #'run-at-time 0 nil function args))
+
+(defun slime-handle-net-read-error (error)
+ (let ((packet (buffer-string)))
+ (slime-with-popup-buffer ((slime-buffer-name :error))
+ (princ (format "%s\nin packet:\n%s" (error-message-string error) packet))
+ (goto-char (point-min)))
+ (cond ((y-or-n-p "Skip this packet? ")
+ `(:emacs-skipped-packet ,packet))
+ (t
+ (when (y-or-n-p "Enter debugger instead? ")
+ (debug 'error error))
+ (signal (car error) (cdr error))))))
+
+(defun slime-net-read-or-lose (process)
+ (condition-case error
+ (slime-net-read)
+ (error
+ (slime-net-close process t)
+ (error "net-read error: %S" error))))
+
+(defun slime-net-read ()
+ "Read a message from the network buffer."
+ (goto-char (point-min))
+ (let* ((length (slime-net-decode-length))
+ (start (+ (point) 6))
+ (end (+ start length)))
+ (cl-assert (cl-plusp length))
+ (prog1 (save-restriction
+ (narrow-to-region start end)
+ (condition-case error
+ (progn
+ (decode-coding-region start end 'utf-8-unix)
+ (setq end (point-max))
+ (read (current-buffer)))
+ (error
+ (slime-handle-net-read-error error))))
+ (delete-region (point-min) end))))
+
+(defun slime-net-decode-length ()
+ (string-to-number (buffer-substring-no-properties (point) (+ (point) 6))
+ 16))
+
+(defun slime-net-encode-length (n)
+ (format "%06x" n))
+
+(defun slime-prin1-to-string (sexp)
+ "Like `prin1-to-string' but don't octal-escape non-ascii characters.
+This is more compatible with the CL reader."
+ (let (print-escape-nonascii
+ print-escape-newlines
+ print-length
+ print-level)
+ (prin1-to-string sexp)))
+
+
+;;;; Connections
+;;;
+;;; "Connections" are the high-level Emacs<->Lisp networking concept.
+;;;
+;;; Emacs has a connection to each Lisp process that it's interacting
+;;; with. Typically there would only be one, but a user can choose to
+;;; connect to many Lisps simultaneously.
+;;;
+;;; A connection consists of a control socket, optionally an extra
+;;; socket dedicated to receiving Lisp output (an optimization), and a
+;;; set of connection-local state variables.
+;;;
+;;; The state variables are stored as buffer-local variables in the
+;;; control socket's process-buffer and are used via accessor
+;;; functions. These variables include things like the *FEATURES* list
+;;; and Unix Pid of the Lisp process.
+;;;
+;;; One connection is "current" at any given time. This is:
+;;; `slime-dispatching-connection' if dynamically bound, or
+;;; `slime-buffer-connection' if this is set buffer-local, or
+;;; `slime-default-connection' otherwise.
+;;;
+;;; When you're invoking commands in your source files you'll be using
+;;; `slime-default-connection'. This connection can be interactively
+;;; reassigned via the connection-list buffer.
+;;;
+;;; When a command creates a new buffer it will set
+;;; `slime-buffer-connection' so that commands in the new buffer will
+;;; use the connection that the buffer originated from. For example,
+;;; the apropos command creates the *Apropos* buffer and any command
+;;; in that buffer (e.g. `M-.') will go to the same Lisp that did the
+;;; apropos search. REPL buffers are similarly tied to their
+;;; respective connections.
+;;;
+;;; When Emacs is dispatching some network message that arrived from a
+;;; connection it will dynamically bind `slime-dispatching-connection'
+;;; so that the event will be processed in the context of that
+;;; connection.
+;;;
+;;; This is mostly transparent. The user should be aware that he can
+;;; set the default connection to pick which Lisp handles commands in
+;;; Lisp-mode source buffers, and slime hackers should be aware that
+;;; they can tie a buffer to a specific connection. The rest takes
+;;; care of itself.
+
+(defvar slime-dispatching-connection nil
+ "Network process currently executing.
+This is dynamically bound while handling messages from Lisp; it
+overrides `slime-buffer-connection' and `slime-default-connection'.")
+
+(make-variable-buffer-local
+ (defvar slime-buffer-connection nil
+ "Network connection to use in the current buffer.
+This overrides `slime-default-connection'."))
+
+(defvar slime-default-connection nil
+ "Network connection to use by default.
+Used for all Lisp communication, except when overridden by
+`slime-dispatching-connection' or `slime-buffer-connection'.")
+
+(defun slime-current-connection ()
+ "Return the connection to use for Lisp interaction.
+Return nil if there's no connection."
+ (or slime-dispatching-connection
+ slime-buffer-connection
+ slime-default-connection))
+
+(defun slime-connection ()
+ "Return the connection to use for Lisp interaction.
+Signal an error if there's no connection."
+ (let ((conn (slime-current-connection)))
+ (cond ((and (not conn) slime-net-processes)
+ (or (slime-auto-select-connection)
+ (error "No default connection selected.")))
+ ((not conn)
+ (or (slime-auto-start)
+ (error "Not connected.")))
+ ((not (eq (process-status conn) 'open))
+ (error "Connection closed."))
+ (t conn))))
+
+(define-obsolete-variable-alias 'slime-auto-connect
+'slime-auto-start "2.5")
+(defcustom slime-auto-start 'never
+ "Controls auto connection when information from lisp process is needed.
+This doesn't mean it will connect right after Slime is loaded."
+ :group 'slime-mode
+ :type '(choice (const never)
+ (const always)
+ (const ask)))
+
+(defun slime-auto-start ()
+ (cond ((or (eq slime-auto-start 'always)
+ (and (eq slime-auto-start 'ask)
+ (y-or-n-p "No connection. Start Slime? ")))
+ (save-window-excursion
+ (slime)
+ (while (not (slime-current-connection))
+ (sleep-for 1))
+ (slime-connection)))
+ (t nil)))
+
+(defcustom slime-auto-select-connection 'ask
+ "Controls auto selection after the default connection was closed."
+ :group 'slime-mode
+ :type '(choice (const never)
+ (const always)
+ (const ask)))
+
+(defun slime-auto-select-connection ()
+ (let* ((c0 (car slime-net-processes))
+ (c (cond ((eq slime-auto-select-connection 'always) c0)
+ ((and (eq slime-auto-select-connection 'ask)
+ (y-or-n-p
+ (format "No default connection selected. %s %s? "
+ "Switch to" (slime-connection-name c0))))
+ c0))))
+ (when c
+ (slime-select-connection c)
+ (message "Switching to connection: %s" (slime-connection-name c))
+ c)))
+
+(defun slime-select-connection (process)
+ "Make PROCESS the default connection."
+ (setq slime-default-connection process))
+
+(defvar slime-cycle-connections-hook nil)
+
+(defun slime-cycle-connections-within (connections)
+ (let* ((tail (or (cdr (member (slime-current-connection) connections))
+ connections)) ; loop around to the beginning
+ (next (car tail)))
+ (slime-select-connection next)
+ (run-hooks 'slime-cycle-connections-hook)
+ (message "Lisp: %s %s"
+ (slime-connection-name next)
+ (process-contact next))))
+
+(defun slime-next-connection ()
+ "Change current slime connection, cycling through all connections."
+ (interactive)
+ (slime-cycle-connections-within (reverse slime-net-processes)))
+
+(define-obsolete-function-alias 'slime-cycle-connections
+ 'slime-next-connection "2.13")
+
+(defun slime-prev-connection ()
+ "Change current slime connection, cycling through all connections.
+Goes in reverse order, relative to `slime-next-connection'."
+ (interactive)
+ (slime-cycle-connections-within slime-net-processes))
+
+(cl-defmacro slime-with-connection-buffer ((&optional process) &rest body)
+ "Execute BODY in the process-buffer of PROCESS.
+If PROCESS is not specified, `slime-connection' is used.
+
+\(fn (&optional PROCESS) &body BODY))"
+ (declare (indent 1))
+ `(with-current-buffer
+ (process-buffer (or ,process (slime-connection)
+ (error "No connection")))
+ ,@body))
+
+;;; Connection-local variables:
+
+(defmacro slime-def-connection-var (varname &rest initial-value-and-doc)
+ "Define a connection-local variable.
+The value of the variable can be read by calling the function of the
+same name (it must not be accessed directly). The accessor function is
+setf-able.
+
+The actual variable bindings are stored buffer-local in the
+process-buffers of connections. The accessor function refers to
+the binding for `slime-connection'."
+ (declare (indent 2))
+ (let ((real-var (intern (format "%s:connlocal" varname))))
+ `(progn
+ ;; Variable
+ (make-variable-buffer-local
+ (defvar ,real-var ,@initial-value-and-doc))
+ ;; Accessor
+ (defun ,varname (&optional process)
+ (slime-with-connection-buffer (process) ,real-var))
+ ;; Setf
+ (defsetf ,varname (&optional process) (store)
+ `(slime-with-connection-buffer (,process)
+ (setq (\, (quote (\, real-var))) (\, store))))
+ '(\, varname))))
+
+(slime-def-connection-var slime-connection-number nil
+ "Serial number of a connection.
+Bound in the connection's process-buffer.")
+
+(slime-def-connection-var slime-lisp-features '()
+ "The symbol-names of Lisp's *FEATURES*.
+This is automatically synchronized from Lisp.")
+
+(slime-def-connection-var slime-lisp-modules '()
+ "The strings of Lisp's *MODULES*.")
+
+(slime-def-connection-var slime-pid nil
+ "The process id of the Lisp process.")
+
+(slime-def-connection-var slime-lisp-implementation-type nil
+ "The implementation type of the Lisp process.")
+
+(slime-def-connection-var slime-lisp-implementation-version nil
+ "The implementation type of the Lisp process.")
+
+(slime-def-connection-var slime-lisp-implementation-name nil
+ "The short name for the Lisp implementation.")
+
+(slime-def-connection-var slime-lisp-implementation-program nil
+ "The argv[0] of the process running the Lisp implementation.")
+
+(slime-def-connection-var slime-connection-name nil
+ "The short name for connection.")
+
+(slime-def-connection-var slime-inferior-process nil
+ "The inferior process for the connection if any.")
+
+(slime-def-connection-var slime-communication-style nil
+ "The communication style.")
+
+(slime-def-connection-var slime-machine-instance nil
+ "The name of the (remote) machine running the Lisp process.")
+
+(slime-def-connection-var slime-connection-coding-systems nil
+ "Coding systems supported by the Lisp process.")
+
+;;;;; Connection setup
+
+(defvar slime-connection-counter 0
+ "The number of SLIME connections made. For generating serial numbers.")
+
+;;; Interface
+(defun slime-setup-connection (process)
+ "Make a connection out of PROCESS."
+ (let ((slime-dispatching-connection process))
+ (slime-init-connection-state process)
+ (slime-select-connection process)
+ process))
+
+(defun slime-init-connection-state (proc)
+ "Initialize connection state in the process-buffer of PROC."
+ ;; To make life simpler for the user: if this is the only open
+ ;; connection then reset the connection counter.
+ (when (equal slime-net-processes (list proc))
+ (setq slime-connection-counter 0))
+ (slime-with-connection-buffer ()
+ (setq slime-buffer-connection proc))
+ (setf (slime-connection-number proc) (cl-incf slime-connection-counter))
+ ;; We do the rest of our initialization asynchronously. The current
+ ;; function may be called from a timer, and if we setup the REPL
+ ;; from a timer then it mysteriously uses the wrong keymap for the
+ ;; first command.
+ (let ((slime-current-thread t))
+ (slime-eval-async '(swank:connection-info)
+ (slime-curry #'slime-set-connection-info proc))))
+
+(defun slime-set-connection-info (connection info)
+ "Initialize CONNECTION with INFO received from Lisp."
+ (let ((slime-dispatching-connection connection)
+ (slime-current-thread t))
+ (cl-destructuring-bind (&key pid style lisp-implementation machine
+ features version modules encoding
+ &allow-other-keys) info
+ (slime-check-version version connection)
+ (setf (slime-pid) pid
+ (slime-communication-style) style
+ (slime-lisp-features) features
+ (slime-lisp-modules) modules)
+ (cl-destructuring-bind (&key type name version program)
+ lisp-implementation
+ (setf (slime-lisp-implementation-type) type
+ (slime-lisp-implementation-version) version
+ (slime-lisp-implementation-name) name
+ (slime-lisp-implementation-program) program
+ (slime-connection-name) (slime-generate-connection-name name)))
+ (cl-destructuring-bind (&key instance ((:type _)) ((:version _))) machine
+ (setf (slime-machine-instance) instance))
+ (cl-destructuring-bind (&key coding-systems) encoding
+ (setf (slime-connection-coding-systems) coding-systems)))
+ (let ((args (let ((p (slime-inferior-process)))
+ (if p (slime-inferior-lisp-args p)))))
+ (let ((name (plist-get args ':name)))
+ (when name
+ (unless (string= (slime-lisp-implementation-name) name)
+ (setf (slime-connection-name)
+ (slime-generate-connection-name (symbol-name name))))))
+ (slime-load-contribs)
+ (run-hooks 'slime-connected-hook)
+ (let ((fun (plist-get args ':init-function)))
+ (when fun (funcall fun))))
+ (message "Connected. %s" (slime-random-words-of-encouragement))))
+
+(defun slime-check-version (version conn)
+ (or (equal version slime-protocol-version)
+ (equal slime-protocol-version 'ignore)
+ (y-or-n-p
+ (format "Versions differ: %s (slime) vs. %s (swank). Continue? "
+ slime-protocol-version version))
+ (slime-net-close conn)
+ (top-level)))
+
+(defun slime-generate-connection-name (lisp-name)
+ (cl-loop for i from 1
+ for name = lisp-name then (format "%s<%d>" lisp-name i)
+ while (cl-find name slime-net-processes
+ :key #'slime-connection-name :test #'equal)
+ finally (cl-return name)))
+
+(defun slime-connection-close-hook (process)
+ (when (eq process slime-default-connection)
+ (when slime-net-processes
+ (slime-select-connection (car slime-net-processes))
+ (message "Default connection closed; switched to #%S (%S)"
+ (slime-connection-number)
+ (slime-connection-name)))))
+
+(add-hook 'slime-net-process-close-hooks 'slime-connection-close-hook)
+
+;;;;; Commands on connections
+
+(defun slime-disconnect ()
+ "Close the current connection."
+ (interactive)
+ (slime-net-close (slime-connection)))
+
+(defun slime-disconnect-all ()
+ "Disconnect all connections."
+ (interactive)
+ (mapc #'slime-net-close slime-net-processes))
+
+(defun slime-connection-port (connection)
+ "Return the remote port number of CONNECTION."
+ (cadr (process-contact connection)))
+
+(defun slime-process (&optional connection)
+ "Return the Lisp process for CONNECTION (default `slime-connection').
+Return nil if there's no process object for the connection."
+ (let ((proc (slime-inferior-process connection)))
+ (if (and proc
+ (memq (process-status proc) '(run stop)))
+ proc)))
+
+;; Non-macro version to keep the file byte-compilable.
+(defun slime-set-inferior-process (connection process)
+ (setf (slime-inferior-process connection) process))
+
+(defun slime-use-sigint-for-interrupt (&optional connection)
+ (let ((c (or connection (slime-connection))))
+ (cl-ecase (slime-communication-style c)
+ ((:fd-handler nil) t)
+ ((:spawn :sigio) nil))))
+
+(defvar slime-inhibit-pipelining t
+ "*If true, don't send background requests if Lisp is already busy.")
+
+(defun slime-background-activities-enabled-p ()
+ (and (let ((con (slime-current-connection)))
+ (and con
+ (eq (process-status con) 'open)))
+ (or (not (slime-busy-p))
+ (not slime-inhibit-pipelining))))
+
+
+;;;; Communication protocol
+
+;;;;; Emacs Lisp programming interface
+;;;
+;;; The programming interface for writing Emacs commands is based on
+;;; remote procedure calls (RPCs). The basic operation is to ask Lisp
+;;; to apply a named Lisp function to some arguments, then to do
+;;; something with the result.
+;;;
+;;; Requests can be either synchronous (blocking) or asynchronous
+;;; (with the result passed to a callback/continuation function). If
+;;; an error occurs during the request then the debugger is entered
+;;; before the result arrives -- for synchronous evaluations this
+;;; requires a recursive edit.
+;;;
+;;; You should use asynchronous evaluations (`slime-eval-async') for
+;;; most things. Reserve synchronous evaluations (`slime-eval') for
+;;; the cases where blocking Emacs is really appropriate (like
+;;; completion) and that shouldn't trigger errors (e.g. not evaluate
+;;; user-entered code).
+;;;
+;;; We have the concept of the "current Lisp package". RPC requests
+;;; always say what package the user is making them from and the Lisp
+;;; side binds that package to *BUFFER-PACKAGE* to use as it sees
+;;; fit. The current package is defined as the buffer-local value of
+;;; `slime-buffer-package' if set, and otherwise the package named by
+;;; the nearest IN-PACKAGE as found by text search (cl-first backwards,
+;;; then forwards).
+;;;
+;;; Similarly we have the concept of the current thread, i.e. which
+;;; thread in the Lisp process should handle the request. The current
+;;; thread is determined solely by the buffer-local value of
+;;; `slime-current-thread'. This is usually bound to t meaning "no
+;;; particular thread", but can also be used to nominate a specific
+;;; thread. The REPL and the debugger both use this feature to deal
+;;; with specific threads.
+
+(make-variable-buffer-local
+ (defvar slime-current-thread t
+ "The id of the current thread on the Lisp side.
+t means the \"current\" thread;
+:repl-thread the thread that executes REPL requests;
+fixnum a specific thread."))
+
+(make-variable-buffer-local
+ (defvar slime-buffer-package nil
+ "The Lisp package associated with the current buffer.
+This is set only in buffers bound to specific packages."))
+
+;;; `slime-rex' is the RPC primitive which is used to implement both
+;;; `slime-eval' and `slime-eval-async'. You can use it directly if
+;;; you need to, but the others are usually more convenient.
+
+(cl-defmacro slime-rex ((&rest saved-vars)
+ (sexp &optional
+ (package '(slime-current-package))
+ (thread 'slime-current-thread))
+ &rest continuations)
+ "(slime-rex (VAR ...) (SEXP &optional PACKAGE THREAD) CLAUSES ...)
+
+Remote EXecute SEXP.
+
+VARs are a list of saved variables visible in the other forms. Each
+VAR is either a symbol or a list (VAR INIT-VALUE).
+
+SEXP is evaluated and the princed version is sent to Lisp.
+
+PACKAGE is evaluated and Lisp binds *BUFFER-PACKAGE* to this package.
+The default value is (slime-current-package).
+
+CLAUSES is a list of patterns with same syntax as
+`slime-dcase'. The result of the evaluation of SEXP is
+dispatched on CLAUSES. The result is either a sexp of the
+form (:ok VALUE) or (:abort CONDITION). CLAUSES is executed
+asynchronously.
+
+Note: don't use backquote syntax for SEXP, because various Emacs
+versions cannot deal with that."
+ (declare (indent 2))
+ (let ((result (cl-gensym)))
+ `(lexical-let ,(cl-loop for var in saved-vars
+ collect (cl-etypecase var
+ (symbol (list var var))
+ (cons var)))
+ (slime-dispatch-event
+ (list :emacs-rex ,sexp ,package ,thread
+ (lambda (,result)
+ (slime-dcase ,result
+ ,@continuations)))))))
+
+;;; Interface
+(defun slime-current-package ()
+ "Return the Common Lisp package in the current context.
+If `slime-buffer-package' has a value then return that, otherwise
+search for and read an `in-package' form."
+ (or slime-buffer-package
+ (save-restriction
+ (widen)
+ (slime-find-buffer-package))))
+
+(defvar slime-find-buffer-package-function 'slime-search-buffer-package
+ "*Function to use for `slime-find-buffer-package'.
+The result should be the package-name (a string)
+or nil if nothing suitable can be found.")
+
+(defun slime-find-buffer-package ()
+ "Figure out which Lisp package the current buffer is associated with."
+ (funcall slime-find-buffer-package-function))
+
+(make-variable-buffer-local
+ (defvar slime-package-cache nil
+ "Cons of the form (buffer-modified-tick . package)"))
+
+;; When modifing this code consider cases like:
+;; (in-package #.*foo*)
+;; (in-package #:cl)
+;; (in-package :cl)
+;; (in-package "CL")
+;; (in-package |CL|)
+;; (in-package #+ansi-cl :cl #-ansi-cl 'lisp)
+
+(defun slime-search-buffer-package ()
+ (let ((case-fold-search t)
+ (regexp (concat "^(\\(cl:\\|common-lisp:\\)?in-package\\>[ \t']*"
+ "\\([^)]+\\)[ \t]*)")))
+ (save-excursion
+ (when (or (re-search-backward regexp nil t)
+ (re-search-forward regexp nil t))
+ (match-string-no-properties 2)))))
+
+;;; Synchronous requests are implemented in terms of asynchronous
+;;; ones. We make an asynchronous request with a continuation function
+;;; that `throw's its result up to a `catch' and then enter a loop of
+;;; handling I/O until that happens.
+
+(defvar slime-stack-eval-tags nil
+ "List of stack-tags of continuations waiting on the stack.")
+
+(defun slime-eval (sexp &optional package)
+ "Evaluate EXPR on the superior Lisp and return the result."
+ (when (null package) (setq package (slime-current-package)))
+ (let* ((tag (cl-gensym (format "slime-result-%d-"
+ (1+ (slime-continuation-counter)))))
+ (slime-stack-eval-tags (cons tag slime-stack-eval-tags)))
+ (apply
+ #'funcall
+ (catch tag
+ (slime-rex (tag sexp)
+ (sexp package)
+ ((:ok value)
+ (unless (member tag slime-stack-eval-tags)
+ (error "Reply to canceled synchronous eval request tag=%S sexp=%S"
+ tag sexp))
+ (throw tag (list #'identity value)))
+ ((:abort _condition)
+ (throw tag (list #'error "Synchronous Lisp Evaluation aborted"))))
+ (let ((debug-on-quit t)
+ (inhibit-quit nil)
+ (conn (slime-connection)))
+ (while t
+ (unless (eq (process-status conn) 'open)
+ (error "Lisp connection closed unexpectedly"))
+ (accept-process-output nil 0.01)))))))
+
+(defun slime-eval-async (sexp &optional cont package)
+ "Evaluate EXPR on the superior Lisp and call CONT with the result."
+ (declare (indent 1))
+ (slime-rex (cont (buffer (current-buffer)))
+ (sexp (or package (slime-current-package)))
+ ((:ok result)
+ (when cont
+ (set-buffer buffer)
+ (funcall cont result)))
+ ((:abort condition)
+ (message "Evaluation aborted on %s." condition)))
+ ;; Guard against arbitrary return values which once upon a time
+ ;; showed up in the minibuffer spuriously (due to a bug in
+ ;; slime-autodoc.) If this ever happens again, returning the
+ ;; following will make debugging much easier:
+ :slime-eval-async)
+
+;;; These functions can be handy too:
+
+(defun slime-connected-p ()
+ "Return true if the Swank connection is open."
+ (not (null slime-net-processes)))
+
+(defun slime-check-connected ()
+ "Signal an error if we are not connected to Lisp."
+ (unless (slime-connected-p)
+ (error "Not connected. Use `%s' to start a Lisp."
+ (substitute-command-keys "\\[slime]"))))
+
+;; UNUSED
+(defun slime-debugged-connection-p (conn)
+ ;; This previously was (AND (SLDB-DEBUGGED-CONTINUATIONS CONN) T),
+ ;; but an SLDB buffer may exist without having continuations
+ ;; attached to it, e.g. the one resulting from `slime-interrupt'.
+ (cl-loop for b in (sldb-buffers)
+ thereis (with-current-buffer b
+ (eq slime-buffer-connection conn))))
+
+(defun slime-busy-p (&optional conn)
+ "True if Lisp has outstanding requests.
+Debugged requests are ignored."
+ (let ((debugged (sldb-debugged-continuations (or conn (slime-connection)))))
+ (cl-remove-if (lambda (id)
+ (memq id debugged))
+ (slime-rex-continuations)
+ :key #'car)))
+
+(defun slime-sync ()
+ "Block until the most recent request has finished."
+ (when (slime-rex-continuations)
+ (let ((tag (caar (slime-rex-continuations))))
+ (while (cl-find tag (slime-rex-continuations) :key #'car)
+ (accept-process-output nil 0.1)))))
+
+(defun slime-ping ()
+ "Check that communication works."
+ (interactive)
+ (message "%s" (slime-eval "PONG")))
+
+;;;;; Protocol event handler (cl-the guts)
+;;;
+;;; This is the protocol in all its glory. The input to this function
+;;; is a protocol event that either originates within Emacs or arrived
+;;; over the network from Lisp.
+;;;
+;;; Each event is a list beginning with a keyword and followed by
+;;; arguments. The keyword identifies the type of event. Events
+;;; originating from Emacs have names starting with :emacs- and events
+;;; from Lisp don't.
+
+(slime-def-connection-var slime-rex-continuations '()
+ "List of (ID . FUNCTION) continuations waiting for RPC results.")
+
+(slime-def-connection-var slime-continuation-counter 0
+ "Continuation serial number counter.")
+
+(defvar slime-event-hooks)
+
+(defun slime-dispatch-event (event &optional process)
+ (let ((slime-dispatching-connection (or process (slime-connection))))
+ (or (run-hook-with-args-until-success 'slime-event-hooks event)
+ (slime-dcase event
+ ((:emacs-rex form package thread continuation)
+ (when (and (slime-use-sigint-for-interrupt) (slime-busy-p))
+ (slime-display-oneliner "; pipelined request... %S" form))
+ (let ((id (cl-incf (slime-continuation-counter))))
+ (slime-send `(:emacs-rex ,form ,package ,thread ,id))
+ (push (cons id continuation) (slime-rex-continuations))
+ (slime--recompute-modelines)))
+ ((:return value id)
+ (let ((rec (assq id (slime-rex-continuations))))
+ (cond (rec (setf (slime-rex-continuations)
+ (remove rec (slime-rex-continuations)))
+ (slime--recompute-modelines)
+ (funcall (cdr rec) value))
+ (t
+ (error "Unexpected reply: %S %S" id value)))))
+ ((:debug-activate thread level &optional select)
+ (cl-assert thread)
+ (sldb-activate thread level select))
+ ((:debug thread level condition restarts frames conts)
+ (cl-assert thread)
+ (sldb-setup thread level condition restarts frames conts))
+ ((:debug-return thread level stepping)
+ (cl-assert thread)
+ (sldb-exit thread level stepping))
+ ((:emacs-interrupt thread)
+ (slime-send `(:emacs-interrupt ,thread)))
+ ((:channel-send id msg)
+ (slime-channel-send (or (slime-find-channel id)
+ (error "Invalid channel id: %S %S" id msg))
+ msg))
+ ((:emacs-channel-send id msg)
+ (slime-send `(:emacs-channel-send ,id ,msg)))
+ ((:read-from-minibuffer thread tag prompt initial-value)
+ (slime-read-from-minibuffer-for-swank thread tag prompt
+ initial-value))
+ ((:y-or-n-p thread tag question)
+ (slime-y-or-n-p thread tag question))
+ ((:emacs-return-string thread tag string)
+ (slime-send `(:emacs-return-string ,thread ,tag ,string)))
+ ((:new-features features)
+ (setf (slime-lisp-features) features))
+ ((:indentation-update info)
+ (slime-handle-indentation-update info))
+ ((:eval-no-wait form)
+ (slime-check-eval-in-emacs-enabled)
+ (eval (read form)))
+ ((:eval thread tag form-string)
+ (slime-check-eval-in-emacs-enabled)
+ (slime-eval-for-lisp thread tag form-string))
+ ((:emacs-return thread tag value)
+ (slime-send `(:emacs-return ,thread ,tag ,value)))
+ ((:ed what)
+ (slime-ed what))
+ ((:inspect what thread tag)
+ (let ((hook (when (and thread tag)
+ (slime-curry #'slime-send
+ `(:emacs-return ,thread ,tag nil)))))
+ (slime-open-inspector what nil hook)))
+ ((:background-message message)
+ (slime-background-message "%s" message))
+ ((:debug-condition thread message)
+ (cl-assert thread)
+ (message "%s" message))
+ ((:ping thread tag)
+ (slime-send `(:emacs-pong ,thread ,tag)))
+ ((:reader-error packet condition)
+ (slime-with-popup-buffer ((slime-buffer-name :error))
+ (princ (format "Invalid protocol message:\n%s\n\n%s"
+ condition packet))
+ (goto-char (point-min)))
+ (error "Invalid protocol message"))
+ ((:invalid-rpc id message)
+ (setf (slime-rex-continuations)
+ (cl-remove id (slime-rex-continuations) :key #'car))
+ (error "Invalid rpc: %s" message))
+ ((:emacs-skipped-packet _pkg))
+ ((:test-delay seconds) ; for testing only
+ (sit-for seconds))))))
+
+(defun slime-send (sexp)
+ "Send SEXP directly over the wire on the current connection."
+ (slime-net-send sexp (slime-connection)))
+
+(defun slime-reset ()
+ "Clear all pending continuations and erase connection buffer."
+ (interactive)
+ (setf (slime-rex-continuations) '())
+ (mapc #'kill-buffer (sldb-buffers))
+ (slime-with-connection-buffer ()
+ (erase-buffer)))
+
+(defun slime-send-sigint ()
+ (interactive)
+ (signal-process (slime-pid) 'SIGINT))
+
+;;;;; Channels
+
+;;; A channel implements a set of operations. Those operations can be
+;;; invoked by sending messages to the channel. Channels are used for
+;;; protocols which can't be expressed naturally with RPCs, e.g. for
+;;; streaming data over the wire.
+;;;
+;;; A channel can be "remote" or "local". Remote channels are
+;;; represented by integers. Local channels are structures. Messages
+;;; sent to a closed (remote) channel are ignored.
+
+(slime-def-connection-var slime-channels '()
+ "Alist of the form (ID . CHANNEL).")
+
+(slime-def-connection-var slime-channels-counter 0
+ "Channel serial number counter.")
+
+(cl-defstruct (slime-channel (:conc-name slime-channel.)
+ (:constructor
+ slime-make-channel% (operations name id plist)))
+ operations name id plist)
+
+(defun slime-make-channel (operations &optional name)
+ (let* ((id (cl-incf (slime-channels-counter)))
+ (ch (slime-make-channel% operations name id nil)))
+ (push (cons id ch) (slime-channels))
+ ch))
+
+(defun slime-close-channel (channel)
+ (setf (slime-channel.operations channel) 'closed-channel)
+ (let ((probe (assq (slime-channel.id channel) (slime-channels))))
+ (cond (probe (setf (slime-channels) (delete probe (slime-channels))))
+ (t (error "Invalid channel: %s" channel)))))
+
+(defun slime-find-channel (id)
+ (cdr (assq id (slime-channels))))
+
+(defun slime-channel-send (channel message)
+ (apply (or (gethash (car message) (slime-channel.operations channel))
+ (error "Unsupported operation: %S %S" message channel))
+ channel (cdr message)))
+
+(defun slime-channel-put (channel prop value)
+ (setf (slime-channel.plist channel)
+ (plist-put (slime-channel.plist channel) prop value)))
+
+(defun slime-channel-get (channel prop)
+ (plist-get (slime-channel.plist channel) prop))
+
+(eval-and-compile
+ (defun slime-channel-method-table-name (type)
+ (intern (format "slime-%s-channel-methods" type))))
+
+(defmacro slime-define-channel-type (name)
+ (declare (indent defun))
+ (let ((tab (slime-channel-method-table-name name)))
+ `(progn
+ (defvar ,tab)
+ (setq ,tab (make-hash-table :size 10)))))
+
+(defmacro slime-define-channel-method (type method args &rest body)
+ (declare (indent 3) (debug (&define name sexp lambda-list
+ def-body)))
+ `(puthash ',method
+ (lambda (self . ,args) . ,body)
+ ,(slime-channel-method-table-name type)))
+
+(defun slime-send-to-remote-channel (channel-id msg)
+ (slime-dispatch-event `(:emacs-channel-send ,channel-id ,msg)))
+
+;;;;; Event logging to *slime-events*
+;;;
+;;; The *slime-events* buffer logs all protocol messages for debugging
+;;; purposes. Optionally you can enable outline-mode in that buffer,
+;;; which is convenient but slows things down significantly.
+
+(defvar slime-log-events t
+ "*Log protocol events to the *slime-events* buffer.")
+
+(defvar slime-outline-mode-in-events-buffer nil
+ "*Non-nil means use outline-mode in *slime-events*.")
+
+(defvar slime-event-buffer-name (slime-buffer-name :events)
+ "The name of the slime event buffer.")
+
+(defun slime-log-event (event)
+ "Record the fact that EVENT occurred."
+ (when slime-log-events
+ (with-current-buffer (slime-events-buffer)
+ ;; trim?
+ (when (> (buffer-size) 100000)
+ (goto-char (/ (buffer-size) 2))
+ (re-search-forward "^(" nil t)
+ (delete-region (point-min) (point)))
+ (goto-char (point-max))
+ (save-excursion
+ (slime-pprint-event event (current-buffer)))
+ (when (and (boundp 'outline-minor-mode)
+ outline-minor-mode)
+ (hide-entry))
+ (goto-char (point-max)))))
+
+(defun slime-pprint-event (event buffer)
+ "Pretty print EVENT in BUFFER with limited depth and width."
+ (let ((print-length 20)
+ (print-level 6)
+ (pp-escape-newlines t))
+ (pp event buffer)))
+
+(defun slime-events-buffer ()
+ "Return or create the event log buffer."
+ (or (get-buffer slime-event-buffer-name)
+ (let ((buffer (get-buffer-create slime-event-buffer-name)))
+ (with-current-buffer buffer
+ (buffer-disable-undo)
+ (set (make-local-variable 'outline-regexp) "^(")
+ (set (make-local-variable 'comment-start) ";")
+ (set (make-local-variable 'comment-end) "")
+ (when slime-outline-mode-in-events-buffer
+ (outline-minor-mode)))
+ buffer)))
+
+
+;;;;; Cleanup after a quit
+
+(defun slime-restart-inferior-lisp ()
+ "Kill and restart the Lisp subprocess."
+ (interactive)
+ (cl-assert (slime-inferior-process) () "No inferior lisp process")
+ (slime-quit-lisp-internal (slime-connection) 'slime-restart-sentinel t))
+
+(defun slime-restart-sentinel (process _message)
+ "Restart the inferior lisp process.
+Also rearrange windows."
+ (cl-assert (process-status process) 'closed)
+ (let* ((proc (slime-inferior-process process))
+ (args (slime-inferior-lisp-args proc))
+ (buffer (buffer-name (process-buffer proc)))
+ ;;(buffer-window (get-buffer-window buffer))
+ (new-proc (slime-start-lisp (plist-get args :program)
+ (plist-get args :program-args)
+ (plist-get args :env)
+ nil
+ buffer)))
+ (slime-net-close process)
+ (slime-inferior-connect new-proc args)
+ (switch-to-buffer buffer)
+ (goto-char (point-max))))
+
+
+;;;; Compilation and the creation of compiler-note annotations
+
+(defvar slime-highlight-compiler-notes t
+ "*When non-nil annotate buffers with compilation notes etc.")
+
+(defvar slime-before-compile-functions nil
+ "A list of function called before compiling a buffer or region.
+The function receive two arguments: the beginning and the end of the
+region that will be compiled.")
+
+;; FIXME: remove some of the options
+(defcustom slime-compilation-finished-hook 'slime-maybe-show-compilation-log
+ "Hook called with a list of compiler notes after a compilation."
+ :group 'slime-mode
+ :type 'hook
+ :options '(slime-maybe-show-compilation-log
+ slime-create-compilation-log
+ slime-show-compilation-log
+ slime-maybe-list-compiler-notes
+ slime-list-compiler-notes
+ slime-maybe-show-xrefs-for-notes
+ slime-goto-first-note))
+
+;; FIXME: I doubt that anybody uses this directly and it seems to be
+;; only an ugly way to pass arguments.
+(defvar slime-compilation-policy nil
+ "When non-nil compile with these optimization settings.")
+
+(defun slime-compute-policy (arg)
+ "Return the policy for the prefix argument ARG."
+ (let ((between (lambda (min n max)
+ (cond ((< n min) min)
+ ((> n max) max)
+ (t n)))))
+ (let ((n (prefix-numeric-value arg)))
+ (cond ((not arg) slime-compilation-policy)
+ ((cl-plusp n) `((cl:debug . ,(funcall between 0 n 3))))
+ ((eq arg '-) `((cl:speed . 3)))
+ (t `((cl:speed . ,(funcall between 0 (abs n) 3))))))))
+
+(cl-defstruct (slime-compilation-result
+ (:type list)
+ (:conc-name slime-compilation-result.)
+ (:constructor nil)
+ (:copier nil))
+ tag notes successp duration loadp faslfile)
+
+(defvar slime-last-compilation-result nil
+ "The result of the most recently issued compilation.")
+
+(defun slime-compiler-notes ()
+ "Return all compiler notes, warnings, and errors."
+ (slime-compilation-result.notes slime-last-compilation-result))
+
+(defun slime-compile-and-load-file (&optional policy)
+ "Compile and load the buffer's file and highlight compiler notes.
+
+With (positive) prefix argument the file is compiled with maximal
+debug settings (`C-u'). With negative prefix argument it is compiled for
+speed (`M--'). If a numeric argument is passed set debug or speed settings
+to it depending on its sign.
+
+Each source location that is the subject of a compiler note is
+underlined and annotated with the relevant information. The commands
+`slime-next-note' and `slime-previous-note' can be used to navigate
+between compiler notes and to display their full details."
+ (interactive "P")
+ (slime-compile-file t (slime-compute-policy policy)))
+
+(defcustom slime-compile-file-options '()
+ "Plist of additional options that C-c C-k should pass to Lisp.
+Currently only :fasl-directory is supported."
+ :group 'slime-lisp
+ :type '(plist :key-type symbol :value-type (file :must-match t)))
+
+(defun slime-compile-file (&optional load policy)
+ "Compile current buffer's file and highlight resulting compiler notes.
+
+See `slime-compile-and-load-file' for further details."
+ (interactive)
+ (unless buffer-file-name
+ (error "Buffer %s is not associated with a file." (buffer-name)))
+ (check-parens)
+ (slime--maybe-save-buffer)
+ (run-hook-with-args 'slime-before-compile-functions (point-min) (point-max))
+ (let ((file (slime-to-lisp-filename (buffer-file-name)))
+ (options (slime-simplify-plist `(,@slime-compile-file-options
+ :policy ,policy))))
+ (slime-eval-async
+ `(swank:compile-file-for-emacs ,file ,(if load t nil)
+ . ,(slime-hack-quotes options))
+ #'slime-compilation-finished)
+ (message "Compiling %s..." file)))
+
+;; FIXME: compilation-save-buffers-predicate was introduced in 24.1
+(defun slime--maybe-save-buffer ()
+ (let ((slime--this-buffer (current-buffer)))
+ (save-some-buffers (not compilation-ask-about-save)
+ (lambda () (eq (current-buffer) slime--this-buffer)))))
+
+(defun slime-hack-quotes (arglist)
+ ;; eval is the wrong primitive, we really want funcall
+ (cl-loop for arg in arglist collect `(quote ,arg)))
+
+(defun slime-simplify-plist (plist)
+ (cl-loop for (key val) on plist by #'cddr
+ append (cond ((null val) '())
+ (t (list key val)))))
+
+(defun slime-compile-defun (&optional raw-prefix-arg)
+ "Compile the current toplevel form.
+
+With (positive) prefix argument the form is compiled with maximal
+debug settings (`C-u'). With negative prefix argument it is compiled for
+speed (`M--'). If a numeric argument is passed set debug or speed settings
+to it depending on its sign."
+ (interactive "P")
+ (let ((slime-compilation-policy (slime-compute-policy raw-prefix-arg)))
+ (if (use-region-p)
+ (slime-compile-region (region-beginning) (region-end))
+ (apply #'slime-compile-region (slime-region-for-defun-at-point)))))
+
+(defun slime-compile-region (start end)
+ "Compile the region."
+ (interactive "r")
+ ;; Check connection before running hooks things like
+ ;; slime-flash-region don't make much sense if there's no connection
+ (slime-connection)
+ (slime-flash-region start end)
+ (run-hook-with-args 'slime-before-compile-functions start end)
+ (slime-compile-string (buffer-substring-no-properties start end) start))
+
+(defun slime-flash-region (start end &optional timeout)
+ "Temporarily highlight region from START to END."
+ (let ((overlay (make-overlay start end)))
+ (overlay-put overlay 'face 'secondary-selection)
+ (run-with-timer (or timeout 0.2) nil 'delete-overlay overlay)))
+
+(defun slime-compile-string (string start-offset)
+ (let* ((line (save-excursion
+ (goto-char start-offset)
+ (list (line-number-at-pos) (1+ (current-column)))))
+ (position `((:position ,start-offset) (:line ,@line))))
+ (slime-eval-async
+ `(swank:compile-string-for-emacs
+ ,string
+ ,(buffer-name)
+ ',position
+ ,(if (buffer-file-name) (slime-to-lisp-filename (buffer-file-name)))
+ ',slime-compilation-policy)
+ #'slime-compilation-finished)))
+
+(defcustom slime-load-failed-fasl 'ask
+ "Which action to take when COMPILE-FILE set FAILURE-P to T.
+NEVER doesn't load the fasl
+ALWAYS loads the fasl
+ASK asks the user."
+ :type '(choice (const never)
+ (const always)
+ (const ask)))
+
+(defun slime-load-failed-fasl-p ()
+ (cl-ecase slime-load-failed-fasl
+ (never nil)
+ (always t)
+ (ask (y-or-n-p "Compilation failed. Load fasl file anyway? "))))
+
+(defun slime-compilation-finished (result)
+ (with-struct (slime-compilation-result. notes duration successp
+ loadp faslfile) result
+ (setf slime-last-compilation-result result)
+ (slime-show-note-counts notes duration (cond ((not loadp) successp)
+ (t (and faslfile successp))))
+ (when slime-highlight-compiler-notes
+ (slime-highlight-notes notes))
+ (run-hook-with-args 'slime-compilation-finished-hook notes)
+ (when (and loadp faslfile
+ (or successp
+ (slime-load-failed-fasl-p)))
+ (slime-eval-async `(swank:load-file ,faslfile)))))
+
+(defun slime-show-note-counts (notes secs successp)
+ (message (concat
+ (cond (successp "Compilation finished")
+ (t (slime-add-face 'font-lock-warning-face
+ "Compilation failed")))
+ (if (null notes) ". (No warnings)" ": ")
+ (mapconcat
+ (lambda (messages)
+ (cl-destructuring-bind (sev . notes) messages
+ (let ((len (length notes)))
+ (format "%d %s%s" len (slime-severity-label sev)
+ (if (= len 1) "" "s")))))
+ (sort (slime-alistify notes #'slime-note.severity #'eq)
+ (lambda (x y) (slime-severity< (car y) (car x))))
+ " ")
+ (if secs (format " [%.2f secs]" secs)))))
+
+(defun slime-highlight-notes (notes)
+ "Highlight compiler notes, warnings, and errors in the buffer."
+ (interactive (list (slime-compiler-notes)))
+ (with-temp-message "Highlighting notes..."
+ (save-excursion
+ (save-restriction
+ (widen) ; highlight notes on the whole buffer
+ (slime-remove-old-overlays)
+ (mapc #'slime-overlay-note (slime-merge-notes-for-display notes))))))
+
+(defvar slime-note-overlays '()
+ "List of overlays created by `slime-make-note-overlay'")
+
+(defun slime-remove-old-overlays ()
+ "Delete the existing note overlays."
+ (mapc #'delete-overlay slime-note-overlays)
+ (setq slime-note-overlays '()))
+
+(defun slime-filter-buffers (predicate)
+ "Return a list of where PREDICATE returns true.
+PREDICATE is executed in the buffer to test."
+ (cl-remove-if-not (lambda (%buffer)
+ (with-current-buffer %buffer
+ (funcall predicate)))
+ (buffer-list)))
+
+;;;;; Recompilation.
+
+;; FIXME: This whole idea is questionable since it depends so
+;; crucially on precise source-locs.
+
+(defun slime-recompile-location (location)
+ (save-excursion
+ (slime-goto-source-location location)
+ (slime-compile-defun)))
+
+(defun slime-recompile-locations (locations cont)
+ (slime-eval-async
+ `(swank:compile-multiple-strings-for-emacs
+ ',(cl-loop for loc in locations collect
+ (save-excursion
+ (slime-goto-source-location loc)
+ (cl-destructuring-bind (start end)
+ (slime-region-for-defun-at-point)
+ (list (buffer-substring-no-properties start end)
+ (buffer-name)
+ (slime-current-package)
+ start
+ (if (buffer-file-name)
+ (slime-to-lisp-filename (buffer-file-name))
+ nil)))))
+ ',slime-compilation-policy)
+ cont))
+
+
+;;;;; Merging together compiler notes in the same location.
+
+(defun slime-merge-notes-for-display (notes)
+ "Merge together notes that refer to the same location.
+This operation is \"lossy\" in the broad sense but not for display purposes."
+ (mapcar #'slime-merge-notes
+ (slime-group-similar 'slime-notes-in-same-location-p notes)))
+
+(defun slime-merge-notes (notes)
+ "Merge NOTES together. Keep the highest severity, concatenate the messages."
+ (let* ((new-severity (cl-reduce #'slime-most-severe notes
+ :key #'slime-note.severity))
+ (new-message (mapconcat #'slime-note.message notes "\n")))
+ (let ((new-note (cl-copy-list (car notes))))
+ (setf (cl-getf new-note :message) new-message)
+ (setf (cl-getf new-note :severity) new-severity)
+ new-note)))
+
+(defun slime-notes-in-same-location-p (a b)
+ (equal (slime-note.location a) (slime-note.location b)))
+
+
+;;;;; Compiler notes list
+
+(defun slime-one-line-ify (string)
+ "Return a single-line version of STRING.
+Each newlines and following indentation is replaced by a single space."
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (while (re-search-forward "\n[\n \t]*" nil t)
+ (replace-match " "))
+ (buffer-string)))
+
+(defun slime-xrefs-for-notes (notes)
+ (let ((xrefs))
+ (dolist (note notes)
+ (let* ((location (cl-getf note :location))
+ (fn (cadr (assq :file (cdr location))))
+ (file (assoc fn xrefs))
+ (node
+ (list (format "%s: %s"
+ (cl-getf note :severity)
+ (slime-one-line-ify (cl-getf note :message)))
+ location)))
+ (when fn
+ (if file
+ (push node (cdr file))
+ (setf xrefs (cl-acons fn (list node) xrefs))))))
+ xrefs))
+
+(defun slime-maybe-show-xrefs-for-notes (notes)
+ "Show the compiler notes NOTES if they come from more than one file."
+ (let ((xrefs (slime-xrefs-for-notes notes)))
+ (when (slime-length> xrefs 1) ; >1 file
+ (slime-show-xrefs
+ xrefs 'definition "Compiler notes" (slime-current-package)))))
+
+(defun slime-note-has-location-p (note)
+ (not (eq ':error (car (slime-note.location note)))))
+
+(defun slime-redefinition-note-p (note)
+ (eq (slime-note.severity note) :redefinition))
+
+(defun slime-create-compilation-log (notes)
+ "Create a buffer for `next-error' to use."
+ (with-current-buffer (get-buffer-create (slime-buffer-name :compilation))
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (slime-insert-compilation-log notes)
+ (compilation-mode)))
+
+(defun slime-maybe-show-compilation-log (notes)
+ "Display the log on failed compilations or if NOTES is non-nil."
+ (slime-create-compilation-log notes)
+ (with-struct (slime-compilation-result. notes duration successp)
+ slime-last-compilation-result
+ (unless successp
+ (with-current-buffer (slime-buffer-name :compilation)
+ (let ((inhibit-read-only t))
+ (goto-char (point-max))
+ (insert "Compilation " (if successp "succeeded." "failed."))
+ (goto-char (point-min))
+ (display-buffer (current-buffer)))))))
+
+(defun slime-show-compilation-log (notes)
+ "Create and display the compilation log buffer."
+ (interactive (list (slime-compiler-notes)))
+ (slime-with-popup-buffer ((slime-buffer-name :compilation)
+ :mode 'compilation-mode)
+ (slime-insert-compilation-log notes)))
+
+(defun slime-insert-compilation-log (notes)
+ "Insert NOTES in format suitable for `compilation-mode'."
+ (cl-destructuring-bind (grouped-notes canonicalized-locs-table)
+ (slime-group-and-sort-notes notes)
+ (with-temp-message "Preparing compilation log..."
+ (let ((inhibit-read-only t)
+ (inhibit-modification-hooks t)) ; inefficient font-lock-hook
+ (insert (format "cd %s\n%d compiler notes:\n\n"
+ default-directory (length notes)))
+ (dolist (notes grouped-notes)
+ (let ((loc (gethash (cl-first notes) canonicalized-locs-table))
+ (start (point)))
+ (insert (slime-canonicalized-location-to-string loc) ":")
+ (slime-insert-note-group notes)
+ (insert "\n")
+ (slime-make-note-overlay (cl-first notes) start (1- (point))))))
+ (set (make-local-variable 'compilation-skip-threshold) 0)
+ (setq next-error-last-buffer (current-buffer)))))
+
+(defun slime-insert-note-group (notes)
+ "Insert a group of compiler messages."
+ (insert "\n")
+ (dolist (note notes)
+ (insert " " (slime-severity-label (slime-note.severity note)) ": ")
+ (let ((start (point)))
+ (insert (slime-note.message note))
+ (let ((ctx (slime-note.source-context note)))
+ (if ctx (insert "\n" ctx)))
+ (slime-indent-block start 4))
+ (insert "\n")))
+
+(defun slime-indent-block (start column)
+ "If the region back to START isn't a one-liner indent it."
+ (when (< start (line-beginning-position))
+ (save-excursion
+ (goto-char start)
+ (insert "\n"))
+ (slime-indent-rigidly start (point) column)))
+
+(defun slime-canonicalized-location (location)
+ "Return a list (FILE LINE COLUMN) for slime-location LOCATION.
+This is quite an expensive operation so use carefully."
+ (save-excursion
+ (slime-goto-location-buffer (slime-location.buffer location))
+ (save-excursion
+ (slime-goto-source-location location)
+ (list (or (buffer-file-name) (buffer-name))
+ (save-restriction
+ (widen)
+ (line-number-at-pos))
+ (1+ (current-column))))))
+
+(defun slime-canonicalized-location-to-string (loc)
+ (if loc
+ (cl-destructuring-bind (filename line col) loc
+ (format "%s:%d:%d"
+ (cond ((not filename) "")
+ ((let ((rel (file-relative-name filename)))
+ (if (< (length rel) (length filename))
+ rel)))
+ (t filename))
+ line col))
+ (format "Unknown location")))
+
+(defun slime-goto-note-in-compilation-log (note)
+ "Find `note' in the compilation log and display it."
+ (with-current-buffer (get-buffer (slime-buffer-name :compilation))
+ (let ((pos
+ (save-excursion
+ (goto-char (point-min))
+ (cl-loop for overlay = (slime-find-next-note)
+ while overlay
+ for other-note = (overlay-get overlay 'slime-note)
+ when (slime-notes-in-same-location-p note other-note)
+ return (overlay-start overlay)))))
+ (when pos
+ (slime--display-position pos nil 0)))))
+
+(defun slime-group-and-sort-notes (notes)
+ "First sort, then group NOTES according to their canonicalized locs."
+ (let ((locs (make-hash-table :test #'eq)))
+ (mapc (lambda (note)
+ (let ((loc (slime-note.location note)))
+ (when (slime-location-p loc)
+ (puthash note (slime-canonicalized-location loc) locs))))
+ notes)
+ (list (slime-group-similar
+ (lambda (n1 n2)
+ (equal (gethash n1 locs nil) (gethash n2 locs t)))
+ (let* ((bottom most-negative-fixnum)
+ (+default+ (list "" bottom bottom)))
+ (sort notes
+ (lambda (n1 n2)
+ (cl-destructuring-bind ((filename1 line1 col1)
+ (filename2 line2 col2))
+ (list (gethash n1 locs +default+)
+ (gethash n2 locs +default+))
+ (cond ((string-lessp filename1 filename2) t)
+ ((string-lessp filename2 filename1) nil)
+ ((< line1 line2) t)
+ ((> line1 line2) nil)
+ (t (< col1 col2))))))))
+ locs)))
+
+(defun slime-note.severity (note)
+ (plist-get note :severity))
+
+(defun slime-note.message (note)
+ (plist-get note :message))
+
+(defun slime-note.source-context (note)
+ (plist-get note :source-context))
+
+(defun slime-note.location (note)
+ (plist-get note :location))
+
+(defun slime-severity-label (severity)
+ (cl-subseq (symbol-name severity) 1))
+
+
+;;;;; Adding a single compiler note
+
+(defun slime-overlay-note (note)
+ "Add a compiler note to the buffer as an overlay.
+If an appropriate overlay for a compiler note in the same location
+already exists then the new information is merged into it. Otherwise a
+new overlay is created."
+ (cl-multiple-value-bind (start end) (slime-choose-overlay-region note)
+ (when start
+ (goto-char start)
+ (let ((severity (plist-get note :severity))
+ (message (plist-get note :message))
+ (overlay (slime-note-at-point)))
+ (if overlay
+ (slime-merge-note-into-overlay overlay severity message)
+ (slime-create-note-overlay note start end severity message))))))
+
+(defun slime-make-note-overlay (note start end)
+ (let ((overlay (make-overlay start end)))
+ (overlay-put overlay 'slime-note note)
+ (push overlay slime-note-overlays)
+ overlay))
+
+(defun slime-create-note-overlay (note start end severity message)
+ "Create an overlay representing a compiler note.
+The overlay has several properties:
+ FACE - to underline the relevant text.
+ SEVERITY - for future reference :NOTE, :STYLE-WARNING, :WARNING, or :ERROR.
+ MOUSE-FACE - highlight the note when the mouse passes over.
+ HELP-ECHO - a string describing the note, both for future reference
+ and for display as a tooltip (due to the special
+ property name)."
+ (let ((overlay (slime-make-note-overlay note start end)))
+ (cl-macrolet ((putp (name value) `(overlay-put overlay ,name ,value)))
+ (putp 'face (slime-severity-face severity))
+ (putp 'severity severity)
+ (putp 'mouse-face 'highlight)
+ (putp 'help-echo message)
+ overlay)))
+
+;; XXX Obsolete due to `slime-merge-notes-for-display' doing the
+;; work already -- unless we decide to put several sets of notes on a
+;; buffer without clearing in between, which only this handles.
+(defun slime-merge-note-into-overlay (overlay severity message)
+ "Merge another compiler note into an existing overlay.
+The help text describes both notes, and the highest of the severities
+is kept."
+ (cl-macrolet ((putp (name value) `(overlay-put overlay ,name ,value))
+ (getp (name) `(overlay-get overlay ,name)))
+ (putp 'severity (slime-most-severe severity (getp 'severity)))
+ (putp 'face (slime-severity-face (getp 'severity)))
+ (putp 'help-echo (concat (getp 'help-echo) "\n" message))))
+
+(defun slime-choose-overlay-region (note)
+ "Choose the start and end points for an overlay over NOTE.
+If the location's sexp is a list spanning multiple lines, then the
+region around the first element is used.
+Return nil if there's no useful source location."
+ (let ((location (slime-note.location note)))
+ (when location
+ (slime-dcase location
+ ((:error _)) ; do nothing
+ ((:location file pos _hints)
+ (cond ((eq (car file) ':source-form) nil)
+ ((eq (slime-note.severity note) :read-error)
+ (slime-choose-overlay-for-read-error location))
+ ((equal pos '(:eof))
+ (cl-values (1- (point-max)) (point-max)))
+ (t
+ (slime-choose-overlay-for-sexp location))))))))
+
+(defun slime-choose-overlay-for-read-error (location)
+ (let ((pos (slime-location-offset location)))
+ (save-excursion
+ (goto-char pos)
+ (cond ((slime-symbol-at-point)
+ ;; package not found, &c.
+ (cl-values (slime-symbol-start-pos) (slime-symbol-end-pos)))
+ (t
+ (cl-values pos (1+ pos)))))))
+
+(defun slime-choose-overlay-for-sexp (location)
+ (slime-goto-source-location location)
+ (skip-chars-forward "'#`")
+ (let ((start (point)))
+ (ignore-errors (slime-forward-sexp))
+ (if (slime-same-line-p start (point))
+ (cl-values start (point))
+ (cl-values (1+ start)
+ (progn (goto-char (1+ start))
+ (ignore-errors (forward-sexp 1))
+ (point))))))
+
+(defun slime-same-line-p (pos1 pos2)
+ "Return t if buffer positions POS1 and POS2 are on the same line."
+ (save-excursion (goto-char (min pos1 pos2))
+ (<= (max pos1 pos2) (line-end-position))))
+
+(defvar slime-severity-face-plist
+ '(:error slime-error-face
+ :read-error slime-error-face
+ :warning slime-warning-face
+ :redefinition slime-style-warning-face
+ :style-warning slime-style-warning-face
+ :note slime-note-face))
+
+(defun slime-severity-face (severity)
+ "Return the name of the font-lock face representing SEVERITY."
+ (or (plist-get slime-severity-face-plist severity)
+ (error "No face for: %S" severity)))
+
+(defvar slime-severity-order
+ '(:note :style-warning :redefinition :warning :error :read-error))
+
+(defun slime-severity< (sev1 sev2)
+ "Return true if SEV1 is less severe than SEV2."
+ (< (cl-position sev1 slime-severity-order)
+ (cl-position sev2 slime-severity-order)))
+
+(defun slime-most-severe (sev1 sev2)
+ "Return the most servere of two conditions."
+ (if (slime-severity< sev1 sev2) sev2 sev1))
+
+;; XXX: unused function
+(defun slime-visit-source-path (source-path)
+ "Visit a full source path including the top-level form."
+ (goto-char (point-min))
+ (slime-forward-source-path source-path))
+
+(defun slime-forward-positioned-source-path (source-path)
+ "Move forward through a sourcepath from a fixed position.
+The point is assumed to already be at the outermost sexp, making the
+first element of the source-path redundant."
+ (ignore-errors
+ (slime-forward-sexp)
+ (beginning-of-defun))
+ (let ((source-path (cdr source-path)))
+ (when source-path
+ (down-list 1)
+ (slime-forward-source-path source-path))))
+
+(defun slime-forward-source-path (source-path)
+ (let ((origin (point)))
+ (condition-case nil
+ (progn
+ (cl-loop for (count . more) on source-path
+ do (progn
+ (slime-forward-sexp count)
+ (when more (down-list 1))))
+ ;; Align at beginning
+ (slime-forward-sexp)
+ (beginning-of-sexp))
+ (error (goto-char origin)))))
+
+
+;; FIXME: really fix this mess
+;; FIXME: the check shouln't be done here anyway but by M-. itself.
+
+(defun slime-filesystem-toplevel-directory ()
+ ;; Windows doesn't have a true toplevel root directory, and all
+ ;; filenames look like "c:/foo/bar/quux.baz" from an Emacs
+ ;; perspective anyway.
+ (if (memq system-type '(ms-dos windows-nt))
+ ""
+ (file-name-as-directory "/")))
+
+(defun slime-file-name-merge-source-root (target-filename buffer-filename)
+ "Returns a filename where the source root directory of TARGET-FILENAME
+is replaced with the source root directory of BUFFER-FILENAME.
+
+If no common source root could be determined, return NIL.
+
+E.g. (slime-file-name-merge-source-root
+ \"/usr/local/src/joe/upstream/sbcl/code/late-extensions.lisp\"
+ \"/usr/local/src/joe/hacked/sbcl/compiler/deftype.lisp\")
+
+ ==> \"/usr/local/src/joe/hacked/sbcl/code/late-extensions.lisp\"
+"
+ (let ((target-dirs (split-string (file-name-directory target-filename)
+ "/" t))
+ (buffer-dirs (split-string (file-name-directory buffer-filename)
+ "/" t)))
+ ;; Starting from the end, we look if one of the TARGET-DIRS exists
+ ;; in BUFFER-FILENAME---if so, it and everything left from that dirname
+ ;; is considered to be the source root directory of BUFFER-FILENAME.
+ (cl-loop with target-suffix-dirs = nil
+ with buffer-dirs* = (reverse buffer-dirs)
+ with target-dirs* = (reverse target-dirs)
+ for target-dir in target-dirs*
+ do (let ((concat-dirs (lambda (dirs)
+ (apply #'concat
+ (mapcar #'file-name-as-directory
+ dirs))))
+ (pos (cl-position target-dir buffer-dirs*
+ :test #'equal)))
+ (if (not pos) ; TARGET-DIR not in BUFFER-FILENAME?
+ (push target-dir target-suffix-dirs)
+ (let* ((target-suffix
+ ; PUSH reversed for us!
+ (funcall concat-dirs target-suffix-dirs))
+ (buffer-root
+ (funcall concat-dirs
+ (reverse (nthcdr pos buffer-dirs*)))))
+ (cl-return (concat (slime-filesystem-toplevel-directory)
+ buffer-root
+ target-suffix
+ (file-name-nondirectory
+ target-filename)))))))))
+
+(defun slime-highlight-differences-in-dirname (base-dirname contrast-dirname)
+ "Returns a copy of BASE-DIRNAME where all differences between
+BASE-DIRNAME and CONTRAST-DIRNAME are propertized with a
+highlighting face."
+ (setq base-dirname (file-name-as-directory base-dirname))
+ (setq contrast-dirname (file-name-as-directory contrast-dirname))
+ (let ((base-dirs (split-string base-dirname "/" t))
+ (contrast-dirs (split-string contrast-dirname "/" t)))
+ (with-temp-buffer
+ (cl-loop initially (insert (slime-filesystem-toplevel-directory))
+ for base-dir in base-dirs do
+ (let ((pos (cl-position base-dir contrast-dirs :test #'equal)))
+ (cond ((not pos)
+ (slime-insert-propertized '(face highlight) base-dir)
+ (insert "/"))
+ (t
+ (insert (file-name-as-directory base-dir))
+ (setq contrast-dirs
+ (nthcdr (1+ pos) contrast-dirs))))))
+ (buffer-substring (point-min) (point-max)))))
+
+(defvar slime-warn-when-possibly-tricked-by-M-. t
+ "When working on multiple source trees simultaneously, the way
+`slime-edit-definition' (M-.) works can sometimes be confusing:
+
+`M-.' visits locations that are present in the current Lisp image,
+which works perfectly well as long as the image reflects the source
+tree that one is currently looking at.
+
+In the other case, however, one can easily end up visiting a file
+in a different source root directory (cl-the one corresponding to
+the Lisp image), and is thus easily tricked to modify the wrong
+source files---which can lead to quite some stressfull cursing.
+
+If this variable is T, a warning message is issued to raise the
+user's attention whenever `M-.' is about opening a file in a
+different source root that also exists in the source root
+directory of the user's current buffer.
+
+There's no guarantee that all possible cases are covered, but
+if you encounter such a warning, it's a strong indication that
+you should check twice before modifying.")
+
+(defun slime-maybe-warn-for-different-source-root (target-filename
+ buffer-filename)
+ (let ((guessed-target (slime-file-name-merge-source-root target-filename
+ buffer-filename)))
+ (when (and guessed-target
+ (not (equal guessed-target target-filename))
+ (file-exists-p guessed-target))
+ (slime-message "Attention: This is `%s'."
+ (concat (slime-highlight-differences-in-dirname
+ (file-name-directory target-filename)
+ (file-name-directory guessed-target))
+ (file-name-nondirectory target-filename))))))
+
+(defun slime-check-location-filename-sanity (filename)
+ (when slime-warn-when-possibly-tricked-by-M-.
+ (cl-macrolet ((truename-safe (file) `(and ,file (file-truename ,file))))
+ (let ((target-filename (truename-safe filename))
+ (buffer-filename (truename-safe (buffer-file-name))))
+ (when (and target-filename
+ buffer-filename)
+ (slime-maybe-warn-for-different-source-root
+ target-filename buffer-filename))))))
+
+(defun slime-check-location-buffer-name-sanity (buffer-name)
+ (slime-check-location-filename-sanity
+ (buffer-file-name (get-buffer buffer-name))))
+
+
+
+(defun slime-goto-location-buffer (buffer)
+ (slime-dcase buffer
+ ((:file filename)
+ (let ((filename (slime-from-lisp-filename filename)))
+ (slime-check-location-filename-sanity filename)
+ (set-buffer (or (get-file-buffer filename)
+ (let ((find-file-suppress-same-file-warnings t))
+ (find-file-noselect filename))))))
+ ((:buffer buffer-name)
+ (slime-check-location-buffer-name-sanity buffer-name)
+ (set-buffer buffer-name))
+ ((:buffer-and-file buffer filename)
+ (slime-goto-location-buffer
+ (if (get-buffer buffer)
+ (list :buffer buffer)
+ (list :file filename))))
+ ((:source-form string)
+ (set-buffer (get-buffer-create (slime-buffer-name :source)))
+ (erase-buffer)
+ (lisp-mode)
+ (insert string)
+ (goto-char (point-min)))
+ ((:zip file entry)
+ (require 'arc-mode)
+ (set-buffer (find-file-noselect file t))
+ (goto-char (point-min))
+ (re-search-forward (concat " " entry "$"))
+ (let ((buffer (save-window-excursion
+ (archive-extract)
+ (current-buffer))))
+ (set-buffer buffer)
+ (goto-char (point-min))))))
+
+(defun slime-goto-location-position (position)
+ (slime-dcase position
+ ((:position pos)
+ (goto-char 1)
+ (forward-char (- (1- pos) (slime-eol-conversion-fixup (1- pos)))))
+ ((:offset start offset)
+ (goto-char start)
+ (forward-char offset))
+ ((:line start &optional column)
+ (goto-char (point-min))
+ (beginning-of-line start)
+ (cond (column (move-to-column column))
+ (t (skip-chars-forward " \t"))))
+ ((:function-name name)
+ (let ((case-fold-search t)
+ (name (regexp-quote name)))
+ (goto-char (point-min))
+ (when (or
+ (re-search-forward
+ (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +(*%s\\S_"
+ (regexp-quote name)) nil t)
+ (re-search-forward
+ (format "[( \t]%s\\>\\(\\s \\|$\\)" name) nil t))
+ (goto-char (match-beginning 0)))))
+ ((:method name specializers &rest qualifiers)
+ (slime-search-method-location name specializers qualifiers))
+ ((:source-path source-path start-position)
+ (cond (start-position
+ (goto-char start-position)
+ (slime-forward-positioned-source-path source-path))
+ (t
+ (slime-forward-source-path source-path))))
+ ((:eof)
+ (goto-char (point-max)))))
+
+(defun slime-eol-conversion-fixup (n)
+ ;; Return the number of \r\n eol markers that we need to cross when
+ ;; moving N chars forward. N is the number of chars but \r\n are
+ ;; counted as 2 separate chars.
+ (cl-case (coding-system-eol-type buffer-file-coding-system)
+ ((1)
+ (save-excursion
+ (cl-do ((pos (+ (point) n))
+ (count 0 (1+ count)))
+ ((>= (point) pos) (1- count))
+ (forward-line)
+ (cl-decf pos))))
+ (t 0)))
+
+(defun slime-search-method-location (name specializers qualifiers)
+ ;; Look for a sequence of words (def<something> method name
+ ;; qualifers specializers don't look for "T" since it isn't requires
+ ;; (arg without t) as class is taken as such.
+ (let* ((case-fold-search t)
+ (name (regexp-quote name))
+ (qualifiers (mapconcat (lambda (el) (concat ".+?\\<" el "\\>"))
+ qualifiers ""))
+ (specializers (mapconcat
+ (lambda (el)
+ (if (eql (aref el 0) ?\()
+ (let ((spec (read el)))
+ (if (eq (car spec) 'EQL)
+ (concat
+ ".*?\\n\\{0,1\\}.*?(EQL.*?'\\{0,1\\}"
+ (format "%s" (cl-second spec)) ")")
+ (error "don't understand specializer: %s,%s"
+ el (car spec))))
+ (concat ".+?\n\\{0,1\\}.+?\\<" el "\\>")))
+ (remove "T" specializers) ""))
+ (regexp (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\s +%s%s" name
+ qualifiers specializers)))
+ (or (and (re-search-forward regexp nil t)
+ (goto-char (match-beginning 0)))
+ ;; (slime-goto-location-position `(:function-name ,name))
+ )))
+
+(defun slime-search-call-site (fname)
+ "Move to the place where FNAME called.
+Don't move if there are multiple or no calls in the current defun."
+ (save-restriction
+ (narrow-to-defun)
+ (let ((start (point))
+ (regexp (concat "(" fname "[)\n \t]"))
+ (case-fold-search t))
+ (cond ((and (re-search-forward regexp nil t)
+ (not (re-search-forward regexp nil t)))
+ (goto-char (match-beginning 0)))
+ (t (goto-char start))))))
+
+(defun slime-search-edit-path (edit-path)
+ "Move to EDIT-PATH starting at the current toplevel form."
+ (when edit-path
+ (unless (and (= (current-column) 0)
+ (looking-at "("))
+ (beginning-of-defun))
+ (slime-forward-source-path edit-path)))
+
+(defun slime-goto-source-location (location &optional noerror)
+ "Move to the source location LOCATION. Several kinds of locations
+are supported:
+
+<location> ::= (:location <buffer> <position> <hints>)
+ | (:error <message>)
+
+<buffer> ::= (:file <filename>)
+ | (:buffer <buffername>)
+ | (:buffer-and-file <buffername> <filename>)
+ | (:source-form <string>)
+ | (:zip <file> <entry>)
+
+<position> ::= (:position <fixnum>) ; 1 based (for files)
+ | (:offset <start> <offset>) ; start+offset (for C-c C-c)
+ | (:line <line> [<column>])
+ | (:function-name <string>)
+ | (:source-path <list> <start-position>)
+ | (:method <name string> <specializers> . <qualifiers>)"
+ (slime-dcase location
+ ((:location buffer _position _hints)
+ (slime-goto-location-buffer buffer)
+ (let ((pos (slime-location-offset location)))
+ (cond ((and (<= (point-min) pos) (<= pos (point-max))))
+ (widen-automatically (widen))
+ (t
+ (error "Location is outside accessible part of buffer")))
+ (goto-char pos)))
+ ((:error message)
+ (if noerror
+ (slime-message "%s" message)
+ (error "%s" message)))))
+
+(defun slime-location-offset (location)
+ "Return the position, as character number, of LOCATION."
+ (save-restriction
+ (widen)
+ (condition-case nil
+ (slime-goto-location-position
+ (slime-location.position location))
+ (error (goto-char 0)))
+ (cl-destructuring-bind (&key snippet edit-path call-site align)
+ (slime-location.hints location)
+ (when snippet (slime-isearch snippet))
+ (when edit-path (slime-search-edit-path edit-path))
+ (when call-site (slime-search-call-site call-site))
+ (when align
+ (slime-forward-sexp)
+ (beginning-of-sexp)))
+ (point)))
+
+
+;;;;; Incremental search
+;;
+;; Search for the longest match of a string in either direction.
+;;
+;; This is for locating text that is expected to be near the point and
+;; may have been modified (but hopefully not near the beginning!)
+
+(defun slime-isearch (string)
+ "Find the longest occurence of STRING either backwards of forwards.
+If multiple matches exist the choose the one nearest to point."
+ (goto-char
+ (let* ((start (point))
+ (len1 (slime-isearch-with-function 'search-forward string))
+ (pos1 (point)))
+ (goto-char start)
+ (let* ((len2 (slime-isearch-with-function 'search-backward string))
+ (pos2 (point)))
+ (cond ((and len1 len2)
+ ;; Have a match in both directions
+ (cond ((= len1 len2)
+ ;; Both are full matches -- choose the nearest.
+ (if (< (abs (- start pos1))
+ (abs (- start pos2)))
+ pos1 pos2))
+ ((> len1 len2) pos1)
+ ((> len2 len1) pos2)))
+ (len1 pos1)
+ (len2 pos2)
+ (t start))))))
+
+(defun slime-isearch-with-function (search-fn string)
+ "Search for the longest substring of STRING using SEARCH-FN.
+SEARCH-FN is either the symbol `search-forward' or `search-backward'."
+ (unless (string= string "")
+ (cl-loop for i from 1 to (length string)
+ while (funcall search-fn (substring string 0 i) nil t)
+ for match-data = (match-data)
+ do (cl-case search-fn
+ (search-forward (goto-char (match-beginning 0)))
+ (search-backward (goto-char (1+ (match-end 0)))))
+ finally (cl-return (if (null match-data)
+ nil
+ ;; Finish based on the last successful match
+ (store-match-data match-data)
+ (goto-char (match-beginning 0))
+ (- (match-end 0) (match-beginning 0)))))))
+
+
+;;;;; Visiting and navigating the overlays of compiler notes
+
+(defun slime-next-note ()
+ "Go to and describe the next compiler note in the buffer."
+ (interactive)
+ (let ((here (point))
+ (note (slime-find-next-note)))
+ (if note
+ (slime-show-note note)
+ (goto-char here)
+ (message "No next note."))))
+
+(defun slime-previous-note ()
+ "Go to and describe the previous compiler note in the buffer."
+ (interactive)
+ (let ((here (point))
+ (note (slime-find-previous-note)))
+ (if note
+ (slime-show-note note)
+ (goto-char here)
+ (message "No previous note."))))
+
+(defun slime-goto-first-note (&rest _)
+ "Go to the first note in the buffer."
+ (let ((point (point)))
+ (goto-char (point-min))
+ (cond ((slime-find-next-note)
+ (slime-show-note (slime-note-at-point)))
+ (t (goto-char point)))))
+
+(defun slime-remove-notes ()
+ "Remove compiler-note annotations from the current buffer."
+ (interactive)
+ (slime-remove-old-overlays))
+
+(defun slime-show-note (overlay)
+ "Present the details of a compiler note to the user."
+ (slime-temporarily-highlight-note overlay)
+ (if (get-buffer-window (slime-buffer-name :compilation) t)
+ (slime-goto-note-in-compilation-log (overlay-get overlay 'slime-note))
+ (let ((message (get-char-property (point) 'help-echo)))
+ (slime-message "%s" (if (zerop (length message)) "\"\"" message)))))
+
+;; FIXME: could probably use flash region
+(defun slime-temporarily-highlight-note (overlay)
+ "Temporarily highlight a compiler note's overlay.
+The highlighting is designed to both make the relevant source more
+visible, and to highlight any further notes that are nested inside the
+current one.
+
+The highlighting is automatically undone with a timer."
+ (run-with-timer 0.2 nil
+ #'overlay-put overlay 'face (overlay-get overlay 'face))
+ (overlay-put overlay 'face 'slime-highlight-face))
+
+
+;;;;; Overlay lookup operations
+
+(defun slime-note-at-point ()
+ "Return the overlay for a note starting at point, otherwise NIL."
+ (cl-find (point) (slime-note-overlays-at-point)
+ :key 'overlay-start))
+
+(defun slime-note-overlay-p (overlay)
+ "Return true if OVERLAY represents a compiler note."
+ (overlay-get overlay 'slime-note))
+
+(defun slime-note-overlays-at-point ()
+ "Return a list of all note overlays that are under the point."
+ (cl-remove-if-not 'slime-note-overlay-p (overlays-at (point))))
+
+(defun slime-find-next-note ()
+ "Go to the next position with the `slime-note' text property.
+Retuns the note overlay if such a position is found, otherwise nil."
+ (slime-search-property 'slime-note nil #'slime-note-at-point))
+
+(defun slime-find-previous-note ()
+ "Go to the next position with the `slime-note' text property.
+Retuns the note overlay if such a position is found, otherwise nil."
+ (slime-search-property 'slime-note t #'slime-note-at-point))
+
+
+;;;; Arglist Display
+
+(defun slime-space (n)
+ "Insert a space and print some relevant information (function arglist).
+Designed to be bound to the SPC key. Prefix argument can be used to insert
+more than one space."
+ (interactive "p")
+ (self-insert-command n)
+ (slime-echo-arglist))
+
+(put 'slime-space 'delete-selection t) ; for delete-section-mode & CUA
+
+(defun slime-echo-arglist ()
+ (when (slime-background-activities-enabled-p)
+ (let ((op (slime-operator-before-point)))
+ (when op
+ (slime-eval-async `(swank:operator-arglist ,op
+ ,(slime-current-package))
+ (lambda (arglist)
+ (when arglist
+ (slime-message "%s" arglist))))))))
+
+(defvar slime-operator-before-point-function 'slime-lisp-operator-before-point)
+
+(defun slime-operator-before-point ()
+ (funcall slime-operator-before-point-function))
+
+(defun slime-lisp-operator-before-point ()
+ (ignore-errors
+ (save-excursion
+ (backward-up-list 1)
+ (down-list 1)
+ (slime-symbol-at-point))))
+
+;;;; Completion
+
+;; FIXME: use this in Emacs 24
+;;(define-obsolete-function-alias slime-complete-symbol completion-at-point)
+
+(defalias 'slime-complete-symbol #'completion-at-point)
+(make-obsolete 'slime-complete-symbol #'completion-at-point "2015-10-17")
+
+;; This is the function that we add to
+;; `completion-at-point-functions'. For backward-compatibilty we look
+;; at `slime-complete-symbol-function' first. The indirection through
+;; `slime-completion-at-point-functions' is used so that users don't
+;; have to set `completion-at-point-functions' in every slime-like
+;; buffer.
+(defun slime--completion-at-point ()
+ (cond (slime-complete-symbol-function
+ slime-complete-symbol-function)
+ (t
+ (run-hook-with-args-until-success
+ 'slime-completion-at-point-functions))))
+
+(defun slime-setup-completion ()
+ (add-hook 'completion-at-point-functions #'slime--completion-at-point nil t))
+
+(defun slime-simple-completion-at-point ()
+ "Complete the symbol at point.
+Perform completion similar to `elisp-completion-at-point'."
+ (let* ((end (point))
+ (beg (slime-symbol-start-pos)))
+ (list beg end (completion-table-dynamic #'slime-simple-completions))))
+
+(defun slime-filename-completion ()
+ "If point is at a string starting with \", complete it as filename.
+Return nil if point is not at filename."
+ (when (save-excursion (re-search-backward "\"[^ \t\n]+\\="
+ (max (point-min) (- (point) 1000))
+ t))
+ (let ((comint-completion-addsuffix '("/" . "\"")))
+ (comint-filename-completion))))
+
+;; FIXME: for backward compatibility. Remove it one day
+;; together with slime-complete-symbol-function.
+(defun slime-simple-complete-symbol ()
+ (let ((completion-at-point-functions '(slime-maybe-complete-as-filename
+ slime-simple-completion-at-point)))
+ (completion-at-point)))
+
+;; NOTE: the original idea was to bind this to TAB but that no longer
+;; works as `completion-at-point' sets a transient keymap that
+;; overrides TAB. So this is rather useless now.
+(defun slime-indent-and-complete-symbol ()
+ "Indent the current line and perform symbol completion.
+First indent the line. If indenting doesn't move point, complete
+the symbol. If there's no symbol at the point, show the arglist
+for the most recently enclosed macro or function."
+ (interactive)
+ (let ((pos (point)))
+ (unless (get-text-property (line-beginning-position) 'slime-repl-prompt)
+ (lisp-indent-line))
+ (when (= pos (point))
+ (cond ((save-excursion (re-search-backward "[^() \n\t\r]+\\=" nil t))
+ (completion-at-point))
+ ((memq (char-before) '(?\t ?\ ))
+ (slime-echo-arglist))))))
+
+(make-obsolete 'slime-indent-and-complete-symbol
+ "Set tab-always-indent to 'complete."
+ "2015-10-18")
+
+(defvar slime-minibuffer-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "\t" #'completion-at-point)
+ (define-key map "\M-\t" #'completion-at-point)
+ map)
+ "Minibuffer keymap used for reading CL expressions.")
+
+(defvar slime-minibuffer-history '()
+ "History list of expressions read from the minibuffer.")
+
+(defun slime-minibuffer-setup-hook ()
+ (cons (lexical-let ((package (slime-current-package))
+ (connection (slime-connection)))
+ (lambda ()
+ (setq slime-buffer-package package)
+ (setq slime-buffer-connection connection)
+ (set-syntax-table lisp-mode-syntax-table)
+ (slime-setup-completion)))
+ minibuffer-setup-hook))
+
+(defun slime-read-from-minibuffer (prompt &optional initial-value history)
+ "Read a string from the minibuffer, prompting with PROMPT.
+If INITIAL-VALUE is non-nil, it is inserted into the minibuffer before
+reading input. The result is a string (\"\" if no input was given)."
+ (let ((minibuffer-setup-hook (slime-minibuffer-setup-hook)))
+ (read-from-minibuffer prompt initial-value slime-minibuffer-map
+ nil (or history 'slime-minibuffer-history))))
+
+(defun slime-bogus-completion-alist (list)
+ "Make an alist out of list.
+The same elements go in the CAR, and nil in the CDR. To support the
+apparently very stupid `try-completions' interface, that wants an
+alist but ignores CDRs."
+ (mapcar (lambda (x) (cons x nil)) list))
+
+(defun slime-simple-completions (prefix)
+ (cl-destructuring-bind (completions _partial)
+ (let ((slime-current-thread t))
+ (slime-eval
+ `(swank:simple-completions ,(substring-no-properties prefix)
+ ',(slime-current-package))))
+ completions))
+
+
+;;;; Edit definition
+
+(defun slime-push-definition-stack ()
+ "Add point to find-tag-marker-ring."
+ (require 'etags)
+ (ring-insert find-tag-marker-ring (point-marker)))
+
+(defun slime-pop-find-definition-stack ()
+ "Pop the edit-definition stack and goto the location."
+ (interactive)
+ (pop-tag-mark))
+
+(cl-defstruct (slime-xref (:conc-name slime-xref.) (:type list))
+ dspec location)
+
+(cl-defstruct (slime-location (:conc-name slime-location.) (:type list)
+ (:constructor nil)
+ (:copier nil))
+ tag buffer position hints)
+
+(defun slime-location-p (o) (and (consp o) (eq (car o) :location)))
+
+(defun slime-xref-has-location-p (xref)
+ (slime-location-p (slime-xref.location xref)))
+
+(defun make-slime-buffer-location (buffer-name position &optional hints)
+ `(:location (:buffer ,buffer-name) (:position ,position)
+ ,(when hints `(:hints ,hints))))
+
+(defun make-slime-file-location (file-name position &optional hints)
+ `(:location (:file ,file-name) (:position ,position)
+ ,(when hints `(:hints ,hints))))
+
+;;; The hooks are tried in order until one succeeds, otherwise the
+;;; default implementation involving `slime-find-definitions-function'
+;;; is used. The hooks are called with the same arguments as
+;;; `slime-edit-definition'.
+(defvar slime-edit-definition-hooks)
+
+(defun slime-edit-definition (&optional name where)
+ "Lookup the definition of the name at point.
+If there's no name at point, or a prefix argument is given, then the
+function name is prompted."
+ (interactive (list (or (and (not current-prefix-arg)
+ (slime-symbol-at-point))
+ (slime-read-symbol-name "Edit Definition of: "))))
+ ;; The hooks might search for a name in a different manner, so don't
+ ;; ask the user if it's missing before the hooks are run
+ (or (run-hook-with-args-until-success 'slime-edit-definition-hooks
+ name where)
+ (slime-edit-definition-cont (slime-find-definitions name)
+ name where)))
+
+(defun slime-edit-definition-cont (xrefs name where)
+ (cl-destructuring-bind (1loc file-alist) (slime-analyze-xrefs xrefs)
+ (cond ((null xrefs)
+ (error "No known definition for: %s (in %s)"
+ name (slime-current-package)))
+ (1loc
+ (slime-push-definition-stack)
+ (slime-pop-to-location (slime-xref.location (car xrefs)) where))
+ ((slime-length= xrefs 1) ; ((:error "..."))
+ (error "%s" (cadr (slime-xref.location (car xrefs)))))
+ (t
+ (slime-push-definition-stack)
+ (slime-show-xrefs file-alist 'definition name
+ (slime-current-package))))))
+
+(defvar slime-edit-uses-xrefs
+ '(:calls :macroexpands :binds :references :sets :specializes))
+
+;;; FIXME. TODO: Would be nice to group the symbols (in each
+;;; type-group) by their home-package.
+(defun slime-edit-uses (symbol)
+ "Lookup all the uses of SYMBOL."
+ (interactive (list (slime-read-symbol-name "Edit Uses of: ")))
+ (slime-xrefs slime-edit-uses-xrefs
+ symbol
+ (lambda (xrefs type symbol package)
+ (cond
+ ((null xrefs)
+ (message "No xref information found for %s." symbol))
+ ((and (slime-length= xrefs 1) ; one group
+ (slime-length= (cdar xrefs) 1)) ; one ref in group
+ (cl-destructuring-bind (_ (_ loc)) (cl-first xrefs)
+ (slime-push-definition-stack)
+ (slime-pop-to-location loc)))
+ (t
+ (slime-push-definition-stack)
+ (slime-show-xref-buffer xrefs type symbol package))))))
+
+(defun slime-analyze-xrefs (xrefs)
+ "Find common filenames in XREFS.
+Return a list (SINGLE-LOCATION FILE-ALIST).
+SINGLE-LOCATION is true if all xrefs point to the same location.
+FILE-ALIST is an alist of the form ((FILENAME . (XREF ...)) ...)."
+ (list (and xrefs
+ (let ((loc (slime-xref.location (car xrefs))))
+ (and (slime-location-p loc)
+ (cl-every (lambda (x) (equal (slime-xref.location x) loc))
+ (cdr xrefs)))))
+ (slime-alistify xrefs #'slime-xref-group #'equal)))
+
+(defun slime-xref-group (xref)
+ (cond ((slime-xref-has-location-p xref)
+ (slime-dcase (slime-location.buffer (slime-xref.location xref))
+ ((:file filename) filename)
+ ((:buffer bufname)
+ (let ((buffer (get-buffer bufname)))
+ (if buffer
+ (format "%S" buffer) ; "#<buffer foo.lisp>"
+ (format "%s (previously existing buffer)" bufname))))
+ ((:buffer-and-file _buffer filename) filename)
+ ((:source-form _) "(S-Exp)")
+ ((:zip _zip entry) entry)))
+ (t
+ "(No location)")))
+
+(defun slime-pop-to-location (location &optional where)
+ (slime-goto-source-location location)
+ (cl-ecase where
+ ((nil) (switch-to-buffer (current-buffer)))
+ (window (pop-to-buffer (current-buffer) t))
+ (frame (let ((pop-up-frames t)) (pop-to-buffer (current-buffer) t)))))
+
+(defun slime-postprocess-xref (original-xref)
+ "Process (for normalization purposes) an Xref comming directly
+from SWANK before the rest of Slime sees it. In particular,
+convert ETAGS based xrefs to actual file+position based
+locations."
+ (if (not (slime-xref-has-location-p original-xref))
+ (list original-xref)
+ (let ((loc (slime-xref.location original-xref)))
+ (slime-dcase (slime-location.buffer loc)
+ ((:etags-file tags-file)
+ (slime-dcase (slime-location.position loc)
+ ((:tag &rest tags)
+ (visit-tags-table tags-file)
+ (mapcar (lambda (xref)
+ (let ((old-dspec (slime-xref.dspec original-xref))
+ (new-dspec (slime-xref.dspec xref)))
+ (setf (slime-xref.dspec xref)
+ (format "%s: %s" old-dspec new-dspec))
+ xref))
+ (cl-mapcan #'slime-etags-definitions tags)))))
+ (t
+ (list original-xref))))))
+
+(defun slime-postprocess-xrefs (xrefs)
+ (cl-mapcan #'slime-postprocess-xref xrefs))
+
+(defun slime-find-definitions (name)
+ "Find definitions for NAME."
+ (slime-postprocess-xrefs (funcall slime-find-definitions-function name)))
+
+(defun slime-find-definitions-rpc (name)
+ (slime-eval `(swank:find-definitions-for-emacs ,name)))
+
+(defun slime-edit-definition-other-window (name)
+ "Like `slime-edit-definition' but switch to the other window."
+ (interactive (list (slime-read-symbol-name "Symbol: ")))
+ (slime-edit-definition name 'window))
+
+(defun slime-edit-definition-other-frame (name)
+ "Like `slime-edit-definition' but switch to the other window."
+ (interactive (list (slime-read-symbol-name "Symbol: ")))
+ (slime-edit-definition name 'frame))
+
+(defun slime-edit-definition-with-etags (name)
+ (interactive (list (slime-read-symbol-name "Symbol: ")))
+ (let ((xrefs (slime-etags-definitions name)))
+ (cond (xrefs
+ (message "Using tag file...")
+ (slime-edit-definition-cont xrefs name nil))
+ (t
+ (error "No known definition for: %s" name)))))
+
+(defun slime-etags-to-locations (name)
+ "Search for definitions matching `name' in the currently active
+tags table. Return a possibly empty list of slime-locations."
+ (let ((locs '()))
+ (save-excursion
+ (let ((first-time t))
+ (while (visit-tags-table-buffer (not first-time))
+ (setq first-time nil)
+ (goto-char (point-min))
+ (while (search-forward name nil t)
+ (beginning-of-line)
+ (cl-destructuring-bind (hint line &rest pos) (etags-snarf-tag)
+ (unless (eq hint t) ; hint==t if we are in a filename line
+ (push `(:location (:file ,(expand-file-name (file-of-tag)))
+ (:line ,line)
+ (:snippet ,hint))
+ locs))))))
+ (nreverse locs))))
+
+(defun slime-etags-definitions (name)
+ "Search definitions matching NAME in the tags file.
+The result is a (possibly empty) list of definitions."
+ (mapcar (lambda (loc)
+ (make-slime-xref :dspec (cl-second (slime-location.hints loc))
+ :location loc))
+ (slime-etags-to-locations name)))
+
+;;;;; first-change-hook
+
+(defun slime-first-change-hook ()
+ "Notify Lisp that a source file's buffer has been modified."
+ ;; Be careful not to disturb anything!
+ ;; In particular if we muck up the match-data then query-replace
+ ;; breaks. -luke (26/Jul/2004)
+ (save-excursion
+ (save-match-data
+ (when (and (buffer-file-name)
+ (file-exists-p (buffer-file-name))
+ (slime-background-activities-enabled-p))
+ (let ((filename (slime-to-lisp-filename (buffer-file-name))))
+ (slime-eval-async `(swank:buffer-first-change ,filename)))))))
+
+(defun slime-setup-first-change-hook ()
+ (add-hook (make-local-variable 'first-change-hook)
+ 'slime-first-change-hook))
+
+(add-hook 'slime-mode-hook 'slime-setup-first-change-hook)
+
+
+;;;; Eval for Lisp
+
+(defun slime-lisp-readable-p (x)
+ (or (stringp x)
+ (memq x '(nil t))
+ (integerp x)
+ (keywordp x)
+ (and (consp x)
+ (let ((l x))
+ (while (consp l)
+ (slime-lisp-readable-p (car x))
+ (setq l (cdr l)))
+ (slime-lisp-readable-p l)))))
+
+(defun slime-eval-for-lisp (thread tag form-string)
+ (let ((ok nil)
+ (value nil)
+ (error nil)
+ (c (slime-connection)))
+ (unwind-protect
+ (condition-case err
+ (progn
+ (slime-check-eval-in-emacs-enabled)
+ (setq value (eval (read form-string)))
+ (setq ok t))
+ ((debug error)
+ (setq error err)))
+ (let ((result (cond ((and ok
+ (not (slime-lisp-readable-p value)))
+ `(:unreadable ,(slime-prin1-to-string value)))
+ (ok `(:ok ,value))
+ (error `(:error ,(symbol-name (car error))
+ . ,(mapcar #'slime-prin1-to-string
+ (cdr error))))
+ (t `(:abort)))))
+ (slime-dispatch-event `(:emacs-return ,thread ,tag ,result) c)))))
+
+(defun slime-check-eval-in-emacs-enabled ()
+ "Raise an error if `slime-enable-evaluate-in-emacs' isn't true."
+ (unless slime-enable-evaluate-in-emacs
+ (error (concat "slime-eval-in-emacs disabled for security. "
+ "Set `slime-enable-evaluate-in-emacs' true to enable it."))))
+
+
+;;;; `ED'
+
+(defvar slime-ed-frame nil
+ "The frame used by `slime-ed'.")
+
+(defcustom slime-ed-use-dedicated-frame t
+ "*When non-nil, `slime-ed' will create and reuse a dedicated frame."
+ :type 'boolean
+ :group 'slime-mode)
+
+(defun slime-ed (what)
+ "Edit WHAT.
+
+WHAT can be:
+ A filename (string),
+ A list (:filename FILENAME &key LINE COLUMN POSITION),
+ A function name (:function-name STRING)
+ nil.
+
+This is for use in the implementation of COMMON-LISP:ED."
+ (when slime-ed-use-dedicated-frame
+ (unless (and slime-ed-frame (frame-live-p slime-ed-frame))
+ (setq slime-ed-frame (make-frame)))
+ (select-frame slime-ed-frame))
+ (when what
+ (slime-dcase what
+ ((:filename file &key line column position bytep)
+ (find-file (slime-from-lisp-filename file))
+ (when line (slime-goto-line line))
+ (when column (move-to-column column))
+ (when position
+ (goto-char (if bytep
+ (byte-to-position position)
+ position))))
+ ((:function-name name)
+ (slime-edit-definition name)))))
+
+(defun slime-goto-line (line-number)
+ "Move to line LINE-NUMBER (1-based).
+This is similar to `goto-line' but without pushing the mark and
+the display stuff that we neither need nor want."
+ (cl-assert (= (buffer-size) (- (point-max) (point-min))) ()
+ "slime-goto-line in narrowed buffer")
+ (goto-char (point-min))
+ (forward-line (1- line-number)))
+
+(defun slime-y-or-n-p (thread tag question)
+ (slime-dispatch-event `(:emacs-return ,thread ,tag ,(y-or-n-p question))))
+
+(defun slime-read-from-minibuffer-for-swank (thread tag prompt initial-value)
+ (let ((answer (condition-case nil
+ (slime-read-from-minibuffer prompt initial-value)
+ (quit nil))))
+ (slime-dispatch-event `(:emacs-return ,thread ,tag ,answer))))
+
+;;;; Interactive evaluation.
+
+(defun slime-interactive-eval (string)
+ "Read and evaluate STRING and print value in minibuffer.
+
+Note: If a prefix argument is in effect then the result will be
+inserted in the current buffer."
+ (interactive (list (slime-read-from-minibuffer "Slime Eval: ")))
+ (cl-case current-prefix-arg
+ ((nil)
+ (slime-eval-with-transcript `(swank:interactive-eval ,string)))
+ ((-)
+ (slime-eval-save string))
+ (t
+ (slime-eval-print string))))
+
+(defvar slime-transcript-start-hook nil
+ "Hook run before start an evalution.")
+(defvar slime-transcript-stop-hook nil
+ "Hook run after finishing a evalution.")
+
+(defun slime-display-eval-result (value)
+ (slime-message "%s" value))
+
+(defun slime-eval-with-transcript (form)
+ "Eval FORM in Lisp. Display output, if any."
+ (run-hooks 'slime-transcript-start-hook)
+ (slime-rex () (form)
+ ((:ok value)
+ (run-hooks 'slime-transcript-stop-hook)
+ (slime-display-eval-result value))
+ ((:abort condition)
+ (run-hooks 'slime-transcript-stop-hook)
+ (message "Evaluation aborted on %s." condition))))
+
+(defun slime-eval-print (string)
+ "Eval STRING in Lisp; insert any output and the result at point."
+ (slime-eval-async `(swank:eval-and-grab-output ,string)
+ (lambda (result)
+ (cl-destructuring-bind (output value) result
+ (push-mark)
+ (insert output value)))))
+
+(defun slime-eval-save (string)
+ "Evaluate STRING in Lisp and save the result in the kill ring."
+ (slime-eval-async `(swank:eval-and-grab-output ,string)
+ (lambda (result)
+ (cl-destructuring-bind (output value) result
+ (let ((string (concat output value)))
+ (kill-new string)
+ (message "Evaluation finished; pushed result to kill ring."))))))
+
+(defun slime-eval-describe (form)
+ "Evaluate FORM in Lisp and display the result in a new buffer."
+ (slime-eval-async form (slime-rcurry #'slime-show-description
+ (slime-current-package))))
+
+(defvar slime-description-autofocus nil
+ "If non-nil select description windows on display.")
+
+(defun slime-show-description (string package)
+ ;; So we can have one description buffer open per connection. Useful
+ ;; for comparing the output of DISASSEMBLE across implementations.
+ ;; FIXME: could easily be achieved with M-x rename-buffer
+ (let ((bufname (slime-buffer-name :description)))
+ (slime-with-popup-buffer (bufname :package package
+ :connection t
+ :select slime-description-autofocus)
+ (princ string)
+ (goto-char (point-min)))))
+
+(defun slime-last-expression ()
+ (buffer-substring-no-properties
+ (save-excursion (backward-sexp) (point))
+ (point)))
+
+(defun slime-eval-last-expression ()
+ "Evaluate the expression preceding point."
+ (interactive)
+ (slime-interactive-eval (slime-last-expression)))
+
+(defun slime-eval-defun ()
+ "Evaluate the current toplevel form.
+Use `slime-re-evaluate-defvar' if the from starts with '(defvar'"
+ (interactive)
+ (let ((form (slime-defun-at-point)))
+ (cond ((string-match "^(defvar " form)
+ (slime-re-evaluate-defvar form))
+ (t
+ (slime-interactive-eval form)))))
+
+(defun slime-eval-region (start end)
+ "Evaluate region."
+ (interactive "r")
+ (slime-eval-with-transcript
+ `(swank:interactive-eval-region
+ ,(buffer-substring-no-properties start end))))
+
+(defun slime-pprint-eval-region (start end)
+ "Evaluate region; pprint the value in a buffer."
+ (interactive "r")
+ (slime-eval-describe
+ `(swank:pprint-eval
+ ,(buffer-substring-no-properties start end))))
+
+(defun slime-eval-buffer ()
+ "Evaluate the current buffer.
+The value is printed in the echo area."
+ (interactive)
+ (slime-eval-region (point-min) (point-max)))
+
+(defun slime-re-evaluate-defvar (form)
+ "Force the re-evaluaton of the defvar form before point.
+
+First make the variable unbound, then evaluate the entire form."
+ (interactive (list (slime-last-expression)))
+ (slime-eval-with-transcript `(swank:re-evaluate-defvar ,form)))
+
+(defun slime-pprint-eval-last-expression ()
+ "Evaluate the form before point; pprint the value in a buffer."
+ (interactive)
+ (slime-eval-describe `(swank:pprint-eval ,(slime-last-expression))))
+
+(defun slime-eval-print-last-expression (string)
+ "Evaluate sexp before point; print value into the current buffer"
+ (interactive (list (slime-last-expression)))
+ (insert "\n")
+ (slime-eval-print string))
+
+;;;; Edit Lisp value
+;;;
+(defun slime-edit-value (form-string)
+ "\\<slime-edit-value-mode-map>\
+Edit the value of a setf'able form in a new buffer.
+The value is inserted into a temporary buffer for editing and then set
+in Lisp when committed with \\[slime-edit-value-commit]."
+ (interactive
+ (list (slime-read-from-minibuffer "Edit value (evaluated): "
+ (slime-sexp-at-point))))
+ (slime-eval-async `(swank:value-for-editing ,form-string)
+ (lexical-let ((form-string form-string)
+ (package (slime-current-package)))
+ (lambda (result)
+ (slime-edit-value-callback form-string result
+ package)))))
+
+(make-variable-buffer-local
+ (defvar slime-edit-form-string nil
+ "The form being edited by `slime-edit-value'."))
+
+(define-minor-mode slime-edit-value-mode
+ "Mode for editing a Lisp value."
+ nil
+ " Edit-Value"
+ '(("\C-c\C-c" . slime-edit-value-commit)))
+
+(defun slime-edit-value-callback (form-string current-value package)
+ (let* ((name (generate-new-buffer-name (format "*Edit %s*" form-string)))
+ (buffer (slime-with-popup-buffer (name :package package
+ :connection t
+ :select t
+ :mode 'lisp-mode)
+ (slime-popup-buffer-mode -1) ; don't want binding of 'q'
+ (slime-mode 1)
+ (slime-edit-value-mode 1)
+ (setq slime-edit-form-string form-string)
+ (insert current-value)
+ (current-buffer))))
+ (with-current-buffer buffer
+ (setq buffer-read-only nil)
+ (message "Type C-c C-c when done"))))
+
+(defun slime-edit-value-commit ()
+ "Commit the edited value to the Lisp image.
+\\(See `slime-edit-value'.)"
+ (interactive)
+ (if (null slime-edit-form-string)
+ (error "Not editing a value.")
+ (let ((value (buffer-substring-no-properties (point-min) (point-max))))
+ (lexical-let ((buffer (current-buffer)))
+ (slime-eval-async `(swank:commit-edited-value ,slime-edit-form-string
+ ,value)
+ (lambda (_)
+ (with-current-buffer buffer
+ (quit-window t))))))))
+
+;;;; Tracing
+
+(defun slime-untrace-all ()
+ "Untrace all functions."
+ (interactive)
+ (slime-eval `(swank:untrace-all)))
+
+(defun slime-toggle-trace-fdefinition (spec)
+ "Toggle trace."
+ (interactive (list (slime-read-from-minibuffer
+ "(Un)trace: " (slime-symbol-at-point))))
+ (message "%s" (slime-eval `(swank:swank-toggle-trace ,spec))))
+
+
+
+(defun slime-disassemble-symbol (symbol-name)
+ "Display the disassembly for SYMBOL-NAME."
+ (interactive (list (slime-read-symbol-name "Disassemble: ")))
+ (slime-eval-describe `(swank:disassemble-form ,(concat "'" symbol-name))))
+
+(defun slime-undefine-function (symbol-name)
+ "Unbind the function slot of SYMBOL-NAME."
+ (interactive (list (slime-read-symbol-name "fmakunbound: " t)))
+ (slime-eval-async `(swank:undefine-function ,symbol-name)
+ (lambda (result) (message "%s" result))))
+
+(defun slime-unintern-symbol (symbol-name package)
+ "Unintern the symbol given with SYMBOL-NAME PACKAGE."
+ (interactive (list (slime-read-symbol-name "Unintern symbol: " t)
+ (slime-read-package-name "from package: "
+ (slime-current-package))))
+ (slime-eval-async `(swank:unintern-symbol ,symbol-name ,package)
+ (lambda (result) (message "%s" result))))
+
+(defun slime-delete-package (package-name)
+ "Delete the package with name PACKAGE-NAME."
+ (interactive (list (slime-read-package-name "Delete package: "
+ (slime-current-package))))
+ (slime-eval-async `(cl:delete-package
+ (swank::guess-package ,package-name))))
+
+(defun slime-load-file (filename)
+ "Load the Lisp file FILENAME."
+ (interactive (list
+ (read-file-name "Load file: " nil nil
+ nil (if (buffer-file-name)
+ (file-name-nondirectory
+ (buffer-file-name))))))
+ (let ((lisp-filename (slime-to-lisp-filename (expand-file-name filename))))
+ (slime-eval-with-transcript `(swank:load-file ,lisp-filename))))
+
+(defvar slime-change-directory-hooks nil
+ "Hook run by `slime-change-directory'.
+The functions are called with the new (absolute) directory.")
+
+(defun slime-change-directory (directory)
+ "Make DIRECTORY become Lisp's current directory.
+Return whatever swank:set-default-directory returns."
+ (let ((dir (expand-file-name directory)))
+ (prog1 (slime-eval `(swank:set-default-directory
+ ,(slime-to-lisp-filename dir)))
+ (slime-with-connection-buffer nil (cd-absolute dir))
+ (run-hook-with-args 'slime-change-directory-hooks dir))))
+
+(defun slime-cd (directory)
+ "Make DIRECTORY become Lisp's current directory.
+Return whatever swank:set-default-directory returns."
+ (interactive (list (read-directory-name "Directory: " nil nil t)))
+ (message "default-directory: %s" (slime-change-directory directory)))
+
+(defun slime-pwd ()
+ "Show Lisp's default directory."
+ (interactive)
+ (message "Directory %s" (slime-eval `(swank:default-directory))))
+
+
+;;;; Profiling
+
+(defun slime-toggle-profile-fdefinition (fname-string)
+ "Toggle profiling for FNAME-STRING."
+ (interactive (list (slime-read-from-minibuffer
+ "(Un)Profile: "
+ (slime-symbol-at-point))))
+ (slime-eval-async `(swank:toggle-profile-fdefinition ,fname-string)
+ (lambda (r) (message "%s" r))))
+
+(defun slime-unprofile-all ()
+ "Unprofile all functions."
+ (interactive)
+ (slime-eval-async '(swank:unprofile-all)
+ (lambda (r) (message "%s" r))))
+
+(defun slime-profile-report ()
+ "Print profile report."
+ (interactive)
+ (slime-eval-with-transcript '(swank:profile-report)))
+
+(defun slime-profile-reset ()
+ "Reset profile counters."
+ (interactive)
+ (slime-eval-async (slime-eval `(swank:profile-reset))
+ (lambda (r) (message "%s" r))))
+
+(defun slime-profiled-functions ()
+ "Return list of names of currently profiled functions."
+ (interactive)
+ (slime-eval-async `(swank:profiled-functions)
+ (lambda (r) (message "%s" r))))
+
+(defun slime-profile-package (package callers methods)
+ "Profile all functions in PACKAGE.
+If CALLER is non-nil names have counts of the most common calling
+functions recorded.
+If METHODS is non-nil, profile all methods of all generic function
+having names in the given package."
+ (interactive (list (slime-read-package-name "Package: ")
+ (y-or-n-p "Record the most common callers? ")
+ (y-or-n-p "Profile methods? ")))
+ (slime-eval-async `(swank:swank-profile-package ,package ,callers ,methods)
+ (lambda (r) (message "%s" r))))
+
+(defun slime-profile-by-substring (substring &optional package)
+ "Profile all functions which names contain SUBSTRING.
+If PACKAGE is NIL, then search in all packages."
+ (interactive (list
+ (slime-read-from-minibuffer
+ "Profile by matching substring: "
+ (slime-symbol-at-point))
+ (slime-read-package-name "Package (RET for all packages): ")))
+ (let ((package (unless (equal package "") package)))
+ (slime-eval-async `(swank:profile-by-substring ,substring ,package)
+ (lambda (r) (message "%s" r)) )))
+
+;;;; Documentation
+
+(defvar slime-documentation-lookup-function
+ 'slime-hyperspec-lookup)
+
+(defun slime-documentation-lookup ()
+ "Generalized documentation lookup. Defaults to hyperspec lookup."
+ (interactive)
+ (call-interactively slime-documentation-lookup-function))
+
+(defun slime-hyperspec-lookup (symbol-name)
+ "A wrapper for `hyperspec-lookup'"
+ (interactive (list (common-lisp-hyperspec-read-symbol-name
+ (slime-symbol-at-point))))
+ (hyperspec-lookup symbol-name))
+
+(defun slime-describe-symbol (symbol-name)
+ "Describe the symbol at point."
+ (interactive (list (slime-read-symbol-name "Describe symbol: ")))
+ (when (not symbol-name)
+ (error "No symbol given"))
+ (slime-eval-describe `(swank:describe-symbol ,symbol-name)))
+
+(defun slime-documentation (symbol-name)
+ "Display function- or symbol-documentation for SYMBOL-NAME."
+ (interactive (list (slime-read-symbol-name "Documentation for symbol: ")))
+ (when (not symbol-name)
+ (error "No symbol given"))
+ (slime-eval-describe
+ `(swank:documentation-symbol ,symbol-name)))
+
+(defun slime-describe-function (symbol-name)
+ (interactive (list (slime-read-symbol-name "Describe symbol's function: ")))
+ (when (not symbol-name)
+ (error "No symbol given"))
+ (slime-eval-describe `(swank:describe-function ,symbol-name)))
+
+(defface slime-apropos-symbol
+ '((t (:inherit bold)))
+ "Face for the symbol name in Apropos output."
+ :group 'slime)
+
+(defface slime-apropos-label
+ '((t (:inherit italic)))
+ "Face for label (`Function', `Variable' ...) in Apropos output."
+ :group 'slime)
+
+(defun slime-apropos-summary (string case-sensitive-p package only-external-p)
+ "Return a short description for the performed apropos search."
+ (concat (if case-sensitive-p "Case-sensitive " "")
+ "Apropos for "
+ (format "%S" string)
+ (if package (format " in package %S" package) "")
+ (if only-external-p " (external symbols only)" "")))
+
+(defun slime-apropos (string &optional only-external-p package
+ case-sensitive-p)
+ "Show all bound symbols whose names match STRING. With prefix
+arg, you're interactively asked for parameters of the search."
+ (interactive
+ (if current-prefix-arg
+ (list (read-string "SLIME Apropos: ")
+ (y-or-n-p "External symbols only? ")
+ (let ((pkg (slime-read-package-name "Package: ")))
+ (if (string= pkg "") nil pkg))
+ (y-or-n-p "Case-sensitive? "))
+ (list (read-string "SLIME Apropos: ") t nil nil)))
+ (let ((buffer-package (or package (slime-current-package))))
+ (slime-eval-async
+ `(swank:apropos-list-for-emacs ,string ,only-external-p
+ ,case-sensitive-p ',package)
+ (slime-rcurry #'slime-show-apropos string buffer-package
+ (slime-apropos-summary string case-sensitive-p
+ package only-external-p)))))
+
+(defun slime-apropos-all ()
+ "Shortcut for (slime-apropos <string> nil nil)"
+ (interactive)
+ (slime-apropos (read-string "SLIME Apropos: ") nil nil))
+
+(defun slime-apropos-package (package &optional internal)
+ "Show apropos listing for symbols in PACKAGE.
+With prefix argument include internal symbols."
+ (interactive (list (let ((pkg (slime-read-package-name "Package: ")))
+ (if (string= pkg "") (slime-current-package) pkg))
+ current-prefix-arg))
+ (slime-apropos "" (not internal) package))
+
+(autoload 'apropos-mode "apropos")
+(defun slime-show-apropos (plists string package summary)
+ (if (null plists)
+ (message "No apropos matches for %S" string)
+ (slime-with-popup-buffer ((slime-buffer-name :apropos)
+ :package package :connection t
+ :mode 'apropos-mode)
+ (if (boundp 'header-line-format)
+ (setq header-line-format summary)
+ (insert summary "\n\n"))
+ (slime-set-truncate-lines)
+ (slime-print-apropos plists)
+ (set-syntax-table lisp-mode-syntax-table)
+ (goto-char (point-min)))))
+
+(defvar slime-apropos-namespaces
+ '((:variable "Variable")
+ (:function "Function")
+ (:generic-function "Generic Function")
+ (:macro "Macro")
+ (:special-operator "Special Operator")
+ (:setf "Setf")
+ (:type "Type")
+ (:class "Class")
+ (:alien-type "Alien type")
+ (:alien-struct "Alien struct")
+ (:alien-union "Alien type")
+ (:alien-enum "Alien enum")))
+
+(defun slime-print-apropos (plists)
+ (dolist (plist plists)
+ (let ((designator (plist-get plist :designator)))
+ (cl-assert designator)
+ (slime-insert-propertized `(face slime-apropos-symbol) designator))
+ (terpri)
+ (cl-loop for (prop value) on plist by #'cddr
+ unless (eq prop :designator) do
+ (let ((namespace (cadr (or (assq prop slime-apropos-namespaces)
+ (error "Unknown property: %S" prop))))
+ (start (point)))
+ (princ " ")
+ (slime-insert-propertized `(face slime-apropos-label) namespace)
+ (princ ": ")
+ (princ (cl-etypecase value
+ (string value)
+ ((member nil :not-documented) "(not documented)")))
+ (add-text-properties
+ start (point)
+ (list 'type prop 'action 'slime-call-describer
+ 'button t 'apropos-label namespace
+ 'item (plist-get plist :designator)))
+ (terpri)))))
+
+(defun slime-call-describer (arg)
+ (let* ((pos (if (markerp arg) arg (point)))
+ (type (get-text-property pos 'type))
+ (item (get-text-property pos 'item)))
+ (slime-eval-describe `(swank:describe-definition-for-emacs ,item ,type))))
+
+(defun slime-info ()
+ "Open Slime manual"
+ (interactive)
+ (let ((file (expand-file-name "doc/slime.info" slime-path)))
+ (if (file-exists-p file)
+ (info file)
+ (message "No slime.info, run `make slime.info' in %s"
+ (expand-file-name "doc/" slime-path)))))
+
+
+;;;; XREF: cross-referencing
+
+(defvar slime-xref-mode-map)
+
+(define-derived-mode slime-xref-mode lisp-mode "Xref"
+ "slime-xref-mode: Major mode for cross-referencing.
+\\<slime-xref-mode-map>\
+The most important commands:
+\\[slime-xref-quit] - Dismiss buffer.
+\\[slime-show-xref] - Display referenced source and keep xref window.
+\\[slime-goto-xref] - Jump to referenced source and dismiss xref window.
+
+\\{slime-xref-mode-map}
+\\{slime-popup-buffer-mode-map}
+"
+ (slime-popup-buffer-mode)
+ (setq font-lock-defaults nil)
+ (setq delayed-mode-hooks nil)
+ (slime-mode -1))
+
+(slime-define-keys slime-xref-mode-map
+ ((kbd "RET") 'slime-goto-xref)
+ ((kbd "SPC") 'slime-goto-xref)
+ ("v" 'slime-show-xref)
+ ("n" 'slime-xref-next-line)
+ ("p" 'slime-xref-prev-line)
+ ("." 'slime-xref-next-line)
+ ("," 'slime-xref-prev-line)
+ ("\C-c\C-c" 'slime-recompile-xref)
+ ("\C-c\C-k" 'slime-recompile-all-xrefs)
+ ("\M-," 'slime-xref-retract)
+ ([remap next-line] 'slime-xref-next-line)
+ ([remap previous-line] 'slime-xref-prev-line)
+ )
+
+
+;;;;; XREF results buffer and window management
+
+(cl-defmacro slime-with-xref-buffer ((_xref-type _symbol &optional package)
+ &body body)
+ "Execute BODY in a xref buffer, then show that buffer."
+ (declare (indent 1))
+ `(slime-with-popup-buffer ((slime-buffer-name :xref)
+ :package ,package
+ :connection t
+ :select t
+ :mode 'slime-xref-mode)
+ (slime-set-truncate-lines)
+ ,@body))
+
+(defun slime-insert-xrefs (xref-alist)
+ "Insert XREF-ALIST in the current-buffer.
+XREF-ALIST is of the form ((GROUP . ((LABEL LOCATION) ...)) ...).
+GROUP and LABEL are for decoration purposes. LOCATION is a
+source-location."
+ (cl-loop for (group . refs) in xref-alist do
+ (slime-insert-propertized '(face bold) group "\n")
+ (cl-loop for (label location) in refs do
+ (slime-insert-propertized
+ (list 'slime-location location
+ 'face 'font-lock-keyword-face)
+ " " (slime-one-line-ify label) "\n")))
+ ;; Remove the final newline to prevent accidental window-scrolling
+ (backward-delete-char 1))
+
+(defun slime-xref-next-line ()
+ (interactive)
+ (slime-xref-show-location (slime-search-property 'slime-location)))
+
+(defun slime-xref-prev-line ()
+ (interactive)
+ (slime-xref-show-location (slime-search-property 'slime-location t)))
+
+(defun slime-xref-show-location (loc)
+ (cl-ecase (car loc)
+ (:location (slime-show-source-location loc nil 1))
+ (:error (message "%s" (cadr loc)))
+ ((nil))))
+
+(defvar slime-next-location-function nil
+ "Function to call for going to the next location.")
+
+(defvar slime-previous-location-function nil
+ "Function to call for going to the previous location.")
+
+(defvar slime-xref-last-buffer nil
+ "The most recent XREF results buffer.
+This is used by `slime-goto-next-xref'")
+
+(defun slime-show-xref-buffer (xrefs _type _symbol package)
+ (slime-with-xref-buffer (_type _symbol package)
+ (slime-insert-xrefs xrefs)
+ (setq slime-next-location-function 'slime-goto-next-xref)
+ (setq slime-previous-location-function 'slime-goto-previous-xref)
+ (setq slime-xref-last-buffer (current-buffer))
+ (goto-char (point-min))))
+
+(defun slime-show-xrefs (xrefs type symbol package)
+ "Show the results of an XREF query."
+ (if (null xrefs)
+ (message "No references found for %s." symbol)
+ (slime-show-xref-buffer xrefs type symbol package)))
+
+
+;;;;; XREF commands
+
+(defun slime-who-calls (symbol)
+ "Show all known callers of the function SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who calls: " t)))
+ (slime-xref :calls symbol))
+
+(defun slime-calls-who (symbol)
+ "Show all known functions called by the function SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who calls: " t)))
+ (slime-xref :calls-who symbol))
+
+(defun slime-who-references (symbol)
+ "Show all known referrers of the global variable SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who references: " t)))
+ (slime-xref :references symbol))
+
+(defun slime-who-binds (symbol)
+ "Show all known binders of the global variable SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who binds: " t)))
+ (slime-xref :binds symbol))
+
+(defun slime-who-sets (symbol)
+ "Show all known setters of the global variable SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who sets: " t)))
+ (slime-xref :sets symbol))
+
+(defun slime-who-macroexpands (symbol)
+ "Show all known expanders of the macro SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who macroexpands: " t)))
+ (slime-xref :macroexpands symbol))
+
+(defun slime-who-specializes (symbol)
+ "Show all known methods specialized on class SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who specializes: " t)))
+ (slime-xref :specializes symbol))
+
+(defun slime-list-callers (symbol-name)
+ "List the callers of SYMBOL-NAME in a xref window."
+ (interactive (list (slime-read-symbol-name "List callers: ")))
+ (slime-xref :callers symbol-name))
+
+(defun slime-list-callees (symbol-name)
+ "List the callees of SYMBOL-NAME in a xref window."
+ (interactive (list (slime-read-symbol-name "List callees: ")))
+ (slime-xref :callees symbol-name))
+
+;; FIXME: whats the call (slime-postprocess-xrefs result) good for?
+(defun slime-xref (type symbol &optional continuation)
+ "Make an XREF request to Lisp."
+ (slime-eval-async
+ `(swank:xref ',type ',symbol)
+ (slime-rcurry (lambda (result type symbol package cont)
+ (slime-check-xref-implemented type result)
+ (let* ((_xrefs (slime-postprocess-xrefs result))
+ (file-alist (cadr (slime-analyze-xrefs result))))
+ (funcall (or cont 'slime-show-xrefs)
+ file-alist type symbol package)))
+ type
+ symbol
+ (slime-current-package)
+ continuation)))
+
+(defun slime-check-xref-implemented (type xrefs)
+ (when (eq xrefs :not-implemented)
+ (error "%s is not implemented yet on %s."
+ (slime-xref-type type)
+ (slime-lisp-implementation-name))))
+
+(defun slime-xref-type (type)
+ (format "who-%s" (slime-cl-symbol-name type)))
+
+(defun slime-xrefs (types symbol &optional continuation)
+ "Make multiple XREF requests at once."
+ (slime-eval-async
+ `(swank:xrefs ',types ',symbol)
+ #'(lambda (result)
+ (funcall (or continuation
+ #'slime-show-xrefs)
+ (cl-loop for (key . val) in result
+ collect (cons (slime-xref-type key) val))
+ types symbol (slime-current-package)))))
+
+
+;;;;; XREF navigation
+
+(defun slime-xref-location-at-point ()
+ (save-excursion
+ ;; When the end of the last line is at (point-max) we can't find
+ ;; the text property there. Going to bol avoids this problem.
+ (beginning-of-line 1)
+ (or (get-text-property (point) 'slime-location)
+ (error "No reference at point."))))
+
+(defun slime-xref-dspec-at-point ()
+ (save-excursion
+ (beginning-of-line 1)
+ (with-syntax-table lisp-mode-syntax-table
+ (forward-sexp) ; skip initial whitespaces
+ (backward-sexp)
+ (slime-sexp-at-point))))
+
+(defun slime-all-xrefs ()
+ (let ((xrefs nil))
+ (save-excursion
+ (goto-char (point-min))
+ (while (zerop (forward-line 1))
+ (let ((loc (get-text-property (point) 'slime-location)))
+ (when loc
+ (let* ((dspec (slime-xref-dspec-at-point))
+ (xref (make-slime-xref :dspec dspec :location loc)))
+ (push xref xrefs))))))
+ (nreverse xrefs)))
+
+(defun slime-goto-xref ()
+ "Goto the cross-referenced location at point."
+ (interactive)
+ (slime-show-xref)
+ (quit-window))
+
+(defun slime-show-xref ()
+ "Display the xref at point in the other window."
+ (interactive)
+ (let ((location (slime-xref-location-at-point)))
+ (slime-show-source-location location t 1)))
+
+(defun slime-goto-next-xref (&optional backward)
+ "Goto the next cross-reference location."
+ (if (not (buffer-live-p slime-xref-last-buffer))
+ (error "No XREF buffer alive.")
+ (cl-destructuring-bind (location pos)
+ (with-current-buffer slime-xref-last-buffer
+ (list (slime-search-property 'slime-location backward)
+ (point)))
+ (cond ((slime-location-p location)
+ (slime-pop-to-location location)
+ ;; We do this here because changing the location can take
+ ;; a while when Emacs needs to read a file from disk.
+ (with-current-buffer slime-xref-last-buffer
+ (goto-char pos)
+ (slime-highlight-line 0.35)))
+ ((null location)
+ (message (if backward "No previous xref" "No next xref.")))
+ (t ; error location
+ (slime-goto-next-xref backward))))))
+
+(defun slime-goto-previous-xref ()
+ "Goto the previous cross-reference location."
+ (slime-goto-next-xref t))
+
+(defun slime-search-property (prop &optional backward prop-value-fn)
+ "Search the next text range where PROP is non-nil.
+Return the value of PROP.
+If BACKWARD is non-nil, search backward.
+If PROP-VALUE-FN is non-nil use it to extract PROP's value."
+ (let ((next-candidate (if backward
+ #'previous-single-char-property-change
+ #'next-single-char-property-change))
+ (prop-value-fn (or prop-value-fn
+ (lambda ()
+ (get-text-property (point) prop))))
+ (start (point))
+ (prop-value))
+ (while (progn
+ (goto-char (funcall next-candidate (point) prop))
+ (not (or (setq prop-value (funcall prop-value-fn))
+ (eobp)
+ (bobp)))))
+ (cond (prop-value)
+ (t (goto-char start) nil))))
+
+(defun slime-next-location ()
+ "Go to the next location, depending on context.
+When displaying XREF information, this goes to the next reference."
+ (interactive)
+ (when (null slime-next-location-function)
+ (error "No context for finding locations."))
+ (funcall slime-next-location-function))
+
+(defun slime-previous-location ()
+ "Go to the previous location, depending on context.
+When displaying XREF information, this goes to the previous reference."
+ (interactive)
+ (when (null slime-previous-location-function)
+ (error "No context for finding locations."))
+ (funcall slime-previous-location-function))
+
+(defun slime-recompile-xref (&optional raw-prefix-arg)
+ (interactive "P")
+ (let ((slime-compilation-policy (slime-compute-policy raw-prefix-arg)))
+ (let ((location (slime-xref-location-at-point))
+ (dspec (slime-xref-dspec-at-point)))
+ (slime-recompile-locations
+ (list location)
+ (slime-rcurry #'slime-xref-recompilation-cont
+ (list dspec) (current-buffer))))))
+
+(defun slime-recompile-all-xrefs (&optional raw-prefix-arg)
+ (interactive "P")
+ (let ((slime-compilation-policy (slime-compute-policy raw-prefix-arg)))
+ (let ((dspecs) (locations))
+ (dolist (xref (slime-all-xrefs))
+ (when (slime-xref-has-location-p xref)
+ (push (slime-xref.dspec xref) dspecs)
+ (push (slime-xref.location xref) locations)))
+ (slime-recompile-locations
+ locations
+ (slime-rcurry #'slime-xref-recompilation-cont
+ dspecs (current-buffer))))))
+
+(defun slime-xref-recompilation-cont (results dspecs buffer)
+ ;; Extreme long-windedness to insert status of recompilation;
+ ;; sometimes Elisp resembles more of an Ewwlisp.
+
+ ;; FIXME: Should probably throw out the whole recompilation cruft
+ ;; anyway. -- helmut
+ ;; TODO: next iteration of fixme cleanup this is going in a contrib -- jt
+ (with-current-buffer buffer
+ (slime-compilation-finished (slime-aggregate-compilation-results results))
+ (save-excursion
+ (slime-xref-insert-recompilation-flags
+ dspecs (cl-loop for r in results collect
+ (or (slime-compilation-result.successp r)
+ (and (slime-compilation-result.notes r)
+ :complained)))))))
+
+(defun slime-aggregate-compilation-results (results)
+ `(:compilation-result
+ ,(cl-reduce #'append (mapcar #'slime-compilation-result.notes results))
+ ,(cl-every #'slime-compilation-result.successp results)
+ ,(cl-reduce #'+ (mapcar #'slime-compilation-result.duration results))))
+
+(defun slime-xref-insert-recompilation-flags (dspecs compilation-results)
+ (let* ((buffer-read-only nil)
+ (max-column (slime-column-max)))
+ (goto-char (point-min))
+ (cl-loop for dspec in dspecs
+ for result in compilation-results
+ do (save-excursion
+ (cl-loop for dspec2 = (progn (search-forward dspec)
+ (slime-xref-dspec-at-point))
+ until (equal dspec2 dspec))
+ (end-of-line) ; skip old status information.
+ (insert-char ?\ (1+ (- max-column (current-column))))
+ (insert (format "[%s]"
+ (cl-case result
+ ((t) :success)
+ ((nil) :failure)
+ (t result))))))))
+
+
+;;;; Macroexpansion
+
+(define-minor-mode slime-macroexpansion-minor-mode
+ "SLIME mode for macroexpansion"
+ nil
+ " Macroexpand"
+ '(("g" . slime-macroexpand-again)))
+
+(cl-macrolet ((remap (from to)
+ `(dolist (mapping
+ (where-is-internal ,from slime-mode-map))
+ (define-key slime-macroexpansion-minor-mode-map
+ mapping ,to))))
+ (remap 'slime-macroexpand-1 'slime-macroexpand-1-inplace)
+ (remap 'slime-macroexpand-all 'slime-macroexpand-all-inplace)
+ (remap 'slime-compiler-macroexpand-1 'slime-compiler-macroexpand-1-inplace)
+ (remap 'slime-expand-1
+ 'slime-expand-1-inplace)
+ (remap 'advertised-undo 'slime-macroexpand-undo)
+ (remap 'undo 'slime-macroexpand-undo))
+
+(defun slime-macroexpand-undo (&optional arg)
+ (interactive)
+ ;; Emacs 22.x introduced `undo-only' which
+ ;; works by binding `undo-no-redo' to t. We do
+ ;; it this way so we don't break prior Emacs
+ ;; versions.
+ (cl-macrolet ((undo-only (arg) `(let ((undo-no-redo t)) (undo ,arg))))
+ (let ((inhibit-read-only t))
+ (when (fboundp 'slime-remove-edits)
+ (slime-remove-edits (point-min) (point-max)))
+ (undo-only arg))))
+
+(defvar slime-eval-macroexpand-expression nil
+ "Specifies the last macroexpansion preformed.
+This variable specifies both what was expanded and how.")
+
+(defun slime-eval-macroexpand (expander &optional string)
+ (let ((string (or string (slime-sexp-at-point-or-error))))
+ (setq slime-eval-macroexpand-expression `(,expander ,string))
+ (slime-eval-async slime-eval-macroexpand-expression
+ #'slime-initialize-macroexpansion-buffer)))
+
+(defun slime-macroexpand-again ()
+ "Reperform the last macroexpansion."
+ (interactive)
+ (slime-eval-async slime-eval-macroexpand-expression
+ (slime-rcurry #'slime-initialize-macroexpansion-buffer
+ (current-buffer))))
+
+(defun slime-initialize-macroexpansion-buffer (expansion &optional buffer)
+ (pop-to-buffer (or buffer (slime-create-macroexpansion-buffer)))
+ (setq buffer-undo-list nil) ; Get rid of undo information from
+ ; previous expansions.
+ (let ((inhibit-read-only t)
+ (buffer-undo-list t)) ; Make the initial insertion not be undoable.
+ (erase-buffer)
+ (insert expansion)
+ (goto-char (point-min))
+ (font-lock-fontify-buffer)))
+
+(defun slime-create-macroexpansion-buffer ()
+ (let ((name (slime-buffer-name :macroexpansion)))
+ (slime-with-popup-buffer (name :package t :connection t
+ :mode 'lisp-mode)
+ (slime-mode 1)
+ (slime-macroexpansion-minor-mode 1)
+ (setq font-lock-keywords-case-fold-search t)
+ (current-buffer))))
+
+(defun slime-eval-macroexpand-inplace (expander)
+ "Substitute the sexp at point with its macroexpansion.
+
+NB: Does not affect slime-eval-macroexpand-expression"
+ (interactive)
+ (let* ((bounds (or (slime-bounds-of-sexp-at-point)
+ (user-error "No sexp at point"))))
+ (lexical-let* ((start (copy-marker (car bounds)))
+ (end (copy-marker (cdr bounds)))
+ (point (point))
+ (package (slime-current-package))
+ (buffer (current-buffer)))
+ (slime-eval-async
+ `(,expander ,(buffer-substring-no-properties start end))
+ (lambda (expansion)
+ (with-current-buffer buffer
+ (let ((buffer-read-only nil))
+ (when (fboundp 'slime-remove-edits)
+ (slime-remove-edits (point-min) (point-max)))
+ (goto-char start)
+ (delete-region start end)
+ (slime-insert-indented expansion)
+ (goto-char point))))))))
+
+(defun slime-macroexpand-1 (&optional repeatedly)
+ "Display the macro expansion of the form starting at point.
+The form is expanded with CL:MACROEXPAND-1 or, if a prefix
+argument is given, with CL:MACROEXPAND."
+ (interactive "P")
+ (slime-eval-macroexpand
+ (if repeatedly 'swank:swank-macroexpand 'swank:swank-macroexpand-1)))
+
+(defun slime-macroexpand-1-inplace (&optional repeatedly)
+ (interactive "P")
+ (slime-eval-macroexpand-inplace
+ (if repeatedly 'swank:swank-macroexpand 'swank:swank-macroexpand-1)))
+
+(defun slime-macroexpand-all ()
+ "Display the recursively macro expanded sexp starting at
+point."
+ (interactive)
+ (slime-eval-macroexpand 'swank:swank-macroexpand-all))
+
+(defun slime-macroexpand-all-inplace ()
+ "Display the recursively macro expanded sexp starting at point."
+ (interactive)
+ (slime-eval-macroexpand-inplace 'swank:swank-macroexpand-all))
+
+(defun slime-compiler-macroexpand-1 (&optional repeatedly)
+ "Display the compiler-macro expansion of sexp starting at point."
+ (interactive "P")
+ (slime-eval-macroexpand
+ (if repeatedly
+ 'swank:swank-compiler-macroexpand
+ 'swank:swank-compiler-macroexpand-1)))
+
+(defun slime-compiler-macroexpand-1-inplace (&optional repeatedly)
+ "Display the compiler-macro expansion of sexp starting at point."
+ (interactive "P")
+ (slime-eval-macroexpand-inplace
+ (if repeatedly
+ 'swank:swank-compiler-macroexpand
+ 'swank:swank-compiler-macroexpand-1)))
+
+(defun slime-expand-1 (&optional repeatedly)
+ "Display the macro expansion of the form starting at point.
+The form is expanded with CL:MACROEXPAND-1 or, if a prefix
+argument is given, with CL:MACROEXPAND. If the form denotes a
+compiler macro, SWANK/BACKEND:COMPILER-MACROEXPAND or
+SWANK/BACKEND:COMPILER-MACROEXPAND-1 are used instead."
+ (interactive "P")
+ (slime-eval-macroexpand
+ (if repeatedly
+ 'swank:swank-expand
+ 'swank:swank-expand-1)))
+
+(defun slime-expand-1-inplace (&optional repeatedly)
+ "Display the macro expansion of the form at point.
+The form is expanded with CL:MACROEXPAND-1 or, if a prefix
+argument is given, with CL:MACROEXPAND."
+ (interactive "P")
+ (slime-eval-macroexpand-inplace
+ (if repeatedly
+ 'swank:swank-expand
+ 'swank:swank-expand-1)))
+
+(defun slime-format-string-expand (&optional string)
+ "Expand the format-string at point and display it."
+ (interactive (list (or (and (not current-prefix-arg)
+ (slime-string-at-point))
+ (slime-read-from-minibuffer "Expand format: "
+ (slime-string-at-point)))))
+ (slime-eval-macroexpand 'swank:swank-format-string-expand string))
+
+
+;;;; Subprocess control
+
+(defun slime-interrupt ()
+ "Interrupt Lisp."
+ (interactive)
+ (cond ((slime-use-sigint-for-interrupt) (slime-send-sigint))
+ (t (slime-dispatch-event `(:emacs-interrupt ,slime-current-thread)))))
+
+(defun slime-quit ()
+ (error "Not implemented properly. Use `slime-interrupt' instead."))
+
+(defun slime-quit-lisp (&optional kill)
+ "Quit lisp, kill the inferior process and associated buffers."
+ (interactive "P")
+ (slime-quit-lisp-internal (slime-connection) 'slime-quit-sentinel kill))
+
+(defun slime-quit-lisp-internal (connection sentinel kill)
+ (let ((slime-dispatching-connection connection))
+ (slime-eval-async '(swank:quit-lisp))
+ (let* ((process (slime-inferior-process connection)))
+ (set-process-filter connection nil)
+ (set-process-sentinel connection sentinel)
+ (when (and kill process)
+ (sleep-for 0.2)
+ (unless (memq (process-status process) '(exit signal))
+ (kill-process process))))))
+
+(defun slime-quit-sentinel (process _message)
+ (cl-assert (process-status process) 'closed)
+ (let* ((inferior (slime-inferior-process process))
+ (inferior-buffer (if inferior (process-buffer inferior))))
+ (when inferior (delete-process inferior))
+ (when inferior-buffer (kill-buffer inferior-buffer))
+ (slime-net-close process)
+ (message "Connection closed.")))
+
+
+;;;; Debugger (SLDB)
+
+(defvar sldb-hook nil
+ "Hook run on entry to the debugger.")
+
+(defcustom sldb-initial-restart-limit 6
+ "Maximum number of restarts to display initially."
+ :group 'slime-debugger
+ :type 'integer)
+
+
+;;;;; Local variables in the debugger buffer
+
+;; Small helper.
+(defun slime-make-variables-buffer-local (&rest variables)
+ (mapcar #'make-variable-buffer-local variables))
+
+(slime-make-variables-buffer-local
+ (defvar sldb-condition nil
+ "A list (DESCRIPTION TYPE) describing the condition being debugged.")
+
+ (defvar sldb-restarts nil
+ "List of (NAME DESCRIPTION) for each available restart.")
+
+ (defvar sldb-level nil
+ "Current debug level (recursion depth) displayed in buffer.")
+
+ (defvar sldb-backtrace-start-marker nil
+ "Marker placed at the first frame of the backtrace.")
+
+ (defvar sldb-restart-list-start-marker nil
+ "Marker placed at the first restart in the restart list.")
+
+ (defvar sldb-continuations nil
+ "List of ids for pending continuation."))
+
+;;;;; SLDB macros
+
+;; some macros that we need to define before the first use
+
+(defmacro sldb-in-face (name string)
+ "Return STRING propertised with face sldb-NAME-face."
+ (declare (indent 1))
+ (let ((facename (intern (format "sldb-%s-face" (symbol-name name))))
+ (var (cl-gensym "string")))
+ `(let ((,var ,string))
+ (slime-add-face ',facename ,var)
+ ,var)))
+
+
+;;;;; sldb-mode
+
+(defvar sldb-mode-syntax-table
+ (let ((table (copy-syntax-table lisp-mode-syntax-table)))
+ ;; We give < and > parenthesis syntax, so that #< ... > is treated
+ ;; as a balanced expression. This enables autodoc-mode to match
+ ;; #<unreadable> actual arguments in the backtraces with formal
+ ;; arguments of the function. (For Lisp mode, this is not
+ ;; desirable, since we do not wish to get a mismatched paren
+ ;; highlighted everytime we type < or >.)
+ (modify-syntax-entry ?< "(" table)
+ (modify-syntax-entry ?> ")" table)
+ table)
+ "Syntax table for SLDB mode.")
+
+(define-derived-mode sldb-mode fundamental-mode "sldb"
+ "Superior lisp debugger mode.
+In addition to ordinary SLIME commands, the following are
+available:\\<sldb-mode-map>
+
+Commands to examine the selected frame:
+ \\[sldb-toggle-details] - toggle details (local bindings, CATCH tags)
+ \\[sldb-show-source] - view source for the frame
+ \\[sldb-eval-in-frame] - eval in frame
+ \\[sldb-pprint-eval-in-frame] - eval in frame, pretty-print result
+ \\[sldb-disassemble] - disassemble
+ \\[sldb-inspect-in-frame] - inspect
+
+Commands to invoke restarts:
+ \\[sldb-quit] - quit
+ \\[sldb-abort] - abort
+ \\[sldb-continue] - continue
+ \\[sldb-invoke-restart-0]-\\[sldb-invoke-restart-9] - restart shortcuts
+ \\[sldb-invoke-restart-by-name] - invoke restart by name
+
+Commands to navigate frames:
+ \\[sldb-down] - down
+ \\[sldb-up] - up
+ \\[sldb-details-down] - down, with details
+ \\[sldb-details-up] - up, with details
+ \\[sldb-cycle] - cycle between restarts & backtrace
+ \\[sldb-beginning-of-backtrace] - beginning of backtrace
+ \\[sldb-end-of-backtrace] - end of backtrace
+
+Miscellaneous commands:
+ \\[sldb-restart-frame] - restart frame
+ \\[sldb-return-from-frame] - return from frame
+ \\[sldb-step] - step
+ \\[sldb-break-with-default-debugger] - switch to native debugger
+ \\[sldb-break-with-system-debugger] - switch to system debugger (gdb)
+ \\[slime-interactive-eval] - eval
+ \\[sldb-inspect-condition] - inspect signalled condition
+
+Full list of commands:
+
+\\{sldb-mode-map}"
+ (erase-buffer)
+ (set-syntax-table sldb-mode-syntax-table)
+ (slime-set-truncate-lines)
+ ;; Make original slime-connection "sticky" for SLDB commands in this buffer
+ (setq slime-buffer-connection (slime-connection)))
+
+(set-keymap-parent sldb-mode-map slime-parent-map)
+
+(slime-define-keys sldb-mode-map
+
+ ((kbd "RET") 'sldb-default-action)
+ ("\C-m" 'sldb-default-action)
+ ([return] 'sldb-default-action)
+ ([mouse-2] 'sldb-default-action/mouse)
+ ([follow-link] 'mouse-face)
+ ("\C-i" 'sldb-cycle)
+ ("h" 'describe-mode)
+ ("v" 'sldb-show-source)
+ ("e" 'sldb-eval-in-frame)
+ ("d" 'sldb-pprint-eval-in-frame)
+ ("D" 'sldb-disassemble)
+ ("i" 'sldb-inspect-in-frame)
+ ("n" 'sldb-down)
+ ("p" 'sldb-up)
+ ("\M-n" 'sldb-details-down)
+ ("\M-p" 'sldb-details-up)
+ ("<" 'sldb-beginning-of-backtrace)
+ (">" 'sldb-end-of-backtrace)
+ ("t" 'sldb-toggle-details)
+ ("r" 'sldb-restart-frame)
+ ("I" 'sldb-invoke-restart-by-name)
+ ("R" 'sldb-return-from-frame)
+ ("c" 'sldb-continue)
+ ("s" 'sldb-step)
+ ("x" 'sldb-next)
+ ("o" 'sldb-out)
+ ("b" 'sldb-break-on-return)
+ ("a" 'sldb-abort)
+ ("q" 'sldb-quit)
+ ("A" 'sldb-break-with-system-debugger)
+ ("B" 'sldb-break-with-default-debugger)
+ ("P" 'sldb-print-condition)
+ ("C" 'sldb-inspect-condition)
+ (":" 'slime-interactive-eval)
+ ("\C-c\C-c" 'sldb-recompile-frame-source))
+
+;; Keys 0-9 are shortcuts to invoke particular restarts.
+(dotimes (number 10)
+ (let ((fname (intern (format "sldb-invoke-restart-%S" number)))
+ (docstring (format "Invoke restart numbered %S." number)))
+ (eval `(defun ,fname ()
+ ,docstring
+ (interactive)
+ (sldb-invoke-restart ,number)))
+ (define-key sldb-mode-map (number-to-string number) fname)))
+
+
+;;;;; SLDB buffer creation & update
+
+(defun sldb-buffers (&optional connection)
+ "Return a list of all sldb buffers (belonging to CONNECTION.)"
+ (if connection
+ (slime-filter-buffers (lambda ()
+ (and (eq slime-buffer-connection connection)
+ (eq major-mode 'sldb-mode))))
+ (slime-filter-buffers (lambda () (eq major-mode 'sldb-mode)))))
+
+(defun sldb-find-buffer (thread &optional connection)
+ (let ((connection (or connection (slime-connection))))
+ (cl-find-if (lambda (buffer)
+ (with-current-buffer buffer
+ (and (eq slime-buffer-connection connection)
+ (eq slime-current-thread thread))))
+ (sldb-buffers))))
+
+(defun sldb-get-default-buffer ()
+ "Get a sldb buffer.
+The chosen buffer the default connection's it if exists."
+ (car (sldb-buffers slime-default-connection)))
+
+(defun sldb-get-buffer (thread &optional connection)
+ "Find or create a sldb-buffer for THREAD."
+ (let ((connection (or connection (slime-connection))))
+ (or (sldb-find-buffer thread connection)
+ (let ((name (format "*sldb %s/%s*" (slime-connection-name) thread)))
+ (with-current-buffer (generate-new-buffer name)
+ (setq slime-buffer-connection connection
+ slime-current-thread thread)
+ (current-buffer))))))
+
+(defun sldb-debugged-continuations (connection)
+ "Return the all debugged continuations for CONNECTION across SLDB buffers."
+ (cl-loop for b in (sldb-buffers)
+ append (with-current-buffer b
+ (and (eq slime-buffer-connection connection)
+ sldb-continuations))))
+
+(defun sldb-setup (thread level condition restarts frames conts)
+ "Setup a new SLDB buffer.
+CONDITION is a string describing the condition to debug.
+RESTARTS is a list of strings (NAME DESCRIPTION) for each available restart.
+FRAMES is a list (NUMBER DESCRIPTION &optional PLIST) describing the initial
+portion of the backtrace. Frames are numbered from 0.
+CONTS is a list of pending Emacs continuations."
+ (with-current-buffer (sldb-get-buffer thread)
+ (cl-assert (if (equal sldb-level level)
+ (equal sldb-condition condition)
+ t)
+ () "Bug: sldb-level is equal but condition differs\n%s\n%s"
+ sldb-condition condition)
+ (unless (equal sldb-level level)
+ (setq buffer-read-only nil)
+ (sldb-mode)
+ (setq slime-current-thread thread)
+ (setq sldb-level level)
+ (setq mode-name (format "sldb[%d]" sldb-level))
+ (setq sldb-condition condition)
+ (setq sldb-restarts restarts)
+ (setq sldb-continuations conts)
+ (sldb-insert-condition condition)
+ (insert "\n\n" (sldb-in-face section "Restarts:") "\n")
+ (setq sldb-restart-list-start-marker (point-marker))
+ (sldb-insert-restarts restarts 0 sldb-initial-restart-limit)
+ (insert "\n" (sldb-in-face section "Backtrace:") "\n")
+ (setq sldb-backtrace-start-marker (point-marker))
+ (save-excursion
+ (if frames
+ (sldb-insert-frames (sldb-prune-initial-frames frames) t)
+ (insert "[No backtrace]")))
+ (run-hooks 'sldb-hook)
+ (set-syntax-table lisp-mode-syntax-table))
+ ;; FIXME: remove when dropping Emacs23 support
+ (let ((saved (selected-window)))
+ (pop-to-buffer (current-buffer))
+ (set-window-parameter (selected-window) 'sldb-restore saved))
+ (unless noninteractive ; needed for tests in batch-mode
+ (slime--display-region (point-min) (point)))
+ (setq buffer-read-only t)
+ (when (and slime-stack-eval-tags
+ ;; (y-or-n-p "Enter recursive edit? ")
+ )
+ (message "Entering recursive edit..")
+ (recursive-edit))))
+
+(defun sldb-activate (thread level select)
+ "Display the debugger buffer for THREAD.
+If LEVEL isn't the same as in the buffer reinitialize the buffer."
+ (or (let ((buffer (sldb-find-buffer thread)))
+ (when buffer
+ (with-current-buffer buffer
+ (when (equal sldb-level level)
+ (when select (pop-to-buffer (current-buffer)))
+ t))))
+ (sldb-reinitialize thread level)))
+
+(defun sldb-reinitialize (thread level)
+ (slime-rex (thread level)
+ ('(swank:debugger-info-for-emacs 0 10)
+ nil thread)
+ ((:ok result)
+ (apply #'sldb-setup thread level result))))
+
+(defun sldb-exit (thread _level &optional stepping)
+ "Exit from the debug level LEVEL."
+ (let ((sldb (sldb-find-buffer thread)))
+ (when sldb
+ (with-current-buffer sldb
+ (cond (stepping
+ (setq sldb-level nil)
+ (run-with-timer 0.4 nil 'sldb-close-step-buffer sldb))
+ ((not (eq sldb (window-buffer (selected-window))))
+ ;; A different window selection means an indirect,
+ ;; non-interactive exit, we just kill the sldb buffer.
+ (kill-buffer))
+ (t
+ ;; An interactive exit should restore configuration per
+ ;; `quit-window's protocol. FIXME: remove
+ ;; `previous-window' hack when dropping Emacs23 support
+ (let ((previous-window (window-parameter (selected-window)
+ 'sldb-restore)))
+ (quit-window t)
+ (if (and (not (>= emacs-major-version 24))
+ (window-live-p previous-window))
+ (select-window previous-window)))))))))
+
+(defun sldb-close-step-buffer (buffer)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (when (not sldb-level)
+ (quit-window t)))))
+
+
+;;;;;; SLDB buffer insertion
+
+(defun sldb-insert-condition (condition)
+ "Insert the text for CONDITION.
+CONDITION should be a list (MESSAGE TYPE EXTRAS).
+EXTRAS is currently used for the stepper."
+ (cl-destructuring-bind (message type extras) condition
+ (slime-insert-propertized '(sldb-default-action sldb-inspect-condition)
+ (sldb-in-face topline message)
+ "\n"
+ (sldb-in-face condition type))
+ (sldb-dispatch-extras extras)))
+
+(defvar sldb-extras-hooks)
+
+(defun sldb-dispatch-extras (extras)
+ ;; this is (mis-)used for the stepper
+ (dolist (extra extras)
+ (slime-dcase extra
+ ((:show-frame-source n)
+ (sldb-show-frame-source n))
+ (t
+ (or (run-hook-with-args-until-success 'sldb-extras-hooks extra)
+ ;;(error "Unhandled extra element:" extra)
+ )))))
+
+(defun sldb-insert-restarts (restarts start count)
+ "Insert RESTARTS and add the needed text props
+RESTARTS should be a list ((NAME DESCRIPTION) ...)."
+ (let* ((len (length restarts))
+ (end (if count (min (+ start count) len) len)))
+ (cl-loop for (name string) in (cl-subseq restarts start end)
+ for number from start
+ do (slime-insert-propertized
+ `(,@nil restart ,number
+ sldb-default-action sldb-invoke-restart
+ mouse-face highlight)
+ " " (sldb-in-face restart-number (number-to-string number))
+ ": [" (sldb-in-face restart-type name) "] "
+ (sldb-in-face restart string))
+ (insert "\n"))
+ (when (< end len)
+ (let ((pos (point)))
+ (slime-insert-propertized
+ (list 'sldb-default-action
+ (slime-rcurry #'sldb-insert-more-restarts restarts pos end))
+ " --more--\n")))))
+
+(defun sldb-insert-more-restarts (restarts position start)
+ (goto-char position)
+ (let ((inhibit-read-only t))
+ (delete-region position (1+ (line-end-position)))
+ (sldb-insert-restarts restarts start nil)))
+
+(defun sldb-frame.string (frame)
+ (cl-destructuring-bind (_ str &optional _) frame str))
+
+(defun sldb-frame.number (frame)
+ (cl-destructuring-bind (n _ &optional _) frame n))
+
+(defun sldb-frame.plist (frame)
+ (cl-destructuring-bind (_ _ &optional plist) frame plist))
+
+(defun sldb-frame-restartable-p (frame)
+ (and (plist-get (sldb-frame.plist frame) :restartable) t))
+
+(defun sldb-prune-initial-frames (frames)
+ "Return the prefix of FRAMES to initially present to the user.
+Regexp heuristics are used to avoid showing SWANK-internal frames."
+ (let* ((case-fold-search t)
+ (rx "^\\([() ]\\|lambda\\)*swank\\>"))
+ (or (cl-loop for frame in frames
+ until (string-match rx (sldb-frame.string frame))
+ collect frame)
+ frames)))
+
+(defun sldb-insert-frames (frames more)
+ "Insert FRAMES into buffer.
+If MORE is non-nil, more frames are on the Lisp stack."
+ (mapc #'sldb-insert-frame frames)
+ (when more
+ (slime-insert-propertized
+ `(,@nil sldb-default-action sldb-fetch-more-frames
+ sldb-previous-frame-number
+ ,(sldb-frame.number (cl-first (last frames)))
+ point-entered sldb-fetch-more-frames
+ start-open t
+ face sldb-section-face
+ mouse-face highlight)
+ " --more--")
+ (insert "\n")))
+
+(defun sldb-compute-frame-face (frame)
+ (if (sldb-frame-restartable-p frame)
+ 'sldb-restartable-frame-line-face
+ 'sldb-frame-line-face))
+
+(defun sldb-insert-frame (frame &optional face)
+ "Insert FRAME with FACE at point.
+If FACE is nil, `sldb-compute-frame-face' is used to determine the face."
+ (setq face (or face (sldb-compute-frame-face frame)))
+ (let ((number (sldb-frame.number frame))
+ (string (sldb-frame.string frame))
+ (props `(frame ,frame sldb-default-action sldb-toggle-details)))
+ (slime-propertize-region props
+ (slime-propertize-region '(mouse-face highlight)
+ (insert " " (sldb-in-face frame-label (format "%2d:" number)) " ")
+ (slime-insert-indented
+ (slime-add-face face string)))
+ (insert "\n"))))
+
+(defun sldb-fetch-more-frames (&rest _)
+ "Fetch more backtrace frames.
+Called on the `point-entered' text-property hook."
+ (let ((inhibit-point-motion-hooks t)
+ (inhibit-read-only t)
+ (prev (get-text-property (point) 'sldb-previous-frame-number)))
+ ;; we may be called twice, PREV is nil the second time
+ (when prev
+ (let* ((count 40)
+ (from (1+ prev))
+ (to (+ from count))
+ (frames (slime-eval `(swank:backtrace ,from ,to)))
+ (more (slime-length= frames count))
+ (pos (point)))
+ (delete-region (line-beginning-position) (point-max))
+ (sldb-insert-frames frames more)
+ (goto-char pos)))))
+
+
+;;;;;; SLDB examining text props
+
+(defun sldb-restart-at-point ()
+ (or (get-text-property (point) 'restart)
+ (error "No restart at point")))
+
+(defun sldb-frame-number-at-point ()
+ (let ((frame (get-text-property (point) 'frame)))
+ (cond (frame (car frame))
+ (t (error "No frame at point")))))
+
+(defun sldb-var-number-at-point ()
+ (let ((var (get-text-property (point) 'var)))
+ (cond (var var)
+ (t (error "No variable at point")))))
+
+(defun sldb-previous-frame-number ()
+ (save-excursion
+ (sldb-backward-frame)
+ (sldb-frame-number-at-point)))
+
+(defun sldb-frame-details-visible-p ()
+ (and (get-text-property (point) 'frame)
+ (get-text-property (point) 'details-visible-p)))
+
+(defun sldb-frame-region ()
+ (slime-property-bounds 'frame))
+
+(defun sldb-forward-frame ()
+ (goto-char (next-single-char-property-change (point) 'frame)))
+
+(defun sldb-backward-frame ()
+ (when (> (point) sldb-backtrace-start-marker)
+ (goto-char (previous-single-char-property-change
+ (if (get-text-property (point) 'frame)
+ (car (sldb-frame-region))
+ (point))
+ 'frame
+ nil sldb-backtrace-start-marker))))
+
+(defun sldb-goto-last-frame ()
+ (goto-char (point-max))
+ (while (not (get-text-property (point) 'frame))
+ (goto-char (previous-single-property-change (point) 'frame))
+ ;; Recenter to bottom of the window; -2 to account for the
+ ;; empty last line displayed in sldb buffers.
+ (recenter -2)))
+
+(defun sldb-beginning-of-backtrace ()
+ "Goto the first frame."
+ (interactive)
+ (goto-char sldb-backtrace-start-marker))
+
+
+;;;;;; SLDB recenter & redisplay
+;; not sure yet, whether this is a good idea.
+;;
+;; jt: seconded. Only `sldb-show-frame-details' and
+;; `sldb-hide-frame-details' use this. They could avoid it by not
+;; removing and reinserting the frame's name line.
+(defmacro slime-save-coordinates (origin &rest body)
+ "Restore line and column relative to ORIGIN, after executing BODY.
+
+This is useful if BODY deletes and inserts some text but we want to
+preserve the current row and column as closely as possible."
+ (let ((base (make-symbol "base"))
+ (goal (make-symbol "goal"))
+ (mark (make-symbol "mark")))
+ `(let* ((,base ,origin)
+ (,goal (slime-coordinates ,base))
+ (,mark (point-marker)))
+ (set-marker-insertion-type ,mark t)
+ (prog1 (save-excursion ,@body)
+ (slime-restore-coordinate ,base ,goal ,mark)))))
+
+(put 'slime-save-coordinates 'lisp-indent-function 1)
+
+(defun slime-coordinates (origin)
+ ;; Return a pair (X . Y) for the column and line distance to ORIGIN.
+ (let ((y (slime-count-lines origin (point)))
+ (x (save-excursion
+ (- (current-column)
+ (progn (goto-char origin) (current-column))))))
+ (cons x y)))
+
+(defun slime-restore-coordinate (base goal limit)
+ ;; Move point to GOAL. Coordinates are relative to BASE.
+ ;; Don't move beyond LIMIT.
+ (save-restriction
+ (narrow-to-region base limit)
+ (goto-char (point-min))
+ (let ((col (current-column)))
+ (forward-line (cdr goal))
+ (when (and (eobp) (bolp) (not (bobp)))
+ (backward-char))
+ (move-to-column (+ col (car goal))))))
+
+(defun slime-count-lines (start end)
+ "Return the number of lines between START and END.
+This is 0 if START and END at the same line."
+ (- (count-lines start end)
+ (if (save-excursion (goto-char end) (bolp)) 0 1)))
+
+
+;;;;; SLDB commands
+
+(defun sldb-default-action ()
+ "Invoke the action at point."
+ (interactive)
+ (let ((fn (get-text-property (point) 'sldb-default-action)))
+ (if fn (funcall fn))))
+
+(defun sldb-default-action/mouse (event)
+ "Invoke the action pointed at by the mouse."
+ (interactive "e")
+ (cl-destructuring-bind (_mouse-1 (_w pos &rest ignore)) event
+ (save-excursion
+ (goto-char pos)
+ (let ((fn (get-text-property (point) 'sldb-default-action)))
+ (if fn (funcall fn))))))
+
+(defun sldb-cycle ()
+ "Cycle between restart list and backtrace."
+ (interactive)
+ (let ((pt (point)))
+ (cond ((< pt sldb-restart-list-start-marker)
+ (goto-char sldb-restart-list-start-marker))
+ ((< pt sldb-backtrace-start-marker)
+ (goto-char sldb-backtrace-start-marker))
+ (t
+ (goto-char sldb-restart-list-start-marker)))))
+
+(defun sldb-end-of-backtrace ()
+ "Fetch the entire backtrace and go to the last frame."
+ (interactive)
+ (sldb-fetch-all-frames)
+ (sldb-goto-last-frame))
+
+(defun sldb-fetch-all-frames ()
+ (let ((inhibit-read-only t)
+ (inhibit-point-motion-hooks t))
+ (sldb-goto-last-frame)
+ (let ((last (sldb-frame-number-at-point)))
+ (goto-char (next-single-char-property-change (point) 'frame))
+ (delete-region (point) (point-max))
+ (save-excursion
+ (sldb-insert-frames (slime-eval `(swank:backtrace ,(1+ last) nil))
+ nil)))))
+
+
+;;;;;; SLDB show source
+
+(defun sldb-show-source ()
+ "Highlight the frame at point's expression in a source code buffer."
+ (interactive)
+ (sldb-show-frame-source (sldb-frame-number-at-point)))
+
+(defun sldb-show-frame-source (frame-number)
+ (slime-eval-async
+ `(swank:frame-source-location ,frame-number)
+ (lambda (source-location)
+ (slime-dcase source-location
+ ((:error message)
+ (message "%s" message)
+ (ding))
+ (t
+ (slime-show-source-location source-location t nil))))))
+
+(defun slime-show-source-location (source-location
+ &optional highlight recenter-arg)
+ "Go to SOURCE-LOCATION and display the buffer in the other window."
+ (slime-goto-source-location source-location)
+ ;; show the location, but don't hijack focus.
+ (slime--display-position (point) t recenter-arg)
+ (when highlight (slime-highlight-sexp)))
+
+(defun slime--display-position (pos other-window recenter-arg)
+ (with-selected-window (display-buffer (current-buffer) other-window)
+ (goto-char pos)
+ (recenter recenter-arg)))
+
+;; Set window-start so that the region from START to END becomes visible.
+;; START is inclusive; END is exclusive.
+(defun slime--adjust-window-start (start end)
+ (let* ((last (max start (1- end)))
+ (window-height (window-text-height))
+ (region-height (count-screen-lines start last t)))
+ ;; if needed, make the region visible
+ (when (or (not (pos-visible-in-window-p start))
+ (not (pos-visible-in-window-p last)))
+ (let* ((nlines (cond ((or (< start (window-start))
+ (>= region-height window-height))
+ 0)
+ (t
+ (- region-height)))))
+ (goto-char start)
+ (recenter nlines)))
+ (cl-assert (pos-visible-in-window-p start))
+ (cl-assert (or (pos-visible-in-window-p last)
+ (> region-height window-height)))
+ (cl-assert (pos-visible-in-window-p (1- (window-end nil t)) nil t))))
+
+;; move POS to visible region
+(defun slime--adjust-window-point (pos)
+ (cond ((pos-visible-in-window-p pos)
+ (goto-char pos))
+ ((< pos (window-start))
+ (goto-char (window-start)))
+ (t
+ (goto-char (1- (window-end nil t)))
+ (move-to-column 0)))
+ (cl-assert (pos-visible-in-window-p (point) nil t)))
+
+(defun slime--display-region (start end)
+ "Make the region from START to END visible.
+Minimize point motion."
+ (cl-assert (<= start end))
+ (cl-assert (eq (window-buffer (selected-window))
+ (current-buffer)))
+ (let ((pos (point)))
+ (slime--adjust-window-start start end)
+ (slime--adjust-window-point pos)))
+
+(defun slime-highlight-sexp (&optional start end)
+ "Highlight the first sexp after point."
+ (let ((start (or start (point)))
+ (end (or end (save-excursion (ignore-errors (forward-sexp)) (point)))))
+ (slime-flash-region start end)))
+
+(defun slime-highlight-line (&optional timeout)
+ (slime-flash-region (+ (line-beginning-position) (current-indentation))
+ (line-end-position)
+ timeout))
+
+
+;;;;;; SLDB toggle details
+
+(defun sldb-toggle-details (&optional on)
+ "Toggle display of details for the current frame.
+The details include local variable bindings and CATCH-tags."
+ (interactive)
+ (cl-assert (sldb-frame-number-at-point))
+ (let ((inhibit-read-only t)
+ (inhibit-point-motion-hooks t))
+ (if (or on (not (sldb-frame-details-visible-p)))
+ (sldb-show-frame-details)
+ (sldb-hide-frame-details))))
+
+(defun sldb-show-frame-details ()
+ ;; fetch and display info about local variables and catch tags
+ (cl-destructuring-bind (start end frame locals catches) (sldb-frame-details)
+ (slime-save-coordinates start
+ (delete-region start end)
+ (slime-propertize-region `(frame ,frame details-visible-p t)
+ (sldb-insert-frame frame (if (sldb-frame-restartable-p frame)
+ 'sldb-restartable-frame-line-face
+ ;; FIXME: can we somehow merge the two?
+ 'sldb-detailed-frame-line-face))
+ (let ((indent1 " ")
+ (indent2 " "))
+ (insert indent1 (sldb-in-face section
+ (if locals "Locals:" "[No Locals]")) "\n")
+ (sldb-insert-locals locals indent2 frame)
+ (when catches
+ (insert indent1 (sldb-in-face section "Catch-tags:") "\n")
+ (dolist (tag catches)
+ (slime-propertize-region `(catch-tag ,tag)
+ (insert indent2 (sldb-in-face catch-tag (format "%s" tag))
+ "\n"))))
+ (setq end (point)))))
+ (slime--display-region (point) end)))
+
+(defun sldb-frame-details ()
+ ;; Return a list (START END FRAME LOCALS CATCHES) for frame at point.
+ (let* ((frame (get-text-property (point) 'frame))
+ (num (car frame)))
+ (cl-destructuring-bind (start end) (sldb-frame-region)
+ (cl-list* start end frame
+ (slime-eval `(swank:frame-locals-and-catch-tags ,num))))))
+
+(defvar sldb-insert-frame-variable-value-function
+ 'sldb-insert-frame-variable-value)
+
+(defun sldb-insert-locals (vars prefix frame)
+ "Insert VARS and add PREFIX at the beginning of each inserted line.
+VAR should be a plist with the keys :name, :id, and :value."
+ (cl-loop for i from 0
+ for var in vars do
+ (cl-destructuring-bind (&key name id value) var
+ (slime-propertize-region
+ (list 'sldb-default-action 'sldb-inspect-var 'var i)
+ (insert prefix
+ (sldb-in-face local-name
+ (concat name (if (zerop id) "" (format "#%d" id))))
+ " = ")
+ (funcall sldb-insert-frame-variable-value-function
+ value frame i)
+ (insert "\n")))))
+
+(defun sldb-insert-frame-variable-value (value _frame _index)
+ (insert (sldb-in-face local-value value)))
+
+(defun sldb-hide-frame-details ()
+ ;; delete locals and catch tags, but keep the function name and args.
+ (cl-destructuring-bind (start end) (sldb-frame-region)
+ (let ((frame (get-text-property (point) 'frame)))
+ (slime-save-coordinates start
+ (delete-region start end)
+ (slime-propertize-region '(details-visible-p nil)
+ (sldb-insert-frame frame))))))
+
+(defun sldb-disassemble ()
+ "Disassemble the code for the current frame."
+ (interactive)
+ (let ((frame (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:sldb-disassemble ,frame)
+ (lambda (result)
+ (slime-show-description result nil)))))
+
+
+;;;;;; SLDB eval and inspect
+
+(defun sldb-eval-in-frame (frame string package)
+ "Prompt for an expression and evaluate it in the selected frame."
+ (interactive (sldb-read-form-for-frame "Eval in frame (%s)> "))
+ (slime-eval-async `(swank:eval-string-in-frame ,string ,frame ,package)
+ (if current-prefix-arg
+ 'slime-write-string
+ 'slime-display-eval-result)))
+
+(defun sldb-pprint-eval-in-frame (frame string package)
+ "Prompt for an expression, evaluate in selected frame, pretty-print result."
+ (interactive (sldb-read-form-for-frame "Eval in frame (%s)> "))
+ (slime-eval-async
+ `(swank:pprint-eval-string-in-frame ,string ,frame ,package)
+ (lambda (result)
+ (slime-show-description result nil))))
+
+(defun sldb-read-form-for-frame (fstring)
+ (let* ((frame (sldb-frame-number-at-point))
+ (pkg (slime-eval `(swank:frame-package-name ,frame))))
+ (list frame
+ (let ((slime-buffer-package pkg))
+ (slime-read-from-minibuffer (format fstring pkg)))
+ pkg)))
+
+(defun sldb-inspect-in-frame (string)
+ "Prompt for an expression and inspect it in the selected frame."
+ (interactive (list (slime-read-from-minibuffer
+ "Inspect in frame (evaluated): "
+ (slime-sexp-at-point))))
+ (let ((number (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:inspect-in-frame ,string ,number)
+ 'slime-open-inspector)))
+
+(defun sldb-inspect-var ()
+ (let ((frame (sldb-frame-number-at-point))
+ (var (sldb-var-number-at-point)))
+ (slime-eval-async `(swank:inspect-frame-var ,frame ,var)
+ 'slime-open-inspector)))
+
+(defun sldb-inspect-condition ()
+ "Inspect the current debugger condition."
+ (interactive)
+ (slime-eval-async '(swank:inspect-current-condition)
+ 'slime-open-inspector))
+
+(defun sldb-print-condition ()
+ (interactive)
+ (slime-eval-describe `(swank:sdlb-print-condition)))
+
+
+;;;;;; SLDB movement
+
+(defun sldb-down ()
+ "Select next frame."
+ (interactive)
+ (sldb-forward-frame))
+
+(defun sldb-up ()
+ "Select previous frame."
+ (interactive)
+ (sldb-backward-frame)
+ (when (= (point) sldb-backtrace-start-marker)
+ (recenter (1+ (count-lines (point-min) (point))))))
+
+(defun sldb-sugar-move (move-fn)
+ (let ((inhibit-read-only t))
+ (when (sldb-frame-details-visible-p) (sldb-hide-frame-details))
+ (funcall move-fn)
+ (sldb-show-source)
+ (sldb-toggle-details t)))
+
+(defun sldb-details-up ()
+ "Select previous frame and show details."
+ (interactive)
+ (sldb-sugar-move 'sldb-up))
+
+(defun sldb-details-down ()
+ "Select next frame and show details."
+ (interactive)
+ (sldb-sugar-move 'sldb-down))
+
+
+;;;;;; SLDB restarts
+
+(defun sldb-quit ()
+ "Quit to toplevel."
+ (interactive)
+ (cl-assert sldb-restarts () "sldb-quit called outside of sldb buffer")
+ (slime-rex () ('(swank:throw-to-toplevel))
+ ((:ok x) (error "sldb-quit returned [%s]" x))
+ ((:abort _))))
+
+(defun sldb-continue ()
+ "Invoke the \"continue\" restart."
+ (interactive)
+ (cl-assert sldb-restarts () "sldb-continue called outside of sldb buffer")
+ (slime-rex ()
+ ('(swank:sldb-continue))
+ ((:ok _)
+ (message "No restart named continue")
+ (ding))
+ ((:abort _))))
+
+(defun sldb-abort ()
+ "Invoke the \"abort\" restart."
+ (interactive)
+ (slime-eval-async '(swank:sldb-abort)
+ (lambda (v) (message "Restart returned: %S" v))))
+
+(defun sldb-invoke-restart (&optional number)
+ "Invoke a restart.
+Optional NUMBER (index into `sldb-restarts') specifies the
+restart to invoke, otherwise use the restart at point."
+ (interactive)
+ (let ((restart (or number (sldb-restart-at-point))))
+ (slime-rex ()
+ ((list 'swank:invoke-nth-restart-for-emacs sldb-level restart))
+ ((:ok value) (message "Restart returned: %s" value))
+ ((:abort _)))))
+
+(defun sldb-invoke-restart-by-name (restart-name)
+ (interactive (list (let ((completion-ignore-case t))
+ (completing-read "Restart: " sldb-restarts nil t
+ ""
+ 'sldb-invoke-restart-by-name))))
+ (sldb-invoke-restart (cl-position restart-name sldb-restarts
+ :test 'string= :key 'first)))
+
+(defun sldb-break-with-default-debugger (&optional dont-unwind)
+ "Enter default debugger."
+ (interactive "P")
+ (slime-rex ()
+ ((list 'swank:sldb-break-with-default-debugger
+ (not (not dont-unwind)))
+ nil slime-current-thread)
+ ((:abort _))))
+
+(defun sldb-break-with-system-debugger (&optional lightweight)
+ "Enter system debugger (gdb)."
+ (interactive "P")
+ (slime-attach-gdb slime-buffer-connection lightweight))
+
+(defun slime-attach-gdb (connection &optional lightweight)
+ "Run `gud-gdb'on the connection with PID `pid'.
+
+If `lightweight' is given, do not send any request to the
+inferior Lisp (e.g. to obtain default gdb config) but only
+operate from the Emacs side; intended for cases where the Lisp is
+truly screwed up."
+ (interactive
+ (list (slime-read-connection "Attach gdb to: " (slime-connection)) "P"))
+ (let ((pid (slime-pid connection))
+ (file (slime-lisp-implementation-program connection))
+ (commands (unless lightweight
+ (let ((slime-dispatching-connection connection))
+ (slime-eval `(swank:gdb-initial-commands))))))
+ (gud-gdb (format "gdb -p %d %s" pid (or file "")))
+ (with-current-buffer gud-comint-buffer
+ (dolist (cmd commands)
+ ;; First wait until gdb was initialized, then wait until current
+ ;; command was processed.
+ (while (not (looking-back comint-prompt-regexp nil))
+ (sit-for 0.01))
+ ;; We do not use `gud-call' because we want the initial commands
+ ;; to be displayed by the user so he knows what he's got.
+ (insert cmd)
+ (comint-send-input)))))
+
+(defun slime-read-connection (prompt &optional initial-value)
+ "Read a connection from the minibuffer.
+Return the net process, or nil."
+ (cl-assert (memq initial-value slime-net-processes))
+ (let* ((to-string (lambda (p)
+ (format "%s (pid %d)"
+ (slime-connection-name p) (slime-pid p))))
+ (candidates (mapcar (lambda (p) (cons (funcall to-string p) p))
+ slime-net-processes)))
+ (cdr (assoc (completing-read prompt candidates
+ nil t (funcall to-string initial-value))
+ candidates))))
+
+(defun sldb-step ()
+ "Step to next basic-block boundary."
+ (interactive)
+ (let ((frame (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:sldb-step ,frame))))
+
+(defun sldb-next ()
+ "Step over call."
+ (interactive)
+ (let ((frame (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:sldb-next ,frame))))
+
+(defun sldb-out ()
+ "Resume stepping after returning from this function."
+ (interactive)
+ (let ((frame (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:sldb-out ,frame))))
+
+(defun sldb-break-on-return ()
+ "Set a breakpoint at the current frame.
+The debugger is entered when the frame exits."
+ (interactive)
+ (let ((frame (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:sldb-break-on-return ,frame)
+ (lambda (msg) (message "%s" msg)))))
+
+(defun sldb-break (name)
+ "Set a breakpoint at the start of the function NAME."
+ (interactive (list (slime-read-symbol-name "Function: " t)))
+ (slime-eval-async `(swank:sldb-break ,name)
+ (lambda (msg) (message "%s" msg))))
+
+(defun sldb-return-from-frame (string)
+ "Reads an expression in the minibuffer and causes the function to
+return that value, evaluated in the context of the frame."
+ (interactive (list (slime-read-from-minibuffer "Return from frame: ")))
+ (let* ((number (sldb-frame-number-at-point)))
+ (slime-rex ()
+ ((list 'swank:sldb-return-from-frame number string))
+ ((:ok value) (message "%s" value))
+ ((:abort _)))))
+
+(defun sldb-restart-frame ()
+ "Causes the frame to restart execution with the same arguments as it
+was called originally."
+ (interactive)
+ (let* ((number (sldb-frame-number-at-point)))
+ (slime-rex ()
+ ((list 'swank:restart-frame number))
+ ((:ok value) (message "%s" value))
+ ((:abort _)))))
+
+(defun slime-toggle-break-on-signals ()
+ "Toggle the value of *break-on-signals*."
+ (interactive)
+ (slime-eval-async `(swank:toggle-break-on-signals)
+ (lambda (msg) (message "%s" msg))))
+
+
+;;;;;; SLDB recompilation commands
+
+(defun sldb-recompile-frame-source (&optional raw-prefix-arg)
+ (interactive "P")
+ (slime-eval-async
+ `(swank:frame-source-location ,(sldb-frame-number-at-point))
+ (lexical-let ((policy (slime-compute-policy raw-prefix-arg)))
+ (lambda (source-location)
+ (slime-dcase source-location
+ ((:error message)
+ (message "%s" message)
+ (ding))
+ (t
+ (let ((slime-compilation-policy policy))
+ (slime-recompile-location source-location))))))))
+
+
+;;;; Thread control panel
+
+(defvar slime-threads-buffer-name (slime-buffer-name :threads))
+(defvar slime-threads-buffer-timer nil)
+
+(defcustom slime-threads-update-interval nil
+ "Interval at which the list of threads will be updated."
+ :type '(choice
+ (number :value 0.5)
+ (const nil))
+ :group 'slime-ui)
+
+(defun slime-list-threads ()
+ "Display a list of threads."
+ (interactive)
+ (let ((name slime-threads-buffer-name))
+ (slime-with-popup-buffer (name :connection t
+ :mode 'slime-thread-control-mode)
+ (slime-update-threads-buffer)
+ (goto-char (point-min))
+ (when slime-threads-update-interval
+ (when slime-threads-buffer-timer
+ (cancel-timer slime-threads-buffer-timer))
+ (setq slime-threads-buffer-timer
+ (run-with-timer
+ slime-threads-update-interval
+ slime-threads-update-interval
+ 'slime-update-threads-buffer))))))
+
+(defun slime-quit-threads-buffer ()
+ (when slime-threads-buffer-timer
+ (cancel-timer slime-threads-buffer-timer))
+ (quit-window t)
+ (slime-eval-async `(swank:quit-thread-browser)))
+
+(defun slime-update-threads-buffer ()
+ (interactive)
+ (with-current-buffer slime-threads-buffer-name
+ (slime-eval-async '(swank:list-threads)
+ 'slime-display-threads)))
+
+(defun slime-move-point (position)
+ "Move point in the current buffer and in the window the buffer is displayed."
+ (let ((window (get-buffer-window (current-buffer) t)))
+ (goto-char position)
+ (when window
+ (set-window-point window position))))
+
+(defun slime-display-threads (threads)
+ (with-current-buffer slime-threads-buffer-name
+ (let* ((inhibit-read-only t)
+ (old-thread-id (get-text-property (point) 'thread-id))
+ (old-line (line-number-at-pos))
+ (old-column (current-column)))
+ (erase-buffer)
+ (slime-insert-threads threads)
+ (let ((new-line (cl-position old-thread-id (cdr threads)
+ :key #'car :test #'equal)))
+ (goto-char (point-min))
+ (forward-line (or new-line old-line))
+ (move-to-column old-column)
+ (slime-move-point (point))))))
+
+(defun slime-transpose-lists (list-of-lists)
+ (let ((ncols (length (car list-of-lists))))
+ (cl-loop for col-index below ncols
+ collect (cl-loop for row in list-of-lists
+ collect (elt row col-index)))))
+
+(defun slime-insert-table-row (line line-props col-props col-widths)
+ (slime-propertize-region line-props
+ (cl-loop for string in line
+ for col-prop in col-props
+ for width in col-widths do
+ (slime-insert-propertized col-prop string)
+ (insert-char ?\ (- width (length string))))))
+
+(defun slime-insert-table (rows header row-properties column-properties)
+ "Insert a \"table\" so that the columns are nicely aligned."
+ (let* ((ncols (length header))
+ (lines (cons header rows))
+ (widths (cl-loop for columns in (slime-transpose-lists lines)
+ collect (1+ (cl-loop for cell in columns
+ maximize (length cell)))))
+ (header-line (with-temp-buffer
+ (slime-insert-table-row
+ header nil (make-list ncols nil) widths)
+ (buffer-string))))
+ (cond ((boundp 'header-line-format)
+ (setq header-line-format header-line))
+ (t (insert header-line "\n")))
+ (cl-loop for line in rows for line-props in row-properties do
+ (slime-insert-table-row line line-props column-properties widths)
+ (insert "\n"))))
+
+(defvar slime-threads-table-properties
+ '(nil (face bold)))
+
+(defun slime-insert-threads (threads)
+ (let* ((labels (car threads))
+ (threads (cdr threads))
+ (header (cl-loop for label in labels collect
+ (capitalize (substring (symbol-name label) 1))))
+ (rows (cl-loop for thread in threads collect
+ (cl-loop for prop in thread collect
+ (format "%s" prop))))
+ (line-props (cl-loop for (id) in threads for i from 0
+ collect `(thread-index ,i thread-id ,id)))
+ (col-props (cl-loop for nil in labels for i from 0 collect
+ (nth i slime-threads-table-properties))))
+ (slime-insert-table rows header line-props col-props)))
+
+
+;;;;; Major mode
+
+(define-derived-mode slime-thread-control-mode fundamental-mode
+ "Threads"
+ "SLIME Thread Control Panel Mode.
+
+\\{slime-thread-control-mode-map}
+\\{slime-popup-buffer-mode-map}"
+ (when slime-truncate-lines
+ (set (make-local-variable 'truncate-lines) t))
+ (setq buffer-undo-list t))
+
+(slime-define-keys slime-thread-control-mode-map
+ ("a" 'slime-thread-attach)
+ ("d" 'slime-thread-debug)
+ ("g" 'slime-update-threads-buffer)
+ ("k" 'slime-thread-kill)
+ ("q" 'slime-quit-threads-buffer))
+
+(defun slime-thread-kill ()
+ (interactive)
+ (slime-eval `(cl:mapc 'swank:kill-nth-thread
+ ',(slime-get-properties 'thread-index)))
+ (call-interactively 'slime-update-threads-buffer))
+
+(defun slime-get-region-properties (prop start end)
+ (cl-loop for position = (if (get-text-property start prop)
+ start
+ (next-single-property-change start prop))
+ then (next-single-property-change position prop)
+ while (<= position end)
+ collect (get-text-property position prop)))
+
+(defun slime-get-properties (prop)
+ (if (use-region-p)
+ (slime-get-region-properties prop
+ (region-beginning)
+ (region-end))
+ (let ((value (get-text-property (point) prop)))
+ (when value
+ (list value)))))
+
+(defun slime-thread-attach ()
+ (interactive)
+ (let ((id (get-text-property (point) 'thread-index))
+ (file (slime-swank-port-file)))
+ (slime-eval-async `(swank:start-swank-server-in-thread ,id ,file)))
+ (slime-read-port-and-connect nil))
+
+(defun slime-thread-debug ()
+ (interactive)
+ (let ((id (get-text-property (point) 'thread-index)))
+ (slime-eval-async `(swank:debug-nth-thread ,id))))
+
+
+;;;;; Connection listing
+
+(define-derived-mode slime-connection-list-mode fundamental-mode
+ "Slime-Connections"
+ "SLIME Connection List Mode.
+
+\\{slime-connection-list-mode-map}
+\\{slime-popup-buffer-mode-map}"
+ (when slime-truncate-lines
+ (set (make-local-variable 'truncate-lines) t)))
+
+(slime-define-keys slime-connection-list-mode-map
+ ("d" 'slime-connection-list-make-default)
+ ("g" 'slime-update-connection-list)
+ ((kbd "C-k") 'slime-quit-connection-at-point)
+ ("R" 'slime-restart-connection-at-point))
+
+(defun slime-connection-at-point ()
+ (or (get-text-property (point) 'slime-connection)
+ (error "No connection at point")))
+
+(defun slime-quit-connection-at-point (connection)
+ (interactive (list (slime-connection-at-point)))
+ (let ((slime-dispatching-connection connection)
+ (end (time-add (current-time) (seconds-to-time 3))))
+ (slime-quit-lisp t)
+ (while (memq connection slime-net-processes)
+ (when (time-less-p end (current-time))
+ (message "Quit timeout expired. Disconnecting.")
+ (delete-process connection))
+ (sit-for 0 100)))
+ (slime-update-connection-list))
+
+(defun slime-restart-connection-at-point (connection)
+ (interactive (list (slime-connection-at-point)))
+ (let ((slime-dispatching-connection connection))
+ (slime-restart-inferior-lisp)))
+
+(defun slime-connection-list-make-default ()
+ "Make the connection at point the default connection."
+ (interactive)
+ (slime-select-connection (slime-connection-at-point))
+ (slime-update-connection-list))
+
+(defvar slime-connections-buffer-name (slime-buffer-name :connections))
+
+(defun slime-list-connections ()
+ "Display a list of all connections."
+ (interactive)
+ (slime-with-popup-buffer (slime-connections-buffer-name
+ :mode 'slime-connection-list-mode)
+ (slime-draw-connection-list)))
+
+(defun slime-update-connection-list ()
+ "Display a list of all connections."
+ (interactive)
+ (let ((pos (point))
+ (inhibit-read-only t))
+ (erase-buffer)
+ (slime-draw-connection-list)
+ (goto-char pos)))
+
+(defun slime-draw-connection-list ()
+ (let ((default-pos nil)
+ (default slime-default-connection)
+ (fstring "%s%2s %-10s %-17s %-7s %-s\n"))
+ (insert (format fstring " " "Nr" "Name" "Port" "Pid" "Type")
+ (format fstring " " "--" "----" "----" "---" "----"))
+ (dolist (p (reverse slime-net-processes))
+ (when (eq default p) (setf default-pos (point)))
+ (slime-insert-propertized
+ (list 'slime-connection p)
+ (format fstring
+ (if (eq default p) "*" " ")
+ (slime-connection-number p)
+ (slime-connection-name p)
+ (or (process-id p) (process-contact p))
+ (slime-pid p)
+ (slime-lisp-implementation-type p))))
+ (when default-pos
+ (goto-char default-pos))))
+
+
+;;;; Inspector
+
+(defgroup slime-inspector nil
+ "Inspector faces."
+ :prefix "slime-inspector-"
+ :group 'slime)
+
+(defface slime-inspector-topline-face
+ '((t ()))
+ "Face for top line describing object."
+ :group 'slime-inspector)
+
+(defface slime-inspector-label-face
+ '((t (:inherit font-lock-constant-face)))
+ "Face for labels in the inspector."
+ :group 'slime-inspector)
+
+(defface slime-inspector-value-face
+ '((t (:inherit font-lock-builtin-face)))
+ "Face for things which can themselves be inspected."
+ :group 'slime-inspector)
+
+(defface slime-inspector-action-face
+ '((t (:inherit font-lock-warning-face)))
+ "Face for labels of inspector actions."
+ :group 'slime-inspector)
+
+(defface slime-inspector-type-face
+ '((t (:inherit font-lock-type-face)))
+ "Face for type description in inspector."
+ :group 'slime-inspector)
+
+(defvar slime-inspector-mark-stack '())
+
+(defun slime-inspect (string)
+ "Eval an expression and inspect the result."
+ (interactive
+ (list (slime-read-from-minibuffer "Inspect value (evaluated): "
+ (slime-sexp-at-point))))
+ (slime-eval-async `(swank:init-inspector ,string) 'slime-open-inspector))
+
+(define-derived-mode slime-inspector-mode fundamental-mode
+ "Slime-Inspector"
+ "
+\\{slime-inspector-mode-map}
+\\{slime-popup-buffer-mode-map}"
+ (set-syntax-table lisp-mode-syntax-table)
+ (slime-set-truncate-lines)
+ (setq buffer-read-only t))
+
+(defun slime-inspector-buffer ()
+ (or (get-buffer (slime-buffer-name :inspector))
+ (slime-with-popup-buffer ((slime-buffer-name :inspector)
+ :mode 'slime-inspector-mode)
+ (setq slime-inspector-mark-stack '())
+ (buffer-disable-undo)
+ (current-buffer))))
+
+(defmacro slime-inspector-fontify (face string)
+ `(slime-add-face ',(intern (format "slime-inspector-%s-face" face)) ,string))
+
+(defvar slime-inspector-insert-ispec-function 'slime-inspector-insert-ispec)
+
+(defun slime-open-inspector (inspected-parts &optional point hook)
+ "Display INSPECTED-PARTS in a new inspector window.
+Optionally set point to POINT. If HOOK is provided, it is added to local
+KILL-BUFFER hooks for the inspector buffer."
+ (with-current-buffer (slime-inspector-buffer)
+ (when hook
+ (add-hook 'kill-buffer-hook hook t t))
+ (setq slime-buffer-connection (slime-current-connection))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (pop-to-buffer (current-buffer))
+ (cl-destructuring-bind (&key id title content) inspected-parts
+ (cl-macrolet ((fontify (face string)
+ `(slime-inspector-fontify ,face ,string)))
+ (slime-propertize-region
+ (list 'slime-part-number id
+ 'mouse-face 'highlight
+ 'face 'slime-inspector-value-face)
+ (insert title))
+ (while (eq (char-before) ?\n)
+ (backward-delete-char 1))
+ (insert "\n" (fontify label "--------------------") "\n")
+ (save-excursion
+ (slime-inspector-insert-content content))
+ (when point
+ (cl-check-type point cons)
+ (ignore-errors
+ (goto-char (point-min))
+ (forward-line (1- (car point)))
+ (move-to-column (cdr point)))))))))
+
+(defvar slime-inspector-limit 500)
+
+(defun slime-inspector-insert-content (content)
+ (slime-inspector-fetch-chunk
+ content nil
+ (lambda (chunk)
+ (let ((inhibit-read-only t))
+ (slime-inspector-insert-chunk chunk t t)))))
+
+(defun slime-inspector-insert-chunk (chunk prev next)
+ "Insert CHUNK at point.
+If PREV resp. NEXT are true insert more-buttons as needed."
+ (cl-destructuring-bind (ispecs len start end) chunk
+ (when (and prev (> start 0))
+ (slime-inspector-insert-more-button start t))
+ (mapc slime-inspector-insert-ispec-function ispecs)
+ (when (and next (< end len))
+ (slime-inspector-insert-more-button end nil))))
+
+(defun slime-inspector-insert-ispec (ispec)
+ (if (stringp ispec)
+ (insert ispec)
+ (slime-dcase ispec
+ ((:value string id)
+ (slime-propertize-region
+ (list 'slime-part-number id
+ 'mouse-face 'highlight
+ 'face 'slime-inspector-value-face)
+ (insert string)))
+ ((:label string)
+ (insert (slime-inspector-fontify label string)))
+ ((:action string id)
+ (slime-insert-propertized (list 'slime-action-number id
+ 'mouse-face 'highlight
+ 'face 'slime-inspector-action-face)
+ string)))))
+
+(defun slime-inspector-position ()
+ "Return a pair (Y-POSITION X-POSITION) representing the
+position of point in the current buffer."
+ ;; We make sure we return absolute coordinates even if the user has
+ ;; narrowed the buffer.
+ ;; FIXME: why would somebody narrow the buffer?
+ (save-restriction
+ (widen)
+ (cons (line-number-at-pos)
+ (current-column))))
+
+(defun slime-inspector-property-at-point ()
+ (let* ((properties '(slime-part-number slime-range-button
+ slime-action-number))
+ (find-property
+ (lambda (point)
+ (cl-loop for property in properties
+ for value = (get-text-property point property)
+ when value
+ return (list property value)))))
+ (or (funcall find-property (point))
+ (funcall find-property (1- (point))))))
+
+(defun slime-inspector-operate-on-point ()
+ "Invoke the command for the text at point.
+1. If point is on a value then recursivly call the inspector on
+that value.
+2. If point is on an action then call that action.
+3. If point is on a range-button fetch and insert the range."
+ (interactive)
+ (let ((opener (lexical-let ((point (slime-inspector-position)))
+ (lambda (parts)
+ (when parts
+ (slime-open-inspector parts point)))))
+ (new-opener (lambda (parts)
+ (when parts
+ (slime-open-inspector parts)))))
+ (cl-destructuring-bind (&optional property value)
+ (slime-inspector-property-at-point)
+ (cl-case property
+ (slime-part-number
+ (slime-eval-async `(swank:inspect-nth-part ,value)
+ new-opener)
+ (push (slime-inspector-position) slime-inspector-mark-stack))
+ (slime-range-button
+ (slime-inspector-fetch-more value))
+ (slime-action-number
+ (slime-eval-async `(swank::inspector-call-nth-action ,value)
+ opener))
+ (t (error "No object at point"))))))
+
+(defun slime-inspector-operate-on-click (event)
+ "Move to events' position and operate the part."
+ (interactive "@e")
+ (let ((point (posn-point (event-end event))))
+ (cond ((and point
+ (or (get-text-property point 'slime-part-number)
+ (get-text-property point 'slime-range-button)
+ (get-text-property point 'slime-action-number)))
+ (goto-char point)
+ (slime-inspector-operate-on-point))
+ (t
+ (error "No clickable part here")))))
+
+(defun slime-inspector-pop ()
+ "Reinspect the previous object."
+ (interactive)
+ (slime-eval-async
+ `(swank:inspector-pop)
+ (lambda (result)
+ (cond (result
+ (slime-open-inspector result (pop slime-inspector-mark-stack)))
+ (t
+ (message "No previous object")
+ (ding))))))
+
+(defun slime-inspector-next ()
+ "Inspect the next object in the history."
+ (interactive)
+ (let ((result (slime-eval `(swank:inspector-next))))
+ (cond (result
+ (push (slime-inspector-position) slime-inspector-mark-stack)
+ (slime-open-inspector result))
+ (t (message "No next object")
+ (ding)))))
+
+(defun slime-inspector-quit ()
+ "Quit the inspector and kill the buffer."
+ (interactive)
+ (slime-eval-async `(swank:quit-inspector))
+ (quit-window t))
+
+;; FIXME: first return value is just point.
+;; FIXME: could probably use slime-search-property.
+(defun slime-find-inspectable-object (direction limit)
+ "Find the next/previous inspectable object.
+DIRECTION can be either 'next or 'prev.
+LIMIT is the maximum or minimum position in the current buffer.
+
+Return a list of two values: If an object could be found, the
+starting position of the found object and T is returned;
+otherwise LIMIT and NIL is returned."
+ (let ((finder (cl-ecase direction
+ (next 'next-single-property-change)
+ (prev 'previous-single-property-change))))
+ (let ((prop nil) (curpos (point)))
+ (while (and (not prop) (not (= curpos limit)))
+ (let ((newpos (funcall finder curpos 'slime-part-number nil limit)))
+ (setq prop (get-text-property newpos 'slime-part-number))
+ (setq curpos newpos)))
+ (list curpos (and prop t)))))
+
+(defun slime-inspector-next-inspectable-object (arg)
+ "Move point to the next inspectable object.
+With optional ARG, move across that many objects.
+If ARG is negative, move backwards."
+ (interactive "p")
+ (let ((maxpos (point-max)) (minpos (point-min))
+ (previously-wrapped-p nil))
+ ;; Forward.
+ (while (> arg 0)
+ (cl-destructuring-bind (pos foundp)
+ (slime-find-inspectable-object 'next maxpos)
+ (if foundp
+ (progn (goto-char pos) (setq arg (1- arg))
+ (setq previously-wrapped-p nil))
+ (if (not previously-wrapped-p) ; cycle detection
+ (progn (goto-char minpos) (setq previously-wrapped-p t))
+ (error "No inspectable objects")))))
+ ;; Backward.
+ (while (< arg 0)
+ (cl-destructuring-bind (pos foundp)
+ (slime-find-inspectable-object 'prev minpos)
+ ;; SLIME-OPEN-INSPECTOR inserts the title of an inspector page
+ ;; as a presentation at the beginning of the buffer; skip
+ ;; that. (Notice how this problem can not arise in ``Forward.'')
+ (if (and foundp (/= pos minpos))
+ (progn (goto-char pos) (setq arg (1+ arg))
+ (setq previously-wrapped-p nil))
+ (if (not previously-wrapped-p) ; cycle detection
+ (progn (goto-char maxpos) (setq previously-wrapped-p t))
+ (error "No inspectable objects")))))))
+
+(defun slime-inspector-previous-inspectable-object (arg)
+ "Move point to the previous inspectable object.
+With optional ARG, move across that many objects.
+If ARG is negative, move forwards."
+ (interactive "p")
+ (slime-inspector-next-inspectable-object (- arg)))
+
+(defun slime-inspector-describe ()
+ (interactive)
+ (slime-eval-describe `(swank:describe-inspectee)))
+
+(defun slime-inspector-pprint (part)
+ (interactive (list (or (get-text-property (point) 'slime-part-number)
+ (error "No part at point"))))
+ (slime-eval-describe `(swank:pprint-inspector-part ,part)))
+
+(defun slime-inspector-eval (string)
+ "Eval an expression in the context of the inspected object."
+ (interactive (list (slime-read-from-minibuffer "Inspector eval: ")))
+ (slime-eval-with-transcript `(swank:inspector-eval ,string)))
+
+(defun slime-inspector-history ()
+ "Show the previously inspected objects."
+ (interactive)
+ (slime-eval-describe `(swank:inspector-history)))
+
+(defun slime-inspector-show-source (part)
+ (interactive (list (or (get-text-property (point) 'slime-part-number)
+ (error "No part at point"))))
+ (slime-eval-async
+ `(swank:find-source-location-for-emacs '(:inspector ,part))
+ #'slime-show-source-location))
+
+(defun slime-inspector-reinspect ()
+ (interactive)
+ (slime-eval-async `(swank:inspector-reinspect)
+ (lexical-let ((point (slime-inspector-position)))
+ (lambda (parts)
+ (slime-open-inspector parts point)))))
+
+(defun slime-inspector-toggle-verbose ()
+ (interactive)
+ (slime-eval-async `(swank:inspector-toggle-verbose)
+ (lexical-let ((point (slime-inspector-position)))
+ (lambda (parts)
+ (slime-open-inspector parts point)))))
+
+(defun slime-inspector-insert-more-button (index previous)
+ (slime-insert-propertized
+ (list 'slime-range-button (list index previous)
+ 'mouse-face 'highlight
+ 'face 'slime-inspector-action-face)
+ (if previous " [--more--]\n" " [--more--]")))
+
+(defun slime-inspector-fetch-all ()
+ "Fetch all inspector contents and go to the end."
+ (interactive)
+ (goto-char (1- (point-max)))
+ (let ((button (get-text-property (point) 'slime-range-button)))
+ (when button
+ (let (slime-inspector-limit)
+ (slime-inspector-fetch-more button)))))
+
+(defun slime-inspector-fetch-more (button)
+ (cl-destructuring-bind (index prev) button
+ (slime-inspector-fetch-chunk
+ (list '() (1+ index) index index) prev
+ (slime-rcurry
+ (lambda (chunk prev)
+ (let ((inhibit-read-only t))
+ (apply #'delete-region (slime-property-bounds 'slime-range-button))
+ (slime-inspector-insert-chunk chunk prev (not prev))))
+ prev))))
+
+(defun slime-inspector-fetch-chunk (chunk prev cont)
+ (slime-inspector-fetch chunk slime-inspector-limit prev cont))
+
+(defun slime-inspector-fetch (chunk limit prev cont)
+ (cl-destructuring-bind (from to)
+ (slime-inspector-next-range chunk limit prev)
+ (cond ((and from to)
+ (slime-eval-async
+ `(swank:inspector-range ,from ,to)
+ (slime-rcurry (lambda (chunk2 chunk1 limit prev cont)
+ (slime-inspector-fetch
+ (slime-inspector-join-chunks chunk1 chunk2)
+ limit prev cont))
+ chunk limit prev cont)))
+ (t (funcall cont chunk)))))
+
+(defun slime-inspector-next-range (chunk limit prev)
+ (cl-destructuring-bind (_ len start end) chunk
+ (let ((count (- end start)))
+ (cond ((and prev (< 0 start) (or (not limit) (< count limit)))
+ (list (if limit (max (- end limit) 0) 0) start))
+ ((and (not prev) (< end len) (or (not limit) (< count limit)))
+ (list end (if limit (+ start limit) most-positive-fixnum)))
+ (t '(nil nil))))))
+
+(defun slime-inspector-join-chunks (chunk1 chunk2)
+ (cl-destructuring-bind (i1 _l1 s1 e1) chunk1
+ (cl-destructuring-bind (i2 l2 s2 e2) chunk2
+ (cond ((= e1 s2)
+ (list (append i1 i2) l2 s1 e2))
+ ((= e2 s1)
+ (list (append i2 i1) l2 s2 e1))
+ (t (error "Invalid chunks"))))))
+
+(set-keymap-parent slime-inspector-mode-map slime-parent-map)
+
+(slime-define-keys slime-inspector-mode-map
+ ([return] 'slime-inspector-operate-on-point)
+ ("\C-m" 'slime-inspector-operate-on-point)
+ ([mouse-1] 'slime-inspector-operate-on-click)
+ ([mouse-2] 'slime-inspector-operate-on-click)
+ ([mouse-6] 'slime-inspector-pop)
+ ([mouse-7] 'slime-inspector-next)
+ ("l" 'slime-inspector-pop)
+ ("n" 'slime-inspector-next)
+ (" " 'slime-inspector-next)
+ ("d" 'slime-inspector-describe)
+ ("p" 'slime-inspector-pprint)
+ ("e" 'slime-inspector-eval)
+ ("h" 'slime-inspector-history)
+ ("g" 'slime-inspector-reinspect)
+ ("v" 'slime-inspector-toggle-verbose)
+ ("\C-i" 'slime-inspector-next-inspectable-object)
+ ([(shift tab)]
+ 'slime-inspector-previous-inspectable-object) ; Emacs translates S-TAB
+ ([backtab] 'slime-inspector-previous-inspectable-object) ; to BACKTAB on X.
+ ("." 'slime-inspector-show-source)
+ (">" 'slime-inspector-fetch-all)
+ ("q" 'slime-inspector-quit))
+
+
+;;;; Buffer selector
+
+(defvar slime-selector-methods nil
+ "List of buffer-selection methods for the `slime-select' command.
+Each element is a list (KEY DESCRIPTION FUNCTION).
+DESCRIPTION is a one-line description of what the key selects.")
+
+(defvar slime-selector-other-window nil
+ "If non-nil use switch-to-buffer-other-window.")
+
+(defun slime-selector (&optional other-window)
+ "Select a new buffer by type, indicated by a single character.
+The user is prompted for a single character indicating the method by
+which to choose a new buffer. The `?' character describes the
+available methods.
+
+See `def-slime-selector-method' for defining new methods."
+ (interactive)
+ (message "Select [%s]: "
+ (apply #'string (mapcar #'car slime-selector-methods)))
+ (let* ((slime-selector-other-window other-window)
+ (ch (save-window-excursion
+ (select-window (minibuffer-window))
+ (read-char)))
+ (method (cl-find ch slime-selector-methods :key #'car)))
+ (cond (method
+ (funcall (cl-third method)))
+ (t
+ (message "No method for character: ?\\%c" ch)
+ (ding)
+ (sleep-for 1)
+ (discard-input)
+ (slime-selector)))))
+
+(defmacro def-slime-selector-method (key description &rest body)
+ "Define a new `slime-select' buffer selection method.
+
+KEY is the key the user will enter to choose this method.
+
+DESCRIPTION is a one-line sentence describing how the method
+selects a buffer.
+
+BODY is a series of forms which are evaluated when the selector
+is chosen. The returned buffer is selected with
+switch-to-buffer."
+ (let ((method `(lambda ()
+ (let ((buffer (progn ,@body)))
+ (cond ((not (get-buffer buffer))
+ (message "No such buffer: %S" buffer)
+ (ding))
+ ((get-buffer-window buffer)
+ (select-window (get-buffer-window buffer)))
+ (slime-selector-other-window
+ (switch-to-buffer-other-window buffer))
+ (t
+ (switch-to-buffer buffer)))))))
+ `(setq slime-selector-methods
+ (cl-sort (cons (list ,key ,description ,method)
+ (cl-remove ,key slime-selector-methods :key #'car))
+ #'< :key #'car))))
+
+(def-slime-selector-method ?? "Selector help buffer."
+ (ignore-errors (kill-buffer "*Select Help*"))
+ (with-current-buffer (get-buffer-create "*Select Help*")
+ (insert "Select Methods:\n\n")
+ (cl-loop for (key line nil) in slime-selector-methods
+ do (insert (format "%c:\t%s\n" key line)))
+ (goto-char (point-min))
+ (help-mode)
+ (display-buffer (current-buffer) t))
+ (slime-selector)
+ (current-buffer))
+
+(cl-pushnew (list ?4 "Select in other window" (lambda () (slime-selector t)))
+ slime-selector-methods :key #'car)
+
+(def-slime-selector-method ?q "Abort."
+ (top-level))
+
+(def-slime-selector-method ?i
+ "*inferior-lisp* buffer."
+ (cond ((and (slime-connected-p) (slime-process))
+ (process-buffer (slime-process)))
+ (t
+ "*inferior-lisp*")))
+
+(def-slime-selector-method ?v
+ "*slime-events* buffer."
+ slime-event-buffer-name)
+
+(def-slime-selector-method ?l
+ "most recently visited lisp-mode buffer."
+ (slime-recently-visited-buffer 'lisp-mode))
+
+(def-slime-selector-method ?d
+ "*sldb* buffer for the current connection."
+ (or (sldb-get-default-buffer)
+ (error "No debugger buffer")))
+
+(def-slime-selector-method ?e
+ "most recently visited emacs-lisp-mode buffer."
+ (slime-recently-visited-buffer 'emacs-lisp-mode))
+
+(def-slime-selector-method ?c
+ "SLIME connections buffer."
+ (slime-list-connections)
+ slime-connections-buffer-name)
+
+(def-slime-selector-method ?n
+ "Cycle to the next Lisp connection."
+ (slime-next-connection)
+ (concat "*slime-repl "
+ (slime-connection-name (slime-current-connection))
+ "*"))
+
+(def-slime-selector-method ?p
+ "Cycle to the previous Lisp connection."
+ (slime-prev-connection)
+ (concat "*slime-repl "
+ (slime-connection-name (slime-current-connection))
+ "*"))
+
+(def-slime-selector-method ?t
+ "SLIME threads buffer."
+ (slime-list-threads)
+ slime-threads-buffer-name)
+
+(defun slime-recently-visited-buffer (mode)
+ "Return the most recently visited buffer whose major-mode is MODE.
+Only considers buffers that are not already visible."
+ (cl-loop for buffer in (buffer-list)
+ when (and (with-current-buffer buffer (eq major-mode mode))
+ (not (string-match "^ " (buffer-name buffer)))
+ (null (get-buffer-window buffer 'visible)))
+ return buffer
+ finally (error "Can't find unshown buffer in %S" mode)))
+
+
+;;;; Indentation
+
+(defun slime-update-indentation ()
+ "Update indentation for all macros defined in the Lisp system."
+ (interactive)
+ (slime-eval-async '(swank:update-indentation-information)))
+
+(defvar slime-indentation-update-hooks)
+
+(defun slime-intern-indentation-spec (spec)
+ (cond ((consp spec)
+ (cons (slime-intern-indentation-spec (car spec))
+ (slime-intern-indentation-spec (cdr spec))))
+ ((stringp spec)
+ (intern spec))
+ (t
+ spec)))
+
+;; FIXME: restore the old version without per-package
+;; stuff. slime-indentation.el should be able tho disable the simple
+;; version if needed.
+(defun slime-handle-indentation-update (alist)
+ "Update Lisp indent information.
+
+ALIST is a list of (SYMBOL-NAME . INDENT-SPEC) of proposed indentation
+settings for `common-lisp-indent-function'. The appropriate property
+is setup, unless the user already set one explicitly."
+ (dolist (info alist)
+ (let ((symbol (intern (car info)))
+ (indent (slime-intern-indentation-spec (cl-second info)))
+ (packages (cl-third info)))
+ (if (and (boundp 'common-lisp-system-indentation)
+ (fboundp 'slime-update-system-indentation))
+ ;; A table provided by slime-cl-indent.el.
+ (funcall #'slime-update-system-indentation symbol indent packages)
+ ;; Does the symbol have an indentation value that we set?
+ (when (equal (get symbol 'common-lisp-indent-function)
+ (get symbol 'slime-indent))
+ (put symbol 'common-lisp-indent-function indent)
+ (put symbol 'slime-indent indent)))
+ (run-hook-with-args 'slime-indentation-update-hooks
+ symbol indent packages))))
+
+
+;;;; Contrib modules
+
+(defun slime-require (module)
+ (cl-pushnew module slime-required-modules)
+ (when (slime-connected-p)
+ (slime-load-contribs)))
+
+(defun slime-load-contribs ()
+ (let ((needed (cl-remove-if (lambda (s)
+ (member (cl-subseq (symbol-name s) 1)
+ (mapcar #'downcase
+ (slime-lisp-modules))))
+ slime-required-modules)))
+ (when needed
+ ;; No asynchronous request because with :SPAWN that could result
+ ;; in the attempt to load modules concurrently which may not be
+ ;; supported by the host Lisp.
+ (setf (slime-lisp-modules)
+ (slime-eval `(swank:swank-require ',needed))))))
+
+(cl-defstruct slime-contrib
+ name
+ slime-dependencies
+ swank-dependencies
+ enable
+ disable
+ authors
+ license)
+
+(defun slime-contrib--enable-fun (name)
+ (intern (concat (symbol-name name) "-init")))
+
+(defun slime-contrib--disable-fun (name)
+ (intern (concat (symbol-name name) "-unload")))
+
+(defmacro define-slime-contrib (name _docstring &rest clauses)
+ (declare (indent 1))
+ (cl-destructuring-bind (&key slime-dependencies
+ swank-dependencies
+ on-load
+ on-unload
+ authors
+ license)
+ (cl-loop for (key . value) in clauses append `(,key ,value))
+ `(progn
+ ,@(mapcar (lambda (d) `(require ',d)) slime-dependencies)
+ (defun ,(slime-contrib--enable-fun name) ()
+ (mapc #'funcall ',(mapcar
+ #'slime-contrib--enable-fun
+ slime-dependencies))
+ (mapc #'slime-require ',swank-dependencies)
+ ,@on-load)
+ (defun ,(slime-contrib--disable-fun name) ()
+ ,@on-unload
+ (mapc #'funcall ',(mapcar
+ #'slime-contrib--disable-fun
+ slime-dependencies)))
+ (put 'slime-contribs ',name
+ (make-slime-contrib
+ :name ',name :authors ',authors :license ',license
+ :slime-dependencies ',slime-dependencies
+ :swank-dependencies ',swank-dependencies
+ :enable ',(slime-contrib--enable-fun name)
+ :disable ',(slime-contrib--disable-fun name))))))
+
+(defun slime-all-contribs ()
+ (cl-loop for (nil val) on (symbol-plist 'slime-contribs) by #'cddr
+ when (slime-contrib-p val)
+ collect val))
+
+(defun slime-contrib-all-dependencies (contrib)
+ "List all contribs recursively needed by CONTRIB, including self."
+ (cons contrib
+ (cl-mapcan #'slime-contrib-all-dependencies
+ (slime-contrib-slime-dependencies
+ (slime-find-contrib contrib)))))
+
+(defun slime-find-contrib (name)
+ (get 'slime-contribs name))
+
+(defun slime-read-contrib-name ()
+ (let ((names (cl-loop for c in (slime-all-contribs) collect
+ (symbol-name (slime-contrib-name c)))))
+ (intern (completing-read "Contrib: " names nil t))))
+
+(defun slime-enable-contrib (name)
+ (interactive (list (slime-read-contrib-name)))
+ (let ((c (or (slime-find-contrib name)
+ (error "Unknown contrib: %S" name))))
+ (funcall (slime-contrib-enable c))))
+
+(defun slime-disable-contrib (name)
+ (interactive (list (slime-read-contrib-name)))
+ (let ((c (or (slime-find-contrib name)
+ (error "Unknown contrib: %S" name))))
+ (funcall (slime-contrib-disable c))))
+
+
+;;;;; Pull-down menu
+
+(defvar slime-easy-menu
+ (let ((C '(slime-connected-p)))
+ `("SLIME"
+ [ "Edit Definition..." slime-edit-definition ,C ]
+ [ "Return From Definition" slime-pop-find-definition-stack ,C ]
+ [ "Complete Symbol" completion-at-point ,C ]
+ "--"
+ ("Evaluation"
+ [ "Eval Defun" slime-eval-defun ,C ]
+ [ "Eval Last Expression" slime-eval-last-expression ,C ]
+ [ "Eval And Pretty-Print" slime-pprint-eval-last-expression ,C ]
+ [ "Eval Region" slime-eval-region ,C ]
+ [ "Eval Region And Pretty-Print" slime-pprint-eval-region ,C ]
+ [ "Interactive Eval..." slime-interactive-eval ,C ]
+ [ "Edit Lisp Value..." slime-edit-value ,C ]
+ [ "Call Defun" slime-call-defun ,C ])
+ ("Debugging"
+ [ "Macroexpand Once..." slime-macroexpand-1 ,C ]
+ [ "Macroexpand All..." slime-macroexpand-all ,C ]
+ [ "Create Trace Buffer" slime-redirect-trace-output ,C ]
+ [ "Toggle Trace..." slime-toggle-trace-fdefinition ,C ]
+ [ "Untrace All" slime-untrace-all ,C]
+ [ "Disassemble..." slime-disassemble-symbol ,C ]
+ [ "Inspect..." slime-inspect ,C ])
+ ("Compilation"
+ [ "Compile Defun" slime-compile-defun ,C ]
+ [ "Compile/Load File" slime-compile-and-load-file ,C ]
+ [ "Compile File" slime-compile-file ,C ]
+ [ "Compile Region" slime-compile-region ,C ]
+ "--"
+ [ "Next Note" slime-next-note t ]
+ [ "Previous Note" slime-previous-note t ]
+ [ "Remove Notes" slime-remove-notes t ]
+ [ "List Notes" slime-list-compiler-notes ,C ])
+ ("Cross Reference"
+ [ "Who Calls..." slime-who-calls ,C ]
+ [ "Who References... " slime-who-references ,C ]
+ [ "Who Sets..." slime-who-sets ,C ]
+ [ "Who Binds..." slime-who-binds ,C ]
+ [ "Who Macroexpands..." slime-who-macroexpands ,C ]
+ [ "Who Specializes..." slime-who-specializes ,C ]
+ [ "List Callers..." slime-list-callers ,C ]
+ [ "List Callees..." slime-list-callees ,C ]
+ [ "Next Location" slime-next-location t ])
+ ("Editing"
+ [ "Check Parens" check-parens t]
+ [ "Update Indentation" slime-update-indentation ,C]
+ [ "Select Buffer" slime-selector t])
+ ("Profiling"
+ [ "Toggle Profiling..." slime-toggle-profile-fdefinition ,C ]
+ [ "Profile Package" slime-profile-package ,C]
+ [ "Profile by Substring" slime-profile-by-substring ,C ]
+ [ "Unprofile All" slime-unprofile-all ,C ]
+ [ "Show Profiled" slime-profiled-functions ,C ]
+ "--"
+ [ "Report" slime-profile-report ,C ]
+ [ "Reset Counters" slime-profile-reset ,C ])
+ ("Documentation"
+ [ "Describe Symbol..." slime-describe-symbol ,C ]
+ [ "Lookup Documentation..." slime-documentation-lookup t ]
+ [ "Apropos..." slime-apropos ,C ]
+ [ "Apropos all..." slime-apropos-all ,C ]
+ [ "Apropos Package..." slime-apropos-package ,C ]
+ [ "Hyperspec..." slime-hyperspec-lookup t ])
+ "--"
+ [ "Interrupt Command" slime-interrupt ,C ]
+ [ "Abort Async. Command" slime-quit ,C ]
+ [ "Sync Package & Directory" slime-sync-package-and-default-directory ,C]
+ )))
+
+(defvar slime-sldb-easy-menu
+ (let ((C '(slime-connected-p)))
+ `("SLDB"
+ [ "Next Frame" sldb-down t ]
+ [ "Previous Frame" sldb-up t ]
+ [ "Toggle Frame Details" sldb-toggle-details t ]
+ [ "Next Frame (Details)" sldb-details-down t ]
+ [ "Previous Frame (Details)" sldb-details-up t ]
+ "--"
+ [ "Eval Expression..." slime-interactive-eval ,C ]
+ [ "Eval in Frame..." sldb-eval-in-frame ,C ]
+ [ "Eval in Frame (pretty print)..." sldb-pprint-eval-in-frame ,C ]
+ [ "Inspect In Frame..." sldb-inspect-in-frame ,C ]
+ [ "Inspect Condition Object" sldb-inspect-condition ,C ]
+ "--"
+ [ "Restart Frame" sldb-restart-frame ,C ]
+ [ "Return from Frame..." sldb-return-from-frame ,C ]
+ ("Invoke Restart"
+ [ "Continue" sldb-continue ,C ]
+ [ "Abort" sldb-abort ,C ]
+ [ "Step" sldb-step ,C ]
+ [ "Step next" sldb-next ,C ]
+ [ "Step out" sldb-out ,C ]
+ )
+ "--"
+ [ "Quit (throw)" sldb-quit ,C ]
+ [ "Break With Default Debugger" sldb-break-with-default-debugger ,C ])))
+
+(easy-menu-define menubar-slime slime-mode-map "SLIME" slime-easy-menu)
+
+(defun slime-add-easy-menu ()
+ (easy-menu-add slime-easy-menu 'slime-mode-map))
+
+(add-hook 'slime-mode-hook 'slime-add-easy-menu)
+
+(defun slime-sldb-add-easy-menu ()
+ (easy-menu-define menubar-slime-sldb
+ sldb-mode-map "SLDB" slime-sldb-easy-menu)
+ (easy-menu-add slime-sldb-easy-menu 'sldb-mode-map))
+
+(add-hook 'sldb-mode-hook 'slime-sldb-add-easy-menu)
+
+
+;;;; Cheat Sheet
+
+(defvar
+ slime-cheat-sheet-table
+ '((:title
+ "Editing lisp code"
+ :map slime-mode-map
+ :bindings ((slime-eval-defun "Evaluate current top level form")
+ (slime-compile-defun "Compile current top level form")
+ (slime-interactive-eval "Prompt for form and eval it")
+ (slime-compile-and-load-file "Compile and load current file")
+ (slime-sync-package-and-default-directory
+ "Synch default package and directory with current buffer")
+ (slime-next-note "Next compiler note")
+ (slime-previous-note "Previous compiler note")
+ (slime-remove-notes "Remove notes")
+ slime-documentation-lookup))
+ (:title "Completion"
+ :map slime-mode-map
+ :bindings (slime-indent-and-complete-symbol
+ slime-fuzzy-complete-symbol))
+ (:title
+ "Within SLDB buffers"
+ :map sldb-mode-map
+ :bindings ((sldb-default-action "Do 'whatever' with thing at point")
+ (sldb-toggle-details "Toggle frame details visualization")
+ (sldb-quit "Quit to REPL")
+ (sldb-abort "Invoke ABORT restart")
+ (sldb-continue "Invoke CONTINUE restart (if available)")
+ (sldb-show-source "Jump to frame's source code")
+ (sldb-eval-in-frame "Evaluate in frame at point")
+ (sldb-inspect-in-frame
+ "Evaluate in frame at point and inspect result")))
+ (:title
+ "Within the Inspector"
+ :map slime-inspector-mode-map
+ :bindings ((slime-inspector-next-inspectable-object
+ "Jump to next inspectable object")
+ (slime-inspector-operate-on-point
+ "Inspect object or execute action at point")
+ (slime-inspector-reinspect "Reinspect current object")
+ (slime-inspector-pop "Return to previous object")
+ ;;(slime-inspector-copy-down "Send object at point to REPL")
+ (slime-inspector-toggle-verbose "Toggle verbose mode")
+ (slime-inspector-quit "Quit")))
+ (:title
+ "Finding Definitions"
+ :map slime-mode-map
+ :bindings (slime-edit-definition
+ slime-pop-find-definition-stack))))
+
+(defun slime-cheat-sheet ()
+ (interactive)
+ (switch-to-buffer-other-frame
+ (get-buffer-create (slime-buffer-name :cheat-sheet)))
+ (setq buffer-read-only nil)
+ (delete-region (point-min) (point-max))
+ (goto-char (point-min))
+ (insert
+ "SLIME: The Superior Lisp Interaction Mode for Emacs (minor-mode).\n\n")
+ (dolist (mode slime-cheat-sheet-table)
+ (let ((title (cl-getf mode :title))
+ (mode-map (cl-getf mode :map))
+ (mode-keys (cl-getf mode :bindings)))
+ (insert title)
+ (insert ":\n")
+ (insert (make-string (1+ (length title)) ?-))
+ (insert "\n")
+ (let ((keys '())
+ (descriptions '()))
+ (dolist (func mode-keys)
+ ;; func is eithor the function name or a list (NAME DESCRIPTION)
+ (push (if (symbolp func)
+ (prin1-to-string func)
+ (cl-second func))
+ descriptions)
+ (let ((all-bindings (where-is-internal (if (symbolp func)
+ func
+ (cl-first func))
+ (symbol-value mode-map)))
+ (key-bindings '()))
+ (dolist (binding all-bindings)
+ (when (and (vectorp binding)
+ (integerp (aref binding 0)))
+ (push binding key-bindings)))
+ (push (mapconcat 'key-description key-bindings " or ") keys)))
+ (cl-loop with desc-length = (apply 'max (mapcar 'length descriptions))
+ for key in (nreverse keys)
+ for desc in (nreverse descriptions)
+ do (insert desc)
+ do (insert (make-string (- desc-length (length desc)) ? ))
+ do (insert " => ")
+ do (insert (if (string= "" key)
+ "<not on any key>"
+ key))
+ do (insert "\n")
+ finally do (insert "\n")))))
+ (setq buffer-read-only t)
+ (goto-char (point-min)))
+
+
+;;;; Utilities (no not Paul Graham style)
+
+;; XXX: unused function
+(defun slime-intersperse (element list)
+ "Intersperse ELEMENT between each element of LIST."
+ (if (null list)
+ '()
+ (cons (car list)
+ (cl-mapcan (lambda (x) (list element x)) (cdr list)))))
+
+;;; FIXME: this looks almost slime `slime-alistify', perhaps the two
+;;; functions can be merged.
+(defun slime-group-similar (similar-p list)
+ "Return the list of lists of 'similar' adjacent elements of LIST.
+The function SIMILAR-P is used to test for similarity.
+The order of the input list is preserved."
+ (if (null list)
+ nil
+ (let ((accumulator (list (list (car list)))))
+ (dolist (x (cdr list))
+ (if (funcall similar-p x (caar accumulator))
+ (push x (car accumulator))
+ (push (list x) accumulator)))
+ (reverse (mapcar #'reverse accumulator)))))
+
+(defun slime-alistify (list key test)
+ "Partition the elements of LIST into an alist.
+KEY extracts the key from an element and TEST is used to compare
+keys."
+ (let ((alist '()))
+ (dolist (e list)
+ (let* ((k (funcall key e))
+ (probe (cl-assoc k alist :test test)))
+ (if probe
+ (push e (cdr probe))
+ (push (cons k (list e)) alist))))
+ ;; Put them back in order.
+ (cl-loop for (key . value) in (reverse alist)
+ collect (cons key (reverse value)))))
+
+;;;;; Misc.
+
+(defun slime-length= (seq n)
+ "Return (= (length SEQ) N)."
+ (cl-etypecase seq
+ (list
+ (cond ((zerop n) (null seq))
+ ((let ((tail (nthcdr (1- n) seq)))
+ (and tail (null (cdr tail)))))))
+ (sequence
+ (= (length seq) n))))
+
+(defun slime-length> (seq n)
+ "Return (> (length SEQ) N)."
+ (cl-etypecase seq
+ (list (nthcdr n seq))
+ (sequence (> (length seq) n))))
+
+(defun slime-trim-whitespace (str)
+ (let ((start (cl-position-if-not (lambda (x)
+ (memq x '(?\t ?\n ?\s ?\r)))
+ str))
+
+ (end (cl-position-if-not (lambda (x)
+ (memq x '(?\t ?\n ?\s ?\r)))
+ str
+ :from-end t)))
+ (if start
+ (substring str start (1+ end))
+ "")))
+
+;;;;; Buffer related
+
+(defun slime-buffer-narrowed-p (&optional buffer)
+ "Returns T if BUFFER (or the current buffer respectively) is narrowed."
+ (with-current-buffer (or buffer (current-buffer))
+ (let ((beg (point-min))
+ (end (point-max))
+ (total (buffer-size)))
+ (or (/= beg 1) (/= end (1+ total))))))
+
+(defun slime-column-max ()
+ (save-excursion
+ (goto-char (point-min))
+ (cl-loop for column = (prog2 (end-of-line) (current-column) (forward-line))
+ until (= (point) (point-max))
+ maximizing column)))
+
+;;;;; CL symbols vs. Elisp symbols.
+
+(defun slime-cl-symbol-name (symbol)
+ (let ((n (if (stringp symbol) symbol (symbol-name symbol))))
+ (if (string-match ":\\([^:]*\\)$" n)
+ (let ((symbol-part (match-string 1 n)))
+ (if (string-match "^|\\(.*\\)|$" symbol-part)
+ (match-string 1 symbol-part)
+ symbol-part))
+ n)))
+
+(defun slime-cl-symbol-package (symbol &optional default)
+ (let ((n (if (stringp symbol) symbol (symbol-name symbol))))
+ (if (string-match "^\\([^:]*\\):" n)
+ (match-string 1 n)
+ default)))
+
+(defun slime-qualify-cl-symbol-name (symbol-or-name)
+ "Return a package-qualified string for SYMBOL-OR-NAME.
+If SYMBOL-OR-NAME doesn't already have a package prefix the
+current package is used."
+ (let ((s (if (stringp symbol-or-name)
+ symbol-or-name
+ (symbol-name symbol-or-name))))
+ (if (slime-cl-symbol-package s)
+ s
+ (format "%s::%s"
+ (let* ((package (slime-current-package)))
+ ;; package is a string like ":cl-user"
+ ;; or "CL-USER", or "\"CL-USER\"".
+ (if package
+ (slime-pretty-package-name package)
+ "CL-USER"))
+ (slime-cl-symbol-name s)))))
+
+;;;;; Moving, CL idiosyncracies aware (reader conditionals &c.)
+
+(defmacro slime-point-moves-p (&rest body)
+ "Execute BODY and return true if the current buffer's point moved."
+ (declare (indent 0))
+ (let ((pointvar (cl-gensym "point-")))
+ `(let ((,pointvar (point)))
+ (save-current-buffer ,@body)
+ (/= ,pointvar (point)))))
+
+(defun slime-forward-sexp (&optional count)
+ "Like `forward-sexp', but understands reader-conditionals (#- and #+),
+and skips comments."
+ (dotimes (_i (or count 1))
+ (slime-forward-cruft)
+ (forward-sexp)))
+
+(defconst slime-reader-conditionals-regexp
+ ;; #!+, #!- are SBCL specific reader-conditional syntax.
+ ;; We need this for the source files of SBCL itself.
+ (regexp-opt '("#+" "#-" "#!+" "#!-")))
+
+(defun slime-forward-reader-conditional ()
+ "Move past any reader conditional (#+ or #-) at point."
+ (when (looking-at slime-reader-conditionals-regexp)
+ (goto-char (match-end 0))
+ (let* ((plus-conditional-p (eq (char-before) ?+))
+ (result (slime-eval-feature-expression
+ (condition-case e
+ (read (current-buffer))
+ (invalid-read-syntax
+ (signal 'slime-unknown-feature-expression (cdr e)))))))
+ (unless (if plus-conditional-p result (not result))
+ ;; skip this sexp
+ (slime-forward-sexp)))))
+
+(defun slime-forward-cruft ()
+ "Move forward over whitespace, comments, reader conditionals."
+ (while (slime-point-moves-p (skip-chars-forward " \t\n")
+ (forward-comment (buffer-size))
+ (inline (slime-forward-reader-conditional)))))
+
+(defun slime-keywordify (symbol)
+ "Make a keyword out of the symbol SYMBOL."
+ (let ((name (downcase (symbol-name symbol))))
+ (intern (if (eq ?: (aref name 0))
+ name
+ (concat ":" name)))))
+
+(put 'slime-incorrect-feature-expression
+ 'error-conditions '(slime-incorrect-feature-expression error))
+
+(put 'slime-unknown-feature-expression
+ 'error-conditions '(slime-unknown-feature-expression
+ slime-incorrect-feature-expression
+ error))
+
+;; FIXME: let it crash
+;; FIXME: the length=1 constraint is bogus
+(defun slime-eval-feature-expression (e)
+ "Interpret a reader conditional expression."
+ (cond ((symbolp e)
+ (memq (slime-keywordify e) (slime-lisp-features)))
+ ((and (consp e) (symbolp (car e)))
+ (funcall (let ((head (slime-keywordify (car e))))
+ (cl-case head
+ (:and #'cl-every)
+ (:or #'cl-some)
+ (:not
+ (lexical-let ((feature-expression e))
+ (lambda (f l)
+ (cond
+ ((slime-length= l 0) t)
+ ((slime-length= l 1) (not (apply f l)))
+ (t (signal 'slime-incorrect-feature-expression
+ feature-expression))))))
+ (t (signal 'slime-unknown-feature-expression head))))
+ #'slime-eval-feature-expression
+ (cdr e)))
+ (t (signal 'slime-incorrect-feature-expression e))))
+
+;;;;; Extracting Lisp forms from the buffer or user
+
+(defun slime-defun-at-point ()
+ "Return the text of the defun at point."
+ (apply #'buffer-substring-no-properties
+ (slime-region-for-defun-at-point)))
+
+(defun slime-region-for-defun-at-point ()
+ "Return the start and end position of defun at point."
+ (save-excursion
+ (save-match-data
+ (end-of-defun)
+ (let ((end (point)))
+ (beginning-of-defun)
+ (list (point) end)))))
+
+(defun slime-beginning-of-symbol ()
+ "Move to the beginning of the CL-style symbol at point."
+ (while (re-search-backward "\\(\\sw\\|\\s_\\|\\s\\.\\|\\s\\\\|[#@|]\\)\\="
+ (when (> (point) 2000) (- (point) 2000))
+ t))
+ (re-search-forward "\\=#[-+.<|]" nil t)
+ (when (and (looking-at "@") (eq (char-before) ?\,))
+ (forward-char)))
+
+(defun slime-end-of-symbol ()
+ "Move to the end of the CL-style symbol at point."
+ (re-search-forward "\\=\\(\\sw\\|\\s_\\|\\s\\.\\|#:\\|[@|]\\)*"))
+
+(put 'slime-symbol 'end-op 'slime-end-of-symbol)
+(put 'slime-symbol 'beginning-op 'slime-beginning-of-symbol)
+
+(defun slime-symbol-start-pos ()
+ "Return the starting position of the symbol under point.
+The result is unspecified if there isn't a symbol under the point."
+ (save-excursion (slime-beginning-of-symbol) (point)))
+
+(defun slime-symbol-end-pos ()
+ (save-excursion (slime-end-of-symbol) (point)))
+
+(defun slime-bounds-of-symbol-at-point ()
+ "Return the bounds of the symbol around point.
+The returned bounds are either nil or non-empty."
+ (let ((bounds (bounds-of-thing-at-point 'slime-symbol)))
+ (if (and bounds
+ (< (car bounds)
+ (cdr bounds)))
+ bounds)))
+
+(defun slime-symbol-at-point ()
+ "Return the name of the symbol at point, otherwise nil."
+ ;; (thing-at-point 'symbol) returns "" in empty buffers
+ (let ((bounds (slime-bounds-of-symbol-at-point)))
+ (if bounds
+ (buffer-substring-no-properties (car bounds)
+ (cdr bounds)))))
+
+(defun slime-bounds-of-sexp-at-point ()
+ "Return the bounds sexp at point as a pair (or nil)."
+ (or (slime-bounds-of-symbol-at-point)
+ (and (equal (char-after) ?\()
+ (member (char-before) '(?\' ?\, ?\@))
+ ;; hide stuff before ( to avoid quirks with '( etc.
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (bounds-of-thing-at-point 'sexp)))
+ (bounds-of-thing-at-point 'sexp)))
+
+(defun slime-sexp-at-point ()
+ "Return the sexp at point as a string, otherwise nil."
+ (let ((bounds (slime-bounds-of-sexp-at-point)))
+ (if bounds
+ (buffer-substring-no-properties (car bounds)
+ (cdr bounds)))))
+
+(defun slime-sexp-at-point-or-error ()
+ "Return the sexp at point as a string, othwise signal an error."
+ (or (slime-sexp-at-point) (user-error "No expression at point")))
+
+(defun slime-string-at-point ()
+ "Returns the string at point as a string, otherwise nil."
+ (let ((sexp (slime-sexp-at-point)))
+ (if (and sexp
+ (eql (char-syntax (aref sexp 0)) ?\"))
+ sexp
+ nil)))
+
+(defun slime-string-at-point-or-error ()
+ "Return the sexp at point as a string, othwise signal an error."
+ (or (slime-string-at-point) (error "No string at point.")))
+
+(defun slime-input-complete-p (start end)
+ "Return t if the region from START to END contains a complete sexp."
+ (save-excursion
+ (goto-char start)
+ (cond ((looking-at "\\s *['`#]?[(\"]")
+ (ignore-errors
+ (save-restriction
+ (narrow-to-region start end)
+ ;; Keep stepping over blanks and sexps until the end of
+ ;; buffer is reached or an error occurs. Tolerate extra
+ ;; close parens.
+ (cl-loop do (skip-chars-forward " \t\r\n)")
+ until (eobp)
+ do (forward-sexp))
+ t)))
+ (t t))))
+
+
+;;;; slime.el in pretty colors
+
+(cl-loop for sym in (list 'slime-def-connection-var
+ 'slime-define-channel-type
+ 'slime-define-channel-method
+ 'define-slime-contrib
+ 'slime-defun-if-undefined
+ 'slime-defmacro-if-undefined)
+ for regexp = (format "(\\(%S\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"
+ sym)
+ do (font-lock-add-keywords
+ 'emacs-lisp-mode
+ `((,regexp (1 font-lock-keyword-face)
+ (2 font-lock-variable-name-face)))))
+
+;;;; Finishing up
+
+(eval-when-compile
+ (require 'bytecomp))
+
+(defun slime--byte-compile (symbol)
+ (require 'bytecomp) ;; tricky interaction between autoload and let.
+ (let ((byte-compile-warnings '()))
+ (byte-compile symbol)))
+
+(defun slime--compile-hotspots ()
+ (mapc (lambda (sym)
+ (cond ((fboundp sym)
+ (unless (byte-code-function-p (symbol-function sym))
+ (slime--byte-compile sym)))
+ (t (error "%S is not fbound" sym))))
+ '(slime-alistify
+ slime-log-event
+ slime-events-buffer
+ slime-process-available-input
+ slime-dispatch-event
+ slime-net-filter
+ slime-net-have-input-p
+ slime-net-decode-length
+ slime-net-read
+ slime-print-apropos
+ slime-insert-propertized
+ slime-beginning-of-symbol
+ slime-end-of-symbol
+ slime-eval-feature-expression
+ slime-forward-sexp
+ slime-forward-cruft
+ slime-forward-reader-conditional)))
+
+(slime--compile-hotspots)
+
+(add-to-list 'load-path (expand-file-name "contrib" slime-path))
+
+(run-hooks 'slime-load-hook)
+(provide 'slime)
+
+;; Local Variables:
+;; outline-regexp: ";;;;+"
+;; indent-tabs-mode: nil
+;; coding: latin-1-unix
+;; End:
+;;; slime.el ends here
diff --git a/vim/bundle/slimv/slime/start-swank.lisp b/vim/bundle/slimv/slime/start-swank.lisp
new file mode 100644
index 0000000..77bd3aa
--- /dev/null
+++ b/vim/bundle/slimv/slime/start-swank.lisp
@@ -0,0 +1,39 @@
+;;; This file is intended to be loaded by an implementation to
+;;; get a running swank server
+;;; e.g. sbcl --load start-swank.lisp
+;;;
+;;; Default port is 4005
+
+;;; For additional swank-side configurations see
+;;; 6.2 section of the Slime user manual.
+;;;
+;;; Modified for Slimv:
+;;; - don't close connection
+;;; - pass swank port in environment variable
+
+(load (merge-pathnames "swank-loader.lisp" *load-truename*))
+
+(swank-loader:init
+ :delete nil ; delete any existing SWANK packages
+ :reload nil ; reload SWANK, even if the SWANK package already exists
+ :load-contribs nil) ; load all contribs
+
+(defun my-getenv (name &optional default)
+ #+CMU
+ (let ((x (assoc name ext:*environment-list*
+ :test #'string=)))
+ (if x (cdr x) default))
+ #-CMU
+ (or
+ #+Allegro (sys:getenv name)
+ #+CLISP (ext:getenv name)
+ #+ECL (si:getenv name)
+ #+SBCL (sb-unix::posix-getenv name)
+ #+LISPWORKS (lispworks:environment-variable name)
+ #+CCL (ccl::getenv name)
+ default))
+
+(swank:create-server :port (parse-integer (my-getenv "SWANK_PORT" "4005"))
+ ;; if non-nil the connection won't be closed
+ ;; after connecting
+ :dont-close t)
diff --git a/vim/bundle/slimv/slime/swank-loader.lisp b/vim/bundle/slimv/slime/swank-loader.lisp
new file mode 100644
index 0000000..7bb81da
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank-loader.lisp
@@ -0,0 +1,366 @@
+;;;; -*- indent-tabs-mode: nil -*-
+;;;
+;;; swank-loader.lisp --- Compile and load the Slime backend.
+;;;
+;;; Created 2003, James Bielman <jamesjb@jamesjb.com>
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+;; If you want customize the source- or fasl-directory you can set
+;; swank-loader:*source-directory* resp. swank-loader:*fasl-directory*
+;; before loading this files.
+;; E.g.:
+;;
+;; (load ".../swank-loader.lisp")
+;; (setq swank-loader::*fasl-directory* "/tmp/fasl/")
+;; (swank-loader:init)
+
+(cl:defpackage :swank-loader
+ (:use :cl)
+ (:export :init
+ :dump-image
+ :list-fasls
+ :*source-directory*
+ :*fasl-directory*))
+
+(cl:in-package :swank-loader)
+
+(defvar *source-directory*
+ (make-pathname :name nil :type nil
+ :defaults (or *load-pathname* *default-pathname-defaults*))
+ "The directory where to look for the source.")
+
+(defparameter *sysdep-files*
+ #+cmu '((swank source-path-parser) (swank source-file-cache) (swank cmucl)
+ (swank gray))
+ #+scl '((swank source-path-parser) (swank source-file-cache) (swank scl)
+ (swank gray))
+ #+sbcl '((swank source-path-parser) (swank source-file-cache) (swank sbcl)
+ (swank gray))
+ #+clozure '(metering (swank ccl) (swank gray))
+ #+lispworks '((swank lispworks) (swank gray))
+ #+allegro '((swank allegro) (swank gray))
+ #+clisp '(xref metering (swank clisp) (swank gray))
+ #+armedbear '((swank abcl))
+ #+cormanlisp '((swank corman) (swank gray))
+ #+ecl '((swank ecl) (swank gray))
+ #+clasp '((swank clasp) (swank gray))
+ #+mkcl '((swank mkcl) (swank gray))
+ )
+
+(defparameter *implementation-features*
+ '(:allegro :lispworks :sbcl :clozure :cmu :clisp :ccl :corman :cormanlisp
+ :armedbear :gcl :ecl :scl :mkcl :clasp))
+
+(defparameter *os-features*
+ '(:macosx :linux :windows :mswindows :win32 :solaris :darwin :sunos :hpux
+ :unix))
+
+(defparameter *architecture-features*
+ '(:powerpc :ppc :x86 :x86-64 :x86_64 :amd64 :i686 :i586 :i486 :pc386 :iapx386
+ :sparc64 :sparc :hppa64 :hppa :arm :armv5l :armv6l :armv7l :arm64
+ :pentium3 :pentium4
+ :mips :mipsel
+ :java-1.4 :java-1.5 :java-1.6 :java-1.7))
+
+(defun q (s) (read-from-string s))
+
+#+ecl
+(defun ecl-version-string ()
+ (format nil "~A~@[-~A~]"
+ (lisp-implementation-version)
+ (when (find-symbol "LISP-IMPLEMENTATION-VCS-ID" :ext)
+ (let ((vcs-id (funcall (q "ext:lisp-implementation-vcs-id"))))
+ (when (>= (length vcs-id) 8)
+ (subseq vcs-id 0 8))))))
+
+#+clasp
+(defun clasp-version-string ()
+ (format nil "~A~@[-~A~]"
+ (lisp-implementation-version)
+ (core:lisp-implementation-id)))
+
+(defun lisp-version-string ()
+ #+(or clozure cmu) (substitute-if #\_ (lambda (x) (find x " /"))
+ (lisp-implementation-version))
+ #+(or cormanlisp scl mkcl) (lisp-implementation-version)
+ #+sbcl (format nil "~a~:[~;-no-threads~]"
+ (lisp-implementation-version)
+ #+sb-thread nil
+ #-sb-thread t)
+ #+lispworks (lisp-implementation-version)
+ #+allegro (format nil "~@{~a~}"
+ excl::*common-lisp-version-number*
+ (if (eq 'h 'H) "A" "M") ; ANSI vs MoDeRn
+ (if (member :smp *features*) "s" "")
+ (if (member :64bit *features*) "-64bit" "")
+ (excl:ics-target-case
+ (:-ics "")
+ (:+ics "-ics")))
+ #+clisp (let ((s (lisp-implementation-version)))
+ (subseq s 0 (position #\space s)))
+ #+armedbear (lisp-implementation-version)
+ #+ecl (ecl-version-string)
+ #+clasp (clasp-version-string))
+
+(defun unique-dir-name ()
+ "Return a name that can be used as a directory name that is
+unique to a Lisp implementation, Lisp implementation version,
+operating system, and hardware architecture."
+ (flet ((first-of (features)
+ (loop for f in features
+ when (find f *features*) return it))
+ (maybe-warn (value fstring &rest args)
+ (cond (value)
+ (t (apply #'warn fstring args)
+ "unknown"))))
+ (let ((lisp (maybe-warn (first-of *implementation-features*)
+ "No implementation feature found in ~a."
+ *implementation-features*))
+ (os (maybe-warn (first-of *os-features*)
+ "No os feature found in ~a." *os-features*))
+ (arch (maybe-warn (first-of *architecture-features*)
+ "No architecture feature found in ~a."
+ *architecture-features*))
+ (version (maybe-warn (lisp-version-string)
+ "Don't know how to get Lisp ~
+ implementation version.")))
+ (format nil "~(~@{~a~^-~}~)" lisp version os arch))))
+
+(defun file-newer-p (new-file old-file)
+ "Returns true if NEW-FILE is newer than OLD-FILE."
+ (> (file-write-date new-file) (file-write-date old-file)))
+
+(defun string-starts-with (string prefix)
+ (string-equal string prefix :end1 (min (length string) (length prefix))))
+
+(defun slime-version-string ()
+ "Return a string identifying the SLIME version.
+Return nil if nothing appropriate is available."
+ (with-open-file (s (merge-pathnames "slime.el" *source-directory*)
+ :if-does-not-exist nil)
+ (loop with prefix = ";; Version: "
+ for line = (read-line s nil :eof)
+ until (eq line :eof)
+ when (string-starts-with line prefix)
+ return (subseq line (length prefix)))))
+
+(defun default-fasl-dir ()
+ (merge-pathnames
+ (make-pathname
+ :directory `(:relative ".slime" "fasl"
+ ,@(if (slime-version-string) (list (slime-version-string)))
+ ,(unique-dir-name)))
+ (user-homedir-pathname)))
+
+(defvar *fasl-directory* (default-fasl-dir)
+ "The directory where fasl files should be placed.")
+
+(defun binary-pathname (src-pathname binary-dir)
+ "Return the pathname where SRC-PATHNAME's binary should be compiled."
+ (let ((cfp (compile-file-pathname src-pathname)))
+ (merge-pathnames (make-pathname :name (pathname-name cfp)
+ :type (pathname-type cfp))
+ binary-dir)))
+
+(defun handle-swank-load-error (condition context pathname)
+ (fresh-line *error-output*)
+ (pprint-logical-block (*error-output* () :per-line-prefix ";; ")
+ (format *error-output*
+ "~%Error ~A ~A:~% ~A~%"
+ context pathname condition)))
+
+(defun compile-files (files fasl-dir load quiet)
+ "Compile each file in FILES if the source is newer than its
+corresponding binary, or the file preceding it was recompiled.
+If LOAD is true, load the fasl file."
+ (let ((needs-recompile nil)
+ (state :unknown))
+ (dolist (src files)
+ (let ((dest (binary-pathname src fasl-dir)))
+ (handler-bind
+ ((error (lambda (c)
+ (ecase state
+ (:compile (handle-swank-load-error c "compiling" src))
+ (:load (handle-swank-load-error c "loading" dest))
+ (:unknown (handle-swank-load-error c "???ing" src))))))
+ (when (or needs-recompile
+ (not (probe-file dest))
+ (file-newer-p src dest))
+ (ensure-directories-exist dest)
+ ;; need to recompile SRC, so we'll need to recompile
+ ;; everything after this too.
+ (setf needs-recompile t
+ state :compile)
+ (or (compile-file src :output-file dest :print nil
+ :verbose (not quiet))
+ ;; An implementation may not necessarily signal a
+ ;; condition itself when COMPILE-FILE fails (e.g. ECL)
+ (error "COMPILE-FILE returned NIL.")))
+ (when load
+ (setf state :load)
+ (load dest :verbose (not quiet))))))))
+
+#+cormanlisp
+(defun compile-files (files fasl-dir load quiet)
+ "Corman Lisp has trouble with compiled files."
+ (declare (ignore fasl-dir))
+ (when load
+ (dolist (file files)
+ (load file :verbose (not quiet)
+ (force-output)))))
+
+(defun load-user-init-file ()
+ "Load the user init file, return NIL if it does not exist."
+ (load (merge-pathnames (user-homedir-pathname)
+ (make-pathname :name ".swank" :type "lisp"))
+ :if-does-not-exist nil))
+
+(defun load-site-init-file (dir)
+ (load (make-pathname :name "site-init" :type "lisp"
+ :defaults dir)
+ :if-does-not-exist nil))
+
+(defun src-files (names src-dir)
+ (mapcar (lambda (name)
+ (multiple-value-bind (dirs name)
+ (etypecase name
+ (symbol (values '() name))
+ (cons (values (butlast name) (car (last name)))))
+ (make-pathname
+ :directory (append (or (pathname-directory src-dir)
+ '(:relative))
+ (mapcar #'string-downcase dirs))
+ :name (string-downcase name)
+ :type "lisp"
+ :defaults src-dir)))
+ names))
+
+(defvar *swank-files*
+ `(packages
+ (swank backend) ,@*sysdep-files* (swank match) (swank rpc)
+ swank))
+
+(defvar *contribs*
+ '(swank-util swank-repl
+ swank-c-p-c swank-arglists swank-fuzzy
+ swank-fancy-inspector
+ swank-presentations swank-presentation-streams
+ #+(or asdf2 asdf3 sbcl ecl) swank-asdf
+ swank-package-fu
+ swank-hyperdoc
+ #+sbcl swank-sbcl-exts
+ swank-mrepl
+ swank-trace-dialog
+ swank-macrostep
+ swank-quicklisp)
+ "List of names for contrib modules.")
+
+(defun append-dir (absolute name)
+ (merge-pathnames
+ (make-pathname :directory `(:relative ,name) :defaults absolute)
+ absolute))
+
+(defun contrib-dir (base-dir)
+ (append-dir base-dir "contrib"))
+
+(defun load-swank (&key (src-dir *source-directory*)
+ (fasl-dir *fasl-directory*)
+ quiet)
+ (with-compilation-unit ()
+ (compile-files (src-files *swank-files* src-dir) fasl-dir t quiet))
+ (funcall (q "swank::before-init")
+ (slime-version-string)
+ (list (contrib-dir fasl-dir)
+ (contrib-dir src-dir))))
+
+(defun delete-stale-contrib-fasl-files (swank-files contrib-files fasl-dir)
+ (let ((newest (reduce #'max (mapcar #'file-write-date swank-files))))
+ (dolist (src contrib-files)
+ (let ((fasl (binary-pathname src fasl-dir)))
+ (when (and (probe-file fasl)
+ (<= (file-write-date fasl) newest))
+ (delete-file fasl))))))
+
+(defun compile-contribs (&key (src-dir (contrib-dir *source-directory*))
+ (fasl-dir (contrib-dir *fasl-directory*))
+ (swank-src-dir *source-directory*)
+ load quiet)
+ (let* ((swank-src-files (src-files *swank-files* swank-src-dir))
+ (contrib-src-files (src-files *contribs* src-dir)))
+ (delete-stale-contrib-fasl-files swank-src-files contrib-src-files
+ fasl-dir)
+ (compile-files contrib-src-files fasl-dir load quiet)))
+
+(defun loadup ()
+ (load-swank)
+ (compile-contribs :load t))
+
+(defun setup ()
+ (load-site-init-file *source-directory*)
+ (load-user-init-file)
+ (when (#-clisp probe-file
+ #+clisp ext:probe-directory
+ (contrib-dir *source-directory*))
+ (eval `(pushnew 'compile-contribs ,(q "swank::*after-init-hook*"))))
+ (funcall (q "swank::init")))
+
+(defun list-swank-packages ()
+ (remove-if-not (lambda (package)
+ (let ((name (package-name package)))
+ (and (string-not-equal name "swank-loader")
+ (string-starts-with name "swank"))))
+ (list-all-packages)))
+
+(defun delete-packages (packages)
+ (dolist (package packages)
+ (flet ((handle-package-error (c)
+ (let ((pkgs (set-difference (package-used-by-list package)
+ packages)))
+ (when pkgs
+ (warn "deleting ~a which is used by ~{~a~^, ~}."
+ package pkgs))
+ (continue c))))
+ (handler-bind ((package-error #'handle-package-error))
+ (delete-package package)))))
+
+(defun init (&key delete reload load-contribs (setup t)
+ (quiet (not *load-verbose*)))
+ "Load SWANK and initialize some global variables.
+If DELETE is true, delete any existing SWANK packages.
+If RELOAD is true, reload SWANK, even if the SWANK package already exists.
+If LOAD-CONTRIBS is true, load all contribs
+If SETUP is true, load user init files and initialize some
+global variabes in SWANK."
+ (when (and delete (find-package :swank))
+ (delete-packages (list-swank-packages)))
+ (cond ((or (not (find-package :swank)) reload)
+ (load-swank :quiet quiet))
+ (t
+ (warn "Not reloading SWANK. Package already exists.")))
+ (when load-contribs
+ (compile-contribs :load t :quiet quiet))
+ (when setup
+ (setup)))
+
+(defun dump-image (filename)
+ (init :setup nil)
+ (funcall (q "swank/backend:save-image") filename))
+
+(defun list-fasls (&key (include-contribs t) (compile t)
+ (quiet (not *compile-verbose*)))
+ "List up SWANK's fasls along with their dependencies."
+ (flet ((collect-fasls (files fasl-dir)
+ (when compile
+ (compile-files files fasl-dir nil quiet))
+ (loop for src in files
+ when (probe-file (binary-pathname src fasl-dir))
+ collect it)))
+ (append (collect-fasls (src-files *swank-files* *source-directory*)
+ *fasl-directory*)
+ (when include-contribs
+ (collect-fasls (src-files *contribs*
+ (contrib-dir *source-directory*))
+ (contrib-dir *fasl-directory*))))))
diff --git a/vim/bundle/slimv/slime/swank.asd b/vim/bundle/slimv/slime/swank.asd
new file mode 100644
index 0000000..d9a7627
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank.asd
@@ -0,0 +1,37 @@
+;;; -*- lisp -*-
+
+;; ASDF system definition for loading the Swank server independently
+;; of Emacs.
+;;
+;; This is only useful if you want to start a Swank server in a Lisp
+;; processes that doesn't run under Emacs. Lisp processes created by
+;; `M-x slime' automatically start the server.
+
+;; Usage:
+;;
+;; (require :swank)
+;; (swank:create-swank-server PORT) => ACTUAL-PORT
+;;
+;; (PORT can be zero to mean "any available port".)
+;; Then the Swank server is running on localhost:ACTUAL-PORT. You can
+;; use `M-x slime-connect' to connect Emacs to it.
+;;
+;; This code has been placed in the Public Domain. All warranties
+;; are disclaimed.
+
+(defpackage :swank-loader
+ (:use :cl))
+
+(in-package :swank-loader)
+
+(defclass swank-loader-file (asdf:cl-source-file) ())
+
+;;;; after loading run init
+
+(defmethod asdf:perform ((o asdf:load-op) (f swank-loader-file))
+ (load (asdf::component-pathname f))
+ (funcall (read-from-string "swank-loader::init") :reload t))
+
+(asdf:defsystem :swank
+ :default-component-class swank-loader-file
+ :components ((:file "swank-loader")))
diff --git a/vim/bundle/slimv/slime/swank.lisp b/vim/bundle/slimv/slime/swank.lisp
new file mode 100644
index 0000000..909bd19
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank.lisp
@@ -0,0 +1,3743 @@
+;;;; swank.lisp --- Server for SLIME commands.
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+;;; This file defines the "Swank" TCP server for Emacs to talk to. The
+;;; code in this file is purely portable Common Lisp. We do require a
+;;; smattering of non-portable functions in order to write the server,
+;;; so we have defined them in `swank/backend.lisp' and implemented
+;;; them separately for each Lisp implementation. These extensions are
+;;; available to us here via the `SWANK/BACKEND' package.
+
+(in-package :swank)
+;;;; Top-level variables, constants, macros
+
+(defconstant cl-package (find-package :cl)
+ "The COMMON-LISP package.")
+
+(defconstant keyword-package (find-package :keyword)
+ "The KEYWORD package.")
+
+(defconstant default-server-port 4005
+ "The default TCP port for the server (when started manually).")
+
+(defvar *swank-debug-p* t
+ "When true, print extra debugging information.")
+
+(defvar *backtrace-pprint-dispatch-table*
+ (let ((table (copy-pprint-dispatch nil)))
+ (flet ((print-string (stream string)
+ (cond (*print-escape*
+ (escape-string string stream
+ :map '((#\" . "\\\"")
+ (#\\ . "\\\\")
+ (#\newline . "\\n")
+ (#\return . "\\r"))))
+ (t (write-string string stream)))))
+ (set-pprint-dispatch 'string #'print-string 0 table)
+ table)))
+
+(defvar *backtrace-printer-bindings*
+ `((*print-pretty* . t)
+ (*print-readably* . nil)
+ (*print-level* . 4)
+ (*print-length* . 6)
+ (*print-lines* . 1)
+ (*print-right-margin* . 200)
+ (*print-pprint-dispatch* . ,*backtrace-pprint-dispatch-table*))
+ "Pretter settings for printing backtraces.")
+
+(defvar *default-worker-thread-bindings* '()
+ "An alist to initialize dynamic variables in worker threads.
+The list has the form ((VAR . VALUE) ...). Each variable VAR will be
+bound to the corresponding VALUE.")
+
+(defun call-with-bindings (alist fun)
+ "Call FUN with variables bound according to ALIST.
+ALIST is a list of the form ((VAR . VAL) ...)."
+ (if (null alist)
+ (funcall fun)
+ (let* ((rlist (reverse alist))
+ (vars (mapcar #'car rlist))
+ (vals (mapcar #'cdr rlist)))
+ (progv vars vals
+ (funcall fun)))))
+
+(defmacro with-bindings (alist &body body)
+ "See `call-with-bindings'."
+ `(call-with-bindings ,alist (lambda () ,@body)))
+
+;;; The `DEFSLIMEFUN' macro defines a function that Emacs can call via
+;;; RPC.
+
+(defmacro defslimefun (name arglist &body rest)
+ "A DEFUN for functions that Emacs can call by RPC."
+ `(progn
+ (defun ,name ,arglist ,@rest)
+ ;; see <http://www.franz.com/support/documentation/6.2/\
+ ;; doc/pages/variables/compiler/\
+ ;; s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (export ',name (symbol-package ',name)))))
+
+(defun missing-arg ()
+ "A function that the compiler knows will never to return a value.
+You can use (MISSING-ARG) as the initform for defstruct slots that
+must always be supplied. This way the :TYPE slot option need not
+include some arbitrary initial value like NIL."
+ (error "A required &KEY or &OPTIONAL argument was not supplied."))
+
+
+;;;; Hooks
+;;;
+;;; We use Emacs-like `add-hook' and `run-hook' utilities to support
+;;; simple indirection. The interface is more CLish than the Emacs
+;;; Lisp one.
+
+(defmacro add-hook (place function)
+ "Add FUNCTION to the list of values on PLACE."
+ `(pushnew ,function ,place))
+
+(defun run-hook (functions &rest arguments)
+ "Call each of FUNCTIONS with ARGUMENTS."
+ (dolist (function functions)
+ (apply function arguments)))
+
+(defvar *new-connection-hook* '()
+ "This hook is run each time a connection is established.
+The connection structure is given as the argument.
+Backend code should treat the connection structure as opaque.")
+
+(defvar *connection-closed-hook* '()
+ "This hook is run when a connection is closed.
+The connection as passed as an argument.
+Backend code should treat the connection structure as opaque.")
+
+(defvar *pre-reply-hook* '()
+ "Hook run (without arguments) immediately before replying to an RPC.")
+
+(defvar *after-init-hook* '()
+ "Hook run after user init files are loaded.")
+
+
+;;;; Connections
+;;;
+;;; Connection structures represent the network connections between
+;;; Emacs and Lisp. Each has a socket stream, a set of user I/O
+;;; streams that redirect to Emacs, and optionally a second socket
+;;; used solely to pipe user-output to Emacs (an optimization). This
+;;; is also the place where we keep everything that needs to be
+;;; freed/closed/killed when we disconnect.
+
+(defstruct (connection
+ (:constructor %make-connection)
+ (:conc-name connection.)
+ (:print-function print-connection))
+ ;; The listening socket. (usually closed)
+ (socket (missing-arg) :type t :read-only t)
+ ;; Character I/O stream of socket connection. Read-only to avoid
+ ;; race conditions during initialization.
+ (socket-io (missing-arg) :type stream :read-only t)
+ ;; Optional dedicated output socket (backending `user-output' slot).
+ ;; Has a slot so that it can be closed with the connection.
+ (dedicated-output nil :type (or stream null))
+ ;; Streams that can be used for user interaction, with requests
+ ;; redirected to Emacs.
+ (user-input nil :type (or stream null))
+ (user-output nil :type (or stream null))
+ (user-io nil :type (or stream null))
+ ;; Bindings used for this connection (usually streams)
+ (env '() :type list)
+ ;; A stream that we use for *trace-output*; if nil, we user user-output.
+ (trace-output nil :type (or stream null))
+ ;; A stream where we send REPL results.
+ (repl-results nil :type (or stream null))
+ ;; Cache of macro-indentation information that has been sent to Emacs.
+ ;; This is used for preparing deltas to update Emacs's knowledge.
+ ;; Maps: symbol -> indentation-specification
+ (indentation-cache (make-hash-table :test 'eq) :type hash-table)
+ ;; The list of packages represented in the cache:
+ (indentation-cache-packages '())
+ ;; The communication style used.
+ (communication-style nil :type (member nil :spawn :sigio :fd-handler))
+ )
+
+(defun print-connection (conn stream depth)
+ (declare (ignore depth))
+ (print-unreadable-object (conn stream :type t :identity t)))
+
+(defstruct (singlethreaded-connection (:include connection)
+ (:conc-name sconn.))
+ ;; The SIGINT handler we should restore when the connection is
+ ;; closed.
+ saved-sigint-handler
+ ;; A queue of events. Not all events can be processed in order and
+ ;; we need a place to stored them.
+ (event-queue '() :type list)
+ ;; A counter that is incremented whenever an event is added to the
+ ;; queue. This is used to detected modifications to the event queue
+ ;; by interrupts. The counter wraps around.
+ (events-enqueued 0 :type fixnum))
+
+(defstruct (multithreaded-connection (:include connection)
+ (:conc-name mconn.))
+ ;; In multithreaded systems we delegate certain tasks to specific
+ ;; threads. The `reader-thread' is responsible for reading network
+ ;; requests from Emacs and sending them to the `control-thread'; the
+ ;; `control-thread' is responsible for dispatching requests to the
+ ;; threads that should handle them; the `repl-thread' is the one
+ ;; that evaluates REPL expressions. The control thread dispatches
+ ;; all REPL evaluations to the REPL thread and for other requests it
+ ;; spawns new threads.
+ reader-thread
+ control-thread
+ repl-thread
+ auto-flush-thread
+ indentation-cache-thread
+ ;; List of threads that are currently processing requests. We use
+ ;; this to find the newest/current thread for an interrupt. In the
+ ;; future we may store here (thread . request-tag) pairs so that we
+ ;; can interrupt specific requests.
+ (active-threads '() :type list)
+ )
+
+(defvar *emacs-connection* nil
+ "The connection to Emacs currently in use.")
+
+(defun make-connection (socket stream style)
+ (let ((conn (funcall (ecase style
+ (:spawn
+ #'make-multithreaded-connection)
+ ((:sigio nil :fd-handler)
+ #'make-singlethreaded-connection))
+ :socket socket
+ :socket-io stream
+ :communication-style style)))
+ (run-hook *new-connection-hook* conn)
+ (send-to-sentinel `(:add-connection ,conn))
+ conn))
+
+(defslimefun ping (tag)
+ tag)
+
+(defun safe-backtrace ()
+ (ignore-errors
+ (call-with-debugging-environment
+ (lambda () (backtrace 0 nil)))))
+
+(define-condition swank-error (error)
+ ((backtrace :initarg :backtrace :reader swank-error.backtrace)
+ (condition :initarg :condition :reader swank-error.condition))
+ (:report (lambda (c s) (princ (swank-error.condition c) s)))
+ (:documentation "Condition which carries a backtrace."))
+
+(defun signal-swank-error (condition &optional (backtrace (safe-backtrace)))
+ (error 'swank-error :condition condition :backtrace backtrace))
+
+(defvar *debug-on-swank-protocol-error* nil
+ "When non-nil invoke the system debugger on errors that were
+signalled during decoding/encoding the wire protocol. Do not set this
+to T unless you want to debug swank internals.")
+
+(defmacro with-swank-error-handler ((connection) &body body)
+ "Close the connection on internal `swank-error's."
+ (let ((conn (gensym)))
+ `(let ((,conn ,connection))
+ (handler-case
+ (handler-bind ((swank-error
+ (lambda (condition)
+ (when *debug-on-swank-protocol-error*
+ (invoke-default-debugger condition)))))
+ (progn . ,body))
+ (swank-error (condition)
+ (close-connection ,conn
+ (swank-error.condition condition)
+ (swank-error.backtrace condition)))))))
+
+(defmacro with-panic-handler ((connection) &body body)
+ "Close the connection on unhandled `serious-condition's."
+ (let ((conn (gensym)))
+ `(let ((,conn ,connection))
+ (handler-bind ((serious-condition
+ (lambda (condition)
+ (close-connection ,conn condition (safe-backtrace))
+ (abort condition))))
+ . ,body))))
+
+(add-hook *new-connection-hook* 'notify-backend-of-connection)
+(defun notify-backend-of-connection (connection)
+ (declare (ignore connection))
+ (emacs-connected))
+
+
+;;;; Utilities
+
+
+;;;;; Logging
+
+(defvar *swank-io-package*
+ (let ((package (make-package :swank-io-package :use '())))
+ (import '(nil t quote) package)
+ package))
+
+(defvar *log-events* nil)
+
+(defun init-log-output ()
+ (unless *log-output*
+ (setq *log-output* (real-output-stream *error-output*))))
+
+(add-hook *after-init-hook* 'init-log-output)
+
+(defun real-input-stream (stream)
+ (typecase stream
+ (synonym-stream
+ (real-input-stream (symbol-value (synonym-stream-symbol stream))))
+ (two-way-stream
+ (real-input-stream (two-way-stream-input-stream stream)))
+ (t stream)))
+
+(defun real-output-stream (stream)
+ (typecase stream
+ (synonym-stream
+ (real-output-stream (symbol-value (synonym-stream-symbol stream))))
+ (two-way-stream
+ (real-output-stream (two-way-stream-output-stream stream)))
+ (t stream)))
+
+(defvar *event-history* (make-array 40 :initial-element nil)
+ "A ring buffer to record events for better error messages.")
+(defvar *event-history-index* 0)
+(defvar *enable-event-history* t)
+
+(defun log-event (format-string &rest args)
+ "Write a message to *terminal-io* when *log-events* is non-nil.
+Useful for low level debugging."
+ (with-standard-io-syntax
+ (let ((*print-readably* nil)
+ (*print-pretty* nil)
+ (*package* *swank-io-package*))
+ (when *enable-event-history*
+ (setf (aref *event-history* *event-history-index*)
+ (format nil "~?" format-string args))
+ (setf *event-history-index*
+ (mod (1+ *event-history-index*) (length *event-history*))))
+ (when *log-events*
+ (write-string (escape-non-ascii (format nil "~?" format-string args))
+ *log-output*)
+ (force-output *log-output*)))))
+
+(defun event-history-to-list ()
+ "Return the list of events (older events first)."
+ (let ((arr *event-history*)
+ (idx *event-history-index*))
+ (concatenate 'list (subseq arr idx) (subseq arr 0 idx))))
+
+(defun clear-event-history ()
+ (fill *event-history* nil)
+ (setq *event-history-index* 0))
+
+(defun dump-event-history (stream)
+ (dolist (e (event-history-to-list))
+ (dump-event e stream)))
+
+(defun dump-event (event stream)
+ (cond ((stringp event)
+ (write-string (escape-non-ascii event) stream))
+ ((null event))
+ (t
+ (write-string
+ (escape-non-ascii (format nil "Unexpected event: ~A~%" event))
+ stream))))
+
+(defun escape-non-ascii (string)
+ "Return a string like STRING but with non-ascii chars escaped."
+ (cond ((ascii-string-p string) string)
+ (t (with-output-to-string (out)
+ (loop for c across string do
+ (cond ((ascii-char-p c) (write-char c out))
+ (t (format out "\\x~4,'0X" (char-code c)))))))))
+
+(defun ascii-string-p (o)
+ (and (stringp o)
+ (every #'ascii-char-p o)))
+
+(defun ascii-char-p (c)
+ (<= (char-code c) 127))
+
+
+;;;;; Helper macros
+
+(defmacro dcase (value &body patterns)
+ "Dispatch VALUE to one of PATTERNS.
+A cross between `case' and `destructuring-bind'.
+The pattern syntax is:
+ ((HEAD . ARGS) . BODY)
+The list of patterns is searched for a HEAD `eq' to the car of
+VALUE. If one is found, the BODY is executed with ARGS bound to the
+corresponding values in the CDR of VALUE."
+ (let ((operator (gensym "op-"))
+ (operands (gensym "rand-"))
+ (tmp (gensym "tmp-")))
+ `(let* ((,tmp ,value)
+ (,operator (car ,tmp))
+ (,operands (cdr ,tmp)))
+ (case ,operator
+ ,@(loop for (pattern . body) in patterns collect
+ (if (eq pattern t)
+ `(t ,@body)
+ (destructuring-bind (op &rest rands) pattern
+ `(,op (destructuring-bind ,rands ,operands
+ ,@body)))))
+ ,@(if (eq (caar (last patterns)) t)
+ '()
+ `((t (error "dcase failed: ~S" ,tmp))))))))
+
+
+;;;; Interrupt handling
+
+;; Usually we'd like to enter the debugger when an interrupt happens.
+;; But for some operations, in particular send&receive, it's crucial
+;; that those are not interrupted when the mailbox is in an
+;; inconsistent/locked state. Obviously, if send&receive don't work we
+;; can't communicate and the debugger will not work. To solve that
+;; problem, we try to handle interrupts only at certain safe-points.
+;;
+;; Whenever an interrupt happens we call the function
+;; INVOKE-OR-QUEUE-INTERRUPT. Usually this simply invokes the
+;; debugger, but if interrupts are disabled the interrupt is put in a
+;; queue for later processing. At safe-points, we call
+;; CHECK-SLIME-INTERRUPTS which looks at the queue and invokes the
+;; debugger if needed.
+;;
+;; The queue for interrupts is stored in a thread local variable.
+;; WITH-CONNECTION sets it up. WITH-SLIME-INTERRUPTS allows
+;; interrupts, i.e. the debugger is entered immediately. When we call
+;; "user code" or non-problematic code we allow interrupts. When
+;; inside WITHOUT-SLIME-INTERRUPTS, interrupts are queued. When we
+;; switch from "user code" to more delicate operations we need to
+;; disable interrupts. In particular, interrupts should be disabled
+;; for SEND and RECEIVE-IF.
+
+;; If true execute interrupts, otherwise queue them.
+;; Note: `with-connection' binds *pending-slime-interrupts*.
+(defvar *slime-interrupts-enabled*)
+
+(defmacro with-interrupts-enabled% (flag body)
+ `(progn
+ ,@(if flag '((check-slime-interrupts)))
+ (multiple-value-prog1
+ (let ((*slime-interrupts-enabled* ,flag))
+ ,@body)
+ ,@(if flag '((check-slime-interrupts))))))
+
+(defmacro with-slime-interrupts (&body body)
+ `(with-interrupts-enabled% t ,body))
+
+(defmacro without-slime-interrupts (&body body)
+ `(with-interrupts-enabled% nil ,body))
+
+(defun invoke-or-queue-interrupt (function)
+ (log-event "invoke-or-queue-interrupt: ~a~%" function)
+ (cond ((not (boundp '*slime-interrupts-enabled*))
+ (without-slime-interrupts
+ (funcall function)))
+ (*slime-interrupts-enabled*
+ (log-event "interrupts-enabled~%")
+ (funcall function))
+ (t
+ (setq *pending-slime-interrupts*
+ (nconc *pending-slime-interrupts*
+ (list function)))
+ (cond ((cdr *pending-slime-interrupts*)
+ (log-event "too many queued interrupts~%")
+ (with-simple-restart (continue "Continue from interrupt")
+ (handler-bind ((serious-condition #'invoke-slime-debugger))
+ (check-slime-interrupts))))
+ (t
+ (log-event "queue-interrupt: ~a~%" function)
+ (when *interrupt-queued-handler*
+ (funcall *interrupt-queued-handler*)))))))
+
+
+;;; FIXME: poor name?
+(defmacro with-io-redirection ((connection) &body body)
+ "Execute BODY I/O redirection to CONNECTION. "
+ `(with-bindings (connection.env ,connection)
+ . ,body))
+
+;; Thread local variable used for flow-control.
+;; It's bound by `with-connection'.
+(defvar *send-counter*)
+
+(defmacro with-connection ((connection) &body body)
+ "Execute BODY in the context of CONNECTION."
+ `(let ((connection ,connection)
+ (function (lambda () . ,body)))
+ (if (eq *emacs-connection* connection)
+ (funcall function)
+ (let ((*emacs-connection* connection)
+ (*pending-slime-interrupts* '())
+ (*send-counter* 0))
+ (without-slime-interrupts
+ (with-swank-error-handler (connection)
+ (with-io-redirection (connection)
+ (call-with-debugger-hook #'swank-debugger-hook
+ function))))))))
+
+(defun call-with-retry-restart (msg thunk)
+ (loop (with-simple-restart (retry "~a" msg)
+ (return (funcall thunk)))))
+
+(defmacro with-retry-restart ((&key (msg "Retry.")) &body body)
+ (check-type msg string)
+ `(call-with-retry-restart ,msg (lambda () ,@body)))
+
+(defmacro with-struct* ((conc-name get obj) &body body)
+ (let ((var (gensym)))
+ `(let ((,var ,obj))
+ (macrolet ((,get (slot)
+ (let ((getter (intern (concatenate 'string
+ ',(string conc-name)
+ (string slot))
+ (symbol-package ',conc-name))))
+ `(,getter ,',var))))
+ ,@body))))
+
+(defmacro define-special (name doc)
+ "Define a special variable NAME with doc string DOC.
+This is like defvar, but NAME will not be initialized."
+ `(progn
+ (defvar ,name)
+ (setf (documentation ',name 'variable) ,doc)))
+
+
+;;;;; Sentinel
+;;;
+;;; The sentinel thread manages some global lists.
+;;; FIXME: Overdesigned?
+
+(defvar *connections* '()
+ "List of all active connections, with the most recent at the front.")
+
+(defvar *servers* '()
+ "A list ((server-socket port thread) ...) describing the listening sockets.
+Used to close sockets on server shutdown or restart.")
+
+;; FIXME: we simply access the global variable here. We could ask the
+;; sentinel thread instead but then we still have the problem that the
+;; connection could be closed before we use it.
+(defun default-connection ()
+ "Return the 'default' Emacs connection.
+This connection can be used to talk with Emacs when no specific
+connection is in use, i.e. *EMACS-CONNECTION* is NIL.
+
+The default connection is defined (quite arbitrarily) as the most
+recently established one."
+ (car *connections*))
+
+(defun start-sentinel ()
+ (unless (find-registered 'sentinel)
+ (let ((thread (spawn #'sentinel :name "Swank Sentinel")))
+ (register-thread 'sentinel thread))))
+
+(defun sentinel ()
+ (catch 'exit-sentinel
+ (loop (sentinel-serve (receive)))))
+
+(defun send-to-sentinel (msg)
+ (let ((sentinel (find-registered 'sentinel)))
+ (cond (sentinel (send sentinel msg))
+ (t (sentinel-serve msg)))))
+
+(defun sentinel-serve (msg)
+ (dcase msg
+ ((:add-connection conn)
+ (push conn *connections*))
+ ((:close-connection connection condition backtrace)
+ (close-connection% connection condition backtrace)
+ (sentinel-maybe-exit))
+ ((:add-server socket port thread)
+ (push (list socket port thread) *servers*))
+ ((:stop-server key port)
+ (sentinel-stop-server key port)
+ (sentinel-maybe-exit))))
+
+(defun sentinel-stop-server (key value)
+ (let ((probe (find value *servers* :key (ecase key
+ (:socket #'car)
+ (:port #'cadr)))))
+ (cond (probe
+ (setq *servers* (delete probe *servers*))
+ (destructuring-bind (socket _port thread) probe
+ (declare (ignore _port))
+ (ignore-errors (close-socket socket))
+ (when (and thread
+ (thread-alive-p thread)
+ (not (eq thread (current-thread))))
+ (kill-thread thread))))
+ (t
+ (warn "No server for ~s: ~s" key value)))))
+
+(defun sentinel-maybe-exit ()
+ (when (and (null *connections*)
+ (null *servers*)
+ (and (current-thread)
+ (eq (find-registered 'sentinel)
+ (current-thread))))
+ (register-thread 'sentinel nil)
+ (throw 'exit-sentinel nil)))
+
+
+;;;;; Misc
+
+(defun use-threads-p ()
+ (eq (connection.communication-style *emacs-connection*) :spawn))
+
+(defun current-thread-id ()
+ (thread-id (current-thread)))
+
+(declaim (inline ensure-list))
+(defun ensure-list (thing)
+ (if (listp thing) thing (list thing)))
+
+
+;;;;; Symbols
+
+;; FIXME: this docstring is more confusing than helpful.
+(defun symbol-status (symbol &optional (package (symbol-package symbol)))
+ "Returns one of
+
+ :INTERNAL if the symbol is _present_ in PACKAGE as an _internal_ symbol,
+
+ :EXTERNAL if the symbol is _present_ in PACKAGE as an _external_ symbol,
+
+ :INHERITED if the symbol is _inherited_ by PACKAGE through USE-PACKAGE,
+ but is not _present_ in PACKAGE,
+
+ or NIL if SYMBOL is not _accessible_ in PACKAGE.
+
+
+Be aware not to get confused with :INTERNAL and how \"internal
+symbols\" are defined in the spec; there is a slight mismatch of
+definition with the Spec and what's commonly meant when talking
+about internal symbols most times. As the spec says:
+
+ In a package P, a symbol S is
+
+ _accessible_ if S is either _present_ in P itself or was
+ inherited from another package Q (which implies
+ that S is _external_ in Q.)
+
+ You can check that with: (AND (SYMBOL-STATUS S P) T)
+
+
+ _present_ if either P is the /home package/ of S or S has been
+ imported into P or exported from P by IMPORT, or
+ EXPORT respectively.
+
+ Or more simply, if S is not _inherited_.
+
+ You can check that with: (LET ((STATUS (SYMBOL-STATUS S P)))
+ (AND STATUS
+ (NOT (EQ STATUS :INHERITED))))
+
+
+ _external_ if S is going to be inherited into any package that
+ /uses/ P by means of USE-PACKAGE, MAKE-PACKAGE, or
+ DEFPACKAGE.
+
+ Note that _external_ implies _present_, since to
+ make a symbol _external_, you'd have to use EXPORT
+ which will automatically make the symbol _present_.
+
+ You can check that with: (EQ (SYMBOL-STATUS S P) :EXTERNAL)
+
+
+ _internal_ if S is _accessible_ but not _external_.
+
+ You can check that with: (LET ((STATUS (SYMBOL-STATUS S P)))
+ (AND STATUS
+ (NOT (EQ STATUS :EXTERNAL))))
+
+
+ Notice that this is *different* to
+ (EQ (SYMBOL-STATUS S P) :INTERNAL)
+ because what the spec considers _internal_ is split up into two
+ explicit pieces: :INTERNAL, and :INHERITED; just as, for instance,
+ CL:FIND-SYMBOL does.
+
+ The rationale is that most times when you speak about \"internal\"
+ symbols, you're actually not including the symbols inherited
+ from other packages, but only about the symbols directly specific
+ to the package in question.
+"
+ (when package ; may be NIL when symbol is completely uninterned.
+ (check-type symbol symbol) (check-type package package)
+ (multiple-value-bind (present-symbol status)
+ (find-symbol (symbol-name symbol) package)
+ (and (eq symbol present-symbol) status))))
+
+(defun symbol-external-p (symbol &optional (package (symbol-package symbol)))
+ "True if SYMBOL is external in PACKAGE.
+If PACKAGE is not specified, the home package of SYMBOL is used."
+ (eq (symbol-status symbol package) :external))
+
+
+;;;; TCP Server
+
+(defvar *communication-style* (preferred-communication-style))
+
+(defvar *dont-close* nil
+ "Default value of :dont-close argument to start-server and
+ create-server.")
+
+(defun start-server (port-file &key (style *communication-style*)
+ (dont-close *dont-close*))
+ "Start the server and write the listen port number to PORT-FILE.
+This is the entry point for Emacs."
+ (setup-server 0
+ (lambda (port) (announce-server-port port-file port))
+ style dont-close nil))
+
+(defun create-server (&key (port default-server-port)
+ (style *communication-style*)
+ (dont-close *dont-close*)
+ backlog)
+ "Start a SWANK server on PORT running in STYLE.
+If DONT-CLOSE is true then the listen socket will accept multiple
+connections, otherwise it will be closed after the first."
+ (setup-server port #'simple-announce-function
+ style dont-close backlog))
+
+(defun find-external-format-or-lose (coding-system)
+ (or (find-external-format coding-system)
+ (error "Unsupported coding system: ~s" coding-system)))
+
+(defparameter *loopback-interface* "127.0.0.1")
+
+(defmacro restart-loop (form &body clauses)
+ "Executes FORM, with restart-case CLAUSES which have a chance to modify FORM's
+environment before trying again (by returning normally) or giving up (through an
+explicit transfer of control), all within an implicit block named nil.
+e.g.: (restart-loop (http-request url) (use-value (new) (setq url new)))"
+ `(loop (restart-case (return ,form) ,@clauses)))
+
+(defun socket-quest (port backlog)
+ (restart-loop (create-socket *loopback-interface* port :backlog backlog)
+ (use-value (&optional (new-port (1+ port)))
+ :report (lambda (stream) (format stream "Try a port other than ~D" port))
+ :interactive
+ (lambda ()
+ (format *query-io* "Enter port (defaults to ~D): " (1+ port))
+ (finish-output *query-io*) ; necessary for tunnels
+ (ignore-errors (list (parse-integer (read-line *query-io*)))))
+ (setq port new-port))))
+
+(defun setup-server (port announce-fn style dont-close backlog)
+ (init-log-output)
+ (let* ((socket (socket-quest port backlog))
+ (port (local-port socket)))
+ (funcall announce-fn port)
+ (labels ((serve () (accept-connections socket style dont-close))
+ (note () (send-to-sentinel `(:add-server ,socket ,port
+ ,(current-thread))))
+ (serve-loop () (note) (loop do (serve) while dont-close)))
+ (ecase style
+ (:spawn (initialize-multiprocessing
+ (lambda ()
+ (start-sentinel)
+ (spawn #'serve-loop :name (format nil "Swank ~s" port)))))
+ ((:fd-handler :sigio)
+ (note)
+ (add-fd-handler socket #'serve))
+ ((nil) (serve-loop))))
+ port))
+
+(defun stop-server (port)
+ "Stop server running on PORT."
+ (send-to-sentinel `(:stop-server :port ,port)))
+
+(defun restart-server (&key (port default-server-port)
+ (style *communication-style*)
+ (dont-close *dont-close*))
+ "Stop the server listening on PORT, then start a new SWANK server
+on PORT running in STYLE. If DONT-CLOSE is true then the listen socket
+will accept multiple connections, otherwise it will be closed after the
+first."
+ (stop-server port)
+ (sleep 5)
+ (create-server :port port :style style :dont-close dont-close))
+
+(defun accept-connections (socket style dont-close)
+ (let ((client (unwind-protect
+ (accept-connection socket :external-format nil
+ :buffering t)
+ (unless dont-close
+ (close-socket socket)))))
+ (authenticate-client client)
+ (serve-requests (make-connection socket client style))
+ (unless dont-close
+ (send-to-sentinel `(:stop-server :socket ,socket)))))
+
+(defun authenticate-client (stream)
+ (let ((secret (slime-secret)))
+ (when secret
+ (set-stream-timeout stream 20)
+ (let ((first-val (decode-message stream)))
+ (unless (and (stringp first-val) (string= first-val secret))
+ (error "Incoming connection doesn't know the password.")))
+ (set-stream-timeout stream nil))))
+
+(defun slime-secret ()
+ "Finds the magic secret from the user's home directory. Returns nil
+if the file doesn't exist; otherwise the first line of the file."
+ (with-open-file (in
+ (merge-pathnames (user-homedir-pathname) #p".slime-secret")
+ :if-does-not-exist nil)
+ (and in (read-line in nil ""))))
+
+(defun serve-requests (connection)
+ "Read and process all requests on connections."
+ (etypecase connection
+ (multithreaded-connection
+ (spawn-threads-for-connection connection))
+ (singlethreaded-connection
+ (ecase (connection.communication-style connection)
+ ((nil) (simple-serve-requests connection))
+ (:sigio (install-sigio-handler connection))
+ (:fd-handler (install-fd-handler connection))))))
+
+(defun stop-serving-requests (connection)
+ (etypecase connection
+ (multithreaded-connection
+ (cleanup-connection-threads connection))
+ (singlethreaded-connection
+ (ecase (connection.communication-style connection)
+ ((nil))
+ (:sigio (deinstall-sigio-handler connection))
+ (:fd-handler (deinstall-fd-handler connection))))))
+
+(defun announce-server-port (file port)
+ (with-open-file (s file
+ :direction :output
+ :if-exists :error
+ :if-does-not-exist :create)
+ (format s "~S~%" port))
+ (simple-announce-function port))
+
+(defun simple-announce-function (port)
+ (when *swank-debug-p*
+ (format *log-output* "~&;; Swank started at port: ~D.~%" port)
+ (force-output *log-output*)))
+
+
+;;;;; Event Decoding/Encoding
+
+(defun decode-message (stream)
+ "Read an S-expression from STREAM using the SLIME protocol."
+ (log-event "decode-message~%")
+ (without-slime-interrupts
+ (handler-bind ((error #'signal-swank-error))
+ (handler-case (read-message stream *swank-io-package*)
+ (swank-reader-error (c)
+ `(:reader-error ,(swank-reader-error.packet c)
+ ,(swank-reader-error.cause c)))))))
+
+(defun encode-message (message stream)
+ "Write an S-expression to STREAM using the SLIME protocol."
+ (log-event "encode-message~%")
+ (without-slime-interrupts
+ (handler-bind ((error #'signal-swank-error))
+ (write-message message *swank-io-package* stream))))
+
+
+;;;;; Event Processing
+
+(defvar *sldb-quit-restart* nil
+ "The restart that will be invoked when the user calls sldb-quit.")
+
+;; Establish a top-level restart and execute BODY.
+;; Execute K if the restart is invoked.
+(defmacro with-top-level-restart ((connection k) &body body)
+ `(with-connection (,connection)
+ (restart-case
+ (let ((*sldb-quit-restart* (find-restart 'abort)))
+ ,@body)
+ (abort (&optional v)
+ :report "Return to SLIME's top level."
+ (declare (ignore v))
+ (force-user-output)
+ ,k))))
+
+(defun handle-requests (connection &optional timeout)
+ "Read and process :emacs-rex requests.
+The processing is done in the extent of the toplevel restart."
+ (with-connection (connection)
+ (cond (*sldb-quit-restart*
+ (process-requests timeout))
+ (t
+ (tagbody
+ start
+ (with-top-level-restart (connection (go start))
+ (process-requests timeout)))))))
+
+(defun process-requests (timeout)
+ "Read and process requests from Emacs."
+ (loop
+ (multiple-value-bind (event timeout?)
+ (wait-for-event `(or (:emacs-rex . _)
+ (:emacs-channel-send . _))
+ timeout)
+ (when timeout? (return))
+ (dcase event
+ ((:emacs-rex &rest args) (apply #'eval-for-emacs args))
+ ((:emacs-channel-send channel (selector &rest args))
+ (channel-send channel selector args))))))
+
+(defun current-socket-io ()
+ (connection.socket-io *emacs-connection*))
+
+(defun close-connection (connection condition backtrace)
+ (send-to-sentinel `(:close-connection ,connection ,condition ,backtrace)))
+
+(defun close-connection% (c condition backtrace)
+ (let ((*debugger-hook* nil))
+ (log-event "close-connection: ~a ...~%" condition)
+ (format *log-output* "~&;; swank:close-connection: ~A~%"
+ (escape-non-ascii (safe-condition-message condition)))
+ (stop-serving-requests c)
+ (close (connection.socket-io c))
+ (when (connection.dedicated-output c)
+ (close (connection.dedicated-output c)))
+ (setf *connections* (remove c *connections*))
+ (run-hook *connection-closed-hook* c)
+ (when (and condition (not (typep condition 'end-of-file)))
+ (finish-output *log-output*)
+ (format *log-output* "~&;; Event history start:~%")
+ (dump-event-history *log-output*)
+ (format *log-output* "~
+;; Event history end.~%~
+;; Backtrace:~%~{~A~%~}~
+;; Connection to Emacs lost. [~%~
+;; condition: ~A~%~
+;; type: ~S~%~
+;; style: ~S]~%"
+ (loop for (i f) in backtrace collect
+ (ignore-errors
+ (format nil "~d: ~a" i (escape-non-ascii f))))
+ (escape-non-ascii (safe-condition-message condition) )
+ (type-of condition)
+ (connection.communication-style c)))
+ (finish-output *log-output*)
+ (log-event "close-connection ~a ... done.~%" condition)))
+
+;;;;;; Thread based communication
+
+(defun read-loop (connection)
+ (let ((input-stream (connection.socket-io connection))
+ (control-thread (mconn.control-thread connection)))
+ (with-swank-error-handler (connection)
+ (loop (send control-thread (decode-message input-stream))))))
+
+(defun dispatch-loop (connection)
+ (let ((*emacs-connection* connection))
+ (with-panic-handler (connection)
+ (loop (dispatch-event connection (receive))))))
+
+(defvar *auto-flush-interval* 0.2)
+
+(defun auto-flush-loop (stream)
+ (loop
+ (when (not (and (open-stream-p stream)
+ (output-stream-p stream)))
+ (return nil))
+ (force-output stream)
+ (sleep *auto-flush-interval*)))
+
+(defgeneric thread-for-evaluation (connection id)
+ (:documentation "Find or create a thread to evaluate the next request.")
+ (:method ((connection multithreaded-connection) (id (eql t)))
+ (spawn-worker-thread connection))
+ (:method ((connection multithreaded-connection) (id (eql :find-existing)))
+ (car (mconn.active-threads connection)))
+ (:method (connection (id integer))
+ (declare (ignorable connection))
+ (find-thread id))
+ (:method ((connection singlethreaded-connection) id)
+ (declare (ignorable connection connection id))
+ (current-thread)))
+
+(defun interrupt-worker-thread (connection id)
+ (let ((thread (thread-for-evaluation connection
+ (cond ((eq id t) :find-existing)
+ (t id)))))
+ (log-event "interrupt-worker-thread: ~a ~a~%" id thread)
+ (if thread
+ (etypecase connection
+ (multithreaded-connection
+ (interrupt-thread thread
+ (lambda ()
+ ;; safely interrupt THREAD
+ (invoke-or-queue-interrupt #'simple-break))))
+ (singlethreaded-connection
+ (simple-break)))
+ (encode-message (list :debug-condition (current-thread-id)
+ (format nil "Thread with id ~a not found"
+ id))
+ (current-socket-io)))))
+
+(defun spawn-worker-thread (connection)
+ (spawn (lambda ()
+ (with-bindings *default-worker-thread-bindings*
+ (with-top-level-restart (connection nil)
+ (apply #'eval-for-emacs
+ (cdr (wait-for-event `(:emacs-rex . _)))))))
+ :name "worker"))
+
+(defun add-active-thread (connection thread)
+ (etypecase connection
+ (multithreaded-connection
+ (push thread (mconn.active-threads connection)))
+ (singlethreaded-connection)))
+
+(defun remove-active-thread (connection thread)
+ (etypecase connection
+ (multithreaded-connection
+ (setf (mconn.active-threads connection)
+ (delete thread (mconn.active-threads connection) :count 1)))
+ (singlethreaded-connection)))
+
+(defun dispatch-event (connection event)
+ "Handle an event triggered either by Emacs or within Lisp."
+ (log-event "dispatch-event: ~s~%" event)
+ (dcase event
+ ((:emacs-rex form package thread-id id)
+ (let ((thread (thread-for-evaluation connection thread-id)))
+ (cond (thread
+ (add-active-thread connection thread)
+ (send-event thread `(:emacs-rex ,form ,package ,id)))
+ (t
+ (encode-message
+ (list :invalid-rpc id
+ (format nil "Thread not found: ~s" thread-id))
+ (current-socket-io))))))
+ ((:return thread &rest args)
+ (remove-active-thread connection thread)
+ (encode-message `(:return ,@args) (current-socket-io)))
+ ((:emacs-interrupt thread-id)
+ (interrupt-worker-thread connection thread-id))
+ (((:write-string
+ :debug :debug-condition :debug-activate :debug-return :channel-send
+ :presentation-start :presentation-end
+ :new-package :new-features :ed :indentation-update
+ :eval :eval-no-wait :background-message :inspect :ping
+ :y-or-n-p :read-from-minibuffer :read-string :read-aborted :test-delay
+ :write-image)
+ &rest _)
+ (declare (ignore _))
+ (encode-message event (current-socket-io)))
+ (((:emacs-pong :emacs-return :emacs-return-string) thread-id &rest args)
+ (send-event (find-thread thread-id) (cons (car event) args)))
+ ((:emacs-channel-send channel-id msg)
+ (let ((ch (find-channel channel-id)))
+ (send-event (channel-thread ch) `(:emacs-channel-send ,ch ,msg))))
+ ((:reader-error packet condition)
+ (encode-message `(:reader-error ,packet
+ ,(safe-condition-message condition))
+ (current-socket-io)))))
+
+
+(defun send-event (thread event)
+ (log-event "send-event: ~s ~s~%" thread event)
+ (let ((c *emacs-connection*))
+ (etypecase c
+ (multithreaded-connection
+ (send thread event))
+ (singlethreaded-connection
+ (setf (sconn.event-queue c) (nconc (sconn.event-queue c) (list event)))
+ (setf (sconn.events-enqueued c) (mod (1+ (sconn.events-enqueued c))
+ most-positive-fixnum))))))
+
+(defun send-to-emacs (event)
+ "Send EVENT to Emacs."
+ ;;(log-event "send-to-emacs: ~a" event)
+ (without-slime-interrupts
+ (let ((c *emacs-connection*))
+ (etypecase c
+ (multithreaded-connection
+ (send (mconn.control-thread c) event))
+ (singlethreaded-connection
+ (dispatch-event c event)))
+ (maybe-slow-down))))
+
+
+;;;;;; Flow control
+
+;; After sending N (usually 100) messages we slow down and ping Emacs
+;; to make sure that everything we have sent so far was received.
+
+(defconstant send-counter-limit 100)
+
+(defun maybe-slow-down ()
+ (let ((counter (incf *send-counter*)))
+ (when (< send-counter-limit counter)
+ (setf *send-counter* 0)
+ (ping-pong))))
+
+(defun ping-pong ()
+ (let* ((tag (make-tag))
+ (pattern `(:emacs-pong ,tag)))
+ (send-to-emacs `(:ping ,(current-thread-id) ,tag))
+ (wait-for-event pattern)))
+
+
+(defun wait-for-event (pattern &optional timeout)
+ "Scan the event queue for PATTERN and return the event.
+If TIMEOUT is 'nil wait until a matching event is enqued.
+If TIMEOUT is 't only scan the queue without waiting.
+The second return value is t if the timeout expired before a matching
+event was found."
+ (log-event "wait-for-event: ~s ~s~%" pattern timeout)
+ (without-slime-interrupts
+ (let ((c *emacs-connection*))
+ (etypecase c
+ (multithreaded-connection
+ (receive-if (lambda (e) (event-match-p e pattern)) timeout))
+ (singlethreaded-connection
+ (wait-for-event/event-loop c pattern timeout))))))
+
+(defun wait-for-event/event-loop (connection pattern timeout)
+ (assert (or (not timeout) (eq timeout t)))
+ (loop
+ (check-slime-interrupts)
+ (let ((event (poll-for-event connection pattern)))
+ (when event (return (car event))))
+ (let ((events-enqueued (sconn.events-enqueued connection))
+ (ready (wait-for-input (list (current-socket-io)) timeout)))
+ (cond ((and timeout (not ready))
+ (return (values nil t)))
+ ((or (/= events-enqueued (sconn.events-enqueued connection))
+ (eq ready :interrupt))
+ ;; rescan event queue, interrupts may enqueue new events
+ )
+ (t
+ (assert (equal ready (list (current-socket-io))))
+ (dispatch-event connection
+ (decode-message (current-socket-io))))))))
+
+(defun poll-for-event (connection pattern)
+ (let* ((c connection)
+ (tail (member-if (lambda (e) (event-match-p e pattern))
+ (sconn.event-queue c))))
+ (when tail
+ (setf (sconn.event-queue c)
+ (nconc (ldiff (sconn.event-queue c) tail) (cdr tail)))
+ tail)))
+
+;;; FIXME: Make this use SWANK-MATCH.
+(defun event-match-p (event pattern)
+ (cond ((or (keywordp pattern) (numberp pattern) (stringp pattern)
+ (member pattern '(nil t)))
+ (equal event pattern))
+ ((symbolp pattern) t)
+ ((consp pattern)
+ (case (car pattern)
+ ((or) (some (lambda (p) (event-match-p event p)) (cdr pattern)))
+ (t (and (consp event)
+ (and (event-match-p (car event) (car pattern))
+ (event-match-p (cdr event) (cdr pattern)))))))
+ (t (error "Invalid pattern: ~S" pattern))))
+
+
+
+(defun spawn-threads-for-connection (connection)
+ (setf (mconn.control-thread connection)
+ (spawn (lambda () (control-thread connection))
+ :name "control-thread"))
+ connection)
+
+(defun control-thread (connection)
+ (with-struct* (mconn. @ connection)
+ (setf (@ control-thread) (current-thread))
+ (setf (@ reader-thread) (spawn (lambda () (read-loop connection))
+ :name "reader-thread"))
+ (setf (@ indentation-cache-thread)
+ (spawn (lambda () (indentation-cache-loop connection))
+ :name "swank-indentation-cache-thread"))
+ (dispatch-loop connection)))
+
+(defun cleanup-connection-threads (connection)
+ (let* ((c connection)
+ (threads (list (mconn.repl-thread c)
+ (mconn.reader-thread c)
+ (mconn.control-thread c)
+ (mconn.auto-flush-thread c)
+ (mconn.indentation-cache-thread c))))
+ (dolist (thread threads)
+ (when (and thread
+ (thread-alive-p thread)
+ (not (equal (current-thread) thread)))
+ (kill-thread thread)))))
+
+;;;;;; Signal driven IO
+
+(defun install-sigio-handler (connection)
+ (add-sigio-handler (connection.socket-io connection)
+ (lambda () (process-io-interrupt connection)))
+ (handle-requests connection t))
+
+(defvar *io-interupt-level* 0)
+
+(defun process-io-interrupt (connection)
+ (log-event "process-io-interrupt ~d ...~%" *io-interupt-level*)
+ (let ((*io-interupt-level* (1+ *io-interupt-level*)))
+ (invoke-or-queue-interrupt
+ (lambda () (handle-requests connection t))))
+ (log-event "process-io-interrupt ~d ... done ~%" *io-interupt-level*))
+
+(defun deinstall-sigio-handler (connection)
+ (log-event "deinstall-sigio-handler...~%")
+ (remove-sigio-handlers (connection.socket-io connection))
+ (log-event "deinstall-sigio-handler...done~%"))
+
+;;;;;; SERVE-EVENT based IO
+
+(defun install-fd-handler (connection)
+ (add-fd-handler (connection.socket-io connection)
+ (lambda () (handle-requests connection t)))
+ (setf (sconn.saved-sigint-handler connection)
+ (install-sigint-handler
+ (lambda ()
+ (invoke-or-queue-interrupt
+ (lambda () (dispatch-interrupt-event connection))))))
+ (handle-requests connection t))
+
+(defun dispatch-interrupt-event (connection)
+ (with-connection (connection)
+ (dispatch-event connection `(:emacs-interrupt ,(current-thread-id)))))
+
+(defun deinstall-fd-handler (connection)
+ (log-event "deinstall-fd-handler~%")
+ (remove-fd-handlers (connection.socket-io connection))
+ (install-sigint-handler (sconn.saved-sigint-handler connection)))
+
+;;;;;; Simple sequential IO
+
+(defun simple-serve-requests (connection)
+ (unwind-protect
+ (with-connection (connection)
+ (call-with-user-break-handler
+ (lambda ()
+ (invoke-or-queue-interrupt
+ (lambda () (dispatch-interrupt-event connection))))
+ (lambda ()
+ (with-simple-restart (close-connection "Close SLIME connection.")
+ (let* ((stdin (real-input-stream *standard-input*))
+ (*standard-input* (make-repl-input-stream connection
+ stdin)))
+ (tagbody toplevel
+ (with-top-level-restart (connection (go toplevel))
+ (simple-repl))))))))
+ (close-connection connection nil (safe-backtrace))))
+
+;; this is signalled when our custom stream thinks the end-of-file is reached.
+;; (not when the end-of-file on the socket is reached)
+(define-condition end-of-repl-input (end-of-file) ())
+
+(defun simple-repl ()
+ (loop
+ (format t "~a> " (package-string-for-prompt *package*))
+ (force-output)
+ (let ((form (handler-case (read)
+ (end-of-repl-input () (return)))))
+ (let ((- form)
+ (values (multiple-value-list (eval form))))
+ (setq *** ** ** * * (car values)
+ /// // // / / values
+ +++ ++ ++ + + form)
+ (cond ((null values) (format t "; No values~&"))
+ (t (mapc (lambda (v) (format t "~s~&" v)) values)))))))
+
+(defun make-repl-input-stream (connection stdin)
+ (make-input-stream
+ (lambda () (repl-input-stream-read connection stdin))))
+
+(defun repl-input-stream-read (connection stdin)
+ (loop
+ (let* ((socket (connection.socket-io connection))
+ (inputs (list socket stdin))
+ (ready (wait-for-input inputs)))
+ (cond ((eq ready :interrupt)
+ (check-slime-interrupts))
+ ((member socket ready)
+ ;; A Slime request from Emacs is pending; make sure to
+ ;; redirect IO to the REPL buffer.
+ (with-simple-restart (process-input "Continue reading input.")
+ (let ((*sldb-quit-restart* (find-restart 'process-input)))
+ (with-io-redirection (connection)
+ (handle-requests connection t)))))
+ ((member stdin ready)
+ ;; User typed something into the *inferior-lisp* buffer,
+ ;; so do not redirect.
+ (return (read-non-blocking stdin)))
+ (t (assert (null ready)))))))
+
+(defun read-non-blocking (stream)
+ (with-output-to-string (str)
+ (handler-case
+ (loop (let ((c (read-char-no-hang stream)))
+ (unless c (return))
+ (write-char c str)))
+ (end-of-file () (error 'end-of-repl-input :stream stream)))))
+
+
+;;; Channels
+
+;; FIXME: should be per connection not global.
+(defvar *channels* '())
+(defvar *channel-counter* 0)
+
+(defclass channel ()
+ ((id :reader channel-id)
+ (thread :initarg :thread :initform (current-thread) :reader channel-thread)
+ (name :initarg :name :initform nil)))
+
+(defmethod initialize-instance :after ((ch channel) &key)
+ (with-slots (id) ch
+ (setf id (incf *channel-counter*))
+ (push (cons id ch) *channels*)))
+
+(defmethod print-object ((c channel) stream)
+ (print-unreadable-object (c stream :type t)
+ (with-slots (id name) c
+ (format stream "~d ~a" id name))))
+
+(defun find-channel (id)
+ (cdr (assoc id *channels*)))
+
+(defgeneric channel-send (channel selector args))
+
+(defmacro define-channel-method (selector (channel &rest args) &body body)
+ `(defmethod channel-send (,channel (selector (eql ',selector)) args)
+ (destructuring-bind ,args args
+ . ,body)))
+
+(defun send-to-remote-channel (channel-id msg)
+ (send-to-emacs `(:channel-send ,channel-id ,msg)))
+
+
+
+(defvar *slime-features* nil
+ "The feature list that has been sent to Emacs.")
+
+(defun send-oob-to-emacs (object)
+ (send-to-emacs object))
+
+;; FIXME: belongs to swank-repl.lisp
+(defun force-user-output ()
+ (force-output (connection.user-io *emacs-connection*)))
+
+(add-hook *pre-reply-hook* 'force-user-output)
+
+;; FIXME: belongs to swank-repl.lisp
+(defun clear-user-input ()
+ (clear-input (connection.user-input *emacs-connection*)))
+
+;; FIXME: not thread save.
+(defvar *tag-counter* 0)
+
+(defun make-tag ()
+ (setq *tag-counter* (mod (1+ *tag-counter*) (expt 2 22))))
+
+(defun y-or-n-p-in-emacs (format-string &rest arguments)
+ "Like y-or-n-p, but ask in the Emacs minibuffer."
+ (let ((tag (make-tag))
+ (question (apply #'format nil format-string arguments)))
+ (force-output)
+ (send-to-emacs `(:y-or-n-p ,(current-thread-id) ,tag ,question))
+ (third (wait-for-event `(:emacs-return ,tag result)))))
+
+(defun read-from-minibuffer-in-emacs (prompt &optional initial-value)
+ "Ask user a question in Emacs' minibuffer. Returns \"\" when user
+entered nothing, returns NIL when user pressed C-g."
+ (check-type prompt string) (check-type initial-value (or null string))
+ (let ((tag (make-tag)))
+ (force-output)
+ (send-to-emacs `(:read-from-minibuffer ,(current-thread-id) ,tag
+ ,prompt ,initial-value))
+ (third (wait-for-event `(:emacs-return ,tag result)))))
+
+(defstruct (unredable-result
+ (:constructor make-unredable-result (string))
+ (:copier nil)
+ (:print-object
+ (lambda (object stream)
+ (print-unreadable-object (object stream :type t)
+ (princ (unredable-result-string object) stream)))))
+ string)
+
+(defun process-form-for-emacs (form)
+ "Returns a string which emacs will read as equivalent to
+FORM. FORM can contain lists, strings, characters, symbols and
+numbers.
+
+Characters are converted emacs' ?<char> notaion, strings are left
+as they are (except for espacing any nested \" chars, numbers are
+printed in base 10 and symbols are printed as their symbol-name
+converted to lower case."
+ (etypecase form
+ (string (format nil "~S" form))
+ (cons (format nil "(~A . ~A)"
+ (process-form-for-emacs (car form))
+ (process-form-for-emacs (cdr form))))
+ (character (format nil "?~C" form))
+ (symbol (concatenate 'string (when (eq (symbol-package form)
+ #.(find-package "KEYWORD"))
+ ":")
+ (string-downcase (symbol-name form))))
+ (number (let ((*print-base* 10))
+ (princ-to-string form)))))
+
+(defun eval-in-emacs (form &optional nowait)
+ "Eval FORM in Emacs.
+`slime-enable-evaluate-in-emacs' should be set to T on the Emacs side."
+ (cond (nowait
+ (send-to-emacs `(:eval-no-wait ,(process-form-for-emacs form))))
+ (t
+ (force-output)
+ (let ((tag (make-tag)))
+ (send-to-emacs `(:eval ,(current-thread-id) ,tag
+ ,(process-form-for-emacs form)))
+ (let ((value (caddr (wait-for-event `(:emacs-return ,tag result)))))
+ (dcase value
+ ((:unreadable value) (make-unredable-result value))
+ ((:ok value) value)
+ ((:error kind . data) (error "~a: ~{~a~}" kind data))
+ ((:abort) (abort))))))))
+
+(defvar *swank-wire-protocol-version* nil
+ "The version of the swank/slime communication protocol.")
+
+(defslimefun connection-info ()
+ "Return a key-value list of the form:
+\(&key PID STYLE LISP-IMPLEMENTATION MACHINE FEATURES PACKAGE VERSION)
+PID: is the process-id of Lisp process (or nil, depending on the STYLE)
+STYLE: the communication style
+LISP-IMPLEMENTATION: a list (&key TYPE NAME VERSION)
+FEATURES: a list of keywords
+PACKAGE: a list (&key NAME PROMPT)
+VERSION: the protocol version"
+ (let ((c *emacs-connection*))
+ (setq *slime-features* *features*)
+ `(:pid ,(getpid) :style ,(connection.communication-style c)
+ :encoding (:coding-systems
+ ,(loop for cs in '("utf-8-unix" "iso-latin-1-unix")
+ when (find-external-format cs) collect cs))
+ :lisp-implementation (:type ,(lisp-implementation-type)
+ :name ,(lisp-implementation-type-name)
+ :version ,(lisp-implementation-version)
+ :program ,(lisp-implementation-program))
+ :machine (:instance ,(machine-instance)
+ :type ,(machine-type)
+ :version ,(machine-version))
+ :features ,(features-for-emacs)
+ :modules ,*modules*
+ :package (:name ,(package-name *package*)
+ :prompt ,(package-string-for-prompt *package*))
+ :version ,*swank-wire-protocol-version*)))
+
+(defun debug-on-swank-error ()
+ (assert (eq *debug-on-swank-protocol-error* *debug-swank-backend*))
+ *debug-on-swank-protocol-error*)
+
+(defun (setf debug-on-swank-error) (new-value)
+ (setf *debug-on-swank-protocol-error* new-value)
+ (setf *debug-swank-backend* new-value))
+
+(defslimefun toggle-debug-on-swank-error ()
+ (setf (debug-on-swank-error) (not (debug-on-swank-error))))
+
+
+;;;; Reading and printing
+
+(define-special *buffer-package*
+ "Package corresponding to slime-buffer-package.
+
+EVAL-FOR-EMACS binds *buffer-package*. Strings originating from a slime
+buffer are best read in this package. See also FROM-STRING and TO-STRING.")
+
+(define-special *buffer-readtable*
+ "Readtable associated with the current buffer")
+
+(defmacro with-buffer-syntax ((&optional package) &body body)
+ "Execute BODY with appropriate *package* and *readtable* bindings.
+
+This should be used for code that is conceptionally executed in an
+Emacs buffer."
+ `(call-with-buffer-syntax ,package (lambda () ,@body)))
+
+(defun call-with-buffer-syntax (package fun)
+ (let ((*package* (if package
+ (guess-buffer-package package)
+ *buffer-package*)))
+ ;; Don't shadow *readtable* unnecessarily because that prevents
+ ;; the user from assigning to it.
+ (if (eq *readtable* *buffer-readtable*)
+ (call-with-syntax-hooks fun)
+ (let ((*readtable* *buffer-readtable*))
+ (call-with-syntax-hooks fun)))))
+
+(defmacro without-printing-errors ((&key object stream
+ (msg "<<error printing object>>"))
+ &body body)
+ "Catches errors during evaluation of BODY and prints MSG instead."
+ `(handler-case (progn ,@body)
+ (serious-condition ()
+ ,(cond ((and stream object)
+ (let ((gstream (gensym "STREAM+")))
+ `(let ((,gstream ,stream))
+ (print-unreadable-object (,object ,gstream :type t
+ :identity t)
+ (write-string ,msg ,gstream)))))
+ (stream
+ `(write-string ,msg ,stream))
+ (object
+ `(with-output-to-string (s)
+ (print-unreadable-object (,object s :type t :identity t)
+ (write-string ,msg s))))
+ (t msg)))))
+
+(defun to-string (object)
+ "Write OBJECT in the *BUFFER-PACKAGE*.
+The result may not be readable. Handles problems with PRINT-OBJECT methods
+gracefully."
+ (with-buffer-syntax ()
+ (let ((*print-readably* nil))
+ (without-printing-errors (:object object :stream nil)
+ (prin1-to-string object)))))
+
+(defun from-string (string)
+ "Read string in the *BUFFER-PACKAGE*"
+ (with-buffer-syntax ()
+ (let ((*read-suppress* nil))
+ (values (read-from-string string)))))
+
+(defun parse-string (string package)
+ "Read STRING in PACKAGE."
+ (with-buffer-syntax (package)
+ (let ((*read-suppress* nil))
+ (read-from-string string))))
+
+;; FIXME: deal with #\| etc. hard to do portably.
+(defun tokenize-symbol (string)
+ "STRING is interpreted as the string representation of a symbol
+and is tokenized accordingly. The result is returned in three
+values: The package identifier part, the actual symbol identifier
+part, and a flag if the STRING represents a symbol that is
+internal to the package identifier part. (Notice that the flag is
+also true with an empty package identifier part, as the STRING is
+considered to represent a symbol internal to some current package.)"
+ (let ((package (let ((pos (position #\: string)))
+ (if pos (subseq string 0 pos) nil)))
+ (symbol (let ((pos (position #\: string :from-end t)))
+ (if pos (subseq string (1+ pos)) string)))
+ (internp (not (= (count #\: string) 1))))
+ (values symbol package internp)))
+
+(defun tokenize-symbol-thoroughly (string)
+ "This version of TOKENIZE-SYMBOL handles escape characters."
+ (let ((package nil)
+ (token (make-array (length string) :element-type 'character
+ :fill-pointer 0))
+ (backslash nil)
+ (vertical nil)
+ (internp nil))
+ (loop for char across string do
+ (cond
+ (backslash
+ (vector-push-extend char token)
+ (setq backslash nil))
+ ((char= char #\\) ; Quotes next character, even within |...|
+ (setq backslash t))
+ ((char= char #\|)
+ (setq vertical (not vertical)))
+ (vertical
+ (vector-push-extend char token))
+ ((char= char #\:)
+ (cond ((and package internp)
+ (return-from tokenize-symbol-thoroughly))
+ (package
+ (setq internp t))
+ (t
+ (setq package token
+ token (make-array (length string)
+ :element-type 'character
+ :fill-pointer 0)))))
+ (t
+ (vector-push-extend (casify-char char) token))))
+ (unless vertical
+ (values token package (or (not package) internp)))))
+
+(defun untokenize-symbol (package-name internal-p symbol-name)
+ "The inverse of TOKENIZE-SYMBOL.
+
+ (untokenize-symbol \"quux\" nil \"foo\") ==> \"quux:foo\"
+ (untokenize-symbol \"quux\" t \"foo\") ==> \"quux::foo\"
+ (untokenize-symbol nil nil \"foo\") ==> \"foo\"
+"
+ (cond ((not package-name) symbol-name)
+ (internal-p (cat package-name "::" symbol-name))
+ (t (cat package-name ":" symbol-name))))
+
+(defun casify-char (char)
+ "Convert CHAR accoring to readtable-case."
+ (ecase (readtable-case *readtable*)
+ (:preserve char)
+ (:upcase (char-upcase char))
+ (:downcase (char-downcase char))
+ (:invert (if (upper-case-p char)
+ (char-downcase char)
+ (char-upcase char)))))
+
+
+(defun find-symbol-with-status (symbol-name status
+ &optional (package *package*))
+ (multiple-value-bind (symbol flag) (find-symbol symbol-name package)
+ (if (and flag (eq flag status))
+ (values symbol flag)
+ (values nil nil))))
+
+(defun parse-symbol (string &optional (package *package*))
+ "Find the symbol named STRING.
+Return the symbol and a flag indicating whether the symbols was found."
+ (multiple-value-bind (sname pname internalp)
+ (tokenize-symbol-thoroughly string)
+ (when sname
+ (let ((package (cond ((string= pname "") keyword-package)
+ (pname (find-package pname))
+ (t package))))
+ (if package
+ (multiple-value-bind (symbol flag)
+ (if internalp
+ (find-symbol sname package)
+ (find-symbol-with-status sname ':external package))
+ (values symbol flag sname package))
+ (values nil nil nil nil))))))
+
+(defun parse-symbol-or-lose (string &optional (package *package*))
+ (multiple-value-bind (symbol status) (parse-symbol string package)
+ (if status
+ (values symbol status)
+ (error "Unknown symbol: ~A [in ~A]" string package))))
+
+(defun parse-package (string)
+ "Find the package named STRING.
+Return the package or nil."
+ ;; STRING comes usually from a (in-package STRING) form.
+ (ignore-errors
+ (find-package (let ((*package* *swank-io-package*))
+ (read-from-string string)))))
+
+(defun unparse-name (string)
+ "Print the name STRING according to the current printer settings."
+ ;; this is intended for package or symbol names
+ (subseq (prin1-to-string (make-symbol string)) 2))
+
+(defun guess-package (string)
+ "Guess which package corresponds to STRING.
+Return nil if no package matches."
+ (when string
+ (or (find-package string)
+ (parse-package string)
+ (if (find #\! string) ; for SBCL
+ (guess-package (substitute #\- #\! string))))))
+
+(defvar *readtable-alist* (default-readtable-alist)
+ "An alist mapping package names to readtables.")
+
+(defun guess-buffer-readtable (package-name)
+ (let ((package (guess-package package-name)))
+ (or (and package
+ (cdr (assoc (package-name package) *readtable-alist*
+ :test #'string=)))
+ *readtable*)))
+
+
+;;;; Evaluation
+
+(defvar *pending-continuations* '()
+ "List of continuations for Emacs. (thread local)")
+
+(defun guess-buffer-package (string)
+ "Return a package for STRING.
+Fall back to the current if no such package exists."
+ (or (and string (guess-package string))
+ *package*))
+
+(defun eval-for-emacs (form buffer-package id)
+ "Bind *BUFFER-PACKAGE* to BUFFER-PACKAGE and evaluate FORM.
+Return the result to the continuation ID.
+Errors are trapped and invoke our debugger."
+ (let (ok result condition)
+ (unwind-protect
+ (let ((*buffer-package* (guess-buffer-package buffer-package))
+ (*buffer-readtable* (guess-buffer-readtable buffer-package))
+ (*pending-continuations* (cons id *pending-continuations*)))
+ (check-type *buffer-package* package)
+ (check-type *buffer-readtable* readtable)
+ ;; APPLY would be cleaner than EVAL.
+ ;; (setq result (apply (car form) (cdr form)))
+ (handler-bind ((t (lambda (c) (setf condition c))))
+ (setq result (with-slime-interrupts (eval form))))
+ (run-hook *pre-reply-hook*)
+ (setq ok t))
+ (send-to-emacs `(:return ,(current-thread)
+ ,(if ok
+ `(:ok ,result)
+ `(:abort ,(prin1-to-string condition)))
+ ,id)))))
+
+(defvar *echo-area-prefix* "=> "
+ "A prefix that `format-values-for-echo-area' should use.")
+
+(defun format-values-for-echo-area (values)
+ (with-buffer-syntax ()
+ (let ((*print-readably* nil))
+ (cond ((null values) "; No value")
+ ((and (integerp (car values)) (null (cdr values)))
+ (let ((i (car values)))
+ (format nil "~A~D (~a bit~:p, #x~X, #o~O, #b~B)"
+ *echo-area-prefix*
+ i (integer-length i) i i i)))
+ ((and (typep (car values) 'ratio)
+ (null (cdr values))
+ (ignore-errors
+ ;; The ratio may be to large to be represented as a single float
+ (format nil "~A~D (~:*~f)"
+ *echo-area-prefix*
+ (car values)))))
+ (t (format nil "~a~{~S~^, ~}" *echo-area-prefix* values))))))
+
+(defmacro values-to-string (values)
+ `(format-values-for-echo-area (multiple-value-list ,values)))
+
+(defslimefun interactive-eval (string)
+ (with-buffer-syntax ()
+ (with-retry-restart (:msg "Retry SLIME interactive evaluation request.")
+ (let ((values (multiple-value-list (eval (from-string string)))))
+ (finish-output)
+ (format-values-for-echo-area values)))))
+
+(defslimefun eval-and-grab-output (string)
+ (with-buffer-syntax ()
+ (with-retry-restart (:msg "Retry SLIME evaluation request.")
+ (let* ((s (make-string-output-stream))
+ (*standard-output* s)
+ (values (multiple-value-list (eval (from-string string)))))
+ (list (get-output-stream-string s)
+ (format nil "~{~S~^~%~}" values))))))
+
+(defun eval-region (string)
+ "Evaluate STRING.
+Return the results of the last form as a list and as secondary value the
+last form."
+ (with-input-from-string (stream string)
+ (let (- values)
+ (loop
+ (let ((form (read stream nil stream)))
+ (when (eq form stream)
+ (finish-output)
+ (return (values values -)))
+ (setq - form)
+ (setq values (multiple-value-list (eval form)))
+ (finish-output))))))
+
+(defslimefun interactive-eval-region (string)
+ (with-buffer-syntax ()
+ (with-retry-restart (:msg "Retry SLIME interactive evaluation request.")
+ (format-values-for-echo-area (eval-region string)))))
+
+(defslimefun re-evaluate-defvar (form)
+ (with-buffer-syntax ()
+ (with-retry-restart (:msg "Retry SLIME evaluation request.")
+ (let ((form (read-from-string form)))
+ (destructuring-bind (dv name &optional value doc) form
+ (declare (ignore value doc))
+ (assert (eq dv 'defvar))
+ (makunbound name)
+ (prin1-to-string (eval form)))))))
+
+(defvar *swank-pprint-bindings*
+ `((*print-pretty* . t)
+ (*print-level* . nil)
+ (*print-length* . nil)
+ (*print-circle* . t)
+ (*print-gensym* . t)
+ (*print-readably* . nil))
+ "A list of variables bindings during pretty printing.
+Used by pprint-eval.")
+
+(defun swank-pprint (values)
+ "Bind some printer variables and pretty print each object in VALUES."
+ (with-buffer-syntax ()
+ (with-bindings *swank-pprint-bindings*
+ (cond ((null values) "; No value")
+ (t (with-output-to-string (*standard-output*)
+ (dolist (o values)
+ (pprint o)
+ (terpri))))))))
+
+(defslimefun pprint-eval (string)
+ (with-buffer-syntax ()
+ (let* ((s (make-string-output-stream))
+ (values
+ (let ((*standard-output* s)
+ (*trace-output* s))
+ (multiple-value-list (eval (read-from-string string))))))
+ (cat (get-output-stream-string s)
+ (swank-pprint values)))))
+
+(defslimefun set-package (name)
+ "Set *package* to the package named NAME.
+Return the full package-name and the string to use in the prompt."
+ (let ((p (guess-package name)))
+ (assert (packagep p) nil "Package ~a doesn't exist." name)
+ (setq *package* p)
+ (list (package-name p) (package-string-for-prompt p))))
+
+(defun cat (&rest strings)
+ "Concatenate all arguments and make the result a string."
+ (with-output-to-string (out)
+ (dolist (s strings)
+ (etypecase s
+ (string (write-string s out))
+ (character (write-char s out))))))
+
+(defun truncate-string (string width &optional ellipsis)
+ (let ((len (length string)))
+ (cond ((< len width) string)
+ (ellipsis (cat (subseq string 0 width) ellipsis))
+ (t (subseq string 0 width)))))
+
+(defun call/truncated-output-to-string (length function
+ &optional (ellipsis ".."))
+ "Call FUNCTION with a new stream, return the output written to the stream.
+If FUNCTION tries to write more than LENGTH characters, it will be
+aborted and return immediately with the output written so far."
+ (let ((buffer (make-string (+ length (length ellipsis))))
+ (fill-pointer 0))
+ (block buffer-full
+ (flet ((write-output (string)
+ (let* ((free (- length fill-pointer))
+ (count (min free (length string))))
+ (replace buffer string :start1 fill-pointer :end2 count)
+ (incf fill-pointer count)
+ (when (> (length string) free)
+ (replace buffer ellipsis :start1 fill-pointer)
+ (return-from buffer-full buffer)))))
+ (let ((stream (make-output-stream #'write-output)))
+ (funcall function stream)
+ (finish-output stream)
+ (subseq buffer 0 fill-pointer))))))
+
+(defmacro with-string-stream ((var &key length bindings)
+ &body body)
+ (cond ((and (not bindings) (not length))
+ `(with-output-to-string (,var) . ,body))
+ ((not bindings)
+ `(call/truncated-output-to-string
+ ,length (lambda (,var) . ,body)))
+ (t
+ `(with-bindings ,bindings
+ (with-string-stream (,var :length ,length)
+ . ,body)))))
+
+(defun to-line (object &optional width)
+ "Print OBJECT to a single line. Return the string."
+ (let ((width (or width 512)))
+ (without-printing-errors (:object object :stream nil)
+ (with-string-stream (stream :length width)
+ (write object :stream stream :right-margin width :lines 1)))))
+
+(defun escape-string (string stream &key length (map '((#\" . "\\\"")
+ (#\\ . "\\\\"))))
+ "Write STRING to STREAM surronded by double-quotes.
+LENGTH -- if non-nil truncate output after LENGTH chars.
+MAP -- rewrite the chars in STRING according to this alist."
+ (let ((limit (or length array-dimension-limit)))
+ (write-char #\" stream)
+ (loop for c across string
+ for i from 0 do
+ (when (= i limit)
+ (write-string "..." stream)
+ (return))
+ (let ((probe (assoc c map)))
+ (cond (probe (write-string (cdr probe) stream))
+ (t (write-char c stream)))))
+ (write-char #\" stream)))
+
+
+;;;; Prompt
+
+;; FIXME: do we really need 45 lines of code just to figure out the
+;; prompt?
+
+(defvar *canonical-package-nicknames*
+ `((:common-lisp-user . :cl-user))
+ "Canonical package names to use instead of shortest name/nickname.")
+
+(defvar *auto-abbreviate-dotted-packages* t
+ "Abbreviate dotted package names to their last component if T.")
+
+(defun package-string-for-prompt (package)
+ "Return the shortest nickname (or canonical name) of PACKAGE."
+ (unparse-name
+ (or (canonical-package-nickname package)
+ (auto-abbreviated-package-name package)
+ (shortest-package-nickname package))))
+
+(defun canonical-package-nickname (package)
+ "Return the canonical package nickname, if any, of PACKAGE."
+ (let ((name (cdr (assoc (package-name package) *canonical-package-nicknames*
+ :test #'string=))))
+ (and name (string name))))
+
+(defun auto-abbreviated-package-name (package)
+ "Return an abbreviated 'name' for PACKAGE.
+
+N.B. this is not an actual package name or nickname."
+ (when *auto-abbreviate-dotted-packages*
+ (loop with package-name = (package-name package)
+ with offset = nil
+ do (let ((last-dot-pos (position #\. package-name :end offset
+ :from-end t)))
+ (unless last-dot-pos
+ (return nil))
+ ;; If a dot chunk contains only numbers, that chunk most
+ ;; likely represents a version number; so we collect the
+ ;; next chunks, too, until we find one with meat.
+ (let ((name (subseq package-name (1+ last-dot-pos) offset)))
+ (if (notevery #'digit-char-p name)
+ (return (subseq package-name (1+ last-dot-pos)))
+ (setq offset last-dot-pos)))))))
+
+(defun shortest-package-nickname (package)
+ "Return the shortest nickname of PACKAGE."
+ (loop for name in (cons (package-name package) (package-nicknames package))
+ for shortest = name then (if (< (length name) (length shortest))
+ name
+ shortest)
+ finally (return shortest)))
+
+
+
+(defslimefun ed-in-emacs (&optional what)
+ "Edit WHAT in Emacs.
+
+WHAT can be:
+ A pathname or a string,
+ A list (PATHNAME-OR-STRING &key LINE COLUMN POSITION),
+ A function name (symbol or cons),
+ NIL. "
+ (flet ((canonicalize-filename (filename)
+ (pathname-to-filename (or (probe-file filename) filename))))
+ (let ((target
+ (etypecase what
+ (null nil)
+ ((or string pathname)
+ `(:filename ,(canonicalize-filename what)))
+ ((cons (or string pathname) *)
+ `(:filename ,(canonicalize-filename (car what)) ,@(cdr what)))
+ ((or symbol cons)
+ `(:function-name ,(prin1-to-string what))))))
+ (cond (*emacs-connection* (send-oob-to-emacs `(:ed ,target)))
+ ((default-connection)
+ (with-connection ((default-connection))
+ (send-oob-to-emacs `(:ed ,target))))
+ (t (error "No connection"))))))
+
+(defslimefun inspect-in-emacs (what &key wait)
+ "Inspect WHAT in Emacs. If WAIT is true (default NIL) blocks until the
+inspector has been closed in Emacs."
+ (flet ((send-it ()
+ (let ((tag (when wait (make-tag)))
+ (thread (when wait (current-thread-id))))
+ (with-buffer-syntax ()
+ (reset-inspector)
+ (send-oob-to-emacs `(:inspect ,(inspect-object what)
+ ,thread
+ ,tag)))
+ (when wait
+ (wait-for-event `(:emacs-return ,tag result))))))
+ (cond
+ (*emacs-connection*
+ (send-it))
+ ((default-connection)
+ (with-connection ((default-connection))
+ (send-it))))
+ what))
+
+(defslimefun value-for-editing (form)
+ "Return a readable value of FORM for editing in Emacs.
+FORM is expected, but not required, to be SETF'able."
+ ;; FIXME: Can we check FORM for setfability? -luke (12/Mar/2005)
+ (with-buffer-syntax ()
+ (let* ((value (eval (read-from-string form)))
+ (*print-length* nil))
+ (prin1-to-string value))))
+
+(defslimefun commit-edited-value (form value)
+ "Set the value of a setf'able FORM to VALUE.
+FORM and VALUE are both strings from Emacs."
+ (with-buffer-syntax ()
+ (eval `(setf ,(read-from-string form)
+ ,(read-from-string (concatenate 'string "`" value))))
+ t))
+
+(defun background-message (format-string &rest args)
+ "Display a message in Emacs' echo area.
+
+Use this function for informative messages only. The message may even
+be dropped if we are too busy with other things."
+ (when *emacs-connection*
+ (send-to-emacs `(:background-message
+ ,(apply #'format nil format-string args)))))
+
+;; This is only used by the test suite.
+(defun sleep-for (seconds)
+ "Sleep for at least SECONDS seconds.
+This is just like cl:sleep but guarantees to sleep
+at least SECONDS."
+ (let* ((start (get-internal-real-time))
+ (end (+ start
+ (* seconds internal-time-units-per-second))))
+ (loop
+ (let ((now (get-internal-real-time)))
+ (cond ((< end now) (return))
+ (t (sleep (/ (- end now)
+ internal-time-units-per-second))))))))
+
+
+;;;; Debugger
+
+(defun invoke-slime-debugger (condition)
+ "Sends a message to Emacs declaring that the debugger has been entered,
+then waits to handle further requests from Emacs. Eventually returns
+after Emacs causes a restart to be invoked."
+ (without-slime-interrupts
+ (cond (*emacs-connection*
+ (debug-in-emacs condition))
+ ((default-connection)
+ (with-connection ((default-connection))
+ (debug-in-emacs condition))))))
+
+(define-condition invoke-default-debugger () ())
+
+(defun swank-debugger-hook (condition hook)
+ "Debugger function for binding *DEBUGGER-HOOK*."
+ (declare (ignore hook))
+ (handler-case
+ (call-with-debugger-hook #'swank-debugger-hook
+ (lambda () (invoke-slime-debugger condition)))
+ (invoke-default-debugger ()
+ (invoke-default-debugger condition))))
+
+(defun invoke-default-debugger (condition)
+ (call-with-debugger-hook nil (lambda () (invoke-debugger condition))))
+
+(defvar *global-debugger* t
+ "Non-nil means the Swank debugger hook will be installed globally.")
+
+(add-hook *new-connection-hook* 'install-debugger)
+(defun install-debugger (connection)
+ (declare (ignore connection))
+ (when *global-debugger*
+ (install-debugger-globally #'swank-debugger-hook)))
+
+;;;;; Debugger loop
+;;;
+;;; These variables are dynamically bound during debugging.
+;;;
+(defvar *swank-debugger-condition* nil
+ "The condition being debugged.")
+
+(defvar *sldb-level* 0
+ "The current level of recursive debugging.")
+
+(defvar *sldb-initial-frames* 20
+ "The initial number of backtrace frames to send to Emacs.")
+
+(defvar *sldb-restarts* nil
+ "The list of currenlty active restarts.")
+
+(defvar *sldb-stepping-p* nil
+ "True during execution of a step command.")
+
+(defun debug-in-emacs (condition)
+ (let ((*swank-debugger-condition* condition)
+ (*sldb-restarts* (compute-restarts condition))
+ (*sldb-quit-restart* (and *sldb-quit-restart*
+ (find-restart *sldb-quit-restart*)))
+ (*package* (or (and (boundp '*buffer-package*)
+ (symbol-value '*buffer-package*))
+ *package*))
+ (*sldb-level* (1+ *sldb-level*))
+ (*sldb-stepping-p* nil))
+ (force-user-output)
+ (call-with-debugging-environment
+ (lambda ()
+ (sldb-loop *sldb-level*)))))
+
+(defun sldb-loop (level)
+ (unwind-protect
+ (loop
+ (with-simple-restart (abort "Return to sldb level ~D." level)
+ (send-to-emacs
+ (list* :debug (current-thread-id) level
+ (debugger-info-for-emacs 0 *sldb-initial-frames*)))
+ (send-to-emacs
+ (list :debug-activate (current-thread-id) level nil))
+ (loop
+ (handler-case
+ (dcase (wait-for-event
+ `(or (:emacs-rex . _)
+ (:sldb-return ,(1+ level))))
+ ((:emacs-rex &rest args) (apply #'eval-for-emacs args))
+ ((:sldb-return _) (declare (ignore _)) (return nil)))
+ (sldb-condition (c)
+ (handle-sldb-condition c))))))
+ (send-to-emacs `(:debug-return
+ ,(current-thread-id) ,level ,*sldb-stepping-p*))
+ (wait-for-event `(:sldb-return ,(1+ level)) t) ; clean event-queue
+ (when (> level 1)
+ (send-event (current-thread) `(:sldb-return ,level)))))
+
+(defun handle-sldb-condition (condition)
+ "Handle an internal debugger condition.
+Rather than recursively debug the debugger (a dangerous idea!), these
+conditions are simply reported."
+ (let ((real-condition (original-condition condition)))
+ (send-to-emacs `(:debug-condition ,(current-thread-id)
+ ,(princ-to-string real-condition)))))
+
+(defun %%condition-message (condition)
+ (let ((limit (ash 1 16)))
+ (with-string-stream (stream :length limit)
+ (handler-case
+ (let ((*print-readably* nil)
+ (*print-pretty* t)
+ (*print-right-margin* 65)
+ (*print-circle* t)
+ (*print-length* (or *print-length* limit))
+ (*print-level* (or *print-level* limit))
+ (*print-lines* (or *print-lines* limit)))
+ (print-condition condition stream))
+ (serious-condition (c)
+ (ignore-errors
+ (with-standard-io-syntax
+ (let ((*print-readably* nil))
+ (format stream "~&Error (~a) during printing: " (type-of c))
+ (print-unreadable-object (condition stream :type t
+ :identity t))))))))))
+
+(defun %condition-message (condition)
+ (string-trim #(#\newline #\space #\tab)
+ (%%condition-message condition)))
+
+(defvar *sldb-condition-printer* #'%condition-message
+ "Function called to print a condition to an SLDB buffer.")
+
+(defun safe-condition-message (condition)
+ "Print condition to a string, handling any errors during printing."
+ (funcall *sldb-condition-printer* condition))
+
+(defun debugger-condition-for-emacs ()
+ (list (safe-condition-message *swank-debugger-condition*)
+ (format nil " [Condition of type ~S]"
+ (type-of *swank-debugger-condition*))
+ (condition-extras *swank-debugger-condition*)))
+
+(defun format-restarts-for-emacs ()
+ "Return a list of restarts for *swank-debugger-condition* in a
+format suitable for Emacs."
+ (let ((*print-right-margin* most-positive-fixnum))
+ (loop for restart in *sldb-restarts* collect
+ (list (format nil "~:[~;*~]~a"
+ (eq restart *sldb-quit-restart*)
+ (restart-name restart))
+ (with-output-to-string (stream)
+ (without-printing-errors (:object restart
+ :stream stream
+ :msg "<<error printing restart>>")
+ (princ restart stream)))))))
+
+;;;;; SLDB entry points
+
+(defslimefun sldb-break-with-default-debugger (dont-unwind)
+ "Invoke the default debugger."
+ (cond (dont-unwind
+ (invoke-default-debugger *swank-debugger-condition*))
+ (t
+ (signal 'invoke-default-debugger))))
+
+(defslimefun backtrace (start end)
+ "Return a list ((I FRAME PLIST) ...) of frames from START to END.
+
+I is an integer, and can be used to reference the corresponding frame
+from Emacs; FRAME is a string representation of an implementation's
+frame."
+ (loop for frame in (compute-backtrace start end)
+ for i from start collect
+ (list* i (frame-to-string frame)
+ (ecase (frame-restartable-p frame)
+ ((nil) nil)
+ ((t) `((:restartable t)))))))
+
+(defun frame-to-string (frame)
+ (with-string-stream (stream :length (* (or *print-lines* 1)
+ (or *print-right-margin* 100))
+ :bindings *backtrace-printer-bindings*)
+ (handler-case (print-frame frame stream)
+ (serious-condition ()
+ (format stream "[error printing frame]")))))
+
+(defslimefun debugger-info-for-emacs (start end)
+ "Return debugger state, with stack frames from START to END.
+The result is a list:
+ (condition ({restart}*) ({stack-frame}*) (cont*))
+where
+ condition ::= (description type [extra])
+ restart ::= (name description)
+ stack-frame ::= (number description [plist])
+ extra ::= (:references and other random things)
+ cont ::= continutation
+ plist ::= (:restartable {nil | t | :unknown})
+
+condition---a pair of strings: message, and type. If show-source is
+not nil it is a frame number for which the source should be displayed.
+
+restart---a pair of strings: restart name, and description.
+
+stack-frame---a number from zero (the top), and a printed
+representation of the frame's call.
+
+continutation---the id of a pending Emacs continuation.
+
+Below is an example return value. In this case the condition was a
+division by zero (multi-line description), and only one frame is being
+fetched (start=0, end=1).
+
+ ((\"Arithmetic error DIVISION-BY-ZERO signalled.
+Operation was KERNEL::DIVISION, operands (1 0).\"
+ \"[Condition of type DIVISION-BY-ZERO]\")
+ ((\"ABORT\" \"Return to Slime toplevel.\")
+ (\"ABORT\" \"Return to Top-Level.\"))
+ ((0 \"(KERNEL::INTEGER-/-INTEGER 1 0)\" (:restartable nil)))
+ (4))"
+ (list (debugger-condition-for-emacs)
+ (format-restarts-for-emacs)
+ (backtrace start end)
+ *pending-continuations*))
+
+(defun nth-restart (index)
+ (nth index *sldb-restarts*))
+
+(defslimefun invoke-nth-restart (index)
+ (let ((restart (nth-restart index)))
+ (when restart
+ (invoke-restart-interactively restart))))
+
+(defslimefun sldb-abort ()
+ (invoke-restart (find 'abort *sldb-restarts* :key #'restart-name)))
+
+(defslimefun sldb-continue ()
+ (continue))
+
+(defun coerce-to-condition (datum args)
+ (etypecase datum
+ (string (make-condition 'simple-error :format-control datum
+ :format-arguments args))
+ (symbol (apply #'make-condition datum args))))
+
+(defslimefun simple-break (&optional (datum "Interrupt from Emacs") &rest args)
+ (with-simple-restart (continue "Continue from break.")
+ (invoke-slime-debugger (coerce-to-condition datum args))))
+
+;; FIXME: (last (compute-restarts)) looks dubious.
+(defslimefun throw-to-toplevel ()
+ "Invoke the ABORT-REQUEST restart abort an RPC from Emacs.
+If we are not evaluating an RPC then ABORT instead."
+ (let ((restart (or (and *sldb-quit-restart*
+ (find-restart *sldb-quit-restart*))
+ (car (last (compute-restarts))))))
+ (cond (restart (invoke-restart restart))
+ (t (format nil "Restart not active [~s]" *sldb-quit-restart*)))))
+
+(defslimefun invoke-nth-restart-for-emacs (sldb-level n)
+ "Invoke the Nth available restart.
+SLDB-LEVEL is the debug level when the request was made. If this
+has changed, ignore the request."
+ (when (= sldb-level *sldb-level*)
+ (invoke-nth-restart n)))
+
+(defun wrap-sldb-vars (form)
+ `(let ((*sldb-level* ,*sldb-level*))
+ ,form))
+
+(defun eval-in-frame-aux (frame string package print)
+ (let* ((form (wrap-sldb-vars (parse-string string package)))
+ (values (multiple-value-list (eval-in-frame form frame))))
+ (with-buffer-syntax (package)
+ (funcall print values))))
+
+(defslimefun eval-string-in-frame (string frame package)
+ (eval-in-frame-aux frame string package #'format-values-for-echo-area))
+
+(defslimefun pprint-eval-string-in-frame (string frame package)
+ (eval-in-frame-aux frame string package #'swank-pprint))
+
+(defslimefun frame-package-name (frame)
+ (let ((pkg (frame-package frame)))
+ (cond (pkg (package-name pkg))
+ (t (with-buffer-syntax () (package-name *package*))))))
+
+(defslimefun frame-locals-and-catch-tags (index)
+ "Return a list (LOCALS TAGS) for vars and catch tags in the frame INDEX.
+LOCALS is a list of the form ((&key NAME ID VALUE) ...).
+TAGS has is a list of strings."
+ (list (frame-locals-for-emacs index)
+ (mapcar #'to-string (frame-catch-tags index))))
+
+(defun frame-locals-for-emacs (index)
+ (with-bindings *backtrace-printer-bindings*
+ (loop for var in (frame-locals index) collect
+ (destructuring-bind (&key name id value) var
+ (list :name (let ((*package* (or (frame-package index) *package*)))
+ (prin1-to-string name))
+ :id id
+ :value (to-line value *print-right-margin*))))))
+
+(defslimefun sldb-disassemble (index)
+ (with-output-to-string (*standard-output*)
+ (disassemble-frame index)))
+
+(defslimefun sldb-return-from-frame (index string)
+ (let ((form (from-string string)))
+ (to-string (multiple-value-list (return-from-frame index form)))))
+
+(defslimefun sldb-break (name)
+ (with-buffer-syntax ()
+ (sldb-break-at-start (read-from-string name))))
+
+(defmacro define-stepper-function (name backend-function-name)
+ `(defslimefun ,name (frame)
+ (cond ((sldb-stepper-condition-p *swank-debugger-condition*)
+ (setq *sldb-stepping-p* t)
+ (,backend-function-name))
+ ((find-restart 'continue)
+ (activate-stepping frame)
+ (setq *sldb-stepping-p* t)
+ (continue))
+ (t
+ (error "Not currently single-stepping, ~
+and no continue restart available.")))))
+
+(define-stepper-function sldb-step sldb-step-into)
+(define-stepper-function sldb-next sldb-step-next)
+(define-stepper-function sldb-out sldb-step-out)
+
+(defslimefun toggle-break-on-signals ()
+ (setq *break-on-signals* (not *break-on-signals*))
+ (format nil "*break-on-signals* = ~a" *break-on-signals*))
+
+(defslimefun sdlb-print-condition ()
+ (princ-to-string *swank-debugger-condition*))
+
+
+;;;; Compilation Commands.
+
+(defstruct (:compilation-result
+ (:type list) :named)
+ notes
+ (successp nil :type boolean)
+ (duration 0.0 :type float)
+ (loadp nil :type boolean)
+ (faslfile nil :type (or null string)))
+
+(defun measure-time-interval (fun)
+ "Call FUN and return the first return value and the elapsed time.
+The time is measured in seconds."
+ (declare (type function fun))
+ (let ((before (get-internal-real-time)))
+ (values
+ (funcall fun)
+ (/ (- (get-internal-real-time) before)
+ (coerce internal-time-units-per-second 'float)))))
+
+(defun make-compiler-note (condition)
+ "Make a compiler note data structure from a compiler-condition."
+ (declare (type compiler-condition condition))
+ (list* :message (message condition)
+ :severity (severity condition)
+ :location (location condition)
+ :references (references condition)
+ (let ((s (source-context condition)))
+ (if s (list :source-context s)))))
+
+(defun collect-notes (function)
+ (let ((notes '()))
+ (multiple-value-bind (result seconds)
+ (handler-bind ((compiler-condition
+ (lambda (c) (push (make-compiler-note c) notes))))
+ (measure-time-interval
+ (lambda ()
+ ;; To report location of error-signaling toplevel forms
+ ;; for errors in EVAL-WHEN or during macroexpansion.
+ (restart-case (multiple-value-list (funcall function))
+ (abort () :report "Abort compilation." (list nil))))))
+ (destructuring-bind (successp &optional loadp faslfile) result
+ (let ((faslfile (etypecase faslfile
+ (null nil)
+ (pathname (pathname-to-filename faslfile)))))
+ (make-compilation-result :notes (reverse notes)
+ :duration seconds
+ :successp (if successp t)
+ :loadp (if loadp t)
+ :faslfile faslfile))))))
+
+(defun swank-compile-file* (pathname load-p &rest options &key policy
+ &allow-other-keys)
+ (multiple-value-bind (output-pathname warnings? failure?)
+ (swank-compile-file pathname
+ (fasl-pathname pathname options)
+ nil
+ (or (guess-external-format pathname)
+ :default)
+ :policy policy)
+ (declare (ignore warnings?))
+ (values t (not failure?) load-p output-pathname)))
+
+(defvar *compile-file-for-emacs-hook* '(swank-compile-file*))
+
+(defslimefun compile-file-for-emacs (filename load-p &rest options)
+ "Compile FILENAME and, when LOAD-P, load the result.
+Record compiler notes signalled as `compiler-condition's."
+ (with-buffer-syntax ()
+ (collect-notes
+ (lambda ()
+ (let ((pathname (filename-to-pathname filename))
+ (*compile-print* nil)
+ (*compile-verbose* t))
+ (loop for hook in *compile-file-for-emacs-hook*
+ do
+ (multiple-value-bind (tried success load? output-pathname)
+ (apply hook pathname load-p options)
+ (when tried
+ (return (values success load? output-pathname))))))))))
+
+;; FIXME: now that *compile-file-for-emacs-hook* is there this is
+;; redundant and confusing.
+(defvar *fasl-pathname-function* nil
+ "In non-nil, use this function to compute the name for fasl-files.")
+
+(defun pathname-as-directory (pathname)
+ (append (pathname-directory pathname)
+ (when (pathname-name pathname)
+ (list (file-namestring pathname)))))
+
+(defun compile-file-output (file directory)
+ (make-pathname :directory (pathname-as-directory directory)
+ :defaults (compile-file-pathname file)))
+
+(defun fasl-pathname (input-file options)
+ (cond (*fasl-pathname-function*
+ (funcall *fasl-pathname-function* input-file options))
+ ((getf options :fasl-directory)
+ (let ((dir (getf options :fasl-directory)))
+ (assert (char= (aref dir (1- (length dir))) #\/))
+ (compile-file-output input-file dir)))
+ (t
+ (compile-file-pathname input-file))))
+
+(defslimefun compile-string-for-emacs (string buffer position filename policy)
+ "Compile STRING (exerpted from BUFFER at POSITION).
+Record compiler notes signalled as `compiler-condition's."
+ (let ((offset (cadr (assoc :position position))))
+ (with-buffer-syntax ()
+ (collect-notes
+ (lambda ()
+ (let ((*compile-print* t) (*compile-verbose* nil))
+ (swank-compile-string string
+ :buffer buffer
+ :position offset
+ :filename filename
+ :policy policy)))))))
+
+(defslimefun compile-multiple-strings-for-emacs (strings policy)
+ "Compile STRINGS (exerpted from BUFFER at POSITION).
+Record compiler notes signalled as `compiler-condition's."
+ (loop for (string buffer package position filename) in strings collect
+ (collect-notes
+ (lambda ()
+ (with-buffer-syntax (package)
+ (let ((*compile-print* t) (*compile-verbose* nil))
+ (swank-compile-string string
+ :buffer buffer
+ :position position
+ :filename filename
+ :policy policy)))))))
+
+(defun file-newer-p (new-file old-file)
+ "Returns true if NEW-FILE is newer than OLD-FILE."
+ (> (file-write-date new-file) (file-write-date old-file)))
+
+(defun requires-compile-p (source-file)
+ (let ((fasl-file (probe-file (compile-file-pathname source-file))))
+ (or (not fasl-file)
+ (file-newer-p source-file fasl-file))))
+
+(defslimefun compile-file-if-needed (filename loadp)
+ (let ((pathname (filename-to-pathname filename)))
+ (cond ((requires-compile-p pathname)
+ (compile-file-for-emacs pathname loadp))
+ (t
+ (collect-notes
+ (lambda ()
+ (or (not loadp)
+ (load (compile-file-pathname pathname)))))))))
+
+
+;;;; Loading
+
+(defslimefun load-file (filename)
+ (to-string (load (filename-to-pathname filename))))
+
+
+;;;;; swank-require
+
+(defslimefun swank-require (modules &optional filename)
+ "Load the module MODULE."
+ (dolist (module (ensure-list modules))
+ (unless (member (string module) *modules* :test #'string=)
+ (require module (if filename
+ (filename-to-pathname filename)
+ (module-filename module)))
+ (assert (member (string module) *modules* :test #'string=)
+ () "Required module ~s was not provided" module)))
+ *modules*)
+
+(defvar *find-module* 'find-module
+ "Pluggable function to locate modules.
+The function receives a module name as argument and should return
+the filename of the module (or nil if the file doesn't exist).")
+
+(defun module-filename (module)
+ "Return the filename for the module MODULE."
+ (or (funcall *find-module* module)
+ (error "Can't locate module: ~s" module)))
+
+;;;;;; Simple *find-module* function.
+
+(defun merged-directory (dirname defaults)
+ (pathname-directory
+ (merge-pathnames
+ (make-pathname :directory `(:relative ,dirname) :defaults defaults)
+ defaults)))
+
+(defvar *load-path* '()
+ "A list of directories to search for modules.")
+
+(defun module-candidates (name dir)
+ (list (compile-file-pathname (make-pathname :name name :defaults dir))
+ (make-pathname :name name :type "lisp" :defaults dir)))
+
+(defun find-module (module)
+ (let ((name (string-downcase module)))
+ (some (lambda (dir) (some #'probe-file (module-candidates name dir)))
+ *load-path*)))
+
+
+;;;; Macroexpansion
+
+(defvar *macroexpand-printer-bindings*
+ '((*print-circle* . nil)
+ (*print-pretty* . t)
+ (*print-escape* . t)
+ (*print-lines* . nil)
+ (*print-level* . nil)
+ (*print-length* . nil)))
+
+(defun apply-macro-expander (expander string)
+ (with-buffer-syntax ()
+ (with-bindings *macroexpand-printer-bindings*
+ (prin1-to-string (funcall expander (from-string string))))))
+
+(defslimefun swank-macroexpand-1 (string)
+ (apply-macro-expander #'macroexpand-1 string))
+
+(defslimefun swank-macroexpand (string)
+ (apply-macro-expander #'macroexpand string))
+
+(defslimefun swank-macroexpand-all (string)
+ (apply-macro-expander #'macroexpand-all string))
+
+(defslimefun swank-compiler-macroexpand-1 (string)
+ (apply-macro-expander #'compiler-macroexpand-1 string))
+
+(defslimefun swank-compiler-macroexpand (string)
+ (apply-macro-expander #'compiler-macroexpand string))
+
+(defslimefun swank-expand-1 (string)
+ (apply-macro-expander #'expand-1 string))
+
+(defslimefun swank-expand (string)
+ (apply-macro-expander #'expand string))
+
+(defun expand-1 (form)
+ (multiple-value-bind (expansion expanded?) (macroexpand-1 form)
+ (if expanded?
+ (values expansion t)
+ (compiler-macroexpand-1 form))))
+
+(defun expand (form)
+ (expand-repeatedly #'expand-1 form))
+
+(defun expand-repeatedly (expander form)
+ (loop
+ (multiple-value-bind (expansion expanded?) (funcall expander form)
+ (unless expanded? (return expansion))
+ (setq form expansion))))
+
+(defslimefun swank-format-string-expand (string)
+ (apply-macro-expander #'format-string-expand string))
+
+(defslimefun disassemble-form (form)
+ (with-buffer-syntax ()
+ (with-output-to-string (*standard-output*)
+ (let ((*print-readably* nil))
+ (disassemble (eval (read-from-string form)))))))
+
+
+;;;; Simple completion
+
+(defslimefun simple-completions (prefix package)
+ "Return a list of completions for the string PREFIX."
+ (let ((strings (all-completions prefix package)))
+ (list strings (longest-common-prefix strings))))
+
+(defun all-completions (prefix package)
+ (multiple-value-bind (name pname intern) (tokenize-symbol prefix)
+ (let* ((extern (and pname (not intern)))
+ (pkg (cond ((equal pname "") keyword-package)
+ ((not pname) (guess-buffer-package package))
+ (t (guess-package pname))))
+ (test (lambda (sym) (prefix-match-p name (symbol-name sym))))
+ (syms (and pkg (matching-symbols pkg extern test)))
+ (strings (loop for sym in syms
+ for str = (unparse-symbol sym)
+ when (prefix-match-p name str) ; remove |Foo|
+ collect str)))
+ (format-completion-set strings intern pname))))
+
+(defun matching-symbols (package external test)
+ (let ((test (if external
+ (lambda (s)
+ (and (symbol-external-p s package)
+ (funcall test s)))
+ test))
+ (result '()))
+ (do-symbols (s package)
+ (when (funcall test s)
+ (push s result)))
+ (remove-duplicates result)))
+
+(defun unparse-symbol (symbol)
+ (let ((*print-case* (case (readtable-case *readtable*)
+ (:downcase :upcase)
+ (t :downcase))))
+ (unparse-name (symbol-name symbol))))
+
+(defun prefix-match-p (prefix string)
+ "Return true if PREFIX is a prefix of STRING."
+ (not (mismatch prefix string :end2 (min (length string) (length prefix))
+ :test #'char-equal)))
+
+(defun longest-common-prefix (strings)
+ "Return the longest string that is a common prefix of STRINGS."
+ (if (null strings)
+ ""
+ (flet ((common-prefix (s1 s2)
+ (let ((diff-pos (mismatch s1 s2)))
+ (if diff-pos (subseq s1 0 diff-pos) s1))))
+ (reduce #'common-prefix strings))))
+
+(defun format-completion-set (strings internal-p package-name)
+ "Format a set of completion strings.
+Returns a list of completions with package qualifiers if needed."
+ (mapcar (lambda (string) (untokenize-symbol package-name internal-p string))
+ (sort strings #'string<)))
+
+
+;;;; Simple arglist display
+
+(defslimefun operator-arglist (name package)
+ (ignore-errors
+ (let ((args (arglist (parse-symbol name (guess-buffer-package package)))))
+ (cond ((eq args :not-available) nil)
+ (t (princ-to-string (cons name args)))))))
+
+
+;;;; Documentation
+
+(defslimefun apropos-list-for-emacs (name &optional external-only
+ case-sensitive package)
+ "Make an apropos search for Emacs.
+The result is a list of property lists."
+ (let ((package (if package
+ (or (parse-package package)
+ (error "No such package: ~S" package)))))
+ ;; The MAPCAN will filter all uninteresting symbols, i.e. those
+ ;; who cannot be meaningfully described.
+ (mapcan (listify #'briefly-describe-symbol-for-emacs)
+ (sort (remove-duplicates
+ (apropos-symbols name external-only case-sensitive package))
+ #'present-symbol-before-p))))
+
+(defun briefly-describe-symbol-for-emacs (symbol)
+ "Return a property list describing SYMBOL.
+Like `describe-symbol-for-emacs' but with at most one line per item."
+ (flet ((first-line (string)
+ (let ((pos (position #\newline string)))
+ (if (null pos) string (subseq string 0 pos)))))
+ (let ((desc (map-if #'stringp #'first-line
+ (describe-symbol-for-emacs symbol))))
+ (if desc
+ (list* :designator (to-string symbol) desc)))))
+
+(defun map-if (test fn &rest lists)
+ "Like (mapcar FN . LISTS) but only call FN on objects satisfying TEST.
+Example:
+\(map-if #'oddp #'- '(1 2 3 4 5)) => (-1 2 -3 4 -5)"
+ (apply #'mapcar
+ (lambda (x) (if (funcall test x) (funcall fn x) x))
+ lists))
+
+(defun listify (f)
+ "Return a function like F, but which returns any non-null value
+wrapped in a list."
+ (lambda (x)
+ (let ((y (funcall f x)))
+ (and y (list y)))))
+
+(defun present-symbol-before-p (x y)
+ "Return true if X belongs before Y in a printed summary of symbols.
+Sorted alphabetically by package name and then symbol name, except
+that symbols accessible in the current package go first."
+ (declare (type symbol x y))
+ (flet ((accessible (s)
+ ;; Test breaks on NIL for package that does not inherit it
+ (eq (find-symbol (symbol-name s) *buffer-package*) s)))
+ (let ((ax (accessible x)) (ay (accessible y)))
+ (cond ((and ax ay) (string< (symbol-name x) (symbol-name y)))
+ (ax t)
+ (ay nil)
+ (t (let ((px (symbol-package x)) (py (symbol-package y)))
+ (if (eq px py)
+ (string< (symbol-name x) (symbol-name y))
+ (string< (package-name px) (package-name py)))))))))
+
+(defun make-apropos-matcher (pattern case-sensitive)
+ (let ((chr= (if case-sensitive #'char= #'char-equal)))
+ (lambda (symbol)
+ (search pattern (string symbol) :test chr=))))
+
+(defun apropos-symbols (string external-only case-sensitive package)
+ (let ((packages (or package (remove (find-package :keyword)
+ (list-all-packages))))
+ (matcher (make-apropos-matcher string case-sensitive))
+ (result))
+ (with-package-iterator (next packages :external :internal)
+ (loop (multiple-value-bind (morep symbol) (next)
+ (cond ((not morep) (return))
+ ((and (if external-only (symbol-external-p symbol) t)
+ (funcall matcher symbol))
+ (push symbol result))))))
+ result))
+
+(defun call-with-describe-settings (fn)
+ (let ((*print-readably* nil))
+ (funcall fn)))
+
+(defmacro with-describe-settings ((&rest _) &body body)
+ (declare (ignore _))
+ `(call-with-describe-settings (lambda () ,@body)))
+
+(defun describe-to-string (object)
+ (with-describe-settings ()
+ (with-output-to-string (*standard-output*)
+ (describe object))))
+
+(defslimefun describe-symbol (symbol-name)
+ (with-buffer-syntax ()
+ (describe-to-string (parse-symbol-or-lose symbol-name))))
+
+(defslimefun describe-function (name)
+ (with-buffer-syntax ()
+ (let ((symbol (parse-symbol-or-lose name)))
+ (describe-to-string (or (macro-function symbol)
+ (symbol-function symbol))))))
+
+(defslimefun describe-definition-for-emacs (name kind)
+ (with-buffer-syntax ()
+ (with-describe-settings ()
+ (with-output-to-string (*standard-output*)
+ (describe-definition (parse-symbol-or-lose name) kind)))))
+
+(defslimefun documentation-symbol (symbol-name)
+ (with-buffer-syntax ()
+ (multiple-value-bind (sym foundp) (parse-symbol symbol-name)
+ (if foundp
+ (let ((vdoc (documentation sym 'variable))
+ (fdoc (documentation sym 'function)))
+ (with-output-to-string (string)
+ (format string "Documentation for the symbol ~a:~2%" sym)
+ (unless (or vdoc fdoc)
+ (format string "Not documented." ))
+ (when vdoc
+ (format string "Variable:~% ~a~2%" vdoc))
+ (when fdoc
+ (format string "Function:~% Arglist: ~a~2% ~a"
+ (arglist sym)
+ fdoc))))
+ (format nil "No such symbol, ~a." symbol-name)))))
+
+
+;;;; Package Commands
+
+(defslimefun list-all-package-names (&optional nicknames)
+ "Return a list of all package names.
+Include the nicknames if NICKNAMES is true."
+ (mapcar #'unparse-name
+ (if nicknames
+ (mapcan #'package-names (list-all-packages))
+ (mapcar #'package-name (list-all-packages)))))
+
+
+;;;; Tracing
+
+;; Use eval for the sake of portability...
+(defun tracedp (fspec)
+ (member fspec (eval '(trace))))
+
+(defvar *after-toggle-trace-hook* nil
+ "Hook called whenever a SPEC is traced or untraced.
+
+If non-nil, called with two arguments SPEC and TRACED-P." )
+(defslimefun swank-toggle-trace (spec-string)
+ (let* ((spec (from-string spec-string))
+ (retval (cond ((consp spec) ; handle complicated cases in the backend
+ (toggle-trace spec))
+ ((tracedp spec)
+ (eval `(untrace ,spec))
+ (format nil "~S is now untraced." spec))
+ (t
+ (eval `(trace ,spec))
+ (format nil "~S is now traced." spec))))
+ (traced-p (let* ((tosearch "is now traced.")
+ (start (- (length retval)
+ (length tosearch)))
+ (end (+ start (length tosearch))))
+ (search tosearch (subseq retval start end))))
+ (hook-msg (when *after-toggle-trace-hook*
+ (funcall *after-toggle-trace-hook*
+ spec
+ traced-p))))
+ (if hook-msg
+ (format nil "~a~%(also ~a)" retval hook-msg)
+ retval)))
+
+(defslimefun untrace-all ()
+ (untrace))
+
+
+;;;; Undefing
+
+(defslimefun undefine-function (fname-string)
+ (let ((fname (from-string fname-string)))
+ (format nil "~S" (fmakunbound fname))))
+
+(defslimefun unintern-symbol (name package)
+ (let ((pkg (guess-package package)))
+ (cond ((not pkg) (format nil "No such package: ~s" package))
+ (t
+ (multiple-value-bind (sym found) (parse-symbol name pkg)
+ (case found
+ ((nil) (format nil "~s not in package ~s" name package))
+ (t
+ (unintern sym pkg)
+ (format nil "Uninterned symbol: ~s" sym))))))))
+
+(defslimefun swank-delete-package (package-name)
+ (let ((pkg (or (guess-package package-name)
+ (error "No such package: ~s" package-name))))
+ (delete-package pkg)
+ nil))
+
+
+;;;; Profiling
+
+(defun profiledp (fspec)
+ (member fspec (profiled-functions)))
+
+(defslimefun toggle-profile-fdefinition (fname-string)
+ (let ((fname (from-string fname-string)))
+ (cond ((profiledp fname)
+ (unprofile fname)
+ (format nil "~S is now unprofiled." fname))
+ (t
+ (profile fname)
+ (format nil "~S is now profiled." fname)))))
+
+(defslimefun profile-by-substring (substring package)
+ (let ((count 0))
+ (flet ((maybe-profile (symbol)
+ (when (and (fboundp symbol)
+ (not (profiledp symbol))
+ (search substring (symbol-name symbol) :test #'equalp))
+ (handler-case (progn
+ (profile symbol)
+ (incf count))
+ (error (condition)
+ (warn "~a" condition))))))
+ (if package
+ (do-symbols (symbol (parse-package package))
+ (maybe-profile symbol))
+ (do-all-symbols (symbol)
+ (maybe-profile symbol))))
+ (format nil "~a function~:p ~:*~[are~;is~:;are~] now profiled" count)))
+
+(defslimefun swank-profile-package (package-name callersp methodsp)
+ (let ((pkg (or (guess-package package-name)
+ (error "Not a valid package name: ~s" package-name))))
+ (check-type callersp boolean)
+ (check-type methodsp boolean)
+ (profile-package pkg callersp methodsp)))
+
+
+;;;; Source Locations
+
+(defslimefun find-definition-for-thing (thing)
+ (find-source-location thing))
+
+(defslimefun find-source-location-for-emacs (spec)
+ (find-source-location (value-spec-ref spec)))
+
+(defun value-spec-ref (spec)
+ (dcase spec
+ ((:string string package)
+ (with-buffer-syntax (package)
+ (eval (read-from-string string))))
+ ((:inspector part)
+ (inspector-nth-part part))
+ ((:sldb frame var)
+ (frame-var-value frame var))))
+
+(defvar *find-definitions-right-trim* ",:.>")
+(defvar *find-definitions-left-trim* "#:<")
+
+(defun find-definitions-find-symbol-or-package (name)
+ (flet ((do-find (name)
+ (multiple-value-bind (symbol found name)
+ (with-buffer-syntax ()
+ (parse-symbol name))
+ (cond (found
+ (return-from find-definitions-find-symbol-or-package
+ (values symbol found)))
+ ;; Packages are not named by symbols, so
+ ;; not-interned symbols can refer to packages
+ ((find-package name)
+ (return-from find-definitions-find-symbol-or-package
+ (values (make-symbol name) t)))))))
+ (do-find name)
+ (do-find (string-right-trim *find-definitions-right-trim* name))
+ (do-find (string-left-trim *find-definitions-left-trim* name))
+ (do-find (string-left-trim *find-definitions-left-trim*
+ (string-right-trim
+ *find-definitions-right-trim* name)))))
+
+(defslimefun find-definitions-for-emacs (name)
+ "Return a list ((DSPEC LOCATION) ...) of definitions for NAME.
+DSPEC is a string and LOCATION a source location. NAME is a string."
+ (multiple-value-bind (symbol found)
+ (find-definitions-find-symbol-or-package name)
+ (when found
+ (mapcar #'xref>elisp (find-definitions symbol)))))
+
+;;; Generic function so contribs can extend it.
+(defgeneric xref-doit (type thing)
+ (:method (type thing)
+ (declare (ignore type thing))
+ :not-implemented))
+
+(macrolet ((define-xref-action (xref-type handler)
+ `(defmethod xref-doit ((type (eql ,xref-type)) thing)
+ (declare (ignorable type))
+ (funcall ,handler thing))))
+ (define-xref-action :calls #'who-calls)
+ (define-xref-action :calls-who #'calls-who)
+ (define-xref-action :references #'who-references)
+ (define-xref-action :binds #'who-binds)
+ (define-xref-action :sets #'who-sets)
+ (define-xref-action :macroexpands #'who-macroexpands)
+ (define-xref-action :specializes #'who-specializes)
+ (define-xref-action :callers #'list-callers)
+ (define-xref-action :callees #'list-callees))
+
+(defslimefun xref (type name)
+ (multiple-value-bind (sexp error) (ignore-errors (from-string name))
+ (unless error
+ (let ((xrefs (xref-doit type sexp)))
+ (if (eq xrefs :not-implemented)
+ :not-implemented
+ (mapcar #'xref>elisp xrefs))))))
+
+(defslimefun xrefs (types name)
+ (loop for type in types
+ for xrefs = (xref type name)
+ when (and (not (eq :not-implemented xrefs))
+ (not (null xrefs)))
+ collect (cons type xrefs)))
+
+(defun xref>elisp (xref)
+ (destructuring-bind (name loc) xref
+ (list (to-string name) loc)))
+
+
+;;;;; Lazy lists
+
+(defstruct (lcons (:constructor %lcons (car %cdr))
+ (:predicate lcons?))
+ car
+ (%cdr nil :type (or null lcons function))
+ (forced? nil))
+
+(defmacro lcons (car cdr)
+ `(%lcons ,car (lambda () ,cdr)))
+
+(defmacro lcons* (car cdr &rest more)
+ (cond ((null more) `(lcons ,car ,cdr))
+ (t `(lcons ,car (lcons* ,cdr ,@more)))))
+
+(defun lcons-cdr (lcons)
+ (with-struct* (lcons- @ lcons)
+ (cond ((@ forced?)
+ (@ %cdr))
+ (t
+ (let ((value (funcall (@ %cdr))))
+ (setf (@ forced?) t
+ (@ %cdr) value))))))
+
+(defun llist-range (llist start end)
+ (llist-take (llist-skip llist start) (- end start)))
+
+(defun llist-skip (lcons index)
+ (do ((i 0 (1+ i))
+ (l lcons (lcons-cdr l)))
+ ((or (= i index) (null l))
+ l)))
+
+(defun llist-take (lcons count)
+ (let ((result '()))
+ (do ((i 0 (1+ i))
+ (l lcons (lcons-cdr l)))
+ ((or (= i count)
+ (null l)))
+ (push (lcons-car l) result))
+ (nreverse result)))
+
+(defun iline (label value)
+ `(:line ,label ,value))
+
+
+;;;; Inspecting
+
+(defvar *inspector-verbose* nil)
+
+(defvar *inspector-printer-bindings*
+ '((*print-lines* . 1)
+ (*print-right-margin* . 75)
+ (*print-pretty* . t)
+ (*print-readably* . nil)))
+
+(defvar *inspector-verbose-printer-bindings*
+ '((*print-escape* . t)
+ (*print-circle* . t)
+ (*print-array* . nil)))
+
+(defstruct inspector-state)
+(defstruct (istate (:conc-name istate.) (:include inspector-state))
+ object
+ (verbose *inspector-verbose*)
+ (parts (make-array 10 :adjustable t :fill-pointer 0))
+ (actions (make-array 10 :adjustable t :fill-pointer 0))
+ metadata-plist
+ content
+ next previous)
+
+(defvar *istate* nil)
+(defvar *inspector-history*)
+
+(defun reset-inspector ()
+ (setq *istate* nil
+ *inspector-history* (make-array 10 :adjustable t :fill-pointer 0)))
+
+(defslimefun init-inspector (string)
+ (with-buffer-syntax ()
+ (with-retry-restart (:msg "Retry SLIME inspection request.")
+ (reset-inspector)
+ (inspect-object (eval (read-from-string string))))))
+
+(defun ensure-istate-metadata (o indicator default)
+ (with-struct (istate. object metadata-plist) *istate*
+ (assert (eq object o))
+ (let ((data (getf metadata-plist indicator default)))
+ (setf (getf metadata-plist indicator) data)
+ data)))
+
+(defun inspect-object (o)
+ (let* ((prev *istate*)
+ (istate (make-istate :object o :previous prev
+ :verbose (cond (prev (istate.verbose prev))
+ (t *inspector-verbose*)))))
+ (setq *istate* istate)
+ (setf (istate.content istate) (emacs-inspect/istate istate))
+ (unless (find o *inspector-history*)
+ (vector-push-extend o *inspector-history*))
+ (let ((previous (istate.previous istate)))
+ (if previous (setf (istate.next previous) istate)))
+ (istate>elisp istate)))
+
+(defun emacs-inspect/istate (istate)
+ (with-bindings (if (istate.verbose istate)
+ *inspector-verbose-printer-bindings*
+ *inspector-printer-bindings*)
+ (emacs-inspect (istate.object istate))))
+
+(defun istate>elisp (istate)
+ (list :title (prepare-title istate)
+ :id (assign-index (istate.object istate) (istate.parts istate))
+ :content (prepare-range istate 0 500)))
+
+(defun prepare-title (istate)
+ (if (istate.verbose istate)
+ (with-bindings *inspector-verbose-printer-bindings*
+ (to-string (istate.object istate)))
+ (with-string-stream (stream :length 200
+ :bindings *inspector-printer-bindings*)
+ (print-unreadable-object
+ ((istate.object istate) stream :type t :identity t)))))
+
+(defun prepare-range (istate start end)
+ (let* ((range (content-range (istate.content istate) start end))
+ (ps (loop for part in range append (prepare-part part istate))))
+ (list ps
+ (if (< (length ps) (- end start))
+ (+ start (length ps))
+ (+ end 1000))
+ start end)))
+
+(defun prepare-part (part istate)
+ (let ((newline '#.(string #\newline)))
+ (etypecase part
+ (string (list part))
+ (cons (dcase part
+ ((:newline) (list newline))
+ ((:value obj &optional str)
+ (list (value-part obj str (istate.parts istate))))
+ ((:label &rest strs)
+ (list (list :label (apply #'cat (mapcar #'string strs)))))
+ ((:action label lambda &key (refreshp t))
+ (list (action-part label lambda refreshp
+ (istate.actions istate))))
+ ((:line label value)
+ (list (princ-to-string label) ": "
+ (value-part value nil (istate.parts istate))
+ newline)))))))
+
+(defun value-part (object string parts)
+ (list :value
+ (or string (print-part-to-string object))
+ (assign-index object parts)))
+
+(defun action-part (label lambda refreshp actions)
+ (list :action label (assign-index (list lambda refreshp) actions)))
+
+(defun assign-index (object vector)
+ (let ((index (fill-pointer vector)))
+ (vector-push-extend object vector)
+ index))
+
+(defun print-part-to-string (value)
+ (let* ((*print-readably* nil)
+ (string (to-line value))
+ (pos (position value *inspector-history*)))
+ (if pos
+ (format nil "@~D=~A" pos string)
+ string)))
+
+(defun content-range (list start end)
+ (typecase list
+ (list (let ((len (length list)))
+ (subseq list start (min len end))))
+ (lcons (llist-range list start end))))
+
+(defslimefun inspector-nth-part (index)
+ "Return the current inspector's INDEXth part.
+The second value indicates if that part exists at all."
+ (let* ((parts (istate.parts *istate*))
+ (foundp (< index (length parts))))
+ (values (and foundp (aref parts index))
+ foundp)))
+
+(defslimefun inspect-nth-part (index)
+ (with-buffer-syntax ()
+ (inspect-object (inspector-nth-part index))))
+
+(defslimefun inspector-range (from to)
+ (prepare-range *istate* from to))
+
+(defslimefun inspector-call-nth-action (index &rest args)
+ (destructuring-bind (fun refreshp) (aref (istate.actions *istate*) index)
+ (apply fun args)
+ (if refreshp
+ (inspector-reinspect)
+ ;; tell emacs that we don't want to refresh the inspector buffer
+ nil)))
+
+(defslimefun inspector-pop ()
+ "Inspect the previous object.
+Return nil if there's no previous object."
+ (with-buffer-syntax ()
+ (cond ((istate.previous *istate*)
+ (setq *istate* (istate.previous *istate*))
+ (istate>elisp *istate*))
+ (t nil))))
+
+(defslimefun inspector-next ()
+ "Inspect the next element in the history of inspected objects.."
+ (with-buffer-syntax ()
+ (cond ((istate.next *istate*)
+ (setq *istate* (istate.next *istate*))
+ (istate>elisp *istate*))
+ (t nil))))
+
+(defslimefun inspector-reinspect ()
+ (let ((istate *istate*))
+ (setf (istate.content istate) (emacs-inspect/istate istate))
+ (istate>elisp istate)))
+
+(defslimefun inspector-toggle-verbose ()
+ "Toggle verbosity of inspected object."
+ (setf (istate.verbose *istate*) (not (istate.verbose *istate*)))
+ (istate>elisp *istate*))
+
+(defslimefun inspector-eval (string)
+ (let* ((obj (istate.object *istate*))
+ (context (eval-context obj))
+ (form (with-buffer-syntax ((cdr (assoc '*package* context)))
+ (read-from-string string)))
+ (ignorable (remove-if #'boundp (mapcar #'car context))))
+ (to-string (eval `(let ((* ',obj) (- ',form)
+ . ,(loop for (var . val) in context
+ unless (constantp var) collect
+ `(,var ',val)))
+ (declare (ignorable . ,ignorable))
+ ,form)))))
+
+(defslimefun inspector-history ()
+ (with-output-to-string (out)
+ (let ((newest (loop for s = *istate* then next
+ for next = (istate.next s)
+ if (not next) return s)))
+ (format out "--- next/prev chain ---")
+ (loop for s = newest then (istate.previous s) while s do
+ (let ((val (istate.object s)))
+ (format out "~%~:[ ~; *~]@~d "
+ (eq s *istate*)
+ (position val *inspector-history*))
+ (print-unreadable-object (val out :type t :identity t)))))
+ (format out "~%~%--- all visited objects ---")
+ (loop for val across *inspector-history* for i from 0 do
+ (format out "~%~2,' d " i)
+ (print-unreadable-object (val out :type t :identity t)))))
+
+(defslimefun quit-inspector ()
+ (reset-inspector)
+ nil)
+
+(defslimefun describe-inspectee ()
+ "Describe the currently inspected object."
+ (with-buffer-syntax ()
+ (describe-to-string (istate.object *istate*))))
+
+(defslimefun pprint-inspector-part (index)
+ "Pretty-print the currently inspected object."
+ (with-buffer-syntax ()
+ (swank-pprint (list (inspector-nth-part index)))))
+
+(defslimefun inspect-in-frame (string index)
+ (with-buffer-syntax ()
+ (with-retry-restart (:msg "Retry SLIME inspection request.")
+ (reset-inspector)
+ (inspect-object (eval-in-frame (from-string string) index)))))
+
+(defslimefun inspect-current-condition ()
+ (with-buffer-syntax ()
+ (reset-inspector)
+ (inspect-object *swank-debugger-condition*)))
+
+(defslimefun inspect-frame-var (frame var)
+ (with-buffer-syntax ()
+ (reset-inspector)
+ (inspect-object (frame-var-value frame var))))
+
+;;;;; Lists
+
+(defmethod emacs-inspect ((o cons))
+ (if (listp (cdr o))
+ (inspect-list o)
+ (inspect-cons o)))
+
+(defun inspect-cons (cons)
+ (label-value-line*
+ ('car (car cons))
+ ('cdr (cdr cons))))
+
+(defun inspect-list (list)
+ (multiple-value-bind (length tail) (safe-length list)
+ (flet ((frob (title list)
+ (list* title '(:newline) (inspect-list-aux list))))
+ (cond ((not length)
+ (frob "A circular list:"
+ (cons (car list)
+ (ldiff (cdr list) list))))
+ ((not tail)
+ (frob "A proper list:" list))
+ (t
+ (frob "An improper list:" list))))))
+
+(defun inspect-list-aux (list)
+ (loop for i from 0 for rest on list while (consp rest) append
+ (if (listp (cdr rest))
+ (label-value-line i (car rest))
+ (label-value-line* (i (car rest)) (:tail (cdr rest))))))
+
+(defun safe-length (list)
+ "Similar to `list-length', but avoid errors on improper lists.
+Return two values: the length of the list and the last cdr.
+Return NIL if LIST is circular."
+ (do ((n 0 (+ n 2)) ;Counter.
+ (fast list (cddr fast)) ;Fast pointer: leaps by 2.
+ (slow list (cdr slow))) ;Slow pointer: leaps by 1.
+ (nil)
+ (cond ((null fast) (return (values n nil)))
+ ((not (consp fast)) (return (values n fast)))
+ ((null (cdr fast)) (return (values (1+ n) (cdr fast))))
+ ((and (eq fast slow) (> n 0)) (return nil))
+ ((not (consp (cdr fast))) (return (values (1+ n) (cdr fast)))))))
+
+;;;;; Hashtables
+
+(defun hash-table-to-alist (ht)
+ (let ((result '()))
+ (maphash (lambda (key value)
+ (setq result (acons key value result)))
+ ht)
+ result))
+
+(defmethod emacs-inspect ((ht hash-table))
+ (append
+ (label-value-line*
+ ("Count" (hash-table-count ht))
+ ("Size" (hash-table-size ht))
+ ("Test" (hash-table-test ht))
+ ("Rehash size" (hash-table-rehash-size ht))
+ ("Rehash threshold" (hash-table-rehash-threshold ht)))
+ (let ((weakness (hash-table-weakness ht)))
+ (when weakness
+ (label-value-line "Weakness:" weakness)))
+ (unless (zerop (hash-table-count ht))
+ `((:action "[clear hashtable]"
+ ,(lambda () (clrhash ht))) (:newline)
+ "Contents: " (:newline)))
+ (let ((content (hash-table-to-alist ht)))
+ (cond ((every (lambda (x) (typep (first x) '(or string symbol))) content)
+ (setf content (sort content 'string< :key #'first)))
+ ((every (lambda (x) (typep (first x) 'number)) content)
+ (setf content (sort content '< :key #'first))))
+ (loop for (key . value) in content appending
+ `((:value ,key) " = " (:value ,value)
+ " " (:action "[remove entry]"
+ ,(let ((key key))
+ (lambda () (remhash key ht))))
+ (:newline))))))
+
+;;;;; Arrays
+
+(defmethod emacs-inspect ((array array))
+ (lcons*
+ (iline "Dimensions" (array-dimensions array))
+ (iline "Element type" (array-element-type array))
+ (iline "Total size" (array-total-size array))
+ (iline "Adjustable" (adjustable-array-p array))
+ (iline "Fill pointer" (if (array-has-fill-pointer-p array)
+ (fill-pointer array)))
+ "Contents:" '(:newline)
+ (labels ((k (i max)
+ (cond ((= i max) '())
+ (t (lcons (iline i (row-major-aref array i))
+ (k (1+ i) max))))))
+ (k 0 (array-total-size array)))))
+
+;;;;; Chars
+
+(defmethod emacs-inspect ((char character))
+ (append
+ (label-value-line*
+ ("Char code" (char-code char))
+ ("Lower cased" (char-downcase char))
+ ("Upper cased" (char-upcase char)))
+ (if (get-macro-character char)
+ `("In the current readtable ("
+ (:value ,*readtable*) ") it is a macro character: "
+ (:value ,(get-macro-character char))))))
+
+;;;; Thread listing
+
+(defvar *thread-list* ()
+ "List of threads displayed in Emacs. We don't care a about
+synchronization issues (yet). There can only be one thread listing at
+a time.")
+
+(defslimefun list-threads ()
+ "Return a list (LABELS (ID NAME STATUS ATTRS ...) ...).
+LABELS is a list of attribute names and the remaining lists are the
+corresponding attribute values per thread.
+Example:
+ ((:id :name :status :priority)
+ (6 \"swank-indentation-cache-thread\" \"Semaphore timed wait\" 0)
+ (5 \"reader-thread\" \"Active\" 0)
+ (4 \"control-thread\" \"Semaphore timed wait\" 0)
+ (2 \"Swank Sentinel\" \"Semaphore timed wait\" 0)
+ (1 \"listener\" \"Active\" 0)
+ (0 \"Initial\" \"Sleep\" 0))"
+ (setq *thread-list* (all-threads))
+ (when (and *emacs-connection*
+ (use-threads-p)
+ (equalp (thread-name (current-thread)) "worker"))
+ (setf *thread-list* (delete (current-thread) *thread-list*)))
+ (let* ((plist (thread-attributes (car *thread-list*)))
+ (labels (loop for (key) on plist by #'cddr
+ collect key)))
+ `((:id :name :status ,@labels)
+ ,@(loop for thread in *thread-list*
+ for name = (thread-name thread)
+ for attributes = (thread-attributes thread)
+ collect (list* (thread-id thread)
+ (string name)
+ (thread-status thread)
+ (loop for label in labels
+ collect (getf attributes label)))))))
+
+(defslimefun quit-thread-browser ()
+ (setq *thread-list* nil))
+
+(defun nth-thread (index)
+ (nth index *thread-list*))
+
+(defslimefun debug-nth-thread (index)
+ (let ((connection *emacs-connection*))
+ (interrupt-thread (nth-thread index)
+ (lambda ()
+ (invoke-or-queue-interrupt
+ (lambda ()
+ (with-connection (connection)
+ (simple-break))))))))
+
+(defslimefun kill-nth-thread (index)
+ (kill-thread (nth-thread index)))
+
+(defslimefun start-swank-server-in-thread (index port-file-name)
+ "Interrupt the INDEXth thread and make it start a swank server.
+The server port is written to PORT-FILE-NAME."
+ (interrupt-thread (nth-thread index)
+ (lambda ()
+ (start-server port-file-name :style nil))))
+
+;;;; Class browser
+
+(defun mop-helper (class-name fn)
+ (let ((class (find-class class-name nil)))
+ (if class
+ (mapcar (lambda (x) (to-string (class-name x)))
+ (funcall fn class)))))
+
+(defslimefun mop (type symbol-name)
+ "Return info about classes using mop.
+
+ When type is:
+ :subclasses - return the list of subclasses of class.
+ :superclasses - return the list of superclasses of class."
+ (let ((symbol (parse-symbol symbol-name *buffer-package*)))
+ (ecase type
+ (:subclasses
+ (mop-helper symbol #'swank-mop:class-direct-subclasses))
+ (:superclasses
+ (mop-helper symbol #'swank-mop:class-direct-superclasses)))))
+
+
+;;;; Automatically synchronized state
+;;;
+;;; Here we add hooks to push updates of relevant information to
+;;; Emacs.
+
+;;;;; *FEATURES*
+
+(defun sync-features-to-emacs ()
+ "Update Emacs if any relevant Lisp state has changed."
+ ;; FIXME: *slime-features* should be connection-local
+ (unless (eq *slime-features* *features*)
+ (setq *slime-features* *features*)
+ (send-to-emacs (list :new-features (features-for-emacs)))))
+
+(defun features-for-emacs ()
+ "Return `*slime-features*' in a format suitable to send it to Emacs."
+ *slime-features*)
+
+(add-hook *pre-reply-hook* 'sync-features-to-emacs)
+
+
+;;;;; Indentation of macros
+;;;
+;;; This code decides how macros should be indented (based on their
+;;; arglists) and tells Emacs. A per-connection cache is used to avoid
+;;; sending redundant information to Emacs -- we just say what's
+;;; changed since last time.
+;;;
+;;; The strategy is to scan all symbols, pick out the macros, and look
+;;; for &body-arguments.
+
+(defvar *configure-emacs-indentation* t
+ "When true, automatically send indentation information to Emacs
+after each command.")
+
+(defslimefun update-indentation-information ()
+ (send-to-indentation-cache `(:update-indentation-information))
+ nil)
+
+;; This function is for *PRE-REPLY-HOOK*.
+(defun sync-indentation-to-emacs ()
+ "Send any indentation updates to Emacs via CONNECTION."
+ (when *configure-emacs-indentation*
+ (send-to-indentation-cache `(:sync-indentation ,*buffer-package*))))
+
+;; Send REQUEST to the cache. If we are single threaded perform the
+;; request right away, otherwise delegate the request to the
+;; indentation-cache-thread.
+(defun send-to-indentation-cache (request)
+ (let ((c *emacs-connection*))
+ (etypecase c
+ (singlethreaded-connection
+ (handle-indentation-cache-request c request))
+ (multithreaded-connection
+ (without-slime-interrupts
+ (send (mconn.indentation-cache-thread c) request))))))
+
+(defun indentation-cache-loop (connection)
+ (with-connection (connection)
+ (loop
+ (restart-case
+ (handle-indentation-cache-request connection (receive))
+ (abort ()
+ :report "Return to the indentation cache request handling loop.")))))
+
+(defun handle-indentation-cache-request (connection request)
+ (dcase request
+ ((:sync-indentation package)
+ (let ((fullp (need-full-indentation-update-p connection)))
+ (perform-indentation-update connection fullp package)))
+ ((:update-indentation-information)
+ (perform-indentation-update connection t nil))))
+
+(defun need-full-indentation-update-p (connection)
+ "Return true if the whole indentation cache should be updated.
+This is a heuristic to avoid scanning all symbols all the time:
+instead, we only do a full scan if the set of packages has changed."
+ (set-difference (list-all-packages)
+ (connection.indentation-cache-packages connection)))
+
+(defun perform-indentation-update (connection force package)
+ "Update the indentation cache in CONNECTION and update Emacs.
+If FORCE is true then start again without considering the old cache."
+ (let ((cache (connection.indentation-cache connection)))
+ (when force (clrhash cache))
+ (let ((delta (update-indentation/delta-for-emacs cache force package)))
+ (setf (connection.indentation-cache-packages connection)
+ (list-all-packages))
+ (unless (null delta)
+ (setf (connection.indentation-cache connection) cache)
+ (send-to-emacs (list :indentation-update delta))))))
+
+(defun update-indentation/delta-for-emacs (cache force package)
+ "Update the cache and return the changes in a (SYMBOL INDENT PACKAGES) list.
+If FORCE is true then check all symbols, otherwise only check symbols
+belonging to PACKAGE."
+ (let ((alist '()))
+ (flet ((consider (symbol)
+ (let ((indent (symbol-indentation symbol)))
+ (when indent
+ (unless (equal (gethash symbol cache) indent)
+ (setf (gethash symbol cache) indent)
+ (let ((pkgs (mapcar #'package-name
+ (symbol-packages symbol)))
+ (name (string-downcase symbol)))
+ (push (list name indent pkgs) alist)))))))
+ (cond (force
+ (do-all-symbols (symbol)
+ (consider symbol)))
+ ((package-name package) ; don't try to iterate over a
+ ; deleted package.
+ (do-symbols (symbol package)
+ (when (eq (symbol-package symbol) package)
+ (consider symbol)))))
+ alist)))
+
+(defun package-names (package)
+ "Return the name and all nicknames of PACKAGE in a fresh list."
+ (cons (package-name package) (copy-list (package-nicknames package))))
+
+(defun symbol-packages (symbol)
+ "Return the packages where SYMBOL can be found."
+ (let ((string (string symbol)))
+ (loop for p in (list-all-packages)
+ when (eq symbol (find-symbol string p))
+ collect p)))
+
+(defun cl-symbol-p (symbol)
+ "Is SYMBOL a symbol in the COMMON-LISP package?"
+ (eq (symbol-package symbol) cl-package))
+
+(defun known-to-emacs-p (symbol)
+ "Return true if Emacs has special rules for indenting SYMBOL."
+ (cl-symbol-p symbol))
+
+(defun symbol-indentation (symbol)
+ "Return a form describing the indentation of SYMBOL.
+The form is to be used as the `common-lisp-indent-function' property
+in Emacs."
+ (if (and (macro-function symbol)
+ (not (known-to-emacs-p symbol)))
+ (let ((arglist (arglist symbol)))
+ (etypecase arglist
+ ((member :not-available)
+ nil)
+ (list
+ (macro-indentation arglist))))
+ nil))
+
+(defun macro-indentation (arglist)
+ (if (well-formed-list-p arglist)
+ (position '&body (remove '&optional (clean-arglist arglist)))
+ nil))
+
+(defun clean-arglist (arglist)
+ "Remove &whole, &enviroment, and &aux elements from ARGLIST."
+ (cond ((null arglist) '())
+ ((member (car arglist) '(&whole &environment))
+ (clean-arglist (cddr arglist)))
+ ((eq (car arglist) '&aux)
+ '())
+ (t (cons (car arglist) (clean-arglist (cdr arglist))))))
+
+(defun well-formed-list-p (list)
+ "Is LIST a proper list terminated by NIL?"
+ (typecase list
+ (null t)
+ (cons (well-formed-list-p (cdr list)))
+ (t nil)))
+
+(defun print-indentation-lossage (&optional (stream *standard-output*))
+ "Return the list of symbols whose indentation styles collide incompatibly.
+Collisions are caused because package information is ignored."
+ (let ((table (make-hash-table :test 'equal)))
+ (flet ((name (s) (string-downcase (symbol-name s))))
+ (do-all-symbols (s)
+ (setf (gethash (name s) table)
+ (cons s (symbol-indentation s))))
+ (let ((collisions '()))
+ (do-all-symbols (s)
+ (let* ((entry (gethash (name s) table))
+ (owner (car entry))
+ (indent (cdr entry)))
+ (unless (or (eq s owner)
+ (equal (symbol-indentation s) indent)
+ (and (not (fboundp s))
+ (null (macro-function s))))
+ (pushnew owner collisions)
+ (pushnew s collisions))))
+ (if (null collisions)
+ (format stream "~&No worries!~%")
+ (format stream "~&Symbols with collisions:~%~{ ~S~%~}"
+ collisions))))))
+
+;;; FIXME: it's too slow on CLASP right now, remove once it's fast enough.
+#-clasp
+(add-hook *pre-reply-hook* 'sync-indentation-to-emacs)
+
+
+;;;; Testing
+
+(defslimefun io-speed-test (&optional (n 1000) (m 1))
+ (let* ((s *standard-output*)
+ (*trace-output* (make-broadcast-stream s *log-output*)))
+ (time (progn
+ (dotimes (i n)
+ (format s "~D abcdefghijklm~%" i)
+ (when (zerop (mod n m))
+ (finish-output s)))
+ (finish-output s)
+ (when *emacs-connection*
+ (eval-in-emacs '(message "done.")))))
+ (terpri *trace-output*)
+ (finish-output *trace-output*)
+ nil))
+
+(defslimefun flow-control-test (n delay)
+ (let ((stream (make-output-stream
+ (let ((conn *emacs-connection*))
+ (lambda (string)
+ (declare (ignore string))
+ (with-connection (conn)
+ (send-to-emacs `(:test-delay ,delay))))))))
+ (dotimes (i n)
+ (print i stream)
+ (force-output stream)
+ (background-message "flow-control-test: ~d" i))))
+
+
+(defun before-init (version load-path)
+ (pushnew :swank *features*)
+ (setq *swank-wire-protocol-version* version)
+ (setq *load-path* load-path))
+
+(defun init ()
+ (run-hook *after-init-hook*))
+
+;; Local Variables:
+;; coding: latin-1-unix
+;; indent-tabs-mode: nil
+;; outline-regexp: ";;;;;*"
+;; End:
+
+;;; swank.lisp ends here
diff --git a/vim/bundle/slimv/slime/swank/abcl.lisp b/vim/bundle/slimv/slime/swank/abcl.lisp
new file mode 100644
index 0000000..f5764d6
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/abcl.lisp
@@ -0,0 +1,847 @@
+;;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;;*"; -*-
+;;;
+;;; swank-abcl.lisp --- Armedbear CL specific code for SLIME.
+;;;
+;;; Adapted from swank-acl.lisp, Andras Simon, 2004
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+(defpackage swank/abcl
+ (:use cl swank/backend))
+
+(in-package swank/abcl)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (require :collect) ;just so that it doesn't spoil the flying letters
+ (require :pprint)
+ (require :gray-streams)
+ (assert (>= (read-from-string (subseq (lisp-implementation-version) 0 4))
+ 0.22)
+ () "This file needs ABCL version 0.22 or newer"))
+
+(defimplementation gray-package-name ()
+ "GRAY-STREAMS")
+
+;; FIXME: switch to shared Gray stream implementation when bugs are
+;; fixed in ABCL. See: http://abcl.org/trac/ticket/373.
+(progn
+ (defimplementation make-output-stream (write-string)
+ (ext:make-slime-output-stream write-string))
+
+ (defimplementation make-input-stream (read-string)
+ (ext:make-slime-input-stream read-string
+ (make-synonym-stream '*standard-output*))))
+
+(defimplementation call-with-compilation-hooks (function)
+ (funcall function))
+
+;;; swank-mop
+
+;;dummies and definition
+
+(defclass standard-slot-definition ()())
+
+;(defun class-finalized-p (class) t)
+
+(defun slot-definition-documentation (slot)
+ (declare (ignore slot))
+ #+nil (documentation slot 't))
+
+(defun slot-definition-type (slot)
+ (declare (ignore slot))
+ t)
+
+(defun class-prototype (class)
+ (declare (ignore class))
+ nil)
+
+(defun generic-function-declarations (gf)
+ (declare (ignore gf))
+ nil)
+
+(defun specializer-direct-methods (spec)
+ (mop:class-direct-methods spec))
+
+(defun slot-definition-name (slot)
+ (mop:slot-definition-name slot))
+
+(defun class-slots (class)
+ (mop:class-slots class))
+
+(defun method-generic-function (method)
+ (mop:method-generic-function method))
+
+(defun method-function (method)
+ (mop:method-function method))
+
+(defun slot-boundp-using-class (class object slotdef)
+ (declare (ignore class))
+ (system::slot-boundp object (slot-definition-name slotdef)))
+
+(defun slot-value-using-class (class object slotdef)
+ (declare (ignore class))
+ (system::slot-value object (slot-definition-name slotdef)))
+
+(import-to-swank-mop
+ '( ;; classes
+ cl:standard-generic-function
+ standard-slot-definition ;;dummy
+ cl:method
+ cl:standard-class
+ #+#.(swank/backend:with-symbol 'compute-applicable-methods-using-classes
+ 'mop)
+ mop:compute-applicable-methods-using-classes
+ ;; standard-class readers
+ mop:class-default-initargs
+ mop:class-direct-default-initargs
+ mop:class-direct-slots
+ mop:class-direct-subclasses
+ mop:class-direct-superclasses
+ mop:eql-specializer
+ mop:class-finalized-p
+ mop:finalize-inheritance
+ cl:class-name
+ mop:class-precedence-list
+ class-prototype ;;dummy
+ class-slots
+ specializer-direct-methods
+ ;; eql-specializer accessors
+ mop::eql-specializer-object
+ ;; generic function readers
+ mop:generic-function-argument-precedence-order
+ generic-function-declarations ;;dummy
+ mop:generic-function-lambda-list
+ mop:generic-function-methods
+ mop:generic-function-method-class
+ mop:generic-function-method-combination
+ mop:generic-function-name
+ ;; method readers
+ method-generic-function
+ method-function
+ mop:method-lambda-list
+ mop:method-specializers
+ mop:method-qualifiers
+ ;; slot readers
+ mop:slot-definition-allocation
+ slot-definition-documentation ;;dummy
+ mop:slot-definition-initargs
+ mop:slot-definition-initform
+ mop:slot-definition-initfunction
+ slot-definition-name
+ slot-definition-type ;;dummy
+ mop:slot-definition-readers
+ mop:slot-definition-writers
+ slot-boundp-using-class
+ slot-value-using-class
+ mop:slot-makunbound-using-class))
+
+;;;; TCP Server
+
+
+(defimplementation preferred-communication-style ()
+ :spawn)
+
+(defimplementation create-socket (host port &key backlog)
+ (ext:make-server-socket port))
+
+(defimplementation local-port (socket)
+ (java:jcall (java:jmethod "java.net.ServerSocket" "getLocalPort") socket))
+
+(defimplementation close-socket (socket)
+ (ext:server-socket-close socket))
+
+(defimplementation accept-connection (socket
+ &key external-format buffering timeout)
+ (declare (ignore buffering timeout))
+ (ext:get-socket-stream (ext:socket-accept socket)
+ :element-type (if external-format
+ 'character
+ '(unsigned-byte 8))
+ :external-format (or external-format :default)))
+
+;;;; UTF8
+
+;; faster please!
+(defimplementation string-to-utf8 (s)
+ (jbytes-to-octets
+ (java:jcall
+ (java:jmethod "java.lang.String" "getBytes" "java.lang.String")
+ s
+ "UTF8")))
+
+(defimplementation utf8-to-string (u)
+ (java:jnew
+ (java:jconstructor "org.armedbear.lisp.SimpleString"
+ "java.lang.String")
+ (java:jnew (java:jconstructor "java.lang.String" "[B" "java.lang.String")
+ (octets-to-jbytes u)
+ "UTF8")))
+
+(defun octets-to-jbytes (octets)
+ (declare (type octets (simple-array (unsigned-byte 8) (*))))
+ (let* ((len (length octets))
+ (bytes (java:jnew-array "byte" len)))
+ (loop for byte across octets
+ for i from 0
+ do (java:jstatic (java:jmethod "java.lang.reflect.Array" "setByte"
+ "java.lang.Object" "int" "byte")
+ "java.lang.relect.Array"
+ bytes i byte))
+ bytes))
+
+(defun jbytes-to-octets (jbytes)
+ (let* ((len (java:jarray-length jbytes))
+ (octets (make-array len :element-type '(unsigned-byte 8))))
+ (loop for i from 0 below len
+ for jbyte = (java:jarray-ref jbytes i)
+ do (setf (aref octets i) jbyte))
+ octets))
+
+;;;; External formats
+
+(defvar *external-format-to-coding-system*
+ '((:iso-8859-1 "latin-1" "iso-latin-1" "iso-8859-1")
+ ((:iso-8859-1 :eol-style :lf)
+ "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix")
+ (:utf-8 "utf-8")
+ ((:utf-8 :eol-style :lf) "utf-8-unix")
+ (:euc-jp "euc-jp")
+ ((:euc-jp :eol-style :lf) "euc-jp-unix")
+ (:us-ascii "us-ascii")
+ ((:us-ascii :eol-style :lf) "us-ascii-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (car (rassoc-if (lambda (x)
+ (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+
+;;;; Unix signals
+
+(defimplementation getpid ()
+ (handler-case
+ (let* ((runtime
+ (java:jstatic "getRuntime" "java.lang.Runtime"))
+ (command
+ (java:jnew-array-from-array
+ "java.lang.String" #("sh" "-c" "echo $PPID")))
+ (runtime-exec-jmethod
+ ;; Complicated because java.lang.Runtime.exec() is
+ ;; overloaded on a non-primitive type (array of
+ ;; java.lang.String), so we have to use the actual
+ ;; parameter instance to get java.lang.Class
+ (java:jmethod "java.lang.Runtime" "exec"
+ (java:jcall
+ (java:jmethod "java.lang.Object" "getClass")
+ command)))
+ (process
+ (java:jcall runtime-exec-jmethod runtime command))
+ (output
+ (java:jcall (java:jmethod "java.lang.Process" "getInputStream")
+ process)))
+ (java:jcall (java:jmethod "java.lang.Process" "waitFor")
+ process)
+ (loop :with b :do
+ (setq b
+ (java:jcall (java:jmethod "java.io.InputStream" "read")
+ output))
+ :until (member b '(-1 #x0a)) ; Either EOF or LF
+ :collecting (code-char b) :into result
+ :finally (return
+ (parse-integer (coerce result 'string)))))
+ (t () 0)))
+
+(defimplementation lisp-implementation-type-name ()
+ "armedbear")
+
+(defimplementation set-default-directory (directory)
+ (let ((dir (sys::probe-directory directory)))
+ (when dir (setf *default-pathname-defaults* dir))
+ (namestring dir)))
+
+
+;;;; Misc
+
+(defimplementation arglist (fun)
+ (cond ((symbolp fun)
+ (multiple-value-bind (arglist present)
+ (sys::arglist fun)
+ (when (and (not present)
+ (fboundp fun)
+ (typep (symbol-function fun)
+ 'standard-generic-function))
+ (setq arglist
+ (mop::generic-function-lambda-list (symbol-function fun))
+ present
+ t))
+ (if present arglist :not-available)))
+ (t :not-available)))
+
+(defimplementation function-name (function)
+ (nth-value 2 (function-lambda-expression function)))
+
+(defimplementation macroexpand-all (form &optional env)
+ (ext:macroexpand-all form env))
+
+(defimplementation collect-macro-forms (form &optional env)
+ ;; Currently detects only normal macros, not compiler macros.
+ (declare (ignore env))
+ (with-collected-macro-forms (macro-forms)
+ (handler-bind ((warning #'muffle-warning))
+ (ignore-errors
+ (compile nil `(lambda () ,(macroexpand-all form env)))))
+ (values macro-forms nil)))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((doc (kind &optional (sym symbol))
+ (or (documentation sym kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (when (boundp symbol)
+ (doc 'variable)))
+ (when (fboundp symbol)
+ (maybe-push
+ (cond ((macro-function symbol) :macro)
+ ((special-operator-p symbol) :special-operator)
+ ((typep (fdefinition symbol) 'generic-function)
+ :generic-function)
+ (t :function))
+ (doc 'function)))
+ (maybe-push
+ :class (if (find-class symbol nil)
+ (doc 'class)))
+ result)))
+
+(defimplementation describe-definition (symbol namespace)
+ (ecase namespace
+ ((:variable :macro)
+ (describe symbol))
+ ((:function :generic-function)
+ (describe (symbol-function symbol)))
+ (:class
+ (describe (find-class symbol)))))
+
+(defimplementation describe-definition (symbol namespace)
+ (ecase namespace
+ (:variable
+ (describe symbol))
+ ((:function :generic-function)
+ (describe (symbol-function symbol)))
+ (:class
+ (describe (find-class symbol)))))
+
+
+;;;; Debugger
+
+;; Copied from swank-sbcl.lisp.
+;;
+;; Notice that *INVOKE-DEBUGGER-HOOK* is tried before *DEBUGGER-HOOK*,
+;; so we have to make sure that the latter gets run when it was
+;; established locally by a user (i.e. changed meanwhile.)
+(defun make-invoke-debugger-hook (hook)
+ (lambda (condition old-hook)
+ (if *debugger-hook*
+ (funcall *debugger-hook* condition old-hook)
+ (funcall hook condition old-hook))))
+
+(defimplementation call-with-debugger-hook (hook fun)
+ (let ((*debugger-hook* hook)
+ (sys::*invoke-debugger-hook* (make-invoke-debugger-hook hook)))
+ (funcall fun)))
+
+(defimplementation install-debugger-globally (function)
+ (setq *debugger-hook* function)
+ (setq sys::*invoke-debugger-hook* (make-invoke-debugger-hook function)))
+
+(defvar *sldb-topframe*)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (let* ((magic-token (intern "SWANK-DEBUGGER-HOOK" 'swank))
+ (*sldb-topframe*
+ (second (member magic-token (sys:backtrace)
+ :key (lambda (frame)
+ (first (sys:frame-to-list frame)))))))
+ (funcall debugger-loop-fn)))
+
+(defun backtrace (start end)
+ "A backtrace without initial SWANK frames."
+ (let ((backtrace (sys:backtrace)))
+ (subseq (or (member *sldb-topframe* backtrace) backtrace)
+ start end)))
+
+(defun nth-frame (index)
+ (nth index (backtrace 0 nil)))
+
+(defimplementation compute-backtrace (start end)
+ (let ((end (or end most-positive-fixnum)))
+ (backtrace start end)))
+
+(defimplementation print-frame (frame stream)
+ (write-string (sys:frame-to-string frame)
+ stream))
+
+;;; Sorry, but can't seem to declare DEFIMPLEMENTATION under FLET.
+;;; --ME 20150403
+(defun nth-frame-list (index)
+ (java:jcall "toLispList" (nth-frame index)))
+
+(defun match-lambda (operator values)
+ (jvm::match-lambda-list
+ (multiple-value-list
+ (jvm::parse-lambda-list (ext:arglist operator)))
+ values))
+
+(defimplementation frame-locals (index)
+ (loop
+ :for id :upfrom 0
+ :with frame = (nth-frame-list index)
+ :with operator = (first frame)
+ :with values = (rest frame)
+ :with arglist = (if (and operator (consp values) (not (null values)))
+ (handler-case
+ (match-lambda operator values)
+ (jvm::lambda-list-mismatch (e)
+ :lambda-list-mismatch))
+ :not-available)
+ :for value :in values
+ :collecting (list
+ :name (if (not (keywordp arglist))
+ (first (nth id arglist))
+ (format nil "arg~A" id))
+ :id id
+ :value value)))
+
+(defimplementation frame-var-value (index id)
+ (elt (rest (java:jcall "toLispList" (nth-frame index))) id))
+
+
+#+nil
+(defimplementation disassemble-frame (index)
+ (disassemble (debugger:frame-function (nth-frame index))))
+
+(defimplementation frame-source-location (index)
+ (let ((frame (nth-frame index)))
+ (or (source-location (nth-frame index))
+ `(:error ,(format nil "No source for frame: ~a" frame)))))
+
+#+nil
+(defimplementation eval-in-frame (form frame-number)
+ (debugger:eval-form-in-context
+ form
+ (debugger:environment-of-frame (nth-frame frame-number))))
+
+#+nil
+(defimplementation return-from-frame (frame-number form)
+ (let ((frame (nth-frame frame-number)))
+ (multiple-value-call #'debugger:frame-return
+ frame (debugger:eval-form-in-context
+ form
+ (debugger:environment-of-frame frame)))))
+
+;;; XXX doesn't work for frames with arguments
+#+nil
+(defimplementation restart-frame (frame-number)
+ (let ((frame (nth-frame frame-number)))
+ (debugger:frame-retry frame (debugger:frame-function frame))))
+
+;;;; Compiler hooks
+
+(defvar *buffer-name* nil)
+(defvar *buffer-start-position*)
+(defvar *buffer-string*)
+(defvar *compile-filename*)
+
+(defvar *abcl-signaled-conditions*)
+
+(defun handle-compiler-warning (condition)
+ (let ((loc (when (and jvm::*compile-file-pathname*
+ system::*source-position*)
+ (cons jvm::*compile-file-pathname* system::*source-position*))))
+ ;; filter condition signaled more than once.
+ (unless (member condition *abcl-signaled-conditions*)
+ (push condition *abcl-signaled-conditions*)
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity :warning
+ :message (format nil "~A" condition)
+ :location (cond (*buffer-name*
+ (make-location
+ (list :buffer *buffer-name*)
+ (list :offset *buffer-start-position* 0)))
+ (loc
+ (destructuring-bind (file . pos) loc
+ (make-location
+ (list :file (namestring (truename file)))
+ (list :position (1+ pos)))))
+ (t
+ (make-location
+ (list :file (namestring *compile-filename*))
+ (list :position 1))))))))
+
+(defimplementation swank-compile-file (input-file output-file
+ load-p external-format
+ &key policy)
+ (declare (ignore external-format policy))
+ (let ((jvm::*resignal-compiler-warnings* t)
+ (*abcl-signaled-conditions* nil))
+ (handler-bind ((warning #'handle-compiler-warning))
+ (let ((*buffer-name* nil)
+ (*compile-filename* input-file))
+ (multiple-value-bind (fn warn fail)
+ (compile-file input-file :output-file output-file)
+ (values fn warn
+ (and fn load-p
+ (not (load fn)))))))))
+
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore filename policy))
+ (let ((jvm::*resignal-compiler-warnings* t)
+ (*abcl-signaled-conditions* nil))
+ (handler-bind ((warning #'handle-compiler-warning))
+ (let ((*buffer-name* buffer)
+ (*buffer-start-position* position)
+ (*buffer-string* string)
+ (sys::*source* (make-pathname :device "emacs-buffer" :name buffer))
+ (sys::*source-position* position))
+ (funcall (compile nil (read-from-string
+ (format nil "(~S () ~A)" 'lambda string))))
+ t))))
+
+#|
+;;;; Definition Finding
+
+(defun find-fspec-location (fspec type)
+ (let ((file (excl::fspec-pathname fspec type)))
+ (etypecase file
+ (pathname
+ (let ((start (scm:find-definition-in-file fspec type file)))
+ (make-location (list :file (namestring (truename file)))
+ (if start
+ (list :position (1+ start))
+ (list :function-name (string fspec))))))
+ ((member :top-level)
+ (list :error (format nil "Defined at toplevel: ~A" fspec)))
+ (null
+ (list :error (format nil "Unkown source location for ~A" fspec))))))
+
+(defun fspec-definition-locations (fspec)
+ (let ((defs (excl::find-multiple-definitions fspec)))
+ (loop for (fspec type) in defs
+ collect (list fspec (find-fspec-location fspec type)))))
+
+(defimplementation find-definitions (symbol)
+ (fspec-definition-locations symbol))
+|#
+
+(defgeneric source-location (object))
+
+(defmethod source-location ((symbol symbol))
+ (when (pathnamep (ext:source-pathname symbol))
+ (let ((pos (ext:source-file-position symbol))
+ (path (namestring (ext:source-pathname symbol))))
+ (cond ((ext:pathname-jar-p path)
+ `(:location
+ ;; strip off "jar:file:" = 9 characters
+ (:zip ,@(split-string (subseq path 9) "!/"))
+ ;; pos never seems right. Use function name.
+ (:function-name ,(string symbol))
+ (:align t)))
+ ((equal (pathname-device (ext:source-pathname symbol)) "emacs-buffer")
+ ;; conspire with swank-compile-string to keep the buffer
+ ;; name in a pathname whose device is "emacs-buffer".
+ `(:location
+ (:buffer ,(pathname-name (ext:source-pathname symbol)))
+ (:function-name ,(string symbol))
+ (:align t)))
+ (t
+ `(:location
+ (:file ,path)
+ ,(if pos
+ (list :position (1+ pos))
+ (list :function-name (string symbol)))
+ (:align t)))))))
+
+(defmethod source-location ((frame sys::java-stack-frame))
+ (destructuring-bind (&key class method file line) (sys:frame-to-list frame)
+ (declare (ignore method))
+ (let ((file (or (find-file-in-path file *source-path*)
+ (let ((f (format nil "~{~a/~}~a"
+ (butlast (split-string class "\\."))
+ file)))
+ (find-file-in-path f *source-path*)))))
+ (and file
+ `(:location ,file (:line ,line) ())))))
+
+(defmethod source-location ((frame sys::lisp-stack-frame))
+ (destructuring-bind (operator &rest args) (sys:frame-to-list frame)
+ (declare (ignore args))
+ (etypecase operator
+ (function (source-location operator))
+ (list nil)
+ (symbol (source-location operator)))))
+
+(defmethod source-location ((fun function))
+ (let ((name (function-name fun)))
+ (and name (source-location name))))
+
+(defun system-property (name)
+ (java:jstatic "getProperty" "java.lang.System" name))
+
+(defun pathname-parent (pathname)
+ (make-pathname :directory (butlast (pathname-directory pathname))))
+
+(defun pathname-absolute-p (pathname)
+ (eq (car (pathname-directory pathname)) ':absolute))
+
+(defun split-string (string regexp)
+ (coerce
+ (java:jcall (java:jmethod "java.lang.String" "split" "java.lang.String")
+ string regexp)
+ 'list))
+
+(defun path-separator ()
+ (java:jfield "java.io.File" "pathSeparator"))
+
+(defun search-path-property (prop-name)
+ (let ((string (system-property prop-name)))
+ (and string
+ (remove nil
+ (mapcar #'truename
+ (split-string string (path-separator)))))))
+
+(defun jdk-source-path ()
+ (let* ((jre-home (truename (system-property "java.home")))
+ (src-zip (merge-pathnames "src.zip" (pathname-parent jre-home)))
+ (truename (probe-file src-zip)))
+ (and truename (list truename))))
+
+(defun class-path ()
+ (append (search-path-property "java.class.path")
+ (search-path-property "sun.boot.class.path")))
+
+(defvar *source-path*
+ (append (search-path-property "user.dir")
+ (jdk-source-path)
+ ;;(list (truename "/scratch/abcl/src"))
+ )
+ "List of directories to search for source files.")
+
+(defun zipfile-contains-p (zipfile-name entry-name)
+ (let ((zipfile (java:jnew (java:jconstructor "java.util.zip.ZipFile"
+ "java.lang.String")
+ zipfile-name)))
+ (java:jcall
+ (java:jmethod "java.util.zip.ZipFile" "getEntry" "java.lang.String")
+ zipfile entry-name)))
+
+;; (find-file-in-path "java/lang/String.java" *source-path*)
+;; (find-file-in-path "Lisp.java" *source-path*)
+
+;; Try to find FILENAME in PATH. If found, return a file spec as
+;; needed by Emacs. We also look in zip files.
+(defun find-file-in-path (filename path)
+ (labels ((try (dir)
+ (cond ((not (pathname-type dir))
+ (let ((f (probe-file (merge-pathnames filename dir))))
+ (and f `(:file ,(namestring f)))))
+ ((equal (pathname-type dir) "zip")
+ (try-zip dir))
+ (t (error "strange path element: ~s" path))))
+ (try-zip (zip)
+ (let* ((zipfile-name (namestring (truename zip))))
+ (and (zipfile-contains-p zipfile-name filename)
+ `(:dir ,zipfile-name ,filename)))))
+ (cond ((pathname-absolute-p filename) (probe-file filename))
+ (t
+ (loop for dir in path
+ if (try dir) return it)))))
+
+(defimplementation find-definitions (symbol)
+ (ext:resolve symbol)
+ (let ((srcloc (source-location symbol)))
+ (and srcloc `((,symbol ,srcloc)))))
+
+#|
+Uncomment this if you have patched xref.lisp, as in
+http://article.gmane.org/gmane.lisp.slime.devel/2425
+Also, make sure that xref.lisp is loaded by modifying the armedbear
+part of *sysdep-pathnames* in swank.loader.lisp.
+
+;;;; XREF
+(setq pxref:*handle-package-forms* '(cl:in-package))
+
+(defmacro defxref (name function)
+ `(defimplementation ,name (name)
+ (xref-results (,function name))))
+
+(defxref who-calls pxref:list-callers)
+(defxref who-references pxref:list-readers)
+(defxref who-binds pxref:list-setters)
+(defxref who-sets pxref:list-setters)
+(defxref list-callers pxref:list-callers)
+(defxref list-callees pxref:list-callees)
+
+(defun xref-results (symbols)
+ (let ((xrefs '()))
+ (dolist (symbol symbols)
+ (push (list symbol (cadar (source-location symbol))) xrefs))
+ xrefs))
+|#
+
+;;;; Inspecting
+(defmethod emacs-inspect ((o t))
+ (let ((parts (sys:inspected-parts o)))
+ `("The object is of type " ,(symbol-name (type-of o)) "." (:newline)
+ ,@(if parts
+ (loop :for (label . value) :in parts
+ :appending (label-value-line label value))
+ (list "No inspectable parts, dumping output of CL:DESCRIBE:"
+ '(:newline)
+ (with-output-to-string (desc) (describe o desc)))))))
+
+(defmethod emacs-inspect ((slot mop::slot-definition))
+ `("Name: "
+ (:value ,(mop:slot-definition-name slot))
+ (:newline)
+ "Documentation:" (:newline)
+ ,@(when (slot-definition-documentation slot)
+ `((:value ,(slot-definition-documentation slot)) (:newline)))
+ "Initialization:" (:newline)
+ " Args: " (:value ,(mop:slot-definition-initargs slot)) (:newline)
+ " Form: " ,(if (mop:slot-definition-initfunction slot)
+ `(:value ,(mop:slot-definition-initform slot))
+ "#<unspecified>") (:newline)
+ " Function: "
+ (:value ,(mop:slot-definition-initfunction slot))
+ (:newline)))
+
+(defmethod emacs-inspect ((f function))
+ `(,@(when (function-name f)
+ `("Name: "
+ ,(princ-to-string (function-name f)) (:newline)))
+ ,@(multiple-value-bind (args present)
+ (sys::arglist f)
+ (when present
+ `("Argument list: "
+ ,(princ-to-string args) (:newline))))
+ (:newline)
+ #+nil,@(when (documentation f t)
+ `("Documentation:" (:newline)
+ ,(documentation f t) (:newline)))
+ ,@(when (function-lambda-expression f)
+ `("Lambda expression:"
+ (:newline) ,(princ-to-string
+ (function-lambda-expression f)) (:newline)))))
+
+;;; Although by convention toString() is supposed to be a
+;;; non-computationally expensive operation this isn't always the
+;;; case, so make its computation a user interaction.
+(defparameter *to-string-hashtable* (make-hash-table))
+(defmethod emacs-inspect ((o java:java-object))
+ (let ((to-string (lambda ()
+ (handler-case
+ (setf (gethash o *to-string-hashtable*)
+ (java:jcall "toString" o))
+ (t (e)
+ (setf (gethash o *to-string-hashtable*)
+ (format nil
+ "Could not invoke toString(): ~A"
+ e)))))))
+ (append
+ (if (gethash o *to-string-hashtable*)
+ (label-value-line "toString()" (gethash o *to-string-hashtable*))
+ `((:action "[compute toString()]" ,to-string) (:newline)))
+ (loop :for (label . value) :in (sys:inspected-parts o)
+ :appending (label-value-line label value)))))
+
+;;;; Multithreading
+
+(defimplementation spawn (fn &key name)
+ (threads:make-thread (lambda () (funcall fn)) :name name))
+
+(defvar *thread-plists* (make-hash-table) ; should be a weak table
+ "A hashtable mapping threads to a plist.")
+
+(defvar *thread-id-counter* 0)
+
+(defimplementation thread-id (thread)
+ (threads:synchronized-on *thread-plists*
+ (or (getf (gethash thread *thread-plists*) 'id)
+ (setf (getf (gethash thread *thread-plists*) 'id)
+ (incf *thread-id-counter*)))))
+
+(defimplementation find-thread (id)
+ (find id (all-threads)
+ :key (lambda (thread)
+ (getf (gethash thread *thread-plists*) 'id))))
+
+(defimplementation thread-name (thread)
+ (threads:thread-name thread))
+
+(defimplementation thread-status (thread)
+ (format nil "Thread is ~:[dead~;alive~]" (threads:thread-alive-p thread)))
+
+(defimplementation make-lock (&key name)
+ (declare (ignore name))
+ (threads:make-thread-lock))
+
+(defimplementation call-with-lock-held (lock function)
+ (threads:with-thread-lock (lock) (funcall function)))
+
+(defimplementation current-thread ()
+ (threads:current-thread))
+
+(defimplementation all-threads ()
+ (copy-list (threads:mapcar-threads #'identity)))
+
+(defimplementation thread-alive-p (thread)
+ (member thread (all-threads)))
+
+(defimplementation interrupt-thread (thread fn)
+ (threads:interrupt-thread thread fn))
+
+(defimplementation kill-thread (thread)
+ (threads:destroy-thread thread))
+
+(defstruct mailbox
+ (queue '()))
+
+(defun mailbox (thread)
+ "Return THREAD's mailbox."
+ (threads:synchronized-on *thread-plists*
+ (or (getf (gethash thread *thread-plists*) 'mailbox)
+ (setf (getf (gethash thread *thread-plists*) 'mailbox)
+ (make-mailbox)))))
+
+(defimplementation send (thread message)
+ (let ((mbox (mailbox thread)))
+ (threads:synchronized-on mbox
+ (setf (mailbox-queue mbox)
+ (nconc (mailbox-queue mbox) (list message)))
+ (threads:object-notify-all mbox))))
+
+(defimplementation receive-if (test &optional timeout)
+ (let* ((mbox (mailbox (current-thread))))
+ (assert (or (not timeout) (eq timeout t)))
+ (loop
+ (check-slime-interrupts)
+ (threads:synchronized-on mbox
+ (let* ((q (mailbox-queue mbox))
+ (tail (member-if test q)))
+ (when tail
+ (setf (mailbox-queue mbox) (nconc (ldiff q tail) (cdr tail)))
+ (return (car tail)))
+ (when (eq timeout t) (return (values nil t)))
+ (threads:object-wait mbox 0.3))))))
+
+(defimplementation quit-lisp ()
+ (ext:exit))
+;;;
+#+#.(swank/backend:with-symbol 'package-local-nicknames 'ext)
+(defimplementation package-local-nicknames (package)
+ (ext:package-local-nicknames package))
diff --git a/vim/bundle/slimv/slime/swank/allegro.lisp b/vim/bundle/slimv/slime/swank/allegro.lisp
new file mode 100644
index 0000000..f5918da
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/allegro.lisp
@@ -0,0 +1,1053 @@
+;;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;;* "; -*-
+;;;
+;;; swank-allegro.lisp --- Allegro CL specific code for SLIME.
+;;;
+;;; Created 2003
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+(defpackage swank/allegro
+ (:use cl swank/backend))
+
+(in-package swank/allegro)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (require :sock)
+ (require :process)
+ #+(version>= 8 2)
+ (require 'lldb))
+
+(defimplementation gray-package-name ()
+ '#:excl)
+
+;;; swank-mop
+
+(import-swank-mop-symbols :clos '(:slot-definition-documentation))
+
+(defun swank-mop:slot-definition-documentation (slot)
+ (documentation slot t))
+
+
+;;;; UTF8
+
+(define-symbol-macro utf8-ef
+ (load-time-value
+ (excl:crlf-base-ef (excl:find-external-format :utf-8))
+ t))
+
+(defimplementation string-to-utf8 (s)
+ (excl:string-to-octets s :external-format utf8-ef
+ :null-terminate nil))
+
+(defimplementation utf8-to-string (u)
+ (excl:octets-to-string u :external-format utf8-ef))
+
+
+;;;; TCP Server
+
+(defimplementation preferred-communication-style ()
+ :spawn)
+
+(defimplementation create-socket (host port &key backlog)
+ (socket:make-socket :connect :passive :local-port port
+ :local-host host :reuse-address t
+ :backlog (or backlog 5)))
+
+(defimplementation local-port (socket)
+ (socket:local-port socket))
+
+(defimplementation close-socket (socket)
+ (close socket))
+
+(defimplementation accept-connection (socket &key external-format buffering
+ timeout)
+ (declare (ignore buffering timeout))
+ (let ((s (socket:accept-connection socket :wait t)))
+ (when external-format
+ (setf (stream-external-format s) external-format))
+ s))
+
+(defimplementation socket-fd (stream)
+ (excl::stream-input-handle stream))
+
+(defvar *external-format-to-coding-system*
+ '((:iso-8859-1
+ "latin-1" "latin-1-unix" "iso-latin-1-unix"
+ "iso-8859-1" "iso-8859-1-unix")
+ (:utf-8 "utf-8" "utf-8-unix")
+ (:euc-jp "euc-jp" "euc-jp-unix")
+ (:us-ascii "us-ascii" "us-ascii-unix")
+ (:emacs-mule "emacs-mule" "emacs-mule-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (let ((e (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+ (and e (excl:crlf-base-ef
+ (excl:find-external-format (car e)
+ :try-variant t)))))
+
+;;;; Unix signals
+
+(defimplementation getpid ()
+ (excl::getpid))
+
+(defimplementation lisp-implementation-type-name ()
+ "allegro")
+
+(defimplementation set-default-directory (directory)
+ (let* ((dir (namestring (truename (merge-pathnames directory)))))
+ (setf *default-pathname-defaults* (pathname (excl:chdir dir)))
+ dir))
+
+(defimplementation default-directory ()
+ (namestring (excl:current-directory)))
+
+;;;; Misc
+
+(defimplementation arglist (symbol)
+ (handler-case (excl:arglist symbol)
+ (simple-error () :not-available)))
+
+(defimplementation macroexpand-all (form &optional env)
+ (declare (ignore env))
+ #+(version>= 8 0)
+ (excl::walk-form form)
+ #-(version>= 8 0)
+ (excl::walk form))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((doc (kind &optional (sym symbol))
+ (or (documentation sym kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (when (boundp symbol)
+ (doc 'variable)))
+ (maybe-push
+ :function (if (fboundp symbol)
+ (doc 'function)))
+ (maybe-push
+ :class (if (find-class symbol nil)
+ (doc 'class)))
+ result)))
+
+(defimplementation describe-definition (symbol namespace)
+ (ecase namespace
+ (:variable
+ (describe symbol))
+ ((:function :generic-function)
+ (describe (symbol-function symbol)))
+ (:class
+ (describe (find-class symbol)))))
+
+(defimplementation type-specifier-p (symbol)
+ (or (ignore-errors
+ (subtypep nil symbol))
+ (not (eq (type-specifier-arglist symbol) :not-available))))
+
+(defimplementation function-name (f)
+ (check-type f function)
+ (cross-reference::object-to-function-name f))
+
+;;;; Debugger
+
+(defvar *sldb-topframe*)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (let ((*sldb-topframe* (find-topframe))
+ (excl::*break-hook* nil))
+ (funcall debugger-loop-fn)))
+
+(defimplementation sldb-break-at-start (fname)
+ ;; :print-before is kind of mis-used but we just want to stuff our
+ ;; break form somewhere. This does not work for setf, :before and
+ ;; :after methods, which need special syntax in the trace call, see
+ ;; ACL's doc/debugging.htm chapter 10.
+ (eval `(trace (,fname
+ :print-before
+ ((break "Function start breakpoint of ~A" ',fname)))))
+ `(:ok ,(format nil "Set breakpoint at start of ~S" fname)))
+
+(defun find-topframe ()
+ (let ((magic-symbol (intern (symbol-name :swank-debugger-hook)
+ (find-package :swank)))
+ (top-frame (excl::int-newest-frame (excl::current-thread))))
+ (loop for frame = top-frame then (next-frame frame)
+ for i from 0
+ while (and frame (< i 30))
+ when (eq (debugger:frame-name frame) magic-symbol)
+ return (next-frame frame)
+ finally (return top-frame))))
+
+(defun next-frame (frame)
+ (let ((next (excl::int-next-older-frame frame)))
+ (cond ((not next) nil)
+ ((debugger:frame-visible-p next) next)
+ (t (next-frame next)))))
+
+(defun nth-frame (index)
+ (do ((frame *sldb-topframe* (next-frame frame))
+ (i index (1- i)))
+ ((zerop i) frame)))
+
+(defimplementation compute-backtrace (start end)
+ (let ((end (or end most-positive-fixnum)))
+ (loop for f = (nth-frame start) then (next-frame f)
+ for i from start below end
+ while f collect f)))
+
+(defimplementation print-frame (frame stream)
+ (debugger:output-frame stream frame :moderate))
+
+(defimplementation frame-locals (index)
+ (let ((frame (nth-frame index)))
+ (loop for i from 0 below (debugger:frame-number-vars frame)
+ collect (list :name (debugger:frame-var-name frame i)
+ :id 0
+ :value (debugger:frame-var-value frame i)))))
+
+(defimplementation frame-var-value (frame var)
+ (let ((frame (nth-frame frame)))
+ (debugger:frame-var-value frame var)))
+
+(defimplementation disassemble-frame (index)
+ (let ((frame (nth-frame index)))
+ (multiple-value-bind (x fun xx xxx pc) (debugger::dyn-fd-analyze frame)
+ (format t "pc: ~d (~s ~s ~s)~%fun: ~a~%" pc x xx xxx fun)
+ (disassemble (debugger:frame-function frame)))))
+
+(defimplementation frame-source-location (index)
+ (let* ((frame (nth-frame index)))
+ (multiple-value-bind (x fun xx xxx pc) (debugger::dyn-fd-analyze frame)
+ (declare (ignore x xx xxx))
+ (cond ((and pc
+ #+(version>= 8 2)
+ (pc-source-location fun pc)
+ #-(version>= 8 2)
+ (function-source-location fun)))
+ (t ; frames for unbound functions etc end up here
+ (cadr (car (fspec-definition-locations
+ (car (debugger:frame-expression frame))))))))))
+
+(defun function-source-location (fun)
+ (cadr (car (fspec-definition-locations
+ (xref::object-to-function-name fun)))))
+
+#+(version>= 8 2)
+(defun pc-source-location (fun pc)
+ (let* ((debug-info (excl::function-source-debug-info fun)))
+ (cond ((not debug-info)
+ (function-source-location fun))
+ (t
+ (let* ((code-loc (find-if (lambda (c)
+ (<= (- pc (sys::natural-width))
+ (let ((x (excl::ldb-code-pc c)))
+ (or x -1))
+ pc))
+ debug-info)))
+ (cond ((not code-loc)
+ (ldb-code-to-src-loc (aref debug-info 0)))
+ (t
+ (ldb-code-to-src-loc code-loc))))))))
+
+#+(version>= 8 2)
+(defun ldb-code-to-src-loc (code)
+ (declare (optimize debug))
+ (let* ((func (excl::ldb-code-func code))
+ (debug-info (excl::function-source-debug-info func))
+ (start (loop for i from (excl::ldb-code-index code) downto 0
+ for bpt = (aref debug-info i)
+ for start = (excl::ldb-code-start-char bpt)
+ when start return start))
+ (src-file (excl:source-file func)))
+ (cond (start
+ (buffer-or-file-location src-file start))
+ (func
+ (let* ((debug-info (excl::function-source-debug-info func))
+ (whole (aref debug-info 0))
+ (paths (source-paths-of (excl::ldb-code-source whole)
+ (excl::ldb-code-source code)))
+ (path (if paths (longest-common-prefix paths) '()))
+ (start 0))
+ (buffer-or-file
+ src-file
+ (lambda (file)
+ (make-location `(:file ,file)
+ `(:source-path (0 . ,path) ,start)))
+ (lambda (buffer bstart)
+ (make-location `(:buffer ,buffer)
+ `(:source-path (0 . ,path)
+ ,(+ bstart start)))))))
+ (t
+ nil))))
+
+(defun longest-common-prefix (sequences)
+ (assert sequences)
+ (flet ((common-prefix (s1 s2)
+ (let ((diff-pos (mismatch s1 s2)))
+ (if diff-pos (subseq s1 0 diff-pos) s1))))
+ (reduce #'common-prefix sequences)))
+
+(defun source-paths-of (whole part)
+ (let ((result '()))
+ (labels ((walk (form path)
+ (cond ((eq form part)
+ (push (reverse path) result))
+ ((consp form)
+ (loop for i from 0 while (consp form) do
+ (walk (pop form) (cons i path)))))))
+ (walk whole '())
+ (reverse result))))
+
+(defimplementation eval-in-frame (form frame-number)
+ (let ((frame (nth-frame frame-number)))
+ ;; let-bind lexical variables
+ (let ((vars (loop for i below (debugger:frame-number-vars frame)
+ for name = (debugger:frame-var-name frame i)
+ if (typep name '(and symbol (not null) (not keyword)))
+ collect `(,name ',(debugger:frame-var-value frame i)))))
+ (debugger:eval-form-in-context
+ `(let* ,vars ,form)
+ (debugger:environment-of-frame frame)))))
+
+(defimplementation frame-package (frame-number)
+ (let* ((frame (nth-frame frame-number))
+ (exp (debugger:frame-expression frame)))
+ (typecase exp
+ ((cons symbol) (symbol-package (car exp)))
+ ((cons (cons (eql :internal) (cons symbol)))
+ (symbol-package (cadar exp))))))
+
+(defimplementation return-from-frame (frame-number form)
+ (let ((frame (nth-frame frame-number)))
+ (multiple-value-call #'debugger:frame-return
+ frame (debugger:eval-form-in-context
+ form
+ (debugger:environment-of-frame frame)))))
+
+(defimplementation frame-restartable-p (frame)
+ (handler-case (debugger:frame-retryable-p frame)
+ (serious-condition (c)
+ (funcall (read-from-string "swank::background-message")
+ "~a ~a" frame (princ-to-string c))
+ nil)))
+
+(defimplementation restart-frame (frame-number)
+ (let ((frame (nth-frame frame-number)))
+ (cond ((debugger:frame-retryable-p frame)
+ (apply #'debugger:frame-retry frame (debugger:frame-function frame)
+ (cdr (debugger:frame-expression frame))))
+ (t "Frame is not retryable"))))
+
+;;;; Compiler hooks
+
+(defvar *buffer-name* nil)
+(defvar *buffer-start-position*)
+(defvar *buffer-string*)
+(defvar *compile-filename* nil)
+
+(defun compiler-note-p (object)
+ (member (type-of object) '(excl::compiler-note compiler::compiler-note)))
+
+(defun redefinition-p (condition)
+ (and (typep condition 'style-warning)
+ (every #'char-equal "redefin" (princ-to-string condition))))
+
+(defun compiler-undefined-functions-called-warning-p (object)
+ (typep object 'excl:compiler-undefined-functions-called-warning))
+
+(deftype compiler-note ()
+ `(satisfies compiler-note-p))
+
+(deftype redefinition ()
+ `(satisfies redefinition-p))
+
+(defun signal-compiler-condition (&rest args)
+ (apply #'signal 'compiler-condition args))
+
+(defun handle-compiler-warning (condition)
+ (declare (optimize (debug 3) (speed 0) (space 0)))
+ (cond ((and #-(version>= 10 0) (not *buffer-name*)
+ (compiler-undefined-functions-called-warning-p condition))
+ (handle-undefined-functions-warning condition))
+ ((and (typep condition 'excl::compiler-note)
+ (let ((format (slot-value condition 'excl::format-control)))
+ (and (search "Closure" format)
+ (search "will be stack allocated" format))))
+ ;; Ignore "Closure <foo> will be stack allocated" notes.
+ ;; That occurs often but is usually uninteresting.
+ )
+ (t
+ (signal-compiler-condition
+ :original-condition condition
+ :severity (etypecase condition
+ (redefinition :redefinition)
+ (style-warning :style-warning)
+ (warning :warning)
+ (compiler-note :note)
+ (reader-error :read-error)
+ (error :error))
+ :message (format nil "~A" condition)
+ :location (compiler-warning-location condition)))))
+
+(defun condition-pathname-and-position (condition)
+ (let* ((context #+(version>= 10 0)
+ (getf (slot-value condition 'excl::plist)
+ :source-context))
+ (location-available (and context
+ (excl::source-context-start-char context))))
+ (cond (location-available
+ (values (excl::source-context-pathname context)
+ (when-let (start-char (excl::source-context-start-char context))
+ (1+ (if (listp start-char) ; HACK
+ (first start-char)
+ start-char)))))
+ ((typep condition 'reader-error)
+ (let ((pos (car (last (slot-value condition 'excl::format-arguments))))
+ (file (pathname (stream-error-stream condition))))
+ (when (integerp pos)
+ (values file pos))))
+ (t
+ (let ((loc (getf (slot-value condition 'excl::plist) :loc)))
+ (when loc
+ (destructuring-bind (file . pos) loc
+ (let ((start (if (consp pos) ; 8.2 and newer
+ (car pos)
+ pos)))
+ (values file (1+ start))))))))))
+
+(defun compiler-warning-location (condition)
+ (multiple-value-bind (pathname position)
+ (condition-pathname-and-position condition)
+ (cond (*buffer-name*
+ (make-location
+ (list :buffer *buffer-name*)
+ (if position
+ (list :position position)
+ (list :offset *buffer-start-position* 0))))
+ (pathname
+ (make-location
+ (list :file (namestring (truename pathname)))
+ (list :position position)))
+ (t
+ (make-error-location "No error location available.")))))
+
+;; TODO: report it as a bug to Franz that the condition's plist
+;; slot contains (:loc nil).
+(defun handle-undefined-functions-warning (condition)
+ (let ((fargs (slot-value condition 'excl::format-arguments)))
+ (loop for (fname . locs) in (car fargs) do
+ (dolist (loc locs)
+ (multiple-value-bind (pos file) (ecase (length loc)
+ (2 (values-list loc))
+ (3 (destructuring-bind
+ (start end file) loc
+ (declare (ignore end))
+ (values start file))))
+ (signal-compiler-condition
+ :original-condition condition
+ :severity :warning
+ :message (format nil "Undefined function referenced: ~S"
+ fname)
+ :location (make-location (list :file file)
+ (list :position (1+ pos)))))))))
+
+(defimplementation call-with-compilation-hooks (function)
+ (handler-bind ((warning #'handle-compiler-warning)
+ (compiler-note #'handle-compiler-warning)
+ (reader-error #'handle-compiler-warning))
+ (funcall function)))
+
+(defimplementation swank-compile-file (input-file output-file
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
+ (handler-case
+ (with-compilation-hooks ()
+ (let ((*buffer-name* nil)
+ (*compile-filename* input-file)
+ #+(version>= 8 2)
+ (compiler:save-source-level-debug-info-switch t)
+ (excl:*load-source-file-info* t)
+ #+(version>= 8 2)
+ (excl:*load-source-debug-info* t))
+ (compile-file *compile-filename*
+ :output-file output-file
+ :load-after-compile load-p
+ :external-format external-format)))
+ (reader-error () (values nil nil t))))
+
+(defun call-with-temp-file (fn)
+ (let ((tmpname (system:make-temp-file-name)))
+ (unwind-protect
+ (with-open-file (file tmpname :direction :output :if-exists :error)
+ (funcall fn file tmpname))
+ (delete-file tmpname))))
+
+(defvar *temp-file-map* (make-hash-table :test #'equal)
+ "A mapping from tempfile names to Emacs buffer names.")
+
+(defun write-tracking-preamble (stream file file-offset)
+ "Instrument the top of the temporary file to be compiled.
+
+The header tells allegro that any definitions compiled in the temp
+file should be found in FILE exactly at FILE-OFFSET. To get Allegro
+to do this, this factors in the length of the inserted header itself."
+ (with-standard-io-syntax
+ (let* ((*package* (find-package :keyword))
+ (source-pathname-form
+ `(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+ (cl:setq excl::*source-pathname*
+ (pathname ,(sys::frob-source-file file)))))
+ (source-pathname-string (write-to-string source-pathname-form))
+ (position-form-length-bound 160) ; should be enough for everyone
+ (header-length (+ (length source-pathname-string)
+ position-form-length-bound))
+ (position-form
+ `(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+ (cl:setq excl::*partial-source-file-p* ,(- file-offset
+ header-length
+ 1 ; for the newline
+ ))))
+ (position-form-string (write-to-string position-form))
+ (padding-string (make-string (- position-form-length-bound
+ (length position-form-string))
+ :initial-element #\;)))
+ (write-string source-pathname-string stream)
+ (write-string position-form-string stream)
+ (write-string padding-string stream)
+ (write-char #\newline stream))))
+
+(defun compile-from-temp-file (string buffer offset file)
+ (call-with-temp-file
+ (lambda (stream filename)
+ (when (and file offset (probe-file file))
+ (write-tracking-preamble stream file offset))
+ (write-string string stream)
+ (finish-output stream)
+ (multiple-value-bind (binary-filename warnings? failure?)
+ (let ((sys:*source-file-types* '(nil)) ; suppress .lisp extension
+ #+(version>= 8 2)
+ (compiler:save-source-level-debug-info-switch t)
+ (excl:*redefinition-warnings* nil))
+ (compile-file filename))
+ (declare (ignore warnings?))
+ (when binary-filename
+ (let ((excl:*load-source-file-info* t)
+ #+(version>= 8 2)
+ (excl:*load-source-debug-info* t))
+ excl::*source-pathname*
+ (load binary-filename))
+ (when (and buffer offset (or (not file)
+ (not (probe-file file))))
+ (setf (gethash (pathname stream) *temp-file-map*)
+ (list buffer offset)))
+ (delete-file binary-filename))
+ (not failure?)))))
+
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore policy))
+ (handler-case
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer)
+ (*buffer-start-position* position)
+ (*buffer-string* string))
+ (compile-from-temp-file string buffer position filename)))
+ (reader-error () nil)))
+
+;;;; Definition Finding
+
+(defun buffer-or-file (file file-fun buffer-fun)
+ (let* ((probe (gethash file *temp-file-map*)))
+ (cond (probe
+ (destructuring-bind (buffer start) probe
+ (funcall buffer-fun buffer start)))
+ (t (funcall file-fun (namestring (truename file)))))))
+
+(defun buffer-or-file-location (file offset)
+ (buffer-or-file file
+ (lambda (filename)
+ (make-location `(:file ,filename)
+ `(:position ,(1+ offset))))
+ (lambda (buffer start)
+ (make-location `(:buffer ,buffer)
+ `(:offset ,start ,offset)))))
+
+(defun fspec-primary-name (fspec)
+ (etypecase fspec
+ (symbol fspec)
+ (list (fspec-primary-name (second fspec)))))
+
+(defun find-definition-in-file (fspec type file top-level)
+ (let* ((part
+ (or (scm::find-definition-in-definition-group
+ fspec type (scm:section-file :file file)
+ :top-level top-level)
+ (scm::find-definition-in-definition-group
+ (fspec-primary-name fspec)
+ type (scm:section-file :file file)
+ :top-level top-level)))
+ (start (and part
+ (scm::source-part-start part)))
+ (pos (if start
+ (list :position (1+ start))
+ (list :function-name (string (fspec-primary-name fspec))))))
+ (make-location (list :file (namestring (truename file)))
+ pos)))
+
+(defun find-fspec-location (fspec type file top-level)
+ (handler-case
+ (etypecase file
+ (pathname
+ (let ((probe (gethash file *temp-file-map*)))
+ (cond (probe
+ (destructuring-bind (buffer offset) probe
+ (make-location `(:buffer ,buffer)
+ `(:offset ,offset 0))))
+ (t
+ (find-definition-in-file fspec type file top-level)))))
+ ((member :top-level)
+ (make-error-location "Defined at toplevel: ~A"
+ (fspec->string fspec))))
+ (error (e)
+ (make-error-location "Error: ~A" e))))
+
+(defun fspec->string (fspec)
+ (typecase fspec
+ (symbol (let ((*package* (find-package :keyword)))
+ (prin1-to-string fspec)))
+ (list (format nil "(~A ~A)"
+ (prin1-to-string (first fspec))
+ (let ((*package* (find-package :keyword)))
+ (prin1-to-string (second fspec)))))
+ (t (princ-to-string fspec))))
+
+(defun fspec-definition-locations (fspec)
+ (cond
+ ((and (listp fspec) (eq (car fspec) :internal))
+ (destructuring-bind (_internal next _n) fspec
+ (declare (ignore _internal _n))
+ (fspec-definition-locations next)))
+ (t
+ (let ((defs (excl::find-source-file fspec)))
+ (when (and (null defs)
+ (listp fspec)
+ (string= (car fspec) '#:method))
+ ;; If methods are defined in a defgeneric form, the source location is
+ ;; recorded for the gf but not for the methods. Therefore fall back to
+ ;; the gf as the likely place of definition.
+ (setq defs (excl::find-source-file (second fspec))))
+ (if (null defs)
+ (list
+ (list fspec
+ (make-error-location "Unknown source location for ~A"
+ (fspec->string fspec))))
+ (loop for (fspec type file top-level) in defs collect
+ (list (list type fspec)
+ (find-fspec-location fspec type file top-level))))))))
+
+(defimplementation find-definitions (symbol)
+ (fspec-definition-locations symbol))
+
+(defimplementation find-source-location (obj)
+ (first (rest (first (fspec-definition-locations obj)))))
+
+;;;; XREF
+
+(defmacro defxref (name relation name1 name2)
+ `(defimplementation ,name (x)
+ (xref-result (xref:get-relation ,relation ,name1 ,name2))))
+
+(defxref who-calls :calls :wild x)
+(defxref calls-who :calls x :wild)
+(defxref who-references :uses :wild x)
+(defxref who-binds :binds :wild x)
+(defxref who-macroexpands :macro-calls :wild x)
+(defxref who-sets :sets :wild x)
+
+(defun xref-result (fspecs)
+ (loop for fspec in fspecs
+ append (fspec-definition-locations fspec)))
+
+;; list-callers implemented by groveling through all fbound symbols.
+;; Only symbols are considered. Functions in the constant pool are
+;; searched recursively. Closure environments are ignored at the
+;; moment (constants in methods are therefore not found).
+
+(defun map-function-constants (function fn depth)
+ "Call FN with the elements of FUNCTION's constant pool."
+ (do ((i 0 (1+ i))
+ (max (excl::function-constant-count function)))
+ ((= i max))
+ (let ((c (excl::function-constant function i)))
+ (cond ((and (functionp c)
+ (not (eq c function))
+ (plusp depth))
+ (map-function-constants c fn (1- depth)))
+ (t
+ (funcall fn c))))))
+
+(defun in-constants-p (fun symbol)
+ (map-function-constants fun
+ (lambda (c)
+ (when (eq c symbol)
+ (return-from in-constants-p t)))
+ 3))
+
+(defun function-callers (name)
+ (let ((callers '()))
+ (do-all-symbols (sym)
+ (when (fboundp sym)
+ (let ((fn (fdefinition sym)))
+ (when (in-constants-p fn name)
+ (push sym callers)))))
+ callers))
+
+(defimplementation list-callers (name)
+ (xref-result (function-callers name)))
+
+(defimplementation list-callees (name)
+ (let ((result '()))
+ (map-function-constants (fdefinition name)
+ (lambda (c)
+ (when (fboundp c)
+ (push c result)))
+ 2)
+ (xref-result result)))
+
+;;;; Profiling
+
+;; Per-function profiling based on description in
+;; http://www.franz.com/support/documentation/8.0/\
+;; doc/runtime-analyzer.htm#data-collection-control-2
+
+(defvar *profiled-functions* ())
+(defvar *profile-depth* 0)
+
+(defmacro with-redirected-y-or-n-p (&body body)
+ ;; If the profiler is restarted when the data from the previous
+ ;; session is not reported yet, the user is warned via Y-OR-N-P.
+ ;; As the CL:Y-OR-N-P question is (for some reason) not directly
+ ;; sent to the Slime user, the function CL:Y-OR-N-P is temporarily
+ ;; overruled.
+ `(let* ((pkg (find-package :common-lisp))
+ (saved-pdl (excl::package-definition-lock pkg))
+ (saved-ynp (symbol-function 'cl:y-or-n-p)))
+ (setf (excl::package-definition-lock pkg) nil
+ (symbol-function 'cl:y-or-n-p)
+ (symbol-function (read-from-string "swank:y-or-n-p-in-emacs")))
+ (unwind-protect
+ (progn ,@body)
+ (setf (symbol-function 'cl:y-or-n-p) saved-ynp
+ (excl::package-definition-lock pkg) saved-pdl))))
+
+(defun start-acl-profiler ()
+ (with-redirected-y-or-n-p
+ (prof:start-profiler :type :time :count t
+ :start-sampling-p nil :verbose nil)))
+(defun acl-profiler-active-p ()
+ (not (eq (prof:profiler-status :verbose nil) :inactive)))
+
+(defun stop-acl-profiler ()
+ (prof:stop-profiler :verbose nil))
+
+(excl:def-fwrapper profile-fwrapper (&rest args)
+ ;; Ensures sampling is done during the execution of the function,
+ ;; taking into account recursion.
+ (declare (ignore args))
+ (cond ((zerop *profile-depth*)
+ (let ((*profile-depth* (1+ *profile-depth*)))
+ (prof:start-sampling)
+ (unwind-protect (excl:call-next-fwrapper)
+ (prof:stop-sampling))))
+ (t
+ (excl:call-next-fwrapper))))
+
+(defimplementation profile (fname)
+ (unless (acl-profiler-active-p)
+ (start-acl-profiler))
+ (excl:fwrap fname 'profile-fwrapper 'profile-fwrapper)
+ (push fname *profiled-functions*))
+
+(defimplementation profiled-functions ()
+ *profiled-functions*)
+
+(defimplementation unprofile (fname)
+ (excl:funwrap fname 'profile-fwrapper)
+ (setq *profiled-functions* (remove fname *profiled-functions*)))
+
+(defimplementation profile-report ()
+ (prof:show-flat-profile :verbose nil)
+ (when *profiled-functions*
+ (start-acl-profiler)))
+
+(defimplementation profile-reset ()
+ (when (acl-profiler-active-p)
+ (stop-acl-profiler)
+ (start-acl-profiler))
+ "Reset profiling counters.")
+
+;;;; Inspecting
+
+(excl:without-redefinition-warnings
+(defmethod emacs-inspect ((o t))
+ (allegro-inspect o)))
+
+(defmethod emacs-inspect ((o function))
+ (allegro-inspect o))
+
+(defmethod emacs-inspect ((o standard-object))
+ (allegro-inspect o))
+
+(defun allegro-inspect (o)
+ (loop for (d dd) on (inspect::inspect-ctl o)
+ append (frob-allegro-field-def o d)
+ until (eq d dd)))
+
+(defun frob-allegro-field-def (object def)
+ (with-struct (inspect::field-def- name type access) def
+ (ecase type
+ ((:unsigned-word :unsigned-byte :unsigned-natural
+ :unsigned-long :unsigned-half-long
+ :unsigned-3byte :unsigned-long32)
+ (label-value-line name (inspect::component-ref-v object access type)))
+ ((:lisp :value :func)
+ (label-value-line name (inspect::component-ref object access)))
+ (:indirect
+ (destructuring-bind (prefix count ref set) access
+ (declare (ignore set prefix))
+ (loop for i below (funcall count object)
+ append (label-value-line (format nil "~A-~D" name i)
+ (funcall ref object i))))))))
+
+;;;; Multithreading
+
+(defimplementation initialize-multiprocessing (continuation)
+ (mp:start-scheduler)
+ (funcall continuation))
+
+(defimplementation spawn (fn &key name)
+ (mp:process-run-function name fn))
+
+(defvar *id-lock* (mp:make-process-lock :name "id lock"))
+(defvar *thread-id-counter* 0)
+
+(defimplementation thread-id (thread)
+ (mp:with-process-lock (*id-lock*)
+ (or (getf (mp:process-property-list thread) 'id)
+ (setf (getf (mp:process-property-list thread) 'id)
+ (incf *thread-id-counter*)))))
+
+(defimplementation find-thread (id)
+ (find id mp:*all-processes*
+ :key (lambda (p) (getf (mp:process-property-list p) 'id))))
+
+(defimplementation thread-name (thread)
+ (mp:process-name thread))
+
+(defimplementation thread-status (thread)
+ (princ-to-string (mp:process-whostate thread)))
+
+(defimplementation thread-attributes (thread)
+ (list :priority (mp:process-priority thread)
+ :times-resumed (mp:process-times-resumed thread)))
+
+(defimplementation make-lock (&key name)
+ (mp:make-process-lock :name name))
+
+(defimplementation call-with-lock-held (lock function)
+ (mp:with-process-lock (lock) (funcall function)))
+
+(defimplementation current-thread ()
+ mp:*current-process*)
+
+(defimplementation all-threads ()
+ (copy-list mp:*all-processes*))
+
+(defimplementation interrupt-thread (thread fn)
+ (mp:process-interrupt thread fn))
+
+(defimplementation kill-thread (thread)
+ (mp:process-kill thread))
+
+(defvar *mailbox-lock* (mp:make-process-lock :name "mailbox lock"))
+
+(defstruct (mailbox (:conc-name mailbox.))
+ (lock (mp:make-process-lock :name "process mailbox"))
+ (queue '() :type list)
+ (gate (mp:make-gate nil)))
+
+(defun mailbox (thread)
+ "Return THREAD's mailbox."
+ (mp:with-process-lock (*mailbox-lock*)
+ (or (getf (mp:process-property-list thread) 'mailbox)
+ (setf (getf (mp:process-property-list thread) 'mailbox)
+ (make-mailbox)))))
+
+(defimplementation send (thread message)
+ (let* ((mbox (mailbox thread)))
+ (mp:with-process-lock ((mailbox.lock mbox))
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message)))
+ (mp:open-gate (mailbox.gate mbox)))))
+
+(defimplementation receive-if (test &optional timeout)
+ (let ((mbox (mailbox mp:*current-process*)))
+ (assert (or (not timeout) (eq timeout t)))
+ (loop
+ (check-slime-interrupts)
+ (mp:with-process-lock ((mailbox.lock mbox))
+ (let* ((q (mailbox.queue mbox))
+ (tail (member-if test q)))
+ (when tail
+ (setf (mailbox.queue mbox) (nconc (ldiff q tail) (cdr tail)))
+ (return (car tail)))
+ (mp:close-gate (mailbox.gate mbox))))
+ (when (eq timeout t) (return (values nil t)))
+ (mp:process-wait-with-timeout "receive-if" 0.5
+ #'mp:gate-open-p (mailbox.gate mbox)))))
+
+(let ((alist '())
+ (lock (mp:make-process-lock :name "register-thread")))
+
+ (defimplementation register-thread (name thread)
+ (declare (type symbol name))
+ (mp:with-process-lock (lock)
+ (etypecase thread
+ (null
+ (setf alist (delete name alist :key #'car)))
+ (mp:process
+ (let ((probe (assoc name alist)))
+ (cond (probe (setf (cdr probe) thread))
+ (t (setf alist (acons name thread alist))))))))
+ nil)
+
+ (defimplementation find-registered (name)
+ (mp:with-process-lock (lock)
+ (cdr (assoc name alist)))))
+
+(defimplementation set-default-initial-binding (var form)
+ (push (cons var form)
+ #+(version>= 9 0)
+ excl:*required-thread-bindings*
+ #-(version>= 9 0)
+ excl::required-thread-bindings))
+
+(defimplementation quit-lisp ()
+ (excl:exit 0 :quiet t))
+
+
+;;Trace implementations
+;;In Allegro 7.0, we have:
+;; (trace <name>)
+;; (trace ((method <name> <qualifier>? (<specializer>+))))
+;; (trace ((labels <name> <label-name>)))
+;; (trace ((labels (method <name> (<specializer>+)) <label-name>)))
+;; <name> can be a normal name or a (setf name)
+
+(defimplementation toggle-trace (spec)
+ (ecase (car spec)
+ ((setf)
+ (toggle-trace-aux spec))
+ (:defgeneric (toggle-trace-generic-function-methods (second spec)))
+ ((setf :defmethod :labels :flet)
+ (toggle-trace-aux (process-fspec-for-allegro spec)))
+ (:call
+ (destructuring-bind (caller callee) (cdr spec)
+ (toggle-trace-aux callee
+ :inside (list (process-fspec-for-allegro caller)))))))
+
+(defun tracedp (fspec)
+ (member fspec (eval '(trace)) :test #'equal))
+
+(defun toggle-trace-aux (fspec &rest args)
+ (cond ((tracedp fspec)
+ (eval `(untrace ,fspec))
+ (format nil "~S is now untraced." fspec))
+ (t
+ (eval `(trace (,fspec ,@args)))
+ (format nil "~S is now traced." fspec))))
+
+(defun toggle-trace-generic-function-methods (name)
+ (let ((methods (mop:generic-function-methods (fdefinition name))))
+ (cond ((tracedp name)
+ (eval `(untrace ,name))
+ (dolist (method methods (format nil "~S is now untraced." name))
+ (excl:funtrace (mop:method-function method))))
+ (t
+ (eval `(trace (,name)))
+ (dolist (method methods (format nil "~S is now traced." name))
+ (excl:ftrace (mop:method-function method)))))))
+
+(defun process-fspec-for-allegro (fspec)
+ (cond ((consp fspec)
+ (ecase (first fspec)
+ ((setf) fspec)
+ ((:defun :defgeneric) (second fspec))
+ ((:defmethod) `(method ,@(rest fspec)))
+ ((:labels) `(labels ,(process-fspec-for-allegro (second fspec))
+ ,(third fspec)))
+ ((:flet) `(flet ,(process-fspec-for-allegro (second fspec))
+ ,(third fspec)))))
+ (t
+ fspec)))
+
+
+;;;; Weak hashtables
+
+(defimplementation make-weak-key-hash-table (&rest args)
+ (apply #'make-hash-table :weak-keys t args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+ (apply #'make-hash-table :values :weak args))
+
+(defimplementation hash-table-weakness (hashtable)
+ (cond ((excl:hash-table-weak-keys hashtable) :key)
+ ((eq (excl:hash-table-values hashtable) :weak) :value)))
+
+
+
+;;;; Character names
+
+(defimplementation character-completion-set (prefix matchp)
+ (loop for name being the hash-keys of excl::*name-to-char-table*
+ when (funcall matchp prefix name)
+ collect (string-capitalize name)))
+
+
+;;;; wrap interface implementation
+
+(defimplementation wrap (spec indicator &key before after replace)
+ (let ((allegro-spec (process-fspec-for-allegro spec)))
+ (excl:fwrap allegro-spec
+ indicator
+ (excl:def-fwrapper allegro-wrapper (&rest args)
+ (let (retlist completed)
+ (unwind-protect
+ (progn
+ (when before
+ (funcall before args))
+ (setq retlist (multiple-value-list
+ (if replace
+ (funcall replace args)
+ (excl:call-next-fwrapper))))
+ (setq completed t)
+ (values-list retlist))
+ (when after
+ (funcall after (if completed
+ retlist
+ :exited-non-locally)))))))
+ allegro-spec))
+
+(defimplementation unwrap (spec indicator)
+ (let ((allegro-spec (process-fspec-for-allegro spec)))
+ (excl:funwrap allegro-spec indicator)
+ allegro-spec))
+
+(defimplementation wrapped-p (spec indicator)
+ (getf (excl:fwrap-order (process-fspec-for-allegro spec)) indicator))
diff --git a/vim/bundle/slimv/slime/swank/backend.lisp b/vim/bundle/slimv/slime/swank/backend.lisp
new file mode 100644
index 0000000..81023df
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/backend.lisp
@@ -0,0 +1,1536 @@
+;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;;*" -*-
+;;;
+;;; slime-backend.lisp --- SLIME backend interface.
+;;;
+;;; Created by James Bielman in 2003. Released into the public domain.
+;;;
+;;;; Frontmatter
+;;;
+;;; This file defines the functions that must be implemented
+;;; separately for each Lisp. Each is declared as a generic function
+;;; for which swank-<implementation>.lisp provides methods.
+
+(in-package swank/backend)
+
+
+;;;; Metacode
+
+(defparameter *debug-swank-backend* nil
+ "If this is true, backends should not catch errors but enter the
+debugger where appropriate. Also, they should not perform backtrace
+magic but really show every frame including SWANK related ones.")
+
+(defparameter *interface-functions* '()
+ "The names of all interface functions.")
+
+(defparameter *unimplemented-interfaces* '()
+ "List of interface functions that are not implemented.
+DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
+
+(defvar *log-output* nil) ; should be nil for image dumpers
+
+(defmacro definterface (name args documentation &rest default-body)
+ "Define an interface function for the backend to implement.
+A function is defined with NAME, ARGS, and DOCUMENTATION. This
+function first looks for a function to call in NAME's property list
+that is indicated by 'IMPLEMENTATION; failing that, it looks for a
+function indicated by 'DEFAULT. If neither is present, an error is
+signaled.
+
+If a DEFAULT-BODY is supplied, then a function with the same body and
+ARGS will be added to NAME's property list as the property indicated
+by 'DEFAULT.
+
+Backends implement these functions using DEFIMPLEMENTATION."
+ (check-type documentation string "a documentation string")
+ (assert (every #'symbolp args) ()
+ "Complex lambda-list not supported: ~S ~S" name args)
+ (labels ((gen-default-impl ()
+ `(setf (get ',name 'default) (lambda ,args ,@default-body)))
+ (args-as-list (args)
+ (destructuring-bind (req opt key rest) (parse-lambda-list args)
+ `(,@req ,@opt
+ ,@(loop for k in key append `(,(kw k) ,k))
+ ,@(or rest '(())))))
+ (parse-lambda-list (args)
+ (parse args '(&optional &key &rest)
+ (make-array 4 :initial-element nil)))
+ (parse (args keywords vars)
+ (cond ((null args)
+ (reverse (map 'list #'reverse vars)))
+ ((member (car args) keywords)
+ (parse (cdr args) (cdr (member (car args) keywords)) vars))
+ (t (push (car args) (aref vars (length keywords)))
+ (parse (cdr args) keywords vars))))
+ (kw (s) (intern (string s) :keyword)))
+ `(progn
+ (defun ,name ,args
+ ,documentation
+ (let ((f (or (get ',name 'implementation)
+ (get ',name 'default))))
+ (cond (f (apply f ,@(args-as-list args)))
+ (t (error "~S not implemented" ',name)))))
+ (pushnew ',name *interface-functions*)
+ ,(if (null default-body)
+ `(pushnew ',name *unimplemented-interfaces*)
+ (gen-default-impl))
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (export ',name :swank/backend))
+ ',name)))
+
+(defmacro defimplementation (name args &body body)
+ (assert (every #'symbolp args) ()
+ "Complex lambda-list not supported: ~S ~S" name args)
+ `(progn
+ (setf (get ',name 'implementation)
+ ;; For implicit BLOCK. FLET because of interplay w/ decls.
+ (flet ((,name ,args ,@body)) #',name))
+ (if (member ',name *interface-functions*)
+ (setq *unimplemented-interfaces*
+ (remove ',name *unimplemented-interfaces*))
+ (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
+ ',name))
+
+(defun warn-unimplemented-interfaces ()
+ "Warn the user about unimplemented backend features.
+The portable code calls this function at startup."
+ (let ((*print-pretty* t))
+ (warn "These Swank interfaces are unimplemented:~% ~:<~{~A~^ ~:_~}~:>"
+ (list (sort (copy-list *unimplemented-interfaces*) #'string<)))))
+
+(defun import-to-swank-mop (symbol-list)
+ (dolist (sym symbol-list)
+ (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
+ (when swank-mop-sym
+ (unintern swank-mop-sym :swank-mop))
+ (import sym :swank-mop)
+ (export sym :swank-mop))))
+
+(defun import-swank-mop-symbols (package except)
+ "Import the mop symbols from PACKAGE to SWANK-MOP.
+EXCEPT is a list of symbol names which should be ignored."
+ (do-symbols (s :swank-mop)
+ (unless (member s except :test #'string=)
+ (let ((real-symbol (find-symbol (string s) package)))
+ (assert real-symbol () "Symbol ~A not found in package ~A" s package)
+ (unintern s :swank-mop)
+ (import real-symbol :swank-mop)
+ (export real-symbol :swank-mop)))))
+
+(definterface gray-package-name ()
+ "Return a package-name that contains the Gray stream symbols.
+This will be used like so:
+ (defpackage foo
+ (:import-from #.(gray-package-name) . #.*gray-stream-symbols*)")
+
+
+;;;; Utilities
+
+(defmacro with-struct ((conc-name &rest names) obj &body body)
+ "Like with-slots but works only for structs."
+ (check-type conc-name symbol)
+ (flet ((reader (slot)
+ (intern (concatenate 'string
+ (symbol-name conc-name)
+ (symbol-name slot))
+ (symbol-package conc-name))))
+ (let ((tmp (gensym "OO-")))
+ ` (let ((,tmp ,obj))
+ (symbol-macrolet
+ ,(loop for name in names collect
+ (typecase name
+ (symbol `(,name (,(reader name) ,tmp)))
+ (cons `(,(first name) (,(reader (second name)) ,tmp)))
+ (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
+ ,@body)))))
+
+(defmacro when-let ((var value) &body body)
+ `(let ((,var ,value))
+ (when ,var ,@body)))
+
+(defun boolean-to-feature-expression (value)
+ "Converts a boolean VALUE to a form suitable for testing with #+."
+ (if value
+ '(:and)
+ '(:or)))
+
+(defun with-symbol (name package)
+ "Check if a symbol with a given NAME exists in PACKAGE and returns a
+form suitable for testing with #+."
+ (boolean-to-feature-expression
+ (and (find-package package)
+ (find-symbol (string name) package))))
+
+(defun choose-symbol (package name alt-package alt-name)
+ "If symbol package:name exists return that symbol, otherwise alt-package:alt-name.
+ Suitable for use with #."
+ (or (and (find-package package)
+ (find-symbol (string name) package))
+ (find-symbol (string alt-name) alt-package)))
+
+
+;;;; UFT8
+
+(deftype octet () '(unsigned-byte 8))
+(deftype octets () '(simple-array octet (*)))
+
+;; Helper function. Decode the next N bytes starting from INDEX.
+;; Return the decoded char and the new index.
+(defun utf8-decode-aux (buffer index limit byte0 n)
+ (declare (type octets buffer) (fixnum index limit byte0 n))
+ (if (< (- limit index) n)
+ (values nil index)
+ (do ((i 0 (1+ i))
+ (code byte0 (let ((byte (aref buffer (+ index i))))
+ (cond ((= (ldb (byte 2 6) byte) #b10)
+ (+ (ash code 6) (ldb (byte 6 0) byte)))
+ (t
+ (error "Invalid encoding"))))))
+ ((= i n)
+ (values (cond ((<= code #xff) (code-char code))
+ ((<= #xd800 code #xdfff)
+ (error "Invalid Unicode code point: #x~x" code))
+ ((and (< code char-code-limit)
+ (code-char code)))
+ (t
+ (error
+ "Can't represent code point: #x~x ~
+ (char-code-limit is #x~x)"
+ code char-code-limit)))
+ (+ index n))))))
+
+;; Decode one character in BUFFER starting at INDEX.
+;; Return 2 values: the character and the new index.
+;; If there aren't enough bytes between INDEX and LIMIT return nil.
+(defun utf8-decode (buffer index limit)
+ (declare (type octets buffer) (fixnum index limit))
+ (if (= index limit)
+ (values nil index)
+ (let ((b (aref buffer index)))
+ (if (<= b #x7f)
+ (values (code-char b) (1+ index))
+ (macrolet ((try (marker else)
+ (let* ((l (integer-length marker))
+ (n (- l 2)))
+ `(if (= (ldb (byte ,l ,(- 8 l)) b) ,marker)
+ (utf8-decode-aux buffer (1+ index) limit
+ (ldb (byte ,(- 8 l) 0) b)
+ ,n)
+ ,else))))
+ (try #b110
+ (try #b1110
+ (try #b11110
+ (try #b111110
+ (try #b1111110
+ (error "Invalid encoding")))))))))))
+
+;; Decode characters from BUFFER and write them to STRING.
+;; Return 2 values: LASTINDEX and LASTSTART where
+;; LASTINDEX is the last index in BUFFER that was not decoded
+;; and LASTSTART is the last index in STRING not written.
+(defun utf8-decode-into (buffer index limit string start end)
+ (declare (string string) (fixnum index limit start end) (type octets buffer))
+ (loop
+ (cond ((= start end)
+ (return (values index start)))
+ (t
+ (multiple-value-bind (c i) (utf8-decode buffer index limit)
+ (cond (c
+ (setf (aref string start) c)
+ (setq index i)
+ (setq start (1+ start)))
+ (t
+ (return (values index start)))))))))
+
+(defun default-utf8-to-string (octets)
+ (let* ((limit (length octets))
+ (str (make-string limit)))
+ (multiple-value-bind (i s) (utf8-decode-into octets 0 limit str 0 limit)
+ (if (= i limit)
+ (if (= limit s)
+ str
+ (adjust-array str s))
+ (loop
+ (let ((end (+ (length str) (- limit i))))
+ (setq str (adjust-array str end))
+ (multiple-value-bind (i2 s2)
+ (utf8-decode-into octets i limit str s end)
+ (cond ((= i2 limit)
+ (return (adjust-array str s2)))
+ (t
+ (setq i i2)
+ (setq s s2))))))))))
+
+(defmacro utf8-encode-aux (code buffer start end n)
+ `(cond ((< (- ,end ,start) ,n)
+ ,start)
+ (t
+ (setf (aref ,buffer ,start)
+ (dpb (ldb (byte ,(- 7 n) ,(* 6 (1- n))) ,code)
+ (byte ,(- 7 n) 0)
+ ,(dpb 0 (byte 1 (- 7 n)) #xff)))
+ ,@(loop for i from 0 upto (- n 2) collect
+ `(setf (aref ,buffer (+ ,start ,(- n 1 i)))
+ (dpb (ldb (byte 6 ,(* 6 i)) ,code)
+ (byte 6 0)
+ #b10111111)))
+ (+ ,start ,n))))
+
+(defun %utf8-encode (code buffer start end)
+ (declare (type (unsigned-byte 31) code) (type octets buffer)
+ (type (and fixnum unsigned-byte) start end))
+ (cond ((<= code #x7f)
+ (cond ((< start end)
+ (setf (aref buffer start) code)
+ (1+ start))
+ (t start)))
+ ((<= code #x7ff) (utf8-encode-aux code buffer start end 2))
+ ((<= #xd800 code #xdfff)
+ (error "Invalid Unicode code point (surrogate): #x~x" code))
+ ((<= code #xffff) (utf8-encode-aux code buffer start end 3))
+ ((<= code #x1fffff) (utf8-encode-aux code buffer start end 4))
+ ((<= code #x3ffffff) (utf8-encode-aux code buffer start end 5))
+ (t (utf8-encode-aux code buffer start end 6))))
+
+(defun utf8-encode (char buffer start end)
+ (declare (type character char) (type octets buffer)
+ (type (and fixnum unsigned-byte) start end))
+ (%utf8-encode (char-code char) buffer start end))
+
+(defun utf8-encode-into (string start end buffer index limit)
+ (declare (string string) (type octets buffer) (fixnum start end index limit))
+ (loop
+ (cond ((= start end)
+ (return (values start index)))
+ ((= index limit)
+ (return (values start index)))
+ (t
+ (let ((i2 (utf8-encode (char string start) buffer index limit)))
+ (cond ((= i2 index)
+ (return (values start index)))
+ (t
+ (setq index i2)
+ (incf start))))))))
+
+(defun default-string-to-utf8 (string)
+ (let* ((len (length string))
+ (b (make-array len :element-type 'octet)))
+ (multiple-value-bind (s i) (utf8-encode-into string 0 len b 0 len)
+ (if (= s len)
+ b
+ (loop
+ (let ((limit (+ (length b) (- len s))))
+ (setq b (coerce (adjust-array b limit) 'octets))
+ (multiple-value-bind (s2 i2)
+ (utf8-encode-into string s len b i limit)
+ (cond ((= s2 len)
+ (return (coerce (adjust-array b i2) 'octets)))
+ (t
+ (setq i i2)
+ (setq s s2))))))))))
+
+(definterface string-to-utf8 (string)
+ "Convert the string STRING to a (simple-array (unsigned-byte 8))"
+ (default-string-to-utf8 string))
+
+(definterface utf8-to-string (octets)
+ "Convert the (simple-array (unsigned-byte 8)) OCTETS to a string."
+ (default-utf8-to-string octets))
+
+
+;;;; TCP server
+
+(definterface create-socket (host port &key backlog)
+ "Create a listening TCP socket on interface HOST and port PORT.
+BACKLOG queue length for incoming connections.")
+
+(definterface local-port (socket)
+ "Return the local port number of SOCKET.")
+
+(definterface close-socket (socket)
+ "Close the socket SOCKET.")
+
+(definterface accept-connection (socket &key external-format
+ buffering timeout)
+ "Accept a client connection on the listening socket SOCKET.
+Return a stream for the new connection.
+If EXTERNAL-FORMAT is nil return a binary stream
+otherwise create a character stream.
+BUFFERING can be one of:
+ nil ... no buffering
+ t ... enable buffering
+ :line ... enable buffering with automatic flushing on eol.")
+
+(definterface add-sigio-handler (socket fn)
+ "Call FN whenever SOCKET is readable.")
+
+(definterface remove-sigio-handlers (socket)
+ "Remove all sigio handlers for SOCKET.")
+
+(definterface add-fd-handler (socket fn)
+ "Call FN when Lisp is waiting for input and SOCKET is readable.")
+
+(definterface remove-fd-handlers (socket)
+ "Remove all fd-handlers for SOCKET.")
+
+(definterface preferred-communication-style ()
+ "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
+ nil)
+
+(definterface set-stream-timeout (stream timeout)
+ "Set the 'stream 'timeout. The timeout is either the real number
+ specifying the timeout in seconds or 'nil for no timeout."
+ (declare (ignore stream timeout))
+ nil)
+
+;;; Base condition for networking errors.
+(define-condition network-error (simple-error) ())
+
+(definterface emacs-connected ()
+ "Hook called when the first connection from Emacs is established.
+Called from the INIT-FN of the socket server that accepts the
+connection.
+
+This is intended for setting up extra context, e.g. to discover
+that the calling thread is the one that interacts with Emacs."
+ nil)
+
+
+;;;; Unix signals
+
+(defconstant +sigint+ 2)
+
+(definterface getpid ()
+ "Return the (Unix) process ID of this superior Lisp.")
+
+(definterface install-sigint-handler (function)
+ "Call FUNCTION on SIGINT (instead of invoking the debugger).
+Return old signal handler."
+ (declare (ignore function))
+ nil)
+
+(definterface call-with-user-break-handler (handler function)
+ "Install the break handler HANDLER while executing FUNCTION."
+ (let ((old-handler (install-sigint-handler handler)))
+ (unwind-protect (funcall function)
+ (install-sigint-handler old-handler))))
+
+(definterface quit-lisp ()
+ "Exit the current lisp image.")
+
+(definterface lisp-implementation-type-name ()
+ "Return a short name for the Lisp implementation."
+ (lisp-implementation-type))
+
+(definterface lisp-implementation-program ()
+ "Return the argv[0] of the running Lisp process, or NIL."
+ (let ((file (car (command-line-args))))
+ (when (and file (probe-file file))
+ (namestring (truename file)))))
+
+(definterface socket-fd (socket-stream)
+ "Return the file descriptor for SOCKET-STREAM.")
+
+(definterface make-fd-stream (fd external-format)
+ "Create a character stream for the file descriptor FD.")
+
+(definterface dup (fd)
+ "Duplicate a file descriptor.
+If the syscall fails, signal a condition.
+See dup(2).")
+
+(definterface exec-image (image-file args)
+ "Replace the current process with a new process image.
+The new image is created by loading the previously dumped
+core file IMAGE-FILE.
+ARGS is a list of strings passed as arguments to
+the new image.
+This is thin wrapper around exec(3).")
+
+(definterface command-line-args ()
+ "Return a list of strings as passed by the OS."
+ nil)
+
+
+;; pathnames are sooo useless
+
+(definterface filename-to-pathname (filename)
+ "Return a pathname for FILENAME.
+A filename in Emacs may for example contain asterisks which should not
+be translated to wildcards."
+ (parse-namestring filename))
+
+(definterface pathname-to-filename (pathname)
+ "Return the filename for PATHNAME."
+ (namestring pathname))
+
+(definterface default-directory ()
+ "Return the default directory."
+ (directory-namestring (truename *default-pathname-defaults*)))
+
+(definterface set-default-directory (directory)
+ "Set the default directory.
+This is used to resolve filenames without directory component."
+ (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
+ (default-directory))
+
+
+(definterface call-with-syntax-hooks (fn)
+ "Call FN with hooks to handle special syntax."
+ (funcall fn))
+
+(definterface default-readtable-alist ()
+ "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
+ '())
+
+
+;;;; Packages
+
+(definterface package-local-nicknames (package)
+ "Returns an alist of (local-nickname . actual-package) describing the
+nicknames local to the designated package."
+ (declare (ignore package))
+ nil)
+
+(definterface find-locally-nicknamed-package (name base-package)
+ "Return the package whose local nickname in BASE-PACKAGE matches NAME.
+Return NIL if local nicknames are not implemented or if there is no
+such package."
+ (cdr (assoc name (package-local-nicknames base-package) :test #'string-equal)))
+
+
+;;;; Compilation
+
+(definterface call-with-compilation-hooks (func)
+ "Call FUNC with hooks to record compiler conditions.")
+
+(defmacro with-compilation-hooks ((&rest ignore) &body body)
+ "Execute BODY as in CALL-WITH-COMPILATION-HOOKS."
+ (declare (ignore ignore))
+ `(call-with-compilation-hooks (lambda () (progn ,@body))))
+
+(definterface swank-compile-string (string &key buffer position filename
+ policy)
+ "Compile source from STRING.
+During compilation, compiler conditions must be trapped and
+resignalled as COMPILER-CONDITIONs.
+
+If supplied, BUFFER and POSITION specify the source location in Emacs.
+
+Additionally, if POSITION is supplied, it must be added to source
+positions reported in compiler conditions.
+
+If FILENAME is specified it may be used by certain implementations to
+rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
+source information.
+
+If POLICY is supplied, and non-NIL, it may be used by certain
+implementations to compile with optimization qualities of its
+value.
+
+Should return T on successful compilation, NIL otherwise.
+")
+
+(definterface swank-compile-file (input-file output-file load-p
+ external-format
+ &key policy)
+ "Compile INPUT-FILE signalling COMPILE-CONDITIONs.
+If LOAD-P is true, load the file after compilation.
+EXTERNAL-FORMAT is a value returned by find-external-format or
+:default.
+
+If POLICY is supplied, and non-NIL, it may be used by certain
+implementations to compile with optimization qualities of its
+value.
+
+Should return OUTPUT-TRUENAME, WARNINGS-P and FAILURE-p
+like `compile-file'")
+
+(deftype severity ()
+ '(member :error :read-error :warning :style-warning :note :redefinition))
+
+;; Base condition type for compiler errors, warnings and notes.
+(define-condition compiler-condition (condition)
+ ((original-condition
+ ;; The original condition thrown by the compiler if appropriate.
+ ;; May be NIL if a compiler does not report using conditions.
+ :type (or null condition)
+ :initarg :original-condition
+ :accessor original-condition)
+
+ (severity :type severity
+ :initarg :severity
+ :accessor severity)
+
+ (message :initarg :message
+ :accessor message)
+
+ ;; Macro expansion history etc. which may be helpful in some cases
+ ;; but is often very verbose.
+ (source-context :initarg :source-context
+ :type (or null string)
+ :initform nil
+ :accessor source-context)
+
+ (references :initarg :references
+ :initform nil
+ :accessor references)
+
+ (location :initarg :location
+ :accessor location)))
+
+(definterface find-external-format (coding-system)
+ "Return a \"external file format designator\" for CODING-SYSTEM.
+CODING-SYSTEM is Emacs-style coding system name (a string),
+e.g. \"latin-1-unix\"."
+ (if (equal coding-system "iso-latin-1-unix")
+ :default
+ nil))
+
+(definterface guess-external-format (pathname)
+ "Detect the external format for the file with name pathname.
+Return nil if the file contains no special markers."
+ ;; Look for a Emacs-style -*- coding: ... -*- or Local Variable: section.
+ (with-open-file (s pathname :if-does-not-exist nil
+ :external-format (or (find-external-format "latin-1-unix")
+ :default))
+ (if s
+ (or (let* ((line (read-line s nil))
+ (p (search "-*-" line)))
+ (when p
+ (let* ((start (+ p (length "-*-")))
+ (end (search "-*-" line :start2 start)))
+ (when end
+ (%search-coding line start end)))))
+ (let* ((len (file-length s))
+ (buf (make-string (min len 3000))))
+ (file-position s (- len (length buf)))
+ (read-sequence buf s)
+ (let ((start (search "Local Variables:" buf :from-end t))
+ (end (search "End:" buf :from-end t)))
+ (and start end (< start end)
+ (%search-coding buf start end))))))))
+
+(defun %search-coding (str start end)
+ (let ((p (search "coding:" str :start2 start :end2 end)))
+ (when p
+ (incf p (length "coding:"))
+ (loop while (and (< p end)
+ (member (aref str p) '(#\space #\tab)))
+ do (incf p))
+ (let ((end (position-if (lambda (c) (find c '(#\space #\tab #\newline)))
+ str :start p)))
+ (find-external-format (subseq str p end))))))
+
+
+;;;; Streams
+
+(definterface make-output-stream (write-string)
+ "Return a new character output stream.
+The stream calls WRITE-STRING when output is ready.")
+
+(definterface make-input-stream (read-string)
+ "Return a new character input stream.
+The stream calls READ-STRING when input is needed.")
+
+
+;;;; Documentation
+
+(definterface arglist (name)
+ "Return the lambda list for the symbol NAME. NAME can also be
+a lisp function object, on lisps which support this.
+
+The result can be a list or the :not-available keyword if the
+arglist cannot be determined."
+ (declare (ignore name))
+ :not-available)
+
+(defgeneric declaration-arglist (decl-identifier)
+ (:documentation
+ "Return the argument list of the declaration specifier belonging to the
+declaration identifier DECL-IDENTIFIER. If the arglist cannot be determined,
+the keyword :NOT-AVAILABLE is returned.
+
+The different SWANK backends can specialize this generic function to
+include implementation-dependend declaration specifiers, or to provide
+additional information on the specifiers defined in ANSI Common Lisp.")
+ (:method (decl-identifier)
+ (case decl-identifier
+ (dynamic-extent '(&rest variables))
+ (ignore '(&rest variables))
+ (ignorable '(&rest variables))
+ (special '(&rest variables))
+ (inline '(&rest function-names))
+ (notinline '(&rest function-names))
+ (declaration '(&rest names))
+ (optimize '(&any compilation-speed debug safety space speed))
+ (type '(type-specifier &rest args))
+ (ftype '(type-specifier &rest function-names))
+ (otherwise
+ (flet ((typespec-p (symbol)
+ (member :type (describe-symbol-for-emacs symbol))))
+ (cond ((and (symbolp decl-identifier) (typespec-p decl-identifier))
+ '(&rest variables))
+ ((and (listp decl-identifier)
+ (typespec-p (first decl-identifier)))
+ '(&rest variables))
+ (t :not-available)))))))
+
+(defgeneric type-specifier-arglist (typespec-operator)
+ (:documentation
+ "Return the argument list of the type specifier belonging to
+TYPESPEC-OPERATOR.. If the arglist cannot be determined, the keyword
+:NOT-AVAILABLE is returned.
+
+The different SWANK backends can specialize this generic function to
+include implementation-dependend declaration specifiers, or to provide
+additional information on the specifiers defined in ANSI Common Lisp.")
+ (:method (typespec-operator)
+ (declare (special *type-specifier-arglists*)) ; defined at end of file.
+ (typecase typespec-operator
+ (symbol (or (cdr (assoc typespec-operator *type-specifier-arglists*))
+ :not-available))
+ (t :not-available))))
+
+(definterface type-specifier-p (symbol)
+ "Determine if SYMBOL is a type-specifier."
+ (or (documentation symbol 'type)
+ (not (eq (type-specifier-arglist symbol) :not-available))))
+
+(definterface function-name (function)
+ "Return the name of the function object FUNCTION.
+
+The result is either a symbol, a list, or NIL if no function name is
+available."
+ (declare (ignore function))
+ nil)
+
+(definterface valid-function-name-p (form)
+ "Is FORM syntactically valid to name a function?
+ If true, FBOUNDP should not signal a type-error for FORM."
+ (flet ((length=2 (list)
+ (and (not (null (cdr list))) (null (cddr list)))))
+ (or (symbolp form)
+ (and (consp form) (length=2 form)
+ (eq (first form) 'setf) (symbolp (second form))))))
+
+(definterface macroexpand-all (form &optional env)
+ "Recursively expand all macros in FORM.
+Return the resulting form.")
+
+(definterface compiler-macroexpand-1 (form &optional env)
+ "Call the compiler-macro for form.
+If FORM is a function call for which a compiler-macro has been
+defined, invoke the expander function using *macroexpand-hook* and
+return the results and T. Otherwise, return the original form and
+NIL."
+ (let ((fun (and (consp form)
+ (valid-function-name-p (car form))
+ (compiler-macro-function (car form) env))))
+ (if fun
+ (let ((result (funcall *macroexpand-hook* fun form env)))
+ (values result (not (eq result form))))
+ (values form nil))))
+
+(definterface compiler-macroexpand (form &optional env)
+ "Repetitively call `compiler-macroexpand-1'."
+ (labels ((frob (form expanded)
+ (multiple-value-bind (new-form newly-expanded)
+ (compiler-macroexpand-1 form env)
+ (if newly-expanded
+ (frob new-form t)
+ (values new-form expanded)))))
+ (frob form env)))
+
+(defmacro with-collected-macro-forms
+ ((forms &optional result) instrumented-form &body body)
+ "Collect macro forms by locally binding *MACROEXPAND-HOOK*.
+
+Evaluates INSTRUMENTED-FORM and collects any forms which undergo
+macro-expansion into a list. Then evaluates BODY with FORMS bound to
+the list of forms, and RESULT (optionally) bound to the value of
+INSTRUMENTED-FORM."
+ (assert (and (symbolp forms) (not (null forms))))
+ (assert (symbolp result))
+ (let ((result-symbol (or result (gensym))))
+ `(call-with-collected-macro-forms
+ (lambda (,forms ,result-symbol)
+ (declare (ignore ,@(and (not result)
+ `(,result-symbol))))
+ ,@body)
+ (lambda () ,instrumented-form))))
+
+(defun call-with-collected-macro-forms (body-fn instrumented-fn)
+ (let ((return-value nil)
+ (collected-forms '()))
+ (let* ((real-macroexpand-hook *macroexpand-hook*)
+ (*macroexpand-hook*
+ (lambda (macro-function form environment)
+ (let ((result (funcall real-macroexpand-hook
+ macro-function form environment)))
+ (unless (eq result form)
+ (push form collected-forms))
+ result))))
+ (setf return-value (funcall instrumented-fn)))
+ (funcall body-fn collected-forms return-value)))
+
+(definterface collect-macro-forms (form &optional env)
+ "Collect subforms of FORM which undergo (compiler-)macro expansion.
+Returns two values: a list of macro forms and a list of compiler macro
+forms."
+ (with-collected-macro-forms (macro-forms expansion)
+ (ignore-errors (macroexpand-all form env))
+ (with-collected-macro-forms (compiler-macro-forms)
+ (handler-bind ((warning #'muffle-warning))
+ (ignore-errors
+ (compile nil `(lambda () ,expansion))))
+ (values macro-forms compiler-macro-forms))))
+
+(definterface format-string-expand (control-string)
+ "Expand the format string CONTROL-STRING."
+ (macroexpand `(formatter ,control-string)))
+
+(definterface describe-symbol-for-emacs (symbol)
+ "Return a property list describing SYMBOL.
+
+The property list has an entry for each interesting aspect of the
+symbol. The recognised keys are:
+
+ :VARIABLE :FUNCTION :SETF :SPECIAL-OPERATOR :MACRO :COMPILER-MACRO
+ :TYPE :CLASS :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
+
+The value of each property is the corresponding documentation string,
+or NIL (or the obsolete :NOT-DOCUMENTED). It is legal to include keys
+not listed here (but slime-print-apropos in Emacs must know about
+them).
+
+Properties should be included if and only if they are applicable to
+the symbol. For example, only (and all) fbound symbols should include
+the :FUNCTION property.
+
+Example:
+\(describe-symbol-for-emacs 'vector)
+ => (:CLASS :NOT-DOCUMENTED
+ :TYPE :NOT-DOCUMENTED
+ :FUNCTION \"Constructs a simple-vector from the given objects.\")")
+
+(definterface describe-definition (name type)
+ "Describe the definition NAME of TYPE.
+TYPE can be any value returned by DESCRIBE-SYMBOL-FOR-EMACS.
+
+Return a documentation string, or NIL if none is available.")
+
+
+;;;; Debugging
+
+(definterface install-debugger-globally (function)
+ "Install FUNCTION as the debugger for all threads/processes. This
+usually involves setting *DEBUGGER-HOOK* and, if the implementation
+permits, hooking into BREAK as well."
+ (setq *debugger-hook* function))
+
+(definterface call-with-debugging-environment (debugger-loop-fn)
+ "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
+
+This function is called recursively at each debug level to invoke the
+debugger loop. The purpose is to setup any necessary environment for
+other debugger callbacks that will be called within the debugger loop.
+
+For example, this is a reasonable place to compute a backtrace, switch
+to safe reader/printer settings, and so on.")
+
+(definterface call-with-debugger-hook (hook fun)
+ "Call FUN and use HOOK as debugger hook. HOOK can be NIL.
+
+HOOK should be called for both BREAK and INVOKE-DEBUGGER."
+ (let ((*debugger-hook* hook))
+ (funcall fun)))
+
+(define-condition sldb-condition (condition)
+ ((original-condition
+ :initarg :original-condition
+ :accessor original-condition))
+ (:report (lambda (condition stream)
+ (format stream "Condition in debugger code~@[: ~A~]"
+ (original-condition condition))))
+ (:documentation
+ "Wrapper for conditions that should not be debugged.
+
+When a condition arises from the internals of the debugger, it is not
+desirable to debug it -- we'd risk entering an endless loop trying to
+debug the debugger! Instead, such conditions can be reported to the
+user without (re)entering the debugger by wrapping them as
+`sldb-condition's."))
+
+;;; The following functions in this section are supposed to be called
+;;; within the dynamic contour of CALL-WITH-DEBUGGING-ENVIRONMENT only.
+
+(definterface compute-backtrace (start end)
+ "Returns a backtrace of the condition currently being debugged,
+that is an ordered list consisting of frames. ``Ordered list''
+means that an integer I can be mapped back to the i-th frame of this
+backtrace.
+
+START and END are zero-based indices constraining the number of frames
+returned. Frame zero is defined as the frame which invoked the
+debugger. If END is nil, return the frames from START to the end of
+the stack.")
+
+(definterface print-frame (frame stream)
+ "Print frame to stream.")
+
+(definterface frame-restartable-p (frame)
+ "Is the frame FRAME restartable?.
+Return T if `restart-frame' can safely be called on the frame."
+ (declare (ignore frame))
+ nil)
+
+(definterface frame-source-location (frame-number)
+ "Return the source location for the frame associated to FRAME-NUMBER.")
+
+(definterface frame-catch-tags (frame-number)
+ "Return a list of catch tags for being printed in a debugger stack
+frame."
+ (declare (ignore frame-number))
+ '())
+
+(definterface frame-locals (frame-number)
+ "Return a list of ((&key NAME ID VALUE) ...) where each element of
+the list represents a local variable in the stack frame associated to
+FRAME-NUMBER.
+
+NAME, a symbol; the name of the local variable.
+
+ID, an integer; used as primary key for the local variable, unique
+relatively to the frame under operation.
+
+value, an object; the value of the local variable.")
+
+(definterface frame-var-value (frame-number var-id)
+ "Return the value of the local variable associated to VAR-ID
+relatively to the frame associated to FRAME-NUMBER.")
+
+(definterface disassemble-frame (frame-number)
+ "Disassemble the code for the FRAME-NUMBER.
+The output should be written to standard output.
+FRAME-NUMBER is a non-negative integer.")
+
+(definterface eval-in-frame (form frame-number)
+ "Evaluate a Lisp form in the lexical context of a stack frame
+in the debugger.
+
+FRAME-NUMBER must be a positive integer with 0 indicating the
+frame which invoked the debugger.
+
+The return value is the result of evaulating FORM in the
+appropriate context.")
+
+(definterface frame-package (frame-number)
+ "Return the package corresponding to the frame at FRAME-NUMBER.
+Return nil if the backend can't figure it out."
+ (declare (ignore frame-number))
+ nil)
+
+(definterface frame-call (frame-number)
+ "Return a string representing a call to the entry point of a frame.")
+
+(definterface return-from-frame (frame-number form)
+ "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
+produced by evaluating FORM in the frame context to its caller.
+
+Execute any clean-up code from unwind-protect forms above the frame
+during unwinding.
+
+Return a string describing the error if it's not possible to return
+from the frame.")
+
+(definterface restart-frame (frame-number)
+ "Restart execution of the frame FRAME-NUMBER with the same arguments
+as it was called originally.")
+
+(definterface print-condition (condition stream)
+ "Print a condition for display in SLDB."
+ (princ condition stream))
+
+(definterface condition-extras (condition)
+ "Return a list of extra for the debugger.
+The allowed elements are of the form:
+ (:SHOW-FRAME-SOURCE frame-number)
+ (:REFERENCES &rest refs)
+"
+ (declare (ignore condition))
+ '())
+
+(definterface gdb-initial-commands ()
+ "List of gdb commands supposed to be executed first for the
+ ATTACH-GDB restart."
+ nil)
+
+(definterface activate-stepping (frame-number)
+ "Prepare the frame FRAME-NUMBER for stepping.")
+
+(definterface sldb-break-on-return (frame-number)
+ "Set a breakpoint in the frame FRAME-NUMBER.")
+
+(definterface sldb-break-at-start (symbol)
+ "Set a breakpoint on the beginning of the function for SYMBOL.")
+
+(definterface sldb-stepper-condition-p (condition)
+ "Return true if SLDB was invoked due to a single-stepping condition,
+false otherwise. "
+ (declare (ignore condition))
+ nil)
+
+(definterface sldb-step-into ()
+ "Step into the current single-stepper form.")
+
+(definterface sldb-step-next ()
+ "Step to the next form in the current function.")
+
+(definterface sldb-step-out ()
+ "Stop single-stepping temporarily, but resume it once the current function
+returns.")
+
+
+;;;; Definition finding
+
+(defstruct (:location (:type list) :named
+ (:constructor make-location
+ (buffer position &optional hints)))
+ buffer position
+ ;; Hints is a property list optionally containing:
+ ;; :snippet SOURCE-TEXT
+ ;; This is a snippet of the actual source text at the start of
+ ;; the definition, which could be used in a text search.
+ hints)
+
+(defstruct (:error (:type list) :named (:constructor)) message)
+
+;;; Valid content for BUFFER slot
+(defstruct (:file (:type list) :named (:constructor)) name)
+(defstruct (:buffer (:type list) :named (:constructor)) name)
+(defstruct (:etags-file (:type list) :named (:constructor)) filename)
+
+;;; Valid content for POSITION slot
+(defstruct (:position (:type list) :named (:constructor)) pos)
+(defstruct (:tag (:type list) :named (:constructor)) tag1 tag2)
+
+(defmacro converting-errors-to-error-location (&body body)
+ "Catches errors during BODY and converts them to an error location."
+ (let ((gblock (gensym "CONVERTING-ERRORS+")))
+ `(block ,gblock
+ (handler-bind ((error
+ #'(lambda (e)
+ (if *debug-swank-backend*
+ nil ;decline
+ (return-from ,gblock
+ (make-error-location e))))))
+ ,@body))))
+
+(defun make-error-location (datum &rest args)
+ (cond ((typep datum 'condition)
+ `(:error ,(format nil "Error: ~A" datum)))
+ ((symbolp datum)
+ `(:error ,(format nil "Error: ~A"
+ (apply #'make-condition datum args))))
+ (t
+ (assert (stringp datum))
+ `(:error ,(apply #'format nil datum args)))))
+
+(definterface find-definitions (name)
+ "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
+
+NAME is a \"definition specifier\".
+
+DSPEC is a \"definition specifier\" describing the
+definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
+\(DEFVAR FOO).
+
+LOCATION is the source location for the definition.")
+
+(definterface find-source-location (object)
+ "Returns the source location of OBJECT, or NIL.
+
+That is the source location of the underlying datastructure of
+OBJECT. E.g. on a STANDARD-OBJECT, the source location of the
+respective DEFCLASS definition is returned, on a STRUCTURE-CLASS the
+respective DEFSTRUCT definition, and so on."
+ ;; This returns one source location and not a list of locations. It's
+ ;; supposed to return the location of the DEFGENERIC definition on
+ ;; #'SOME-GENERIC-FUNCTION.
+ (declare (ignore object))
+ (make-error-location "FIND-SOURCE-LOCATION is not yet implemented on ~
+ this implementation."))
+
+(definterface buffer-first-change (filename)
+ "Called for effect the first time FILENAME's buffer is modified.
+CMUCL/SBCL use this to cache the unmodified file and use the
+unmodified text to improve the precision of source locations."
+ (declare (ignore filename))
+ nil)
+
+
+
+;;;; XREF
+
+(definterface who-calls (function-name)
+ "Return the call sites of FUNCTION-NAME (a symbol).
+The results is a list ((DSPEC LOCATION) ...)."
+ (declare (ignore function-name))
+ :not-implemented)
+
+(definterface calls-who (function-name)
+ "Return the call sites of FUNCTION-NAME (a symbol).
+The results is a list ((DSPEC LOCATION) ...)."
+ (declare (ignore function-name))
+ :not-implemented)
+
+(definterface who-references (variable-name)
+ "Return the locations where VARIABLE-NAME (a symbol) is referenced.
+See WHO-CALLS for a description of the return value."
+ (declare (ignore variable-name))
+ :not-implemented)
+
+(definterface who-binds (variable-name)
+ "Return the locations where VARIABLE-NAME (a symbol) is bound.
+See WHO-CALLS for a description of the return value."
+ (declare (ignore variable-name))
+ :not-implemented)
+
+(definterface who-sets (variable-name)
+ "Return the locations where VARIABLE-NAME (a symbol) is set.
+See WHO-CALLS for a description of the return value."
+ (declare (ignore variable-name))
+ :not-implemented)
+
+(definterface who-macroexpands (macro-name)
+ "Return the locations where MACRO-NAME (a symbol) is expanded.
+See WHO-CALLS for a description of the return value."
+ (declare (ignore macro-name))
+ :not-implemented)
+
+(definterface who-specializes (class-name)
+ "Return the locations where CLASS-NAME (a symbol) is specialized.
+See WHO-CALLS for a description of the return value."
+ (declare (ignore class-name))
+ :not-implemented)
+
+;;; Simpler variants.
+
+(definterface list-callers (function-name)
+ "List the callers of FUNCTION-NAME.
+This function is like WHO-CALLS except that it is expected to use
+lower-level means. Whereas WHO-CALLS is usually implemented with
+special compiler support, LIST-CALLERS is usually implemented by
+groveling for constants in function objects throughout the heap.
+
+The return value is as for WHO-CALLS.")
+
+(definterface list-callees (function-name)
+ "List the functions called by FUNCTION-NAME.
+See LIST-CALLERS for a description of the return value.")
+
+
+;;;; Profiling
+
+;;; The following functions define a minimal profiling interface.
+
+(definterface profile (fname)
+ "Marks symbol FNAME for profiling.")
+
+(definterface profiled-functions ()
+ "Returns a list of profiled functions.")
+
+(definterface unprofile (fname)
+ "Marks symbol FNAME as not profiled.")
+
+(definterface unprofile-all ()
+ "Marks all currently profiled functions as not profiled."
+ (dolist (f (profiled-functions))
+ (unprofile f)))
+
+(definterface profile-report ()
+ "Prints profile report.")
+
+(definterface profile-reset ()
+ "Resets profile counters.")
+
+(definterface profile-package (package callers-p methods)
+ "Wrap profiling code around all functions in PACKAGE. If a function
+is already profiled, then unprofile and reprofile (useful to notice
+function redefinition.)
+
+If CALLERS-P is T names have counts of the most common calling
+functions recorded.
+
+When called with arguments :METHODS T, profile all methods of all
+generic functions having names in the given package. Generic functions
+themselves, that is, their dispatch functions, are left alone.")
+
+
+;;;; Trace
+
+(definterface toggle-trace (spec)
+ "Toggle tracing of the function(s) given with SPEC.
+SPEC can be:
+ (setf NAME) ; a setf function
+ (:defmethod NAME QUALIFIER... (SPECIALIZER...)) ; a specific method
+ (:defgeneric NAME) ; a generic function with all methods
+ (:call CALLER CALLEE) ; trace calls from CALLER to CALLEE.
+ (:labels TOPLEVEL LOCAL)
+ (:flet TOPLEVEL LOCAL) ")
+
+
+;;;; Inspector
+
+(defgeneric emacs-inspect (object)
+ (:documentation
+ "Explain to Emacs how to inspect OBJECT.
+
+Returns a list specifying how to render the object for inspection.
+
+Every element of the list must be either a string, which will be
+inserted into the buffer as is, or a list of the form:
+
+ (:value object &optional format) - Render an inspectable
+ object. If format is provided it must be a string and will be
+ rendered in place of the value, otherwise use princ-to-string.
+
+ (:newline) - Render a \\n
+
+ (:action label lambda &key (refresh t)) - Render LABEL (a text
+ string) which when clicked will call LAMBDA. If REFRESH is
+ non-NIL the currently inspected object will be re-inspected
+ after calling the lambda.
+"))
+
+(defmethod emacs-inspect ((object t))
+ "Generic method for inspecting any kind of object.
+
+Since we don't know how to deal with OBJECT we simply dump the
+output of CL:DESCRIBE."
+ `("Type: " (:value ,(type-of object)) (:newline)
+ "Don't know how to inspect the object, dumping output of CL:DESCRIBE:"
+ (:newline) (:newline)
+ ,(with-output-to-string (desc) (describe object desc))))
+
+(definterface eval-context (object)
+ "Return a list of bindings corresponding to OBJECT's slots."
+ (declare (ignore object))
+ '())
+
+;;; Utilities for inspector methods.
+;;;
+
+(defun label-value-line (label value &key (newline t))
+ "Create a control list which prints \"LABEL: VALUE\" in the inspector.
+If NEWLINE is non-NIL a `(:newline)' is added to the result."
+ (list* (princ-to-string label) ": " `(:value ,value)
+ (if newline '((:newline)) nil)))
+
+(defmacro label-value-line* (&rest label-values)
+ ` (append ,@(loop for (label value) in label-values
+ collect `(label-value-line ,label ,value))))
+
+(definterface describe-primitive-type (object)
+ "Return a string describing the primitive type of object."
+ (declare (ignore object))
+ "N/A")
+
+
+;;;; Multithreading
+;;;
+;;; The default implementations are sufficient for non-multiprocessing
+;;; implementations.
+
+(definterface initialize-multiprocessing (continuation)
+ "Initialize multiprocessing, if necessary and then invoke CONTINUATION.
+
+Depending on the impleimentaion, this function may never return."
+ (funcall continuation))
+
+(definterface spawn (fn &key name)
+ "Create a new thread to call FN.")
+
+(definterface thread-id (thread)
+ "Return an Emacs-parsable object to identify THREAD.
+
+Ids should be comparable with equal, i.e.:
+ (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)"
+ thread)
+
+(definterface find-thread (id)
+ "Return the thread for ID.
+ID should be an id previously obtained with THREAD-ID.
+Can return nil if the thread no longer exists."
+ (declare (ignore id))
+ (current-thread))
+
+(definterface thread-name (thread)
+ "Return the name of THREAD.
+Thread names are short strings meaningful to the user. They do not
+have to be unique."
+ (declare (ignore thread))
+ "The One True Thread")
+
+(definterface thread-status (thread)
+ "Return a string describing THREAD's state."
+ (declare (ignore thread))
+ "")
+
+(definterface thread-attributes (thread)
+ "Return a plist of implementation-dependent attributes for THREAD"
+ (declare (ignore thread))
+ '())
+
+(definterface current-thread ()
+ "Return the currently executing thread."
+ 0)
+
+(definterface all-threads ()
+ "Return a fresh list of all threads."
+ '())
+
+(definterface thread-alive-p (thread)
+ "Test if THREAD is termintated."
+ (member thread (all-threads)))
+
+(definterface interrupt-thread (thread fn)
+ "Cause THREAD to execute FN.")
+
+(definterface kill-thread (thread)
+ "Terminate THREAD immediately.
+Don't execute unwind-protected sections, don't raise conditions.
+(Do not pass go, do not collect $200.)"
+ (declare (ignore thread))
+ nil)
+
+(definterface send (thread object)
+ "Send OBJECT to thread THREAD."
+ (declare (ignore thread))
+ object)
+
+(definterface receive (&optional timeout)
+ "Return the next message from current thread's mailbox."
+ (receive-if (constantly t) timeout))
+
+(definterface receive-if (predicate &optional timeout)
+ "Return the first message satisfiying PREDICATE.")
+
+(definterface register-thread (name thread)
+ "Associate the thread THREAD with the symbol NAME.
+The thread can then be retrieved with `find-registered'.
+If THREAD is nil delete the association."
+ (declare (ignore name thread))
+ nil)
+
+(definterface find-registered (name)
+ "Find the thread that was registered for the symbol NAME.
+Return nil if the no thread was registred or if the tread is dead."
+ (declare (ignore name))
+ nil)
+
+(definterface set-default-initial-binding (var form)
+ "Initialize special variable VAR by default with FORM.
+
+Some implementations initialize certain variables in each newly
+created thread. This function sets the form which is used to produce
+the initial value."
+ (set var (eval form)))
+
+;; List of delayed interrupts.
+;; This should only have thread-local bindings, so no init form.
+(defvar *pending-slime-interrupts*)
+
+(defun check-slime-interrupts ()
+ "Execute pending interrupts if any.
+This should be called periodically in operations which
+can take a long time to complete.
+Return a boolean indicating whether any interrupts was processed."
+ (when (and (boundp '*pending-slime-interrupts*)
+ *pending-slime-interrupts*)
+ (funcall (pop *pending-slime-interrupts*))
+ t))
+
+(defvar *interrupt-queued-handler* nil
+ "Function to call on queued interrupts.
+Interrupts get queued when an interrupt occurs while interrupt
+handling is disabled.
+
+Backends can use this function to abort slow operations.")
+
+(definterface wait-for-input (streams &optional timeout)
+ "Wait for input on a list of streams. Return those that are ready.
+STREAMS is a list of streams
+TIMEOUT nil, t, or real number. If TIMEOUT is t, return those streams
+which are ready (or have reached end-of-file) without waiting.
+If TIMEOUT is a number and no streams is ready after TIMEOUT seconds,
+return nil.
+
+Return :interrupt if an interrupt occurs while waiting.")
+
+
+;;;; Locks
+
+;; Please use locks only in swank-gray.lisp. Locks are too low-level
+;; for our taste.
+
+(definterface make-lock (&key name)
+ "Make a lock for thread synchronization.
+Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time
+but that thread may hold it more than once."
+ (declare (ignore name))
+ :null-lock)
+
+(definterface call-with-lock-held (lock function)
+ "Call FUNCTION with LOCK held, queueing if necessary."
+ (declare (ignore lock)
+ (type function function))
+ (funcall function))
+
+
+;;;; Weak datastructures
+
+(definterface make-weak-key-hash-table (&rest args)
+ "Like MAKE-HASH-TABLE, but weak w.r.t. the keys."
+ (apply #'make-hash-table args))
+
+(definterface make-weak-value-hash-table (&rest args)
+ "Like MAKE-HASH-TABLE, but weak w.r.t. the values."
+ (apply #'make-hash-table args))
+
+(definterface hash-table-weakness (hashtable)
+ "Return nil or one of :key :value :key-or-value :key-and-value"
+ (declare (ignore hashtable))
+ nil)
+
+
+;;;; Character names
+
+(definterface character-completion-set (prefix matchp)
+ "Return a list of names of characters that match PREFIX."
+ ;; Handle the standard and semi-standard characters.
+ (loop for name in '("Newline" "Space" "Tab" "Page" "Rubout"
+ "Linefeed" "Return" "Backspace")
+ when (funcall matchp prefix name)
+ collect name))
+
+
+(defparameter *type-specifier-arglists*
+ '((and . (&rest type-specifiers))
+ (array . (&optional element-type dimension-spec))
+ (base-string . (&optional size))
+ (bit-vector . (&optional size))
+ (complex . (&optional type-specifier))
+ (cons . (&optional car-typespec cdr-typespec))
+ (double-float . (&optional lower-limit upper-limit))
+ (eql . (object))
+ (float . (&optional lower-limit upper-limit))
+ (function . (&optional arg-typespec value-typespec))
+ (integer . (&optional lower-limit upper-limit))
+ (long-float . (&optional lower-limit upper-limit))
+ (member . (&rest eql-objects))
+ (mod . (n))
+ (not . (type-specifier))
+ (or . (&rest type-specifiers))
+ (rational . (&optional lower-limit upper-limit))
+ (real . (&optional lower-limit upper-limit))
+ (satisfies . (predicate-symbol))
+ (short-float . (&optional lower-limit upper-limit))
+ (signed-byte . (&optional size))
+ (simple-array . (&optional element-type dimension-spec))
+ (simple-base-string . (&optional size))
+ (simple-bit-vector . (&optional size))
+ (simple-string . (&optional size))
+ (single-float . (&optional lower-limit upper-limit))
+ (simple-vector . (&optional size))
+ (string . (&optional size))
+ (unsigned-byte . (&optional size))
+ (values . (&rest typespecs))
+ (vector . (&optional element-type size))
+ ))
+
+;;; Heap dumps
+
+(definterface save-image (filename &optional restart-function)
+ "Save a heap image to the file FILENAME.
+RESTART-FUNCTION, if non-nil, should be called when the image is loaded.")
+
+(definterface background-save-image (filename &key restart-function
+ completion-function)
+ "Request saving a heap image to the file FILENAME.
+RESTART-FUNCTION, if non-nil, should be called when the image is loaded.
+COMPLETION-FUNCTION, if non-nil, should be called after saving the image.")
+
+(defun deinit-log-output ()
+ ;; Can't hang on to an fd-stream from a previous session.
+ (setf *log-output* nil))
+
+
+;;;; Wrapping
+
+(definterface wrap (spec indicator &key before after replace)
+ "Intercept future calls to SPEC and surround them in callbacks.
+
+INDICATOR is a symbol identifying a particular wrapping, and is used
+to differentiate between multiple wrappings.
+
+Implementations intercept calls to SPEC and call, in this order:
+
+* the BEFORE callback, if it's provided, with a single argument set to
+ the list of arguments passed to the intercepted call;
+
+* the original definition of SPEC recursively honouring any wrappings
+ previously established under different values of INDICATOR. If the
+ compatible function REPLACE is provided, call that instead.
+
+* the AFTER callback, if it's provided, with a single set to the list
+ of values returned by the previous call, or, if that call exited
+ non-locally, a single descriptive symbol, like :EXITED-NON-LOCALLY."
+ (declare (ignore indicator))
+ (assert (symbolp spec) nil
+ "The default implementation for WRAP allows only simple names")
+ (assert (null (get spec 'slime-wrap)) nil
+ "The default implementation for WRAP allows a single wrapping")
+ (let* ((saved (symbol-function spec))
+ (replacement (lambda (&rest args)
+ (let (retlist completed)
+ (unwind-protect
+ (progn
+ (when before
+ (funcall before args))
+ (setq retlist (multiple-value-list
+ (apply (or replace
+ saved) args)))
+ (setq completed t)
+ (values-list retlist))
+ (when after
+ (funcall after (if completed
+ retlist
+ :exited-non-locally))))))))
+ (setf (get spec 'slime-wrap) (list saved replacement))
+ (setf (symbol-function spec) replacement))
+ spec)
+
+(definterface unwrap (spec indicator)
+ "Remove from SPEC any wrappings tagged with INDICATOR."
+ (if (wrapped-p spec indicator)
+ (setf (symbol-function spec) (first (get spec 'slime-wrap)))
+ (cerror "All right, so I did"
+ "Hmmm, ~a is not correctly wrapped, you probably redefined it"
+ spec))
+ (setf (get spec 'slime-wrap) nil)
+ spec)
+
+(definterface wrapped-p (spec indicator)
+ "Returns true if SPEC is wrapped with INDICATOR."
+ (declare (ignore indicator))
+ (and (symbolp spec)
+ (let ((prop-value (get spec 'slime-wrap)))
+ (cond ((and prop-value
+ (not (eq (second prop-value)
+ (symbol-function spec))))
+ (warn "~a appears to be incorrectly wrapped" spec)
+ nil)
+ (prop-value t)
+ (t nil)))))
diff --git a/vim/bundle/slimv/slime/swank/ccl.lisp b/vim/bundle/slimv/slime/swank/ccl.lisp
new file mode 100644
index 0000000..66195c5
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/ccl.lisp
@@ -0,0 +1,861 @@
+;;;; -*- indent-tabs-mode: nil -*-
+;;;
+;;; swank-ccl.lisp --- SLIME backend for Clozure CL.
+;;;
+;;; Copyright (C) 2003, James Bielman <jamesjb@jamesjb.com>
+;;;
+;;; This program is licensed under the terms of the Lisp Lesser GNU
+;;; Public License, known as the LLGPL, and distributed with Clozure CL
+;;; as the file "LICENSE". The LLGPL consists of a preamble and the
+;;; LGPL, which is distributed with Clozure CL as the file "LGPL". Where
+;;; these conflict, the preamble takes precedence.
+;;;
+;;; The LLGPL is also available online at
+;;; http://opensource.franz.com/preamble.html
+
+(defpackage swank/ccl
+ (:use cl swank/backend))
+
+(in-package swank/ccl)
+
+(eval-when (:compile-toplevel :execute :load-toplevel)
+ (assert (and (= ccl::*openmcl-major-version* 1)
+ (>= ccl::*openmcl-minor-version* 4))
+ () "This file needs CCL version 1.4 or newer"))
+
+(defimplementation gray-package-name ()
+ "CCL")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (multiple-value-bind (ok err) (ignore-errors (require 'xref))
+ (unless ok
+ (warn "~a~%" err))))
+
+;;; swank-mop
+
+(import-to-swank-mop
+ '( ;; classes
+ cl:standard-generic-function
+ ccl:standard-slot-definition
+ cl:method
+ cl:standard-class
+ ccl:eql-specializer
+ openmcl-mop:finalize-inheritance
+ openmcl-mop:compute-applicable-methods-using-classes
+ ;; standard-class readers
+ openmcl-mop:class-default-initargs
+ openmcl-mop:class-direct-default-initargs
+ openmcl-mop:class-direct-slots
+ openmcl-mop:class-direct-subclasses
+ openmcl-mop:class-direct-superclasses
+ openmcl-mop:class-finalized-p
+ cl:class-name
+ openmcl-mop:class-precedence-list
+ openmcl-mop:class-prototype
+ openmcl-mop:class-slots
+ openmcl-mop:specializer-direct-methods
+ ;; eql-specializer accessors
+ openmcl-mop:eql-specializer-object
+ ;; generic function readers
+ openmcl-mop:generic-function-argument-precedence-order
+ openmcl-mop:generic-function-declarations
+ openmcl-mop:generic-function-lambda-list
+ openmcl-mop:generic-function-methods
+ openmcl-mop:generic-function-method-class
+ openmcl-mop:generic-function-method-combination
+ openmcl-mop:generic-function-name
+ ;; method readers
+ openmcl-mop:method-generic-function
+ openmcl-mop:method-function
+ openmcl-mop:method-lambda-list
+ openmcl-mop:method-specializers
+ openmcl-mop:method-qualifiers
+ ;; slot readers
+ openmcl-mop:slot-definition-allocation
+ openmcl-mop:slot-definition-documentation
+ openmcl-mop:slot-value-using-class
+ openmcl-mop:slot-definition-initargs
+ openmcl-mop:slot-definition-initform
+ openmcl-mop:slot-definition-initfunction
+ openmcl-mop:slot-definition-name
+ openmcl-mop:slot-definition-type
+ openmcl-mop:slot-definition-readers
+ openmcl-mop:slot-definition-writers
+ openmcl-mop:slot-boundp-using-class
+ openmcl-mop:slot-makunbound-using-class))
+
+;;; UTF8
+
+(defimplementation string-to-utf8 (string)
+ (ccl:encode-string-to-octets string :external-format :utf-8))
+
+(defimplementation utf8-to-string (octets)
+ (ccl:decode-string-from-octets octets :external-format :utf-8))
+
+;;; TCP Server
+
+(defimplementation preferred-communication-style ()
+ :spawn)
+
+(defimplementation create-socket (host port &key backlog)
+ (ccl:make-socket :connect :passive :local-port port
+ :local-host host :reuse-address t
+ :backlog (or backlog 5)))
+
+(defimplementation local-port (socket)
+ (ccl:local-port socket))
+
+(defimplementation close-socket (socket)
+ (close socket))
+
+(defimplementation accept-connection (socket &key external-format
+ buffering timeout)
+ (declare (ignore buffering timeout))
+ (let ((stream-args (and external-format
+ `(:external-format ,external-format))))
+ (ccl:accept-connection socket :wait t :stream-args stream-args)))
+
+(defvar *external-format-to-coding-system*
+ '((:iso-8859-1
+ "latin-1" "latin-1-unix" "iso-latin-1-unix"
+ "iso-8859-1" "iso-8859-1-unix")
+ (:utf-8 "utf-8" "utf-8-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+
+(defimplementation socket-fd (stream)
+ (ccl::ioblock-device (ccl::stream-ioblock stream t)))
+
+;;; Unix signals
+
+(defimplementation getpid ()
+ (ccl::getpid))
+
+(defimplementation lisp-implementation-type-name ()
+ "ccl")
+
+;;; Arglist
+
+(defimplementation arglist (fname)
+ (multiple-value-bind (arglist binding) (let ((*break-on-signals* nil))
+ (ccl:arglist fname))
+ (if binding
+ arglist
+ :not-available)))
+
+(defimplementation function-name (function)
+ (ccl:function-name function))
+
+(defmethod declaration-arglist ((decl-identifier (eql 'optimize)))
+ (let ((flags (ccl:declaration-information decl-identifier)))
+ (if flags
+ `(&any ,flags)
+ (call-next-method))))
+
+;;; Compilation
+
+(defun handle-compiler-warning (condition)
+ "Resignal a ccl:compiler-warning as swank/backend:compiler-warning."
+ (signal 'compiler-condition
+ :original-condition condition
+ :message (compiler-warning-short-message condition)
+ :source-context nil
+ :severity (compiler-warning-severity condition)
+ :location (source-note-to-source-location
+ (ccl:compiler-warning-source-note condition)
+ (lambda () "Unknown source")
+ (ccl:compiler-warning-function-name condition))))
+
+(defgeneric compiler-warning-severity (condition))
+(defmethod compiler-warning-severity ((c ccl:compiler-warning)) :warning)
+(defmethod compiler-warning-severity ((c ccl:style-warning)) :style-warning)
+
+(defgeneric compiler-warning-short-message (condition))
+
+;; Pretty much the same as ccl:report-compiler-warning but
+;; without the source position and function name stuff.
+(defmethod compiler-warning-short-message ((c ccl:compiler-warning))
+ (with-output-to-string (stream)
+ (ccl:report-compiler-warning c stream :short t)))
+
+;; Needed because `ccl:report-compiler-warning' would return
+;; "Nonspecific warning".
+(defmethod compiler-warning-short-message ((c ccl::shadowed-typecase-clause))
+ (princ-to-string c))
+
+(defimplementation call-with-compilation-hooks (function)
+ (handler-bind ((ccl:compiler-warning 'handle-compiler-warning))
+ (let ((ccl:*merge-compiler-warnings* nil))
+ (funcall function))))
+
+(defimplementation swank-compile-file (input-file output-file
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
+ (with-compilation-hooks ()
+ (compile-file input-file
+ :output-file output-file
+ :load load-p
+ :external-format external-format)))
+
+;; Use a temp file rather than in-core compilation in order to handle
+;; eval-when's as compile-time.
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore policy))
+ (with-compilation-hooks ()
+ (let ((temp-file-name (ccl:temp-pathname))
+ (ccl:*save-source-locations* t))
+ (unwind-protect
+ (progn
+ (with-open-file (s temp-file-name :direction :output
+ :if-exists :error :external-format :utf-8)
+ (write-string string s))
+ (let ((binary-filename (compile-temp-file
+ temp-file-name filename buffer position)))
+ (delete-file binary-filename)))
+ (delete-file temp-file-name)))))
+
+(defvar *temp-file-map* (make-hash-table :test #'equal)
+ "A mapping from tempfile names to Emacs buffer names.")
+
+(defun compile-temp-file (temp-file-name buffer-file-name buffer-name offset)
+ (compile-file temp-file-name
+ :load t
+ :compile-file-original-truename
+ (or buffer-file-name
+ (progn
+ (setf (gethash temp-file-name *temp-file-map*)
+ buffer-name)
+ temp-file-name))
+ :compile-file-original-buffer-offset (1- offset)
+ :external-format :utf-8))
+
+(defimplementation save-image (filename &optional restart-function)
+ (ccl:save-application filename :toplevel-function restart-function))
+
+;;; Cross-referencing
+
+(defun xref-locations (relation name &optional inverse)
+ (delete-duplicates
+ (mapcan #'find-definitions
+ (if inverse
+ (ccl::get-relation relation name :wild :exhaustive t)
+ (ccl::get-relation relation :wild name :exhaustive t)))
+ :test 'equal))
+
+(defimplementation who-binds (name)
+ (xref-locations :binds name))
+
+(defimplementation who-macroexpands (name)
+ (xref-locations :macro-calls name t))
+
+(defimplementation who-references (name)
+ (remove-duplicates
+ (append (xref-locations :references name)
+ (xref-locations :sets name)
+ (xref-locations :binds name))
+ :test 'equal))
+
+(defimplementation who-sets (name)
+ (xref-locations :sets name))
+
+(defimplementation who-calls (name)
+ (remove-duplicates
+ (append
+ (xref-locations :direct-calls name)
+ (xref-locations :indirect-calls name)
+ (xref-locations :macro-calls name t))
+ :test 'equal))
+
+(defimplementation who-specializes (class)
+ (when (symbolp class)
+ (setq class (find-class class nil)))
+ (when class
+ (delete-duplicates
+ (mapcar (lambda (m)
+ (car (find-definitions m)))
+ (ccl:specializer-direct-methods class))
+ :test 'equal)))
+
+(defimplementation list-callees (name)
+ (remove-duplicates
+ (append
+ (xref-locations :direct-calls name t)
+ (xref-locations :macro-calls name nil))
+ :test 'equal))
+
+(defimplementation list-callers (symbol)
+ (delete-duplicates
+ (mapcan #'find-definitions (ccl:caller-functions symbol))
+ :test #'equal))
+
+;;; Profiling (alanr: lifted from swank-clisp)
+
+(defimplementation profile (fname)
+ (eval `(swank-monitor:monitor ,fname))) ;monitor is a macro
+
+(defimplementation profiled-functions ()
+ swank-monitor:*monitored-functions*)
+
+(defimplementation unprofile (fname)
+ (eval `(swank-monitor:unmonitor ,fname))) ;unmonitor is a macro
+
+(defimplementation unprofile-all ()
+ (swank-monitor:unmonitor))
+
+(defimplementation profile-report ()
+ (swank-monitor:report-monitoring))
+
+(defimplementation profile-reset ()
+ (swank-monitor:reset-all-monitoring))
+
+(defimplementation profile-package (package callers-p methods)
+ (declare (ignore callers-p methods))
+ (swank-monitor:monitor-all package))
+
+;;; Debugging
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (let* (;;(*debugger-hook* nil)
+ ;; don't let error while printing error take us down
+ (ccl:*signal-printing-errors* nil))
+ (funcall debugger-loop-fn)))
+
+;; This is called for an async interrupt and is running in a random
+;; thread not selected by the user, so don't use thread-local vars
+;; such as *emacs-connection*.
+(defun find-repl-thread ()
+ (let* ((*break-on-signals* nil)
+ (conn (swank::default-connection)))
+ (and (swank::multithreaded-connection-p conn)
+ (swank::mconn.repl-thread conn))))
+
+(defimplementation call-with-debugger-hook (hook fun)
+ (let ((*debugger-hook* hook)
+ (ccl:*break-hook* hook)
+ (ccl:*select-interactive-process-hook* 'find-repl-thread))
+ (funcall fun)))
+
+(defimplementation install-debugger-globally (function)
+ (setq *debugger-hook* function)
+ (setq ccl:*break-hook* function)
+ (setq ccl:*select-interactive-process-hook* 'find-repl-thread)
+ )
+
+(defun map-backtrace (function &optional
+ (start-frame-number 0)
+ end-frame-number)
+ "Call FUNCTION passing information about each stack frame
+ from frames START-FRAME-NUMBER to END-FRAME-NUMBER."
+ (let ((end-frame-number (or end-frame-number most-positive-fixnum)))
+ (ccl:map-call-frames function
+ :origin ccl:*top-error-frame*
+ :start-frame-number start-frame-number
+ :count (- end-frame-number start-frame-number))))
+
+(defimplementation compute-backtrace (start-frame-number end-frame-number)
+ (let (result)
+ (map-backtrace (lambda (p context)
+ (push (list :frame p context) result))
+ start-frame-number end-frame-number)
+ (nreverse result)))
+
+(defimplementation print-frame (frame stream)
+ (assert (eq (first frame) :frame))
+ (destructuring-bind (p context) (rest frame)
+ (let ((lfun (ccl:frame-function p context)))
+ (format stream "(~S" (or (ccl:function-name lfun) lfun))
+ (let* ((unavailable (cons nil nil))
+ (args (ccl:frame-supplied-arguments p context
+ :unknown-marker unavailable)))
+ (declare (dynamic-extent unavailable))
+ (if (eq args unavailable)
+ (format stream " #<Unknown Arguments>")
+ (dolist (arg args)
+ (if (eq arg unavailable)
+ (format stream " #<Unavailable>")
+ (format stream " ~s" arg)))))
+ (format stream ")"))))
+
+(defmacro with-frame ((p context) frame-number &body body)
+ `(call/frame ,frame-number (lambda (,p ,context) . ,body)))
+
+(defun call/frame (frame-number if-found)
+ (map-backtrace
+ (lambda (p context)
+ (return-from call/frame
+ (funcall if-found p context)))
+ frame-number))
+
+(defimplementation frame-call (frame-number)
+ (with-frame (p context) frame-number
+ (with-output-to-string (stream)
+ (print-frame (list :frame p context) stream))))
+
+(defimplementation frame-var-value (frame var)
+ (with-frame (p context) frame
+ (cdr (nth var (ccl:frame-named-variables p context)))))
+
+(defimplementation frame-locals (index)
+ (with-frame (p context) index
+ (loop for (name . value) in (ccl:frame-named-variables p context)
+ collect (list :name name :value value :id 0))))
+
+(defimplementation frame-source-location (index)
+ (with-frame (p context) index
+ (multiple-value-bind (lfun pc) (ccl:frame-function p context)
+ (if pc
+ (pc-source-location lfun pc)
+ (function-source-location lfun)))))
+
+(defun function-name-package (name)
+ (etypecase name
+ (null nil)
+ (symbol (symbol-package name))
+ ((cons (eql ccl::traced)) (function-name-package (second name)))
+ ((cons (eql setf)) (symbol-package (second name)))
+ ((cons (eql :internal)) (function-name-package (car (last name))))
+ ((cons (and symbol (not keyword)) (cons list null))
+ (symbol-package (car name)))
+ (standard-method (function-name-package (ccl:method-name name)))))
+
+(defimplementation frame-package (frame-number)
+ (with-frame (p context) frame-number
+ (let* ((lfun (ccl:frame-function p context))
+ (name (ccl:function-name lfun)))
+ (function-name-package name))))
+
+(defimplementation eval-in-frame (form index)
+ (with-frame (p context) index
+ (let ((vars (ccl:frame-named-variables p context)))
+ (eval `(let ,(loop for (var . val) in vars collect `(,var ',val))
+ (declare (ignorable ,@(mapcar #'car vars)))
+ ,form)))))
+
+(defimplementation return-from-frame (index form)
+ (let ((values (multiple-value-list (eval-in-frame form index))))
+ (with-frame (p context) index
+ (declare (ignore context))
+ (ccl:apply-in-frame p #'values values))))
+
+(defimplementation restart-frame (index)
+ (with-frame (p context) index
+ (ccl:apply-in-frame p
+ (ccl:frame-function p context)
+ (ccl:frame-supplied-arguments p context))))
+
+(defimplementation disassemble-frame (the-frame-number)
+ (with-frame (p context) the-frame-number
+ (multiple-value-bind (lfun pc) (ccl:frame-function p context)
+ (format t "LFUN: ~a~%PC: ~a FP: #x~x CONTEXT: ~a~%" lfun pc p context)
+ (disassemble lfun))))
+
+;; CCL commit r11373 | gz | 2008-11-16 16:35:28 +0100 (Sun, 16 Nov 2008)
+;; contains some interesting details:
+;;
+;; Source location are recorded in CCL:SOURCE-NOTE's, which are objects
+;; with accessors CCL:SOURCE-NOTE-FILENAME, CCL:SOURCE-NOTE-START-POS,
+;; CCL:SOURCE-NOTE-END-POS and CCL:SOURCE-NOTE-TEXT. The start and end
+;; positions are file positions (not character positions). The text will
+;; be NIL unless text recording was on at read-time. If the original
+;; file is still available, you can force missing source text to be read
+;; from the file at runtime via CCL:ENSURE-SOURCE-NOTE-TEXT.
+;;
+;; Source-note's are associated with definitions (via record-source-file)
+;; and also stored in function objects (including anonymous and nested
+;; functions). The former can be retrieved via
+;; CCL:FIND-DEFINITION-SOURCES, the latter via CCL:FUNCTION-SOURCE-NOTE.
+;;
+;; The recording behavior is controlled by the new variable
+;; CCL:*SAVE-SOURCE-LOCATIONS*:
+;;
+;; If NIL, don't store source-notes in function objects, and store only
+;; the filename for definitions (the latter only if
+;; *record-source-file* is true).
+;;
+;; If T, store source-notes, including a copy of the original source
+;; text, for function objects and definitions (the latter only if
+;; *record-source-file* is true).
+;;
+;; If :NO-TEXT, store source-notes, but without saved text, for
+;; function objects and defintions (the latter only if
+;; *record-source-file* is true). This is the default.
+;;
+;; PC to source mapping is controlled by the new variable
+;; CCL:*RECORD-PC-MAPPING*. If true (the default), functions store a
+;; compressed table mapping pc offsets to corresponding source locations.
+;; This can be retrieved by (CCL:FIND-SOURCE-NOTE-AT-PC function pc)
+;; which returns a source-note for the source at offset pc in the
+;; function.
+
+(defun function-source-location (function)
+ (source-note-to-source-location
+ (or (ccl:function-source-note function)
+ (function-name-source-note function))
+ (lambda ()
+ (format nil "Function has no source note: ~A" function))
+ (ccl:function-name function)))
+
+(defun pc-source-location (function pc)
+ (source-note-to-source-location
+ (or (ccl:find-source-note-at-pc function pc)
+ (ccl:function-source-note function)
+ (function-name-source-note function))
+ (lambda ()
+ (format nil "No source note at PC: ~a[~d]" function pc))
+ (ccl:function-name function)))
+
+(defun function-name-source-note (fun)
+ (let ((defs (ccl:find-definition-sources (ccl:function-name fun) 'function)))
+ (and defs
+ (destructuring-bind ((type . name) srcloc . srclocs) (car defs)
+ (declare (ignore type name srclocs))
+ srcloc))))
+
+(defun source-note-to-source-location (source if-nil-thunk &optional name)
+ (labels ((filename-to-buffer (filename)
+ (cond ((gethash filename *temp-file-map*)
+ (list :buffer (gethash filename *temp-file-map*)))
+ ((probe-file filename)
+ (list :file (ccl:native-translated-namestring
+ (truename filename))))
+ (t (error "File ~s doesn't exist" filename)))))
+ (handler-case
+ (cond ((ccl:source-note-p source)
+ (let* ((full-text (ccl:source-note-text source))
+ (file-name (ccl:source-note-filename source))
+ (start-pos (ccl:source-note-start-pos source)))
+ (make-location
+ (when file-name (filename-to-buffer (pathname file-name)))
+ (when start-pos (list :position (1+ start-pos)))
+ (when full-text
+ (list :snippet (subseq full-text 0
+ (min 40 (length full-text))))))))
+ ((and source name)
+ ;; This branch is probably never used
+ (make-location
+ (filename-to-buffer source)
+ (list :function-name (princ-to-string
+ (if (functionp name)
+ (ccl:function-name name)
+ name)))))
+ (t `(:error ,(funcall if-nil-thunk))))
+ (error (c) `(:error ,(princ-to-string c))))))
+
+(defun alphatizer-definitions (name)
+ (let ((alpha (gethash name ccl::*nx1-alphatizers*)))
+ (and alpha (ccl:find-definition-sources alpha))))
+
+(defun p2-definitions (name)
+ (let ((nx1-op (gethash name ccl::*nx1-operators*)))
+ (and nx1-op
+ (let ((dispatch (ccl::backend-p2-dispatch ccl::*target-backend*)) )
+ (and (array-in-bounds-p dispatch nx1-op)
+ (let ((p2 (aref dispatch nx1-op)))
+ (and p2
+ (ccl:find-definition-sources p2))))))))
+
+(defimplementation find-definitions (name)
+ (let ((defs (append (or (ccl:find-definition-sources name)
+ (and (symbolp name)
+ (fboundp name)
+ (ccl:find-definition-sources
+ (symbol-function name))))
+ (alphatizer-definitions name)
+ (p2-definitions name))))
+ (loop for ((type . name) . sources) in defs
+ collect (list (definition-name type name)
+ (source-note-to-source-location
+ (find-if-not #'null sources)
+ (lambda () "No source-note available")
+ name)))))
+
+(defimplementation find-source-location (obj)
+ (let* ((defs (ccl:find-definition-sources obj))
+ (best-def (or (find (ccl:name-of obj) defs :key #'cdar :test #'equal)
+ (car defs)))
+ (note (find-if-not #'null (cdr best-def))))
+ (when note
+ (source-note-to-source-location
+ note
+ (lambda () "No source note available")))))
+
+(defun definition-name (type object)
+ (case (ccl:definition-type-name type)
+ (method (ccl:name-of object))
+ (t (list (ccl:definition-type-name type) (ccl:name-of object)))))
+
+;;; Utilities
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((doc (kind &optional (sym symbol))
+ (or (documentation sym kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (when (boundp symbol)
+ (doc 'variable)))
+ (maybe-push
+ :function (if (fboundp symbol)
+ (doc 'function)))
+ (maybe-push
+ :setf (let ((setf-function-name (ccl:setf-function-spec-name
+ `(setf ,symbol))))
+ (when (fboundp setf-function-name)
+ (doc 'function setf-function-name))))
+ (maybe-push
+ :type (when (ccl:type-specifier-p symbol)
+ (doc 'type)))
+ result)))
+
+(defimplementation describe-definition (symbol namespace)
+ (ecase namespace
+ (:variable
+ (describe symbol))
+ ((:function :generic-function)
+ (describe (symbol-function symbol)))
+ (:setf
+ (describe (ccl:setf-function-spec-name `(setf ,symbol))))
+ (:class
+ (describe (find-class symbol)))
+ (:type
+ (describe (or (find-class symbol nil) symbol)))))
+
+;; spec ::= (:defmethod <name> {<qualifier>}* ({<specializer>}*))
+(defun parse-defmethod-spec (spec)
+ (values (second spec)
+ (subseq spec 2 (position-if #'consp spec))
+ (find-if #'consp (cddr spec))))
+
+(defimplementation toggle-trace (spec)
+ "We currently ignore just about everything."
+ (let ((what (ecase (first spec)
+ ((setf)
+ spec)
+ ((:defgeneric)
+ (second spec))
+ ((:defmethod)
+ (multiple-value-bind (name qualifiers specializers)
+ (parse-defmethod-spec spec)
+ (find-method (fdefinition name)
+ qualifiers
+ specializers))))))
+ (cond ((member what (trace) :test #'equal)
+ (ccl::%untrace what)
+ (format nil "~S is now untraced." what))
+ (t
+ (ccl:trace-function what)
+ (format nil "~S is now traced." what)))))
+
+;;; Macroexpansion
+
+(defimplementation macroexpand-all (form &optional env)
+ (ccl:macroexpand-all form env))
+
+;;;; Inspection
+
+(defun comment-type-p (type)
+ (or (eq type :comment)
+ (and (consp type) (eq (car type) :comment))))
+
+(defmethod emacs-inspect ((o t))
+ (let* ((inspector:*inspector-disassembly* t)
+ (i (inspector:make-inspector o))
+ (count (inspector:compute-line-count i)))
+ (loop for l from 0 below count append
+ (multiple-value-bind (value label type) (inspector:line-n i l)
+ (etypecase type
+ ((member nil :normal)
+ `(,(or label "") (:value ,value) (:newline)))
+ ((member :colon)
+ (label-value-line label value))
+ ((member :static)
+ (list (princ-to-string label) " " `(:value ,value) '(:newline)))
+ ((satisfies comment-type-p)
+ (list (princ-to-string label) '(:newline))))))))
+
+(defmethod emacs-inspect :around ((o t))
+ (if (or (uvector-inspector-p o)
+ (not (ccl:uvectorp o)))
+ (call-next-method)
+ (let ((value (call-next-method)))
+ (cond ((listp value)
+ (append value
+ `((:newline)
+ (:value ,(make-instance 'uvector-inspector :object o)
+ "Underlying UVECTOR"))))
+ (t value)))))
+
+(defmethod emacs-inspect ((f function))
+ (append
+ (label-value-line "Name" (function-name f))
+ `("Its argument list is: "
+ ,(princ-to-string (arglist f)) (:newline))
+ (label-value-line "Documentation" (documentation f t))
+ (when (function-lambda-expression f)
+ (label-value-line "Lambda Expression"
+ (function-lambda-expression f)))
+ (when (ccl:function-source-note f)
+ (label-value-line "Source note"
+ (ccl:function-source-note f)))
+ (when (typep f 'ccl:compiled-lexical-closure)
+ (append
+ (label-value-line "Inner function" (ccl::closure-function f))
+ '("Closed over values:" (:newline))
+ (loop for (name value) in (ccl::closure-closed-over-values f)
+ append (label-value-line (format nil " ~a" name)
+ value))))))
+
+(defclass uvector-inspector ()
+ ((object :initarg :object)))
+
+(defgeneric uvector-inspector-p (object)
+ (:method ((object t)) nil)
+ (:method ((object uvector-inspector)) t))
+
+(defmethod emacs-inspect ((uv uvector-inspector))
+ (with-slots (object) uv
+ (loop for i below (ccl:uvsize object) append
+ (label-value-line (princ-to-string i) (ccl:uvref object i)))))
+
+(defimplementation type-specifier-p (symbol)
+ (or (ccl:type-specifier-p symbol)
+ (not (eq (type-specifier-arglist symbol) :not-available))))
+
+;;; Multiprocessing
+
+(defvar *known-processes*
+ (make-hash-table :size 20 :weak :key :test #'eq)
+ "A map from threads to mailboxes.")
+
+(defvar *known-processes-lock* (ccl:make-lock "*known-processes-lock*"))
+
+(defstruct (mailbox (:conc-name mailbox.))
+ (mutex (ccl:make-lock "thread mailbox"))
+ (semaphore (ccl:make-semaphore))
+ (queue '() :type list))
+
+(defimplementation spawn (fun &key name)
+ (ccl:process-run-function (or name "Anonymous (Swank)")
+ fun))
+
+(defimplementation thread-id (thread)
+ (ccl:process-serial-number thread))
+
+(defimplementation find-thread (id)
+ (find id (ccl:all-processes) :key #'ccl:process-serial-number))
+
+(defimplementation thread-name (thread)
+ (ccl:process-name thread))
+
+(defimplementation thread-status (thread)
+ (format nil "~A" (ccl:process-whostate thread)))
+
+(defimplementation thread-attributes (thread)
+ (list :priority (ccl:process-priority thread)))
+
+(defimplementation make-lock (&key name)
+ (ccl:make-lock name))
+
+(defimplementation call-with-lock-held (lock function)
+ (ccl:with-lock-grabbed (lock)
+ (funcall function)))
+
+(defimplementation current-thread ()
+ ccl:*current-process*)
+
+(defimplementation all-threads ()
+ (ccl:all-processes))
+
+(defimplementation kill-thread (thread)
+ ;;(ccl:process-kill thread) ; doesn't cut it
+ (ccl::process-initial-form-exited thread :kill))
+
+(defimplementation thread-alive-p (thread)
+ (not (ccl:process-exhausted-p thread)))
+
+(defimplementation interrupt-thread (thread function)
+ (ccl:process-interrupt
+ thread
+ (lambda ()
+ (let ((ccl:*top-error-frame* (ccl::%current-exception-frame)))
+ (funcall function)))))
+
+(defun mailbox (thread)
+ (ccl:with-lock-grabbed (*known-processes-lock*)
+ (or (gethash thread *known-processes*)
+ (setf (gethash thread *known-processes*) (make-mailbox)))))
+
+(defimplementation send (thread message)
+ (assert message)
+ (let* ((mbox (mailbox thread))
+ (mutex (mailbox.mutex mbox)))
+ (ccl:with-lock-grabbed (mutex)
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message)))
+ (ccl:signal-semaphore (mailbox.semaphore mbox)))))
+
+(defimplementation receive-if (test &optional timeout)
+ (let* ((mbox (mailbox ccl:*current-process*))
+ (mutex (mailbox.mutex mbox)))
+ (assert (or (not timeout) (eq timeout t)))
+ (loop
+ (check-slime-interrupts)
+ (ccl:with-lock-grabbed (mutex)
+ (let* ((q (mailbox.queue mbox))
+ (tail (member-if test q)))
+ (when tail
+ (setf (mailbox.queue mbox)
+ (nconc (ldiff q tail) (cdr tail)))
+ (return (car tail)))))
+ (when (eq timeout t) (return (values nil t)))
+ (ccl:timed-wait-on-semaphore (mailbox.semaphore mbox) 1))))
+
+(let ((alist '())
+ (lock (ccl:make-lock "register-thread")))
+
+ (defimplementation register-thread (name thread)
+ (declare (type symbol name))
+ (ccl:with-lock-grabbed (lock)
+ (etypecase thread
+ (null
+ (setf alist (delete name alist :key #'car)))
+ (ccl:process
+ (let ((probe (assoc name alist)))
+ (cond (probe (setf (cdr probe) thread))
+ (t (setf alist (acons name thread alist))))))))
+ nil)
+
+ (defimplementation find-registered (name)
+ (ccl:with-lock-grabbed (lock)
+ (cdr (assoc name alist)))))
+
+(defimplementation set-default-initial-binding (var form)
+ (eval `(ccl::def-standard-initial-binding ,var ,form)))
+
+(defimplementation quit-lisp ()
+ (ccl:quit))
+
+(defimplementation set-default-directory (directory)
+ (let ((dir (truename (merge-pathnames directory))))
+ (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
+ (ccl:cwd dir)
+ (default-directory)))
+
+;;; Weak datastructures
+
+(defimplementation make-weak-key-hash-table (&rest args)
+ (apply #'make-hash-table :weak :key args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+ (apply #'make-hash-table :weak :value args))
+
+(defimplementation hash-table-weakness (hashtable)
+ (ccl:hash-table-weak-p hashtable))
+
+(pushnew 'deinit-log-output ccl:*save-exit-functions*)
diff --git a/vim/bundle/slimv/slime/swank/clasp.lisp b/vim/bundle/slimv/slime/swank/clasp.lisp
new file mode 100644
index 0000000..3e0c4ef
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/clasp.lisp
@@ -0,0 +1,730 @@
+;;;; -*- indent-tabs-mode: nil -*-
+;;;
+;;; swank-clasp.lisp --- SLIME backend for CLASP.
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+;;; Administrivia
+
+(defpackage swank/clasp
+ (:use cl swank/backend))
+
+(in-package swank/clasp)
+
+
+(defmacro cslime-log (fmt &rest fmt-args)
+ `(format t ,fmt ,@fmt-args))
+
+;; Hard dependencies.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (require 'sockets))
+
+;; Soft dependencies.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (when (probe-file "sys:profile.fas")
+ (require :profile)
+ (pushnew :profile *features*))
+ (when (probe-file "sys:serve-event")
+ (require :serve-event)
+ (pushnew :serve-event *features*)))
+
+(declaim (optimize (debug 3)))
+
+;;; Swank-mop
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (import-swank-mop-symbols
+ :clos
+ `(:eql-specializer
+ :eql-specializer-object
+ :generic-function-declarations
+ :specializer-direct-methods
+ ,@(unless (fboundp 'clos:compute-applicable-methods-using-classes)
+ '(:compute-applicable-methods-using-classes)))))
+
+(defimplementation gray-package-name ()
+ "GRAY")
+
+
+;;;; TCP Server
+
+(defimplementation preferred-communication-style ()
+ ;; CLASP does not provide threads yet.
+ ;; ECLs swank implementation says that CLOS is not thread safe and
+ ;; I use ECLs CLOS implementation - this is a worry for the future.
+ nil
+ )
+
+(defun resolve-hostname (name)
+ (car (sb-bsd-sockets:host-ent-addresses
+ (sb-bsd-sockets:get-host-by-name name))))
+
+(defimplementation create-socket (host port &key backlog)
+ (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+ :type :stream
+ :protocol :tcp)))
+ (setf (sb-bsd-sockets:sockopt-reuse-address socket) t)
+ (sb-bsd-sockets:socket-bind socket (resolve-hostname host) port)
+ (sb-bsd-sockets:socket-listen socket (or backlog 5))
+ socket))
+
+(defimplementation local-port (socket)
+ (nth-value 1 (sb-bsd-sockets:socket-name socket)))
+
+(defimplementation close-socket (socket)
+ (sb-bsd-sockets:socket-close socket))
+
+(defimplementation accept-connection (socket
+ &key external-format
+ buffering timeout)
+ (declare (ignore timeout))
+ (sb-bsd-sockets:socket-make-stream (accept socket)
+ :output t
+ :input t
+ :buffering (ecase buffering
+ ((t) :full)
+ ((nil) :none)
+ (:line :line))
+ :element-type (if external-format
+ 'character
+ '(unsigned-byte 8))
+ :external-format external-format))
+(defun accept (socket)
+ "Like socket-accept, but retry on EAGAIN."
+ (loop (handler-case
+ (return (sb-bsd-sockets:socket-accept socket))
+ (sb-bsd-sockets:interrupted-error ()))))
+
+(defimplementation socket-fd (socket)
+ (etypecase socket
+ (fixnum socket)
+ (two-way-stream (socket-fd (two-way-stream-input-stream socket)))
+ (sb-bsd-sockets:socket (sb-bsd-sockets:socket-file-descriptor socket))
+ (file-stream (si:file-stream-fd socket))))
+
+(defvar *external-format-to-coding-system*
+ '((:latin-1
+ "latin-1" "latin-1-unix" "iso-latin-1-unix"
+ "iso-8859-1" "iso-8859-1-unix")
+ (:utf-8 "utf-8" "utf-8-unix")))
+
+(defun external-format (coding-system)
+ (or (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*))
+ (find coding-system (ext:all-encodings) :test #'string-equal)))
+
+(defimplementation find-external-format (coding-system)
+ #+unicode (external-format coding-system)
+ ;; Without unicode support, CLASP uses the one-byte encoding of the
+ ;; underlying OS, and will barf on anything except :DEFAULT. We
+ ;; return NIL here for known multibyte encodings, so
+ ;; SWANK:CREATE-SERVER will barf.
+ #-unicode (let ((xf (external-format coding-system)))
+ (if (member xf '(:utf-8))
+ nil
+ :default)))
+
+
+;;;; Unix Integration
+
+;;; If CLASP is built with thread support, it'll spawn a helper thread
+;;; executing the SIGINT handler. We do not want to BREAK into that
+;;; helper but into the main thread, though. This is coupled with the
+;;; current choice of NIL as communication-style in so far as CLASP's
+;;; main-thread is also the Slime's REPL thread.
+
+#+clasp-working
+(defimplementation call-with-user-break-handler (real-handler function)
+ (let ((old-handler #'si:terminal-interrupt))
+ (setf (symbol-function 'si:terminal-interrupt)
+ (make-interrupt-handler real-handler))
+ (unwind-protect (funcall function)
+ (setf (symbol-function 'si:terminal-interrupt) old-handler))))
+
+#+threads
+(defun make-interrupt-handler (real-handler)
+ (let ((main-thread (find 'si:top-level (mp:all-processes)
+ :key #'mp:process-name)))
+ #'(lambda (&rest args)
+ (declare (ignore args))
+ (mp:interrupt-process main-thread real-handler))))
+
+#-threads
+(defun make-interrupt-handler (real-handler)
+ #'(lambda (&rest args)
+ (declare (ignore args))
+ (funcall real-handler)))
+
+
+(defimplementation getpid ()
+ (si:getpid))
+
+(defimplementation set-default-directory (directory)
+ (ext:chdir (namestring directory)) ; adapts *DEFAULT-PATHNAME-DEFAULTS*.
+ (default-directory))
+
+(defimplementation default-directory ()
+ (namestring (ext:getcwd)))
+
+(defimplementation quit-lisp ()
+ (core:quit))
+
+
+
+;;; Instead of busy waiting with communication-style NIL, use select()
+;;; on the sockets' streams.
+#+serve-event
+(progn
+ (defun poll-streams (streams timeout)
+ (let* ((serve-event::*descriptor-handlers*
+ (copy-list serve-event::*descriptor-handlers*))
+ (active-fds '())
+ (fd-stream-alist
+ (loop for s in streams
+ for fd = (socket-fd s)
+ collect (cons fd s)
+ do (serve-event:add-fd-handler fd :input
+ #'(lambda (fd)
+ (push fd active-fds))))))
+ (serve-event:serve-event timeout)
+ (loop for fd in active-fds collect (cdr (assoc fd fd-stream-alist)))))
+
+ (defimplementation wait-for-input (streams &optional timeout)
+ (assert (member timeout '(nil t)))
+ (loop
+ (cond ((check-slime-interrupts) (return :interrupt))
+ (timeout (return (poll-streams streams 0)))
+ (t
+ (when-let (ready (poll-streams streams 0.2))
+ (return ready))))))
+
+) ; #+serve-event (progn ...
+
+#-serve-event
+(defimplementation wait-for-input (streams &optional timeout)
+ (assert (member timeout '(nil t)))
+ (loop
+ (cond ((check-slime-interrupts) (return :interrupt))
+ (timeout (return (remove-if-not #'listen streams)))
+ (t
+ (let ((ready (remove-if-not #'listen streams)))
+ (if ready (return ready))
+ (sleep 0.1))))))
+
+
+;;;; Compilation
+
+(defvar *buffer-name* nil)
+(defvar *buffer-start-position*)
+
+(defun signal-compiler-condition (&rest args)
+ (apply #'signal 'compiler-condition args))
+
+#-clasp-bytecmp
+(defun handle-compiler-message (condition)
+ ;; CLASP emits lots of noise in compiler-notes, like "Invoking
+ ;; external command".
+ (unless (typep condition 'c::compiler-note)
+ (signal-compiler-condition
+ :original-condition condition
+ :message (princ-to-string condition)
+ :severity (etypecase condition
+ (cmp:compiler-fatal-error :error)
+ (cmp:compiler-error :error)
+ (error :error)
+ (style-warning :style-warning)
+ (warning :warning))
+ :location (condition-location condition))))
+
+#-clasp-bytecmp
+(defun condition-location (condition)
+ (let ((file (cmp:compiler-message-file condition))
+ (position (cmp:compiler-message-file-position condition)))
+ (if (and position (not (minusp position)))
+ (if *buffer-name*
+ (make-buffer-location *buffer-name*
+ *buffer-start-position*
+ position)
+ (make-file-location file position))
+ (make-error-location "No location found."))))
+
+(defimplementation call-with-compilation-hooks (function)
+ (funcall function))
+#|| #-clasp-bytecmp
+ (handler-bind ((c:compiler-message #'handle-compiler-message))
+ (funcall function)))
+||#
+
+
+(defimplementation swank-compile-file (input-file output-file
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
+ (format t "Compiling file input-file = ~a output-file = ~a~%" input-file output-file)
+ ;; Ignore the output-file and generate our own
+ (let ((tmp-output-file (compile-file-pathname (si:mkstemp "TMP:clasp-swank-compile-file-"))))
+ (format t "Using tmp-output-file: ~a~%" tmp-output-file)
+ (multiple-value-bind (fasl warnings-p failure-p)
+ (with-compilation-hooks ()
+ (compile-file input-file :output-file tmp-output-file
+ :external-format external-format))
+ (values fasl warnings-p
+ (or failure-p
+ (when load-p
+ (not (load fasl))))))))
+
+(defvar *tmpfile-map* (make-hash-table :test #'equal))
+
+(defun note-buffer-tmpfile (tmp-file buffer-name)
+ ;; EXT:COMPILED-FUNCTION-FILE below will return a namestring.
+ (let ((tmp-namestring (namestring (truename tmp-file))))
+ (setf (gethash tmp-namestring *tmpfile-map*) buffer-name)
+ tmp-namestring))
+
+(defun tmpfile-to-buffer (tmp-file)
+ (gethash tmp-file *tmpfile-map*))
+
+(defimplementation swank-compile-string (string &key buffer position filename policy)
+ (declare (ignore policy))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer) ; for compilation hooks
+ (*buffer-start-position* position))
+ (let ((tmp-file (si:mkstemp "TMP:clasp-swank-tmpfile-"))
+ (fasl-file)
+ (warnings-p)
+ (failure-p))
+ (unwind-protect
+ (with-open-file (tmp-stream tmp-file :direction :output
+ :if-exists :supersede)
+ (write-string string tmp-stream)
+ (finish-output tmp-stream)
+ (multiple-value-setq (fasl-file warnings-p failure-p)
+ (let ((truename (or filename (note-buffer-tmpfile tmp-file buffer))))
+ (compile-file tmp-file
+ :source-debug-namestring truename
+ :source-debug-offset (1- position)))))
+ (when fasl-file (load fasl-file))
+ (when (probe-file tmp-file)
+ (delete-file tmp-file))
+ (when fasl-file
+ (delete-file fasl-file)))
+ (not failure-p)))))
+
+;;;; Documentation
+
+(defimplementation arglist (name)
+ (multiple-value-bind (arglist foundp)
+ (core:function-lambda-list name) ;; Uses bc-split
+ (if foundp arglist :not-available)))
+
+(defimplementation function-name (f)
+ (typecase f
+ (generic-function (clos::generic-function-name f))
+ (function (ext:compiled-function-name f))))
+
+;; FIXME
+(defimplementation macroexpand-all (form &optional env)
+ (declare (ignore env))
+ (macroexpand form))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((frob (type boundp)
+ (when (funcall boundp symbol)
+ (let ((doc (describe-definition symbol type)))
+ (setf result (list* type doc result))))))
+ (frob :VARIABLE #'boundp)
+ (frob :FUNCTION #'fboundp)
+ (frob :CLASS (lambda (x) (find-class x nil))))
+ result))
+
+(defimplementation describe-definition (name type)
+ (case type
+ (:variable (documentation name 'variable))
+ (:function (documentation name 'function))
+ (:class (documentation name 'class))
+ (t nil)))
+
+(defimplementation type-specifier-p (symbol)
+ (or (subtypep nil symbol)
+ (not (eq (type-specifier-arglist symbol) :not-available))))
+
+
+;;; Debugging
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (import
+ '(si::*break-env*
+ si::*ihs-top*
+ si::*ihs-current*
+ si::*ihs-base*
+#+frs si::*frs-base*
+#+frs si::*frs-top*
+ si::*tpl-commands*
+ si::*tpl-level*
+#+frs si::frs-top
+ si::ihs-top
+ si::ihs-fun
+ si::ihs-env
+#+frs si::sch-frs-base
+ si::set-break-env
+ si::set-current-ihs
+ si::tpl-commands)))
+
+(defun make-invoke-debugger-hook (hook)
+ (when hook
+ #'(lambda (condition old-hook)
+ ;; Regard *debugger-hook* if set by user.
+ (if *debugger-hook*
+ nil ; decline, *DEBUGGER-HOOK* will be tried next.
+ (funcall hook condition old-hook)))))
+
+(defimplementation install-debugger-globally (function)
+ (setq *debugger-hook* function)
+ (setq ext:*invoke-debugger-hook* (make-invoke-debugger-hook function))
+ )
+
+(defimplementation call-with-debugger-hook (hook fun)
+ (let ((*debugger-hook* hook)
+ (ext:*invoke-debugger-hook* (make-invoke-debugger-hook hook)))
+ (funcall fun))
+ )
+
+(defvar *backtrace* '())
+
+;;; Commented out; it's not clear this is a good way of doing it. In
+;;; particular because it makes errors stemming from this file harder
+;;; to debug, and given the "young" age of CLASP's swank backend, that's
+;;; a bad idea.
+
+;; (defun in-swank-package-p (x)
+;; (and
+;; (symbolp x)
+;; (member (symbol-package x)
+;; (list #.(find-package :swank)
+;; #.(find-package :swank/backend)
+;; #.(ignore-errors (find-package :swank-mop))
+;; #.(ignore-errors (find-package :swank-loader))))
+;; t))
+
+;; (defun is-swank-source-p (name)
+;; (setf name (pathname name))
+;; (pathname-match-p
+;; name
+;; (make-pathname :defaults swank-loader::*source-directory*
+;; :name (pathname-name name)
+;; :type (pathname-type name)
+;; :version (pathname-version name))))
+
+;; (defun is-ignorable-fun-p (x)
+;; (or
+;; (in-swank-package-p (frame-name x))
+;; (multiple-value-bind (file position)
+;; (ignore-errors (si::bc-file (car x)))
+;; (declare (ignore position))
+;; (if file (is-swank-source-p file)))))
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (declare (type function debugger-loop-fn))
+ (let* ((*ihs-top* (or #+#.(swank/backend:with-symbol '*stack-top-hint* 'core)
+ core:*stack-top-hint*
+ (ihs-top)))
+ (*ihs-current* *ihs-top*)
+#+frs (*frs-base* (or (sch-frs-base *frs-top* *ihs-base*) (1+ (frs-top))))
+#+frs (*frs-top* (frs-top))
+ (*tpl-level* (1+ *tpl-level*))
+ (*backtrace* (loop for ihs from 0 below *ihs-top*
+ collect (list (si::ihs-fun ihs)
+ (si::ihs-env ihs)
+ ihs))))
+ (declare (special *ihs-current*))
+#+frs (loop for f from *frs-base* until *frs-top*
+ do (let ((i (- (si::frs-ihs f) *ihs-base* 1)))
+ (when (plusp i)
+ (let* ((x (elt *backtrace* i))
+ (name (si::frs-tag f)))
+ (unless (si::fixnump name)
+ (push name (third x)))))))
+ (setf *backtrace* (nreverse *backtrace*))
+ (set-break-env)
+ (set-current-ihs)
+ (let ((*ihs-base* *ihs-top*))
+ (funcall debugger-loop-fn))))
+
+(defimplementation compute-backtrace (start end)
+ (subseq *backtrace* start
+ (and (numberp end)
+ (min end (length *backtrace*)))))
+
+(defun frame-name (frame)
+ (let ((x (first frame)))
+ (if (symbolp x)
+ x
+ (function-name x))))
+
+(defun frame-function (frame-number)
+ (let ((x (first (elt *backtrace* frame-number))))
+ (etypecase x
+ (symbol
+ (and (fboundp x)
+ (fdefinition x)))
+ (function
+ x))))
+
+(defimplementation print-frame (frame stream)
+ (format stream "(~s~{ ~s~})" (function-name (first frame))
+ #+#.(swank/backend:with-symbol 'ihs-arguments 'core)
+ (coerce (core:ihs-arguments (third frame)) 'list)
+ #-#.(swank/backend:with-symbol 'ihs-arguments 'core)
+ nil))
+
+(defimplementation frame-source-location (frame-number)
+ (source-location (frame-function frame-number)))
+
+#+clasp-working
+(defimplementation frame-catch-tags (frame-number)
+ (third (elt *backtrace* frame-number)))
+
+(defun ihs-frame-id (frame-number)
+ (- (core:ihs-top) frame-number))
+
+(defimplementation frame-locals (frame-number)
+ (let* ((frame (elt *backtrace* frame-number))
+ (env (second frame))
+ (locals (loop for x = env then (core:get-parent-environment x)
+ while x
+ nconc (loop for name across (core:environment-debug-names x)
+ for value across (core:environment-debug-values x)
+ collect (list :name name :id 0 :value value)))))
+ (nconc
+ (loop for arg across (core:ihs-arguments (third frame))
+ for i from 0
+ collect (list :name (intern (format nil "ARG~d" i) #.*package*)
+ :id 0
+ :value arg))
+ locals)))
+
+(defimplementation frame-var-value (frame-number var-number)
+ (let* ((frame (elt *backtrace* frame-number))
+ (env (second frame))
+ (args (core:ihs-arguments (third frame))))
+ (if (< var-number (length args))
+ (svref args var-number)
+ (elt (frame-locals frame-number) var-number))))
+
+#+clasp-working
+(defimplementation disassemble-frame (frame-number)
+ (let ((fun (frame-function frame-number)))
+ (disassemble fun)))
+
+(defimplementation eval-in-frame (form frame-number)
+ (let ((env (second (elt *backtrace* frame-number))))
+ (core:compile-form-and-eval-with-env form env)))
+
+#+clasp-working
+(defimplementation gdb-initial-commands ()
+ ;; These signals are used by the GC.
+ #+linux '("handle SIGPWR noprint nostop"
+ "handle SIGXCPU noprint nostop"))
+
+#+clasp-working
+(defimplementation command-line-args ()
+ (loop for n from 0 below (si:argc) collect (si:argv n)))
+
+
+;;;; Inspector
+
+;;; FIXME: Would be nice if it was possible to inspect objects
+;;; implemented in C.
+
+
+;;;; Definitions
+
+(defun make-file-location (file file-position)
+ ;; File positions in CL start at 0, but Emacs' buffer positions
+ ;; start at 1. We specify (:ALIGN T) because the positions comming
+ ;; from CLASP point at right after the toplevel form appearing before
+ ;; the actual target toplevel form; (:ALIGN T) will DTRT in that case.
+ (make-location `(:file ,(namestring (translate-logical-pathname file)))
+ `(:position ,(1+ file-position))
+ `(:align t)))
+
+(defun make-buffer-location (buffer-name start-position &optional (offset 0))
+ (make-location `(:buffer ,buffer-name)
+ `(:offset ,start-position ,offset)
+ `(:align t)))
+
+(defun translate-location (location)
+ (make-location (list :file (namestring (ext:source-location-pathname location)))
+ (list :position (ext:source-location-offset location))
+ '(:align t)))
+
+(defimplementation find-definitions (name)
+ (loop for kind in ext:*source-location-kinds*
+ for locations = (ext:source-location name kind)
+ when locations
+ nconc (loop for location in locations
+ collect (list kind (translate-location location)))))
+
+(defun source-location (object)
+ (let ((location (ext:source-location object t)))
+ (when location
+ (translate-location (car location)))))
+
+(defimplementation find-source-location (object)
+ (or (source-location object)
+ (make-error-location "Source definition of ~S not found." object)))
+
+
+;;;; Profiling
+
+#+profile
+(progn
+
+(defimplementation profile (fname)
+ (when fname (eval `(profile:profile ,fname))))
+
+(defimplementation unprofile (fname)
+ (when fname (eval `(profile:unprofile ,fname))))
+
+(defimplementation unprofile-all ()
+ (profile:unprofile-all)
+ "All functions unprofiled.")
+
+(defimplementation profile-report ()
+ (profile:report))
+
+(defimplementation profile-reset ()
+ (profile:reset)
+ "Reset profiling counters.")
+
+(defimplementation profiled-functions ()
+ (profile:profile))
+
+(defimplementation profile-package (package callers methods)
+ (declare (ignore callers methods))
+ (eval `(profile:profile ,(package-name (find-package package)))))
+) ; #+profile (progn ...
+
+
+;;;; Threads
+
+#+threads
+(progn
+ (defvar *thread-id-counter* 0)
+
+ (defparameter *thread-id-map* (make-hash-table))
+
+ (defvar *thread-id-map-lock*
+ (mp:make-lock :name "thread id map lock"))
+
+ (defimplementation spawn (fn &key name)
+ (mp:process-run-function name fn))
+
+ (defimplementation thread-id (target-thread)
+ (block thread-id
+ (mp:with-lock (*thread-id-map-lock*)
+ ;; Does TARGET-THREAD have an id already?
+ (maphash (lambda (id thread-pointer)
+ (let ((thread (si:weak-pointer-value thread-pointer)))
+ (cond ((not thread)
+ (remhash id *thread-id-map*))
+ ((eq thread target-thread)
+ (return-from thread-id id)))))
+ *thread-id-map*)
+ ;; TARGET-THREAD not found in *THREAD-ID-MAP*
+ (let ((id (incf *thread-id-counter*))
+ (thread-pointer (si:make-weak-pointer target-thread)))
+ (setf (gethash id *thread-id-map*) thread-pointer)
+ id))))
+
+ (defimplementation find-thread (id)
+ (mp:with-lock (*thread-id-map-lock*)
+ (let* ((thread-ptr (gethash id *thread-id-map*))
+ (thread (and thread-ptr (si:weak-pointer-value thread-ptr))))
+ (unless thread
+ (remhash id *thread-id-map*))
+ thread)))
+
+ (defimplementation thread-name (thread)
+ (mp:process-name thread))
+
+ (defimplementation thread-status (thread)
+ (if (mp:process-active-p thread)
+ "RUNNING"
+ "STOPPED"))
+
+ (defimplementation make-lock (&key name)
+ (mp:make-lock :name name :recursive t))
+
+ (defimplementation call-with-lock-held (lock function)
+ (declare (type function function))
+ (mp:with-lock (lock) (funcall function)))
+
+ (defimplementation current-thread ()
+ mp:*current-process*)
+
+ (defimplementation all-threads ()
+ (mp:all-processes))
+
+ (defimplementation interrupt-thread (thread fn)
+ (mp:interrupt-process thread fn))
+
+ (defimplementation kill-thread (thread)
+ (mp:process-kill thread))
+
+ (defimplementation thread-alive-p (thread)
+ (mp:process-active-p thread))
+
+ (defvar *mailbox-lock* (mp:make-lock :name "mailbox lock"))
+ (defvar *mailboxes* (list))
+ (declaim (type list *mailboxes*))
+
+ (defstruct (mailbox (:conc-name mailbox.))
+ thread
+ (mutex (mp:make-lock))
+ (cvar (mp:make-condition-variable))
+ (queue '() :type list))
+
+ (defun mailbox (thread)
+ "Return THREAD's mailbox."
+ (mp:with-lock (*mailbox-lock*)
+ (or (find thread *mailboxes* :key #'mailbox.thread)
+ (let ((mb (make-mailbox :thread thread)))
+ (push mb *mailboxes*)
+ mb))))
+
+ (defimplementation send (thread message)
+ (let* ((mbox (mailbox thread))
+ (mutex (mailbox.mutex mbox)))
+ (mp:with-lock (mutex)
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message)))
+ (mp:condition-variable-broadcast (mailbox.cvar mbox)))))
+
+ (defimplementation receive-if (test &optional timeout)
+ (let* ((mbox (mailbox (current-thread)))
+ (mutex (mailbox.mutex mbox)))
+ (assert (or (not timeout) (eq timeout t)))
+ (loop
+ (check-slime-interrupts)
+ (mp:with-lock (mutex)
+ (let* ((q (mailbox.queue mbox))
+ (tail (member-if test q)))
+ (when tail
+ (setf (mailbox.queue mbox) (nconc (ldiff q tail) (cdr tail)))
+ (return (car tail))))
+ (when (eq timeout t) (return (values nil t)))
+ (mp:condition-variable-timedwait (mailbox.cvar mbox)
+ mutex
+ 0.2)))))
+
+ ) ; #+threads (progn ...
+
+
+(defmethod emacs-inspect ((object core:cxx-object))
+ (let ((encoded (core:encode object)))
+ (loop for (key . value) in encoded
+ append (list (string key) ": " (list :value value) (list :newline)))))
diff --git a/vim/bundle/slimv/slime/swank/clisp.lisp b/vim/bundle/slimv/slime/swank/clisp.lisp
new file mode 100644
index 0000000..27ae688
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/clisp.lisp
@@ -0,0 +1,930 @@
+;;;; -*- indent-tabs-mode: nil -*-
+
+;;;; SWANK support for CLISP.
+
+;;;; Copyright (C) 2003, 2004 W. Jenkner, V. Sedach
+
+;;;; This program is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public License as
+;;;; published by the Free Software Foundation; either version 2 of
+;;;; the License, or (at your option) any later version.
+
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+
+;;;; You should have received a copy of the GNU General Public
+;;;; License along with this program; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;;;; MA 02111-1307, USA.
+
+;;; This is work in progress, but it's already usable. Many things
+;;; are adapted from other swank-*.lisp, in particular from
+;;; swank-allegro (I don't use allegro at all, but it's the shortest
+;;; one and I found Helmut Eller's code there enlightening).
+
+;;; This code will work better with recent versions of CLISP (say, the
+;;; last release or CVS HEAD) while it may not work at all with older
+;;; versions. It is reasonable to expect it to work on platforms with
+;;; a "SOCKET" package, in particular on GNU/Linux or Unix-like
+;;; systems, but also on Win32. This backend uses the portable xref
+;;; from the CMU AI repository and metering.lisp from CLOCC [1], which
+;;; are conveniently included in SLIME.
+
+;;; [1] http://cvs.sourceforge.net/viewcvs.py/clocc/clocc/src/tools/metering/
+
+(defpackage swank/clisp
+ (:use cl swank/backend))
+
+(in-package swank/clisp)
+
+(eval-when (:compile-toplevel)
+ (unless (string< "2.44" (lisp-implementation-version))
+ (error "Need at least CLISP version 2.44")))
+
+(defimplementation gray-package-name ()
+ "GRAY")
+
+;;;; if this lisp has the complete CLOS then we use it, otherwise we
+;;;; build up a "fake" swank-mop and then override the methods in the
+;;;; inspector.
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar *have-mop*
+ (and (find-package :clos)
+ (eql :external
+ (nth-value 1 (find-symbol (string ':standard-slot-definition)
+ :clos))))
+ "True in those CLISP images which have a complete MOP implementation."))
+
+#+#.(cl:if swank/clisp::*have-mop* '(cl:and) '(cl:or))
+(progn
+ (import-swank-mop-symbols :clos '(:slot-definition-documentation))
+
+ (defun swank-mop:slot-definition-documentation (slot)
+ (clos::slot-definition-documentation slot)))
+
+#-#.(cl:if swank/clisp::*have-mop* '(and) '(or))
+(defclass swank-mop:standard-slot-definition ()
+ ()
+ (:documentation
+ "Dummy class created so that swank.lisp will compile and load."))
+
+(let ((getpid (or (find-symbol "PROCESS-ID" :system)
+ ;; old name prior to 2005-03-01, clisp <= 2.33.2
+ (find-symbol "PROGRAM-ID" :system)
+ #+win32 ; integrated into the above since 2005-02-24
+ (and (find-package :win32) ; optional modules/win32
+ (find-symbol "GetCurrentProcessId" :win32)))))
+ (defimplementation getpid () ; a required interface
+ (cond
+ (getpid (funcall getpid))
+ #+win32 ((ext:getenv "PID")) ; where does that come from?
+ (t -1))))
+
+(defimplementation call-with-user-break-handler (handler function)
+ (handler-bind ((system::simple-interrupt-condition
+ (lambda (c)
+ (declare (ignore c))
+ (funcall handler)
+ (when (find-restart 'socket-status)
+ (invoke-restart (find-restart 'socket-status)))
+ (continue))))
+ (funcall function)))
+
+(defimplementation lisp-implementation-type-name ()
+ "clisp")
+
+(defimplementation set-default-directory (directory)
+ (setf (ext:default-directory) directory)
+ (namestring (setf *default-pathname-defaults* (ext:default-directory))))
+
+(defimplementation filename-to-pathname (string)
+ (cond ((member :cygwin *features*)
+ (parse-cygwin-filename string))
+ (t (parse-namestring string))))
+
+(defun parse-cygwin-filename (string)
+ (multiple-value-bind (match _ drive absolute)
+ (regexp:match "^(([a-zA-Z\\]+):)?([\\/])?" string :extended t)
+ (declare (ignore _))
+ (assert (and match (if drive absolute t)) ()
+ "Invalid filename syntax: ~a" string)
+ (let* ((sans-prefix (subseq string (regexp:match-end match)))
+ (path (remove "" (regexp:regexp-split "[\\/]" sans-prefix)))
+ (path (loop for name in path collect
+ (cond ((equal name "..") ':back)
+ (t name))))
+ (directoryp (or (equal string "")
+ (find (aref string (1- (length string))) "\\/"))))
+ (multiple-value-bind (file type)
+ (cond ((and (not directoryp) (last path))
+ (let* ((file (car (last path)))
+ (pos (position #\. file :from-end t)))
+ (cond ((and pos (> pos 0))
+ (values (subseq file 0 pos)
+ (subseq file (1+ pos))))
+ (t file)))))
+ (make-pathname :host nil
+ :device nil
+ :directory (cons
+ (if absolute :absolute :relative)
+ (let ((path (if directoryp
+ path
+ (butlast path))))
+ (if drive
+ (cons
+ (regexp:match-string string drive)
+ path)
+ path)))
+ :name file
+ :type type)))))
+
+;;;; UTF
+
+(defimplementation string-to-utf8 (string)
+ (let ((enc (load-time-value
+ (ext:make-encoding :charset "utf-8" :line-terminator :unix)
+ t)))
+ (ext:convert-string-to-bytes string enc)))
+
+(defimplementation utf8-to-string (octets)
+ (let ((enc (load-time-value
+ (ext:make-encoding :charset "utf-8" :line-terminator :unix)
+ t)))
+ (ext:convert-string-from-bytes octets enc)))
+
+;;;; TCP Server
+
+(defimplementation create-socket (host port &key backlog)
+ (socket:socket-server port :interface host :backlog (or backlog 5)))
+
+(defimplementation local-port (socket)
+ (socket:socket-server-port socket))
+
+(defimplementation close-socket (socket)
+ (socket:socket-server-close socket))
+
+(defimplementation accept-connection (socket
+ &key external-format buffering timeout)
+ (declare (ignore buffering timeout))
+ (socket:socket-accept socket
+ :buffered buffering ;; XXX may not work if t
+ :element-type (if external-format
+ 'character
+ '(unsigned-byte 8))
+ :external-format (or external-format :default)))
+
+#-win32
+(defimplementation wait-for-input (streams &optional timeout)
+ (assert (member timeout '(nil t)))
+ (let ((streams (mapcar (lambda (s) (list* s :input nil)) streams)))
+ (loop
+ (cond ((check-slime-interrupts) (return :interrupt))
+ (timeout
+ (socket:socket-status streams 0 0)
+ (return (loop for (s nil . x) in streams
+ if x collect s)))
+ (t
+ (with-simple-restart (socket-status "Return from socket-status.")
+ (socket:socket-status streams 0 500000))
+ (let ((ready (loop for (s nil . x) in streams
+ if x collect s)))
+ (when ready (return ready))))))))
+
+#+win32
+(defimplementation wait-for-input (streams &optional timeout)
+ (assert (member timeout '(nil t)))
+ (loop
+ (cond ((check-slime-interrupts) (return :interrupt))
+ (t
+ (let ((ready (remove-if-not #'input-available-p streams)))
+ (when ready (return ready)))
+ (when timeout (return nil))
+ (sleep 0.1)))))
+
+#+win32
+;; Some facts to remember (for the next time we need to debug this):
+;; - interactive-sream-p returns t for socket-streams
+;; - listen returns nil for socket-streams
+;; - (type-of <socket-stream>) is 'stream
+;; - (type-of *terminal-io*) is 'two-way-stream
+;; - stream-element-type on our sockets is usually (UNSIGNED-BYTE 8)
+;; - calling socket:socket-status on non sockets signals an error,
+;; but seems to mess up something internally.
+;; - calling read-char-no-hang on sockets does not signal an error,
+;; but seems to mess up something internally.
+(defun input-available-p (stream)
+ (case (stream-element-type stream)
+ (character
+ (let ((c (read-char-no-hang stream nil nil)))
+ (cond ((not c)
+ nil)
+ (t
+ (unread-char c stream)
+ t))))
+ (t
+ (eq (socket:socket-status (cons stream :input) 0 0)
+ :input))))
+
+;;;; Coding systems
+
+(defvar *external-format-to-coding-system*
+ '(((:charset "iso-8859-1" :line-terminator :unix)
+ "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix")
+ ((:charset "iso-8859-1")
+ "latin-1" "iso-latin-1" "iso-8859-1")
+ ((:charset "utf-8") "utf-8")
+ ((:charset "utf-8" :line-terminator :unix) "utf-8-unix")
+ ((:charset "euc-jp") "euc-jp")
+ ((:charset "euc-jp" :line-terminator :unix) "euc-jp-unix")
+ ((:charset "us-ascii") "us-ascii")
+ ((:charset "us-ascii" :line-terminator :unix) "us-ascii-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (let ((args (car (rassoc-if (lambda (x)
+ (member coding-system x :test #'equal))
+ *external-format-to-coding-system*))))
+ (and args (apply #'ext:make-encoding args))))
+
+
+;;;; Swank functions
+
+(defimplementation arglist (fname)
+ (block nil
+ (or (ignore-errors
+ (let ((exp (function-lambda-expression fname)))
+ (and exp (return (second exp)))))
+ (ignore-errors
+ (return (ext:arglist fname)))
+ :not-available)))
+
+(defimplementation macroexpand-all (form &optional env)
+ (declare (ignore env))
+ (ext:expand-form form))
+
+(defimplementation collect-macro-forms (form &optional env)
+ ;; Currently detects only normal macros, not compiler macros.
+ (declare (ignore env))
+ (with-collected-macro-forms (macro-forms)
+ (handler-bind ((warning #'muffle-warning))
+ (ignore-errors
+ (compile nil `(lambda () ,form))))
+ (values macro-forms nil)))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ "Return a plist describing SYMBOL.
+Return NIL if the symbol is unbound."
+ (let ((result ()))
+ (flet ((doc (kind)
+ (or (documentation symbol kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push :variable (when (boundp symbol) (doc 'variable)))
+ (when (fboundp symbol)
+ (maybe-push
+ ;; Report WHEN etc. as macros, even though they may be
+ ;; implemented as special operators.
+ (if (macro-function symbol) :macro
+ (typecase (fdefinition symbol)
+ (generic-function :generic-function)
+ (function :function)
+ ;; (type-of 'progn) -> ext:special-operator
+ (t :special-operator)))
+ (doc 'function)))
+ (when (or (get symbol 'system::setf-function) ; e.g. #'(setf elt)
+ (get symbol 'system::setf-expander)); defsetf
+ (maybe-push :setf (doc 'setf)))
+ (when (or (get symbol 'system::type-symbol); cf. clisp/src/describe.lisp
+ (get symbol 'system::defstruct-description)
+ (get symbol 'system::deftype-expander))
+ (maybe-push :type (doc 'type))) ; even for 'structure
+ (when (find-class symbol nil)
+ (maybe-push :class (doc 'type)))
+ ;; Let this code work compiled in images without FFI
+ (let ((types (load-time-value
+ (and (find-package "FFI")
+ (symbol-value
+ (find-symbol "*C-TYPE-TABLE*" "FFI"))))))
+ ;; Use ffi::*c-type-table* so as not to suffer the overhead of
+ ;; (ignore-errors (ffi:parse-c-type symbol)) for 99.9% of symbols
+ ;; which are not FFI type names.
+ (when (and types (nth-value 1 (gethash symbol types)))
+ ;; Maybe use (case (head (ffi:deparse-c-type)))
+ ;; to distinguish struct and union types?
+ (maybe-push :alien-type :not-documented)))
+ result)))
+
+(defimplementation describe-definition (symbol namespace)
+ (ecase namespace
+ (:variable (describe symbol))
+ (:macro (describe (macro-function symbol)))
+ (:function (describe (symbol-function symbol)))
+ (:class (describe (find-class symbol)))))
+
+(defimplementation type-specifier-p (symbol)
+ (or (ignore-errors
+ (subtypep nil symbol))
+ (not (eq (type-specifier-arglist symbol) :not-available))))
+
+(defun fspec-pathname (spec)
+ (let ((path spec)
+ type
+ lines)
+ (when (consp path)
+ (psetq type (car path)
+ path (cadr path)
+ lines (cddr path)))
+ (when (and path
+ (member (pathname-type path)
+ custom:*compiled-file-types* :test #'equal))
+ (setq path
+ (loop for suffix in custom:*source-file-types*
+ thereis (probe-file (make-pathname :defaults path
+ :type suffix)))))
+ (values path type lines)))
+
+(defun fspec-location (name fspec)
+ (multiple-value-bind (file type lines)
+ (fspec-pathname fspec)
+ (list (if type (list name type) name)
+ (cond (file
+ (multiple-value-bind (truename c)
+ (ignore-errors (truename file))
+ (cond (truename
+ (make-location
+ (list :file (namestring truename))
+ (if (consp lines)
+ (list* :line lines)
+ (list :function-name (string name)))
+ (when (consp type)
+ (list :snippet (format nil "~A" type)))))
+ (t (list :error (princ-to-string c))))))
+ (t (list :error
+ (format nil "No source information available for: ~S"
+ fspec)))))))
+
+(defimplementation find-definitions (name)
+ (mapcar #'(lambda (e) (fspec-location name e))
+ (documentation name 'sys::file)))
+
+(defun trim-whitespace (string)
+ (string-trim #(#\newline #\space #\tab) string))
+
+(defvar *sldb-backtrace*)
+
+(defun sldb-backtrace ()
+ "Return a list ((ADDRESS . DESCRIPTION) ...) of frames."
+ (let* ((modes '((:all-stack-elements 1)
+ (:all-frames 2)
+ (:only-lexical-frames 3)
+ (:only-eval-and-apply-frames 4)
+ (:only-apply-frames 5)))
+ (mode (cadr (assoc :all-stack-elements modes))))
+ (do ((frames '())
+ (last nil frame)
+ (frame (sys::the-frame)
+ (sys::frame-up 1 frame mode)))
+ ((eq frame last) (nreverse frames))
+ (unless (boring-frame-p frame)
+ (push frame frames)))))
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (let* (;;(sys::*break-count* (1+ sys::*break-count*))
+ ;;(sys::*driver* debugger-loop-fn)
+ ;;(sys::*fasoutput-stream* nil)
+ (*sldb-backtrace*
+ (let* ((f (sys::the-frame))
+ (bt (sldb-backtrace))
+ (rest (member f bt)))
+ (if rest (nthcdr 8 rest) bt))))
+ (funcall debugger-loop-fn)))
+
+(defun nth-frame (index)
+ (nth index *sldb-backtrace*))
+
+(defun boring-frame-p (frame)
+ (member (frame-type frame) '(stack-value bind-var bind-env
+ compiled-tagbody compiled-block)))
+
+(defun frame-to-string (frame)
+ (with-output-to-string (s)
+ (sys::describe-frame s frame)))
+
+(defun frame-type (frame)
+ ;; FIXME: should bind *print-length* etc. to small values.
+ (frame-string-type (frame-to-string frame)))
+
+;; FIXME: they changed the layout in 2.44 and not all patterns have
+;; been updated.
+(defvar *frame-prefixes*
+ '(("\\[[0-9]\\+\\] frame binding variables" bind-var)
+ ("<1> #<compiled-function" compiled-fun)
+ ("<1> #<system-function" sys-fun)
+ ("<1> #<special-operator" special-op)
+ ("EVAL frame" eval)
+ ("APPLY frame" apply)
+ ("\\[[0-9]\\+\\] compiled tagbody frame" compiled-tagbody)
+ ("\\[[0-9]\\+\\] compiled block frame" compiled-block)
+ ("block frame" block)
+ ("nested block frame" block)
+ ("tagbody frame" tagbody)
+ ("nested tagbody frame" tagbody)
+ ("catch frame" catch)
+ ("handler frame" handler)
+ ("unwind-protect frame" unwind-protect)
+ ("driver frame" driver)
+ ("\\[[0-9]\\+\\] frame binding environments" bind-env)
+ ("CALLBACK frame" callback)
+ ("- " stack-value)
+ ("<1> " fun)
+ ("<2> " 2nd-frame)
+ ))
+
+(defun frame-string-type (string)
+ (cadr (assoc-if (lambda (pattern) (is-prefix-p pattern string))
+ *frame-prefixes*)))
+
+(defimplementation compute-backtrace (start end)
+ (let* ((bt *sldb-backtrace*)
+ (len (length bt)))
+ (loop for f in (subseq bt start (min (or end len) len))
+ collect f)))
+
+(defimplementation print-frame (frame stream)
+ (let* ((str (frame-to-string frame)))
+ (write-string (extract-frame-line str)
+ stream)))
+
+(defun extract-frame-line (frame-string)
+ (let ((s frame-string))
+ (trim-whitespace
+ (case (frame-string-type s)
+ ((eval special-op)
+ (string-match "EVAL frame .*for form \\(.*\\)" s 1))
+ (apply
+ (string-match "APPLY frame for call \\(.*\\)" s 1))
+ ((compiled-fun sys-fun fun)
+ (extract-function-name s))
+ (t s)))))
+
+(defun extract-function-name (string)
+ (let ((1st (car (split-frame-string string))))
+ (or (string-match (format nil "^<1>[ ~%]*#<[-A-Za-z]* \\(.*\\)>")
+ 1st
+ 1)
+ (string-match (format nil "^<1>[ ~%]*\\(.*\\)") 1st 1)
+ 1st)))
+
+(defun split-frame-string (string)
+ (let ((rx (format nil "~%\\(~{~A~^\\|~}\\)"
+ (mapcar #'car *frame-prefixes*))))
+ (loop for pos = 0 then (1+ (regexp:match-start match))
+ for match = (regexp:match rx string :start pos)
+ if match collect (subseq string pos (regexp:match-start match))
+ else collect (subseq string pos)
+ while match)))
+
+(defun string-match (pattern string n)
+ (let* ((match (nth-value n (regexp:match pattern string))))
+ (if match (regexp:match-string string match))))
+
+(defimplementation eval-in-frame (form frame-number)
+ (sys::eval-at (nth-frame frame-number) form))
+
+(defimplementation frame-locals (frame-number)
+ (let ((frame (nth-frame frame-number)))
+ (loop for i below (%frame-count-vars frame)
+ collect (list :name (%frame-var-name frame i)
+ :value (%frame-var-value frame i)
+ :id 0))))
+
+(defimplementation frame-var-value (frame var)
+ (%frame-var-value (nth-frame frame) var))
+
+;;; Interpreter-Variablen-Environment has the shape
+;;; NIL or #(v1 val1 ... vn valn NEXT-ENV).
+
+(defun %frame-count-vars (frame)
+ (cond ((sys::eval-frame-p frame)
+ (do ((venv (frame-venv frame) (next-venv venv))
+ (count 0 (+ count (/ (1- (length venv)) 2))))
+ ((not venv) count)))
+ ((member (frame-type frame) '(compiled-fun sys-fun fun special-op))
+ (length (%parse-stack-values frame)))
+ (t 0)))
+
+(defun %frame-var-name (frame i)
+ (cond ((sys::eval-frame-p frame)
+ (nth-value 0 (venv-ref (frame-venv frame) i)))
+ (t (format nil "~D" i))))
+
+(defun %frame-var-value (frame i)
+ (cond ((sys::eval-frame-p frame)
+ (let ((name (venv-ref (frame-venv frame) i)))
+ (multiple-value-bind (v c) (ignore-errors (sys::eval-at frame name))
+ (if c
+ (format-sldb-condition c)
+ v))))
+ ((member (frame-type frame) '(compiled-fun sys-fun fun special-op))
+ (let ((str (nth i (%parse-stack-values frame))))
+ (trim-whitespace (subseq str 2))))
+ (t (break "Not implemented"))))
+
+(defun frame-venv (frame)
+ (let ((env (sys::eval-at frame '(sys::the-environment))))
+ (svref env 0)))
+
+(defun next-venv (venv) (svref venv (1- (length venv))))
+
+(defun venv-ref (env i)
+ "Reference the Ith binding in ENV.
+Return two values: NAME and VALUE"
+ (let ((idx (* i 2)))
+ (if (< idx (1- (length env)))
+ (values (svref env idx) (svref env (1+ idx)))
+ (venv-ref (next-venv env) (- i (/ (1- (length env)) 2))))))
+
+(defun %parse-stack-values (frame)
+ (labels ((next (fp) (sys::frame-down 1 fp 1))
+ (parse (fp accu)
+ (let ((str (frame-to-string fp)))
+ (cond ((is-prefix-p "- " str)
+ (parse (next fp) (cons str accu)))
+ ((is-prefix-p "<1> " str)
+ ;;(when (eq (frame-type frame) 'compiled-fun)
+ ;; (pop accu))
+ (dolist (str (cdr (split-frame-string str)))
+ (when (is-prefix-p "- " str)
+ (push str accu)))
+ (nreverse accu))
+ (t (parse (next fp) accu))))))
+ (parse (next frame) '())))
+
+(defun is-prefix-p (regexp string)
+ (if (regexp:match (concatenate 'string "^" regexp) string) t))
+
+(defimplementation return-from-frame (index form)
+ (sys::return-from-eval-frame (nth-frame index) form))
+
+(defimplementation restart-frame (index)
+ (sys::redo-eval-frame (nth-frame index)))
+
+(defimplementation frame-source-location (index)
+ `(:error
+ ,(format nil "frame-source-location not implemented. (frame: ~A)"
+ (nth-frame index))))
+
+;;;; Profiling
+
+(defimplementation profile (fname)
+ (eval `(swank-monitor:monitor ,fname))) ;monitor is a macro
+
+(defimplementation profiled-functions ()
+ swank-monitor:*monitored-functions*)
+
+(defimplementation unprofile (fname)
+ (eval `(swank-monitor:unmonitor ,fname))) ;unmonitor is a macro
+
+(defimplementation unprofile-all ()
+ (swank-monitor:unmonitor))
+
+(defimplementation profile-report ()
+ (swank-monitor:report-monitoring))
+
+(defimplementation profile-reset ()
+ (swank-monitor:reset-all-monitoring))
+
+(defimplementation profile-package (package callers-p methods)
+ (declare (ignore callers-p methods))
+ (swank-monitor:monitor-all package))
+
+;;;; Handle compiler conditions (find out location of error etc.)
+
+(defmacro compile-file-frobbing-notes ((&rest args) &body body)
+ "Pass ARGS to COMPILE-FILE, send the compiler notes to
+*STANDARD-INPUT* and frob them in BODY."
+ `(let ((*error-output* (make-string-output-stream))
+ (*compile-verbose* t))
+ (multiple-value-prog1
+ (compile-file ,@args)
+ (handler-case
+ (with-input-from-string
+ (*standard-input* (get-output-stream-string *error-output*))
+ ,@body)
+ (sys::simple-end-of-file () nil)))))
+
+(defvar *orig-c-warn* (symbol-function 'system::c-warn))
+(defvar *orig-c-style-warn* (symbol-function 'system::c-style-warn))
+(defvar *orig-c-error* (symbol-function 'system::c-error))
+(defvar *orig-c-report-problems* (symbol-function 'system::c-report-problems))
+
+(defmacro dynamic-flet (names-functions &body body)
+ "(dynamic-flet ((NAME FUNCTION) ...) BODY ...)
+Execute BODY with NAME's function slot set to FUNCTION."
+ `(ext:letf* ,(loop for (name function) in names-functions
+ collect `((symbol-function ',name) ,function))
+ ,@body))
+
+(defvar *buffer-name* nil)
+(defvar *buffer-offset*)
+
+(defun compiler-note-location ()
+ "Return the current compiler location."
+ (let ((lineno1 sys::*compile-file-lineno1*)
+ (lineno2 sys::*compile-file-lineno2*)
+ (file sys::*compile-file-truename*))
+ (cond ((and file lineno1 lineno2)
+ (make-location (list ':file (namestring file))
+ (list ':line lineno1)))
+ (*buffer-name*
+ (make-location (list ':buffer *buffer-name*)
+ (list ':offset *buffer-offset* 0)))
+ (t
+ (list :error "No error location available")))))
+
+(defun signal-compiler-warning (cstring args severity orig-fn)
+ (signal 'compiler-condition
+ :severity severity
+ :message (apply #'format nil cstring args)
+ :location (compiler-note-location))
+ (apply orig-fn cstring args))
+
+(defun c-warn (cstring &rest args)
+ (signal-compiler-warning cstring args :warning *orig-c-warn*))
+
+(defun c-style-warn (cstring &rest args)
+ (dynamic-flet ((sys::c-warn *orig-c-warn*))
+ (signal-compiler-warning cstring args :style-warning *orig-c-style-warn*)))
+
+(defun c-error (&rest args)
+ (signal 'compiler-condition
+ :severity :error
+ :message (apply #'format nil
+ (if (= (length args) 3)
+ (cdr args)
+ args))
+ :location (compiler-note-location))
+ (apply *orig-c-error* args))
+
+(defimplementation call-with-compilation-hooks (function)
+ (handler-bind ((warning #'handle-notification-condition))
+ (dynamic-flet ((system::c-warn #'c-warn)
+ (system::c-style-warn #'c-style-warn)
+ (system::c-error #'c-error))
+ (funcall function))))
+
+(defun handle-notification-condition (condition)
+ "Handle a condition caused by a compiler warning."
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity :warning
+ :message (princ-to-string condition)
+ :location (compiler-note-location)))
+
+(defimplementation swank-compile-file (input-file output-file
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
+ (with-compilation-hooks ()
+ (with-compilation-unit ()
+ (multiple-value-bind (fasl-file warningsp failurep)
+ (compile-file input-file
+ :output-file output-file
+ :external-format external-format)
+ (values fasl-file warningsp
+ (or failurep
+ (and load-p
+ (not (load fasl-file)))))))))
+
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore filename policy))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer)
+ (*buffer-offset* position))
+ (funcall (compile nil (read-from-string
+ (format nil "(~S () ~A)" 'lambda string))))
+ t)))
+
+;;;; Portable XREF from the CMU AI repository.
+
+(setq pxref::*handle-package-forms* '(cl:in-package))
+
+(defmacro defxref (name function)
+ `(defimplementation ,name (name)
+ (xref-results (,function name))))
+
+(defxref who-calls pxref:list-callers)
+(defxref who-references pxref:list-readers)
+(defxref who-binds pxref:list-setters)
+(defxref who-sets pxref:list-setters)
+(defxref list-callers pxref:list-callers)
+(defxref list-callees pxref:list-callees)
+
+(defun xref-results (symbols)
+ (let ((xrefs '()))
+ (dolist (symbol symbols)
+ (push (fspec-location symbol symbol) xrefs))
+ xrefs))
+
+(when (find-package :swank-loader)
+ (setf (symbol-function (intern "USER-INIT-FILE" :swank-loader))
+ (lambda ()
+ (let ((home (user-homedir-pathname)))
+ (and (ext:probe-directory home)
+ (probe-file (format nil "~A/.swank.lisp"
+ (namestring (truename home)))))))))
+
+;;; Don't set *debugger-hook* to nil on break.
+(ext:without-package-lock ()
+ (defun break (&optional (format-string "Break") &rest args)
+ (if (not sys::*use-clcs*)
+ (progn
+ (terpri *error-output*)
+ (apply #'format *error-output*
+ (concatenate 'string "*** - " format-string)
+ args)
+ (funcall ext:*break-driver* t))
+ (let ((condition
+ (make-condition 'simple-condition
+ :format-control format-string
+ :format-arguments args))
+ ;;(*debugger-hook* nil)
+ ;; Issue 91
+ )
+ (ext:with-restarts
+ ((continue
+ :report (lambda (stream)
+ (format stream (sys::text "Return from ~S loop")
+ 'break))
+ ()))
+ (with-condition-restarts condition (list (find-restart 'continue))
+ (invoke-debugger condition)))))
+ nil))
+
+;;;; Inspecting
+
+(defmethod emacs-inspect ((o t))
+ (let* ((*print-array* nil) (*print-pretty* t)
+ (*print-circle* t) (*print-escape* t)
+ (*print-lines* custom:*inspect-print-lines*)
+ (*print-level* custom:*inspect-print-level*)
+ (*print-length* custom:*inspect-print-length*)
+ (sys::*inspect-all* (make-array 10 :fill-pointer 0 :adjustable t))
+ (tmp-pack (make-package (gensym "INSPECT-TMP-PACKAGE-")))
+ (*package* tmp-pack)
+ (sys::*inspect-unbound-value* (intern "#<unbound>" tmp-pack)))
+ (let ((inspection (sys::inspect-backend o)))
+ (append (list
+ (format nil "~S~% ~A~{~%~A~}~%" o
+ (sys::insp-title inspection)
+ (sys::insp-blurb inspection)))
+ (loop with count = (sys::insp-num-slots inspection)
+ for i below count
+ append (multiple-value-bind (value name)
+ (funcall (sys::insp-nth-slot inspection)
+ i)
+ `((:value ,name) " = " (:value ,value)
+ (:newline))))))))
+
+(defimplementation quit-lisp ()
+ #+lisp=cl (ext:quit)
+ #-lisp=cl (lisp:quit))
+
+
+(defimplementation preferred-communication-style ()
+ nil)
+
+;;; FIXME
+;;;
+;;; Clisp 2.48 added experimental support for threads. Basically, you
+;;; can use :SPAWN now, BUT:
+;;;
+;;; - there are problems with GC, and threads stuffed into weak
+;;; hash-tables as is the case for *THREAD-PLIST-TABLE*.
+;;;
+;;; See test case at
+;;; http://thread.gmane.org/gmane.lisp.clisp.devel/20429
+;;;
+;;; Even though said to be fixed, it's not:
+;;;
+;;; http://thread.gmane.org/gmane.lisp.clisp.devel/20429/focus=20443
+;;;
+;;; - The DYNAMIC-FLET above is an implementation technique that's
+;;; probably not sustainable in light of threads. This got to be
+;;; rewritten.
+;;;
+;;; TCR (2009-07-30)
+
+#+#.(cl:if (cl:find-package "MP") '(:and) '(:or))
+(progn
+ (defimplementation spawn (fn &key name)
+ (mp:make-thread fn :name name))
+
+ (defvar *thread-plist-table-lock*
+ (mp:make-mutex :name "THREAD-PLIST-TABLE-LOCK"))
+
+ (defvar *thread-plist-table* (make-hash-table :weak :key)
+ "A hashtable mapping threads to a plist.")
+
+ (defvar *thread-id-counter* 0)
+
+ (defimplementation thread-id (thread)
+ (mp:with-mutex-lock (*thread-plist-table-lock*)
+ (or (getf (gethash thread *thread-plist-table*) 'thread-id)
+ (setf (getf (gethash thread *thread-plist-table*) 'thread-id)
+ (incf *thread-id-counter*)))))
+
+ (defimplementation find-thread (id)
+ (find id (all-threads)
+ :key (lambda (thread)
+ (getf (gethash thread *thread-plist-table*) 'thread-id))))
+
+ (defimplementation thread-name (thread)
+ ;; To guard against returning #<UNBOUND>.
+ (princ-to-string (mp:thread-name thread)))
+
+ (defimplementation thread-status (thread)
+ (if (thread-alive-p thread)
+ "RUNNING"
+ "STOPPED"))
+
+ (defimplementation make-lock (&key name)
+ (mp:make-mutex :name name :recursive-p t))
+
+ (defimplementation call-with-lock-held (lock function)
+ (mp:with-mutex-lock (lock)
+ (funcall function)))
+
+ (defimplementation current-thread ()
+ (mp:current-thread))
+
+ (defimplementation all-threads ()
+ (mp:list-threads))
+
+ (defimplementation interrupt-thread (thread fn)
+ (mp:thread-interrupt thread :function fn))
+
+ (defimplementation kill-thread (thread)
+ (mp:thread-interrupt thread :function t))
+
+ (defimplementation thread-alive-p (thread)
+ (mp:thread-active-p thread))
+
+ (defvar *mailboxes-lock* (make-lock :name "MAILBOXES-LOCK"))
+ (defvar *mailboxes* (list))
+
+ (defstruct (mailbox (:conc-name mailbox.))
+ thread
+ (lock (make-lock :name "MAILBOX.LOCK"))
+ (waitqueue (mp:make-exemption :name "MAILBOX.WAITQUEUE"))
+ (queue '() :type list))
+
+ (defun mailbox (thread)
+ "Return THREAD's mailbox."
+ (mp:with-mutex-lock (*mailboxes-lock*)
+ (or (find thread *mailboxes* :key #'mailbox.thread)
+ (let ((mb (make-mailbox :thread thread)))
+ (push mb *mailboxes*)
+ mb))))
+
+ (defimplementation send (thread message)
+ (let* ((mbox (mailbox thread))
+ (lock (mailbox.lock mbox)))
+ (mp:with-mutex-lock (lock)
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message)))
+ (mp:exemption-broadcast (mailbox.waitqueue mbox)))))
+
+ (defimplementation receive-if (test &optional timeout)
+ (let* ((mbox (mailbox (current-thread)))
+ (lock (mailbox.lock mbox)))
+ (assert (or (not timeout) (eq timeout t)))
+ (loop
+ (check-slime-interrupts)
+ (mp:with-mutex-lock (lock)
+ (let* ((q (mailbox.queue mbox))
+ (tail (member-if test q)))
+ (when tail
+ (setf (mailbox.queue mbox) (nconc (ldiff q tail) (cdr tail)))
+ (return (car tail))))
+ (when (eq timeout t) (return (values nil t)))
+ (mp:exemption-wait (mailbox.waitqueue mbox) lock :timeout 0.2))))))
+
+
+;;;; Weak hashtables
+
+(defimplementation make-weak-key-hash-table (&rest args)
+ (apply #'make-hash-table :weak :key args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+ (apply #'make-hash-table :weak :value args))
+
+(defimplementation save-image (filename &optional restart-function)
+ (let ((args `(,filename
+ ,@(if restart-function
+ `((:init-function ,restart-function))))))
+ (apply #'ext:saveinitmem args)))
diff --git a/vim/bundle/slimv/slime/swank/cmucl.lisp b/vim/bundle/slimv/slime/swank/cmucl.lisp
new file mode 100644
index 0000000..12d4282
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/cmucl.lisp
@@ -0,0 +1,2470 @@
+;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;+" -*-
+;;;
+;;; License: Public Domain
+;;;
+;;;; Introduction
+;;;
+;;; This is the CMUCL implementation of the `swank/backend' package.
+
+(defpackage swank/cmucl
+ (:use cl swank/backend swank/source-path-parser swank/source-file-cache
+ fwrappers))
+
+(in-package swank/cmucl)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+ (let ((min-version #x20c))
+ (assert (>= c:byte-fasl-file-version min-version)
+ () "This file requires CMUCL version ~x or newer" min-version))
+
+ (require 'gray-streams))
+
+
+(import-swank-mop-symbols :pcl '(:slot-definition-documentation))
+
+(defun swank-mop:slot-definition-documentation (slot)
+ (documentation slot t))
+
+;;; UTF8
+
+(locally (declare (optimize (ext:inhibit-warnings 3)))
+ ;; Compile and load the utf8 format, if not already loaded.
+ (stream::find-external-format :utf-8))
+
+(defimplementation string-to-utf8 (string)
+ (let ((ef (load-time-value (stream::find-external-format :utf-8) t)))
+ (stream:string-to-octets string :external-format ef)))
+
+(defimplementation utf8-to-string (octets)
+ (let ((ef (load-time-value (stream::find-external-format :utf-8) t)))
+ (stream:octets-to-string octets :external-format ef)))
+
+
+;;;; TCP server
+;;;
+;;; In CMUCL we support all communication styles. By default we use
+;;; `:SIGIO' because it is the most responsive, but it's somewhat
+;;; dangerous: CMUCL is not in general "signal safe", and you don't
+;;; know for sure what you'll be interrupting. Both `:FD-HANDLER' and
+;;; `:SPAWN' are reasonable alternatives.
+
+(defimplementation preferred-communication-style ()
+ :sigio)
+
+#-(or darwin mips)
+(defimplementation create-socket (host port &key backlog)
+ (let* ((addr (resolve-hostname host))
+ (addr (if (not (find-symbol "SOCKET-ERROR" :ext))
+ (ext:htonl addr)
+ addr)))
+ (ext:create-inet-listener port :stream :reuse-address t :host addr
+ :backlog (or backlog 5))))
+
+;; There seems to be a bug in create-inet-listener on Mac/OSX and Irix.
+#+(or darwin mips)
+(defimplementation create-socket (host port &key backlog)
+ (declare (ignore host))
+ (ext:create-inet-listener port :stream :reuse-address t))
+
+(defimplementation local-port (socket)
+ (nth-value 1 (ext::get-socket-host-and-port (socket-fd socket))))
+
+(defimplementation close-socket (socket)
+ (let ((fd (socket-fd socket)))
+ (sys:invalidate-descriptor fd)
+ (ext:close-socket fd)))
+
+(defimplementation accept-connection (socket &key
+ external-format buffering timeout)
+ (declare (ignore timeout))
+ (make-socket-io-stream (ext:accept-tcp-connection socket)
+ (ecase buffering
+ ((t) :full)
+ (:line :line)
+ ((nil) :none))
+ external-format))
+
+;;;;; Sockets
+
+(defimplementation socket-fd (socket)
+ "Return the filedescriptor for the socket represented by SOCKET."
+ (etypecase socket
+ (fixnum socket)
+ (sys:fd-stream (sys:fd-stream-fd socket))))
+
+(defun resolve-hostname (hostname)
+ "Return the IP address of HOSTNAME as an integer (in host byte-order)."
+ (let ((hostent (ext:lookup-host-entry hostname)))
+ (car (ext:host-entry-addr-list hostent))))
+
+(defvar *external-format-to-coding-system*
+ '((:iso-8859-1 "iso-latin-1-unix")
+ #+unicode
+ (:utf-8 "utf-8-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+
+(defun make-socket-io-stream (fd buffering external-format)
+ "Create a new input/output fd-stream for FD."
+ (cond (external-format
+ (sys:make-fd-stream fd :input t :output t
+ :element-type 'character
+ :buffering buffering
+ :external-format external-format))
+ (t
+ (sys:make-fd-stream fd :input t :output t
+ :element-type '(unsigned-byte 8)
+ :buffering buffering))))
+
+(defimplementation make-fd-stream (fd external-format)
+ (make-socket-io-stream fd :full external-format))
+
+(defimplementation dup (fd)
+ (multiple-value-bind (clone error) (unix:unix-dup fd)
+ (unless clone (error "dup failed: ~a" (unix:get-unix-error-msg error)))
+ clone))
+
+(defimplementation command-line-args ()
+ ext:*command-line-strings*)
+
+(defimplementation exec-image (image-file args)
+ (multiple-value-bind (ok error)
+ (unix:unix-execve (car (command-line-args))
+ (list* (car (command-line-args))
+ "-core" image-file
+ "-noinit"
+ args))
+ (error "~a" (unix:get-unix-error-msg error))
+ ok))
+
+;;;;; Signal-driven I/O
+
+(defimplementation install-sigint-handler (function)
+ (sys:enable-interrupt :sigint (lambda (signal code scp)
+ (declare (ignore signal code scp))
+ (funcall function))))
+
+(defvar *sigio-handlers* '()
+ "List of (key . function) pairs.
+All functions are called on SIGIO, and the key is used for removing
+specific functions.")
+
+(defun reset-sigio-handlers () (setq *sigio-handlers* '()))
+;; All file handlers are invalid afer reload.
+(pushnew 'reset-sigio-handlers ext:*after-save-initializations*)
+
+(defun set-sigio-handler ()
+ (sys:enable-interrupt :sigio (lambda (signal code scp)
+ (sigio-handler signal code scp))))
+
+(defun sigio-handler (signal code scp)
+ (declare (ignore signal code scp))
+ (mapc #'funcall (mapcar #'cdr *sigio-handlers*)))
+
+(defun fcntl (fd command arg)
+ "fcntl(2) - manipulate a file descriptor."
+ (multiple-value-bind (ok error) (unix:unix-fcntl fd command arg)
+ (cond (ok)
+ (t (error "fcntl: ~A" (unix:get-unix-error-msg error))))))
+
+(defimplementation add-sigio-handler (socket fn)
+ (set-sigio-handler)
+ (let ((fd (socket-fd socket)))
+ (fcntl fd unix:f-setown (unix:unix-getpid))
+ (let ((old-flags (fcntl fd unix:f-getfl 0)))
+ (fcntl fd unix:f-setfl (logior old-flags unix:fasync)))
+ (assert (not (assoc fd *sigio-handlers*)))
+ (push (cons fd fn) *sigio-handlers*)))
+
+(defimplementation remove-sigio-handlers (socket)
+ (let ((fd (socket-fd socket)))
+ (when (assoc fd *sigio-handlers*)
+ (setf *sigio-handlers* (remove fd *sigio-handlers* :key #'car))
+ (let ((old-flags (fcntl fd unix:f-getfl 0)))
+ (fcntl fd unix:f-setfl (logandc2 old-flags unix:fasync)))
+ (sys:invalidate-descriptor fd))
+ (assert (not (assoc fd *sigio-handlers*)))
+ (when (null *sigio-handlers*)
+ (sys:default-interrupt :sigio))))
+
+;;;;; SERVE-EVENT
+
+(defimplementation add-fd-handler (socket fn)
+ (let ((fd (socket-fd socket)))
+ (sys:add-fd-handler fd :input (lambda (_) _ (funcall fn)))))
+
+(defimplementation remove-fd-handlers (socket)
+ (sys:invalidate-descriptor (socket-fd socket)))
+
+(defimplementation wait-for-input (streams &optional timeout)
+ (assert (member timeout '(nil t)))
+ (loop
+ (let ((ready (remove-if-not #'listen streams)))
+ (when ready (return ready)))
+ (when timeout (return nil))
+ (multiple-value-bind (in out) (make-pipe)
+ (let* ((f (constantly t))
+ (handlers (loop for s in (cons in (mapcar #'to-fd-stream streams))
+ collect (add-one-shot-handler s f))))
+ (unwind-protect
+ (let ((*interrupt-queued-handler* (lambda ()
+ (write-char #\! out))))
+ (when (check-slime-interrupts) (return :interrupt))
+ (sys:serve-event))
+ (mapc #'sys:remove-fd-handler handlers)
+ (close in)
+ (close out))))))
+
+(defun to-fd-stream (stream)
+ (etypecase stream
+ (sys:fd-stream stream)
+ (synonym-stream
+ (to-fd-stream
+ (symbol-value (synonym-stream-symbol stream))))
+ (two-way-stream
+ (to-fd-stream (two-way-stream-input-stream stream)))))
+
+(defun add-one-shot-handler (stream function)
+ (let (handler)
+ (setq handler (sys:add-fd-handler (sys:fd-stream-fd stream) :input
+ (lambda (fd)
+ (declare (ignore fd))
+ (sys:remove-fd-handler handler)
+ (funcall function stream))))))
+
+(defun make-pipe ()
+ (multiple-value-bind (in out) (unix:unix-pipe)
+ (values (sys:make-fd-stream in :input t :buffering :none)
+ (sys:make-fd-stream out :output t :buffering :none))))
+
+
+;;;; Stream handling
+
+(defimplementation gray-package-name ()
+ "EXT")
+
+
+;;;; Compilation Commands
+
+(defvar *previous-compiler-condition* nil
+ "Used to detect duplicates.")
+
+(defvar *previous-context* nil
+ "Previous compiler error context.")
+
+(defvar *buffer-name* nil
+ "The name of the Emacs buffer we are compiling from.
+NIL if we aren't compiling from a buffer.")
+
+(defvar *buffer-start-position* nil)
+(defvar *buffer-substring* nil)
+
+(defimplementation call-with-compilation-hooks (function)
+ (let ((*previous-compiler-condition* nil)
+ (*previous-context* nil)
+ (*print-readably* nil))
+ (handler-bind ((c::compiler-error #'handle-notification-condition)
+ (c::style-warning #'handle-notification-condition)
+ (c::warning #'handle-notification-condition))
+ (funcall function))))
+
+(defimplementation swank-compile-file (input-file output-file
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
+ (clear-xref-info input-file)
+ (with-compilation-hooks ()
+ (let ((*buffer-name* nil)
+ (ext:*ignore-extra-close-parentheses* nil))
+ (multiple-value-bind (output-file warnings-p failure-p)
+ (compile-file input-file :output-file output-file
+ :external-format external-format)
+ (values output-file warnings-p
+ (or failure-p
+ (when load-p
+ ;; Cache the latest source file for definition-finding.
+ (source-cache-get input-file
+ (file-write-date input-file))
+ (not (load output-file)))))))))
+
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore filename policy))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer)
+ (*buffer-start-position* position)
+ (*buffer-substring* string)
+ (source-info (list :emacs-buffer buffer
+ :emacs-buffer-offset position
+ :emacs-buffer-string string)))
+ (with-input-from-string (stream string)
+ (let ((failurep (ext:compile-from-stream stream :source-info
+ source-info)))
+ (not failurep))))))
+
+
+;;;;; Trapping notes
+;;;
+;;; We intercept conditions from the compiler and resignal them as
+;;; `SWANK:COMPILER-CONDITION's.
+
+(defun handle-notification-condition (condition)
+ "Handle a condition caused by a compiler warning."
+ (unless (eq condition *previous-compiler-condition*)
+ (let ((context (c::find-error-context nil)))
+ (setq *previous-compiler-condition* condition)
+ (setq *previous-context* context)
+ (signal-compiler-condition condition context))))
+
+(defun signal-compiler-condition (condition context)
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity (severity-for-emacs condition)
+ :message (compiler-condition-message condition)
+ :source-context (compiler-error-context context)
+ :location (if (read-error-p condition)
+ (read-error-location condition)
+ (compiler-note-location context))))
+
+(defun severity-for-emacs (condition)
+ "Return the severity of CONDITION."
+ (etypecase condition
+ ((satisfies read-error-p) :read-error)
+ (c::compiler-error :error)
+ (c::style-warning :note)
+ (c::warning :warning)))
+
+(defun read-error-p (condition)
+ (eq (type-of condition) 'c::compiler-read-error))
+
+(defun compiler-condition-message (condition)
+ "Briefly describe a compiler error for Emacs.
+When Emacs presents the message it already has the source popped up
+and the source form highlighted. This makes much of the information in
+the error-context redundant."
+ (princ-to-string condition))
+
+(defun compiler-error-context (error-context)
+ "Describe context information for Emacs."
+ (declare (type (or c::compiler-error-context null) error-context))
+ (multiple-value-bind (enclosing source)
+ (if error-context
+ (values (c::compiler-error-context-enclosing-source error-context)
+ (c::compiler-error-context-source error-context)))
+ (if (or enclosing source)
+ (format nil "~@[--> ~{~<~%--> ~1:;~A ~>~}~%~]~
+ ~@[==>~{~&~A~}~]"
+ enclosing source))))
+
+(defun read-error-location (condition)
+ (let* ((finfo (car (c::source-info-current-file c::*source-info*)))
+ (file (c::file-info-name finfo))
+ (pos (c::compiler-read-error-position condition)))
+ (cond ((and (eq file :stream) *buffer-name*)
+ (make-location (list :buffer *buffer-name*)
+ (list :offset *buffer-start-position* pos)))
+ ((and (pathnamep file) (not *buffer-name*))
+ (make-location (list :file (unix-truename file))
+ (list :position (1+ pos))))
+ (t (break)))))
+
+(defun compiler-note-location (context)
+ "Derive the location of a complier message from its context.
+Return a `location' record, or (:error REASON) on failure."
+ (if (null context)
+ (note-error-location)
+ (with-struct (c::compiler-error-context- file-name
+ original-source
+ original-source-path) context
+ (or (locate-compiler-note file-name original-source
+ (reverse original-source-path))
+ (note-error-location)))))
+
+(defun note-error-location ()
+ "Pseudo-location for notes that can't be located."
+ (cond (*compile-file-truename*
+ (make-location (list :file (unix-truename *compile-file-truename*))
+ (list :eof)))
+ (*buffer-name*
+ (make-location (list :buffer *buffer-name*)
+ (list :position *buffer-start-position*)))
+ (t (list :error "No error location available."))))
+
+(defun locate-compiler-note (file source source-path)
+ (cond ((and (eq file :stream) *buffer-name*)
+ ;; Compiling from a buffer
+ (make-location (list :buffer *buffer-name*)
+ (list :offset *buffer-start-position*
+ (source-path-string-position
+ source-path *buffer-substring*))))
+ ((and (pathnamep file) (null *buffer-name*))
+ ;; Compiling from a file
+ (make-location (list :file (unix-truename file))
+ (list :position (1+ (source-path-file-position
+ source-path file)))))
+ ((and (eq file :lisp) (stringp source))
+ ;; No location known, but we have the source form.
+ ;; XXX How is this case triggered? -luke (16/May/2004)
+ ;; This can happen if the compiler needs to expand a macro
+ ;; but the macro-expander is not yet compiled. Calling the
+ ;; (interpreted) macro-expander triggers IR1 conversion of
+ ;; the lambda expression for the expander and invokes the
+ ;; compiler recursively.
+ (make-location (list :source-form source)
+ (list :position 1)))))
+
+(defun unix-truename (pathname)
+ (ext:unix-namestring (truename pathname)))
+
+
+;;;; XREF
+;;;
+;;; Cross-reference support is based on the standard CMUCL `XREF'
+;;; package. This package has some caveats: XREF information is
+;;; recorded during compilation and not preserved in fasl files, and
+;;; XREF recording is disabled by default. Redefining functions can
+;;; also cause duplicate references to accumulate, but
+;;; `swank-compile-file' will automatically clear out any old records
+;;; from the same filename.
+;;;
+;;; To enable XREF recording, set `c:*record-xref-info*' to true. To
+;;; clear out the XREF database call `xref:init-xref-database'.
+
+(defmacro defxref (name function)
+ `(defimplementation ,name (name)
+ (xref-results (,function name))))
+
+(defxref who-calls xref:who-calls)
+(defxref who-references xref:who-references)
+(defxref who-binds xref:who-binds)
+(defxref who-sets xref:who-sets)
+
+;;; More types of XREF information were added since 18e:
+;;;
+
+(defxref who-macroexpands xref:who-macroexpands)
+;; XXX
+(defimplementation who-specializes (symbol)
+ (let* ((methods (xref::who-specializes (find-class symbol)))
+ (locations (mapcar #'method-location methods)))
+ (mapcar #'list methods locations)))
+
+(defun xref-results (contexts)
+ (mapcar (lambda (xref)
+ (list (xref:xref-context-name xref)
+ (resolve-xref-location xref)))
+ contexts))
+
+(defun resolve-xref-location (xref)
+ (let ((name (xref:xref-context-name xref))
+ (file (xref:xref-context-file xref))
+ (source-path (xref:xref-context-source-path xref)))
+ (cond ((and file source-path)
+ (let ((position (source-path-file-position source-path file)))
+ (make-location (list :file (unix-truename file))
+ (list :position (1+ position)))))
+ (file
+ (make-location (list :file (unix-truename file))
+ (list :function-name (string name))))
+ (t
+ `(:error ,(format nil "Unknown source location: ~S ~S ~S "
+ name file source-path))))))
+
+(defun clear-xref-info (namestring)
+ "Clear XREF notes pertaining to NAMESTRING.
+This is a workaround for a CMUCL bug: XREF records are cumulative."
+ (when c:*record-xref-info*
+ (let ((filename (truename namestring)))
+ (dolist (db (list xref::*who-calls*
+ xref::*who-is-called*
+ xref::*who-macroexpands*
+ xref::*who-references*
+ xref::*who-binds*
+ xref::*who-sets*))
+ (maphash (lambda (target contexts)
+ ;; XXX update during traversal?
+ (setf (gethash target db)
+ (delete filename contexts
+ :key #'xref:xref-context-file
+ :test #'equalp)))
+ db)))))
+
+
+;;;; Find callers and callees
+;;;
+;;; Find callers and callees by looking at the constant pool of
+;;; compiled code objects. We assume every fdefn object in the
+;;; constant pool corresponds to a call to that function. A better
+;;; strategy would be to use the disassembler to find actual
+;;; call-sites.
+
+(labels ((make-stack () (make-array 100 :fill-pointer 0 :adjustable t))
+ (map-cpool (code fun)
+ (declare (type kernel:code-component code) (type function fun))
+ (loop for i from vm:code-constants-offset
+ below (kernel:get-header-data code)
+ do (funcall fun (kernel:code-header-ref code i))))
+
+ (callees (fun)
+ (let ((callees (make-stack)))
+ (map-cpool (vm::find-code-object fun)
+ (lambda (o)
+ (when (kernel:fdefn-p o)
+ (vector-push-extend (kernel:fdefn-function o)
+ callees))))
+ (coerce callees 'list)))
+
+ (callers (fun)
+ (declare (function fun))
+ (let ((callers (make-stack)))
+ (ext:gc :full t)
+ ;; scan :dynamic first to avoid the need for even more gcing
+ (dolist (space '(:dynamic :read-only :static))
+ (vm::map-allocated-objects
+ (lambda (obj header size)
+ (declare (type fixnum header) (ignore size))
+ (when (= vm:code-header-type header)
+ (map-cpool obj
+ (lambda (c)
+ (when (and (kernel:fdefn-p c)
+ (eq (kernel:fdefn-function c) fun))
+ (vector-push-extend obj callers))))))
+ space)
+ (ext:gc))
+ (coerce callers 'list)))
+
+ (entry-points (code)
+ (loop for entry = (kernel:%code-entry-points code)
+ then (kernel::%function-next entry)
+ while entry
+ collect entry))
+
+ (guess-main-entry-point (entry-points)
+ (or (find-if (lambda (fun)
+ (ext:valid-function-name-p
+ (kernel:%function-name fun)))
+ entry-points)
+ (car entry-points)))
+
+ (fun-dspec (fun)
+ (list (kernel:%function-name fun) (function-location fun)))
+
+ (code-dspec (code)
+ (let ((eps (entry-points code))
+ (di (kernel:%code-debug-info code)))
+ (cond (eps (fun-dspec (guess-main-entry-point eps)))
+ (di (list (c::debug-info-name di)
+ (debug-info-function-name-location di)))
+ (t (list (princ-to-string code)
+ `(:error "No src-loc available")))))))
+ (declare (inline map-cpool))
+
+ (defimplementation list-callers (symbol)
+ (mapcar #'code-dspec (callers (coerce symbol 'function) )))
+
+ (defimplementation list-callees (symbol)
+ (mapcar #'fun-dspec (callees symbol))))
+
+(defun test-list-callers (count)
+ (let ((funsyms '()))
+ (do-all-symbols (s)
+ (when (and (fboundp s)
+ (functionp (symbol-function s))
+ (not (macro-function s))
+ (not (special-operator-p s)))
+ (push s funsyms)))
+ (let ((len (length funsyms)))
+ (dotimes (i count)
+ (let ((sym (nth (random len) funsyms)))
+ (format t "~s -> ~a~%" sym (mapcar #'car (list-callers sym))))))))
+
+;; (test-list-callers 100)
+
+
+;;;; Resolving source locations
+;;;
+;;; Our mission here is to "resolve" references to code locations into
+;;; actual file/buffer names and character positions. The references
+;;; we work from come out of the compiler's statically-generated debug
+;;; information, such as `code-location''s and `debug-source''s. For
+;;; more details, see the "Debugger Programmer's Interface" section of
+;;; the CMUCL manual.
+;;;
+;;; The first step is usually to find the corresponding "source-path"
+;;; for the location. Once we have the source-path we can pull up the
+;;; source file and `READ' our way through to the right position. The
+;;; main source-code groveling work is done in
+;;; `source-path-parser.lisp'.
+
+(defvar *debug-definition-finding* nil
+ "When true don't handle errors while looking for definitions.
+This is useful when debugging the definition-finding code.")
+
+(defmacro safe-definition-finding (&body body)
+ "Execute BODY and return the source-location it returns.
+If an error occurs and `*debug-definition-finding*' is false, then
+return an error pseudo-location.
+
+The second return value is NIL if no error occurs, otherwise it is the
+condition object."
+ `(flet ((body () ,@body))
+ (if *debug-definition-finding*
+ (body)
+ (handler-case (values (progn ,@body) nil)
+ (error (c) (values `(:error ,(trim-whitespace (princ-to-string c)))
+ c))))))
+
+(defun trim-whitespace (string)
+ (string-trim #(#\newline #\space #\tab) string))
+
+(defun code-location-source-location (code-location)
+ "Safe wrapper around `code-location-from-source-location'."
+ (safe-definition-finding
+ (source-location-from-code-location code-location)))
+
+(defun source-location-from-code-location (code-location)
+ "Return the source location for CODE-LOCATION."
+ (let ((debug-fun (di:code-location-debug-function code-location)))
+ (when (di::bogus-debug-function-p debug-fun)
+ ;; Those lousy cheapskates! They've put in a bogus debug source
+ ;; because the code was compiled at a low debug setting.
+ (error "Bogus debug function: ~A" debug-fun)))
+ (let* ((debug-source (di:code-location-debug-source code-location))
+ (from (di:debug-source-from debug-source))
+ (name (di:debug-source-name debug-source)))
+ (ecase from
+ (:file
+ (location-in-file name code-location debug-source))
+ (:stream
+ (location-in-stream code-location debug-source))
+ (:lisp
+ ;; The location comes from a form passed to `compile'.
+ ;; The best we can do is return the form itself for printing.
+ (make-location
+ (list :source-form (with-output-to-string (*standard-output*)
+ (debug::print-code-location-source-form
+ code-location 100 t)))
+ (list :position 1))))))
+
+(defun location-in-file (filename code-location debug-source)
+ "Resolve the source location for CODE-LOCATION in FILENAME."
+ (let* ((code-date (di:debug-source-created debug-source))
+ (root-number (di:debug-source-root-number debug-source))
+ (source-code (get-source-code filename code-date)))
+ (with-input-from-string (s source-code)
+ (make-location (list :file (unix-truename filename))
+ (list :position (1+ (code-location-stream-position
+ code-location s root-number)))
+ `(:snippet ,(read-snippet s))))))
+
+(defun location-in-stream (code-location debug-source)
+ "Resolve the source location for a CODE-LOCATION from a stream.
+This only succeeds if the code was compiled from an Emacs buffer."
+ (unless (debug-source-info-from-emacs-buffer-p debug-source)
+ (error "The code is compiled from a non-SLIME stream."))
+ (let* ((info (c::debug-source-info debug-source))
+ (string (getf info :emacs-buffer-string))
+ (position (code-location-string-offset
+ code-location
+ string)))
+ (make-location
+ (list :buffer (getf info :emacs-buffer))
+ (list :offset (getf info :emacs-buffer-offset) position)
+ (list :snippet (with-input-from-string (s string)
+ (file-position s position)
+ (read-snippet s))))))
+
+;;;;; Function-name locations
+;;;
+(defun debug-info-function-name-location (debug-info)
+ "Return a function-name source-location for DEBUG-INFO.
+Function-name source-locations are a fallback for when precise
+positions aren't available."
+ (with-struct (c::debug-info- (fname name) source) debug-info
+ (with-struct (c::debug-source- info from name) (car source)
+ (ecase from
+ (:file
+ (make-location (list :file (namestring (truename name)))
+ (list :function-name (string fname))))
+ (:stream
+ (assert (debug-source-info-from-emacs-buffer-p (car source)))
+ (make-location (list :buffer (getf info :emacs-buffer))
+ (list :function-name (string fname))))
+ (:lisp
+ (make-location (list :source-form (princ-to-string (aref name 0)))
+ (list :position 1)))))))
+
+(defun debug-source-info-from-emacs-buffer-p (debug-source)
+ "Does the `info' slot of DEBUG-SOURCE contain an Emacs buffer location?
+This is true for functions that were compiled directly from buffers."
+ (info-from-emacs-buffer-p (c::debug-source-info debug-source)))
+
+(defun info-from-emacs-buffer-p (info)
+ (and info
+ (consp info)
+ (eq :emacs-buffer (car info))))
+
+
+;;;;; Groveling source-code for positions
+
+(defun code-location-stream-position (code-location stream root)
+ "Return the byte offset of CODE-LOCATION in STREAM. Extract the
+toplevel-form-number and form-number from CODE-LOCATION and use that
+to find the position of the corresponding form.
+
+Finish with STREAM positioned at the start of the code location."
+ (let* ((location (debug::maybe-block-start-location code-location))
+ (tlf-offset (- (di:code-location-top-level-form-offset location)
+ root))
+ (form-number (di:code-location-form-number location)))
+ (let ((pos (form-number-stream-position tlf-offset form-number stream)))
+ (file-position stream pos)
+ pos)))
+
+(defun form-number-stream-position (tlf-number form-number stream)
+ "Return the starting character position of a form in STREAM.
+TLF-NUMBER is the top-level-form number.
+FORM-NUMBER is an index into a source-path table for the TLF."
+ (multiple-value-bind (tlf position-map) (read-source-form tlf-number stream)
+ (let* ((path-table (di:form-number-translations tlf 0))
+ (source-path
+ (if (<= (length path-table) form-number) ; source out of sync?
+ (list 0) ; should probably signal a condition
+ (reverse (cdr (aref path-table form-number))))))
+ (source-path-source-position source-path tlf position-map))))
+
+(defun code-location-string-offset (code-location string)
+ "Return the byte offset of CODE-LOCATION in STRING.
+See CODE-LOCATION-STREAM-POSITION."
+ (with-input-from-string (s string)
+ (code-location-stream-position code-location s 0)))
+
+
+;;;; Finding definitions
+
+;;; There are a great many different types of definition for us to
+;;; find. We search for definitions of every kind and return them in a
+;;; list.
+
+(defimplementation find-definitions (name)
+ (append (function-definitions name)
+ (setf-definitions name)
+ (variable-definitions name)
+ (class-definitions name)
+ (type-definitions name)
+ (compiler-macro-definitions name)
+ (source-transform-definitions name)
+ (function-info-definitions name)
+ (ir1-translator-definitions name)
+ (template-definitions name)
+ (primitive-definitions name)
+ (vm-support-routine-definitions name)
+ ))
+
+;;;;; Functions, macros, generic functions, methods
+;;;
+;;; We make extensive use of the compile-time debug information that
+;;; CMUCL records, in particular "debug functions" and "code
+;;; locations." Refer to the "Debugger Programmer's Interface" section
+;;; of the CMUCL manual for more details.
+
+(defun function-definitions (name)
+ "Return definitions for NAME in the \"function namespace\", i.e.,
+regular functions, generic functions, methods and macros.
+NAME can any valid function name (e.g, (setf car))."
+ (let ((macro? (and (symbolp name) (macro-function name)))
+ (function? (and (ext:valid-function-name-p name)
+ (ext:info :function :definition name)
+ (if (symbolp name) (fboundp name) t))))
+ (cond (macro?
+ (list `((defmacro ,name)
+ ,(function-location (macro-function name)))))
+ (function?
+ (let ((function (fdefinition name)))
+ (if (genericp function)
+ (gf-definitions name function)
+ (list (list `(function ,name)
+ (function-location function)))))))))
+
+;;;;;; Ordinary (non-generic/macro/special) functions
+;;;
+;;; First we test if FUNCTION is a closure created by defstruct, and
+;;; if so extract the defstruct-description (`dd') from the closure
+;;; and find the constructor for the struct. Defstruct creates a
+;;; defun for the default constructor and we use that as an
+;;; approximation to the source location of the defstruct.
+;;;
+;;; For an ordinary function we return the source location of the
+;;; first code-location we find.
+;;;
+(defun function-location (function)
+ "Return the source location for FUNCTION."
+ (cond ((struct-closure-p function)
+ (struct-closure-location function))
+ ((c::byte-function-or-closure-p function)
+ (byte-function-location function))
+ (t
+ (compiled-function-location function))))
+
+(defun compiled-function-location (function)
+ "Return the location of a regular compiled function."
+ (multiple-value-bind (code-location error)
+ (safe-definition-finding (function-first-code-location function))
+ (cond (error (list :error (princ-to-string error)))
+ (t (code-location-source-location code-location)))))
+
+(defun function-first-code-location (function)
+ "Return the first code-location we can find for FUNCTION."
+ (and (function-has-debug-function-p function)
+ (di:debug-function-start-location
+ (di:function-debug-function function))))
+
+(defun function-has-debug-function-p (function)
+ (di:function-debug-function function))
+
+(defun function-code-object= (closure function)
+ (and (eq (vm::find-code-object closure)
+ (vm::find-code-object function))
+ (not (eq closure function))))
+
+(defun byte-function-location (fun)
+ "Return the location of the byte-compiled function FUN."
+ (etypecase fun
+ ((or c::hairy-byte-function c::simple-byte-function)
+ (let* ((di (kernel:%code-debug-info (c::byte-function-component fun))))
+ (if di
+ (debug-info-function-name-location di)
+ `(:error
+ ,(format nil "Byte-function without debug-info: ~a" fun)))))
+ (c::byte-closure
+ (byte-function-location (c::byte-closure-function fun)))))
+
+;;; Here we deal with structure accessors. Note that `dd' is a
+;;; "defstruct descriptor" structure in CMUCL. A `dd' describes a
+;;; `defstruct''d structure.
+
+(defun struct-closure-p (function)
+ "Is FUNCTION a closure created by defstruct?"
+ (or (function-code-object= function #'kernel::structure-slot-accessor)
+ (function-code-object= function #'kernel::structure-slot-setter)
+ (function-code-object= function #'kernel::%defstruct)))
+
+(defun struct-closure-location (function)
+ "Return the location of the structure that FUNCTION belongs to."
+ (assert (struct-closure-p function))
+ (safe-definition-finding
+ (dd-location (struct-closure-dd function))))
+
+(defun struct-closure-dd (function)
+ "Return the defstruct-definition (dd) of FUNCTION."
+ (assert (= (kernel:get-type function) vm:closure-header-type))
+ (flet ((find-layout (function)
+ (sys:find-if-in-closure
+ (lambda (x)
+ (let ((value (if (di::indirect-value-cell-p x)
+ (c:value-cell-ref x)
+ x)))
+ (when (kernel::layout-p value)
+ (return-from find-layout value))))
+ function)))
+ (kernel:layout-info (find-layout function))))
+
+(defun dd-location (dd)
+ "Return the location of a `defstruct'."
+ (let ((ctor (struct-constructor dd)))
+ (cond (ctor
+ (function-location (coerce ctor 'function)))
+ (t
+ (let ((name (kernel:dd-name dd)))
+ (multiple-value-bind (location foundp)
+ (ext:info :source-location :defvar name)
+ (cond (foundp
+ (resolve-source-location location))
+ (t
+ (error "No location for defstruct: ~S" name)))))))))
+
+(defun struct-constructor (dd)
+ "Return the name of the constructor from a defstruct definition."
+ (let* ((constructor (or (kernel:dd-default-constructor dd)
+ (car (kernel::dd-constructors dd)))))
+ (if (consp constructor) (car constructor) constructor)))
+
+;;;;;; Generic functions and methods
+
+(defun gf-definitions (name function)
+ "Return the definitions of a generic function and its methods."
+ (cons (list `(defgeneric ,name) (gf-location function))
+ (gf-method-definitions function)))
+
+(defun gf-location (gf)
+ "Return the location of the generic function GF."
+ (definition-source-location gf (pcl::generic-function-name gf)))
+
+(defun gf-method-definitions (gf)
+ "Return the locations of all methods of the generic function GF."
+ (mapcar #'method-definition (pcl::generic-function-methods gf)))
+
+(defun method-definition (method)
+ (list (method-dspec method)
+ (method-location method)))
+
+(defun method-dspec (method)
+ "Return a human-readable \"definition specifier\" for METHOD."
+ (let* ((gf (pcl:method-generic-function method))
+ (name (pcl:generic-function-name gf))
+ (specializers (pcl:method-specializers method))
+ (qualifiers (pcl:method-qualifiers method)))
+ `(method ,name ,@qualifiers ,(pcl::unparse-specializers specializers))))
+
+(defun method-location (method)
+ (typecase method
+ (pcl::standard-accessor-method
+ (definition-source-location
+ (cond ((pcl::definition-source method)
+ method)
+ (t
+ (pcl::slot-definition-class
+ (pcl::accessor-method-slot-definition method))))
+ (pcl::accessor-method-slot-name method)))
+ (t
+ (function-location (or (pcl::method-fast-function method)
+ (pcl:method-function method))))))
+
+(defun genericp (fn)
+ (typep fn 'generic-function))
+
+;;;;;; Types and classes
+
+(defun type-definitions (name)
+ "Return `deftype' locations for type NAME."
+ (maybe-make-definition (ext:info :type :expander name) 'deftype name))
+
+(defun maybe-make-definition (function kind name)
+ "If FUNCTION is non-nil then return its definition location."
+ (if function
+ (list (list `(,kind ,name) (function-location function)))))
+
+(defun class-definitions (name)
+ "Return the definition locations for the class called NAME."
+ (if (symbolp name)
+ (let ((class (kernel::find-class name nil)))
+ (etypecase class
+ (null '())
+ (kernel::structure-class
+ (list (list `(defstruct ,name) (dd-location (find-dd name)))))
+ #+(or)
+ (conditions::condition-class
+ (list (list `(define-condition ,name)
+ (condition-class-location class))))
+ (kernel::standard-class
+ (list (list `(defclass ,name)
+ (pcl-class-location (find-class name)))))
+ ((or kernel::built-in-class
+ conditions::condition-class
+ kernel:funcallable-structure-class)
+ (list (list `(class ,name) (class-location class))))))))
+
+(defun pcl-class-location (class)
+ "Return the `defclass' location for CLASS."
+ (definition-source-location class (pcl:class-name class)))
+
+;; FIXME: eval used for backward compatibility.
+(defun class-location (class)
+ (declare (type kernel::class class))
+ (let ((name (kernel:%class-name class)))
+ (multiple-value-bind (loc found?)
+ (let ((x (ignore-errors
+ (multiple-value-list
+ (eval `(ext:info :source-location :class ',name))))))
+ (values-list x))
+ (cond (found? (resolve-source-location loc))
+ (`(:error
+ ,(format nil "No location recorded for class: ~S" name)))))))
+
+(defun find-dd (name)
+ "Find the defstruct-definition by the name of its structure-class."
+ (let ((layout (ext:info :type :compiler-layout name)))
+ (if layout
+ (kernel:layout-info layout))))
+
+(defun condition-class-location (class)
+ (let ((slots (conditions::condition-class-slots class))
+ (name (conditions::condition-class-name class)))
+ (cond ((null slots)
+ `(:error ,(format nil "No location info for condition: ~A" name)))
+ (t
+ ;; Find the class via one of its slot-reader methods.
+ (let* ((slot (first slots))
+ (gf (fdefinition
+ (first (conditions::condition-slot-readers slot)))))
+ (method-location
+ (first
+ (pcl:compute-applicable-methods-using-classes
+ gf (list (find-class name))))))))))
+
+(defun make-name-in-file-location (file string)
+ (multiple-value-bind (filename c)
+ (ignore-errors
+ (unix-truename (merge-pathnames (make-pathname :type "lisp")
+ file)))
+ (cond (filename (make-location `(:file ,filename)
+ `(:function-name ,(string string))))
+ (t (list :error (princ-to-string c))))))
+
+(defun source-location-form-numbers (location)
+ (c::decode-form-numbers (c::form-numbers-form-numbers location)))
+
+(defun source-location-tlf-number (location)
+ (nth-value 0 (source-location-form-numbers location)))
+
+(defun source-location-form-number (location)
+ (nth-value 1 (source-location-form-numbers location)))
+
+(defun resolve-file-source-location (location)
+ (let ((filename (c::file-source-location-pathname location))
+ (tlf-number (source-location-tlf-number location))
+ (form-number (source-location-form-number location)))
+ (with-open-file (s filename)
+ (let ((pos (form-number-stream-position tlf-number form-number s)))
+ (make-location `(:file ,(unix-truename filename))
+ `(:position ,(1+ pos)))))))
+
+(defun resolve-stream-source-location (location)
+ (let ((info (c::stream-source-location-user-info location))
+ (tlf-number (source-location-tlf-number location))
+ (form-number (source-location-form-number location)))
+ ;; XXX duplication in frame-source-location
+ (assert (info-from-emacs-buffer-p info))
+ (destructuring-bind (&key emacs-buffer emacs-buffer-string
+ emacs-buffer-offset) info
+ (with-input-from-string (s emacs-buffer-string)
+ (let ((pos (form-number-stream-position tlf-number form-number s)))
+ (make-location `(:buffer ,emacs-buffer)
+ `(:offset ,emacs-buffer-offset ,pos)))))))
+
+;; XXX predicates for 18e backward compatibilty. Remove them when
+;; we're 19a only.
+(defun file-source-location-p (object)
+ (when (fboundp 'c::file-source-location-p)
+ (c::file-source-location-p object)))
+
+(defun stream-source-location-p (object)
+ (when (fboundp 'c::stream-source-location-p)
+ (c::stream-source-location-p object)))
+
+(defun source-location-p (object)
+ (or (file-source-location-p object)
+ (stream-source-location-p object)))
+
+(defun resolve-source-location (location)
+ (etypecase location
+ ((satisfies file-source-location-p)
+ (resolve-file-source-location location))
+ ((satisfies stream-source-location-p)
+ (resolve-stream-source-location location))))
+
+(defun definition-source-location (object name)
+ (let ((source (pcl::definition-source object)))
+ (etypecase source
+ (null
+ `(:error ,(format nil "No source info for: ~A" object)))
+ ((satisfies source-location-p)
+ (resolve-source-location source))
+ (pathname
+ (make-name-in-file-location source name))
+ (cons
+ (destructuring-bind ((dg name) pathname) source
+ (declare (ignore dg))
+ (etypecase pathname
+ (pathname (make-name-in-file-location pathname (string name)))
+ (null `(:error ,(format nil "Cannot resolve: ~S" source)))))))))
+
+(defun setf-definitions (name)
+ (let ((f (or (ext:info :setf :inverse name)
+ (ext:info :setf :expander name)
+ (and (symbolp name)
+ (fboundp `(setf ,name))
+ (fdefinition `(setf ,name))))))
+ (if f
+ `(((setf ,name) ,(function-location (cond ((functionp f) f)
+ ((macro-function f))
+ ((fdefinition f)))))))))
+
+(defun variable-location (symbol)
+ (multiple-value-bind (location foundp)
+ ;; XXX for 18e compatibilty. rewrite this when we drop 18e
+ ;; support.
+ (ignore-errors (eval `(ext:info :source-location :defvar ',symbol)))
+ (if (and foundp location)
+ (resolve-source-location location)
+ `(:error ,(format nil "No source info for variable ~S" symbol)))))
+
+(defun variable-definitions (name)
+ (if (symbolp name)
+ (multiple-value-bind (kind recorded-p) (ext:info :variable :kind name)
+ (if recorded-p
+ (list (list `(variable ,kind ,name)
+ (variable-location name)))))))
+
+(defun compiler-macro-definitions (symbol)
+ (maybe-make-definition (compiler-macro-function symbol)
+ 'define-compiler-macro
+ symbol))
+
+(defun source-transform-definitions (name)
+ (maybe-make-definition (ext:info :function :source-transform name)
+ 'c:def-source-transform
+ name))
+
+(defun function-info-definitions (name)
+ (let ((info (ext:info :function :info name)))
+ (if info
+ (append (loop for transform in (c::function-info-transforms info)
+ collect (list `(c:deftransform ,name
+ ,(c::type-specifier
+ (c::transform-type transform)))
+ (function-location (c::transform-function
+ transform))))
+ (maybe-make-definition (c::function-info-derive-type info)
+ 'c::derive-type name)
+ (maybe-make-definition (c::function-info-optimizer info)
+ 'c::optimizer name)
+ (maybe-make-definition (c::function-info-ltn-annotate info)
+ 'c::ltn-annotate name)
+ (maybe-make-definition (c::function-info-ir2-convert info)
+ 'c::ir2-convert name)
+ (loop for template in (c::function-info-templates info)
+ collect (list `(,(type-of template)
+ ,(c::template-name template))
+ (function-location
+ (c::vop-info-generator-function
+ template))))))))
+
+(defun ir1-translator-definitions (name)
+ (maybe-make-definition (ext:info :function :ir1-convert name)
+ 'c:def-ir1-translator name))
+
+(defun template-definitions (name)
+ (let* ((templates (c::backend-template-names c::*backend*))
+ (template (gethash name templates)))
+ (etypecase template
+ (null)
+ (c::vop-info
+ (maybe-make-definition (c::vop-info-generator-function template)
+ (type-of template) name)))))
+
+;; for cases like: (%primitive NAME ...)
+(defun primitive-definitions (name)
+ (let ((csym (find-symbol (string name) 'c)))
+ (and csym
+ (not (eq csym name))
+ (template-definitions csym))))
+
+(defun vm-support-routine-definitions (name)
+ (let ((sr (c::backend-support-routines c::*backend*))
+ (name (find-symbol (string name) 'c)))
+ (and name
+ (slot-exists-p sr name)
+ (maybe-make-definition (slot-value sr name)
+ (find-symbol (string 'vm-support-routine) 'c)
+ name))))
+
+
+;;;; Documentation.
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((doc (kind)
+ (or (documentation symbol kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (multiple-value-bind (kind recorded-p)
+ (ext:info variable kind symbol)
+ (declare (ignore kind))
+ (if (or (boundp symbol) recorded-p)
+ (doc 'variable))))
+ (when (fboundp symbol)
+ (maybe-push
+ (cond ((macro-function symbol) :macro)
+ ((special-operator-p symbol) :special-operator)
+ ((genericp (fdefinition symbol)) :generic-function)
+ (t :function))
+ (doc 'function)))
+ (maybe-push
+ :setf (if (or (ext:info setf inverse symbol)
+ (ext:info setf expander symbol))
+ (doc 'setf)))
+ (maybe-push
+ :type (if (ext:info type kind symbol)
+ (doc 'type)))
+ (maybe-push
+ :class (if (find-class symbol nil)
+ (doc 'class)))
+ (maybe-push
+ :alien-type (if (not (eq (ext:info alien-type kind symbol) :unknown))
+ (doc 'alien-type)))
+ (maybe-push
+ :alien-struct (if (ext:info alien-type struct symbol)
+ (doc nil)))
+ (maybe-push
+ :alien-union (if (ext:info alien-type union symbol)
+ (doc nil)))
+ (maybe-push
+ :alien-enum (if (ext:info alien-type enum symbol)
+ (doc nil)))
+ result)))
+
+(defimplementation describe-definition (symbol namespace)
+ (describe (ecase namespace
+ (:variable
+ symbol)
+ ((:function :generic-function)
+ (symbol-function symbol))
+ (:setf
+ (or (ext:info setf inverse symbol)
+ (ext:info setf expander symbol)))
+ (:type
+ (kernel:values-specifier-type symbol))
+ (:class
+ (find-class symbol))
+ (:alien-struct
+ (ext:info :alien-type :struct symbol))
+ (:alien-union
+ (ext:info :alien-type :union symbol))
+ (:alien-enum
+ (ext:info :alien-type :enum symbol))
+ (:alien-type
+ (ecase (ext:info :alien-type :kind symbol)
+ (:primitive
+ (let ((alien::*values-type-okay* t))
+ (funcall (ext:info :alien-type :translator symbol)
+ (list symbol))))
+ ((:defined)
+ (ext:info :alien-type :definition symbol))
+ (:unknown :unkown))))))
+
+;;;;; Argument lists
+
+(defimplementation arglist (fun)
+ (etypecase fun
+ (function (function-arglist fun))
+ (symbol (function-arglist (or (macro-function fun)
+ (symbol-function fun))))))
+
+(defun function-arglist (fun)
+ (let ((arglist
+ (cond ((eval:interpreted-function-p fun)
+ (eval:interpreted-function-arglist fun))
+ ((pcl::generic-function-p fun)
+ (pcl:generic-function-lambda-list fun))
+ ((c::byte-function-or-closure-p fun)
+ (byte-code-function-arglist fun))
+ ((kernel:%function-arglist (kernel:%function-self fun))
+ (handler-case (read-arglist fun)
+ (error () :not-available)))
+ ;; this should work both for compiled-debug-function
+ ;; and for interpreted-debug-function
+ (t
+ (handler-case (debug-function-arglist
+ (di::function-debug-function fun))
+ (di:unhandled-condition () :not-available))))))
+ (check-type arglist (or list (member :not-available)))
+ arglist))
+
+(defimplementation function-name (function)
+ (cond ((eval:interpreted-function-p function)
+ (eval:interpreted-function-name function))
+ ((pcl::generic-function-p function)
+ (pcl::generic-function-name function))
+ ((c::byte-function-or-closure-p function)
+ (c::byte-function-name function))
+ (t (kernel:%function-name (kernel:%function-self function)))))
+
+;;; A simple case: the arglist is available as a string that we can
+;;; `read'.
+
+(defun read-arglist (fn)
+ "Parse the arglist-string of the function object FN."
+ (let ((string (kernel:%function-arglist
+ (kernel:%function-self fn)))
+ (package (find-package
+ (c::compiled-debug-info-package
+ (kernel:%code-debug-info
+ (vm::find-code-object fn))))))
+ (with-standard-io-syntax
+ (let ((*package* (or package *package*)))
+ (read-from-string string)))))
+
+;;; A harder case: an approximate arglist is derived from available
+;;; debugging information.
+
+(defun debug-function-arglist (debug-function)
+ "Derive the argument list of DEBUG-FUNCTION from debug info."
+ (let ((args (di::debug-function-lambda-list debug-function))
+ (required '())
+ (optional '())
+ (rest '())
+ (key '()))
+ ;; collect the names of debug-vars
+ (dolist (arg args)
+ (etypecase arg
+ (di::debug-variable
+ (push (di::debug-variable-symbol arg) required))
+ ((member :deleted)
+ (push ':deleted required))
+ (cons
+ (ecase (car arg)
+ (:keyword
+ (push (second arg) key))
+ (:optional
+ (push (debug-variable-symbol-or-deleted (second arg)) optional))
+ (:rest
+ (push (debug-variable-symbol-or-deleted (second arg)) rest))))))
+ ;; intersperse lambda keywords as needed
+ (append (nreverse required)
+ (if optional (cons '&optional (nreverse optional)))
+ (if rest (cons '&rest (nreverse rest)))
+ (if key (cons '&key (nreverse key))))))
+
+(defun debug-variable-symbol-or-deleted (var)
+ (etypecase var
+ (di:debug-variable
+ (di::debug-variable-symbol var))
+ ((member :deleted)
+ '#:deleted)))
+
+(defun symbol-debug-function-arglist (fname)
+ "Return FNAME's debug-function-arglist and %function-arglist.
+A utility for debugging DEBUG-FUNCTION-ARGLIST."
+ (let ((fn (fdefinition fname)))
+ (values (debug-function-arglist (di::function-debug-function fn))
+ (kernel:%function-arglist (kernel:%function-self fn)))))
+
+;;; Deriving arglists for byte-compiled functions:
+;;;
+(defun byte-code-function-arglist (fn)
+ ;; There doesn't seem to be much arglist information around for
+ ;; byte-code functions. Use the arg-count and return something like
+ ;; (arg0 arg1 ...)
+ (etypecase fn
+ (c::simple-byte-function
+ (loop for i from 0 below (c::simple-byte-function-num-args fn)
+ collect (make-arg-symbol i)))
+ (c::hairy-byte-function
+ (hairy-byte-function-arglist fn))
+ (c::byte-closure
+ (byte-code-function-arglist (c::byte-closure-function fn)))))
+
+(defun make-arg-symbol (i)
+ (make-symbol (format nil "~A~D" (string 'arg) i)))
+
+;;; A "hairy" byte-function is one that takes a variable number of
+;;; arguments. `hairy-byte-function' is a type from the bytecode
+;;; interpreter.
+;;;
+(defun hairy-byte-function-arglist (fn)
+ (let ((counter -1))
+ (flet ((next-arg () (make-arg-symbol (incf counter))))
+ (with-struct (c::hairy-byte-function- min-args max-args rest-arg-p
+ keywords-p keywords) fn
+ (let ((arglist '())
+ (optional (- max-args min-args)))
+ ;; XXX isn't there a better way to write this?
+ ;; (Looks fine to me. -luke)
+ (dotimes (i min-args)
+ (push (next-arg) arglist))
+ (when (plusp optional)
+ (push '&optional arglist)
+ (dotimes (i optional)
+ (push (next-arg) arglist)))
+ (when rest-arg-p
+ (push '&rest arglist)
+ (push (next-arg) arglist))
+ (when keywords-p
+ (push '&key arglist)
+ (loop for (key _ __) in keywords
+ do (push key arglist))
+ (when (eq keywords-p :allow-others)
+ (push '&allow-other-keys arglist)))
+ (nreverse arglist))))))
+
+
+;;;; Miscellaneous.
+
+(defimplementation macroexpand-all (form &optional env)
+ (walker:macroexpand-all form env))
+
+(defimplementation compiler-macroexpand-1 (form &optional env)
+ (ext:compiler-macroexpand-1 form env))
+
+(defimplementation compiler-macroexpand (form &optional env)
+ (ext:compiler-macroexpand form env))
+
+(defimplementation set-default-directory (directory)
+ (setf (ext:default-directory) (namestring directory))
+ ;; Setting *default-pathname-defaults* to an absolute directory
+ ;; makes the behavior of MERGE-PATHNAMES a bit more intuitive.
+ (setf *default-pathname-defaults* (pathname (ext:default-directory)))
+ (default-directory))
+
+(defimplementation default-directory ()
+ (namestring (ext:default-directory)))
+
+(defimplementation getpid ()
+ (unix:unix-getpid))
+
+(defimplementation lisp-implementation-type-name ()
+ "cmucl")
+
+(defimplementation quit-lisp ()
+ (ext::quit))
+
+;;; source-path-{stream,file,string,etc}-position moved into
+;;; source-path-parser
+
+
+;;;; Debugging
+
+(defvar *sldb-stack-top*)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (unix:unix-sigsetmask 0)
+ (let* ((*sldb-stack-top* (or debug:*stack-top-hint* (di:top-frame)))
+ (debug:*stack-top-hint* nil)
+ (kernel:*current-level* 0))
+ (handler-bind ((di::unhandled-condition
+ (lambda (condition)
+ (error 'sldb-condition
+ :original-condition condition))))
+ (unwind-protect
+ (progn
+ #+(or)(sys:scrub-control-stack)
+ (funcall debugger-loop-fn))
+ #+(or)(sys:scrub-control-stack)
+ ))))
+
+(defun frame-down (frame)
+ (handler-case (di:frame-down frame)
+ (di:no-debug-info () nil)))
+
+(defun nth-frame (index)
+ (do ((frame *sldb-stack-top* (frame-down frame))
+ (i index (1- i)))
+ ((zerop i) frame)))
+
+(defimplementation compute-backtrace (start end)
+ (let ((end (or end most-positive-fixnum)))
+ (loop for f = (nth-frame start) then (frame-down f)
+ for i from start below end
+ while f collect f)))
+
+(defimplementation print-frame (frame stream)
+ (let ((*standard-output* stream))
+ (handler-case
+ (debug::print-frame-call frame :verbosity 1 :number nil)
+ (error (e)
+ (ignore-errors (princ e stream))))))
+
+(defimplementation frame-source-location (index)
+ (let ((frame (nth-frame index)))
+ (cond ((foreign-frame-p frame) (foreign-frame-source-location frame))
+ ((code-location-source-location (di:frame-code-location frame))))))
+
+(defimplementation eval-in-frame (form index)
+ (di:eval-in-frame (nth-frame index) form))
+
+(defun frame-debug-vars (frame)
+ "Return a vector of debug-variables in frame."
+ (let ((loc (di:frame-code-location frame)))
+ (remove-if
+ (lambda (v)
+ (not (eq (di:debug-variable-validity v loc) :valid)))
+ (di::debug-function-debug-variables (di:frame-debug-function frame)))))
+
+(defun debug-var-value (var frame)
+ (let* ((loc (di:frame-code-location frame))
+ (validity (di:debug-variable-validity var loc)))
+ (ecase validity
+ (:valid (di:debug-variable-value var frame))
+ ((:invalid :unknown) (make-symbol (string validity))))))
+
+(defimplementation frame-locals (index)
+ (let ((frame (nth-frame index)))
+ (loop for v across (frame-debug-vars frame)
+ collect (list :name (di:debug-variable-symbol v)
+ :id (di:debug-variable-id v)
+ :value (debug-var-value v frame)))))
+
+(defimplementation frame-var-value (frame var)
+ (let* ((frame (nth-frame frame))
+ (dvar (aref (frame-debug-vars frame) var)))
+ (debug-var-value dvar frame)))
+
+(defimplementation frame-catch-tags (index)
+ (mapcar #'car (di:frame-catches (nth-frame index))))
+
+(defimplementation frame-package (frame-number)
+ (let* ((frame (nth-frame frame-number))
+ (dbg-fun (di:frame-debug-function frame)))
+ (typecase dbg-fun
+ (di::compiled-debug-function
+ (let* ((comp (di::compiled-debug-function-component dbg-fun))
+ (dbg-info (kernel:%code-debug-info comp)))
+ (typecase dbg-info
+ (c::compiled-debug-info
+ (find-package (c::compiled-debug-info-package dbg-info)))))))))
+
+(defimplementation return-from-frame (index form)
+ (let ((sym (find-symbol (string 'find-debug-tag-for-frame)
+ :debug-internals)))
+ (if sym
+ (let* ((frame (nth-frame index))
+ (probe (funcall sym frame)))
+ (cond (probe (throw (car probe) (eval-in-frame form index)))
+ (t (format nil "Cannot return from frame: ~S" frame))))
+ "return-from-frame is not implemented in this version of CMUCL.")))
+
+(defimplementation activate-stepping (frame)
+ (set-step-breakpoints (nth-frame frame)))
+
+(defimplementation sldb-break-on-return (frame)
+ (break-on-return (nth-frame frame)))
+
+;;; We set the breakpoint in the caller which might be a bit confusing.
+;;;
+(defun break-on-return (frame)
+ (let* ((caller (di:frame-down frame))
+ (cl (di:frame-code-location caller)))
+ (flet ((hook (frame bp)
+ (when (frame-pointer= frame caller)
+ (di:delete-breakpoint bp)
+ (signal-breakpoint bp frame))))
+ (let* ((info (ecase (di:code-location-kind cl)
+ ((:single-value-return :unknown-return) nil)
+ (:known-return (debug-function-returns
+ (di:frame-debug-function frame)))))
+ (bp (di:make-breakpoint #'hook cl :kind :code-location
+ :info info)))
+ (di:activate-breakpoint bp)
+ `(:ok ,(format nil "Set breakpoint in ~A" caller))))))
+
+(defun frame-pointer= (frame1 frame2)
+ "Return true if the frame pointers of FRAME1 and FRAME2 are the same."
+ (sys:sap= (di::frame-pointer frame1) (di::frame-pointer frame2)))
+
+;;; The PC in escaped frames at a single-return-value point is
+;;; actually vm:single-value-return-byte-offset bytes after the
+;;; position given in the debug info. Here we try to recognize such
+;;; cases.
+;;;
+(defun next-code-locations (frame code-location)
+ "Like `debug::next-code-locations' but be careful in escaped frames."
+ (let ((next (debug::next-code-locations code-location)))
+ (flet ((adjust-pc ()
+ (let ((cl (di::copy-compiled-code-location code-location)))
+ (incf (di::compiled-code-location-pc cl)
+ vm:single-value-return-byte-offset)
+ cl)))
+ (cond ((and (di::compiled-frame-escaped frame)
+ (eq (di:code-location-kind code-location)
+ :single-value-return)
+ (= (length next) 1)
+ (di:code-location= (car next) (adjust-pc)))
+ (debug::next-code-locations (car next)))
+ (t
+ next)))))
+
+(defun set-step-breakpoints (frame)
+ (let ((cl (di:frame-code-location frame)))
+ (when (di:debug-block-elsewhere-p (di:code-location-debug-block cl))
+ (error "Cannot step in elsewhere code"))
+ (let* ((debug::*bad-code-location-types*
+ (remove :call-site debug::*bad-code-location-types*))
+ (next (next-code-locations frame cl)))
+ (cond (next
+ (let ((steppoints '()))
+ (flet ((hook (bp-frame bp)
+ (signal-breakpoint bp bp-frame)
+ (mapc #'di:delete-breakpoint steppoints)))
+ (dolist (code-location next)
+ (let ((bp (di:make-breakpoint #'hook code-location
+ :kind :code-location)))
+ (di:activate-breakpoint bp)
+ (push bp steppoints))))))
+ (t
+ (break-on-return frame))))))
+
+
+;; XXX the return values at return breakpoints should be passed to the
+;; user hooks. debug-int.lisp should be changed to do this cleanly.
+
+;;; The sigcontext and the PC for a breakpoint invocation are not
+;;; passed to user hook functions, but we need them to extract return
+;;; values. So we advice di::handle-breakpoint and bind the values to
+;;; special variables.
+;;;
+(defvar *breakpoint-sigcontext*)
+(defvar *breakpoint-pc*)
+
+(define-fwrapper bind-breakpoint-sigcontext (offset c sigcontext)
+ (let ((*breakpoint-sigcontext* sigcontext)
+ (*breakpoint-pc* offset))
+ (call-next-function)))
+(set-fwrappers 'di::handle-breakpoint '())
+(fwrap 'di::handle-breakpoint #'bind-breakpoint-sigcontext)
+
+(defun sigcontext-object (sc index)
+ "Extract the lisp object in sigcontext SC at offset INDEX."
+ (kernel:make-lisp-obj (vm:sigcontext-register sc index)))
+
+(defun known-return-point-values (sigcontext sc-offsets)
+ (let ((fp (system:int-sap (vm:sigcontext-register sigcontext
+ vm::cfp-offset))))
+ (system:without-gcing
+ (loop for sc-offset across sc-offsets
+ collect (di::sub-access-debug-var-slot fp sc-offset sigcontext)))))
+
+;;; CMUCL returns the first few values in registers and the rest on
+;;; the stack. In the multiple value case, the number of values is
+;;; stored in a dedicated register. The values of the registers can be
+;;; accessed in the sigcontext for the breakpoint. There are 3 kinds
+;;; of return conventions: :single-value-return, :unknown-return, and
+;;; :known-return.
+;;;
+;;; The :single-value-return convention returns the value in a
+;;; register without setting the nargs registers.
+;;;
+;;; The :unknown-return variant is used for multiple values. A
+;;; :unknown-return point consists actually of 2 breakpoints: one for
+;;; the single value case and one for the general case. The single
+;;; value breakpoint comes vm:single-value-return-byte-offset after
+;;; the multiple value breakpoint.
+;;;
+;;; The :known-return convention is used by local functions.
+;;; :known-return is currently not supported because we don't know
+;;; where the values are passed.
+;;;
+(defun breakpoint-values (breakpoint)
+ "Return the list of return values for a return point."
+ (flet ((1st (sc) (sigcontext-object sc (car vm::register-arg-offsets))))
+ (let ((sc (locally (declare (optimize (speed 0)))
+ (alien:sap-alien *breakpoint-sigcontext* (* unix:sigcontext))))
+ (cl (di:breakpoint-what breakpoint)))
+ (ecase (di:code-location-kind cl)
+ (:single-value-return
+ (list (1st sc)))
+ (:known-return
+ (let ((info (di:breakpoint-info breakpoint)))
+ (if (vectorp info)
+ (known-return-point-values sc info)
+ (progn
+ ;;(break)
+ (list "<<known-return convention not supported>>" info)))))
+ (:unknown-return
+ (let ((mv-return-pc (di::compiled-code-location-pc cl)))
+ (if (= mv-return-pc *breakpoint-pc*)
+ (mv-function-end-breakpoint-values sc)
+ (list (1st sc)))))))))
+
+;; XXX: di::get-function-end-breakpoint-values takes 2 arguments in
+;; newer versions of CMUCL (after ~March 2005).
+(defun mv-function-end-breakpoint-values (sigcontext)
+ (let ((sym (find-symbol "FUNCTION-END-BREAKPOINT-VALUES/STANDARD" :di)))
+ (cond (sym (funcall sym sigcontext))
+ (t (funcall 'di::get-function-end-breakpoint-values sigcontext)))))
+
+(defun debug-function-returns (debug-fun)
+ "Return the return style of DEBUG-FUN."
+ (let* ((cdfun (di::compiled-debug-function-compiler-debug-fun debug-fun)))
+ (c::compiled-debug-function-returns cdfun)))
+
+(define-condition breakpoint (simple-condition)
+ ((message :initarg :message :reader breakpoint.message)
+ (values :initarg :values :reader breakpoint.values))
+ (:report (lambda (c stream) (princ (breakpoint.message c) stream))))
+
+(defimplementation condition-extras (condition)
+ (typecase condition
+ (breakpoint
+ ;; pop up the source buffer
+ `((:show-frame-source 0)))
+ (t '())))
+
+(defun signal-breakpoint (breakpoint frame)
+ "Signal a breakpoint condition for BREAKPOINT in FRAME.
+Try to create a informative message."
+ (flet ((brk (values fstring &rest args)
+ (let ((msg (apply #'format nil fstring args))
+ (debug:*stack-top-hint* frame))
+ (break 'breakpoint :message msg :values values))))
+ (with-struct (di::breakpoint- kind what) breakpoint
+ (case kind
+ (:code-location
+ (case (di:code-location-kind what)
+ ((:single-value-return :known-return :unknown-return)
+ (let ((values (breakpoint-values breakpoint)))
+ (brk values "Return value: ~{~S ~}" values)))
+ (t
+ #+(or)
+ (when (eq (di:code-location-kind what) :call-site)
+ (call-site-function breakpoint frame))
+ (brk nil "Breakpoint: ~S ~S"
+ (di:code-location-kind what)
+ (di::compiled-code-location-pc what)))))
+ (:function-start
+ (brk nil "Function start breakpoint"))
+ (t (brk nil "Breakpoint: ~A in ~A" breakpoint frame))))))
+
+(defimplementation sldb-break-at-start (fname)
+ (let ((debug-fun (di:function-debug-function (coerce fname 'function))))
+ (cond ((not debug-fun)
+ `(:error ,(format nil "~S has no debug-function" fname)))
+ (t
+ (flet ((hook (frame bp &optional args cookie)
+ (declare (ignore args cookie))
+ (signal-breakpoint bp frame)))
+ (let ((bp (di:make-breakpoint #'hook debug-fun
+ :kind :function-start)))
+ (di:activate-breakpoint bp)
+ `(:ok ,(format nil "Set breakpoint in ~S" fname))))))))
+
+(defun frame-cfp (frame)
+ "Return the Control-Stack-Frame-Pointer for FRAME."
+ (etypecase frame
+ (di::compiled-frame (di::frame-pointer frame))
+ ((or di::interpreted-frame null) -1)))
+
+(defun frame-ip (frame)
+ "Return the (absolute) instruction pointer and the relative pc of FRAME."
+ (if (not frame)
+ -1
+ (let ((debug-fun (di::frame-debug-function frame)))
+ (etypecase debug-fun
+ (di::compiled-debug-function
+ (let* ((code-loc (di:frame-code-location frame))
+ (component (di::compiled-debug-function-component debug-fun))
+ (pc (di::compiled-code-location-pc code-loc))
+ (ip (sys:without-gcing
+ (sys:sap-int
+ (sys:sap+ (kernel:code-instructions component) pc)))))
+ (values ip pc)))
+ (di::interpreted-debug-function -1)
+ (di::bogus-debug-function
+ #-x86
+ (let* ((real (di::frame-real-frame (di::frame-up frame)))
+ (fp (di::frame-pointer real)))
+ ;;#+(or)
+ (progn
+ (format *debug-io* "Frame-real-frame = ~S~%" real)
+ (format *debug-io* "fp = ~S~%" fp)
+ (format *debug-io* "lra = ~S~%"
+ (kernel:stack-ref fp vm::lra-save-offset)))
+ (values
+ (sys:int-sap
+ (- (kernel:get-lisp-obj-address
+ (kernel:stack-ref fp vm::lra-save-offset))
+ (- (ash vm:function-code-offset vm:word-shift)
+ vm:function-pointer-type)))
+ 0))
+ #+x86
+ (let ((fp (di::frame-pointer (di:frame-up frame))))
+ (multiple-value-bind (ra ofp) (di::x86-call-context fp)
+ (declare (ignore ofp))
+ (values ra 0))))))))
+
+(defun frame-registers (frame)
+ "Return the lisp registers CSP, CFP, IP, OCFP, LRA for FRAME-NUMBER."
+ (let* ((cfp (frame-cfp frame))
+ (csp (frame-cfp (di::frame-up frame)))
+ (ip (frame-ip frame))
+ (ocfp (frame-cfp (di::frame-down frame)))
+ (lra (frame-ip (di::frame-down frame))))
+ (values csp cfp ip ocfp lra)))
+
+(defun print-frame-registers (frame-number)
+ (let ((frame (di::frame-real-frame (nth-frame frame-number))))
+ (flet ((fixnum (p) (etypecase p
+ (integer p)
+ (sys:system-area-pointer (sys:sap-int p)))))
+ (apply #'format t "~
+~8X Stack Pointer
+~8X Frame Pointer
+~8X Instruction Pointer
+~8X Saved Frame Pointer
+~8X Saved Instruction Pointer~%" (mapcar #'fixnum
+ (multiple-value-list (frame-registers frame)))))))
+
+(defvar *gdb-program-name*
+ (ext:enumerate-search-list (p "path:gdb")
+ (when (probe-file p)
+ (return p))))
+
+(defimplementation disassemble-frame (frame-number)
+ (print-frame-registers frame-number)
+ (terpri)
+ (let* ((frame (di::frame-real-frame (nth-frame frame-number)))
+ (debug-fun (di::frame-debug-function frame)))
+ (etypecase debug-fun
+ (di::compiled-debug-function
+ (let* ((component (di::compiled-debug-function-component debug-fun))
+ (fun (di:debug-function-function debug-fun)))
+ (if fun
+ (disassemble fun)
+ (disassem:disassemble-code-component component))))
+ (di::bogus-debug-function
+ (cond ((probe-file *gdb-program-name*)
+ (let ((ip (sys:sap-int (frame-ip frame))))
+ (princ (gdb-command "disas 0x~x" ip))))
+ (t
+ (format t "~%[Disassembling bogus frames not implemented]")))))))
+
+(defmacro with-temporary-file ((stream filename) &body body)
+ `(call/temporary-file (lambda (,stream ,filename) . ,body)))
+
+(defun call/temporary-file (fun)
+ (let ((name (system::pick-temporary-file-name)))
+ (unwind-protect
+ (with-open-file (stream name :direction :output :if-exists :supersede)
+ (funcall fun stream name))
+ (delete-file name))))
+
+(defun gdb-command (format-string &rest args)
+ (let ((str (gdb-exec (format nil
+ "interpreter-exec mi2 \"attach ~d\"~%~
+ interpreter-exec console ~s~%detach"
+ (getpid)
+ (apply #'format nil format-string args))))
+ (prompt (format nil
+ #-(and darwin x86) "~%^done~%(gdb) ~%"
+ #+(and darwin x86)
+"~%^done,thread-id=\"1\"~%(gdb) ~%")))
+ (subseq str (+ (or (search prompt str) 0) (length prompt)))))
+
+(defun gdb-exec (cmd)
+ (with-temporary-file (file filename)
+ (write-string cmd file)
+ (force-output file)
+ (let* ((output (make-string-output-stream))
+ ;; gdb on sparc needs to know the executable to find the
+ ;; symbols. Without this, gdb can't disassemble anything.
+ ;; NOTE: We assume that the first entry in
+ ;; lisp::*cmucl-lib* is the bin directory where lisp is
+ ;; located. If this is not true, we'll have to do
+ ;; something better to find the lisp executable.
+ (lisp-path
+ #+sparc
+ (list
+ (namestring
+ (probe-file
+ (merge-pathnames "lisp" (car (lisp::parse-unix-search-path
+ lisp::*cmucl-lib*))))))
+ #-sparc
+ nil)
+ (proc (ext:run-program *gdb-program-name*
+ `(,@lisp-path "-batch" "-x" ,filename)
+ :wait t
+ :output output)))
+ (assert (eq (ext:process-status proc) :exited))
+ (assert (eq (ext:process-exit-code proc) 0))
+ (get-output-stream-string output))))
+
+(defun foreign-frame-p (frame)
+ #-x86
+ (let ((ip (frame-ip frame)))
+ (and (sys:system-area-pointer-p ip)
+ (typep (di::frame-debug-function frame) 'di::bogus-debug-function)))
+ #+x86
+ (let ((ip (frame-ip frame)))
+ (and (sys:system-area-pointer-p ip)
+ (multiple-value-bind (pc code)
+ (di::compute-lra-data-from-pc ip)
+ (declare (ignore pc))
+ (not code)))))
+
+(defun foreign-frame-source-location (frame)
+ (let ((ip (sys:sap-int (frame-ip frame))))
+ (cond ((probe-file *gdb-program-name*)
+ (parse-gdb-line-info (gdb-command "info line *0x~x" ip)))
+ (t `(:error "no srcloc available for ~a" frame)))))
+
+;; The output of gdb looks like:
+;; Line 215 of "../../src/lisp/x86-assem.S"
+;; starts at address 0x805318c <Ldone+11>
+;; and ends at 0x805318e <Ldone+13>.
+;; The ../../ are fixed up with the "target:" search list which might
+;; be wrong sometimes.
+(defun parse-gdb-line-info (string)
+ (with-input-from-string (*standard-input* string)
+ (let ((w1 (read-word)))
+ (cond ((equal w1 "Line")
+ (let ((line (read-word)))
+ (assert (equal (read-word) "of"))
+ (let* ((file (read-from-string (read-word)))
+ (pathname
+ (or (probe-file file)
+ (probe-file (format nil "target:lisp/~a" file))
+ file)))
+ (make-location (list :file (unix-truename pathname))
+ (list :line (parse-integer line))))))
+ (t
+ `(:error ,string))))))
+
+(defun read-word (&optional (stream *standard-input*))
+ (peek-char t stream)
+ (concatenate 'string (loop until (whitespacep (peek-char nil stream))
+ collect (read-char stream))))
+
+(defun whitespacep (char)
+ (member char '(#\space #\newline)))
+
+
+;;;; Inspecting
+
+(defconstant +lowtag-symbols+
+ '(vm:even-fixnum-type
+ vm:function-pointer-type
+ vm:other-immediate-0-type
+ vm:list-pointer-type
+ vm:odd-fixnum-type
+ vm:instance-pointer-type
+ vm:other-immediate-1-type
+ vm:other-pointer-type)
+ "Names of the constants that specify type tags.
+The `symbol-value' of each element is a type tag.")
+
+(defconstant +header-type-symbols+
+ (labels ((suffixp (suffix string)
+ (and (>= (length string) (length suffix))
+ (string= string suffix :start1 (- (length string)
+ (length suffix)))))
+ (header-type-symbol-p (x)
+ (and (suffixp "-TYPE" (symbol-name x))
+ (not (member x +lowtag-symbols+))
+ (boundp x)
+ (typep (symbol-value x) 'fixnum))))
+ (remove-if-not #'header-type-symbol-p
+ (append (apropos-list "-TYPE" "VM")
+ (apropos-list "-TYPE" "BIGNUM"))))
+ "A list of names of the type codes in boxed objects.")
+
+(defimplementation describe-primitive-type (object)
+ (with-output-to-string (*standard-output*)
+ (let* ((lowtag (kernel:get-lowtag object))
+ (lowtag-symbol (find lowtag +lowtag-symbols+ :key #'symbol-value)))
+ (format t "lowtag: ~A" lowtag-symbol)
+ (when (member lowtag (list vm:other-pointer-type
+ vm:function-pointer-type
+ vm:other-immediate-0-type
+ vm:other-immediate-1-type
+ ))
+ (let* ((type (kernel:get-type object))
+ (type-symbol (find type +header-type-symbols+
+ :key #'symbol-value)))
+ (format t ", type: ~A" type-symbol))))))
+
+(defmethod emacs-inspect ((o t))
+ (cond ((di::indirect-value-cell-p o)
+ `("Value: " (:value ,(c:value-cell-ref o))))
+ ((alien::alien-value-p o)
+ (inspect-alien-value o))
+ (t
+ (cmucl-inspect o))))
+
+(defun cmucl-inspect (o)
+ (destructuring-bind (text labeledp . parts) (inspect::describe-parts o)
+ (list* (format nil "~A~%" text)
+ (if labeledp
+ (loop for (label . value) in parts
+ append (label-value-line label value))
+ (loop for value in parts for i from 0
+ append (label-value-line i value))))))
+
+(defmethod emacs-inspect ((o function))
+ (let ((header (kernel:get-type o)))
+ (cond ((= header vm:function-header-type)
+ (append (label-value-line*
+ ("Self" (kernel:%function-self o))
+ ("Next" (kernel:%function-next o))
+ ("Name" (kernel:%function-name o))
+ ("Arglist" (kernel:%function-arglist o))
+ ("Type" (kernel:%function-type o))
+ ("Code" (kernel:function-code-header o)))
+ (list
+ (with-output-to-string (s)
+ (disassem:disassemble-function o :stream s)))))
+ ((= header vm:closure-header-type)
+ (list* (format nil "~A is a closure.~%" o)
+ (append
+ (label-value-line "Function" (kernel:%closure-function o))
+ `("Environment:" (:newline))
+ (loop for i from 0 below (1- (kernel:get-closure-length o))
+ append (label-value-line
+ i (kernel:%closure-index-ref o i))))))
+ ((eval::interpreted-function-p o)
+ (cmucl-inspect o))
+ (t
+ (call-next-method)))))
+
+(defmethod emacs-inspect ((o kernel:funcallable-instance))
+ (append (label-value-line*
+ (:function (kernel:%funcallable-instance-function o))
+ (:lexenv (kernel:%funcallable-instance-lexenv o))
+ (:layout (kernel:%funcallable-instance-layout o)))
+ (cmucl-inspect o)))
+
+(defmethod emacs-inspect ((o kernel:code-component))
+ (append
+ (label-value-line*
+ ("code-size" (kernel:%code-code-size o))
+ ("entry-points" (kernel:%code-entry-points o))
+ ("debug-info" (kernel:%code-debug-info o))
+ ("trace-table-offset" (kernel:code-header-ref
+ o vm:code-trace-table-offset-slot)))
+ `("Constants:" (:newline))
+ (loop for i from vm:code-constants-offset
+ below (kernel:get-header-data o)
+ append (label-value-line i (kernel:code-header-ref o i)))
+ `("Code:"
+ (:newline)
+ , (with-output-to-string (*standard-output*)
+ (cond ((c::compiled-debug-info-p (kernel:%code-debug-info o))
+ (disassem:disassemble-code-component o))
+ ((or
+ (c::debug-info-p (kernel:%code-debug-info o))
+ (consp (kernel:code-header-ref
+ o vm:code-trace-table-offset-slot)))
+ (c:disassem-byte-component o))
+ (t
+ (disassem:disassemble-memory
+ (disassem::align
+ (+ (logandc2 (kernel:get-lisp-obj-address o)
+ vm:lowtag-mask)
+ (* vm:code-constants-offset vm:word-bytes))
+ (ash 1 vm:lowtag-bits))
+ (ash (kernel:%code-code-size o) vm:word-shift))))))))
+
+(defmethod emacs-inspect ((o kernel:fdefn))
+ (label-value-line*
+ ("name" (kernel:fdefn-name o))
+ ("function" (kernel:fdefn-function o))
+ ("raw-addr" (sys:sap-ref-32
+ (sys:int-sap (kernel:get-lisp-obj-address o))
+ (* vm:fdefn-raw-addr-slot vm:word-bytes)))))
+
+#+(or)
+(defmethod emacs-inspect ((o array))
+ (if (typep o 'simple-array)
+ (call-next-method)
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:rank (array-rank o))
+ (:fill-pointer (kernel:%array-fill-pointer o))
+ (:fill-pointer-p (kernel:%array-fill-pointer-p o))
+ (:elements (kernel:%array-available-elements o))
+ (:data (kernel:%array-data-vector o))
+ (:displacement (kernel:%array-displacement o))
+ (:displaced-p (kernel:%array-displaced-p o))
+ (:dimensions (array-dimensions o)))))
+
+(defmethod emacs-inspect ((o simple-vector))
+ (append
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:length (c::vector-length o)))
+ (loop for i below (length o)
+ append (label-value-line i (aref o i)))))
+
+(defun inspect-alien-record (alien)
+ (with-struct (alien::alien-value- sap type) alien
+ (with-struct (alien::alien-record-type- kind name fields) type
+ (append
+ (label-value-line*
+ (:sap sap)
+ (:kind kind)
+ (:name name))
+ (loop for field in fields
+ append (let ((slot (alien::alien-record-field-name field)))
+ (declare (optimize (speed 0)))
+ (label-value-line slot (alien:slot alien slot))))))))
+
+(defun inspect-alien-pointer (alien)
+ (with-struct (alien::alien-value- sap type) alien
+ (label-value-line*
+ (:sap sap)
+ (:type type)
+ (:to (alien::deref alien)))))
+
+(defun inspect-alien-value (alien)
+ (typecase (alien::alien-value-type alien)
+ (alien::alien-record-type (inspect-alien-record alien))
+ (alien::alien-pointer-type (inspect-alien-pointer alien))
+ (t (cmucl-inspect alien))))
+
+(defimplementation eval-context (obj)
+ (cond ((typep (class-of obj) 'structure-class)
+ (let* ((dd (kernel:layout-info (kernel:layout-of obj)))
+ (slots (kernel:dd-slots dd)))
+ (list* (cons '*package*
+ (symbol-package (if slots
+ (kernel:dsd-name (car slots))
+ (kernel:dd-name dd))))
+ (loop for slot in slots collect
+ (cons (kernel:dsd-name slot)
+ (funcall (kernel:dsd-accessor slot) obj))))))))
+
+
+;;;; Profiling
+(defimplementation profile (fname)
+ (eval `(profile:profile ,fname)))
+
+(defimplementation unprofile (fname)
+ (eval `(profile:unprofile ,fname)))
+
+(defimplementation unprofile-all ()
+ (eval `(profile:unprofile))
+ "All functions unprofiled.")
+
+(defimplementation profile-report ()
+ (eval `(profile:report-time)))
+
+(defimplementation profile-reset ()
+ (eval `(profile:reset-time))
+ "Reset profiling counters.")
+
+(defimplementation profiled-functions ()
+ profile:*timed-functions*)
+
+(defimplementation profile-package (package callers methods)
+ (profile:profile-all :package package
+ :callers-p callers
+ :methods methods))
+
+
+;;;; Multiprocessing
+
+#+mp
+(progn
+ (defimplementation initialize-multiprocessing (continuation)
+ (mp::init-multi-processing)
+ (mp:make-process continuation :name "swank")
+ ;; Threads magic: this never returns! But top-level becomes
+ ;; available again.
+ (unless mp::*idle-process*
+ (mp::startup-idle-and-top-level-loops)))
+
+ (defimplementation spawn (fn &key name)
+ (mp:make-process fn :name (or name "Anonymous")))
+
+ (defvar *thread-id-counter* 0)
+
+ (defimplementation thread-id (thread)
+ (or (getf (mp:process-property-list thread) 'id)
+ (setf (getf (mp:process-property-list thread) 'id)
+ (incf *thread-id-counter*))))
+
+ (defimplementation find-thread (id)
+ (find id (all-threads)
+ :key (lambda (p) (getf (mp:process-property-list p) 'id))))
+
+ (defimplementation thread-name (thread)
+ (mp:process-name thread))
+
+ (defimplementation thread-status (thread)
+ (mp:process-whostate thread))
+
+ (defimplementation current-thread ()
+ mp:*current-process*)
+
+ (defimplementation all-threads ()
+ (copy-list mp:*all-processes*))
+
+ (defimplementation interrupt-thread (thread fn)
+ (mp:process-interrupt thread fn))
+
+ (defimplementation kill-thread (thread)
+ (mp:destroy-process thread))
+
+ (defvar *mailbox-lock* (mp:make-lock "mailbox lock"))
+
+ (defstruct (mailbox (:conc-name mailbox.))
+ (mutex (mp:make-lock "process mailbox"))
+ (queue '() :type list))
+
+ (defun mailbox (thread)
+ "Return THREAD's mailbox."
+ (mp:with-lock-held (*mailbox-lock*)
+ (or (getf (mp:process-property-list thread) 'mailbox)
+ (setf (getf (mp:process-property-list thread) 'mailbox)
+ (make-mailbox)))))
+
+ (defimplementation send (thread message)
+ (check-slime-interrupts)
+ (let* ((mbox (mailbox thread)))
+ (mp:with-lock-held ((mailbox.mutex mbox))
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message))))))
+
+ (defimplementation receive-if (test &optional timeout)
+ (let ((mbox (mailbox mp:*current-process*)))
+ (assert (or (not timeout) (eq timeout t)))
+ (loop
+ (check-slime-interrupts)
+ (mp:with-lock-held ((mailbox.mutex mbox))
+ (let* ((q (mailbox.queue mbox))
+ (tail (member-if test q)))
+ (when tail
+ (setf (mailbox.queue mbox)
+ (nconc (ldiff q tail) (cdr tail)))
+ (return (car tail)))))
+ (when (eq timeout t) (return (values nil t)))
+ (mp:process-wait-with-timeout
+ "receive-if" 0.5
+ (lambda () (some test (mailbox.queue mbox)))))))
+
+
+ ) ;; #+mp
+
+
+
+;;;; GC hooks
+;;;
+;;; Display GC messages in the echo area to avoid cluttering the
+;;; normal output.
+;;;
+
+;; this should probably not be here, but where else?
+(defun background-message (message)
+ (swank::background-message message))
+
+(defun print-bytes (nbytes &optional stream)
+ "Print the number NBYTES to STREAM in KB, MB, or GB units."
+ (let ((names '((0 bytes) (10 kb) (20 mb) (30 gb) (40 tb) (50 eb))))
+ (multiple-value-bind (power name)
+ (loop for ((p1 n1) (p2 n2)) on names
+ while n2 do
+ (when (<= (expt 2 p1) nbytes (1- (expt 2 p2)))
+ (return (values p1 n1))))
+ (cond (name
+ (format stream "~,1F ~A" (/ nbytes (expt 2 power)) name))
+ (t
+ (format stream "~:D bytes" nbytes))))))
+
+(defconstant gc-generations 6)
+
+#+gencgc
+(defun generation-stats ()
+ "Return a string describing the size distribution among the generations."
+ (let* ((alloc (loop for i below gc-generations
+ collect (lisp::gencgc-stats i)))
+ (sum (coerce (reduce #'+ alloc) 'float)))
+ (format nil "~{~3F~^/~}"
+ (mapcar (lambda (size) (/ size sum))
+ alloc))))
+
+(defvar *gc-start-time* 0)
+
+(defun pre-gc-hook (bytes-in-use)
+ (setq *gc-start-time* (get-internal-real-time))
+ (let ((msg (format nil "[Commencing GC with ~A in use.]"
+ (print-bytes bytes-in-use))))
+ (background-message msg)))
+
+(defun post-gc-hook (bytes-retained bytes-freed trigger)
+ (declare (ignore trigger))
+ (let* ((seconds (/ (- (get-internal-real-time) *gc-start-time*)
+ internal-time-units-per-second))
+ (msg (format nil "[GC done. ~A freed ~A retained ~A ~4F sec]"
+ (print-bytes bytes-freed)
+ (print-bytes bytes-retained)
+ #+gencgc(generation-stats)
+ #-gencgc""
+ seconds)))
+ (background-message msg)))
+
+(defun install-gc-hooks ()
+ (setq ext:*gc-notify-before* #'pre-gc-hook)
+ (setq ext:*gc-notify-after* #'post-gc-hook))
+
+(defun remove-gc-hooks ()
+ (setq ext:*gc-notify-before* #'lisp::default-gc-notify-before)
+ (setq ext:*gc-notify-after* #'lisp::default-gc-notify-after))
+
+(defvar *install-gc-hooks* t
+ "If non-nil install GC hooks")
+
+(defimplementation emacs-connected ()
+ (when *install-gc-hooks*
+ (install-gc-hooks)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;Trace implementations
+;;In CMUCL, we have:
+;; (trace <name>)
+;; (trace (method <name> <qualifier>? (<specializer>+)))
+;; (trace :methods t '<name>) ;;to trace all methods of the gf <name>
+;; <name> can be a normal name or a (setf name)
+
+(defun tracedp (spec)
+ (member spec (eval '(trace)) :test #'equal))
+
+(defun toggle-trace-aux (spec &rest options)
+ (cond ((tracedp spec)
+ (eval `(untrace ,spec))
+ (format nil "~S is now untraced." spec))
+ (t
+ (eval `(trace ,spec ,@options))
+ (format nil "~S is now traced." spec))))
+
+(defimplementation toggle-trace (spec)
+ (ecase (car spec)
+ ((setf)
+ (toggle-trace-aux spec))
+ ((:defgeneric)
+ (let ((name (second spec)))
+ (toggle-trace-aux name :methods name)))
+ ((:defmethod)
+ (cond ((fboundp `(method ,@(cdr spec)))
+ (toggle-trace-aux `(method ,(cdr spec))))
+ ;; Man, is this ugly
+ ((fboundp `(pcl::fast-method ,@(cdr spec)))
+ (toggle-trace-aux `(pcl::fast-method ,@(cdr spec))))
+ (t
+ (error 'undefined-function :name (cdr spec)))))
+ ((:call)
+ (destructuring-bind (caller callee) (cdr spec)
+ (toggle-trace-aux (process-fspec callee)
+ :wherein (list (process-fspec caller)))))
+ ;; doesn't work properly
+ ;; ((:labels :flet) (toggle-trace-aux (process-fspec spec)))
+ ))
+
+(defun process-fspec (fspec)
+ (cond ((consp fspec)
+ (ecase (first fspec)
+ ((:defun :defgeneric) (second fspec))
+ ((:defmethod)
+ `(method ,(second fspec) ,@(third fspec) ,(fourth fspec)))
+ ((:labels) `(labels ,(third fspec) ,(process-fspec (second fspec))))
+ ((:flet) `(flet ,(third fspec) ,(process-fspec (second fspec))))))
+ (t
+ fspec)))
+
+;;; Weak datastructures
+
+(defimplementation make-weak-key-hash-table (&rest args)
+ (apply #'make-hash-table :weak-p t args))
+
+
+;;; Save image
+
+(defimplementation save-image (filename &optional restart-function)
+ (multiple-value-bind (pid error) (unix:unix-fork)
+ (when (not pid) (error "fork: ~A" (unix:get-unix-error-msg error)))
+ (cond ((= pid 0)
+ (apply #'ext:save-lisp
+ filename
+ (if restart-function
+ `(:init-function ,restart-function))))
+ (t
+ (let ((status (waitpid pid)))
+ (destructuring-bind (&key exited? status &allow-other-keys) status
+ (assert (and exited? (equal status 0)) ()
+ "Invalid exit status: ~a" status)))))))
+
+(defun waitpid (pid)
+ (alien:with-alien ((status c-call:int))
+ (let ((code (alien:alien-funcall
+ (alien:extern-alien
+ waitpid (alien:function c-call:int c-call:int
+ (* c-call:int) c-call:int))
+ pid (alien:addr status) 0)))
+ (cond ((= code -1) (error "waitpid: ~A" (unix:get-unix-error-msg)))
+ (t (assert (= code pid))
+ (decode-wait-status status))))))
+
+(defun decode-wait-status (status)
+ (let ((output (with-output-to-string (s)
+ (call-program (list (process-status-program)
+ (format nil "~d" status))
+ :output s))))
+ (read-from-string output)))
+
+(defun call-program (args &key output)
+ (destructuring-bind (program &rest args) args
+ (let ((process (ext:run-program program args :output output)))
+ (when (not program) (error "fork failed"))
+ (unless (and (eq (ext:process-status process) :exited)
+ (= (ext:process-exit-code process) 0))
+ (error "Non-zero exit status")))))
+
+(defvar *process-status-program* nil)
+
+(defun process-status-program ()
+ (or *process-status-program*
+ (setq *process-status-program*
+ (compile-process-status-program))))
+
+(defun compile-process-status-program ()
+ (let ((infile (system::pick-temporary-file-name
+ "/tmp/process-status~d~c.c")))
+ (with-open-file (stream infile :direction :output :if-exists :supersede)
+ (format stream "
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <sys/wait.h>
+#include <assert.h>
+
+#define FLAG(value) (value ? \"t\" : \"nil\")
+
+int main (int argc, char** argv) {
+ assert (argc == 2);
+ {
+ char* endptr = NULL;
+ char* arg = argv[1];
+ long int status = strtol (arg, &endptr, 10);
+ assert (endptr != arg && *endptr == '\\0');
+ printf (\"(:exited? %s :status %d :signal? %s :signal %d :coredump? %s\"
+ \" :stopped? %s :stopsig %d)\\n\",
+ FLAG(WIFEXITED(status)), WEXITSTATUS(status),
+ FLAG(WIFSIGNALED(status)), WTERMSIG(status),
+ FLAG(WCOREDUMP(status)),
+ FLAG(WIFSTOPPED(status)), WSTOPSIG(status));
+ fflush (NULL);
+ return 0;
+ }
+}
+")
+ (finish-output stream))
+ (let* ((outfile (system::pick-temporary-file-name))
+ (args (list "cc" "-o" outfile infile)))
+ (warn "Running cc: ~{~a ~}~%" args)
+ (call-program args :output t)
+ (delete-file infile)
+ outfile)))
+
+;; FIXME: lisp:unicode-complete introduced in version 20d.
+#+#.(swank/backend:with-symbol 'unicode-complete 'lisp)
+(defun match-semi-standard (prefix matchp)
+ ;; Handle the CMUCL's short character names.
+ (loop for name in lisp::char-name-alist
+ when (funcall matchp prefix (car name))
+ collect (car name)))
+
+#+#.(swank/backend:with-symbol 'unicode-complete 'lisp)
+(defimplementation character-completion-set (prefix matchp)
+ (let ((names (lisp::unicode-complete prefix)))
+ ;; Match prefix against semistandard names. If there's a match,
+ ;; add it to our list of matches.
+ (let ((semi-standard (match-semi-standard prefix matchp)))
+ (when semi-standard
+ (setf names (append semi-standard names))))
+ (setf names (mapcar #'string-capitalize names))
+ (loop for n in names
+ when (funcall matchp prefix n)
+ collect n)))
diff --git a/vim/bundle/slimv/slime/swank/corman.lisp b/vim/bundle/slimv/slime/swank/corman.lisp
new file mode 100644
index 0000000..80d9ddd
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/corman.lisp
@@ -0,0 +1,583 @@
+;;;
+;;; swank-corman.lisp --- Corman Lisp specific code for SLIME.
+;;;
+;;; Copyright (C) 2004, 2005 Espen Wiborg (espenhw@grumblesmurf.org)
+;;;
+;;; License
+;;; =======
+;;; This software is provided 'as-is', without any express or implied
+;;; warranty. In no event will the author be held liable for any damages
+;;; arising from the use of this software.
+;;;
+;;; Permission is granted to anyone to use this software for any purpose,
+;;; including commercial applications, and to alter it and redistribute
+;;; it freely, subject to the following restrictions:
+;;;
+;;; 1. The origin of this software must not be misrepresented; you must
+;;; not claim that you wrote the original software. If you use this
+;;; software in a product, an acknowledgment in the product documentation
+;;; would be appreciated but is not required.
+;;;
+;;; 2. Altered source versions must be plainly marked as such, and must
+;;; not be misrepresented as being the original software.
+;;;
+;;; 3. This notice may not be removed or altered from any source
+;;; distribution.
+;;;
+;;; Notes
+;;; =====
+;;; You will need CCL 2.51, and you will *definitely* need to patch
+;;; CCL with the patches at
+;;; http://www.grumblesmurf.org/lisp/corman-patches, otherwise SLIME
+;;; will blow up in your face. You should also follow the
+;;; instructions on http://www.grumblesmurf.org/lisp/corman-slime.
+;;;
+;;; The only communication style currently supported is NIL.
+;;;
+;;; Starting CCL inside emacs (with M-x slime) seems to work for me
+;;; with Corman Lisp 2.51, but I have seen random failures with 2.5
+;;; (sometimes it works, other times it hangs on start or hangs when
+;;; initializing WinSock) - starting CCL externally and using M-x
+;;; slime-connect always works fine.
+;;;
+;;; Sometimes CCL gets confused and starts giving you random memory
+;;; access violation errors on startup; if this happens, try redumping
+;;; your image.
+;;;
+;;; What works
+;;; ==========
+;;; * Basic editing and evaluation
+;;; * Arglist display
+;;; * Compilation
+;;; * Loading files
+;;; * apropos/describe
+;;; * Debugger
+;;; * Inspector
+;;;
+;;; TODO
+;;; ====
+;;; * More debugger functionality (missing bits: restart-frame,
+;;; return-from-frame, disassemble-frame, activate-stepping,
+;;; toggle-trace)
+;;; * XREF
+;;; * Profiling
+;;; * More sophisticated communication styles than NIL
+;;;
+
+(in-package :swank/backend)
+
+;;; Pull in various needed bits
+(require :composite-streams)
+(require :sockets)
+(require :winbase)
+(require :lp)
+
+(use-package :gs)
+
+;; MOP stuff
+
+(defclass swank-mop:standard-slot-definition ()
+ ()
+ (:documentation
+ "Dummy class created so that swank.lisp will compile and load."))
+
+(defun named-by-gensym-p (c)
+ (null (symbol-package (class-name c))))
+
+(deftype swank-mop:eql-specializer ()
+ '(satisfies named-by-gensym-p))
+
+(defun swank-mop:eql-specializer-object (specializer)
+ (with-hash-table-iterator (next-entry cl::*clos-singleton-specializers*)
+ (loop (multiple-value-bind (more key value)
+ (next-entry)
+ (unless more (return nil))
+ (when (eq specializer value)
+ (return key))))))
+
+(defun swank-mop:class-finalized-p (class)
+ (declare (ignore class))
+ t)
+
+(defun swank-mop:class-prototype (class)
+ (make-instance class))
+
+(defun swank-mop:specializer-direct-methods (obj)
+ (declare (ignore obj))
+ nil)
+
+(defun swank-mop:generic-function-argument-precedence-order (gf)
+ (generic-function-lambda-list gf))
+
+(defun swank-mop:generic-function-method-combination (gf)
+ (declare (ignore gf))
+ :standard)
+
+(defun swank-mop:generic-function-declarations (gf)
+ (declare (ignore gf))
+ nil)
+
+(defun swank-mop:slot-definition-documentation (slot)
+ (declare (ignore slot))
+ (getf slot :documentation nil))
+
+(defun swank-mop:slot-definition-type (slot)
+ (declare (ignore slot))
+ t)
+
+(import-swank-mop-symbols :cl '(;; classes
+ :standard-slot-definition
+ :eql-specializer
+ :eql-specializer-object
+ ;; standard class readers
+ :class-default-initargs
+ :class-direct-default-initargs
+ :class-finalized-p
+ :class-prototype
+ :specializer-direct-methods
+ ;; gf readers
+ :generic-function-argument-precedence-order
+ :generic-function-declarations
+ :generic-function-method-combination
+ ;; method readers
+ ;; slot readers
+ :slot-definition-documentation
+ :slot-definition-type))
+
+;;;; swank implementations
+
+;;; Debugger
+
+(defvar *stack-trace* nil)
+(defvar *frame-trace* nil)
+
+(defstruct frame
+ name function address debug-info variables)
+
+(defimplementation call-with-debugging-environment (fn)
+ (let* ((real-stack-trace (cl::stack-trace))
+ (*stack-trace* (cdr (member 'cl:invoke-debugger real-stack-trace
+ :key #'car)))
+ (*frame-trace*
+ (let* ((db::*debug-level* (1+ db::*debug-level*))
+ (db::*debug-frame-pointer* (db::stash-ebp
+ (ct:create-foreign-ptr)))
+ (db::*debug-max-level* (length real-stack-trace))
+ (db::*debug-min-level* 1))
+ (cdr (member #'cl:invoke-debugger
+ (cons
+ (make-frame :function nil)
+ (loop for i from db::*debug-min-level*
+ upto db::*debug-max-level*
+ until (eq (db::get-frame-function i)
+ cl::*top-level*)
+ collect
+ (make-frame
+ :function (db::get-frame-function i)
+ :address (db::get-frame-address i))))
+ :key #'frame-function)))))
+ (funcall fn)))
+
+(defimplementation compute-backtrace (start end)
+ (loop for f in (subseq *stack-trace* start (min end (length *stack-trace*)))
+ collect f))
+
+(defimplementation print-frame (frame stream)
+ (format stream "~S" frame))
+
+(defun get-frame-debug-info (frame)
+ (or (frame-debug-info frame)
+ (setf (frame-debug-info frame)
+ (db::prepare-frame-debug-info (frame-function frame)
+ (frame-address frame)))))
+
+(defimplementation frame-locals (frame-number)
+ (let* ((frame (elt *frame-trace* frame-number))
+ (info (get-frame-debug-info frame)))
+ (let ((var-list
+ (loop for i from 4 below (length info) by 2
+ collect `(list :name ',(svref info i) :id 0
+ :value (db::debug-filter ,(svref info i))))))
+ (let ((vars (eval-in-frame `(list ,@var-list) frame-number)))
+ (setf (frame-variables frame) vars)))))
+
+(defimplementation eval-in-frame (form frame-number)
+ (let ((frame (elt *frame-trace* frame-number)))
+ (let ((cl::*compiler-environment* (get-frame-debug-info frame)))
+ (eval form))))
+
+(defimplementation frame-var-value (frame-number var)
+ (let ((vars (frame-variables (elt *frame-trace* frame-number))))
+ (when vars
+ (second (elt vars var)))))
+
+(defimplementation frame-source-location (frame-number)
+ (fspec-location (frame-function (elt *frame-trace* frame-number))))
+
+(defun break (&optional (format-control "Break") &rest format-arguments)
+ (with-simple-restart (continue "Return from BREAK.")
+ (let ();(*debugger-hook* nil))
+ (let ((condition
+ (make-condition 'simple-condition
+ :format-control format-control
+ :format-arguments format-arguments)))
+ ;;(format *debug-io* ";;; User break: ~A~%" condition)
+ (invoke-debugger condition))))
+ nil)
+
+;;; Socket communication
+
+(defimplementation create-socket (host port &key backlog)
+ (sockets:start-sockets)
+ (sockets:make-server-socket :host host :port port))
+
+(defimplementation local-port (socket)
+ (sockets:socket-port socket))
+
+(defimplementation close-socket (socket)
+ (close socket))
+
+(defimplementation accept-connection (socket
+ &key external-format buffering timeout)
+ (declare (ignore buffering timeout external-format))
+ (sockets:make-socket-stream (sockets:accept-socket socket)))
+
+;;; Misc
+
+(defimplementation preferred-communication-style ()
+ nil)
+
+(defimplementation getpid ()
+ ccl:*current-process-id*)
+
+(defimplementation lisp-implementation-type-name ()
+ "cormanlisp")
+
+(defimplementation quit-lisp ()
+ (sockets:stop-sockets)
+ (win32:exitprocess 0))
+
+(defimplementation set-default-directory (directory)
+ (setf (ccl:current-directory) directory)
+ (directory-namestring (setf *default-pathname-defaults*
+ (truename (merge-pathnames directory)))))
+
+(defimplementation default-directory ()
+ (directory-namestring (ccl:current-directory)))
+
+(defimplementation macroexpand-all (form &optional env)
+ (declare (ignore env))
+ (ccl:macroexpand-all form))
+
+;;; Documentation
+
+(defun fspec-location (fspec)
+ (when (symbolp fspec)
+ (setq fspec (symbol-function fspec)))
+ (let ((file (ccl::function-source-file fspec)))
+ (if file
+ (handler-case
+ (let ((truename (truename
+ (merge-pathnames file
+ ccl:*cormanlisp-directory*))))
+ (make-location (list :file (namestring truename))
+ (if (ccl::function-source-line fspec)
+ (list :line
+ (1+ (ccl::function-source-line fspec)))
+ (list :function-name
+ (princ-to-string
+ (function-name fspec))))))
+ (error (c) (list :error (princ-to-string c))))
+ (list :error (format nil "No source information available for ~S"
+ fspec)))))
+
+(defimplementation find-definitions (name)
+ (list (list name (fspec-location name))))
+
+(defimplementation arglist (name)
+ (handler-case
+ (cond ((and (symbolp name)
+ (macro-function name))
+ (ccl::macro-lambda-list (symbol-function name)))
+ (t
+ (when (symbolp name)
+ (setq name (symbol-function name)))
+ (if (eq (class-of name) cl::the-class-standard-gf)
+ (generic-function-lambda-list name)
+ (ccl:function-lambda-list name))))
+ (error () :not-available)))
+
+(defimplementation function-name (fn)
+ (handler-case (getf (cl::function-info-list fn) 'cl::function-name)
+ (error () nil)))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((doc (kind &optional (sym symbol))
+ (or (documentation sym kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (when (boundp symbol)
+ (doc 'variable)))
+ (maybe-push
+ :function (if (fboundp symbol)
+ (doc 'function)))
+ (maybe-push
+ :class (if (find-class symbol nil)
+ (doc 'class)))
+ result)))
+
+(defimplementation describe-definition (symbol namespace)
+ (ecase namespace
+ (:variable
+ (describe symbol))
+ ((:function :generic-function)
+ (describe (symbol-function symbol)))
+ (:class
+ (describe (find-class symbol)))))
+
+;;; Compiler
+
+(defvar *buffer-name* nil)
+(defvar *buffer-position*)
+(defvar *buffer-string*)
+(defvar *compile-filename* nil)
+
+;; FIXME
+(defimplementation call-with-compilation-hooks (FN)
+ (handler-bind ((error (lambda (c)
+ (signal 'compiler-condition
+ :original-condition c
+ :severity :warning
+ :message (format nil "~A" c)
+ :location
+ (cond (*buffer-name*
+ (make-location
+ (list :buffer *buffer-name*)
+ (list :offset *buffer-position* 0)))
+ (*compile-filename*
+ (make-location
+ (list :file *compile-filename*)
+ (list :position 1)))
+ (t
+ (list :error "No location")))))))
+ (funcall fn)))
+
+(defimplementation swank-compile-file (input-file output-file
+ load-p external-format
+ &key policy)
+ (declare (ignore external-format policy))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* nil)
+ (*compile-filename* input-file))
+ (multiple-value-bind (output-file warnings? failure?)
+ (compile-file input-file :output-file output-file)
+ (values output-file warnings?
+ (or failure? (and load-p (load output-file))))))))
+
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore filename policy))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer)
+ (*buffer-position* position)
+ (*buffer-string* string))
+ (funcall (compile nil (read-from-string
+ (format nil "(~S () ~A)" 'lambda string))))
+ t)))
+
+;;;; Inspecting
+
+;; Hack to make swank.lisp load, at least
+(defclass file-stream ())
+
+(defun comma-separated (list &optional (callback (lambda (v)
+ `(:value ,v))))
+ (butlast (loop for e in list
+ collect (funcall callback e)
+ collect ", ")))
+
+(defmethod emacs-inspect ((class standard-class))
+ `("Name: "
+ (:value ,(class-name class))
+ (:newline)
+ "Super classes: "
+ ,@(comma-separated (swank-mop:class-direct-superclasses class))
+ (:newline)
+ "Direct Slots: "
+ ,@(comma-separated
+ (swank-mop:class-direct-slots class)
+ (lambda (slot)
+ `(:value ,slot
+ ,(princ-to-string
+ (swank-mop:slot-definition-name slot)))))
+ (:newline)
+ "Effective Slots: "
+ ,@(if (swank-mop:class-finalized-p class)
+ (comma-separated
+ (swank-mop:class-slots class)
+ (lambda (slot)
+ `(:value ,slot ,(princ-to-string
+ (swank-mop:slot-definition-name slot)))))
+ '("#<N/A (class not finalized)>"))
+ (:newline)
+ ,@(when (documentation class t)
+ `("Documentation:" (:newline) ,(documentation class t) (:newline)))
+ "Sub classes: "
+ ,@(comma-separated (swank-mop:class-direct-subclasses class)
+ (lambda (sub)
+ `(:value ,sub ,(princ-to-string (class-name sub)))))
+ (:newline)
+ "Precedence List: "
+ ,@(if (swank-mop:class-finalized-p class)
+ (comma-separated
+ (swank-mop:class-precedence-list class)
+ (lambda (class)
+ `(:value ,class
+ ,(princ-to-string (class-name class)))))
+ '("#<N/A (class not finalized)>"))
+ (:newline)))
+
+(defmethod emacs-inspect ((slot cons))
+ ;; Inspects slot definitions
+ (if (eq (car slot) :name)
+ `("Name: " (:value ,(swank-mop:slot-definition-name slot))
+ (:newline)
+ ,@(when (swank-mop:slot-definition-documentation slot)
+ `("Documentation:"
+ (:newline)
+ (:value
+ ,(swank-mop:slot-definition-documentation slot))
+ (:newline)))
+ "Init args: " (:value
+ ,(swank-mop:slot-definition-initargs slot))
+ (:newline)
+ "Init form: "
+ ,(if (swank-mop:slot-definition-initfunction slot)
+ `(:value ,(swank-mop:slot-definition-initform slot))
+ "#<unspecified>") (:newline)
+ "Init function: "
+ (:value ,(swank-mop:slot-definition-initfunction slot))
+ (:newline))
+ (call-next-method)))
+
+(defmethod emacs-inspect ((pathname pathnames::pathname-internal))
+ (list* (if (wild-pathname-p pathname)
+ "A wild pathname."
+ "A pathname.")
+ '(:newline)
+ (append (label-value-line*
+ ("Namestring" (namestring pathname))
+ ("Host" (pathname-host pathname))
+ ("Device" (pathname-device pathname))
+ ("Directory" (pathname-directory pathname))
+ ("Name" (pathname-name pathname))
+ ("Type" (pathname-type pathname))
+ ("Version" (pathname-version pathname)))
+ (unless (or (wild-pathname-p pathname)
+ (not (probe-file pathname)))
+ (label-value-line "Truename" (truename pathname))))))
+
+(defmethod emacs-inspect ((o t))
+ (cond ((cl::structurep o) (inspect-structure o))
+ (t (call-next-method))))
+
+(defun inspect-structure (o)
+ (let* ((template (cl::uref o 1))
+ (num-slots (cl::struct-template-num-slots template)))
+ (cond ((symbolp template)
+ (loop for i below num-slots
+ append (label-value-line i (cl::uref o (+ 2 i)))))
+ (t
+ (loop for i below num-slots
+ append (label-value-line (elt template (+ 6 (* i 5)))
+ (cl::uref o (+ 2 i))))))))
+
+
+;;; Threads
+
+(require 'threads)
+
+(defstruct (mailbox (:conc-name mailbox.))
+ thread
+ (lock (make-instance 'threads:critical-section))
+ (queue '() :type list))
+
+(defvar *mailbox-lock* (make-instance 'threads:critical-section))
+(defvar *mailboxes* (list))
+
+(defmacro with-lock (lock &body body)
+ `(threads:with-synchronization (threads:cs ,lock)
+ ,@body))
+
+(defimplementation spawn (fun &key name)
+ (declare (ignore name))
+ (th:create-thread
+ (lambda ()
+ (handler-bind ((serious-condition #'invoke-debugger))
+ (unwind-protect (funcall fun)
+ (with-lock *mailbox-lock*
+ (setq *mailboxes* (remove cormanlisp:*current-thread-id*
+ *mailboxes* :key #'mailbox.thread))))))))
+
+(defimplementation thread-id (thread)
+ thread)
+
+(defimplementation find-thread (thread)
+ (if (thread-alive-p thread)
+ thread))
+
+(defimplementation thread-alive-p (thread)
+ (if (threads:thread-handle thread) t nil))
+
+(defimplementation current-thread ()
+ cormanlisp:*current-thread-id*)
+
+;; XXX implement it
+(defimplementation all-threads ()
+ '())
+
+;; XXX something here is broken
+(defimplementation kill-thread (thread)
+ (threads:terminate-thread thread 'killed))
+
+(defun mailbox (thread)
+ (with-lock *mailbox-lock*
+ (or (find thread *mailboxes* :key #'mailbox.thread)
+ (let ((mb (make-mailbox :thread thread)))
+ (push mb *mailboxes*)
+ mb))))
+
+(defimplementation send (thread message)
+ (let ((mbox (mailbox thread)))
+ (with-lock (mailbox.lock mbox)
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message))))))
+
+(defimplementation receive ()
+ (let ((mbox (mailbox cormanlisp:*current-thread-id*)))
+ (loop
+ (with-lock (mailbox.lock mbox)
+ (when (mailbox.queue mbox)
+ (return (pop (mailbox.queue mbox)))))
+ (sleep 0.1))))
+
+
+;;; This is probably not good, but it WFM
+(in-package :common-lisp)
+
+(defvar *old-documentation* #'documentation)
+(defun documentation (thing &optional (type 'function))
+ (if (symbolp thing)
+ (funcall *old-documentation* thing type)
+ (values)))
+
+(defmethod print-object ((restart restart) stream)
+ (if (or *print-escape*
+ *print-readably*)
+ (print-unreadable-object (restart stream :type t :identity t)
+ (princ (restart-name restart) stream))
+ (when (functionp (restart-report-function restart))
+ (funcall (restart-report-function restart) stream))))
diff --git a/vim/bundle/slimv/slime/swank/ecl.lisp b/vim/bundle/slimv/slime/swank/ecl.lisp
new file mode 100644
index 0000000..2d19c64
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/ecl.lisp
@@ -0,0 +1,845 @@
+;;;; -*- indent-tabs-mode: nil -*-
+;;;
+;;; swank-ecl.lisp --- SLIME backend for ECL.
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+;;; Administrivia
+
+(defpackage swank/ecl
+ (:use cl swank/backend))
+
+(in-package swank/ecl)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun ecl-version ()
+ (let ((version (find-symbol "+ECL-VERSION-NUMBER+" :EXT)))
+ (if version
+ (symbol-value version)
+ 0)))
+ (when (< (ecl-version) 100301)
+ (error "~&IMPORTANT:~% ~
+ The version of ECL you're using (~A) is too old.~% ~
+ Please upgrade to at least 10.3.1.~% ~
+ Sorry for the inconvenience.~%~%"
+ (lisp-implementation-version))))
+
+;; Hard dependencies.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (require 'sockets))
+
+;; Soft dependencies.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (when (probe-file "sys:profile.fas")
+ (require :profile)
+ (pushnew :profile *features*))
+ (when (probe-file "sys:serve-event.fas")
+ (require :serve-event)
+ (pushnew :serve-event *features*)))
+
+(declaim (optimize (debug 3)))
+
+;;; Swank-mop
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (import-swank-mop-symbols
+ :clos
+ (and (< (ecl-version) 121201)
+ `(:eql-specializer
+ :eql-specializer-object
+ :generic-function-declarations
+ :specializer-direct-methods
+ ,@(unless (fboundp 'clos:compute-applicable-methods-using-classes)
+ '(:compute-applicable-methods-using-classes))))))
+
+(defimplementation gray-package-name ()
+ "GRAY")
+
+
+;;;; TCP Server
+
+(defimplementation preferred-communication-style ()
+ ;; While ECL does provide threads, some parts of it are not
+ ;; thread-safe (2010-02-23), including the compiler and CLOS.
+ nil
+ ;; ECL on Windows does not provide condition-variables
+ ;; (or #+(and threads (not windows)) :spawn
+ ;; nil)
+ )
+
+(defun resolve-hostname (name)
+ (car (sb-bsd-sockets:host-ent-addresses
+ (sb-bsd-sockets:get-host-by-name name))))
+
+(defimplementation create-socket (host port &key backlog)
+ (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+ :type :stream
+ :protocol :tcp)))
+ (setf (sb-bsd-sockets:sockopt-reuse-address socket) t)
+ (sb-bsd-sockets:socket-bind socket (resolve-hostname host) port)
+ (sb-bsd-sockets:socket-listen socket (or backlog 5))
+ socket))
+
+(defimplementation local-port (socket)
+ (nth-value 1 (sb-bsd-sockets:socket-name socket)))
+
+(defimplementation close-socket (socket)
+ (sb-bsd-sockets:socket-close socket))
+
+(defimplementation accept-connection (socket
+ &key external-format
+ buffering timeout)
+ (declare (ignore timeout))
+ (sb-bsd-sockets:socket-make-stream (accept socket)
+ :output t
+ :input t
+ :buffering (ecase buffering
+ ((t) :full)
+ ((nil) :none)
+ (:line :line))
+ :element-type (if external-format
+ 'character
+ '(unsigned-byte 8))
+ :external-format external-format))
+(defun accept (socket)
+ "Like socket-accept, but retry on EAGAIN."
+ (loop (handler-case
+ (return (sb-bsd-sockets:socket-accept socket))
+ (sb-bsd-sockets:interrupted-error ()))))
+
+(defimplementation socket-fd (socket)
+ (etypecase socket
+ (fixnum socket)
+ (two-way-stream (socket-fd (two-way-stream-input-stream socket)))
+ (sb-bsd-sockets:socket (sb-bsd-sockets:socket-file-descriptor socket))
+ (file-stream (si:file-stream-fd socket))))
+
+(defvar *external-format-to-coding-system*
+ '((:latin-1
+ "latin-1" "latin-1-unix" "iso-latin-1-unix"
+ "iso-8859-1" "iso-8859-1-unix")
+ (:utf-8 "utf-8" "utf-8-unix")))
+
+(defun external-format (coding-system)
+ (or (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*))
+ (find coding-system (ext:all-encodings) :test #'string-equal)))
+
+(defimplementation find-external-format (coding-system)
+ #+unicode (external-format coding-system)
+ ;; Without unicode support, ECL uses the one-byte encoding of the
+ ;; underlying OS, and will barf on anything except :DEFAULT. We
+ ;; return NIL here for known multibyte encodings, so
+ ;; SWANK:CREATE-SERVER will barf.
+ #-unicode (let ((xf (external-format coding-system)))
+ (if (member xf '(:utf-8))
+ nil
+ :default)))
+
+
+;;;; Unix Integration
+
+;;; If ECL is built with thread support, it'll spawn a helper thread
+;;; executing the SIGINT handler. We do not want to BREAK into that
+;;; helper but into the main thread, though. This is coupled with the
+;;; current choice of NIL as communication-style in so far as ECL's
+;;; main-thread is also the Slime's REPL thread.
+
+(defimplementation call-with-user-break-handler (real-handler function)
+ (let ((old-handler #'si:terminal-interrupt))
+ (setf (symbol-function 'si:terminal-interrupt)
+ (make-interrupt-handler real-handler))
+ (unwind-protect (funcall function)
+ (setf (symbol-function 'si:terminal-interrupt) old-handler))))
+
+#+threads
+(defun make-interrupt-handler (real-handler)
+ (let ((main-thread (find 'si:top-level (mp:all-processes)
+ :key #'mp:process-name)))
+ #'(lambda (&rest args)
+ (declare (ignore args))
+ (mp:interrupt-process main-thread real-handler))))
+
+#-threads
+(defun make-interrupt-handler (real-handler)
+ #'(lambda (&rest args)
+ (declare (ignore args))
+ (funcall real-handler)))
+
+
+(defimplementation getpid ()
+ (si:getpid))
+
+(defimplementation set-default-directory (directory)
+ (ext:chdir (namestring directory)) ; adapts *DEFAULT-PATHNAME-DEFAULTS*.
+ (default-directory))
+
+(defimplementation default-directory ()
+ (namestring (ext:getcwd)))
+
+(defimplementation quit-lisp ()
+ (ext:quit))
+
+
+
+;;; Instead of busy waiting with communication-style NIL, use select()
+;;; on the sockets' streams.
+#+serve-event
+(progn
+ (defun poll-streams (streams timeout)
+ (let* ((serve-event::*descriptor-handlers*
+ (copy-list serve-event::*descriptor-handlers*))
+ (active-fds '())
+ (fd-stream-alist
+ (loop for s in streams
+ for fd = (socket-fd s)
+ collect (cons fd s)
+ do (serve-event:add-fd-handler fd :input
+ #'(lambda (fd)
+ (push fd active-fds))))))
+ (serve-event:serve-event timeout)
+ (loop for fd in active-fds collect (cdr (assoc fd fd-stream-alist)))))
+
+ (defimplementation wait-for-input (streams &optional timeout)
+ (assert (member timeout '(nil t)))
+ (loop
+ (cond ((check-slime-interrupts) (return :interrupt))
+ (timeout (return (poll-streams streams 0)))
+ (t
+ (when-let (ready (poll-streams streams 0.2))
+ (return ready))))))
+
+) ; #+serve-event (progn ...
+
+#-serve-event
+(defimplementation wait-for-input (streams &optional timeout)
+ (assert (member timeout '(nil t)))
+ (loop
+ (cond ((check-slime-interrupts) (return :interrupt))
+ (timeout (return (remove-if-not #'listen streams)))
+ (t
+ (let ((ready (remove-if-not #'listen streams)))
+ (if ready (return ready))
+ (sleep 0.1))))))
+
+
+;;;; Compilation
+
+(defvar *buffer-name* nil)
+(defvar *buffer-start-position*)
+
+(defun signal-compiler-condition (&rest args)
+ (apply #'signal 'compiler-condition args))
+
+#-ecl-bytecmp
+(defun handle-compiler-message (condition)
+ ;; ECL emits lots of noise in compiler-notes, like "Invoking
+ ;; external command".
+ (unless (typep condition 'c::compiler-note)
+ (signal-compiler-condition
+ :original-condition condition
+ :message (princ-to-string condition)
+ :severity (etypecase condition
+ (c:compiler-fatal-error :error)
+ (c:compiler-error :error)
+ (error :error)
+ (style-warning :style-warning)
+ (warning :warning))
+ :location (condition-location condition))))
+
+#-ecl-bytecmp
+(defun condition-location (condition)
+ (let ((file (c:compiler-message-file condition))
+ (position (c:compiler-message-file-position condition)))
+ (if (and position (not (minusp position)))
+ (if *buffer-name*
+ (make-buffer-location *buffer-name*
+ *buffer-start-position*
+ position)
+ (make-file-location file position))
+ (make-error-location "No location found."))))
+
+(defimplementation call-with-compilation-hooks (function)
+ #+ecl-bytecmp
+ (funcall function)
+ #-ecl-bytecmp
+ (handler-bind ((c:compiler-message #'handle-compiler-message))
+ (funcall function)))
+
+(defimplementation swank-compile-file (input-file output-file
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
+ (with-compilation-hooks ()
+ (compile-file input-file :output-file output-file
+ :load load-p
+ :external-format external-format)))
+
+(defvar *tmpfile-map* (make-hash-table :test #'equal))
+
+(defun note-buffer-tmpfile (tmp-file buffer-name)
+ ;; EXT:COMPILED-FUNCTION-FILE below will return a namestring.
+ (let ((tmp-namestring (namestring (truename tmp-file))))
+ (setf (gethash tmp-namestring *tmpfile-map*) buffer-name)
+ tmp-namestring))
+
+(defun tmpfile-to-buffer (tmp-file)
+ (gethash tmp-file *tmpfile-map*))
+
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore policy))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer) ; for compilation hooks
+ (*buffer-start-position* position))
+ (let ((tmp-file (si:mkstemp "TMP:ecl-swank-tmpfile-"))
+ (fasl-file)
+ (warnings-p)
+ (failure-p))
+ (unwind-protect
+ (with-open-file (tmp-stream tmp-file :direction :output
+ :if-exists :supersede)
+ (write-string string tmp-stream)
+ (finish-output tmp-stream)
+ (multiple-value-setq (fasl-file warnings-p failure-p)
+ (compile-file tmp-file
+ :load t
+ :source-truename (or filename
+ (note-buffer-tmpfile tmp-file buffer))
+ :source-offset (1- position))))
+ (when (probe-file tmp-file)
+ (delete-file tmp-file))
+ (when fasl-file
+ (delete-file fasl-file)))
+ (not failure-p)))))
+
+;;;; Documentation
+
+(defimplementation arglist (name)
+ (multiple-value-bind (arglist foundp)
+ (ext:function-lambda-list name)
+ (if foundp arglist :not-available)))
+
+(defimplementation function-name (f)
+ (typecase f
+ (generic-function (clos:generic-function-name f))
+ (function (si:compiled-function-name f))))
+
+;; FIXME
+;; (defimplementation macroexpand-all (form &optional env)
+;; (declare (ignore env))
+
+(defimplementation collect-macro-forms (form &optional env)
+ ;; Currently detects only normal macros, not compiler macros.
+ (declare (ignore env))
+ (with-collected-macro-forms (macro-forms)
+ (handler-bind ((warning #'muffle-warning))
+ (ignore-errors
+ (compile nil `(lambda () ,form))))
+ (values macro-forms nil)))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((frob (type boundp)
+ (when (funcall boundp symbol)
+ (let ((doc (describe-definition symbol type)))
+ (setf result (list* type doc result))))))
+ (frob :VARIABLE #'boundp)
+ (frob :FUNCTION #'fboundp)
+ (frob :CLASS (lambda (x) (find-class x nil))))
+ result))
+
+(defimplementation describe-definition (name type)
+ (case type
+ (:variable (documentation name 'variable))
+ (:function (documentation name 'function))
+ (:class (documentation name 'class))
+ (t nil)))
+
+(defimplementation type-specifier-p (symbol)
+ (or (subtypep nil symbol)
+ (not (eq (type-specifier-arglist symbol) :not-available))))
+
+
+;;; Debugging
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (import
+ '(si::*break-env*
+ si::*ihs-top*
+ si::*ihs-current*
+ si::*ihs-base*
+ si::*frs-base*
+ si::*frs-top*
+ si::*tpl-commands*
+ si::*tpl-level*
+ si::frs-top
+ si::ihs-top
+ si::ihs-fun
+ si::ihs-env
+ si::sch-frs-base
+ si::set-break-env
+ si::set-current-ihs
+ si::tpl-commands)))
+
+(defun make-invoke-debugger-hook (hook)
+ (when hook
+ #'(lambda (condition old-hook)
+ ;; Regard *debugger-hook* if set by user.
+ (if *debugger-hook*
+ nil ; decline, *DEBUGGER-HOOK* will be tried next.
+ (funcall hook condition old-hook)))))
+
+(defimplementation install-debugger-globally (function)
+ (setq *debugger-hook* function)
+ (setq ext:*invoke-debugger-hook* (make-invoke-debugger-hook function)))
+
+(defimplementation call-with-debugger-hook (hook fun)
+ (let ((*debugger-hook* hook)
+ (ext:*invoke-debugger-hook* (make-invoke-debugger-hook hook)))
+ (funcall fun)))
+
+(defvar *backtrace* '())
+
+;;; Commented out; it's not clear this is a good way of doing it. In
+;;; particular because it makes errors stemming from this file harder
+;;; to debug, and given the "young" age of ECL's swank backend, that's
+;;; a bad idea.
+
+;; (defun in-swank-package-p (x)
+;; (and
+;; (symbolp x)
+;; (member (symbol-package x)
+;; (list #.(find-package :swank)
+;; #.(find-package :swank/backend)
+;; #.(ignore-errors (find-package :swank-mop))
+;; #.(ignore-errors (find-package :swank-loader))))
+;; t))
+
+;; (defun is-swank-source-p (name)
+;; (setf name (pathname name))
+;; (pathname-match-p
+;; name
+;; (make-pathname :defaults swank-loader::*source-directory*
+;; :name (pathname-name name)
+;; :type (pathname-type name)
+;; :version (pathname-version name))))
+
+;; (defun is-ignorable-fun-p (x)
+;; (or
+;; (in-swank-package-p (frame-name x))
+;; (multiple-value-bind (file position)
+;; (ignore-errors (si::bc-file (car x)))
+;; (declare (ignore position))
+;; (if file (is-swank-source-p file)))))
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (declare (type function debugger-loop-fn))
+ (let* ((*ihs-top* (ihs-top))
+ (*ihs-current* *ihs-top*)
+ (*frs-base* (or (sch-frs-base *frs-top* *ihs-base*) (1+ (frs-top))))
+ (*frs-top* (frs-top))
+ (*tpl-level* (1+ *tpl-level*))
+ (*backtrace* (loop for ihs from 0 below *ihs-top*
+ collect (list (si::ihs-fun ihs)
+ (si::ihs-env ihs)
+ nil))))
+ (declare (special *ihs-current*))
+ (loop for f from *frs-base* until *frs-top*
+ do (let ((i (- (si::frs-ihs f) *ihs-base* 1)))
+ (when (plusp i)
+ (let* ((x (elt *backtrace* i))
+ (name (si::frs-tag f)))
+ (unless (si::fixnump name)
+ (push name (third x)))))))
+ (setf *backtrace* (nreverse *backtrace*))
+ (set-break-env)
+ (set-current-ihs)
+ (let ((*ihs-base* *ihs-top*))
+ (funcall debugger-loop-fn))))
+
+(defimplementation compute-backtrace (start end)
+ (subseq *backtrace* start
+ (and (numberp end)
+ (min end (length *backtrace*)))))
+
+(defun frame-name (frame)
+ (let ((x (first frame)))
+ (if (symbolp x)
+ x
+ (function-name x))))
+
+(defun function-position (fun)
+ (multiple-value-bind (file position)
+ (si::bc-file fun)
+ (when file
+ (make-file-location file position))))
+
+(defun frame-function (frame)
+ (let* ((x (first frame))
+ fun position)
+ (etypecase x
+ (symbol (and (fboundp x)
+ (setf fun (fdefinition x)
+ position (function-position fun))))
+ (function (setf fun x position (function-position x))))
+ (values fun position)))
+
+(defun frame-decode-env (frame)
+ (let ((functions '())
+ (blocks '())
+ (variables '()))
+ (setf frame (si::decode-ihs-env (second frame)))
+ (dolist (record (remove-if-not #'consp frame))
+ (let* ((record0 (car record))
+ (record1 (cdr record)))
+ (cond ((or (symbolp record0) (stringp record0))
+ (setq variables (acons record0 record1 variables)))
+ ((not (si::fixnump record0))
+ (push record1 functions))
+ ((symbolp record1)
+ (push record1 blocks))
+ (t
+ ))))
+ (values functions blocks variables)))
+
+(defimplementation print-frame (frame stream)
+ (format stream "~A" (first frame)))
+
+(defimplementation frame-source-location (frame-number)
+ (nth-value 1 (frame-function (elt *backtrace* frame-number))))
+
+(defimplementation frame-catch-tags (frame-number)
+ (third (elt *backtrace* frame-number)))
+
+(defimplementation frame-locals (frame-number)
+ (loop for (name . value) in (nth-value 2 (frame-decode-env
+ (elt *backtrace* frame-number)))
+ collect (list :name name :id 0 :value value)))
+
+(defimplementation frame-var-value (frame-number var-number)
+ (destructuring-bind (name . value)
+ (elt
+ (nth-value 2 (frame-decode-env (elt *backtrace* frame-number)))
+ var-number)
+ (declare (ignore name))
+ value))
+
+(defimplementation disassemble-frame (frame-number)
+ (let ((fun (frame-function (elt *backtrace* frame-number))))
+ (disassemble fun)))
+
+(defimplementation eval-in-frame (form frame-number)
+ (let ((env (second (elt *backtrace* frame-number))))
+ (si:eval-with-env form env)))
+
+(defimplementation gdb-initial-commands ()
+ ;; These signals are used by the GC.
+ #+linux '("handle SIGPWR noprint nostop"
+ "handle SIGXCPU noprint nostop"))
+
+(defimplementation command-line-args ()
+ (loop for n from 0 below (si:argc) collect (si:argv n)))
+
+
+;;;; Inspector
+
+;;; FIXME: Would be nice if it was possible to inspect objects
+;;; implemented in C.
+
+
+;;;; Definitions
+
+(defvar +TAGS+ (namestring
+ (merge-pathnames "TAGS" (translate-logical-pathname "SYS:"))))
+
+(defun make-file-location (file file-position)
+ ;; File positions in CL start at 0, but Emacs' buffer positions
+ ;; start at 1. We specify (:ALIGN T) because the positions comming
+ ;; from ECL point at right after the toplevel form appearing before
+ ;; the actual target toplevel form; (:ALIGN T) will DTRT in that case.
+ (make-location `(:file ,(namestring (translate-logical-pathname file)))
+ `(:position ,(1+ file-position))
+ `(:align t)))
+
+(defun make-buffer-location (buffer-name start-position &optional (offset 0))
+ (make-location `(:buffer ,buffer-name)
+ `(:offset ,start-position ,offset)
+ `(:align t)))
+
+(defun make-TAGS-location (&rest tags)
+ (make-location `(:etags-file ,+TAGS+)
+ `(:tag ,@tags)))
+
+(defimplementation find-definitions (name)
+ (let ((annotations (ext:get-annotation name 'si::location :all)))
+ (cond (annotations
+ (loop for annotation in annotations
+ collect (destructuring-bind (dspec file . pos) annotation
+ `(,dspec ,(make-file-location file pos)))))
+ (t
+ (mapcan #'(lambda (type) (find-definitions-by-type name type))
+ (classify-definition-name name))))))
+
+(defun classify-definition-name (name)
+ (let ((types '()))
+ (when (fboundp name)
+ (cond ((special-operator-p name)
+ (push :special-operator types))
+ ((macro-function name)
+ (push :macro types))
+ ((typep (fdefinition name) 'generic-function)
+ (push :generic-function types))
+ ((si:mangle-name name t)
+ (push :c-function types))
+ (t
+ (push :lisp-function types))))
+ (when (boundp name)
+ (cond ((constantp name)
+ (push :constant types))
+ (t
+ (push :global-variable types))))
+ types))
+
+(defun find-definitions-by-type (name type)
+ (ecase type
+ (:lisp-function
+ (when-let (loc (source-location (fdefinition name)))
+ (list `((defun ,name) ,loc))))
+ (:c-function
+ (when-let (loc (source-location (fdefinition name)))
+ (list `((c-source ,name) ,loc))))
+ (:generic-function
+ (loop for method in (clos:generic-function-methods (fdefinition name))
+ for specs = (clos:method-specializers method)
+ for loc = (source-location method)
+ when loc
+ collect `((defmethod ,name ,specs) ,loc)))
+ (:macro
+ (when-let (loc (source-location (macro-function name)))
+ (list `((defmacro ,name) ,loc))))
+ (:constant
+ (when-let (loc (source-location name))
+ (list `((defconstant ,name) ,loc))))
+ (:global-variable
+ (when-let (loc (source-location name))
+ (list `((defvar ,name) ,loc))))
+ (:special-operator)))
+
+;;; FIXME: There ought to be a better way.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun c-function-name-p (name)
+ (and (symbolp name) (si:mangle-name name t) t))
+ (defun c-function-p (object)
+ (and (functionp object)
+ (let ((fn-name (function-name object)))
+ (and fn-name (c-function-name-p fn-name))))))
+
+(deftype c-function ()
+ `(satisfies c-function-p))
+
+(defun assert-source-directory ()
+ (unless (probe-file #P"SRC:")
+ (error "ECL's source directory ~A does not exist. ~
+ You can specify a different location via the environment ~
+ variable `ECLSRCDIR'."
+ (namestring (translate-logical-pathname #P"SYS:")))))
+
+(defun assert-TAGS-file ()
+ (unless (probe-file +TAGS+)
+ (error "No TAGS file ~A found. It should have been installed with ECL."
+ +TAGS+)))
+
+(defun package-names (package)
+ (cons (package-name package) (package-nicknames package)))
+
+(defun source-location (object)
+ (converting-errors-to-error-location
+ (typecase object
+ (c-function
+ (assert-source-directory)
+ (assert-TAGS-file)
+ (let ((lisp-name (function-name object)))
+ (assert lisp-name)
+ (multiple-value-bind (flag c-name) (si:mangle-name lisp-name t)
+ (assert flag)
+ ;; In ECL's code base sometimes the mangled name is used
+ ;; directly, sometimes ECL's DPP magic of @SI::SYMBOL or
+ ;; @EXT::SYMBOL is used. We cannot predict here, so we just
+ ;; provide several candidates.
+ (apply #'make-TAGS-location
+ c-name
+ (loop with s = (symbol-name lisp-name)
+ for p in (package-names (symbol-package lisp-name))
+ collect (format nil "~A::~A" p s)
+ collect (format nil "~(~A::~A~)" p s))))))
+ (function
+ (multiple-value-bind (file pos) (ext:compiled-function-file object)
+ (cond ((not file)
+ (return-from source-location nil))
+ ((tmpfile-to-buffer file)
+ (make-buffer-location (tmpfile-to-buffer file) pos))
+ (t
+ (assert (probe-file file))
+ (assert (not (minusp pos)))
+ (make-file-location file pos)))))
+ (method
+ ;; FIXME: This will always return NIL at the moment; ECL does not
+ ;; store debug information for methods yet.
+ (source-location (clos:method-function object)))
+ ((member nil t)
+ (multiple-value-bind (flag c-name) (si:mangle-name object)
+ (assert flag)
+ (make-TAGS-location c-name))))))
+
+(defimplementation find-source-location (object)
+ (or (source-location object)
+ (make-error-location "Source definition of ~S not found." object)))
+
+
+;;;; Profiling
+
+#+profile
+(progn
+
+(defimplementation profile (fname)
+ (when fname (eval `(profile:profile ,fname))))
+
+(defimplementation unprofile (fname)
+ (when fname (eval `(profile:unprofile ,fname))))
+
+(defimplementation unprofile-all ()
+ (profile:unprofile-all)
+ "All functions unprofiled.")
+
+(defimplementation profile-report ()
+ (profile:report))
+
+(defimplementation profile-reset ()
+ (profile:reset)
+ "Reset profiling counters.")
+
+(defimplementation profiled-functions ()
+ (profile:profile))
+
+(defimplementation profile-package (package callers methods)
+ (declare (ignore callers methods))
+ (eval `(profile:profile ,(package-name (find-package package)))))
+) ; #+profile (progn ...
+
+
+;;;; Threads
+
+#+threads
+(progn
+ (defvar *thread-id-counter* 0)
+
+ (defparameter *thread-id-map* (make-hash-table))
+
+ (defvar *thread-id-map-lock*
+ (mp:make-lock :name "thread id map lock"))
+
+ (defimplementation spawn (fn &key name)
+ (mp:process-run-function name fn))
+
+ (defimplementation thread-id (target-thread)
+ (block thread-id
+ (mp:with-lock (*thread-id-map-lock*)
+ ;; Does TARGET-THREAD have an id already?
+ (maphash (lambda (id thread-pointer)
+ (let ((thread (si:weak-pointer-value thread-pointer)))
+ (cond ((not thread)
+ (remhash id *thread-id-map*))
+ ((eq thread target-thread)
+ (return-from thread-id id)))))
+ *thread-id-map*)
+ ;; TARGET-THREAD not found in *THREAD-ID-MAP*
+ (let ((id (incf *thread-id-counter*))
+ (thread-pointer (si:make-weak-pointer target-thread)))
+ (setf (gethash id *thread-id-map*) thread-pointer)
+ id))))
+
+ (defimplementation find-thread (id)
+ (mp:with-lock (*thread-id-map-lock*)
+ (let* ((thread-ptr (gethash id *thread-id-map*))
+ (thread (and thread-ptr (si:weak-pointer-value thread-ptr))))
+ (unless thread
+ (remhash id *thread-id-map*))
+ thread)))
+
+ (defimplementation thread-name (thread)
+ (mp:process-name thread))
+
+ (defimplementation thread-status (thread)
+ (if (mp:process-active-p thread)
+ "RUNNING"
+ "STOPPED"))
+
+ (defimplementation make-lock (&key name)
+ (mp:make-lock :name name :recursive t))
+
+ (defimplementation call-with-lock-held (lock function)
+ (declare (type function function))
+ (mp:with-lock (lock) (funcall function)))
+
+ (defimplementation current-thread ()
+ mp:*current-process*)
+
+ (defimplementation all-threads ()
+ (mp:all-processes))
+
+ (defimplementation interrupt-thread (thread fn)
+ (mp:interrupt-process thread fn))
+
+ (defimplementation kill-thread (thread)
+ (mp:process-kill thread))
+
+ (defimplementation thread-alive-p (thread)
+ (mp:process-active-p thread))
+
+ (defvar *mailbox-lock* (mp:make-lock :name "mailbox lock"))
+ (defvar *mailboxes* (list))
+ (declaim (type list *mailboxes*))
+
+ (defstruct (mailbox (:conc-name mailbox.))
+ thread
+ (mutex (mp:make-lock))
+ (cvar (mp:make-condition-variable))
+ (queue '() :type list))
+
+ (defun mailbox (thread)
+ "Return THREAD's mailbox."
+ (mp:with-lock (*mailbox-lock*)
+ (or (find thread *mailboxes* :key #'mailbox.thread)
+ (let ((mb (make-mailbox :thread thread)))
+ (push mb *mailboxes*)
+ mb))))
+
+ (defimplementation send (thread message)
+ (let* ((mbox (mailbox thread))
+ (mutex (mailbox.mutex mbox)))
+ (mp:with-lock (mutex)
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message)))
+ (mp:condition-variable-broadcast (mailbox.cvar mbox)))))
+
+ (defimplementation receive-if (test &optional timeout)
+ (let* ((mbox (mailbox (current-thread)))
+ (mutex (mailbox.mutex mbox)))
+ (assert (or (not timeout) (eq timeout t)))
+ (loop
+ (check-slime-interrupts)
+ (mp:with-lock (mutex)
+ (let* ((q (mailbox.queue mbox))
+ (tail (member-if test q)))
+ (when tail
+ (setf (mailbox.queue mbox) (nconc (ldiff q tail) (cdr tail)))
+ (return (car tail))))
+ (when (eq timeout t) (return (values nil t)))
+ (mp:condition-variable-timedwait (mailbox.cvar mbox)
+ mutex
+ 0.2)))))
+
+ ) ; #+threads (progn ...
diff --git a/vim/bundle/slimv/slime/swank/gray.lisp b/vim/bundle/slimv/slime/swank/gray.lisp
new file mode 100644
index 0000000..b910a78
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/gray.lisp
@@ -0,0 +1,170 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; swank-gray.lisp --- Gray stream based IO redirection.
+;;;
+;;; Created 2003
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+(in-package swank/backend)
+
+#.(progn
+ (defvar *gray-stream-symbols*
+ '(fundamental-character-output-stream
+ stream-write-char
+ stream-write-string
+ stream-fresh-line
+ stream-force-output
+ stream-finish-output
+
+ fundamental-character-input-stream
+ stream-read-char
+ stream-peek-char
+ stream-read-line
+ stream-listen
+ stream-unread-char
+ stream-clear-input
+ stream-line-column
+ stream-read-char-no-hang))
+ nil)
+
+(defpackage swank/gray
+ (:use cl swank/backend)
+ (:import-from #.(gray-package-name) . #.*gray-stream-symbols*)
+ (:export . #.*gray-stream-symbols*))
+
+(in-package swank/gray)
+
+(defclass slime-output-stream (fundamental-character-output-stream)
+ ((output-fn :initarg :output-fn)
+ (buffer :initform (make-string 8000))
+ (fill-pointer :initform 0)
+ (column :initform 0)
+ (lock :initform (make-lock :name "buffer write lock"))))
+
+(defmacro with-slime-output-stream (stream &body body)
+ `(with-slots (lock output-fn buffer fill-pointer column) ,stream
+ (call-with-lock-held lock (lambda () ,@body))))
+
+(defmethod stream-write-char ((stream slime-output-stream) char)
+ (with-slime-output-stream stream
+ (setf (schar buffer fill-pointer) char)
+ (incf fill-pointer)
+ (incf column)
+ (when (char= #\newline char)
+ (setf column 0))
+ (when (= fill-pointer (length buffer))
+ (finish-output stream)))
+ char)
+
+(defmethod stream-write-string ((stream slime-output-stream) string
+ &optional start end)
+ (with-slime-output-stream stream
+ (let* ((start (or start 0))
+ (end (or end (length string)))
+ (len (length buffer))
+ (count (- end start))
+ (free (- len fill-pointer)))
+ (when (>= count free)
+ (stream-finish-output stream))
+ (cond ((< count len)
+ (replace buffer string :start1 fill-pointer
+ :start2 start :end2 end)
+ (incf fill-pointer count))
+ (t
+ (funcall output-fn (subseq string start end))))
+ (let ((last-newline (position #\newline string :from-end t
+ :start start :end end)))
+ (setf column (if last-newline
+ (- end last-newline 1)
+ (+ column count))))))
+ string)
+
+(defmethod stream-line-column ((stream slime-output-stream))
+ (with-slime-output-stream stream column))
+
+(defmethod stream-finish-output ((stream slime-output-stream))
+ (with-slime-output-stream stream
+ (unless (zerop fill-pointer)
+ (funcall output-fn (subseq buffer 0 fill-pointer))
+ (setf fill-pointer 0)))
+ nil)
+
+(defmethod stream-force-output ((stream slime-output-stream))
+ (stream-finish-output stream))
+
+(defmethod stream-fresh-line ((stream slime-output-stream))
+ (with-slime-output-stream stream
+ (cond ((zerop column) nil)
+ (t (terpri stream) t))))
+
+(defclass slime-input-stream (fundamental-character-input-stream)
+ ((input-fn :initarg :input-fn)
+ (buffer :initform "") (index :initform 0)
+ (lock :initform (make-lock :name "buffer read lock"))))
+
+(defmethod stream-read-char ((s slime-input-stream))
+ (call-with-lock-held
+ (slot-value s 'lock)
+ (lambda ()
+ (with-slots (buffer index input-fn) s
+ (when (= index (length buffer))
+ (let ((string (funcall input-fn)))
+ (cond ((zerop (length string))
+ (return-from stream-read-char :eof))
+ (t
+ (setf buffer string)
+ (setf index 0)))))
+ (assert (plusp (length buffer)))
+ (prog1 (aref buffer index) (incf index))))))
+
+(defmethod stream-listen ((s slime-input-stream))
+ (call-with-lock-held
+ (slot-value s 'lock)
+ (lambda ()
+ (with-slots (buffer index) s
+ (< index (length buffer))))))
+
+(defmethod stream-unread-char ((s slime-input-stream) char)
+ (call-with-lock-held
+ (slot-value s 'lock)
+ (lambda ()
+ (with-slots (buffer index) s
+ (decf index)
+ (cond ((eql (aref buffer index) char)
+ (setf (aref buffer index) char))
+ (t
+ (warn "stream-unread-char: ignoring ~S (expected ~S)"
+ char (aref buffer index)))))))
+ nil)
+
+(defmethod stream-clear-input ((s slime-input-stream))
+ (call-with-lock-held
+ (slot-value s 'lock)
+ (lambda ()
+ (with-slots (buffer index) s
+ (setf buffer ""
+ index 0))))
+ nil)
+
+(defmethod stream-line-column ((s slime-input-stream))
+ nil)
+
+(defmethod stream-read-char-no-hang ((s slime-input-stream))
+ (call-with-lock-held
+ (slot-value s 'lock)
+ (lambda ()
+ (with-slots (buffer index) s
+ (when (< index (length buffer))
+ (prog1 (aref buffer index) (incf index)))))))
+
+
+;;;
+
+(defimplementation make-output-stream (write-string)
+ (make-instance 'slime-output-stream :output-fn write-string))
+
+(defimplementation make-input-stream (read-string)
+ (make-instance 'slime-input-stream :input-fn read-string))
diff --git a/vim/bundle/slimv/slime/swank/lispworks.lisp b/vim/bundle/slimv/slime/swank/lispworks.lisp
new file mode 100644
index 0000000..d4b656e
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/lispworks.lisp
@@ -0,0 +1,1018 @@
+;;; -*- indent-tabs-mode: nil -*-
+;;;
+;;; swank-lispworks.lisp --- LispWorks specific code for SLIME.
+;;;
+;;; Created 2003, Helmut Eller
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+(defpackage swank/lispworks
+ (:use cl swank/backend))
+
+(in-package swank/lispworks)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (require "comm"))
+
+(defimplementation gray-package-name ()
+ "STREAM")
+
+(import-swank-mop-symbols :clos '(:slot-definition-documentation
+ :slot-boundp-using-class
+ :slot-value-using-class
+ :slot-makunbound-using-class
+ :eql-specializer
+ :eql-specializer-object
+ :compute-applicable-methods-using-classes))
+
+(defun swank-mop:slot-definition-documentation (slot)
+ (documentation slot t))
+
+(defun swank-mop:slot-boundp-using-class (class object slotd)
+ (clos:slot-boundp-using-class class object
+ (clos:slot-definition-name slotd)))
+
+(defun swank-mop:slot-value-using-class (class object slotd)
+ (clos:slot-value-using-class class object
+ (clos:slot-definition-name slotd)))
+
+(defun (setf swank-mop:slot-value-using-class) (value class object slotd)
+ (setf (clos:slot-value-using-class class object
+ (clos:slot-definition-name slotd))
+ value))
+
+(defun swank-mop:slot-makunbound-using-class (class object slotd)
+ (clos:slot-makunbound-using-class class object
+ (clos:slot-definition-name slotd)))
+
+(defun swank-mop:compute-applicable-methods-using-classes (gf classes)
+ (clos::compute-applicable-methods-from-classes gf classes))
+
+;; lispworks doesn't have the eql-specializer class, it represents
+;; them as a list of `(EQL ,OBJECT)
+(deftype swank-mop:eql-specializer () 'cons)
+
+(defun swank-mop:eql-specializer-object (eql-spec)
+ (second eql-spec))
+
+(eval-when (:compile-toplevel :execute :load-toplevel)
+ (defvar *original-defimplementation* (macro-function 'defimplementation))
+ (defmacro defimplementation (&whole whole name args &body body
+ &environment env)
+ (declare (ignore args body))
+ `(progn
+ (dspec:record-definition '(defun ,name) (dspec:location)
+ :check-redefinition-p nil)
+ ,(funcall *original-defimplementation* whole env))))
+
+;;; UTF8
+
+(defimplementation string-to-utf8 (string)
+ (ef:encode-lisp-string string '(:utf-8 :eol-style :lf)))
+
+(defimplementation utf8-to-string (octets)
+ (ef:decode-external-string octets '(:utf-8 :eol-style :lf)))
+
+;;; TCP server
+
+(defimplementation preferred-communication-style ()
+ :spawn)
+
+(defun socket-fd (socket)
+ (etypecase socket
+ (fixnum socket)
+ (comm:socket-stream (comm:socket-stream-socket socket))))
+
+(defimplementation create-socket (host port &key backlog)
+ (multiple-value-bind (socket where errno)
+ #-(or lispworks4.1 (and macosx lispworks4.3))
+ (comm::create-tcp-socket-for-service port :address host
+ :backlog (or backlog 5))
+ #+(or lispworks4.1 (and macosx lispworks4.3))
+ (comm::create-tcp-socket-for-service port)
+ (cond (socket socket)
+ (t (error 'network-error
+ :format-control "~A failed: ~A (~D)"
+ :format-arguments (list where
+ (list #+unix (lw:get-unix-error errno))
+ errno))))))
+
+(defimplementation local-port (socket)
+ (nth-value 1 (comm:get-socket-address (socket-fd socket))))
+
+(defimplementation close-socket (socket)
+ (comm::close-socket (socket-fd socket)))
+
+(defimplementation accept-connection (socket
+ &key external-format buffering timeout)
+ (declare (ignore buffering))
+ (let* ((fd (comm::get-fd-from-socket socket)))
+ (assert (/= fd -1))
+ (cond ((not external-format)
+ (make-instance 'comm:socket-stream
+ :socket fd
+ :direction :io
+ :read-timeout timeout
+ :element-type '(unsigned-byte 8)))
+ (t
+ (assert (valid-external-format-p external-format))
+ (ecase (first external-format)
+ ((:latin-1 :ascii)
+ (make-instance 'comm:socket-stream
+ :socket fd
+ :direction :io
+ :read-timeout timeout
+ :element-type 'base-char))
+ (:utf-8
+ (make-flexi-stream
+ (make-instance 'comm:socket-stream
+ :socket fd
+ :direction :io
+ :read-timeout timeout
+ :element-type '(unsigned-byte 8))
+ external-format)))))))
+
+(defun make-flexi-stream (stream external-format)
+ (unless (member :flexi-streams *features*)
+ (error "Cannot use external format ~A~
+ without having installed flexi-streams in the inferior-lisp."
+ external-format))
+ (funcall (read-from-string "FLEXI-STREAMS:MAKE-FLEXI-STREAM")
+ stream
+ :external-format
+ (apply (read-from-string "FLEXI-STREAMS:MAKE-EXTERNAL-FORMAT")
+ external-format)))
+
+;;; Coding Systems
+
+(defun valid-external-format-p (external-format)
+ (member external-format *external-format-to-coding-system*
+ :test #'equal :key #'car))
+
+(defvar *external-format-to-coding-system*
+ '(((:latin-1 :eol-style :lf)
+ "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix")
+ ;;((:latin-1) "latin-1" "iso-latin-1" "iso-8859-1")
+ ;;((:utf-8) "utf-8")
+ ((:utf-8 :eol-style :lf) "utf-8-unix")
+ ;;((:euc-jp) "euc-jp")
+ ((:euc-jp :eol-style :lf) "euc-jp-unix")
+ ;;((:ascii) "us-ascii")
+ ((:ascii :eol-style :lf) "us-ascii-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+
+;;; Unix signals
+
+(defun sigint-handler ()
+ (with-simple-restart (continue "Continue from SIGINT handler.")
+ (invoke-debugger "SIGINT")))
+
+(defun make-sigint-handler (process)
+ (lambda (&rest args)
+ (declare (ignore args))
+ (mp:process-interrupt process #'sigint-handler)))
+
+(defun set-sigint-handler ()
+ ;; Set SIGINT handler on Swank request handler thread.
+ #-win32
+ (sys::set-signal-handler +sigint+
+ (make-sigint-handler mp:*current-process*)))
+
+#-win32
+(defimplementation install-sigint-handler (handler)
+ (sys::set-signal-handler +sigint+
+ (let ((self mp:*current-process*))
+ (lambda (&rest args)
+ (declare (ignore args))
+ (mp:process-interrupt self handler)))))
+
+(defimplementation getpid ()
+ #+win32 (win32:get-current-process-id)
+ #-win32 (system::getpid))
+
+(defimplementation lisp-implementation-type-name ()
+ "lispworks")
+
+(defimplementation set-default-directory (directory)
+ (namestring (hcl:change-directory directory)))
+
+;;;; Documentation
+
+(defun map-list (function list)
+ "Map over proper and not proper lists."
+ (loop for (car . cdr) on list
+ collect (funcall function car) into result
+ when (null cdr) return result
+ when (atom cdr) return (nconc result (funcall function cdr))))
+
+(defun replace-strings-with-symbols (tree)
+ (map-list
+ (lambda (x)
+ (typecase x
+ (list
+ (replace-strings-with-symbols x))
+ (symbol
+ x)
+ (string
+ (intern x))
+ (t
+ (intern (write-to-string x)))))
+ tree))
+
+(defimplementation arglist (symbol-or-function)
+ (let ((arglist (lw:function-lambda-list symbol-or-function)))
+ (etypecase arglist
+ ((member :dont-know)
+ :not-available)
+ (list
+ (replace-strings-with-symbols arglist)))))
+
+(defimplementation function-name (function)
+ (nth-value 2 (function-lambda-expression function)))
+
+(defimplementation macroexpand-all (form &optional env)
+ (declare (ignore env))
+ (walker:walk-form form))
+
+(defun generic-function-p (object)
+ (typep object 'generic-function))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ "Return a plist describing SYMBOL.
+Return NIL if the symbol is unbound."
+ (let ((result '()))
+ (labels ((first-line (string)
+ (let ((pos (position #\newline string)))
+ (if (null pos) string (subseq string 0 pos))))
+ (doc (kind &optional (sym symbol))
+ (let ((string (or (documentation sym kind))))
+ (if string
+ (first-line string)
+ :not-documented)))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (when (boundp symbol)
+ (doc 'variable)))
+ (maybe-push
+ :generic-function (if (and (fboundp symbol)
+ (generic-function-p (fdefinition symbol)))
+ (doc 'function)))
+ (maybe-push
+ :function (if (and (fboundp symbol)
+ (not (generic-function-p (fdefinition symbol))))
+ (doc 'function)))
+ (maybe-push
+ :setf (let ((setf-name (sys:underlying-setf-name `(setf ,symbol))))
+ (if (fboundp setf-name)
+ (doc 'setf))))
+ (maybe-push
+ :class (if (find-class symbol nil)
+ (doc 'class)))
+ result)))
+
+(defimplementation describe-definition (symbol type)
+ (ecase type
+ (:variable (describe-symbol symbol))
+ (:class (describe (find-class symbol)))
+ ((:function :generic-function) (describe-function symbol))
+ (:setf (describe-function (sys:underlying-setf-name `(setf ,symbol))))))
+
+(defun describe-function (symbol)
+ (cond ((fboundp symbol)
+ (format t "(~A ~/pprint-fill/)~%~%~:[(not documented)~;~:*~A~]~%"
+ symbol
+ (lispworks:function-lambda-list symbol)
+ (documentation symbol 'function))
+ (describe (fdefinition symbol)))
+ (t (format t "~S is not fbound" symbol))))
+
+(defun describe-symbol (sym)
+ (format t "~A is a symbol in package ~A." sym (symbol-package sym))
+ (when (boundp sym)
+ (format t "~%~%Value: ~A" (symbol-value sym)))
+ (let ((doc (documentation sym 'variable)))
+ (when doc
+ (format t "~%~%Variable documentation:~%~A" doc)))
+ (when (fboundp sym)
+ (describe-function sym)))
+
+(defimplementation type-specifier-p (symbol)
+ (or (ignore-errors
+ (subtypep nil symbol))
+ (not (eq (type-specifier-arglist symbol) :not-available))))
+
+;;; Debugging
+
+(defclass slime-env (env:environment)
+ ((debugger-hook :initarg :debugger-hoook)))
+
+(defun slime-env (hook io-bindings)
+ (make-instance 'slime-env :name "SLIME Environment"
+ :io-bindings io-bindings
+ :debugger-hoook hook))
+
+(defmethod env-internals:environment-display-notifier
+ ((env slime-env) &key restarts condition)
+ (declare (ignore restarts condition))
+ (swank:swank-debugger-hook condition *debugger-hook*))
+
+(defmethod env-internals:environment-display-debugger ((env slime-env))
+ *debug-io*)
+
+(defmethod env-internals:confirm-p ((e slime-env) &optional msg &rest args)
+ (apply #'swank:y-or-n-p-in-emacs msg args))
+
+(defimplementation call-with-debugger-hook (hook fun)
+ (let ((*debugger-hook* hook))
+ (env:with-environment ((slime-env hook '()))
+ (funcall fun))))
+
+(defimplementation install-debugger-globally (function)
+ (setq *debugger-hook* function)
+ (setf (env:environment) (slime-env function '())))
+
+(defvar *sldb-top-frame*)
+
+(defun interesting-frame-p (frame)
+ (cond ((or (dbg::call-frame-p frame)
+ (dbg::derived-call-frame-p frame)
+ (dbg::foreign-frame-p frame)
+ (dbg::interpreted-call-frame-p frame))
+ t)
+ ((dbg::catch-frame-p frame) dbg:*print-catch-frames*)
+ ((dbg::binding-frame-p frame) dbg:*print-binding-frames*)
+ ((dbg::handler-frame-p frame) dbg:*print-handler-frames*)
+ ((dbg::restart-frame-p frame) dbg:*print-restart-frames*)
+ (t nil)))
+
+(defun nth-next-frame (frame n)
+ "Unwind FRAME N times."
+ (do ((frame frame (dbg::frame-next frame))
+ (i n (if (interesting-frame-p frame) (1- i) i)))
+ ((or (not frame)
+ (and (interesting-frame-p frame) (zerop i)))
+ frame)))
+
+(defun nth-frame (index)
+ (nth-next-frame *sldb-top-frame* index))
+
+(defun find-top-frame ()
+ "Return the most suitable top-frame for the debugger."
+ (flet ((find-named-frame (name)
+ (do ((frame (dbg::debugger-stack-current-frame
+ dbg::*debugger-stack*)
+ (nth-next-frame frame 1)))
+ ((or (null frame) ; no frame found!
+ (and (dbg::call-frame-p frame)
+ (eq (dbg::call-frame-function-name frame)
+ name)))
+ (nth-next-frame frame 1)))))
+ (or (find-named-frame 'invoke-debugger)
+ (find-named-frame 'swank::safe-backtrace)
+ ;; if we can't find a likely top frame, take any old frame
+ ;; at the top
+ (dbg::debugger-stack-current-frame dbg::*debugger-stack*))))
+
+(defimplementation call-with-debugging-environment (fn)
+ (dbg::with-debugger-stack ()
+ (let ((*sldb-top-frame* (find-top-frame)))
+ (funcall fn))))
+
+(defimplementation compute-backtrace (start end)
+ (let ((end (or end most-positive-fixnum))
+ (backtrace '()))
+ (do ((frame (nth-frame start) (dbg::frame-next frame))
+ (i start))
+ ((or (not frame) (= i end)) (nreverse backtrace))
+ (when (interesting-frame-p frame)
+ (incf i)
+ (push frame backtrace)))))
+
+(defun frame-actual-args (frame)
+ (let ((*break-on-signals* nil)
+ (kind nil))
+ (loop for arg in (dbg::call-frame-arglist frame)
+ if (eq kind '&rest)
+ nconc (handler-case
+ (dbg::dbg-eval arg frame)
+ (error (e) (list (format nil "<~A>" arg))))
+ and do (loop-finish)
+ else
+ if (member arg '(&rest &optional &key))
+ do (setq kind arg)
+ else
+ nconc
+ (handler-case
+ (nconc (and (eq kind '&key)
+ (list (cond ((symbolp arg)
+ (intern (symbol-name arg) :keyword))
+ ((and (consp arg) (symbolp (car arg)))
+ (intern (symbol-name (car arg))
+ :keyword))
+ (t (caar arg)))))
+ (list (dbg::dbg-eval
+ (cond ((symbolp arg) arg)
+ ((and (consp arg) (symbolp (car arg)))
+ (car arg))
+ (t (cadar arg)))
+ frame)))
+ (error (e) (list (format nil "<~A>" arg)))))))
+
+(defimplementation print-frame (frame stream)
+ (cond ((dbg::call-frame-p frame)
+ (prin1 (cons (dbg::call-frame-function-name frame)
+ (frame-actual-args frame))
+ stream))
+ (t (princ frame stream))))
+
+(defun frame-vars (frame)
+ (first (dbg::frame-locals-format-list frame #'list 75 0)))
+
+(defimplementation frame-locals (n)
+ (let ((frame (nth-frame n)))
+ (if (dbg::call-frame-p frame)
+ (mapcar (lambda (var)
+ (destructuring-bind (name value symbol location) var
+ (declare (ignore name location))
+ (list :name symbol :id 0
+ :value value)))
+ (frame-vars frame)))))
+
+(defimplementation frame-var-value (frame var)
+ (let ((frame (nth-frame frame)))
+ (destructuring-bind (_n value _s _l) (nth var (frame-vars frame))
+ (declare (ignore _n _s _l))
+ value)))
+
+(defimplementation frame-source-location (frame)
+ (let ((frame (nth-frame frame))
+ (callee (if (plusp frame) (nth-frame (1- frame)))))
+ (if (dbg::call-frame-p frame)
+ (let ((dspec (dbg::call-frame-function-name frame))
+ (cname (and (dbg::call-frame-p callee)
+ (dbg::call-frame-function-name callee)))
+ (path (and (dbg::call-frame-p frame)
+ (dbg::call-frame-edit-path frame))))
+ (if dspec
+ (frame-location dspec cname path))))))
+
+(defimplementation eval-in-frame (form frame-number)
+ (let ((frame (nth-frame frame-number)))
+ (dbg::dbg-eval form frame)))
+
+(defun function-name-package (name)
+ (typecase name
+ (null nil)
+ (symbol (symbol-package name))
+ ((cons (eql hcl:subfunction))
+ (destructuring-bind (name parent) (cdr name)
+ (declare (ignore name))
+ (function-name-package parent)))
+ ((cons (eql lw:top-level-form)) nil)
+ (t nil)))
+
+(defimplementation frame-package (frame-number)
+ (let ((frame (nth-frame frame-number)))
+ (if (dbg::call-frame-p frame)
+ (function-name-package (dbg::call-frame-function-name frame)))))
+
+(defimplementation return-from-frame (frame-number form)
+ (let* ((frame (nth-frame frame-number))
+ (return-frame (dbg::find-frame-for-return frame)))
+ (dbg::dbg-return-from-call-frame frame form return-frame
+ dbg::*debugger-stack*)))
+
+(defimplementation restart-frame (frame-number)
+ (let ((frame (nth-frame frame-number)))
+ (dbg::restart-frame frame :same-args t)))
+
+(defimplementation disassemble-frame (frame-number)
+ (let* ((frame (nth-frame frame-number)))
+ (when (dbg::call-frame-p frame)
+ (let ((function (dbg::get-call-frame-function frame)))
+ (disassemble function)))))
+
+;;; Definition finding
+
+(defun frame-location (dspec callee-name edit-path)
+ (let ((infos (dspec:find-dspec-locations dspec)))
+ (cond (infos
+ (destructuring-bind ((rdspec location) &rest _) infos
+ (declare (ignore _))
+ (let ((name (and callee-name (symbolp callee-name)
+ (string callee-name)))
+ (path (edit-path-to-cmucl-source-path edit-path)))
+ (make-dspec-location rdspec location
+ `(:call-site ,name :edit-path ,path)))))
+ (t
+ (list :error (format nil "Source location not available for: ~S"
+ dspec))))))
+
+;; dbg::call-frame-edit-path is not documented but lets assume the
+;; binary representation of the integer EDIT-PATH should be
+;; interpreted as a sequence of CAR or CDR. #b1111010 is roughly the
+;; same as cadadddr. Something is odd with the highest bit.
+(defun edit-path-to-cmucl-source-path (edit-path)
+ (and edit-path
+ (cons 0
+ (let ((n -1))
+ (loop for i from (1- (integer-length edit-path)) downto 0
+ if (logbitp i edit-path) do (incf n)
+ else collect (prog1 n (setq n 0)))))))
+
+;; (edit-path-to-cmucl-source-path #b1111010) => (0 3 1)
+
+(defimplementation find-definitions (name)
+ (let ((locations (dspec:find-name-locations dspec:*dspec-classes* name)))
+ (loop for (dspec location) in locations
+ collect (list dspec (make-dspec-location dspec location)))))
+
+
+;;; Compilation
+
+(defmacro with-swank-compilation-unit ((location &rest options) &body body)
+ (lw:rebinding (location)
+ `(let ((compiler::*error-database* '()))
+ (with-compilation-unit ,options
+ (multiple-value-prog1 (progn ,@body)
+ (signal-error-data-base compiler::*error-database*
+ ,location)
+ (signal-undefined-functions compiler::*unknown-functions*
+ ,location))))))
+
+(defimplementation swank-compile-file (input-file output-file
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
+ (with-swank-compilation-unit (input-file)
+ (compile-file input-file
+ :output-file output-file
+ :load load-p
+ :external-format external-format)))
+
+(defvar *within-call-with-compilation-hooks* nil
+ "Whether COMPILE-FILE was called from within CALL-WITH-COMPILATION-HOOKS.")
+
+(defvar *undefined-functions-hash* nil
+ "Hash table to map info about undefined functions to pathnames.")
+
+(lw:defadvice (compile-file compile-file-and-collect-notes :around)
+ (pathname &rest rest)
+ (multiple-value-prog1 (apply #'lw:call-next-advice pathname rest)
+ (when *within-call-with-compilation-hooks*
+ (maphash (lambda (unfun dspecs)
+ (dolist (dspec dspecs)
+ (let ((unfun-info (list unfun dspec)))
+ (unless (gethash unfun-info *undefined-functions-hash*)
+ (setf (gethash unfun-info *undefined-functions-hash*)
+ pathname)))))
+ compiler::*unknown-functions*))))
+
+(defimplementation call-with-compilation-hooks (function)
+ (let ((compiler::*error-database* '())
+ (*undefined-functions-hash* (make-hash-table :test 'equal))
+ (*within-call-with-compilation-hooks* t))
+ (with-compilation-unit ()
+ (prog1 (funcall function)
+ (signal-error-data-base compiler::*error-database*)
+ (signal-undefined-functions compiler::*unknown-functions*)))))
+
+(defun map-error-database (database fn)
+ (loop for (filename . defs) in database do
+ (loop for (dspec . conditions) in defs do
+ (dolist (c conditions)
+ (multiple-value-bind (condition path)
+ (if (consp c) (values (car c) (cdr c)) (values c nil))
+ (funcall fn filename dspec condition path))))))
+
+(defun lispworks-severity (condition)
+ (cond ((not condition) :warning)
+ (t (etypecase condition
+ #-(or lispworks4 lispworks5)
+ (conditions:compiler-note :note)
+ (error :error)
+ (style-warning :warning)
+ (warning :warning)))))
+
+(defun signal-compiler-condition (message location condition)
+ (check-type message string)
+ (signal
+ (make-instance 'compiler-condition :message message
+ :severity (lispworks-severity condition)
+ :location location
+ :original-condition condition)))
+
+(defvar *temp-file-format* '(:utf-8 :eol-style :lf))
+
+(defun compile-from-temp-file (string filename)
+ (unwind-protect
+ (progn
+ (with-open-file (s filename :direction :output
+ :if-exists :supersede
+ :external-format *temp-file-format*)
+
+ (write-string string s)
+ (finish-output s))
+ (multiple-value-bind (binary-filename warnings? failure?)
+ (compile-file filename :load t
+ :external-format *temp-file-format*)
+ (declare (ignore warnings?))
+ (when binary-filename
+ (delete-file binary-filename))
+ (not failure?)))
+ (delete-file filename)))
+
+(defun dspec-function-name-position (dspec fallback)
+ (etypecase dspec
+ (cons (let ((name (dspec:dspec-primary-name dspec)))
+ (typecase name
+ ((or symbol string)
+ (list :function-name (string name)))
+ (t fallback))))
+ (null fallback)
+ (symbol (list :function-name (string dspec)))))
+
+(defmacro with-fairly-standard-io-syntax (&body body)
+ "Like WITH-STANDARD-IO-SYNTAX but preserve *PACKAGE* and *READTABLE*."
+ (let ((package (gensym))
+ (readtable (gensym)))
+ `(let ((,package *package*)
+ (,readtable *readtable*))
+ (with-standard-io-syntax
+ (let ((*package* ,package)
+ (*readtable* ,readtable))
+ ,@body)))))
+
+(defun skip-comments (stream)
+ (let ((pos0 (file-position stream)))
+ (cond ((equal (ignore-errors (list (read-delimited-list #\( stream)))
+ '(()))
+ (file-position stream (1- (file-position stream))))
+ (t (file-position stream pos0)))))
+
+#-(or lispworks4.1 lispworks4.2) ; no dspec:parse-form-dspec prior to 4.3
+(defun dspec-stream-position (stream dspec)
+ (with-fairly-standard-io-syntax
+ (loop (let* ((pos (progn (skip-comments stream) (file-position stream)))
+ (form (read stream nil '#1=#:eof)))
+ (when (eq form '#1#)
+ (return nil))
+ (labels ((check-dspec (form)
+ (when (consp form)
+ (let ((operator (car form)))
+ (case operator
+ ((progn)
+ (mapcar #'check-dspec
+ (cdr form)))
+ ((eval-when locally macrolet symbol-macrolet)
+ (mapcar #'check-dspec
+ (cddr form)))
+ ((in-package)
+ (let ((package (find-package (second form))))
+ (when package
+ (setq *package* package))))
+ (otherwise
+ (let ((form-dspec (dspec:parse-form-dspec form)))
+ (when (dspec:dspec-equal dspec form-dspec)
+ (return pos)))))))))
+ (check-dspec form))))))
+
+(defun dspec-file-position (file dspec)
+ (let* ((*compile-file-pathname* (pathname file))
+ (*compile-file-truename* (truename *compile-file-pathname*))
+ (*load-pathname* *compile-file-pathname*)
+ (*load-truename* *compile-file-truename*))
+ (with-open-file (stream file)
+ (let ((pos
+ #-(or lispworks4.1 lispworks4.2)
+ (ignore-errors (dspec-stream-position stream dspec))))
+ (if pos
+ (list :position (1+ pos))
+ (dspec-function-name-position dspec `(:position 1)))))))
+
+(defun emacs-buffer-location-p (location)
+ (and (consp location)
+ (eq (car location) :emacs-buffer)))
+
+(defun make-dspec-location (dspec location &optional hints)
+ (etypecase location
+ ((or pathname string)
+ (multiple-value-bind (file err)
+ (ignore-errors (namestring (truename location)))
+ (if err
+ (list :error (princ-to-string err))
+ (make-location `(:file ,file)
+ (dspec-file-position file dspec)
+ hints))))
+ (symbol
+ `(:error ,(format nil "Cannot resolve location: ~S" location)))
+ ((satisfies emacs-buffer-location-p)
+ (destructuring-bind (_ buffer offset) location
+ (declare (ignore _))
+ (make-location `(:buffer ,buffer)
+ (dspec-function-name-position dspec `(:offset ,offset 0))
+ hints)))))
+
+(defun make-dspec-progenitor-location (dspec location edit-path)
+ (let ((canon-dspec (dspec:canonicalize-dspec dspec)))
+ (make-dspec-location
+ (if canon-dspec
+ (if (dspec:local-dspec-p canon-dspec)
+ (dspec:dspec-progenitor canon-dspec)
+ canon-dspec)
+ nil)
+ location
+ (if edit-path
+ (list :edit-path (edit-path-to-cmucl-source-path edit-path))))))
+
+(defun signal-error-data-base (database &optional location)
+ (map-error-database
+ database
+ (lambda (filename dspec condition edit-path)
+ (signal-compiler-condition
+ (format nil "~A" condition)
+ (make-dspec-progenitor-location dspec (or location filename) edit-path)
+ condition))))
+
+(defun unmangle-unfun (symbol)
+ "Converts symbols like 'SETF::|\"CL-USER\" \"GET\"| to
+function names like \(SETF GET)."
+ (cond ((sys::setf-symbol-p symbol)
+ (sys::setf-pair-from-underlying-name symbol))
+ (t symbol)))
+
+(defun signal-undefined-functions (htab &optional filename)
+ (maphash (lambda (unfun dspecs)
+ (dolist (dspec dspecs)
+ (signal-compiler-condition
+ (format nil "Undefined function ~A" (unmangle-unfun unfun))
+ (make-dspec-progenitor-location
+ dspec
+ (or filename
+ (gethash (list unfun dspec) *undefined-functions-hash*))
+ nil)
+ nil)))
+ htab))
+
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore filename policy))
+ (assert buffer)
+ (assert position)
+ (let* ((location (list :emacs-buffer buffer position))
+ (tmpname (hcl:make-temp-file nil "lisp")))
+ (with-swank-compilation-unit (location)
+ (compile-from-temp-file
+ (with-output-to-string (s)
+ (let ((*print-radix* t))
+ (print `(eval-when (:compile-toplevel)
+ (setq dspec::*location* (list ,@location)))
+ s))
+ (write-string string s))
+ tmpname))))
+
+;;; xref
+
+(defmacro defxref (name function)
+ `(defimplementation ,name (name)
+ (xref-results (,function name))))
+
+(defxref who-calls hcl:who-calls)
+(defxref who-macroexpands hcl:who-calls) ; macros are in the calls table too
+(defxref calls-who hcl:calls-who)
+(defxref list-callers list-callers-internal)
+(defxref list-callees list-callees-internal)
+
+(defun list-callers-internal (name)
+ (let ((callers (make-array 100
+ :fill-pointer 0
+ :adjustable t)))
+ (hcl:sweep-all-objects
+ #'(lambda (object)
+ (when (and #+Harlequin-PC-Lisp (low:compiled-code-p object)
+ #+Harlequin-Unix-Lisp (sys:callablep object)
+ #-(or Harlequin-PC-Lisp Harlequin-Unix-Lisp)
+ (sys:compiled-code-p object)
+ (system::find-constant$funcallable name object))
+ (vector-push-extend object callers))))
+ ;; Delay dspec:object-dspec until after sweep-all-objects
+ ;; to reduce allocation problems.
+ (loop for object across callers
+ collect (if (symbolp object)
+ (list 'function object)
+ (or (dspec:object-dspec object) object)))))
+
+(defun list-callees-internal (name)
+ (let ((callees '()))
+ (system::find-constant$funcallable
+ 'junk name
+ :test #'(lambda (junk constant)
+ (declare (ignore junk))
+ (when (and (symbolp constant)
+ (fboundp constant))
+ (pushnew (list 'function constant) callees :test 'equal))
+ ;; Return nil so we iterate over all constants.
+ nil))
+ callees))
+
+;; only for lispworks 4.2 and above
+#-lispworks4.1
+(progn
+ (defxref who-references hcl:who-references)
+ (defxref who-binds hcl:who-binds)
+ (defxref who-sets hcl:who-sets))
+
+(defimplementation who-specializes (classname)
+ (let ((methods (clos:class-direct-methods (find-class classname))))
+ (xref-results (mapcar #'dspec:object-dspec methods))))
+
+(defun xref-results (dspecs)
+ (flet ((frob-locs (dspec locs)
+ (cond (locs
+ (loop for (name loc) in locs
+ collect (list name (make-dspec-location name loc))))
+ (t `((,dspec (:error "Source location not available")))))))
+ (loop for dspec in dspecs
+ append (frob-locs dspec (dspec:dspec-definition-locations dspec)))))
+
+;;; Inspector
+
+(defmethod emacs-inspect ((o t))
+ (lispworks-inspect o))
+
+(defmethod emacs-inspect ((o function))
+ (lispworks-inspect o))
+
+;; FIXME: slot-boundp-using-class in LW works with names so we can't
+;; use our method in swank.lisp.
+(defmethod emacs-inspect ((o standard-object))
+ (lispworks-inspect o))
+
+(defun lispworks-inspect (o)
+ (multiple-value-bind (names values _getter _setter type)
+ (lw:get-inspector-values o nil)
+ (declare (ignore _getter _setter))
+ (append
+ (label-value-line "Type" type)
+ (loop for name in names
+ for value in values
+ append (label-value-line name value)))))
+
+;;; Miscellaneous
+
+(defimplementation quit-lisp ()
+ (lispworks:quit))
+
+;;; Tracing
+
+(defun parse-fspec (fspec)
+ "Return a dspec for FSPEC."
+ (ecase (car fspec)
+ ((:defmethod) `(method ,(cdr fspec)))))
+
+(defun tracedp (dspec)
+ (member dspec (eval '(trace)) :test #'equal))
+
+(defun toggle-trace-aux (dspec)
+ (cond ((tracedp dspec)
+ (eval `(untrace ,dspec))
+ (format nil "~S is now untraced." dspec))
+ (t
+ (eval `(trace (,dspec)))
+ (format nil "~S is now traced." dspec))))
+
+(defimplementation toggle-trace (fspec)
+ (toggle-trace-aux (parse-fspec fspec)))
+
+;;; Multithreading
+
+(defimplementation initialize-multiprocessing (continuation)
+ (cond ((not mp::*multiprocessing*)
+ (push (list "Initialize SLIME" '() continuation)
+ mp:*initial-processes*)
+ (mp:initialize-multiprocessing))
+ (t (funcall continuation))))
+
+(defimplementation spawn (fn &key name)
+ (mp:process-run-function name () fn))
+
+(defvar *id-lock* (mp:make-lock))
+(defvar *thread-id-counter* 0)
+
+(defimplementation thread-id (thread)
+ (mp:with-lock (*id-lock*)
+ (or (getf (mp:process-plist thread) 'id)
+ (setf (getf (mp:process-plist thread) 'id)
+ (incf *thread-id-counter*)))))
+
+(defimplementation find-thread (id)
+ (find id (mp:list-all-processes)
+ :key (lambda (p) (getf (mp:process-plist p) 'id))))
+
+(defimplementation thread-name (thread)
+ (mp:process-name thread))
+
+(defimplementation thread-status (thread)
+ (format nil "~A ~D"
+ (mp:process-whostate thread)
+ (mp:process-priority thread)))
+
+(defimplementation make-lock (&key name)
+ (mp:make-lock :name name))
+
+(defimplementation call-with-lock-held (lock function)
+ (mp:with-lock (lock) (funcall function)))
+
+(defimplementation current-thread ()
+ mp:*current-process*)
+
+(defimplementation all-threads ()
+ (mp:list-all-processes))
+
+(defimplementation interrupt-thread (thread fn)
+ (mp:process-interrupt thread fn))
+
+(defimplementation kill-thread (thread)
+ (mp:process-kill thread))
+
+(defimplementation thread-alive-p (thread)
+ (mp:process-alive-p thread))
+
+(defstruct (mailbox (:conc-name mailbox.))
+ (mutex (mp:make-lock :name "thread mailbox"))
+ (queue '() :type list))
+
+(defvar *mailbox-lock* (mp:make-lock))
+
+(defun mailbox (thread)
+ (mp:with-lock (*mailbox-lock*)
+ (or (getf (mp:process-plist thread) 'mailbox)
+ (setf (getf (mp:process-plist thread) 'mailbox)
+ (make-mailbox)))))
+
+(defimplementation receive-if (test &optional timeout)
+ (let* ((mbox (mailbox mp:*current-process*))
+ (lock (mailbox.mutex mbox)))
+ (assert (or (not timeout) (eq timeout t)))
+ (loop
+ (check-slime-interrupts)
+ (mp:with-lock (lock "receive-if/try")
+ (let* ((q (mailbox.queue mbox))
+ (tail (member-if test q)))
+ (when tail
+ (setf (mailbox.queue mbox) (nconc (ldiff q tail) (cdr tail)))
+ (return (car tail)))))
+ (when (eq timeout t) (return (values nil t)))
+ (mp:process-wait-with-timeout
+ "receive-if" 0.3 (lambda () (some test (mailbox.queue mbox)))))))
+
+(defimplementation send (thread message)
+ (let ((mbox (mailbox thread)))
+ (mp:with-lock ((mailbox.mutex mbox))
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message))))))
+
+(let ((alist '())
+ (lock (mp:make-lock :name "register-thread")))
+
+ (defimplementation register-thread (name thread)
+ (declare (type symbol name))
+ (mp:with-lock (lock)
+ (etypecase thread
+ (null
+ (setf alist (delete name alist :key #'car)))
+ (mp:process
+ (let ((probe (assoc name alist)))
+ (cond (probe (setf (cdr probe) thread))
+ (t (setf alist (acons name thread alist))))))))
+ nil)
+
+ (defimplementation find-registered (name)
+ (mp:with-lock (lock)
+ (cdr (assoc name alist)))))
+
+
+(defimplementation set-default-initial-binding (var form)
+ (setq mp:*process-initial-bindings*
+ (acons var `(eval (quote ,form))
+ mp:*process-initial-bindings* )))
+
+(defimplementation thread-attributes (thread)
+ (list :priority (mp:process-priority thread)
+ :idle (mp:process-idle-time thread)))
+
+
+;;;; Weak hashtables
+
+(defimplementation make-weak-key-hash-table (&rest args)
+ (apply #'make-hash-table :weak-kind :key args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+ (apply #'make-hash-table :weak-kind :value args))
diff --git a/vim/bundle/slimv/slime/swank/match.lisp b/vim/bundle/slimv/slime/swank/match.lisp
new file mode 100644
index 0000000..d6200db
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/match.lisp
@@ -0,0 +1,242 @@
+;;
+;; SELECT-MATCH macro (and IN macro)
+;;
+;; Copyright 1990 Stephen Adams
+;;
+;; You are free to copy, distribute and make derivative works of this
+;; source provided that this copyright notice is displayed near the
+;; beginning of the file. No liability is accepted for the
+;; correctness or performance of the code. If you modify the code
+;; please indicate this fact both at the place of modification and in
+;; this copyright message.
+;;
+;; Stephen Adams
+;; Department of Electronics and Computer Science
+;; University of Southampton
+;; SO9 5NH, UK
+;;
+;; sra@ecs.soton.ac.uk
+;;
+
+;;
+;; Synopsis:
+;;
+;; (select-match expression
+;; (pattern action+)*)
+;;
+;; --- or ---
+;;
+;; (select-match expression
+;; pattern => expression
+;; pattern => expression
+;; ...)
+;;
+;; pattern -> constant ;egs 1, #\x, #c(1.0 1.1)
+;; | symbol ;matches anything
+;; | 'anything ;must be EQUAL
+;; | (pattern = pattern) ;both patterns must match
+;; | (#'function pattern) ;predicate test
+;; | (pattern . pattern) ;cons cell
+;;
+
+;; Example
+;;
+;; (select-match item
+;; (('if e1 e2 e3) 'if-then-else) ;(1)
+;; ((#'oddp k) 'an-odd-integer) ;(2)
+;; (((#'treep tree) = (hd . tl)) 'something-else) ;(3)
+;; (other 'anything-else)) ;(4)
+;;
+;; Notes
+;;
+;; . Each pattern is tested in turn. The first match is taken.
+;;
+;; . If no pattern matches, an error is signalled.
+;;
+;; . Constant patterns (things X for which (CONSTANTP X) is true, i.e.
+;; numbers, strings, characters, etc.) match things which are EQUAL.
+;;
+;; . Quoted patterns (which are CONSTANTP) are constants.
+;;
+;; . Symbols match anything. The symbol is bound to the matched item
+;; for the execution of the actions.
+;; For example, (SELECT-MATCH '(1 2 3)
+;; (1 . X) => X)
+;; returns (2 3) because X is bound to the cdr of the candidate.
+;;
+;; . The two pattern match (p1 = p2) can be used to name parts
+;; of the matched structure. For example, (ALL = (HD . TL))
+;; matches a cons cell. ALL is bound to the cons cell, HD to its car
+;; and TL to its tail.
+;;
+;; . A predicate test applies the predicate to the item being matched.
+;; If the predicate returns NIL then the match fails.
+;; If it returns truth, then the nested pattern is matched. This is
+;; often just a symbol like K in the example.
+;;
+;; . Care should be taken with the domain values for predicate matches.
+;; If, in the above eg, item is not an integer, an error would occur
+;; during the test. A safer pattern would be
+;; (#'integerp (#'oddp k))
+;; This would only test for oddness of the item was an integer.
+;;
+;; . A single symbol will match anything so it can be used as a default
+;; case, like OTHER above.
+;;
+
+(in-package swank/match)
+
+(defmacro match (expression &body patterns)
+ `(select-match ,expression ,@patterns))
+
+(defmacro select-match (expression &rest patterns)
+ (let* ((do-let (not (atom expression)))
+ (key (if do-let (gensym) expression))
+ (cbody (expand-select-patterns key patterns))
+ (cform `(cond . ,cbody)))
+ (if do-let
+ `(let ((,key ,expression)) ,cform)
+ cform)))
+
+(defun expand-select-patterns (key patterns)
+ (if (eq (second patterns) '=>)
+ (expand-select-patterns-style-2 key patterns)
+ (expand-select-patterns-style-1 key patterns)))
+
+(defun expand-select-patterns-style-1 (key patterns)
+ (if (null patterns)
+ `((t (error "Case select pattern match failure on ~S" ,key)))
+ (let* ((pattern (caar patterns))
+ (actions (cdar patterns))
+ (rest (cdr patterns))
+ (test (compile-select-test key pattern))
+ (bindings (compile-select-bindings key pattern actions)))
+ `(,(if bindings `(,test (let ,bindings . ,actions))
+ `(,test . ,actions))
+ . ,(unless (eq test t)
+ (expand-select-patterns-style-1 key rest))))))
+
+(defun expand-select-patterns-style-2 (key patterns)
+ (cond ((null patterns)
+ `((t (error "Case select pattern match failure on ~S" ,key))))
+ (t (when (or (< (length patterns) 3)
+ (not (eq (second patterns) '=>)))
+ (error "Illegal patterns: ~S" patterns))
+ (let* ((pattern (first patterns))
+ (actions (list (third patterns)))
+ (rest (cdddr patterns))
+ (test (compile-select-test key pattern))
+ (bindings (compile-select-bindings key pattern actions)))
+ `(,(if bindings `(,test (let ,bindings . ,actions))
+ `(,test . ,actions))
+ . ,(unless (eq test t)
+ (expand-select-patterns-style-2 key rest)))))))
+
+(defun compile-select-test (key pattern)
+ (let ((tests (remove t (compile-select-tests key pattern))))
+ (cond
+ ;; note AND does this anyway, but this allows us to tell if
+ ;; the pattern will always match.
+ ((null tests) t)
+ ((= (length tests) 1) (car tests))
+ (t `(and . ,tests)))))
+
+(defun compile-select-tests (key pattern)
+ (cond ((constantp pattern) `((,(cond ((numberp pattern) 'eql)
+ ((symbolp pattern) 'eq)
+ (t 'equal))
+ ,key ,pattern)))
+ ((symbolp pattern) '(t))
+ ((select-double-match? pattern)
+ (append
+ (compile-select-tests key (first pattern))
+ (compile-select-tests key (third pattern))))
+ ((select-predicate? pattern)
+ (append
+ `((,(second (first pattern)) ,key))
+ (compile-select-tests key (second pattern))))
+ ((consp pattern)
+ (append
+ `((consp ,key))
+ (compile-select-tests (cs-car key) (car
+ pattern))
+ (compile-select-tests (cs-cdr key) (cdr
+ pattern))))
+ (t (error "Illegal select pattern: ~S" pattern))))
+
+
+(defun compile-select-bindings (key pattern action)
+ (cond ((constantp pattern) '())
+ ((symbolp pattern)
+ (if (select-in-tree pattern action)
+ `((,pattern ,key))
+ '()))
+ ((select-double-match? pattern)
+ (append
+ (compile-select-bindings key (first pattern) action)
+ (compile-select-bindings key (third pattern) action)))
+ ((select-predicate? pattern)
+ (compile-select-bindings key (second pattern) action))
+ ((consp pattern)
+ (append
+ (compile-select-bindings (cs-car key) (car pattern)
+ action)
+ (compile-select-bindings (cs-cdr key) (cdr pattern)
+ action)))))
+
+(defun select-in-tree (atom tree)
+ (or (eq atom tree)
+ (if (consp tree)
+ (or (select-in-tree atom (car tree))
+ (select-in-tree atom (cdr tree))))))
+
+(defun select-double-match? (pattern)
+ ;; (<pattern> = <pattern>)
+ (and (consp pattern) (consp (cdr pattern)) (consp (cddr pattern))
+ (null (cdddr pattern))
+ (eq (second pattern) '=)))
+
+(defun select-predicate? (pattern)
+ ;; ((function <f>) <pattern>)
+ (and (consp pattern)
+ (consp (cdr pattern))
+ (null (cddr pattern))
+ (consp (first pattern))
+ (consp (cdr (first pattern)))
+ (null (cddr (first pattern)))
+ (eq (caar pattern) 'function)))
+
+(defun cs-car (exp)
+ (cs-car/cdr 'car exp
+ '((car . caar) (cdr . cadr) (caar . caaar) (cadr . caadr)
+ (cdar . cadar) (cddr . caddr)
+ (caaar . caaaar) (caadr . caaadr) (cadar . caadar)
+ (caddr . caaddr) (cdaar . cadaar) (cdadr . cadadr)
+ (cddar . caddar) (cdddr . cadddr))))
+
+(defun cs-cdr (exp)
+ (cs-car/cdr 'cdr exp
+ '((car . cdar) (cdr . cddr) (caar . cdaar) (cadr . cdadr)
+ (cdar . cddar) (cddr . cdddr)
+ (caaar . cdaaar) (caadr . cdaadr) (cadar . cdadar)
+ (caddr . cdaddr) (cdaar . cddaar) (cdadr . cddadr)
+ (cddar . cdddar) (cdddr . cddddr))))
+
+(defun cs-car/cdr (op exp table)
+ (if (and (consp exp) (= (length exp) 2))
+ (let ((replacement (assoc (car exp) table)))
+ (if replacement
+ `(,(cdr replacement) ,(second exp))
+ `(,op ,exp)))
+ `(,op ,exp)))
+
+;; (setf c1 '(select-match x (a 1) (b 2 3 4)))
+;; (setf c2 '(select-match (car y)
+;; (1 (print 100) 101) (2 200) ("hello" 5) (:x 20) (else (1+
+;; else))))
+;; (setf c3 '(select-match (caddr y)
+;; ((all = (x y)) (list x y all))
+;; ((a '= b) (list 'assign a b))
+;; ((#'oddp k) (1+ k)))))
+
+
diff --git a/vim/bundle/slimv/slime/swank/mkcl.lisp b/vim/bundle/slimv/slime/swank/mkcl.lisp
new file mode 100644
index 0000000..53696fb
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/mkcl.lisp
@@ -0,0 +1,933 @@
+;;;; -*- indent-tabs-mode: nil -*-
+;;;
+;;; swank-mkcl.lisp --- SLIME backend for MKCL.
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+;;; Administrivia
+
+(defpackage swank/mkcl
+ (:use cl swank/backend))
+
+(in-package swank/mkcl)
+
+;;(declaim (optimize (debug 3)))
+
+(defvar *tmp*)
+
+(defimplementation gray-package-name ()
+ '#:gray)
+
+(eval-when (:compile-toplevel :load-toplevel)
+
+ (swank/backend::import-swank-mop-symbols :clos
+ ;; '(:eql-specializer
+ ;; :eql-specializer-object
+ ;; :generic-function-declarations
+ ;; :specializer-direct-methods
+ ;; :compute-applicable-methods-using-classes)
+ nil
+ ))
+
+
+;;; UTF8
+
+(defimplementation string-to-utf8 (string)
+ (mkcl:octets (si:utf-8 string)))
+
+(defimplementation utf8-to-string (octets)
+ (string (si:utf-8 octets)))
+
+
+;;;; TCP Server
+
+(eval-when (:compile-toplevel :load-toplevel)
+ ;; At compile-time we need access to the sb-bsd-sockets package for the
+ ;; the following code to be read properly.
+ ;; It is a bit a shame we have to load the entire module to get that.
+ (require 'sockets))
+
+
+(defun resolve-hostname (name)
+ (car (sb-bsd-sockets:host-ent-addresses
+ (sb-bsd-sockets:get-host-by-name name))))
+
+(defimplementation create-socket (host port &key backlog)
+ (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+ :type :stream
+ :protocol :tcp)))
+ (setf (sb-bsd-sockets:sockopt-reuse-address socket) t)
+ (sb-bsd-sockets:socket-bind socket (resolve-hostname host) port)
+ (sb-bsd-sockets:socket-listen socket (or backlog 5))
+ socket))
+
+(defimplementation local-port (socket)
+ (nth-value 1 (sb-bsd-sockets:socket-name socket)))
+
+(defimplementation close-socket (socket)
+ (sb-bsd-sockets:socket-close socket))
+
+(defun accept (socket)
+ "Like socket-accept, but retry on EINTR."
+ (loop (handler-case
+ (return (sb-bsd-sockets:socket-accept socket))
+ (sb-bsd-sockets:interrupted-error ()))))
+
+(defimplementation accept-connection (socket
+ &key external-format
+ buffering timeout)
+ (declare (ignore timeout))
+ (sb-bsd-sockets:socket-make-stream (accept socket)
+ :output t ;; bogus
+ :input t ;; bogus
+ :buffering buffering ;; bogus
+ :element-type (if external-format
+ 'character
+ '(unsigned-byte 8))
+ :external-format external-format
+ ))
+
+(defimplementation preferred-communication-style ()
+ :spawn
+ )
+
+(defvar *external-format-to-coding-system*
+ '((:iso-8859-1
+ "latin-1" "latin-1-unix" "iso-latin-1-unix"
+ "iso-8859-1" "iso-8859-1-unix")
+ (:utf-8 "utf-8" "utf-8-unix")))
+
+(defun external-format (coding-system)
+ (or (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*))
+ (find coding-system (si:all-encodings) :test #'string-equal)))
+
+(defimplementation find-external-format (coding-system)
+ #+unicode (external-format coding-system)
+ ;; Without unicode support, MKCL uses the one-byte encoding of the
+ ;; underlying OS, and will barf on anything except :DEFAULT. We
+ ;; return NIL here for known multibyte encodings, so
+ ;; SWANK:CREATE-SERVER will barf.
+ #-unicode (let ((xf (external-format coding-system)))
+ (if (member xf '(:utf-8))
+ nil
+ :default)))
+
+
+
+;;;; Unix signals
+
+(defimplementation install-sigint-handler (handler)
+ (let ((old-handler (symbol-function 'si:terminal-interrupt)))
+ (setf (symbol-function 'si:terminal-interrupt)
+ (if (consp handler)
+ (car handler)
+ (lambda (&rest args)
+ (declare (ignore args))
+ (funcall handler)
+ (continue))))
+ (list old-handler)))
+
+
+(defimplementation getpid ()
+ (mkcl:getpid))
+
+(defimplementation set-default-directory (directory)
+ (mk-ext::chdir (namestring directory))
+ (default-directory))
+
+(defimplementation default-directory ()
+ (namestring (mk-ext:getcwd)))
+
+(defmacro progf (plist &rest forms)
+ `(let (_vars _vals)
+ (do ((p ,plist (cddr p)))
+ ((endp p))
+ (push (car p) _vars)
+ (push (cadr p) _vals))
+ (progv _vars _vals ,@forms)
+ )
+ )
+
+(defvar *inferior-lisp-sleeping-post* nil)
+
+(defimplementation quit-lisp ()
+ (progf (ignore-errors (eval (read-from-string "swank::*saved-global-streams*"))) ;; restore original IO streams.
+ (when *inferior-lisp-sleeping-post* (mt:semaphore-signal *inferior-lisp-sleeping-post*))
+ ;;(mk-ext:quit :verbose t)
+ ))
+
+
+;;;; Compilation
+
+(defvar *buffer-name* nil)
+(defvar *buffer-start-position*)
+(defvar *buffer-string*)
+(defvar *compile-filename*)
+
+(defun signal-compiler-condition (&rest args)
+ (signal (apply #'make-condition 'compiler-condition args)))
+
+#|
+(defun handle-compiler-warning (condition)
+ (signal-compiler-condition
+ :original-condition condition
+ :message (format nil "~A" condition)
+ :severity :warning
+ :location
+ (if *buffer-name*
+ (make-location (list :buffer *buffer-name*)
+ (list :offset *buffer-start-position* 0))
+ ;; ;; compiler::*current-form*
+ ;; (if compiler::*current-function*
+ ;; (make-location (list :file *compile-filename*)
+ ;; (list :function-name
+ ;; (symbol-name
+ ;; (slot-value compiler::*current-function*
+ ;; 'compiler::name))))
+ (list :error "No location found.")
+ ;; )
+ )))
+|#
+
+#|
+(defun condition-location (condition)
+ (let ((file (compiler:compiler-message-file condition))
+ (position (compiler:compiler-message-file-position condition)))
+ (if (and position (not (minusp position)))
+ (if *buffer-name*
+ (make-buffer-location *buffer-name*
+ *buffer-start-position*
+ position)
+ (make-file-location file position))
+ (make-error-location "No location found."))))
+|#
+
+(defun condition-location (condition)
+ (if *buffer-name*
+ (make-location (list :buffer *buffer-name*)
+ (list :offset *buffer-start-position* 0))
+ ;; ;; compiler::*current-form* ;
+ ;; (if compiler::*current-function* ;
+ ;; (make-location (list :file *compile-filename*) ;
+ ;; (list :function-name ;
+ ;; (symbol-name ;
+ ;; (slot-value compiler::*current-function* ;
+ ;; 'compiler::name)))) ;
+ (if (typep condition 'compiler::compiler-message)
+ (make-location (list :file (namestring (compiler:compiler-message-file condition)))
+ (list :end-position (compiler:compiler-message-file-end-position condition)))
+ (list :error "No location found."))
+ )
+ )
+
+(defun handle-compiler-message (condition)
+ (unless (typep condition 'compiler::compiler-note)
+ (signal-compiler-condition
+ :original-condition condition
+ :message (princ-to-string condition)
+ :severity (etypecase condition
+ (compiler:compiler-fatal-error :error)
+ (compiler:compiler-error :error)
+ (error :error)
+ (style-warning :style-warning)
+ (warning :warning))
+ :location (condition-location condition))))
+
+(defimplementation call-with-compilation-hooks (function)
+ (handler-bind ((compiler:compiler-message #'handle-compiler-message))
+ (funcall function)))
+
+(defimplementation swank-compile-file (input-file output-file
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* nil)
+ (*compile-filename* input-file))
+ (handler-bind (#|
+ (compiler::compiler-note
+ #'(lambda (n)
+ (format t "~%swank saw a compiler note: ~A~%" n) (finish-output) nil))
+ (compiler::compiler-warning
+ #'(lambda (w)
+ (format t "~%swank saw a compiler warning: ~A~%" w) (finish-output) nil))
+ (compiler::compiler-error
+ #'(lambda (e)
+ (format t "~%swank saw a compiler error: ~A~%" e) (finish-output) nil))
+ |#
+ )
+ (multiple-value-bind (output-truename warnings-p failure-p)
+ (compile-file input-file :output-file output-file :external-format external-format)
+ (values output-truename warnings-p
+ (or failure-p
+ (and load-p (not (load output-truename))))))))))
+
+(defimplementation swank-compile-string (string &key buffer position filename policy)
+ (declare (ignore filename policy))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer)
+ (*buffer-start-position* position)
+ (*buffer-string* string))
+ (with-input-from-string (s string)
+ (when position (file-position position))
+ (compile-from-stream s)))))
+
+(defun compile-from-stream (stream)
+ (let ((file (mkcl:mkstemp "TMP:MKCL-SWANK-TMPXXXXXX"))
+ output-truename
+ warnings-p
+ failure-p
+ )
+ (with-open-file (s file :direction :output :if-exists :overwrite)
+ (do ((line (read-line stream nil) (read-line stream nil)))
+ ((not line))
+ (write-line line s)))
+ (unwind-protect
+ (progn
+ (multiple-value-setq (output-truename warnings-p failure-p)
+ (compile-file file))
+ (and (not failure-p) (load output-truename)))
+ (when (probe-file file) (delete-file file))
+ (when (probe-file output-truename) (delete-file output-truename)))))
+
+
+;;;; Documentation
+
+(defun grovel-docstring-for-arglist (name type)
+ (flet ((compute-arglist-offset (docstring)
+ (when docstring
+ (let ((pos1 (search "Args: " docstring)))
+ (if pos1
+ (+ pos1 6)
+ (let ((pos2 (search "Syntax: " docstring)))
+ (when pos2
+ (+ pos2 8))))))))
+ (let* ((docstring (si::get-documentation name type))
+ (pos (compute-arglist-offset docstring)))
+ (if pos
+ (multiple-value-bind (arglist errorp)
+ (ignore-errors
+ (values (read-from-string docstring t nil :start pos)))
+ (if (or errorp (not (listp arglist)))
+ :not-available
+ arglist
+ ))
+ :not-available ))))
+
+(defimplementation arglist (name)
+ (cond ((and (symbolp name) (special-operator-p name))
+ (let ((arglist (grovel-docstring-for-arglist name 'function)))
+ (if (consp arglist) (cdr arglist) arglist)))
+ ((and (symbolp name) (macro-function name))
+ (let ((arglist (grovel-docstring-for-arglist name 'function)))
+ (if (consp arglist) (cdr arglist) arglist)))
+ ((or (functionp name) (fboundp name))
+ (multiple-value-bind (name fndef)
+ (if (functionp name)
+ (values (function-name name) name)
+ (values name (fdefinition name)))
+ (let ((fle (function-lambda-expression fndef)))
+ (case (car fle)
+ (si:lambda-block (caddr fle))
+ (t (typecase fndef
+ (generic-function (clos::generic-function-lambda-list fndef))
+ (compiled-function (grovel-docstring-for-arglist name 'function))
+ (function :not-available)))))))
+ (t :not-available)))
+
+(defimplementation function-name (f)
+ (si:compiled-function-name f)
+ )
+
+(eval-when (:compile-toplevel :load-toplevel)
+ ;; At compile-time we need access to the walker package for the
+ ;; the following code to be read properly.
+ ;; It is a bit a shame we have to load the entire module to get that.
+ (require 'walker))
+
+(defimplementation macroexpand-all (form &optional env)
+ (declare (ignore env))
+ (walker:macroexpand-all form))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (dolist (type '(:VARIABLE :FUNCTION :CLASS))
+ (let ((doc (describe-definition symbol type)))
+ (when doc
+ (setf result (list* type doc result)))))
+ result))
+
+(defimplementation describe-definition (name type)
+ (case type
+ (:variable (documentation name 'variable))
+ (:function (documentation name 'function))
+ (:class (documentation name 'class))
+ (t nil)))
+
+;;; Debugging
+
+(eval-when (:compile-toplevel :load-toplevel)
+ (import
+ '(si::*break-env*
+ si::*ihs-top*
+ si::*ihs-current*
+ si::*ihs-base*
+ si::*frs-base*
+ si::*frs-top*
+ si::*tpl-commands*
+ si::*tpl-level*
+ si::frs-top
+ si::ihs-top
+ si::ihs-fun
+ si::ihs-env
+ si::sch-frs-base
+ si::set-break-env
+ si::set-current-ihs
+ si::tpl-commands)))
+
+(defvar *backtrace* '())
+
+(defun in-swank-package-p (x)
+ (and
+ (symbolp x)
+ (member (symbol-package x)
+ (list #.(find-package :swank)
+ #.(find-package :swank/backend)
+ #.(ignore-errors (find-package :swank-mop))
+ #.(ignore-errors (find-package :swank-loader))))
+ t))
+
+(defun is-swank-source-p (name)
+ (setf name (pathname name))
+ #+(or)
+ (pathname-match-p
+ name
+ (make-pathname :defaults swank-loader::*source-directory*
+ :name (pathname-name name)
+ :type (pathname-type name)
+ :version (pathname-version name)))
+ nil)
+
+(defun is-ignorable-fun-p (x)
+ (or
+ (in-swank-package-p (frame-name x))
+ (multiple-value-bind (file position)
+ (ignore-errors (si::compiled-function-file (car x)))
+ (declare (ignore position))
+ (if file (is-swank-source-p file)))))
+
+(defmacro find-ihs-top (x)
+ (declare (ignore x))
+ '(si::ihs-top))
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (declare (type function debugger-loop-fn))
+ (let* (;;(*tpl-commands* si::tpl-commands)
+ (*ihs-base* 0)
+ (*ihs-top* (find-ihs-top 'call-with-debugging-environment))
+ (*ihs-current* *ihs-top*)
+ (*frs-base* (or (sch-frs-base 0 #|*frs-top*|# *ihs-base*) (1+ (frs-top))))
+ (*frs-top* (frs-top))
+ (*read-suppress* nil)
+ ;;(*tpl-level* (1+ *tpl-level*))
+ (*backtrace* (loop for ihs from 0 below *ihs-top*
+ collect (list (si::ihs-fun ihs)
+ (si::ihs-env ihs)
+ nil))))
+ (declare (special *ihs-current*))
+ (loop for f from *frs-base* to *frs-top*
+ do (let ((i (- (si::frs-ihs f) *ihs-base* 1)))
+ (when (plusp i)
+ (let* ((x (elt *backtrace* i))
+ (name (si::frs-tag f)))
+ (unless (mkcl:fixnump name)
+ (push name (third x)))))))
+ (setf *backtrace* (remove-if #'is-ignorable-fun-p (nreverse *backtrace*)))
+ (setf *tmp* *backtrace*)
+ (set-break-env)
+ (set-current-ihs)
+ (let ((*ihs-base* *ihs-top*))
+ (funcall debugger-loop-fn))))
+
+(defimplementation call-with-debugger-hook (hook fun)
+ (let ((*debugger-hook* hook)
+ (*ihs-base* (find-ihs-top 'call-with-debugger-hook)))
+ (funcall fun)))
+
+(defimplementation compute-backtrace (start end)
+ (when (numberp end)
+ (setf end (min end (length *backtrace*))))
+ (loop for f in (subseq *backtrace* start end)
+ collect f))
+
+(defimplementation format-sldb-condition (condition)
+ "Format a condition for display in SLDB."
+ ;;(princ-to-string condition)
+ (format nil "~A~%In thread: ~S" condition mt:*thread*)
+ )
+
+(defun frame-name (frame)
+ (let ((x (first frame)))
+ (if (symbolp x)
+ x
+ (function-name x))))
+
+(defun function-position (fun)
+ (multiple-value-bind (file position)
+ (si::compiled-function-file fun)
+ (and file (make-location
+ `(:file ,(if (stringp file) file (namestring file)))
+ ;;`(:position ,position)
+ `(:end-position , position)))))
+
+(defun frame-function (frame)
+ (let* ((x (first frame))
+ fun position)
+ (etypecase x
+ (symbol (and (fboundp x)
+ (setf fun (fdefinition x)
+ position (function-position fun))))
+ (function (setf fun x position (function-position x))))
+ (values fun position)))
+
+(defun frame-decode-env (frame)
+ (let ((functions '())
+ (blocks '())
+ (variables '()))
+ (setf frame (si::decode-ihs-env (second frame)))
+ (dolist (record frame)
+ (let* ((record0 (car record))
+ (record1 (cdr record)))
+ (cond ((or (symbolp record0) (stringp record0))
+ (setq variables (acons record0 record1 variables)))
+ ((not (mkcl:fixnump record0))
+ (push record1 functions))
+ ((symbolp record1)
+ (push record1 blocks))
+ (t
+ ))))
+ (values functions blocks variables)))
+
+(defimplementation print-frame (frame stream)
+ (let ((function (first frame)))
+ (let ((fname
+;;; (cond ((symbolp function) function)
+;;; ((si:instancep function) (slot-value function 'name))
+;;; ((compiled-function-p function)
+;;; (or (si::compiled-function-name function) 'lambda))
+;;; (t :zombi))
+ (si::get-fname function)
+ ))
+ (if (eq fname 'si::bytecode)
+ (format stream "~A [Evaluation of: ~S]"
+ fname (function-lambda-expression function))
+ (format stream "~A" fname)
+ )
+ (when (si::closurep function)
+ (format stream
+ ", closure generated from ~A"
+ (si::get-fname (si:closure-producer function)))
+ )
+ )
+ )
+ )
+
+(defimplementation frame-source-location (frame-number)
+ (nth-value 1 (frame-function (elt *backtrace* frame-number))))
+
+(defimplementation frame-catch-tags (frame-number)
+ (third (elt *backtrace* frame-number)))
+
+(defimplementation frame-locals (frame-number)
+ (loop for (name . value) in (nth-value 2 (frame-decode-env (elt *backtrace* frame-number)))
+ with i = 0
+ collect (list :name name :id (prog1 i (incf i)) :value value)))
+
+(defimplementation frame-var-value (frame-number var-id)
+ (cdr (elt (nth-value 2 (frame-decode-env (elt *backtrace* frame-number))) var-id)))
+
+(defimplementation disassemble-frame (frame-number)
+ (let ((fun (frame-fun (elt *backtrace* frame-number))))
+ (disassemble fun)))
+
+(defimplementation eval-in-frame (form frame-number)
+ (let ((env (second (elt *backtrace* frame-number))))
+ (si:eval-in-env form env)))
+
+#|
+(defimplementation gdb-initial-commands ()
+ ;; These signals are used by the GC.
+ #+linux '("handle SIGPWR noprint nostop"
+ "handle SIGXCPU noprint nostop"))
+
+(defimplementation command-line-args ()
+ (loop for n from 0 below (si:argc) collect (si:argv n)))
+|#
+
+;;;; Inspector
+
+(defmethod emacs-inspect ((o t))
+ ; ecl clos support leaves some to be desired
+ (cond
+ ((streamp o)
+ (list*
+ (format nil "~S is an ordinary stream~%" o)
+ (append
+ (list
+ "Open for "
+ (cond
+ ((ignore-errors (interactive-stream-p o)) "Interactive")
+ ((and (input-stream-p o) (output-stream-p o)) "Input and output")
+ ((input-stream-p o) "Input")
+ ((output-stream-p o) "Output"))
+ `(:newline) `(:newline))
+ (label-value-line*
+ ("Element type" (stream-element-type o))
+ ("External format" (stream-external-format o)))
+ (ignore-errors (label-value-line*
+ ("Broadcast streams" (broadcast-stream-streams o))))
+ (ignore-errors (label-value-line*
+ ("Concatenated streams" (concatenated-stream-streams o))))
+ (ignore-errors (label-value-line*
+ ("Echo input stream" (echo-stream-input-stream o))))
+ (ignore-errors (label-value-line*
+ ("Echo output stream" (echo-stream-output-stream o))))
+ (ignore-errors (label-value-line*
+ ("Output String" (get-output-stream-string o))))
+ (ignore-errors (label-value-line*
+ ("Synonym symbol" (synonym-stream-symbol o))))
+ (ignore-errors (label-value-line*
+ ("Input stream" (two-way-stream-input-stream o))))
+ (ignore-errors (label-value-line*
+ ("Output stream" (two-way-stream-output-stream o)))))))
+ ((si:instancep o) ;;t
+ (let* ((cl (si:instance-class o))
+ (slots (clos::class-slots cl)))
+ (list* (format nil "~S is an instance of class ~A~%"
+ o (clos::class-name cl))
+ (loop for x in slots append
+ (let* ((name (clos::slot-definition-name x))
+ (value (if (slot-boundp o name)
+ (clos::slot-value o name)
+ "Unbound"
+ )))
+ (list
+ (format nil "~S: " name)
+ `(:value ,value)
+ `(:newline)))))))
+ (t (list (format nil "~A" o)))))
+
+;;;; Definitions
+
+(defimplementation find-definitions (name)
+ (if (fboundp name)
+ (let ((tmp (find-source-location (symbol-function name))))
+ `(((defun ,name) ,tmp)))))
+
+(defimplementation find-source-location (obj)
+ (setf *tmp* obj)
+ (or
+ (typecase obj
+ (function
+ (multiple-value-bind (file pos) (ignore-errors (si::compiled-function-file obj))
+ (if (and file pos)
+ (make-location
+ `(:file ,(if (stringp file) file (namestring file)))
+ `(:end-position ,pos) ;; `(:position ,pos)
+ `(:snippet
+ ,(with-open-file (s file)
+ (file-position s pos)
+ (skip-comments-and-whitespace s)
+ (read-snippet s))))))))
+ `(:error (format nil "Source definition of ~S not found" obj))))
+
+;;;; Profiling
+
+
+(eval-when (:compile-toplevel :load-toplevel)
+ ;; At compile-time we need access to the profile package for the
+ ;; the following code to be read properly.
+ ;; It is a bit a shame we have to load the entire module to get that.
+ (require 'profile))
+
+
+(defimplementation profile (fname)
+ (when fname (eval `(profile:profile ,fname))))
+
+(defimplementation unprofile (fname)
+ (when fname (eval `(profile:unprofile ,fname))))
+
+(defimplementation unprofile-all ()
+ (profile:unprofile-all)
+ "All functions unprofiled.")
+
+(defimplementation profile-report ()
+ (profile:report))
+
+(defimplementation profile-reset ()
+ (profile:reset)
+ "Reset profiling counters.")
+
+(defimplementation profiled-functions ()
+ (profile:profile))
+
+(defimplementation profile-package (package callers methods)
+ (declare (ignore callers methods))
+ (eval `(profile:profile ,(package-name (find-package package)))))
+
+
+;;;; Threads
+
+(defvar *thread-id-counter* 0)
+
+(defvar *thread-id-counter-lock*
+ (mt:make-lock :name "thread id counter lock"))
+
+(defun next-thread-id ()
+ (mt:with-lock (*thread-id-counter-lock*)
+ (incf *thread-id-counter*))
+ )
+
+(defparameter *thread-id-map* (make-hash-table))
+(defparameter *id-thread-map* (make-hash-table))
+
+(defvar *thread-id-map-lock*
+ (mt:make-lock :name "thread id map lock"))
+
+(defparameter +default-thread-local-variables+
+ '(*macroexpand-hook*
+ *default-pathname-defaults*
+ *readtable*
+ *random-state*
+ *compile-print*
+ *compile-verbose*
+ *load-print*
+ *load-verbose*
+ *print-array*
+ *print-base*
+ *print-case*
+ *print-circle*
+ *print-escape*
+ *print-gensym*
+ *print-length*
+ *print-level*
+ *print-lines*
+ *print-miser-width*
+ *print-pprint-dispatch*
+ *print-pretty*
+ *print-radix*
+ *print-readably*
+ *print-right-margin*
+ *read-base*
+ *read-default-float-format*
+ *read-eval*
+ *read-suppress*
+ ))
+
+(defun thread-local-default-bindings ()
+ (let (local)
+ (dolist (var +default-thread-local-variables+ local)
+ (setq local (acons var (symbol-value var) local))
+ )))
+
+;; mkcl doesn't have weak pointers
+(defimplementation spawn (fn &key name initial-bindings)
+ (let* ((local-defaults (thread-local-default-bindings))
+ (thread
+ ;;(mt:make-thread :name name)
+ (mt:make-thread :name name
+ :initial-bindings (nconc initial-bindings
+ local-defaults))
+ )
+ (id (next-thread-id)))
+ (mt:with-lock (*thread-id-map-lock*)
+ (setf (gethash id *thread-id-map*) thread)
+ (setf (gethash thread *id-thread-map*) id))
+ (mt:thread-preset
+ thread
+ #'(lambda ()
+ (unwind-protect
+ (progn
+ ;;(format t "~&Starting thread: ~S.~%" name) (finish-output)
+ (mt:thread-detach nil)
+ (funcall fn))
+ (progn
+ ;;(format t "~&Wrapping up thread: ~S.~%" name) (finish-output)
+ (mt:with-lock (*thread-id-map-lock*)
+ (remhash thread *id-thread-map*)
+ (remhash id *thread-id-map*))
+ ;;(format t "~&Finished thread: ~S~%" name) (finish-output)
+ ))))
+ (mt:thread-enable thread)
+ (mt:thread-yield)
+ thread
+ ))
+
+(defimplementation thread-id (thread)
+ (block thread-id
+ (mt:with-lock (*thread-id-map-lock*)
+ (or (gethash thread *id-thread-map*)
+ (let ((id (next-thread-id)))
+ (setf (gethash id *thread-id-map*) thread)
+ (setf (gethash thread *id-thread-map*) id)
+ id)))))
+
+(defimplementation find-thread (id)
+ (mt:with-lock (*thread-id-map-lock*)
+ (gethash id *thread-id-map*)))
+
+(defimplementation thread-name (thread)
+ (mt:thread-name thread))
+
+(defimplementation thread-status (thread)
+ (if (mt:thread-active-p thread)
+ "RUNNING"
+ "STOPPED"))
+
+(defimplementation make-lock (&key name)
+ (mt:make-lock :name name :recursive t))
+
+(defimplementation call-with-lock-held (lock function)
+ (declare (type function function))
+ (mt:with-lock (lock) (funcall function)))
+
+(defimplementation current-thread ()
+ mt:*thread*)
+
+(defimplementation all-threads ()
+ (mt:all-threads))
+
+(defimplementation interrupt-thread (thread fn)
+ (mt:interrupt-thread thread fn))
+
+(defimplementation kill-thread (thread)
+ (mt:interrupt-thread thread #'mt:terminate-thread)
+ )
+
+(defimplementation thread-alive-p (thread)
+ (mt:thread-active-p thread))
+
+(defvar *mailbox-lock* (mt:make-lock :name "mailbox lock"))
+(defvar *mailboxes* (list))
+(declaim (type list *mailboxes*))
+
+(defstruct (mailbox (:conc-name mailbox.))
+ thread
+ locked-by
+ (mutex (mt:make-lock :name "thread mailbox"))
+ (semaphore (mt:make-semaphore))
+ (queue '() :type list))
+
+(defun mailbox (thread)
+ "Return THREAD's mailbox."
+ (mt:with-lock (*mailbox-lock*)
+ (or (find thread *mailboxes* :key #'mailbox.thread)
+ (let ((mb (make-mailbox :thread thread)))
+ (push mb *mailboxes*)
+ mb))))
+
+(defimplementation send (thread message)
+ (handler-case
+ (let* ((mbox (mailbox thread))
+ (mutex (mailbox.mutex mbox)))
+;; (mt:interrupt-thread
+;; thread
+;; (lambda ()
+;; (mt:with-lock (mutex)
+;; (setf (mailbox.queue mbox)
+;; (nconc (mailbox.queue mbox) (list message))))))
+
+;; (format t "~&! thread = ~S~% thread = ~S~% message = ~S~%"
+;; mt:*thread* thread message) (finish-output)
+ (mt:with-lock (mutex)
+ (setf (mailbox.locked-by mbox) mt:*thread*)
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message)))
+ ;;(format t "*") (finish-output)
+ (handler-case
+ (mt:semaphore-signal (mailbox.semaphore mbox))
+ (condition (condition)
+ (format t "Something went bad with semaphore-signal ~A" condition) (finish-output)
+ ;;(break)
+ ))
+ (setf (mailbox.locked-by mbox) nil)
+ )
+ ;;(format t "+") (finish-output)
+ )
+ (condition (condition)
+ (format t "~&Error in send: ~S~%" condition) (finish-output))
+ )
+ )
+
+;; (defimplementation receive ()
+;; (block got-mail
+;; (let* ((mbox (mailbox mt:*thread*))
+;; (mutex (mailbox.mutex mbox)))
+;; (loop
+;; (mt:with-lock (mutex)
+;; (if (mailbox.queue mbox)
+;; (return-from got-mail (pop (mailbox.queue mbox)))))
+;; ;;interrupt-thread will halt this if it takes longer than 1sec
+;; (sleep 1)))))
+
+
+(defimplementation receive-if (test &optional timeout)
+ (handler-case
+ (let* ((mbox (mailbox (current-thread)))
+ (mutex (mailbox.mutex mbox))
+ got-one)
+ (assert (or (not timeout) (eq timeout t)))
+ (loop
+ (check-slime-interrupts)
+ ;;(format t "~&: ~S~%" mt:*thread*) (finish-output)
+ (handler-case
+ (setq got-one (mt:semaphore-wait (mailbox.semaphore mbox) 2))
+ (condition (condition)
+ (format t "~&In (swank-mkcl) receive-if: Something went bad with semaphore-wait ~A~%" condition)
+ (finish-output)
+ nil
+ )
+ )
+ (mt:with-lock (mutex)
+ (setf (mailbox.locked-by mbox) mt:*thread*)
+ (let* ((q (mailbox.queue mbox))
+ (tail (member-if test q)))
+ (when tail
+ (setf (mailbox.queue mbox) (nconc (ldiff q tail) (cdr tail)))
+ (setf (mailbox.locked-by mbox) nil)
+ ;;(format t "~&thread ~S received: ~S~%" mt:*thread* (car tail))
+ (return (car tail))))
+ (setf (mailbox.locked-by mbox) nil)
+ )
+
+ ;;(format t "/ ~S~%" mt:*thread*) (finish-output)
+ (when (eq timeout t) (return (values nil t)))
+;; (unless got-one
+;; (format t "~&In (swank-mkcl) receive-if: semaphore-wait timed out!~%"))
+ )
+ )
+ (condition (condition)
+ (format t "~&Error in (swank-mkcl) receive-if: ~S, ~A~%" condition condition) (finish-output)
+ nil
+ )
+ )
+ )
+
+
+(defmethod stream-finish-output ((stream stream))
+ (finish-output stream))
+
+
+;;
+
+;;#+windows
+(defimplementation doze-in-repl ()
+ (setq *inferior-lisp-sleeping-post* (mt:make-semaphore))
+ ;;(loop (sleep 1))
+ (mt:semaphore-wait *inferior-lisp-sleeping-post*)
+ (mk-ext:quit :verbose t)
+ )
+
diff --git a/vim/bundle/slimv/slime/swank/rpc.lisp b/vim/bundle/slimv/slime/swank/rpc.lisp
new file mode 100644
index 0000000..e30cc2c
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/rpc.lisp
@@ -0,0 +1,162 @@
+;;; -*- indent-tabs-mode: nil; coding: latin-1-unix -*-
+;;;
+;;; swank-rpc.lisp -- Pass remote calls and responses between lisp systems.
+;;;
+;;; Created 2010, Terje Norderhaug <terje@in-progress.com>
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+(in-package swank/rpc)
+
+
+;;;;; Input
+
+(define-condition swank-reader-error (reader-error)
+ ((packet :type string :initarg :packet
+ :reader swank-reader-error.packet)
+ (cause :type reader-error :initarg :cause
+ :reader swank-reader-error.cause)))
+
+(defun read-message (stream package)
+ (let ((packet (read-packet stream)))
+ (handler-case (values (read-form packet package))
+ (reader-error (c)
+ (error 'swank-reader-error
+ :packet packet :cause c)))))
+
+(defun read-packet (stream)
+ (let* ((length (parse-header stream))
+ (octets (read-chunk stream length)))
+ (handler-case (swank/backend:utf8-to-string octets)
+ (error (c)
+ (error 'swank-reader-error
+ :packet (asciify octets)
+ :cause c)))))
+
+(defun asciify (packet)
+ (with-output-to-string (*standard-output*)
+ (loop for code across (etypecase packet
+ (string (map 'vector #'char-code packet))
+ (vector packet))
+ do (cond ((<= code #x7f) (write-char (code-char code)))
+ (t (format t "\\x~x" code))))))
+
+(defun parse-header (stream)
+ (parse-integer (map 'string #'code-char (read-chunk stream 6))
+ :radix 16))
+
+(defun read-chunk (stream length)
+ (let* ((buffer (make-array length :element-type '(unsigned-byte 8)))
+ (count (read-sequence buffer stream)))
+ (cond ((= count length)
+ buffer)
+ ((zerop count)
+ (error 'end-of-file :stream stream))
+ (t
+ (error "Short read: length=~D count=~D" length count)))))
+
+(defparameter *validate-input* nil
+ "Set to true to require input that more strictly conforms to the protocol")
+
+(defun read-form (string package)
+ (with-standard-io-syntax
+ (let ((*package* package))
+ (if *validate-input*
+ (validating-read string)
+ (read-from-string string)))))
+
+(defun validating-read (string)
+ (with-input-from-string (*standard-input* string)
+ (simple-read)))
+
+(defun simple-read ()
+ "Read a form that conforms to the protocol, otherwise signal an error."
+ (let ((c (read-char)))
+ (case c
+ (#\( (loop collect (simple-read)
+ while (ecase (read-char)
+ (#\) nil)
+ (#\space t))))
+ (#\' `(quote ,(simple-read)))
+ (t
+ (cond
+ ((digit-char-p c)
+ (parse-integer
+ (map 'simple-string #'identity
+ (loop for ch = c then (read-char nil nil)
+ while (and ch (digit-char-p ch))
+ collect ch
+ finally (unread-char ch)))))
+ ((or (member c '(#\: #\")) (alpha-char-p c))
+ (unread-char c)
+ (read-preserving-whitespace))
+ (t (error "Invalid character ~:c" c)))))))
+
+
+;;;;; Output
+
+(defun write-message (message package stream)
+ (let* ((string (prin1-to-string-for-emacs message package))
+ (octets (handler-case (swank/backend:string-to-utf8 string)
+ (error (c) (encoding-error c string))))
+ (length (length octets)))
+ (write-header stream length)
+ (write-sequence octets stream)
+ (finish-output stream)))
+
+;; FIXME: for now just tell emacs that we and an encoding problem.
+(defun encoding-error (condition string)
+ (swank/backend:string-to-utf8
+ (prin1-to-string-for-emacs
+ `(:reader-error
+ ,(asciify string)
+ ,(format nil "Error during string-to-utf8: ~a"
+ (or (ignore-errors (asciify (princ-to-string condition)))
+ (asciify (princ-to-string (type-of condition))))))
+ (find-package :cl))))
+
+(defun write-header (stream length)
+ (declare (type (unsigned-byte 24) length))
+ ;;(format *trace-output* "length: ~d (#x~x)~%" length length)
+ (loop for c across (format nil "~6,'0x" length)
+ do (write-byte (char-code c) stream)))
+
+(defun switch-to-double-floats (x)
+ (typecase x
+ (double-float x)
+ (float (coerce x 'double-float))
+ (null x)
+ (list (loop for (x . cdr) on x
+ collect (switch-to-double-floats x) into result
+ until (atom cdr)
+ finally (return (append result (switch-to-double-floats cdr)))))
+ (t x)))
+
+(defun prin1-to-string-for-emacs (object package)
+ (with-standard-io-syntax
+ (let ((*print-case* :downcase)
+ (*print-readably* nil)
+ (*print-pretty* nil)
+ (*package* package)
+ ;; Emacs has only double floats.
+ (*read-default-float-format* 'double-float))
+ (prin1-to-string (switch-to-double-floats object)))))
+
+
+#| TEST/DEMO:
+
+(defparameter *transport*
+ (with-output-to-string (out)
+ (write-message '(:message (hello "world")) *package* out)
+ (write-message '(:return 5) *package* out)
+ (write-message '(:emacs-rex NIL) *package* out)))
+
+*transport*
+
+(with-input-from-string (in *transport*)
+ (loop while (peek-char T in NIL)
+ collect (read-message in *package*)))
+
+|#
diff --git a/vim/bundle/slimv/slime/swank/sbcl.lisp b/vim/bundle/slimv/slime/swank/sbcl.lisp
new file mode 100644
index 0000000..b54fcd5
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/sbcl.lisp
@@ -0,0 +1,2044 @@
+;;;;; -*- indent-tabs-mode: nil -*-
+;;;
+;;; swank-sbcl.lisp --- SLIME backend for SBCL.
+;;;
+;;; Created 2003, Daniel Barlow <dan@metacircles.com>
+;;;
+;;; This code has been placed in the Public Domain. All warranties are
+;;; disclaimed.
+
+;;; Requires the SB-INTROSPECT contrib.
+
+;;; Administrivia
+
+(defpackage swank/sbcl
+ (:use cl swank/backend swank/source-path-parser swank/source-file-cache))
+
+(in-package swank/sbcl)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (require 'sb-bsd-sockets)
+ (require 'sb-introspect)
+ (require 'sb-posix)
+ (require 'sb-cltl2))
+
+(declaim (optimize (debug 2)
+ (sb-c::insert-step-conditions 0)
+ (sb-c::insert-debug-catch 0)))
+
+;;; backwards compability tests
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ ;; Generate a form suitable for testing for stepper support (0.9.17)
+ ;; with #+.
+ (defun sbcl-with-new-stepper-p ()
+ (with-symbol 'enable-stepping 'sb-impl))
+ ;; Ditto for weak hash-tables
+ (defun sbcl-with-weak-hash-tables ()
+ (with-symbol 'hash-table-weakness 'sb-ext))
+ ;; And for xref support (1.0.1)
+ (defun sbcl-with-xref-p ()
+ (with-symbol 'who-calls 'sb-introspect))
+ ;; ... for restart-frame support (1.0.2)
+ (defun sbcl-with-restart-frame ()
+ (with-symbol 'frame-has-debug-tag-p 'sb-debug))
+ ;; ... for :setf :inverse info (1.1.17)
+ (defun sbcl-with-setf-inverse-meta-info ()
+ (boolean-to-feature-expression
+ ;; going through FIND-SYMBOL since META-INFO was renamed from
+ ;; TYPE-INFO in 1.2.10.
+ (let ((sym (find-symbol "META-INFO" "SB-C")))
+ (and sym
+ (fboundp sym)
+ (funcall sym :setf :inverse ()))))))
+
+;;; swank-mop
+
+(import-swank-mop-symbols :sb-mop '(:slot-definition-documentation))
+
+(defun swank-mop:slot-definition-documentation (slot)
+ (sb-pcl::documentation slot t))
+
+;; stream support
+
+(defimplementation gray-package-name ()
+ "SB-GRAY")
+
+;; Pretty printer calls this, apparently
+(defmethod sb-gray:stream-line-length
+ ((s sb-gray:fundamental-character-input-stream))
+ nil)
+
+;;; Connection info
+
+(defimplementation lisp-implementation-type-name ()
+ "sbcl")
+
+;; Declare return type explicitly to shut up STYLE-WARNINGS about
+;; %SAP-ALIEN in ENABLE-SIGIO-ON-FD below.
+(declaim (ftype (function () (values (signed-byte 32) &optional)) getpid))
+(defimplementation getpid ()
+ (sb-posix:getpid))
+
+;;; UTF8
+
+(defimplementation string-to-utf8 (string)
+ (sb-ext:string-to-octets string :external-format :utf8))
+
+(defimplementation utf8-to-string (octets)
+ (sb-ext:octets-to-string octets :external-format :utf8))
+
+;;; TCP Server
+
+(defimplementation preferred-communication-style ()
+ (cond
+ ;; fixme: when SBCL/win32 gains better select() support, remove
+ ;; this.
+ ((member :sb-thread *features*) :spawn)
+ ((member :win32 *features*) nil)
+ (t :fd-handler)))
+
+(defun resolve-hostname (name)
+ (car (sb-bsd-sockets:host-ent-addresses
+ (sb-bsd-sockets:get-host-by-name name))))
+
+(defimplementation create-socket (host port &key backlog)
+ (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+ :type :stream
+ :protocol :tcp)))
+ (setf (sb-bsd-sockets:sockopt-reuse-address socket) t)
+ (sb-bsd-sockets:socket-bind socket (resolve-hostname host) port)
+ (sb-bsd-sockets:socket-listen socket (or backlog 5))
+ socket))
+
+(defimplementation local-port (socket)
+ (nth-value 1 (sb-bsd-sockets:socket-name socket)))
+
+(defimplementation close-socket (socket)
+ (sb-sys:invalidate-descriptor (socket-fd socket))
+ (sb-bsd-sockets:socket-close socket))
+
+(defimplementation accept-connection (socket &key
+ external-format
+ buffering timeout)
+ (declare (ignore timeout))
+ (make-socket-io-stream (accept socket) external-format
+ (ecase buffering
+ ((t :full) :full)
+ ((nil :none) :none)
+ ((:line) :line))))
+
+
+;; The SIGIO stuff should probably be removed as it's unlikey that
+;; anybody uses it.
+#-win32
+(progn
+ (defimplementation install-sigint-handler (function)
+ (sb-sys:enable-interrupt sb-unix:sigint
+ (lambda (&rest args)
+ (declare (ignore args))
+ (sb-sys:invoke-interruption
+ (lambda ()
+ (sb-sys:with-interrupts
+ (funcall function)))))))
+
+ (defvar *sigio-handlers* '()
+ "List of (key . fn) pairs to be called on SIGIO.")
+
+ (defun sigio-handler (signal code scp)
+ (declare (ignore signal code scp))
+ (sb-sys:with-interrupts
+ (mapc (lambda (handler)
+ (funcall (the function (cdr handler))))
+ *sigio-handlers*)))
+
+ (defun set-sigio-handler ()
+ (sb-sys:enable-interrupt sb-unix:sigio #'sigio-handler))
+
+ (defun enable-sigio-on-fd (fd)
+ (sb-posix::fcntl fd sb-posix::f-setfl sb-posix::o-async)
+ (sb-posix::fcntl fd sb-posix::f-setown (getpid))
+ (values))
+
+ (defimplementation add-sigio-handler (socket fn)
+ (set-sigio-handler)
+ (let ((fd (socket-fd socket)))
+ (enable-sigio-on-fd fd)
+ (push (cons fd fn) *sigio-handlers*)))
+
+ (defimplementation remove-sigio-handlers (socket)
+ (let ((fd (socket-fd socket)))
+ (setf *sigio-handlers* (delete fd *sigio-handlers* :key #'car))
+ (sb-sys:invalidate-descriptor fd))
+ (close socket)))
+
+
+(defimplementation add-fd-handler (socket fun)
+ (let ((fd (socket-fd socket))
+ (handler nil))
+ (labels ((add ()
+ (setq handler (sb-sys:add-fd-handler fd :input #'run)))
+ (run (fd)
+ (sb-sys:remove-fd-handler handler) ; prevent recursion
+ (unwind-protect
+ (funcall fun)
+ (when (sb-unix:unix-fstat fd) ; still open?
+ (add)))))
+ (add))))
+
+(defimplementation remove-fd-handlers (socket)
+ (sb-sys:invalidate-descriptor (socket-fd socket)))
+
+(defimplementation socket-fd (socket)
+ (etypecase socket
+ (fixnum socket)
+ (sb-bsd-sockets:socket (sb-bsd-sockets:socket-file-descriptor socket))
+ (file-stream (sb-sys:fd-stream-fd socket))))
+
+(defimplementation command-line-args ()
+ sb-ext:*posix-argv*)
+
+(defimplementation dup (fd)
+ (sb-posix:dup fd))
+
+(defvar *wait-for-input-called*)
+
+(defimplementation wait-for-input (streams &optional timeout)
+ (assert (member timeout '(nil t)))
+ (when (boundp '*wait-for-input-called*)
+ (setq *wait-for-input-called* t))
+ (let ((*wait-for-input-called* nil))
+ (loop
+ (let ((ready (remove-if-not #'input-ready-p streams)))
+ (when ready (return ready)))
+ (when (check-slime-interrupts)
+ (return :interrupt))
+ (when *wait-for-input-called*
+ (return :interrupt))
+ (when timeout
+ (return nil))
+ (sleep 0.1))))
+
+(defun fd-stream-input-buffer-empty-p (stream)
+ (let ((buffer (sb-impl::fd-stream-ibuf stream)))
+ (or (not buffer)
+ (= (sb-impl::buffer-head buffer)
+ (sb-impl::buffer-tail buffer)))))
+
+#-win32
+(defun input-ready-p (stream)
+ (or (not (fd-stream-input-buffer-empty-p stream))
+ #+#.(swank/backend:with-symbol 'fd-stream-fd-type 'sb-impl)
+ (eq :regular (sb-impl::fd-stream-fd-type stream))
+ (not (sb-impl::sysread-may-block-p stream))))
+
+#+win32
+(progn
+ (defun input-ready-p (stream)
+ (or (not (fd-stream-input-buffer-empty-p stream))
+ (handle-listen (sockint::fd->handle (sb-impl::fd-stream-fd stream)))))
+
+ (sb-alien:define-alien-routine ("WSACreateEvent" wsa-create-event)
+ sb-win32:handle)
+
+ (sb-alien:define-alien-routine ("WSACloseEvent" wsa-close-event)
+ sb-alien:int
+ (event sb-win32:handle))
+
+ (defconstant +fd-read+ #.(ash 1 0))
+ (defconstant +fd-close+ #.(ash 1 5))
+
+ (sb-alien:define-alien-routine ("WSAEventSelect" wsa-event-select)
+ sb-alien:int
+ (fd sb-alien:int)
+ (handle sb-win32:handle)
+ (mask sb-alien:long))
+
+ (sb-alien:load-shared-object "kernel32.dll")
+ (sb-alien:define-alien-routine ("WaitForSingleObjectEx"
+ wait-for-single-object-ex)
+ sb-alien:int
+ (event sb-win32:handle)
+ (milliseconds sb-alien:long)
+ (alertable sb-alien:int))
+
+ ;; see SB-WIN32:HANDLE-LISTEN
+ (defun handle-listen (handle)
+ (sb-alien:with-alien ((avail sb-win32:dword)
+ (buf (array char #.sb-win32::input-record-size)))
+ (unless (zerop (sb-win32:peek-named-pipe handle nil 0 nil
+ (sb-alien:alien-sap
+ (sb-alien:addr avail))
+ nil))
+ (return-from handle-listen (plusp avail)))
+
+ (unless (zerop (sb-win32:peek-console-input handle
+ (sb-alien:alien-sap buf)
+ sb-win32::input-record-size
+ (sb-alien:alien-sap
+ (sb-alien:addr avail))))
+ (return-from handle-listen (plusp avail))))
+
+ (let ((event (wsa-create-event)))
+ (wsa-event-select handle event (logior +fd-read+ +fd-close+))
+ (let ((val (wait-for-single-object-ex event 0 0)))
+ (wsa-close-event event)
+ (unless (= val -1)
+ (return-from handle-listen (zerop val)))))
+
+ nil)
+
+ )
+
+(defvar *external-format-to-coding-system*
+ '((:iso-8859-1
+ "latin-1" "latin-1-unix" "iso-latin-1-unix"
+ "iso-8859-1" "iso-8859-1-unix")
+ (:utf-8 "utf-8" "utf-8-unix")
+ (:euc-jp "euc-jp" "euc-jp-unix")
+ (:us-ascii "us-ascii" "us-ascii-unix")))
+
+;; C.f. R.M.Kreuter in <20536.1219412774@progn.net> on sbcl-general,
+;; 2008-08-22.
+(defvar *physical-pathname-host* (pathname-host (user-homedir-pathname)))
+
+(defimplementation filename-to-pathname (filename)
+ (sb-ext:parse-native-namestring filename *physical-pathname-host*))
+
+(defimplementation find-external-format (coding-system)
+ (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+
+(defimplementation set-default-directory (directory)
+ (let ((directory (truename (merge-pathnames directory))))
+ (sb-posix:chdir directory)
+ (setf *default-pathname-defaults* directory)
+ (default-directory)))
+
+(defun make-socket-io-stream (socket external-format buffering)
+ (let ((args `(,@()
+ :output t
+ :input t
+ :element-type ,(if external-format
+ 'character
+ '(unsigned-byte 8))
+ :buffering ,buffering
+ ,@(cond ((and external-format (sb-int:featurep :sb-unicode))
+ `(:external-format ,external-format))
+ (t '()))
+ :serve-events ,(eq :fd-handler swank:*communication-style*)
+ ;; SBCL < 1.0.42.43 doesn't support :SERVE-EVENTS
+ ;; argument.
+ :allow-other-keys t)))
+ (apply #'sb-bsd-sockets:socket-make-stream socket args)))
+
+(defun accept (socket)
+ "Like socket-accept, but retry on EAGAIN."
+ (loop (handler-case
+ (return (sb-bsd-sockets:socket-accept socket))
+ (sb-bsd-sockets:interrupted-error ()))))
+
+
+;;;; Support for SBCL syntax
+
+;;; SBCL's source code is riddled with #! reader macros. Also symbols
+;;; containing `!' have special meaning. We have to work long and
+;;; hard to be able to read the source. To deal with #! reader
+;;; macros, we use a special readtable. The special symbols are
+;;; converted by a condition handler.
+
+(defun feature-in-list-p (feature list)
+ (etypecase feature
+ (symbol (member feature list :test #'eq))
+ (cons (flet ((subfeature-in-list-p (subfeature)
+ (feature-in-list-p subfeature list)))
+ ;; Don't use ECASE since SBCL also has :host-feature,
+ ;; don't need to handle it or anything else appearing in
+ ;; the future or in erronous code.
+ (case (first feature)
+ (:or (some #'subfeature-in-list-p (rest feature)))
+ (:and (every #'subfeature-in-list-p (rest feature)))
+ (:not (destructuring-bind (e) (cdr feature)
+ (not (subfeature-in-list-p e)))))))))
+
+(defun shebang-reader (stream sub-character infix-parameter)
+ (declare (ignore sub-character))
+ (when infix-parameter
+ (error "illegal read syntax: #~D!" infix-parameter))
+ (let ((next-char (read-char stream)))
+ (unless (find next-char "+-")
+ (error "illegal read syntax: #!~C" next-char))
+ ;; When test is not satisfied
+ ;; FIXME: clearer if order of NOT-P and (NOT NOT-P) were reversed? then
+ ;; would become "unless test is satisfied"..
+ (when (let* ((*package* (find-package "KEYWORD"))
+ (*read-suppress* nil)
+ (not-p (char= next-char #\-))
+ (feature (read stream)))
+ (if (feature-in-list-p feature *features*)
+ not-p
+ (not not-p)))
+ ;; Read (and discard) a form from input.
+ (let ((*read-suppress* t))
+ (read stream t nil t))))
+ (values))
+
+(defvar *shebang-readtable*
+ (let ((*readtable* (copy-readtable nil)))
+ (set-dispatch-macro-character #\# #\!
+ (lambda (s c n) (shebang-reader s c n))
+ *readtable*)
+ *readtable*))
+
+(defun shebang-readtable ()
+ *shebang-readtable*)
+
+(defun sbcl-package-p (package)
+ (let ((name (package-name package)))
+ (eql (mismatch "SB-" name) 3)))
+
+(defun sbcl-source-file-p (filename)
+ (when filename
+ (loop for (nil pattern) in (logical-pathname-translations "SYS")
+ thereis (pathname-match-p filename pattern))))
+
+(defun guess-readtable-for-filename (filename)
+ (if (sbcl-source-file-p filename)
+ (shebang-readtable)
+ *readtable*))
+
+(defvar *debootstrap-packages* t)
+
+(defun call-with-debootstrapping (fun)
+ (handler-bind ((sb-int:bootstrap-package-not-found
+ #'sb-int:debootstrap-package))
+ (funcall fun)))
+
+(defmacro with-debootstrapping (&body body)
+ `(call-with-debootstrapping (lambda () ,@body)))
+
+(defimplementation call-with-syntax-hooks (fn)
+ (cond ((and *debootstrap-packages*
+ (sbcl-package-p *package*))
+ (with-debootstrapping (funcall fn)))
+ (t
+ (funcall fn))))
+
+(defimplementation default-readtable-alist ()
+ (let ((readtable (shebang-readtable)))
+ (loop for p in (remove-if-not #'sbcl-package-p (list-all-packages))
+ collect (cons (package-name p) readtable))))
+
+;;; Packages
+
+#+#.(swank/backend:with-symbol 'package-local-nicknames 'sb-ext)
+(defimplementation package-local-nicknames (package)
+ (sb-ext:package-local-nicknames package))
+
+;;; Utilities
+
+#+#.(swank/backend:with-symbol 'function-lambda-list 'sb-introspect)
+(defimplementation arglist (fname)
+ (sb-introspect:function-lambda-list fname))
+
+#-#.(swank/backend:with-symbol 'function-lambda-list 'sb-introspect)
+(defimplementation arglist (fname)
+ (sb-introspect:function-arglist fname))
+
+(defimplementation function-name (f)
+ (check-type f function)
+ (sb-impl::%fun-name f))
+
+(defmethod declaration-arglist ((decl-identifier (eql 'optimize)))
+ (flet ((ensure-list (thing) (if (listp thing) thing (list thing))))
+ (let* ((flags (sb-cltl2:declaration-information decl-identifier)))
+ (if flags
+ ;; Symbols aren't printed with package qualifiers, but the
+ ;; FLAGS would have to be fully qualified when used inside a
+ ;; declaration. So we strip those as long as there's no
+ ;; better way. (FIXME)
+ `(&any ,@(remove-if-not
+ #'(lambda (qualifier)
+ (find-symbol (symbol-name (first qualifier)) :cl))
+ flags :key #'ensure-list))
+ (call-next-method)))))
+
+#+#.(swank/backend:with-symbol 'deftype-lambda-list 'sb-introspect)
+(defmethod type-specifier-arglist :around (typespec-operator)
+ (multiple-value-bind (arglist foundp)
+ (sb-introspect:deftype-lambda-list typespec-operator)
+ (if foundp arglist (call-next-method))))
+
+(defimplementation type-specifier-p (symbol)
+ (or (sb-ext:valid-type-specifier-p symbol)
+ (not (eq (type-specifier-arglist symbol) :not-available))))
+
+(defvar *buffer-name* nil)
+(defvar *buffer-tmpfile* nil)
+(defvar *buffer-offset*)
+(defvar *buffer-substring* nil)
+
+(defvar *previous-compiler-condition* nil
+ "Used to detect duplicates.")
+
+(defun handle-notification-condition (condition)
+ "Handle a condition caused by a compiler warning.
+This traps all compiler conditions at a lower-level than using
+C:*COMPILER-NOTIFICATION-FUNCTION*. The advantage is that we get to
+craft our own error messages, which can omit a lot of redundant
+information."
+ (unless (or (eq condition *previous-compiler-condition*))
+ ;; First resignal warnings, so that outer handlers -- which may choose to
+ ;; muffle this -- get a chance to run.
+ (when (typep condition 'warning)
+ (signal condition))
+ (setq *previous-compiler-condition* condition)
+ (signal-compiler-condition (real-condition condition)
+ (sb-c::find-error-context nil))))
+
+(defun signal-compiler-condition (condition context)
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity (etypecase condition
+ (sb-ext:compiler-note :note)
+ (sb-c:compiler-error :error)
+ (reader-error :read-error)
+ (error :error)
+ #+#.(swank/backend:with-symbol redefinition-warning
+ sb-kernel)
+ (sb-kernel:redefinition-warning
+ :redefinition)
+ (style-warning :style-warning)
+ (warning :warning))
+ :references (condition-references condition)
+ :message (brief-compiler-message-for-emacs condition)
+ :source-context (compiler-error-context context)
+ :location (compiler-note-location condition context)))
+
+(defun real-condition (condition)
+ "Return the encapsulated condition or CONDITION itself."
+ (typecase condition
+ (sb-int:encapsulated-condition (sb-int:encapsulated-condition condition))
+ (t condition)))
+
+(defun condition-references (condition)
+ (if (typep condition 'sb-int:reference-condition)
+ (externalize-reference
+ (sb-int:reference-condition-references condition))))
+
+(defun compiler-note-location (condition context)
+ (flet ((bailout ()
+ (return-from compiler-note-location
+ (make-error-location "No error location available"))))
+ (cond (context
+ (locate-compiler-note
+ (sb-c::compiler-error-context-file-name context)
+ (compiler-source-path context)
+ (sb-c::compiler-error-context-original-source context)))
+ ((typep condition 'reader-error)
+ (let* ((stream (stream-error-stream condition))
+ (file (pathname stream)))
+ (unless (open-stream-p stream)
+ (bailout))
+ (if (compiling-from-buffer-p file)
+ ;; The stream position for e.g. "comma not inside
+ ;; backquote" is at the character following the
+ ;; comma, :offset is 0-based, hence the 1-.
+ (make-location (list :buffer *buffer-name*)
+ (list :offset *buffer-offset*
+ (1- (file-position stream))))
+ (progn
+ (assert (compiling-from-file-p file))
+ ;; No 1- because :position is 1-based.
+ (make-location (list :file (namestring file))
+ (list :position (file-position stream)))))))
+ (t (bailout)))))
+
+(defun compiling-from-buffer-p (filename)
+ (and *buffer-name*
+ ;; The following is to trigger COMPILING-FROM-GENERATED-CODE-P
+ ;; in LOCATE-COMPILER-NOTE, and allows handling nested
+ ;; compilation from eg. hitting C-C on (eval-when ... (require ..))).
+ ;;
+ ;; PROBE-FILE to handle tempfile directory being a symlink.
+ (pathnamep filename)
+ (let ((true1 (probe-file filename))
+ (true2 (probe-file *buffer-tmpfile*)))
+ (and true1 (equal true1 true2)))))
+
+(defun compiling-from-file-p (filename)
+ (and (pathnamep filename)
+ (or (null *buffer-name*)
+ (null *buffer-tmpfile*)
+ (let ((true1 (probe-file filename))
+ (true2 (probe-file *buffer-tmpfile*)))
+ (not (and true1 (equal true1 true2)))))))
+
+(defun compiling-from-generated-code-p (filename source)
+ (and (eq filename :lisp) (stringp source)))
+
+(defun locate-compiler-note (file source-path source)
+ (cond ((compiling-from-buffer-p file)
+ (make-location (list :buffer *buffer-name*)
+ (list :offset *buffer-offset*
+ (source-path-string-position
+ source-path *buffer-substring*))))
+ ((compiling-from-file-p file)
+ (let ((position (source-path-file-position source-path file)))
+ (make-location (list :file (namestring file))
+ (list :position (and position
+ (1+ position))))))
+ ((compiling-from-generated-code-p file source)
+ (make-location (list :source-form source)
+ (list :position 1)))
+ (t
+ (error "unhandled case in compiler note ~S ~S ~S"
+ file source-path source))))
+
+(defun brief-compiler-message-for-emacs (condition)
+ "Briefly describe a compiler error for Emacs.
+When Emacs presents the message it already has the source popped up
+and the source form highlighted. This makes much of the information in
+the error-context redundant."
+ (let ((sb-int:*print-condition-references* nil))
+ (princ-to-string condition)))
+
+(defun compiler-error-context (error-context)
+ "Describe a compiler error for Emacs including context information."
+ (declare (type (or sb-c::compiler-error-context null) error-context))
+ (multiple-value-bind (enclosing source)
+ (if error-context
+ (values (sb-c::compiler-error-context-enclosing-source error-context)
+ (sb-c::compiler-error-context-source error-context)))
+ (and (or enclosing source)
+ (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~%~}~]"
+ enclosing source))))
+
+(defun compiler-source-path (context)
+ "Return the source-path for the current compiler error.
+Returns NIL if this cannot be determined by examining internal
+compiler state."
+ (cond ((sb-c::node-p context)
+ (reverse
+ (sb-c::source-path-original-source
+ (sb-c::node-source-path context))))
+ ((sb-c::compiler-error-context-p context)
+ (reverse
+ (sb-c::compiler-error-context-original-source-path context)))))
+
+(defimplementation call-with-compilation-hooks (function)
+ (declare (type function function))
+ (handler-bind
+ ;; N.B. Even though these handlers are called HANDLE-FOO they
+ ;; actually decline, i.e. the signalling of the original
+ ;; condition continues upward.
+ ((sb-c:fatal-compiler-error #'handle-notification-condition)
+ (sb-c:compiler-error #'handle-notification-condition)
+ (sb-ext:compiler-note #'handle-notification-condition)
+ (error #'handle-notification-condition)
+ (warning #'handle-notification-condition))
+ (funcall function)))
+
+;;; HACK: SBCL 1.2.12 shipped with a bug where
+;;; SB-EXT:RESTRICT-COMPILER-POLICY would signal an error when there
+;;; were no policy restrictions in place. This workaround ensures the
+;;; existence of at least one dummy restriction.
+(handler-case (sb-ext:restrict-compiler-policy)
+ (error () (sb-ext:restrict-compiler-policy 'debug)))
+
+(defun compiler-policy (qualities)
+ "Return compiler policy qualities present in the QUALITIES alist.
+QUALITIES is an alist with (quality . value)"
+ #+#.(swank/backend:with-symbol 'restrict-compiler-policy 'sb-ext)
+ (loop with policy = (sb-ext:restrict-compiler-policy)
+ for (quality) in qualities
+ collect (cons quality
+ (or (cdr (assoc quality policy))
+ 0))))
+
+(defun (setf compiler-policy) (policy)
+ (declare (ignorable policy))
+ #+#.(swank/backend:with-symbol 'restrict-compiler-policy 'sb-ext)
+ (loop for (qual . value) in policy
+ do (sb-ext:restrict-compiler-policy qual value)))
+
+(defmacro with-compiler-policy (policy &body body)
+ (let ((current-policy (gensym)))
+ `(let ((,current-policy (compiler-policy ,policy)))
+ (setf (compiler-policy) ,policy)
+ (unwind-protect (progn ,@body)
+ (setf (compiler-policy) ,current-policy)))))
+
+(defimplementation swank-compile-file (input-file output-file
+ load-p external-format
+ &key policy)
+ (multiple-value-bind (output-file warnings-p failure-p)
+ (with-compiler-policy policy
+ (with-compilation-hooks ()
+ (compile-file input-file :output-file output-file
+ :external-format external-format)))
+ (values output-file warnings-p
+ (or failure-p
+ (when load-p
+ ;; Cache the latest source file for definition-finding.
+ (source-cache-get input-file
+ (file-write-date input-file))
+ (not (load output-file)))))))
+
+;;;; compile-string
+
+;;; We copy the string to a temporary file in order to get adequate
+;;; semantics for :COMPILE-TOPLEVEL and :LOAD-TOPLEVEL EVAL-WHEN forms
+;;; which the previous approach using
+;;; (compile nil `(lambda () ,(read-from-string string)))
+;;; did not provide.
+
+(locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
+
+(sb-alien:define-alien-routine (#-win32 "tempnam" #+win32 "_tempnam" tempnam)
+ sb-alien:c-string
+ (dir sb-alien:c-string)
+ (prefix sb-alien:c-string))
+
+)
+
+(defun temp-file-name ()
+ "Return a temporary file name to compile strings into."
+ (tempnam nil nil))
+
+(defvar *trap-load-time-warnings* t)
+
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (let ((*buffer-name* buffer)
+ (*buffer-offset* position)
+ (*buffer-substring* string)
+ (*buffer-tmpfile* (temp-file-name)))
+ (labels ((load-it (filename)
+ (cond (*trap-load-time-warnings*
+ (with-compilation-hooks () (load filename)))
+ (t (load filename))))
+ (cf ()
+ (with-compiler-policy policy
+ (with-compilation-unit
+ (:source-plist (list :emacs-buffer buffer
+ :emacs-filename filename
+ :emacs-package (package-name *package*)
+ :emacs-position position
+ :emacs-string string)
+ :source-namestring filename
+ :allow-other-keys t)
+ (compile-file *buffer-tmpfile* :external-format :utf-8)))))
+ (with-open-file (s *buffer-tmpfile* :direction :output :if-exists :error
+ :external-format :utf-8)
+ (write-string string s))
+ (unwind-protect
+ (multiple-value-bind (output-file warningsp failurep)
+ (with-compilation-hooks () (cf))
+ (declare (ignore warningsp))
+ (when output-file
+ (load-it output-file))
+ (not failurep))
+ (ignore-errors
+ (delete-file *buffer-tmpfile*)
+ (delete-file (compile-file-pathname *buffer-tmpfile*)))))))
+
+;;;; Definitions
+
+(defparameter *definition-types*
+ '(:variable defvar
+ :constant defconstant
+ :type deftype
+ :symbol-macro define-symbol-macro
+ :macro defmacro
+ :compiler-macro define-compiler-macro
+ :function defun
+ :generic-function defgeneric
+ :method defmethod
+ :setf-expander define-setf-expander
+ :structure defstruct
+ :condition define-condition
+ :class defclass
+ :method-combination define-method-combination
+ :package defpackage
+ :transform :deftransform
+ :optimizer :defoptimizer
+ :vop :define-vop
+ :source-transform :define-source-transform
+ :ir1-convert :def-ir1-translator
+ :declaration declaim
+ :alien-type :define-alien-type)
+ "Map SB-INTROSPECT definition type names to Slime-friendly forms")
+
+(defun definition-specifier (type)
+ "Return a pretty specifier for NAME representing a definition of type TYPE."
+ (getf *definition-types* type))
+
+(defun make-dspec (type name source-location)
+ (list* (definition-specifier type)
+ name
+ (sb-introspect::definition-source-description source-location)))
+
+(defimplementation find-definitions (name)
+ (loop for type in *definition-types* by #'cddr
+ for defsrcs = (sb-introspect:find-definition-sources-by-name name type)
+ append (loop for defsrc in defsrcs collect
+ (list (make-dspec type name defsrc)
+ (converting-errors-to-error-location
+ (definition-source-for-emacs defsrc
+ type name))))))
+
+(defimplementation find-source-location (obj)
+ (flet ((general-type-of (obj)
+ (typecase obj
+ (method :method)
+ (generic-function :generic-function)
+ (function :function)
+ (structure-class :structure-class)
+ (class :class)
+ (method-combination :method-combination)
+ (package :package)
+ (condition :condition)
+ (structure-object :structure-object)
+ (standard-object :standard-object)
+ (t :thing)))
+ (to-string (obj)
+ (typecase obj
+ ;; Packages are possibly named entities.
+ (package (princ-to-string obj))
+ ((or structure-object standard-object condition)
+ (with-output-to-string (s)
+ (print-unreadable-object (obj s :type t :identity t))))
+ (t (princ-to-string obj)))))
+ (converting-errors-to-error-location
+ (let ((defsrc (sb-introspect:find-definition-source obj)))
+ (definition-source-for-emacs defsrc
+ (general-type-of obj)
+ (to-string obj))))))
+
+(defmacro with-definition-source ((&rest names) obj &body body)
+ "Like with-slots but works only for structs."
+ (flet ((reader (slot)
+ ;; Use read-from-string instead of intern so that
+ ;; conc-name can be a string such as ext:struct- and not
+ ;; cause errors and not force interning ext::struct-
+ (read-from-string
+ (concatenate 'string "sb-introspect:definition-source-"
+ (string slot)))))
+ (let ((tmp (gensym "OO-")))
+ ` (let ((,tmp ,obj))
+ (symbol-macrolet
+ ,(loop for name in names collect
+ (typecase name
+ (symbol `(,name (,(reader name) ,tmp)))
+ (cons `(,(first name) (,(reader (second name)) ,tmp)))
+ (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
+ ,@body)))))
+
+(defun categorize-definition-source (definition-source)
+ (with-definition-source (pathname form-path character-offset plist)
+ definition-source
+ (let ((file-p (and pathname (probe-file pathname)
+ (or form-path character-offset))))
+ (cond ((and (getf plist :emacs-buffer) file-p) :buffer-and-file)
+ ((getf plist :emacs-buffer) :buffer)
+ (file-p :file)
+ (pathname :file-without-position)
+ (t :invalid)))))
+
+#+#.(swank/backend:with-symbol 'definition-source-form-number 'sb-introspect)
+(defun form-number-position (definition-source stream)
+ (let* ((tlf-number (car (sb-introspect:definition-source-form-path definition-source)))
+ (form-number (sb-introspect:definition-source-form-number definition-source)))
+ (multiple-value-bind (tlf pos-map) (read-source-form tlf-number stream)
+ (let* ((path-table (sb-di::form-number-translations tlf 0))
+ (path (cond ((<= (length path-table) form-number)
+ (warn "inconsistent form-number-translations")
+ (list 0))
+ (t
+ (reverse (cdr (aref path-table form-number)))))))
+ (source-path-source-position path tlf pos-map)))))
+
+#+#.(swank/backend:with-symbol 'definition-source-form-number 'sb-introspect)
+(defun file-form-number-position (definition-source)
+ (let* ((code-date (sb-introspect:definition-source-file-write-date definition-source))
+ (filename (sb-introspect:definition-source-pathname definition-source))
+ (*readtable* (guess-readtable-for-filename filename))
+ (source-code (get-source-code filename code-date)))
+ (with-debootstrapping
+ (with-input-from-string (s source-code)
+ (form-number-position definition-source s)))))
+
+#+#.(swank/backend:with-symbol 'definition-source-form-number 'sb-introspect)
+(defun string-form-number-position (definition-source string)
+ (with-input-from-string (s string)
+ (form-number-position definition-source s)))
+
+(defun definition-source-buffer-location (definition-source)
+ (with-definition-source (form-path character-offset plist) definition-source
+ (destructuring-bind (&key emacs-buffer emacs-position emacs-directory
+ emacs-string &allow-other-keys)
+ plist
+ (let ((*readtable* (guess-readtable-for-filename emacs-directory))
+ start
+ end)
+ (with-debootstrapping
+ (or
+ (and form-path
+ (or
+ #+#.(swank/backend:with-symbol 'definition-source-form-number 'sb-introspect)
+ (setf (values start end)
+ (and (sb-introspect:definition-source-form-number definition-source)
+ (string-form-number-position definition-source emacs-string)))
+ (setf (values start end)
+ (source-path-string-position form-path emacs-string))))
+ (setf start character-offset
+ end most-positive-fixnum)))
+ (make-location
+ `(:buffer ,emacs-buffer)
+ `(:offset ,emacs-position ,start)
+ `(:snippet
+ ,(subseq emacs-string
+ start
+ (min end (+ start *source-snippet-size*)))))))))
+
+(defun definition-source-file-location (definition-source)
+ (with-definition-source (pathname form-path character-offset plist
+ file-write-date) definition-source
+ (let* ((namestring (namestring (translate-logical-pathname pathname)))
+ (pos (or (and form-path
+ (or
+ #+#.(swank/backend:with-symbol 'definition-source-form-number 'sb-introspect)
+ (and (sb-introspect:definition-source-form-number definition-source)
+ (ignore-errors (file-form-number-position definition-source)))
+ (ignore-errors
+ (source-file-position namestring file-write-date
+ form-path))))
+ character-offset))
+ (snippet (source-hint-snippet namestring file-write-date pos)))
+ (make-location `(:file ,namestring)
+ ;; /file positions/ in Common Lisp start from
+ ;; 0, buffer positions in Emacs start from 1.
+ `(:position ,(1+ pos))
+ `(:snippet ,snippet)))))
+
+(defun definition-source-buffer-and-file-location (definition-source)
+ (let ((buffer (definition-source-buffer-location definition-source)))
+ (make-location (list :buffer-and-file
+ (cadr (location-buffer buffer))
+ (namestring (sb-introspect:definition-source-pathname
+ definition-source)))
+ (location-position buffer)
+ (location-hints buffer))))
+
+(defun definition-source-for-emacs (definition-source type name)
+ (with-definition-source (pathname form-path character-offset plist
+ file-write-date)
+ definition-source
+ (ecase (categorize-definition-source definition-source)
+ (:buffer-and-file
+ (definition-source-buffer-and-file-location definition-source))
+ (:buffer
+ (definition-source-buffer-location definition-source))
+ (:file
+ (definition-source-file-location definition-source))
+ (:file-without-position
+ (make-location `(:file ,(namestring
+ (translate-logical-pathname pathname)))
+ '(:position 1)
+ (when (eql type :function)
+ `(:snippet ,(format nil "(defun ~a "
+ (symbol-name name))))))
+ (:invalid
+ (error "DEFINITION-SOURCE of ~(~A~) ~A did not contain ~
+ meaningful information."
+ type name)))))
+
+(defun source-file-position (filename write-date form-path)
+ (let ((source (get-source-code filename write-date))
+ (*readtable* (guess-readtable-for-filename filename)))
+ (with-debootstrapping
+ (source-path-string-position form-path source))))
+
+(defun source-hint-snippet (filename write-date position)
+ (read-snippet-from-string (get-source-code filename write-date) position))
+
+(defun function-source-location (function &optional name)
+ (declare (type function function))
+ (definition-source-for-emacs (sb-introspect:find-definition-source function)
+ :function
+ (or name (function-name function))))
+
+(defun setf-expander (symbol)
+ (or
+ #+#.(swank/sbcl::sbcl-with-setf-inverse-meta-info)
+ (sb-int:info :setf :inverse symbol)
+ (sb-int:info :setf :expander symbol)))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ "Return a plist describing SYMBOL.
+Return NIL if the symbol is unbound."
+ (let ((result '()))
+ (flet ((doc (kind)
+ (or (documentation symbol kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (multiple-value-bind (kind recorded-p)
+ (sb-int:info :variable :kind symbol)
+ (declare (ignore kind))
+ (if (or (boundp symbol) recorded-p)
+ (doc 'variable))))
+ (when (fboundp symbol)
+ (maybe-push
+ (cond ((macro-function symbol) :macro)
+ ((special-operator-p symbol) :special-operator)
+ ((typep (fdefinition symbol) 'generic-function)
+ :generic-function)
+ (t :function))
+ (doc 'function)))
+ (maybe-push
+ :setf (and (setf-expander symbol)
+ (doc 'setf)))
+ (maybe-push
+ :type (if (sb-int:info :type :kind symbol)
+ (doc 'type)))
+ result)))
+
+(defimplementation describe-definition (symbol type)
+ (case type
+ (:variable
+ (describe symbol))
+ (:function
+ (describe (symbol-function symbol)))
+ (:setf
+ (describe (setf-expander symbol)))
+ (:class
+ (describe (find-class symbol)))
+ (:type
+ (describe (sb-kernel:values-specifier-type symbol)))))
+
+#+#.(swank/sbcl::sbcl-with-xref-p)
+(progn
+ (defmacro defxref (name &optional fn-name)
+ `(defimplementation ,name (what)
+ (sanitize-xrefs
+ (mapcar #'source-location-for-xref-data
+ (,(find-symbol (symbol-name (if fn-name
+ fn-name
+ name))
+ "SB-INTROSPECT")
+ what)))))
+ (defxref who-calls)
+ (defxref who-binds)
+ (defxref who-sets)
+ (defxref who-references)
+ (defxref who-macroexpands)
+ #+#.(swank/backend:with-symbol 'who-specializes-directly 'sb-introspect)
+ (defxref who-specializes who-specializes-directly))
+
+(defun source-location-for-xref-data (xref-data)
+ (destructuring-bind (name . defsrc) xref-data
+ (list name (converting-errors-to-error-location
+ (definition-source-for-emacs defsrc 'function name)))))
+
+(defimplementation list-callers (symbol)
+ (let ((fn (fdefinition symbol)))
+ (sanitize-xrefs
+ (mapcar #'function-dspec (sb-introspect:find-function-callers fn)))))
+
+(defimplementation list-callees (symbol)
+ (let ((fn (fdefinition symbol)))
+ (sanitize-xrefs
+ (mapcar #'function-dspec (sb-introspect:find-function-callees fn)))))
+
+(defun sanitize-xrefs (xrefs)
+ (remove-duplicates
+ (remove-if (lambda (f)
+ (member f (ignored-xref-function-names)))
+ (loop for entry in xrefs
+ for name = (car entry)
+ collect (if (and (consp name)
+ (member (car name)
+ '(sb-pcl::fast-method
+ sb-pcl::slow-method
+ sb-pcl::method)))
+ (cons (cons 'defmethod (cdr name))
+ (cdr entry))
+ entry))
+ :key #'car)
+ :test (lambda (a b)
+ (and (eq (first a) (first b))
+ (equal (second a) (second b))))))
+
+(defun ignored-xref-function-names ()
+ #-#.(swank/sbcl::sbcl-with-new-stepper-p)
+ '(nil sb-c::step-form sb-c::step-values)
+ #+#.(swank/sbcl::sbcl-with-new-stepper-p)
+ '(nil))
+
+(defun function-dspec (fn)
+ "Describe where the function FN was defined.
+Return a list of the form (NAME LOCATION)."
+ (let ((name (function-name fn)))
+ (list name (converting-errors-to-error-location
+ (function-source-location fn name)))))
+
+;;; macroexpansion
+
+(defimplementation macroexpand-all (form &optional env)
+ (sb-cltl2:macroexpand-all form env))
+
+(defimplementation collect-macro-forms (form &optional environment)
+ (let ((macro-forms '())
+ (compiler-macro-forms '())
+ (function-quoted-forms '()))
+ (sb-walker:walk-form
+ form environment
+ (lambda (form context environment)
+ (declare (ignore context))
+ (when (and (consp form)
+ (symbolp (car form)))
+ (cond ((eq (car form) 'function)
+ (push (cadr form) function-quoted-forms))
+ ((member form function-quoted-forms)
+ nil)
+ ((macro-function (car form) environment)
+ (push form macro-forms))
+ ((not (eq form (compiler-macroexpand-1 form environment)))
+ (push form compiler-macro-forms))))
+ form))
+ (values macro-forms compiler-macro-forms)))
+
+
+;;; Debugging
+
+;;; Notice that SB-EXT:*INVOKE-DEBUGGER-HOOK* is slightly stronger
+;;; than just a hook into BREAK. In particular, it'll make
+;;; (LET ((*DEBUGGER-HOOK* NIL)) ..error..) drop into SLDB rather
+;;; than the native debugger. That should probably be considered a
+;;; feature.
+
+(defun make-invoke-debugger-hook (hook)
+ (when hook
+ #'(sb-int:named-lambda swank-invoke-debugger-hook
+ (condition old-hook)
+ (if *debugger-hook*
+ nil ; decline, *DEBUGGER-HOOK* will be tried next.
+ (funcall hook condition old-hook)))))
+
+(defun set-break-hook (hook)
+ (setq sb-ext:*invoke-debugger-hook* (make-invoke-debugger-hook hook)))
+
+(defun call-with-break-hook (hook continuation)
+ (let ((sb-ext:*invoke-debugger-hook* (make-invoke-debugger-hook hook)))
+ (funcall continuation)))
+
+(defimplementation install-debugger-globally (function)
+ (setq *debugger-hook* function)
+ (set-break-hook function))
+
+(defimplementation condition-extras (condition)
+ (cond #+#.(swank/sbcl::sbcl-with-new-stepper-p)
+ ((typep condition 'sb-impl::step-form-condition)
+ `((:show-frame-source 0)))
+ ((typep condition 'sb-int:reference-condition)
+ (let ((refs (sb-int:reference-condition-references condition)))
+ (if refs
+ `((:references ,(externalize-reference refs))))))))
+
+(defun externalize-reference (ref)
+ (etypecase ref
+ (null nil)
+ (cons (cons (externalize-reference (car ref))
+ (externalize-reference (cdr ref))))
+ ((or string number) ref)
+ (symbol
+ (cond ((eq (symbol-package ref) (symbol-package :test))
+ ref)
+ (t (symbol-name ref))))))
+
+(defvar *sldb-stack-top*)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (declare (type function debugger-loop-fn))
+ (let ((*sldb-stack-top*
+ (if (and (not *debug-swank-backend*)
+ sb-debug:*stack-top-hint*)
+ #+#.(swank/backend:with-symbol 'resolve-stack-top-hint 'sb-debug)
+ (sb-debug::resolve-stack-top-hint)
+ #-#.(swank/backend:with-symbol 'resolve-stack-top-hint 'sb-debug)
+ sb-debug:*stack-top-hint*
+ (sb-di:top-frame)))
+ (sb-debug:*stack-top-hint* nil))
+ (handler-bind ((sb-di:debug-condition
+ (lambda (condition)
+ (signal 'sldb-condition
+ :original-condition condition))))
+ (funcall debugger-loop-fn))))
+
+#+#.(swank/sbcl::sbcl-with-new-stepper-p)
+(progn
+ (defimplementation activate-stepping (frame)
+ (declare (ignore frame))
+ (sb-impl::enable-stepping))
+ (defimplementation sldb-stepper-condition-p (condition)
+ (typep condition 'sb-ext:step-form-condition))
+ (defimplementation sldb-step-into ()
+ (invoke-restart 'sb-ext:step-into))
+ (defimplementation sldb-step-next ()
+ (invoke-restart 'sb-ext:step-next))
+ (defimplementation sldb-step-out ()
+ (invoke-restart 'sb-ext:step-out)))
+
+(defimplementation call-with-debugger-hook (hook fun)
+ (let ((*debugger-hook* hook)
+ #+#.(swank/sbcl::sbcl-with-new-stepper-p)
+ (sb-ext:*stepper-hook*
+ (lambda (condition)
+ (typecase condition
+ (sb-ext:step-form-condition
+ (let ((sb-debug:*stack-top-hint* (sb-di::find-stepped-frame)))
+ (sb-impl::invoke-debugger condition)))))))
+ (handler-bind (#+#.(swank/sbcl::sbcl-with-new-stepper-p)
+ (sb-ext:step-condition #'sb-impl::invoke-stepper))
+ (call-with-break-hook hook fun))))
+
+(defun nth-frame (index)
+ (do ((frame *sldb-stack-top* (sb-di:frame-down frame))
+ (i index (1- i)))
+ ((zerop i) frame)))
+
+(defimplementation compute-backtrace (start end)
+ "Return a list of frames starting with frame number START and
+continuing to frame number END or, if END is nil, the last frame on the
+stack."
+ (let ((end (or end most-positive-fixnum)))
+ (loop for f = (nth-frame start) then (sb-di:frame-down f)
+ for i from start below end
+ while f collect f)))
+
+(defimplementation print-frame (frame stream)
+ (sb-debug::print-frame-call frame stream))
+
+(defimplementation frame-restartable-p (frame)
+ #+#.(swank/sbcl::sbcl-with-restart-frame)
+ (not (null (sb-debug:frame-has-debug-tag-p frame))))
+
+(defimplementation frame-call (frame-number)
+ (multiple-value-bind (name args)
+ (sb-debug::frame-call (nth-frame frame-number))
+ (with-output-to-string (stream)
+ (locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
+ (pprint-logical-block (stream nil :prefix "(" :suffix ")")
+ (locally (declare (sb-ext:unmuffle-conditions sb-ext:compiler-note))
+ (let ((*print-length* nil)
+ (*print-level* nil))
+ (prin1 (sb-debug::ensure-printable-object name) stream))
+ (let ((args (sb-debug::ensure-printable-object args)))
+ (if (listp args)
+ (format stream "~{ ~_~S~}" args)
+ (format stream " ~S" args)))))))))
+
+;;;; Code-location -> source-location translation
+
+;;; If debug-block info is avaibale, we determine the file position of
+;;; the source-path for a code-location. If the code was compiled
+;;; with C-c C-c, we have to search the position in the source string.
+;;; If there's no debug-block info, we return the (less precise)
+;;; source-location of the corresponding function.
+
+(defun code-location-source-location (code-location)
+ (let* ((dsource (sb-di:code-location-debug-source code-location))
+ (plist (sb-c::debug-source-plist dsource))
+ (package (getf plist :emacs-package))
+ (*package* (or (and package
+ (find-package package))
+ *package*)))
+ (if (getf plist :emacs-buffer)
+ (emacs-buffer-source-location code-location plist)
+ #+#.(swank/backend:with-symbol 'debug-source-from 'sb-di)
+ (ecase (sb-di:debug-source-from dsource)
+ (:file (file-source-location code-location))
+ (:lisp (lisp-source-location code-location)))
+ #-#.(swank/backend:with-symbol 'debug-source-from 'sb-di)
+ (if (sb-di:debug-source-namestring dsource)
+ (file-source-location code-location)
+ (lisp-source-location code-location)))))
+
+;;; FIXME: The naming policy of source-location functions is a bit
+;;; fuzzy: we have FUNCTION-SOURCE-LOCATION which returns the
+;;; source-location for a function, and we also have FILE-SOURCE-LOCATION &co
+;;; which returns the source location for a _code-location_.
+;;;
+;;; Maybe these should be named code-location-file-source-location,
+;;; etc, turned into generic functions, or something. In the very
+;;; least the names should indicate the main entry point vs. helper
+;;; status.
+
+(defun file-source-location (code-location)
+ (if (code-location-has-debug-block-info-p code-location)
+ (source-file-source-location code-location)
+ (fallback-source-location code-location)))
+
+(defun fallback-source-location (code-location)
+ (let ((fun (code-location-debug-fun-fun code-location)))
+ (cond (fun (function-source-location fun))
+ (t (error "Cannot find source location for: ~A " code-location)))))
+
+(defun lisp-source-location (code-location)
+ (let ((source (prin1-to-string
+ (sb-debug::code-location-source-form code-location 100)))
+ (condition swank:*swank-debugger-condition*))
+ (if (and (typep condition 'sb-impl::step-form-condition)
+ (search "SB-IMPL::WITH-STEPPING-ENABLED" source
+ :test #'char-equal)
+ (search "SB-IMPL::STEP-FINISHED" source :test #'char-equal))
+ ;; The initial form is utterly uninteresting -- and almost
+ ;; certainly right there in the REPL.
+ (make-error-location "Stepping...")
+ (make-location `(:source-form ,source) '(:position 1)))))
+
+(defun emacs-buffer-source-location (code-location plist)
+ (if (code-location-has-debug-block-info-p code-location)
+ (destructuring-bind (&key emacs-buffer emacs-position emacs-string
+ &allow-other-keys)
+ plist
+ (let* ((pos (string-source-position code-location emacs-string))
+ (snipped (read-snippet-from-string emacs-string pos)))
+ (make-location `(:buffer ,emacs-buffer)
+ `(:offset ,emacs-position ,pos)
+ `(:snippet ,snipped))))
+ (fallback-source-location code-location)))
+
+(defun source-file-source-location (code-location)
+ (let* ((code-date (code-location-debug-source-created code-location))
+ (filename (code-location-debug-source-name code-location))
+ (*readtable* (guess-readtable-for-filename filename))
+ (source-code (get-source-code filename code-date)))
+ (with-debootstrapping
+ (with-input-from-string (s source-code)
+ (let* ((pos (stream-source-position code-location s))
+ (snippet (read-snippet s pos)))
+ (make-location `(:file ,filename)
+ `(:position ,pos)
+ `(:snippet ,snippet)))))))
+
+(defun code-location-debug-source-name (code-location)
+ (namestring (truename (#.(swank/backend:choose-symbol
+ 'sb-c 'debug-source-name
+ 'sb-c 'debug-source-namestring)
+ (sb-di::code-location-debug-source code-location)))))
+
+(defun code-location-debug-source-created (code-location)
+ (sb-c::debug-source-created
+ (sb-di::code-location-debug-source code-location)))
+
+(defun code-location-debug-fun-fun (code-location)
+ (sb-di:debug-fun-fun (sb-di:code-location-debug-fun code-location)))
+
+(defun code-location-has-debug-block-info-p (code-location)
+ (handler-case
+ (progn (sb-di:code-location-debug-block code-location)
+ t)
+ (sb-di:no-debug-blocks () nil)))
+
+(defun stream-source-position (code-location stream)
+ (let* ((cloc (sb-debug::maybe-block-start-location code-location))
+ (tlf-number (sb-di::code-location-toplevel-form-offset cloc))
+ (form-number (sb-di::code-location-form-number cloc)))
+ (multiple-value-bind (tlf pos-map) (read-source-form tlf-number stream)
+ (let* ((path-table (sb-di::form-number-translations tlf 0))
+ (path (cond ((<= (length path-table) form-number)
+ (warn "inconsistent form-number-translations")
+ (list 0))
+ (t
+ (reverse (cdr (aref path-table form-number)))))))
+ (source-path-source-position path tlf pos-map)))))
+
+(defun string-source-position (code-location string)
+ (with-input-from-string (s string)
+ (stream-source-position code-location s)))
+
+;;; source-path-file-position and friends are in source-path-parser
+
+(defimplementation frame-source-location (index)
+ (converting-errors-to-error-location
+ (code-location-source-location
+ (sb-di:frame-code-location (nth-frame index)))))
+
+(defvar *keep-non-valid-locals* nil)
+
+(defun frame-debug-vars (frame)
+ "Return a vector of debug-variables in frame."
+ (let ((all-vars (sb-di::debug-fun-debug-vars (sb-di:frame-debug-fun frame))))
+ (cond (*keep-non-valid-locals* all-vars)
+ (t (let ((loc (sb-di:frame-code-location frame)))
+ (remove-if (lambda (var)
+ (ecase (sb-di:debug-var-validity var loc)
+ (:valid nil)
+ ((:invalid :unknown) t)))
+ all-vars))))))
+
+(defun debug-var-value (var frame location)
+ (ecase (sb-di:debug-var-validity var location)
+ (:valid (sb-di:debug-var-value var frame))
+ ((:invalid :unknown) ':<not-available>)))
+
+(defun debug-var-info (var)
+ ;; Introduced by SBCL 1.0.49.76.
+ (let ((s (find-symbol "DEBUG-VAR-INFO" :sb-di)))
+ (when (and s (fboundp s))
+ (funcall s var))))
+
+(defimplementation frame-locals (index)
+ (let* ((frame (nth-frame index))
+ (loc (sb-di:frame-code-location frame))
+ (vars (frame-debug-vars frame))
+ ;; Since SBCL 1.0.49.76 PREPROCESS-FOR-EVAL understands SB-DEBUG::MORE
+ ;; specially.
+ (more-name (or (find-symbol "MORE" :sb-debug) 'more))
+ (more-context nil)
+ (more-count nil)
+ (more-id 0))
+ (when vars
+ (let ((locals
+ (loop for v across vars
+ do (when (eq (sb-di:debug-var-symbol v) more-name)
+ (incf more-id))
+ (case (debug-var-info v)
+ (:more-context
+ (setf more-context (debug-var-value v frame loc)))
+ (:more-count
+ (setf more-count (debug-var-value v frame loc))))
+ collect
+ (list :name (sb-di:debug-var-symbol v)
+ :id (sb-di:debug-var-id v)
+ :value (debug-var-value v frame loc)))))
+ (when (and more-context more-count)
+ (setf locals (append locals
+ (list
+ (list :name more-name
+ :id more-id
+ :value (multiple-value-list
+ (sb-c:%more-arg-values
+ more-context
+ 0 more-count)))))))
+ locals))))
+
+(defimplementation frame-var-value (frame var)
+ (let* ((frame (nth-frame frame))
+ (vars (frame-debug-vars frame))
+ (loc (sb-di:frame-code-location frame))
+ (dvar (if (= var (length vars))
+ ;; If VAR is out of bounds, it must be the fake var
+ ;; we made up for &MORE.
+ (let* ((context-var (find :more-context vars
+ :key #'debug-var-info))
+ (more-context (debug-var-value context-var frame
+ loc))
+ (count-var (find :more-count vars
+ :key #'debug-var-info))
+ (more-count (debug-var-value count-var frame loc)))
+ (return-from frame-var-value
+ (multiple-value-list (sb-c:%more-arg-values
+ more-context
+ 0 more-count))))
+ (aref vars var))))
+ (debug-var-value dvar frame loc)))
+
+(defimplementation frame-catch-tags (index)
+ (mapcar #'car (sb-di:frame-catches (nth-frame index))))
+
+(defimplementation eval-in-frame (form index)
+ (let ((frame (nth-frame index)))
+ (funcall (the function
+ (sb-di:preprocess-for-eval form
+ (sb-di:frame-code-location frame)))
+ frame)))
+
+(defimplementation frame-package (frame-number)
+ (let* ((frame (nth-frame frame-number))
+ (fun (sb-di:debug-fun-fun (sb-di:frame-debug-fun frame))))
+ (when fun
+ (let ((name (function-name fun)))
+ (typecase name
+ (null nil)
+ (symbol (symbol-package name))
+ ((cons (eql setf) (cons symbol)) (symbol-package (cadr name))))))))
+
+#+#.(swank/sbcl::sbcl-with-restart-frame)
+(progn
+ (defimplementation return-from-frame (index form)
+ (let* ((frame (nth-frame index)))
+ (cond ((sb-debug:frame-has-debug-tag-p frame)
+ (let ((values (multiple-value-list (eval-in-frame form index))))
+ (sb-debug:unwind-to-frame-and-call frame
+ (lambda ()
+ (values-list values)))))
+ (t (format nil "Cannot return from frame: ~S" frame)))))
+
+ (defimplementation restart-frame (index)
+ (let ((frame (nth-frame index)))
+ (when (sb-debug:frame-has-debug-tag-p frame)
+ (multiple-value-bind (fname args) (sb-debug::frame-call frame)
+ (multiple-value-bind (fun arglist)
+ (if (and (sb-int:legal-fun-name-p fname) (fboundp fname))
+ (values (fdefinition fname) args)
+ (values (sb-di:debug-fun-fun (sb-di:frame-debug-fun frame))
+ (sb-debug::frame-args-as-list frame)))
+ (when (functionp fun)
+ (sb-debug:unwind-to-frame-and-call
+ frame
+ (lambda ()
+ ;; Ensure TCO.
+ (declare (optimize (debug 0)))
+ (apply fun arglist)))))))
+ (format nil "Cannot restart frame: ~S" frame))))
+
+;; FIXME: this implementation doesn't unwind the stack before
+;; re-invoking the function, but it's better than no implementation at
+;; all.
+#-#.(swank/sbcl::sbcl-with-restart-frame)
+(progn
+ (defun sb-debug-catch-tag-p (tag)
+ (and (symbolp tag)
+ (not (symbol-package tag))
+ (string= tag :sb-debug-catch-tag)))
+
+ (defimplementation return-from-frame (index form)
+ (let* ((frame (nth-frame index))
+ (probe (assoc-if #'sb-debug-catch-tag-p
+ (sb-di::frame-catches frame))))
+ (cond (probe (throw (car probe) (eval-in-frame form index)))
+ (t (format nil "Cannot return from frame: ~S" frame)))))
+
+ (defimplementation restart-frame (index)
+ (let ((frame (nth-frame index)))
+ (return-from-frame index (sb-debug::frame-call-as-list frame)))))
+
+;;;;; reference-conditions
+
+(defimplementation print-condition (condition stream)
+ (let ((sb-int:*print-condition-references* nil))
+ (princ condition stream)))
+
+
+;;;; Profiling
+
+(defimplementation profile (fname)
+ (when fname (eval `(sb-profile:profile ,fname))))
+
+(defimplementation unprofile (fname)
+ (when fname (eval `(sb-profile:unprofile ,fname))))
+
+(defimplementation unprofile-all ()
+ (sb-profile:unprofile)
+ "All functions unprofiled.")
+
+(defimplementation profile-report ()
+ (sb-profile:report))
+
+(defimplementation profile-reset ()
+ (sb-profile:reset)
+ "Reset profiling counters.")
+
+(defimplementation profiled-functions ()
+ (sb-profile:profile))
+
+(defimplementation profile-package (package callers methods)
+ (declare (ignore callers methods))
+ (eval `(sb-profile:profile ,(package-name (find-package package)))))
+
+
+;;;; Inspector
+
+(defmethod emacs-inspect ((o t))
+ (cond ((sb-di::indirect-value-cell-p o)
+ (label-value-line* (:value (sb-kernel:value-cell-ref o))))
+ (t
+ (multiple-value-bind (text label parts) (sb-impl::inspected-parts o)
+ (list* (string-right-trim '(#\Newline) text)
+ '(:newline)
+ (if label
+ (loop for (l . v) in parts
+ append (label-value-line l v))
+ (loop for value in parts
+ for i from 0
+ append (label-value-line i value))))))))
+
+(defmethod emacs-inspect ((o function))
+ (let ((header (sb-kernel:widetag-of o)))
+ (cond ((= header sb-vm:simple-fun-header-widetag)
+ (label-value-line*
+ (:name (sb-kernel:%simple-fun-name o))
+ (:arglist (sb-kernel:%simple-fun-arglist o))
+ (:self (sb-kernel:%simple-fun-self o))
+ (:next (sb-kernel:%simple-fun-next o))
+ (:type (sb-kernel:%simple-fun-type o))
+ (:code (sb-kernel:fun-code-header o))))
+ ((= header sb-vm:closure-header-widetag)
+ (append
+ (label-value-line :function (sb-kernel:%closure-fun o))
+ `("Closed over values:" (:newline))
+ (loop for i below (1- (sb-kernel:get-closure-length o))
+ append (label-value-line
+ i (sb-kernel:%closure-index-ref o i)))))
+ (t (call-next-method o)))))
+
+(defmethod emacs-inspect ((o sb-kernel:code-component))
+ (append
+ (label-value-line*
+ (:code-size (sb-kernel:%code-code-size o))
+ (:entry-points (sb-kernel:%code-entry-points o))
+ (:debug-info (sb-kernel:%code-debug-info o)))
+ `("Constants:" (:newline))
+ (loop for i from sb-vm:code-constants-offset
+ below
+ (#.(swank/backend:choose-symbol 'sb-kernel 'code-header-words
+ 'sb-kernel 'get-header-data)
+ o)
+ append (label-value-line i (sb-kernel:code-header-ref o i)))
+ `("Code:" (:newline)
+ , (with-output-to-string (s)
+ (cond ((sb-kernel:%code-debug-info o)
+ (sb-disassem:disassemble-code-component o :stream s))
+ (t
+ (sb-disassem:disassemble-memory
+ (sb-disassem::align
+ (+ (logandc2 (sb-kernel:get-lisp-obj-address o)
+ sb-vm:lowtag-mask)
+ (* sb-vm:code-constants-offset
+ sb-vm:n-word-bytes))
+ (ash 1 sb-vm:n-lowtag-bits))
+ (ash (sb-kernel:%code-code-size o) sb-vm:word-shift)
+ :stream s)))))))
+
+(defmethod emacs-inspect ((o sb-ext:weak-pointer))
+ (label-value-line*
+ (:value (sb-ext:weak-pointer-value o))))
+
+(defmethod emacs-inspect ((o sb-kernel:fdefn))
+ (label-value-line*
+ (:name (sb-kernel:fdefn-name o))
+ (:function (sb-kernel:fdefn-fun o))))
+
+(defmethod emacs-inspect :around ((o generic-function))
+ (append
+ (call-next-method)
+ (label-value-line*
+ (:pretty-arglist (sb-pcl::generic-function-pretty-arglist o))
+ (:initial-methods (sb-pcl::generic-function-initial-methods o))
+ )))
+
+
+;;;; Multiprocessing
+
+#+(and sb-thread
+ #.(swank/backend:with-symbol "THREAD-NAME" "SB-THREAD"))
+(progn
+ (defvar *thread-id-counter* 0)
+
+ (defvar *thread-id-counter-lock*
+ (sb-thread:make-mutex :name "thread id counter lock"))
+
+ (defun next-thread-id ()
+ (sb-thread:with-mutex (*thread-id-counter-lock*)
+ (incf *thread-id-counter*)))
+
+ (defparameter *thread-id-map* (make-hash-table))
+
+ ;; This should be a thread -> id map but as weak keys are not
+ ;; supported it is id -> map instead.
+ (defvar *thread-id-map-lock*
+ (sb-thread:make-mutex :name "thread id map lock"))
+
+ (defimplementation spawn (fn &key name)
+ (sb-thread:make-thread fn :name name))
+
+ (defimplementation thread-id (thread)
+ (block thread-id
+ (sb-thread:with-mutex (*thread-id-map-lock*)
+ (loop for id being the hash-key in *thread-id-map*
+ using (hash-value thread-pointer)
+ do
+ (let ((maybe-thread (sb-ext:weak-pointer-value thread-pointer)))
+ (cond ((null maybe-thread)
+ ;; the value is gc'd, remove it manually
+ (remhash id *thread-id-map*))
+ ((eq thread maybe-thread)
+ (return-from thread-id id)))))
+ ;; lazy numbering
+ (let ((id (next-thread-id)))
+ (setf (gethash id *thread-id-map*) (sb-ext:make-weak-pointer thread))
+ id))))
+
+ (defimplementation find-thread (id)
+ (sb-thread:with-mutex (*thread-id-map-lock*)
+ (let ((thread-pointer (gethash id *thread-id-map*)))
+ (if thread-pointer
+ (let ((maybe-thread (sb-ext:weak-pointer-value thread-pointer)))
+ (if maybe-thread
+ maybe-thread
+ ;; the value is gc'd, remove it manually
+ (progn
+ (remhash id *thread-id-map*)
+ nil)))
+ nil))))
+
+ (defimplementation thread-name (thread)
+ ;; sometimes the name is not a string (e.g. NIL)
+ (princ-to-string (sb-thread:thread-name thread)))
+
+ (defimplementation thread-status (thread)
+ (if (sb-thread:thread-alive-p thread)
+ "Running"
+ "Stopped"))
+
+ (defimplementation make-lock (&key name)
+ (sb-thread:make-mutex :name name))
+
+ (defimplementation call-with-lock-held (lock function)
+ (declare (type function function))
+ (sb-thread:with-recursive-lock (lock) (funcall function)))
+
+ (defimplementation current-thread ()
+ sb-thread:*current-thread*)
+
+ (defimplementation all-threads ()
+ (sb-thread:list-all-threads))
+
+ (defimplementation interrupt-thread (thread fn)
+ (sb-thread:interrupt-thread thread fn))
+
+ (defimplementation kill-thread (thread)
+ (sb-thread:terminate-thread thread))
+
+ (defimplementation thread-alive-p (thread)
+ (sb-thread:thread-alive-p thread))
+
+ (defvar *mailbox-lock* (sb-thread:make-mutex :name "mailbox lock"))
+ (defvar *mailboxes* (list))
+ (declaim (type list *mailboxes*))
+
+ (defstruct (mailbox (:conc-name mailbox.))
+ thread
+ (mutex (sb-thread:make-mutex))
+ (waitqueue (sb-thread:make-waitqueue))
+ (queue '() :type list))
+
+ (defun mailbox (thread)
+ "Return THREAD's mailbox."
+ (sb-thread:with-mutex (*mailbox-lock*)
+ (or (find thread *mailboxes* :key #'mailbox.thread)
+ (let ((mb (make-mailbox :thread thread)))
+ (push mb *mailboxes*)
+ mb))))
+
+ (defimplementation send (thread message)
+ (let* ((mbox (mailbox thread))
+ (mutex (mailbox.mutex mbox)))
+ (sb-thread:with-mutex (mutex)
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message)))
+ (sb-thread:condition-broadcast (mailbox.waitqueue mbox)))))
+
+
+ (defun condition-timed-wait (waitqueue mutex timeout)
+ (macrolet ((foo ()
+ (cond ((member :sb-lutex *features*) ; Darwin
+ '(sb-thread:condition-wait waitqueue mutex))
+ (t
+ '(handler-case
+ (let ((*break-on-signals* nil))
+ (sb-sys:with-deadline (:seconds timeout
+ :override t)
+ (sb-thread:condition-wait waitqueue mutex) t))
+ (sb-ext:timeout ()
+ nil))))))
+ (foo)))
+
+ (defimplementation receive-if (test &optional timeout)
+ (let* ((mbox (mailbox (current-thread)))
+ (mutex (mailbox.mutex mbox))
+ (waitq (mailbox.waitqueue mbox)))
+ (assert (or (not timeout) (eq timeout t)))
+ (loop
+ (check-slime-interrupts)
+ (sb-thread:with-mutex (mutex)
+ (let* ((q (mailbox.queue mbox))
+ (tail (member-if test q)))
+ (when tail
+ (setf (mailbox.queue mbox) (nconc (ldiff q tail) (cdr tail)))
+ (return (car tail))))
+ (when (eq timeout t) (return (values nil t)))
+ (condition-timed-wait waitq mutex 0.2)))))
+
+ (let ((alist '())
+ (mutex (sb-thread:make-mutex :name "register-thread")))
+
+ (defimplementation register-thread (name thread)
+ (declare (type symbol name))
+ (sb-thread:with-mutex (mutex)
+ (etypecase thread
+ (null
+ (setf alist (delete name alist :key #'car)))
+ (sb-thread:thread
+ (let ((probe (assoc name alist)))
+ (cond (probe (setf (cdr probe) thread))
+ (t (setf alist (acons name thread alist))))))))
+ nil)
+
+ (defimplementation find-registered (name)
+ (sb-thread:with-mutex (mutex)
+ (cdr (assoc name alist)))))
+
+ ;; Workaround for deadlocks between the world-lock and auto-flush-thread
+ ;; buffer write lock.
+ ;;
+ ;; Another alternative would be to grab the world-lock here, but that's less
+ ;; future-proof, and could introduce other lock-ordering issues in the
+ ;; future.
+ ;;
+ ;; In an ideal world we would just have an :AROUND method on
+ ;; SLIME-OUTPUT-STREAM, and be done, but that class doesn't exist when this
+ ;; file is loaded -- so first we need a dummy definition that will be
+ ;; overridden by swank-gray.lisp.
+ #.(unless (find-package 'swank/gray) (make-package 'swank/gray) nil)
+ (eval-when (:load-toplevel :execute)
+ (unless (find-package 'swank/gray) (make-package 'swank/gray) nil))
+ (defclass swank/gray::slime-output-stream
+ (sb-gray:fundamental-character-output-stream)
+ ())
+ (defmethod sb-gray:stream-force-output
+ :around ((stream swank/gray::slime-output-stream))
+ (handler-case
+ (sb-sys:with-deadline (:seconds 0.1)
+ (call-next-method))
+ (sb-sys:deadline-timeout ()
+ nil)))
+ )
+
+(defimplementation quit-lisp ()
+ #+#.(swank/backend:with-symbol 'exit 'sb-ext)
+ (sb-ext:exit)
+ #-#.(swank/backend:with-symbol 'exit 'sb-ext)
+ (progn
+ #+sb-thread
+ (dolist (thread (remove (current-thread) (all-threads)))
+ (ignore-errors (sb-thread:terminate-thread thread)))
+ (sb-ext:quit)))
+
+
+
+;;Trace implementations
+;;In SBCL, we have:
+;; (trace <name>)
+;; (trace :methods '<name>) ;to trace all methods of the gf <name>
+;; (trace (method <name> <qualifier>? (<specializer>+)))
+;; <name> can be a normal name or a (setf name)
+
+(defun toggle-trace-aux (fspec &rest args)
+ (cond ((member fspec (eval '(trace)) :test #'equal)
+ (eval `(untrace ,fspec))
+ (format nil "~S is now untraced." fspec))
+ (t
+ (eval `(trace ,@(if args `(:encapsulate nil) (list)) ,fspec ,@args))
+ (format nil "~S is now traced." fspec))))
+
+(defun process-fspec (fspec)
+ (cond ((consp fspec)
+ (ecase (first fspec)
+ ((:defun :defgeneric) (second fspec))
+ ((:defmethod) `(method ,@(rest fspec)))
+ ((:labels) `(labels ,(process-fspec (second fspec)) ,(third fspec)))
+ ((:flet) `(flet ,(process-fspec (second fspec)) ,(third fspec)))))
+ (t
+ fspec)))
+
+(defimplementation toggle-trace (spec)
+ (ecase (car spec)
+ ((setf)
+ (toggle-trace-aux spec))
+ ((:defmethod)
+ (toggle-trace-aux `(sb-pcl::fast-method ,@(rest (process-fspec spec)))))
+ ((:defgeneric)
+ (toggle-trace-aux (second spec) :methods t))
+ ((:call)
+ (destructuring-bind (caller callee) (cdr spec)
+ (toggle-trace-aux callee :wherein (list (process-fspec caller)))))))
+
+;;; Weak datastructures
+
+(defimplementation make-weak-key-hash-table (&rest args)
+ #+#.(swank/sbcl::sbcl-with-weak-hash-tables)
+ (apply #'make-hash-table :weakness :key args)
+ #-#.(swank/sbcl::sbcl-with-weak-hash-tables)
+ (apply #'make-hash-table args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+ #+#.(swank/sbcl::sbcl-with-weak-hash-tables)
+ (apply #'make-hash-table :weakness :value args)
+ #-#.(swank/sbcl::sbcl-with-weak-hash-tables)
+ (apply #'make-hash-table args))
+
+(defimplementation hash-table-weakness (hashtable)
+ #+#.(swank/sbcl::sbcl-with-weak-hash-tables)
+ (sb-ext:hash-table-weakness hashtable))
+
+#-win32
+(defimplementation save-image (filename &optional restart-function)
+ (flet ((restart-sbcl ()
+ (sb-debug::enable-debugger)
+ (setf sb-impl::*descriptor-handlers* nil)
+ (funcall restart-function)))
+ (let ((pid (sb-posix:fork)))
+ (cond ((= pid 0)
+ (sb-debug::disable-debugger)
+ (apply #'sb-ext:save-lisp-and-die filename
+ (when restart-function
+ (list :toplevel #'restart-sbcl))))
+ (t
+ (multiple-value-bind (rpid status) (sb-posix:waitpid pid 0)
+ (assert (= pid rpid))
+ (assert (and (sb-posix:wifexited status)
+ (zerop (sb-posix:wexitstatus status))))))))))
+
+#+unix
+(progn
+ (sb-alien:define-alien-routine ("execv" sys-execv) sb-alien:int
+ (program sb-alien:c-string)
+ (argv (* sb-alien:c-string)))
+
+ (defun execv (program args)
+ "Replace current executable with another one."
+ (let ((a-args (sb-alien:make-alien sb-alien:c-string
+ (+ 1 (length args)))))
+ (unwind-protect
+ (progn
+ (loop for index from 0 by 1
+ and item in (append args '(nil))
+ do (setf (sb-alien:deref a-args index)
+ item))
+ (when (minusp
+ (sys-execv program a-args))
+ (error "execv(3) returned.")))
+ (sb-alien:free-alien a-args))))
+
+ (defun runtime-pathname ()
+ #+#.(swank/backend:with-symbol
+ '*runtime-pathname* 'sb-ext)
+ sb-ext:*runtime-pathname*
+ #-#.(swank/backend:with-symbol
+ '*runtime-pathname* 'sb-ext)
+ (car sb-ext:*posix-argv*))
+
+ (defimplementation exec-image (image-file args)
+ (loop with fd-arg =
+ (loop for arg in args
+ and key = "" then arg
+ when (string-equal key "--swank-fd")
+ return (parse-integer arg))
+ for my-fd from 3 to 1024
+ when (/= my-fd fd-arg)
+ do (ignore-errors (sb-posix:fcntl my-fd sb-posix:f-setfd 1)))
+ (let* ((self-string (pathname-to-filename (runtime-pathname))))
+ (execv
+ self-string
+ (apply 'list self-string "--core" image-file args)))))
+
+(defimplementation make-fd-stream (fd external-format)
+ (sb-sys:make-fd-stream fd :input t :output t
+ :element-type 'character
+ :buffering :full
+ :dual-channel-p t
+ :external-format external-format))
+
+#-win32
+(defimplementation background-save-image (filename &key restart-function
+ completion-function)
+ (flet ((restart-sbcl ()
+ (sb-debug::enable-debugger)
+ (setf sb-impl::*descriptor-handlers* nil)
+ (funcall restart-function)))
+ (multiple-value-bind (pipe-in pipe-out) (sb-posix:pipe)
+ (let ((pid (sb-posix:fork)))
+ (cond ((= pid 0)
+ (sb-posix:close pipe-in)
+ (sb-debug::disable-debugger)
+ (apply #'sb-ext:save-lisp-and-die filename
+ (when restart-function
+ (list :toplevel #'restart-sbcl))))
+ (t
+ (sb-posix:close pipe-out)
+ (sb-sys:add-fd-handler
+ pipe-in :input
+ (lambda (fd)
+ (sb-sys:invalidate-descriptor fd)
+ (sb-posix:close fd)
+ (multiple-value-bind (rpid status) (sb-posix:waitpid pid 0)
+ (assert (= pid rpid))
+ (assert (sb-posix:wifexited status))
+ (funcall completion-function
+ (zerop (sb-posix:wexitstatus status))))))))))))
+
+(pushnew 'deinit-log-output sb-ext:*save-hooks*)
+
+
+;;;; wrap interface implementation
+
+(defun sbcl-version>= (&rest subversions)
+ #+#.(swank/backend:with-symbol 'assert-version->= 'sb-ext)
+ (values (ignore-errors (apply #'sb-ext:assert-version->= subversions) t))
+ #-#.(swank/backend:with-symbol 'assert-version->= 'sb-ext)
+ nil)
+
+(defimplementation wrap (spec indicator &key before after replace)
+ (when (wrapped-p spec indicator)
+ (warn "~a already wrapped with indicator ~a, unwrapping first"
+ spec indicator)
+ (sb-int:unencapsulate spec indicator))
+ (sb-int:encapsulate spec indicator
+ #-#.(swank/backend:with-symbol 'arg-list 'sb-int)
+ (lambda (function &rest args)
+ (sbcl-wrap spec before after replace function args))
+ #+#.(swank/backend:with-symbol 'arg-list 'sb-int)
+ (if (sbcl-version>= 1 1 16)
+ (lambda ()
+ (sbcl-wrap spec before after replace
+ (symbol-value 'sb-int:basic-definition)
+ (symbol-value 'sb-int:arg-list)))
+ `(sbcl-wrap ',spec ,before ,after ,replace
+ (symbol-value 'sb-int:basic-definition)
+ (symbol-value 'sb-int:arg-list)))))
+
+(defimplementation unwrap (spec indicator)
+ (sb-int:unencapsulate spec indicator))
+
+(defimplementation wrapped-p (spec indicator)
+ (sb-int:encapsulated-p spec indicator))
+
+(defun sbcl-wrap (spec before after replace function args)
+ (declare (ignore spec))
+ (let (retlist completed)
+ (unwind-protect
+ (progn
+ (when before
+ (funcall before args))
+ (setq retlist (multiple-value-list (if replace
+ (funcall replace
+ args)
+ (apply function args))))
+ (setq completed t)
+ (values-list retlist))
+ (when after
+ (funcall after (if completed retlist :exited-non-locally))))))
+
+#+#.(swank/backend:with-symbol 'comma-expr 'sb-impl)
+(progn
+ (defmethod sexp-in-bounds-p ((s sb-impl::comma) i)
+ (= i 1))
+
+ (defmethod sexp-ref ((s sb-impl::comma) i)
+ (sb-impl::comma-expr s)))
diff --git a/vim/bundle/slimv/slime/swank/scl.lisp b/vim/bundle/slimv/slime/swank/scl.lisp
new file mode 100644
index 0000000..7327133
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/scl.lisp
@@ -0,0 +1,1726 @@
+;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;+" -*-
+;;;
+;;; Scieneer Common Lisp code for SLIME.
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+(defpackage swank/scl
+ (:use cl swank/backend swank/source-path-parser swank/source-file-cache))
+
+(in-package swank/scl)
+
+
+
+;;; swank-mop
+
+(import-swank-mop-symbols :clos '(:slot-definition-documentation))
+
+(defun swank-mop:slot-definition-documentation (slot)
+ (documentation slot t))
+
+
+;;;; TCP server
+;;;
+;;; SCL only supports the :spawn communication style.
+;;;
+
+(defimplementation preferred-communication-style ()
+ :spawn)
+
+(defimplementation create-socket (host port &key backlog)
+ (let ((addr (resolve-hostname host)))
+ (ext:create-inet-listener port :stream :host addr :reuse-address t
+ :backlog (or backlog 5))))
+
+(defimplementation local-port (socket)
+ (nth-value 1 (ext::get-socket-host-and-port (socket-fd socket))))
+
+(defimplementation close-socket (socket)
+ (ext:close-socket (socket-fd socket)))
+
+(defimplementation accept-connection (socket
+ &key external-format buffering timeout)
+ (let ((buffering (or buffering :full))
+ (fd (socket-fd socket)))
+ (loop
+ (let ((ready (sys:wait-until-fd-usable fd :input timeout)))
+ (unless ready
+ (error "Timeout accepting connection on socket: ~S~%" socket)))
+ (let ((new-fd (ignore-errors (ext:accept-tcp-connection fd))))
+ (when new-fd
+ (return (make-socket-io-stream new-fd external-format
+ (ecase buffering
+ ((t) :full)
+ ((nil) :none)
+ (:line :line)))))))))
+
+(defimplementation set-stream-timeout (stream timeout)
+ (check-type timeout (or null real))
+ (if (fboundp 'ext::stream-timeout)
+ (setf (ext::stream-timeout stream) timeout)
+ (setf (slot-value (slot-value stream 'lisp::stream) 'lisp::timeout)
+ timeout)))
+
+;;;;; Sockets
+
+(defun socket-fd (socket)
+ "Return the file descriptor for the socket represented by 'socket."
+ (etypecase socket
+ (fixnum socket)
+ (stream (sys:fd-stream-fd socket))))
+
+(defun resolve-hostname (hostname)
+ "Return the IP address of 'hostname as an integer (in host byte-order)."
+ (let ((hostent (ext:lookup-host-entry hostname)))
+ (car (ext:host-entry-addr-list hostent))))
+
+(defvar *external-format-to-coding-system*
+ '((:iso-8859-1
+ "latin-1" "latin-1-unix" "iso-latin-1-unix"
+ "iso-8859-1" "iso-8859-1-unix")
+ (:utf-8 "utf-8" "utf-8-unix")
+ (:euc-jp "euc-jp" "euc-jp-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+
+(defun make-socket-io-stream (fd external-format buffering)
+ "Create a new input/output fd-stream for 'fd."
+ (cond ((not external-format)
+ (sys:make-fd-stream fd :input t :output t :buffering buffering
+ :element-type '(unsigned-byte 8)))
+ (t
+ (let* ((stream (sys:make-fd-stream fd :input t :output t
+ :element-type 'base-char
+ :buffering buffering
+ :external-format external-format)))
+ ;; Ignore character conversion errors. Without this the
+ ;; communication channel is prone to lockup if a character
+ ;; conversion error occurs.
+ (setf (lisp::character-conversion-stream-input-error-value stream)
+ #\?)
+ (setf (lisp::character-conversion-stream-output-error-value stream)
+ #\?)
+ stream))))
+
+
+;;;; Stream handling
+
+(defimplementation gray-package-name ()
+ '#:ext)
+
+
+;;;; Compilation Commands
+
+(defvar *previous-compiler-condition* nil
+ "Used to detect duplicates.")
+
+(defvar *previous-context* nil
+ "Previous compiler error context.")
+
+(defvar *buffer-name* nil
+ "The name of the Emacs buffer we are compiling from.
+ Nil if we aren't compiling from a buffer.")
+
+(defvar *buffer-start-position* nil)
+(defvar *buffer-substring* nil)
+
+(defimplementation call-with-compilation-hooks (function)
+ (let ((*previous-compiler-condition* nil)
+ (*previous-context* nil)
+ (*print-readably* nil))
+ (handler-bind ((c::compiler-error #'handle-notification-condition)
+ (c::style-warning #'handle-notification-condition)
+ (c::warning #'handle-notification-condition))
+ (funcall function))))
+
+(defimplementation swank-compile-file (input-file output-file
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* nil)
+ (ext:*ignore-extra-close-parentheses* nil))
+ (multiple-value-bind (output-file warnings-p failure-p)
+ (compile-file input-file
+ :output-file output-file
+ :external-format external-format)
+ (values output-file warnings-p
+ (or failure-p
+ (when load-p
+ ;; Cache the latest source file for definition-finding.
+ (source-cache-get input-file
+ (file-write-date input-file))
+ (not (load output-file)))))))))
+
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore filename policy))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer)
+ (*buffer-start-position* position)
+ (*buffer-substring* string))
+ (with-input-from-string (stream string)
+ (ext:compile-from-stream
+ stream
+ :source-info `(:emacs-buffer ,buffer
+ :emacs-buffer-offset ,position
+ :emacs-buffer-string ,string))))))
+
+
+;;;;; Trapping notes
+;;;
+;;; We intercept conditions from the compiler and resignal them as
+;;; `swank:compiler-condition's.
+
+(defun handle-notification-condition (condition)
+ "Handle a condition caused by a compiler warning."
+ (unless (eq condition *previous-compiler-condition*)
+ (let ((context (c::find-error-context nil)))
+ (setq *previous-compiler-condition* condition)
+ (setq *previous-context* context)
+ (signal-compiler-condition condition context))))
+
+(defun signal-compiler-condition (condition context)
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity (severity-for-emacs condition)
+ :message (brief-compiler-message-for-emacs condition)
+ :source-context (compiler-error-context context)
+ :location (if (read-error-p condition)
+ (read-error-location condition)
+ (compiler-note-location context))))
+
+(defun severity-for-emacs (condition)
+ "Return the severity of 'condition."
+ (etypecase condition
+ ((satisfies read-error-p) :read-error)
+ (c::compiler-error :error)
+ (c::style-warning :note)
+ (c::warning :warning)))
+
+(defun read-error-p (condition)
+ (eq (type-of condition) 'c::compiler-read-error))
+
+(defun brief-compiler-message-for-emacs (condition)
+ "Briefly describe a compiler error for Emacs.
+ When Emacs presents the message it already has the source popped up
+ and the source form highlighted. This makes much of the information in
+ the error-context redundant."
+ (princ-to-string condition))
+
+(defun compiler-error-context (error-context)
+ "Describe a compiler error for Emacs including context information."
+ (declare (type (or c::compiler-error-context null) error-context))
+ (multiple-value-bind (enclosing source)
+ (if error-context
+ (values (c::compiler-error-context-enclosing-source error-context)
+ (c::compiler-error-context-source error-context)))
+ (if (and enclosing source)
+ (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]"
+ enclosing source))))
+
+(defun read-error-location (condition)
+ (let* ((finfo (car (c::source-info-current-file c::*source-info*)))
+ (file (c::file-info-name finfo))
+ (pos (c::compiler-read-error-position condition)))
+ (cond ((and (eq file :stream) *buffer-name*)
+ (make-location (list :buffer *buffer-name*)
+ (list :offset *buffer-start-position* pos)))
+ ((and (pathnamep file) (not *buffer-name*))
+ (make-location (list :file (unix-truename file))
+ (list :position (1+ pos))))
+ (t (break)))))
+
+(defun compiler-note-location (context)
+ "Derive the location of a complier message from its context.
+ Return a `location' record, or (:error <reason>) on failure."
+ (if (null context)
+ (note-error-location)
+ (let ((file (c::compiler-error-context-file-name context))
+ (source (c::compiler-error-context-original-source context))
+ (path
+ (reverse
+ (c::compiler-error-context-original-source-path context))))
+ (or (locate-compiler-note file source path)
+ (note-error-location)))))
+
+(defun note-error-location ()
+ "Pseudo-location for notes that can't be located."
+ (list :error "No error location available."))
+
+(defun locate-compiler-note (file source source-path)
+ (cond ((and (eq file :stream) *buffer-name*)
+ ;; Compiling from a buffer
+ (make-location (list :buffer *buffer-name*)
+ (list :offset *buffer-start-position*
+ (source-path-string-position
+ source-path *buffer-substring*))))
+ ((and (pathnamep file) (null *buffer-name*))
+ ;; Compiling from a file
+ (make-location (list :file (unix-truename file))
+ (list :position (1+ (source-path-file-position
+ source-path file)))))
+ ((and (eq file :lisp) (stringp source))
+ ;; No location known, but we have the source form.
+ ;; XXX How is this case triggered? -luke (16/May/2004)
+ ;; This can happen if the compiler needs to expand a macro
+ ;; but the macro-expander is not yet compiled. Calling the
+ ;; (interpreted) macro-expander triggers IR1 conversion of
+ ;; the lambda expression for the expander and invokes the
+ ;; compiler recursively.
+ (make-location (list :source-form source)
+ (list :position 1)))))
+
+(defun unix-truename (pathname)
+ (ext:unix-namestring (truename pathname)))
+
+
+
+;;; TODO
+(defimplementation who-calls (name) nil)
+(defimplementation who-references (name) nil)
+(defimplementation who-binds (name) nil)
+(defimplementation who-sets (name) nil)
+(defimplementation who-specializes (symbol) nil)
+(defimplementation who-macroexpands (name) nil)
+
+
+;;;; Find callers and callees
+;;;
+;;; Find callers and callees by looking at the constant pool of
+;;; compiled code objects. We assume every fdefn object in the
+;;; constant pool corresponds to a call to that function. A better
+;;; strategy would be to use the disassembler to find actual
+;;; call-sites.
+
+(declaim (inline map-code-constants))
+(defun map-code-constants (code fn)
+ "Call 'fn for each constant in 'code's constant pool."
+ (check-type code kernel:code-component)
+ (loop for i from vm:code-constants-offset below (kernel:get-header-data code)
+ do (funcall fn (kernel:code-header-ref code i))))
+
+(defun function-callees (function)
+ "Return 'function's callees as a list of functions."
+ (let ((callees '()))
+ (map-code-constants
+ (vm::find-code-object function)
+ (lambda (obj)
+ (when (kernel:fdefn-p obj)
+ (push (kernel:fdefn-function obj) callees))))
+ callees))
+
+(declaim (ext:maybe-inline map-allocated-code-components))
+(defun map-allocated-code-components (spaces fn)
+ "Call FN for each allocated code component in one of 'spaces. FN
+ receives the object as argument. 'spaces should be a list of the
+ symbols :dynamic, :static, or :read-only."
+ (dolist (space spaces)
+ (declare (inline vm::map-allocated-objects)
+ (optimize (ext:inhibit-warnings 3)))
+ (vm::map-allocated-objects
+ (lambda (obj header size)
+ (declare (type fixnum size) (ignore size))
+ (when (= vm:code-header-type header)
+ (funcall fn obj)))
+ space)))
+
+(declaim (ext:maybe-inline map-caller-code-components))
+(defun map-caller-code-components (function spaces fn)
+ "Call 'fn for each code component with a fdefn for 'function in its
+ constant pool."
+ (let ((function (coerce function 'function)))
+ (declare (inline map-allocated-code-components))
+ (map-allocated-code-components
+ spaces
+ (lambda (obj)
+ (map-code-constants
+ obj
+ (lambda (constant)
+ (when (and (kernel:fdefn-p constant)
+ (eq (kernel:fdefn-function constant)
+ function))
+ (funcall fn obj))))))))
+
+(defun function-callers (function &optional (spaces '(:read-only :static
+ :dynamic)))
+ "Return 'function's callers. The result is a list of code-objects."
+ (let ((referrers '()))
+ (declare (inline map-caller-code-components))
+ (map-caller-code-components function spaces
+ (lambda (code) (push code referrers)))
+ referrers))
+
+(defun debug-info-definitions (debug-info)
+ "Return the defintions for a debug-info. This should only be used
+ for code-object without entry points, i.e., byte compiled
+ code (are theree others?)"
+ ;; This mess has only been tested with #'ext::skip-whitespace, a
+ ;; byte-compiled caller of #'read-char .
+ (check-type debug-info (and (not c::compiled-debug-info) c::debug-info))
+ (let ((name (c::debug-info-name debug-info))
+ (source (c::debug-info-source debug-info)))
+ (destructuring-bind (first) source
+ (ecase (c::debug-source-from first)
+ (:file
+ (list (list name
+ (make-location
+ (list :file (unix-truename (c::debug-source-name first)))
+ (list :function-name (string name))))))))))
+
+(defun valid-function-name-p (name)
+ (or (symbolp name) (and (consp name)
+ (eq (car name) 'setf)
+ (symbolp (cadr name))
+ (not (cddr name)))))
+
+(defun code-component-entry-points (code)
+ "Return a list ((name location) ...) of function definitons for
+ the code omponent 'code."
+ (let ((names '()))
+ (do ((f (kernel:%code-entry-points code) (kernel::%function-next f)))
+ ((not f))
+ (let ((name (kernel:%function-name f)))
+ (when (valid-function-name-p name)
+ (push (list name (function-location f)) names))))
+ names))
+
+(defimplementation list-callers (symbol)
+ "Return a list ((name location) ...) of callers."
+ (let ((components (function-callers symbol))
+ (xrefs '()))
+ (dolist (code components)
+ (let* ((entry (kernel:%code-entry-points code))
+ (defs (if entry
+ (code-component-entry-points code)
+ ;; byte compiled stuff
+ (debug-info-definitions
+ (kernel:%code-debug-info code)))))
+ (setq xrefs (nconc defs xrefs))))
+ xrefs))
+
+(defimplementation list-callees (symbol)
+ (let ((fns (function-callees symbol)))
+ (mapcar (lambda (fn)
+ (list (kernel:%function-name fn)
+ (function-location fn)))
+ fns)))
+
+
+;;;; Resolving source locations
+;;;
+;;; Our mission here is to "resolve" references to code locations into
+;;; actual file/buffer names and character positions. The references
+;;; we work from come out of the compiler's statically-generated debug
+;;; information, such as `code-location''s and `debug-source''s. For
+;;; more details, see the "Debugger Programmer's Interface" section of
+;;; the SCL manual.
+;;;
+;;; The first step is usually to find the corresponding "source-path"
+;;; for the location. Once we have the source-path we can pull up the
+;;; source file and `READ' our way through to the right position. The
+;;; main source-code groveling work is done in
+;;; `source-path-parser.lisp'.
+
+(defvar *debug-definition-finding* nil
+ "When true don't handle errors while looking for definitions.
+ This is useful when debugging the definition-finding code.")
+
+(defmacro safe-definition-finding (&body body)
+ "Execute 'body and return the source-location it returns.
+ If an error occurs and `*debug-definition-finding*' is false, then
+ return an error pseudo-location.
+
+ The second return value is 'nil if no error occurs, otherwise it is the
+ condition object."
+ `(flet ((body () ,@body))
+ (if *debug-definition-finding*
+ (body)
+ (handler-case (values (progn ,@body) nil)
+ (error (c) (values (list :error (princ-to-string c)) c))))))
+
+(defun code-location-source-location (code-location)
+ "Safe wrapper around `code-location-from-source-location'."
+ (safe-definition-finding
+ (source-location-from-code-location code-location)))
+
+(defun source-location-from-code-location (code-location)
+ "Return the source location for 'code-location."
+ (let ((debug-fun (di:code-location-debug-function code-location)))
+ (when (di::bogus-debug-function-p debug-fun)
+ ;; Those lousy cheapskates! They've put in a bogus debug source
+ ;; because the code was compiled at a low debug setting.
+ (error "Bogus debug function: ~A" debug-fun)))
+ (let* ((debug-source (di:code-location-debug-source code-location))
+ (from (di:debug-source-from debug-source))
+ (name (di:debug-source-name debug-source)))
+ (ecase from
+ (:file
+ (location-in-file name code-location debug-source))
+ (:stream
+ (location-in-stream code-location debug-source))
+ (:lisp
+ ;; The location comes from a form passed to `compile'.
+ ;; The best we can do is return the form itself for printing.
+ (make-location
+ (list :source-form (with-output-to-string (*standard-output*)
+ (debug::print-code-location-source-form
+ code-location 100 t)))
+ (list :position 1))))))
+
+(defun location-in-file (filename code-location debug-source)
+ "Resolve the source location for 'code-location in 'filename."
+ (let* ((code-date (di:debug-source-created debug-source))
+ (source-code (get-source-code filename code-date)))
+ (with-input-from-string (s source-code)
+ (make-location (list :file (unix-truename filename))
+ (list :position (1+ (code-location-stream-position
+ code-location s)))
+ `(:snippet ,(read-snippet s))))))
+
+(defun location-in-stream (code-location debug-source)
+ "Resolve the source location for a 'code-location from a stream.
+ This only succeeds if the code was compiled from an Emacs buffer."
+ (unless (debug-source-info-from-emacs-buffer-p debug-source)
+ (error "The code is compiled from a non-SLIME stream."))
+ (let* ((info (c::debug-source-info debug-source))
+ (string (getf info :emacs-buffer-string))
+ (position (code-location-string-offset
+ code-location
+ string)))
+ (make-location
+ (list :buffer (getf info :emacs-buffer))
+ (list :offset (getf info :emacs-buffer-offset) position)
+ (list :snippet (with-input-from-string (s string)
+ (file-position s position)
+ (read-snippet s))))))
+
+;;;;; Function-name locations
+;;;
+(defun debug-info-function-name-location (debug-info)
+ "Return a function-name source-location for 'debug-info.
+ Function-name source-locations are a fallback for when precise
+ positions aren't available."
+ (with-struct (c::debug-info- (fname name) source) debug-info
+ (with-struct (c::debug-source- info from name) (car source)
+ (ecase from
+ (:file
+ (make-location (list :file (namestring (truename name)))
+ (list :function-name (string fname))))
+ (:stream
+ (assert (debug-source-info-from-emacs-buffer-p (car source)))
+ (make-location (list :buffer (getf info :emacs-buffer))
+ (list :function-name (string fname))))
+ (:lisp
+ (make-location (list :source-form (princ-to-string (aref name 0)))
+ (list :position 1)))))))
+
+(defun debug-source-info-from-emacs-buffer-p (debug-source)
+ "Does the `info' slot of 'debug-source contain an Emacs buffer location?
+ This is true for functions that were compiled directly from buffers."
+ (info-from-emacs-buffer-p (c::debug-source-info debug-source)))
+
+(defun info-from-emacs-buffer-p (info)
+ (and info
+ (consp info)
+ (eq :emacs-buffer (car info))))
+
+
+;;;;; Groveling source-code for positions
+
+(defun code-location-stream-position (code-location stream)
+ "Return the byte offset of 'code-location in 'stream. Extract the
+ toplevel-form-number and form-number from 'code-location and use that
+ to find the position of the corresponding form.
+
+ Finish with 'stream positioned at the start of the code location."
+ (let* ((location (debug::maybe-block-start-location code-location))
+ (tlf-offset (di:code-location-top-level-form-offset location))
+ (form-number (di:code-location-form-number location)))
+ (let ((pos (form-number-stream-position tlf-offset form-number stream)))
+ (file-position stream pos)
+ pos)))
+
+(defun form-number-stream-position (tlf-number form-number stream)
+ "Return the starting character position of a form in 'stream.
+ 'tlf-number is the top-level-form number.
+ 'form-number is an index into a source-path table for the TLF."
+ (multiple-value-bind (tlf position-map) (read-source-form tlf-number stream)
+ (let* ((path-table (di:form-number-translations tlf 0))
+ (source-path
+ (if (<= (length path-table) form-number) ; source out of sync?
+ (list 0) ; should probably signal a condition
+ (reverse (cdr (aref path-table form-number))))))
+ (source-path-source-position source-path tlf position-map))))
+
+(defun code-location-string-offset (code-location string)
+ "Return the byte offset of 'code-location in 'string.
+ See 'code-location-stream-position."
+ (with-input-from-string (s string)
+ (code-location-stream-position code-location s)))
+
+
+;;;; Finding definitions
+
+;;; There are a great many different types of definition for us to
+;;; find. We search for definitions of every kind and return them in a
+;;; list.
+
+(defimplementation find-definitions (name)
+ (append (function-definitions name)
+ (setf-definitions name)
+ (variable-definitions name)
+ (class-definitions name)
+ (type-definitions name)
+ (compiler-macro-definitions name)
+ (source-transform-definitions name)
+ (function-info-definitions name)
+ (ir1-translator-definitions name)))
+
+;;;;; Functions, macros, generic functions, methods
+;;;
+;;; We make extensive use of the compile-time debug information that
+;;; SCL records, in particular "debug functions" and "code
+;;; locations." Refer to the "Debugger Programmer's Interface" section
+;;; of the SCL manual for more details.
+
+(defun function-definitions (name)
+ "Return definitions for 'name in the \"function namespace\", i.e.,
+ regular functions, generic functions, methods and macros.
+ 'name can any valid function name (e.g, (setf car))."
+ (let ((macro? (and (symbolp name) (macro-function name)))
+ (special? (and (symbolp name) (special-operator-p name)))
+ (function? (and (valid-function-name-p name)
+ (ext:info :function :definition name)
+ (if (symbolp name) (fboundp name) t))))
+ (cond (macro?
+ (list `((defmacro ,name)
+ ,(function-location (macro-function name)))))
+ (special?
+ (list `((:special-operator ,name)
+ (:error ,(format nil "Special operator: ~S" name)))))
+ (function?
+ (let ((function (fdefinition name)))
+ (if (genericp function)
+ (generic-function-definitions name function)
+ (list (list `(function ,name)
+ (function-location function)))))))))
+
+;;;;;; Ordinary (non-generic/macro/special) functions
+;;;
+;;; First we test if FUNCTION is a closure created by defstruct, and
+;;; if so extract the defstruct-description (`dd') from the closure
+;;; and find the constructor for the struct. Defstruct creates a
+;;; defun for the default constructor and we use that as an
+;;; approximation to the source location of the defstruct.
+;;;
+;;; For an ordinary function we return the source location of the
+;;; first code-location we find.
+;;;
+(defun function-location (function)
+ "Return the source location for FUNCTION."
+ (cond ((struct-closure-p function)
+ (struct-closure-location function))
+ ((c::byte-function-or-closure-p function)
+ (byte-function-location function))
+ (t
+ (compiled-function-location function))))
+
+(defun compiled-function-location (function)
+ "Return the location of a regular compiled function."
+ (multiple-value-bind (code-location error)
+ (safe-definition-finding (function-first-code-location function))
+ (cond (error (list :error (princ-to-string error)))
+ (t (code-location-source-location code-location)))))
+
+(defun function-first-code-location (function)
+ "Return the first code-location we can find for 'function."
+ (and (function-has-debug-function-p function)
+ (di:debug-function-start-location
+ (di:function-debug-function function))))
+
+(defun function-has-debug-function-p (function)
+ (di:function-debug-function function))
+
+(defun function-code-object= (closure function)
+ (and (eq (vm::find-code-object closure)
+ (vm::find-code-object function))
+ (not (eq closure function))))
+
+
+(defun byte-function-location (fn)
+ "Return the location of the byte-compiled function 'fn."
+ (etypecase fn
+ ((or c::hairy-byte-function c::simple-byte-function)
+ (let* ((component (c::byte-function-component fn))
+ (debug-info (kernel:%code-debug-info component)))
+ (debug-info-function-name-location debug-info)))
+ (c::byte-closure
+ (byte-function-location (c::byte-closure-function fn)))))
+
+;;; Here we deal with structure accessors. Note that `dd' is a
+;;; "defstruct descriptor" structure in SCL. A `dd' describes a
+;;; `defstruct''d structure.
+
+(defun struct-closure-p (function)
+ "Is 'function a closure created by defstruct?"
+ (or (function-code-object= function #'kernel::structure-slot-accessor)
+ (function-code-object= function #'kernel::structure-slot-setter)
+ (function-code-object= function #'kernel::%defstruct)))
+
+(defun struct-closure-location (function)
+ "Return the location of the structure that 'function belongs to."
+ (assert (struct-closure-p function))
+ (safe-definition-finding
+ (dd-location (struct-closure-dd function))))
+
+(defun struct-closure-dd (function)
+ "Return the defstruct-definition (dd) of FUNCTION."
+ (assert (= (kernel:get-type function) vm:closure-header-type))
+ (flet ((find-layout (function)
+ (sys:find-if-in-closure
+ (lambda (x)
+ (let ((value (if (di::indirect-value-cell-p x)
+ (c:value-cell-ref x)
+ x)))
+ (when (kernel::layout-p value)
+ (return-from find-layout value))))
+ function)))
+ (kernel:layout-info (find-layout function))))
+
+(defun dd-location (dd)
+ "Return the location of a `defstruct'."
+ ;; Find the location in a constructor.
+ (function-location (struct-constructor dd)))
+
+(defun struct-constructor (dd)
+ "Return a constructor function from a defstruct definition.
+Signal an error if no constructor can be found."
+ (let ((constructor (or (kernel:dd-default-constructor dd)
+ (car (kernel::dd-constructors dd)))))
+ (when (or (null constructor)
+ (and (consp constructor) (null (car constructor))))
+ (error "Cannot find structure's constructor: ~S"
+ (kernel::dd-name dd)))
+ (coerce (if (consp constructor) (first constructor) constructor)
+ 'function)))
+
+;;;;;; Generic functions and methods
+
+(defun generic-function-definitions (name function)
+ "Return the definitions of a generic function and its methods."
+ (cons (list `(defgeneric ,name) (gf-location function))
+ (gf-method-definitions function)))
+
+(defun gf-location (gf)
+ "Return the location of the generic function GF."
+ (definition-source-location gf (clos:generic-function-name gf)))
+
+(defun gf-method-definitions (gf)
+ "Return the locations of all methods of the generic function GF."
+ (mapcar #'method-definition (clos:generic-function-methods gf)))
+
+(defun method-definition (method)
+ (list (method-dspec method)
+ (method-location method)))
+
+(defun method-dspec (method)
+ "Return a human-readable \"definition specifier\" for METHOD."
+ (let* ((gf (clos:method-generic-function method))
+ (name (clos:generic-function-name gf))
+ (specializers (clos:method-specializers method))
+ (qualifiers (clos:method-qualifiers method)))
+ `(method ,name ,@qualifiers ,specializers
+ #+nil (clos::unparse-specializers specializers))))
+
+;; XXX maybe special case setters/getters
+(defun method-location (method)
+ (function-location (clos:method-function method)))
+
+(defun genericp (fn)
+ (typep fn 'generic-function))
+
+;;;;;; Types and classes
+
+(defun type-definitions (name)
+ "Return `deftype' locations for type NAME."
+ (maybe-make-definition (ext:info :type :expander name) 'deftype name))
+
+(defun maybe-make-definition (function kind name)
+ "If FUNCTION is non-nil then return its definition location."
+ (if function
+ (list (list `(,kind ,name) (function-location function)))))
+
+(defun class-definitions (name)
+ "Return the definition locations for the class called NAME."
+ (if (symbolp name)
+ (let ((class (find-class name nil)))
+ (etypecase class
+ (null '())
+ (structure-class
+ (list (list `(defstruct ,name)
+ (dd-location (find-dd name)))))
+ (standard-class
+ (list (list `(defclass ,name)
+ (class-location (find-class name)))))
+ ((or built-in-class
+ kernel:funcallable-structure-class)
+ (list (list `(kernel::define-type-class ,name)
+ `(:error
+ ,(format nil "No source info for ~A" name)))))))))
+
+(defun class-location (class)
+ "Return the `defclass' location for CLASS."
+ (definition-source-location class (class-name class)))
+
+(defun find-dd (name)
+ "Find the defstruct-definition by the name of its structure-class."
+ (let ((layout (ext:info :type :compiler-layout name)))
+ (if layout
+ (kernel:layout-info layout))))
+
+(defun condition-class-location (class)
+ (let ((name (class-name class)))
+ `(:error ,(format nil "No location info for condition: ~A" name))))
+
+(defun make-name-in-file-location (file string)
+ (multiple-value-bind (filename c)
+ (ignore-errors
+ (unix-truename (merge-pathnames (make-pathname :type "lisp")
+ file)))
+ (cond (filename (make-location `(:file ,filename)
+ `(:function-name ,(string string))))
+ (t (list :error (princ-to-string c))))))
+
+(defun definition-source-location (object name)
+ `(:error ,(format nil "No source info for: ~A" object)))
+
+(defun setf-definitions (name)
+ (let ((function (or (ext:info :setf :inverse name)
+ (ext:info :setf :expander name))))
+ (if function
+ (list (list `(setf ,name)
+ (function-location (coerce function 'function)))))))
+
+
+(defun variable-location (symbol)
+ `(:error ,(format nil "No source info for variable ~S" symbol)))
+
+(defun variable-definitions (name)
+ (if (symbolp name)
+ (multiple-value-bind (kind recorded-p) (ext:info :variable :kind name)
+ (if recorded-p
+ (list (list `(variable ,kind ,name)
+ (variable-location name)))))))
+
+(defun compiler-macro-definitions (symbol)
+ (maybe-make-definition (compiler-macro-function symbol)
+ 'define-compiler-macro
+ symbol))
+
+(defun source-transform-definitions (name)
+ (maybe-make-definition (ext:info :function :source-transform name)
+ 'c:def-source-transform
+ name))
+
+(defun function-info-definitions (name)
+ (let ((info (ext:info :function :info name)))
+ (if info
+ (append (loop for transform in (c::function-info-transforms info)
+ collect (list `(c:deftransform ,name
+ ,(c::type-specifier
+ (c::transform-type transform)))
+ (function-location (c::transform-function
+ transform))))
+ (maybe-make-definition (c::function-info-derive-type info)
+ 'c::derive-type name)
+ (maybe-make-definition (c::function-info-optimizer info)
+ 'c::optimizer name)
+ (maybe-make-definition (c::function-info-ltn-annotate info)
+ 'c::ltn-annotate name)
+ (maybe-make-definition (c::function-info-ir2-convert info)
+ 'c::ir2-convert name)
+ (loop for template in (c::function-info-templates info)
+ collect (list `(c::vop ,(c::template-name template))
+ (function-location
+ (c::vop-info-generator-function
+ template))))))))
+
+(defun ir1-translator-definitions (name)
+ (maybe-make-definition (ext:info :function :ir1-convert name)
+ 'c:def-ir1-translator name))
+
+
+;;;; Documentation.
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((doc (kind)
+ (or (documentation symbol kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (multiple-value-bind (kind recorded-p)
+ (ext:info variable kind symbol)
+ (declare (ignore kind))
+ (if (or (boundp symbol) recorded-p)
+ (doc 'variable))))
+ (when (fboundp symbol)
+ (maybe-push
+ (cond ((macro-function symbol) :macro)
+ ((special-operator-p symbol) :special-operator)
+ ((genericp (fdefinition symbol)) :generic-function)
+ (t :function))
+ (doc 'function)))
+ (maybe-push
+ :setf (if (or (ext:info setf inverse symbol)
+ (ext:info setf expander symbol))
+ (doc 'setf)))
+ (maybe-push
+ :type (if (ext:info type kind symbol)
+ (doc 'type)))
+ (maybe-push
+ :class (if (find-class symbol nil)
+ (doc 'class)))
+ (maybe-push
+ :alien-type (if (not (eq (ext:info alien-type kind symbol) :unknown))
+ (doc 'alien-type)))
+ (maybe-push
+ :alien-struct (if (ext:info alien-type struct symbol)
+ (doc nil)))
+ (maybe-push
+ :alien-union (if (ext:info alien-type union symbol)
+ (doc nil)))
+ (maybe-push
+ :alien-enum (if (ext:info alien-type enum symbol)
+ (doc nil)))
+ result)))
+
+(defimplementation describe-definition (symbol namespace)
+ (describe (ecase namespace
+ (:variable
+ symbol)
+ ((:function :generic-function)
+ (symbol-function symbol))
+ (:setf
+ (or (ext:info setf inverse symbol)
+ (ext:info setf expander symbol)))
+ (:type
+ (kernel:values-specifier-type symbol))
+ (:class
+ (find-class symbol))
+ (:alien-struct
+ (ext:info :alien-type :struct symbol))
+ (:alien-union
+ (ext:info :alien-type :union symbol))
+ (:alien-enum
+ (ext:info :alien-type :enum symbol))
+ (:alien-type
+ (ecase (ext:info :alien-type :kind symbol)
+ (:primitive
+ (let ((alien::*values-type-okay* t))
+ (funcall (ext:info :alien-type :translator symbol)
+ (list symbol))))
+ ((:defined)
+ (ext:info :alien-type :definition symbol))
+ (:unknown :unknown))))))
+
+;;;;; Argument lists
+
+(defimplementation arglist (fun)
+ (multiple-value-bind (args winp)
+ (ext:function-arglist fun)
+ (if winp args :not-available)))
+
+(defimplementation function-name (function)
+ (cond ((eval:interpreted-function-p function)
+ (eval:interpreted-function-name function))
+ ((typep function 'generic-function)
+ (clos:generic-function-name function))
+ ((c::byte-function-or-closure-p function)
+ (c::byte-function-name function))
+ (t (kernel:%function-name (kernel:%function-self function)))))
+
+
+;;; A harder case: an approximate arglist is derived from available
+;;; debugging information.
+
+(defun debug-function-arglist (debug-function)
+ "Derive the argument list of DEBUG-FUNCTION from debug info."
+ (let ((args (di::debug-function-lambda-list debug-function))
+ (required '())
+ (optional '())
+ (rest '())
+ (key '()))
+ ;; collect the names of debug-vars
+ (dolist (arg args)
+ (etypecase arg
+ (di::debug-variable
+ (push (di::debug-variable-symbol arg) required))
+ ((member :deleted)
+ (push ':deleted required))
+ (cons
+ (ecase (car arg)
+ (:keyword
+ (push (second arg) key))
+ (:optional
+ (push (debug-variable-symbol-or-deleted (second arg)) optional))
+ (:rest
+ (push (debug-variable-symbol-or-deleted (second arg)) rest))))))
+ ;; intersperse lambda keywords as needed
+ (append (nreverse required)
+ (if optional (cons '&optional (nreverse optional)))
+ (if rest (cons '&rest (nreverse rest)))
+ (if key (cons '&key (nreverse key))))))
+
+(defun debug-variable-symbol-or-deleted (var)
+ (etypecase var
+ (di:debug-variable
+ (di::debug-variable-symbol var))
+ ((member :deleted)
+ '#:deleted)))
+
+(defun symbol-debug-function-arglist (fname)
+ "Return FNAME's debug-function-arglist and %function-arglist.
+ A utility for debugging DEBUG-FUNCTION-ARGLIST."
+ (let ((fn (fdefinition fname)))
+ (values (debug-function-arglist (di::function-debug-function fn))
+ (kernel:%function-arglist (kernel:%function-self fn)))))
+
+
+;;;; Miscellaneous.
+
+(defimplementation macroexpand-all (form &optional env)
+ (declare (ignore env))
+ (macroexpand form))
+
+(defimplementation set-default-directory (directory)
+ (setf (ext:default-directory) (namestring directory))
+ ;; Setting *default-pathname-defaults* to an absolute directory
+ ;; makes the behavior of MERGE-PATHNAMES a bit more intuitive.
+ (setf *default-pathname-defaults* (pathname (ext:default-directory)))
+ (default-directory))
+
+(defimplementation default-directory ()
+ (namestring (ext:default-directory)))
+
+(defimplementation pathname-to-filename (pathname)
+ (ext:unix-namestring pathname nil))
+
+(defimplementation getpid ()
+ (unix:unix-getpid))
+
+(defimplementation lisp-implementation-type-name ()
+ (if (eq ext:*case-mode* :upper) "scl" "scl-lower"))
+
+(defimplementation quit-lisp ()
+ (ext:quit))
+
+;;; source-path-{stream,file,string,etc}-position moved into
+;;; source-path-parser
+
+
+;;;; Debugging
+
+(defvar *sldb-stack-top*)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (let* ((*sldb-stack-top* (or debug:*stack-top-hint* (di:top-frame)))
+ (debug:*stack-top-hint* nil)
+ (kernel:*current-level* 0))
+ (handler-bind ((di::unhandled-condition
+ (lambda (condition)
+ (error 'sldb-condition
+ :original-condition condition))))
+ (funcall debugger-loop-fn))))
+
+(defun frame-down (frame)
+ (handler-case (di:frame-down frame)
+ (di:no-debug-info () nil)))
+
+(defun nth-frame (index)
+ (do ((frame *sldb-stack-top* (frame-down frame))
+ (i index (1- i)))
+ ((zerop i) frame)))
+
+(defimplementation compute-backtrace (start end)
+ (let ((end (or end most-positive-fixnum)))
+ (loop for f = (nth-frame start) then (frame-down f)
+ for i from start below end
+ while f collect f)))
+
+(defimplementation print-frame (frame stream)
+ (let ((*standard-output* stream))
+ (handler-case
+ (debug::print-frame-call frame :verbosity 1 :number nil)
+ (error (e)
+ (ignore-errors (princ e stream))))))
+
+(defimplementation frame-source-location (index)
+ (code-location-source-location (di:frame-code-location (nth-frame index))))
+
+(defimplementation eval-in-frame (form index)
+ (di:eval-in-frame (nth-frame index) form))
+
+(defun frame-debug-vars (frame)
+ "Return a vector of debug-variables in frame."
+ (di::debug-function-debug-variables (di:frame-debug-function frame)))
+
+(defun debug-var-value (var frame location)
+ (let ((validity (di:debug-variable-validity var location)))
+ (ecase validity
+ (:valid (di:debug-variable-value var frame))
+ ((:invalid :unknown) (make-symbol (string validity))))))
+
+(defimplementation frame-locals (index)
+ (let* ((frame (nth-frame index))
+ (loc (di:frame-code-location frame))
+ (vars (frame-debug-vars frame)))
+ (loop for v across vars collect
+ (list :name (di:debug-variable-symbol v)
+ :id (di:debug-variable-id v)
+ :value (debug-var-value v frame loc)))))
+
+(defimplementation frame-var-value (frame var)
+ (let* ((frame (nth-frame frame))
+ (dvar (aref (frame-debug-vars frame) var)))
+ (debug-var-value dvar frame (di:frame-code-location frame))))
+
+(defimplementation frame-catch-tags (index)
+ (mapcar #'car (di:frame-catches (nth-frame index))))
+
+(defimplementation return-from-frame (index form)
+ (let ((sym (find-symbol (symbol-name '#:find-debug-tag-for-frame)
+ :debug-internals)))
+ (if sym
+ (let* ((frame (nth-frame index))
+ (probe (funcall sym frame)))
+ (cond (probe (throw (car probe) (eval-in-frame form index)))
+ (t (format nil "Cannot return from frame: ~S" frame))))
+ "return-from-frame is not implemented in this version of SCL.")))
+
+(defimplementation activate-stepping (frame)
+ (set-step-breakpoints (nth-frame frame)))
+
+(defimplementation sldb-break-on-return (frame)
+ (break-on-return (nth-frame frame)))
+
+;;; We set the breakpoint in the caller which might be a bit confusing.
+;;;
+(defun break-on-return (frame)
+ (let* ((caller (di:frame-down frame))
+ (cl (di:frame-code-location caller)))
+ (flet ((hook (frame bp)
+ (when (frame-pointer= frame caller)
+ (di:delete-breakpoint bp)
+ (signal-breakpoint bp frame))))
+ (let* ((info (ecase (di:code-location-kind cl)
+ ((:single-value-return :unknown-return) nil)
+ (:known-return (debug-function-returns
+ (di:frame-debug-function frame)))))
+ (bp (di:make-breakpoint #'hook cl :kind :code-location
+ :info info)))
+ (di:activate-breakpoint bp)
+ `(:ok ,(format nil "Set breakpoint in ~A" caller))))))
+
+(defun frame-pointer= (frame1 frame2)
+ "Return true if the frame pointers of FRAME1 and FRAME2 are the same."
+ (sys:sap= (di::frame-pointer frame1) (di::frame-pointer frame2)))
+
+;;; The PC in escaped frames at a single-return-value point is
+;;; actually vm:single-value-return-byte-offset bytes after the
+;;; position given in the debug info. Here we try to recognize such
+;;; cases.
+;;;
+(defun next-code-locations (frame code-location)
+ "Like `debug::next-code-locations' but be careful in escaped frames."
+ (let ((next (debug::next-code-locations code-location)))
+ (flet ((adjust-pc ()
+ (let ((cl (di::copy-compiled-code-location code-location)))
+ (incf (di::compiled-code-location-pc cl)
+ vm:single-value-return-byte-offset)
+ cl)))
+ (cond ((and (di::compiled-frame-escaped frame)
+ (eq (di:code-location-kind code-location)
+ :single-value-return)
+ (= (length next) 1)
+ (di:code-location= (car next) (adjust-pc)))
+ (debug::next-code-locations (car next)))
+ (t
+ next)))))
+
+(defun set-step-breakpoints (frame)
+ (let ((cl (di:frame-code-location frame)))
+ (when (di:debug-block-elsewhere-p (di:code-location-debug-block cl))
+ (error "Cannot step in elsewhere code"))
+ (let* ((debug::*bad-code-location-types*
+ (remove :call-site debug::*bad-code-location-types*))
+ (next (next-code-locations frame cl)))
+ (cond (next
+ (let ((steppoints '()))
+ (flet ((hook (bp-frame bp)
+ (signal-breakpoint bp bp-frame)
+ (mapc #'di:delete-breakpoint steppoints)))
+ (dolist (code-location next)
+ (let ((bp (di:make-breakpoint #'hook code-location
+ :kind :code-location)))
+ (di:activate-breakpoint bp)
+ (push bp steppoints))))))
+ (t
+ (break-on-return frame))))))
+
+
+;; XXX the return values at return breakpoints should be passed to the
+;; user hooks. debug-int.lisp should be changed to do this cleanly.
+
+;;; The sigcontext and the PC for a breakpoint invocation are not
+;;; passed to user hook functions, but we need them to extract return
+;;; values. So we advice di::handle-breakpoint and bind the values to
+;;; special variables.
+;;;
+(defvar *breakpoint-sigcontext*)
+(defvar *breakpoint-pc*)
+
+(defun sigcontext-object (sc index)
+ "Extract the lisp object in sigcontext SC at offset INDEX."
+ (kernel:make-lisp-obj (vm:ucontext-register sc index)))
+
+(defun known-return-point-values (sigcontext sc-offsets)
+ (let ((fp (system:int-sap (vm:ucontext-register sigcontext
+ vm::cfp-offset))))
+ (system:without-gcing
+ (loop for sc-offset across sc-offsets
+ collect (di::sub-access-debug-var-slot fp sc-offset sigcontext)))))
+
+;;; SCL returns the first few values in registers and the rest on
+;;; the stack. In the multiple value case, the number of values is
+;;; stored in a dedicated register. The values of the registers can be
+;;; accessed in the sigcontext for the breakpoint. There are 3 kinds
+;;; of return conventions: :single-value-return, :unknown-return, and
+;;; :known-return.
+;;;
+;;; The :single-value-return convention returns the value in a
+;;; register without setting the nargs registers.
+;;;
+;;; The :unknown-return variant is used for multiple values. A
+;;; :unknown-return point consists actually of 2 breakpoints: one for
+;;; the single value case and one for the general case. The single
+;;; value breakpoint comes vm:single-value-return-byte-offset after
+;;; the multiple value breakpoint.
+;;;
+;;; The :known-return convention is used by local functions.
+;;; :known-return is currently not supported because we don't know
+;;; where the values are passed.
+;;;
+(defun breakpoint-values (breakpoint)
+ "Return the list of return values for a return point."
+ (flet ((1st (sc) (sigcontext-object sc (car vm::register-arg-offsets))))
+ (let ((sc (locally (declare (optimize (ext:inhibit-warnings 3)))
+ (alien:sap-alien *breakpoint-sigcontext* (* unix:ucontext))))
+ (cl (di:breakpoint-what breakpoint)))
+ (ecase (di:code-location-kind cl)
+ (:single-value-return
+ (list (1st sc)))
+ (:known-return
+ (let ((info (di:breakpoint-info breakpoint)))
+ (if (vectorp info)
+ (known-return-point-values sc info)
+ (progn
+ ;;(break)
+ (list "<<known-return convention not supported>>" info)))))
+ (:unknown-return
+ (let ((mv-return-pc (di::compiled-code-location-pc cl)))
+ (if (= mv-return-pc *breakpoint-pc*)
+ (mv-function-end-breakpoint-values sc)
+ (list (1st sc)))))))))
+
+(defun mv-function-end-breakpoint-values (sigcontext)
+ (let ((sym (find-symbol
+ (symbol-name '#:function-end-breakpoint-values/standard)
+ :debug-internals)))
+ (cond (sym (funcall sym sigcontext))
+ (t (di::get-function-end-breakpoint-values sigcontext)))))
+
+(defun debug-function-returns (debug-fun)
+ "Return the return style of DEBUG-FUN."
+ (let* ((cdfun (di::compiled-debug-function-compiler-debug-fun debug-fun)))
+ (c::compiled-debug-function-returns cdfun)))
+
+(define-condition breakpoint (simple-condition)
+ ((message :initarg :message :reader breakpoint.message)
+ (values :initarg :values :reader breakpoint.values))
+ (:report (lambda (c stream) (princ (breakpoint.message c) stream))))
+
+#+nil
+(defimplementation condition-extras ((c breakpoint))
+ ;; simply pop up the source buffer
+ `((:short-frame-source 0)))
+
+(defun signal-breakpoint (breakpoint frame)
+ "Signal a breakpoint condition for BREAKPOINT in FRAME.
+Try to create a informative message."
+ (flet ((brk (values fstring &rest args)
+ (let ((msg (apply #'format nil fstring args))
+ (debug:*stack-top-hint* frame))
+ (break 'breakpoint :message msg :values values))))
+ (with-struct (di::breakpoint- kind what) breakpoint
+ (case kind
+ (:code-location
+ (case (di:code-location-kind what)
+ ((:single-value-return :known-return :unknown-return)
+ (let ((values (breakpoint-values breakpoint)))
+ (brk values "Return value: ~{~S ~}" values)))
+ (t
+ #+(or)
+ (when (eq (di:code-location-kind what) :call-site)
+ (call-site-function breakpoint frame))
+ (brk nil "Breakpoint: ~S ~S"
+ (di:code-location-kind what)
+ (di::compiled-code-location-pc what)))))
+ (:function-start
+ (brk nil "Function start breakpoint"))
+ (t (brk nil "Breakpoint: ~A in ~A" breakpoint frame))))))
+
+#+nil
+(defimplementation sldb-break-at-start (fname)
+ (let ((debug-fun (di:function-debug-function (coerce fname 'function))))
+ (cond ((not debug-fun)
+ `(:error ,(format nil "~S has no debug-function" fname)))
+ (t
+ (flet ((hook (frame bp &optional args cookie)
+ (declare (ignore args cookie))
+ (signal-breakpoint bp frame)))
+ (let ((bp (di:make-breakpoint #'hook debug-fun
+ :kind :function-start)))
+ (di:activate-breakpoint bp)
+ `(:ok ,(format nil "Set breakpoint in ~S" fname))))))))
+
+(defun frame-cfp (frame)
+ "Return the Control-Stack-Frame-Pointer for FRAME."
+ (etypecase frame
+ (di::compiled-frame (di::frame-pointer frame))
+ ((or di::interpreted-frame null) -1)))
+
+(defun frame-ip (frame)
+ "Return the (absolute) instruction pointer and the relative pc of FRAME."
+ (if (not frame)
+ -1
+ (let ((debug-fun (di::frame-debug-function frame)))
+ (etypecase debug-fun
+ (di::compiled-debug-function
+ (let* ((code-loc (di:frame-code-location frame))
+ (component (di::compiled-debug-function-component debug-fun))
+ (pc (di::compiled-code-location-pc code-loc))
+ (ip (sys:without-gcing
+ (sys:sap-int
+ (sys:sap+ (kernel:code-instructions component) pc)))))
+ (values ip pc)))
+ ((or di::bogus-debug-function di::interpreted-debug-function)
+ -1)))))
+
+(defun frame-registers (frame)
+ "Return the lisp registers CSP, CFP, IP, OCFP, LRA for FRAME-NUMBER."
+ (let* ((cfp (frame-cfp frame))
+ (csp (frame-cfp (di::frame-up frame)))
+ (ip (frame-ip frame))
+ (ocfp (frame-cfp (di::frame-down frame)))
+ (lra (frame-ip (di::frame-down frame))))
+ (values csp cfp ip ocfp lra)))
+
+(defun print-frame-registers (frame-number)
+ (let ((frame (di::frame-real-frame (nth-frame frame-number))))
+ (flet ((fixnum (p) (etypecase p
+ (integer p)
+ (sys:system-area-pointer (sys:sap-int p)))))
+ (apply #'format t "~
+CSP = ~X
+CFP = ~X
+IP = ~X
+OCFP = ~X
+LRA = ~X~%" (mapcar #'fixnum
+ (multiple-value-list (frame-registers frame)))))))
+
+
+(defimplementation disassemble-frame (frame-number)
+ "Return a string with the disassembly of frames code."
+ (print-frame-registers frame-number)
+ (terpri)
+ (let* ((frame (di::frame-real-frame (nth-frame frame-number)))
+ (debug-fun (di::frame-debug-function frame)))
+ (etypecase debug-fun
+ (di::compiled-debug-function
+ (let* ((component (di::compiled-debug-function-component debug-fun))
+ (fun (di:debug-function-function debug-fun)))
+ (if fun
+ (disassemble fun)
+ (disassem:disassemble-code-component component))))
+ (di::bogus-debug-function
+ (format t "~%[Disassembling bogus frames not implemented]")))))
+
+
+;;;; Inspecting
+
+(defconstant +lowtag-symbols+
+ '(vm:even-fixnum-type
+ vm:instance-pointer-type
+ vm:other-immediate-0-type
+ vm:list-pointer-type
+ vm:odd-fixnum-type
+ vm:function-pointer-type
+ vm:other-immediate-1-type
+ vm:other-pointer-type)
+ "Names of the constants that specify type tags.
+The `symbol-value' of each element is a type tag.")
+
+(defconstant +header-type-symbols+
+ (labels ((suffixp (suffix string)
+ (and (>= (length string) (length suffix))
+ (string= string suffix :start1 (- (length string)
+ (length suffix)))))
+ (header-type-symbol-p (x)
+ (and (suffixp (symbol-name '#:-type) (symbol-name x))
+ (not (member x +lowtag-symbols+))
+ (boundp x)
+ (typep (symbol-value x) 'fixnum))))
+ (remove-if-not #'header-type-symbol-p
+ (append (apropos-list (symbol-name '#:-type) :vm)
+ (apropos-list (symbol-name '#:-type) :bignum))))
+ "A list of names of the type codes in boxed objects.")
+
+(defimplementation describe-primitive-type (object)
+ (with-output-to-string (*standard-output*)
+ (let* ((lowtag (kernel:get-lowtag object))
+ (lowtag-symbol (find lowtag +lowtag-symbols+ :key #'symbol-value)))
+ (format t "lowtag: ~A" lowtag-symbol)
+ (when (member lowtag (list vm:other-pointer-type
+ vm:function-pointer-type
+ vm:other-immediate-0-type
+ vm:other-immediate-1-type
+ ))
+ (let* ((type (kernel:get-type object))
+ (type-symbol (find type +header-type-symbols+
+ :key #'symbol-value)))
+ (format t ", type: ~A" type-symbol))))))
+
+(defmethod emacs-inspect ((o t))
+ (cond ((di::indirect-value-cell-p o)
+ `("Value: " (:value ,(c:value-cell-ref o))))
+ ((alien::alien-value-p o)
+ (inspect-alien-value o))
+ (t
+ (scl-inspect o))))
+
+(defun scl-inspect (o)
+ (destructuring-bind (text labeledp . parts)
+ (inspect::describe-parts o)
+ (list* (format nil "~A~%" text)
+ (if labeledp
+ (loop for (label . value) in parts
+ append (label-value-line label value))
+ (loop for value in parts for i from 0
+ append (label-value-line i value))))))
+
+(defmethod emacs-inspect ((o function))
+ (let ((header (kernel:get-type o)))
+ (cond ((= header vm:function-header-type)
+ (list* (format nil "~A is a function.~%" o)
+ (append (label-value-line*
+ ("Self" (kernel:%function-self o))
+ ("Next" (kernel:%function-next o))
+ ("Name" (kernel:%function-name o))
+ ("Arglist" (kernel:%function-arglist o))
+ ("Type" (kernel:%function-type o))
+ ("Code" (kernel:function-code-header o)))
+ (list
+ (with-output-to-string (s)
+ (disassem:disassemble-function o :stream s))))))
+ ((= header vm:closure-header-type)
+ (list* (format nil "~A is a closure.~%" o)
+ (append
+ (label-value-line "Function" (kernel:%closure-function o))
+ `("Environment:" (:newline))
+ (loop for i from 0 below (- (kernel:get-closure-length o)
+ (1- vm:closure-info-offset))
+ append (label-value-line
+ i (kernel:%closure-index-ref o i))))))
+ ((eval::interpreted-function-p o)
+ (scl-inspect o))
+ (t
+ (call-next-method)))))
+
+
+(defmethod emacs-inspect ((o kernel:code-component))
+ (append
+ (label-value-line*
+ ("code-size" (kernel:%code-code-size o))
+ ("entry-points" (kernel:%code-entry-points o))
+ ("debug-info" (kernel:%code-debug-info o))
+ ("trace-table-offset" (kernel:code-header-ref
+ o vm:code-trace-table-offset-slot)))
+ `("Constants:" (:newline))
+ (loop for i from vm:code-constants-offset
+ below (kernel:get-header-data o)
+ append (label-value-line i (kernel:code-header-ref o i)))
+ `("Code:" (:newline)
+ , (with-output-to-string (s)
+ (cond ((kernel:%code-debug-info o)
+ (disassem:disassemble-code-component o :stream s))
+ (t
+ (disassem:disassemble-memory
+ (disassem::align
+ (+ (logandc2 (kernel:get-lisp-obj-address o)
+ vm:lowtag-mask)
+ (* vm:code-constants-offset vm:word-bytes))
+ (ash 1 vm:lowtag-bits))
+ (ash (kernel:%code-code-size o) vm:word-shift)
+ :stream s)))))))
+
+(defmethod emacs-inspect ((o kernel:fdefn))
+ (label-value-line*
+ ("name" (kernel:fdefn-name o))
+ ("function" (kernel:fdefn-function o))
+ ("raw-addr" (sys:sap-ref-32
+ (sys:int-sap (kernel:get-lisp-obj-address o))
+ (* vm:fdefn-raw-addr-slot vm:word-bytes)))))
+
+(defmethod emacs-inspect ((o array))
+ (cond ((kernel:array-header-p o)
+ (list* (format nil "~A is an array.~%" o)
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:rank (array-rank o))
+ (:fill-pointer (kernel:%array-fill-pointer o))
+ (:fill-pointer-p (kernel:%array-fill-pointer-p o))
+ (:elements (kernel:%array-available-elements o))
+ (:data (kernel:%array-data-vector o))
+ (:displacement (kernel:%array-displacement o))
+ (:displaced-p (kernel:%array-displaced-p o))
+ (:dimensions (array-dimensions o)))))
+ (t
+ (list* (format nil "~A is an simple-array.~%" o)
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:length (length o)))))))
+
+(defmethod emacs-inspect ((o simple-vector))
+ (list* (format nil "~A is a vector.~%" o)
+ (append
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:length (c::vector-length o)))
+ (unless (eq (array-element-type o) 'nil)
+ (loop for i below (length o)
+ append (label-value-line i (aref o i)))))))
+
+(defun inspect-alien-record (alien)
+ (with-struct (alien::alien-value- sap type) alien
+ (with-struct (alien::alien-record-type- kind name fields) type
+ (append
+ (label-value-line*
+ (:sap sap)
+ (:kind kind)
+ (:name name))
+ (loop for field in fields
+ append (let ((slot (alien::alien-record-field-name field)))
+ (label-value-line slot (alien:slot alien slot))))))))
+
+(defun inspect-alien-pointer (alien)
+ (with-struct (alien::alien-value- sap type) alien
+ (label-value-line*
+ (:sap sap)
+ (:type type)
+ (:to (alien::deref alien)))))
+
+(defun inspect-alien-value (alien)
+ (typecase (alien::alien-value-type alien)
+ (alien::alien-record-type (inspect-alien-record alien))
+ (alien::alien-pointer-type (inspect-alien-pointer alien))
+ (t (scl-inspect alien))))
+
+;;;; Profiling
+(defimplementation profile (fname)
+ (eval `(profile:profile ,fname)))
+
+(defimplementation unprofile (fname)
+ (eval `(profile:unprofile ,fname)))
+
+(defimplementation unprofile-all ()
+ (eval `(profile:unprofile))
+ "All functions unprofiled.")
+
+(defimplementation profile-report ()
+ (eval `(profile:report-time)))
+
+(defimplementation profile-reset ()
+ (eval `(profile:reset-time))
+ "Reset profiling counters.")
+
+(defimplementation profiled-functions ()
+ profile:*timed-functions*)
+
+(defimplementation profile-package (package callers methods)
+ (profile:profile-all :package package
+ :callers-p callers
+ #+nil :methods #+nil methods))
+
+
+;;;; Multiprocessing
+
+(defimplementation spawn (fn &key name)
+ (thread:thread-create fn :name (or name "Anonymous")))
+
+(defvar *thread-id-counter* 0)
+(defvar *thread-id-counter-lock* (thread:make-lock "Thread ID counter"))
+
+(defimplementation thread-id (thread)
+ (thread:with-lock-held (*thread-id-counter-lock*)
+ (or (getf (thread:thread-plist thread) 'id)
+ (setf (getf (thread:thread-plist thread) 'id)
+ (incf *thread-id-counter*)))))
+
+(defimplementation find-thread (id)
+ (block find-thread
+ (thread:map-over-threads
+ #'(lambda (thread)
+ (when (eql (getf (thread:thread-plist thread) 'id) id)
+ (return-from find-thread thread))))))
+
+(defimplementation thread-name (thread)
+ (princ-to-string (thread:thread-name thread)))
+
+(defimplementation thread-status (thread)
+ (let ((dynamic-values (thread::thread-dynamic-values thread)))
+ (if (zerop dynamic-values) "Exited" "Running")))
+
+(defimplementation make-lock (&key name)
+ (thread:make-lock name))
+
+(defimplementation call-with-lock-held (lock function)
+ (declare (type function function))
+ (thread:with-lock-held (lock) (funcall function)))
+
+(defimplementation current-thread ()
+ thread:*thread*)
+
+(defimplementation all-threads ()
+ (let ((all-threads nil))
+ (thread:map-over-threads #'(lambda (thread) (push thread all-threads)))
+ all-threads))
+
+(defimplementation interrupt-thread (thread fn)
+ (thread:thread-interrupt thread #'(lambda ()
+ (sys:with-interrupts
+ (funcall fn)))))
+
+(defimplementation kill-thread (thread)
+ (thread:destroy-thread thread))
+
+(defimplementation thread-alive-p (thread)
+ (not (zerop (thread::thread-dynamic-values thread))))
+
+(defvar *mailbox-lock* (thread:make-lock "Mailbox lock" :interruptible nil))
+
+(defstruct (mailbox)
+ (lock (thread:make-lock "Thread mailbox" :type :error-check
+ :interruptible nil)
+ :type thread:error-check-lock)
+ (queue '() :type list))
+
+(defun mailbox (thread)
+ "Return 'thread's mailbox."
+ (sys:without-interrupts
+ (thread:with-lock-held (*mailbox-lock*)
+ (or (getf (thread:thread-plist thread) 'mailbox)
+ (setf (getf (thread:thread-plist thread) 'mailbox)
+ (make-mailbox))))))
+
+(defimplementation send (thread message)
+ (let* ((mbox (mailbox thread))
+ (lock (mailbox-lock mbox)))
+ (sys:without-interrupts
+ (thread:with-lock-held (lock "Mailbox Send")
+ (setf (mailbox-queue mbox) (nconc (mailbox-queue mbox)
+ (list message)))))
+ (mp:process-wakeup thread)))
+
+#+nil
+(defimplementation receive ()
+ (receive-if (constantly t)))
+
+(defimplementation receive-if (test &optional timeout)
+ (let ((mbox (mailbox thread:*thread*)))
+ (assert (or (not timeout) (eq timeout t)))
+ (loop
+ (check-slime-interrupts)
+ (sys:without-interrupts
+ (mp:with-lock-held ((mailbox-lock mbox))
+ (let* ((q (mailbox-queue mbox))
+ (tail (member-if test q)))
+ (when tail
+ (setf (mailbox-queue mbox)
+ (nconc (ldiff q tail) (cdr tail)))
+ (return (car tail))))))
+ (when (eq timeout t) (return (values nil t)))
+ (mp:process-wait-with-timeout
+ "Mailbox read wait" 0.5 (lambda () (some test (mailbox-queue mbox)))))))
+
+
+
+(defimplementation emacs-connected ())
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;Trace implementations
+;; In SCL, we have:
+;; (trace <name>)
+;; (trace (method <name> <qualifier>? (<specializer>+)))
+;; (trace :methods t '<name>) ;;to trace all methods of the gf <name>
+;; <name> can be a normal name or a (setf name)
+
+(defun tracedp (spec)
+ (member spec (eval '(trace)) :test #'equal))
+
+(defun toggle-trace-aux (spec &rest options)
+ (cond ((tracedp spec)
+ (eval `(untrace ,spec))
+ (format nil "~S is now untraced." spec))
+ (t
+ (eval `(trace ,spec ,@options))
+ (format nil "~S is now traced." spec))))
+
+(defimplementation toggle-trace (spec)
+ (ecase (car spec)
+ ((setf)
+ (toggle-trace-aux spec))
+ ((:defgeneric)
+ (let ((name (second spec)))
+ (toggle-trace-aux name :methods name)))
+ ((:defmethod)
+ nil)
+ ((:call)
+ (destructuring-bind (caller callee) (cdr spec)
+ (toggle-trace-aux (process-fspec callee)
+ :wherein (list (process-fspec caller)))))))
+
+(defun process-fspec (fspec)
+ (cond ((consp fspec)
+ (ecase (first fspec)
+ ((:defun :defgeneric) (second fspec))
+ ((:defmethod)
+ `(method ,(second fspec) ,@(third fspec) ,(fourth fspec)))
+ ;; this isn't actually supported
+ ((:labels) `(labels ,(process-fspec (second fspec)) ,(third fspec)))
+ ((:flet) `(flet ,(process-fspec (second fspec)) ,(third fspec)))))
+ (t
+ fspec)))
+
+;;; Weak datastructures
+
+;;; Not implemented in SCL.
+(defimplementation make-weak-key-hash-table (&rest args)
+ (apply #'make-hash-table :weak-p t args))
diff --git a/vim/bundle/slimv/slime/swank/source-file-cache.lisp b/vim/bundle/slimv/slime/swank/source-file-cache.lisp
new file mode 100644
index 0000000..ac48acf
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/source-file-cache.lisp
@@ -0,0 +1,136 @@
+;;;; Source-file cache
+;;;
+;;; To robustly find source locations in CMUCL and SBCL it's useful to
+;;; have the exact source code that the loaded code was compiled from.
+;;; In this source we can accurately find the right location, and from
+;;; that location we can extract a "snippet" of code to show what the
+;;; definition looks like. Emacs can use this snippet in a best-match
+;;; search to locate the right definition, which works well even if
+;;; the buffer has been modified.
+;;;
+;;; The idea is that if a definition previously started with
+;;; `(define-foo bar' then it probably still does.
+;;;
+;;; Whenever we see that the file on disk has the same
+;;; `file-write-date' as a location we're looking for we cache the
+;;; whole file inside Lisp. That way we will still have the matching
+;;; version even if the file is later modified on disk. If the file is
+;;; later recompiled and reloaded then we replace our cache entry.
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+
+(defpackage swank/source-file-cache
+ (:use cl)
+ (:import-from swank/backend
+ defimplementation buffer-first-change
+ guess-external-format
+ find-external-format)
+ (:export
+ get-source-code
+ source-cache-get ;FIXME: isn't it odd that both are exported?
+
+ *source-snippet-size*
+ read-snippet
+ read-snippet-from-string
+ ))
+
+(in-package swank/source-file-cache)
+
+(defvar *cache-sourcecode* t
+ "When true complete source files are cached.
+The cache is used to keep known good copies of the source text which
+correspond to the loaded code. Finding definitions is much more
+reliable when the exact source is available, so we cache it in case it
+gets edited on disk later.")
+
+(defvar *source-file-cache* (make-hash-table :test 'equal)
+ "Cache of source file contents.
+Maps from truename to source-cache-entry structure.")
+
+(defstruct (source-cache-entry
+ (:conc-name source-cache-entry.)
+ (:constructor make-source-cache-entry (text date)))
+ text date)
+
+(defimplementation buffer-first-change (filename)
+ "Load a file into the cache when the user modifies its buffer.
+This is a win if the user then saves the file and tries to M-. into it."
+ (unless (source-cached-p filename)
+ (ignore-errors
+ (source-cache-get filename (file-write-date filename))))
+ nil)
+
+(defun get-source-code (filename code-date)
+ "Return the source code for FILENAME as written on DATE in a string.
+If the exact version cannot be found then return the current one from disk."
+ (or (source-cache-get filename code-date)
+ (read-file filename)))
+
+(defun source-cache-get (filename date)
+ "Return the source code for FILENAME as written on DATE in a string.
+Return NIL if the right version cannot be found."
+ (when *cache-sourcecode*
+ (let ((entry (gethash filename *source-file-cache*)))
+ (cond ((and entry (equal date (source-cache-entry.date entry)))
+ ;; Cache hit.
+ (source-cache-entry.text entry))
+ ((or (null entry)
+ (not (equal date (source-cache-entry.date entry))))
+ ;; Cache miss.
+ (if (equal (file-write-date filename) date)
+ ;; File on disk has the correct version.
+ (let ((source (read-file filename)))
+ (setf (gethash filename *source-file-cache*)
+ (make-source-cache-entry source date))
+ source)
+ nil))))))
+
+(defun source-cached-p (filename)
+ "Is any version of FILENAME in the source cache?"
+ (if (gethash filename *source-file-cache*) t))
+
+(defun read-file (filename)
+ "Return the entire contents of FILENAME as a string."
+ (with-open-file (s filename :direction :input
+ :external-format (or (guess-external-format filename)
+ (find-external-format "latin-1")
+ :default))
+ (let* ((string (make-string (file-length s)))
+ (length (read-sequence string s)))
+ (subseq string 0 length))))
+
+;;;; Snippets
+
+(defvar *source-snippet-size* 256
+ "Maximum number of characters in a snippet of source code.
+Snippets at the beginning of definitions are used to tell Emacs what
+the definitions looks like, so that it can accurately find them by
+text search.")
+
+(defun read-snippet (stream &optional position)
+ "Read a string of upto *SOURCE-SNIPPET-SIZE* characters from STREAM.
+If POSITION is given, set the STREAM's file position first."
+ (when position
+ (file-position stream position))
+ #+sbcl (skip-comments-and-whitespace stream)
+ (read-upto-n-chars stream *source-snippet-size*))
+
+(defun read-snippet-from-string (string &optional position)
+ (with-input-from-string (s string)
+ (read-snippet s position)))
+
+(defun skip-comments-and-whitespace (stream)
+ (case (peek-char nil stream)
+ ((#\Space #\Tab #\Newline #\Linefeed #\Page)
+ (read-char stream)
+ (skip-comments-and-whitespace stream))
+ (#\;
+ (read-line stream)
+ (skip-comments-and-whitespace stream))))
+
+(defun read-upto-n-chars (stream n)
+ "Return a string of upto N chars from STREAM."
+ (let* ((string (make-string n))
+ (chars (read-sequence string stream)))
+ (subseq string 0 chars)))
diff --git a/vim/bundle/slimv/slime/swank/source-path-parser.lisp b/vim/bundle/slimv/slime/swank/source-path-parser.lisp
new file mode 100644
index 0000000..bb9c35c
--- /dev/null
+++ b/vim/bundle/slimv/slime/swank/source-path-parser.lisp
@@ -0,0 +1,239 @@
+;;;; Source-paths
+
+;;; CMUCL/SBCL use a data structure called "source-path" to locate
+;;; subforms. The compiler assigns a source-path to each form in a
+;;; compilation unit. Compiler notes usually contain the source-path
+;;; of the error location.
+;;;
+;;; Compiled code objects don't contain source paths, only the
+;;; "toplevel-form-number" and the (sub-) "form-number". To get from
+;;; the form-number to the source-path we need the entire toplevel-form
+;;; (i.e. we have to read the source code). CMUCL has already some
+;;; utilities to do this translation, but we use some extended
+;;; versions, because we need more exact position info. Apparently
+;;; Hemlock is happy with the position of the toplevel-form; we also
+;;; need the position of subforms.
+;;;
+;;; We use a special readtable to get the positions of the subforms.
+;;; The readtable stores the start and end position for each subform in
+;;; hashtable for later retrieval.
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+
+;;; Taken from swank-cmucl.lisp, by Helmut Eller
+
+(defpackage swank/source-path-parser
+ (:use cl)
+ (:export
+ read-source-form
+ source-path-string-position
+ source-path-file-position
+ source-path-source-position
+
+ sexp-in-bounds-p
+ sexp-ref)
+ (:shadow ignore-errors))
+
+(in-package swank/source-path-parser)
+
+;; Some test to ensure the required conformance
+(let ((rt (copy-readtable nil)))
+ (assert (or (not (get-macro-character #\space rt))
+ (nth-value 1 (get-macro-character #\space rt))))
+ (assert (not (get-macro-character #\\ rt))))
+
+(eval-when (:compile-toplevel)
+ (defmacro ignore-errors (&rest forms)
+ ;;`(progn . ,forms) ; for debugging
+ `(cl:ignore-errors . ,forms)))
+
+(defun make-sharpdot-reader (orig-sharpdot-reader)
+ (lambda (s c n)
+ ;; We want things like M-. to work regardless of any #.-fu in
+ ;; the source file that is to be visited. (For instance, when a
+ ;; file contains #. forms referencing constants that do not
+ ;; currently exist in the image.)
+ (ignore-errors (funcall orig-sharpdot-reader s c n))))
+
+(defun make-source-recorder (fn source-map)
+ "Return a macro character function that does the same as FN, but
+additionally stores the result together with the stream positions
+before and after of calling FN in the hashtable SOURCE-MAP."
+ (lambda (stream char)
+ (let ((start (1- (file-position stream)))
+ (values (multiple-value-list (funcall fn stream char)))
+ (end (file-position stream)))
+ #+(or)
+ (format t "[~D \"~{~A~^, ~}\" ~D ~D ~S]~%"
+ start values end (char-code char) char)
+ (when values
+ (destructuring-bind (&optional existing-start &rest existing-end)
+ (car (gethash (car values) source-map))
+ ;; Some macros may return what a sub-call to another macro
+ ;; produced, e.g. "#+(and) (a)" may end up saving (a) twice,
+ ;; once from #\# and once from #\(. If the saved form
+ ;; is a subform, don't save it again.
+ (unless (and existing-start existing-end
+ (<= start existing-start end)
+ (<= start existing-end end))
+ (push (cons start end) (gethash (car values) source-map)))))
+ (values-list values))))
+
+(defun make-source-recording-readtable (readtable source-map)
+ (declare (type readtable readtable) (type hash-table source-map))
+ "Return a source position recording copy of READTABLE.
+The source locations are stored in SOURCE-MAP."
+ (flet ((install-special-sharpdot-reader (rt)
+ (let ((fun (ignore-errors
+ (get-dispatch-macro-character #\# #\. rt))))
+ (when fun
+ (let ((wrapper (make-sharpdot-reader fun)))
+ (set-dispatch-macro-character #\# #\. wrapper rt)))))
+ (install-wrappers (rt)
+ (dotimes (code 128)
+ (let ((char (code-char code)))
+ (multiple-value-bind (fun nt) (get-macro-character char rt)
+ (when fun
+ (let ((wrapper (make-source-recorder fun source-map)))
+ (set-macro-character char wrapper nt rt))))))))
+ (let ((rt (copy-readtable readtable)))
+ (install-special-sharpdot-reader rt)
+ (install-wrappers rt)
+ rt)))
+
+;; FIXME: try to do this with *READ-SUPPRESS* = t to avoid interning.
+;; Should be possible as we only need the right "list structure" and
+;; not the right atoms.
+(defun read-and-record-source-map (stream)
+ "Read the next object from STREAM.
+Return the object together with a hashtable that maps
+subexpressions of the object to stream positions."
+ (let* ((source-map (make-hash-table :test #'eq))
+ (*readtable* (make-source-recording-readtable *readtable* source-map))
+ (*read-suppress* nil)
+ (start (file-position stream))
+ (form (ignore-errors (read stream)))
+ (end (file-position stream)))
+ ;; ensure that at least FORM is in the source-map
+ (unless (gethash form source-map)
+ (push (cons start end) (gethash form source-map)))
+ (values form source-map)))
+
+(defun starts-with-p (string prefix)
+ (declare (type string string prefix))
+ (not (mismatch string prefix
+ :end1 (min (length string) (length prefix))
+ :test #'char-equal)))
+
+(defun extract-package (line)
+ (declare (type string line))
+ (let ((name (cadr (read-from-string line))))
+ (find-package name)))
+
+#+(or)
+(progn
+ (assert (extract-package "(in-package cl)"))
+ (assert (extract-package "(cl:in-package cl)"))
+ (assert (extract-package "(in-package \"CL\")"))
+ (assert (extract-package "(in-package #:cl)")))
+
+;; FIXME: do something cleaner than this.
+(defun readtable-for-package (package)
+ ;; KLUDGE: due to the load order we can't reference the swank
+ ;; package.
+ (funcall (read-from-string "swank::guess-buffer-readtable")
+ (string-upcase (package-name package))))
+
+;; Search STREAM for a "(in-package ...)" form. Use that to derive
+;; the values for *PACKAGE* and *READTABLE*.
+;;
+;; IDEA: move GUESS-READER-STATE to swank.lisp so that all backends
+;; use the same heuristic and to avoid the need to access
+;; swank::guess-buffer-readtable from here.
+(defun guess-reader-state (stream)
+ (let* ((point (file-position stream))
+ (pkg *package*))
+ (file-position stream 0)
+ (loop for line = (read-line stream nil nil) do
+ (when (not line) (return))
+ (when (or (starts-with-p line "(in-package ")
+ (starts-with-p line "(cl:in-package "))
+ (let ((p (extract-package line)))
+ (when p (setf pkg p)))
+ (return)))
+ (file-position stream point)
+ (values (readtable-for-package pkg) pkg)))
+
+(defun skip-whitespace (stream)
+ (peek-char t stream nil nil))
+
+;; Skip over N toplevel forms.
+(defun skip-toplevel-forms (n stream)
+ (let ((*read-suppress* t))
+ (dotimes (i n)
+ (read stream))
+ (skip-whitespace stream)))
+
+(defun read-source-form (n stream)
+ "Read the Nth toplevel form number with source location recording.
+Return the form and the source-map."
+ (multiple-value-bind (*readtable* *package*) (guess-reader-state stream)
+ (skip-toplevel-forms n stream)
+ (read-and-record-source-map stream)))
+
+(defun source-path-stream-position (path stream)
+ "Search the source-path PATH in STREAM and return its position."
+ (check-source-path path)
+ (destructuring-bind (tlf-number . path) path
+ (multiple-value-bind (form source-map) (read-source-form tlf-number stream)
+ (source-path-source-position (cons 0 path) form source-map))))
+
+(defun check-source-path (path)
+ (unless (and (consp path)
+ (every #'integerp path))
+ (error "The source-path ~S is not valid." path)))
+
+(defun source-path-string-position (path string)
+ (with-input-from-string (s string)
+ (source-path-stream-position path s)))
+
+(defun source-path-file-position (path filename)
+ ;; We go this long way round, and don't directly operate on the file
+ ;; stream because FILE-POSITION (used above) is not totally savy even
+ ;; on file character streams; on SBCL, FILE-POSITION returns the binary
+ ;; offset, and not the character offset---screwing up on Unicode.
+ (let ((toplevel-number (first path))
+ (buffer))
+ (with-open-file (file filename)
+ (skip-toplevel-forms (1+ toplevel-number) file)
+ (let ((endpos (file-position file)))
+ (setq buffer (make-array (list endpos) :element-type 'character
+ :initial-element #\Space))
+ (assert (file-position file 0))
+ (read-sequence buffer file :end endpos)))
+ (source-path-string-position path buffer)))
+
+(defgeneric sexp-in-bounds-p (sexp i)
+ (:method ((list list) i)
+ (< i (loop for e on list
+ count t)))
+ (:method ((sexp t) i) nil))
+
+(defgeneric sexp-ref (sexp i)
+ (:method ((s list) i) (elt s i)))
+
+(defun source-path-source-position (path form source-map)
+ "Return the start position of PATH from FORM and SOURCE-MAP. All
+subforms along the path are considered and the start and end position
+of the deepest (i.e. smallest) possible form is returned."
+ ;; compute all subforms along path
+ (let ((forms (loop for i in path
+ for f = form then (if (sexp-in-bounds-p f i)
+ (sexp-ref f i))
+ collect f)))
+ ;; select the first subform present in source-map
+ (loop for form in (nreverse forms)
+ for ((start . end) . rest) = (gethash form source-map)
+ when (and start end (not rest))
+ return (return (values start end)))))
diff --git a/vim/bundle/slimv/slime/xref.lisp b/vim/bundle/slimv/slime/xref.lisp
new file mode 100644
index 0000000..e09a150
--- /dev/null
+++ b/vim/bundle/slimv/slime/xref.lisp
@@ -0,0 +1,2906 @@
+;;; -*- Mode: LISP; Package: XREF; Syntax: Common-lisp; -*-
+;;; Mon Jan 21 16:21:20 1991 by Mark Kantrowitz <mkant@GLINDA.OZ.CS.CMU.EDU>
+;;; xref.lisp
+
+;;; ****************************************************************
+;;; List Callers: A Static Analysis Cross Referencing Tool for Lisp
+;;; ****************************************************************
+;;;
+;;; The List Callers system is a portable Common Lisp cross referencing
+;;; utility. It grovels over a set of files and compiles a database of the
+;;; locations of all references for each symbol used in the files.
+;;; List Callers is similar to the Symbolics Who-Calls and the
+;;; Xerox Masterscope facilities.
+;;;
+;;; When you change a function or variable definition, it can be useful
+;;; to know its callers, in order to update each of them to the new
+;;; definition. Similarly, having a graphic display of the structure
+;;; (e.g., call graph) of a program can help make undocumented code more
+;;; understandable. This static code analyzer facilitates both capabilities.
+;;; The database compiled by xref is suitable for viewing by a graphical
+;;; browser. (Note: the reference graph is not necessarily a DAG. Since many
+;;; graphical browsers assume a DAG, this will lead to infinite loops.
+;;; Some code which is useful in working around this problem is included,
+;;; as well as a sample text-indenting outliner and an interface to Bates'
+;;; PSGraph Postscript Graphing facility.)
+;;;
+;;; Written by Mark Kantrowitz, July 1990.
+;;;
+;;; Address: School of Computer Science
+;;; Carnegie Mellon University
+;;; Pittsburgh, PA 15213
+;;;
+;;; Copyright (c) 1990. All rights reserved.
+;;;
+;;; See general license below.
+;;;
+
+;;; ****************************************************************
+;;; General License Agreement and Lack of Warranty *****************
+;;; ****************************************************************
+;;;
+;;; This software is distributed in the hope that it will be useful (both
+;;; in and of itself and as an example of lisp programming), but WITHOUT
+;;; ANY WARRANTY. The author(s) do not accept responsibility to anyone for
+;;; the consequences of using it or for whether it serves any particular
+;;; purpose or works at all. No warranty is made about the software or its
+;;; performance.
+;;;
+;;; Use and copying of this software and the preparation of derivative
+;;; works based on this software are permitted, so long as the following
+;;; conditions are met:
+;;; o The copyright notice and this entire notice are included intact
+;;; and prominently carried on all copies and supporting documentation.
+;;; o No fees or compensation are charged for use, copies, or
+;;; access to this software. You may charge a nominal
+;;; distribution fee for the physical act of transferring a
+;;; copy, but you may not charge for the program itself.
+;;; o If you modify this software, you must cause the modified
+;;; file(s) to carry prominent notices (a Change Log)
+;;; describing the changes, who made the changes, and the date
+;;; of those changes.
+;;; o Any work distributed or published that in whole or in part
+;;; contains or is a derivative of this software or any part
+;;; thereof is subject to the terms of this agreement. The
+;;; aggregation of another unrelated program with this software
+;;; or its derivative on a volume of storage or distribution
+;;; medium does not bring the other program under the scope
+;;; of these terms.
+;;; o Permission is granted to manufacturers and distributors of
+;;; lisp compilers and interpreters to include this software
+;;; with their distribution.
+;;;
+;;; This software is made available AS IS, and is distributed without
+;;; warranty of any kind, either expressed or implied.
+;;;
+;;; In no event will the author(s) or their institutions be liable to you
+;;; for damages, including lost profits, lost monies, or other special,
+;;; incidental or consequential damages arising out of or in connection
+;;; with the use or inability to use (including but not limited to loss of
+;;; data or data being rendered inaccurate or losses sustained by third
+;;; parties or a failure of the program to operate as documented) the
+;;; program, even if you have been advised of the possibility of such
+;;; damanges, or for any claim by any other party, whether in an action of
+;;; contract, negligence, or other tortious action.
+;;;
+;;; The current version of this software and a variety of related utilities
+;;; may be obtained by anonymous ftp from ftp.cs.cmu.edu in the directory
+;;; user/ai/lang/lisp/code/tools/xref/
+;;;
+;;; Please send bug reports, comments, questions and suggestions to
+;;; mkant@cs.cmu.edu. We would also appreciate receiving any changes
+;;; or improvements you may make.
+;;;
+;;; If you wish to be added to the Lisp-Utilities@cs.cmu.edu mailing list,
+;;; send email to Lisp-Utilities-Request@cs.cmu.edu with your name, email
+;;; address, and affiliation. This mailing list is primarily for
+;;; notification about major updates, bug fixes, and additions to the lisp
+;;; utilities collection. The mailing list is intended to have low traffic.
+;;;
+
+;;; ********************************
+;;; Change Log *********************
+;;; ********************************
+;;;
+;;; 27-FEB-91 mk Added insert arg to psgraph-xref to allow the postscript
+;;; graphs to be inserted in Scribe documents.
+;;; 21-FEB-91 mk Added warning if not compiled.
+;;; 07-FEB-91 mk Fixed bug in record-callers with regard to forms at
+;;; toplevel.
+;;; 21-JAN-91 mk Added file xref-test.lisp to test xref.
+;;; 16-JAN-91 mk Added definition WHO-CALLS to parallel the Symbolics syntax.
+;;; 16-JAN-91 mk Added macroexpansion capability to record-callers. Also
+;;; added parameter *handle-macro-forms*, defaulting to T.
+;;; 16-JAN-91 mk Modified print-caller-tree and related functions
+;;; to allow the user to specify root nodes. If the user
+;;; doesn't specify them, it will default to all root
+;;; nodes, as before.
+;;; 16-JAN-91 mk Added parameter *default-graphing-mode* to specify
+;;; the direction of the graphing. Either :call-graph,
+;;; where the children of a node are those functions called
+;;; by the node, or :caller-graph where the children of a
+;;; node are the callers of the node. :call-graph is the
+;;; default.
+;;; 16-JAN-91 mk Added parameter *indent-amount* to control the indentation
+;;; in print-indented-tree.
+;;; 16-JUL-90 mk Functions with argument lists of () were being ignored
+;;; because of a (when form) wrapped around the body of
+;;; record-callers. Then intent of (when form) was as an extra
+;;; safeguard against infinite looping. This wasn't really
+;;; necessary, so it has been removed.
+;;; 16-JUL-90 mk PSGraph-XREF now has keyword arguments, instead of
+;;; optionals.
+;;; 16-JUL-90 mk Added PRINT-CLASS-HIERARCHY to use psgraph to graph the
+;;; CLOS class hierarchy. This really doesn't belong here,
+;;; and should be moved to psgraph.lisp as an example of how
+;;; to use psgraph.
+;;; 16-JUL-90 mk Fixed several caller patterns. The pattern for member
+;;; had an error which caused many references to be missed.
+;;; 16-JUL-90 mk Added ability to save/load processed databases.
+;;; 5-JUL-91 mk Fixed warning of needing compilation to occur only when the
+;;; source is loaded.
+;;; 20-SEP-93 mk Added fix from Peter Norvig to allow Xref to xref itself.
+;;; The arg to macro-function must be a symbol.
+;;; 7-APR-12 heller Break lines at 80 columns.
+
+;;; ********************************
+;;; To Do **************************
+;;; ********************************
+;;;
+;;; Verify that:
+;;; o null forms don't cause it to infinite loop.
+;;; o nil matches against null argument lists.
+;;; o declarations and doc are being ignored.
+;;;
+;;; Would be nice if in addition to showing callers of a function, it
+;;; displayed the context of the calls to the function (e.g., the
+;;; immediately surrounding form). This entails storing entries of
+;;; the form (symbol context*) in the database and augmenting
+;;; record-callers to keep the context around. The only drawbacks is
+;;; that it would cons a fair bit. If we do this, we should store
+;;; additional information as well in the database, such as the caller
+;;; pattern type (e.g., variable vs. function).
+;;;
+;;; Write a translator from BNF (at least as much of BNF as is used
+;;; in CLtL2), to the format used here.
+;;;
+;;; Should automatically add new patterns for new functions and macros
+;;; based on their arglists. Probably requires much more than this
+;;; simple code walker, so there isn't much we can do.
+;;;
+;;; Defmacro is a problem, because it often hides internal function
+;;; calls within backquote and quote, which we normally ignore. If
+;;; we redefine QUOTE's pattern so that it treats the arg like a FORM,
+;;; we'll probably get them (though maybe the syntax will be mangled),
+;;; but most likely a lot of spurious things as well.
+;;;
+;;; Define an operation for Defsystem which will run XREF-FILE on the
+;;; files of the system. Or yet simpler, when XREF sees a LOAD form
+;;; for which the argument is a string, tries to recursively call
+;;; XREF-FILE on the specified file. Then one could just XREF-FILE
+;;; the file which loads the system. (This should be a program
+;;; parameter.)
+;;;
+;;; Have special keywords which the user may place in a file to have
+;;; XREF-FILE ignore a region.
+;;;
+;;; Should we distinguish flet and labels from defun? I.e., note that
+;;; flet's definitions are locally defined, instead of just lumping
+;;; them in with regular definitions.
+;;;
+;;; Add patterns for series, loop macro.
+;;;
+;;; Need to integrate the variable reference database with the other
+;;; databases, yet maintain separation. So we can distinguish all
+;;; the different types of variable and function references, without
+;;; multiplying databases.
+;;;
+;;; Would pay to comment record-callers and record-callers* in more
+;;; depth.
+;;;
+;;; (&OPTIONAL &REST &KEY &AUX &BODY &WHOLE &ALLOW-OTHER-KEYS &ENVIRONMENT)
+
+;;; ********************************
+;;; Notes **************************
+;;; ********************************
+;;;
+;;; XREF has been tested (successfully) in the following lisps:
+;;; CMU Common Lisp (M2.9 15-Aug-90, Compiler M1.8 15-Aug-90)
+;;; Macintosh Allegro Common Lisp (1.3.2)
+;;; ExCL (Franz Allegro CL 3.1.12 [DEC 3100] 3/30/90)
+;;; Lucid CL (Version 2.1 6-DEC-87)
+;;;
+;;; XREF has been tested (unsuccessfully) in the following lisps:
+;;; Ibuki Common Lisp (01/01, October 15, 1987)
+;;; - if interpreted, runs into stack overflow
+;;; - does not compile (tried ibcl on Suns, PMAXes and RTs)
+;;; seems to be due to a limitation in the c compiler.
+;;;
+;;; XREF needs to be tested in the following lisps:
+;;; Symbolics Common Lisp (8.0)
+;;; Lucid Common Lisp (3.0, 4.0)
+;;; KCL (June 3, 1987 or later)
+;;; AKCL (1.86, June 30, 1987 or later)
+;;; TI (Release 4.1 or later)
+;;; Golden Common Lisp (3.1 IBM-PC)
+;;; VAXLisp (2.0, 3.1)
+;;; HP Common Lisp (same as Lucid?)
+;;; Procyon Common Lisp
+
+
+;;; ****************************************************************
+;;; Documentation **************************************************
+;;; ****************************************************************
+;;;
+;;; XREF analyzes a user's program, determining which functions call a
+;;; given function, and the location of where variables are bound/assigned
+;;; and used. The user may retrieve this information for either a single
+;;; symbol, or display the call graph of portions of the program
+;;; (including the entire program). This allows the programmer to debug
+;;; and document the program's structure.
+;;;
+;;; XREF is primarily intended for analyzing large programs, where it is
+;;; difficult, if not impossible, for the programmer to grasp the structure
+;;; of the whole program. Nothing precludes using XREF for smaller programs,
+;;; where it can be useful for inspecting the relationships between pieces
+;;; of the program and for documenting the program.
+;;;
+;;; Two aspects of the Lisp programming language greatly simplify the
+;;; analysis of Lisp programs:
+;;; o Lisp programs are naturally represented as data.
+;;; Successive definitions from a file are easily read in
+;;; as list structure.
+;;; o The basic syntax of Lisp is uniform. A list program
+;;; consists of a set of nested forms, where each form is
+;;; a list whose car is a tag (e.g., function name) that
+;;; specifies the structure of the rest of the form.
+;;; Thus Lisp programs, when represented as data, can be considered to be
+;;; parse trees. Given a grammar of syntax patterns for the language, XREF
+;;; recursively descends the parse tree for a given definition, computing
+;;; a set of relations that hold for the definition at each node in the
+;;; tree. For example, one kind of relation is that the function defined
+;;; by the definition calls the functions in its body. The relations are
+;;; stored in a database for later examination by the user.
+;;;
+;;; While XREF currently only works for programs written in Lisp, it could
+;;; be extended to other programming languages by writing a function to
+;;; generate parse trees for definitions in that language, and a core
+;;; set of patterns for the language's syntax.
+;;;
+;;; Since XREF normally does a static syntactic analysis of the program,
+;;; it does not detect references due to the expansion of a macro definition.
+;;; To do this in full generality XREF would have to have knowledge about the
+;;; semantics of the program (e.g., macros which call other functions to
+;;; do the expansion). This entails either modifying the compiler to
+;;; record the relationships (e.g., Symbolics Who-Calls Database) or doing
+;;; a walk of loaded code and macroexpanding as needed (PCL code walker).
+;;; The former is not portable, while the latter requires that the code
+;;; used by macros be loaded and in working order. On the other hand, then
+;;; we would need no special knowledge about macros (excluding the 24 special
+;;; forms of Lisp).
+;;;
+;;; Parameters may be set to enable macro expansion in XREF. Then XREF
+;;; will expand any macros for which it does not have predefined patterns.
+;;; (For example, most Lisps will implement dolist as a macro. Since XREF
+;;; has a pattern defined for dolist, it will not call macroexpand-1 on
+;;; a form whose car is dolist.) For this to work properly, the code must
+;;; be loaded before being processed by XREF, and XREF's parameters should
+;;; be set so that it processes forms in their proper packages.
+;;;
+;;; If macro expansion is disabled, the default rules for handling macro
+;;; references may not be sufficient for some user-defined macros, because
+;;; macros allow a variety of non-standard syntactic extensions to the
+;;; language. In this case, the user may specify additional templates in
+;;; a manner similar to that in which the core Lisp grammar was specified.
+;;;
+
+
+;;; ********************************
+;;; User Guide *********************
+;;; ********************************
+;;; -----
+;;; The following functions are called to cross reference the source files.
+;;;
+;;; XREF-FILES (&rest files) [FUNCTION]
+;;; Grovels over the lisp code located in source file FILES, using
+;;; xref-file.
+;;;
+;;; XREF-FILE (filename &optional clear-tables verbose) [Function]
+;;; Cross references the function and variable calls in FILENAME by
+;;; walking over the source code located in the file. Defaults type of
+;;; filename to ".lisp". Chomps on the code using record-callers and
+;;; record-callers*. If CLEAR-TABLES is T (the default), it clears the
+;;; callers database before processing the file. Specify CLEAR-TABLES as
+;;; nil to append to the database. If VERBOSE is T (the default), prints
+;;; out the name of the file, one progress dot for each form processed,
+;;; and the total number of forms.
+;;;
+;;; -----
+;;; The following functions display information about the uses of the
+;;; specified symbol as a function, variable, or constant.
+;;;
+;;; LIST-CALLERS (symbol) [FUNCTION]
+;;; Lists all functions which call SYMBOL as a function (function
+;;; invocation).
+;;;
+;;; LIST-READERS (symbol) [FUNCTION]
+;;; Lists all functions which refer to SYMBOL as a variable
+;;; (variable reference).
+;;;
+;;; LIST-SETTERS (symbol) [FUNCTION]
+;;; Lists all functions which bind/set SYMBOL as a variable
+;;; (variable mutation).
+;;;
+;;; LIST-USERS (symbol) [FUNCTION]
+;;; Lists all functions which use SYMBOL as a variable or function.
+;;;
+;;; WHO-CALLS (symbol &optional how) [FUNCTION]
+;;; Lists callers of symbol. HOW may be :function, :reader, :setter,
+;;; or :variable."
+;;;
+;;; WHAT-FILES-CALL (symbol) [FUNCTION]
+;;; Lists names of files that contain uses of SYMBOL
+;;; as a function, variable, or constant.
+;;;
+;;; SOURCE-FILE (symbol) [FUNCTION]
+;;; Lists the names of files in which SYMBOL is defined/used.
+;;;
+;;; LIST-CALLEES (symbol) [FUNCTION]
+;;; Lists names of functions and variables called by SYMBOL.
+;;;
+;;; -----
+;;; The following functions may be useful for viewing the database and
+;;; debugging the calling patterns.
+;;;
+;;; *LAST-FORM* () [VARIABLE]
+;;; The last form read from the file. Useful for figuring out what went
+;;; wrong when xref-file drops into the debugger.
+;;;
+;;; *XREF-VERBOSE* t [VARIABLE]
+;;; When T, xref-file(s) prints out the names of the files it looks at,
+;;; progress dots, and the number of forms read.
+;;;
+;;; *TYPES-TO-IGNORE* (quote (:lisp :lisp2)) [VARIABLE]
+;;; Default set of caller types (as specified in the patterns) to ignore
+;;; in the database handling functions. :lisp is CLtL 1st edition,
+;;; :lisp2 is additional patterns from CLtL 2nd edition.
+;;;
+;;; *HANDLE-PACKAGE-FORMS* () [VARIABLE]
+;;; When non-NIL, and XREF-FILE sees a package-setting form like
+;;; IN-PACKAGE, sets the current package to the specified package by
+;;; evaluating the form. When done with the file, xref-file resets the
+;;; package to its original value. In some of the displaying functions,
+;;; when this variable is non-NIL one may specify that all symbols from a
+;;; particular set of packages be ignored. This is only useful if the
+;;; files use different packages with conflicting names.
+;;;
+;;; *HANDLE-FUNCTION-FORMS* t [VARIABLE]
+;;; When T, XREF-FILE tries to be smart about forms which occur in
+;;; a function position, such as lambdas and arbitrary Lisp forms.
+;;; If so, it recursively calls record-callers with pattern 'FORM.
+;;; If the form is a lambda, makes the caller a caller of
+;;; :unnamed-lambda.
+;;;
+;;; *HANDLE-MACRO-FORMS* t [VARIABLE]
+;;; When T, if the file was loaded before being processed by XREF, and
+;;; the car of a form is a macro, it notes that the parent calls the
+;;; macro, and then calls macroexpand-1 on the form.
+;;;
+;;; *DEFAULT-GRAPHING-MODE* :call-graph [VARIABLE]
+;;; Specifies whether we graph up or down. If :call-graph, the children
+;;; of a node are the functions it calls. If :caller-graph, the
+;;; children of a node are the functions that call it.
+;;;
+;;; *INDENT-AMOUNT* 3 [VARIABLE]
+;;; Number of spaces to indent successive levels in PRINT-INDENTED-TREE.
+;;;
+;;; DISPLAY-DATABASE (&optional database types-to-ignore) [FUNCTION]
+;;; Prints out the name of each symbol and all its callers. Specify
+;;; database :callers (the default) to get function call references,
+;;; :file to the get files in which the symbol is called, :readers to get
+;;; variable references, and :setters to get variable binding and
+;;; assignments. Ignores functions of types listed in types-to-ignore.
+;;;
+;;; PRINT-CALLER-TREES (&key (mode *default-graphing-mode*) [FUNCTION]
+;;; (types-to-ignore *types-to-ignore*)
+;;; compact root-nodes)
+;;; Prints the calling trees (which may actually be a full graph and not
+;;; necessarily a DAG) as indented text trees using
+;;; PRINT-INDENTED-TREE. MODE is :call-graph for trees where the children
+;;; of a node are the functions called by the node, or :caller-graph for
+;;; trees where the children of a node are the functions the node calls.
+;;; TYPES-TO-IGNORE is a list of funcall types (as specified in the
+;;; patterns) to ignore in printing out the database. For example,
+;;; '(:lisp) would ignore all calls to common lisp functions. COMPACT is
+;;; a flag to tell the program to try to compact the trees a bit by not
+;;; printing trees if they have already been seen. ROOT-NODES is a list
+;;; of root nodes of trees to display. If ROOT-NODES is nil, tries to
+;;; find all root nodes in the database.
+;;;
+;;; MAKE-CALLER-TREE (&optional (mode *default-graphing-mode*) [FUNCTION]
+;;; (types-to-ignore *types-to-ignore*)
+;;; compact)
+;;; Outputs list structure of a tree which roughly represents the
+;;; possibly cyclical structure of the caller database.
+;;; If mode is :call-graph, the children of a node are the functions
+;;; it calls. If mode is :caller-graph, the children of a node are the
+;;; functions that call it.
+;;; If compact is T, tries to eliminate the already-seen nodes, so
+;;; that the graph for a node is printed at most once. Otherwise it will
+;;; duplicate the node's tree (except for cycles). This is usefull
+;;; because the call tree is actually a directed graph, so we can either
+;;; duplicate references or display only the first one.
+;;;
+;;; DETERMINE-FILE-DEPENDENCIES (&optional database) [FUNCTION]
+;;; Makes a hash table of file dependencies for the references listed in
+;;; DATABASE. This function may be useful for automatically resolving
+;;; file references for automatic creation of a system definition
+;;; (defsystem).
+;;;
+;;; PRINT-FILE-DEPENDENCIES (&optional database) [FUNCTION]
+;;; Prints a list of file dependencies for the references listed in
+;;; DATABASE. This function may be useful for automatically computing
+;;; file loading constraints for a system definition tool.
+;;;
+;;; WRITE-CALLERS-DATABASE-TO-FILE (filename) [FUNCTION]
+;;; Saves the contents of the current callers database to a file. This
+;;; file can be loaded to restore the previous contents of the
+;;; database. (For large systems it can take a long time to crunch
+;;; through the code, so this can save some time.)
+;;;
+;;; -----
+;;; The following macros define new function and macro call patterns.
+;;; They may be used to extend the static analysis tool to handle
+;;; new def forms, extensions to Common Lisp, and program defs.
+;;;
+;;; DEFINE-PATTERN-SUBSTITUTION (name pattern) [MACRO]
+;;; Defines NAME to be equivalent to the specified pattern. Useful for
+;;; making patterns more readable. For example, the LAMBDA-LIST is
+;;; defined as a pattern substitution, making the definition of the
+;;; DEFUN caller-pattern simpler.
+;;;
+;;; DEFINE-CALLER-PATTERN (name pattern &optional caller-type) [MACRO]
+;;; Defines NAME as a function/macro call with argument structure
+;;; described by PATTERN. CALLER-TYPE, if specified, assigns a type to
+;;; the pattern, which may be used to exclude references to NAME while
+;;; viewing the database. For example, all the Common Lisp definitions
+;;; have a caller-type of :lisp or :lisp2, so that you can exclude
+;;; references to common lisp functions from the calling tree.
+;;;
+;;; DEFINE-VARIABLE-PATTERN (name &optional caller-type) [MACRO]
+;;; Defines NAME as a variable reference of type CALLER-TYPE. This is
+;;; mainly used to establish the caller-type of the variable.
+;;;
+;;; DEFINE-CALLER-PATTERN-SYNONYMS (source destinations) [MACRO]
+;;; For defining function caller pattern syntax synonyms. For each name
+;;; in DESTINATIONS, defines its pattern as a copy of the definition
+;;; of SOURCE. Allows a large number of identical patterns to be defined
+;;; simultaneously. Must occur after the SOURCE has been defined.
+;;;
+;;; -----
+;;; This system includes pattern definitions for the latest
+;;; common lisp specification, as published in Guy Steele,
+;;; Common Lisp: The Language, 2nd Edition.
+;;;
+;;; Patterns may be either structures to match, or a predicate
+;;; like symbolp/numberp/stringp. The pattern specification language
+;;; is similar to the notation used in CLtL2, but in a more lisp-like
+;;; form:
+;;; (:eq name) The form element must be eq to the symbol NAME.
+;;; (:test test) TEST must be true when applied to the form element.
+;;; (:typep type) The form element must be of type TYPE.
+;;; (:or pat1 pat2 ...) Tries each of the patterns in left-to-right order,
+;;; until one succeeds.
+;;; Equivalent to { pat1 | pat2 | ... }
+;;; (:rest pattern) The remaining form elements are grouped into a
+;;; list which is matched against PATTERN.
+;;; (:optional pat1 ...) The patterns may optionally match against the
+;;; form element.
+;;; Equivalent to [ pat1 ... ].
+;;; (:star pat1 ...) The patterns may match against the patterns
+;;; any number of times, including 0.
+;;; Equivalent to { pat1 ... }*.
+;;; (:plus pat1 ...) The patterns may match against the patterns
+;;; any number of times, but at least once.
+;;; Equivalent to { pat1 ... }+.
+;;; &optional, &key, Similar in behavior to the corresponding
+;;; &rest lambda-list keywords.
+;;; FORM A random lisp form. If a cons, assumes the
+;;; car is a function or macro and tries to
+;;; match the args against that symbol's pattern.
+;;; If a symbol, assumes it's a variable reference.
+;;; :ignore Ignores the corresponding form element.
+;;; NAME The corresponding form element should be
+;;; the name of a new definition (e.g., the
+;;; first arg in a defun pattern is NAME.
+;;; FUNCTION, MACRO The corresponding form element should be
+;;; a function reference not handled by FORM.
+;;; Used in the definition of apply and funcall.
+;;; VAR The corresponding form element should be
+;;; a variable definition or mutation. Used
+;;; in the definition of let, let*, etc.
+;;; VARIABLE The corresponding form element should be
+;;; a variable reference.
+;;;
+;;; In all other pattern symbols, it looks up the symbols pattern substitution
+;;; and recursively matches against the pattern. Automatically destructures
+;;; list structure that does not include consing dots.
+;;;
+;;; Among the pattern substitution names defined are:
+;;; STRING, SYMBOL, NUMBER Appropriate :test patterns.
+;;; LAMBDA-LIST Matches against a lambda list.
+;;; BODY Matches against a function body definition.
+;;; FN Matches against #'function, 'function,
+;;; and lambdas. This is used in the definition
+;;; of apply, funcall, and the mapping patterns.
+;;; and others...
+;;;
+;;; Here's some sample pattern definitions:
+;;; (define-caller-pattern defun
+;;; (name lambda-list
+;;; (:star (:or documentation-string declaration))
+;;; (:star form))
+;;; :lisp)
+;;; (define-caller-pattern funcall (fn (:star form)) :lisp)
+;;;
+;;; In general, the system is intelligent enough to handle any sort of
+;;; simple funcall. One only need specify the syntax for functions and
+;;; macros which use optional arguments, keyword arguments, or some
+;;; argument positions are special, such as in apply and funcall, or
+;;; to indicate that the function is of the specified caller type.
+;;;
+;;;
+;;; NOTES:
+;;;
+;;; XRef assumes syntactically correct lisp code.
+;;;
+;;; This is by no means perfect. For example, let and let* are treated
+;;; identically, instead of differentiating between serial and parallel
+;;; binding. But it's still a useful tool. It can be helpful in
+;;; maintaining code, debugging problems with patch files, determining
+;;; whether functions are multiply defined, and help you remember where
+;;; a function is defined or called.
+;;;
+;;; XREF runs best when compiled.
+
+;;; ********************************
+;;; References *********************
+;;; ********************************
+;;;
+;;; Xerox Interlisp Masterscope Program:
+;;; Larry M Masinter, Global program analysis in an interactive environment
+;;; PhD Thesis, Stanford University, 1980.
+;;;
+;;; Symbolics Who-Calls Database:
+;;; User's Guide to Symbolics Computers, Volume 1, Cambridge, MA, July 1986
+;;; Genera 7.0, pp 183-185.
+;;;
+
+;;; ********************************
+;;; Example ************************
+;;; ********************************
+;;;
+;;; Here is an example of running XREF on a short program.
+;;; [In Scribe documentation, give a simple short program and resulting
+;;; XREF output, including postscript call graphs.]
+#|
+<cl> (xref:xref-file "/afs/cs/user/mkant/Lisp/Graph-Dag/graph-dag.lisp")
+Cross-referencing file /afs/cs/user/mkant/Lisp/Graph-Dag/graph-dag.lisp.
+................................................
+48 forms processed.
+<cl> (xref:display-database :readers)
+
+*DISPLAY-CUTOFF-DEPTH* is referenced by CALCULATE-LEVEL-POSITION
+CALCULATE-LEVEL-POSITION-BEFORE CALCULATE-POSITION-IN-LEVEL.
+*OFFSET-FROM-EDGE-OF-PANE* is referenced by CALCULATE-LEVEL-POSITION
+CALCULATE-LEVEL-POSITION-BEFORE.
+*WITHIN-LEVEL-SPACING* is referenced by BREADTH CALCULATE-POSITION-INFO.
+*DIRECTION* is referenced by CREATE-POSITION-INFO.
+*LINK-OFFSET* is referenced by OFFSET-OF-LINK-FROM-ATTACHMENT-POINT.
+*ROOT-IS-SEQUENCE* is referenced by GRAPH.
+*LEVEL-SPACING* is referenced by CALCULATE-LEVEL-POSITION
+CALCULATE-LEVEL-POSITION-BEFORE.
+*ORIENTATION* is referenced by BREADTH CALCULATE-LEVEL-POSITION
+CALCULATE-LEVEL-POSITION-BEFORE CALCULATE-POSITION-IN-LEVEL.
+*DEFAULT-GRAPH-POSITION* is referenced by CREATE-POSITION-INFO.
+*GRAPHING-CUTOFF-DEPTH* is referenced by CREATE-NODE-STRUCTURE.
+*LIST-OF-NODES* is referenced by CALCULATE-LEVEL-POSITION
+CALCULATE-LEVEL-POSITION-BEFORE CREATE-NODE FIND-NODE.
+*GRAPH-TYPE* is referenced by CREATE-NODE-STRUCTURE.
+<cl> (xref:print-caller-trees :root-nodes '(display-graph))
+
+Rooted calling trees:
+ DISPLAY-GRAPH
+ CREATE-POSITION-INFO
+ CALCULATE-POSITION-INFO
+ CALCULATE-POSITION
+ NODE-POSITION-ALREADY-SET-FLAG
+ NODE-LEVEL-ALREADY-SET-FLAG
+ CALCULATE-POSITION-IN-LEVEL
+ NODE-CHILDREN
+ NODE-LEVEL
+ CALCULATE-POSITION
+ NEW-CALCULATE-BREADTH
+ NODE-CHILDREN
+ BREADTH
+ OPPOSITE-DIMENSION
+ NODE-HEIGHT
+ NODE-WIDTH
+ NEW-CALCULATE-BREADTH
+ NODE-PARENTS
+ OPPOSITE-DIMENSION
+ NODE-HEIGHT
+ NODE-WIDTH
+ OPPOSITE-POSITION
+ NODE-Y
+ NODE-X
+ NODE-LEVEL
+ CALCULATE-LEVEL-POSITION
+ NODE-LEVEL
+ NODE-POSITION
+ NODE-X
+ NODE-Y
+ DIMENSION
+ NODE-WIDTH
+ NODE-HEIGHT
+ CALCULATE-LEVEL-POSITION-BEFORE
+ NODE-LEVEL
+ NODE-POSITION
+ NODE-X
+ NODE-Y
+ NODE-WIDTH
+ NODE-HEIGHT
+ DIMENSION
+ NODE-WIDTH
+ NODE-HEIGHT
+|#
+
+;;; ****************************************************************
+;;; List Callers ***************************************************
+;;; ****************************************************************
+
+(defpackage :pxref
+ (:use :common-lisp)
+ (:export #:list-callers
+ #:list-users
+ #:list-readers
+ #:list-setters
+ #:what-files-call
+ #:who-calls
+ #:list-callees
+ #:source-file
+ #:clear-tables
+ #:define-pattern-substitution
+ #:define-caller-pattern
+ #:define-variable-pattern
+ #:define-caller-pattern-synonyms
+ #:clear-patterns
+ #:*last-form*
+ #:*xref-verbose*
+ #:*handle-package-forms*
+ #:*handle-function-forms*
+ #:*handle-macro-forms*
+ #:*types-to-ignore*
+ #:*last-caller-tree*
+ #:*default-graphing-mode*
+ #:*indent-amount*
+ #:xref-file
+ #:xref-files
+ #:write-callers-database-to-file
+ #:display-database
+ #:print-caller-trees
+ #:make-caller-tree
+ #:print-indented-tree
+ #:determine-file-dependencies
+ #:print-file-dependencies
+ #:psgraph-xref
+ ))
+
+(in-package "PXREF")
+
+;;; Warn user if they're loading the source instead of compiling it first.
+;(eval-when (compile load eval)
+; (defvar compiled-p nil))
+;(eval-when (compile load)
+; (setq compiled-p t))
+;(eval-when (load eval)
+; (unless compiled-p
+; (warn "This file should be compiled before loading for best results.")))
+(eval-when (eval)
+ (warn "This file should be compiled before loading for best results."))
+
+
+;;; ********************************
+;;; Primitives *********************
+;;; ********************************
+(defun lookup (symbol environment)
+ (dolist (frame environment)
+ (when (member symbol frame)
+ (return symbol))))
+
+(defun car-eq (list item)
+ (and (consp list)
+ (eq (car list) item)))
+
+;;; ********************************
+;;; Callers Database ***************
+;;; ********************************
+(defvar *file-callers-database* (make-hash-table :test #'equal)
+ "Contains name and list of file callers (files which call) for that name.")
+(defvar *callers-database* (make-hash-table :test #'equal)
+ "Contains name and list of callers (function invocation) for that name.")
+(defvar *readers-database* (make-hash-table :test #'equal)
+ "Contains name and list of readers (variable use) for that name.")
+(defvar *setters-database* (make-hash-table :test #'equal)
+ "Contains name and list of setters (variable mutation) for that name.")
+(defvar *callees-database* (make-hash-table :test #'equal)
+ "Contains name and list of functions and variables it calls.")
+(defun callers-list (name &optional (database :callers))
+ (case database
+ (:file (gethash name *file-callers-database*))
+ (:callees (gethash name *callees-database*))
+ (:callers (gethash name *callers-database*))
+ (:readers (gethash name *readers-database*))
+ (:setters (gethash name *setters-database*))))
+(defsetf callers-list (name &optional (database :callers)) (caller)
+ `(setf (gethash ,name (case ,database
+ (:file *file-callers-database*)
+ (:callees *callees-database*)
+ (:callers *callers-database*)
+ (:readers *readers-database*)
+ (:setters *setters-database*)))
+ ,caller))
+
+(defun list-callers (symbol)
+ "Lists all functions which call SYMBOL as a function (function invocation)."
+ (callers-list symbol :callers))
+(defun list-readers (symbol)
+ "Lists all functions which refer to SYMBOL as a variable
+ (variable reference)."
+ (callers-list symbol :readers))
+(defun list-setters (symbol)
+ "Lists all functions which bind/set SYMBOL as a variable
+ (variable mutation)."
+ (callers-list symbol :setters))
+(defun list-users (symbol)
+ "Lists all functions which use SYMBOL as a variable or function."
+ (values (list-callers symbol)
+ (list-readers symbol)
+ (list-setters symbol)))
+(defun who-calls (symbol &optional how)
+ "Lists callers of symbol. HOW may be :function, :reader, :setter,
+ or :variable."
+ ;; would be nice to have :macro and distinguish variable
+ ;; binding from assignment. (i.e., variable binding, assignment, and use)
+ (case how
+ (:function (list-callers symbol))
+ (:reader (list-readers symbol))
+ (:setter (list-setters symbol))
+ (:variable (append (list-readers symbol)
+ (list-setters symbol)))
+ (otherwise (append (list-callers symbol)
+ (list-readers symbol)
+ (list-setters symbol)))))
+(defun what-files-call (symbol)
+ "Lists names of files that contain uses of SYMBOL
+ as a function, variable, or constant."
+ (callers-list symbol :file))
+(defun list-callees (symbol)
+ "Lists names of functions and variables called by SYMBOL."
+ (callers-list symbol :callees))
+
+(defvar *source-file* (make-hash-table :test #'equal)
+ "Contains function name and source file for that name.")
+(defun source-file (symbol)
+ "Lists the names of files in which SYMBOL is defined/used."
+ (gethash symbol *source-file*))
+(defsetf source-file (name) (value)
+ `(setf (gethash ,name *source-file*) ,value))
+
+(defun clear-tables ()
+ (clrhash *file-callers-database*)
+ (clrhash *callers-database*)
+ (clrhash *callees-database*)
+ (clrhash *readers-database*)
+ (clrhash *setters-database*)
+ (clrhash *source-file*))
+
+
+;;; ********************************
+;;; Pattern Database ***************
+;;; ********************************
+;;; Pattern Types
+(defvar *pattern-caller-type* (make-hash-table :test #'equal))
+(defun pattern-caller-type (name)
+ (gethash name *pattern-caller-type*))
+(defsetf pattern-caller-type (name) (value)
+ `(setf (gethash ,name *pattern-caller-type*) ,value))
+
+;;; Pattern Substitutions
+(defvar *pattern-substitution-table* (make-hash-table :test #'equal)
+ "Stores general patterns for function destructuring.")
+(defun lookup-pattern-substitution (name)
+ (gethash name *pattern-substitution-table*))
+(defmacro define-pattern-substitution (name pattern)
+ "Defines NAME to be equivalent to the specified pattern. Useful for
+ making patterns more readable. For example, the LAMBDA-LIST is
+ defined as a pattern substitution, making the definition of the
+ DEFUN caller-pattern simpler."
+ `(setf (gethash ',name *pattern-substitution-table*)
+ ',pattern))
+
+;;; Function/Macro caller patterns:
+;;; The car of the form is skipped, so we don't need to specify
+;;; (:eq function-name) like we would for a substitution.
+;;;
+;;; Patterns must be defined in the XREF package because the pattern
+;;; language is tested by comparing symbols (using #'equal) and not
+;;; their printreps. This is fine for the lisp grammer, because the XREF
+;;; package depends on the LISP package, so a symbol like 'xref::cons is
+;;; translated automatically into 'lisp::cons. However, since
+;;; (equal 'foo::bar 'baz::bar) returns nil unless both 'foo::bar and
+;;; 'baz::bar are inherited from the same package (e.g., LISP),
+;;; if package handling is turned on the user must specify package
+;;; names in the caller pattern definitions for functions that occur
+;;; in packages other than LISP, otherwise the symbols will not match.
+;;;
+;;; Perhaps we should enforce the definition of caller patterns in the
+;;; XREF package by wrapping the body of define-caller-pattern in
+;;; the XREF package:
+;;; (defmacro define-caller-pattern (name value &optional caller-type)
+;;; (let ((old-package *package*))
+;;; (setf *package* (find-package "XREF"))
+;;; (prog1
+;;; `(progn
+;;; (when ',caller-type
+;;; (setf (pattern-caller-type ',name) ',caller-type))
+;;; (when ',value
+;;; (setf (gethash ',name *caller-pattern-table*)
+;;; ',value)))
+;;; (setf *package* old-package))))
+;;; Either that, or for the purpose of pattern testing we should compare
+;;; printreps. [The latter makes the primitive patterns like VAR
+;;; reserved words.]
+(defvar *caller-pattern-table* (make-hash-table :test #'equal)
+ "Stores patterns for function destructuring.")
+(defun lookup-caller-pattern (name)
+ (gethash name *caller-pattern-table*))
+(defmacro define-caller-pattern (name pattern &optional caller-type)
+ "Defines NAME as a function/macro call with argument structure
+ described by PATTERN. CALLER-TYPE, if specified, assigns a type to
+ the pattern, which may be used to exclude references to NAME while
+ viewing the database. For example, all the Common Lisp definitions
+ have a caller-type of :lisp or :lisp2, so that you can exclude
+ references to common lisp functions from the calling tree."
+ `(progn
+ (when ',caller-type
+ (setf (pattern-caller-type ',name) ',caller-type))
+ (when ',pattern
+ (setf (gethash ',name *caller-pattern-table*)
+ ',pattern))))
+
+;;; For defining variables
+(defmacro define-variable-pattern (name &optional caller-type)
+ "Defines NAME as a variable reference of type CALLER-TYPE. This is
+ mainly used to establish the caller-type of the variable."
+ `(progn
+ (when ',caller-type
+ (setf (pattern-caller-type ',name) ',caller-type))))
+
+;;; For defining synonyms. Means much less space taken up by the patterns.
+(defmacro define-caller-pattern-synonyms (source destinations)
+ "For defining function caller pattern syntax synonyms. For each name
+ in DESTINATIONS, defines its pattern as a copy of the definition of SOURCE.
+ Allows a large number of identical patterns to be defined simultaneously.
+ Must occur after the SOURCE has been defined."
+ `(let ((source-type (pattern-caller-type ',source))
+ (source-pattern (gethash ',source *caller-pattern-table*)))
+ (when source-type
+ (dolist (dest ',destinations)
+ (setf (pattern-caller-type dest) source-type)))
+ (when source-pattern
+ (dolist (dest ',destinations)
+ (setf (gethash dest *caller-pattern-table*)
+ source-pattern)))))
+
+(defun clear-patterns ()
+ (clrhash *pattern-substitution-table*)
+ (clrhash *caller-pattern-table*)
+ (clrhash *pattern-caller-type*))
+
+;;; ********************************
+;;; Cross Reference Files **********
+;;; ********************************
+(defvar *last-form* ()
+ "The last form read from the file. Useful for figuring out what went wrong
+ when xref-file drops into the debugger.")
+
+(defvar *xref-verbose* t
+ "When T, xref-file(s) prints out the names of the files it looks at,
+ progress dots, and the number of forms read.")
+
+;;; This needs to first clear the tables?
+(defun xref-files (&rest files)
+ "Grovels over the lisp code located in source file FILES, using xref-file."
+ ;; If the arg is a list, use it.
+ (when (listp (car files)) (setq files (car files)))
+ (dolist (file files)
+ (xref-file file nil))
+ (values))
+
+(defvar *handle-package-forms* nil ;'(lisp::in-package)
+ "When non-NIL, and XREF-FILE sees a package-setting form like IN-PACKAGE,
+ sets the current package to the specified package by evaluating the
+ form. When done with the file, xref-file resets the package to its
+ original value. In some of the displaying functions, when this variable
+ is non-NIL one may specify that all symbols from a particular set of
+ packages be ignored. This is only useful if the files use different
+ packages with conflicting names.")
+
+(defvar *normal-readtable* (copy-readtable nil)
+ "Normal, unadulterated CL readtable.")
+
+(defun xref-file (filename &optional (clear-tables t) (verbose *xref-verbose*))
+ "Cross references the function and variable calls in FILENAME by
+ walking over the source code located in the file. Defaults type of
+ filename to \".lisp\". Chomps on the code using record-callers and
+ record-callers*. If CLEAR-TABLES is T (the default), it clears the callers
+ database before processing the file. Specify CLEAR-TABLES as nil to
+ append to the database. If VERBOSE is T (the default), prints out the
+ name of the file, one progress dot for each form processed, and the
+ total number of forms."
+ ;; Default type to "lisp"
+ (when (and (null (pathname-type filename))
+ (not (probe-file filename)))
+ (cond ((stringp filename)
+ (setf filename (concatenate 'string filename ".lisp")))
+ ((pathnamep filename)
+ (setf filename (merge-pathnames filename
+ (make-pathname :type "lisp"))))))
+ (when clear-tables (clear-tables))
+ (let ((count 0)
+ (old-package *package*)
+ (*readtable* *normal-readtable*))
+ (when verbose
+ (format t "~&Cross-referencing file ~A.~&" filename))
+ (with-open-file (stream filename :direction :input)
+ (do ((form (read stream nil :eof) (read stream nil :eof)))
+ ((eq form :eof))
+ (incf count)
+ (when verbose
+ (format *standard-output* ".")
+ (force-output *standard-output*))
+ (setq *last-form* form)
+ (record-callers filename form)
+ ;; Package Magic.
+ (when (and *handle-package-forms*
+ (consp form)
+ (member (car form) *handle-package-forms*))
+ (eval form))))
+ (when verbose
+ (format t "~&~D forms processed." count))
+ (setq *package* old-package)
+ (values)))
+
+(defvar *handle-function-forms* t
+ "When T, XREF-FILE tries to be smart about forms which occur in
+ a function position, such as lambdas and arbitrary Lisp forms.
+ If so, it recursively calls record-callers with pattern 'FORM.
+ If the form is a lambda, makes the caller a caller of :unnamed-lambda.")
+
+(defvar *handle-macro-forms* t
+ "When T, if the file was loaded before being processed by XREF, and the
+ car of a form is a macro, it notes that the parent calls the macro,
+ and then calls macroexpand-1 on the form.")
+
+(defvar *callees-database-includes-variables* nil)
+
+(defun record-callers (filename form
+ &optional pattern parent (environment nil)
+ funcall)
+ "RECORD-CALLERS is the main routine used to walk down the code. It matches
+ the PATTERN against the FORM, possibly adding statements to the database.
+ PARENT is the name defined by the current outermost definition; it is
+ the caller of the forms in the body (e.g., FORM). ENVIRONMENT is used
+ to keep track of the scoping of variables. FUNCALL deals with the type
+ of variable assignment and hence how the environment should be modified.
+ RECORD-CALLERS handles atomic patterns and simple list-structure patterns.
+ For complex list-structure pattern destructuring, it calls RECORD-CALLERS*."
+; (when form)
+ (unless pattern (setq pattern 'FORM))
+ (cond ((symbolp pattern)
+ (case pattern
+ (:IGNORE
+ ;; Ignores the rest of the form.
+ (values t parent environment))
+ (NAME
+ ;; This is the name of a new definition.
+ (push filename (source-file form))
+ (values t form environment))
+ ((FUNCTION MACRO)
+ ;; This is the name of a call.
+ (cond ((and *handle-function-forms* (consp form))
+ ;; If we're a cons and special handling is on,
+ (when (eq (car form) 'lambda)
+ (pushnew filename (callers-list :unnamed-lambda :file))
+ (when parent
+ (pushnew parent (callers-list :unnamed-lambda
+ :callers))
+ (pushnew :unnamed-lambda (callers-list parent
+ :callees))))
+ (record-callers filename form 'form parent environment))
+ (t
+ ;; If we're just a regular function name call.
+ (pushnew filename (callers-list form :file))
+ (when parent
+ (pushnew parent (callers-list form :callers))
+ (pushnew form (callers-list parent :callees)))
+ (values t parent environment))))
+ (VAR
+ ;; This is the name of a new variable definition.
+ ;; Includes arglist parameters.
+ (when (and (symbolp form) (not (keywordp form))
+ (not (member form lambda-list-keywords)))
+ (pushnew form (car environment))
+ (pushnew filename (callers-list form :file))
+ (when parent
+; (pushnew form (callers-list parent :callees))
+ (pushnew parent (callers-list form :setters)))
+ (values t parent environment)))
+ (VARIABLE
+ ;; VAR reference
+ (pushnew filename (callers-list form :file))
+ (when (and parent (not (lookup form environment)))
+ (pushnew parent (callers-list form :readers))
+ (when *callees-database-includes-variables*
+ (pushnew form (callers-list parent :callees))))
+ (values t parent environment))
+ (FORM
+ ;; A random form (var or funcall).
+ (cond ((consp form)
+ ;; Get new pattern from TAG.
+ (let ((new-pattern (lookup-caller-pattern (car form))))
+ (pushnew filename (callers-list (car form) :file))
+ (when parent
+ (pushnew parent (callers-list (car form) :callers))
+ (pushnew (car form) (callers-list parent :callees)))
+ (cond ((and new-pattern (cdr form))
+ ;; Special Pattern and there's stuff left
+ ;; to be processed. Note that we check if
+ ;; a pattern is defined for the form before
+ ;; we check to see if we can macroexpand it.
+ (record-callers filename (cdr form) new-pattern
+ parent environment :funcall))
+ ((and *handle-macro-forms*
+ (symbolp (car form)) ; pnorvig 9/9/93
+ (macro-function (car form)))
+ ;; The car of the form is a macro and
+ ;; macro processing is turned on. Macroexpand-1
+ ;; the form and try again.
+ (record-callers filename
+ (macroexpand-1 form)
+ 'form parent environment
+ :funcall))
+ ((null (cdr form))
+ ;; No more left to be processed. Note that
+ ;; this must occur after the macros clause,
+ ;; since macros can expand into more code.
+ (values t parent environment))
+ (t
+ ;; Random Form. We assume it is a function call.
+ (record-callers filename (cdr form)
+ '((:star FORM))
+ parent environment :funcall)))))
+ (t
+ (when (and (not (lookup form environment))
+ (not (numberp form))
+ ;; the following line should probably be
+ ;; commented out?
+ (not (keywordp form))
+ (not (stringp form))
+ (not (eq form t))
+ (not (eq form nil)))
+ (pushnew filename (callers-list form :file))
+ ;; ??? :callers
+ (when parent
+ (pushnew parent (callers-list form :readers))
+ (when *callees-database-includes-variables*
+ (pushnew form (callers-list parent :callees)))))
+ (values t parent environment))))
+ (otherwise
+ ;; Pattern Substitution
+ (let ((new-pattern (lookup-pattern-substitution pattern)))
+ (if new-pattern
+ (record-callers filename form new-pattern
+ parent environment)
+ (when (eq pattern form)
+ (values t parent environment)))))))
+ ((consp pattern)
+ (case (car pattern)
+ (:eq (when (eq (second pattern) form)
+ (values t parent environment)))
+ (:test (when (funcall (eval (second pattern)) form)
+ (values t parent environment)))
+ (:typep (when (typep form (second pattern))
+ (values t parent environment)))
+ (:or (dolist (subpat (rest pattern))
+ (multiple-value-bind (processed parent environment)
+ (record-callers filename form subpat
+ parent environment)
+ (when processed
+ (return (values processed parent environment))))))
+ (:rest ; (:star :plus :optional :rest)
+ (record-callers filename form (second pattern)
+ parent environment))
+ (otherwise
+ (multiple-value-bind (d p env)
+ (record-callers* filename form pattern
+ parent (cons nil environment))
+ (values d p (if funcall environment env))))))))
+
+(defun record-callers* (filename form pattern parent environment
+ &optional continuation
+ in-optionals in-keywords)
+ "RECORD-CALLERS* handles complex list-structure patterns, such as
+ ordered lists of subpatterns, patterns involving :star, :plus,
+ &optional, &key, &rest, and so on. CONTINUATION is a stack of
+ unprocessed patterns, IN-OPTIONALS and IN-KEYWORDS are corresponding
+ stacks which determine whether &rest or &key has been seen yet in
+ the current pattern."
+ ;; form must be a cons or nil.
+; (when form)
+ (if (null pattern)
+ (if (null continuation)
+ (values t parent environment)
+ (record-callers* filename form (car continuation) parent environment
+ (cdr continuation)
+ (cdr in-optionals)
+ (cdr in-keywords)))
+ (let ((pattern-elt (car pattern)))
+ (cond ((car-eq pattern-elt :optional)
+ (if (null form)
+ (values t parent environment)
+ (multiple-value-bind (processed par env)
+ (record-callers* filename form (cdr pattern-elt)
+ parent environment
+ (cons (cdr pattern) continuation)
+ (cons (car in-optionals) in-optionals)
+ (cons (car in-keywords) in-keywords))
+ (if processed
+ (values processed par env)
+ (record-callers* filename form (cdr pattern)
+ parent environment continuation
+ in-optionals in-keywords)))))
+ ((car-eq pattern-elt :star)
+ (if (null form)
+ (values t parent environment)
+ (multiple-value-bind (processed par env)
+ (record-callers* filename form (cdr pattern-elt)
+ parent environment
+ (cons pattern continuation)
+ (cons (car in-optionals) in-optionals)
+ (cons (car in-keywords) in-keywords))
+ (if processed
+ (values processed par env)
+ (record-callers* filename form (cdr pattern)
+ parent environment continuation
+ in-optionals in-keywords)))))
+ ((car-eq pattern-elt :plus)
+ (record-callers* filename form (cdr pattern-elt)
+ parent environment
+ (cons (cons (cons :star (cdr pattern-elt))
+ (cdr pattern))
+ continuation)
+ (cons (car in-optionals) in-optionals)
+ (cons (car in-keywords) in-keywords)))
+ ((car-eq pattern-elt :rest)
+ (record-callers filename form pattern-elt parent environment))
+ ((eq pattern-elt '&optional)
+ (record-callers* filename form (cdr pattern)
+ parent environment continuation
+ (cons t in-optionals)
+ (cons (car in-keywords) in-keywords)))
+ ((eq pattern-elt '&rest)
+ (record-callers filename form (second pattern)
+ parent environment))
+ ((eq pattern-elt '&key)
+ (record-callers* filename form (cdr pattern)
+ parent environment continuation
+ (cons (car in-optionals) in-optionals)
+ (cons t in-keywords)))
+ ((null form)
+ (when (or (car in-keywords) (car in-optionals))
+ (values t parent environment)))
+ ((consp form)
+ (multiple-value-bind (processed parent environment)
+ (record-callers filename (if (car in-keywords)
+ (cadr form)
+ (car form))
+ pattern-elt
+ parent environment)
+ (cond (processed
+ (record-callers* filename (if (car in-keywords)
+ (cddr form)
+ (cdr form))
+ (cdr pattern)
+ parent environment
+ continuation
+ in-optionals in-keywords))
+ ((or (car in-keywords)
+ (car in-optionals))
+ (values t parent environment)))))))))
+
+
+;;; ********************************
+;;; Misc Utilities *****************
+;;; ********************************
+(defvar *types-to-ignore*
+ '(:lisp ; CLtL 1st Edition
+ :lisp2 ; CLtL 2nd Edition additional patterns
+ )
+ "Default set of caller types (as specified in the patterns) to ignore
+ in the database handling functions. :lisp is CLtL 1st edition,
+ :lisp2 is additional patterns from CLtL 2nd edition.")
+
+(defun display-database (&optional (database :callers)
+ (types-to-ignore *types-to-ignore*))
+ "Prints out the name of each symbol and all its callers. Specify database
+ :callers (the default) to get function call references, :fill to the get
+ files in which the symbol is called, :readers to get variable references,
+ and :setters to get variable binding and assignments. Ignores functions
+ of types listed in types-to-ignore."
+ (maphash #'(lambda (name callers)
+ (unless (or (member (pattern-caller-type name)
+ types-to-ignore)
+ ;; When we're doing fancy package crap,
+ ;; allow us to ignore symbols based on their
+ ;; packages.
+ (when *handle-package-forms*
+ (member (symbol-package name)
+ types-to-ignore
+ :key #'find-package)))
+ (format t "~&~S is referenced by~{ ~S~}."
+ name callers)))
+ (ecase database
+ (:file *file-callers-database*)
+ (:callers *callers-database*)
+ (:readers *readers-database*)
+ (:setters *setters-database*))))
+
+(defun write-callers-database-to-file (filename)
+ "Saves the contents of the current callers database to a file. This
+ file can be loaded to restore the previous contents of the
+ database. (For large systems it can take a long time to crunch
+ through the code, so this can save some time.)"
+ (with-open-file (stream filename :direction :output)
+ (format stream "~&(clear-tables)")
+ (maphash #'(lambda (x y)
+ (format stream "~&(setf (source-file '~S) '~S)"
+ x y))
+ *source-file*)
+ (maphash #'(lambda (x y)
+ (format stream "~&(setf (callers-list '~S :file) '~S)"
+ x y))
+ *file-callers-database*)
+ (maphash #'(lambda (x y)
+ (format stream "~&(setf (callers-list '~S :callers) '~S)"
+ x y))
+ *callers-database*)
+ (maphash #'(lambda (x y)
+ (format stream "~&(setf (callers-list '~S :callees) '~S)"
+ x y))
+ *callees-database*)
+ (maphash #'(lambda (x y)
+ (format stream "~&(setf (callers-list '~S :readers) '~S)"
+ x y))
+ *readers-database*)
+ (maphash #'(lambda (x y)
+ (format stream "~&(setf (callers-list '~S :setters) '~S)"
+ x y))
+ *setters-database*)))
+
+
+;;; ********************************
+;;; Print Caller Trees *************
+;;; ********************************
+;;; The following function is useful for reversing a caller table into
+;;; a callee table. Possibly later we'll extend xref to create two
+;;; such database hash tables. Needs to include vars as well.
+(defun invert-hash-table (table &optional (types-to-ignore *types-to-ignore*))
+ "Makes a copy of the hash table in which (name value*) pairs
+ are inverted to (value name*) pairs."
+ (let ((target (make-hash-table :test #'equal)))
+ (maphash #'(lambda (key values)
+ (dolist (value values)
+ (unless (member (pattern-caller-type key)
+ types-to-ignore)
+ (pushnew key (gethash value target)))))
+ table)
+ target))
+
+;;; Resolve file references for automatic creation of a defsystem file.
+(defun determine-file-dependencies (&optional (database *callers-database*))
+ "Makes a hash table of file dependencies for the references listed in
+ DATABASE. This function may be useful for automatically resolving
+ file references for automatic creation of a system definition (defsystem)."
+ (let ((file-ref-ht (make-hash-table :test #'equal)))
+ (maphash #'(lambda (key values)
+ (let ((key-file (source-file key)))
+ (when key
+ (dolist (value values)
+ (let ((value-file (source-file value)))
+ (when value-file
+ (dolist (s key-file)
+ (dolist (d value-file)
+ (pushnew d (gethash s file-ref-ht))))))))))
+ database)
+ file-ref-ht))
+
+(defun print-file-dependencies (&optional (database *callers-database*))
+ "Prints a list of file dependencies for the references listed in DATABASE.
+ This function may be useful for automatically computing file loading
+ constraints for a system definition tool."
+ (maphash #'(lambda (key value) (format t "~&~S --> ~S" key value))
+ (determine-file-dependencies database)))
+
+;;; The following functions demonstrate a possible way to interface
+;;; xref to a graphical browser such as psgraph to mimic the capabilities
+;;; of Masterscope's graphical browser.
+
+(defvar *last-caller-tree* nil)
+
+(defvar *default-graphing-mode* :call-graph
+ "Specifies whether we graph up or down. If :call-graph, the children
+ of a node are the functions it calls. If :caller-graph, the children
+ of a node are the functions that call it.")
+
+(defun gather-tree (parents &optional already-seen
+ (mode *default-graphing-mode*)
+ (types-to-ignore *types-to-ignore*) compact)
+ "Extends the tree, copying it into list structure, until it repeats
+ a reference (hits a cycle)."
+ (let ((*already-seen* nil)
+ (database (case mode
+ (:call-graph *callees-database*)
+ (:caller-graph *callers-database*))))
+ (declare (special *already-seen*))
+ (labels
+ ((amass-tree
+ (parents &optional already-seen)
+ (let (result this-item)
+ (dolist (parent parents)
+ (unless (member (pattern-caller-type parent)
+ types-to-ignore)
+ (pushnew parent *already-seen*)
+ (if (member parent already-seen)
+ (setq this-item nil) ; :ignore
+ (if compact
+ (multiple-value-setq (this-item already-seen)
+ (amass-tree (gethash parent database)
+ (cons parent already-seen)))
+ (setq this-item
+ (amass-tree (gethash parent database)
+ (cons parent already-seen)))))
+ (setq parent (format nil "~S" parent))
+ (when (consp parent) (setq parent (cons :xref-list parent)))
+ (unless (eq this-item :ignore)
+ (push (if this-item
+ (list parent this-item)
+ parent)
+ result))))
+ (values result ;(reverse result)
+ already-seen))))
+ (values (amass-tree parents already-seen)
+ *already-seen*))))
+
+(defun find-roots-and-cycles (&optional (mode *default-graphing-mode*)
+ (types-to-ignore *types-to-ignore*))
+ "Returns a list of uncalled callers (roots) and called callers (potential
+ cycles)."
+ (let ((uncalled-callers nil)
+ (called-callers nil)
+ (database (ecase mode
+ (:call-graph *callers-database*)
+ (:caller-graph *callees-database*)))
+ (other-database (ecase mode
+ (:call-graph *callees-database*)
+ (:caller-graph *callers-database*))))
+ (maphash #'(lambda (name value)
+ (declare (ignore value))
+ (unless (member (pattern-caller-type name)
+ types-to-ignore)
+ (if (gethash name database)
+ (push name called-callers)
+ (push name uncalled-callers))))
+ other-database)
+ (values uncalled-callers called-callers)))
+
+(defun make-caller-tree (&optional (mode *default-graphing-mode*)
+ (types-to-ignore *types-to-ignore*) compact)
+ "Outputs list structure of a tree which roughly represents the possibly
+ cyclical structure of the caller database.
+ If mode is :call-graph, the children of a node are the functions it calls.
+ If mode is :caller-graph, the children of a node are the functions that
+ call it.
+ If compact is T, tries to eliminate the already-seen nodes, so that
+ the graph for a node is printed at most once. Otherwise it will duplicate
+ the node's tree (except for cycles). This is usefull because the call tree
+ is actually a directed graph, so we can either duplicate references or
+ display only the first one."
+ ;; Would be nice to print out line numbers and whenever we skip a duplicated
+ ;; reference, print the line number of the full reference after the node.
+ (multiple-value-bind (uncalled-callers called-callers)
+ (find-roots-and-cycles mode types-to-ignore)
+ (multiple-value-bind (trees already-seen)
+ (gather-tree uncalled-callers nil mode types-to-ignore compact)
+ (setq *last-caller-tree* trees)
+ (let ((more-trees (gather-tree (set-difference called-callers
+ already-seen)
+ already-seen
+ mode types-to-ignore compact)))
+ (values trees more-trees)))))
+
+(defvar *indent-amount* 3
+ "Number of spaces to indent successive levels in PRINT-INDENTED-TREE.")
+
+(defun print-indented-tree (trees &optional (indent 0))
+ "Simple code to print out a list-structure tree (such as those created
+ by make-caller-tree) as indented text."
+ (when trees
+ (dolist (tree trees)
+ (cond ((and (listp tree) (eq (car tree) :xref-list))
+ (format t "~&~VT~A" indent (cdr tree)))
+ ((listp tree)
+ (format t "~&~VT~A" indent (car tree))
+ (print-indented-tree (cadr tree) (+ indent *indent-amount*)))
+ (t
+ (format t "~&~VT~A" indent tree))))))
+
+(defun print-caller-trees (&key (mode *default-graphing-mode*)
+ (types-to-ignore *types-to-ignore*)
+ compact
+ root-nodes)
+ "Prints the calling trees (which may actually be a full graph and not
+ necessarily a DAG) as indented text trees using PRINT-INDENTED-TREE.
+ MODE is :call-graph for trees where the children of a node are the
+ functions called by the node, or :caller-graph for trees where the
+ children of a node are the functions the node calls. TYPES-TO-IGNORE
+ is a list of funcall types (as specified in the patterns) to ignore
+ in printing out the database. For example, '(:lisp) would ignore all
+ calls to common lisp functions. COMPACT is a flag to tell the program
+ to try to compact the trees a bit by not printing trees if they have
+ already been seen. ROOT-NODES is a list of root nodes of trees to
+ display. If ROOT-NODES is nil, tries to find all root nodes in the
+ database."
+ (multiple-value-bind (rooted cycles)
+ (if root-nodes
+ (values (gather-tree root-nodes nil mode types-to-ignore compact))
+ (make-caller-tree mode types-to-ignore compact))
+ (when rooted
+ (format t "~&Rooted calling trees:")
+ (print-indented-tree rooted 2))
+ (when cycles
+ (when rooted
+ (format t "~2%"))
+ (format t "~&Cyclic calling trees:")
+ (print-indented-tree cycles 2))))
+
+
+;;; ********************************
+;;; Interface to PSGraph ***********
+;;; ********************************
+#|
+;;; Interface to Bates' PostScript Graphing Utility
+(load "/afs/cs/user/mkant/Lisp/PSGraph/psgraph")
+
+(defparameter *postscript-output-directory* "")
+(defun psgraph-xref (&key (mode *default-graphing-mode*)
+ (output-directory *postscript-output-directory*)
+ (types-to-ignore *types-to-ignore*)
+ (compact t)
+ (shrink t)
+ root-nodes
+ insert)
+ ;; If root-nodes is a non-nil list, uses that list as the starting
+ ;; position. Otherwise tries to find all roots in the database.
+ (multiple-value-bind (rooted cycles)
+ (if root-nodes
+ (values (gather-tree root-nodes nil mode types-to-ignore compact))
+ (make-caller-tree mode types-to-ignore compact))
+ (psgraph-output (append rooted cycles) output-directory shrink insert)))
+
+(defun psgraph-output (list-of-trees directory shrink &optional insert)
+ (let ((psgraph:*fontsize* 9)
+ (psgraph:*second-fontsize* 7)
+; (psgraph:*boxkind* "fill")
+ (psgraph:*boxgray* "0") ; .8
+ (psgraph:*edgewidth* "1")
+ (psgraph:*edgegray* "0"))
+ (labels ((stringify (thing)
+ (cond ((stringp thing) (string-downcase thing))
+ ((symbolp thing) (string-downcase (symbol-name thing)))
+ ((and (listp thing) (eq (car thing) :xref-list))
+ (stringify (cdr thing)))
+ ((listp thing) (stringify (car thing)))
+ (t (string thing)))))
+ (dolist (item list-of-trees)
+ (let* ((fname (stringify item))
+ (filename (concatenate 'string directory
+ (string-trim '(#\: #\|) fname)
+ ".ps")))
+ (format t "~&Creating PostScript file ~S." filename)
+ (with-open-file (*standard-output* filename
+ :direction :output
+ :if-does-not-exist :create
+ :if-exists :supersede)
+ ;; Note that the #'eq prints the DAG as a tree. If
+ ;; you replace it with #'equal, it will print it as
+ ;; a DAG, which I think is slightly ugly.
+ (psgraph:psgraph item
+ #'caller-tree-children #'caller-info shrink
+ insert #'eq)))))))
+
+(defun caller-tree-children (tree)
+ (when (and tree (listp tree) (not (eq (car tree) :xref-list)))
+ (cadr tree)))
+
+(defun caller-tree-node (tree)
+ (when tree
+ (cond ((and (listp tree) (eq (car tree) :xref-list))
+ (cdr tree))
+ ((listp tree)
+ (car tree))
+ (t
+ tree))))
+
+(defun caller-info (tree)
+ (let ((node (caller-tree-node tree)))
+ (list node)))
+|#
+#|
+;;; Code to print out graphical trees of CLOS class hierarchies.
+(defun print-class-hierarchy (&optional (start-class 'anything)
+ (file "classes.ps"))
+ (let ((start (find-class start-class)))
+ (when start
+ (with-open-file (*standard-output* file :direction :output)
+ (psgraph:psgraph start
+ #'clos::class-direct-subclasses
+ #'(lambda (x)
+ (list (format nil "~A" (clos::class-name x))))
+ t nil #'eq)))))
+
+|#
+
+
+;;; ****************************************************************
+;;; Cross Referencing Patterns for Common Lisp *********************
+;;; ****************************************************************
+(clear-patterns)
+
+;;; ********************************
+;;; Pattern Substitutions **********
+;;; ********************************
+(define-pattern-substitution integer (:test #'integerp))
+(define-pattern-substitution rational (:test #'rationalp))
+(define-pattern-substitution symbol (:test #'symbolp))
+(define-pattern-substitution string (:test #'stringp))
+(define-pattern-substitution number (:test #'numberp))
+(define-pattern-substitution lambda-list
+ ((:star var)
+ (:optional (:eq &optional)
+ (:star (:or var
+ (var (:optional form (:optional var))))))
+ (:optional (:eq &rest) var)
+ (:optional (:eq &key) (:star (:or var
+ ((:or var
+ (keyword var))
+ (:optional form (:optional var)))))
+ (:optional &allow-other-keys))
+ (:optional (:eq &aux)
+ (:star (:or var
+ (var (:optional form)))))))
+(define-pattern-substitution test form)
+(define-pattern-substitution body
+ ((:star (:or declaration documentation-string))
+ (:star form)))
+(define-pattern-substitution documentation-string string)
+(define-pattern-substitution initial-value form)
+(define-pattern-substitution tag symbol)
+(define-pattern-substitution declaration ((:eq declare)(:rest :ignore)))
+(define-pattern-substitution destination form)
+(define-pattern-substitution control-string string)
+(define-pattern-substitution format-arguments
+ ((:star form)))
+(define-pattern-substitution fn
+ (:or ((:eq quote) function)
+ ((:eq function) function)
+ function))
+
+;;; ********************************
+;;; Caller Patterns ****************
+;;; ********************************
+
+;;; Types Related
+(define-caller-pattern coerce (form :ignore) :lisp)
+(define-caller-pattern type-of (form) :lisp)
+(define-caller-pattern upgraded-array-element-type (:ignore) :lisp2)
+(define-caller-pattern upgraded-complex-part-type (:ignore) :lisp2)
+
+;;; Lambdas and Definitions
+(define-variable-pattern lambda-list-keywords :lisp)
+(define-variable-pattern lambda-parameters-limit :lisp)
+(define-caller-pattern lambda (lambda-list (:rest body)) :lisp)
+
+(define-caller-pattern defun
+ (name lambda-list
+ (:star (:or documentation-string declaration))
+ (:star form))
+ :lisp)
+
+;;; perhaps this should use VAR, instead of NAME
+(define-caller-pattern defvar
+ (var (:optional initial-value (:optional documentation-string)))
+ :lisp)
+(define-caller-pattern defparameter
+ (var initial-value (:optional documentation-string))
+ :lisp)
+(define-caller-pattern defconstant
+ (var initial-value (:optional documentation-string))
+ :lisp)
+
+(define-caller-pattern eval-when
+ (:ignore ; the situations
+ (:star form))
+ :lisp)
+
+;;; Logical Values
+(define-variable-pattern nil :lisp)
+(define-variable-pattern t :lisp)
+
+;;; Predicates
+(define-caller-pattern typep (form form) :lisp)
+(define-caller-pattern subtypep (form form) :lisp)
+
+(define-caller-pattern null (form) :lisp)
+(define-caller-pattern symbolp (form) :lisp)
+(define-caller-pattern atom (form) :lisp)
+(define-caller-pattern consp (form) :lisp)
+(define-caller-pattern listp (form) :lisp)
+(define-caller-pattern numberp (form) :lisp)
+(define-caller-pattern integerp (form) :lisp)
+(define-caller-pattern rationalp (form) :lisp)
+(define-caller-pattern floatp (form) :lisp)
+(define-caller-pattern realp (form) :lisp2)
+(define-caller-pattern complexp (form) :lisp)
+(define-caller-pattern characterp (form) :lisp)
+(define-caller-pattern stringp (form) :lisp)
+(define-caller-pattern bit-vector-p (form) :lisp)
+(define-caller-pattern vectorp (form) :lisp)
+(define-caller-pattern simple-vector-p (form) :lisp)
+(define-caller-pattern simple-string-p (form) :lisp)
+(define-caller-pattern simple-bit-vector-p (form) :lisp)
+(define-caller-pattern arrayp (form) :lisp)
+(define-caller-pattern packagep (form) :lisp)
+(define-caller-pattern functionp (form) :lisp)
+(define-caller-pattern compiled-function-p (form) :lisp)
+(define-caller-pattern commonp (form) :lisp)
+
+;;; Equality Predicates
+(define-caller-pattern eq (form form) :lisp)
+(define-caller-pattern eql (form form) :lisp)
+(define-caller-pattern equal (form form) :lisp)
+(define-caller-pattern equalp (form form) :lisp)
+
+;;; Logical Operators
+(define-caller-pattern not (form) :lisp)
+(define-caller-pattern or ((:star form)) :lisp)
+(define-caller-pattern and ((:star form)) :lisp)
+
+;;; Reference
+
+;;; Quote is a problem. In Defmacro & friends, we'd like to actually
+;;; look at the argument, 'cause it hides internal function calls
+;;; of the defmacro.
+(define-caller-pattern quote (:ignore) :lisp)
+
+(define-caller-pattern function ((:or fn form)) :lisp)
+(define-caller-pattern symbol-value (form) :lisp)
+(define-caller-pattern symbol-function (form) :lisp)
+(define-caller-pattern fdefinition (form) :lisp2)
+(define-caller-pattern boundp (form) :lisp)
+(define-caller-pattern fboundp (form) :lisp)
+(define-caller-pattern special-form-p (form) :lisp)
+
+;;; Assignment
+(define-caller-pattern setq ((:star var form)) :lisp)
+(define-caller-pattern psetq ((:star var form)) :lisp)
+(define-caller-pattern set (form form) :lisp)
+(define-caller-pattern makunbound (form) :lisp)
+(define-caller-pattern fmakunbound (form) :lisp)
+
+;;; Generalized Variables
+(define-caller-pattern setf ((:star form form)) :lisp)
+(define-caller-pattern psetf ((:star form form)) :lisp)
+(define-caller-pattern shiftf ((:plus form) form) :lisp)
+(define-caller-pattern rotatef ((:star form)) :lisp)
+(define-caller-pattern define-modify-macro
+ (name
+ lambda-list
+ fn
+ (:optional documentation-string))
+ :lisp)
+(define-caller-pattern defsetf
+ (:or (name name (:optional documentation-string))
+ (name lambda-list (var)
+ (:star (:or declaration documentation-string))
+ (:star form)))
+ :lisp)
+(define-caller-pattern define-setf-method
+ (name lambda-list
+ (:star (:or declaration documentation-string))
+ (:star form))
+ :lisp)
+(define-caller-pattern get-setf-method (form) :lisp)
+(define-caller-pattern get-setf-method-multiple-value (form) :lisp)
+
+
+;;; Function invocation
+(define-caller-pattern apply (fn form (:star form)) :lisp)
+(define-caller-pattern funcall (fn (:star form)) :lisp)
+
+
+;;; Simple sequencing
+(define-caller-pattern progn ((:star form)) :lisp)
+(define-caller-pattern prog1 (form (:star form)) :lisp)
+(define-caller-pattern prog2 (form form (:star form)) :lisp)
+
+;;; Variable bindings
+(define-caller-pattern let
+ (((:star (:or var (var &optional form))))
+ (:star declaration)
+ (:star form))
+ :lisp)
+(define-caller-pattern let*
+ (((:star (:or var (var &optional form))))
+ (:star declaration)
+ (:star form))
+ :lisp)
+(define-caller-pattern compiler-let
+ (((:star (:or var (var form))))
+ (:star form))
+ :lisp)
+(define-caller-pattern progv
+ (form form (:star form)) :lisp)
+(define-caller-pattern flet
+ (((:star (name lambda-list
+ (:star (:or declaration
+ documentation-string))
+ (:star form))))
+ (:star form))
+ :lisp)
+(define-caller-pattern labels
+ (((:star (name lambda-list
+ (:star (:or declaration
+ documentation-string))
+ (:star form))))
+ (:star form))
+ :lisp)
+(define-caller-pattern macrolet
+ (((:star (name lambda-list
+ (:star (:or declaration
+ documentation-string))
+ (:star form))))
+ (:star form))
+ :lisp)
+(define-caller-pattern symbol-macrolet
+ (((:star (var form))) (:star declaration) (:star form))
+ :lisp2)
+
+;;; Conditionals
+(define-caller-pattern if (test form (:optional form)) :lisp)
+(define-caller-pattern when (test (:star form)) :lisp)
+(define-caller-pattern unless (test (:star form)) :lisp)
+(define-caller-pattern cond ((:star (test (:star form)))) :lisp)
+(define-caller-pattern case
+ (form
+ (:star ((:or symbol
+ ((:star symbol)))
+ (:star form))))
+ :lisp)
+(define-caller-pattern typecase (form (:star (symbol (:star form))))
+ :lisp)
+
+;;; Blocks and Exits
+(define-caller-pattern block (name (:star form)) :lisp)
+(define-caller-pattern return-from (function (:optional form)) :lisp)
+(define-caller-pattern return ((:optional form)) :lisp)
+
+;;; Iteration
+(define-caller-pattern loop ((:star form)) :lisp)
+(define-caller-pattern do
+ (((:star (:or var
+ (var (:optional form (:optional form)))))) ; init step
+ (form (:star form)) ; end-test result
+ (:star declaration)
+ (:star (:or tag form))) ; statement
+ :lisp)
+(define-caller-pattern do*
+ (((:star (:or var
+ (var (:optional form (:optional form))))))
+ (form (:star form))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern dolist
+ ((var form (:optional form))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern dotimes
+ ((var form (:optional form))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+
+;;; Mapping
+(define-caller-pattern mapcar (fn form (:star form)) :lisp)
+(define-caller-pattern maplist (fn form (:star form)) :lisp)
+(define-caller-pattern mapc (fn form (:star form)) :lisp)
+(define-caller-pattern mapl (fn form (:star form)) :lisp)
+(define-caller-pattern mapcan (fn form (:star form)) :lisp)
+(define-caller-pattern mapcon (fn form (:star form)) :lisp)
+
+;;; The "Program Feature"
+(define-caller-pattern tagbody ((:star (:or tag form))) :lisp)
+(define-caller-pattern prog
+ (((:star (:or var (var (:optional form)))))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern prog*
+ (((:star (:or var (var (:optional form)))))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern go (tag) :lisp)
+
+;;; Multiple Values
+(define-caller-pattern values ((:star form)) :lisp)
+(define-variable-pattern multiple-values-limit :lisp)
+(define-caller-pattern values-list (form) :lisp)
+(define-caller-pattern multiple-value-list (form) :lisp)
+(define-caller-pattern multiple-value-call (fn (:star form)) :lisp)
+(define-caller-pattern multiple-value-prog1 (form (:star form)) :lisp)
+(define-caller-pattern multiple-value-bind
+ (((:star var)) form
+ (:star declaration)
+ (:star form))
+ :lisp)
+(define-caller-pattern multiple-value-setq (((:star var)) form) :lisp)
+(define-caller-pattern nth-value (form form) :lisp2)
+
+;;; Dynamic Non-Local Exits
+(define-caller-pattern catch (tag (:star form)) :lisp)
+(define-caller-pattern throw (tag form) :lisp)
+(define-caller-pattern unwind-protect (form (:star form)) :lisp)
+
+;;; Macros
+(define-caller-pattern macro-function (form) :lisp)
+(define-caller-pattern defmacro
+ (name
+ lambda-list
+ (:star (:or declaration documentation-string))
+ (:star form))
+ :lisp)
+(define-caller-pattern macroexpand (form (:optional :ignore)) :lisp)
+(define-caller-pattern macroexpand-1 (form (:optional :ignore)) :lisp)
+(define-variable-pattern *macroexpand-hook* :lisp)
+
+;;; Destructuring
+(define-caller-pattern destructuring-bind
+ (lambda-list form
+ (:star declaration)
+ (:star form))
+ :lisp2)
+
+;;; Compiler Macros
+(define-caller-pattern define-compiler-macro
+ (name lambda-list
+ (:star (:or declaration documentation-string))
+ (:star form))
+ :lisp2)
+(define-caller-pattern compiler-macro-function (form) :lisp2)
+(define-caller-pattern compiler-macroexpand (form (:optional :ignore)) :lisp2)
+(define-caller-pattern compiler-macroexpand-1 (form (:optional :ignore))
+ :lisp2)
+
+;;; Environments
+(define-caller-pattern variable-information (form &optional :ignore)
+ :lisp2)
+(define-caller-pattern function-information (fn &optional :ignore) :lisp2)
+(define-caller-pattern declaration-information (form &optional :ignore) :lisp2)
+(define-caller-pattern augment-environment (form &key (:star :ignore)) :lisp2)
+(define-caller-pattern define-declaration
+ (name
+ lambda-list
+ (:star form))
+ :lisp2)
+(define-caller-pattern parse-macro (name lambda-list form) :lisp2)
+(define-caller-pattern enclose (form &optional :ignore) :lisp2)
+
+
+;;; Declarations
+(define-caller-pattern declare ((:rest :ignore)) :lisp)
+(define-caller-pattern proclaim ((:rest :ignore)) :lisp)
+(define-caller-pattern locally ((:star declaration) (:star form)) :lisp)
+(define-caller-pattern declaim ((:rest :ignore)) :lisp2)
+(define-caller-pattern the (form form) :lisp)
+
+;;; Symbols
+(define-caller-pattern get (form form (:optional form)) :lisp)
+(define-caller-pattern remprop (form form) :lisp)
+(define-caller-pattern symbol-plist (form) :lisp)
+(define-caller-pattern getf (form form (:optional form)) :lisp)
+(define-caller-pattern remf (form form) :lisp)
+(define-caller-pattern get-properties (form form) :lisp)
+
+(define-caller-pattern symbol-name (form) :lisp)
+(define-caller-pattern make-symbol (form) :lisp)
+(define-caller-pattern copy-symbol (form (:optional :ignore)) :lisp)
+(define-caller-pattern gensym ((:optional :ignore)) :lisp)
+(define-variable-pattern *gensym-counter* :lisp2)
+(define-caller-pattern gentemp ((:optional :ignore :ignore)) :lisp)
+(define-caller-pattern symbol-package (form) :lisp)
+(define-caller-pattern keywordp (form) :lisp)
+
+;;; Packages
+(define-variable-pattern *package* :lisp)
+(define-caller-pattern make-package ((:rest :ignore)) :lisp)
+(define-caller-pattern in-package ((:rest :ignore)) :lisp)
+(define-caller-pattern find-package ((:rest :ignore)) :lisp)
+(define-caller-pattern package-name ((:rest :ignore)) :lisp)
+(define-caller-pattern package-nicknames ((:rest :ignore)) :lisp)
+(define-caller-pattern rename-package ((:rest :ignore)) :lisp)
+(define-caller-pattern package-use-list ((:rest :ignore)) :lisp)
+(define-caller-pattern package-used-by-list ((:rest :ignore)) :lisp)
+(define-caller-pattern package-shadowing-symbols ((:rest :ignore)) :lisp)
+(define-caller-pattern list-all-packages () :lisp)
+(define-caller-pattern delete-package ((:rest :ignore)) :lisp2)
+(define-caller-pattern intern (form &optional :ignore) :lisp)
+(define-caller-pattern find-symbol (form &optional :ignore) :lisp)
+(define-caller-pattern unintern (form &optional :ignore) :lisp)
+
+(define-caller-pattern export ((:or symbol ((:star symbol)))
+ &optional :ignore) :lisp)
+(define-caller-pattern unexport ((:or symbol ((:star symbol)))
+ &optional :ignore) :lisp)
+(define-caller-pattern import ((:or symbol ((:star symbol)))
+ &optional :ignore) :lisp)
+(define-caller-pattern shadowing-import ((:or symbol ((:star symbol)))
+ &optional :ignore) :lisp)
+(define-caller-pattern shadow ((:or symbol ((:star symbol)))
+ &optional :ignore) :lisp)
+
+(define-caller-pattern use-package ((:rest :ignore)) :lisp)
+(define-caller-pattern unuse-package ((:rest :ignore)) :lisp)
+(define-caller-pattern defpackage (name (:rest :ignore)) :lisp2)
+(define-caller-pattern find-all-symbols (form) :lisp)
+(define-caller-pattern do-symbols
+ ((var (:optional form (:optional form)))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern do-external-symbols
+ ((var (:optional form (:optional form)))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern do-all-symbols
+ ((var (:optional form))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern with-package-iterator
+ ((name form (:plus :ignore))
+ (:star form))
+ :lisp2)
+
+;;; Modules
+(define-variable-pattern *modules* :lisp)
+(define-caller-pattern provide (form) :lisp)
+(define-caller-pattern require (form &optional :ignore) :lisp)
+
+
+;;; Numbers
+(define-caller-pattern zerop (form) :lisp)
+(define-caller-pattern plusp (form) :lisp)
+(define-caller-pattern minusp (form) :lisp)
+(define-caller-pattern oddp (form) :lisp)
+(define-caller-pattern evenp (form) :lisp)
+
+(define-caller-pattern = (form (:star form)) :lisp)
+(define-caller-pattern /= (form (:star form)) :lisp)
+(define-caller-pattern > (form (:star form)) :lisp)
+(define-caller-pattern < (form (:star form)) :lisp)
+(define-caller-pattern <= (form (:star form)) :lisp)
+(define-caller-pattern >= (form (:star form)) :lisp)
+
+(define-caller-pattern max (form (:star form)) :lisp)
+(define-caller-pattern min (form (:star form)) :lisp)
+
+(define-caller-pattern - (form (:star form)) :lisp)
+(define-caller-pattern + (form (:star form)) :lisp)
+(define-caller-pattern * (form (:star form)) :lisp)
+(define-caller-pattern / (form (:star form)) :lisp)
+(define-caller-pattern 1+ (form) :lisp)
+(define-caller-pattern 1- (form) :lisp)
+
+(define-caller-pattern incf (form form) :lisp)
+(define-caller-pattern decf (form form) :lisp)
+
+(define-caller-pattern conjugate (form) :lisp)
+
+(define-caller-pattern gcd ((:star form)) :lisp)
+(define-caller-pattern lcm ((:star form)) :lisp)
+
+(define-caller-pattern exp (form) :lisp)
+(define-caller-pattern expt (form form) :lisp)
+(define-caller-pattern log (form (:optional form)) :lisp)
+(define-caller-pattern sqrt (form) :lisp)
+(define-caller-pattern isqrt (form) :lisp)
+
+(define-caller-pattern abs (form) :lisp)
+(define-caller-pattern phase (form) :lisp)
+(define-caller-pattern signum (form) :lisp)
+(define-caller-pattern sin (form) :lisp)
+(define-caller-pattern cos (form) :lisp)
+(define-caller-pattern tan (form) :lisp)
+(define-caller-pattern cis (form) :lisp)
+(define-caller-pattern asin (form) :lisp)
+(define-caller-pattern acos (form) :lisp)
+(define-caller-pattern atan (form &optional form) :lisp)
+(define-variable-pattern pi :lisp)
+
+(define-caller-pattern sinh (form) :lisp)
+(define-caller-pattern cosh (form) :lisp)
+(define-caller-pattern tanh (form) :lisp)
+(define-caller-pattern asinh (form) :lisp)
+(define-caller-pattern acosh (form) :lisp)
+(define-caller-pattern atanh (form) :lisp)
+
+;;; Type Conversions and Extractions
+(define-caller-pattern float (form (:optional form)) :lisp)
+(define-caller-pattern rational (form) :lisp)
+(define-caller-pattern rationalize (form) :lisp)
+(define-caller-pattern numerator (form) :lisp)
+(define-caller-pattern denominator (form) :lisp)
+
+(define-caller-pattern floor (form (:optional form)) :lisp)
+(define-caller-pattern ceiling (form (:optional form)) :lisp)
+(define-caller-pattern truncate (form (:optional form)) :lisp)
+(define-caller-pattern round (form (:optional form)) :lisp)
+
+(define-caller-pattern mod (form form) :lisp)
+(define-caller-pattern rem (form form) :lisp)
+
+(define-caller-pattern ffloor (form (:optional form)) :lisp)
+(define-caller-pattern fceiling (form (:optional form)) :lisp)
+(define-caller-pattern ftruncate (form (:optional form)) :lisp)
+(define-caller-pattern fround (form (:optional form)) :lisp)
+
+(define-caller-pattern decode-float (form) :lisp)
+(define-caller-pattern scale-float (form form) :lisp)
+(define-caller-pattern float-radix (form) :lisp)
+(define-caller-pattern float-sign (form (:optional form)) :lisp)
+(define-caller-pattern float-digits (form) :lisp)
+(define-caller-pattern float-precision (form) :lisp)
+(define-caller-pattern integer-decode-float (form) :lisp)
+
+(define-caller-pattern complex (form (:optional form)) :lisp)
+(define-caller-pattern realpart (form) :lisp)
+(define-caller-pattern imagpart (form) :lisp)
+
+(define-caller-pattern logior ((:star form)) :lisp)
+(define-caller-pattern logxor ((:star form)) :lisp)
+(define-caller-pattern logand ((:star form)) :lisp)
+(define-caller-pattern logeqv ((:star form)) :lisp)
+
+(define-caller-pattern lognand (form form) :lisp)
+(define-caller-pattern lognor (form form) :lisp)
+(define-caller-pattern logandc1 (form form) :lisp)
+(define-caller-pattern logandc2 (form form) :lisp)
+(define-caller-pattern logorc1 (form form) :lisp)
+(define-caller-pattern logorc2 (form form) :lisp)
+
+(define-caller-pattern boole (form form form) :lisp)
+(define-variable-pattern boole-clr :lisp)
+(define-variable-pattern boole-set :lisp)
+(define-variable-pattern boole-1 :lisp)
+(define-variable-pattern boole-2 :lisp)
+(define-variable-pattern boole-c1 :lisp)
+(define-variable-pattern boole-c2 :lisp)
+(define-variable-pattern boole-and :lisp)
+(define-variable-pattern boole-ior :lisp)
+(define-variable-pattern boole-xor :lisp)
+(define-variable-pattern boole-eqv :lisp)
+(define-variable-pattern boole-nand :lisp)
+(define-variable-pattern boole-nor :lisp)
+(define-variable-pattern boole-andc1 :lisp)
+(define-variable-pattern boole-andc2 :lisp)
+(define-variable-pattern boole-orc1 :lisp)
+(define-variable-pattern boole-orc2 :lisp)
+
+(define-caller-pattern lognot (form) :lisp)
+(define-caller-pattern logtest (form form) :lisp)
+(define-caller-pattern logbitp (form form) :lisp)
+(define-caller-pattern ash (form form) :lisp)
+(define-caller-pattern logcount (form) :lisp)
+(define-caller-pattern integer-length (form) :lisp)
+
+(define-caller-pattern byte (form form) :lisp)
+(define-caller-pattern byte-size (form) :lisp)
+(define-caller-pattern byte-position (form) :lisp)
+(define-caller-pattern ldb (form form) :lisp)
+(define-caller-pattern ldb-test (form form) :lisp)
+(define-caller-pattern mask-field (form form) :lisp)
+(define-caller-pattern dpb (form form form) :lisp)
+(define-caller-pattern deposit-field (form form form) :lisp)
+
+;;; Random Numbers
+(define-caller-pattern random (form (:optional form)) :lisp)
+(define-variable-pattern *random-state* :lisp)
+(define-caller-pattern make-random-state ((:optional form)) :lisp)
+(define-caller-pattern random-state-p (form) :lisp)
+
+;;; Implementation Parameters
+(define-variable-pattern most-positive-fixnum :lisp)
+(define-variable-pattern most-negative-fixnum :lisp)
+(define-variable-pattern most-positive-short-float :lisp)
+(define-variable-pattern least-positive-short-float :lisp)
+(define-variable-pattern least-negative-short-float :lisp)
+(define-variable-pattern most-negative-short-float :lisp)
+(define-variable-pattern most-positive-single-float :lisp)
+(define-variable-pattern least-positive-single-float :lisp)
+(define-variable-pattern least-negative-single-float :lisp)
+(define-variable-pattern most-negative-single-float :lisp)
+(define-variable-pattern most-positive-double-float :lisp)
+(define-variable-pattern least-positive-double-float :lisp)
+(define-variable-pattern least-negative-double-float :lisp)
+(define-variable-pattern most-negative-double-float :lisp)
+(define-variable-pattern most-positive-long-float :lisp)
+(define-variable-pattern least-positive-long-float :lisp)
+(define-variable-pattern least-negative-long-float :lisp)
+(define-variable-pattern most-negative-long-float :lisp)
+(define-variable-pattern least-positive-normalized-short-float :lisp2)
+(define-variable-pattern least-negative-normalized-short-float :lisp2)
+(define-variable-pattern least-positive-normalized-single-float :lisp2)
+(define-variable-pattern least-negative-normalized-single-float :lisp2)
+(define-variable-pattern least-positive-normalized-double-float :lisp2)
+(define-variable-pattern least-negative-normalized-double-float :lisp2)
+(define-variable-pattern least-positive-normalized-long-float :lisp2)
+(define-variable-pattern least-negative-normalized-long-float :lisp2)
+(define-variable-pattern short-float-epsilon :lisp)
+(define-variable-pattern single-float-epsilon :lisp)
+(define-variable-pattern double-float-epsilon :lisp)
+(define-variable-pattern long-float-epsilon :lisp)
+(define-variable-pattern short-float-negative-epsilon :lisp)
+(define-variable-pattern single-float-negative-epsilon :lisp)
+(define-variable-pattern double-float-negative-epsilon :lisp)
+(define-variable-pattern long-float-negative-epsilon :lisp)
+
+;;; Characters
+(define-variable-pattern char-code-limit :lisp)
+(define-variable-pattern char-font-limit :lisp)
+(define-variable-pattern char-bits-limit :lisp)
+(define-caller-pattern standard-char-p (form) :lisp)
+(define-caller-pattern graphic-char-p (form) :lisp)
+(define-caller-pattern string-char-p (form) :lisp)
+(define-caller-pattern alpha-char-p (form) :lisp)
+(define-caller-pattern upper-case-p (form) :lisp)
+(define-caller-pattern lower-case-p (form) :lisp)
+(define-caller-pattern both-case-p (form) :lisp)
+(define-caller-pattern digit-char-p (form (:optional form)) :lisp)
+(define-caller-pattern alphanumericp (form) :lisp)
+
+(define-caller-pattern char= ((:star form)) :lisp)
+(define-caller-pattern char/= ((:star form)) :lisp)
+(define-caller-pattern char< ((:star form)) :lisp)
+(define-caller-pattern char> ((:star form)) :lisp)
+(define-caller-pattern char<= ((:star form)) :lisp)
+(define-caller-pattern char>= ((:star form)) :lisp)
+
+(define-caller-pattern char-equal ((:star form)) :lisp)
+(define-caller-pattern char-not-equal ((:star form)) :lisp)
+(define-caller-pattern char-lessp ((:star form)) :lisp)
+(define-caller-pattern char-greaterp ((:star form)) :lisp)
+(define-caller-pattern char-not-greaterp ((:star form)) :lisp)
+(define-caller-pattern char-not-lessp ((:star form)) :lisp)
+
+(define-caller-pattern char-code (form) :lisp)
+(define-caller-pattern char-bits (form) :lisp)
+(define-caller-pattern char-font (form) :lisp)
+(define-caller-pattern code-char (form (:optional form form)) :lisp)
+(define-caller-pattern make-char (form (:optional form form)) :lisp)
+(define-caller-pattern characterp (form) :lisp)
+(define-caller-pattern char-upcase (form) :lisp)
+(define-caller-pattern char-downcase (form) :lisp)
+(define-caller-pattern digit-char (form (:optional form form)) :lisp)
+(define-caller-pattern char-int (form) :lisp)
+(define-caller-pattern int-char (form) :lisp)
+(define-caller-pattern char-name (form) :lisp)
+(define-caller-pattern name-char (form) :lisp)
+(define-variable-pattern char-control-bit :lisp)
+(define-variable-pattern char-meta-bit :lisp)
+(define-variable-pattern char-super-bit :lisp)
+(define-variable-pattern char-hyper-bit :lisp)
+(define-caller-pattern char-bit (form form) :lisp)
+(define-caller-pattern set-char-bit (form form form) :lisp)
+
+;;; Sequences
+(define-caller-pattern complement (fn) :lisp2)
+(define-caller-pattern elt (form form) :lisp)
+(define-caller-pattern subseq (form form &optional form) :lisp)
+(define-caller-pattern copy-seq (form) :lisp)
+(define-caller-pattern length (form) :lisp)
+(define-caller-pattern reverse (form) :lisp)
+(define-caller-pattern nreverse (form) :lisp)
+(define-caller-pattern make-sequence (form form &key form) :lisp)
+
+(define-caller-pattern concatenate (form (:star form)) :lisp)
+(define-caller-pattern map (form fn form (:star form)) :lisp)
+(define-caller-pattern map-into (form fn (:star form)) :lisp2)
+
+(define-caller-pattern some (fn form (:star form)) :lisp)
+(define-caller-pattern every (fn form (:star form)) :lisp)
+(define-caller-pattern notany (fn form (:star form)) :lisp)
+(define-caller-pattern notevery (fn form (:star form)) :lisp)
+
+(define-caller-pattern reduce (fn form &key (:star form)) :lisp)
+(define-caller-pattern fill (form form &key (:star form)) :lisp)
+(define-caller-pattern replace (form form &key (:star form)) :lisp)
+(define-caller-pattern remove (form form &key (:star form)) :lisp)
+(define-caller-pattern remove-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern remove-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern delete (form form &key (:star form)) :lisp)
+(define-caller-pattern delete-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern delete-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern remove-duplicates (form &key (:star form)) :lisp)
+(define-caller-pattern delete-duplicates (form &key (:star form)) :lisp)
+(define-caller-pattern substitute (form form form &key (:star form)) :lisp)
+(define-caller-pattern substitute-if (form fn form &key (:star form)) :lisp)
+(define-caller-pattern substitute-if-not (form fn form &key (:star form))
+ :lisp)
+(define-caller-pattern nsubstitute (form form form &key (:star form)) :lisp)
+(define-caller-pattern nsubstitute-if (form fn form &key (:star form)) :lisp)
+(define-caller-pattern nsubstitute-if-not (form fn form &key (:star form))
+ :lisp)
+(define-caller-pattern find (form form &key (:star form)) :lisp)
+(define-caller-pattern find-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern find-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern position (form form &key (:star form)) :lisp)
+(define-caller-pattern position-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern position-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern count (form form &key (:star form)) :lisp)
+(define-caller-pattern count-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern count-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern mismatch (form form &key (:star form)) :lisp)
+(define-caller-pattern search (form form &key (:star form)) :lisp)
+(define-caller-pattern sort (form fn &key (:star form)) :lisp)
+(define-caller-pattern stable-sort (form fn &key (:star form)) :lisp)
+(define-caller-pattern merge (form form form fn &key (:star form)) :lisp)
+
+;;; Lists
+(define-caller-pattern car (form) :lisp)
+(define-caller-pattern cdr (form) :lisp)
+(define-caller-pattern caar (form) :lisp)
+(define-caller-pattern cadr (form) :lisp)
+(define-caller-pattern cdar (form) :lisp)
+(define-caller-pattern cddr (form) :lisp)
+(define-caller-pattern caaar (form) :lisp)
+(define-caller-pattern caadr (form) :lisp)
+(define-caller-pattern cadar (form) :lisp)
+(define-caller-pattern caddr (form) :lisp)
+(define-caller-pattern cdaar (form) :lisp)
+(define-caller-pattern cdadr (form) :lisp)
+(define-caller-pattern cddar (form) :lisp)
+(define-caller-pattern cdddr (form) :lisp)
+(define-caller-pattern caaaar (form) :lisp)
+(define-caller-pattern caaadr (form) :lisp)
+(define-caller-pattern caadar (form) :lisp)
+(define-caller-pattern caaddr (form) :lisp)
+(define-caller-pattern cadaar (form) :lisp)
+(define-caller-pattern cadadr (form) :lisp)
+(define-caller-pattern caddar (form) :lisp)
+(define-caller-pattern cadddr (form) :lisp)
+(define-caller-pattern cdaaar (form) :lisp)
+(define-caller-pattern cdaadr (form) :lisp)
+(define-caller-pattern cdadar (form) :lisp)
+(define-caller-pattern cdaddr (form) :lisp)
+(define-caller-pattern cddaar (form) :lisp)
+(define-caller-pattern cddadr (form) :lisp)
+(define-caller-pattern cdddar (form) :lisp)
+(define-caller-pattern cddddr (form) :lisp)
+
+(define-caller-pattern cons (form form) :lisp)
+(define-caller-pattern tree-equal (form form &key (:star fn)) :lisp)
+(define-caller-pattern endp (form) :lisp)
+(define-caller-pattern list-length (form) :lisp)
+(define-caller-pattern nth (form form) :lisp)
+
+(define-caller-pattern first (form) :lisp)
+(define-caller-pattern second (form) :lisp)
+(define-caller-pattern third (form) :lisp)
+(define-caller-pattern fourth (form) :lisp)
+(define-caller-pattern fifth (form) :lisp)
+(define-caller-pattern sixth (form) :lisp)
+(define-caller-pattern seventh (form) :lisp)
+(define-caller-pattern eighth (form) :lisp)
+(define-caller-pattern ninth (form) :lisp)
+(define-caller-pattern tenth (form) :lisp)
+
+(define-caller-pattern rest (form) :lisp)
+(define-caller-pattern nthcdr (form form) :lisp)
+(define-caller-pattern last (form (:optional form)) :lisp)
+(define-caller-pattern list ((:star form)) :lisp)
+(define-caller-pattern list* ((:star form)) :lisp)
+(define-caller-pattern make-list (form &key (:star form)) :lisp)
+(define-caller-pattern append ((:star form)) :lisp)
+(define-caller-pattern copy-list (form) :lisp)
+(define-caller-pattern copy-alist (form) :lisp)
+(define-caller-pattern copy-tree (form) :lisp)
+(define-caller-pattern revappend (form form) :lisp)
+(define-caller-pattern nconc ((:star form)) :lisp)
+(define-caller-pattern nreconc (form form) :lisp)
+(define-caller-pattern push (form form) :lisp)
+(define-caller-pattern pushnew (form form &key (:star form)) :lisp)
+(define-caller-pattern pop (form) :lisp)
+(define-caller-pattern butlast (form (:optional form)) :lisp)
+(define-caller-pattern nbutlast (form (:optional form)) :lisp)
+(define-caller-pattern ldiff (form form) :lisp)
+(define-caller-pattern rplaca (form form) :lisp)
+(define-caller-pattern rplacd (form form) :lisp)
+
+(define-caller-pattern subst (form form form &key (:star form)) :lisp)
+(define-caller-pattern subst-if (form fn form &key (:star form)) :lisp)
+(define-caller-pattern subst-if-not (form fn form &key (:star form)) :lisp)
+(define-caller-pattern nsubst (form form form &key (:star form)) :lisp)
+(define-caller-pattern nsubst-if (form fn form &key (:star form)) :lisp)
+(define-caller-pattern nsubst-if-not (form fn form &key (:star form)) :lisp)
+(define-caller-pattern sublis (form form &key (:star form)) :lisp)
+(define-caller-pattern nsublis (form form &key (:star form)) :lisp)
+(define-caller-pattern member (form form &key (:star form)) :lisp)
+(define-caller-pattern member-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern member-if-not (fn form &key (:star form)) :lisp)
+
+(define-caller-pattern tailp (form form) :lisp)
+(define-caller-pattern adjoin (form form &key (:star form)) :lisp)
+(define-caller-pattern union (form form &key (:star form)) :lisp)
+(define-caller-pattern nunion (form form &key (:star form)) :lisp)
+(define-caller-pattern intersection (form form &key (:star form)) :lisp)
+(define-caller-pattern nintersection (form form &key (:star form)) :lisp)
+(define-caller-pattern set-difference (form form &key (:star form)) :lisp)
+(define-caller-pattern nset-difference (form form &key (:star form)) :lisp)
+(define-caller-pattern set-exclusive-or (form form &key (:star form)) :lisp)
+(define-caller-pattern nset-exclusive-or (form form &key (:star form)) :lisp)
+(define-caller-pattern subsetp (form form &key (:star form)) :lisp)
+
+(define-caller-pattern acons (form form form) :lisp)
+(define-caller-pattern pairlis (form form (:optional form)) :lisp)
+(define-caller-pattern assoc (form form &key (:star form)) :lisp)
+(define-caller-pattern assoc-if (fn form) :lisp)
+(define-caller-pattern assoc-if-not (fn form) :lisp)
+(define-caller-pattern rassoc (form form &key (:star form)) :lisp)
+(define-caller-pattern rassoc-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern rassoc-if-not (fn form &key (:star form)) :lisp)
+
+;;; Hash Tables
+(define-caller-pattern make-hash-table (&key (:star form)) :lisp)
+(define-caller-pattern hash-table-p (form) :lisp)
+(define-caller-pattern gethash (form form (:optional form)) :lisp)
+(define-caller-pattern remhash (form form) :lisp)
+(define-caller-pattern maphash (fn form) :lisp)
+(define-caller-pattern clrhash (form) :lisp)
+(define-caller-pattern hash-table-count (form) :lisp)
+(define-caller-pattern with-hash-table-iterator
+ ((name form) (:star form)) :lisp2)
+(define-caller-pattern hash-table-rehash-size (form) :lisp2)
+(define-caller-pattern hash-table-rehash-threshold (form) :lisp2)
+(define-caller-pattern hash-table-size (form) :lisp2)
+(define-caller-pattern hash-table-test (form) :lisp2)
+(define-caller-pattern sxhash (form) :lisp)
+
+;;; Arrays
+(define-caller-pattern make-array (form &key (:star form)) :lisp)
+(define-variable-pattern array-rank-limit :lisp)
+(define-variable-pattern array-dimension-limit :lisp)
+(define-variable-pattern array-total-size-limit :lisp)
+(define-caller-pattern vector ((:star form)) :lisp)
+(define-caller-pattern aref (form (:star form)) :lisp)
+(define-caller-pattern svref (form form) :lisp)
+(define-caller-pattern array-element-type (form) :lisp)
+(define-caller-pattern array-rank (form) :lisp)
+(define-caller-pattern array-dimension (form form) :lisp)
+(define-caller-pattern array-dimensions (form) :lisp)
+(define-caller-pattern array-total-size (form) :lisp)
+(define-caller-pattern array-in-bounds-p (form (:star form)) :lisp)
+(define-caller-pattern array-row-major-index (form (:star form)) :lisp)
+(define-caller-pattern row-major-aref (form form) :lisp2)
+(define-caller-pattern adjustable-array-p (form) :lisp)
+
+(define-caller-pattern bit (form (:star form)) :lisp)
+(define-caller-pattern sbit (form (:star form)) :lisp)
+
+(define-caller-pattern bit-and (form form (:optional form)) :lisp)
+(define-caller-pattern bit-ior (form form (:optional form)) :lisp)
+(define-caller-pattern bit-xor (form form (:optional form)) :lisp)
+(define-caller-pattern bit-eqv (form form (:optional form)) :lisp)
+(define-caller-pattern bit-nand (form form (:optional form)) :lisp)
+(define-caller-pattern bit-nor (form form (:optional form)) :lisp)
+(define-caller-pattern bit-andc1 (form form (:optional form)) :lisp)
+(define-caller-pattern bit-andc2 (form form (:optional form)) :lisp)
+(define-caller-pattern bit-orc1 (form form (:optional form)) :lisp)
+(define-caller-pattern bit-orc2 (form form (:optional form)) :lisp)
+(define-caller-pattern bit-not (form (:optional form)) :lisp)
+
+(define-caller-pattern array-has-fill-pointer-p (form) :lisp)
+(define-caller-pattern fill-pointer (form) :lisp)
+(define-caller-pattern vector-push (form form) :lisp)
+(define-caller-pattern vector-push-extend (form form (:optional form)) :lisp)
+(define-caller-pattern vector-pop (form) :lisp)
+(define-caller-pattern adjust-array (form form &key (:star form)) :lisp)
+
+;;; Strings
+(define-caller-pattern char (form form) :lisp)
+(define-caller-pattern schar (form form) :lisp)
+(define-caller-pattern string= (form form &key (:star form)) :lisp)
+(define-caller-pattern string-equal (form form &key (:star form)) :lisp)
+(define-caller-pattern string< (form form &key (:star form)) :lisp)
+(define-caller-pattern string> (form form &key (:star form)) :lisp)
+(define-caller-pattern string<= (form form &key (:star form)) :lisp)
+(define-caller-pattern string>= (form form &key (:star form)) :lisp)
+(define-caller-pattern string/= (form form &key (:star form)) :lisp)
+(define-caller-pattern string-lessp (form form &key (:star form)) :lisp)
+(define-caller-pattern string-greaterp (form form &key (:star form)) :lisp)
+(define-caller-pattern string-not-greaterp (form form &key (:star form)) :lisp)
+(define-caller-pattern string-not-lessp (form form &key (:star form)) :lisp)
+(define-caller-pattern string-not-equal (form form &key (:star form)) :lisp)
+
+(define-caller-pattern make-string (form &key (:star form)) :lisp)
+(define-caller-pattern string-trim (form form) :lisp)
+(define-caller-pattern string-left-trim (form form) :lisp)
+(define-caller-pattern string-right-trim (form form) :lisp)
+(define-caller-pattern string-upcase (form &key (:star form)) :lisp)
+(define-caller-pattern string-downcase (form &key (:star form)) :lisp)
+(define-caller-pattern string-capitalize (form &key (:star form)) :lisp)
+(define-caller-pattern nstring-upcase (form &key (:star form)) :lisp)
+(define-caller-pattern nstring-downcase (form &key (:star form)) :lisp)
+(define-caller-pattern nstring-capitalize (form &key (:star form)) :lisp)
+(define-caller-pattern string (form) :lisp)
+
+;;; Structures
+(define-caller-pattern defstruct
+ ((:or name (name (:rest :ignore)))
+ (:optional documentation-string)
+ (:plus :ignore))
+ :lisp)
+
+;;; The Evaluator
+(define-caller-pattern eval (form) :lisp)
+(define-variable-pattern *evalhook* :lisp)
+(define-variable-pattern *applyhook* :lisp)
+(define-caller-pattern evalhook (form fn fn &optional :ignore) :lisp)
+(define-caller-pattern applyhook (fn form fn fn &optional :ignore) :lisp)
+(define-caller-pattern constantp (form) :lisp)
+
+;;; Streams
+(define-variable-pattern *standard-input* :lisp)
+(define-variable-pattern *standard-output* :lisp)
+(define-variable-pattern *error-output* :lisp)
+(define-variable-pattern *query-io* :lisp)
+(define-variable-pattern *debug-io* :lisp)
+(define-variable-pattern *terminal-io* :lisp)
+(define-variable-pattern *trace-output* :lisp)
+(define-caller-pattern make-synonym-stream (symbol) :lisp)
+(define-caller-pattern make-broadcast-stream ((:star form)) :lisp)
+(define-caller-pattern make-concatenated-stream ((:star form)) :lisp)
+(define-caller-pattern make-two-way-stream (form form) :lisp)
+(define-caller-pattern make-echo-stream (form form) :lisp)
+(define-caller-pattern make-string-input-stream (form &optional form form)
+ :lisp)
+(define-caller-pattern make-string-output-stream (&key (:star form)) :lisp)
+(define-caller-pattern get-output-stream-string (form) :lisp)
+
+(define-caller-pattern with-open-stream
+ ((var form)
+ (:star declaration)
+ (:star form))
+ :lisp)
+
+(define-caller-pattern with-input-from-string
+ ((var form &key (:star form))
+ (:star declaration)
+ (:star form))
+ :lisp)
+
+(define-caller-pattern with-output-to-string
+ ((var (:optional form))
+ (:star declaration)
+ (:star form))
+ :lisp)
+(define-caller-pattern streamp (form) :lisp)
+(define-caller-pattern open-stream-p (form) :lisp2)
+(define-caller-pattern input-stream-p (form) :lisp)
+(define-caller-pattern output-stream-p (form) :lisp)
+(define-caller-pattern stream-element-type (form) :lisp)
+(define-caller-pattern close (form (:rest :ignore)) :lisp)
+(define-caller-pattern broadcast-stream-streams (form) :lisp2)
+(define-caller-pattern concatenated-stream-streams (form) :lisp2)
+(define-caller-pattern echo-stream-input-stream (form) :lisp2)
+(define-caller-pattern echo-stream-output-stream (form) :lisp2)
+(define-caller-pattern synonym-stream-symbol (form) :lisp2)
+(define-caller-pattern two-way-stream-input-stream (form) :lisp2)
+(define-caller-pattern two-way-stream-output-stream (form) :lisp2)
+(define-caller-pattern interactive-stream-p (form) :lisp2)
+(define-caller-pattern stream-external-format (form) :lisp2)
+
+;;; Reader
+(define-variable-pattern *read-base* :lisp)
+(define-variable-pattern *read-suppress* :lisp)
+(define-variable-pattern *read-eval* :lisp2)
+(define-variable-pattern *readtable* :lisp)
+(define-caller-pattern copy-readtable (&optional form form) :lisp)
+(define-caller-pattern readtablep (form) :lisp)
+(define-caller-pattern set-syntax-from-char (form form &optional form form)
+ :lisp)
+(define-caller-pattern set-macro-character (form fn &optional form) :lisp)
+(define-caller-pattern get-macro-character (form (:optional form)) :lisp)
+(define-caller-pattern make-dispatch-macro-character (form &optional form form)
+ :lisp)
+(define-caller-pattern set-dispatch-macro-character
+ (form form fn (:optional form)) :lisp)
+(define-caller-pattern get-dispatch-macro-character
+ (form form (:optional form)) :lisp)
+(define-caller-pattern readtable-case (form) :lisp2)
+(define-variable-pattern *print-readably* :lisp2)
+(define-variable-pattern *print-escape* :lisp)
+(define-variable-pattern *print-pretty* :lisp)
+(define-variable-pattern *print-circle* :lisp)
+(define-variable-pattern *print-base* :lisp)
+(define-variable-pattern *print-radix* :lisp)
+(define-variable-pattern *print-case* :lisp)
+(define-variable-pattern *print-gensym* :lisp)
+(define-variable-pattern *print-level* :lisp)
+(define-variable-pattern *print-length* :lisp)
+(define-variable-pattern *print-array* :lisp)
+(define-caller-pattern with-standard-io-syntax
+ ((:star declaration)
+ (:star form))
+ :lisp2)
+
+(define-caller-pattern read (&optional form form form form) :lisp)
+(define-variable-pattern *read-default-float-format* :lisp)
+(define-caller-pattern read-preserving-whitespace
+ (&optional form form form form) :lisp)
+(define-caller-pattern read-delimited-list (form &optional form form) :lisp)
+(define-caller-pattern read-line (&optional form form form form) :lisp)
+(define-caller-pattern read-char (&optional form form form form) :lisp)
+(define-caller-pattern unread-char (form (:optional form)) :lisp)
+(define-caller-pattern peek-char (&optional form form form form) :lisp)
+(define-caller-pattern listen ((:optional form)) :lisp)
+(define-caller-pattern read-char-no-hang ((:star form)) :lisp)
+(define-caller-pattern clear-input ((:optional form)) :lisp)
+(define-caller-pattern read-from-string (form (:star form)) :lisp)
+(define-caller-pattern parse-integer (form &rest :ignore) :lisp)
+(define-caller-pattern read-byte ((:star form)) :lisp)
+
+(define-caller-pattern write (form &key (:star form)) :lisp)
+(define-caller-pattern prin1 (form (:optional form)) :lisp)
+(define-caller-pattern print (form (:optional form)) :lisp)
+(define-caller-pattern pprint (form (:optional form)) :lisp)
+(define-caller-pattern princ (form (:optional form)) :lisp)
+(define-caller-pattern write-to-string (form &key (:star form)) :lisp)
+(define-caller-pattern prin1-to-string (form) :lisp)
+(define-caller-pattern princ-to-string (form) :lisp)
+(define-caller-pattern write-char (form (:optional form)) :lisp)
+(define-caller-pattern write-string (form &optional form &key (:star form))
+ :lisp)
+(define-caller-pattern write-line (form &optional form &key (:star form))
+ :lisp)
+(define-caller-pattern terpri ((:optional form)) :lisp)
+(define-caller-pattern fresh-line ((:optional form)) :lisp)
+(define-caller-pattern finish-output ((:optional form)) :lisp)
+(define-caller-pattern force-output ((:optional form)) :lisp)
+(define-caller-pattern clear-output ((:optional form)) :lisp)
+(define-caller-pattern print-unreadable-object
+ ((form form &key (:star form))
+ (:star declaration)
+ (:star form))
+ :lisp2)
+(define-caller-pattern write-byte (form form) :lisp)
+(define-caller-pattern format
+ (destination
+ control-string
+ (:rest format-arguments))
+ :lisp)
+
+(define-caller-pattern y-or-n-p (control-string (:star form)) :lisp)
+(define-caller-pattern yes-or-no-p (control-string (:star form)) :lisp)
+
+;;; Pathnames
+(define-caller-pattern wild-pathname-p (form &optional form) :lisp2)
+(define-caller-pattern pathname-match-p (form form) :lisp2)
+(define-caller-pattern translate-pathname (form form form &key (:star form))
+ :lisp2)
+
+(define-caller-pattern logical-pathname (form) :lisp2)
+(define-caller-pattern translate-logical-pathname (form &key (:star form))
+ :lisp2)
+(define-caller-pattern logical-pathname-translations (form) :lisp2)
+(define-caller-pattern load-logical-pathname-translations (form) :lisp2)
+(define-caller-pattern compile-file-pathname (form &key form) :lisp2)
+
+(define-caller-pattern pathname (form) :lisp)
+(define-caller-pattern truename (form) :lisp)
+(define-caller-pattern parse-namestring ((:star form)) :lisp)
+(define-caller-pattern merge-pathnames ((:star form)) :lisp)
+(define-variable-pattern *default-pathname-defaults* :lisp)
+(define-caller-pattern make-pathname ((:star form)) :lisp)
+(define-caller-pattern pathnamep (form) :lisp)
+(define-caller-pattern pathname-host (form) :lisp)
+(define-caller-pattern pathname-device (form) :lisp)
+(define-caller-pattern pathname-directory (form) :lisp)
+(define-caller-pattern pathname-name (form) :lisp)
+(define-caller-pattern pathname-type (form) :lisp)
+(define-caller-pattern pathname-version (form) :lisp)
+(define-caller-pattern namestring (form) :lisp)
+(define-caller-pattern file-namestring (form) :lisp)
+(define-caller-pattern directory-namestring (form) :lisp)
+(define-caller-pattern host-namestring (form) :lisp)
+(define-caller-pattern enough-namestring (form (:optional form)) :lisp)
+(define-caller-pattern user-homedir-pathname (&optional form) :lisp)
+(define-caller-pattern open (form &key (:star form)) :lisp)
+(define-caller-pattern with-open-file
+ ((var form (:rest :ignore))
+ (:star declaration)
+ (:star form))
+ :lisp)
+
+(define-caller-pattern rename-file (form form) :lisp)
+(define-caller-pattern delete-file (form) :lisp)
+(define-caller-pattern probe-file (form) :lisp)
+(define-caller-pattern file-write-date (form) :lisp)
+(define-caller-pattern file-author (form) :lisp)
+(define-caller-pattern file-position (form (:optional form)) :lisp)
+(define-caller-pattern file-length (form) :lisp)
+(define-caller-pattern file-string-length (form form) :lisp2)
+(define-caller-pattern load (form &key (:star form)) :lisp)
+(define-variable-pattern *load-verbose* :lisp)
+(define-variable-pattern *load-print* :lisp2)
+(define-variable-pattern *load-pathname* :lisp2)
+(define-variable-pattern *load-truename* :lisp2)
+(define-caller-pattern make-load-form (form) :lisp2)
+(define-caller-pattern make-load-form-saving-slots (form &optional form)
+ :lisp2)
+(define-caller-pattern directory (form &key (:star form)) :lisp)
+
+;;; Errors
+(define-caller-pattern error (form (:star form)) :lisp)
+(define-caller-pattern cerror (form form (:star form)) :lisp)
+(define-caller-pattern warn (form (:star form)) :lisp)
+(define-variable-pattern *break-on-warnings* :lisp)
+(define-caller-pattern break (&optional form (:star form)) :lisp)
+(define-caller-pattern check-type (form form (:optional form)) :lisp)
+(define-caller-pattern assert
+ (form
+ (:optional ((:star var))
+ (:optional form (:star form))))
+ :lisp)
+(define-caller-pattern etypecase (form (:star (symbol (:star form)))) :lisp)
+(define-caller-pattern ctypecase (form (:star (symbol (:star form)))) :lisp)
+(define-caller-pattern ecase
+ (form
+ (:star ((:or symbol ((:star symbol)))
+ (:star form))))
+ :lisp)
+(define-caller-pattern ccase
+ (form
+ (:star ((:or symbol ((:star symbol)))
+ (:star form))))
+ :lisp)
+
+;;; The Compiler
+(define-caller-pattern compile (form (:optional form)) :lisp)
+(define-caller-pattern compile-file (form &key (:star form)) :lisp)
+(define-variable-pattern *compile-verbose* :lisp2)
+(define-variable-pattern *compile-print* :lisp2)
+(define-variable-pattern *compile-file-pathname* :lisp2)
+(define-variable-pattern *compile-file-truename* :lisp2)
+(define-caller-pattern load-time-value (form (:optional form)) :lisp2)
+(define-caller-pattern disassemble (form) :lisp)
+(define-caller-pattern function-lambda-expression (fn) :lisp2)
+(define-caller-pattern with-compilation-unit (((:star :ignore)) (:star form))
+ :lisp2)
+
+;;; Documentation
+(define-caller-pattern documentation (form form) :lisp)
+(define-caller-pattern trace ((:star form)) :lisp)
+(define-caller-pattern untrace ((:star form)) :lisp)
+(define-caller-pattern step (form) :lisp)
+(define-caller-pattern time (form) :lisp)
+(define-caller-pattern describe (form &optional form) :lisp)
+(define-caller-pattern describe-object (form &optional form) :lisp2)
+(define-caller-pattern inspect (form) :lisp)
+(define-caller-pattern room ((:optional form)) :lisp)
+(define-caller-pattern ed ((:optional form)) :lisp)
+(define-caller-pattern dribble ((:optional form)) :lisp)
+(define-caller-pattern apropos (form (:optional form)) :lisp)
+(define-caller-pattern apropos-list (form (:optional form)) :lisp)
+(define-caller-pattern get-decoded-time () :lisp)
+(define-caller-pattern get-universal-time () :lisp)
+(define-caller-pattern decode-universal-time (form &optional form) :lisp)
+(define-caller-pattern encode-universal-time
+ (form form form form form form &optional form) :lisp)
+(define-caller-pattern get-internal-run-time () :lisp)
+(define-caller-pattern get-internal-real-time () :lisp)
+(define-caller-pattern sleep (form) :lisp)
+
+(define-caller-pattern lisp-implementation-type () :lisp)
+(define-caller-pattern lisp-implementation-version () :lisp)
+(define-caller-pattern machine-type () :lisp)
+(define-caller-pattern machine-version () :lisp)
+(define-caller-pattern machine-instance () :lisp)
+(define-caller-pattern software-type () :lisp)
+(define-caller-pattern software-version () :lisp)
+(define-caller-pattern short-site-name () :lisp)
+(define-caller-pattern long-site-name () :lisp)
+(define-variable-pattern *features* :lisp)
+
+(define-caller-pattern identity (form) :lisp)
+
+;;; Pretty Printing
+(define-variable-pattern *print-pprint-dispatch* :lisp2)
+(define-variable-pattern *print-right-margin* :lisp2)
+(define-variable-pattern *print-miser-width* :lisp2)
+(define-variable-pattern *print-lines* :lisp2)
+(define-caller-pattern pprint-newline (form &optional form) :lisp2)
+(define-caller-pattern pprint-logical-block
+ ((var form &key (:star form))
+ (:star form))
+ :lisp2)
+(define-caller-pattern pprint-exit-if-list-exhausted () :lisp2)
+(define-caller-pattern pprint-pop () :lisp2)
+(define-caller-pattern pprint-indent (form form &optional form) :lisp2)
+(define-caller-pattern pprint-tab (form form form &optional form) :lisp2)
+(define-caller-pattern pprint-fill (form form &optional form form) :lisp2)
+(define-caller-pattern pprint-linear (form form &optional form form) :lisp2)
+(define-caller-pattern pprint-tabular (form form &optional form form form)
+ :lisp2)
+(define-caller-pattern formatter (control-string) :lisp2)
+(define-caller-pattern copy-pprint-dispatch (&optional form) :lisp2)
+(define-caller-pattern pprint-dispatch (form &optional form) :lisp2)
+(define-caller-pattern set-pprint-dispatch (form form &optional form form)
+ :lisp2)
+
+;;; CLOS
+(define-caller-pattern add-method (fn form) :lisp2)
+(define-caller-pattern call-method (form form) :lisp2)
+(define-caller-pattern call-next-method ((:star form)) :lisp2)
+(define-caller-pattern change-class (form form) :lisp2)
+(define-caller-pattern class-name (form) :lisp2)
+(define-caller-pattern class-of (form) :lisp2)
+(define-caller-pattern compute-applicable-methods (fn (:star form)) :lisp2)
+(define-caller-pattern defclass (name &rest :ignore) :lisp2)
+(define-caller-pattern defgeneric (name lambda-list &rest :ignore) :lisp2)
+(define-caller-pattern define-method-combination
+ (name lambda-list ((:star :ignore))
+ (:optional ((:eq :arguments) :ignore))
+ (:optional ((:eq :generic-function) :ignore))
+ (:star (:or declaration documentation-string))
+ (:star form))
+ :lisp2)
+(define-caller-pattern defmethod
+ (name (:star symbol) lambda-list
+ (:star (:or declaration documentation-string))
+ (:star form))
+ :lisp2)
+(define-caller-pattern ensure-generic-function (name &key (:star form)) :lisp2)
+(define-caller-pattern find-class (form &optional form form) :lisp2)
+(define-caller-pattern find-method (fn &rest :ignore) :lisp2)
+(define-caller-pattern function-keywords (&rest :ignore) :lisp2)
+(define-caller-pattern generic-flet (((:star (name lambda-list))) (:star form))
+ :lisp2)
+(define-caller-pattern generic-labels
+ (((:star (name lambda-list))) (:star form))
+ :lisp2)
+(define-caller-pattern generic-function (lambda-list) :lisp2)
+(define-caller-pattern initialize-instance (form &key (:star form)) :lisp2)
+(define-caller-pattern invalid-method-error (fn form (:star form)) :lisp2)
+(define-caller-pattern make-instance (fn (:star form)) :lisp2)
+(define-caller-pattern make-instances-obsolete (fn) :lisp2)
+(define-caller-pattern method-combination-error (form (:star form)) :lisp2)
+(define-caller-pattern method-qualifiers (fn) :lisp2)
+(define-caller-pattern next-method-p () :lisp2)
+(define-caller-pattern no-applicable-method (fn (:star form)) :lisp2)
+(define-caller-pattern no-next-method (fn (:star form)) :lisp2)
+(define-caller-pattern print-object (form form) :lisp2)
+(define-caller-pattern reinitialize-instance (form (:star form)) :lisp2)
+(define-caller-pattern remove-method (fn form) :lisp2)
+(define-caller-pattern shared-initialize (form form (:star form)) :lisp2)
+(define-caller-pattern slot-boundp (form form) :lisp2)
+(define-caller-pattern slot-exists-p (form form) :lisp2)
+(define-caller-pattern slot-makeunbound (form form) :lisp2)
+(define-caller-pattern slot-missing (fn form form form &optional form) :lisp2)
+(define-caller-pattern slot-unbound (fn form form) :lisp2)
+(define-caller-pattern slot-value (form form) :lisp2)
+(define-caller-pattern update-instance-for-different-class
+ (form form (:star form)) :lisp2)
+(define-caller-pattern update-instance-for-redefined-class
+ (form form (:star form)) :lisp2)
+(define-caller-pattern with-accessors
+ (((:star :ignore)) form
+ (:star declaration)
+ (:star form))
+ :lisp2)
+(define-caller-pattern with-added-methods
+ ((name lambda-list) form
+ (:star form))
+ :lisp2)
+(define-caller-pattern with-slots
+ (((:star :ignore)) form
+ (:star declaration)
+ (:star form))
+ :lisp2)
+
+;;; Conditions
+(define-caller-pattern signal (form (:star form)) :lisp2)
+(define-variable-pattern *break-on-signals* :lisp2)
+(define-caller-pattern handler-case (form (:star (form ((:optional var))
+ (:star form))))
+ :lisp2)
+(define-caller-pattern ignore-errors ((:star form)) :lisp2)
+(define-caller-pattern handler-bind (((:star (form form)))
+ (:star form))
+ :lisp2)
+(define-caller-pattern define-condition (name &rest :ignore) :lisp2)
+(define-caller-pattern make-condition (form &rest :ignore) :lisp2)
+(define-caller-pattern with-simple-restart
+ ((name form (:star form)) (:star form)) :lisp2)
+(define-caller-pattern restart-case
+ (form
+ (:star (form form (:star form))))
+ :lisp2)
+(define-caller-pattern restart-bind
+ (((:star (name fn &key (:star form))))
+ (:star form))
+ :lisp2)
+(define-caller-pattern with-condition-restarts
+ (form form
+ (:star declaration)
+ (:star form))
+ :lisp2)
+(define-caller-pattern compute-restarts (&optional form) :lisp2)
+(define-caller-pattern restart-name (form) :lisp2)
+(define-caller-pattern find-restart (form &optional form) :lisp2)
+(define-caller-pattern invoke-restart (form (:star form)) :lisp2)
+(define-caller-pattern invoke-restart-interactively (form) :lisp2)
+(define-caller-pattern abort (&optional form) :lisp2)
+(define-caller-pattern continue (&optional form) :lisp2)
+(define-caller-pattern muffle-warning (&optional form) :lisp2)
+(define-caller-pattern store-value (form &optional form) :lisp2)
+(define-caller-pattern use-value (form &optional form) :lisp2)
+(define-caller-pattern invoke-debugger (form) :lisp2)
+(define-variable-pattern *debugger-hook* :lisp2)
+(define-caller-pattern simple-condition-format-string (form) :lisp2)
+(define-caller-pattern simple-condition-format-arguments (form) :lisp2)
+(define-caller-pattern type-error-datum (form) :lisp2)
+(define-caller-pattern type-error-expected-type (form) :lisp2)
+(define-caller-pattern package-error-package (form) :lisp2)
+(define-caller-pattern stream-error-stream (form) :lisp2)
+(define-caller-pattern file-error-pathname (form) :lisp2)
+(define-caller-pattern cell-error-name (form) :lisp2)
+(define-caller-pattern arithmetic-error-operation (form) :lisp2)
+(define-caller-pattern arithmetic-error-operands (form) :lisp2)
+
+;;; For ZetaLisp Flavors
+(define-caller-pattern send (form fn (:star form)) :flavors)
diff --git a/vim/bundle/slimv/swank-clojure/COPYING b/vim/bundle/slimv/swank-clojure/COPYING
new file mode 100644
index 0000000..fec593a
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/COPYING
@@ -0,0 +1,227 @@
+Eclipse Public License - v 1.0
+
+THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE
+PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF
+THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.
+
+1. DEFINITIONS
+
+"Contribution" means:
+
+a) in the case of the initial Contributor, the initial code and
+documentation distributed under this Agreement, and
+
+b) in the case of each subsequent Contributor:
+
+i) changes to the Program, and
+
+ii) additions to the Program;
+
+where such changes and/or additions to the Program originate from and
+are distributed by that particular Contributor. A Contribution
+'originates' from a Contributor if it was added to the Program by such
+Contributor itself or anyone acting on such Contributor's
+behalf. Contributions do not include additions to the Program which:
+(i) are separate modules of software distributed in conjunction with
+the Program under their own license agreement, and (ii) are not
+derivative works of the Program.
+
+"Contributor" means any person or entity that distributes the Program.
+
+"Licensed Patents" mean patent claims licensable by a Contributor
+which are necessarily infringed by the use or sale of its Contribution
+alone or when combined with the Program.
+
+"Program" means the Contributions distributed in accordance with this
+Agreement.
+
+"Recipient" means anyone who receives the Program under this
+Agreement, including all Contributors.
+
+2. GRANT OF RIGHTS
+
+a) Subject to the terms of this Agreement, each Contributor hereby
+grants Recipient a non-exclusive, worldwide, royalty-free copyright
+license to reproduce, prepare derivative works of, publicly display,
+publicly perform, distribute and sublicense the Contribution of such
+Contributor, if any, and such derivative works, in source code and
+object code form.
+
+b) Subject to the terms of this Agreement, each Contributor hereby
+grants Recipient a non-exclusive, worldwide, royalty-free patent
+license under Licensed Patents to make, use, sell, offer to sell,
+import and otherwise transfer the Contribution of such Contributor, if
+any, in source code and object code form. This patent license shall
+apply to the combination of the Contribution and the Program if, at
+the time the Contribution is added by the Contributor, such addition
+of the Contribution causes such combination to be covered by the
+Licensed Patents. The patent license shall not apply to any other
+combinations which include the Contribution. No hardware per se is
+licensed hereunder.
+
+c) Recipient understands that although each Contributor grants the
+licenses to its Contributions set forth herein, no assurances are
+provided by any Contributor that the Program does not infringe the
+patent or other intellectual property rights of any other entity. Each
+Contributor disclaims any liability to Recipient for claims brought by
+any other entity based on infringement of intellectual property rights
+or otherwise. As a condition to exercising the rights and licenses
+granted hereunder, each Recipient hereby assumes sole responsibility
+to secure any other intellectual property rights needed, if any. For
+example, if a third party patent license is required to allow
+Recipient to distribute the Program, it is Recipient's responsibility
+to acquire that license before distributing the Program.
+
+d) Each Contributor represents that to its knowledge it has sufficient
+copyright rights in its Contribution, if any, to grant the copyright
+license set forth in this Agreement.
+
+3. REQUIREMENTS
+
+A Contributor may choose to distribute the Program in object code form
+under its own license agreement, provided that:
+
+a) it complies with the terms and conditions of this Agreement; and
+
+b) its license agreement:
+
+i) effectively disclaims on behalf of all Contributors all warranties
+and conditions, express and implied, including warranties or
+conditions of title and non-infringement, and implied warranties or
+conditions of merchantability and fitness for a particular purpose;
+
+ii) effectively excludes on behalf of all Contributors all liability
+for damages, including direct, indirect, special, incidental and
+consequential damages, such as lost profits;
+
+iii) states that any provisions which differ from this Agreement are
+offered by that Contributor alone and not by any other party; and
+
+iv) states that source code for the Program is available from such
+Contributor, and informs licensees how to obtain it in a reasonable
+manner on or through a medium customarily used for software exchange.
+
+When the Program is made available in source code form:
+
+a) it must be made available under this Agreement; and
+
+b) a copy of this Agreement must be included with each copy of the Program.
+
+Contributors may not remove or alter any copyright notices contained
+within the Program.
+
+Each Contributor must identify itself as the originator of its
+Contribution, if any, in a manner that reasonably allows subsequent
+Recipients to identify the originator of the Contribution.
+
+4. COMMERCIAL DISTRIBUTION
+
+Commercial distributors of software may accept certain
+responsibilities with respect to end users, business partners and the
+like. While this license is intended to facilitate the commercial use
+of the Program, the Contributor who includes the Program in a
+commercial product offering should do so in a manner which does not
+create potential liability for other Contributors. Therefore, if a
+Contributor includes the Program in a commercial product offering,
+such Contributor ("Commercial Contributor") hereby agrees to defend
+and indemnify every other Contributor ("Indemnified Contributor")
+against any losses, damages and costs (collectively "Losses") arising
+from claims, lawsuits and other legal actions brought by a third party
+against the Indemnified Contributor to the extent caused by the acts
+or omissions of such Commercial Contributor in connection with its
+distribution of the Program in a commercial product offering. The
+obligations in this section do not apply to any claims or Losses
+relating to any actual or alleged intellectual property
+infringement. In order to qualify, an Indemnified Contributor must: a)
+promptly notify the Commercial Contributor in writing of such claim,
+and b) allow the Commercial Contributor tocontrol, and cooperate with
+the Commercial Contributor in, the defense and any related settlement
+negotiations. The Indemnified Contributor may participate in any such
+claim at its own expense.
+
+For example, a Contributor might include the Program in a commercial
+product offering, Product X. That Contributor is then a Commercial
+Contributor. If that Commercial Contributor then makes performance
+claims, or offers warranties related to Product X, those performance
+claims and warranties are such Commercial Contributor's responsibility
+alone. Under this section, the Commercial Contributor would have to
+defend claims against the other Contributors related to those
+performance claims and warranties, and if a court requires any other
+Contributor to pay any damages as a result, the Commercial Contributor
+must pay those damages.
+
+5. NO WARRANTY
+
+EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS
+PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY
+WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY
+OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely
+responsible for determining the appropriateness of using and
+distributing the Program and assumes all risks associated with its
+exercise of rights under this Agreement , including but not limited to
+the risks and costs of program errors, compliance with applicable
+laws, damage to or loss of data, programs or equipment, and
+unavailability or interruption of operations.
+
+6. DISCLAIMER OF LIABILITY
+
+EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR
+ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING
+WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR
+DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED
+HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+7. GENERAL
+
+If any provision of this Agreement is invalid or unenforceable under
+applicable law, it shall not affect the validity or enforceability of
+the remainder of the terms of this Agreement, and without further
+action by the parties hereto, such provision shall be reformed to the
+minimum extent necessary to make such provision valid and enforceable.
+
+If Recipient institutes patent litigation against any entity
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+the Program itself (excluding combinations of the Program with other
+software or hardware) infringes such Recipient's patent(s), then such
+Recipient's rights granted under Section 2(b) shall terminate as of
+the date such litigation is filed.
+
+All Recipient's rights under this Agreement shall terminate if it
+fails to comply with any of the material terms or conditions of this
+Agreement and does not cure such failure in a reasonable period of
+time after becoming aware of such noncompliance. If all Recipient's
+rights under this Agreement terminate, Recipient agrees to cease use
+and distribution of the Program as soon as reasonably
+practicable. However, Recipient's obligations under this Agreement and
+any licenses granted by Recipient relating to the Program shall
+continue and survive.
+
+Everyone is permitted to copy and distribute copies of this Agreement,
+but in order to avoid inconsistency the Agreement is copyrighted and
+may only be modified in the following manner. The Agreement Steward
+reserves the right to publish new versions (including revisions) of
+this Agreement from time to time. No one other than the Agreement
+Steward has the right to modify this Agreement. The Eclipse Foundation
+is the initial Agreement Steward. The Eclipse Foundation may assign
+the responsibility to serve as the Agreement Steward to a suitable
+separate entity. Each new version of the Agreement will be given a
+distinguishing version number. The Program (including Contributions)
+may always be distributed subject to the version of the Agreement
+under which it was received. In addition, after a new version of the
+Agreement is published, Contributor may elect to distribute the
+Program (including its Contributions) under the new version. Except as
+expressly stated in Sections 2(a) and 2(b) above, Recipient receives
+no rights or licenses to the intellectual property of any Contributor
+under this Agreement, whether expressly, by implication, estoppel or
+otherwise. All rights in the Program not expressly granted under this
+Agreement are reserved.
+
+This Agreement is governed by the laws of the State of Washington and
+the intellectual property laws of the United States of America. No
+party to this Agreement will bring a legal action under this Agreement
+more than one year after the cause of action arose. Each party waives
+its rights to a jury trial in any resulting litigation.
diff --git a/vim/bundle/slimv/swank-clojure/README.md b/vim/bundle/slimv/swank-clojure/README.md
new file mode 100644
index 0000000..f2af463
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/README.md
@@ -0,0 +1,152 @@
+# Swank Clojure
+
+[Swank Clojure](http://github.com/technomancy/swank-clojure) is a
+server that allows [SLIME](http://common-lisp.net/project/slime/) (the
+Superior Lisp Interaction Mode for Emacs) to connect to Clojure
+projects. To use it you must launch a swank server, then connect to it
+from within Emacs.
+
+## Usage
+
+If you just want a standalone swank server with no third-party
+libraries, you can just install swank-clojure using Leiningen.
+
+ $ lein plugin install swank-clojure 1.3.0-SNAPSHOT
+ $ ~/.lein/bin/swank-clojure
+
+ M-x slime-connect
+
+If you put ~/.lein/bin on your $PATH it's even more convenient.
+
+You can also start a swank server from inside your project:
+
+ $ lein swank # you can specify PORT and HOST optionally
+
+Note that the lein-swank plugin now comes with Swank Clojure; it does
+not need to be specified as a separate dependency any more.
+
+If you're using Maven, add this to your pom.xml under the
+\<dependencies\> section:
+
+ <dependency>
+ <groupId>swank-clojure</groupId>
+ <artifactId>swank-clojure</artifactId>
+ <version>1.2.1</version>
+ </dependency>
+
+Then you can launch a swank server like so:
+
+ $ mvn -o clojure:swank
+
+Note that due to a bug in clojure-maven-plugin, you currently cannot
+include it as a test-scoped dependency; it must be compile-scoped. You
+also cannot change the port from Maven; it's hard-coded to 4005.
+
+Put this in your Emacs configuration to get syntax highlighting in the
+slime repl:
+
+ (add-hook 'slime-repl-mode-hook 'clojure-mode-font-lock-setup)
+
+## Connecting with SLIME
+
+Install the "slime-repl" package using package.el. If you are using
+Emacs 23, it's best to get [the latest version of package.el from
+Emacs
+trunk](http://bit.ly/pkg-el). Then
+add Marmalade as an archive source:
+
+ (add-to-list 'package-archives
+ '("marmalade" . "http://marmalade-repo.org/packages/") t)
+
+Then you can do <kbd>M-x package-list-packages</kbd>. Go down to
+slime-repl and mark it with <kbd>i</kbd>. Execute the installation by
+pressing <kbd>x</kbd>.
+
+When you perform the installation, you will see warnings related to
+the byte-compilation of the packages. This is **normal**; the packages
+will work just fine even if there are problems byte-compiling it upon
+installation.
+
+Then you should be able to connect to the swank server you launched:
+
+ M-x slime-connect
+
+It will prompt you for your host (usually localhost) and port. It may
+also warn you that your SLIME version doesn't match your Swank
+version; this should be OK.
+
+Having old versions of SLIME either manually installed or installed
+using a system-wide package manager like apt-get may cause issues.
+
+## SLIME Commands
+
+Commonly-used SLIME commands:
+
+* **C-c TAB**: Autocomplete symbol at point
+* **C-x C-e**: Eval the form under the point
+* **C-c C-k**: Compile the current buffer
+* **C-c C-l**: Load current buffer and force dependent namespaces to reload
+* **M-.**: Jump to the definition of a var
+* **C-c S-i**: Inspect a value
+* **C-c C-m**: Macroexpand the call under the point
+* **C-c C-d C-d**: Look up documentation for a var
+* **C-c C-z**: Switch from a Clojure buffer to the repl buffer
+* **C-c M-p**: Switch the repl namespace to match the current buffer
+* **C-c C-w c**: List all callers of a given function
+
+Pressing "v" on a stack trace a debug buffer will jump to the file and
+line referenced by that frame if possible.
+
+Note that SLIME was designed to work with Common Lisp, which has a
+distinction between interpreted code and compiled code. Clojure has no
+such distinction, so the load-file functionality is overloaded to add
+<code>:reload-all</code> behaviour.
+
+## Embedding
+
+You can embed Swank Clojure in your project, start the server from
+within your own code, and connect via Emacs to that instance:
+
+ (ns my-app
+ (:require [swank.swank]))
+ (swank.swank/start-repl) ;; optionally takes a port argument
+
+Then use M-x slime-connect to connect from within Emacs.
+
+You can also start the server directly from the "java" command-line
+launcher if you AOT-compile it and specify "swank.swank" as your main
+class.
+
+## Debug Repl
+
+For now, see [Hugo Duncan's
+blog](http://hugoduncan.org/post/2010/swank_clojure_gets_a_break_with_the_local_environment.xhtml)
+for an explanation of this excellent feature. Further documentation to come.
+
+## swank-clojure.el
+
+Previous versions of Swank Clojure bundled an Elisp library called
+swank-clojure.el that provided ways to launch your swank server from
+within your Emacs process. It's much more reliable to launch the
+server from your build tool, so this has been removed.
+
+## Community
+
+The [mailing list](http://groups.google.com/group/swank-clojure) and
+clojure channel on Freenode are the best places to bring up
+questions/issues.
+
+Contributions are preferred as either Github pull requests or using
+"git format-patch". Please use standard indentation with no tabs,
+trailing whitespace, or lines longer than 80 columns. See [this post
+on submitting good patches](http://technomancy.us/135) for some
+tips. If you've got some time on your hands, reading this [style
+guide](http://mumble.net/~campbell/scheme/style.txt) wouldn't hurt
+either.
+
+## License
+
+Copyright (C) 2008-2011 Jeffrey Chu, Phil Hagelberg, Hugo Duncan, and
+contributors
+
+Licensed under the EPL. (See the file COPYING.)
diff --git a/vim/bundle/slimv/swank-clojure/leiningen/swank.clj b/vim/bundle/slimv/swank-clojure/leiningen/swank.clj
new file mode 100644
index 0000000..d3875b8
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/leiningen/swank.clj
@@ -0,0 +1,30 @@
+(ns leiningen.swank
+ "Launch swank server for Emacs to connect."
+ (:use [leiningen.compile :only [eval-in-project]])
+ (:import [java.io File]))
+
+(defn swank-form [project port host opts]
+ ;; bootclasspath workaround: http://dev.clojure.org/jira/browse/CLJ-673
+ (when (:eval-in-leiningen project)
+ (require '[clojure walk template stacktrace]))
+ `(do
+ (let [is# ~(:repl-init-script project)]
+ (when (.exists (File. (str is#)))
+ (load-file is#)))
+ (require '~'swank.swank)
+ (require '~'swank.commands.basic)
+ (@(ns-resolve '~'swank.swank '~'start-repl)
+ (Integer. ~port) ~@(concat (map read-string opts)
+ [:host host]))
+ ;; This exits immediately when using :eval-in-leiningen; must block
+ (when ~(:eval-in-leiningen project)
+ (doseq [t# ((ns-resolve '~'swank.commands.basic
+ '~'get-thread-list))]
+ (.join t#)))))
+
+(defn swank
+ "Launch swank server for Emacs to connect. Optionally takes PORT and HOST."
+ ([project port host & opts]
+ (eval-in-project project (swank-form project port host opts)))
+ ([project port] (swank project port "localhost"))
+ ([project] (swank project 4005)))
diff --git a/vim/bundle/slimv/swank-clojure/project.clj b/vim/bundle/slimv/swank-clojure/project.clj
new file mode 100644
index 0000000..f0a1c71
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/project.clj
@@ -0,0 +1,9 @@
+(defproject swank-clojure "1.3.0"
+ :description "Swank server connecting Clojure to Emacs SLIME"
+ :url "http://github.com/technomancy/swank-clojure"
+ :dependencies [[org.clojure/clojure "1.2.0"]]
+ :dev-dependencies [[lein-multi "1.0.0"]]
+ :multi-deps {"1.1" [[org.clojure/clojure "1.1.0"]
+ [org.clojure/clojure-contrib "1.1.0"]]
+ "1.3" [[org.clojure/clojure "1.3.0-master-SNAPSHOT"]]}
+ :shell-wrapper {:main swank.swank})
diff --git a/vim/bundle/slimv/swank-clojure/swank/clj_contrib/macroexpand.clj b/vim/bundle/slimv/swank-clojure/swank/clj_contrib/macroexpand.clj
new file mode 100644
index 0000000..8cb052b
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/clj_contrib/macroexpand.clj
@@ -0,0 +1,17 @@
+(ns swank.clj-contrib.macroexpand)
+
+(def
+ #^{:private true}
+ walk-enabled?
+ (.getResource (clojure.lang.RT/baseLoader) "clojure/contrib/macro_utils.clj"))
+
+(when walk-enabled?
+ (require 'clojure.contrib.macro-utils))
+
+(defmacro macroexpand-all* [form]
+ (if walk-enabled?
+ `(clojure.contrib.macro-utils/mexpand-all ~form)
+ `(macroexpand ~form)))
+
+(defn macroexpand-all [form]
+ (macroexpand-all* form)) \ No newline at end of file
diff --git a/vim/bundle/slimv/swank-clojure/swank/clj_contrib/pprint.clj b/vim/bundle/slimv/swank-clojure/swank/clj_contrib/pprint.clj
new file mode 100644
index 0000000..b10df5f
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/clj_contrib/pprint.clj
@@ -0,0 +1,34 @@
+(ns swank.clj-contrib.pprint)
+
+(def #^{:private true} pprint-enabled?
+ (try ;; 1.2+
+ (.getResource (clojure.lang.RT/baseLoader) "clojure/pprint")
+ (require '[clojure.pprint :as pp])
+ (defmacro #^{:private true} pretty-pr-code*
+ ([code]
+ (if pprint-enabled?
+ `(binding [pp/*print-suppress-namespaces* true]
+ (pp/with-pprint-dispatch pp/code-dispatch
+ (pp/write ~code :pretty true :stream nil)))
+ `(pr-str ~code))))
+ true
+ (catch Exception e
+ (try ;; 1.0, 1.1
+ (.loadClass (clojure.lang.RT/baseLoader)
+ "clojure.contrib.pprint.PrettyWriter")
+ (require '[clojure.contrib.pprint :as pp])
+ (defmacro #^{:private true} pretty-pr-code*
+ ([code]
+ (if pprint-enabled?
+ `(binding [pp/*print-suppress-namespaces* true]
+ (pp/with-pprint-dispatch pp/*code-dispatch*
+ (pp/write ~code :pretty true :stream nil)))
+ `(pr-str ~code))))
+ true
+ ;; if you just don't have contrib, be silent.
+ (catch ClassNotFoundException _)
+ (catch Exception e
+ (println e))))))
+
+(defn pretty-pr-code [code]
+ (pretty-pr-code* code))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands.clj b/vim/bundle/slimv/swank-clojure/swank/commands.clj
new file mode 100644
index 0000000..1ad8bdc
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands.clj
@@ -0,0 +1,14 @@
+(ns swank.commands)
+
+(defonce slime-fn-map {})
+
+(defmacro defslimefn
+ ([fname & body]
+ `(alter-var-root #'slime-fn-map
+ assoc
+ (symbol "swank" ~(name fname))
+ (defn ~fname ~@body)))
+ {:indent 'defun})
+
+(defn slime-fn [sym]
+ (slime-fn-map (symbol "swank" (name sym)))) \ No newline at end of file
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/basic.clj b/vim/bundle/slimv/swank-clojure/swank/commands/basic.clj
new file mode 100644
index 0000000..a397280
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/basic.clj
@@ -0,0 +1,601 @@
+(ns swank.commands.basic
+ (:refer-clojure :exclude [load-file print-doc])
+ (:use (swank util commands core)
+ (swank.util.concurrent thread)
+ (swank.util string clojure)
+ (swank.clj-contrib pprint macroexpand))
+ (:require (swank.util [sys :as sys])
+ (swank.commands [xref :as xref]))
+ (:import (java.io StringReader File)
+ (java.util.zip ZipFile)
+ (clojure.lang LineNumberingPushbackReader)))
+
+;;;; Connection
+
+(defslimefn connection-info []
+ `(:pid ~(sys/get-pid)
+ :style :spawn
+ :lisp-implementation (:type "Clojure"
+ :name "clojure"
+ :version ~(clojure-version))
+ :package (:name ~(name (ns-name *ns*))
+ :prompt ~(name (ns-name *ns*)))
+ :version ~(deref protocol-version)))
+
+(defslimefn quit-lisp []
+ (System/exit 0))
+
+(defslimefn toggle-debug-on-swank-error []
+ (alter-var-root #'swank.core/debug-swank-clojure not))
+
+;;;; Evaluation
+
+(defn- eval-region
+ "Evaluate string, return the results of the last form as a list and
+ a secondary value the last form."
+ ([string]
+ (eval-region string "NO_SOURCE_FILE" 1))
+ ([string file line]
+ (with-open [rdr (proxy [LineNumberingPushbackReader]
+ ((StringReader. string))
+ (getLineNumber [] line))]
+ (binding [*file* file]
+ (loop [form (read rdr false rdr), value nil, last-form nil]
+ (if (= form rdr)
+ [value last-form]
+ (recur (read rdr false rdr)
+ (eval (with-env-locals form))
+ form)))))))
+
+(defn- compile-region
+ "Compile region."
+ ([string file line]
+ (with-open [rdr1 (proxy [LineNumberingPushbackReader]
+ ((StringReader. string)))
+ rdr (proxy [LineNumberingPushbackReader] (rdr1)
+ (getLineNumber [] (+ line (.getLineNumber rdr1) -1)))]
+ (clojure.lang.Compiler/load rdr file (.getName (File. file))))))
+
+
+(defslimefn interactive-eval-region [string]
+ (with-emacs-package
+ (pr-str (first (eval-region string)))))
+
+(defslimefn interactive-eval [string]
+ (with-emacs-package
+ (pr-str (first (eval-region string)))))
+
+(defslimefn listener-eval [form]
+ (with-emacs-package
+ (with-package-tracking
+ (let [[value last-form] (eval-region form)]
+ (when (and last-form (not (one-of? last-form '*1 '*2 '*3 '*e)))
+ (set! *3 *2)
+ (set! *2 *1)
+ (set! *1 value))
+ (send-repl-results-to-emacs value)))))
+
+(defslimefn eval-and-grab-output [string]
+ (with-emacs-package
+ (let [retval (promise)]
+ (list (with-out-str
+ (deliver retval (pr-str (first (eval-region string)))))
+ @retval))))
+
+(defslimefn pprint-eval [string]
+ (with-emacs-package
+ (pretty-pr-code (first (eval-region string)))))
+
+;;;; Macro expansion
+
+(defn- apply-macro-expander [expander string]
+ (pretty-pr-code (expander (read-string string))))
+
+(defslimefn swank-macroexpand-1 [string]
+ (apply-macro-expander macroexpand-1 string))
+
+(defslimefn swank-macroexpand [string]
+ (apply-macro-expander macroexpand string))
+
+;; not implemented yet, needs walker
+(defslimefn swank-macroexpand-all [string]
+ (apply-macro-expander macroexpand-all string))
+
+;;;; Compiler / Execution
+
+(def compiler-exception-location-re #"Exception:.*\(([^:]+):([0-9]+)\)")
+(defn- guess-compiler-exception-location [#^Throwable t]
+ (when (instance? clojure.lang.Compiler$CompilerException t)
+ (let [[match file line] (re-find compiler-exception-location-re (str t))]
+ (when (and file line)
+ `(:location (:file ~file) (:line ~(Integer/parseInt line)) nil)))))
+
+;; TODO: Make more and better guesses
+(defn- exception-location [#^Throwable t]
+ (or (guess-compiler-exception-location t)
+ '(:error "No error location available")))
+
+;; plist of message, severity, location, references, short-message
+(defn- exception-to-message [#^Throwable t]
+ `(:message ~(.toString t)
+ :severity :error
+ :location ~(exception-location t)
+ :references nil
+ :short-message ~(.toString t)))
+
+(defn- compile-file-for-emacs*
+ "Compiles a file for emacs. Because clojure doesn't compile, this is
+ simple an alias for load file w/ timing and messages. This function
+ is to reply with the following:
+ (:swank-compilation-unit notes results durations)"
+ ([file-name]
+ (let [start (System/nanoTime)]
+ (try
+ (let [ret (clojure.core/load-file file-name)
+ delta (- (System/nanoTime) start)]
+ `(:compilation-result nil ~(pr-str ret) ~(/ delta 1000000000.0)))
+ (catch Throwable t
+ (let [delta (- (System/nanoTime) start)
+ causes (exception-causes t)
+ num (count causes)]
+ (.printStackTrace t) ;; prints to *inferior-lisp*
+ `(:compilation-result
+ ~(map exception-to-message causes) ;; notes
+ nil ;; results
+ ~(/ delta 1000000000.0) ;; durations
+ )))))))
+
+(defslimefn compile-file-for-emacs
+ ([file-name load? & compile-options]
+ (when load?
+ (compile-file-for-emacs* file-name))))
+
+(defslimefn load-file [file-name]
+ (let [libs-ref @(resolve 'clojure.core/*loaded-libs*)
+ libs @libs-ref]
+ (try
+ (dosync (ref-set libs-ref #{}))
+ (pr-str (clojure.core/load-file file-name))
+ (finally
+ (dosync (alter libs-ref into libs))))))
+
+(defn- line-at-position [file position]
+ (try
+ (with-open [f (java.io.LineNumberReader. (java.io.FileReader. file))]
+ (.skip f position)
+ (.getLineNumber f))
+ (catch Exception e 1)))
+
+(defslimefn compile-string-for-emacs [string buffer position directory debug]
+ (let [start (System/nanoTime)
+ line (line-at-position directory position)
+ ret (with-emacs-package
+ (when-not (= (name (ns-name *ns*)) *current-package*)
+ (throw (clojure.lang.Compiler$CompilerException.
+ directory line
+ (Exception. (str "No such namespace: "
+ *current-package*)))))
+ (compile-region string directory line))
+ delta (- (System/nanoTime) start)]
+ `(:compilation-result nil ~(pr-str ret) ~(/ delta 1000000000.0))))
+
+;;;; Describe
+
+(defn- maybe-resolve-sym [symbol-name]
+ (try
+ (ns-resolve (maybe-ns *current-package*) (symbol symbol-name))
+ (catch ClassNotFoundException e nil)))
+
+(defn- maybe-resolve-ns [sym-name]
+ (let [sym (symbol sym-name)]
+ (or ((ns-aliases (maybe-ns *current-package*)) sym)
+ (find-ns sym))))
+
+(defn- print-doc* [m]
+ (println "-------------------------")
+ (println (str (when-let [ns (:ns m)] (str (ns-name ns) "/")) (:name m)))
+ (cond
+ (:forms m) (doseq [f (:forms m)]
+ (print " ")
+ (prn f))
+ (:arglists m) (prn (:arglists m)))
+ (if (:special-form m)
+ (do
+ (println "Special Form")
+ (println " " (:doc m))
+ (if (contains? m :url)
+ (when (:url m)
+ (println (str "\n Please see http://clojure.org/" (:url m))))
+ (println (str "\n Please see http://clojure.org/special_forms#"
+ (:name m)))))
+ (do
+ (when (:macro m)
+ (println "Macro"))
+ (println " " (:doc m)))))
+
+(def print-doc (let [print-doc (resolve 'clojure.core/print-doc)]
+ (if (or (nil? print-doc) (-> print-doc meta :private))
+ (comp print-doc* meta)
+ print-doc)))
+
+(defn- describe-to-string [var]
+ (with-out-str
+ (print-doc var)))
+
+(defn- describe-symbol* [symbol-name]
+ (with-emacs-package
+ (if-let [v (maybe-resolve-sym symbol-name)]
+ (if-not (class? v)
+ (describe-to-string v)))))
+
+(defslimefn describe-symbol [symbol-name]
+ (describe-symbol* symbol-name))
+
+(defslimefn describe-function [symbol-name]
+ (describe-symbol* symbol-name))
+
+;; Only one namespace... so no kinds
+(defslimefn describe-definition-for-emacs [name kind]
+ (describe-symbol* name))
+
+;; Only one namespace... so only describe symbol
+(defslimefn documentation-symbol
+ ([symbol-name default] (documentation-symbol symbol-name))
+ ([symbol-name] (describe-symbol* symbol-name)))
+
+;;;; Documentation
+
+(defn- briefly-describe-symbol-for-emacs [var]
+ (let [lines (fn [s] (.split #^String s (System/getProperty "line.separator")))
+ [_ symbol-name arglists d1 d2 & __] (lines (describe-to-string var))
+ macro? (= d1 "Macro")]
+ (list :designator symbol-name
+ (cond
+ macro? :macro
+ (:arglists (meta var)) :function
+ :else :variable)
+ (apply str (concat arglists (if macro? d2 d1))))))
+
+(defn- make-apropos-matcher [pattern case-sensitive?]
+ (let [pattern (java.util.regex.Pattern/quote pattern)
+ pat (re-pattern (if case-sensitive?
+ pattern
+ (format "(?i:%s)" pattern)))]
+ (fn [var] (re-find pat (pr-str var)))))
+
+(defn- apropos-symbols [string external-only? case-sensitive? package]
+ (let [packages (or (when package [package]) (all-ns))
+ matcher (make-apropos-matcher string case-sensitive?)
+ lister (if external-only? ns-publics ns-interns)]
+ (filter matcher
+ (apply concat (map (comp (partial map second) lister)
+ packages)))))
+
+(defn- present-symbol-before
+ "Comparator such that x belongs before y in a printed summary of symbols.
+Sorted alphabetically by namespace name and then symbol name, except
+that symbols accessible in the current namespace go first."
+ [x y]
+ (let [accessible?
+ (fn [var] (= (maybe-resolve-sym (:name (meta var)))
+ var))
+ ax (accessible? x) ay (accessible? y)]
+ (cond
+ (and ax ay) (compare (:name (meta x)) (:name (meta y)))
+ ax -1
+ ay 1
+ :else (let [nx (str (:ns (meta x))) ny (str (:ns (meta y)))]
+ (if (= nx ny)
+ (compare (:name (meta x)) (:name (meta y)))
+ (compare nx ny))))))
+
+(defslimefn apropos-list-for-emacs
+ ([name]
+ (apropos-list-for-emacs name nil))
+ ([name external-only?]
+ (apropos-list-for-emacs name external-only? nil))
+ ([name external-only? case-sensitive?]
+ (apropos-list-for-emacs name external-only? case-sensitive? nil))
+ ([name external-only? case-sensitive? package]
+ (let [package (when package
+ (maybe-ns package))]
+ (map briefly-describe-symbol-for-emacs
+ (sort present-symbol-before
+ (apropos-symbols name external-only? case-sensitive?
+ package))))))
+
+;;;; Operator messages
+(defslimefn operator-arglist [name package]
+ (try
+ (let [f (read-string name)]
+ (cond
+ (keyword? f) "([map])"
+ (symbol? f) (let [var (ns-resolve (maybe-ns package) f)]
+ (if-let [args (and var (:arglists (meta var)))]
+ (pr-str args)
+ nil))
+ :else nil))
+ (catch Throwable t nil)))
+
+;;;; Package Commands
+
+(defslimefn list-all-package-names
+ ([] (map (comp str ns-name) (all-ns)))
+ ([nicknames?] (list-all-package-names)))
+
+(defslimefn set-package [name]
+ (let [ns (maybe-ns name)]
+ (in-ns (ns-name ns))
+ (list (str (ns-name ns))
+ (str (ns-name ns)))))
+
+;;;; Tracing
+
+(defonce traced-fn-map {})
+
+(def #^{:dynamic true} *trace-level* 0)
+
+(defn- indent [num]
+ (dotimes [x (+ 1 num)]
+ (print " ")))
+
+(defn- trace-fn-call [sym f args]
+ (let [fname (symbol (str (.name (.ns sym)) "/" (.sym sym)))]
+ (indent *trace-level*)
+ (println (str *trace-level* ":")
+ (apply str (take 240 (pr-str (when fname (cons fname args)) ))))
+ (let [result (binding [*trace-level* (+ *trace-level* 1)] (apply f args))]
+ (indent *trace-level*)
+ (println (str *trace-level* ": " fname " returned " (apply str (take 240 (pr-str result)))))
+ result)))
+
+(defslimefn swank-toggle-trace [fname]
+ (when-let [sym (maybe-resolve-sym fname)]
+ (if-let [f# (get traced-fn-map sym)]
+ (do
+ (alter-var-root #'traced-fn-map dissoc sym)
+ (alter-var-root sym (constantly f#))
+ (str " untraced."))
+ (let [f# @sym]
+ (alter-var-root #'traced-fn-map assoc sym f#)
+ (alter-var-root sym
+ (constantly
+ (fn [& args]
+ (trace-fn-call sym f# args))))
+ (str " traced.")))))
+
+(defslimefn untrace-all []
+ (doseq [sym (keys traced-fn-map)]
+ (swank-toggle-trace (.sym sym))))
+
+;;;; Source Locations
+(comment
+ "Sets the default directory (java's user.dir). Note, however, that
+ this will not change the search path of load-file. ")
+(defslimefn set-default-directory
+ ([directory & ignore]
+ (System/setProperty "user.dir" directory)
+ directory))
+
+
+;;;; meta dot find
+
+(defn- clean-windows-path [#^String path]
+ ;; Decode file URI encoding and remove an opening slash from
+ ;; /c:/program%20files/... in jar file URLs and file resources.
+ (or (and (.startsWith (System/getProperty "os.name") "Windows")
+ (second (re-matches #"^/([a-zA-Z]:/.*)$" path)))
+ path))
+
+(defn- slime-zip-resource [#^java.net.URL resource]
+ (let [jar-connection #^java.net.JarURLConnection (.openConnection resource)
+ jar-file (.getPath (.toURI (.getJarFileURL jar-connection)))]
+ (list :zip (clean-windows-path jar-file) (.getEntryName jar-connection))))
+
+(defn- slime-file-resource [#^java.net.URL resource]
+ (list :file (clean-windows-path (.getFile resource))))
+
+(defn- slime-find-resource [#^String file]
+ (if-let [resource (.getResource (clojure.lang.RT/baseLoader) file)]
+ (if (= (.getProtocol resource) "jar")
+ (slime-zip-resource resource)
+ (slime-file-resource resource))))
+
+(defn- slime-find-file [#^String file]
+ (if (.isAbsolute (File. file))
+ (list :file file)
+ (slime-find-resource file)))
+
+(defn- namespace-to-path [ns]
+ (let [#^String ns-str (name (ns-name ns))
+ last-dot-index (.lastIndexOf ns-str ".")]
+ (if (pos? last-dot-index)
+ (-> (.substring ns-str 0 last-dot-index)
+ (.replace \- \_)
+ (.replace \. \/)))))
+
+(defn- classname-to-path [class-name]
+ (namespace-to-path
+ (symbol (.replace class-name \_ \-))))
+
+
+(defn- location-in-file [path line]
+ `(:location ~path (:line ~line) nil))
+
+(defn- location-label [name type]
+ (if type
+ (str "(" type " " name ")")
+ (str name)))
+
+(defn- location [name type path line]
+ `((~(location-label name type)
+ ~(if path
+ (location-in-file path line)
+ (list :error (format "%s - definition not found." name))))))
+
+(defn- location-not-found [name type]
+ (location name type nil nil))
+
+(defn source-location-for-frame [#^StackTraceElement frame]
+ (let [line (.getLineNumber frame)
+ filename (if (.. frame getFileName (endsWith ".java"))
+ (.. frame getClassName (replace \. \/)
+ (substring 0 (.lastIndexOf (.getClassName frame) "."))
+ (concat (str File/separator (.getFileName frame))))
+ (let [ns-path (classname-to-path
+ ((re-find #"(.*?)\$"
+ (.getClassName frame)) 1))]
+ (if ns-path
+ (str ns-path File/separator (.getFileName frame))
+ (.getFileName frame))))
+ path (slime-find-file filename)]
+ (location-in-file path line)))
+
+(defn- namespace-to-filename [ns]
+ (str (-> (str ns)
+ (.replaceAll "\\." File/separator)
+ (.replace \- \_ ))
+ ".clj"))
+
+(defn- source-location-for-meta [meta xref-type-name]
+ (location (:name meta)
+ xref-type-name
+ (slime-find-file (:file meta))
+ (:line meta)))
+
+(defn- find-ns-definition [sym-name]
+ (if-let [ns (maybe-resolve-ns sym-name)]
+ (when-let [path (slime-find-file (namespace-to-filename ns))]
+ (location ns nil path 1))))
+
+(defn- find-var-definition [sym-name]
+ (if-let [meta (meta (maybe-resolve-sym sym-name))]
+ (source-location-for-meta meta "defn")))
+
+(defslimefn find-definitions-for-emacs [name]
+ (let [sym-name (read-string name)]
+ (or (find-var-definition sym-name)
+ (find-ns-definition sym-name)
+ (location name nil nil nil))))
+
+(defn who-specializes [class]
+ (letfn [(xref-lisp [sym] ; see find-definitions-for-emacs
+ (if-let [meta (meta sym)]
+ (source-location-for-meta meta "method")
+ (location-not-found (.getName sym) "method")))]
+ (let [methods (try (. class getMethods)
+ (catch java.lang.IllegalArgumentException e nil)
+ (catch java.lang.NullPointerException e nil))]
+ (map xref-lisp methods))))
+
+(defn who-calls [name]
+ (letfn [(xref-lisp [sym-var] ; see find-definitions-for-emacs
+ (when-let [meta (meta sym-var)]
+ (source-location-for-meta meta nil)))]
+ (let [callers (xref/all-vars-who-call name) ]
+ (map first (map xref-lisp callers)))))
+
+(defslimefn xref [type name]
+ (let [sexp (maybe-resolve-sym name)]
+ (condp = type
+ :specializes (who-specializes sexp)
+ :calls (who-calls (symbol name))
+ :callers nil
+ :not-implemented)))
+
+(defslimefn throw-to-toplevel []
+ (throw debug-quit-exception))
+
+(defn invoke-restart [restart]
+ ((nth restart 2)))
+
+(defslimefn invoke-nth-restart-for-emacs [level n]
+ ((invoke-restart (*sldb-restarts* (nth (keys *sldb-restarts*) n)))))
+
+(defslimefn throw-to-toplevel []
+ (if-let [restart (*sldb-restarts* :quit)]
+ (invoke-restart restart)))
+
+(defslimefn sldb-continue []
+ (if-let [restart (*sldb-restarts* :continue)]
+ (invoke-restart restart)))
+
+(defslimefn sldb-abort []
+ (if-let [restart (*sldb-restarts* :abort)]
+ (invoke-restart restart)))
+
+
+(defslimefn backtrace [start end]
+ (build-backtrace start end))
+
+(defslimefn buffer-first-change [file-name] nil)
+
+(defn locals-for-emacs [m]
+ (sort-by second
+ (map #(list :name (name (first %)) :id 0
+ :value (pr-str (second %))) m)))
+
+(defslimefn frame-catch-tags-for-emacs [n] nil)
+(defslimefn frame-locals-for-emacs [n]
+ (if (and (zero? n) (seq *current-env*))
+ (locals-for-emacs *current-env*)))
+
+(defslimefn frame-locals-and-catch-tags [n]
+ (list (frame-locals-for-emacs n)
+ (frame-catch-tags-for-emacs n)))
+
+(defslimefn debugger-info-for-emacs [start end]
+ (build-debugger-info-for-emacs start end))
+
+(defslimefn eval-string-in-frame [expr n]
+ (if (and (zero? n) *current-env*)
+ (with-bindings *current-env*
+ (eval expr))))
+
+(defslimefn frame-source-location [n]
+ (source-location-for-frame
+ (nth (.getStackTrace *current-exception*) n)))
+
+;; Older versions of slime use this instead of the above.
+(defslimefn frame-source-location-for-emacs [n]
+ (source-location-for-frame
+ (nth (.getStackTrace *current-exception*) n)))
+
+(defslimefn create-repl [target] '("user" "user"))
+
+;;; Threads
+
+(def #^{:private true} thread-list (atom []))
+
+(defn- get-root-group [#^java.lang.ThreadGroup tg]
+ (if-let [parent (.getParent tg)]
+ (recur parent)
+ tg))
+
+(defn- get-thread-list []
+ (let [rg (get-root-group (.getThreadGroup (Thread/currentThread)))
+ arr (make-array Thread (.activeCount rg))]
+ (.enumerate rg arr true)
+ (seq arr)))
+
+(defn- extract-info [#^Thread t]
+ (map str [(.getId t) (.getName t) (.getPriority t) (.getState t)]))
+
+(defslimefn list-threads
+ "Return a list (LABELS (ID NAME STATUS ATTRS ...) ...).
+LABELS is a list of attribute names and the remaining lists are the
+corresponding attribute values per thread."
+ []
+ (reset! thread-list (get-thread-list))
+ (let [labels '(id name priority state)]
+ (cons labels (map extract-info @thread-list))))
+
+;;; TODO: Find a better way, as Thread.stop is deprecated
+(defslimefn kill-nth-thread [index]
+ (when index
+ (when-let [thread (nth @thread-list index nil)]
+ (println "Thread: " thread)
+ (.stop thread))))
+
+(defslimefn quit-thread-browser []
+ (reset! thread-list []))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/completion.clj b/vim/bundle/slimv/swank-clojure/swank/commands/completion.clj
new file mode 100644
index 0000000..4fc2b20
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/completion.clj
@@ -0,0 +1,103 @@
+(ns swank.commands.completion
+ (:use (swank util core commands)
+ (swank.util string clojure java class-browse)))
+
+(defn potential-ns
+ "Returns a list of potential namespace completions for a given
+ namespace"
+ ([] (potential-ns *ns*))
+ ([ns]
+ (for [ns-sym (concat (keys (ns-aliases (ns-name ns)))
+ (map ns-name (all-ns)))]
+ (name ns-sym))))
+
+(defn potential-var-public
+ "Returns a list of potential public var name completions for a
+ given namespace"
+ ([] (potential-var-public *ns*))
+ ([ns]
+ (for [var-sym (keys (ns-publics ns))]
+ (name var-sym))))
+
+(defn potential-var
+ "Returns a list of all potential var name completions for a given
+ namespace"
+ ([] (potential-var *ns*))
+ ([ns]
+ (for [[key v] (ns-map ns)
+ :when (var? v)]
+ (name key))))
+
+(defn potential-classes
+ "Returns a list of potential class name completions for a given
+ namespace"
+ ([] (potential-classes *ns*))
+ ([ns]
+ (for [class-sym (keys (ns-imports ns))]
+ (name class-sym))))
+
+(defn potential-dot
+ "Returns a list of potential dot method name completions for a given
+ namespace"
+ ([] (potential-dot *ns*))
+ ([ns]
+ (map #(str "." %) (set (map member-name (mapcat instance-methods (vals (ns-imports ns))))))))
+
+(defn potential-static
+ "Returns a list of potential static members for a given namespace"
+ ([#^Class class]
+ (concat (map member-name (static-methods class))
+ (map member-name (static-fields class)))))
+
+
+(defn potential-classes-on-path
+ "Returns a list of Java class and Clojure package names found on the current
+ classpath. To minimize noise, list is nil unless a '.' is present in the search
+ string, and nested classes are only shown if a '$' is present."
+ ([symbol-string]
+ (when (.contains symbol-string ".")
+ (if (.contains symbol-string "$")
+ @nested-classes
+ @top-level-classes))))
+
+(defn resolve-class
+ "Attempts to resolve a symbol into a java Class. Returns nil on
+ failure."
+ ([sym]
+ (try
+ (let [res (resolve sym)]
+ (when (class? res)
+ res))
+ (catch Throwable t
+ nil))))
+
+
+(defn- maybe-alias [sym ns]
+ (or (resolve-ns sym (maybe-ns ns))
+ (maybe-ns ns)))
+
+(defn potential-completions [symbol-ns ns]
+ (if symbol-ns
+ (map #(str symbol-ns "/" %)
+ (if-let [class (resolve-class symbol-ns)]
+ (potential-static class)
+ (potential-var-public (maybe-alias symbol-ns ns))))
+ (concat (potential-var ns)
+ (when-not symbol-ns
+ (potential-ns))
+ (potential-classes ns)
+ (potential-dot ns))))
+
+
+(defslimefn simple-completions [symbol-string package]
+ (try
+ (let [[sym-ns sym-name] (symbol-name-parts symbol-string)
+ potential (concat (potential-completions (when sym-ns (symbol sym-ns)) (ns-name (maybe-ns package)))
+ (potential-classes-on-path symbol-string))
+ matches (seq (sort (filter #(.startsWith #^String % symbol-string) potential)))]
+ (list matches
+ (if matches
+ (reduce largest-common-prefix matches)
+ symbol-string)))
+ (catch java.lang.Throwable t
+ (list nil symbol-string))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/contrib.clj b/vim/bundle/slimv/swank-clojure/swank/commands/contrib.clj
new file mode 100644
index 0000000..6c0ed07
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/contrib.clj
@@ -0,0 +1,9 @@
+(ns swank.commands.contrib
+ (:use (swank util core commands)))
+
+(defslimefn swank-require [keys]
+ (binding [*ns* (find-ns 'swank.commands.contrib)]
+ (doseq [k (if (seq? keys) keys (list keys))]
+ (try
+ (require (symbol (str "swank.commands.contrib." (name k))))
+ (catch java.io.FileNotFoundException fne nil))))) \ No newline at end of file
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_arglists.clj b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_arglists.clj
new file mode 100644
index 0000000..232a116
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_arglists.clj
@@ -0,0 +1,123 @@
+(ns swank.commands.contrib.swank-arglists
+ (:use (swank util core commands)))
+
+((slime-fn 'swank-require) :swank-c-p-c)
+
+;;; pos starts at 1 bc 0 is function name
+(defn position-in-arglist? [arglist pos]
+ (or (some #(= '& %) arglist)
+ (<= pos (count arglist))))
+
+;; (position-in-arglist? '[x y] 2)
+;; => true
+
+(defn highlight-position [arglist pos]
+ (if (zero? pos)
+ arglist
+ ;; i.e. not rest args
+ (let [num-normal-args (count (take-while #(not= % '&) arglist))]
+ (if (<= pos num-normal-args)
+ (into [] (concat (take (dec pos) arglist)
+ '(===>)
+ (list (nth arglist (dec pos)))
+ '(<===)
+ (drop pos arglist)))
+ (let [rest-arg? (some #(= % '&) arglist)]
+ (if rest-arg?
+ (into [] (concat (take-while #(not= % '&) arglist)
+ '(===>)
+ '(&)
+ (list (last arglist))
+ '(<===)))))))))
+
+;; (highlight-position '[x y] 0)
+;; => [===> x <=== y]
+
+(defn highlight-arglists [arglists pos]
+ (let [arglists (read-string arglists)]
+ (loop [checked []
+ current (first arglists)
+ remaining (rest arglists)]
+ (if (position-in-arglist? current pos)
+ (apply list (concat checked
+ [(highlight-position current pos)]
+ remaining))
+ (when (seq remaining)
+ (recur (conj checked current)
+ (first remaining)
+ (rest remaining)))))))
+
+;; (highlight-arglists "([x] [x & more])" 1)
+;; => ([===> x <===] [x & more])
+
+;;(defmacro dbg[x] `(let [x# ~x] (println '~x "->" x#) x#))
+
+(defn defnk-arglists? [arglists]
+ (and (not (nil? arglists ))
+ (not (vector? (first (read-string arglists))))))
+
+(defn fix-defnk-arglists [arglists]
+ (str (list (into [] (read-string arglists)))))
+
+(defn arglists-for-fname-lookup [fname]
+ ((slime-fn 'operator-arglist) fname *current-package*))
+
+(defn arglists-for-fname [fname]
+ (let [arglists (arglists-for-fname-lookup fname)]
+ ;; defnk's arglists format is (a b) instead of ([a b])
+ (if (defnk-arglists? arglists)
+ (fix-defnk-arglists arglists)
+ arglists)))
+
+(defn message-format [cmd arglists pos]
+ (str (when cmd (str cmd ": "))
+ (when arglists
+ (if pos
+ (highlight-arglists arglists pos)
+ arglists))))
+
+(defn handle-apply [raw-specs pos]
+ (let [fname (second (first raw-specs))]
+ (message-format fname (arglists-for-fname fname) (dec pos))))
+
+(defslimefn arglist-for-echo-area [raw-specs & options]
+ (let [{:keys [arg-indices
+ print-right-margin
+ print-lines]} (apply hash-map options)]
+ (if-not (and raw-specs
+ (seq? raw-specs)
+ (seq? (first raw-specs)))
+ nil ;; problem?
+ (let [pos (first (second options))
+ top-level? (= 1 (count raw-specs))
+ parent-pos (when-not top-level?
+ (second (second options)))
+ fname (ffirst raw-specs)
+ parent-fname (when-not top-level?
+ (first (second raw-specs)))
+ arglists (arglists-for-fname fname)
+ inside-binding? (and (not top-level?)
+ (#{"let" "binding" "doseq" "for" "loop"}
+ parent-fname)
+ (= 1 parent-pos))]
+;; (dbg raw-specs)
+;; (dbg options)
+ (cond
+ ;; display arglists for function being applied unless on top of apply
+ (and (= fname "apply") (not= pos 0)) (handle-apply raw-specs pos)
+ ;; highlight binding inside binding forms unless >1 level deep
+ inside-binding? (message-format parent-fname
+ (arglists-for-fname parent-fname)
+ 1)
+ :else (message-format fname arglists pos))))))
+
+(defslimefn variable-desc-for-echo-area [variable-name]
+ (with-emacs-package
+ (or
+ (try
+ (when-let [sym (read-string variable-name)]
+ (when-let [var (resolve sym)]
+ (when (.isBound #^clojure.lang.Var var)
+ (str variable-name " => " (var-get var)))))
+ (catch Exception e nil))
+ "")))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c.clj b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c.clj
new file mode 100644
index 0000000..40ca3fd
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c.clj
@@ -0,0 +1,21 @@
+(ns swank.commands.contrib.swank-c-p-c
+ (:use (swank util core commands)
+ (swank.commands completion)
+ (swank.util string clojure)
+ (swank.commands.contrib.swank-c-p-c internal)))
+
+(defslimefn completions [symbol-string package]
+ (try
+ (let [[sym-ns sym-name] (symbol-name-parts symbol-string)
+ potential (concat
+ (potential-completions
+ (when sym-ns (symbol sym-ns))
+ (ns-name (maybe-ns package)))
+ (potential-classes-on-path symbol-string))
+ matches (seq (sort (filter #(split-compound-prefix-match? symbol-string %) potential)))]
+ (list matches
+ (if matches
+ (reduce largest-common-prefix matches)
+ symbol-string)))
+ (catch java.lang.Throwable t
+ (list nil symbol-string))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c/internal.clj b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c/internal.clj
new file mode 100644
index 0000000..89701dd
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c/internal.clj
@@ -0,0 +1,59 @@
+(ns swank.commands.contrib.swank-c-p-c.internal
+ (:use (swank util core commands)
+ (swank.commands completion)
+ (swank.util string clojure)))
+
+(defn compound-prefix-match?
+ "Takes a `prefix' and a `target' string and returns whether `prefix'
+ is a compound-prefix of `target'.
+
+ Viewing each of `prefix' and `target' as a series of substrings
+ split by `split', if each substring of `prefix' is a prefix of the
+ corresponding substring in `target' then we call `prefix' a
+ compound-prefix of `target'."
+ ([split #^String prefix #^String target]
+ (let [prefixes (split prefix)
+ targets (split target)]
+ (when (<= (count prefixes) (count targets))
+ (every? true? (map #(.startsWith #^String %1 %2) targets prefixes))))))
+
+(defn unacronym
+ "Interposes delimiter between each character of string."
+ ([delimiter #^String string]
+ (apply str (interpose delimiter string)))
+ {:tag String})
+
+(defn delimited-compound-prefix-match?
+ "Uses a delimiter as the `split' for a compound prefix match check.
+ See also: `compound-prefix-match?'"
+ ([delimiter prefix target]
+ (compound-prefix-match? #(.split #^String % (str "[" (java.util.regex.Pattern/quote delimiter) "]") -1)
+ prefix
+ target)))
+
+
+(defn delimited-compound-prefix-match-acronym?
+ ([delimiter prefix target]
+ (or (delimited-compound-prefix-match? delimiter prefix target)
+ (delimited-compound-prefix-match? delimiter (unacronym (first delimiter) prefix) target))))
+
+(defn camel-compound-prefix-match?
+ "Uses camel case as a delimiter for a compound prefix match check.
+
+ See also: `compound-prefix-match?'"
+ ([#^String prefix #^String target]
+ (compound-prefix-match? #(re-seq #"(?:^.|[A-Z])[^A-Z]*" %)
+ prefix
+ target)))
+
+(defn split-compound-prefix-match? [#^String symbol-string #^String potential]
+ (if (.startsWith symbol-string ".")
+ (and (.startsWith potential ".")
+ (camel-compound-prefix-match? symbol-string potential))
+ (let [[sym-ns sym-name] (symbol-name-parts symbol-string)
+ [pot-ns pot-name] (symbol-name-parts potential)]
+ (and (or (= sym-ns pot-ns)
+ (and sym-ns pot-ns
+ (delimited-compound-prefix-match-acronym? "." sym-ns pot-ns)))
+ (or (delimited-compound-prefix-match-acronym? "-." sym-name pot-name)
+ (camel-compound-prefix-match? sym-name pot-name))))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_fuzzy.clj b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_fuzzy.clj
new file mode 100644
index 0000000..5aebb55
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_fuzzy.clj
@@ -0,0 +1,428 @@
+;;; swank_fuzzy.clj --- fuzzy symbol completion, Clojure implementation.
+
+;; Original CL implementation authors (from swank-fuzzy.lisp) below,
+;; Authors: Brian Downing <bdowning@lavos.net>
+;; Tobias C. Rittweiler <tcr@freebits.de>
+;; and others
+
+;; This progam is based on the swank-fuzzy.lisp.
+;; Thanks the CL implementation authors for that useful software.
+
+(ns swank.commands.contrib.swank-fuzzy
+ (:use (swank util core commands))
+ (:use (swank.util clojure)))
+
+(def #^{:dynamic true} *fuzzy-recursion-soft-limit* 30)
+(defn- compute-most-completions [short full]
+ (let [collect-chunk (fn [[pcur [[pa va] ys]] [pb vb]]
+ (let [xs (if (= (dec pb) pcur)
+ [[pa (str va vb)]]
+ [[pb vb] [pa va]])]
+ [pb (if ys (conj xs ys) xs)]))
+ step (fn step [short full pos chunk seed limit?]
+ (cond
+ (and (empty? full) (not (empty? short)))
+ nil
+ (or (empty? short) limit?)
+ (if chunk
+ (conj seed
+ (second (reduce collect-chunk
+ [(ffirst chunk) [(first chunk)]]
+ (rest chunk))))
+ seed)
+ (= (first short) (first full))
+ (let [seed2
+ (step short (rest full) (inc pos) chunk seed
+ (< *fuzzy-recursion-soft-limit* (count seed)))]
+ (recur (rest short) (rest full) (inc pos)
+ (conj chunk [pos (str (first short))])
+ (if (and seed2 (not (empty? seed2)))
+ seed2
+ seed)
+ false))
+ :else
+ (recur short (rest full) (inc pos) chunk seed false)))]
+ (map reverse (step short full 0 [] () false))))
+
+(def fuzzy-completion-symbol-prefixes "*+-%&?<")
+(def fuzzy-completion-word-separators "-/.")
+(def fuzzy-completion-symbol-suffixes "*+->?!")
+(defn- score-completion [completion short full]
+ (let [find1
+ (fn [c s]
+ (re-find (re-pattern (java.util.regex.Pattern/quote (str c))) s))
+ at-beginning? zero?
+ after-prefix?
+ (fn [pos]
+ (and (= pos 1)
+ (find1 (nth full 0) fuzzy-completion-symbol-prefixes)))
+ word-separator?
+ (fn [pos]
+ (find1 (nth full pos) fuzzy-completion-word-separators))
+ after-word-separator?
+ (fn [pos]
+ (find1 (nth full (dec pos)) fuzzy-completion-word-separators))
+ at-end?
+ (fn [pos]
+ (= pos (dec (count full))))
+ before-suffix?
+ (fn [pos]
+ (and (= pos (- (count full) 2))
+ (find1 (nth full (dec (count full)))
+ fuzzy-completion-symbol-suffixes)))]
+ (letfn [(score-or-percentage-of-previous
+ [base-score pos chunk-pos]
+ (if (zero? chunk-pos)
+ base-score
+ (max base-score
+ (+ (* (score-char (dec pos) (dec chunk-pos)) 0.85)
+ (Math/pow 1.2 chunk-pos)))))
+ (score-char
+ [pos chunk-pos]
+ (score-or-percentage-of-previous
+ (cond (at-beginning? pos) 10
+ (after-prefix? pos) 10
+ (word-separator? pos) 1
+ (after-word-separator? pos) 8
+ (at-end? pos) 6
+ (before-suffix? pos) 6
+ :else 1)
+ pos chunk-pos))
+ (score-chunk
+ [chunk]
+ (let [chunk-len (count (second chunk))]
+ (apply +
+ (map score-char
+ (take chunk-len (iterate inc (first chunk)))
+ (reverse (take chunk-len
+ (iterate dec (dec chunk-len))))))))]
+ (let [chunk-scores (map score-chunk completion)
+ length-score (/ 10.0 (inc (- (count full) (count short))))]
+ [(+ (apply + chunk-scores) length-score)
+ (list (map list chunk-scores completion) length-score)]))))
+
+(defn- compute-highest-scoring-completion [short full]
+ (let [scored-results
+ (map (fn [result]
+ [(first (score-completion result short full))
+ result])
+ (compute-most-completions short full))
+ winner (first (sort (fn [[av _] [bv _]] (> av bv))
+ scored-results))]
+ [(second winner) (first winner)]))
+
+(defn- call-with-timeout [time-limit-in-msec proc]
+ "Create a thunk that returns true if given time-limit-in-msec has been
+ elapsed and calls proc with the thunk as an argument. Returns a 3 elements
+ vec: A proc result, given time-limit-in-msec has been elapsed or not,
+ elapsed time in millisecond."
+ (let [timed-out (atom false)
+ start! (fn []
+ (future (do
+ (Thread/sleep time-limit-in-msec)
+ (swap! timed-out (constantly true)))))
+ timed-out? (fn [] @timed-out)
+ started-at (System/nanoTime)]
+ (start!)
+ [(proc timed-out?)
+ @timed-out
+ (/ (double (- (System/nanoTime) started-at)) 1000000.0)]))
+
+(defmacro with-timeout
+ "Create a thunk that returns true if given time-limit-in-msec has been
+ elapsed and bind it to timed-out?. Then execute body."
+ #^{:private true}
+ [[timed-out? time-limit-in-msec] & body]
+ `(call-with-timeout ~time-limit-in-msec (fn [~timed-out?] ~@body)))
+
+(defstruct fuzzy-matching
+ :var :ns :symbol :ns-name :score :ns-chunks :var-chunks)
+
+(defn- fuzzy-extract-matching-info [matching string]
+ (let [[user-ns-name _] (symbol-name-parts string)]
+ (cond
+ (:var matching)
+ [(str (:symbol matching))
+ (cond (nil? user-ns-name) nil
+ :else (:ns-name matching))]
+ :else
+ [""
+ (str (:symbol matching))])))
+
+(defn- fuzzy-find-matching-vars
+ [string ns var-filter external-only?]
+ (let [compute (partial compute-highest-scoring-completion string)
+ ns-maps (cond
+ external-only? ns-publics
+ (= ns *ns*) ns-map
+ :else ns-interns)]
+ (map (fn [[match-result score var sym]]
+ (if (var? var)
+ (struct fuzzy-matching
+ var nil (or (:name (meta var))
+ (symbol (pr-str var)))
+ nil
+ score nil match-result)
+ (struct fuzzy-matching
+ nil nil sym
+ nil
+ score nil match-result)))
+ (filter (fn [[match-result & _]]
+ (or (= string "")
+ (not-empty match-result)))
+ (map (fn [[k v]]
+ (if (= string "")
+ (conj [nil 0.0] v k)
+ (conj (compute (.toLowerCase (str k))) v k)))
+ (filter var-filter (seq (ns-maps ns))))))))
+(defn- fuzzy-find-matching-nss
+ [string]
+ (let [compute (partial compute-highest-scoring-completion string)]
+ (map (fn [[match-result score ns ns-sym]]
+ (struct fuzzy-matching nil ns ns-sym (str ns-sym)
+ score match-result nil))
+ (filter (fn [[match-result & _]] (not-empty match-result))
+ (map (fn [[ns-sym ns]]
+ (conj (compute (str ns-sym)) ns ns-sym))
+ (concat
+ (map (fn [ns] [(symbol (str ns)) ns]) (all-ns))
+ (ns-aliases *ns*)))))))
+
+(defn- fuzzy-generate-matchings
+ [string default-ns timed-out?]
+ (let [take* (partial take-while (fn [_] (not (timed-out?))))
+ [parsed-ns-name parsed-symbol-name] (symbol-name-parts string)
+ find-vars
+ (fn find-vars
+ ([designator ns]
+ (find-vars designator ns identity))
+ ([designator ns var-filter]
+ (find-vars designator ns var-filter nil))
+ ([designator ns var-filter external-only?]
+ (take* (fuzzy-find-matching-vars designator
+ ns
+ var-filter
+ external-only?))))
+ find-nss (comp take* fuzzy-find-matching-nss)
+ make-duplicate-var-filter
+ (fn [fuzzy-ns-matchings]
+ (let [nss (set (map :ns-name fuzzy-ns-matchings))]
+ (comp not nss str :ns meta second)))
+ matching-greater
+ (fn [a b]
+ (cond
+ (> (:score a) (:score b)) -1
+ (< (:score a) (:score b)) 1
+ :else (compare (:symbol a) (:symbol b))))
+ fix-up
+ (fn [matchings parent-package-matching]
+ (map (fn [m]
+ (assoc m
+ :ns-name (:ns-name parent-package-matching)
+ :ns-chunks (:ns-chunks parent-package-matching)
+ :score (if (= parsed-ns-name "")
+ (/ (:score parent-package-matching) 100)
+ (+ (:score parent-package-matching)
+ (:score m)))))
+ matchings))]
+ (sort matching-greater
+ (cond
+ (nil? parsed-ns-name)
+ (concat
+ (find-vars parsed-symbol-name (maybe-ns default-ns))
+ (find-nss parsed-symbol-name))
+ ;; (apply concat
+ ;; (let [ns *ns*]
+ ;; (pcalls #(binding [*ns* ns]
+ ;; (find-vars parsed-symbol-name
+ ;; (maybe-ns default-ns)))
+ ;; #(binding [*ns* ns]
+ ;; (find-nss parsed-symbol-name)))))
+ (= "" parsed-ns-name)
+ (find-vars parsed-symbol-name (maybe-ns default-ns))
+ :else
+ (let [found-nss (find-nss parsed-ns-name)
+ find-vars1 (fn [ns-matching]
+ (fix-up
+ (find-vars parsed-symbol-name
+ (:ns ns-matching)
+ (make-duplicate-var-filter
+ (filter (partial = ns-matching)
+ found-nss))
+ true)
+ ns-matching))]
+ (concat
+ (apply concat
+ (map find-vars1 (sort matching-greater found-nss)))
+ found-nss))))))
+
+(defn- fuzzy-format-matching [string matching]
+ (let [[symbol package] (fuzzy-extract-matching-info matching string)
+ result (str package (when package "/") symbol)]
+ [result (.indexOf #^String result #^String symbol)]))
+
+(defn- classify-matching [m]
+ (let [make-var-meta (fn [m]
+ (fn [key]
+ (when-let [var (:var m)]
+ (when-let [var-meta (meta var)]
+ (get var-meta key)))))
+ vm (make-var-meta m)]
+ (set
+ (filter
+ identity
+ [(when-not (or (vm :macro) (vm :arglists))
+ :boundp)
+ (when (vm :arglists) :fboundp)
+ ;; (:typespec)
+ ;; (:class)
+ (when (vm :macro) :macro)
+ (when (special-symbol? (:symbol m)) :special-operator)
+ (when (:ns-name m) :package)
+ (when (= clojure.lang.MultiFn (vm :tag))
+ :generic-function)]))))
+(defn- classification->string [flags]
+ (format (apply str (replicate 8 "%s"))
+ (if (or (:boundp flags)
+ (:constant flags)) "b" "-")
+ (if (:fboundp flags) "f" "-")
+ (if (:generic-function flags) "g" "-")
+ (if (:class flags) "c" "-")
+ (if (:typespec flags) "t" "-")
+ (if (:macro flags) "m" "-")
+ (if (:special-operator flags) "s" "-")
+ (if (:package flags) "p" "-")))
+
+(defn- fuzzy-convert-matching-for-emacs [string matching]
+ (let [[name added-length] (fuzzy-format-matching string matching)]
+ [name
+ (format "%.2f" (:score matching))
+ (concat (:ns-chunks matching)
+ (map (fn [[offset string]] [(+ added-length offset) string])
+ (:var-chunks matching)))
+ (classification->string (classify-matching matching))
+ ]))
+
+(defn- fuzzy-completion-set
+ [string default-ns limit time-limit-in-msec]
+ (let [[matchings interrupted? _]
+ (with-timeout [timed-out? time-limit-in-msec]
+ (vec (fuzzy-generate-matchings string default-ns timed-out?)))
+ subvec1 (if (and limit
+ (> limit 0)
+ (< limit (count matchings)))
+ (fn [v] (subvec v 0 limit))
+ identity)]
+ [(subvec1 (vec (map (partial fuzzy-convert-matching-for-emacs string)
+ matchings)))
+ interrupted?]))
+
+(defslimefn fuzzy-completions
+ [string default-package-name
+ _limit limit _time-limit-in-msec time-limit-in-msec]
+ (let [[xs x] (fuzzy-completion-set string default-package-name
+ limit time-limit-in-msec)]
+ (list
+ (map (fn [[symbol score chunks class]]
+ (list symbol score (map (partial apply list) chunks) class))
+ xs)
+ (when x 't))))
+
+(defslimefn fuzzy-completion-selected [_ _] nil)
+
+(comment
+ (do
+ (use '[clojure.test])
+
+ (is (= '(([0 "m"] [9 "v"] [15 "b"]))
+ (compute-most-completions "mvb" "multiple-value-bind")))
+ (is (= '(([0 "zz"]) ([0 "z"] [2 "z"]) ([1 "zz"]))
+ (compute-most-completions "zz" "zzz")))
+ (is (= 103
+ (binding [*fuzzy-recursion-soft-limit* 2]
+ (count
+ (compute-most-completions "ZZZZZZ" "ZZZZZZZZZZZZZZZZZZZZZZZ")))))
+
+ (are [x p s] (= x (score-completion [[p s]] s "*multiple-value+"))
+ '[10.625 (((10 [0 "*"])) 0.625)] 0 "*" ;; at-beginning
+ '[10.625 (((10 [1 "m"])) 0.625)] 1 "m" ;; after-prefix
+ '[1.625 (((1 [9 "-"])) 0.625)] 9 "-" ;; word-sep
+ '[8.625 (((8 [10 "v"])) 0.625)] 10 "v" ;; after-word-sep
+ '[6.625 (((6 [15 "+"])) 0.625)] 15 "+" ;; at-end
+ '[6.625 (((6 [14 "e"])) 0.625)] 14 "e" ;; before-suffix
+ '[1.625 (((1 [2 "u"])) 0.625)] 2 "u" ;; other
+ )
+ (is (= (+ 10 ;; m's score
+ (+ (* 10 0.85) (Math/pow 1.2 1))) ;; u's score
+ (let [[_ x]
+ (score-completion [[1 "mu"]] "mu" "*multiple-value+")]
+ ((comp first ffirst) x)))
+ "`m''s score + `u''s score (percentage of previous which is 'm''s)")
+
+ (is (= '[([0 "zz"]) 24.7]
+ (compute-highest-scoring-completion "zz" "zzz")))
+
+ (are [to? ret to proc] (= [ret to?]
+ (let [[x y _] (call-with-timeout to proc)]
+ [x y]))
+ false "r" 10 (fn [_] "r")
+ true nil 1 (fn [_] (Thread/sleep 10) nil))
+
+ (are [symbol package input] (= [symbol package]
+ (fuzzy-extract-matching-info
+ (struct fuzzy-matching
+ true nil
+ "symbol" "ns-name"
+ nil nil nil)
+ input))
+ "symbol" "ns-name" "p/*"
+ "symbol" nil "*")
+ (is (= ["" "ns-name"]
+ (fuzzy-extract-matching-info
+ (struct fuzzy-matching
+ nil nil
+ "ns-name" ""
+ nil nil nil)
+ "")))
+
+ (defmacro try! #^{:private true}
+ [& body]
+ `(do
+ ~@(map (fn [x] `(try ~x (catch Throwable ~'_ nil)))
+ body)))
+
+ (try
+ (def testing-testing0 't)
+ (def #^{:private true} testing-testing1 't)
+ (are [x external-only?] (= x
+ (vec
+ (sort
+ (map (comp str :symbol)
+ (fuzzy-find-matching-vars
+ "testing" *ns*
+ (fn [[k v]]
+ (and (= ((comp :ns meta) v) *ns*)
+ (re-find #"^testing-"
+ (str k))))
+ external-only?)))))
+ ["testing-testing0" "testing-testing1"] nil
+ ["testing-testing0"] true)
+ (finally
+ (try!
+ (ns-unmap *ns* 'testing-testing0)
+ (ns-unmap *ns* 'testing-testing1))))
+
+ (try
+ (create-ns 'testing-testing0)
+ (create-ns 'testing-testing1)
+ (is (= '["testing-testing0" "testing-testing1"]
+ (vec
+ (sort
+ (map (comp str :symbol)
+ (fuzzy-find-matching-nss "testing-"))))))
+ (finally
+ (try!
+ (remove-ns 'testing-testing0)
+ (remove-ns 'testing-testing1))))
+ )
+ )
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/indent.clj b/vim/bundle/slimv/swank-clojure/swank/commands/indent.clj
new file mode 100644
index 0000000..bafa9a8
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/indent.clj
@@ -0,0 +1,100 @@
+(ns swank.commands.indent
+ (:use (swank util core)
+ (swank.core hooks connection)
+ (swank.util hooks)))
+
+(defn- need-full-indentation-update?
+ "Return true if the indentation cache should be updated for all
+ namespaces.
+
+ This is a heuristic so as to avoid scanning all symbols from all
+ namespaces. Instead, we only check whether the set of namespaces in
+ the cache match the set of currently defined namespaces."
+ ([connection]
+ (not= (hash (all-ns))
+ (hash @(connection :indent-cache-pkg)))))
+
+(defn- find-args-body-position
+ "Given an arglist, return the number of arguments before
+ [... & body]
+ If no & body is found, nil will be returned"
+ ([args]
+ (when (coll? args)
+ (when-let [amp-position (position '#{&} args)]
+ (when-let [body-position (position '#{body clauses} args)]
+ (when (= (inc amp-position) body-position)
+ amp-position))))))
+
+(defn- find-arglists-body-position
+ "Find the smallest body position from an arglist"
+ ([arglists]
+ (let [positions (remove nil? (map find-args-body-position arglists))]
+ (when-not (empty? positions)
+ (apply min positions)))))
+
+(defn- find-var-body-position
+ "Returns a var's :indent override or the smallest body position of a
+ var's arglists"
+ ([var]
+ (let [var-meta (meta var)]
+ (or (:indent var-meta)
+ (find-arglists-body-position (:arglists var-meta))))))
+
+(defn- var-indent-representation
+ "Returns the slime indentation representation (name . position) for
+ a given var. If there is no indentation representation, nil is
+ returned."
+ ([var]
+ (when-let [body-position (find-var-body-position var)]
+ (when (or (= body-position 'defun)
+ (not (neg? body-position)))
+ (list (name (:name (meta var)))
+ '.
+ body-position)))))
+
+(defn- get-cache-update-for-var
+ "Checks whether a given var needs to be updated in a cache. If it
+ needs updating, return [var-name var-indentation-representation].
+ Otherwise return nil"
+ ([find-in-cache var]
+ (when-let [indent (var-indent-representation var)]
+ (let [name (:name (meta var))]
+ (when-not (= (find-in-cache name) indent)
+ [name indent])))))
+
+(defn- get-cache-updates-in-namespace
+ "Finds all cache updates needed within a namespace"
+ ([find-in-cache ns]
+ (remove nil? (map (partial get-cache-update-for-var find-in-cache) (vals (ns-interns ns))))))
+
+(defn- update-indentation-delta
+ "Update the cache and return the changes in a (symbol '. indent) list.
+ If FORCE is true then check all symbols, otherwise only check
+ symbols belonging to the buffer package"
+ ([cache-ref load-all-ns?]
+ (let [find-in-cache @cache-ref]
+ (let [namespaces (if load-all-ns? (all-ns) [(maybe-ns *current-package*)])
+ updates (mapcat (partial get-cache-updates-in-namespace find-in-cache) namespaces)]
+ (when (seq updates)
+ (dosync (alter cache-ref into updates))
+ (map second updates))))))
+
+(defn- perform-indentation-update
+ "Update the indentation cache in connection and update emacs.
+ If force is true, then start again without considering the old cache."
+ ([conn force]
+ (let [cache (conn :indent-cache)]
+ (let [delta (update-indentation-delta cache force)]
+ (dosync
+ (ref-set (conn :indent-cache-pkg) (hash (all-ns)))
+ (when (seq delta)
+ (send-to-emacs `(:indentation-update ~delta))))))))
+
+(defn- sync-indentation-to-emacs
+ "Send any indentation updates to Emacs via emacs-connection"
+ ([]
+ (perform-indentation-update
+ *current-connection*
+ (need-full-indentation-update? *current-connection*))))
+
+(add-hook pre-reply-hook #'sync-indentation-to-emacs)
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/inspector.clj b/vim/bundle/slimv/swank-clojure/swank/commands/inspector.clj
new file mode 100644
index 0000000..f8d490c
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/inspector.clj
@@ -0,0 +1,323 @@
+(ns swank.commands.inspector
+ (:use (swank util core commands)
+ (swank.core connection)))
+
+;;;; Inspector for basic clojure data structures
+
+;; This a mess, I'll clean up this code after I figure out exactly
+;; what I need for debugging support.
+
+(def inspectee (ref nil))
+(def inspectee-content (ref nil))
+(def inspectee-parts (ref nil))
+(def inspectee-actions (ref nil))
+(def inspector-stack (ref nil))
+(def inspector-history (ref nil))
+
+(defn reset-inspector []
+ (dosync
+ (ref-set inspectee nil)
+ (ref-set inspectee-content nil)
+ (ref-set inspectee-parts [])
+ (ref-set inspectee-actions [])
+ (ref-set inspector-stack nil)
+ (ref-set inspector-history [])))
+
+(defn inspectee-title [obj]
+ (cond
+ (instance? clojure.lang.LazySeq obj) (str "clojure.lang.LazySeq@...")
+ :else (str obj)))
+
+(defn print-part-to-string [value]
+ (let [s (inspectee-title value)
+ pos (position #{value} @inspector-history)]
+ (if pos
+ (str "#" pos "=" s)
+ s)))
+
+(defn assign-index [o dest]
+ (dosync
+ (let [index (count @dest)]
+ (alter dest conj o)
+ index)))
+
+(defn value-part [obj s]
+ (list :value (or s (print-part-to-string obj))
+ (assign-index obj inspectee-parts)))
+
+(defn action-part [label lambda refresh?]
+ (list :action label
+ (assign-index (list lambda refresh?)
+ inspectee-actions)))
+
+(defn label-value-line
+ ([label value] (label-value-line label value true))
+ ([label value newline?]
+ (list* (str label) ": " (list :value value)
+ (if newline? '((:newline)) nil))))
+
+(defmacro label-value-line* [& label-values]
+ `(concat ~@(map (fn [[label value]]
+ `(label-value-line ~label ~value))
+ label-values)))
+
+;; Inspection
+
+;; This is the simple version that only knows about clojure stuff.
+;; Many of these will probably be redefined by swank-clojure-debug
+(defmulti emacs-inspect
+ (fn known-types [obj]
+ (cond
+ (map? obj) :map
+ (vector? obj) :vector
+ (var? obj) :var
+ (string? obj) :string
+ (seq? obj) :seq
+ (instance? Class obj) :class
+ (instance? clojure.lang.Namespace obj) :namespace
+ (instance? clojure.lang.ARef obj) :aref
+ (.isArray (class obj)) :array)))
+
+(defn inspect-meta-information [obj]
+ (when (> (count (meta obj)) 0)
+ (concat
+ '("Meta Information: " (:newline))
+ (mapcat (fn [[key val]]
+ `(" " (:value ~key) " = " (:value ~val) (:newline)))
+ (meta obj)))))
+
+(defmethod emacs-inspect :map [obj]
+ (concat
+ (label-value-line*
+ ("Class" (class obj))
+ ("Count" (count obj)))
+ '("Contents: " (:newline))
+ (inspect-meta-information obj)
+ (mapcat (fn [[key val]]
+ `(" " (:value ~key) " = " (:value ~val)
+ (:newline)))
+ obj)))
+
+(defmethod emacs-inspect :vector [obj]
+ (concat
+ (label-value-line*
+ ("Class" (class obj))
+ ("Count" (count obj)))
+ '("Contents: " (:newline))
+ (inspect-meta-information obj)
+ (mapcat (fn [i val]
+ `(~(str " " i ". ") (:value ~val) (:newline)))
+ (iterate inc 0)
+ obj)))
+
+(defmethod emacs-inspect :array [obj]
+ (concat
+ (label-value-line*
+ ("Class" (class obj))
+ ("Count" (alength obj))
+ ("Component Type" (.getComponentType (class obj))))
+ '("Contents: " (:newline))
+ (mapcat (fn [i val]
+ `(~(str " " i ". ") (:value ~val) (:newline)))
+ (iterate inc 0)
+ obj)))
+
+(defmethod emacs-inspect :var [#^clojure.lang.Var obj]
+ (concat
+ (label-value-line*
+ ("Class" (class obj)))
+ (inspect-meta-information obj)
+ (when (.isBound obj)
+ `("Value: " (:value ~(var-get obj))))))
+
+(defmethod emacs-inspect :string [obj]
+ (concat
+ (label-value-line*
+ ("Class" (class obj)))
+ (inspect-meta-information obj)
+ (list (str "Value: " (pr-str obj)))))
+
+(defmethod emacs-inspect :seq [obj]
+ (concat
+ (label-value-line*
+ ("Class" (class obj)))
+ '("Contents: " (:newline))
+ (inspect-meta-information obj)
+ (mapcat (fn [i val]
+ `(~(str " " i ". ") (:value ~val) (:newline)))
+ (iterate inc 0)
+ obj)))
+
+(defmethod emacs-inspect :default [obj]
+ (let [fields (. (class obj) getDeclaredFields)
+ names (map (memfn getName) fields)
+ get (fn [f]
+ (try (.setAccessible f true)
+ (catch java.lang.SecurityException e))
+ (try (.get f obj)
+ (catch java.lang.IllegalAccessException e
+ "Access denied.")))
+ vals (map get fields)]
+ (concat
+ `("Type: " (:value ~(class obj)) (:newline)
+ "Value: " (:value ~obj) (:newline)
+ "---" (:newline)
+ "Fields: " (:newline))
+ (mapcat
+ (fn [name val]
+ `(~(str " " name ": ") (:value ~val) (:newline))) names vals))))
+
+(defmethod emacs-inspect :class [#^Class obj]
+ (let [meths (. obj getMethods)
+ fields (. obj getFields)]
+ (concat
+ `("Type: " (:value ~(class obj)) (:newline)
+ "---" (:newline)
+ "Fields: " (:newline))
+ (mapcat (fn [f]
+ `(" " (:value ~f) (:newline))) fields)
+ '("---" (:newline)
+ "Methods: " (:newline))
+ (mapcat (fn [m]
+ `(" " (:value ~m) (:newline))) meths))))
+
+(defmethod emacs-inspect :aref [#^clojure.lang.ARef obj]
+ `("Type: " (:value ~(class obj)) (:newline)
+ "Value: " (:value ~(deref obj)) (:newline)))
+
+(defn ns-refers-by-ns [#^clojure.lang.Namespace ns]
+ (group-by (fn [#^clojure.lang.Var v] (. v ns))
+ (map val (ns-refers ns))))
+
+(defmethod emacs-inspect :namespace [#^clojure.lang.Namespace obj]
+ (concat
+ (label-value-line*
+ ("Class" (class obj))
+ ("Count" (count (ns-map obj))))
+ '("---" (:newline)
+ "Refer from: " (:newline))
+ (mapcat (fn [[ns refers]]
+ `(" "(:value ~ns) " = " (:value ~refers) (:newline)))
+ (ns-refers-by-ns obj))
+ (label-value-line*
+ ("Imports" (ns-imports obj))
+ ("Interns" (ns-interns obj)))))
+
+(defn inspector-content [specs]
+ (letfn [(spec-seq [seq]
+ (let [[f & args] seq]
+ (cond
+ (= f :newline) (str \newline)
+
+ (= f :value)
+ (let [[obj & [str]] args]
+ (value-part obj str))
+
+ (= f :action)
+ (let [[label lambda & options] args
+ {:keys [refresh?]} (apply hash-map options)]
+ (action-part label lambda refresh?)))))
+ (spec-value [val]
+ (cond
+ (string? val) val
+ (seq? val) (spec-seq val)))]
+ (map spec-value specs)))
+
+;; Works for infinite sequences, but it lies about length. Luckily, emacs doesn't
+;; care.
+(defn content-range [lst start end]
+ (let [amount-wanted (- end start)
+ shifted (drop start lst)
+ taken (take amount-wanted shifted)
+ amount-taken (count taken)]
+ (if (< amount-taken amount-wanted)
+ (list taken (+ amount-taken start) start end)
+ ;; There's always more until we know there isn't
+ (list taken (+ end 500) start end))))
+
+(defn inspect-object [o]
+ (dosync
+ (ref-set inspectee o)
+ (alter inspector-stack conj o)
+ (when-not (filter #(identical? o %) @inspector-history)
+ (alter inspector-history conj o))
+ (ref-set inspectee-content (inspector-content (emacs-inspect o)))
+ (list :title (inspectee-title o)
+ :id (assign-index o inspectee-parts)
+ :content (content-range @inspectee-content 0 500))))
+
+(defslimefn init-inspector [string]
+ (with-emacs-package
+ (reset-inspector)
+ (inspect-object (eval (read-string string)))))
+
+(defn inspect-in-emacs [what]
+ (letfn [(send-it []
+ (with-emacs-package
+ (reset-inspector)
+ (send-to-emacs `(:inspect ~(inspect-object what)))))]
+ (cond
+ *current-connection* (send-it)
+ (comment (first @connections))
+ ;; TODO: take a second look at this, will probably need garbage collection on connections
+ (comment
+ (binding [*current-connection* (first @connections)]
+ (send-it))))))
+
+(defslimefn inspect-frame-var [frame index]
+ (if (and (zero? frame) *current-env*)
+ (let [locals *current-env*
+ object (locals (nth (keys locals) index))]
+ (with-emacs-package
+ (reset-inspector)
+ (inspect-object object)))))
+
+(defslimefn inspector-nth-part [index]
+ (get @inspectee-parts index))
+
+(defslimefn inspect-nth-part [index]
+ (with-emacs-package
+ (inspect-object ((slime-fn 'inspector-nth-part) index))))
+
+(defslimefn inspector-range [from to]
+ (content-range @inspectee-content from to))
+
+(defn ref-pop [ref]
+ (let [[f & r] @ref]
+ (ref-set ref r)
+ f))
+
+(defslimefn inspector-call-nth-action [index & args]
+ (let [[fn refresh?] (get @inspectee-actions index)]
+ (apply fn args)
+ (if refresh?
+ (inspect-object (dosync (ref-pop inspector-stack)))
+ nil)))
+
+(defslimefn inspector-pop []
+ (with-emacs-package
+ (cond
+ (rest @inspector-stack)
+ (inspect-object
+ (dosync
+ (ref-pop inspector-stack)
+ (ref-pop inspector-stack)))
+ :else nil)))
+
+(defslimefn inspector-next []
+ (with-emacs-package
+ (let [pos (position #{@inspectee} @inspector-history)]
+ (cond
+ (= (inc pos) (count @inspector-history)) nil
+ :else (inspect-object (get @inspector-history (inc pos)))))))
+
+(defslimefn inspector-reinspect []
+ (inspect-object @inspectee))
+
+(defslimefn quit-inspector []
+ (reset-inspector)
+ nil)
+
+(defslimefn describe-inspectee []
+ (with-emacs-package
+ (str @inspectee)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/xref.clj b/vim/bundle/slimv/swank-clojure/swank/commands/xref.clj
new file mode 100644
index 0000000..16af826
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/xref.clj
@@ -0,0 +1,51 @@
+(ns swank.commands.xref
+ (:use clojure.walk swank.util)
+ (:import (clojure.lang RT)
+ (java.io LineNumberReader InputStreamReader PushbackReader)))
+
+;; Yoinked and modified from clojure.contrib.repl-utils.
+;; Now takes a var instead of a sym in the current ns
+(defn- get-source-from-var
+ "Returns a string of the source code for the given symbol, if it can
+find it. This requires that the symbol resolve to a Var defined in
+a namespace for which the .clj is in the classpath. Returns nil if
+it can't find the source.
+Example: (get-source-from-var 'filter)"
+ [v] (when-let [filepath (:file (meta v))]
+ (when-let [strm (.getResourceAsStream (RT/baseLoader) filepath)]
+ (with-open [rdr (LineNumberReader. (InputStreamReader. strm))]
+ (dotimes [_ (dec (:line (meta v)))] (.readLine rdr))
+ (let [text (StringBuilder.)
+ pbr (proxy [PushbackReader] [rdr]
+ (read [] (let [i (proxy-super read)]
+ (.append text (char i))
+ i)))]
+ (read (PushbackReader. pbr))
+ (str text))))))
+
+(defn- recursive-contains? [coll obj]
+ "True if coll contains obj. Obj can't be a seq"
+ (not (empty? (filter #(= obj %) (flatten coll)))))
+
+(defn- does-var-call-fn [var fn]
+ "Checks if a var calls a function named 'fn"
+ (if-let [source (get-source-from-var var)]
+ (let [node (read-string source)]
+ (if (recursive-contains? node fn)
+ var
+ false))))
+
+(defn- does-ns-refer-to-var? [ns var]
+ (ns-resolve ns var))
+
+(defn all-vars-who-call [sym]
+ (filter
+ ifn?
+ (filter
+ #(identity %)
+ (map #(does-var-call-fn % sym)
+ (flatten
+ (map vals
+ (map ns-interns
+ (filter #(does-ns-refer-to-var? % sym)
+ (all-ns)))))))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/core.clj b/vim/bundle/slimv/swank-clojure/swank/core.clj
new file mode 100644
index 0000000..892b6a8
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core.clj
@@ -0,0 +1,388 @@
+(ns swank.core
+ (:use (swank util commands)
+ (swank.util hooks)
+ (swank.util.concurrent thread)
+ (swank.core connection hooks threadmap))
+ (:require (swank.util.concurrent [mbox :as mb])))
+
+;; Protocol version
+(defonce protocol-version (atom "20100404"))
+
+;; Emacs packages
+(def #^{:dynamic true} *current-package*)
+
+;; current emacs eval id
+(def #^{:dynamic true} *pending-continuations* '())
+
+(def sldb-stepping-p nil)
+(def sldb-initial-frames 10)
+(def #^{:dynamic true} #^{:doc "The current level of recursive debugging."}
+ *sldb-level* 0)
+(def #^{:dynamic true} #^{:doc "The current restarts."}
+ *sldb-restarts* 0)
+
+(def #^{:doc "Include swank-clojure thread in stack trace for debugger."}
+ debug-swank-clojure false)
+
+(defonce active-threads (ref ()))
+
+(defn maybe-ns [package]
+ (cond
+ (symbol? package) (or (find-ns package) (maybe-ns 'user))
+ (string? package) (maybe-ns (symbol package))
+ (keyword? package) (maybe-ns (name package))
+ (instance? clojure.lang.Namespace package) package
+ :else (maybe-ns 'user)))
+
+(defmacro with-emacs-package [& body]
+ `(binding [*ns* (maybe-ns *current-package*)]
+ ~@body))
+
+(defmacro with-package-tracking [& body]
+ `(let [last-ns# *ns*]
+ (try
+ ~@body
+ (finally
+ (when-not (= last-ns# *ns*)
+ (send-to-emacs `(:new-package ~(str (ns-name *ns*))
+ ~(str (ns-name *ns*)))))))))
+
+(defmacro dothread-swank [& body]
+ `(dothread-keeping-clj [*current-connection*]
+ ~@body))
+
+;; Exceptions for debugging
+(defonce debug-quit-exception (Exception. "Debug quit"))
+(defonce debug-continue-exception (Exception. "Debug continue"))
+(defonce debug-abort-exception (Exception. "Debug abort"))
+
+(def #^{:dynamic true} #^Throwable *current-exception* nil)
+
+;; Local environment
+(def #^{:dynamic true} *current-env* nil)
+
+(let [&env :unavailable]
+ (defmacro local-bindings
+ "Produces a map of the names of local bindings to their values."
+ []
+ (if-not (= &env :unavailable)
+ (let [symbols (keys &env)]
+ (zipmap (map (fn [sym] `(quote ~sym)) symbols) symbols)))))
+
+;; Handle Evaluation
+(defn send-to-emacs
+ "Sends a message (msg) to emacs."
+ ([msg]
+ (mb/send @(*current-connection* :control-thread) msg)))
+
+(defn send-repl-results-to-emacs [val]
+ (send-to-emacs `(:write-string ~(str (pr-str val) "\n") :repl-result)))
+
+(defn with-env-locals
+ "Evals a form with given locals. The locals should be a map of symbols to
+values."
+ [form]
+ (if (seq *current-env*)
+ `(let ~(vec (mapcat #(list % `(*current-env* '~%)) (keys *current-env*)))
+ ~form)
+ form))
+
+(defn eval-in-emacs-package [form]
+ (with-emacs-package
+ (eval form)))
+
+
+(defn eval-from-control
+ "Blocks for a mbox message from the control thread and executes it
+ when received. The mbox message is expected to be a slime-fn."
+ ([] (let [form (mb/receive (current-thread))]
+ (apply (ns-resolve *ns* (first form)) (rest form)))))
+
+(defn eval-loop
+ "A loop which continuosly reads actions from the control thread and
+ evaluates them (will block if no mbox message is available)."
+ ([] (continuously (eval-from-control))))
+
+(defn exception-causes [#^Throwable t]
+ (lazy-seq
+ (cons t (when-let [cause (.getCause t)]
+ (exception-causes cause)))))
+
+(defn- debug-quit-exception? [t]
+ (some #(identical? debug-quit-exception %) (exception-causes t)))
+
+(defn- debug-continue-exception? [t]
+ (some #(identical? debug-continue-exception %) (exception-causes t)))
+
+(defn- debug-abort-exception? [t]
+ (some #(identical? debug-abort-exception %) (exception-causes t)))
+
+(defn exception-stacktrace [t]
+ (map #(list %1 %2 '(:restartable nil))
+ (iterate inc 0)
+ (map str (.getStackTrace t))))
+
+(defn debugger-condition-for-emacs []
+ (list (or (.getMessage *current-exception*) "No message.")
+ (str " [Thrown " (class *current-exception*) "]")
+ nil))
+
+(defn make-restart [kw name description f]
+ [kw [name description f]])
+
+(defn add-restart-if [condition restarts kw name description f]
+ (if condition
+ (conj restarts (make-restart kw name description f))
+ restarts))
+
+(declare sldb-debug)
+(defn cause-restart-for [thrown depth]
+ (make-restart
+ (keyword (str "cause" depth))
+ (str "CAUSE" depth)
+ (str "Invoke debugger on cause "
+ (apply str (take depth (repeat " ")))
+ (.getMessage thrown)
+ " [Thrown " (class thrown) "]")
+ (partial sldb-debug nil thrown *pending-continuations*)))
+
+(defn add-cause-restarts [restarts thrown]
+ (loop [restarts restarts
+ cause (.getCause thrown)
+ level 1]
+ (if cause
+ (recur
+ (conj restarts (cause-restart-for cause level))
+ (.getCause cause)
+ (inc level))
+ restarts)))
+
+(defn calculate-restarts [thrown]
+ (let [restarts [(make-restart :quit "QUIT" "Quit to the SLIME top level"
+ (fn [] (throw debug-quit-exception)))]
+ restarts (add-restart-if
+ (pos? *sldb-level*)
+ restarts
+ :abort "ABORT" (str "ABORT to SLIME level " (dec *sldb-level*))
+ (fn [] (throw debug-abort-exception)))
+ restarts (add-restart-if
+ (and (.getMessage thrown)
+ (.contains (.getMessage thrown) "BREAK"))
+ restarts
+ :continue "CONTINUE" (str "Continue from breakpoint")
+ (fn [] (throw debug-continue-exception)))
+ restarts (add-cause-restarts restarts thrown)]
+ (into (array-map) restarts)))
+
+(defn format-restarts-for-emacs []
+ (doall (map #(list (first (second %)) (second (second %))) *sldb-restarts*)))
+
+(defn build-backtrace [start end]
+ (doall (take (- end start) (drop start (exception-stacktrace *current-exception*)))))
+
+(defn build-debugger-info-for-emacs [start end]
+ (list (debugger-condition-for-emacs)
+ (format-restarts-for-emacs)
+ (build-backtrace start end)
+ *pending-continuations*))
+
+(defn sldb-loop
+ "A loop that is intented to take over an eval thread when a debug is
+ encountered (an continue to perform the same thing). It will
+ continue until a *debug-quit* exception is encountered."
+ [level]
+ (try
+ (send-to-emacs
+ (list* :debug (current-thread) level
+ (build-debugger-info-for-emacs 0 sldb-initial-frames)))
+ ([] (continuously
+ (do
+ (send-to-emacs `(:debug-activate ~(current-thread) ~level nil))
+ (eval-from-control))))
+ (catch Throwable t
+ (send-to-emacs
+ `(:debug-return ~(current-thread) ~*sldb-level* ~sldb-stepping-p))
+ (if-not (debug-continue-exception? t)
+ (throw t)))))
+
+(defn invoke-debugger
+ [locals #^Throwable thrown id]
+ (binding [*current-env* locals
+ *current-exception* thrown
+ *sldb-restarts* (calculate-restarts thrown)
+ *sldb-level* (inc *sldb-level*)]
+ (sldb-loop *sldb-level*)))
+
+(defn sldb-debug [locals thrown id]
+ (try
+ (invoke-debugger nil thrown id)
+ (catch Throwable t
+ (when (and (pos? *sldb-level*)
+ (not (debug-abort-exception? t)))
+ (throw t)))))
+
+(defmacro break
+ []
+ `(invoke-debugger (local-bindings) (Exception. "BREAK:") *pending-continuations*))
+
+(defn doall-seq [coll]
+ (if (seq? coll)
+ (doall coll)
+ coll))
+
+(defn eval-for-emacs [form buffer-package id]
+ (try
+ (binding [*current-package* buffer-package
+ *pending-continuations* (cons id *pending-continuations*)]
+ (if-let [f (slime-fn (first form))]
+ (let [form (cons f (rest form))
+ result (doall-seq (eval-in-emacs-package form))]
+ (run-hook pre-reply-hook)
+ (send-to-emacs `(:return ~(thread-name (current-thread))
+ (:ok ~result) ~id)))
+ ;; swank function not defined, abort
+ (send-to-emacs `(:return ~(thread-name (current-thread)) (:abort) ~id))))
+ (catch Throwable t
+ ;; Thread/interrupted clears this thread's interrupted status; if
+ ;; Thread.stop was called on us it may be set and will cause an
+ ;; InterruptedException in one of the send-to-emacs calls below
+ (Thread/interrupted)
+
+ ;; (.printStackTrace t #^java.io.PrintWriter *err*)
+
+ (cond
+ (debug-quit-exception? t)
+ (do
+ (send-to-emacs `(:return ~(thread-name (current-thread)) (:abort) ~id))
+ (if-not (zero? *sldb-level*)
+ (throw t)))
+
+ (debug-abort-exception? t)
+ (do
+ (send-to-emacs `(:return ~(thread-name (current-thread)) (:abort) ~id))
+ (if-not (zero? *sldb-level*)
+ (throw debug-abort-exception)))
+
+ (debug-continue-exception? t)
+ (do
+ (send-to-emacs `(:return ~(thread-name (current-thread)) (:abort) ~id))
+ (throw t))
+
+ :else
+ (do
+ (set! *e t)
+ (try
+ (sldb-debug
+ nil
+ (if debug-swank-clojure t (or (.getCause t) t))
+ id)
+ ;; reply with abort
+ (finally (send-to-emacs `(:return ~(thread-name (current-thread)) (:abort) ~id)))))))))
+
+(defn- add-active-thread [thread]
+ (dosync
+ (commute active-threads conj thread)))
+
+(defn- remove-active-thread [thread]
+ (dosync
+ (commute active-threads (fn [threads] (remove #(= % thread) threads)))))
+
+(defn spawn-worker-thread
+ "Spawn an thread that blocks for a single command from the control
+ thread, executes it, then terminates."
+ ([conn]
+ (dothread-swank
+ (try
+ (add-active-thread (current-thread))
+ (thread-set-name "Swank Worker Thread")
+ (eval-from-control)
+ (finally
+ (remove-active-thread (current-thread)))))))
+
+(defn spawn-repl-thread
+ "Spawn an thread that sets itself as the current
+ connection's :repl-thread and then enters an eval-loop"
+ ([conn]
+ (dothread-swank
+ (thread-set-name "Swank REPL Thread")
+ (with-connection conn
+ (eval-loop)))))
+
+(defn find-or-spawn-repl-thread
+ "Returns the current connection's repl-thread or create a new one if
+ the existing one does not exist."
+ ([conn]
+ ;; TODO - check if an existing repl-agent is still active & doesn't have errors
+ (dosync
+ (or (when-let [conn-repl-thread @(conn :repl-thread)]
+ (when (.isAlive #^Thread conn-repl-thread)
+ conn-repl-thread))
+ (ref-set (conn :repl-thread)
+ (spawn-repl-thread conn))))))
+
+(defn thread-for-evaluation
+ "Given an id and connection, find or create the appropiate agent."
+ ([id conn]
+ (cond
+ (= id true) (spawn-worker-thread conn)
+ (= id :repl-thread) (find-or-spawn-repl-thread conn)
+ :else (find-thread id))))
+
+;; Handle control
+(defn read-loop
+ "A loop that reads from the socket (will block when no message
+ available) and dispatches the message to the control thread."
+ ([conn control]
+ (with-connection conn
+ (continuously (mb/send control (read-from-connection conn))))))
+
+(defn dispatch-event
+ "Dispatches/executes an event in the control thread's mailbox queue."
+ ([ev conn]
+ (let [[action & args] ev]
+ (cond
+ (= action :emacs-rex)
+ (let [[form-string package thread id] args
+ thread (thread-for-evaluation thread conn)]
+ (mb/send thread `(eval-for-emacs ~form-string ~package ~id)))
+
+ (= action :return)
+ (let [[thread & ret] args]
+ (binding [*print-level* nil, *print-length* nil]
+ (write-to-connection conn `(:return ~@ret))))
+
+ (one-of? action
+ :presentation-start :presentation-end
+ :new-package :new-features :ed :percent-apply
+ :indentation-update
+ :eval-no-wait :background-message :inspect)
+ (binding [*print-level* nil, *print-length* nil]
+ (write-to-connection conn ev))
+
+ (= action :write-string)
+ (write-to-connection conn ev)
+
+ (one-of? action
+ :debug :debug-condition :debug-activate :debug-return)
+ (let [[thread & args] args]
+ (write-to-connection conn `(~action ~(thread-map-id thread) ~@args)))
+
+ (= action :emacs-interrupt)
+ (let [[thread & args] args]
+ (dosync
+ (cond
+ (and (true? thread) (seq @active-threads))
+ (.stop #^Thread (first @active-threads))
+ (= thread :repl-thread) (.stop #^Thread @(conn :repl-thread)))))
+ :else
+ nil))))
+
+;; Main loop definitions
+(defn control-loop
+ "A loop that reads from the mbox queue and runs dispatch-event on
+ it (will block if no mbox control message is available). This is
+ intended to only be run on the control thread."
+ ([conn]
+ (binding [*1 nil, *2 nil, *3 nil, *e nil]
+ (with-connection conn
+ (continuously (dispatch-event (mb/receive (current-thread)) conn))))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/connection.clj b/vim/bundle/slimv/swank-clojure/swank/core/connection.clj
new file mode 100644
index 0000000..1b78bc6
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/connection.clj
@@ -0,0 +1,68 @@
+(ns swank.core.connection
+ (:use (swank util)
+ (swank.util sys)
+ (swank.core protocol))
+ (:import (java.net ServerSocket Socket InetAddress)
+ (java.io InputStreamReader OutputStreamWriter)))
+
+(def #^{:dynamic true} *current-connection*)
+(def default-encoding "iso-8859-1")
+
+(defmacro with-connection [conn & body]
+ `(binding [*current-connection* ~conn] ~@body))
+
+(def encoding-map
+ {"latin-1" "iso-8859-1"
+ "latin-1-unix" "iso-8859-1"
+ "iso-latin-1-unix" "iso-8859-1"
+ "iso-8859-1" "iso-8859-1"
+ "iso-8859-1-unix" "iso-8859-1"
+
+ "utf-8" "utf-8"
+ "utf-8-unix" "utf-8"
+
+ "euc-jp" "euc-jp"
+ "euc-jp-unix" "euc-jp"
+
+ "us-ascii" "us-ascii"
+ "us-ascii-unix" "us-ascii"})
+
+(defn make-connection ;; rename to make-swank-connection
+ "Given a `socket', creates a swank connection. Accepts an optional
+ argument `encoding' to define the encoding of the connection. If
+ encoding is nil, then the default encoding will be used.
+
+ See also: `default-encoding', `start-server-socket!'"
+ ([#^Socket socket] (make-connection socket default-encoding))
+ ([#^Socket socket encoding]
+ (let [#^String
+ encoding (or (encoding-map encoding encoding) default-encoding)]
+ {:socket socket
+ :reader (InputStreamReader. (.getInputStream socket) encoding)
+ :writer (OutputStreamWriter. (.getOutputStream socket) encoding)
+ :writer-redir (ref nil)
+
+ :indent-cache (ref {})
+ :indent-cache-pkg (ref nil)
+
+ :control-thread (ref nil)
+ :read-thread (ref nil)
+ :repl-thread (ref nil)})))
+
+(defn read-from-connection
+ "Reads a single message from a swank-connection.
+
+ See also: `write-to-connection', `read-swank-message',
+ `make-swank-connection'"
+ ([] (read-from-connection *current-connection*))
+ ([conn]
+ (read-swank-message (conn :reader))))
+
+(defn write-to-connection
+ "Writes a single message to a swank-connection.
+
+ See also: `read-from-connection', `write-swank-message',
+ `make-swank-connection'"
+ ([msg] (write-to-connection *current-connection* msg))
+ ([conn msg]
+ (write-swank-message (conn :writer) msg)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/hooks.clj b/vim/bundle/slimv/swank-clojure/swank/core/hooks.clj
new file mode 100644
index 0000000..93b5963
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/hooks.clj
@@ -0,0 +1,4 @@
+(ns swank.core.hooks
+ (:use (swank.util hooks)))
+
+(defhook pre-reply-hook) \ No newline at end of file
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/protocol.clj b/vim/bundle/slimv/swank-clojure/swank/core/protocol.clj
new file mode 100644
index 0000000..409d189
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/protocol.clj
@@ -0,0 +1,50 @@
+(ns swank.core.protocol
+ (:use (swank util)
+ (swank.util io))
+ (:require swank.rpc))
+
+;; Read forms
+(def #^{:private true}
+ namespace-re #"(^\(:emacs-rex \([a-zA-Z][a-zA-Z0-9]+):")
+
+(defn- fix-namespace
+ "Changes the namespace of a function call from pkg:fn to ns/fn. If
+ no pkg exists, then nothing is done."
+ ([text] (.replaceAll (re-matcher namespace-re text) "$1/")))
+
+(defn write-swank-message
+ "Given a `writer' (java.io.Writer) and a `message' (typically an
+ sexp), encode the message according to the swank protocol and
+ write the message into the writer."
+ ([#^java.io.Writer writer message]
+ (swank.rpc/encode-message writer message))
+ {:tag String})
+
+(def read-fail-exception (Exception. "Error reading swank message"))
+
+(defn read-swank-message
+ "Given a `reader' (java.io.Reader), read the message as a clojure
+ form (typically a sexp). This method will block until a message is
+ completely transfered.
+
+ Note: This function will do some amount of Common Lisp -> clojure
+ conversions. This is due to the fact that several slime functions
+ like to treat everything it's talking to as a common lisp
+ implementation.
+ - If an :emacs-rex form is received and the first form contains a
+ common lisp package designation, this will convert it to use a
+ clojure designation.
+ - t will be converted to true
+
+ See also `write-swank-message'."
+ ([#^java.io.Reader reader]
+ (let [len (Integer/parseInt (read-chars reader 6 read-fail-exception) 16)
+ msg (read-chars reader len read-fail-exception)
+ form (try
+ (read-string (fix-namespace msg))
+ (catch Exception ex
+ (.println System/err (format "unreadable message: %s" msg))
+ (throw ex)))]
+ (if (seq? form)
+ (deep-replace {'t true} form)
+ form))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/server.clj b/vim/bundle/slimv/swank-clojure/swank/core/server.clj
new file mode 100644
index 0000000..1c9f70a
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/server.clj
@@ -0,0 +1,102 @@
+(ns swank.core.server
+ (:use (swank util core)
+ (swank.util sys io)
+ (swank.util.concurrent thread)
+ (swank.util.net sockets)
+ (swank.core connection protocol))
+ (:import (java.io File FileReader BufferedReader InputStreamReader OutputStreamWriter)
+ (java.net Socket)))
+
+;; The swank.core.server is the layer above swank.util.net.sockets
+;; - Manages the socket server
+;; - Accepts and authenticates incoming connections
+;; - Creates swank.core.connections
+;; - Spins up new threads
+
+(defonce connections (ref []))
+
+(def slime-secret-path (str (user-home-path) File/separator ".slime-secret"))
+
+(defn- slime-secret
+ "Returns the first line from the slime-secret file, path found in
+ slime-secret-path (default: .slime-secret in the user's home
+ directory).
+
+ See also: `accept-authenticated-connection'"
+ ([] (failing-gracefully
+ (let [slime-secret-file (File. (str (user-home-path) File/separator ".slime-secret"))]
+ (when (and (.isFile slime-secret-file) (.canRead slime-secret-file))
+ (with-open [secret (BufferedReader. (FileReader. slime-secret-file))]
+ (.readLine secret)))))))
+
+(defn- accept-authenticated-connection ;; rename to authenticate-socket, takes in a connection
+ "Accepts and returns new connection if it is from an authenticated
+ machine. Otherwise, return nil.
+
+ Authentication depends on the contents of a slime-secret file on
+ both the server (swank) and the client (emacs slime). If no
+ slime-secret file is provided on the server side, all connections
+ are accepted.
+
+ See also: `slime-secret'"
+ ([#^Socket socket opts]
+ (returning [conn (make-connection socket (get opts :encoding default-encoding))]
+ (if-let [secret (slime-secret)]
+ (when-not (= (read-from-connection conn) secret)
+ (close-socket! socket))
+ conn))))
+
+(defn- make-output-redirection
+ ([conn]
+ (call-on-flush-stream
+ #(with-connection conn
+ (send-to-emacs `(:write-string ~%)))))
+ {:tag java.io.StringWriter})
+
+(defn- socket-serve [connection-serve socket opts]
+ (with-connection (accept-authenticated-connection socket opts)
+ (let [out-redir (java.io.PrintWriter. (make-output-redirection
+ *current-connection*))]
+ (binding [*out* out-redir
+ *err* out-redir]
+ (dosync (ref-set (*current-connection* :writer-redir) *out*))
+ (dosync (alter connections conj *current-connection*))
+ (connection-serve *current-connection*)))))
+
+;; Setup frontent
+(defn start-swank-socket-server!
+ "Starts and returns the socket server as a swank host. Takes an
+ optional set of options as a map:
+
+ :announce - an fn that will be called and provided with the
+ listening port of the newly established server. Default: none."
+ ([server connection-serve] (start-swank-socket-server! connection-serve {}))
+ ([server connection-serve options]
+ (start-server-socket! server connection-serve)
+ (when-let [announce (options :announce)]
+ (announce (.getLocalPort server)))
+ server))
+
+(defn setup-server
+ "The port it started on will be called as an argument to (announce-fn
+ port). A connection will then be created and (connection-serve conn)
+ will then be called."
+ [port announce-fn connection-serve opts]
+ (start-swank-socket-server!
+ (make-server-socket {:port port
+ :host (opts :host "localhost")
+ :backlog (opts :backlog 0)})
+ #(socket-serve connection-serve % opts)
+ {:announce announce-fn}))
+
+;; Announcement functions
+(defn simple-announce [port]
+ (println "Connection opened on local port " port))
+
+(defn announce-port-to-file
+ "Writes the given port number into a file."
+ ([#^String file port]
+ (with-open [out (new java.io.FileWriter file)]
+ (doto out
+ (.write (str port "\n"))
+ (.flush)))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/threadmap.clj b/vim/bundle/slimv/swank-clojure/swank/core/threadmap.clj
new file mode 100644
index 0000000..246a3d2
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/threadmap.clj
@@ -0,0 +1,29 @@
+(ns swank.core.threadmap
+ (:use (swank util)
+ (swank.util.concurrent thread)))
+
+(defonce thread-map-next-id (ref 1))
+(defonce thread-map (ref {}))
+
+(defn- thread-map-clean []
+ (doseq [[id t] @thread-map]
+ (when (or (nil? t)
+ (not (thread-alive? t)))
+ (dosync
+ (alter thread-map dissoc id)))))
+
+(defn- get-thread-id [thread]
+ (if-let [entry (find-first #(= (val %) thread) @thread-map)]
+ (key entry)
+ (let [next-id @thread-map-next-id]
+ (alter thread-map assoc next-id thread)
+ (alter thread-map-next-id inc)
+ next-id)))
+
+(defn thread-map-id [thread]
+ (returning [id (dosync (get-thread-id thread))]
+ (thread-map-clean)))
+
+(defn find-thread [id]
+ (@thread-map id))
+
diff --git a/vim/bundle/slimv/swank-clojure/swank/dev.clj b/vim/bundle/slimv/swank-clojure/swank/dev.clj
new file mode 100644
index 0000000..3d702ee
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/dev.clj
@@ -0,0 +1,6 @@
+(ns swank.dev
+ (:use (swank util)))
+
+(defmacro with-swank-io [& body]
+ `(binding [*out* @(:writer-redir (first @swank.core.server/connections))]
+ ~@body))
diff --git a/vim/bundle/slimv/swank-clojure/swank/loader.clj b/vim/bundle/slimv/swank-clojure/swank/loader.clj
new file mode 100644
index 0000000..27466f6
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/loader.clj
@@ -0,0 +1,101 @@
+(ns swank.loader
+ (:require [swank.util.sys :as sys]
+ [swank.util.clojure :as clj])
+ (:import [java.io File]))
+
+(defonce #^File *swank-source-path*
+ (if-let [resource (.getResource (clojure.lang.RT/baseLoader)
+ #^String *file*)]
+ (.getParentFile (File. (.getFile resource)))))
+
+(defonce #^File *swank-compile-path*
+ (File. (str (sys/user-home-path)
+ File/separator
+ ".slime"
+ File/separator
+ "cljclass")))
+
+(defn file-directory? [#^File f]
+ (.isDirectory f))
+
+(defn file-last-modified [#^File f]
+ (.lastModified f))
+
+(defn all-files-in-directory [#^File f]
+ (let [list-files (.listFiles f)
+ files (remove file-directory? list-files)
+ directories (filter file-directory? list-files)]
+ (concat files (mapcat all-files-in-directory directories))))
+
+(defn clj-file? [#^File f]
+ (.endsWith (str f) ".clj"))
+
+(defn swank-source-files [#^File path]
+ (filter clj-file? (all-files-in-directory path)))
+
+(defn relative-path-name [#^File parent #^File file]
+ (let [file-name (str file)
+ parent-name (str parent)]
+ (when (.startsWith file-name parent-name)
+ (.substring file-name (inc (.length parent-name))))))
+
+(defn file-name-to-swank-package-sym [#^String file-name]
+ (assert (clj-file? file-name))
+ (symbol
+ (str "swank."
+ (clj/unmunge
+ (.replaceAll (.substring file-name 0 (- (.length file-name) 4))
+ File/separator
+ ".")))))
+
+(defn swank-packages []
+ (map #(file-name-to-swank-package-sym (relative-path-name *swank-source-path* %))
+ (swank-source-files *swank-source-path*)))
+
+(defn swank-version
+ "A likely bad way of calculating a version number for swank clojure"
+ ([]
+ (str (reduce + (map file-last-modified (swank-source-files *swank-source-path*)))
+ "+" (clojure-version))))
+
+(defn delete-file-recursive [& paths]
+ (when-not (empty? paths)
+ (let [f #^File (first paths)]
+ (if (and f (.exists f))
+ (if (.isDirectory f)
+ (if-let [files (seq (.listFiles f))]
+ (recur (concat files paths))
+ (do
+ (.delete f)
+ (recur (rest paths))))
+ (do
+ (.delete f)
+ (recur (rest paths))))
+ (recur (rest paths))))))
+
+(defn clean-up []
+ (let [current-path (File. *swank-compile-path* (str (swank-version)))]
+ (doseq [compiled-path (.listFiles *swank-compile-path*)
+ :when (not= current-path compiled-path)]
+ (delete-file-recursive compiled-path))))
+
+(defn swank-ns? [ns]
+ (.startsWith (name (ns-name ns)) "swank."))
+
+(defn all-swank-ns []
+ (filter swank-ns? (all-ns)))
+
+(defn compile-swank [#^String path]
+ (binding [*compile-path* path]
+ (doseq [sym (swank-packages)]
+ (println "Compiling" (name sym))
+ (compile sym))))
+
+(defn init []
+ (let [path (File. *swank-compile-path* (str (swank-version)))
+ path-already-exists? (.exists path)]
+ (when-not path-already-exists?
+ (.mkdirs path))
+ (add-classpath (-> path .toURI .toURL))
+ (when-not path-already-exists?
+ (compile-swank (str path)))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/rpc.clj b/vim/bundle/slimv/swank-clojure/swank/rpc.clj
new file mode 100644
index 0000000..5f40a57
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/rpc.clj
@@ -0,0 +1,159 @@
+;;; This code has been placed in the Public Domain. All warranties are disclaimed.
+(ns #^{:doc "Pass remote calls and responses between lisp systems using the swank-rpc protocol."
+ :author "Terje Norderhaug <terje@in-progress.com>"}
+ swank.rpc
+ (:use (swank util)
+ (swank.util io))
+ (:import (java.io Writer Reader PushbackReader StringReader)))
+
+;; ERROR HANDLING
+
+(def swank-protocol-error (Exception. "Swank protocol error."))
+
+;; LOGGING
+
+(def log-events false)
+
+(def log-output nil)
+
+(defn log-event [format-string & args]
+ (when log-events
+ (.write (or log-output *out*) (apply format format-string args))
+ (.flush (or log-output *out*))
+ nil))
+
+;; INPUT
+
+(defn- read-form
+ "Read a form that conforms to the swank rpc protocol"
+ ([#^Reader rdr]
+ (let [c (.read rdr)]
+ (condp = (char c)
+ \" (let [sb (StringBuilder.)]
+ (loop []
+ (let [c (.read rdr)]
+ (if (= c -1)
+ (throw (java.io.EOFException. "Incomplete reading of quoted string."))
+ (condp = (char c)
+ \" (str sb)
+ \\ (do (.append sb (char (.read rdr)))
+ (recur))
+ (do (.append sb (char c))
+ (recur)))))))
+ \( (loop [result []]
+ (let [form (read-form rdr)]
+ (let [c (.read rdr)]
+ (if (= c -1)
+ (throw (java.io.EOFException. "Incomplete reading of list."))
+ (condp = (char c)
+ \) (sequence (conj result form))
+ \space (recur (conj result form)))))))
+ \' (list 'quote (read-form rdr))
+ (let [sb (StringBuilder.)]
+ (loop [c c]
+ (if (not= c -1)
+ (condp = (char c)
+ \\ (do (.append sb (char (.read rdr)))
+ (recur (.read rdr)))
+ \space (.unread rdr c)
+ \) (.unread rdr c)
+ (do (.append sb (char c))
+ (recur (.read rdr))))))
+ (let [str (str sb)]
+ (cond
+ (. Character isDigit c) (Integer/parseInt str)
+ (= "nil" str) nil
+ (= "t" str) true
+ :else (symbol str))))))))
+
+(defn- read-packet
+ ([#^Reader reader]
+ (let [len (Integer/parseInt (read-chars reader 6 swank-protocol-error) 16)]
+ (read-chars reader len swank-protocol-error))))
+
+(defn decode-message
+ "Read an rpc message encoded using the swank rpc protocol."
+ ([#^Reader rdr]
+ (let [packet (read-packet rdr)]
+ (log-event "READ: %s\n" packet)
+ (try
+ (with-open [rdr (PushbackReader. (StringReader. packet))]
+ (read-form rdr))
+ (catch Exception e
+ (list :reader-error packet e))))))
+
+; (with-open [rdr (StringReader. "00001f(swank:a 123 (%b% (t nil) \"c\"))")] (decode-message rdr))
+
+
+;; OUTPUT
+
+(defmulti print-object (fn [x writer] (type x)))
+
+(defmethod print-object :default [o, #^Writer w]
+ (print-method o w))
+
+(defmethod print-object Boolean [o, #^Writer w]
+ (.write w (if o "t" "nil")))
+
+(defmethod print-object String [#^String s, #^Writer w]
+ (let [char-escape-string {\" "\\\""
+ \\ "\\\\"}]
+ (do (.append w \")
+ (dotimes [n (count s)]
+ (let [c (.charAt s n)
+ e (char-escape-string c)]
+ (if e (.write w e) (.append w c))))
+ (.append w \"))
+ nil))
+
+(defmethod print-object clojure.lang.ISeq [o, #^Writer w]
+ (.write w "(")
+ (print-object (first o) w)
+ (doseq [item (rest o)]
+ (.write w " ")
+ (print-object item w))
+ (.write w ")"))
+
+(defn- write-form
+ ([#^Writer writer message]
+ (print-object message writer)))
+
+(defn- write-packet
+ ([#^Writer writer str]
+ (let [len (.length str)]
+ (doto writer
+ (.write (format "%06x" len))
+ (.write str)
+ (.flush)))))
+
+(defn encode-message
+ "Write an rpc message encoded using the swank rpc protocol."
+ ([#^Writer writer message]
+ (let [str (with-out-str
+ (write-form *out* message)) ]
+ (log-event "WRITE: %s\n" str)
+ (write-packet writer str))))
+
+; (with-out-str (encode-message *out* "hello"))
+; (with-out-str (encode-message *out* '(a 123 (swank:b (true false) "c"))))
+
+
+;; DISPATCH
+
+(defonce rpc-fn-map {})
+
+(defn register-dispatch
+ ([name fn]
+ (register-dispatch name fn #'rpc-fn-map))
+ ([name fn fn-map]
+ (alter-var-root fn-map assoc name fn)))
+
+(defn dispatch-message
+ ([message fn-map]
+ (let [operation (first message)
+ operands (rest message)
+ fn (fn-map operation)]
+ (assert fn)
+ (apply fn operands)))
+ ([message]
+ (dispatch-message message rpc-fn-map)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/swank.clj b/vim/bundle/slimv/swank-clojure/swank/swank.clj
new file mode 100644
index 0000000..d14e5c0
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/swank.clj
@@ -0,0 +1,92 @@
+;;;; swank-clojure.clj --- Swank server for Clojure
+;;;
+;;; Copyright (C) 2008 Jeffrey Chu
+;;;
+;;; This file is licensed under the terms of the GNU General Public
+;;; License as distributed with Emacs (press C-h C-c to view it).
+;;;
+;;; See README file for more information about installation
+;;;
+
+(ns swank.swank
+ (:use [swank.core]
+ [swank.core connection server]
+ [swank.util.concurrent thread]
+ [swank.util.net sockets]
+ [clojure.main :only [repl]])
+ (:require [swank.commands]
+ [swank.commands basic indent completion
+ contrib inspector])
+ (:import [java.lang System]
+ [java.io File])
+ (:gen-class))
+
+(defn ignore-protocol-version [version]
+ (reset! protocol-version version))
+
+(defn- connection-serve [conn]
+ (let [control
+ (dothread-swank
+ (thread-set-name "Swank Control Thread")
+ (try
+ (control-loop conn)
+ (catch Exception e
+ ;; fail silently
+ nil))
+ (close-socket! (conn :socket)))
+ read
+ (dothread-swank
+ (thread-set-name "Read Loop Thread")
+ (try
+ (read-loop conn control)
+ (catch Exception e
+ ;; This could be put somewhere better
+ (.println System/err "exception in read loop")
+ (.printStackTrace e)
+ (.interrupt control)
+ (dosync (alter connections (partial remove #{conn}))))))]
+ (dosync
+ (ref-set (conn :control-thread) control)
+ (ref-set (conn :read-thread) read))))
+
+(defn start-server
+ "Start the server and write the listen port number to
+ PORT-FILE. This is the entry point for Emacs."
+ [port-file & opts]
+ (let [opts (apply hash-map opts)]
+ (setup-server (get opts :port 0)
+ (fn announce-port [port]
+ (announce-port-to-file port-file port)
+ (simple-announce port))
+ connection-serve
+ opts)))
+
+(def #^{:private true} encodings-map
+ {"UTF-8" "utf-8-unix"
+ })
+
+(defn- get-system-encoding []
+ (when-let [enc-name (.name (java.nio.charset.Charset/defaultCharset))]
+ (encodings-map enc-name)))
+
+(defn start-repl
+ "Start the server wrapped in a repl. Use this to embed swank in your code."
+ ([port & opts]
+ (let [stop (atom false)
+ opts (merge {:port (Integer. port)
+ :encoding (or (System/getProperty "swank.encoding")
+ (get-system-encoding)
+ "iso-latin-1-unix")}
+ (apply hash-map opts))]
+ (repl :read (fn [rprompt rexit]
+ (if @stop rexit
+ (do (reset! stop true)
+ `(start-server (-> "java.io.tmpdir"
+ (System/getProperty)
+ (File. "slime-port.txt")
+ (.getCanonicalPath))
+ ~@(apply concat opts)))))
+ :need-prompt (constantly false))))
+ ([] (start-repl 4005)))
+
+(def -main start-repl)
diff --git a/vim/bundle/slimv/swank-clojure/swank/util.clj b/vim/bundle/slimv/swank-clojure/swank/util.clj
new file mode 100644
index 0000000..756e6f0
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util.clj
@@ -0,0 +1,72 @@
+(ns swank.util
+ (:import (java.io StringReader)
+ (clojure.lang LineNumberingPushbackReader)))
+
+(defmacro one-of?
+ "Short circuiting value comparison."
+ ([val & possible]
+ (let [v (gensym)]
+ `(let [~v ~val]
+ (or ~@(map (fn [p] `(= ~v ~p)) possible))))))
+
+(defn find-first
+ "Returns the first entry in a coll matches a given predicate."
+ ([coll] (find-first identity coll))
+ ([pred coll]
+ (first (filter pred coll))))
+
+(defn position
+ "Finds the first position of an item that matches a given predicate
+ within col. Returns nil if not found. Optionally provide a start
+ offset to search from."
+ ([pred coll] (position pred coll 0))
+ ([pred coll start]
+ (loop [coll (drop start coll), i start]
+ (when (seq coll)
+ (if (pred (first coll))
+ i
+ (recur (rest coll) (inc i))))))
+ {:tag Integer})
+
+(when-not (ns-resolve 'clojure.core 'group-by)
+ ;; TODO: not sure why eval is necessary here; breaks without it.
+ (eval '(defn group-by
+ "Categorizes elements within a coll into a map based on a function."
+ ([f coll]
+ (reduce
+ (fn [ret x]
+ (let [k (f x)]
+ (assoc ret k (conj (get ret k []) x))))
+ {})))))
+
+(when-not (ns-resolve 'clojure.core 'flatten)
+ (eval '(defn flatten [x]
+ (filter (complement sequential?)
+ (rest (tree-seq sequential? seq x))))))
+
+(defmacro returning [[var ret] & body]
+ `(let [~var ~ret]
+ ~@body
+ ~var))
+
+
+(defn deep-replace [smap coll]
+ (map #(if (or (seq? %) (vector? %))
+ (deep-replace smap %)
+ %)
+ (replace smap coll)))
+
+(defmacro keep-bindings [bindings f]
+ (let [bind-vars (take (count bindings) (repeatedly gensym))]
+ `(let [~@(interleave bind-vars bindings)]
+ (fn [& args#]
+ (binding [~@(interleave bindings bind-vars)]
+ (apply ~f args#))))))
+
+(defmacro continuously [& body]
+ `(loop [] ~@body (recur)))
+
+(defmacro failing-gracefully [& body]
+ `(try
+ ~@body
+ (catch Throwable _# nil)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/class_browse.clj b/vim/bundle/slimv/swank-clojure/swank/util/class_browse.clj
new file mode 100644
index 0000000..94f325b
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/class_browse.clj
@@ -0,0 +1,149 @@
+;;; class-browse.clj -- Java classpath and Clojure namespace browsing
+
+;; by Jeff Valk
+;; created 2009-10-14
+
+;; Scans the classpath for all class files, and provides functions for
+;; categorizing them.
+
+;; See the following for JVM classpath and wildcard expansion rules:
+;; http://java.sun.com/javase/6/docs/technotes/tools/findingclasses.html
+;; http://java.sun.com/javase/6/docs/technotes/tools/solaris/classpath.html
+
+(ns swank.util.class-browse
+ "Provides Java classpath and (compiled) Clojure namespace browsing.
+ Scans the classpath for all class files, and provides functions for
+ categorizing them. Classes are resolved on the start-up classpath only.
+ Calls to 'add-classpath', etc are not considered.
+
+ Class information is built as a list of maps of the following keys:
+ :name Java class or Clojure namespace name
+ :loc Classpath entry (directory or jar) on which the class is located
+ :file Path of the class file, relative to :loc"
+ (:import [java.io File FilenameFilter]
+ [java.util StringTokenizer]
+ [java.util.jar JarFile JarEntry]
+ [java.util.regex Pattern]))
+
+;;; Class file naming, categorization
+
+(defn jar-file? [#^String n] (.endsWith n ".jar"))
+(defn class-file? [#^String n] (.endsWith n ".class"))
+(defn clojure-ns-file? [#^String n] (.endsWith n "__init.class"))
+(defn clojure-fn-file? [#^String n] (re-find #"\$.*__\d+\.class" n))
+(defn top-level-class-file? [#^String n] (re-find #"^[^\$]+\.class" n))
+(defn nested-class-file? [#^String n]
+ ;; ^ excludes anonymous classes
+ (re-find #"^[^\$]+(\$[^\d]\w*)+\.class" n))
+
+(def clojure-ns? (comp clojure-ns-file? :file))
+(def clojure-fn? (comp clojure-fn-file? :file))
+(def top-level-class? (comp top-level-class-file? :file))
+(def nested-class? (comp nested-class-file? :file))
+
+(defn class-or-ns-name
+ "Returns the Java class or Clojure namespace name for a class relative path."
+ [#^String n]
+ (.replace
+ (if (clojure-ns-file? n)
+ (-> n (.replace "__init.class" "") (.replace "_" "-"))
+ (.replace n ".class" ""))
+ File/separator "."))
+
+;;; Path scanning
+
+(defmulti path-class-files
+ "Returns a list of classes found on the specified path location
+ (jar or directory), each comprised of a map with the following keys:
+ :name Java class or Clojure namespace name
+ :loc Classpath entry (directory or jar) on which the class is located
+ :file Path of the class file, relative to :loc"
+ (fn [#^ File f _]
+ (cond (.isDirectory f) :dir
+ (jar-file? (.getName f)) :jar
+ (class-file? (.getName f)) :class)))
+
+(defmethod path-class-files :default
+ [& _] [])
+
+(defmethod path-class-files :jar
+ ;; Build class info for all jar entry class files.
+ [#^File f #^File loc]
+ (let [lp (.getPath loc)]
+ (try
+ (map (fn [fp] {:loc lp :file fp :name (class-or-ns-name fp)})
+ (filter class-file?
+ (map #(.getName #^JarEntry %)
+ (enumeration-seq (.entries (JarFile. f))))))
+ (catch Exception e [])))) ; fail gracefully if jar is unreadable
+
+(defmethod path-class-files :dir
+ ;; Dispatch directories and files (excluding jars) recursively.
+ [#^File d #^File loc]
+ (let [fs (.listFiles d (proxy [FilenameFilter] []
+ (accept [d n] (not (jar-file? n)))))]
+ (reduce concat (for [f fs] (path-class-files f loc)))))
+
+(defmethod path-class-files :class
+ ;; Build class info using file path relative to parent classpath entry
+ ;; location. Make sure it decends; a class can't be on classpath directly.
+ [#^File f #^File loc]
+ (let [fp (.getPath f), lp (.getPath loc)
+ m (re-matcher (re-pattern (Pattern/quote
+ (str "^" lp File/separator))) fp)]
+ (if (not (.find m)) ; must be descendent of loc
+ []
+ (let [fpr (.substring fp (.end m))]
+ [{:loc lp :file fpr :name (class-or-ns-name fpr)}]))))
+
+;;; Classpath expansion
+
+(def java-version
+ (Float/parseFloat (.substring (System/getProperty "java.version") 0 3)))
+
+(defn expand-wildcard
+ "Expands a wildcard path entry to its matching .jar files (JDK 1.6+).
+ If not expanding, returns the path entry as a single-element vector."
+ [#^String path]
+ (let [f (File. path)]
+ (if (and (= (.getName f) "*") (>= java-version 1.6))
+ (-> f .getParentFile
+ (.list (proxy [FilenameFilter] []
+ (accept [d n] (jar-file? n)))))
+ [f])))
+
+(defn scan-paths
+ "Takes one or more classpath strings, scans each classpath entry location, and
+ returns a list of all class file paths found, each relative to its parent
+ directory or jar on the classpath."
+ ([cp]
+ (if cp
+ (let [entries (enumeration-seq
+ (StringTokenizer. cp File/pathSeparator))
+ locs (mapcat expand-wildcard entries)]
+ (reduce concat (for [loc locs] (path-class-files loc loc))))
+ ()))
+ ([cp & more]
+ (reduce #(concat %1 (scan-paths %2)) (scan-paths cp) more)))
+
+;;; Class browsing
+
+(def available-classes
+ (filter (complement clojure-fn?) ; omit compiled clojure fns
+ (scan-paths (System/getProperty "sun.boot.class.path")
+ (System/getProperty "java.ext.dirs")
+ (System/getProperty "java.class.path"))))
+
+;; Force lazy seqs before any user calls, and in background threads; there's
+;; no sense holding up SLIME init. (It's usually quick, but a monstrous
+;; classpath could concievably take a while.)
+
+(def top-level-classes
+ (future (doall (map (comp class-or-ns-name :name)
+ (filter top-level-class?
+ available-classes)))))
+
+(def nested-classes
+ (future (doall (map (comp class-or-ns-name :name)
+ (filter nested-class?
+ available-classes)))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/clojure.clj b/vim/bundle/slimv/swank-clojure/swank/util/clojure.clj
new file mode 100644
index 0000000..9d04875
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/clojure.clj
@@ -0,0 +1,33 @@
+(ns swank.util.clojure)
+
+(defn unmunge
+ "Converts a javafied name to a clojure symbol name"
+ ([#^String name]
+ (reduce (fn [#^String s [to from]]
+ (.replaceAll s from (str to)))
+ name
+ clojure.lang.Compiler/CHAR_MAP)))
+
+(defn ns-path
+ "Returns the path form of a given namespace"
+ ([#^clojure.lang.Namespace ns]
+ (let [#^String ns-str (name (ns-name ns))]
+ (-> ns-str
+ (.substring 0 (.lastIndexOf ns-str "."))
+ (.replace \- \_)
+ (.replace \. \/)))))
+
+(defn symbol-name-parts
+ "Parses a symbol name into a namespace and a name. If name doesn't
+ contain a namespace, the default-ns is used (nil if none provided)."
+ ([symbol]
+ (symbol-name-parts symbol nil))
+ ([#^String symbol default-ns]
+ (let [ns-pos (.indexOf symbol (int \/))]
+ (if (= ns-pos -1) ;; namespace found?
+ [default-ns symbol]
+ [(.substring symbol 0 ns-pos) (.substring symbol (inc ns-pos))]))))
+
+(defn resolve-ns [sym ns]
+ (or (find-ns sym)
+ (get (ns-aliases ns) sym))) \ No newline at end of file
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/concurrent/mbox.clj b/vim/bundle/slimv/swank-clojure/swank/util/concurrent/mbox.clj
new file mode 100644
index 0000000..8c30d74
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/concurrent/mbox.clj
@@ -0,0 +1,31 @@
+(ns swank.util.concurrent.mbox
+ (:refer-clojure :exclude [send get]))
+
+;; Holds references to the mailboxes (message queues)
+(defonce mailboxes (ref {}))
+
+(defn get
+ "Returns the mailbox for a given id. Creates one if one does not
+ already exist."
+ ([id]
+ (dosync
+ (when-not (@mailboxes id)
+ (alter mailboxes assoc
+ id (java.util.concurrent.LinkedBlockingQueue.))))
+ (@mailboxes id))
+ {:tag java.util.concurrent.LinkedBlockingQueue})
+
+(defn send
+ "Sends a message to a given id."
+ ([id message]
+ (let [mbox (get id)]
+ (.put mbox message))))
+
+(defn receive
+ "Blocking recieve for messages for the given id."
+ ([id]
+ (let [mb (get id)]
+ (.take mb))))
+
+(defn clean []
+ )
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/concurrent/thread.clj b/vim/bundle/slimv/swank-clojure/swank/util/concurrent/thread.clj
new file mode 100644
index 0000000..fa77a22
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/concurrent/thread.clj
@@ -0,0 +1,50 @@
+(ns swank.util.concurrent.thread
+ (:use (swank util)))
+
+(defn- gen-name []
+ (name (gensym "Thread-")))
+
+(defn start-thread
+ "Starts a thread that run the given function f"
+ ([#^Runnable f]
+ (doto (Thread. f)
+ (.start))))
+
+(defmacro dothread [& body]
+ `(start-thread (fn [] ~@body)))
+
+(defmacro dothread-keeping [bindings & body]
+ `(start-thread (keep-bindings ~bindings (fn [] ~@body))))
+
+(defmacro dothread-keeping-clj [more-bindings & body]
+ (let [clj-star-syms (filter #(or (= (name %) "*e")
+ (= (name %) "*1")
+ (= (name %) "*2")
+ (= (name %) "*3")
+ (and (.startsWith #^String (name %) "*")
+ (.endsWith #^String (name %) "*")
+ (> (count (name %)) 1)))
+ (keys (ns-publics (find-ns 'clojure.core))))]
+ `(dothread-keeping [~@clj-star-syms ~@more-bindings]
+ ~@body)))
+
+(defn current-thread []
+ (Thread/currentThread))
+
+(defn thread-set-name
+ ([name] (thread-set-name (current-thread) name))
+ ([#^Thread thread name]
+ (.setName thread name)))
+
+(defn thread-name
+ ([] (thread-name (current-thread)))
+ ([#^Thread thread]
+ (.getName thread)))
+
+(defn thread-id
+ ([] (thread-id (current-thread)))
+ ([#^Thread thread]
+ (.getId thread)))
+
+(defn thread-alive? [#^Thread t]
+ (.isAlive t))
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/hooks.clj b/vim/bundle/slimv/swank-clojure/swank/util/hooks.clj
new file mode 100644
index 0000000..dd7af50
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/hooks.clj
@@ -0,0 +1,12 @@
+(ns swank.util.hooks)
+
+(defmacro defhook [name & hooks]
+ `(defonce ~name (ref (list ~@hooks))))
+
+;;;; Hooks
+(defn add-hook [place function]
+ (dosync (alter place conj function)))
+
+(defn run-hook [functions & arguments]
+ (doseq [f @functions]
+ (apply f arguments)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/io.clj b/vim/bundle/slimv/swank-clojure/swank/util/io.clj
new file mode 100644
index 0000000..6247eec
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/io.clj
@@ -0,0 +1,40 @@
+(ns swank.util.io
+ (:use [swank util]
+ [swank.util.concurrent thread])
+ (:import [java.io StringWriter Reader PrintWriter]))
+
+(defn read-chars
+ ([rdr n] (read-chars rdr n false))
+ ([#^Reader rdr n throw-exception]
+ (let [cbuf (make-array Character/TYPE n)]
+ (loop [i 0]
+ (let [size (.read rdr cbuf i (- n i))]
+ (cond
+ (neg? size) (if throw-exception
+ (throw throw-exception)
+ (String. cbuf 0 i))
+ (= (+ i size) n) (String. cbuf)
+ :else (recur (+ i size))))))))
+
+(defn call-on-flush-stream
+ "Creates a stream that will call a given function when flushed."
+ ([flushf]
+ (let [closed? (atom false)
+ #^PrintWriter stream
+ (PrintWriter.
+ (proxy [StringWriter] []
+ (close [] (reset! closed? true))
+ (flush []
+ (let [#^StringWriter me this
+ len (.. me getBuffer length)]
+ (when (> len 0)
+ (flushf (.. me getBuffer (substring 0 len)))
+ (.. me getBuffer (delete 0 len)))))))]
+ (dothread
+ (thread-set-name "Call-on-write Stream")
+ (continuously
+ (Thread/sleep 200)
+ (when-not @closed?
+ (.flush stream))))
+ stream))
+ {:tag PrintWriter})
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/java.clj b/vim/bundle/slimv/swank-clojure/swank/util/java.clj
new file mode 100644
index 0000000..4cc802f
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/java.clj
@@ -0,0 +1,16 @@
+(ns swank.util.java)
+
+(defn member-name [#^java.lang.reflect.Member member]
+ (.getName member))
+
+(defn member-static? [#^java.lang.reflect.Member member]
+ (java.lang.reflect.Modifier/isStatic (.getModifiers member)))
+
+(defn static-methods [#^Class class]
+ (filter member-static? (.getMethods class)))
+
+(defn static-fields [#^Class class]
+ (filter member-static? (.getDeclaredFields class)))
+
+(defn instance-methods [#^Class class]
+ (remove member-static? (.getMethods class)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/net/sockets.clj b/vim/bundle/slimv/swank-clojure/swank/util/net/sockets.clj
new file mode 100644
index 0000000..1c45ff1
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/net/sockets.clj
@@ -0,0 +1,57 @@
+(ns swank.util.net.sockets
+ (:use (swank util)
+ (swank.util.concurrent thread))
+ (:import (java.net ServerSocket Socket SocketException InetAddress)))
+
+(defn make-server-socket
+ "Create a java.net.ServerSocket. A map of `options':
+
+ :port - The port which this ServerSocket will listen on. It must
+ be a number between 0-65535. If 0 or not provided, the server
+ will be created on any free port.
+
+ :host - The address the server will bind to, can be used on multi
+ homed hosts. This can be an InetAddress or a hostname string. If
+ not provided or nil, it will listen on all addresses.
+
+ :backlog - The maximum queue length of incoming connection
+ indications (ie. connection requests). If the queue is full, new
+ indications will be refused. If set to less than or equal to 0,
+ the default value will be used."
+ ([] (ServerSocket.))
+ ([options] (ServerSocket. (options :port 0)
+ (options :backlog 0)
+ (when-let [host (options :host)]
+ (if (instance? InetAddress host)
+ host
+ (InetAddress/getByName host))))))
+
+(defn start-server-socket!
+ "Given a `server-socket' (java.net.ServerSocket), call
+ `handle-socket' for each new connection and provide current
+ socket.
+
+ This will return immediately with the Thread that is blocking for
+ new connections. Use Thread.join() if you need to wait for the
+ server to close."
+ ([server-socket handle-socket]
+ (dothread-keeping-clj nil
+ (thread-set-name (str "Socket Server [" (thread-id) "]"))
+ (with-open [#^ServerSocket server server-socket]
+ (while (not (.isClosed server))
+ (handle-socket (.accept server)))))))
+
+(defn close-socket!
+ "Cleanly shutdown and close a java.net.Socket. This will not affect
+ an already running instance of SocketServer."
+ ([#^Socket socket]
+ (doto socket
+ (.shutdownInput)
+ (.shutdownOutput)
+ (.close))))
+
+(defn close-server-socket!
+ "Shutdown a java.net.SocketServer. Existing connections will
+ persist."
+ ([#^ServerSocket server]
+ (.close server)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/string.clj b/vim/bundle/slimv/swank-clojure/swank/util/string.clj
new file mode 100644
index 0000000..3250a61
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/string.clj
@@ -0,0 +1,16 @@
+(ns swank.util.string)
+
+(defn largest-common-prefix
+ "Returns the largest common prefix of two strings."
+ ([#^String a, #^String b]
+ (apply str (take-while (comp not nil?) (map #(when (= %1 %2) %1) a b))))
+ {:tag String})
+
+(defn char-position
+ "Finds the position of a character within a string, optionally
+ provide a starting index. Returns nil if none is found."
+ ([c str] (char-position c str 0))
+ ([#^Character c #^String str #^Integer start]
+ (let [idx (.indexOf str (int c) start)]
+ (when (not= -1 idx)
+ idx)))) \ No newline at end of file
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/sys.clj b/vim/bundle/slimv/swank-clojure/swank/util/sys.clj
new file mode 100644
index 0000000..f76c319
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/sys.clj
@@ -0,0 +1,13 @@
+(ns swank.util.sys)
+
+(defn get-pid
+ "Returns the PID of the JVM. This is largely a hack and may or may
+ not be accurate depending on the JVM in which clojure is running
+ off of."
+ ([]
+ (or (first (.. java.lang.management.ManagementFactory (getRuntimeMXBean) (getName) (split "@")))
+ (System/getProperty "pid")))
+ {:tag String})
+
+(defn user-home-path []
+ (System/getProperty "user.home"))
diff --git a/vim/bundle/slimv/syntax/clojure/slimv-syntax-clojure.vim b/vim/bundle/slimv/syntax/clojure/slimv-syntax-clojure.vim
new file mode 100644
index 0000000..d21165e
--- /dev/null
+++ b/vim/bundle/slimv/syntax/clojure/slimv-syntax-clojure.vim
@@ -0,0 +1,99 @@
+" slimv-syntax-clojure.vim:
+" Clojure syntax plugin for Slimv
+" Version: 0.9.11
+" Last Change: 10 Jun 2013
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if exists("b:current_syntax") || exists("g:slimv_disable_clojure")
+ finish
+endif
+
+" Clojure keywords not defined by lisp.vim
+syn keyword lispFunc def defmulti defn defn- defonce defprotocol doall dorun doseq dosync doto
+syn keyword lispFunc filter fn for future in-ns letfn ns range str take try
+
+" Try to load built-in or third party syntax files
+" First clojure then lisp (if clojure not found)
+runtime syntax/**/clojure.vim
+runtime syntax/**/lisp.vim
+
+" Add [] and {} to the lisp_rainbow handling
+syn match lispSymbol contained ![^()\[\]{}'`,"; \t]\+!
+syn match lispBarSymbol contained !|..\{-}|!
+syn match lispAtom "'[^ \t()\[\]{}]\+" contains=lispAtomMark
+if exists("g:lisp_rainbow") && g:lisp_rainbow != 0
+ if &bg == "dark"
+ hi def hlLevel0 ctermfg=red guifg=red1
+ hi def hlLevel1 ctermfg=yellow guifg=orange1
+ hi def hlLevel2 ctermfg=green guifg=yellow1
+ hi def hlLevel3 ctermfg=cyan guifg=greenyellow
+ hi def hlLevel4 ctermfg=magenta guifg=green1
+ hi def hlLevel5 ctermfg=red guifg=springgreen1
+ hi def hlLevel6 ctermfg=yellow guifg=cyan1
+ hi def hlLevel7 ctermfg=green guifg=slateblue1
+ hi def hlLevel8 ctermfg=cyan guifg=magenta1
+ hi def hlLevel9 ctermfg=magenta guifg=purple1
+ else
+ hi def hlLevel0 ctermfg=red guifg=red3
+ hi def hlLevel1 ctermfg=darkyellow guifg=orangered3
+ hi def hlLevel2 ctermfg=darkgreen guifg=orange2
+ hi def hlLevel3 ctermfg=blue guifg=yellow3
+ hi def hlLevel4 ctermfg=darkmagenta guifg=olivedrab4
+ hi def hlLevel5 ctermfg=red guifg=green4
+ hi def hlLevel6 ctermfg=darkyellow guifg=paleturquoise3
+ hi def hlLevel7 ctermfg=darkgreen guifg=deepskyblue4
+ hi def hlLevel8 ctermfg=blue guifg=darkslateblue
+ hi def hlLevel9 ctermfg=darkmagenta guifg=darkviolet
+ endif
+
+ silent! syn clear lispParen0
+ silent! syn clear lispParen1
+ silent! syn clear lispParen2
+ silent! syn clear lispParen3
+ silent! syn clear lispParen4
+ silent! syn clear lispParen5
+ silent! syn clear lispParen6
+ silent! syn clear lispParen7
+ silent! syn clear lispParen8
+ silent! syn clear lispParen9
+
+ syn region clojureSexp matchgroup=hlLevel9 start="(" matchgroup=hlLevel9 end=")" contains=TOP,@Spell
+ syn region clojureParen0 matchgroup=hlLevel8 start="`\=(" end=")" contains=TOP,clojureParen0,clojureParen1,clojureParen2,clojureParen3,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen1 matchgroup=hlLevel7 start="`\=(" end=")" contains=TOP,clojureParen1,clojureParen2,clojureParen3,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen2 matchgroup=hlLevel6 start="`\=(" end=")" contains=TOP,clojureParen2,clojureParen3,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen3 matchgroup=hlLevel5 start="`\=(" end=")" contains=TOP,clojureParen3,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen4 matchgroup=hlLevel4 start="`\=(" end=")" contains=TOP,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen5 matchgroup=hlLevel3 start="`\=(" end=")" contains=TOP,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen6 matchgroup=hlLevel2 start="`\=(" end=")" contains=TOP,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen7 matchgroup=hlLevel1 start="`\=(" end=")" contains=TOP,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen8 matchgroup=hlLevel0 start="`\=(" end=")" contains=TOP,clojureParen8,NoInParens
+
+ syn region clojureVector matchgroup=hlLevel9 start="\[" matchgroup=hlLevel9 end="\]" contains=TOP,@Spell
+ syn region clojureParen0 matchgroup=hlLevel8 start="`\=\[" end="\]" contains=TOP,clojureParen0,clojureParen1,clojureParen2,clojureParen3,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen1 matchgroup=hlLevel7 start="`\=\[" end="\]" contains=TOP,clojureParen1,clojureParen2,clojureParen3,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen2 matchgroup=hlLevel6 start="`\=\[" end="\]" contains=TOP,clojureParen2,clojureParen3,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen3 matchgroup=hlLevel5 start="`\=\[" end="\]" contains=TOP,clojureParen3,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen4 matchgroup=hlLevel4 start="`\=\[" end="\]" contains=TOP,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen5 matchgroup=hlLevel3 start="`\=\[" end="\]" contains=TOP,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen6 matchgroup=hlLevel2 start="`\=\[" end="\]" contains=TOP,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen7 matchgroup=hlLevel1 start="`\=\[" end="\]" contains=TOP,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen8 matchgroup=hlLevel0 start="`\=\[" end="\]" contains=TOP,clojureParen8,NoInParens
+
+ syn region clojureMap matchgroup=hlLevel9 start="{" matchgroup=hlLevel9 end="}" contains=TOP,@Spell
+ syn region clojureParen0 matchgroup=hlLevel8 start="`\={" end="}" contains=TOP,clojureParen0,clojureParen1,clojureParen2,clojureParen3,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen1 matchgroup=hlLevel7 start="`\={" end="}" contains=TOP,clojureParen1,clojureParen2,clojureParen3,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen2 matchgroup=hlLevel6 start="`\={" end="}" contains=TOP,clojureParen2,clojureParen3,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen3 matchgroup=hlLevel5 start="`\={" end="}" contains=TOP,clojureParen3,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen4 matchgroup=hlLevel4 start="`\={" end="}" contains=TOP,clojureParen4,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen5 matchgroup=hlLevel3 start="`\={" end="}" contains=TOP,clojureParen5,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen6 matchgroup=hlLevel2 start="`\={" end="}" contains=TOP,clojureParen6,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen7 matchgroup=hlLevel1 start="`\={" end="}" contains=TOP,clojureParen7,clojureParen8,NoInParens
+ syn region clojureParen8 matchgroup=hlLevel0 start="`\={" end="}" contains=TOP,clojureParen8,NoInParens
+endif
+
diff --git a/vim/bundle/slimv/syntax/lisp/slimv-syntax-lisp.vim b/vim/bundle/slimv/syntax/lisp/slimv-syntax-lisp.vim
new file mode 100644
index 0000000..57a707b
--- /dev/null
+++ b/vim/bundle/slimv/syntax/lisp/slimv-syntax-lisp.vim
@@ -0,0 +1,21 @@
+" slimv-syntax-lisp.vim:
+" Lisp syntax plugin for Slimv
+" Version: 0.9.11
+" Last Change: 22 Apr 2013
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if exists("b:current_syntax") || exists("g:slimv_disable_lisp")
+ finish
+endif
+
+runtime syntax/**/lisp.vim
+
+" Change syntax for #\( and #\) to string so that paren matching ignores them
+syn match lispString !#\\[\(\)]!
+
diff --git a/vim/bundle/slimv/syntax/scheme/slimv-syntax-scheme.vim b/vim/bundle/slimv/syntax/scheme/slimv-syntax-scheme.vim
new file mode 100644
index 0000000..d58a467
--- /dev/null
+++ b/vim/bundle/slimv/syntax/scheme/slimv-syntax-scheme.vim
@@ -0,0 +1,89 @@
+" slimv-syntax-scheme.vim:
+" Scheme syntax plugin for Slimv
+" Version: 0.9.9
+" Last Change: 10 Nov 2012
+" Maintainer: Tamas Kovacs <kovisoft at gmail dot com>
+" License: This file is placed in the public domain.
+" No warranty, express or implied.
+" *** *** Use At-Your-Own-Risk! *** ***
+"
+" =====================================================================
+"
+" Load Once:
+if exists("b:current_syntax") || exists("g:slimv_disable_scheme")
+ finish
+endif
+
+runtime syntax/**/scheme.vim
+
+" Add lisp_rainbow handling
+
+syn region schemeMultilineComment start=/#|/ end=/|#/ contains=schemeMultilineComment
+syn keyword schemeExtSyntax ->environment ->namestring
+syn match schemeExtSyntax "#![-a-z!$%&*/:<=>?^_~0-9+.@#%]\+"
+syn match schemeAtomMark "'"
+syn match schemeAtom "'[^ \t()\[\]{}]\+" contains=schemeAtomMark
+syn cluster schemeListCluster contains=schemeSyntax,schemeFunc,schemeString,schemeCharacter,schemeNumber,schemeBoolean,schemeConstant,schemeComment,schemeMultilineComment,schemeQuoted,schemeUnquote,schemeStrucRestricted,schemeOther,schemeError,schemeExtSyntax,schemeExtFunc,schemeAtom,schemeDelimiter
+
+hi def link schemeAtomMark Delimiter
+hi def link schemeAtom Identifier
+
+if exists("g:lisp_rainbow") && g:lisp_rainbow != 0
+ syn region schemeParen0 matchgroup=hlLevel0 start="`\=(" end=")" skip="|.\{-}|" contains=@schemeListCluster,schemeParen1
+ syn region schemeParen1 contained matchgroup=hlLevel1 start="`\=(" end=")" skip="|.\{-}|" contains=@schemeListCluster,schemeParen2
+ syn region schemeParen2 contained matchgroup=hlLevel2 start="`\=(" end=")" skip="|.\{-}|" contains=@schemeListCluster,schemeParen3
+ syn region schemeParen3 contained matchgroup=hlLevel3 start="`\=(" end=")" skip="|.\{-}|" contains=@schemeListCluster,schemeParen4
+ syn region schemeParen4 contained matchgroup=hlLevel4 start="`\=(" end=")" skip="|.\{-}|" contains=@schemeListCluster,schemeParen5
+ syn region schemeParen5 contained matchgroup=hlLevel5 start="`\=(" end=")" skip="|.\{-}|" contains=@schemeListCluster,schemeParen6
+ syn region schemeParen6 contained matchgroup=hlLevel6 start="`\=(" end=")" skip="|.\{-}|" contains=@schemeListCluster,schemeParen7
+ syn region schemeParen7 contained matchgroup=hlLevel7 start="`\=(" end=")" skip="|.\{-}|" contains=@schemeListCluster,schemeParen8
+ syn region schemeParen8 contained matchgroup=hlLevel8 start="`\=(" end=")" skip="|.\{-}|" contains=@schemeListCluster,schemeParen9
+ syn region schemeParen9 contained matchgroup=hlLevel9 start="`\=(" end=")" skip="|.\{-}|" contains=@schemeListCluster,schemeParen0
+
+ syn region schemeParen0 matchgroup=hlLevel0 start="`\=\[" end="\]" skip="|.\{-}|" contains=@schemeListCluster,schemeParen1
+ syn region schemeParen1 contained matchgroup=hlLevel1 start="`\=\[" end="\]" skip="|.\{-}|" contains=@schemeListCluster,schemeParen2
+ syn region schemeParen2 contained matchgroup=hlLevel2 start="`\=\[" end="\]" skip="|.\{-}|" contains=@schemeListCluster,schemeParen3
+ syn region schemeParen3 contained matchgroup=hlLevel3 start="`\=\[" end="\]" skip="|.\{-}|" contains=@schemeListCluster,schemeParen4
+ syn region schemeParen4 contained matchgroup=hlLevel4 start="`\=\[" end="\]" skip="|.\{-}|" contains=@schemeListCluster,schemeParen5
+ syn region schemeParen5 contained matchgroup=hlLevel5 start="`\=\[" end="\]" skip="|.\{-}|" contains=@schemeListCluster,schemeParen6
+ syn region schemeParen6 contained matchgroup=hlLevel6 start="`\=\[" end="\]" skip="|.\{-}|" contains=@schemeListCluster,schemeParen7
+ syn region schemeParen7 contained matchgroup=hlLevel7 start="`\=\[" end="\]" skip="|.\{-}|" contains=@schemeListCluster,schemeParen8
+ syn region schemeParen8 contained matchgroup=hlLevel8 start="`\=\[" end="\]" skip="|.\{-}|" contains=@schemeListCluster,schemeParen9
+ syn region schemeParen9 contained matchgroup=hlLevel9 start="`\=\[" end="\]" skip="|.\{-}|" contains=@schemeListCluster,schemeParen0
+
+ syn region schemeParen0 matchgroup=hlLevel0 start="`\={" end="}" skip="|.\{-}|" contains=@schemeListCluster,schemeParen1
+ syn region schemeParen1 contained matchgroup=hlLevel1 start="`\={" end="}" skip="|.\{-}|" contains=@schemeListCluster,schemeParen2
+ syn region schemeParen2 contained matchgroup=hlLevel2 start="`\={" end="}" skip="|.\{-}|" contains=@schemeListCluster,schemeParen3
+ syn region schemeParen3 contained matchgroup=hlLevel3 start="`\={" end="}" skip="|.\{-}|" contains=@schemeListCluster,schemeParen4
+ syn region schemeParen4 contained matchgroup=hlLevel4 start="`\={" end="}" skip="|.\{-}|" contains=@schemeListCluster,schemeParen5
+ syn region schemeParen5 contained matchgroup=hlLevel5 start="`\={" end="}" skip="|.\{-}|" contains=@schemeListCluster,schemeParen6
+ syn region schemeParen6 contained matchgroup=hlLevel6 start="`\={" end="}" skip="|.\{-}|" contains=@schemeListCluster,schemeParen7
+ syn region schemeParen7 contained matchgroup=hlLevel7 start="`\={" end="}" skip="|.\{-}|" contains=@schemeListCluster,schemeParen8
+ syn region schemeParen8 contained matchgroup=hlLevel8 start="`\={" end="}" skip="|.\{-}|" contains=@schemeListCluster,schemeParen9
+ syn region schemeParen9 contained matchgroup=hlLevel9 start="`\={" end="}" skip="|.\{-}|" contains=@schemeListCluster,schemeParen0
+
+ if &bg == "dark"
+ hi def hlLevel0 ctermfg=red guifg=red1
+ hi def hlLevel1 ctermfg=yellow guifg=orange1
+ hi def hlLevel2 ctermfg=green guifg=yellow1
+ hi def hlLevel3 ctermfg=cyan guifg=greenyellow
+ hi def hlLevel4 ctermfg=magenta guifg=green1
+ hi def hlLevel5 ctermfg=red guifg=springgreen1
+ hi def hlLevel6 ctermfg=yellow guifg=cyan1
+ hi def hlLevel7 ctermfg=green guifg=slateblue1
+ hi def hlLevel8 ctermfg=cyan guifg=magenta1
+ hi def hlLevel9 ctermfg=magenta guifg=purple1
+ else
+ hi def hlLevel0 ctermfg=red guifg=red3
+ hi def hlLevel1 ctermfg=darkyellow guifg=orangered3
+ hi def hlLevel2 ctermfg=darkgreen guifg=orange2
+ hi def hlLevel3 ctermfg=blue guifg=yellow3
+ hi def hlLevel4 ctermfg=darkmagenta guifg=olivedrab4
+ hi def hlLevel5 ctermfg=red guifg=green4
+ hi def hlLevel6 ctermfg=darkyellow guifg=paleturquoise3
+ hi def hlLevel7 ctermfg=darkgreen guifg=deepskyblue4
+ hi def hlLevel8 ctermfg=blue guifg=darkslateblue
+ hi def hlLevel9 ctermfg=darkmagenta guifg=darkviolet
+ endif
+endif
+
diff --git a/vim/bundle/tabular/.gitignore b/vim/bundle/tabular/.gitignore
new file mode 100644
index 0000000..0a56e3f
--- /dev/null
+++ b/vim/bundle/tabular/.gitignore
@@ -0,0 +1 @@
+/doc/tags
diff --git a/vim/bundle/tabular/LICENSE.md b/vim/bundle/tabular/LICENSE.md
new file mode 100644
index 0000000..2cc76e9
--- /dev/null
+++ b/vim/bundle/tabular/LICENSE.md
@@ -0,0 +1,24 @@
+Copyright (c) 2016, Matthew J. Wozniski
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * The names of the contributors may not be used to endorse or promote
+ products derived from this software without specific prior written
+ permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER ``AS IS'' AND ANY EXPRESS
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
+NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/vim/bundle/tabular/README.md b/vim/bundle/tabular/README.md
new file mode 100644
index 0000000..adbfeb0
--- /dev/null
+++ b/vim/bundle/tabular/README.md
@@ -0,0 +1,29 @@
+Tabular
+==============
+Sometimes, it's useful to line up text. Naturally, it's nicer to have the
+computer do this for you, since aligning things by hand quickly becomes
+unpleasant. While there are other plugins for aligning text, the ones I've
+tried are either impossibly difficult to understand and use, or too simplistic
+to handle complicated tasks. This plugin aims to make the easy things easy
+and the hard things possible, without providing an unnecessarily obtuse
+interface. It's still a work in progress, and criticisms are welcome.
+
+See [Aligning Text with Tabular.vim](http://vimcasts.org/episodes/aligning-text-with-tabular-vim/)
+for a screencast that shows how Tabular.vim works.
+
+See [doc/Tabular.txt](http://raw.github.com/godlygeek/tabular/master/doc/Tabular.txt)
+for detailed documentation.
+
+Installation
+==============
+If you don't have a preferred installation method, I recommend installing
+[pathogen.vim](https://github.com/tpope/vim-pathogen), and then simply
+copy and paste:
+
+ mkdir -p ~/.vim/bundle
+ cd ~/.vim/bundle
+ git clone git://github.com/godlygeek/tabular.git
+
+Once help tags have been generated (either using Pathogen's `:Helptags`
+command, or by pointing vim's `:helptags` command at the directory where you
+installed Tabular), you can view the manual with `:help tabular`.
diff --git a/vim/bundle/tabular/after/plugin/TabularMaps.vim b/vim/bundle/tabular/after/plugin/TabularMaps.vim
new file mode 100644
index 0000000..998346f
--- /dev/null
+++ b/vim/bundle/tabular/after/plugin/TabularMaps.vim
@@ -0,0 +1,73 @@
+" Copyright (c) 2016, Matthew J. Wozniski
+" All rights reserved.
+"
+" Redistribution and use in source and binary forms, with or without
+" modification, are permitted provided that the following conditions are met:
+" * Redistributions of source code must retain the above copyright notice,
+" this list of conditions and the following disclaimer.
+" * Redistributions in binary form must reproduce the above copyright
+" notice, this list of conditions and the following disclaimer in the
+" documentation and/or other materials provided with the distribution.
+" * The names of the contributors may not be used to endorse or promote
+" products derived from this software without specific prior written
+" permission.
+"
+" THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER ``AS IS'' AND ANY EXPRESS
+" OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+" OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
+" NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY DIRECT, INDIRECT,
+" INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+" LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+" OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+" LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+" NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
+" EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+if !exists(':Tabularize') || get(g:, 'no_default_tabular_maps', 0)
+ finish " Tabular.vim wasn't loaded or the default maps are unwanted
+endif
+
+let s:save_cpo = &cpo
+set cpo&vim
+
+AddTabularPattern! assignment /[|&+*/%<>=!~-]\@<!\([<>!=]=\|=\~\)\@![|&+*/%<>=!~-]*=/l1r1
+AddTabularPattern! two_spaces / /l0
+
+AddTabularPipeline! multiple_spaces / / map(a:lines, "substitute(v:val, ' *', ' ', 'g')") | tabular#TabularizeStrings(a:lines, ' ', 'l0')
+
+AddTabularPipeline! argument_list /(.*)/ map(a:lines, 'substitute(v:val, ''\s*\([(,)]\)\s*'', ''\1'', ''g'')')
+ \ | tabular#TabularizeStrings(a:lines, '[(,)]', 'l0')
+ \ | map(a:lines, 'substitute(v:val, ''\(\s*\),'', '',\1 '', "g")')
+ \ | map(a:lines, 'substitute(v:val, ''\s*)'', ")", "g")')
+
+function! SplitCDeclarations(lines)
+ let rv = []
+ for line in a:lines
+ " split the line into declaractions
+ let split = split(line, '\s*[,;]\s*')
+ " separate the type from the first declaration
+ let type = substitute(split[0], '\%(\%([&*]\s*\)*\)\=\k\+$', '', '')
+ " add the ; back on every declaration
+ call map(split, 'v:val . ";"')
+ " add the first element to the return as-is, and remove it from the list
+ let rv += [ remove(split, 0) ]
+ " transform the other elements by adding the type on at the beginning
+ call map(split, 'type . v:val')
+ " and add them all to the return
+ let rv += split
+ endfor
+ return rv
+endfunction
+
+AddTabularPipeline! split_declarations /,.*;/ SplitCDeclarations(a:lines)
+
+AddTabularPattern! ternary_operator /^.\{-}\zs?\|:/l1
+
+AddTabularPattern! cpp_io /<<\|>>/l1
+
+AddTabularPattern! pascal_assign /:=/l1
+
+AddTabularPattern! trailing_c_comments /\/\*\|\*\/\|\/\//l1
+
+let &cpo = s:save_cpo
+unlet s:save_cpo
diff --git a/vim/bundle/tabular/autoload/tabular.vim b/vim/bundle/tabular/autoload/tabular.vim
new file mode 100644
index 0000000..f60a73c
--- /dev/null
+++ b/vim/bundle/tabular/autoload/tabular.vim
@@ -0,0 +1,409 @@
+" Tabular: Align columnar data using regex-designated column boundaries
+" Maintainer: Matthew Wozniski (godlygeek@gmail.com)
+" Date: Thu, 03 May 2012 20:49:32 -0400
+" Version: 1.0
+"
+" Long Description:
+" Sometimes, it's useful to line up text. Naturally, it's nicer to have the
+" computer do this for you, since aligning things by hand quickly becomes
+" unpleasant. While there are other plugins for aligning text, the ones I've
+" tried are either impossibly difficult to understand and use, or too simplistic
+" to handle complicated tasks. This plugin aims to make the easy things easy
+" and the hard things possible, without providing an unnecessarily obtuse
+" interface. It's still a work in progress, and criticisms are welcome.
+"
+" License:
+" Copyright (c) 2012, Matthew J. Wozniski
+" All rights reserved.
+"
+" Redistribution and use in source and binary forms, with or without
+" modification, are permitted provided that the following conditions are met:
+" * Redistributions of source code must retain the above copyright notice,
+" this list of conditions and the following disclaimer.
+" * Redistributions in binary form must reproduce the above copyright
+" notice, this list of conditions and the following disclaimer in the
+" documentation and/or other materials provided with the distribution.
+" * The names of the contributors may not be used to endorse or promote
+" products derived from this software without specific prior written
+" permission.
+"
+" THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER ``AS IS'' AND ANY EXPRESS
+" OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+" OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
+" NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY DIRECT, INDIRECT,
+" INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+" LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+" OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+" LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+" NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
+" EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+" Stupid vimscript crap {{{1
+let s:savecpo = &cpo
+set cpo&vim
+
+" Private Functions {{{1
+
+" Return the number of bytes in a string after expanding tabs to spaces. {{{2
+" This expansion is done based on the current value of 'tabstop'
+if exists('*strdisplaywidth')
+ " Needs vim 7.3
+ let s:Strlen = function("strdisplaywidth")
+else
+ function! s:Strlen(string)
+ " Implement the tab handling part of strdisplaywidth for vim 7.2 and
+ " earlier - not much that can be done about handling doublewidth
+ " characters.
+ let rv = 0
+ let i = 0
+
+ for char in split(a:string, '\zs')
+ if char == "\t"
+ let rv += &ts - i
+ let i = 0
+ else
+ let rv += 1
+ let i = (i + 1) % &ts
+ endif
+ endfor
+
+ return rv
+ endfunction
+endif
+
+" Align a string within a field {{{2
+" These functions do not trim leading and trailing spaces.
+
+" Right align 'string' in a field of size 'fieldwidth'
+function! s:Right(string, fieldwidth)
+ let spaces = a:fieldwidth - s:Strlen(a:string)
+ return matchstr(a:string, '^\s*') . repeat(" ", spaces) . substitute(a:string, '^\s*', '', '')
+endfunction
+
+" Left align 'string' in a field of size 'fieldwidth'
+function! s:Left(string, fieldwidth)
+ let spaces = a:fieldwidth - s:Strlen(a:string)
+ return a:string . repeat(" ", spaces)
+endfunction
+
+" Center align 'string' in a field of size 'fieldwidth'
+function! s:Center(string, fieldwidth)
+ let spaces = a:fieldwidth - s:Strlen(a:string)
+ let right = spaces / 2
+ let left = right + (right * 2 != spaces)
+ return repeat(" ", left) . a:string . repeat(" ", right)
+endfunction
+
+" Remove spaces around a string {{{2
+
+" Remove all trailing spaces from a string.
+function! s:StripTrailingSpaces(string)
+ return matchstr(a:string, '^.\{-}\ze\s*$')
+endfunction
+
+" Remove all leading spaces from a string.
+function! s:StripLeadingSpaces(string)
+ return matchstr(a:string, '^\s*\zs.*$')
+endfunction
+
+" Split a string into fields and delimiters {{{2
+" Like split(), but include the delimiters as elements
+" All odd numbered elements are delimiters
+" All even numbered elements are non-delimiters (including zero)
+function! s:SplitDelim(string, delim)
+ let rv = []
+ let beg = 0
+
+ let len = len(a:string)
+ let searchoff = 0
+
+ while 1
+ let mid = match(a:string, a:delim, beg + searchoff, 1)
+ if mid == -1 || mid == len
+ break
+ endif
+
+ let matchstr = matchstr(a:string, a:delim, beg + searchoff, 1)
+ let length = strlen(matchstr)
+
+ if length == 0 && beg == mid
+ " Zero-length match for a zero-length delimiter - advance past it
+ let searchoff += 1
+ continue
+ endif
+
+ if beg == mid
+ let rv += [ "" ]
+ else
+ let rv += [ a:string[beg : mid-1] ]
+ endif
+
+ let rv += [ matchstr ]
+
+ let beg = mid + length
+ let searchoff = 0
+ endwhile
+
+ let rv += [ strpart(a:string, beg) ]
+
+ return rv
+endfunction
+
+" Replace lines from `start' to `start + len - 1' with the given strings. {{{2
+" If more lines are needed to show all strings, they will be added.
+" If there are too few strings to fill all lines, lines will be removed.
+function! s:SetLines(start, len, strings)
+ if a:start > line('$') + 1 || a:start < 1
+ throw "Invalid start line!"
+ endif
+
+ if len(a:strings) > a:len
+ let fensave = &fen
+ let view = winsaveview()
+ call append(a:start + a:len - 1, repeat([''], len(a:strings) - a:len))
+ call winrestview(view)
+ let &fen = fensave
+ elseif len(a:strings) < a:len
+ let fensave = &fen
+ let view = winsaveview()
+ sil exe (a:start + len(a:strings)) . ',' . (a:start + a:len - 1) . 'd_'
+ call winrestview(view)
+ let &fen = fensave
+ endif
+
+ call setline(a:start, a:strings)
+endfunction
+
+" Runs the given commandstring argument as an expression. {{{2
+" The commandstring expression is expected to reference the a:lines argument.
+" If the commandstring expression returns a list the items of that list will
+" replace the items in a:lines, otherwise the expression is assumed to have
+" modified a:lines itself.
+function! s:FilterString(lines, commandstring)
+ exe 'let rv = ' . a:commandstring
+
+ if type(rv) == type(a:lines) && rv isnot a:lines
+ call filter(a:lines, 0)
+ call extend(a:lines, rv)
+ endif
+endfunction
+
+" Public API {{{1
+
+if !exists("g:tabular_default_format")
+ let g:tabular_default_format = "l1"
+endif
+
+let s:formatelempat = '\%([lrc]\d\+\)'
+
+function! tabular#ElementFormatPattern()
+ return s:formatelempat
+endfunction
+
+" Given a list of strings and a delimiter, split each string on every
+" occurrence of the delimiter pattern, format each element according to either
+" the provided format (optional) or the default format, and join them back
+" together with enough space padding to guarantee that the nth delimiter of
+" each string is aligned.
+function! tabular#TabularizeStrings(strings, delim, ...)
+ if a:0 > 1
+ echoerr "TabularizeStrings accepts only 2 or 3 arguments (got ".(a:0+2).")"
+ return 1
+ endif
+
+ let formatstr = (a:0 ? a:1 : g:tabular_default_format)
+
+ if formatstr !~? s:formatelempat . '\+'
+ echoerr "Tabular: Invalid format \"" . formatstr . "\" specified!"
+ return 1
+ endif
+
+ let format = split(formatstr, s:formatelempat . '\zs')
+
+ let lines = map(a:strings, 's:SplitDelim(v:val, a:delim)')
+
+ " Strip spaces
+ " - Only from non-delimiters; spaces in delimiters must have been matched
+ " intentionally
+ " - Don't strip leading spaces from the first element; we like indenting.
+ for line in lines
+ if len(line) == 1 && s:do_gtabularize
+ continue " Leave non-matching lines unchanged for GTabularize
+ endif
+
+ if line[0] !~ '^\s*$'
+ let line[0] = s:StripTrailingSpaces(line[0])
+ endif
+ if len(line) >= 3
+ for i in range(2, len(line)-1, 2)
+ let line[i] = s:StripLeadingSpaces(s:StripTrailingSpaces(line[i]))
+ endfor
+ endif
+ endfor
+
+ " Find the max length of each field
+ let maxes = []
+ for line in lines
+ if len(line) == 1 && s:do_gtabularize
+ continue " non-matching lines don't affect field widths for GTabularize
+ endif
+
+ for i in range(len(line))
+ if i == len(maxes)
+ let maxes += [ s:Strlen(line[i]) ]
+ else
+ let maxes[i] = max( [ maxes[i], s:Strlen(line[i]) ] )
+ endif
+ endfor
+ endfor
+
+ let lead_blank = empty(filter(copy(lines), 'v:val[0] =~ "\\S"'))
+
+ " Concatenate the fields, according to the format pattern.
+ for idx in range(len(lines))
+ let line = lines[idx]
+
+ if len(line) == 1 && s:do_gtabularize
+ let lines[idx] = line[0] " GTabularize doesn't change non-matching lines
+ continue
+ endif
+
+ for i in range(len(line))
+ let how = format[i % len(format)][0]
+ let pad = format[i % len(format)][1:-1]
+
+ if how =~? 'l'
+ let field = s:Left(line[i], maxes[i])
+ elseif how =~? 'r'
+ let field = s:Right(line[i], maxes[i])
+ elseif how =~? 'c'
+ let field = s:Center(line[i], maxes[i])
+ endif
+
+ let line[i] = field . (lead_blank && i == 0 ? '' : repeat(" ", pad))
+ endfor
+
+ let lines[idx] = s:StripTrailingSpaces(join(line, ''))
+ endfor
+endfunction
+
+" Apply 0 or more filters, in sequence, to selected text in the buffer {{{2
+" The lines to be filtered are determined as follows:
+" If the function is called with a range containing multiple lines, then
+" those lines will be used as the range.
+" If the function is called with no range or with a range of 1 line, then
+" if GTabularize mode is being used,
+" the range will not be adjusted
+" if "includepat" is not specified,
+" that 1 line will be filtered,
+" if "includepat" is specified and that line does not match it,
+" no lines will be filtered
+" if "includepat" is specified and that line does match it,
+" all contiguous lines above and below the specified line matching the
+" pattern will be filtered.
+"
+" The remaining arguments must each be a filter to apply to the text.
+" Each filter must either be a String evaluating to a function to be called.
+function! tabular#PipeRange(includepat, ...) range
+ exe a:firstline . ',' . a:lastline
+ \ . 'call tabular#PipeRangeWithOptions(a:includepat, a:000, {})'
+endfunction
+
+" Extended version of tabular#PipeRange, which
+" 1) Takes the list of filters as an explicit list rather than as varargs
+" 2) Supports passing a dictionary of options to control the routine.
+" Currently, the only supported option is 'mode', which determines whether
+" to behave as :Tabularize or as :GTabularize
+" This allows me to add new features here without breaking API compatibility
+" in the future.
+function! tabular#PipeRangeWithOptions(includepat, filterlist, options) range
+ let top = a:firstline
+ let bot = a:lastline
+
+ let s:do_gtabularize = (get(a:options, 'mode', '') ==# 'GTabularize')
+
+ if !s:do_gtabularize
+ " In the default mode, apply range extension logic
+ if a:includepat != '' && top == bot
+ if top < 0 || top > line('$') || getline(top) !~ a:includepat
+ return
+ endif
+ while top > 1 && getline(top-1) =~ a:includepat
+ let top -= 1
+ endwhile
+ while bot < line('$') && getline(bot+1) =~ a:includepat
+ let bot += 1
+ endwhile
+ endif
+ endif
+
+ let lines = map(range(top, bot), 'getline(v:val)')
+
+ for filter in a:filterlist
+ if type(filter) != type("")
+ echoerr "PipeRange: Bad filter: " . string(filter)
+ endif
+
+ call s:FilterString(lines, filter)
+
+ unlet filter
+ endfor
+
+ call s:SetLines(top, bot - top + 1, lines)
+endfunction
+
+" Part of the public interface so interested pipelines can query this and
+" adjust their behavior appropriately.
+function! tabular#DoGTabularize()
+ return s:do_gtabularize
+endfunction
+
+function! s:SplitDelimTest(string, delim, expected)
+ let result = s:SplitDelim(a:string, a:delim)
+
+ if result !=# a:expected
+ echomsg 'Test failed!'
+ echomsg ' string=' . string(a:string) . ' delim=' . string(a:delim)
+ echomsg ' Returned=' . string(result)
+ echomsg ' Expected=' . string(a:expected)
+ endif
+endfunction
+
+function! tabular#SplitDelimUnitTest()
+ let assignment = '[|&+*/%<>=!~-]\@<!\([<>!=]=\|=\~\)\@![|&+*/%<>=!~-]*='
+ let two_spaces = ' '
+ let ternary_operator = '^.\{-}\zs?\|:'
+ let cpp_io = '<<\|>>'
+ let pascal_assign = ':='
+ let trailing_c_comments = '\/\*\|\*\/\|\/\/'
+
+ call s:SplitDelimTest('a+=b', assignment, ['a', '+=', 'b'])
+ call s:SplitDelimTest('a-=b', assignment, ['a', '-=', 'b'])
+ call s:SplitDelimTest('a!=b', assignment, ['a!=b'])
+ call s:SplitDelimTest('a==b', assignment, ['a==b'])
+ call s:SplitDelimTest('a&=b', assignment, ['a', '&=', 'b'])
+ call s:SplitDelimTest('a|=b', assignment, ['a', '|=', 'b'])
+ call s:SplitDelimTest('a=b=c', assignment, ['a', '=', 'b', '=', 'c'])
+
+ call s:SplitDelimTest('a b c', two_spaces, ['a', ' ', 'b', ' ', 'c'])
+ call s:SplitDelimTest('a b c', two_spaces, ['a b', ' ', ' c'])
+ call s:SplitDelimTest('ab c', two_spaces, ['ab', ' ', '', ' ', 'c'])
+
+ call s:SplitDelimTest('a?b:c', ternary_operator, ['a', '?', 'b', ':', 'c'])
+
+ call s:SplitDelimTest('a<<b<<c', cpp_io, ['a', '<<', 'b', '<<', 'c'])
+
+ call s:SplitDelimTest('a:=b=c', pascal_assign, ['a', ':=', 'b=c'])
+
+ call s:SplitDelimTest('x//foo', trailing_c_comments, ['x', '//', 'foo'])
+ call s:SplitDelimTest('x/*foo*/',trailing_c_comments, ['x', '/*', 'foo', '*/', ''])
+
+ call s:SplitDelimTest('#ab#cd#ef', '[^#]*', ['#', 'ab', '#', 'cd', '#', 'ef', ''])
+ call s:SplitDelimTest('#ab#cd#ef', '#\zs', ['#', '', 'ab#', '', 'cd#', '', 'ef'])
+endfunction
+
+" Stupid vimscript crap, part 2 {{{1
+let &cpo = s:savecpo
+unlet s:savecpo
+
+" vim:set sw=2 sts=2 fdm=marker:
diff --git a/vim/bundle/tabular/doc/Tabular.txt b/vim/bundle/tabular/doc/Tabular.txt
new file mode 100644
index 0000000..a4192ad
--- /dev/null
+++ b/vim/bundle/tabular/doc/Tabular.txt
@@ -0,0 +1,260 @@
+*Tabular.txt* Configurable, flexible, intuitive text aligning
+
+ *tabular* *tabular.vim*
+
+ #|#|#|#|#| #| #| ~
+ #| #|#|#| #|#|#| #| #| #| #|#|#| #| #|#| ~
+ #| #| #| #| #| #| #| #| #| #| #|#| ~
+ #| #| #| #| #| #| #| #| #| #| #| ~
+ #| #|#|#| #|#|#| #|#|#| #| #|#|#| #| ~
+
+ For Vim version 7.0 or newer
+
+ By Matt Wozniski
+ mjw@drexel.edu
+
+ Reference Manual ~
+
+ *tabular-toc*
+
+1. Description |tabular-intro|
+2. Walkthrough |tabular-walkthrough|
+3. Scripting |tabular-scripting|
+
+The functionality mentioned here is a plugin, see |add-plugin|.
+You can avoid loading this plugin by setting the "Tabular_loaded" global
+variable in your |vimrc| file: >
+ :let g:tabular_loaded = 1
+
+==============================================================================
+1. Description *tabular-intro*
+
+Sometimes, it's useful to line up text. Naturally, it's nicer to have the
+computer do this for you, since aligning things by hand quickly becomes
+unpleasant. While there are other plugins for aligning text, the ones I've
+tried are either impossibly difficult to understand and use, or too simplistic
+to handle complicated tasks. This plugin aims to make the easy things easy
+and the hard things possible, without providing an unnecessarily obtuse
+interface. It's still a work in progress, and criticisms are welcome.
+
+==============================================================================
+2. Walkthrough *tabular-walkthrough* *:Tabularize*
+
+Tabular's commands are based largely on regular expressions. The basic
+technique used by Tabular is taking some regex to match field delimiters,
+splitting the input lines at those delimiters, trimming unnecessary spaces
+from the non-delimiter parts, padding the non-delimiter parts of the lines
+with spaces to make them the same length, and joining things back together
+again.
+
+For instance, consider starting with the following lines:
+>
+ Some short phrase,some other phrase
+ A much longer phrase here,and another long phrase
+<
+Let's say we want to line these lines up at the commas. We can tell
+Tabularize to do this by passing a pattern matching , to the Tabularize
+command:
+>
+ :Tabularize /,
+
+ Some short phrase , some other phrase
+ A much longer phrase here , and another long phrase
+<
+I encourage you to try copying those lines to another buffer and trying to
+call :Tabularize. You'll want to take notice of two things quickly: First,
+instead of requiring a range, Tabularize tries to figure out what you want to
+happen. Since it knows that you want to act on lines matching a comma, it
+will look upwards and downwards for lines around the current line that match a
+comma, and consider all contiguous lines matching the pattern to be the range
+to be acted upon. You can always override this by specifying a range, though.
+
+The second thing you should notice is that you'll almost certainly be able to
+abbreviate :Tabularize to :Tab - using this form in mappings and scripts is
+discouraged as it will make conflicts with other scripts more likely, but for
+interactive use it's a nice timesaver. Another convenience feature is that
+running :Tabularize without providing a new pattern will cause it to reuse the
+last pattern it was called with.
+
+So, anyway, now the commas line up. Splitting the lines on commas, Tabular
+realized that 'Some short phrase' would need to be padded with spaces to match
+the length of 'A much longer phrase here', and it did that before joining the
+lines back together. You'll also notice that, in addition to the spaces
+inserting for padding, extra spaces were inserted between fields. That's
+because by default, Tabular prints things left-aligned with one space between
+fields. If you wanted to print things right-aligned with no spaces between
+fields, you would provide a different format to the Tabularize command:
+>
+ :Tabularize /,/r0
+
+ Some short phrase, some other phrase
+ A much longer phrase here,and another long phrase
+<
+A format specifier is either l, r, or c, followed by one or more digits. If
+the letter is l, the field will be left aligned, similarly for r and right
+aligning and c and center aligning. The number following the letter is the
+number of spaces padding to insert before the start of the next field.
+Multiple format specifiers can be added to the same command - each field will
+be printed with the next format specifier in the list; when they all have been
+used the first will be used again, and so on. So, the last command right
+aligned every field, then inserted 0 spaces of padding before the next field.
+What if we wanted to right align the text before the comma, and left align the
+text after the comma? The command would look like this:
+>
+ :Tabularize /,/r1c1l0
+
+ Some short phrase , some other phrase
+ A much longer phrase here , and another long phrase
+<
+That command would be read as "Align the matching text, splitting fields on
+commas. Print everything before the first comma right aligned, then 1 space,
+then the comma center aligned, then 1 space, then everything after the comma
+left aligned." Notice that the alignment of the field the comma is in is
+irrelevant - since it's only 1 cell wide, it looks the same whether it's right,
+left, or center aligned. Also notice that the 0 padding spaces specified for
+the 3rd field are unused - but they would be used if there were enough fields
+to require looping through the fields again. For instance:
+>
+ abc,def,ghi
+ a,b
+ a,b,c
+
+ :Tabularize /,/r1c1l0
+
+ abc , def, ghi
+ a , b
+ a , b , c
+<
+Notice that now, the format pattern has been reused; field 4 (the second comma)
+is right aligned, field 5 is center aligned. No spaces were inserted between
+the 3rd field (containing "def") and the 4th field (the second comma) because
+the format specified 'l0'.
+
+But, what if you only wanted to act on the first comma on the line, rather than
+all of the commas on the line? Let's say we want everything before the first
+comma right aligned, then the comma, then everything after the comma left
+aligned:
+>
+ abc,def,ghi
+ a,b
+ a,b,c
+
+ :Tabularize /^[^,]*\zs,/r0c0l0
+
+ abc,def,ghi
+ a,b
+ a,b,c
+<
+Here, we used a Vim regex that would only match the first comma on the line.
+It matches the beginning of the line, followed by all the non-comma characters
+up to the first comma, and then forgets about what it matched so far and
+pretends that the match starts exactly at the comma.
+
+But, now that this command does exactly what we want it to, it's become pretty
+unwieldy. It would be unpleasant to need to type that more than once or
+twice. The solution is to assign a name to it.
+>
+ :AddTabularPattern first_comma /^[^,]*\zs,/r0c0l0
+<
+Now, typing ":Tabularize first_comma" will do the same thing as typing the
+whole pattern out each time. Of course this is more useful if you store the
+name in a file to be used later.
+
+NOTE: In order to make these new commands available every time vim starts,
+you'll need to put those new commands into a .vim file in a plugin directory
+somewhere in your 'runtimepath'. In order to make sure that Tabular.vim has
+already been loaded before your file tries to use :AddTabularPattern or
+:AddTabularPipeline, the new file should be installed in an after/plugin
+directory in 'runtimepath'. In general, it will be safe to find out where the
+TabularMaps.vim plugin was installed, and place other files extending
+Tabular.vim in the same directory as TabularMaps.vim. For more information,
+and some suggested best practices, check out the |tabular-scripting| section.
+
+Lastly, we'll approach the case where tabular cannot achieve your desired goal
+just by splitting lines appart, trimming whitespace, padding with whitespace,
+and rejoining the lines. As an example, consider the multiple_spaces command
+from TabularMaps.vim. The goal is to split using two or more spaces as a
+field delimiter, and join fields back together, properly lined up, with only
+two spaces between the end of each field and the beginning of the next.
+Unfortunately, Tabular can't do this with only the commands we know so far:
+>
+ :Tabularize / /
+<
+The above function won't work, because it will consider "a b" as 5 fields
+delimited by two pairs of 2 spaces ( 'a', ' ', '', ' ', 'b' ) instead of as
+3 fields delimited by one set of 2 or more spaces ( 'a', ' ', 'b' ).
+>
+ :Tabularize / \+/
+<
+The above function won't work either, because it will leave the delimiter as 4
+spaces when used against "a b", meaning that we would fail at our goal of
+collapsing everything down to two spaces between fields. So, we need a new
+command to get around this:
+>
+ :AddTabularPipeline multiple_spaces / \{2,}/
+ \ map(a:lines, "substitute(v:val, ' \{2,}', ' ', 'g')")
+ \ | tabular#TabularizeStrings(a:lines, ' ', 'l0')
+<
+Yeah. I know it looks complicated. Bear with me. I probably will try to add
+in some shortcuts for this syntax, but this verbose will be guaranteed to
+always work.
+
+You should already recognize the name being assigned. The next thing to
+happen is / \{2,}/ which is a pattern specifying which lines should
+automatically be included in the range when no range is given. Without this,
+there would be no pattern to use for extending the range. Everything after
+that is a | separated list of expressions to be evaluated. In the context in
+which they will be evaluated, a:lines will be set to a List of Strings
+containing the text of the lines being filtered as they procede through the
+pipeline you've set up. The \ at the start of the lines are just vim's line
+continuation marker; you needn't worry much about them. So, the first
+expression in the pipeline transforms each line by replacing every instance of
+2 or more spaces with exactly two spaces. The second command in the pipeline
+performs the equivalent of ":Tabularize / /l0"; the only difference is that
+it is operating on a List of Strings rather than text in the buffer. At the
+end of the pipeline, the Strings in the modified a:lines (or the return value
+of the last expression in the pipeline, if it returns a List) will replace the
+chosen range.
+
+==============================================================================
+3. Extending *tabular-scripting*
+
+As mentioned above, the most important consideration when extending Tabular
+with new maps or commands is that your plugin must be loaded after Tabular.vim
+has finished loading, and only if Tabular.vim has loaded successfully. The
+easiest approach to making sure it loads after Tabular.vim is simply putting
+the new file (we'll call it "tabular_extra.vim" as an example) into an
+"after/plugin/" directory in 'runtimepath', for instance:
+>
+ ~/.vim/after/plugin/tabular_extra.vim
+<
+The default set of mappings, found in "TabularMaps.vim", is installed in
+the after/plugin/ subdirectory of whatever directory Tabular was installed to.
+
+The other important consideration is making sure that your commands are only
+called if Tabular.vim was actually loaded. The easiest way to do this is by
+checking for the existence of the :Tabularize command at the start of your
+plugin. A short example plugin would look like this:
+>
+ " after/plugin/my_tabular_commands.vim
+ " Provides extra :Tabularize commands
+
+ if !exists(':Tabularize')
+ finish " Give up here; the Tabular plugin musn't have been loaded
+ endif
+
+ " Make line wrapping possible by resetting the 'cpo' option, first saving it
+ let s:save_cpo = &cpo
+ set cpo&vim
+
+ AddTabularPattern! asterisk /*/l1
+
+ AddTabularPipeline! remove_leading_spaces /^ /
+ \ map(a:lines, "substitute(v:val, '^ *', '', '')")
+
+ " Restore the saved value of 'cpo'
+ let &cpo = s:save_cpo
+ unlet s:save_cpo
+<
+==============================================================================
+vim:tw=78:fo=tcq2:isk=!-~,^*,^\|,^\":ts=8:ft=help:norl:
diff --git a/vim/bundle/tabular/plugin/Tabular.vim b/vim/bundle/tabular/plugin/Tabular.vim
new file mode 100644
index 0000000..e73329a
--- /dev/null
+++ b/vim/bundle/tabular/plugin/Tabular.vim
@@ -0,0 +1,346 @@
+" Tabular: Align columnar data using regex-designated column boundaries
+" Maintainer: Matthew Wozniski (godlygeek@gmail.com)
+" Date: Thu, 03 May 2012 20:49:32 -0400
+" Version: 1.0
+"
+" Long Description:
+" Sometimes, it's useful to line up text. Naturally, it's nicer to have the
+" computer do this for you, since aligning things by hand quickly becomes
+" unpleasant. While there are other plugins for aligning text, the ones I've
+" tried are either impossibly difficult to understand and use, or too simplistic
+" to handle complicated tasks. This plugin aims to make the easy things easy
+" and the hard things possible, without providing an unnecessarily obtuse
+" interface. It's still a work in progress, and criticisms are welcome.
+"
+" License:
+" Copyright (c) 2012, Matthew J. Wozniski
+" All rights reserved.
+"
+" Redistribution and use in source and binary forms, with or without
+" modification, are permitted provided that the following conditions are met:
+" * Redistributions of source code must retain the above copyright notice,
+" this list of conditions and the following disclaimer.
+" * Redistributions in binary form must reproduce the above copyright
+" notice, this list of conditions and the following disclaimer in the
+" documentation and/or other materials provided with the distribution.
+" * The names of the contributors may not be used to endorse or promote
+" products derived from this software without specific prior written
+" permission.
+"
+" THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER ``AS IS'' AND ANY EXPRESS
+" OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+" OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
+" NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY DIRECT, INDIRECT,
+" INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+" LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+" OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+" LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+" NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
+" EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+" Abort if running in vi-compatible mode or the user doesn't want us.
+if &cp || exists('g:tabular_loaded')
+ if &cp && &verbose
+ echo "Not loading Tabular in compatible mode."
+ endif
+ finish
+endif
+
+let g:tabular_loaded = 1
+
+" Stupid vimscript crap {{{1
+let s:savecpo = &cpo
+set cpo&vim
+
+" Private Things {{{1
+
+" Dictionary of command name to command
+let s:TabularCommands = {}
+
+" Generate tab completion list for :Tabularize {{{2
+" Return a list of commands that match the command line typed so far.
+" NOTE: Tries to handle commands with spaces in the name, but Vim doesn't seem
+" to handle that terribly well... maybe I should give up on that.
+function! s:CompleteTabularizeCommand(argstart, cmdline, cursorpos)
+ let names = keys(s:TabularCommands)
+ if exists("b:TabularCommands")
+ let names += keys(b:TabularCommands)
+ endif
+
+ let cmdstart = substitute(a:cmdline, '^\s*\S\+\s*', '', '')
+
+ return filter(names, 'v:val =~# ''^\V'' . escape(cmdstart, ''\'')')
+endfunction
+
+" Choose the proper command map from the given command line {{{2
+" Returns [ command map, command line with leading <buffer> removed ]
+function! s:ChooseCommandMap(commandline)
+ let map = s:TabularCommands
+ let cmd = a:commandline
+
+ if cmd =~# '^<buffer>\s\+'
+ if !exists('b:TabularCommands')
+ let b:TabularCommands = {}
+ endif
+ let map = b:TabularCommands
+ let cmd = substitute(cmd, '^<buffer>\s\+', '', '')
+ endif
+
+ return [ map, cmd ]
+endfunction
+
+" Parse '/pattern/format' into separate pattern and format parts. {{{2
+" If parsing fails, return [ '', '' ]
+function! s:ParsePattern(string)
+ if a:string[0] != '/'
+ return ['','']
+ endif
+
+ let pat = '\\\@<!\%(\\\\\)\{-}\zs/' . tabular#ElementFormatPattern() . '*$'
+ let format = matchstr(a:string[1:-1], pat)
+ if !empty(format)
+ let format = format[1 : -1]
+ let pattern = a:string[1 : -len(format) - 2]
+ else
+ let pattern = a:string[1 : -1]
+ endif
+
+ return [pattern, format]
+endfunction
+
+" Split apart a list of | separated expressions. {{{2
+function! s:SplitCommands(string)
+ if a:string =~ '^\s*$'
+ return []
+ endif
+
+ let end = match(a:string, "[\"'|]")
+
+ " Loop until we find a delimiting | or end-of-string
+ while end != -1 && (a:string[end] != '|' || a:string[end+1] == '|')
+ if a:string[end] == "'"
+ let end = match(a:string, "'", end+1) + 1
+ if end == 0
+ throw "No matching end single quote"
+ endif
+ elseif a:string[end] == '"'
+ " Find a " preceded by an even number of \ (or 0)
+ let pattern = '\%(\\\@<!\%(\\\\\)*\)\@<="'
+ let end = matchend(a:string, pattern, end+1) + 1
+ if end == 0
+ throw "No matching end double quote"
+ endif
+ else " Found ||
+ let end += 2
+ endif
+
+ let end = match(a:string, "[\"'|]", end)
+ endwhile
+
+ if end == 0 || a:string[0 : end - (end > 0)] =~ '^\s*$'
+ throw "Empty element"
+ endif
+
+ if end == -1
+ let rv = [ a:string ]
+ else
+ let rv = [ a:string[0 : end-1] ] + s:SplitCommands(a:string[end+1 : -1])
+ endif
+
+ return rv
+endfunction
+
+" Public Things {{{1
+
+" Command associating a command name with a simple pattern command {{{2
+" AddTabularPattern[!] [<buffer>] name /pattern[/format]
+"
+" If <buffer> is provided, the command will only be available in the current
+" buffer, and will be used instead of any global command with the same name.
+"
+" If a command with the same name and scope already exists, it is an error,
+" unless the ! is provided, in which case the existing command will be
+" replaced.
+"
+" pattern is a regex describing the delimiter to be used.
+"
+" format describes the format pattern to be used. The default will be used if
+" none is provided.
+com! -nargs=+ -bang AddTabularPattern
+ \ call AddTabularPattern(<q-args>, <bang>0)
+
+function! AddTabularPattern(command, force)
+ try
+ let [ commandmap, rest ] = s:ChooseCommandMap(a:command)
+
+ let name = matchstr(rest, '.\{-}\ze\s*/')
+ let pattern = substitute(rest, '.\{-}\s*\ze/', '', '')
+
+ let [ pattern, format ] = s:ParsePattern(pattern)
+
+ if empty(name) || empty(pattern)
+ throw "Invalid arguments!"
+ endif
+
+ if !a:force && has_key(commandmap, name)
+ throw string(name) . " is already defined, use ! to overwrite."
+ endif
+
+ let command = "tabular#TabularizeStrings(a:lines, " . string(pattern)
+
+ if !empty(format)
+ let command .= ", " . string(format)
+ endif
+
+ let command .= ")"
+
+ let commandmap[name] = { 'pattern' : pattern, 'commands' : [ command ] }
+ catch
+ echohl ErrorMsg
+ echomsg "AddTabularPattern: " . v:exception
+ echohl None
+ endtry
+endfunction
+
+" Command associating a command name with a pipeline of functions {{{2
+" AddTabularPipeline[!] [<buffer>] name /pattern/ func [ | func2 [ | func3 ] ]
+"
+" If <buffer> is provided, the command will only be available in the current
+" buffer, and will be used instead of any global command with the same name.
+"
+" If a command with the same name and scope already exists, it is an error,
+" unless the ! is provided, in which case the existing command will be
+" replaced.
+"
+" pattern is a regex that will be used to determine which lines will be
+" filtered. If the cursor line doesn't match the pattern, using the command
+" will be a no-op, otherwise the cursor and all contiguous lines matching the
+" pattern will be filtered.
+"
+" Each 'func' argument represents a function to be called. This function
+" will have access to a:lines, a List containing one String per line being
+" filtered.
+com! -nargs=+ -bang AddTabularPipeline
+ \ call AddTabularPipeline(<q-args>, <bang>0)
+
+function! AddTabularPipeline(command, force)
+ try
+ let [ commandmap, rest ] = s:ChooseCommandMap(a:command)
+
+ let name = matchstr(rest, '.\{-}\ze\s*/')
+ let pattern = substitute(rest, '.\{-}\s*\ze/', '', '')
+
+ let commands = matchstr(pattern, '^/.\{-}\\\@<!\%(\\\\\)\{-}/\zs.*')
+ let pattern = matchstr(pattern, '/\zs.\{-}\\\@<!\%(\\\\\)\{-}\ze/')
+
+ if empty(name) || empty(pattern)
+ throw "Invalid arguments!"
+ endif
+
+ if !a:force && has_key(commandmap, name)
+ throw string(name) . " is already defined, use ! to overwrite."
+ endif
+
+ let commandlist = s:SplitCommands(commands)
+
+ if empty(commandlist)
+ throw "Must provide a list of functions!"
+ endif
+
+ let commandmap[name] = { 'pattern' : pattern, 'commands' : commandlist }
+ catch
+ echohl ErrorMsg
+ echomsg "AddTabularPipeline: " . v:exception
+ echohl None
+ endtry
+endfunction
+
+" Tabularize /pattern[/format] {{{2
+" Tabularize name
+"
+" Align text, either using the given pattern, or the command associated with
+" the given name.
+com! -nargs=* -range -complete=customlist,<SID>CompleteTabularizeCommand
+ \ Tabularize <line1>,<line2>call Tabularize(<q-args>)
+
+function! Tabularize(command, ...) range
+ let piperange_opt = {}
+ if a:0
+ let piperange_opt = a:1
+ endif
+
+ if empty(a:command)
+ if !exists("s:last_tabularize_command")
+ echohl ErrorMsg
+ echomsg "Tabularize hasn't been called yet; no pattern/command to reuse!"
+ echohl None
+ return
+ endif
+ else
+ let s:last_tabularize_command = a:command
+ endif
+
+ let command = s:last_tabularize_command
+
+ let range = a:firstline . ',' . a:lastline
+
+ try
+ let [ pattern, format ] = s:ParsePattern(command)
+
+ if !empty(pattern)
+ let cmd = "tabular#TabularizeStrings(a:lines, " . string(pattern)
+
+ if !empty(format)
+ let cmd .= "," . string(format)
+ endif
+
+ let cmd .= ")"
+
+ exe range . 'call tabular#PipeRangeWithOptions(pattern, [ cmd ], '
+ \ . 'piperange_opt)'
+ else
+ if exists('b:TabularCommands') && has_key(b:TabularCommands, command)
+ let usercmd = b:TabularCommands[command]
+ elseif has_key(s:TabularCommands, command)
+ let usercmd = s:TabularCommands[command]
+ else
+ throw "Unrecognized command " . string(command)
+ endif
+
+ exe range . 'call tabular#PipeRangeWithOptions(usercmd["pattern"], '
+ \ . 'usercmd["commands"], piperange_opt)'
+ endif
+ catch
+ echohl ErrorMsg
+ echomsg "Tabularize: " . v:exception
+ echohl None
+ return
+ endtry
+endfunction
+
+" GTabularize /pattern[/format] {{{2
+" GTabularize name
+"
+" Align text on only matching lines, either using the given pattern, or the
+" command associated with the given name. Mnemonically, this is similar to
+" the :global command, which takes some action on all rows matching a pattern
+" in a range. This command is different from normal :Tabularize in 3 ways:
+" 1) If a line in the range does not match the pattern, it will be left
+" unchanged, and not in any way affect the outcome of other lines in the
+" range (at least, normally - but Pipelines can and will still look at
+" non-matching rows unless they are specifically written to be aware of
+" tabular#DoGTabularize() and handle it appropriately).
+" 2) No automatic range determination - :Tabularize automatically expands
+" a single-line range (or a call with no range) to include all adjacent
+" matching lines. That behavior does not make sense for this command.
+" 3) If called without a range, it will act on all lines in the buffer (like
+" :global) rather than only a single line
+com! -nargs=* -range=% -complete=customlist,<SID>CompleteTabularizeCommand
+ \ GTabularize <line1>,<line2>
+ \ call Tabularize(<q-args>, { 'mode': 'GTabularize' } )
+
+" Stupid vimscript crap, part 2 {{{1
+let &cpo = s:savecpo
+unlet s:savecpo
+
+" vim:set sw=2 sts=2 fdm=marker:
diff --git a/vim/bundle/vim-fugitive/.gitignore b/vim/bundle/vim-fugitive/.gitignore
new file mode 100644
index 0000000..0a56e3f
--- /dev/null
+++ b/vim/bundle/vim-fugitive/.gitignore
@@ -0,0 +1 @@
+/doc/tags
diff --git a/vim/bundle/vim-fugitive/CONTRIBUTING.markdown b/vim/bundle/vim-fugitive/CONTRIBUTING.markdown
new file mode 100644
index 0000000..e651dca
--- /dev/null
+++ b/vim/bundle/vim-fugitive/CONTRIBUTING.markdown
@@ -0,0 +1,18 @@
+Before reporting a bug, you should try stripping down your Vim configuration
+and removing other plugins. The sad truth about VimScript is that it is
+fraught with incompatibilities waiting to happen. I'm happy to work around
+them where I can, but it's up to you to isolate the conflict.
+
+Fugitive is particularly prone to regressions due to Git version issues,
+platform issues, and interactions with other plugins. I end up bisecting a
+lot more than other projects, and thus I'm especially meticulous here about
+maintaining a clean, readable, history. Squash and force push any requested
+changes to a pull request. And if your [commit message
+sucks](http://tbaggery.com/2008/04/19/a-note-about-git-commit-messages.html),
+I'm not going to accept it. Period.
+
+Beyond that, don't be shy about asking before patching. What takes you hours
+might take me minutes simply because I have both domain knowledge and a
+perverse knowledge of VimScript so vast that many would consider it a symptom
+of mental illness. On the flip side, some ideas I'll reject no matter how
+good the implementation is. "Send a patch" is an edge case answer in my book.
diff --git a/vim/bundle/vim-fugitive/README.markdown b/vim/bundle/vim-fugitive/README.markdown
new file mode 100644
index 0000000..71b8bc4
--- /dev/null
+++ b/vim/bundle/vim-fugitive/README.markdown
@@ -0,0 +1,118 @@
+# fugitive.vim
+
+I'm not going to lie to you; fugitive.vim may very well be the best
+Git wrapper of all time. Check out these features:
+
+View any blob, tree, commit, or tag in the repository with `:Gedit` (and
+`:Gsplit`, `:Gvsplit`, `:Gtabedit`, ...). Edit a file in the index and
+write to it to stage the changes. Use `:Gdiff` to bring up the staged
+version of the file side by side with the working tree version and use
+Vim's diff handling capabilities to stage a subset of the file's
+changes.
+
+Bring up the output of `git status` with `:Gstatus`. Press `-` to
+`add`/`reset` a file's changes, or `p` to `add`/`reset` `--patch`. And guess
+what `:Gcommit` does!
+
+`:Gblame` brings up an interactive vertical split with `git blame`
+output. Press enter on a line to edit the commit where the line
+changed, or `o` to open it in a split. When you're done, use `:Gedit`
+in the historic buffer to go back to the work tree version.
+
+`:Gmove` does a `git mv` on a file and simultaneously renames the
+buffer. `:Gremove` does a `git rm` on a file and simultaneously deletes
+the buffer.
+
+Use `:Ggrep` to search the work tree (or any arbitrary commit) with
+`git grep`, skipping over that which is not tracked in the repository.
+`:Glog` loads all previous revisions of a file into the quickfix list so
+you can iterate over them and watch the file evolve!
+
+`:Gread` is a variant of `git checkout -- filename` that operates on the
+buffer rather than the filename. This means you can use `u` to undo it
+and you never get any warnings about the file changing outside Vim.
+`:Gwrite` writes to both the work tree and index versions of a file,
+making it like `git add` when called from a work tree file and like
+`git checkout` when called from the index or a blob in history.
+
+Use `:Gbrowse` to open the current file on GitHub, with optional line
+range (try it in visual mode!). If your current repository isn't on
+GitHub, `git instaweb` will be spun up instead.
+
+Add `%{fugitive#statusline()}` to `'statusline'` to get an indicator
+with the current branch in (surprise!) your statusline.
+
+Last but not least, there's `:Git` for running any arbitrary command,
+and `Git!` to open the output of a command in a temp file.
+
+## Screencasts
+
+* [A complement to command line git](http://vimcasts.org/e/31)
+* [Working with the git index](http://vimcasts.org/e/32)
+* [Resolving merge conflicts with vimdiff](http://vimcasts.org/e/33)
+* [Browsing the git object database](http://vimcasts.org/e/34)
+* [Exploring the history of a git repository](http://vimcasts.org/e/35)
+
+## Installation
+
+If you don't have a preferred installation method, one option is to install
+[pathogen.vim](https://github.com/tpope/vim-pathogen), and then copy
+and paste:
+
+ cd ~/.vim/bundle
+ git clone git://github.com/tpope/vim-fugitive.git
+ vim -u NONE -c "helptags vim-fugitive/doc" -c q
+
+If your Vim version is below 7.2, I recommend also installing
+[vim-git](https://github.com/tpope/vim-git) for syntax highlighting and
+other Git niceties.
+
+## FAQ
+
+> I installed the plugin and started Vim. Why don't any of the commands
+> exist?
+
+Fugitive cares about the current file, not the current working
+directory. Edit a file from the repository.
+
+> I opened a new tab. Why don't any of the commands exist?
+
+Fugitive cares about the current file, not the current working
+directory. Edit a file from the repository.
+
+> Why is `:Gbrowse` not using the right browser?
+
+`:Gbrowse` delegates to `git web--browse`, which is less than perfect
+when it comes to finding the right browser. You can tell it the correct
+browser to use with `git config --global web.browser ...`. On OS X, for
+example, you might want to set this to `open`. See `git web--browse --help`
+for details.
+
+> Here's a patch that automatically opens the quickfix window after
+> `:Ggrep`.
+
+This is a great example of why I recommend asking before patching.
+There are valid arguments to be made both for and against automatically
+opening the quickfix window. Whenever I have to make an arbitrary
+decision like this, I ask what Vim would do. And Vim does not open a
+quickfix window after `:grep`.
+
+Luckily, it's easy to implement the desired behavior without changing
+fugitive.vim. The following autocommand will cause the quickfix window
+to open after any grep invocation:
+
+ autocmd QuickFixCmdPost *grep* cwindow
+
+## Self-Promotion
+
+Like fugitive.vim? Follow the repository on
+[GitHub](https://github.com/tpope/vim-fugitive) and vote for it on
+[vim.org](http://www.vim.org/scripts/script.php?script_id=2975). And if
+you're feeling especially charitable, follow [tpope](http://tpo.pe/) on
+[Twitter](http://twitter.com/tpope) and
+[GitHub](https://github.com/tpope).
+
+## License
+
+Copyright (c) Tim Pope. Distributed under the same terms as Vim itself.
+See `:help license`.
diff --git a/vim/bundle/vim-fugitive/doc/fugitive.txt b/vim/bundle/vim-fugitive/doc/fugitive.txt
new file mode 100644
index 0000000..51fc591
--- /dev/null
+++ b/vim/bundle/vim-fugitive/doc/fugitive.txt
@@ -0,0 +1,357 @@
+*fugitive.txt* A Git wrapper so awesome, it should be illegal
+
+Author: Tim Pope <http://tpo.pe/>
+License: Same terms as Vim itself (see |license|)
+
+This plugin is only available if 'compatible' is not set.
+
+INTRODUCTION *fugitive*
+
+Whenever you edit a file from a Git repository, a set of commands is defined
+that serve as a gateway to Git.
+
+COMMANDS *fugitive-commands*
+
+These commands are local to the buffers in which they work (generally, buffers
+that are part of Git repositories).
+
+ *fugitive-:Git*
+:Git [args] Run an arbitrary git command. Similar to :!git [args]
+ but chdir to the repository tree first.
+
+ *fugitive-:Git!*
+:Git! [args] Like |:Git|, but capture the output into a temp file,
+ and edit that temp file.
+
+ *fugitive-:Gcd*
+:Gcd [directory] |:cd| relative to the repository.
+
+ *fugitive-:Glcd*
+:Glcd [directory] |:lcd| relative to the repository.
+
+ *fugitive-:Gstatus*
+:Gstatus Bring up the output of git-status in the preview
+ window. The following maps, which work on the cursor
+ line file where sensible, are provided:
+
+ g? show this help
+ <C-N> next file
+ <C-P> previous file
+ <CR> |:Gedit|
+ - |:Git| add
+ - |:Git| reset (staged files)
+ cA |:Gcommit| --amend --reuse-message=HEAD
+ ca |:Gcommit| --amend
+ cc |:Gcommit|
+ cva |:Gcommit| --amend --verbose
+ cvc |:Gcommit| --verbose
+ D |:Gdiff|
+ ds |:Gsdiff|
+ dp |:Git!| diff (p for patch; use :Gw to apply)
+ dp |:Git| add --intent-to-add (untracked files)
+ dv |:Gvdiff|
+ O |:Gtabedit|
+ o |:Gsplit|
+ p |:Git| add --patch
+ p |:Git| reset --patch (staged files)
+ q close status
+ r reload status
+ S |:Gvsplit|
+ U |:Git| checkout
+ U |:Git| checkout HEAD (staged files)
+ U |:Git| clean (untracked files)
+ U |:Git| rm (unmerged files)
+
+ *fugitive-:Gcommit*
+:Gcommit [args] A wrapper around git-commit. If there is nothing
+ to commit, |:Gstatus| is called instead. Unless the
+ arguments given would skip the invocation of an editor
+ (e.g., -m), a split window will be used to obtain a
+ commit message, or a new tab if -v is given. Write
+ and close that window (:wq or |:Gwrite|) to finish the
+ commit. Unlike when running the actual git-commit
+ command, it is possible (but unadvisable) to alter the
+ index with commands like git-add and git-reset while a
+ commit message is pending.
+
+ *fugitive-:Gmerge*
+:Gmerge [args] Calls git-merge and loads errors and conflicted files
+ into the quickfix list. Opens a |:Gcommit| style
+ split window for the commit message if the merge
+ succeeds. If called during a merge conflict, the
+ conflicted files from the current index are loaded
+ into the quickfix list.
+
+ *fugitive-:Gpull*
+:Gpull [args] Like |:Gmerge|, but for git-pull.
+
+ *fugitive-:Gpush*
+:Gpush [args] Invoke git-push, load the results into the quickfix
+ list, and invoke |:cwindow| to reveal any errors.
+ |:Dispatch| is used if available for asynchronous
+ invocation.
+
+ *fugitive-:Gfetch*
+:Gfetch [args] Like |:Gpush|, but for git-fetch.
+
+ *fugitive-:Ggrep*
+:Ggrep[!] [args] |:grep|[!] with git-grep as 'grepprg'.
+
+ *fugitive-:Glgrep*
+:Glgrep[!] [args] |:lgrep|[!] with git-grep as 'grepprg'.
+
+ *fugitive-:Glog*
+:Glog [args] Load all previous revisions of the current file into
+ the quickfix list. Additional git-log arguments can
+ be given (for example, --reverse). If "--" appears as
+ an argument, no file specific filtering is done, and
+ previous commits rather than previous file revisions
+ are loaded.
+
+:{range}Glog [args] Use git-log -L to load previous revisions of the given
+ range of the current file into the quickfix list. The
+ cursor is positioned on the first line of the first
+ diff hunk for each commit.
+
+ *fugitive-:Gllog*
+:Gllog [args] Like |:Glog|, but use the location list instead of the
+ quickfix list.
+
+ *fugitive-:Gedit* *fugitive-:Ge*
+:Gedit [revision] |:edit| a |fugitive-revision|.
+
+ *fugitive-:Gsplit*
+:Gsplit [revision] |:split| a |fugitive-revision|.
+
+ *fugitive-:Gvsplit*
+:Gvsplit [revision] |:vsplit| a |fugitive-revision|.
+
+ *fugitive-:Gtabedit*
+:Gtabedit [revision] |:tabedit| a |fugitive-revision|.
+
+ *fugitive-:Gpedit*
+:Gpedit [revision] |:pedit| a |fugitive-revision|.
+
+:Gsplit! [args] *fugitive-:Gsplit!* *fugitive-:Gvsplit!*
+:Gvsplit! [args] *fugitive-:Gtabedit!* *fugitive-:Gpedit!*
+:Gtabedit! [args] Like |:Git!|, but open the resulting temp file in a
+:Gpedit! [args] split, tab, or preview window.
+
+ *fugitive-:Gread*
+:Gread [revision] Empty the buffer and |:read| a |fugitive-revision|.
+ When the argument is omitted, this is similar to
+ git-checkout on a work tree file or git-add on a stage
+ file, but without writing anything to disk.
+
+:{range}Gread [revision]
+ |:read| in a |fugitive-revision| after {range}.
+
+ *fugitive-:Gread!*
+:Gread! [args] Empty the buffer and |:read| the output of a Git
+ command. For example, :Gread! show HEAD:%.
+
+:{range}Gread! [args] |:read| the output of a Git command after {range}.
+
+ *fugitive-:Gw* *fugitive-:Gwrite*
+:Gwrite Write to the current file's path and stage the results.
+ When run in a work tree file, it is effectively git
+ add. Elsewhere, it is effectively git-checkout. A
+ great deal of effort is expended to behave sensibly
+ when the work tree or index version of the file is
+ open in another buffer.
+
+:Gwrite {path} You can give |:Gwrite| an explicit path of where in
+ the work tree to write. You can also give a path like
+ :0:foo.txt or even :0 to write to just that stage in
+ the index.
+
+ *fugitive-:Gwq*
+:Gwq [path] Like |:Gwrite| followed by |:quit| if the write
+ succeeded.
+
+:Gwq! [path] Like |:Gwrite|! followed by |:quit|! if the write
+ succeeded.
+
+ *fugitive-:Gdiff*
+:Gdiff [revision] Perform a |vimdiff| against the current file in the
+ given revision. With no argument, the version in the
+ index is used (which means a three-way diff during a
+ merge conflict, making it a git-mergetool
+ alternative). The newer of the two files is placed
+ to the right or bottom, depending on 'diffopt' and
+ the width of the window relative to 'textwidth'. Use
+ |do| and |dp| and write to the index file to simulate
+ "git add --patch".
+
+ *fugitive-:Gsdiff*
+:Gsdiff [revision] Like |:Gdiff|, but always split horizontally.
+
+ *fugitive-:Gvdiff*
+:Gvdiff [revision] Like |:Gdiff|, but always split vertically.
+
+ *fugitive-:Gmove*
+:Gmove {destination} Wrapper around git-mv that renames the buffer
+ afterward. The destination is relative to the current
+ directory except when started with a /, in which case
+ it is relative to the work tree. Add a ! to pass -f.
+
+ *fugitive-:Gremove*
+:Gremove Wrapper around git-rm that deletes the buffer
+ afterward. When invoked in an index file, --cached is
+ passed. Add a ! to pass -f and forcefully discard the
+ buffer.
+
+ *fugitive-:Gblame*
+:Gblame [flags] Run git-blame on the file and open the results in a
+ scroll bound vertical split. You can give any of
+ ltfnsewMC as flags and they will be passed along to
+ git-blame. The following maps, which work on the
+ cursor line commit where sensible, are provided:
+
+ g? show this help
+ A resize to end of author column
+ C resize to end of commit column
+ D resize to end of date/time column
+ q close blame and return to blamed window
+ gq q, then |:Gedit| to return to work tree version
+ <CR> q, then open commit
+ o open commit in horizontal split
+ O open commit in new tab
+ - reblame at commit
+ ~ reblame at [count]th first grandparent
+ P reblame at [count]th parent (like HEAD^[count])
+
+:[range]Gblame [flags] Run git-blame on the given range.
+
+ *fugitive-:Gbrowse*
+:Gbrowse Open the current file, blob, tree, commit, or tag
+ in your browser at the upstream hosting provider.
+ If a range is given, it is appropriately appended to
+ the URL as an anchor.
+
+ Upstream providers can be added by installing an
+ appropriate Vim plugin. For example, GitHub can be
+ supported by installing rhubarb.vim, available at
+ <https://github.com/tpope/vim-rhubarb>. (Native
+ support for GitHub is currently included, but that is
+ slated to be removed.)
+
+ The hosting provider is determined by looking at the
+ remote for the current or specified branch and falls
+ back to "origin". In the special case of a "."
+ remote, a local instance of git-instaweb will be
+ started and used.
+
+:Gbrowse {revision} Like :Gbrowse, but for a given |fugitive-revision|. A
+ useful value here is -, which ties the URL to the
+ latest commit rather than a volatile branch.
+
+:Gbrowse [...]@{remote} Force using the given remote rather than the remote
+ for the current branch. The remote is used to
+ determine which GitHub repository to link to.
+
+:{range}Gbrowse [args] Appends an anchor to the URL that emphasizes the
+ selected lines. You almost certainly want to give a
+ "-" argument in this case to force the URL to include
+ an exact revision.
+
+:[range]Gbrowse! [args] Like :Gbrowse, but put the URL on the clipboard rather
+ than opening it.
+
+MAPPINGS *fugitive-mappings*
+
+These maps are available everywhere.
+
+ *fugitive-c_CTRL-R_CTRL-G*
+<C-R><C-G> On the command line, recall the path to the current
+ object (that is, a representation of the object
+ recognized by |:Gedit|).
+
+ *fugitive-y_CTRL-G*
+["x]y<C-G> Yank the commit SHA and path to the current object.
+
+These maps are available in Git objects.
+
+ *fugitive-<CR>*
+<CR> Jump to the revision under the cursor.
+
+ *fugitive-o*
+o Jump to the revision under the cursor in a new split.
+
+ *fugitive-S*
+S Jump to the revision under the cursor in a new
+ vertical split.
+
+ *fugitive-O*
+O Jump to the revision under the cursor in a new tab.
+
+ *fugitive--*
+- Go to the tree containing the current tree or blob.
+
+ *fugitive-~*
+~ Go to the current file in the [count]th first
+ ancestor.
+
+ *fugitive-P*
+P Go to the current file in the [count]th parent.
+
+ *fugitive-C*
+C Go to the commit containing the current file.
+
+ *fugitive-.*
+. Start a |:| command line with the current revision
+ prepopulated at the end of the line.
+
+ *fugitive-a*
+a Show the current tag, commit, or tree in an alternate
+ format.
+
+SPECIFYING REVISIONS *fugitive-revision*
+
+Fugitive revisions are similar to Git revisions as defined in the "SPECIFYING
+REVISIONS" section in the git-rev-parse man page. For commands that accept an
+optional revision, the default is the file in the index for work tree files
+and the work tree file for everything else. Example revisions follow.
+
+Revision Meaning ~
+HEAD .git/HEAD
+master .git/refs/heads/master
+HEAD^{} The commit referenced by HEAD
+HEAD^ The parent of the commit referenced by HEAD
+HEAD: The tree referenced by HEAD
+/HEAD The file named HEAD in the work tree
+Makefile The file named Makefile in the work tree
+HEAD^:Makefile The file named Makefile in the parent of HEAD
+:Makefile The file named Makefile in the index (writable)
+- The current file in HEAD
+^ The current file in the previous commit
+~3 The current file 3 commits ago
+: .git/index (Same as |:Gstatus|)
+:0 The current file in the index
+:1 The current file's common ancestor during a conflict
+:2 The current file in the target branch during a conflict
+:3 The current file in the merged branch during a conflict
+:/foo The most recent commit with "foo" in the message
+
+STATUSLINE *fugitive-statusline*
+
+ *fugitive#statusline()*
+Add %{fugitive#statusline()} to your statusline to get an indicator including
+the current branch and the currently edited file's commit. If you don't have
+a statusline, this one matches the default when 'ruler' is set:
+>
+ set statusline=%<%f\ %h%m%r%{fugitive#statusline()}%=%-14.(%l,%c%V%)\ %P
+<
+ *fugitive#head(...)*
+Use fugitive#head() to return the name of the current branch. If the current
+HEAD is detached, fugitive#head() will return the empty string, unless the
+optional argument is given, in which case the hash of the current commit will
+be truncated to the given number of characters.
+
+ABOUT *fugitive-about*
+
+Grab the latest version or report a bug on GitHub:
+
+http://github.com/tpope/vim-fugitive
+
+ vim:tw=78:et:ft=help:norl:
diff --git a/vim/bundle/vim-fugitive/plugin/fugitive.vim b/vim/bundle/vim-fugitive/plugin/fugitive.vim
new file mode 100644
index 0000000..66948f7
--- /dev/null
+++ b/vim/bundle/vim-fugitive/plugin/fugitive.vim
@@ -0,0 +1,3105 @@
+" fugitive.vim - A Git wrapper so awesome, it should be illegal
+" Maintainer: Tim Pope <http://tpo.pe/>
+" Version: 2.2
+" GetLatestVimScripts: 2975 1 :AutoInstall: fugitive.vim
+
+if exists('g:loaded_fugitive') || &cp
+ finish
+endif
+let g:loaded_fugitive = 1
+
+if !exists('g:fugitive_git_executable')
+ let g:fugitive_git_executable = 'git'
+endif
+
+" Section: Utility
+
+function! s:function(name) abort
+ return function(substitute(a:name,'^s:',matchstr(expand('<sfile>'), '<SNR>\d\+_'),''))
+endfunction
+
+function! s:sub(str,pat,rep) abort
+ return substitute(a:str,'\v\C'.a:pat,a:rep,'')
+endfunction
+
+function! s:gsub(str,pat,rep) abort
+ return substitute(a:str,'\v\C'.a:pat,a:rep,'g')
+endfunction
+
+function! s:winshell() abort
+ return &shell =~? 'cmd' || exists('+shellslash') && !&shellslash
+endfunction
+
+function! s:shellesc(arg) abort
+ if a:arg =~ '^[A-Za-z0-9_/.-]\+$'
+ return a:arg
+ elseif s:winshell()
+ return '"'.s:gsub(s:gsub(a:arg, '"', '""'), '\%', '"%"').'"'
+ else
+ return shellescape(a:arg)
+ endif
+endfunction
+
+function! s:fnameescape(file) abort
+ if exists('*fnameescape')
+ return fnameescape(a:file)
+ else
+ return escape(a:file," \t\n*?[{`$\\%#'\"|!<")
+ endif
+endfunction
+
+function! s:throw(string) abort
+ let v:errmsg = 'fugitive: '.a:string
+ throw v:errmsg
+endfunction
+
+function! s:warn(str) abort
+ echohl WarningMsg
+ echomsg a:str
+ echohl None
+ let v:warningmsg = a:str
+endfunction
+
+function! s:shellslash(path) abort
+ if s:winshell()
+ return s:gsub(a:path,'\\','/')
+ else
+ return a:path
+ endif
+endfunction
+
+let s:git_versions = {}
+
+function! fugitive#git_version(...) abort
+ if !has_key(s:git_versions, g:fugitive_git_executable)
+ let s:git_versions[g:fugitive_git_executable] = matchstr(system(g:fugitive_git_executable.' --version'), "\\S\\+\n")
+ endif
+ return s:git_versions[g:fugitive_git_executable]
+endfunction
+
+function! s:recall() abort
+ let rev = s:sub(s:buffer().rev(), '^/', '')
+ if rev ==# ':'
+ return matchstr(getline('.'),'^#\t\%([[:alpha:] ]\+: *\)\=\zs.\{-\}\ze\%( ([^()[:digit:]]\+)\)\=$\|^\d\{6} \x\{40\} \d\t\zs.*')
+ elseif s:buffer().type('tree')
+ let file = matchstr(getline('.'), '\t\zs.*')
+ if empty(file) && line('.') > 2
+ let file = s:sub(getline('.'), '/$', '')
+ endif
+ if !empty(file) && rev !~# ':$'
+ return rev . '/' . file
+ else
+ return rev . file
+ endif
+ endif
+ return rev
+endfunction
+
+function! s:add_methods(namespace, method_names) abort
+ for name in a:method_names
+ let s:{a:namespace}_prototype[name] = s:function('s:'.a:namespace.'_'.name)
+ endfor
+endfunction
+
+let s:commands = []
+function! s:command(definition) abort
+ let s:commands += [a:definition]
+endfunction
+
+function! s:define_commands() abort
+ for command in s:commands
+ exe 'command! -buffer '.command
+ endfor
+endfunction
+
+let s:abstract_prototype = {}
+
+" Section: Initialization
+
+function! fugitive#is_git_dir(path) abort
+ let path = s:sub(a:path, '[\/]$', '') . '/'
+ return getfsize(path.'HEAD') > 10 && (
+ \ isdirectory(path.'objects') && isdirectory(path.'refs') ||
+ \ getftype(path.'commondir') ==# 'file')
+endfunction
+
+function! fugitive#extract_git_dir(path) abort
+ if s:shellslash(a:path) =~# '^fugitive://.*//'
+ return matchstr(s:shellslash(a:path), '\C^fugitive://\zs.\{-\}\ze//')
+ endif
+ let root = s:shellslash(simplify(fnamemodify(a:path, ':p:s?[\/]$??')))
+ let previous = ""
+ while root !=# previous
+ if root =~# '\v^//%([^/]+/?)?$'
+ " This is for accessing network shares from Cygwin Vim. There won't be
+ " any git directory called //.git or //serverName/.git so let's avoid
+ " checking for them since such checks are extremely slow.
+ break
+ endif
+ if index(split($GIT_CEILING_DIRECTORIES, ':'), root) >= 0
+ break
+ endif
+ if root ==# $GIT_WORK_TREE && fugitive#is_git_dir($GIT_DIR)
+ return simplify(fnamemodify(expand($GIT_DIR), ':p:s?[\/]$??'))
+ endif
+ if fugitive#is_git_dir($GIT_DIR)
+ " Ensure that we've cached the worktree
+ call s:configured_tree(simplify(fnamemodify(expand($GIT_DIR), ':p:s?[\/]$??')))
+ if has_key(s:dir_for_worktree, root)
+ return s:dir_for_worktree[root]
+ endif
+ endif
+ let dir = s:sub(root, '[\/]$', '') . '/.git'
+ let type = getftype(dir)
+ if type ==# 'dir' && fugitive#is_git_dir(dir)
+ return dir
+ elseif type ==# 'link' && fugitive#is_git_dir(dir)
+ return resolve(dir)
+ elseif type !=# '' && filereadable(dir)
+ let line = get(readfile(dir, '', 1), 0, '')
+ if line =~# '^gitdir: \.' && fugitive#is_git_dir(root.'/'.line[8:-1])
+ return simplify(root.'/'.line[8:-1])
+ elseif line =~# '^gitdir: ' && fugitive#is_git_dir(line[8:-1])
+ return line[8:-1]
+ endif
+ elseif fugitive#is_git_dir(root)
+ return root
+ endif
+ let previous = root
+ let root = fnamemodify(root, ':h')
+ endwhile
+ return ''
+endfunction
+
+function! fugitive#detect(path) abort
+ if exists('b:git_dir') && (b:git_dir ==# '' || b:git_dir =~# '/$')
+ unlet b:git_dir
+ endif
+ if !exists('b:git_dir')
+ let dir = fugitive#extract_git_dir(a:path)
+ if dir !=# ''
+ let b:git_dir = dir
+ endif
+ endif
+ if exists('b:git_dir')
+ if exists('#User#FugitiveBoot')
+ try
+ let [save_mls, &modelines] = [&mls, 0]
+ doautocmd User FugitiveBoot
+ finally
+ let &mls = save_mls
+ endtry
+ endif
+ if !exists('g:fugitive_no_maps')
+ cnoremap <buffer> <expr> <C-R><C-G> fnameescape(<SID>recall())
+ nnoremap <buffer> <silent> y<C-G> :call setreg(v:register, <SID>recall())<CR>
+ endif
+ let buffer = fugitive#buffer()
+ if expand('%:p') =~# '://'
+ call buffer.setvar('&path', s:sub(buffer.getvar('&path'), '^\.%(,|$)', ''))
+ endif
+ if stridx(buffer.getvar('&tags'), escape(b:git_dir, ', ')) == -1
+ if filereadable(b:git_dir.'/tags')
+ call buffer.setvar('&tags', escape(b:git_dir.'/tags', ', ').','.buffer.getvar('&tags'))
+ endif
+ if &filetype !=# '' && filereadable(b:git_dir.'/'.&filetype.'.tags')
+ call buffer.setvar('&tags', escape(b:git_dir.'/'.&filetype.'.tags', ', ').','.buffer.getvar('&tags'))
+ endif
+ endif
+ try
+ let [save_mls, &modelines] = [&mls, 0]
+ call s:define_commands()
+ doautocmd User Fugitive
+ finally
+ let &mls = save_mls
+ endtry
+ endif
+endfunction
+
+augroup fugitive
+ autocmd!
+ autocmd BufNewFile,BufReadPost * call fugitive#detect(expand('%:p'))
+ autocmd FileType netrw call fugitive#detect(expand('%:p'))
+ autocmd User NERDTreeInit,NERDTreeNewRoot call fugitive#detect(b:NERDTreeRoot.path.str())
+ autocmd VimEnter * if expand('<amatch>')==''|call fugitive#detect(getcwd())|endif
+ autocmd CmdWinEnter * call fugitive#detect(expand('#:p'))
+ autocmd BufWinLeave * execute getwinvar(+bufwinnr(+expand('<abuf>')), 'fugitive_leave')
+augroup END
+
+" Section: Repository
+
+let s:repo_prototype = {}
+let s:repos = {}
+let s:worktree_for_dir = {}
+let s:dir_for_worktree = {}
+
+function! s:repo(...) abort
+ let dir = a:0 ? a:1 : (exists('b:git_dir') && b:git_dir !=# '' ? b:git_dir : fugitive#extract_git_dir(expand('%:p')))
+ if dir !=# ''
+ if has_key(s:repos, dir)
+ let repo = get(s:repos, dir)
+ else
+ let repo = {'git_dir': dir}
+ let s:repos[dir] = repo
+ endif
+ return extend(extend(repo, s:repo_prototype, 'keep'), s:abstract_prototype, 'keep')
+ endif
+ call s:throw('not a git repository: '.expand('%:p'))
+endfunction
+
+function! fugitive#repo(...) abort
+ return call('s:repo', a:000)
+endfunction
+
+function! s:repo_dir(...) dict abort
+ return join([self.git_dir]+a:000,'/')
+endfunction
+
+function! s:configured_tree(git_dir) abort
+ if !has_key(s:worktree_for_dir, a:git_dir)
+ let s:worktree_for_dir[a:git_dir] = ''
+ let config_file = a:git_dir . '/config'
+ if filereadable(config_file)
+ let config = readfile(config_file,'',10)
+ call filter(config,'v:val =~# "^\\s*worktree *="')
+ if len(config) == 1
+ let worktree = matchstr(config[0], '= *\zs.*')
+ endif
+ elseif filereadable(a:git_dir . '/gitdir')
+ let worktree = fnamemodify(readfile(a:git_dir . '/gitdir')[0], ':h')
+ if worktree ==# '.'
+ unlet! worktree
+ endif
+ endif
+ if exists('worktree')
+ let s:worktree_for_dir[a:git_dir] = worktree
+ let s:dir_for_worktree[s:worktree_for_dir[a:git_dir]] = a:git_dir
+ endif
+ endif
+ if s:worktree_for_dir[a:git_dir] =~# '^\.'
+ return simplify(a:git_dir . '/' . s:worktree_for_dir[a:git_dir])
+ else
+ return s:worktree_for_dir[a:git_dir]
+ endif
+endfunction
+
+function! s:repo_tree(...) dict abort
+ if self.dir() =~# '/\.git$'
+ let dir = self.dir()[0:-6]
+ else
+ let dir = s:configured_tree(self.git_dir)
+ endif
+ if dir ==# ''
+ call s:throw('no work tree')
+ else
+ return join([dir]+a:000,'/')
+ endif
+endfunction
+
+function! s:repo_bare() dict abort
+ if self.dir() =~# '/\.git$'
+ return 0
+ else
+ return s:configured_tree(self.git_dir) ==# ''
+ endif
+endfunction
+
+function! s:repo_translate(spec) dict abort
+ let refs = self.dir('refs/')
+ if filereadable(self.dir('commondir'))
+ let refs = simplify(self.dir(get(readfile(self.dir('commondir'), 1), 0, ''))) . '/refs/'
+ endif
+ if a:spec ==# '.' || a:spec ==# '/.'
+ return self.bare() ? self.dir() : self.tree()
+ elseif a:spec =~# '^/\=\.git$' && self.bare()
+ return self.dir()
+ elseif a:spec =~# '^/\=\.git/'
+ return self.dir(s:sub(a:spec, '^/=\.git/', ''))
+ elseif a:spec =~# '^/'
+ return self.tree().a:spec
+ elseif a:spec =~# '^:[0-3]:'
+ return 'fugitive://'.self.dir().'//'.a:spec[1].'/'.a:spec[3:-1]
+ elseif a:spec ==# ':'
+ if $GIT_INDEX_FILE =~# '/[^/]*index[^/]*\.lock$' && fnamemodify($GIT_INDEX_FILE,':p')[0:strlen(self.dir())] ==# self.dir('') && filereadable($GIT_INDEX_FILE)
+ return fnamemodify($GIT_INDEX_FILE,':p')
+ else
+ return self.dir('index')
+ endif
+ elseif a:spec =~# '^:/'
+ let ref = self.rev_parse(matchstr(a:spec,'.[^:]*'))
+ return 'fugitive://'.self.dir().'//'.ref
+ elseif a:spec =~# '^:'
+ return 'fugitive://'.self.dir().'//0/'.a:spec[1:-1]
+ elseif a:spec ==# '@'
+ return self.dir('HEAD')
+ elseif a:spec =~# 'HEAD\|^refs/' && a:spec !~ ':' && filereadable(refs . '../' . a:spec)
+ return simplify(refs . '../' . a:spec)
+ elseif filereadable(refs.a:spec)
+ return refs.a:spec
+ elseif filereadable(refs.'tags/'.a:spec)
+ return refs.'tags/'.a:spec
+ elseif filereadable(refs.'heads/'.a:spec)
+ return refs.'heads/'.a:spec
+ elseif filereadable(refs.'remotes/'.a:spec)
+ return refs.'remotes/'.a:spec
+ elseif filereadable(refs.'remotes/'.a:spec.'/HEAD')
+ return refs.'remotes/'.a:spec.'/HEAD'
+ else
+ try
+ let ref = self.rev_parse(matchstr(a:spec,'[^:]*'))
+ let path = s:sub(matchstr(a:spec,':.*'),'^:','/')
+ return 'fugitive://'.self.dir().'//'.ref.path
+ catch /^fugitive:/
+ return self.tree(a:spec)
+ endtry
+ endif
+endfunction
+
+function! s:repo_head(...) dict abort
+ let head = s:repo().head_ref()
+
+ if head =~# '^ref: '
+ let branch = s:sub(head,'^ref: %(refs/%(heads/|remotes/|tags/)=)=','')
+ elseif head =~# '^\x\{40\}$'
+ " truncate hash to a:1 characters if we're in detached head mode
+ let len = a:0 ? a:1 : 0
+ let branch = len ? head[0:len-1] : ''
+ else
+ return ''
+ endif
+
+ return branch
+endfunction
+
+call s:add_methods('repo',['dir','tree','bare','translate','head'])
+
+function! s:repo_git_command(...) dict abort
+ let git = g:fugitive_git_executable . ' --git-dir='.s:shellesc(self.git_dir)
+ return git.join(map(copy(a:000),'" ".s:shellesc(v:val)'),'')
+endfunction
+
+function! s:repo_git_chomp(...) dict abort
+ return s:sub(system(call(self.git_command,a:000,self)),'\n$','')
+endfunction
+
+function! s:repo_git_chomp_in_tree(...) dict abort
+ let cd = exists('*haslocaldir') && haslocaldir() ? 'lcd ' : 'cd '
+ let dir = getcwd()
+ try
+ execute cd.'`=s:repo().tree()`'
+ return call(s:repo().git_chomp, a:000, s:repo())
+ finally
+ execute cd.'`=dir`'
+ endtry
+endfunction
+
+function! s:repo_rev_parse(rev) dict abort
+ let hash = self.git_chomp('rev-parse','--verify',a:rev)
+ if hash =~ '\<\x\{40\}$'
+ return matchstr(hash,'\<\x\{40\}$')
+ endif
+ call s:throw('rev-parse '.a:rev.': '.hash)
+endfunction
+
+call s:add_methods('repo',['git_command','git_chomp','git_chomp_in_tree','rev_parse'])
+
+function! s:repo_dirglob(base) dict abort
+ let base = s:sub(a:base,'^/','')
+ let matches = split(glob(self.tree(s:gsub(base,'/','*&').'*/')),"\n")
+ call map(matches,'v:val[ strlen(self.tree())+(a:base !~ "^/") : -1 ]')
+ return matches
+endfunction
+
+function! s:repo_superglob(base) dict abort
+ if a:base =~# '^/' || a:base !~# ':'
+ let results = []
+ if a:base !~# '^/'
+ let heads = ["HEAD","ORIG_HEAD","FETCH_HEAD","MERGE_HEAD"]
+ let heads += sort(split(s:repo().git_chomp("rev-parse","--symbolic","--branches","--tags","--remotes"),"\n"))
+ " Add any stashes.
+ if filereadable(s:repo().dir('refs/stash'))
+ let heads += ["stash"]
+ let heads += sort(split(s:repo().git_chomp("stash","list","--pretty=format:%gd"),"\n"))
+ endif
+ call filter(heads,'v:val[ 0 : strlen(a:base)-1 ] ==# a:base')
+ let results += heads
+ endif
+ if !self.bare()
+ let base = s:sub(a:base,'^/','')
+ let matches = split(glob(self.tree(s:gsub(base,'/','*&').'*')),"\n")
+ call map(matches,'s:shellslash(v:val)')
+ call map(matches,'v:val !~ "/$" && isdirectory(v:val) ? v:val."/" : v:val')
+ call map(matches,'v:val[ strlen(self.tree())+(a:base !~ "^/") : -1 ]')
+ let results += matches
+ endif
+ return results
+
+ elseif a:base =~# '^:'
+ let entries = split(self.git_chomp('ls-files','--stage'),"\n")
+ call map(entries,'s:sub(v:val,".*(\\d)\\t(.*)",":\\1:\\2")')
+ if a:base !~# '^:[0-3]\%(:\|$\)'
+ call filter(entries,'v:val[1] == "0"')
+ call map(entries,'v:val[2:-1]')
+ endif
+ call filter(entries,'v:val[ 0 : strlen(a:base)-1 ] ==# a:base')
+ return entries
+
+ else
+ let tree = matchstr(a:base,'.*[:/]')
+ let entries = split(self.git_chomp('ls-tree',tree),"\n")
+ call map(entries,'s:sub(v:val,"^04.*\\zs$","/")')
+ call map(entries,'tree.s:sub(v:val,".*\t","")')
+ return filter(entries,'v:val[ 0 : strlen(a:base)-1 ] ==# a:base')
+ endif
+endfunction
+
+call s:add_methods('repo',['dirglob','superglob'])
+
+function! s:repo_config(conf) dict abort
+ return matchstr(system(s:repo().git_command('config').' '.a:conf),"[^\r\n]*")
+endfun
+
+function! s:repo_user() dict abort
+ let username = s:repo().config('user.name')
+ let useremail = s:repo().config('user.email')
+ return username.' <'.useremail.'>'
+endfun
+
+function! s:repo_aliases() dict abort
+ if !has_key(self,'_aliases')
+ let self._aliases = {}
+ for line in split(self.git_chomp('config','-z','--get-regexp','^alias[.]'),"\1")
+ let self._aliases[matchstr(line, '\.\zs.\{-}\ze\n')] = matchstr(line, '\n\zs.*')
+ endfor
+ endif
+ return self._aliases
+endfunction
+
+call s:add_methods('repo',['config', 'user', 'aliases'])
+
+function! s:repo_keywordprg() dict abort
+ let args = ' --git-dir='.escape(self.dir(),"\\\"' ")
+ if has('gui_running') && !has('win32')
+ return g:fugitive_git_executable . ' --no-pager' . args . ' log -1'
+ else
+ return g:fugitive_git_executable . args . ' show'
+ endif
+endfunction
+
+call s:add_methods('repo',['keywordprg'])
+
+" Section: Buffer
+
+let s:buffer_prototype = {}
+
+function! s:buffer(...) abort
+ let buffer = {'#': bufnr(a:0 ? a:1 : '%')}
+ call extend(extend(buffer,s:buffer_prototype,'keep'),s:abstract_prototype,'keep')
+ if buffer.getvar('git_dir') !=# ''
+ return buffer
+ endif
+ call s:throw('not a git repository: '.expand('%:p'))
+endfunction
+
+function! fugitive#buffer(...) abort
+ return s:buffer(a:0 ? a:1 : '%')
+endfunction
+
+function! s:buffer_getvar(var) dict abort
+ return getbufvar(self['#'],a:var)
+endfunction
+
+function! s:buffer_setvar(var,value) dict abort
+ return setbufvar(self['#'],a:var,a:value)
+endfunction
+
+function! s:buffer_getline(lnum) dict abort
+ return get(getbufline(self['#'], a:lnum), 0, '')
+endfunction
+
+function! s:buffer_repo() dict abort
+ return s:repo(self.getvar('git_dir'))
+endfunction
+
+function! s:buffer_type(...) dict abort
+ if self.getvar('fugitive_type') != ''
+ let type = self.getvar('fugitive_type')
+ elseif fnamemodify(self.spec(),':p') =~# '.\git/refs/\|\.git/\w*HEAD$'
+ let type = 'head'
+ elseif self.getline(1) =~ '^tree \x\{40\}$' && self.getline(2) == ''
+ let type = 'tree'
+ elseif self.getline(1) =~ '^\d\{6\} \w\{4\} \x\{40\}\>\t'
+ let type = 'tree'
+ elseif self.getline(1) =~ '^\d\{6\} \x\{40\}\> \d\t'
+ let type = 'index'
+ elseif isdirectory(self.spec())
+ let type = 'directory'
+ elseif self.spec() == ''
+ let type = 'null'
+ else
+ let type = 'file'
+ endif
+ if a:0
+ return !empty(filter(copy(a:000),'v:val ==# type'))
+ else
+ return type
+ endif
+endfunction
+
+if has('win32')
+
+ function! s:buffer_spec() dict abort
+ let bufname = bufname(self['#'])
+ let retval = ''
+ for i in split(bufname,'[^:]\zs\\')
+ let retval = fnamemodify((retval==''?'':retval.'\').i,':.')
+ endfor
+ return s:shellslash(fnamemodify(retval,':p'))
+ endfunction
+
+else
+
+ function! s:buffer_spec() dict abort
+ let bufname = bufname(self['#'])
+ return s:shellslash(bufname == '' ? '' : fnamemodify(bufname,':p'))
+ endfunction
+
+endif
+
+function! s:buffer_name() dict abort
+ return self.spec()
+endfunction
+
+function! s:buffer_commit() dict abort
+ return matchstr(self.spec(),'^fugitive://.\{-\}//\zs\w*')
+endfunction
+
+function! s:cpath(path) abort
+ if exists('+fileignorecase') && &fileignorecase
+ return tolower(a:path)
+ else
+ return a:path
+ endif
+endfunction
+
+function! s:buffer_path(...) dict abort
+ let rev = matchstr(self.spec(),'^fugitive://.\{-\}//\zs.*')
+ if rev != ''
+ let rev = s:sub(rev,'\w*','')
+ elseif s:cpath(self.spec()[0 : len(self.repo().dir())]) ==#
+ \ s:cpath(self.repo().dir() . '/')
+ let rev = '/.git'.self.spec()[strlen(self.repo().dir()) : -1]
+ elseif !self.repo().bare() &&
+ \ s:cpath(self.spec()[0 : len(self.repo().tree())]) ==#
+ \ s:cpath(self.repo().tree() . '/')
+ let rev = self.spec()[strlen(self.repo().tree()) : -1]
+ endif
+ return s:sub(s:sub(rev,'.\zs/$',''),'^/',a:0 ? a:1 : '')
+endfunction
+
+function! s:buffer_rev() dict abort
+ let rev = matchstr(self.spec(),'^fugitive://.\{-\}//\zs.*')
+ if rev =~ '^\x/'
+ return ':'.rev[0].':'.rev[2:-1]
+ elseif rev =~ '.'
+ return s:sub(rev,'/',':')
+ elseif self.spec() =~ '\.git/index$'
+ return ':'
+ elseif self.spec() =~ '\.git/refs/\|\.git/.*HEAD$'
+ return self.spec()[strlen(self.repo().dir())+1 : -1]
+ else
+ return self.path('/')
+ endif
+endfunction
+
+function! s:buffer_sha1() dict abort
+ if self.spec() =~ '^fugitive://' || self.spec() =~ '\.git/refs/\|\.git/.*HEAD$'
+ return self.repo().rev_parse(self.rev())
+ else
+ return ''
+ endif
+endfunction
+
+function! s:buffer_expand(rev) dict abort
+ if a:rev =~# '^:[0-3]$'
+ let file = a:rev.self.path(':')
+ elseif a:rev =~# '^[-:]/$'
+ let file = '/'.self.path()
+ elseif a:rev =~# '^-'
+ let file = 'HEAD^{}'.a:rev[1:-1].self.path(':')
+ elseif a:rev =~# '^@{'
+ let file = 'HEAD'.a:rev.self.path(':')
+ elseif a:rev =~# '^[~^]'
+ let commit = s:sub(self.commit(),'^\d=$','HEAD')
+ let file = commit.a:rev.self.path(':')
+ else
+ let file = a:rev
+ endif
+ return s:sub(s:sub(file,'\%$',self.path()),'\.\@<=/$','')
+endfunction
+
+function! s:buffer_containing_commit() dict abort
+ if self.commit() =~# '^\d$'
+ return ':'
+ elseif self.commit() =~# '.'
+ return self.commit()
+ else
+ return 'HEAD'
+ endif
+endfunction
+
+function! s:buffer_up(...) dict abort
+ let rev = self.rev()
+ let c = a:0 ? a:1 : 1
+ while c
+ if rev =~# '^[/:]$'
+ let rev = 'HEAD'
+ elseif rev =~# '^:'
+ let rev = ':'
+ elseif rev =~# '^refs/[^^~:]*$\|^[^^~:]*HEAD$'
+ let rev .= '^{}'
+ elseif rev =~# '^/\|:.*/'
+ let rev = s:sub(rev, '.*\zs/.*', '')
+ elseif rev =~# ':.'
+ let rev = matchstr(rev, '^[^:]*:')
+ elseif rev =~# ':$'
+ let rev = rev[0:-2]
+ else
+ return rev.'~'.c
+ endif
+ let c -= 1
+ endwhile
+ return rev
+endfunction
+
+call s:add_methods('buffer',['getvar','setvar','getline','repo','type','spec','name','commit','path','rev','sha1','expand','containing_commit','up'])
+
+" Section: Git
+
+call s:command("-bang -nargs=? -complete=customlist,s:GitComplete Git :execute s:Git(<bang>0,<q-args>)")
+
+function! s:ExecuteInTree(cmd) abort
+ let cd = exists('*haslocaldir') && haslocaldir() ? 'lcd ' : 'cd '
+ let dir = getcwd()
+ try
+ execute cd.'`=s:repo().tree()`'
+ execute a:cmd
+ finally
+ execute cd.'`=dir`'
+ endtry
+endfunction
+
+function! s:Git(bang, args) abort
+ if a:bang
+ return s:Edit('edit', 1, a:args)
+ endif
+ let git = g:fugitive_git_executable
+ if has('gui_running') && !has('win32')
+ let git .= ' --no-pager'
+ endif
+ let args = matchstr(a:args,'\v\C.{-}%($|\\@<!%(\\\\)*\|)@=')
+ if exists(':terminal')
+ let dir = s:repo().tree()
+ if expand('%') != ''
+ -tabedit %
+ else
+ -tabnew
+ endif
+ execute 'lcd' fnameescape(dir)
+ execute 'terminal' git args
+ else
+ call s:ExecuteInTree('!'.git.' '.args)
+ if has('win32')
+ call fugitive#reload_status()
+ endif
+ endif
+ return matchstr(a:args, '\v\C\\@<!%(\\\\)*\|\zs.*')
+endfunction
+
+function! fugitive#git_commands() abort
+ if !exists('s:exec_path')
+ let s:exec_path = s:sub(system(g:fugitive_git_executable.' --exec-path'),'\n$','')
+ endif
+ return map(split(glob(s:exec_path.'/git-*'),"\n"),'s:sub(v:val[strlen(s:exec_path)+5 : -1],"\\.exe$","")')
+endfunction
+
+function! s:GitComplete(A, L, P) abort
+ if strpart(a:L, 0, a:P) !~# ' [[:alnum:]-]\+ '
+ let cmds = fugitive#git_commands()
+ return filter(sort(cmds+keys(s:repo().aliases())), 'strpart(v:val, 0, strlen(a:A)) ==# a:A')
+ else
+ return s:repo().superglob(a:A)
+ endif
+endfunction
+
+" Section: Gcd, Glcd
+
+function! s:DirComplete(A,L,P) abort
+ let matches = s:repo().dirglob(a:A)
+ return matches
+endfunction
+
+call s:command("-bar -bang -nargs=? -complete=customlist,s:DirComplete Gcd :cd<bang> `=s:repo().bare() ? s:repo().dir(<q-args>) : s:repo().tree(<q-args>)`")
+call s:command("-bar -bang -nargs=? -complete=customlist,s:DirComplete Glcd :lcd<bang> `=s:repo().bare() ? s:repo().dir(<q-args>) : s:repo().tree(<q-args>)`")
+
+" Section: Gstatus
+
+call s:command("-bar Gstatus :execute s:Status()")
+augroup fugitive_status
+ autocmd!
+ if !has('win32')
+ autocmd FocusGained,ShellCmdPost * call fugitive#reload_status()
+ autocmd BufDelete term://* call fugitive#reload_status()
+ endif
+augroup END
+
+function! s:Status() abort
+ try
+ Gpedit :
+ wincmd P
+ setlocal foldmethod=syntax foldlevel=1
+ nnoremap <buffer> <silent> q :<C-U>bdelete<CR>
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ endtry
+ return ''
+endfunction
+
+function! fugitive#reload_status() abort
+ if exists('s:reloading_status')
+ return
+ endif
+ try
+ let s:reloading_status = 1
+ let mytab = tabpagenr()
+ for tab in [mytab] + range(1,tabpagenr('$'))
+ for winnr in range(1,tabpagewinnr(tab,'$'))
+ if getbufvar(tabpagebuflist(tab)[winnr-1],'fugitive_type') ==# 'index'
+ execute 'tabnext '.tab
+ if winnr != winnr()
+ execute winnr.'wincmd w'
+ let restorewinnr = 1
+ endif
+ try
+ if !&modified
+ call s:BufReadIndex()
+ endif
+ finally
+ if exists('restorewinnr')
+ wincmd p
+ endif
+ execute 'tabnext '.mytab
+ endtry
+ endif
+ endfor
+ endfor
+ finally
+ unlet! s:reloading_status
+ endtry
+endfunction
+
+function! s:stage_info(lnum) abort
+ let filename = matchstr(getline(a:lnum),'^#\t\zs.\{-\}\ze\%( ([^()[:digit:]]\+)\)\=$')
+ let lnum = a:lnum
+ if has('multi_byte_encoding')
+ let colon = '\%(:\|\%uff1a\)'
+ else
+ let colon = ':'
+ endif
+ while lnum && getline(lnum) !~# colon.'$'
+ let lnum -= 1
+ endwhile
+ if !lnum
+ return ['', '']
+ elseif (getline(lnum+1) =~# '^# .*\<git \%(reset\|rm --cached\) ' && getline(lnum+2) ==# '#') || getline(lnum) ==# '# Changes to be committed:'
+ return [matchstr(filename, colon.' *\zs.*'), 'staged']
+ elseif (getline(lnum+1) =~# '^# .*\<git add ' && getline(lnum+2) ==# '#' && getline(lnum+3) !~# colon.' ') || getline(lnum) ==# '# Untracked files:'
+ return [filename, 'untracked']
+ elseif getline(lnum+2) =~# '^# .*\<git checkout ' || getline(lnum) ==# '# Changes not staged for commit:'
+ return [matchstr(filename, colon.' *\zs.*'), 'unstaged']
+ elseif getline(lnum+2) =~# '^# .*\<git \%(add\|rm\)' || getline(lnum) ==# '# Unmerged paths:'
+ return [matchstr(filename, colon.' *\zs.*'), 'unmerged']
+ else
+ return ['', 'unknown']
+ endif
+endfunction
+
+function! s:StageNext(count) abort
+ for i in range(a:count)
+ call search('^#\t.*','W')
+ endfor
+ return '.'
+endfunction
+
+function! s:StagePrevious(count) abort
+ if line('.') == 1 && exists(':CtrlP') && get(g:, 'ctrl_p_map') =~? '^<c-p>$'
+ return 'CtrlP '.fnameescape(s:repo().tree())
+ else
+ for i in range(a:count)
+ call search('^#\t.*','Wbe')
+ endfor
+ return '.'
+ endif
+endfunction
+
+function! s:StageReloadSeek(target,lnum1,lnum2) abort
+ let jump = a:target
+ let f = matchstr(getline(a:lnum1-1),'^#\t\%([[:alpha:] ]\+: *\|.*\%uff1a *\)\=\zs.*')
+ if f !=# '' | let jump = f | endif
+ let f = matchstr(getline(a:lnum2+1),'^#\t\%([[:alpha:] ]\+: *\|.*\%uff1a *\)\=\zs.*')
+ if f !=# '' | let jump = f | endif
+ silent! edit!
+ 1
+ redraw
+ call search('^#\t\%([[:alpha:] ]\+: *\|.*\%uff1a *\)\=\V'.jump.'\%( ([^()[:digit:]]\+)\)\=\$','W')
+endfunction
+
+function! s:StageUndo() abort
+ let [filename, section] = s:stage_info(line('.'))
+ if empty(filename)
+ return ''
+ endif
+ let repo = s:repo()
+ let hash = repo.git_chomp('hash-object', '-w', filename)
+ if !empty(hash)
+ if section ==# 'untracked'
+ call repo.git_chomp_in_tree('clean', '-f', '--', filename)
+ elseif section ==# 'unmerged'
+ call repo.git_chomp_in_tree('rm', '--', filename)
+ elseif section ==# 'unstaged'
+ call repo.git_chomp_in_tree('checkout', '--', filename)
+ else
+ call repo.git_chomp_in_tree('checkout', 'HEAD', '--', filename)
+ endif
+ call s:StageReloadSeek(filename, line('.'), line('.'))
+ let @" = hash
+ return 'checktime|redraw|echomsg ' .
+ \ string('To restore, :Git cat-file blob '.hash[0:6].' > '.filename)
+ endif
+endfunction
+
+function! s:StageDiff(diff) abort
+ let [filename, section] = s:stage_info(line('.'))
+ if filename ==# '' && section ==# 'staged'
+ return 'Git! diff --no-ext-diff --cached'
+ elseif filename ==# ''
+ return 'Git! diff --no-ext-diff'
+ elseif filename =~# ' -> '
+ let [old, new] = split(filename,' -> ')
+ execute 'Gedit '.s:fnameescape(':0:'.new)
+ return a:diff.' HEAD:'.s:fnameescape(old)
+ elseif section ==# 'staged'
+ execute 'Gedit '.s:fnameescape(':0:'.filename)
+ return a:diff.' -'
+ else
+ execute 'Gedit '.s:fnameescape('/'.filename)
+ return a:diff
+ endif
+endfunction
+
+function! s:StageDiffEdit() abort
+ let [filename, section] = s:stage_info(line('.'))
+ let arg = (filename ==# '' ? '.' : filename)
+ if section ==# 'staged'
+ return 'Git! diff --no-ext-diff --cached '.s:shellesc(arg)
+ elseif section ==# 'untracked'
+ let repo = s:repo()
+ call repo.git_chomp_in_tree('add','--intent-to-add',arg)
+ if arg ==# '.'
+ silent! edit!
+ 1
+ if !search('^# .*:\n#.*\n# .*"git checkout \|^# Changes not staged for commit:$','W')
+ call search('^# .*:$','W')
+ endif
+ else
+ call s:StageReloadSeek(arg,line('.'),line('.'))
+ endif
+ return ''
+ else
+ return 'Git! diff --no-ext-diff '.s:shellesc(arg)
+ endif
+endfunction
+
+function! s:StageToggle(lnum1,lnum2) abort
+ if a:lnum1 == 1 && a:lnum2 == 1
+ return 'Gedit /.git|call search("^index$", "wc")'
+ endif
+ try
+ let output = ''
+ for lnum in range(a:lnum1,a:lnum2)
+ let [filename, section] = s:stage_info(lnum)
+ let repo = s:repo()
+ if getline('.') =~# '^# .*:$'
+ if section ==# 'staged'
+ call repo.git_chomp_in_tree('reset','-q')
+ silent! edit!
+ 1
+ if !search('^# .*:\n# .*"git add .*\n#\n\|^# Untracked files:$','W')
+ call search('^# .*:$','W')
+ endif
+ return ''
+ elseif section ==# 'unstaged'
+ call repo.git_chomp_in_tree('add','-u')
+ silent! edit!
+ 1
+ if !search('^# .*:\n# .*"git add .*\n#\n\|^# Untracked files:$','W')
+ call search('^# .*:$','W')
+ endif
+ return ''
+ else
+ call repo.git_chomp_in_tree('add','.')
+ silent! edit!
+ 1
+ call search('^# .*:$','W')
+ return ''
+ endif
+ endif
+ if filename ==# ''
+ continue
+ endif
+ execute lnum
+ if filename =~ ' -> '
+ let cmd = ['mv','--'] + reverse(split(filename,' -> '))
+ let filename = cmd[-1]
+ elseif section ==# 'staged'
+ let cmd = ['reset','-q','--',filename]
+ elseif getline(lnum) =~# '^#\tdeleted:'
+ let cmd = ['rm','--',filename]
+ elseif getline(lnum) =~# '^#\tmodified:'
+ let cmd = ['add','--',filename]
+ else
+ let cmd = ['add','-A','--',filename]
+ endif
+ if !exists('first_filename')
+ let first_filename = filename
+ endif
+ let output .= call(repo.git_chomp_in_tree,cmd,s:repo())."\n"
+ endfor
+ if exists('first_filename')
+ call s:StageReloadSeek(first_filename,a:lnum1,a:lnum2)
+ endif
+ echo s:sub(s:gsub(output,'\n+','\n'),'\n$','')
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ endtry
+ return 'checktime'
+endfunction
+
+function! s:StagePatch(lnum1,lnum2) abort
+ let add = []
+ let reset = []
+
+ for lnum in range(a:lnum1,a:lnum2)
+ let [filename, section] = s:stage_info(lnum)
+ if getline('.') =~# '^# .*:$' && section ==# 'staged'
+ return 'Git reset --patch'
+ elseif getline('.') =~# '^# .*:$' && section ==# 'unstaged'
+ return 'Git add --patch'
+ elseif getline('.') =~# '^# .*:$' && section ==# 'untracked'
+ return 'Git add -N .'
+ elseif filename ==# ''
+ continue
+ endif
+ if !exists('first_filename')
+ let first_filename = filename
+ endif
+ execute lnum
+ if filename =~ ' -> '
+ let reset += [split(filename,' -> ')[1]]
+ elseif section ==# 'staged'
+ let reset += [filename]
+ elseif getline(lnum) !~# '^#\tdeleted:'
+ let add += [filename]
+ endif
+ endfor
+ try
+ if !empty(add)
+ execute "Git add --patch -- ".join(map(add,'s:shellesc(v:val)'))
+ endif
+ if !empty(reset)
+ execute "Git reset --patch -- ".join(map(reset,'s:shellesc(v:val)'))
+ endif
+ if exists('first_filename')
+ silent! edit!
+ 1
+ redraw
+ call search('^#\t\%([[:alpha:] ]\+: *\)\=\V'.first_filename.'\%( ([^()[:digit:]]\+)\)\=\$','W')
+ endif
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ endtry
+ return 'checktime'
+endfunction
+
+" Section: Gcommit
+
+call s:command("-nargs=? -complete=customlist,s:CommitComplete Gcommit :execute s:Commit(<q-args>)")
+
+function! s:Commit(args, ...) abort
+ let repo = a:0 ? a:1 : s:repo()
+ let cd = exists('*haslocaldir') && haslocaldir() ? 'lcd ' : 'cd '
+ let dir = getcwd()
+ let msgfile = repo.dir('COMMIT_EDITMSG')
+ let outfile = tempname()
+ let errorfile = tempname()
+ try
+ try
+ execute cd.s:fnameescape(repo.tree())
+ if s:winshell()
+ let command = ''
+ let old_editor = $GIT_EDITOR
+ let $GIT_EDITOR = 'false'
+ else
+ let command = 'env GIT_EDITOR=false '
+ endif
+ let command .= repo.git_command('commit').' '.a:args
+ if &shell =~# 'csh'
+ noautocmd silent execute '!('.command.' > '.outfile.') >& '.errorfile
+ elseif a:args =~# '\%(^\| \)-\%(-interactive\|p\|-patch\)\>'
+ noautocmd execute '!'.command.' 2> '.errorfile
+ else
+ noautocmd silent execute '!'.command.' > '.outfile.' 2> '.errorfile
+ endif
+ let error = v:shell_error
+ finally
+ execute cd.'`=dir`'
+ endtry
+ if !has('gui_running')
+ redraw!
+ endif
+ if !error
+ if filereadable(outfile)
+ for line in readfile(outfile)
+ echo line
+ endfor
+ endif
+ return ''
+ else
+ let errors = readfile(errorfile)
+ let error = get(errors,-2,get(errors,-1,'!'))
+ if error =~# 'false''\=\.$'
+ let args = a:args
+ let args = s:gsub(args,'%(%(^| )-- )@<!%(^| )@<=%(-[esp]|--edit|--interactive|--patch|--signoff)%($| )','')
+ let args = s:gsub(args,'%(%(^| )-- )@<!%(^| )@<=%(-c|--reedit-message|--reuse-message|-F|--file|-m|--message)%(\s+|\=)%(''[^'']*''|"%(\\.|[^"])*"|\\.|\S)*','')
+ let args = s:gsub(args,'%(^| )@<=[%#]%(:\w)*','\=expand(submatch(0))')
+ let args = s:sub(args, '\ze -- |$', ' --no-edit --no-interactive --no-signoff')
+ let args = '-F '.s:shellesc(msgfile).' '.args
+ if args !~# '\%(^\| \)--cleanup\>'
+ let args = '--cleanup=strip '.args
+ endif
+ if bufname('%') == '' && line('$') == 1 && getline(1) == '' && !&mod
+ execute 'keepalt edit '.s:fnameescape(msgfile)
+ elseif a:args =~# '\%(^\| \)-\%(-verbose\|\w*v\)\>'
+ execute 'keepalt -tabedit '.s:fnameescape(msgfile)
+ elseif s:buffer().type() ==# 'index'
+ execute 'keepalt edit '.s:fnameescape(msgfile)
+ execute (search('^#','n')+1).'wincmd+'
+ setlocal nopreviewwindow
+ else
+ execute 'keepalt split '.s:fnameescape(msgfile)
+ endif
+ let b:fugitive_commit_arguments = args
+ setlocal bufhidden=wipe filetype=gitcommit
+ return '1'
+ elseif error ==# '!'
+ return s:Status()
+ else
+ call s:throw(error)
+ endif
+ endif
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ finally
+ if exists('old_editor')
+ let $GIT_EDITOR = old_editor
+ endif
+ call delete(outfile)
+ call delete(errorfile)
+ call fugitive#reload_status()
+ endtry
+endfunction
+
+function! s:CommitComplete(A,L,P) abort
+ if a:A =~ '^-' || type(a:A) == type(0) " a:A is 0 on :Gcommit -<Tab>
+ let args = ['-C', '-F', '-a', '-c', '-e', '-i', '-m', '-n', '-o', '-q', '-s', '-t', '-u', '-v', '--all', '--allow-empty', '--amend', '--author=', '--cleanup=', '--dry-run', '--edit', '--file=', '--fixup=', '--include', '--interactive', '--message=', '--no-verify', '--only', '--quiet', '--reedit-message=', '--reuse-message=', '--signoff', '--squash=', '--template=', '--untracked-files', '--verbose']
+ return filter(args,'v:val[0 : strlen(a:A)-1] ==# a:A')
+ else
+ return s:repo().superglob(a:A)
+ endif
+endfunction
+
+function! s:FinishCommit() abort
+ let args = getbufvar(+expand('<abuf>'),'fugitive_commit_arguments')
+ if !empty(args)
+ call setbufvar(+expand('<abuf>'),'fugitive_commit_arguments','')
+ return s:Commit(args, s:repo(getbufvar(+expand('<abuf>'),'git_dir')))
+ endif
+ return ''
+endfunction
+
+" Section: Gmerge, Gpull
+
+call s:command("-nargs=? -bang -complete=custom,s:RevisionComplete Gmerge " .
+ \ "execute s:Merge('merge', <bang>0, <q-args>)")
+call s:command("-nargs=? -bang -complete=custom,s:RemoteComplete Gpull " .
+ \ "execute s:Merge('pull --progress', <bang>0, <q-args>)")
+
+function! s:RevisionComplete(A, L, P) abort
+ return s:repo().git_chomp('rev-parse', '--symbolic', '--branches', '--tags', '--remotes')
+ \ . "\nHEAD\nFETCH_HEAD\nORIG_HEAD"
+endfunction
+
+function! s:RemoteComplete(A, L, P) abort
+ let remote = matchstr(a:L, ' \zs\S\+\ze ')
+ if !empty(remote)
+ let matches = split(s:repo().git_chomp('ls-remote', remote), "\n")
+ call filter(matches, 'v:val =~# "\t" && v:val !~# "{"')
+ call map(matches, 's:sub(v:val, "^.*\t%(refs/%(heads/|tags/)=)=", "")')
+ else
+ let matches = split(s:repo().git_chomp('remote'), "\n")
+ endif
+ return join(matches, "\n")
+endfunction
+
+function! fugitive#cwindow() abort
+ if &buftype == 'quickfix'
+ cwindow
+ else
+ botright cwindow
+ if &buftype == 'quickfix'
+ wincmd p
+ endif
+ endif
+endfunction
+
+let s:common_efm = ''
+ \ . '%+Egit:%.%#,'
+ \ . '%+Eusage:%.%#,'
+ \ . '%+Eerror:%.%#,'
+ \ . '%+Efatal:%.%#,'
+ \ . '%-G%.%#%\e[K%.%#,'
+ \ . '%-G%.%#%\r%.%\+'
+
+function! s:Merge(cmd, bang, args) abort
+ let cd = exists('*haslocaldir') && haslocaldir() ? 'lcd' : 'cd'
+ let cwd = getcwd()
+ let [mp, efm] = [&l:mp, &l:efm]
+ let had_merge_msg = filereadable(s:repo().dir('MERGE_MSG'))
+ try
+ let &l:errorformat = ''
+ \ . '%-Gerror:%.%#false''.,'
+ \ . '%-G%.%# ''git commit'' %.%#,'
+ \ . '%+Emerge:%.%#,'
+ \ . s:common_efm . ','
+ \ . '%+ECannot %.%#: You have unstaged changes.,'
+ \ . '%+ECannot %.%#: Your index contains uncommitted changes.,'
+ \ . '%+EThere is no tracking information for the current branch.,'
+ \ . '%+EYou are not currently on a branch. Please specify which,'
+ \ . 'CONFLICT (%m): %f deleted in %.%#,'
+ \ . 'CONFLICT (%m): Merge conflict in %f,'
+ \ . 'CONFLICT (%m): Rename \"%f\"->%.%#,'
+ \ . 'CONFLICT (%m): Rename %.%#->%f %.%#,'
+ \ . 'CONFLICT (%m): There is a directory with name %f in %.%#,'
+ \ . '%+ECONFLICT %.%#,'
+ \ . '%+EKONFLIKT %.%#,'
+ \ . '%+ECONFLIT %.%#,'
+ \ . "%+EXUNG \u0110\u1ed8T %.%#,"
+ \ . "%+E\u51b2\u7a81 %.%#,"
+ \ . 'U%\t%f'
+ if a:cmd =~# '^merge' && empty(a:args) &&
+ \ (had_merge_msg || isdirectory(s:repo().dir('rebase-apply')) ||
+ \ !empty(s:repo().git_chomp('diff-files', '--diff-filter=U')))
+ let &l:makeprg = g:fugitive_git_executable.' diff-files --name-status --diff-filter=U'
+ else
+ let &l:makeprg = s:sub(g:fugitive_git_executable . ' ' . a:cmd .
+ \ (a:args =~# ' \%(--no-edit\|--abort\|-m\)\>' ? '' : ' --edit') .
+ \ ' ' . a:args, ' *$', '')
+ endif
+ if !empty($GIT_EDITOR) || has('win32')
+ let old_editor = $GIT_EDITOR
+ let $GIT_EDITOR = 'false'
+ else
+ let &l:makeprg = 'env GIT_EDITOR=false ' . &l:makeprg
+ endif
+ execute cd fnameescape(s:repo().tree())
+ silent noautocmd make!
+ catch /^Vim\%((\a\+)\)\=:E211/
+ let err = v:exception
+ finally
+ redraw!
+ let [&l:mp, &l:efm] = [mp, efm]
+ if exists('old_editor')
+ let $GIT_EDITOR = old_editor
+ endif
+ execute cd fnameescape(cwd)
+ endtry
+ call fugitive#reload_status()
+ if empty(filter(getqflist(),'v:val.valid'))
+ if !had_merge_msg && filereadable(s:repo().dir('MERGE_MSG'))
+ cclose
+ return 'Gcommit --no-status -n -t '.s:shellesc(s:repo().dir('MERGE_MSG'))
+ endif
+ endif
+ let qflist = getqflist()
+ let found = 0
+ for e in qflist
+ if !empty(e.bufnr)
+ let found = 1
+ let e.pattern = '^<<<<<<<'
+ endif
+ endfor
+ call fugitive#cwindow()
+ if found
+ call setqflist(qflist, 'r')
+ if !a:bang
+ return 'cfirst'
+ endif
+ endif
+ return exists('err') ? 'echoerr '.string(err) : ''
+endfunction
+
+" Section: Ggrep, Glog
+
+if !exists('g:fugitive_summary_format')
+ let g:fugitive_summary_format = '%s'
+endif
+
+call s:command("-bang -nargs=? -complete=customlist,s:EditComplete Ggrep :execute s:Grep('grep',<bang>0,<q-args>)")
+call s:command("-bang -nargs=? -complete=customlist,s:EditComplete Glgrep :execute s:Grep('lgrep',<bang>0,<q-args>)")
+call s:command("-bar -bang -nargs=* -range=0 -complete=customlist,s:EditComplete Glog :call s:Log('grep<bang>',<line1>,<count>,<f-args>)")
+call s:command("-bar -bang -nargs=* -range=0 -complete=customlist,s:EditComplete Gllog :call s:Log('lgrep<bang>',<line1>,<count>,<f-args>)")
+
+function! s:Grep(cmd,bang,arg) abort
+ let grepprg = &grepprg
+ let grepformat = &grepformat
+ let cd = exists('*haslocaldir') && haslocaldir() ? 'lcd ' : 'cd '
+ let dir = getcwd()
+ try
+ execute cd.'`=s:repo().tree()`'
+ let &grepprg = s:repo().git_command('--no-pager', 'grep', '-n', '--no-color')
+ let &grepformat = '%f:%l:%m,%m %f match%ts,%f'
+ exe a:cmd.'! '.escape(matchstr(a:arg,'\v\C.{-}%($|[''" ]\@=\|)@='),'|')
+ let list = a:cmd =~# '^l' ? getloclist(0) : getqflist()
+ for entry in list
+ if bufname(entry.bufnr) =~ ':'
+ let entry.filename = s:repo().translate(bufname(entry.bufnr))
+ unlet! entry.bufnr
+ let changed = 1
+ elseif a:arg =~# '\%(^\| \)--cached\>'
+ let entry.filename = s:repo().translate(':0:'.bufname(entry.bufnr))
+ unlet! entry.bufnr
+ let changed = 1
+ endif
+ endfor
+ if a:cmd =~# '^l' && exists('changed')
+ call setloclist(0, list, 'r')
+ elseif exists('changed')
+ call setqflist(list, 'r')
+ endif
+ if !a:bang && !empty(list)
+ return (a:cmd =~# '^l' ? 'l' : 'c').'first'.matchstr(a:arg,'\v\C[''" ]\zs\|.*')
+ else
+ return matchstr(a:arg,'\v\C[''" ]\|\zs.*')
+ endif
+ finally
+ let &grepprg = grepprg
+ let &grepformat = grepformat
+ execute cd.'`=dir`'
+ endtry
+endfunction
+
+function! s:Log(cmd, line1, line2, ...) abort
+ let path = s:buffer().path('/')
+ if path =~# '^/\.git\%(/\|$\)' || index(a:000,'--') != -1
+ let path = ''
+ endif
+ let cmd = ['--no-pager', 'log', '--no-color']
+ let cmd += ['--pretty=format:fugitive://'.s:repo().dir().'//%H'.path.'::'.g:fugitive_summary_format]
+ if empty(filter(a:000[0 : index(a:000,'--')],'v:val !~# "^-"'))
+ if s:buffer().commit() =~# '\x\{40\}'
+ let cmd += [s:buffer().commit()]
+ elseif s:buffer().path() =~# '^\.git/refs/\|^\.git/.*HEAD$'
+ let cmd += [s:buffer().path()[5:-1]]
+ endif
+ end
+ let cmd += map(copy(a:000),'s:sub(v:val,"^\\%(%(:\\w)*)","\\=fnamemodify(s:buffer().path(),submatch(1))")')
+ if path =~# '/.'
+ if a:line2
+ let cmd += ['-L', a:line1 . ',' . a:line2 . ':' . path[1:-1]]
+ else
+ let cmd += ['--', path[1:-1]]
+ endif
+ endif
+ let grepformat = &grepformat
+ let grepprg = &grepprg
+ let cd = exists('*haslocaldir') && haslocaldir() ? 'lcd ' : 'cd '
+ let dir = getcwd()
+ try
+ execute cd.'`=s:repo().tree()`'
+ let &grepprg = escape(call(s:repo().git_command,cmd,s:repo()),'%#')
+ let &grepformat = '%Cdiff %.%#,%C--- %.%#,%C+++ %.%#,%Z@@ -%\d%\+\,%\d%\+ +%l\,%\d%\+ @@,%-G-%.%#,%-G+%.%#,%-G %.%#,%A%f::%m,%-G%.%#'
+ exe a:cmd
+ finally
+ let &grepformat = grepformat
+ let &grepprg = grepprg
+ execute cd.'`=dir`'
+ endtry
+endfunction
+
+" Section: Gedit, Gpedit, Gsplit, Gvsplit, Gtabedit, Gread
+
+function! s:Edit(cmd,bang,...) abort
+ let buffer = s:buffer()
+ if a:cmd !~# 'read'
+ if &previewwindow && getbufvar('','fugitive_type') ==# 'index'
+ if winnr('$') == 1
+ let tabs = (&go =~# 'e' || !has('gui_running')) && &stal && (tabpagenr('$') >= &stal)
+ execute 'rightbelow' (&lines - &previewheight - &cmdheight - tabs - 1 - !!&laststatus).'new'
+ elseif winnr('#')
+ wincmd p
+ else
+ wincmd w
+ endif
+ if &diff
+ let mywinnr = winnr()
+ for winnr in range(winnr('$'),1,-1)
+ if winnr != mywinnr && getwinvar(winnr,'&diff')
+ execute winnr.'wincmd w'
+ close
+ if winnr('$') > 1
+ wincmd p
+ endif
+ endif
+ endfor
+ endif
+ endif
+ endif
+
+ if a:bang
+ let arglist = map(copy(a:000), 's:gsub(v:val, ''\\@<!%(\\\\)*\zs[%#]'', ''\=s:buffer().expand(submatch(0))'')')
+ let args = join(arglist, ' ')
+ if a:cmd =~# 'read'
+ let git = buffer.repo().git_command()
+ let last = line('$')
+ silent call s:ExecuteInTree((a:cmd ==# 'read' ? '$read' : a:cmd).'!'.git.' --no-pager '.args)
+ if a:cmd ==# 'read'
+ silent execute '1,'.last.'delete_'
+ endif
+ call fugitive#reload_status()
+ diffupdate
+ return 'redraw|echo '.string(':!'.git.' '.args)
+ else
+ let temp = resolve(tempname())
+ let s:temp_files[s:cpath(temp)] = { 'dir': buffer.repo().dir(), 'args': arglist }
+ silent execute a:cmd.' '.temp
+ if a:cmd =~# 'pedit'
+ wincmd P
+ endif
+ let echo = s:Edit('read',1,args)
+ silent write!
+ setlocal buftype=nowrite nomodified filetype=git foldmarker=<<<<<<<,>>>>>>>
+ if getline(1) !~# '^diff '
+ setlocal readonly nomodifiable
+ endif
+ if a:cmd =~# 'pedit'
+ wincmd p
+ endif
+ return echo
+ endif
+ return ''
+ endif
+
+ if a:0 && a:1 == ''
+ return ''
+ elseif a:0
+ let file = buffer.expand(join(a:000, ' '))
+ elseif expand('%') ==# ''
+ let file = ':'
+ elseif buffer.commit() ==# '' && buffer.path('/') !~# '^/.git\>'
+ let file = buffer.path(':')
+ else
+ let file = buffer.path('/')
+ endif
+ try
+ let file = buffer.repo().translate(file)
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ endtry
+ if file !~# '^fugitive:'
+ let file = s:sub(file, '/$', '')
+ endif
+ if a:cmd ==# 'read'
+ return 'silent %delete_|read '.s:fnameescape(file).'|silent 1delete_|diffupdate|'.line('.')
+ else
+ return a:cmd.' '.s:fnameescape(file)
+ endif
+endfunction
+
+function! s:EditComplete(A,L,P) abort
+ return map(s:repo().superglob(a:A), 'fnameescape(v:val)')
+endfunction
+
+function! s:EditRunComplete(A,L,P) abort
+ if a:L =~# '^\w\+!'
+ return s:GitComplete(a:A,a:L,a:P)
+ else
+ return s:repo().superglob(a:A)
+ endif
+endfunction
+
+call s:command("-bar -bang -nargs=* -complete=customlist,s:EditComplete Ge :execute s:Edit('edit<bang>',0,<f-args>)")
+call s:command("-bar -bang -nargs=* -complete=customlist,s:EditComplete Gedit :execute s:Edit('edit<bang>',0,<f-args>)")
+call s:command("-bar -bang -nargs=* -complete=customlist,s:EditRunComplete Gpedit :execute s:Edit('pedit',<bang>0,<f-args>)")
+call s:command("-bar -bang -nargs=* -complete=customlist,s:EditRunComplete Gsplit :execute s:Edit('split',<bang>0,<f-args>)")
+call s:command("-bar -bang -nargs=* -complete=customlist,s:EditRunComplete Gvsplit :execute s:Edit('vsplit',<bang>0,<f-args>)")
+call s:command("-bar -bang -nargs=* -complete=customlist,s:EditRunComplete Gtabedit :execute s:Edit('tabedit',<bang>0,<f-args>)")
+call s:command("-bar -bang -nargs=* -count -complete=customlist,s:EditRunComplete Gread :execute s:Edit((!<count> && <line1> ? '' : <count>).'read',<bang>0,<f-args>)")
+
+" Section: Gwrite, Gwq
+
+call s:command("-bar -bang -nargs=* -complete=customlist,s:EditComplete Gwrite :execute s:Write(<bang>0,<f-args>)")
+call s:command("-bar -bang -nargs=* -complete=customlist,s:EditComplete Gw :execute s:Write(<bang>0,<f-args>)")
+call s:command("-bar -bang -nargs=* -complete=customlist,s:EditComplete Gwq :execute s:Wq(<bang>0,<f-args>)")
+
+function! s:Write(force,...) abort
+ if exists('b:fugitive_commit_arguments')
+ return 'write|bdelete'
+ elseif expand('%:t') == 'COMMIT_EDITMSG' && $GIT_INDEX_FILE != ''
+ return 'wq'
+ elseif s:buffer().type() == 'index'
+ return 'Gcommit'
+ elseif s:buffer().path() ==# '' && getline(4) =~# '^+++ '
+ let filename = getline(4)[6:-1]
+ setlocal buftype=
+ silent write
+ setlocal buftype=nowrite
+ if matchstr(getline(2),'index [[:xdigit:]]\+\.\.\zs[[:xdigit:]]\{7\}') ==# s:repo().rev_parse(':0:'.filename)[0:6]
+ let err = s:repo().git_chomp('apply','--cached','--reverse',s:buffer().spec())
+ else
+ let err = s:repo().git_chomp('apply','--cached',s:buffer().spec())
+ endif
+ if err !=# ''
+ let v:errmsg = split(err,"\n")[0]
+ return 'echoerr v:errmsg'
+ elseif a:force
+ return 'bdelete'
+ else
+ return 'Gedit '.fnameescape(filename)
+ endif
+ endif
+ let mytab = tabpagenr()
+ let mybufnr = bufnr('')
+ let path = a:0 ? join(a:000, ' ') : s:buffer().path()
+ if empty(path)
+ return 'echoerr '.string('fugitive: cannot determine file path')
+ endif
+ if path =~# '^:\d\>'
+ return 'write'.(a:force ? '! ' : ' ').s:fnameescape(s:repo().translate(s:buffer().expand(path)))
+ endif
+ let always_permitted = (s:buffer().path() ==# path && s:buffer().commit() =~# '^0\=$')
+ if !always_permitted && !a:force && s:repo().git_chomp_in_tree('diff','--name-status','HEAD','--',path) . s:repo().git_chomp_in_tree('ls-files','--others','--',path) !=# ''
+ let v:errmsg = 'fugitive: file has uncommitted changes (use ! to override)'
+ return 'echoerr v:errmsg'
+ endif
+ let file = s:repo().translate(path)
+ let treebufnr = 0
+ for nr in range(1,bufnr('$'))
+ if fnamemodify(bufname(nr),':p') ==# file
+ let treebufnr = nr
+ endif
+ endfor
+
+ if treebufnr > 0 && treebufnr != bufnr('')
+ let temp = tempname()
+ silent execute '%write '.temp
+ for tab in [mytab] + range(1,tabpagenr('$'))
+ for winnr in range(1,tabpagewinnr(tab,'$'))
+ if tabpagebuflist(tab)[winnr-1] == treebufnr
+ execute 'tabnext '.tab
+ if winnr != winnr()
+ execute winnr.'wincmd w'
+ let restorewinnr = 1
+ endif
+ try
+ let lnum = line('.')
+ let last = line('$')
+ silent execute '$read '.temp
+ silent execute '1,'.last.'delete_'
+ silent write!
+ silent execute lnum
+ let did = 1
+ finally
+ if exists('restorewinnr')
+ wincmd p
+ endif
+ execute 'tabnext '.mytab
+ endtry
+ endif
+ endfor
+ endfor
+ if !exists('did')
+ call writefile(readfile(temp,'b'),file,'b')
+ endif
+ else
+ execute 'write! '.s:fnameescape(s:repo().translate(path))
+ endif
+
+ if a:force
+ let error = s:repo().git_chomp_in_tree('add', '--force', '--', path)
+ else
+ let error = s:repo().git_chomp_in_tree('add', '--', path)
+ endif
+ if v:shell_error
+ let v:errmsg = 'fugitive: '.error
+ return 'echoerr v:errmsg'
+ endif
+ if s:buffer().path() ==# path && s:buffer().commit() =~# '^\d$'
+ set nomodified
+ endif
+
+ let one = s:repo().translate(':1:'.path)
+ let two = s:repo().translate(':2:'.path)
+ let three = s:repo().translate(':3:'.path)
+ for nr in range(1,bufnr('$'))
+ let name = fnamemodify(bufname(nr), ':p')
+ if bufloaded(nr) && !getbufvar(nr,'&modified') && (name ==# one || name ==# two || name ==# three)
+ execute nr.'bdelete'
+ endif
+ endfor
+
+ unlet! restorewinnr
+ let zero = s:repo().translate(':0:'.path)
+ silent execute 'doautocmd BufWritePost' s:fnameescape(zero)
+ for tab in range(1,tabpagenr('$'))
+ for winnr in range(1,tabpagewinnr(tab,'$'))
+ let bufnr = tabpagebuflist(tab)[winnr-1]
+ let bufname = fnamemodify(bufname(bufnr), ':p')
+ if bufname ==# zero && bufnr != mybufnr
+ execute 'tabnext '.tab
+ if winnr != winnr()
+ execute winnr.'wincmd w'
+ let restorewinnr = 1
+ endif
+ try
+ let lnum = line('.')
+ let last = line('$')
+ silent execute '$read '.s:fnameescape(file)
+ silent execute '1,'.last.'delete_'
+ silent execute lnum
+ set nomodified
+ diffupdate
+ finally
+ if exists('restorewinnr')
+ wincmd p
+ endif
+ execute 'tabnext '.mytab
+ endtry
+ break
+ endif
+ endfor
+ endfor
+ call fugitive#reload_status()
+ return 'checktime'
+endfunction
+
+function! s:Wq(force,...) abort
+ let bang = a:force ? '!' : ''
+ if exists('b:fugitive_commit_arguments')
+ return 'wq'.bang
+ endif
+ let result = call(s:function('s:Write'),[a:force]+a:000)
+ if result =~# '^\%(write\|wq\|echoerr\)'
+ return s:sub(result,'^write','wq')
+ else
+ return result.'|quit'.bang
+ endif
+endfunction
+
+augroup fugitive_commit
+ autocmd!
+ autocmd VimLeavePre,BufDelete COMMIT_EDITMSG execute s:sub(s:FinishCommit(), '^echoerr (.*)', 'echohl ErrorMsg|echo \1|echohl NONE')
+augroup END
+
+" Section: Gpush, Gfetch
+
+call s:command("-nargs=? -bang -complete=custom,s:RemoteComplete Gpush execute s:Dispatch('<bang>', 'push '.<q-args>)")
+call s:command("-nargs=? -bang -complete=custom,s:RemoteComplete Gfetch execute s:Dispatch('<bang>', 'fetch '.<q-args>)")
+
+function! s:Dispatch(bang, args)
+ let cd = exists('*haslocaldir') && haslocaldir() ? 'lcd' : 'cd'
+ let cwd = getcwd()
+ let [mp, efm, cc] = [&l:mp, &l:efm, get(b:, 'current_compiler', '')]
+ try
+ let b:current_compiler = 'git'
+ let &l:errorformat = s:common_efm
+ let &l:makeprg = g:fugitive_git_executable . ' ' . a:args
+ execute cd fnameescape(s:repo().tree())
+ if exists(':Make') == 2
+ noautocmd Make
+ else
+ silent noautocmd make!
+ redraw!
+ return 'call fugitive#cwindow()'
+ endif
+ return ''
+ finally
+ let [&l:mp, &l:efm, b:current_compiler] = [mp, efm, cc]
+ if empty(cc) | unlet! b:current_compiler | endif
+ execute cd fnameescape(cwd)
+ endtry
+endfunction
+
+" Section: Gdiff
+
+call s:command("-bang -bar -nargs=* -complete=customlist,s:EditComplete Gdiff :execute s:Diff('',<bang>0,<f-args>)")
+call s:command("-bang -bar -nargs=* -complete=customlist,s:EditComplete Gvdiff :execute s:Diff('keepalt vert ',<bang>0,<f-args>)")
+call s:command("-bang -bar -nargs=* -complete=customlist,s:EditComplete Gsdiff :execute s:Diff('keepalt ',<bang>0,<f-args>)")
+
+augroup fugitive_diff
+ autocmd!
+ autocmd BufWinLeave *
+ \ if s:can_diffoff(+expand('<abuf>')) && s:diff_window_count() == 2 |
+ \ call s:diffoff_all(getbufvar(+expand('<abuf>'), 'git_dir')) |
+ \ endif
+ autocmd BufWinEnter *
+ \ if s:can_diffoff(+expand('<abuf>')) && s:diff_window_count() == 1 |
+ \ call s:diffoff() |
+ \ endif
+augroup END
+
+function! s:can_diffoff(buf) abort
+ return getwinvar(bufwinnr(a:buf), '&diff') &&
+ \ !empty(getbufvar(a:buf, 'git_dir')) &&
+ \ !empty(getwinvar(bufwinnr(a:buf), 'fugitive_diff_restore'))
+endfunction
+
+function! fugitive#can_diffoff(buf) abort
+ return s:can_diffoff(a:buf)
+endfunction
+
+function! s:diff_modifier(count) abort
+ let fdc = matchstr(&diffopt, 'foldcolumn:\zs\d\+')
+ if &diffopt =~# 'horizontal' && &diffopt !~# 'vertical'
+ return 'keepalt '
+ elseif &diffopt =~# 'vertical'
+ return 'keepalt vert '
+ elseif winwidth(0) <= a:count * ((&tw ? &tw : 80) + (empty(fdc) ? 2 : fdc))
+ return 'keepalt '
+ else
+ return 'keepalt vert '
+ endif
+endfunction
+
+function! s:diff_window_count() abort
+ let c = 0
+ for nr in range(1,winnr('$'))
+ let c += getwinvar(nr,'&diff')
+ endfor
+ return c
+endfunction
+
+function! s:diff_restore() abort
+ let restore = 'setlocal nodiff noscrollbind'
+ \ . ' scrollopt=' . &l:scrollopt
+ \ . (&l:wrap ? ' wrap' : ' nowrap')
+ \ . ' foldlevel=999'
+ \ . ' foldmethod=' . &l:foldmethod
+ \ . ' foldcolumn=' . &l:foldcolumn
+ \ . ' foldlevel=' . &l:foldlevel
+ \ . (&l:foldenable ? ' foldenable' : ' nofoldenable')
+ if has('cursorbind')
+ let restore .= (&l:cursorbind ? ' ' : ' no') . 'cursorbind'
+ endif
+ return restore
+endfunction
+
+function! s:diffthis() abort
+ if !&diff
+ let w:fugitive_diff_restore = s:diff_restore()
+ diffthis
+ endif
+endfunction
+
+function! s:diffoff() abort
+ if exists('w:fugitive_diff_restore')
+ execute w:fugitive_diff_restore
+ unlet w:fugitive_diff_restore
+ else
+ diffoff
+ endif
+endfunction
+
+function! s:diffoff_all(dir) abort
+ let curwin = winnr()
+ for nr in range(1,winnr('$'))
+ if getwinvar(nr,'&diff')
+ if nr != winnr()
+ execute nr.'wincmd w'
+ let restorewinnr = 1
+ endif
+ if exists('b:git_dir') && b:git_dir ==# a:dir
+ call s:diffoff()
+ endif
+ endif
+ endfor
+ execute curwin.'wincmd w'
+endfunction
+
+function! s:buffer_compare_age(commit) dict abort
+ let scores = {':0': 1, ':1': 2, ':2': 3, ':': 4, ':3': 5}
+ let my_score = get(scores,':'.self.commit(),0)
+ let their_score = get(scores,':'.a:commit,0)
+ if my_score || their_score
+ return my_score < their_score ? -1 : my_score != their_score
+ elseif self.commit() ==# a:commit
+ return 0
+ endif
+ let base = self.repo().git_chomp('merge-base',self.commit(),a:commit)
+ if base ==# self.commit()
+ return -1
+ elseif base ==# a:commit
+ return 1
+ endif
+ let my_time = +self.repo().git_chomp('log','--max-count=1','--pretty=format:%at',self.commit())
+ let their_time = +self.repo().git_chomp('log','--max-count=1','--pretty=format:%at',a:commit)
+ return my_time < their_time ? -1 : my_time != their_time
+endfunction
+
+call s:add_methods('buffer',['compare_age'])
+
+function! s:Diff(vert,keepfocus,...) abort
+ let args = copy(a:000)
+ let post = ''
+ if get(args, 0) =~# '^+'
+ let post = remove(args, 0)[1:-1]
+ endif
+ let vert = empty(a:vert) ? s:diff_modifier(2) : a:vert
+ if exists(':DiffGitCached')
+ return 'DiffGitCached'
+ elseif (empty(args) || args[0] == ':') && s:buffer().commit() =~# '^[0-1]\=$' && s:repo().git_chomp_in_tree('ls-files', '--unmerged', '--', s:buffer().path()) !=# ''
+ let vert = empty(a:vert) ? s:diff_modifier(3) : a:vert
+ let nr = bufnr('')
+ execute 'leftabove '.vert.'split `=fugitive#buffer().repo().translate(s:buffer().expand('':2''))`'
+ execute 'nnoremap <buffer> <silent> dp :diffput '.nr.'<Bar>diffupdate<CR>'
+ let nr2 = bufnr('')
+ call s:diffthis()
+ wincmd p
+ execute 'rightbelow '.vert.'split `=fugitive#buffer().repo().translate(s:buffer().expand('':3''))`'
+ execute 'nnoremap <buffer> <silent> dp :diffput '.nr.'<Bar>diffupdate<CR>'
+ let nr3 = bufnr('')
+ call s:diffthis()
+ wincmd p
+ call s:diffthis()
+ execute 'nnoremap <buffer> <silent> d2o :diffget '.nr2.'<Bar>diffupdate<CR>'
+ execute 'nnoremap <buffer> <silent> d3o :diffget '.nr3.'<Bar>diffupdate<CR>'
+ return post
+ elseif len(args)
+ let arg = join(args, ' ')
+ if arg ==# ''
+ return post
+ elseif arg ==# '/'
+ let file = s:buffer().path('/')
+ elseif arg ==# ':'
+ let file = s:buffer().path(':0:')
+ elseif arg =~# '^:/.'
+ try
+ let file = s:repo().rev_parse(arg).s:buffer().path(':')
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ endtry
+ else
+ let file = s:buffer().expand(arg)
+ endif
+ if file !~# ':' && file !~# '^/' && s:repo().git_chomp('cat-file','-t',file) =~# '^\%(tag\|commit\)$'
+ let file = file.s:buffer().path(':')
+ endif
+ else
+ let file = s:buffer().path(s:buffer().commit() == '' ? ':0:' : '/')
+ endif
+ try
+ let spec = s:repo().translate(file)
+ let commit = matchstr(spec,'\C[^:/]//\zs\x\+')
+ let restore = s:diff_restore()
+ if exists('+cursorbind')
+ setlocal cursorbind
+ endif
+ let w:fugitive_diff_restore = restore
+ if s:buffer().compare_age(commit) < 0
+ execute 'rightbelow '.vert.'diffsplit '.s:fnameescape(spec)
+ else
+ execute 'leftabove '.vert.'diffsplit '.s:fnameescape(spec)
+ endif
+ let &l:readonly = &l:readonly
+ redraw
+ let w:fugitive_diff_restore = restore
+ let winnr = winnr()
+ if getwinvar('#', '&diff')
+ wincmd p
+ if !a:keepfocus
+ call feedkeys(winnr."\<C-W>w", 'n')
+ endif
+ endif
+ return post
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ endtry
+endfunction
+
+" Section: Gmove, Gremove
+
+function! s:Move(force,destination) abort
+ if a:destination =~# '^/'
+ let destination = a:destination[1:-1]
+ else
+ let destination = s:shellslash(fnamemodify(s:sub(a:destination,'[%#]%(:\w)*','\=expand(submatch(0))'),':p'))
+ if destination[0:strlen(s:repo().tree())] ==# s:repo().tree('')
+ let destination = destination[strlen(s:repo().tree('')):-1]
+ endif
+ endif
+ if isdirectory(s:buffer().spec())
+ " Work around Vim parser idiosyncrasy
+ let discarded = s:buffer().setvar('&swapfile',0)
+ endif
+ let message = call(s:repo().git_chomp_in_tree,['mv']+(a:force ? ['-f'] : [])+['--', s:buffer().path(), destination], s:repo())
+ if v:shell_error
+ let v:errmsg = 'fugitive: '.message
+ return 'echoerr v:errmsg'
+ endif
+ let destination = s:repo().tree(destination)
+ if isdirectory(destination)
+ let destination = fnamemodify(s:sub(destination,'/$','').'/'.expand('%:t'),':.')
+ endif
+ call fugitive#reload_status()
+ if s:buffer().commit() == ''
+ if isdirectory(destination)
+ return 'keepalt edit '.s:fnameescape(destination)
+ else
+ return 'keepalt saveas! '.s:fnameescape(destination)
+ endif
+ else
+ return 'file '.s:fnameescape(s:repo().translate(':0:'.destination))
+ endif
+endfunction
+
+function! s:MoveComplete(A,L,P) abort
+ if a:A =~ '^/'
+ return s:repo().superglob(a:A)
+ else
+ let matches = split(glob(a:A.'*'),"\n")
+ call map(matches,'v:val !~ "/$" && isdirectory(v:val) ? v:val."/" : v:val')
+ return matches
+ endif
+endfunction
+
+function! s:Remove(force) abort
+ if s:buffer().commit() ==# ''
+ let cmd = ['rm']
+ elseif s:buffer().commit() ==# '0'
+ let cmd = ['rm','--cached']
+ else
+ let v:errmsg = 'fugitive: rm not supported here'
+ return 'echoerr v:errmsg'
+ endif
+ if a:force
+ let cmd += ['--force']
+ endif
+ let message = call(s:repo().git_chomp_in_tree,cmd+['--',s:buffer().path()],s:repo())
+ if v:shell_error
+ let v:errmsg = 'fugitive: '.s:sub(message,'error:.*\zs\n\(.*-f.*',' (add ! to force)')
+ return 'echoerr '.string(v:errmsg)
+ else
+ call fugitive#reload_status()
+ return 'edit'.(a:force ? '!' : '')
+ endif
+endfunction
+
+augroup fugitive_remove
+ autocmd!
+ autocmd User Fugitive if s:buffer().commit() =~# '^0\=$' |
+ \ exe "command! -buffer -bar -bang -nargs=1 -complete=customlist,s:MoveComplete Gmove :execute s:Move(<bang>0,<q-args>)" |
+ \ exe "command! -buffer -bar -bang Gremove :execute s:Remove(<bang>0)" |
+ \ endif
+augroup END
+
+" Section: Gblame
+
+augroup fugitive_blame
+ autocmd!
+ autocmd BufReadPost *.fugitiveblame setfiletype fugitiveblame
+ autocmd FileType fugitiveblame setlocal nomodeline | if exists('b:git_dir') | let &l:keywordprg = s:repo().keywordprg() | endif
+ autocmd Syntax fugitiveblame call s:BlameSyntax()
+ autocmd User Fugitive if s:buffer().type('file', 'blob') | exe "command! -buffer -bar -bang -range=0 -nargs=* Gblame :execute s:Blame(<bang>0,<line1>,<line2>,<count>,[<f-args>])" | endif
+ autocmd ColorScheme,GUIEnter * call s:RehighlightBlame()
+augroup END
+
+function! s:linechars(pattern) abort
+ let chars = strlen(s:gsub(matchstr(getline('.'), a:pattern), '.', '.'))
+ if exists('*synconcealed') && &conceallevel > 1
+ for col in range(1, chars)
+ let chars -= synconcealed(line('.'), col)[0]
+ endfor
+ endif
+ return chars
+endfunction
+
+function! s:Blame(bang,line1,line2,count,args) abort
+ if exists('b:fugitive_blamed_bufnr')
+ return 'bdelete'
+ endif
+ try
+ if s:buffer().path() == ''
+ call s:throw('file or blob required')
+ endif
+ if filter(copy(a:args),'v:val !~# "^\\%(--root\|--show-name\\|-\\=\\%([ltfnsew]\\|[MC]\\d*\\)\\+\\)$"') != []
+ call s:throw('unsupported option')
+ endif
+ call map(a:args,'s:sub(v:val,"^\\ze[^-]","-")')
+ let cmd = ['--no-pager', 'blame', '--show-number'] + a:args
+ if s:buffer().commit() =~# '\D\|..'
+ let cmd += [s:buffer().commit()]
+ else
+ let cmd += ['--contents', '-']
+ endif
+ let cmd += ['--', s:buffer().path()]
+ let basecmd = escape(call(s:repo().git_command,cmd,s:repo()),'!')
+ try
+ let cd = exists('*haslocaldir') && haslocaldir() ? 'lcd ' : 'cd '
+ if !s:repo().bare()
+ let dir = getcwd()
+ execute cd.'`=s:repo().tree()`'
+ endif
+ if a:count
+ execute 'write !'.substitute(basecmd,' blame ',' blame -L '.a:line1.','.a:line2.' ','g')
+ else
+ let error = resolve(tempname())
+ let temp = error.'.fugitiveblame'
+ if &shell =~# 'csh'
+ silent! execute '%write !('.basecmd.' > '.temp.') >& '.error
+ else
+ silent! execute '%write !'.basecmd.' > '.temp.' 2> '.error
+ endif
+ if exists('l:dir')
+ execute cd.'`=dir`'
+ unlet dir
+ endif
+ if v:shell_error
+ call s:throw(join(readfile(error),"\n"))
+ endif
+ for winnr in range(winnr('$'),1,-1)
+ call setwinvar(winnr, '&scrollbind', 0)
+ if exists('+cursorbind')
+ call setwinvar(winnr, '&cursorbind', 0)
+ endif
+ if getbufvar(winbufnr(winnr), 'fugitive_blamed_bufnr')
+ execute winbufnr(winnr).'bdelete'
+ endif
+ endfor
+ let bufnr = bufnr('')
+ let restore = 'call setwinvar(bufwinnr('.bufnr.'),"&scrollbind",0)'
+ if exists('+cursorbind')
+ let restore .= '|call setwinvar(bufwinnr('.bufnr.'),"&cursorbind",0)'
+ endif
+ if &l:wrap
+ let restore .= '|call setwinvar(bufwinnr('.bufnr.'),"&wrap",1)'
+ endif
+ if &l:foldenable
+ let restore .= '|call setwinvar(bufwinnr('.bufnr.'),"&foldenable",1)'
+ endif
+ setlocal scrollbind nowrap nofoldenable
+ if exists('+cursorbind')
+ setlocal cursorbind
+ endif
+ let top = line('w0') + &scrolloff
+ let current = line('.')
+ let s:temp_files[s:cpath(temp)] = { 'dir': s:repo().dir(), 'args': cmd }
+ exe 'keepalt leftabove vsplit '.temp
+ let b:fugitive_blamed_bufnr = bufnr
+ let w:fugitive_leave = restore
+ let b:fugitive_blame_arguments = join(a:args,' ')
+ execute top
+ normal! zt
+ execute current
+ if exists('+cursorbind')
+ setlocal cursorbind
+ endif
+ setlocal nomodified nomodifiable nonumber scrollbind nowrap foldcolumn=0 nofoldenable winfixwidth filetype=fugitiveblame
+ if exists('+concealcursor')
+ setlocal concealcursor=nc conceallevel=2
+ endif
+ if exists('+relativenumber')
+ setlocal norelativenumber
+ endif
+ execute "vertical resize ".(s:linechars('.\{-\}\ze\s\+\d\+)')+1)
+ nnoremap <buffer> <silent> <F1> :help fugitive-:Gblame<CR>
+ nnoremap <buffer> <silent> g? :help fugitive-:Gblame<CR>
+ nnoremap <buffer> <silent> q :exe substitute(bufwinnr(b:fugitive_blamed_bufnr).' wincmd w<Bar>'.bufnr('').'bdelete','^-1','','')<CR>
+ nnoremap <buffer> <silent> gq :exe substitute(bufwinnr(b:fugitive_blamed_bufnr).' wincmd w<Bar>'.bufnr('').'bdelete<Bar>if expand("%:p") =~# "^fugitive:[\\/][\\/]"<Bar>Gedit<Bar>endif','^-1','','')<CR>
+ nnoremap <buffer> <silent> <CR> :<C-U>exe <SID>BlameCommit("exe 'norm q'<Bar>edit")<CR>
+ nnoremap <buffer> <silent> - :<C-U>exe <SID>BlameJump('')<CR>
+ nnoremap <buffer> <silent> P :<C-U>exe <SID>BlameJump('^'.v:count1)<CR>
+ nnoremap <buffer> <silent> ~ :<C-U>exe <SID>BlameJump('~'.v:count1)<CR>
+ nnoremap <buffer> <silent> i :<C-U>exe <SID>BlameCommit("exe 'norm q'<Bar>edit")<CR>
+ nnoremap <buffer> <silent> o :<C-U>exe <SID>BlameCommit((&splitbelow ? "botright" : "topleft")." split")<CR>
+ nnoremap <buffer> <silent> O :<C-U>exe <SID>BlameCommit("tabedit")<CR>
+ nnoremap <buffer> <silent> A :<C-u>exe "vertical resize ".(<SID>linechars('.\{-\}\ze [0-9:/+-][0-9:/+ -]* \d\+)')+1+v:count)<CR>
+ nnoremap <buffer> <silent> C :<C-u>exe "vertical resize ".(<SID>linechars('^\S\+')+1+v:count)<CR>
+ nnoremap <buffer> <silent> D :<C-u>exe "vertical resize ".(<SID>linechars('.\{-\}\ze\d\ze\s\+\d\+)')+1-v:count)<CR>
+ redraw
+ syncbind
+ endif
+ finally
+ if exists('l:dir')
+ execute cd.'`=dir`'
+ endif
+ endtry
+ return ''
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ endtry
+endfunction
+
+function! s:BlameCommit(cmd) abort
+ let cmd = s:Edit(a:cmd, 0, matchstr(getline('.'),'\x\+'))
+ if cmd =~# '^echoerr'
+ return cmd
+ endif
+ let lnum = matchstr(getline('.'),' \zs\d\+\ze\s\+[([:digit:]]')
+ let path = matchstr(getline('.'),'^\^\=\x\+\s\+\zs.\{-\}\ze\s*\d\+ ')
+ if path ==# ''
+ let path = s:buffer(b:fugitive_blamed_bufnr).path()
+ endif
+ execute cmd
+ if search('^diff .* b/\M'.escape(path,'\').'$','W')
+ call search('^+++')
+ let head = line('.')
+ while search('^@@ \|^diff ') && getline('.') =~# '^@@ '
+ let top = +matchstr(getline('.'),' +\zs\d\+')
+ let len = +matchstr(getline('.'),' +\d\+,\zs\d\+')
+ if lnum >= top && lnum <= top + len
+ let offset = lnum - top
+ if &scrolloff
+ +
+ normal! zt
+ else
+ normal! zt
+ +
+ endif
+ while offset > 0 && line('.') < line('$')
+ +
+ if getline('.') =~# '^[ +]'
+ let offset -= 1
+ endif
+ endwhile
+ return 'normal! zv'
+ endif
+ endwhile
+ execute head
+ normal! zt
+ endif
+ return ''
+endfunction
+
+function! s:BlameJump(suffix) abort
+ let commit = matchstr(getline('.'),'^\^\=\zs\x\+')
+ if commit =~# '^0\+$'
+ let commit = ':0'
+ endif
+ let lnum = matchstr(getline('.'),' \zs\d\+\ze\s\+[([:digit:]]')
+ let path = matchstr(getline('.'),'^\^\=\x\+\s\+\zs.\{-\}\ze\s*\d\+ ')
+ if path ==# ''
+ let path = s:buffer(b:fugitive_blamed_bufnr).path()
+ endif
+ let args = b:fugitive_blame_arguments
+ let offset = line('.') - line('w0')
+ let bufnr = bufnr('%')
+ let winnr = bufwinnr(b:fugitive_blamed_bufnr)
+ if winnr > 0
+ exe winnr.'wincmd w'
+ endif
+ execute s:Edit('edit', 0, commit.a:suffix.':'.path)
+ execute lnum
+ if winnr > 0
+ exe bufnr.'bdelete'
+ endif
+ if exists(':Gblame')
+ execute 'Gblame '.args
+ execute lnum
+ let delta = line('.') - line('w0') - offset
+ if delta > 0
+ execute 'normal! '.delta."\<C-E>"
+ elseif delta < 0
+ execute 'normal! '.(-delta)."\<C-Y>"
+ endif
+ syncbind
+ endif
+ return ''
+endfunction
+
+let s:hash_colors = {}
+
+function! s:BlameSyntax() abort
+ let b:current_syntax = 'fugitiveblame'
+ let conceal = has('conceal') ? ' conceal' : ''
+ let arg = exists('b:fugitive_blame_arguments') ? b:fugitive_blame_arguments : ''
+ syn match FugitiveblameBoundary "^\^"
+ syn match FugitiveblameBlank "^\s\+\s\@=" nextgroup=FugitiveblameAnnotation,fugitiveblameOriginalFile,FugitiveblameOriginalLineNumber skipwhite
+ syn match FugitiveblameHash "\%(^\^\=\)\@<=\x\{7,40\}\>" nextgroup=FugitiveblameAnnotation,FugitiveblameOriginalLineNumber,fugitiveblameOriginalFile skipwhite
+ syn match FugitiveblameUncommitted "\%(^\^\=\)\@<=0\{7,40\}\>" nextgroup=FugitiveblameAnnotation,FugitiveblameOriginalLineNumber,fugitiveblameOriginalFile skipwhite
+ syn region FugitiveblameAnnotation matchgroup=FugitiveblameDelimiter start="(" end="\%( \d\+\)\@<=)" contained keepend oneline
+ syn match FugitiveblameTime "[0-9:/+-][0-9:/+ -]*[0-9:/+-]\%( \+\d\+)\)\@=" contained containedin=FugitiveblameAnnotation
+ exec 'syn match FugitiveblameLineNumber " *\d\+)\@=" contained containedin=FugitiveblameAnnotation'.conceal
+ exec 'syn match FugitiveblameOriginalFile " \%(\f\+\D\@<=\|\D\@=\f\+\)\%(\%(\s\+\d\+\)\=\s\%((\|\s*\d\+)\)\)\@=" contained nextgroup=FugitiveblameOriginalLineNumber,FugitiveblameAnnotation skipwhite'.(arg =~# 'f' ? '' : conceal)
+ exec 'syn match FugitiveblameOriginalLineNumber " *\d\+\%(\s(\)\@=" contained nextgroup=FugitiveblameAnnotation skipwhite'.(arg =~# 'n' ? '' : conceal)
+ exec 'syn match FugitiveblameOriginalLineNumber " *\d\+\%(\s\+\d\+)\)\@=" contained nextgroup=FugitiveblameShort skipwhite'.(arg =~# 'n' ? '' : conceal)
+ syn match FugitiveblameShort " \d\+)" contained contains=FugitiveblameLineNumber
+ syn match FugitiveblameNotCommittedYet "(\@<=Not Committed Yet\>" contained containedin=FugitiveblameAnnotation
+ hi def link FugitiveblameBoundary Keyword
+ hi def link FugitiveblameHash Identifier
+ hi def link FugitiveblameUncommitted Ignore
+ hi def link FugitiveblameTime PreProc
+ hi def link FugitiveblameLineNumber Number
+ hi def link FugitiveblameOriginalFile String
+ hi def link FugitiveblameOriginalLineNumber Float
+ hi def link FugitiveblameShort FugitiveblameDelimiter
+ hi def link FugitiveblameDelimiter Delimiter
+ hi def link FugitiveblameNotCommittedYet Comment
+ let seen = {}
+ for lnum in range(1, line('$'))
+ let hash = matchstr(getline(lnum), '^\^\=\zs\x\{6\}')
+ if hash ==# '' || hash ==# '000000' || has_key(seen, hash)
+ continue
+ endif
+ let seen[hash] = 1
+ if &t_Co > 16 && exists('g:CSApprox_loaded')
+ \ && empty(get(s:hash_colors, hash))
+ let [s, r, g, b; __] = map(matchlist(hash, '\(\x\x\)\(\x\x\)\(\x\x\)'), 'str2nr(v:val,16)')
+ let color = csapprox#per_component#Approximate(r, g, b)
+ if color == 16 && &background ==# 'dark'
+ let color = 8
+ endif
+ let s:hash_colors[hash] = ' ctermfg='.color
+ else
+ let s:hash_colors[hash] = ''
+ endif
+ exe 'syn match FugitiveblameHash'.hash.' "\%(^\^\=\)\@<='.hash.'\x\{1,34\}\>" nextgroup=FugitiveblameAnnotation,FugitiveblameOriginalLineNumber,fugitiveblameOriginalFile skipwhite'
+ endfor
+ call s:RehighlightBlame()
+endfunction
+
+function! s:RehighlightBlame() abort
+ for [hash, cterm] in items(s:hash_colors)
+ if !empty(cterm) || has('gui_running')
+ exe 'hi FugitiveblameHash'.hash.' guifg=#'.hash.get(s:hash_colors, hash, '')
+ else
+ exe 'hi link FugitiveblameHash'.hash.' Identifier'
+ endif
+ endfor
+endfunction
+
+" Section: Gbrowse
+
+call s:command("-bar -bang -range=0 -nargs=* -complete=customlist,s:EditComplete Gbrowse :execute s:Browse(<bang>0,<line1>,<count>,<f-args>)")
+
+function! s:Browse(bang,line1,count,...) abort
+ try
+ let validremote = '\.\|\.\=/.*\|[[:alnum:]_-]\+\%(://.\{-\}\)\='
+ if a:0
+ let remote = matchstr(join(a:000, ' '),'@\zs\%('.validremote.'\)$')
+ let rev = substitute(join(a:000, ' '),'@\%('.validremote.'\)$','','')
+ else
+ let remote = ''
+ let rev = ''
+ endif
+ if rev ==# ''
+ let expanded = s:buffer().rev()
+ elseif rev ==# ':'
+ let expanded = s:buffer().path('/')
+ else
+ let expanded = s:buffer().expand(rev)
+ endif
+ let full = s:repo().translate(expanded)
+ let commit = ''
+ if full =~# '^fugitive://'
+ let commit = matchstr(full,'://.*//\zs\w\w\+')
+ let path = matchstr(full,'://.*//\w\+\zs/.*')
+ if commit =~ '..'
+ let type = s:repo().git_chomp('cat-file','-t',commit.s:sub(path,'^/',':'))
+ let branch = matchstr(expanded, '^[^:]*')
+ else
+ let type = 'blob'
+ endif
+ let path = path[1:-1]
+ elseif s:repo().bare()
+ let path = '.git/' . full[strlen(s:repo().dir())+1:-1]
+ let type = ''
+ else
+ let path = full[strlen(s:repo().tree())+1:-1]
+ if path =~# '^\.git/'
+ let type = ''
+ elseif isdirectory(full)
+ let type = 'tree'
+ else
+ let type = 'blob'
+ endif
+ endif
+ if type ==# 'tree' && !empty(path)
+ let path = s:sub(path, '/\=$', '/')
+ endif
+ if path =~# '^\.git/.*HEAD' && filereadable(s:repo().dir(path[5:-1]))
+ let body = readfile(s:repo().dir(path[5:-1]))[0]
+ if body =~# '^\x\{40\}$'
+ let commit = body
+ let type = 'commit'
+ let path = ''
+ elseif body =~# '^ref: refs/'
+ let path = '.git/' . matchstr(body,'ref: \zs.*')
+ endif
+ endif
+
+ let merge = ''
+ if path =~# '^\.git/refs/remotes/.'
+ if empty(remote)
+ let remote = matchstr(path, '^\.git/refs/remotes/\zs[^/]\+')
+ endif
+ let merge = matchstr(path, '^\.git/refs/remotes/[^/]\+/\zs.\+')
+ let branch = ''
+ let path = '.git/refs/heads/'.merge
+ elseif path =~# '^\.git/refs/heads/.'
+ let branch = path[16:-1]
+ elseif !exists('branch')
+ let branch = s:repo().head()
+ endif
+ if !empty(branch)
+ let r = s:repo().git_chomp('config','branch.'.branch.'.remote')
+ let m = s:repo().git_chomp('config','branch.'.branch.'.merge')[11:-1]
+ if r ==# '.' && !empty(m)
+ let r2 = s:repo().git_chomp('config','branch.'.m.'.remote')
+ if r2 !~# '^\.\=$'
+ let r = r2
+ let m = s:repo().git_chomp('config','branch.'.m.'.merge')[11:-1]
+ endif
+ endif
+ if empty(remote)
+ let remote = r
+ endif
+ if r ==# '.' || r ==# remote
+ let merge = m
+ if path =~# '^\.git/refs/heads/.'
+ let path = '.git/refs/heads/'.merge
+ endif
+ endif
+ endif
+
+ if empty(commit) && path !~# '^\.git/'
+ if a:line1 && !a:count && !empty(merge)
+ let commit = merge
+ else
+ let commit = s:repo().rev_parse('HEAD')
+ endif
+ endif
+
+ if empty(remote)
+ let remote = '.'
+ let raw = s:repo().git_chomp('remote','get-url','origin')
+ else
+ let raw = s:repo().git_chomp('remote','get-url',remote)
+ endif
+ if raw ==# ''
+ let raw = remote
+ endif
+
+ for Handler in g:fugitive_browse_handlers
+ let url = call(Handler, [{
+ \ 'repo': s:repo(),
+ \ 'remote': raw,
+ \ 'revision': 'No longer provided',
+ \ 'commit': commit,
+ \ 'path': path,
+ \ 'type': type,
+ \ 'line1': a:count > 0 ? a:line1 : 0,
+ \ 'line2': a:count > 0 ? a:count : 0}])
+ if !empty(url)
+ break
+ endif
+ endfor
+
+ if empty(url) && raw ==# '.'
+ call s:throw("Instaweb failed to start")
+ elseif empty(url)
+ call s:throw("'".remote."' is not a supported remote")
+ endif
+
+ let url = s:gsub(url, '[ <>]', '\="%".printf("%02X",char2nr(submatch(0)))')
+ if a:bang
+ if has('clipboard')
+ let @+ = url
+ endif
+ return 'echomsg '.string(url)
+ elseif exists(':Browse') == 2
+ return 'echomsg '.string(url).'|Browse '.url
+ else
+ if !exists('g:loaded_netrw')
+ runtime! autoload/netrw.vim
+ endif
+ if exists('*netrw#BrowseX')
+ return 'echomsg '.string(url).'|call netrw#BrowseX('.string(url).', 0)'
+ else
+ return 'echomsg '.string(url).'|call netrw#NetrwBrowseX('.string(url).', 0)'
+ endif
+ endif
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ endtry
+endfunction
+
+function! s:github_url(opts, ...) abort
+ if a:0 || type(a:opts) != type({})
+ return ''
+ endif
+ let domain_pattern = 'github\.com'
+ let domains = exists('g:fugitive_github_domains') ? g:fugitive_github_domains : []
+ for domain in domains
+ let domain_pattern .= '\|' . escape(split(domain, '://')[-1], '.')
+ endfor
+ let repo = matchstr(get(a:opts, 'remote'), '^\%(https\=://\|git://\|git@\)\=\zs\('.domain_pattern.'\)[/:].\{-\}\ze\%(\.git\)\=$')
+ if repo ==# ''
+ return ''
+ endif
+ let path = substitute(a:opts.path, '^/', '', '')
+ if index(domains, 'http://' . matchstr(repo, '^[^:/]*')) >= 0
+ let root = 'http://' . s:sub(repo,':','/')
+ else
+ let root = 'https://' . s:sub(repo,':','/')
+ endif
+ if path =~# '^\.git/refs/heads/'
+ let branch = a:opts.repo.git_chomp('config','branch.'.path[16:-1].'.merge')[11:-1]
+ if branch ==# ''
+ return root . '/commits/' . path[16:-1]
+ else
+ return root . '/commits/' . branch
+ endif
+ elseif path =~# '^\.git/refs/tags/'
+ return root . '/releases/tag/' . path[15:-1]
+ elseif path =~# '^\.git/refs/remotes/[^/]\+/.'
+ return root . '/commits/' . matchstr(path,'remotes/[^/]\+/\zs.*')
+ elseif path =~# '.git/\%(config$\|hooks\>\)'
+ return root . '/admin'
+ elseif path =~# '^\.git\>'
+ return root
+ endif
+ if a:opts.commit =~# '^\d\=$'
+ let commit = a:opts.repo.rev_parse('HEAD')
+ else
+ let commit = a:opts.commit
+ endif
+ if get(a:opts, 'type', '') ==# 'tree' || a:opts.path =~# '/$'
+ let url = substitute(root . '/tree/' . commit . '/' . path, '/$', '', 'g')
+ elseif get(a:opts, 'type', '') ==# 'blob' || a:opts.path =~# '[^/]$'
+ let url = root . '/blob/' . commit . '/' . path
+ if get(a:opts, 'line2') && a:opts.line1 == a:opts.line2
+ let url .= '#L' . a:opts.line1
+ elseif get(a:opts, 'line2')
+ let url .= '#L' . a:opts.line1 . '-L' . a:opts.line2
+ endif
+ else
+ let url = root . '/commit/' . commit
+ endif
+ return url
+endfunction
+
+function! s:instaweb_url(opts) abort
+ if a:opts.remote !=# '.'
+ return ''
+ endif
+ let output = a:opts.repo.git_chomp('instaweb','-b','unknown')
+ if output =~# 'http://'
+ let root = matchstr(output,'http://.*').'/?p='.fnamemodify(a:opts.repo.dir(),':t')
+ else
+ return ''
+ endif
+ if a:opts.path =~# '^\.git/refs/.'
+ return root . ';a=shortlog;h=' . matchstr(a:opts.path,'^\.git/\zs.*')
+ elseif a:opts.path =~# '^\.git\>'
+ return root
+ endif
+ let url = root
+ if a:opts.commit =~# '^\x\{40\}$'
+ if a:opts.type ==# 'commit'
+ let url .= ';a=commit'
+ endif
+ let url .= ';h=' . a:opts.repo.rev_parse(a:opts.commit . (a:opts.path == '' ? '' : ':' . a:opts.path))
+ else
+ if a:opts.type ==# 'blob' && empty(a:opts.commit)
+ let url .= ';h='.a:opts.repo.git_chomp('hash-object', '-w', a:opts.path)
+ else
+ try
+ let url .= ';h=' . a:opts.repo.rev_parse((a:opts.commit == '' ? 'HEAD' : ':' . a:opts.commit) . ':' . a:opts.path)
+ catch /^fugitive:/
+ call s:throw('fugitive: cannot browse uncommitted file')
+ endtry
+ endif
+ let root .= ';hb=' . matchstr(a:opts.repo.head_ref(),'[^ ]\+$')
+ endif
+ if a:opts.path !=# ''
+ let url .= ';f=' . a:opts.path
+ endif
+ if get(a:opts, 'line1')
+ let url .= '#l' . a:opts.line1
+ endif
+ return url
+endfunction
+
+if !exists('g:fugitive_browse_handlers')
+ let g:fugitive_browse_handlers = []
+endif
+
+call extend(g:fugitive_browse_handlers,
+ \ [s:function('s:github_url'), s:function('s:instaweb_url')])
+
+" Section: File access
+
+function! s:ReplaceCmd(cmd,...) abort
+ let fn = expand('%:p')
+ let tmp = tempname()
+ let prefix = ''
+ try
+ if a:0 && a:1 != ''
+ if s:winshell()
+ let old_index = $GIT_INDEX_FILE
+ let $GIT_INDEX_FILE = a:1
+ else
+ let prefix = 'env GIT_INDEX_FILE='.s:shellesc(a:1).' '
+ endif
+ endif
+ let redir = ' > '.tmp
+ if &shellpipe =~ '2>&1'
+ let redir .= ' 2>&1'
+ endif
+ if s:winshell()
+ let cmd_escape_char = &shellxquote == '(' ? '^' : '^^^'
+ call system('cmd /c "'.prefix.s:gsub(a:cmd,'[<>]', cmd_escape_char.'&').redir.'"')
+ elseif &shell =~# 'fish'
+ call system(' begin;'.prefix.a:cmd.redir.';end ')
+ else
+ call system(' ('.prefix.a:cmd.redir.') ')
+ endif
+ finally
+ if exists('old_index')
+ let $GIT_INDEX_FILE = old_index
+ endif
+ endtry
+ silent exe 'keepalt file '.tmp
+ try
+ silent edit!
+ finally
+ try
+ silent exe 'keepalt file '.s:fnameescape(fn)
+ catch /^Vim\%((\a\+)\)\=:E302/
+ endtry
+ call delete(tmp)
+ if fnamemodify(bufname('$'), ':p') ==# tmp
+ silent execute 'bwipeout '.bufnr('$')
+ endif
+ silent exe 'doau BufReadPost '.s:fnameescape(fn)
+ endtry
+endfunction
+
+function! s:BufReadIndex() abort
+ if !exists('b:fugitive_display_format')
+ let b:fugitive_display_format = filereadable(expand('%').'.lock')
+ endif
+ let b:fugitive_display_format = b:fugitive_display_format % 2
+ let b:fugitive_type = 'index'
+ try
+ let b:git_dir = s:repo().dir()
+ setlocal noro ma nomodeline
+ if fnamemodify($GIT_INDEX_FILE !=# '' ? $GIT_INDEX_FILE : b:git_dir . '/index', ':p') ==# expand('%:p')
+ let index = ''
+ else
+ let index = expand('%:p')
+ endif
+ if b:fugitive_display_format
+ call s:ReplaceCmd(s:repo().git_command('ls-files','--stage'),index)
+ set ft=git nospell
+ else
+ let cd = exists('*haslocaldir') && haslocaldir() ? 'lcd ' : 'cd '
+ let dir = getcwd()
+ if fugitive#git_version() =~# '^0\|^1\.[1-7]\.'
+ let cmd = s:repo().git_command('status')
+ else
+ let cmd = s:repo().git_command(
+ \ '-c', 'status.displayCommentPrefix=true',
+ \ '-c', 'color.status=false',
+ \ '-c', 'status.short=false',
+ \ 'status')
+ endif
+ try
+ execute cd.'`=s:repo().tree()`'
+ call s:ReplaceCmd(cmd, index)
+ finally
+ execute cd.'`=dir`'
+ endtry
+ set ft=gitcommit
+ set foldtext=fugitive#foldtext()
+ endif
+ setlocal ro noma nomod noswapfile
+ if &bufhidden ==# ''
+ setlocal bufhidden=delete
+ endif
+ call s:JumpInit()
+ nunmap <buffer> P
+ nunmap <buffer> ~
+ nnoremap <buffer> <silent> <C-N> :<C-U>execute <SID>StageNext(v:count1)<CR>
+ nnoremap <buffer> <silent> <C-P> :<C-U>execute <SID>StagePrevious(v:count1)<CR>
+ nnoremap <buffer> <silent> - :<C-U>silent execute <SID>StageToggle(line('.'),line('.')+v:count1-1)<CR>
+ xnoremap <buffer> <silent> - :<C-U>silent execute <SID>StageToggle(line("'<"),line("'>"))<CR>
+ nnoremap <buffer> <silent> a :<C-U>let b:fugitive_display_format += 1<Bar>exe <SID>BufReadIndex()<CR>
+ nnoremap <buffer> <silent> i :<C-U>let b:fugitive_display_format -= 1<Bar>exe <SID>BufReadIndex()<CR>
+ nnoremap <buffer> <silent> C :<C-U>Gcommit<CR>
+ nnoremap <buffer> <silent> cA :<C-U>Gcommit --amend --reuse-message=HEAD<CR>
+ nnoremap <buffer> <silent> ca :<C-U>Gcommit --amend<CR>
+ nnoremap <buffer> <silent> cc :<C-U>Gcommit<CR>
+ nnoremap <buffer> <silent> cva :<C-U>Gcommit --amend --verbose<CR>
+ nnoremap <buffer> <silent> cvc :<C-U>Gcommit --verbose<CR>
+ nnoremap <buffer> <silent> D :<C-U>execute <SID>StageDiff('Gdiff')<CR>
+ nnoremap <buffer> <silent> dd :<C-U>execute <SID>StageDiff('Gdiff')<CR>
+ nnoremap <buffer> <silent> dh :<C-U>execute <SID>StageDiff('Gsdiff')<CR>
+ nnoremap <buffer> <silent> ds :<C-U>execute <SID>StageDiff('Gsdiff')<CR>
+ nnoremap <buffer> <silent> dp :<C-U>execute <SID>StageDiffEdit()<CR>
+ nnoremap <buffer> <silent> dv :<C-U>execute <SID>StageDiff('Gvdiff')<CR>
+ nnoremap <buffer> <silent> p :<C-U>execute <SID>StagePatch(line('.'),line('.')+v:count1-1)<CR>
+ xnoremap <buffer> <silent> p :<C-U>execute <SID>StagePatch(line("'<"),line("'>"))<CR>
+ nnoremap <buffer> <silent> P :<C-U>execute <SID>StagePatch(line('.'),line('.')+v:count1-1)<CR>
+ xnoremap <buffer> <silent> P :<C-U>execute <SID>StagePatch(line("'<"),line("'>"))<CR>
+ nnoremap <buffer> <silent> q :<C-U>if bufnr('$') == 1<Bar>quit<Bar>else<Bar>bdelete<Bar>endif<CR>
+ nnoremap <buffer> <silent> r :<C-U>edit<CR>
+ nnoremap <buffer> <silent> R :<C-U>edit<CR>
+ nnoremap <buffer> <silent> U :<C-U>execute <SID>StageUndo()<CR>
+ nnoremap <buffer> <silent> g? :help fugitive-:Gstatus<CR>
+ nnoremap <buffer> <silent> <F1> :help fugitive-:Gstatus<CR>
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ endtry
+endfunction
+
+function! s:FileRead() abort
+ try
+ let repo = s:repo(fugitive#extract_git_dir(expand('<amatch>')))
+ let path = s:sub(s:sub(matchstr(expand('<amatch>'),'fugitive://.\{-\}//\zs.*'),'/',':'),'^\d:',':&')
+ let hash = repo.rev_parse(path)
+ if path =~ '^:'
+ let type = 'blob'
+ else
+ let type = repo.git_chomp('cat-file','-t',hash)
+ endif
+ " TODO: use count, if possible
+ return "read !".escape(repo.git_command('cat-file',type,hash),'%#\')
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ endtry
+endfunction
+
+function! s:BufReadIndexFile() abort
+ try
+ let b:fugitive_type = 'blob'
+ let b:git_dir = s:repo().dir()
+ try
+ call s:ReplaceCmd(s:repo().git_command('cat-file','blob',s:buffer().sha1()))
+ finally
+ if &bufhidden ==# ''
+ setlocal bufhidden=delete
+ endif
+ setlocal noswapfile
+ endtry
+ return ''
+ catch /^fugitive: rev-parse/
+ silent exe 'doau BufNewFile '.s:fnameescape(expand('%:p'))
+ return ''
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ endtry
+endfunction
+
+function! s:BufWriteIndexFile() abort
+ let tmp = tempname()
+ try
+ let path = matchstr(expand('<amatch>'),'//\d/\zs.*')
+ let stage = matchstr(expand('<amatch>'),'//\zs\d')
+ silent execute 'write !'.s:repo().git_command('hash-object','-w','--stdin').' > '.tmp
+ let sha1 = readfile(tmp)[0]
+ let old_mode = matchstr(s:repo().git_chomp('ls-files','--stage',path),'^\d\+')
+ if old_mode == ''
+ let old_mode = executable(s:repo().tree(path)) ? '100755' : '100644'
+ endif
+ let info = old_mode.' '.sha1.' '.stage."\t".path
+ call writefile([info],tmp)
+ if s:winshell()
+ let error = system('type '.s:gsub(tmp,'/','\\').'|'.s:repo().git_command('update-index','--index-info'))
+ else
+ let error = system(s:repo().git_command('update-index','--index-info').' < '.tmp)
+ endif
+ if v:shell_error == 0
+ setlocal nomodified
+ if exists('#BufWritePost')
+ execute 'doautocmd BufWritePost '.s:fnameescape(expand('%:p'))
+ endif
+ call fugitive#reload_status()
+ return ''
+ else
+ return 'echoerr '.string('fugitive: '.error)
+ endif
+ finally
+ call delete(tmp)
+ endtry
+endfunction
+
+function! s:BufReadObject() abort
+ try
+ setlocal noro ma
+ let b:git_dir = s:repo().dir()
+ let hash = s:buffer().sha1()
+ if !exists("b:fugitive_type")
+ let b:fugitive_type = s:repo().git_chomp('cat-file','-t',hash)
+ endif
+ if b:fugitive_type !~# '^\%(tag\|commit\|tree\|blob\)$'
+ return "echoerr 'fugitive: unrecognized git type'"
+ endif
+ let firstline = getline('.')
+ if !exists('b:fugitive_display_format') && b:fugitive_type != 'blob'
+ let b:fugitive_display_format = +getbufvar('#','fugitive_display_format')
+ endif
+
+ if b:fugitive_type !=# 'blob'
+ setlocal nomodeline
+ endif
+
+ let pos = getpos('.')
+ silent keepjumps %delete_
+ setlocal endofline
+
+ try
+ if b:fugitive_type ==# 'tree'
+ let b:fugitive_display_format = b:fugitive_display_format % 2
+ if b:fugitive_display_format
+ call s:ReplaceCmd(s:repo().git_command('ls-tree',hash))
+ else
+ call s:ReplaceCmd(s:repo().git_command('show','--no-color',hash))
+ endif
+ elseif b:fugitive_type ==# 'tag'
+ let b:fugitive_display_format = b:fugitive_display_format % 2
+ if b:fugitive_display_format
+ call s:ReplaceCmd(s:repo().git_command('cat-file',b:fugitive_type,hash))
+ else
+ call s:ReplaceCmd(s:repo().git_command('cat-file','-p',hash))
+ endif
+ elseif b:fugitive_type ==# 'commit'
+ let b:fugitive_display_format = b:fugitive_display_format % 2
+ if b:fugitive_display_format
+ call s:ReplaceCmd(s:repo().git_command('cat-file',b:fugitive_type,hash))
+ else
+ call s:ReplaceCmd(s:repo().git_command('show','--no-color','--pretty=format:tree%x20%T%nparent%x20%P%nauthor%x20%an%x20<%ae>%x20%ad%ncommitter%x20%cn%x20<%ce>%x20%cd%nencoding%x20%e%n%n%s%n%n%b',hash))
+ keepjumps call search('^parent ')
+ if getline('.') ==# 'parent '
+ silent keepjumps delete_
+ else
+ silent keepjumps s/\%(^parent\)\@<! /\rparent /ge
+ endif
+ keepjumps let lnum = search('^encoding \%(<unknown>\)\=$','W',line('.')+3)
+ if lnum
+ silent keepjumps delete_
+ end
+ keepjumps 1
+ endif
+ elseif b:fugitive_type ==# 'blob'
+ call s:ReplaceCmd(s:repo().git_command('cat-file',b:fugitive_type,hash))
+ setlocal nomodeline
+ endif
+ finally
+ keepjumps call setpos('.',pos)
+ setlocal ro noma nomod noswapfile
+ if &bufhidden ==# ''
+ setlocal bufhidden=delete
+ endif
+ if b:fugitive_type !=# 'blob'
+ setlocal filetype=git foldmethod=syntax
+ nnoremap <buffer> <silent> a :<C-U>let b:fugitive_display_format += v:count1<Bar>exe <SID>BufReadObject()<CR>
+ nnoremap <buffer> <silent> i :<C-U>let b:fugitive_display_format -= v:count1<Bar>exe <SID>BufReadObject()<CR>
+ else
+ call s:JumpInit()
+ endif
+ endtry
+
+ return ''
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ endtry
+endfunction
+
+augroup fugitive_files
+ autocmd!
+ autocmd BufReadCmd index{,.lock}
+ \ if fugitive#is_git_dir(expand('<amatch>:p:h')) |
+ \ exe s:BufReadIndex() |
+ \ elseif filereadable(expand('<amatch>')) |
+ \ read <amatch> |
+ \ 1delete |
+ \ endif
+ autocmd FileReadCmd fugitive://**//[0-3]/** exe s:FileRead()
+ autocmd BufReadCmd fugitive://**//[0-3]/** exe s:BufReadIndexFile()
+ autocmd BufWriteCmd fugitive://**//[0-3]/** exe s:BufWriteIndexFile()
+ autocmd BufReadCmd fugitive://**//[0-9a-f][0-9a-f]* exe s:BufReadObject()
+ autocmd FileReadCmd fugitive://**//[0-9a-f][0-9a-f]* exe s:FileRead()
+ autocmd FileType git
+ \ if exists('b:git_dir') |
+ \ call s:JumpInit() |
+ \ endif
+ autocmd FileType git,gitcommit,gitrebase
+ \ if exists('b:git_dir') |
+ \ call s:GFInit() |
+ \ endif
+augroup END
+
+" Section: Temp files
+
+if !exists('s:temp_files')
+ let s:temp_files = {}
+endif
+
+augroup fugitive_temp
+ autocmd!
+ autocmd BufNewFile,BufReadPost *
+ \ if has_key(s:temp_files,s:cpath(expand('<afile>:p'))) |
+ \ let b:git_dir = s:temp_files[s:cpath(expand('<afile>:p'))].dir |
+ \ let b:git_type = 'temp' |
+ \ let b:git_args = s:temp_files[s:cpath(expand('<afile>:p'))].args |
+ \ call fugitive#detect(expand('<afile>:p')) |
+ \ setlocal bufhidden=delete nobuflisted |
+ \ nnoremap <buffer> <silent> q :<C-U>bdelete<CR>|
+ \ endif
+augroup END
+
+" Section: Go to file
+
+nnoremap <SID>: :<C-U><C-R>=v:count ? v:count : ''<CR>
+function! s:GFInit(...) abort
+ cnoremap <buffer> <expr> <Plug><cfile> fugitive#cfile()
+ if !exists('g:fugitive_no_maps') && empty(mapcheck('gf', 'n'))
+ nmap <buffer> <silent> gf <SID>:find <Plug><cfile><CR>
+ nmap <buffer> <silent> <C-W>f <SID>:sfind <Plug><cfile><CR>
+ nmap <buffer> <silent> <C-W><C-F> <SID>:sfind <Plug><cfile><CR>
+ nmap <buffer> <silent> <C-W>gf <SID>:tabfind <Plug><cfile><CR>
+ endif
+endfunction
+
+function! s:JumpInit(...) abort
+ nnoremap <buffer> <silent> <CR> :<C-U>exe <SID>GF("edit")<CR>
+ if !&modifiable
+ nnoremap <buffer> <silent> o :<C-U>exe <SID>GF("split")<CR>
+ nnoremap <buffer> <silent> S :<C-U>exe <SID>GF("vsplit")<CR>
+ nnoremap <buffer> <silent> O :<C-U>exe <SID>GF("tabedit")<CR>
+ nnoremap <buffer> <silent> - :<C-U>exe <SID>Edit('edit',0,<SID>buffer().up(v:count1))<Bar> if fugitive#buffer().type('tree')<Bar>call search('^'.escape(expand('#:t'),'.*[]~\').'/\=$','wc')<Bar>endif<CR>
+ nnoremap <buffer> <silent> P :<C-U>exe <SID>Edit('edit',0,<SID>buffer().commit().'^'.v:count1.<SID>buffer().path(':'))<CR>
+ nnoremap <buffer> <silent> ~ :<C-U>exe <SID>Edit('edit',0,<SID>buffer().commit().'~'.v:count1.<SID>buffer().path(':'))<CR>
+ nnoremap <buffer> <silent> C :<C-U>exe <SID>Edit('edit',0,<SID>buffer().containing_commit())<CR>
+ nnoremap <buffer> <silent> cc :<C-U>exe <SID>Edit('edit',0,<SID>buffer().containing_commit())<CR>
+ nnoremap <buffer> <silent> co :<C-U>exe <SID>Edit('split',0,<SID>buffer().containing_commit())<CR>
+ nnoremap <buffer> <silent> cS :<C-U>exe <SID>Edit('vsplit',0,<SID>buffer().containing_commit())<CR>
+ nnoremap <buffer> <silent> cO :<C-U>exe <SID>Edit('tabedit',0,<SID>buffer().containing_commit())<CR>
+ nnoremap <buffer> <silent> cP :<C-U>exe <SID>Edit('pedit',0,<SID>buffer().containing_commit())<CR>
+ nnoremap <buffer> . : <C-R>=fnameescape(<SID>recall())<CR><Home>
+ endif
+endfunction
+
+function! s:cfile() abort
+ try
+ let buffer = s:buffer()
+ let myhash = buffer.sha1()
+ if myhash ==# '' && getline(1) =~# '^\%(commit\|tag\) \w'
+ let myhash = matchstr(getline(1),'^\w\+ \zs\S\+')
+ endif
+
+ if buffer.type('tree')
+ let showtree = (getline(1) =~# '^tree ' && getline(2) == "")
+ if showtree && line('.') > 2
+ return [buffer.commit().':'.s:buffer().path().(buffer.path() =~# '^$\|/$' ? '' : '/').s:sub(getline('.'),'/$','')]
+ elseif getline('.') =~# '^\d\{6\} \l\{3,8\} \x\{40\}\t'
+ return [buffer.commit().':'.s:buffer().path().(buffer.path() =~# '^$\|/$' ? '' : '/').s:sub(matchstr(getline('.'),'\t\zs.*'),'/$','')]
+ endif
+
+ elseif buffer.type('blob')
+ let ref = expand("<cfile>")
+ try
+ let sha1 = buffer.repo().rev_parse(ref)
+ catch /^fugitive:/
+ endtry
+ if exists('sha1')
+ return [ref]
+ endif
+
+ else
+
+ let dcmds = []
+
+ " Index
+ if getline('.') =~# '^\d\{6\} \x\{40\} \d\t'
+ let ref = matchstr(getline('.'),'\x\{40\}')
+ let file = ':'.s:sub(matchstr(getline('.'),'\d\t.*'),'\t',':')
+ return [file]
+
+ elseif getline('.') =~# '^#\trenamed:.* -> '
+ let file = '/'.matchstr(getline('.'),' -> \zs.*')
+ return [file]
+ elseif getline('.') =~# '^#\t\(\k\| \)\+\p\?: *.'
+ let file = '/'.matchstr(getline('.'),': *\zs.\{-\}\ze\%( ([^()[:digit:]]\+)\)\=$')
+ return [file]
+ elseif getline('.') =~# '^#\t.'
+ let file = '/'.matchstr(getline('.'),'#\t\zs.*')
+ return [file]
+ elseif getline('.') =~# ': needs merge$'
+ let file = '/'.matchstr(getline('.'),'.*\ze: needs merge$')
+ return [file, 'Gdiff!']
+
+ elseif getline('.') ==# '# Not currently on any branch.'
+ return ['HEAD']
+ elseif getline('.') =~# '^# On branch '
+ let file = 'refs/heads/'.getline('.')[12:]
+ return [file]
+ elseif getline('.') =~# "^# Your branch .*'"
+ let file = matchstr(getline('.'),"'\\zs\\S\\+\\ze'")
+ return [file]
+ endif
+
+ let showtree = (getline(1) =~# '^tree ' && getline(2) == "")
+
+ if getline('.') =~# '^ref: '
+ let ref = strpart(getline('.'),5)
+
+ elseif getline('.') =~# '^commit \x\{40\}\>'
+ let ref = matchstr(getline('.'),'\x\{40\}')
+ return [ref]
+
+ elseif getline('.') =~# '^parent \x\{40\}\>'
+ let ref = matchstr(getline('.'),'\x\{40\}')
+ let line = line('.')
+ let parent = 0
+ while getline(line) =~# '^parent '
+ let parent += 1
+ let line -= 1
+ endwhile
+ return [ref]
+
+ elseif getline('.') =~ '^tree \x\{40\}$'
+ let ref = matchstr(getline('.'),'\x\{40\}')
+ if s:repo().rev_parse(myhash.':') == ref
+ let ref = myhash.':'
+ endif
+ return [ref]
+
+ elseif getline('.') =~# '^object \x\{40\}$' && getline(line('.')+1) =~ '^type \%(commit\|tree\|blob\)$'
+ let ref = matchstr(getline('.'),'\x\{40\}')
+ let type = matchstr(getline(line('.')+1),'type \zs.*')
+
+ elseif getline('.') =~# '^\l\{3,8\} '.myhash.'$'
+ let ref = buffer.rev()
+
+ elseif getline('.') =~# '^\l\{3,8\} \x\{40\}\>'
+ let ref = matchstr(getline('.'),'\x\{40\}')
+ echoerr "warning: unknown context ".matchstr(getline('.'),'^\l*')
+
+ elseif getline('.') =~# '^[+-]\{3\} [ab/]'
+ let ref = getline('.')[4:]
+
+ elseif getline('.') =~# '^[+-]' && search('^@@ -\d\+,\d\+ +\d\+,','bnW')
+ let type = getline('.')[0]
+ let lnum = line('.') - 1
+ let offset = 0
+ while getline(lnum) !~# '^@@ -\d\+,\d\+ +\d\+,'
+ if getline(lnum) =~# '^[ '.type.']'
+ let offset += 1
+ endif
+ let lnum -= 1
+ endwhile
+ let offset += matchstr(getline(lnum), type.'\zs\d\+')
+ let ref = getline(search('^'.type.'\{3\} [ab]/','bnW'))[4:-1]
+ let dcmds = [offset, 'normal!zv']
+
+ elseif getline('.') =~# '^rename from '
+ let ref = 'a/'.getline('.')[12:]
+ elseif getline('.') =~# '^rename to '
+ let ref = 'b/'.getline('.')[10:]
+
+ elseif getline('.') =~# '^@@ -\d\+,\d\+ +\d\+,'
+ let diff = getline(search('^diff --git \%(a/.*\|/dev/null\) \%(b/.*\|/dev/null\)', 'bcnW'))
+ let offset = matchstr(getline('.'), '+\zs\d\+')
+
+ let dref = matchstr(diff, '\Cdiff --git \zs\%(a/.*\|/dev/null\)\ze \%(b/.*\|/dev/null\)')
+ let ref = matchstr(diff, '\Cdiff --git \%(a/.*\|/dev/null\) \zs\%(b/.*\|/dev/null\)')
+ let dcmd = 'Gdiff! +'.offset
+
+ elseif getline('.') =~# '^diff --git \%(a/.*\|/dev/null\) \%(b/.*\|/dev/null\)'
+ let dref = matchstr(getline('.'),'\Cdiff --git \zs\%(a/.*\|/dev/null\)\ze \%(b/.*\|/dev/null\)')
+ let ref = matchstr(getline('.'),'\Cdiff --git \%(a/.*\|/dev/null\) \zs\%(b/.*\|/dev/null\)')
+ let dcmd = 'Gdiff!'
+
+ elseif getline('.') =~# '^index ' && getline(line('.')-1) =~# '^diff --git \%(a/.*\|/dev/null\) \%(b/.*\|/dev/null\)'
+ let line = getline(line('.')-1)
+ let dref = matchstr(line,'\Cdiff --git \zs\%(a/.*\|/dev/null\)\ze \%(b/.*\|/dev/null\)')
+ let ref = matchstr(line,'\Cdiff --git \%(a/.*\|/dev/null\) \zs\%(b/.*\|/dev/null\)')
+ let dcmd = 'Gdiff!'
+
+ elseif line('$') == 1 && getline('.') =~ '^\x\{40\}$'
+ let ref = getline('.')
+
+ elseif expand('<cword>') =~# '^\x\{7,40\}\>'
+ return [expand('<cword>')]
+
+ else
+ let ref = ''
+ endif
+
+ if myhash ==# ''
+ let ref = s:sub(ref,'^a/','HEAD:')
+ let ref = s:sub(ref,'^b/',':0:')
+ if exists('dref')
+ let dref = s:sub(dref,'^a/','HEAD:')
+ endif
+ else
+ let ref = s:sub(ref,'^a/',myhash.'^:')
+ let ref = s:sub(ref,'^b/',myhash.':')
+ if exists('dref')
+ let dref = s:sub(dref,'^a/',myhash.'^:')
+ endif
+ endif
+
+ if ref ==# '/dev/null'
+ " Empty blob
+ let ref = 'e69de29bb2d1d6434b8b29ae775ad8c2e48c5391'
+ endif
+
+ if exists('dref')
+ return [ref, dcmd . ' ' . s:fnameescape(dref)] + dcmds
+ elseif ref != ""
+ return [ref] + dcmds
+ endif
+
+ endif
+ return []
+ endtry
+endfunction
+
+function! s:GF(mode) abort
+ try
+ let results = s:cfile()
+ catch /^fugitive:/
+ return 'echoerr v:errmsg'
+ endtry
+ if len(results)
+ return s:Edit(a:mode, 0, results[0]).join(map(results[1:-1], '"|".v:val'), '')
+ else
+ return ''
+ endif
+endfunction
+
+function! fugitive#cfile() abort
+ let pre = ''
+ let results = s:cfile()
+ if empty(results)
+ let cfile = expand('<cfile>')
+ if &includeexpr =~# '\<v:fname\>'
+ sandbox let cfile = eval(substitute(&includeexpr, '\C\<v:fname\>', '\=string(cfile)', 'g'))
+ endif
+ return cfile
+ elseif len(results) > 1
+ let pre = '+' . join(map(results[1:-1], 'escape(v:val, " ")'), '\|') . ' '
+ endif
+ return pre . s:fnameescape(fugitive#repo().translate(results[0]))
+endfunction
+
+" Section: Statusline
+
+function! s:repo_head_ref() dict abort
+ if !filereadable(self.dir('HEAD'))
+ return ''
+ endif
+ return readfile(self.dir('HEAD'))[0]
+endfunction
+
+call s:add_methods('repo',['head_ref'])
+
+function! fugitive#statusline(...) abort
+ if !exists('b:git_dir')
+ return ''
+ endif
+ let status = ''
+ if s:buffer().commit() != ''
+ let status .= ':' . s:buffer().commit()[0:7]
+ endif
+ let status .= '('.fugitive#head(7).')'
+ if &statusline =~# '%[MRHWY]' && &statusline !~# '%[mrhwy]'
+ return ',GIT'.status
+ else
+ return '[Git'.status.']'
+ endif
+endfunction
+
+function! fugitive#head(...) abort
+ if !exists('b:git_dir')
+ return ''
+ endif
+
+ return s:repo().head(a:0 ? a:1 : 0)
+endfunction
+
+augroup fugitive_statusline
+ autocmd!
+ autocmd User Flags call Hoist('buffer', function('fugitive#statusline'))
+augroup END
+
+" Section: Folding
+
+function! fugitive#foldtext() abort
+ if &foldmethod !=# 'syntax'
+ return foldtext()
+ elseif getline(v:foldstart) =~# '^diff '
+ let [add, remove] = [-1, -1]
+ let filename = ''
+ for lnum in range(v:foldstart, v:foldend)
+ if filename ==# '' && getline(lnum) =~# '^[+-]\{3\} [abciow12]/'
+ let filename = getline(lnum)[6:-1]
+ endif
+ if getline(lnum) =~# '^+'
+ let add += 1
+ elseif getline(lnum) =~# '^-'
+ let remove += 1
+ elseif getline(lnum) =~# '^Binary '
+ let binary = 1
+ endif
+ endfor
+ if filename ==# ''
+ let filename = matchstr(getline(v:foldstart), '^diff .\{-\} a/\zs.*\ze b/')
+ endif
+ if filename ==# ''
+ let filename = getline(v:foldstart)[5:-1]
+ endif
+ if exists('binary')
+ return 'Binary: '.filename
+ else
+ return (add<10&&remove<100?' ':'') . add . '+ ' . (remove<10&&add<100?' ':'') . remove . '- ' . filename
+ endif
+ elseif getline(v:foldstart) =~# '^# .*:$'
+ let lines = getline(v:foldstart, v:foldend)
+ call filter(lines, 'v:val =~# "^#\t"')
+ cal map(lines,'s:sub(v:val, "^#\t%(modified: +|renamed: +)=", "")')
+ cal map(lines,'s:sub(v:val, "^([[:alpha:] ]+): +(.*)", "\\2 (\\1)")')
+ return getline(v:foldstart).' '.join(lines, ', ')
+ endif
+ return foldtext()
+endfunction
+
+augroup fugitive_foldtext
+ autocmd!
+ autocmd User Fugitive
+ \ if &filetype =~# '^git\%(commit\)\=$' && &foldtext ==# 'foldtext()' |
+ \ set foldtext=fugitive#foldtext() |
+ \ endif
+augroup END
diff --git a/vim/bundle/vim-racer/.gitignore b/vim/bundle/vim-racer/.gitignore
new file mode 100644
index 0000000..0d20b64
--- /dev/null
+++ b/vim/bundle/vim-racer/.gitignore
@@ -0,0 +1 @@
+*.pyc
diff --git a/vim/bundle/vim-racer/README.md b/vim/bundle/vim-racer/README.md
new file mode 100644
index 0000000..b56655d
--- /dev/null
+++ b/vim/bundle/vim-racer/README.md
@@ -0,0 +1,60 @@
+# Vim Racer Plugin
+
+This plugin allows vim to use [Racer](http://github.com/phildawes/racer) for Rust code completion and navigation.
+
+## Installation
+
+1. Build / Install [Racer](http://github.com/phildawes/racer)
+
+2. Install using Pathogen, Vundle or NeoBundle. Or, copy `plugin/racer.vim` into your `~/.vim/plugin` directory.
+
+ Vundle users:
+ ```
+ Plugin 'racer-rust/vim-racer'
+ ```
+
+ NeoBundle users:
+ ```
+ NeoBundle 'racer-rust/vim-racer'
+ ```
+
+ vim-plug users:
+ ```
+ Plug 'racer-rust/vim-racer'
+ ```
+
+ Pathogen users:
+ ```
+ git clone --depth=1 https://github.com/racer-rust/vim-racer.git ~/.vim/bundle/vim-racer
+ ```
+
+3. Add `g:racer_cmd` to your `.vimrc`. Also it's worth turning on 'hidden' mode for buffers otherwise you need to save the current buffer every time you do a goto-definition. E.g.:
+
+ ```
+ set hidden
+ let g:racer_cmd = "/path/to/racer/bin"
+ ```
+
+4. If you want completions to show the complete function definition (e.g. its arguments and return type), enable the experimental completer:
+
+ ```
+ let g:racer_experimental_completer = 1
+ ```
+
+## Example Mappings
+
+vim-racer enables `C-x-C-o` to search for completions and provides several
+`<Plug>` mappings for source code navigation. These mappings are not enabled by
+default but you can easily use them by adding the following lines to your
+`.vimrc` (Or `init.vim` in case of Neovim).
+
+For example, with the following mappings you can navigate to the identifier under
+the cursor and open it on the current buffer, on an horizontal or vertical split,
+or go straight to the documentation:
+
+```
+au FileType rust nmap gd <Plug>(rust-def)
+au FileType rust nmap gs <Plug>(rust-def-split)
+au FileType rust nmap gx <Plug>(rust-def-vertical)
+au FileType rust nmap <leader>gd <Plug>(rust-doc)
+```
diff --git a/vim/bundle/vim-racer/autoload/racer.vim b/vim/bundle/vim-racer/autoload/racer.vim
new file mode 100644
index 0000000..5cb80d7
--- /dev/null
+++ b/vim/bundle/vim-racer/autoload/racer.vim
@@ -0,0 +1,265 @@
+function! s:RacerGetPrefixCol(base)
+ let col = col('.') - 1
+ let b:racer_col = col
+ let b:tmpfname = tempname()
+ call writefile(s:RacerGetBufferContents(a:base), b:tmpfname)
+ let cmd = g:racer_cmd . ' prefix ' . line('.') . ' ' . col . ' ' . b:tmpfname
+ let res = system(cmd)
+ let prefixline = split(res, '\n')[0]
+ let startbyte = split(prefixline[7:], ',')[0]
+ return startbyte - line2byte(byte2line(startbyte)) + 1
+endfunction
+
+function! s:RacerGetExpCompletions(base)
+ let col = col('.')-1
+ let b:tmpfname = tempname()
+ call writefile(s:RacerGetBufferContents(a:base), b:tmpfname)
+ let fname = expand('%:p')
+ let cmd = g:racer_cmd . ' complete ' . line('.') . ' ' . col . ' "' . fname . '" "' . b:tmpfname . '"'
+ let res = system(cmd)
+
+ let typeMap = {
+ \ 'Struct' : 's', 'Module' : 'M', 'Function' : 'f',
+ \ 'Crate' : 'C', 'Let' : 'v', 'StructField' : 'm',
+ \ 'Impl' : 'i', 'Enum' : 'e', 'EnumVariant' : 'E',
+ \ 'Type' : 't', 'FnArg' : 'v', 'Trait' : 'T'
+ \ }
+
+ let lines = split(res, '\n')
+ let out = []
+
+ for line in lines
+ if line !~# '^MATCH'
+ continue
+ endif
+
+ let completions = split(line[6:], ',')
+ let kind = get(typeMap, completions[4])
+ let completion = { 'kind' : kind, 'word' : completions[0], 'dup' : 1 }
+ let info = join(completions[5:], ',')
+
+ if kind ==# 'f'
+ " function
+ let completion['menu'] = substitute(
+ \ substitute(
+ \ substitute(info, '\(pub\|fn\) ', '', 'g'),
+ \ '{*$', '', ''
+ \ ),
+ \ ' where\s\?.*$', '', ''
+ \ )
+ if g:racer_insert_paren == 1
+ let completion['abbr'] = completions[0]
+ let completion['word'] .= '('
+ endif
+ let completion['info'] = info
+ elseif kind ==# 's' " struct
+ let completion['menu'] = substitute(
+ \ substitute(info, '\(pub\|struct\) ', '', 'g'),
+ \ '{*$', '', ''
+ \ )
+ endif
+
+ if stridx(tolower(completions[0]), tolower(a:base)) == 0
+ let out = add(out, completion)
+ endif
+ endfor
+ call delete(b:tmpfname)
+ return out
+endfunction
+
+function! s:RacerSplitLine(line)
+ let separator = ';'
+ let placeholder = '{PLACEHOLDER}'
+ let line = substitute(a:line, '\\;', placeholder, 'g')
+ let parts = split(line, separator)
+ let docs = substitute(
+ \ substitute(
+ \ substitute(
+ \ substitute(get(parts, 7, ''), '^\"\(.*\)\"$', '\1', ''),
+ \ '\\\"', '\"', 'g'
+ \ ),
+ \ '\\''', '''', 'g'
+ \ ),
+ \ '\\n', '\n', 'g'
+ \ )
+ let parts = add(parts[:6], docs)
+ let parts = map(copy(parts), 'substitute(v:val, ''{PLACEHOLDER}'', '';'', ''g'')')
+
+ return parts
+endfunction
+
+function! racer#ShowDocumentation()
+ let winview = winsaveview() " Save the current cursor position
+ " Move to the end of the word for the entire token to search.
+ " Move one char back to avoid moving to the end of the *next* word.
+ execute 'normal he'
+ let col = col('.')
+ let b:tmpfname = tempname()
+ " Create temporary file with the buffer's current state
+ call writefile(getline(1, '$'), b:tmpfname)
+ let fname = expand('%:p')
+ let cmd = g:racer_cmd . ' complete-with-snippet ' . line('.') . ' ' . col . ' ' . fname . ' ' . b:tmpfname
+ let res = system(cmd)
+ " Restore de cursor position
+ call winrestview(winview)
+ " Delete the temporary file
+ call delete(b:tmpfname)
+ let lines = split(res, '\n')
+ for line in lines
+ if line !~# '^MATCH'
+ continue
+ endif
+
+ let docs = s:RacerSplitLine(line[6:])[7]
+ if len(docs) == 0
+ break
+ endif
+
+ " Only open doc buffer if there're docs to show
+ let bn = bufnr('__doc__')
+ if bn > 0
+ let wi = index(tabpagebuflist(tabpagenr()), bn)
+ if wi >= 0
+ " If the __doc__ buffer is open in the current tab, jump to it
+ silent execute (wi+1) . 'wincmd w'
+ else
+ silent execute 'sbuffer ' . bn
+ endif
+ else
+ split '__doc__'
+ endif
+
+ setlocal nobuflisted
+ setlocal modifiable
+ setlocal noswapfile
+ setlocal buftype=nofile
+ silent normal! ggdG
+ silent $put=docs
+ silent normal! 1Gdd
+ setlocal nomodifiable
+ setlocal nomodified
+ setlocal filetype=rustdoc
+ break
+ endfor
+endfunction
+
+function! s:RacerGetCompletions(base)
+ let col = col('.') - 1
+ let b:tmpfname = tempname()
+ " HACK: Special case to offer autocompletion on a string literal
+ if getline('.')[:col-1] =~# '".*"\.$'
+ call writefile(['fn main() {', ' let x: &str = "";', ' x.', '}'], b:tmpfname)
+ let fname = expand('%:p')
+ let cmd = g:racer_cmd . ' complete 3 6 "' . fname . '" "' . b:tmpfname . '"'
+ else
+ call writefile(s:RacerGetBufferContents(a:base), b:tmpfname)
+ let fname = expand('%:p')
+ let cmd = g:racer_cmd . ' complete ' . line('.') . ' ' . col . ' "' . fname . '" "' . b:tmpfname . '"'
+ endif
+ let res = system(cmd)
+ let lines = split(res, '\n')
+ let out = []
+ for line in lines
+ if line !~# '^MATCH'
+ continue
+ endif
+ let completion = split(line[6:], ',')[0]
+ if stridx(tolower(completion), tolower(a:base)) == 0
+ let out = add(out, completion)
+ endif
+ endfor
+ call delete(b:tmpfname)
+
+ return out
+endfunction
+
+function! racer#GoToDefinition()
+ if s:ErrorCheck()
+ return
+ endif
+
+ let col = col('.') - 1
+ let b:racer_col = col
+ let fname = expand('%:p')
+ let tmpfname = tempname()
+ call writefile(getline(1, '$'), tmpfname)
+ let cmd = g:racer_cmd . ' find-definition ' . line('.') . ' ' . col . ' ' . fname . ' ' . tmpfname
+ let res = system(cmd)
+ let lines = split(res, '\n')
+ for line in lines
+ if res =~# ' error: ' && line !=# 'END'
+ call s:Warn(line)
+ elseif line =~# '^MATCH'
+ let linenum = split(line[6:], ',')[1]
+ let colnum = split(line[6:], ',')[2]
+ let fname = split(line[6:], ',')[3]
+ call s:RacerJumpToLocation(fname, linenum, colnum)
+ break
+ endif
+ endfor
+ call delete(tmpfname)
+endfunction
+
+function! s:RacerGetBufferContents(base)
+ " Re-combine the completion base word from omnicomplete with the current
+ " line contents. Since the base word gets remove from the buffer before
+ " this function is invoked we have to put it back in to out tmpfile.
+ let col = col('.') - 1
+ let buf_lines = getline(1, '$')
+ let line_contents = getline('.')
+ let buf_lines[line('.') - 1] =
+ \ strpart(line_contents, 0, col) .
+ \ a:base .
+ \ strpart(line_contents, col, len(line_contents))
+ return buf_lines
+endfunction
+
+function! s:RacerJumpToLocation(filename, linenum, colnum)
+ if a:filename == ''
+ return
+ endif
+
+ " Record jump mark
+ normal! m`
+ if a:filename != bufname('%')
+ try
+ exec 'keepjumps e ' . fnameescape(a:filename)
+ catch /^Vim\%((\a\+)\)\=:E37/
+ " When the buffer is not saved, E37 is thrown. We can ignore it.
+ endtry
+ endif
+ call cursor(a:linenum, a:colnum + 1)
+ " Center definition on screen
+ normal! zz
+endfunction
+
+function! racer#RacerComplete(findstart, base)
+ if a:findstart
+ if s:ErrorCheck()
+ return -1
+ endif
+
+ return s:RacerGetPrefixCol(a:base)
+ else
+ if s:ErrorCheck()
+ return []
+ endif
+
+ if g:racer_experimental_completer == 1
+ return s:RacerGetExpCompletions(a:base)
+ else
+ return s:RacerGetCompletions(a:base)
+ endif
+ endif
+endfunction
+
+function! s:Warn(msg)
+ echohl WarningMsg | echomsg a:msg | echohl NONE
+endfunction
+
+function! s:ErrorCheck()
+ if !executable(g:racer_cmd)
+ call s:Warn('No racer executable found in $PATH (' . $PATH . ')')
+ return 1
+ endif
+endfunction
diff --git a/vim/bundle/vim-racer/ftplugin/rust_racer.vim b/vim/bundle/vim-racer/ftplugin/rust_racer.vim
new file mode 100644
index 0000000..a76fc3b
--- /dev/null
+++ b/vim/bundle/vim-racer/ftplugin/rust_racer.vim
@@ -0,0 +1,44 @@
+let s:save_cpo = &cpo
+set cpo&vim
+
+let s:is_win = has('win32') || has('win64')
+
+if !exists('g:racer_cmd')
+ let s:sep = s:is_win ? '\' : '/'
+ let s:path = join([
+ \ escape(expand('<sfile>:p:h'), '\'),
+ \ '..',
+ \ 'target',
+ \ 'release',
+ \ ], s:sep)
+ if isdirectory(s:path)
+ let s:pathsep = s:is_win ? ';' : ':'
+ let $PATH .= s:pathsep . s:path
+ endif
+ let g:racer_cmd = 'racer'
+endif
+
+" Expand '~' and environment variables
+let g:racer_cmd = expand(g:racer_cmd)
+
+if !exists('g:racer_experimental_completer')
+ let g:racer_experimental_completer = 0
+endif
+
+if !exists('g:racer_insert_paren')
+ let g:racer_insert_paren = 1
+endif
+
+nnoremap <silent><buffer> <Plug>(rust-def)
+ \ :call racer#GoToDefinition()<CR>
+nnoremap <silent><buffer> <Plug>(rust-def-split)
+ \ :split<CR>:call racer#GoToDefinition()<CR>
+nnoremap <silent><buffer> <Plug>(rust-def-vertical)
+ \ :vsplit<CR>:call racer#GoToDefinition()<CR>
+nnoremap <silent><buffer> <Plug>(rust-doc)
+ \ :call racer#ShowDocumentation()<CR>
+
+setlocal omnifunc=racer#RacerComplete
+
+let &cpo = s:save_cpo
+unlet s:save_cpo
diff --git a/vim/bundle/vim-racer/rplugin/python3/deoplete/sources/racer.py b/vim/bundle/vim-racer/rplugin/python3/deoplete/sources/racer.py
new file mode 100644
index 0000000..f041530
--- /dev/null
+++ b/vim/bundle/vim-racer/rplugin/python3/deoplete/sources/racer.py
@@ -0,0 +1,111 @@
+#=============================================================================
+# FILE: racer.py
+# AUTHOR: Shougo Matsushita <Shougo.Matsu at gmail.com>
+# License: MIT license {{{
+# Permission is hereby granted, free of charge, to any person obtaining
+# a copy of this software and associated documentation files (the
+# "Software"), to deal in the Software without restriction, including
+# without limitation the rights to use, copy, modify, merge, publish,
+# distribute, sublicense, and/or sell copies of the Software, and to
+# permit persons to whom the Software is furnished to do so, subject to
+# the following conditions:
+#
+# The above copyright notice and this permission notice shall be included
+# in all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+# }}}
+#=============================================================================
+
+import re
+import os
+import subprocess
+import tempfile
+from .base import Base
+
+class Source(Base):
+ def __init__(self, vim):
+ Base.__init__(self, vim)
+
+ self.name = 'racer'
+ self.mark = '[racer]'
+ self.filetypes = ['rust']
+ self.input_pattern = r'(\.|::)\w*'
+ self.rank = 500
+
+ def on_init(self, context):
+ self.__executable_racer = self.vim.funcs.executable(
+ self.vim.eval('g:racer_cmd'))
+ self.__racer = self.vim.eval('g:racer_cmd')
+
+ def get_complete_position(self, context):
+ if not self.__executable_racer:
+ return -1
+
+ m = re.search('\w*$', context['input'])
+ return m.start() if m else -1
+
+
+ def gather_candidates(self, context):
+ typeMap = {
+ 'Struct': 's', 'Module': 'M', 'Function': 'f',
+ 'Crate': 'C', 'Let': 'v', 'StructField': 'm',
+ 'Impl': 'i', 'Enum': 'e', 'EnumVariant': 'E',
+ 'Type': 't', 'FnArg': 'v', 'Trait': 'T',
+ 'Const': 'c'
+ }
+
+ candidates = []
+ insert_paren = int(self.vim.eval('g:racer_insert_paren'))
+ for line in [l[6:] for l
+ in self.get_results(context, 'complete',
+ context['complete_position'] + 1)
+ if l.startswith('MATCH')]:
+ completions = line.split(',')
+ kind = typeMap.get(completions[4], '')
+ completion = { 'kind': kind, 'word': completions[0], 'dup': 1 }
+ if kind == 'f': # function
+ completion['menu'] = ','.join(completions[5:]).replace(
+ 'pub ', '').replace('fn ', '').rstrip('{')
+ if ' where ' in completion['menu'] or completion[
+ 'menu'].endswith(' where') :
+ where = completion['menu'].rindex(' where')
+ completion['menu'] = completion['menu'][: where]
+ if insert_paren:
+ completion['abbr'] = completions[0]
+ completion['word'] += '('
+ elif kind == 's' : # struct
+ completion['menu'] = ','.join(completions[5:]).replace(
+ 'pub ', '').replace( 'struct ', '').rstrip('{')
+ candidates.append(completion)
+ return candidates
+
+ def get_results(self, context, command, col):
+ with tempfile.NamedTemporaryFile(mode='w') as tf:
+ tf.write("\n".join(self.vim.current.buffer))
+ tf.flush()
+
+ args = [
+ self.__racer, command,
+ str(self.vim.funcs.line('.')),
+ str(col - 1),
+ tf.name
+ ] if command == 'prefix' else [
+ self.__racer, command,
+ str(self.vim.funcs.line('.')),
+ str(col - 1),
+ self.vim.current.buffer.name,
+ tf.name
+ ]
+ try:
+ results = subprocess.check_output(args).decode(
+ context['encoding']).splitlines()
+ except subprocess.CalledProcessError:
+ return []
+ return results
diff --git a/vim/bundle/vim-racer/syntax/rustdoc.vim b/vim/bundle/vim-racer/syntax/rustdoc.vim
new file mode 100644
index 0000000..d527c9b
--- /dev/null
+++ b/vim/bundle/vim-racer/syntax/rustdoc.vim
@@ -0,0 +1,178 @@
+" Vim syntax file
+" Language: Rust Documentation (Markdown)
+" Maintainer: Esteban Kuber <esteban@kuber.com.ar>
+" Remark: Uses HTML and Rust syntax files.
+" Based off plasticboy's Markdown Vim Mode:
+" https://github.com/plasticboy/vim-markdown.
+" TODO: Handle stuff contained within stuff (e.g. headings within blockquotes)
+
+
+" Read the HTML syntax to start with
+if version < 600
+ so <sfile>:p:h/html.vim
+else
+ runtime! syntax/html.vim
+
+ if exists('b:current_syntax')
+ unlet b:current_syntax
+ endif
+endif
+
+if version < 600
+ syntax clear
+elseif exists("b:current_syntax")
+ finish
+endif
+
+" don't use standard HiLink, it will not work with included syntax files
+if version < 508
+ command! -nargs=+ HtmlHiLink hi link <args>
+else
+ command! -nargs=+ HtmlHiLink hi def link <args>
+endif
+
+syn spell toplevel
+syn case ignore
+syn sync linebreaks=1
+
+let s:conceal = ''
+let s:concealends = ''
+if has('conceal') && get(g:, 'vim_markdown_conceal', 1)
+ let s:conceal = ' conceal'
+ let s:concealends = ' concealends'
+endif
+
+" additions to HTML groups
+if get(g:, 'vim_markdown_emphasis_multiline', 1)
+ let s:oneline = ''
+else
+ let s:oneline = ' oneline'
+endif
+execute 'syn region htmlItalic start="\%(^\|\s\)\zs\*\ze[^\\\*\t ]\%(\%([^*]\|\\\*\|\n\)*[^\\\*\t ]\)\?\*\_W" end="[^\\\*\t ]\zs\*\ze\_W" keepend' . s:oneline
+execute 'syn region htmlItalic start="\%(^\|\s\)\zs_\ze[^\\_\t ]" end="[^\\_\t ]\zs_\ze\_W" keepend' . s:oneline
+execute 'syn region htmlBold start="\%(^\|\s\)\*\*\ze\S" end="\S\zs\*\*" keepend' . s:oneline
+execute 'syn region htmlBold start="\%(^\|\s\)\zs__\ze\S" end="\S\zs__" keepend' . s:oneline
+execute 'syn region htmlBoldItalic start="\%(^\|\s\)\zs\*\*\*\ze\S" end="\S\zs\*\*\*" keepend' . s:oneline
+execute 'syn region htmlBoldItalic start="\%(^\|\s\)\zs___\ze\S" end="\S\zs___" keepend' . s:oneline
+
+" [link](URL) | [link][id] | [link][] | ![image](URL)
+syn region mkdFootnotes matchgroup=mkdDelimiter start="\[^" end="\]"
+execute 'syn region mkdID matchgroup=mkdDelimiter start="\[" end="\]" contained oneline' . s:conceal
+execute 'syn region mkdURL matchgroup=mkdDelimiter start="(" end=")" contained oneline' . s:conceal
+execute 'syn region mkdLink matchgroup=mkdDelimiter start="\\\@<!!\?\[" end="\n\{-,1}[^]]\{-}\zs\]\ze[[(]" contains=@mkdNonListItem,@Spell nextgroup=mkdURL,mkdID skipwhite oneline' . s:concealends
+
+" Autolink without angle brackets.
+" mkd inline links: protocol optional user:pass@ sub/domain .com, .co.uk, etc optional port path/querystring/hash fragment
+" ------------ _____________________ ----------------------------- _________________________ ----------------- __
+syn match mkdInlineURL /https\?:\/\/\(\w\+\(:\w\+\)\?@\)\?\([A-Za-z0-9][-_0-9A-Za-z]*\.\)\{1,}\(\w\{2,}\.\?\)\{1,}\(:[0-9]\{1,5}\)\?\S*/
+
+" Autolink with parenthesis.
+syn region mkdInlineURL matchgroup=mkdDelimiter start="(\(https\?:\/\/\(\w\+\(:\w\+\)\?@\)\?\([A-Za-z0-9][-_0-9A-Za-z]*\.\)\{1,}\(\w\{2,}\.\?\)\{1,}\(:[0-9]\{1,5}\)\?\S*)\)\@=" end=")"
+
+" Autolink with angle brackets.
+syn region mkdInlineURL matchgroup=mkdDelimiter start="\\\@<!<\ze[a-z][a-z0-9,.-]\{1,22}:\/\/[^> ]*>" end=">"
+
+" Link definitions: [id]: URL (Optional Title)
+syn region mkdLinkDef matchgroup=mkdDelimiter start="^ \{,3}\zs\[" end="]:" oneline nextgroup=mkdLinkDefTarget skipwhite
+syn region mkdLinkDefTarget start="<\?\zs\S" excludenl end="\ze[>[:space:]\n]" contained nextgroup=mkdLinkTitle,mkdLinkDef skipwhite skipnl oneline
+syn region mkdLinkTitle matchgroup=mkdDelimiter start=+"+ end=+"+ contained
+syn region mkdLinkTitle matchgroup=mkdDelimiter start=+'+ end=+'+ contained
+syn region mkdLinkTitle matchgroup=mkdDelimiter start=+(+ end=+)+ contained
+
+"HTML headings
+syn region htmlH1 start="^\s*#" end="$" contains=@Spell
+syn region htmlH2 start="^\s*##" end="$" contains=@Spell
+syn region htmlH3 start="^\s*###" end="$" contains=@Spell
+syn region htmlH4 start="^\s*####" end="$" contains=@Spell
+syn region htmlH5 start="^\s*#####" end="$" contains=@Spell
+syn region htmlH6 start="^\s*######" end="$" contains=@Spell
+syn match htmlH1 /^.\+\n=\+$/ contains=@Spell
+syn match htmlH2 /^.\+\n-\+$/ contains=@Spell
+
+"define Markdown groups
+syn match mkdLineBreak / \+$/
+syn region mkdBlockquote start=/^\s*>/ end=/$/ contains=mkdLineBreak,@Spell
+syn region mkdCode start=/\(\([^\\]\|^\)\\\)\@<!`/ end=/\(\([^\\]\|^\)\\\)\@<!`/
+syn region mkdCode start=/\s*``[^`]*/ end=/[^`]*``\s*/
+syn region mkdCode start=/^\s*\z(`\{3,}\)[^`]*$/ end=/^\s*\z1`*\s*$/
+syn region mkdCode start=/\s*\~\~[^\~]*/ end=/[^\~]*\~\~\s*/
+syn region mkdCode start=/^\s*\z(\~\{3,}\)\s*[0-9A-Za-z_+-]*\s*$/ end=/^\s*\z1\~*\s*$/
+syn region mkdCode start="<pre[^>]*\\\@<!>" end="</pre>"
+syn region mkdCode start="<code[^>]*\\\@<!>" end="</code>"
+syn region mkdFootnote start="\[^" end="\]"
+syn match mkdCode /^\s*\n\(\(\s\{8,}[^ ]\|\t\t\+[^\t]\).*\n\)\+/
+syn match mkdCode /\%^\(\(\s\{4,}[^ ]\|\t\+[^\t]\).*\n\)\+/
+syn match mkdCode /^\s*\n\(\(\s\{4,}[^ ]\|\t\+[^\t]\).*\n\)\+/ contained
+syn match mkdListItem /^\s*\%([-*+]\|\d\+\.\)\s\+/ contained
+syn region mkdListItemLine start="^\s*\%([-*+]\|\d\+\.\)\s\+" end="$" oneline contains=@mkdNonListItem,mkdListItem,@Spell
+syn region mkdNonListItemBlock start="\(\%^\(\s*\([-*+]\|\d\+\.\)\s\+\)\@!\|\n\(\_^\_$\|\s\{4,}[^ ]\|\t+[^\t]\)\@!\)" end="^\(\s*\([-*+]\|\d\+\.\)\s\+\)\@=" contains=@mkdNonListItem,@Spell
+syn match mkdRule /^\s*\*\s\{0,1}\*\s\{0,1}\*$/
+syn match mkdRule /^\s*-\s\{0,1}-\s\{0,1}-$/
+syn match mkdRule /^\s*_\s\{0,1}_\s\{0,1}_$/
+syn match mkdRule /^\s*-\{3,}$/
+syn match mkdRule /^\s*\*\{3,5}$/
+
+" YAML frontmatter
+if get(g:, 'vim_markdown_frontmatter', 0)
+ syn include @yamlTop syntax/yaml.vim
+ syn region Comment matchgroup=mkdDelimiter start="\%^---$" end="^---$" contains=@yamlTop keepend
+ unlet! b:current_syntax
+endif
+
+if get(g:, 'vim_markdown_toml_frontmatter', 0)
+ try
+ syn include @tomlTop syntax/toml.vim
+ syn region Comment matchgroup=mkdDelimiter start="\%^+++$" end="^+++$" transparent contains=@tomlTop keepend
+ unlet! b:current_syntax
+ catch /E484/
+ syn region Comment matchgroup=mkdDelimiter start="\%^+++$" end="^+++$"
+ endtry
+endif
+
+if get(g:, 'vim_markdown_json_frontmatter', 0)
+ try
+ syn include @jsonTop syntax/json.vim
+ syn region Comment matchgroup=mkdDelimiter start="\%^{$" end="^}$" contains=@jsonTop keepend
+ unlet! b:current_syntax
+ catch /E484/
+ syn region Comment matchgroup=mkdDelimiter start="\%^{$" end="^}$"
+ endtry
+endif
+
+if get(g:, 'vim_markdown_math', 0)
+ syn include @tex syntax/tex.vim
+ syn region mkdMath start="\\\@<!\$" end="\$" contains=@tex keepend
+ syn region mkdMath start="\\\@<!\$\$" end="\$\$" contains=@tex keepend
+endif
+
+syn include @rust syntax/rust.vim
+syn region mkdRust start="\`\`\`$" end="\`\`\`$" contains=@rust keepend
+syn region mkdRust start="\`\`\`rust" end="\`\`\`$" contains=@rust keepend
+syn region mkdRust start="\`\`\`no_run" end="\`\`\`$" contains=@rust keepend
+
+syn cluster mkdNonListItem contains=@htmlTop,htmlItalic,htmlBold,htmlBoldItalic,mkdFootnotes,mkdInlineURL,mkdLink,mkdLinkDef,mkdLineBreak,mkdBlockquote,mkdCode,mkdRule,htmlH1,htmlH2,htmlH3,htmlH4,htmlH5,htmlH6,mkdMath,mkdRust
+
+"highlighting for Markdown groups
+HtmlHiLink mkdString String
+HtmlHiLink mkdCode String
+HtmlHiLink mkdCodeStart String
+HtmlHiLink mkdCodeEnd String
+HtmlHiLink mkdFootnote Comment
+HtmlHiLink mkdBlockquote Comment
+HtmlHiLink mkdListItem Identifier
+HtmlHiLink mkdRule Identifier
+HtmlHiLink mkdLineBreak Visual
+HtmlHiLink mkdFootnotes htmlLink
+HtmlHiLink mkdLink htmlLink
+HtmlHiLink mkdURL htmlString
+HtmlHiLink mkdInlineURL htmlLink
+HtmlHiLink mkdID Identifier
+HtmlHiLink mkdLinkDef mkdID
+HtmlHiLink mkdLinkDefTarget mkdURL
+HtmlHiLink mkdLinkTitle htmlString
+HtmlHiLink mkdDelimiter Delimiter
+
+let b:current_syntax = "mkd"
+
+delcommand HtmlHiLink
+" vim: ts=2
diff --git a/vim/colors/apprentice.vim b/vim/colors/apprentice.vim
index bc864e9..8d144a2 100644
--- a/vim/colors/apprentice.vim
+++ b/vim/colors/apprentice.vim
@@ -35,7 +35,7 @@ endif
let colors_name = "apprentice"
if ($TERM =~ '256' || &t_Co >= 256) || has("gui_running")
- hi Normal ctermbg=NONE ctermfg=250 guibg=#262626 guifg=#bcbcbc cterm=NONE gui=NONE
+ hi Normal ctermbg=NONE ctermfg=250 guibg=#000000 guifg=#bcbcbc cterm=NONE gui=NONE
hi LineNr ctermbg=234 ctermfg=242 guibg=#1c1c1c guifg=#6c6c6c cterm=NONE gui=NONE
hi FoldColumn ctermbg=234 ctermfg=242 guibg=#1c1c1c guifg=#6c6c6c cterm=NONE gui=NONE
hi Folded ctermbg=234 ctermfg=242 guibg=#1c1c1c guifg=#6c6c6c cterm=NONE gui=NONE
diff --git a/vim/ftplugin/rust.vim b/vim/ftplugin/rust.vim
new file mode 100644
index 0000000..8bdfbe5
--- /dev/null
+++ b/vim/ftplugin/rust.vim
@@ -0,0 +1,12 @@
+""
+" Rust config
+" TODO: Move to ftplugin
+"
+au FileType rust nmap <C-]> <Plug>(rust-def)
+au FileType rust nmap g<C-]> <Plug>(rust-def-split)
+au FileType rust nmap g<S-C-]> <Plug>(rust-def-vertical)
+au FileType rust nmap K <Plug>(rust-doc)
+au FileType rust compiler cargo
+au FileType rust set formatprg=rustfmt
+"
+
diff --git a/vim/gvimrc b/vim/gvimrc
new file mode 100644
index 0000000..7b4b7b9
--- /dev/null
+++ b/vim/gvimrc
@@ -0,0 +1,2 @@
+set guioptions-=m guioptions-=T guioptions-=r guioptions-=R guioptions-=l guioptions-=L guioptions-=b
+set guiheadroom=0
diff --git a/vim/main.vim b/vim/main.vim
index 48bcd14..1c67e35 100644
--- a/vim/main.vim
+++ b/vim/main.vim
@@ -1,20 +1,13 @@
-""
+"" {{{ Directory structure and plugin loading
" Configuration for my config organization
-"
set directory=$XDG_CONFIG_HOME/vim,~/,/tmp
set backupdir=$XDG_CACHE_HOME/vim,~/,/tmp
set viminfo+=n$XDG_CACHE_HOME/vim/viminfo
-set runtimepath=$XDG_CONFIG_HOME/vim,$XDG_CONFIG_HOME/vim/after,$VIM,$VIMRUNTIME
+set runtimepath=$XDG_CONFIG_HOME/vim,$XDG_CONFIG_HOME/vim/after,$VIM,$VIMRUNTIME,/usr/share/vim/vimfiles
let $MYVIMRC="$XDG_CONFIG_HOME/vim/main.vim"
-""
" Auto-load plugins from $VIMRUNTIME/bundle
-"execute pathogen#infect()
-
-""
-" General mappings and stuff
-let mapleader = "-"
-""
+execute pathogen#infect()
" Apply filetype-based indent rules and plugins
filetype plugin indent on
@@ -26,7 +19,6 @@ runtime! defaults.vim
" I like reading manpages in vim.
runtime! ftplugin/man.vim
-""
" Load the matchit plugin (shipped with vim) for jumping to matching #ifs and
" #endifs and so on.
" Requires vim 8 for :packadd
@@ -35,22 +27,54 @@ packadd! matchit
" romainl's apprentice colorscheme, with a few changes for higher contrast
colorscheme apprentice
-""
-" Settings!
-"
-set expandtab " <tab> expans to spaces
-set shiftwidth=4 " 4 spaces for autoindent
-set softtabstop=4 " <tab> inserts 4 spaces at a time
-set autowrite " write before swapping buffers
-set number " regular line numbers
-set ttyfast " xterms and linux consoles are fast
-set ttymouse=sgr " for mouse events in columns >233
-set clipboard=unnamed " default to the * register to share with X11
-set undolevels=100000 " don't discard my undo tree
-set undofile " persistent undo tree
-"
+"" }}}
+"" {{{ Settings
+set expandtab " <tab> expans to spaces
+set shiftwidth=4 " 4 spaces for autoindent
+set softtabstop=4 " <tab> inserts 4 spaces at a time
+set autowrite " write before swapping buffers
+set number " regular line numbers
+set ttyfast " xterms and linux consoles are fast
+set ttymouse=sgr " for mouse events in columns >233
+set clipboard=unnamed " default to the * register to share with X11
+set undolevels=100000 " don't discard my undo tree
+set undofile " persistent undo tree
+set completeopt=menuone,noinsert " enter the completion popup, don't insert
+set cscopequickfix=g-,s- " use quickfix for cscope results
+set smartcase ignorecase " smartly ignore case in /search
+set lazyredraw " don't redraw like crazy during macros
+set browsedir=buffer " :browse the current buffer's directory
+" TODO: set cinoptions=:0 " for C, don't indent case statements
+set list " turn on list mode to show invisible chars
+set listchars=trail:-,tab:>- " limit list to trailing whitespace and tabs
+"" }}}
+"" {{{ Autocmds
+" :make hooks to display the quickfix window automatically
+autocmd QuickFixCmdPost [^l]* nested botright cwindow
+"" }}}
+"" {{{ Keybindings
+let mapleader = "-"
+
+" Directional split navigation
+nmap <c-j> <c-w>j
+nmap <c-k> <c-w>k
+nmap <c-h> <c-w>h
+nmap <c-l> <c-w>l
+
+" Close
+nmap <c-x> :bdel<cr>
-""
+" Quickfix and location list navigation
+nmap ]q :cnext<cr>
+nmap [q :cprev<cr>
+nmap ]Q :clast<cr>
+nmap [Q :cfirst<cr>
+nmap ]l :lnext<cr>
+nmap [l :lprev<cr>
+nmap ]L :llast<cr>
+nmap [L :lfirst<cr>
+"" }}}
+"" {{{ Functions
" PASTEBIN with pbpst
"
" Mappings:
@@ -97,4 +121,9 @@ endfunction
nnoremap <leader>p :silent set opfunc=Paste<cr>g@
nnoremap <leader>pp :call Paste('%')<CR>
vnoremap <leader>p <esc>:call Paste(visualmode())<CR>
-""
+"" }}}
+"" {{{ etc
+" Slimv configuration for tmux
+let g:slimv_browser_cmd = 'tmux split-window -h w3m'
+"" }}}
+" vim:foldmethod=marker:foldlevel=0
diff --git a/vim/vim-surround/.gitignore b/vim/vim-surround/.gitignore
new file mode 100644
index 0000000..0a56e3f
--- /dev/null
+++ b/vim/vim-surround/.gitignore
@@ -0,0 +1 @@
+/doc/tags
diff --git a/vim/vim-surround/README.markdown b/vim/vim-surround/README.markdown
new file mode 100644
index 0000000..fef61a8
--- /dev/null
+++ b/vim/vim-surround/README.markdown
@@ -0,0 +1,97 @@
+surround.vim
+============
+
+Surround.vim is all about "surroundings": parentheses, brackets, quotes,
+XML tags, and more. The plugin provides mappings to easily delete,
+change and add such surroundings in pairs.
+
+It's easiest to explain with examples. Press `cs"'` inside
+
+ "Hello world!"
+
+to change it to
+
+ 'Hello world!'
+
+Now press `cs'<q>` to change it to
+
+ <q>Hello world!</q>
+
+To go full circle, press `cst"` to get
+
+ "Hello world!"
+
+To remove the delimiters entirely, press `ds"`.
+
+ Hello world!
+
+Now with the cursor on "Hello", press `ysiw]` (`iw` is a text object).
+
+ [Hello] world!
+
+Let's make that braces and add some space (use `}` instead of `{` for no
+space): `cs]{`
+
+ { Hello } world!
+
+Now wrap the entire line in parentheses with `yssb` or `yss)`.
+
+ ({ Hello } world!)
+
+Revert to the original text: `ds{ds)`
+
+ Hello world!
+
+Emphasize hello: `ysiw<em>`
+
+ <em>Hello</em> world!
+
+Finally, let's try out visual mode. Press a capital V (for linewise
+visual mode) followed by `S<p class="important">`.
+
+ <p class="important">
+ <em>Hello</em> world!
+ </p>
+
+This plugin is very powerful for HTML and XML editing, a niche which
+currently seems underfilled in Vim land. (As opposed to HTML/XML
+*inserting*, for which many plugins are available). Adding, changing,
+and removing pairs of tags simultaneously is a breeze.
+
+The `.` command will work with `ds`, `cs`, and `yss` if you install
+[repeat.vim](https://github.com/tpope/vim-repeat).
+
+Installation
+------------
+
+If you don't have a preferred installation method, I recommend
+installing [pathogen.vim](https://github.com/tpope/vim-pathogen), and
+then simply copy and paste:
+
+ cd ~/.vim/bundle
+ git clone git://github.com/tpope/vim-surround.git
+
+Once help tags have been generated, you can view the manual with
+`:help surround`.
+
+Contributing
+------------
+
+See the contribution guidelines for
+[pathogen.vim](https://github.com/tpope/vim-pathogen#readme).
+
+Self-Promotion
+--------------
+
+Like surround.vim? Follow the repository on
+[GitHub](https://github.com/tpope/vim-surround) and vote for it on
+[vim.org](http://www.vim.org/scripts/script.php?script_id=1697). And if
+you're feeling especially charitable, follow [tpope](http://tpo.pe/) on
+[Twitter](http://twitter.com/tpope) and
+[GitHub](https://github.com/tpope).
+
+License
+-------
+
+Copyright (c) Tim Pope. Distributed under the same terms as Vim itself.
+See `:help license`.
diff --git a/vim/vim-surround/doc/surround.txt b/vim/vim-surround/doc/surround.txt
new file mode 100644
index 0000000..674b6a9
--- /dev/null
+++ b/vim/vim-surround/doc/surround.txt
@@ -0,0 +1,207 @@
+*surround.txt* Plugin for deleting, changing, and adding "surroundings"
+
+Author: Tim Pope <http://tpo.pe/>
+License: Same terms as Vim itself (see |license|)
+
+This plugin is only available if 'compatible' is not set.
+
+INTRODUCTION *surround*
+
+This plugin is a tool for dealing with pairs of "surroundings." Examples
+of surroundings include parentheses, quotes, and HTML tags. They are
+closely related to what Vim refers to as |text-objects|. Provided
+are mappings to allow for removing, changing, and adding surroundings.
+
+Details follow on the exact semantics, but first, consider the following
+examples. An asterisk (*) is used to denote the cursor position.
+
+ Old text Command New text ~
+ "Hello *world!" ds" Hello world!
+ [123+4*56]/2 cs]) (123+456)/2
+ "Look ma, I'm *HTML!" cs"<q> <q>Look ma, I'm HTML!</q>
+ if *x>3 { ysW( if ( x>3 ) {
+ my $str = *whee!; vllllS' my $str = 'whee!';
+
+While a few features of this plugin will work in older versions of Vim,
+Vim 7 is recommended for full functionality.
+
+MAPPINGS *surround-mappings*
+
+Delete surroundings is *ds* . The next character given determines the target
+to delete. The exact nature of the target is explained in |surround-targets|
+but essentially it is the last character of a |text-object|. This mapping
+deletes the difference between the "i"nner object and "a"n object. This is
+easiest to understand with some examples:
+
+ Old text Command New text ~
+ "Hello *world!" ds" Hello world!
+ (123+4*56)/2 ds) 123+456/2
+ <div>Yo!*</div> dst Yo!
+
+Change surroundings is *cs* . It takes two arguments, a target like with
+|ds|, and a replacement. *cS* changes surroundings, placing the surrounded
+text on its own line(s) like |yS|. Details about the second argument can be
+found below in |surround-replacements|. Once again, examples are in order.
+
+ Old text Command New text ~
+ "Hello *world!" cs"' 'Hello world!'
+ "Hello *world!" cs"<q> <q>Hello world!</q>
+ (123+4*56)/2 cs)] [123+456]/2
+ (123+4*56)/2 cs)[ [ 123+456 ]/2
+ <div>Yo!*</div> cst<p> <p>Yo!</p>
+
+*ys* takes a valid Vim motion or text object as the first object, and wraps
+it using the second argument as with |cs|. (It's a stretch, but a good
+mnemonic for "ys" is "you surround".)
+
+ Old text Command New text ~
+ Hello w*orld! ysiw) Hello (world)!
+
+As a special case, *yss* operates on the current line, ignoring leading
+whitespace.
+
+ Old text Command New text ~
+ Hello w*orld! yssB {Hello world!}
+
+There is also *yS* and *ySS* which indent the surrounded text and place it
+on a line of its own.
+
+In visual mode, a simple "S" with an argument wraps the selection. This is
+referred to as the *vS* mapping, although ordinarily there will be
+additional keystrokes between the v and S. In linewise visual mode, the
+surroundings are placed on separate lines and indented. In blockwise visual
+mode, each line is surrounded.
+
+A "gS" in visual mode, known as *vgS* , behaves similarly. In linewise visual
+mode, the automatic indenting is suppressed. In blockwise visual mode, this
+enables surrounding past the end of the line with 'virtualedit' set (there
+seems to be no way in Vim Script to differentiate between a jagged end of line
+selection and a virtual block selected past the end of the line, so two maps
+were needed).
+
+ *i_CTRL-G_s* *i_CTRL-G_S*
+Finally, there is an experimental insert mode mapping on <C-G>s and <C-S>.
+Beware that the latter won't work on terminals with flow control (if you
+accidentally freeze your terminal, use <C-Q> to unfreeze it). The mapping
+inserts the specified surroundings and puts the cursor between them. If,
+immediately after the mapping and before the replacement, a second <C-S> or
+carriage return is pressed, the prefix, cursor, and suffix will be placed on
+three separate lines. <C-G>S (not <C-G>s) also exhibits this behavior.
+
+TARGETS *surround-targets*
+
+The |ds| and |cs| commands both take a target as their first argument. The
+possible targets are based closely on the |text-objects| provided by Vim.
+All targets are currently just one character.
+
+Eight punctuation marks, (, ), {, }, [, ], <, and >, represent themselves
+and their counterparts. If the opening mark is used, contained whitespace is
+also trimmed. The targets b, B, r, and a are aliases for ), }, ], and >
+(the first two mirror Vim; the second two are completely arbitrary and
+subject to change).
+
+Three quote marks, ', ", `, represent themselves, in pairs. They are only
+searched for on the current line.
+
+A t is a pair of HTML or XML tags. See |tag-blocks| for details. Remember
+that you can specify a numerical argument if you want to get to a tag other
+than the innermost one.
+
+The letters w, W, and s correspond to a |word|, a |WORD|, and a |sentence|,
+respectively. These are special in that they have nothing to delete, and
+used with |ds| they are a no-op. With |cs|, one could consider them a
+slight shortcut for ysi (cswb == ysiwb, more or less).
+
+A p represents a |paragraph|. This behaves similarly to w, W, and s above;
+however, newlines are sometimes added and/or removed.
+
+REPLACEMENTS *surround-replacements*
+
+A replacement argument is a single character, and is required by |cs|, |ys|,
+and |vS|. Undefined replacement characters (with the exception of alphabetic
+characters) default to placing themselves at the beginning and end of the
+destination, which can be useful for characters like / and |.
+
+If either ), }, ], or > is used, the text is wrapped in the appropriate pair
+of characters. Similar behavior can be found with (, {, and [ (but not <),
+which append an additional space to the inside. Like with the targets above,
+b, B, r, and a are aliases for ), }, ], and >. To fulfill the common need for
+code blocks in C-style languages, <C-}> (which is really <C-]>) adds braces on
+lines separate from the content.
+
+If t or < is used, Vim prompts for an HTML/XML tag to insert. You may specify
+attributes here and they will be stripped from the closing tag. If replacing a
+tag, its attributes are kept in the new tag. End your input with > to discard
+the those attributes. If <C-T> is used, the tags will appear on lines by
+themselves.
+
+If s is used, a leading but not trailing space is added. This is useful for
+removing parentheses from a function call with csbs.
+
+CUSTOMIZING *surround-customizing*
+
+The following adds a potential replacement on "-" (ASCII 45) in PHP files.
+(To determine the ASCII code to use, :echo char2nr("-")). The carriage
+return will be replaced by the original text.
+>
+ autocmd FileType php let b:surround_45 = "<?php \r ?>"
+<
+This can be used in a PHP file as in the following example.
+
+ Old text Command New text ~
+ print "Hello *world!" yss- <?php print "Hello world!" ?>
+
+Additionally, one can use a global variable for globally available
+replacements.
+>
+ let g:surround_45 = "<% \r %>"
+ let g:surround_61 = "<%= \r %>"
+<
+Advanced, experimental, and subject to change: One can also prompt for
+replacement text. The syntax for this is to surround the replacement in pairs
+of low numbered control characters. If this sounds confusing, that's because
+it is (but it makes the parsing easy). Consider the following example for a
+LaTeX environment on the "l" replacement.
+>
+ let g:surround_108 = "\\begin{\1environment: \1}\r\\end{\1\1}"
+<
+When this replacement is used, the user is prompted with an "environment: "
+prompt for input. This input is inserted between each set of \1's.
+Additional inputs up to \7 can be used.
+
+Furthermore, one can specify a regular expression substitution to apply.
+>
+ let g:surround_108 = "\\begin{\1environment: \1}\r\\end{\1\r}.*\r\1}"
+<
+This will remove anything after the first } in the input when the text is
+placed within the \end{} slot. The first \r marks where the pattern begins,
+and the second where the replacement text begins.
+
+Here's a second example for creating an HTML <div>. The substitution cleverly
+prompts for an id, but only adds id="" if it is non-blank. You may have to
+read this one a few times slowly before you understand it.
+>
+ let g:surround_{char2nr("d")} = "<div\1id: \r..*\r id=\"&\"\1>\r</div>"
+<
+Inputting text replacements is a proof of concept at this point. The ugly,
+unintuitive interface and the brevity of the documentation reflect this.
+
+Finally, It is possible to always append a string to surroundings in insert
+mode (and only insert mode). This is useful with certain plugins and mappings
+that allow you to jump to such markings.
+>
+ let g:surround_insert_tail = "<++>"
+<
+ISSUES *surround-issues*
+
+Vim could potentially get confused when deleting/changing occurs at the very
+end of the line. Please report any repeatable instances of this.
+
+Do we need to use |inputsave()|/|inputrestore()| with the tag replacement?
+
+Indenting is handled haphazardly. Need to decide the most appropriate
+behavior and implement it. Right now one can do :let b:surround_indent = 1
+(or the global equivalent) to enable automatic re-indenting by Vim via |=|;
+should this be the default?
+
+ vim:tw=78:ts=8:ft=help:norl:
diff --git a/vim/vim-surround/plugin/surround.vim b/vim/vim-surround/plugin/surround.vim
new file mode 100644
index 0000000..46f3252
--- /dev/null
+++ b/vim/vim-surround/plugin/surround.vim
@@ -0,0 +1,598 @@
+" surround.vim - Surroundings
+" Author: Tim Pope <http://tpo.pe/>
+" Version: 2.1
+" GetLatestVimScripts: 1697 1 :AutoInstall: surround.vim
+
+if exists("g:loaded_surround") || &cp || v:version < 700
+ finish
+endif
+let g:loaded_surround = 1
+
+" Input functions {{{1
+
+function! s:getchar()
+ let c = getchar()
+ if c =~ '^\d\+$'
+ let c = nr2char(c)
+ endif
+ return c
+endfunction
+
+function! s:inputtarget()
+ let c = s:getchar()
+ while c =~ '^\d\+$'
+ let c .= s:getchar()
+ endwhile
+ if c == " "
+ let c .= s:getchar()
+ endif
+ if c =~ "\<Esc>\|\<C-C>\|\0"
+ return ""
+ else
+ return c
+ endif
+endfunction
+
+function! s:inputreplacement()
+ let c = s:getchar()
+ if c == " "
+ let c .= s:getchar()
+ endif
+ if c =~ "\<Esc>" || c =~ "\<C-C>"
+ return ""
+ else
+ return c
+ endif
+endfunction
+
+function! s:beep()
+ exe "norm! \<Esc>"
+ return ""
+endfunction
+
+function! s:redraw()
+ redraw
+ return ""
+endfunction
+
+" }}}1
+
+" Wrapping functions {{{1
+
+function! s:extractbefore(str)
+ if a:str =~ '\r'
+ return matchstr(a:str,'.*\ze\r')
+ else
+ return matchstr(a:str,'.*\ze\n')
+ endif
+endfunction
+
+function! s:extractafter(str)
+ if a:str =~ '\r'
+ return matchstr(a:str,'\r\zs.*')
+ else
+ return matchstr(a:str,'\n\zs.*')
+ endif
+endfunction
+
+function! s:fixindent(str,spc)
+ let str = substitute(a:str,'\t',repeat(' ',&sw),'g')
+ let spc = substitute(a:spc,'\t',repeat(' ',&sw),'g')
+ let str = substitute(str,'\(\n\|\%^\).\@=','\1'.spc,'g')
+ if ! &et
+ let str = substitute(str,'\s\{'.&ts.'\}',"\t",'g')
+ endif
+ return str
+endfunction
+
+function! s:process(string)
+ let i = 0
+ for i in range(7)
+ let repl_{i} = ''
+ let m = matchstr(a:string,nr2char(i).'.\{-\}\ze'.nr2char(i))
+ if m != ''
+ let m = substitute(strpart(m,1),'\r.*','','')
+ let repl_{i} = input(match(m,'\w\+$') >= 0 ? m.': ' : m)
+ endif
+ endfor
+ let s = ""
+ let i = 0
+ while i < strlen(a:string)
+ let char = strpart(a:string,i,1)
+ if char2nr(char) < 8
+ let next = stridx(a:string,char,i+1)
+ if next == -1
+ let s .= char
+ else
+ let insertion = repl_{char2nr(char)}
+ let subs = strpart(a:string,i+1,next-i-1)
+ let subs = matchstr(subs,'\r.*')
+ while subs =~ '^\r.*\r'
+ let sub = matchstr(subs,"^\r\\zs[^\r]*\r[^\r]*")
+ let subs = strpart(subs,strlen(sub)+1)
+ let r = stridx(sub,"\r")
+ let insertion = substitute(insertion,strpart(sub,0,r),strpart(sub,r+1),'')
+ endwhile
+ let s .= insertion
+ let i = next
+ endif
+ else
+ let s .= char
+ endif
+ let i += 1
+ endwhile
+ return s
+endfunction
+
+function! s:wrap(string,char,type,removed,special)
+ let keeper = a:string
+ let newchar = a:char
+ let s:input = ""
+ let type = a:type
+ let linemode = type ==# 'V' ? 1 : 0
+ let before = ""
+ let after = ""
+ if type ==# "V"
+ let initspaces = matchstr(keeper,'\%^\s*')
+ else
+ let initspaces = matchstr(getline('.'),'\%^\s*')
+ endif
+ let pairs = "b()B{}r[]a<>"
+ let extraspace = ""
+ if newchar =~ '^ '
+ let newchar = strpart(newchar,1)
+ let extraspace = ' '
+ endif
+ let idx = stridx(pairs,newchar)
+ if newchar == ' '
+ let before = ''
+ let after = ''
+ elseif exists("b:surround_".char2nr(newchar))
+ let all = s:process(b:surround_{char2nr(newchar)})
+ let before = s:extractbefore(all)
+ let after = s:extractafter(all)
+ elseif exists("g:surround_".char2nr(newchar))
+ let all = s:process(g:surround_{char2nr(newchar)})
+ let before = s:extractbefore(all)
+ let after = s:extractafter(all)
+ elseif newchar ==# "p"
+ let before = "\n"
+ let after = "\n\n"
+ elseif newchar ==# 's'
+ let before = ' '
+ let after = ''
+ elseif newchar ==# ':'
+ let before = ':'
+ let after = ''
+ elseif newchar =~# "[tT\<C-T><]"
+ let dounmapp = 0
+ let dounmapb = 0
+ if !maparg(">","c")
+ let dounmapb = 1
+ " Hide from AsNeeded
+ exe "cn"."oremap > ><CR>"
+ endif
+ let default = ""
+ if newchar ==# "T"
+ if !exists("s:lastdel")
+ let s:lastdel = ""
+ endif
+ let default = matchstr(s:lastdel,'<\zs.\{-\}\ze>')
+ endif
+ let tag = input("<",default)
+ if dounmapb
+ silent! cunmap >
+ endif
+ let s:input = tag
+ if tag != ""
+ let keepAttributes = ( match(tag, ">$") == -1 )
+ let tag = substitute(tag,'>*$','','')
+ let attributes = ""
+ if keepAttributes
+ let attributes = matchstr(a:removed, '<[^ \t\n]\+\zs\_.\{-\}\ze>')
+ endif
+ let s:input = tag . '>'
+ if tag =~ '/$'
+ let tag = substitute(tag, '/$', '', '')
+ let before = '<'.tag.attributes.' />'
+ let after = ''
+ else
+ let before = '<'.tag.attributes.'>'
+ let after = '</'.substitute(tag,' .*','','').'>'
+ endif
+ if newchar == "\<C-T>"
+ if type ==# "v" || type ==# "V"
+ let before .= "\n\t"
+ endif
+ if type ==# "v"
+ let after = "\n". after
+ endif
+ endif
+ endif
+ elseif newchar ==# 'l' || newchar == '\'
+ " LaTeX
+ let env = input('\begin{')
+ if env != ""
+ let s:input = env."\<CR>"
+ let env = '{' . env
+ let env .= s:closematch(env)
+ echo '\begin'.env
+ let before = '\begin'.env
+ let after = '\end'.matchstr(env,'[^}]*').'}'
+ endif
+ elseif newchar ==# 'f' || newchar ==# 'F'
+ let fnc = input('function: ')
+ if fnc != ""
+ let s:input = fnc."\<CR>"
+ let before = substitute(fnc,'($','','').'('
+ let after = ')'
+ if newchar ==# 'F'
+ let before .= ' '
+ let after = ' ' . after
+ endif
+ endif
+ elseif newchar ==# "\<C-F>"
+ let fnc = input('function: ')
+ let s:input = fnc."\<CR>"
+ let before = '('.fnc.' '
+ let after = ')'
+ elseif idx >= 0
+ let spc = (idx % 3) == 1 ? " " : ""
+ let idx = idx / 3 * 3
+ let before = strpart(pairs,idx+1,1) . spc
+ let after = spc . strpart(pairs,idx+2,1)
+ elseif newchar == "\<C-[>" || newchar == "\<C-]>"
+ let before = "{\n\t"
+ let after = "\n}"
+ elseif newchar !~ '\a'
+ let before = newchar
+ let after = newchar
+ else
+ let before = ''
+ let after = ''
+ endif
+ let after = substitute(after ,'\n','\n'.initspaces,'g')
+ if type ==# 'V' || (a:special && type ==# "v")
+ let before = substitute(before,' \+$','','')
+ let after = substitute(after ,'^ \+','','')
+ if after !~ '^\n'
+ let after = initspaces.after
+ endif
+ if keeper !~ '\n$' && after !~ '^\n'
+ let keeper .= "\n"
+ elseif keeper =~ '\n$' && after =~ '^\n'
+ let after = strpart(after,1)
+ endif
+ if before !~ '\n\s*$'
+ let before .= "\n"
+ if a:special
+ let before .= "\t"
+ endif
+ endif
+ endif
+ if type ==# 'V'
+ let before = initspaces.before
+ endif
+ if before =~ '\n\s*\%$'
+ if type ==# 'v'
+ let keeper = initspaces.keeper
+ endif
+ let padding = matchstr(before,'\n\zs\s\+\%$')
+ let before = substitute(before,'\n\s\+\%$','\n','')
+ let keeper = s:fixindent(keeper,padding)
+ endif
+ if type ==# 'V'
+ let keeper = before.keeper.after
+ elseif type =~ "^\<C-V>"
+ " Really we should be iterating over the buffer
+ let repl = substitute(before,'[\\~]','\\&','g').'\1'.substitute(after,'[\\~]','\\&','g')
+ let repl = substitute(repl,'\n',' ','g')
+ let keeper = substitute(keeper."\n",'\(.\{-\}\)\(\n\)',repl.'\n','g')
+ let keeper = substitute(keeper,'\n\%$','','')
+ else
+ let keeper = before.extraspace.keeper.extraspace.after
+ endif
+ return keeper
+endfunction
+
+function! s:wrapreg(reg,char,removed,special)
+ let orig = getreg(a:reg)
+ let type = substitute(getregtype(a:reg),'\d\+$','','')
+ let new = s:wrap(orig,a:char,type,a:removed,a:special)
+ call setreg(a:reg,new,type)
+endfunction
+" }}}1
+
+function! s:insert(...) " {{{1
+ " Optional argument causes the result to appear on 3 lines, not 1
+ let linemode = a:0 ? a:1 : 0
+ let char = s:inputreplacement()
+ while char == "\<CR>" || char == "\<C-S>"
+ " TODO: use total count for additional blank lines
+ let linemode += 1
+ let char = s:inputreplacement()
+ endwhile
+ if char == ""
+ return ""
+ endif
+ let cb_save = &clipboard
+ set clipboard-=unnamed clipboard-=unnamedplus
+ let reg_save = @@
+ call setreg('"',"\r",'v')
+ call s:wrapreg('"',char,"",linemode)
+ " If line mode is used and the surrounding consists solely of a suffix,
+ " remove the initial newline. This fits a use case of mine but is a
+ " little inconsistent. Is there anyone that would prefer the simpler
+ " behavior of just inserting the newline?
+ if linemode && match(getreg('"'),'^\n\s*\zs.*') == 0
+ call setreg('"',matchstr(getreg('"'),'^\n\s*\zs.*'),getregtype('"'))
+ endif
+ " This can be used to append a placeholder to the end
+ if exists("g:surround_insert_tail")
+ call setreg('"',g:surround_insert_tail,"a".getregtype('"'))
+ endif
+ if col('.') >= col('$')
+ norm! ""p
+ else
+ norm! ""P
+ endif
+ if linemode
+ call s:reindent()
+ endif
+ norm! `]
+ call search('\r','bW')
+ let @@ = reg_save
+ let &clipboard = cb_save
+ return "\<Del>"
+endfunction " }}}1
+
+function! s:reindent() " {{{1
+ if exists("b:surround_indent") ? b:surround_indent : (!exists("g:surround_indent") || g:surround_indent)
+ silent norm! '[=']
+ endif
+endfunction " }}}1
+
+function! s:dosurround(...) " {{{1
+ let scount = v:count1
+ let char = (a:0 ? a:1 : s:inputtarget())
+ let spc = ""
+ if char =~ '^\d\+'
+ let scount = scount * matchstr(char,'^\d\+')
+ let char = substitute(char,'^\d\+','','')
+ endif
+ if char =~ '^ '
+ let char = strpart(char,1)
+ let spc = 1
+ endif
+ if char == 'a'
+ let char = '>'
+ endif
+ if char == 'r'
+ let char = ']'
+ endif
+ let newchar = ""
+ if a:0 > 1
+ let newchar = a:2
+ if newchar == "\<Esc>" || newchar == "\<C-C>" || newchar == ""
+ return s:beep()
+ endif
+ endif
+ let cb_save = &clipboard
+ set clipboard-=unnamed clipboard-=unnamedplus
+ let append = ""
+ let original = getreg('"')
+ let otype = getregtype('"')
+ call setreg('"',"")
+ let strcount = (scount == 1 ? "" : scount)
+ if char == '/'
+ exe 'norm! '.strcount.'[/d'.strcount.']/'
+ elseif char =~# '[[:punct:][:space:]]' && char !~# '[][(){}<>"''`]'
+ exe 'norm! T'.char
+ if getline('.')[col('.')-1] == char
+ exe 'norm! l'
+ endif
+ exe 'norm! dt'.char
+ else
+ exe 'norm! d'.strcount.'i'.char
+ endif
+ let keeper = getreg('"')
+ let okeeper = keeper " for reindent below
+ if keeper == ""
+ call setreg('"',original,otype)
+ let &clipboard = cb_save
+ return ""
+ endif
+ let oldline = getline('.')
+ let oldlnum = line('.')
+ if char ==# "p"
+ call setreg('"','','V')
+ elseif char ==# "s" || char ==# "w" || char ==# "W"
+ " Do nothing
+ call setreg('"','')
+ elseif char =~ "[\"'`]"
+ exe "norm! i \<Esc>d2i".char
+ call setreg('"',substitute(getreg('"'),' ','',''))
+ elseif char == '/'
+ norm! "_x
+ call setreg('"','/**/',"c")
+ let keeper = substitute(substitute(keeper,'^/\*\s\=','',''),'\s\=\*$','','')
+ elseif char =~# '[[:punct:][:space:]]' && char !~# '[][(){}<>]'
+ exe 'norm! F'.char
+ exe 'norm! df'.char
+ else
+ " One character backwards
+ call search('\m.', 'bW')
+ exe "norm! da".char
+ endif
+ let removed = getreg('"')
+ let rem2 = substitute(removed,'\n.*','','')
+ let oldhead = strpart(oldline,0,strlen(oldline)-strlen(rem2))
+ let oldtail = strpart(oldline, strlen(oldline)-strlen(rem2))
+ let regtype = getregtype('"')
+ if char =~# '[\[({<T]' || spc
+ let keeper = substitute(keeper,'^\s\+','','')
+ let keeper = substitute(keeper,'\s\+$','','')
+ endif
+ if col("']") == col("$") && col('.') + 1 == col('$')
+ if oldhead =~# '^\s*$' && a:0 < 2
+ let keeper = substitute(keeper,'\%^\n'.oldhead.'\(\s*.\{-\}\)\n\s*\%$','\1','')
+ endif
+ let pcmd = "p"
+ else
+ let pcmd = "P"
+ endif
+ if line('.') + 1 < oldlnum && regtype ==# "V"
+ let pcmd = "p"
+ endif
+ call setreg('"',keeper,regtype)
+ if newchar != ""
+ let special = a:0 > 2 ? a:3 : 0
+ call s:wrapreg('"',newchar,removed,special)
+ endif
+ silent exe 'norm! ""'.pcmd.'`['
+ if removed =~ '\n' || okeeper =~ '\n' || getreg('"') =~ '\n'
+ call s:reindent()
+ endif
+ if getline('.') =~ '^\s\+$' && keeper =~ '^\s*\n'
+ silent norm! cc
+ endif
+ call setreg('"',original,otype)
+ let s:lastdel = removed
+ let &clipboard = cb_save
+ if newchar == ""
+ silent! call repeat#set("\<Plug>Dsurround".char,scount)
+ else
+ silent! call repeat#set("\<Plug>C".(a:0 > 2 && a:3 ? "S" : "s")."urround".char.newchar.s:input,scount)
+ endif
+endfunction " }}}1
+
+function! s:changesurround(...) " {{{1
+ let a = s:inputtarget()
+ if a == ""
+ return s:beep()
+ endif
+ let b = s:inputreplacement()
+ if b == ""
+ return s:beep()
+ endif
+ call s:dosurround(a,b,a:0 && a:1)
+endfunction " }}}1
+
+function! s:opfunc(type,...) " {{{1
+ let char = s:inputreplacement()
+ if char == ""
+ return s:beep()
+ endif
+ let reg = '"'
+ let sel_save = &selection
+ let &selection = "inclusive"
+ let cb_save = &clipboard
+ set clipboard-=unnamed clipboard-=unnamedplus
+ let reg_save = getreg(reg)
+ let reg_type = getregtype(reg)
+ let type = a:type
+ if a:type == "char"
+ silent exe 'norm! v`[o`]"'.reg.'y'
+ let type = 'v'
+ elseif a:type == "line"
+ silent exe 'norm! `[V`]"'.reg.'y'
+ let type = 'V'
+ elseif a:type ==# "v" || a:type ==# "V" || a:type ==# "\<C-V>"
+ let &selection = sel_save
+ let ve = &virtualedit
+ if !(a:0 && a:1)
+ set virtualedit=
+ endif
+ silent exe 'norm! gv"'.reg.'y'
+ let &virtualedit = ve
+ elseif a:type =~ '^\d\+$'
+ let type = 'v'
+ silent exe 'norm! ^v'.a:type.'$h"'.reg.'y'
+ if mode() ==# 'v'
+ norm! v
+ return s:beep()
+ endif
+ else
+ let &selection = sel_save
+ let &clipboard = cb_save
+ return s:beep()
+ endif
+ let keeper = getreg(reg)
+ if type ==# "v" && a:type !=# "v"
+ let append = matchstr(keeper,'\_s\@<!\s*$')
+ let keeper = substitute(keeper,'\_s\@<!\s*$','','')
+ endif
+ call setreg(reg,keeper,type)
+ call s:wrapreg(reg,char,"",a:0 && a:1)
+ if type ==# "v" && a:type !=# "v" && append != ""
+ call setreg(reg,append,"ac")
+ endif
+ silent exe 'norm! gv'.(reg == '"' ? '' : '"' . reg).'p`['
+ if type ==# 'V' || (getreg(reg) =~ '\n' && type ==# 'v')
+ call s:reindent()
+ endif
+ call setreg(reg,reg_save,reg_type)
+ let &selection = sel_save
+ let &clipboard = cb_save
+ if a:type =~ '^\d\+$'
+ silent! call repeat#set("\<Plug>Y".(a:0 && a:1 ? "S" : "s")."surround".char.s:input,a:type)
+ else
+ silent! call repeat#set("\<Plug>SurroundRepeat".char.s:input)
+ endif
+endfunction
+
+function! s:opfunc2(arg)
+ call s:opfunc(a:arg,1)
+endfunction " }}}1
+
+function! s:closematch(str) " {{{1
+ " Close an open (, {, [, or < on the command line.
+ let tail = matchstr(a:str,'.[^\[\](){}<>]*$')
+ if tail =~ '^\[.\+'
+ return "]"
+ elseif tail =~ '^(.\+'
+ return ")"
+ elseif tail =~ '^{.\+'
+ return "}"
+ elseif tail =~ '^<.+'
+ return ">"
+ else
+ return ""
+ endif
+endfunction " }}}1
+
+nnoremap <silent> <Plug>SurroundRepeat .
+nnoremap <silent> <Plug>Dsurround :<C-U>call <SID>dosurround(<SID>inputtarget())<CR>
+nnoremap <silent> <Plug>Csurround :<C-U>call <SID>changesurround()<CR>
+nnoremap <silent> <Plug>CSurround :<C-U>call <SID>changesurround(1)<CR>
+nnoremap <silent> <Plug>Yssurround :<C-U>call <SID>opfunc(v:count1)<CR>
+nnoremap <silent> <Plug>YSsurround :<C-U>call <SID>opfunc2(v:count1)<CR>
+" <C-U> discards the numerical argument but there's not much we can do with it
+nnoremap <silent> <Plug>Ysurround :<C-U>set opfunc=<SID>opfunc<CR>g@
+nnoremap <silent> <Plug>YSurround :<C-U>set opfunc=<SID>opfunc2<CR>g@
+vnoremap <silent> <Plug>VSurround :<C-U>call <SID>opfunc(visualmode(),visualmode() ==# 'V' ? 1 : 0)<CR>
+vnoremap <silent> <Plug>VgSurround :<C-U>call <SID>opfunc(visualmode(),visualmode() ==# 'V' ? 0 : 1)<CR>
+inoremap <silent> <Plug>Isurround <C-R>=<SID>insert()<CR>
+inoremap <silent> <Plug>ISurround <C-R>=<SID>insert(1)<CR>
+
+if !exists("g:surround_no_mappings") || ! g:surround_no_mappings
+ nmap ds <Plug>Dsurround
+ nmap cs <Plug>Csurround
+ nmap cS <Plug>CSurround
+ nmap ys <Plug>Ysurround
+ nmap yS <Plug>YSurround
+ nmap yss <Plug>Yssurround
+ nmap ySs <Plug>YSsurround
+ nmap ySS <Plug>YSsurround
+ xmap S <Plug>VSurround
+ xmap gS <Plug>VgSurround
+ if !exists("g:surround_no_insert_mappings") || ! g:surround_no_insert_mappings
+ if !hasmapto("<Plug>Isurround","i") && "" == mapcheck("<C-S>","i")
+ imap <C-S> <Plug>Isurround
+ endif
+ imap <C-G>s <Plug>Isurround
+ imap <C-G>S <Plug>ISurround
+ endif
+endif
+
+" vim:set ft=vim sw=2 sts=2 et: