runtime/if_ecl.lisp

   1 ; vim:ts=8
   2
   3 (in-package :vim)
   4
   5 (shadow '(append funcall setq search map close))
   6
   7 (export
   8   '(; These functions are implemented in if_ecl.c and probably use "internal"
   9     ; data structures.
  10     cmd expr
  11     windows current-window window-width window-height window-column window-cursor window-buffer
  12     buffers current-buffer buffer-line-count buffer-lines buffer-name
  13     replace-lines append-line-to-buffer append-to-buffer
  14     eval-range
  15
  16     ; Use or return "internal" data structures.
  17     find-buffer get-line
  18
  19     ; Wrapped Vim functions
  20     append argc argidx argv browse bufexists buflisted bufloaded bufname bufnr
  21     bufwinnr num-buffers byte2line char2nr cindent col confirm
  22     cursor
  23     expand
  24     getcwd
  25     getline
  26     getwinposx getwinposy
  27     input
  28     line
  29     lispindent
  30     maparg
  31     search
  32     setline
  33     virtcol
  34     winbufnr wincol winheight winline winnr
  35     winwidth
  36     tabpagebuflist tabpagenr
  37
  38     ; Other wrapped Vim functionality.
  39     execute normal normal!
  40     map map! unmap unmap!
  41     wincmd
  42     close close!
  43
  44     ; Utility functions
  45     funcall setq var
  46     change-to-buffer
  47     open-buffer
  48     get-pos goto-pos
  49     kill
  50     point bufnr-of line-of col-of virtcol-of winline-of
  51     scroll-window position-window
  52     append-text-to-buffer multi-line-map append-multi-line-string
  53     num-windows
  54
  55     ; Macros
  56     get-pos-after with-buffer with-options with-window with-window-of
  57     ))
  58
  59 (defun build-command (args)
  60   (apply #'concatenate 'string
  61          (mapcar (lambda (arg)
  62                    (etypecase arg
  63                      (null "")
  64                      (character (string arg))
  65                      (string arg)
  66                      (number (princ-to-string arg))))
  67                  args)))
  68
  69 (defun cmd (&rest args)
  70   "Executes an ex command, e.g. \"w\" or \"help ecl\".
  71   Accepts strings, characters, and NIL.  All are concatenated into a single
  72   string to pass to Vim.  Characters are converted to strings, NIL is
  73   converted to \"\".
  74   NOTE: This is exactly the same as typing in the command at the Vim colon-prompt.  If
  75   you want \":exec ...\", use vim:execute.  vim:cmd does NOT allow use of <>
  76   notation, whereas vim:execute does."
  77   ; (format t "cmd is ~S~%" (build-command args))
  78   (execute-int (build-command args)))
  79
  80 (defun execute (&rest args)
  81   (cmd "exec \"" (build-command args) "\""))
  82
  83 (defun expr (str)
  84   "Evaluates a Vim expression; returns the result as a string, or NIL"
  85   (check-type str string)
  86   (expr-int str))
  87
  88 ; Really need to change this to a "deftype" or something and use "check-type".
  89 (defun validate-window (w)
  90   (unless (and w (eq (si:foreign-data-tag w) 'vim::window))
  91     (error "~S is not a valid Vim window" w)))
  92
  93 (defun windows ()
  94   "Returns a list of Vim's windows in the current tab."
  95   (windows-int))
  96
  97 (defun current-window ()
  98   "Returns the current window"
  99   (current-window-int))
 100
 101 (defun window-width (&optional (window (current-window)))
 102   "returns the width of a window (defaults to (current-window))"
 103   (validate-window window)
 104   (window-width-int window))
 105
 106 (defun window-height (&optional (window (current-window)))
 107   "returns the height of a window (defaults to (current-window))"
 108   (validate-window window)
 109   (window-height-int window))
 110
 111 (defun window-column (&optional (window (current-window)))
 112   "returns the leftmost column of the window on the screen"
 113   (validate-window window)
 114   (window-column-int window))
 115
 116 (defun window-cursor (&optional (window (current-window)))
 117   "returns the cursor of a window (defaults to (current-window)) cursors
 118   are (lnum . col) cons cells"
 119   (validate-window window)
 120   (window-cursor-int window))
 121
 122 (defun window-buffer (&optional (window (current-window)))
 123   "returns the buffer of a window (defaults to (current-window))"
 124   (validate-window window)
 125   (window-buffer-int window))
 126
 127 (defun buffers ()
 128   "returns a list of vim's buffers"
 129   (buffers-int))
 130
 131 (defun current-buffer ()
 132   "returns the current buffer"
 133   (current-buffer-int))
 134
 135 ; Really need to change this to a "deftype" or something and use "check-type".
 136 (defun validate-buffer (buffer)
 137   (unless (and buffer
 138                (eq (si:foreign-data-tag buffer) 'vim::buffer))
 139     (error "~S is not a valid Vim buffer" buffer)))
 140
 141 (defun buffer-line-count (&optional (buffer (current-buffer)))
 142   "returns the line count of a buffer (defaults to (current-buffer))"
 143   (validate-buffer buffer)
 144   (buffer-line-count-int buffer))
 145
 146 (defun validate-line-num (line-num buffer &optional (num-lines (vim:buffer-line-count buffer)))
 147   "Valide that line-num < # lines in buffer.
 148   Assumes that buffer is a valid Vim buffer.
 149   If you supply num-lines it must equal (vim:buffer-line-count buffer)."
 150   (unless (and line-num
 151                (typep line-num 'fixnum)
 152                (<= 0 line-num num-lines))
 153     (error "~D is out of range; there are only ~D lines in ~S" line-num num-lines buffer)))
 154
 155 (defmacro validate-buffer-start-end (buffer start end)
 156   `(progn
 157      (validate-buffer ,buffer)
 158      (validate-line-num ,start ,buffer)
 159      (let ((num-lines (vim:buffer-line-count ,buffer)))
 160        (if ,end
 161          (validate-line-num ,end ,buffer num-lines)
 162          (setf ,end num-lines)))))
 163
 164 (defun buffer-lines (&key (buffer (vim:current-buffer))
 165                           (start 0) end)
 166   "returns the lines from :start to :end in :buffer
 167   (defaults to (current-buffer))
 168   :start and :end are in the range 0..(buffer-line-count)
 169   :start is inclusive, :end is excluded
 170   If (= start end), the return will be NIL
 171   To print a single line :start n :end n+1"
 172   (validate-buffer-start-end buffer start end)
 173   (buffer-lines-int buffer start end))
 174
 175 (defun buffer-name (&key (buffer (vim:current-buffer)))
 176   (validate-buffer buffer)
 177   (buffer-name-int buffer))
 178
 179 (defun find-buffer (name)
 180   (find-if
 181     (lambda (b)
 182       (let ((b-name (vim:buffer-name :buffer b)))
 183         (if b-name
 184           (string= name b-name)
 185           (eql name nil))))
 186     (vim:buffers)))
 187
 188 (defun replace-lines (lines &key (start 0) end (buffer (vim:current-buffer)))
 189   "replaces the lines from :start to :end in :buffer with the given list of strings
 190   :start and :end are in the range 0..(buffer-line-count)
 191   :start is inclusive, :end is excluded
 192   If :start == :end, then you insert a new line before :start
 193   To insert a new line at the very beginning of a buffer, :start = :end = 0"
 194   (validate-buffer-start-end buffer start end)
 195   (replace-lines-int buffer lines start end
 196                      0 (length lines)))
 197
 198 (defun get-line (&optional (line (car (window-cursor)))
 199                                (buffer (vim:current-buffer)))
 200   "gets a line from a buffer"
 201   (first (vim:buffer-lines :buffer buffer :start line :end (1+ line))))
 202
 203 (defun append-line-to-buffer (string &key (buffer (vim:current-buffer)))
 204   (validate-buffer buffer)
 205   (let ((end-line (vim:buffer-line-count buffer)))
 206     (replace-lines (list string) :buffer buffer :start end-line :end end-line)))
 207
 208 (defun append-to-buffer (string &key (buffer (vim:current-buffer)))
 209   (validate-buffer buffer)
 210   (let* ((end-line (1- (vim:buffer-line-count buffer)))
 211          (existing (get-line end-line buffer)))
 212     (replace-lines (list (concatenate 'string existing string)) :buffer buffer :start end-line :end (1+ end-line))))
 213
 214 (defun eval-range ()
 215   "called when the :ecl command is issued without an argument"
 216   (with-input-from-string (s (format nil
 217                                      "~{~a~%~}"
 218                                      (vim:buffer-lines :buffer (vim:current-buffer)
 219                                                        ;; ranges for Vim buffers start at 1,
 220                                                        ;; whereas buffer-lines expects 0..lines-in-buffer
 221                                                        :start (1- (car vim:range))
 222                                                        :end (cdr vim:range))))
 223     (loop for form = (read s nil nil)
 224           while form
 225           do (eval form))))
 226
 227 (defparameter *returns-integer* (make-hash-table :test #'equal)
 228   "Stores the Vim functions that return integers, so vim:funcall can parse the
 229 string returned from Vim, if appropriate.")
 230
 231 (defun returns-integer (f)
 232   (setf (gethash f *returns-integer*) t))
 233
 234 (defun returns-integer-p (f)
 235   (gethash f *returns-integer*))
 236
 237 (mapcar #'returns-integer
 238   '("append" "argc" "argidx" "bufexists" "buflisted" "bufloaded" "bufnr"
 239     "bufwinnr" "byte2line" "char2nr" "cindent" "col" "confirm"
 240     "cscope_connection" "cursor" "delete" "did_filetype" "eventhandler"
 241     "executable" "exists" "filereadable" "filewritable" "foldclosed"
 242     "foldclosedend" "foldlevel" "foreground" "getchar" "getcharmod"
 243     "getcmdpos" "getfsize" "getftime" "getwinposx" "getwinposy" "has"
 244     "hasmapto" "histnr" "hlexists" "hlID" "indent" "inputrestore" "inputsave"
 245     "isdirectory" "libcallnr" "line" "line2byte" "lispindent" "localtime"
 246     "match" "matchend" "nextnonblank" "prevnonblank" "remote_foreground"
 247     "remote_peek" "rename" "search" "searchpair" "server2client" "setcmdpos"
 248     "setline" "setreg" "stridx" "strlen" "strridx" "synID" "synIDtrans" "type"
 249     "virtcol" "winbufnr" "wincol" "winheight" "winline" "winnr" "winwidth"))
 250
 251 (defun build-vim-funcall (function-name args)
 252   (with-output-to-string (s)
 253     (princ function-name s)
 254     (princ "(" s)
 255     (loop for (arg . rest) on (remove nil args)
 256           if arg do (prin1 arg s)
 257           if rest do (princ "," s))
 258     (princ ")" s)))
 259
 260 (defun vim:funcall (function-name &rest args)
 261   (assert (typep function-name 'string)
 262           (function-name)
 263           "vim:funcall expects a string, not ~S"
 264           function-name)
 265   (let ((result (vim:expr (build-vim-funcall function-name args))))
 266     (if (and (typep result 'string)
 267              (gethash function-name *returns-integer*))
 268       (parse-integer result)
 269       result)))
 270
 271 ;;; ######################################################################
 272 ;;; Vim FFI
 273 ;;; ######################################################################
 274
 275 (defmacro def-vim-function (name args arg-xlate-functions result-xlat-function
 276                                  &optional documentation)
 277   (unless (and (typep args 'list)
 278                (typep arg-xlate-functions 'list))
 279     (error
 280       "In def-vim-function of ~S, args and arg-xlate-functions must both be lists, not ~S and ~S."
 281       name args arg-xlate-functions))
 282   (flet ((lambda-list-keyword-p (x) (and (atom x)
 283                                          (eql #\& (char (string x) 0))))
 284          (apply-xlat-function (f arg)
 285            (when (listp arg) (setf arg (car arg)))
 286            (if (eq f 't)
 287              arg
 288              (if (atom f)
 289                (list f arg)
 290                f))))
 291     (let* ((parsed-args
 292              (loop for item in args
 293                    if (listp item) collect (car item)
 294                    else unless (lambda-list-keyword-p item) collect item))
 295            (xlated-args (loop for f in arg-xlate-functions
 296                               for arg in parsed-args
 297                               if f collect (apply-xlat-function f arg)))
 298            (funcall-expression `(vim:funcall ,name ,@xlated-args)))
 299       `(defun ,(intern (string-upcase name) :vim) ,args
 300          ,documentation
 301          ,(if (eq 't result-xlat-function)
 302             funcall-expression
 303             (if (atom result-xlat-function)
 304               `(,result-xlat-function ,funcall-expression)
 305               `(let ((result ,funcall-expression))
 306                  ,result-xlat-function)))))))
 307
 308 (defun string-or-number (lnum)
 309   (etypecase lnum
 310     (string lnum)
 311     (number (1+ lnum))))
 312
 313 (defun t-or-number (expr)
 314   (if (eql expr t)
 315     0
 316     (1+ expr)))
 317
 318 (defun t-string-or-number (expr)
 319   (if (eql expr t)
 320     0
 321     (string-or-number expr)))
 322
 323 (defun nil-or-number (expr)
 324   (if expr (1+ expr) 0))
 325
 326 (defun result-number-or-nil (result)
 327   (if (plusp result) (1- result) nil))
 328
 329 (defun result-nil-or-string (result)
 330   (if (string= result "") nil result))
 331
 332 (defun join-with-newlines (list)
 333   (apply #'concatenate 'string
 334          (loop for (item . rest) on list
 335                collect item
 336                if rest collect (string #\Newline))))
 337
 338 (def-vim-function "append" (lnum string) (nil-or-number t) t)
 339 (def-vim-function "argc" () () t)
 340 (def-vim-function "argidx" () () t)
 341 (def-vim-function "argv" (n) (t) t)
 342 (def-vim-function "browse" (save title initdir default) ((if save 1 0) t t t) t)
 343 (def-vim-function "bufexists" (expr) (t-string-or-number) plusp
 344   "Use T to find out about the alternate file name.")
 345 (def-vim-function "buflisted" (expr) (t-string-or-number) plusp
 346   "Use T to find out about the alternate file name.")
 347 (def-vim-function "bufloaded" (expr) (t-string-or-number) plusp
 348   "Use T to find out about the alternate file name.")
 349 (def-vim-function "bufname" (expr) (t-string-or-number) t
 350   "Use T to find out about the alternate file name.")
 351
 352 (def-vim-function "bufnr" (&optional (expr ".")) (t-string-or-number) result-number-or-nil)
 353 (defun num-buffers () (1+ (vim:bufnr "$")))
 354
 355 (def-vim-function "bufwinnr" (expr) (t-string-or-number) result-number-or-nil)
 356
 357 (def-vim-function "byte2line" (byte-count) (1+) 1-)
 358 (def-vim-function "char2nr" (expr) (t) t)
 359 (def-vim-function "cindent" (lnum) (string-or-number) 1-)
 360 (def-vim-function "col" (expr) (t) 1-)
 361
 362 (def-vim-function "confirm" (msg &optional (choices "&Ok") (default 0) (type "Generic"))
 363   (join-with-newlines
 364    join-with-newlines
 365    (if default (1+ default) 0)
 366    nil)
 367   result-number-or-nil
 368   "For MSG and CHOICES, give lists of strings instead of single strings.")
 369
 370 (def-vim-function "cursor" (lnum col) (nil-or-number nil-or-number) 't
 371   "position cursor at {lnum}, {col}; returns T")
 372
 373 ; delete( {fname})              Number  delete file {fname}
 374 ; did_filetype()                Number  TRUE if FileType autocommand event used
 375 ; escape( {string}, {chars})    String  escape {chars} in {string} with '\'
 376 ; eventhandler( )               Number  TRUE if inside an event handler
 377 ; executable( {expr})           Number  1 if executable {expr} exists
 378 ; exists( {expr})               Number  TRUE if {expr} exists
 379
 380 (def-vim-function "expand" (expr &optional flag) (t (if flag 1 0)) t
 381   "Use t/nil for the flag.")
 382
 383 ; filereadable( {file})         Number  TRUE if {file} is a readable file
 384 ; filewritable( {file})         Number  TRUE if {file} is a writable file
 385 ; fnamemodify( {fname}, {mods}) String  modify file name
 386 ; foldclosed( {lnum})           Number  first line of fold at {lnum} if closed
 387 ; foldclosedend( {lnum})        Number  last line of fold at {lnum} if closed
 388 ; foldlevel( {lnum})            Number  fold level at {lnum}
 389 ; foldtext( )                   String  line displayed for closed fold
 390 ; foreground( )                 Number  bring the Vim window to the foreground
 391 ; getchar( [expr])              Number  get one character from the user
 392 ; getcharmod( )                 Number  modifiers for the last typed character
 393 ; getbufvar( {expr}, {varname})         variable {varname} in buffer {expr}
 394 ; getcmdline()                  String  return the current command-line
 395 ; getcmdpos()                   Number  return cursor position in command-line
 396
 397 (def-vim-function "getcwd" () () t)
 398
 399 ; getfsize( {fname})            Number  size in bytes of file
 400 ; getftime( {fname})            Number  last modification time of file
 401
 402 (def-vim-function "getline" (lnum) (string-or-number) t
 403   "line {lnum} from current buffer")
 404
 405 ; getreg( [{regname}])          String  contents of register
 406 ; getregtype( [{regname}])      String  type of register
 407
 408 (def-vim-function "getwinposx" () () result-number-or-nil
 409   "X coord in pixels of GUI Vim window")
 410 (def-vim-function "getwinposy" () () result-number-or-nil
 411   "Y coord in pixels of GUI Vim window")
 412
 413 ; getwinvar( {nr}, {varname})           variable {varname} in window {nr}
 414 ; glob( {expr})                 String  expand file wildcards in {expr}
 415 ; globpath( {path}, {expr})     String  do glob({expr}) for all dirs in {path}
 416 ; has( {feature})                       Number  TRUE if feature {feature} supported
 417 ; hasmapto( {what} [, {mode}])  Number  TRUE if mapping to {what} exists
 418 ; histadd( {history},{item})    String  add an item to a history
 419 ; histdel( {history} [, {item}])        String  remove an item from a history
 420 ; histget( {history} [, {index}])       String  get the item {index} from a history
 421 ; histnr( {history})            Number  highest index of a history
 422 ; hlexists( {name})             Number  TRUE if highlight group {name} exists
 423 ; hlID( {name})                 Number  syntax ID of highlight group {name}
 424 ; hostname()                    String  name of the machine Vim is running on
 425 ; iconv( {expr}, {from}, {to})  String  convert encoding of {expr}
 426 ; indent( {lnum})               Number  indent of line {lnum}
 427
 428 (def-vim-function "input" (prompt &optional text completion) (t t t) t
 429   "Get input from the user.")
 430
 431 ; inputdialog( {p} [, {t} [, {c}]]) String              like input() but in a GUI dialog
 432
 433 ; inputrestore()                Number  restore typeahead
 434 ; inputsave()                   Number  save and clear typeahead
 435 ; inputsecret( {prompt} [, {text}]) String  like input() but hiding the text
 436 ; isdirectory( {directory})     Number  TRUE if {directory} is a directory
 437 ; libcall( {lib}, {func}, {arg})        String  call {func} in library {lib} with {arg}
 438 ; libcallnr( {lib}, {func}, {arg})  Number  idem, but return a Number
 439
 440 (def-vim-function "line" (expr) (t) result-number-or-nil
 441   "line nr of cursor, last line, or mark")
 442 (defun num-lines () (1+ (vim:line "$")))
 443
 444 ; line2byte( {lnum})            Number  byte count of line {lnum}
 445
 446 (def-vim-function "lispindent" (lnum) (string-or-number) 1-
 447   "Lisp indent for line {lnum}")
 448
 449 ; localtime()                   Number  current time
 450
 451 (defparameter *map-modes*
 452   (let ((h (make-hash-table))
 453         (modes '((:normal "n")
 454                  (:visual-select "v")
 455                  (:visual "x")
 456                  (:select "s")
 457                  (:operator-pending "o")
 458                  (:insert "i")
 459                  (:command "c")
 460                  (:lang-arg "l"))))
 461     (loop for (key val) in modes
 462           do (setf (gethash key h) val))
 463     h)
 464   "Map keywords to strings for map modes.")
 465
 466 ; TODO: maybe a "map-map-modes" function / macro, to make processing map modes easier?
 467
 468 (defun check-map-mode (mode)
 469   (let ((mode-string (gethash mode *map-modes*)))
 470     (assert mode-string (mode) "Unknown vim:map mode: ~S; allowed values are ~S"
 471             mode (sort (loop for key being the hash-keys of *map-modes*
 472                              collect key)
 473                        #'string<))
 474     mode-string))
 475
 476 (defun vim:maparg (name &key mode abbr)
 477   (result-nil-or-string
 478     (vim:funcall "maparg"
 479                  name
 480                  (etypecase mode
 481                    (null "")
 482                    (string mode)
 483                    (symbol (check-map-mode mode)))
 484                  (if abbr 1 0))))
 485
 486 ; mapcheck( {name}[, {mode}])   String  check for mappings matching {name}
 487 ; match( {expr}, {pat}[, {start}])
 488 ;                               Number  position where {pat} matches in {expr}
 489 ; matchend( {expr}, {pat}[, {start}])
 490 ;                               Number  position where {pat} ends in {expr}
 491 ; matchstr( {expr}, {pat}[, {start}])
 492 ;                               String  match of {pat} in {expr}
 493 ; mode()                        String  current editing mode
 494 ; nextnonblank( {lnum})         Number  line nr of non-blank line >= {lnum}
 495 ; nr2char( {expr})              String  single char with ASCII value {expr}
 496 ; prevnonblank( {lnum})         Number  line nr of non-blank line <= {lnum}
 497 ; remote_expr( {server}, {string} [, {idvar}])
 498 ;                               String  send expression
 499 ; remote_foreground( {server})  Number  bring Vim server to the foreground
 500 ; remote_peek( {serverid} [, {retvar}])
 501 ;                               Number  check for reply string
 502 ; remote_read( {serverid})      String  read reply string
 503 ; remote_send( {server}, {string} [, {idvar}])
 504 ;                               String  send key sequence
 505 ; rename( {from}, {to})         Number  rename (move) file from {from} to {to}
 506 ; resolve( {filename})          String  get filename a shortcut points to
 507
 508 (defun keywords-to-string (flags meanings)
 509   (apply #'concatenate 'string
 510          (loop for flag in flags
 511                collect (cdr (assoc flag meanings)))))
 512
 513 (let* ((aliases '(("b" :backward :b)
 514                   ("c" :match-at-cursor :c)
 515                   ("e" :move-to-end :e)
 516                   (""  :move)
 517                   ("n" :do-not-move :n)
 518                   ("p" :count-submatches :p)
 519                   ("s" :set-tic :s)
 520                   ("w" :wrap :wl)
 521                   ("W" :no-wrap :wu)))
 522        (meanings (loop for record in aliases
 523                        nconc (loop with string = (car record)
 524                                    for keyword in (cdr record)
 525                                    collect (cons keyword string)))))
 526   (defun search (pattern &key flags (stopline nil stopline-p))
 527     (let ((string-flags (keywords-to-string flags meanings)))
 528       (result-number-or-nil
 529         (vim:funcall "search" pattern string-flags (when stopline-p
 530                                                      (1+ stopline)))))))
 531
 532 ; searchpair( {start}, {middle}, {end} [, {flags} [, {skip}]])
 533 ;                               Number  search for other end of start/end pair
 534 ; server2client( {clientid}, {string})
 535 ;                               Number  send reply string
 536 ; serverlist()                  String  get a list of available servers
 537 ; setbufvar( {expr}, {varname}, {val})  set {varname} in buffer {expr} to {val}
 538 ; setcmdpos( {pos})             Number  set cursor position in command-line
 539
 540 (def-vim-function "setline" (lnum line) (string-or-number t) zerop
 541   "set line {lnum} to {line}")
 542
 543 ; setreg( {n}, {v}[, {opt}])    Number  set register to value and type
 544 ; setwinvar( {nr}, {varname}, {val})    set {varname} in window {nr} to {val}
 545 ; simplify( {filename})         String  simplify filename as much as possible
 546 ; strftime( {format}[, {time}]) String  time in specified format
 547 ; stridx( {haystack}, {needle}) Number  first index of {needle} in {haystack}
 548 ; strlen( {expr})               Number  length of the String {expr}
 549 ; strpart( {src}, {start}[, {len}])
 550 ;                               String  {len} characters of {src} at {start}
 551 ; strridx( {haystack}, {needle})        Number  last index of {needle} in {haystack}
 552 ; strtrans( {expr})             String  translate string to make it printable
 553 ; submatch( {nr})               String  specific match in ":substitute"
 554 ; substitute( {expr}, {pat}, {sub}, {flags})
 555 ;                               String  all {pat} in {expr} replaced with {sub}
 556 ; synID( {line}, {col}, {trans})        Number  syntax ID at {line} and {col}
 557 ; synIDattr( {synID}, {what} [, {mode}])
 558 ;                               String  attribute {what} of syntax ID {synID}
 559 ; synIDtrans( {synID})          Number  translated syntax ID of {synID}
 560 ; system( {expr})               String  output of shell command {expr}
 561
 562 (defun tabpagenr (&optional arg)
 563   "If no arg given, or NIL given, return the tab page number of the current tab.
 564   If arg is given, it must string= \"$\", and we return the tab page number of
 565   the last tab.  (If it doesn't string= \"$\", it's silently ignored.)"
 566   (1- (vim:funcall "tabpagenr"
 567                    (when (and arg (string= arg "$"))
 568                      "$"))))
 569
 570 (def-vim-function "tabpagebuflist" (&optional (arg (vim:tabpagenr)))
 571   (nil-or-number)
 572   (if (eql result 0)
 573     (error "~S is not a valid tab page number" arg)
 574     (mapcar #'1- result)))
 575
 576 ; tempname()                    String  name for a temporary file
 577 ; tolower( {expr})              String  the String {expr} switched to lowercase
 578 ; toupper( {expr})              String  the String {expr} switched to uppercase
 579 ; type( {name})                 Number  type of variable {name}
 580
 581 (def-vim-function "virtcol" (expr) (t) result-number-or-nil
 582   "screen column of cursor or mark")
 583
 584 ; visualmode( [expr])           String  last visual mode used
 585
 586 (def-vim-function "winbufnr" (nr) (nil-or-number) result-number-or-nil
 587   "buffer number of window {nr}")
 588 (def-vim-function "wincol" () () 1-
 589   "window column of the cursor")
 590 (def-vim-function "winheight" (nr) (nil-or-number) result-number-or-nil
 591   "height of window {nr}")
 592 (def-vim-function "winline" () () 1-
 593   "window line of the cursor")
 594
 595 (def-vim-function "winnr" (&optional arg) (t) 1-
 596   "number of current window, or (optionally) \"$\" or \"#\".")
 597 (defun num-windows ()
 598   "Returns the number of open windows in the current tab."
 599   (1+ (vim:winnr "$")))
 600
 601 ; winrestcmd()                  String  returns command to restore window sizes
 602
 603 (def-vim-function "winwidth" (nr) (nil-or-number) result-number-or-nil
 604   "width of window {nr}")
 605
 606 ;;; ######################################################################
 607 ;;; Various utility functions
 608 ;;; ######################################################################
 609 (defmacro with-options (bindings &body body)
 610   "Set new values to existing Vim options; restores old values at exit.  Works
 611   with Vim variables, too, as long as they already exist.  If you only list a
 612   Vim-var, instead of a (var val) pair, the var is set to \"\"."
 613   (loop with var and val
 614         for binding in bindings
 615         for old-var = (gensym "old-var-")
 616         do (multiple-value-setq (var val)
 617              (if (typep binding 'list)
 618                (values-list binding)
 619                (values binding "")))
 620         collect `(,old-var (vim:var ,var)) into let-bindings
 621         collect `(vim:setq ,var ,val) into setup
 622         collect `(vim:setq ,var ,old-var) into teardown
 623         finally (return `(let ,let-bindings
 624                            ,@setup
 625                            (unwind-protect
 626                              (progn ,@body)
 627                              ,@teardown)))))
 628
 629 (defgeneric change-to-buffer (n)
 630   (:documentation "Changes to the given buffer.  Hides the current buffer."))
 631 (defmethod change-to-buffer ((name string))
 632   (change-to-buffer (vim:bufnr name)))
 633 (defmethod change-to-buffer ((number number))
 634   (vim:cmd "silent hide buffer " (1+ number)))
 635
 636 (defgeneric open-buffer (buffer)
 637   (:documentation "Opens a window on the given buffer."))
 638 (defmethod open-buffer ((number number))
 639   (vim:cmd "silent vert sb " (1+ number)))
 640 (defmethod open-buffer ((name string))
 641   (open-buffer (vim:bufnr name)))
 642
 643 (defun vsplit-p ()
 644   "True of the current tab is vertically split."
 645   (find-if (lambda (w) (plusp (vim:window-column w)))
 646            (vim:windows)))
 647
 648 (defmacro with-buffer (expr &body body)
 649   `(vim:with-options (("&guioptions"
 650                        (if (vim::vsplit-p)
 651                          (vim:var "&guioptions")
 652                          (remove-if (lambda (o) (find o "LR"))
 653                                     (vim:var "&guioptions")))))
 654      (unwind-protect
 655        (progn
 656          (vim:open-buffer ,expr)
 657          ,@body)
 658        (vim:close))))
 659
 660 (defun setq (var val)
 661   (check-type var string)
 662   (unless (typep val '(or number string))
 663     (setf val (prin1-to-string val)))
 664   (vim:cmd (format nil "let ~A = ~S" var val))
 665   val)
 666
 667 (defun var (var)
 668   "Get the value of a Vim variable.  If it's a string but looks like a number,
 669   returned as a number."
 670   (let ((val (vim:expr var)))
 671     (if (typep val 'string)
 672       (let ((length (length val)))
 673         (multiple-value-bind (n-val pos) (parse-integer val :junk-allowed t)
 674           (if (and n-val (= length pos))
 675             n-val
 676             val)))
 677       val)))
 678
 679 (defclass point ()
 680   ((bufnr :initarg :bufnr :accessor bufnr-of)
 681    (line :initarg :line :accessor line-of)
 682    (col :initarg :col :accessor col-of)
 683    (virtcol :initarg :virtcol :accessor virtcol-of)
 684    (winline :initarg :winline :accessor winline-of)))
 685
 686 (defun get-pos (&optional (where "."))
 687   "Get the buffer & position of the cursor; returns a POINT class."
 688   (if (vim:line where)
 689     (make-instance 'point
 690       :bufnr (vim:bufnr "%")
 691       :line (vim:line where)
 692       :col (vim:col where)
 693       :virtcol (vim:virtcol where)
 694       :winline (if (string= where ".") (vim:winline) nil))
 695     nil))
 696
 697 (defmacro get-pos-after (&body body)
 698   "Run some code; return the cursor position afterwards."
 699   `(progn ,@body (get-pos)))
 700
 701 (defun scroll-window (n)
 702   "Negative means scroll the window down, i.e. scroll the text up, using <c-e>.
 703   Positive means scroll the window up, i.e. scroll the text down, using <c-y>."
 704   ;; NOTE: use vim:execute, not vim:cmd, to get interpretation of the <c-e>, etc.
 705   (cond ((< n 0) (vim:execute (format nil "normal ~D\\<c-e>" (- n))))
 706         ((> n 0) (vim:execute (format nil "normal ~D\\<c-y>" n)))))
 707
 708 (defun position-window (want)
 709   "Scroll the window such that the current line of text is at the given window line.
 710   The top line is line 0.  If WANT is NIL, positions the current line in the
 711   middle of the screen."
 712   (if want
 713     (scroll-window (- want (vim:winline)))
 714     (position-window (truncate vim:winline 2))))
 715
 716 (defgeneric goto-pos (where))
 717 (defmethod goto-pos (where) nil)
 718 (defmethod goto-pos ((where point))
 719   (with-slots (bufnr line col virtcol winline) where
 720     (when (/= bufnr (vim:bufnr "%"))
 721       (change-to-buffer bufnr))
 722     (vim:cursor line virtcol)
 723     (position-window winline)))
 724
 725 (defun append-text-to-buffer (line)
 726   (vim:setline "$" (concatenate 'string (vim:getline "$") line)))
 727
 728 (defun multi-line-map (f text)
 729   (loop for start = 0 then (1+ end)
 730         for end = (position #\Newline text :start start)
 731         for line = (subseq text start end)
 732         do (cl:funcall f start end line)
 733         while end))
 734
 735 (defun append-multi-line-string (text)
 736   (vim:multi-line-map
 737     (lambda (start end line)
 738       (if (= start 0)
 739         (vim:append-text-to-buffer line)
 740         (vim:append (vim:line "$") line)))
 741     text))
 742
 743 (defun normal (str &rest rest)
 744   "Execute a normal-mode Vim command."
 745   (apply #'vim:cmd "normal " str rest))
 746
 747 (defun normal! (str &rest rest)
 748   "Execute a normal-mode Vim command w/out remapping."
 749   (apply #'vim:cmd "normal! " str rest))
 750
 751 (defun resolve-mapleader (lhs)
 752   "Find any mentions of <leader> in the lhs string and replace it with the
 753   current value of g:mapleader.  Searches case-insensitively."
 754   (let* ((mapleader (vim:var "g:mapleader"))
 755          (mapleader-string (if (stringp mapleader)
 756                              mapleader
 757                              (princ-to-string mapleader))))
 758     (loop for p = (cl:search "<leader>" lhs :test #'char-equal)
 759           while p
 760           do (setf lhs (concatenate 'string
 761                                     (subseq lhs 0 p)
 762                                     mapleader-string
 763                                     (subseq lhs (+ p 8))))
 764           finally (return lhs))))
 765
 766 (defvar *map-functions* (make-hash-table :test #'equal)
 767   "Store references to Lisp functions to which we have Vim mappings.")
 768
 769 (defparameter *vim-map-special-flags*
 770   (let ((h (make-hash-table))
 771         (flags '((:buffer "<buffer>")
 772                  (:silent "<silent>")
 773                  (:special "<special>")
 774                  (:script "<script>")
 775                  (:unique "<unique>")
 776                  (:expr "<expr>"))))
 777     (loop for (key val) in flags
 778           do (setf (gethash key h) val))
 779     h))
 780
 781 (defun xlat-map-flags (flags)
 782   "Translate a _list designator_ for Vim mapping flags (e.g. :buffer,
 783   etc.) into a string with the flags in it (e.g. \"<buffer> \")."
 784   (labels ((normalize-flags (flags)
 785              (etypecase flags
 786                (string (list flags))
 787                (symbol (list (gethash flags *vim-map-special-flags*)))
 788                (list (mapcan #'normalize-flags flags)))))
 789     (apply #'concatenate 'string
 790            (loop for (flag . rest) on (normalize-flags flags)
 791                  collect flag
 792                  if rest collect " "))))
 793
 794 (defun normalize-map-modes (modes)
 795   (labels ((normalize-mode (mode)
 796              (etypecase mode
 797                (null (list ""))
 798                (character (list (string mode)))
 799                (string (if (> (length mode) 1)
 800                          (cl:map 'list #'string mode)
 801                          (list mode)))
 802                (symbol (list (check-map-mode mode)))
 803                (list (mapcan #'normalize-mode mode)))))
 804     (loop for mode in (normalize-mode modes)
 805           if (listp mode) nconc mode
 806           else collect mode)))
 807
 808 (defun %call-map-function (lhs mode)
 809   "Call the mapped Lisp function for the given lhs."
 810   (cl:funcall (gethash (cons lhs mode) *map-functions*)))
 811
 812 (flet ((set-equals (s1 s2)
 813          (loop with max-length = (length s2)
 814                for item in s1
 815                for item-num upfrom 0
 816                always (and (< item-num max-length)
 817                            (member item s2 :test #'string=))
 818                finally (return (= item-num (1- max-length))))))
 819
 820   (defun can-bang (modes)
 821     (set-equals modes '("i" "c")))
 822
 823   (defun no-bang (modes)
 824     (set-equals modes '("n" "v" "o"))))
 825
 826 (defun vim:map (lhs rhs &key mode noremap flags)
 827   "Make a Vim mapping: lhs must be a string.  rhs can be a string or a
 828   function.  Mode can be a string, a keyword, or a list of keywords.  A string
 829   stands for itself, a keyword is translated to strings using
 830   vim::*map-modes*, and a list of keywords or strings is translated into a
 831   mapping for each mode.  No mode => "" => normal+visual-select+operator-
 832   pending modes. For map!, use :mode '(:insert :command)."
 833   (check-type lhs string)
 834   (labels ((map-string (bang rhs mode flags)
 835              (vim:cmd mode (when noremap "nore") "map" bang " " flags " " lhs " " rhs))
 836            (map-function (bang mode flags)
 837              (map-string
 838                bang
 839                (format nil ":ecl (vim::%call-map-function ~S ~S)<CR>" lhs mode)
 840                mode flags)
 841              (setf (gethash (cons lhs mode) *map-functions*) rhs)))
 842     (let ((normalized-mode (normalize-map-modes mode))
 843           bang)
 844       (cond
 845         ((can-bang normalized-mode) (setf bang "!"
 846                                           normalized-mode '("")))
 847         ((no-bang normalized-mode) (setf normalized-mode '(""))))
 848       (loop with flags = (xlat-map-flags flags)
 849             for mode in normalized-mode
 850             if (functionp rhs)
 851             do (map-function bang mode flags)
 852             else do (map-string bang rhs mode flags)))))
 853
 854 (defun vim:map! (lhs rhs &key noremap flags)
 855   "Convenience function: calls vim:map with modes :insert & :command."
 856   (vim:map lhs rhs :mode '("i" "c") :noremap noremap :flags flags))
 857
 858 (defun vim:unmap (lhs &key mode flags)
 859   "Unmap a string.  For unmap!, use :mode '(:insert :command)."
 860   (values-list
 861     (let ((normalized-mode (normalize-map-modes mode)))
 862       (when (equal normalized-mode '(""))
 863         (setf normalized-mode '("n" "v" "o")))
 864       (loop with flags = (xlat-map-flags flags)
 865             for mode in normalized-mode
 866             collect (let ((previous-mapping (vim:maparg lhs :mode mode)))
 867                       (when previous-mapping
 868                         (if (string= mode "")
 869                           (loop for mode in '("n" "v" "o" "")
 870                                 do (remhash (cons lhs mode) *map-functions*))
 871                           (remhash (cons lhs mode) *map-functions*))
 872                         (vim:cmd mode "unmap " (xlat-map-flags flags) lhs)
 873                         previous-mapping))))))
 874
 875 (defun vim:unmap! (lhs &key flags)
 876   "Convenience function: calls vim:unmap with modes :insert & :command."
 877   (vim:unmap lhs :mode '("i" "c") :flags flags))
 878
 879 (let ((signals '((:SIGHUP    . 1)
 880                  (:SIGINT    . 2)
 881                  (:SIGQUIT   . 3)
 882                  (:SIGILL    . 4)
 883                  (:SIGTRAP   . 5)
 884                  (:SIGABRT   . 6)
 885                  (:SIGFPE    . 8)
 886                  (:SIGKILL   . 9)
 887                  (:SIGBUS    . 10)
 888                  (:SIGSEGV   . 11)
 889                  (:SIGSYS    . 12)
 890                  (:SIGPIPE   . 13)
 891                  (:SIGALRM   . 14)
 892                  (:SIGTERM   . 15)
 893                  (:SIGURG    . 16)
 894                  (:SIGSTOP   . 17)
 895                  (:SIGTSTP   . 18)
 896                  (:SIGCONT   . 19)
 897                  (:SIGCHLD   . 20)
 898                  (:SIGTTIN   . 21)
 899                  (:SIGTTOU   . 22)
 900                  (:SIGIO     . 23)
 901                  (:SIGXCPU   . 24)
 902                  (:SIGXFSZ   . 25)
 903                  (:SIGVTALRM . 26)
 904                  (:SIGPROF   . 27)
 905                  (:SIGWINCH  . 28)
 906                  (:SIGINFO   . 29)
 907                  (:SIGUSR1   . 30)
 908                  (:SIGUSR2   . 31))))
 909 (defun vim:kill (pid sig)
 910  (assert (typep pid 'number))
 911  (assert (typep sig 'symbol))
 912  (let ((sig-num (cdr (assoc sig signals))))
 913   (when sig-num
 914    (kill-int pid sig-num)))))
 915
 916 (defun vim:wincmd (the-cmd &optional (n 0))
 917   (vim:cmd (1+ n) "wincmd " the-cmd))
 918
 919 (defun vim:close (&key bang)
 920   (if (cdr (vim:tabpagebuflist))
 921     (vim:cmd "close" (when bang "!"))
 922     (error "Can't vim:close: only one open window.")))
 923
 924 (defun vim:close! ()
 925   (vim:close :bang t))
 926
 927 (defmacro with-window (winnr &body body)
 928   "Run BODY in the context of the given window number.
 929   Signals an error if the given value is NIL or the number is out of range."
 930   (let ((winnr-once (gensym "winnr"))
 931         (cur-win (gensym "cur-win-")))
 932     `(let ((,winnr-once ,winnr))
 933        (if (and (numberp ,winnr-once)
 934                 (<= 0 ,winnr-once (vim:winnr "$")))
 935          (let ((,cur-win (vim:winnr)))
 936            (vim:with-options (("&winwidth" 1))
 937              (vim:wincmd "w" ,winnr-once)
 938              (unwind-protect
 939                (progn ,@body)
 940                (vim:wincmd "w" ,cur-win))))
 941          (error "Invalid window number ~A in with-window" ,winnr-once)))))
 942
 943 (defmacro with-window-of (buffer &body body)
 944   (let ((buffer-once (gensym "buffer-once-"))
 945         (body-func (gensym "body-func-"))
 946         (winnr (gensym "winnr")))
 947     `(flet ((,body-func () ,@body))
 948        (let* ((,buffer-once ,buffer)
 949               (,winnr (vim:bufwinnr ,buffer-once)))
 950          (if ,winnr
 951            (with-window ,winnr (,body-func))
 952            (with-buffer ,buffer-once (,body-func)))))))
 953