picolisp.el (30679B)
1 ;;;;;; picolisp-mode: Major mode to edit picoLisp. 2 ;;;;;; Version: 1.3 3 4 ;;; Copyright (c) 2009, Guillermo R. Palavecino 5 ;;; Copyright (c) 2011, 2012 Thorsten Jolitz 6 7 ;; This file is NOT part of GNU emacs. 8 9 ;;;; Credits: 10 ;; It's based on GNU emacs' lisp-mode and scheme-mode. 11 ;; Some bits were taken from paredit.el 12 ;; Two functions were copied from Xah Lee (http://xahlee.org/) 13 ;; 14 ;;;; Contact: 15 ;; For comments, bug reports, questions, etc, you can contact the 16 ;; first author via IRC to the user named grpala (or armadillo) on 17 ;; irc.freenode.net in the #picolisp channel or via email to the 18 ;; author's nickname at gmail.com 19 ;; 20 ;; Or contact the second author and curent maintainer via email: 21 ;; t <lastname in lowercase letters> AT gmail DOT com 22 ;; 23 ;;;; License: 24 ;; This work is released under the GPL 2 or (at your option) any later 25 ;; version. 26 27 28 (require 'lisp-mode) 29 30 (defcustom picolisp-parsep t 31 "This is to toggle picolisp-mode's multi-line s-exps closing parens separation capability." 32 :type 'boolean 33 :group 'picolisp ) 34 35 ;; I know... this shouldn't be here, but you see, people may want to keep 36 ;; their body-indent value unaltered and have a different one for picolisp 37 ;; sources, so... 38 (defcustom picolisp-body-indent 3 39 "Number of columns to indent the second line of a `(de ...)' form." 40 :group 'picolisp 41 :type 'integer ) 42 43 (defvar picolisp-mode-syntax-table 44 (let ((st (make-syntax-table)) 45 (i 0) ) 46 47 ;; Default is atom-constituent. 48 (while (< i 256) 49 (modify-syntax-entry i "_ " st) 50 (setq i (1+ i)) ) 51 52 ;; Word components. 53 (setq i ?0) 54 (while (<= i ?9) 55 (modify-syntax-entry i "w " st) 56 (setq i (1+ i)) ) 57 (setq i ?A) 58 (while (<= i ?Z) 59 (modify-syntax-entry i "w " st) 60 (setq i (1+ i)) ) 61 (setq i ?a) 62 (while (<= i ?z) 63 (modify-syntax-entry i "w " st) 64 (setq i (1+ i)) ) 65 66 ;; Whitespace 67 (modify-syntax-entry ?\t " " st) 68 (modify-syntax-entry ?\n "> " st) 69 (modify-syntax-entry ?\f " " st) 70 (modify-syntax-entry ?\r " " st) 71 (modify-syntax-entry ?\s " " st) 72 73 ;; These characters are delimiters but otherwise undefined. 74 ;; Brackets and braces balance for editing convenience. 75 (modify-syntax-entry ?\[ "(] " st) 76 (modify-syntax-entry ?\] ")[ " st) 77 (modify-syntax-entry ?{ "(} " st) 78 (modify-syntax-entry ?} "){ " st) 79 80 ;; Other atom delimiters 81 (modify-syntax-entry ?\( "() " st) 82 (modify-syntax-entry ?\) ")( " st) 83 ;; It's used for single-line comments. 84 (modify-syntax-entry ?# "< " st) 85 (modify-syntax-entry ?\" "\" " st) 86 (modify-syntax-entry ?' "' " st) 87 (modify-syntax-entry ?` "' " st) 88 (modify-syntax-entry ?~ "' " st) 89 90 ;; Special characters 91 (modify-syntax-entry ?, "' " st) 92 (modify-syntax-entry ?\\ "\\ " st) 93 st ) ) 94 95 (defvar picolisp-mode-abbrev-table nil) 96 (define-abbrev-table 'picolisp-mode-abbrev-table ()) 97 98 99 (defun picolisp-mode-variables () 100 (set-syntax-table picolisp-mode-syntax-table) 101 ;;(setq local-abbrev-table picolisp-mode-abbrev-table) 102 (make-local-variable 'paragraph-start) 103 (setq paragraph-start (concat "$\\|" page-delimiter)) 104 ;;(setq comint-input-ring-file-name "~/.pil_history") 105 106 (make-local-variable 'paragraph-separate) 107 (setq paragraph-separate paragraph-start) 108 109 (make-local-variable 'paragraph-ignore-fill-prefix) 110 (setq paragraph-ignore-fill-prefix t) 111 112 (make-local-variable 'fill-paragraph-function) 113 (setq fill-paragraph-function 'lisp-fill-paragraph) 114 ;; Adaptive fill mode gets in the way of auto-fill, 115 ;; and should make no difference for explicit fill 116 ;; because lisp-fill-paragraph should do the job. 117 (make-local-variable 'adaptive-fill-mode) 118 (setq adaptive-fill-mode nil) 119 120 (make-local-variable 'normal-auto-fill-function) 121 (setq normal-auto-fill-function 'lisp-mode-auto-fill) 122 123 (make-local-variable 'indent-line-function) 124 (setq indent-line-function 'picolisp-indent-line) 125 126 (make-local-variable 'parse-sexp-ignore-comments) 127 (setq parse-sexp-ignore-comments t) 128 129 (make-local-variable 'comment-start) 130 (setq comment-start "#") 131 132 (set (make-local-variable 'comment-add) 1) 133 (make-local-variable 'comment-start-skip) 134 ;; Look within the line for a # following an even number of backslashes 135 ;; after either a non-backslash or the line beginning. 136 (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)#+[ \t]*"); ((^|[^\n])(\\\\)*)#+[ t]* 137 (set (make-local-variable 'font-lock-comment-start-skip) "#+ *") 138 139 (make-local-variable 'comment-column) 140 (setq comment-column 40) 141 142 (make-local-variable 'parse-sexp-ignore-comments) 143 (setq parse-sexp-ignore-comments t) 144 145 (make-local-variable 'lisp-indent-function) 146 (setq lisp-indent-function 'picolisp-indent-function) 147 148 ;; This is just to avoid tabsize-variations fuck-up. 149 (make-local-variable 'indent-tabs-mode) 150 (setq indent-tabs-mode) 151 152 (setq dabbrev-case-fold-search t) 153 (setq dabbrev-case-replace nil) 154 155 (setq mode-line-process '("" picolisp-mode-line-process)) 156 (set (make-local-variable 'font-lock-defaults) 157 '((picolisp-font-lock-keywords 158 picolisp-font-lock-keywords-1 159 picolisp-font-lock-keywords-2 ) 160 nil t (("+-*/.<>=!?$%_&~^:" . "w")) 161 beginning-of-defun 162 (font-lock-mark-block-function . mark-defun) 163 (font-lock-keywords-case-fold-search . nil) 164 (parse-sexp-lookup-properties . t) 165 (font-lock-extra-managed-props syntax-table) ) ) 166 (set (make-local-variable 'lisp-doc-string-elt-property) 167 'picolisp-doc-string-elt ) ) 168 169 (defvar picolisp-mode-line-process "") 170 171 (defvar picolisp-mode-map 172 (let ((map (make-sparse-keymap "Picolisp"))) 173 (set-keymap-parent map lisp-mode-shared-map) 174 175 ;; more convenient than "C-ck" 176 (define-key map "\C-c\C-v" 'picolisp-edit-K) 177 ;; more convenient than "C-cq" 178 (define-key map "\C-c\C-c" 'picolisp-edit-Q) 179 ;; not necesary: picolisp-edit-Q exits on last undo 180 ;; (define-key map "\C-q" '(save-buffers-kill-terminal 1)) 181 182 (define-key map [menu-bar picolisp] (cons "Picolisp" map)) 183 (define-key map [run-picolisp] '("Run Inferior Picolisp" . run-picolisp)) 184 (define-key map [uncomment-region] 185 '("Uncomment Out Region" . (lambda (beg end) 186 (interactive "r") 187 (comment-region beg end '(4)) ) ) ) 188 (define-key map [comment-region] '("Comment Out Region" . comment-region)) 189 (define-key map [indent-region] '("Indent Region" . indent-region)) 190 (define-key map [indent-line] '("Indent Line" . picolisp-indent-line)) 191 (define-key map "\t" 'picolisp-indent-line) 192 (put 'comment-region 'menu-enable 'mark-active) 193 (put 'uncomment-region 'menu-enable 'mark-active) 194 (put 'indent-region 'menu-enable 'mark-active) 195 map ) 196 "Keymap for Picolisp mode. 197 All commands in `lisp-mode-shared-map' are inherited by this map." ) 198 199 200 ;;;###autoload 201 (defun picolisp-mode () 202 "Major mode for editing Picolisp code. 203 Editing commands are similar to those of `lisp-mode'. 204 205 Commands: 206 Delete converts tabs to spaces as it moves back. 207 Blank lines separate paragraphs. Semicolons start comments. 208 \\{picolisp-mode-map} 209 Entry to this mode calls the value of `picolisp-mode-hook' 210 if that value is non-nil." 211 (interactive) 212 (remove-text-properties (point-min) (point-max) '(display "")) 213 (kill-all-local-variables) 214 (use-local-map picolisp-mode-map) 215 (setq major-mode 'picolisp-mode) 216 (setq mode-name "Picolisp") 217 (picolisp-mode-variables) 218 (run-mode-hooks 'picolisp-mode-hook) 219 (defun paredit-delete-leading-whitespace () 220 (picolisp-delete-leading-whitespace) ) ) 221 222 (autoload 'run-picolisp "inferior-picolisp" 223 "Run an inferior Picolisp process, input and output via buffer `*picolisp*'. 224 If there is a process already running in `*picolisp*', switch to that buffer. 225 With argument, allows you to edit the command line (default is value 226 of `picolisp-program-name'). 227 Runs the hook `inferior-picolisp-mode-hook' \(after the `comint-mode-hook' 228 is run). 229 \(Type \\[describe-mode] in the process buffer for a list of commands.)" 230 t ) 231 232 (defgroup picolisp nil 233 "Editing Picolisp code." 234 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) 235 :group 'lisp ) 236 237 (defcustom picolisp-mode-hook nil 238 "Normal hook run when entering `picolisp-mode'. 239 See `run-hooks'." 240 :type 'hook 241 :group 'picolisp ) 242 243 244 (defconst picolisp-font-lock-keywords-1 245 (eval-when-compile 246 (list 247 ;; 248 ;; Declarations. 249 (list 250 (concat "(" (regexp-opt '("be" "de" "dm") t) "\\>" 251 ;; Any whitespace and declared object. 252 "[ \t]*" 253 "\\(\\sw+\\)?" ) 254 '(2 font-lock-function-name-face 255 nil t ) ) 256 (list (concat "\\<" 257 (regexp-opt '("NIL" "T") t) 258 "\\>" ) 259 '(1 font-lock-constant-face) ) 260 (list 261 (concat "\\<" 262 (regexp-opt '("*OS" "*DB" "*Solo" "*PPid" "*Pid" "@" "@@" "@@@" 263 "This" "*Dbg" "*Zap" "*Scl" "*Class" "*Dbs" "*Run" 264 "*Hup" "*Sig1" "*Sig2" "^" "*Err" "*Msg" "*Uni" 265 "*Led" "*Adr" "*Allow" "*Fork" "*Bye" ) t ) 266 "\\>" ) 267 '(1 font-lock-builtin-face) ) 268 ;; This is so we make the point used in conses more visible 269 '("\\<\\(\\.\\)\\>" (1 font-lock-negation-char-face)) 270 '("(\\(====\\)\\>" (1 font-lock-negation-char-face)) 271 (list ;; Functions that modify @ 272 (concat "(" 273 (regexp-opt '("prog1" "prog2" 274 "cond" "case" 275 "if" "if2" "ifn" 276 "when" "unless" 277 "and" "or" "nor" "not" 278 "nand" "nond" 279 "loop" "do" "while" "until" "for" 280 "state" ) t ) 281 "\\>" ) 282 '(1 font-lock-preprocessor-face) ) ) ) 283 "Subdued expressions to highlight in Picolisp modes." ) 284 285 286 (defconst picolisp-font-lock-keywords-2 287 (append picolisp-font-lock-keywords-1 288 (eval-when-compile 289 (list 290 ;; Control structures. 291 (cons 292 (concat 293 "(" (regexp-opt 294 '( ;; Symbol Functions 295 "new" "sym" "str" "char" "name" "sp?" "pat?" "fun?" "all" 296 "intern" "extern" "qsym" "loc" "box?" "str?" "ext?" 297 "touch" "zap" "length" "size" "format" "chop" "pack" 298 "glue" "pad" "align" "center" "text" "wrap" "pre?" "sub?" 299 "low?" "upp?" "lowc" "uppc" "fold" "val" "getd" "set" 300 "setq" "def" "de" "dm" "recur" "undef" "redef" "daemon" 301 "patch" "xchg" "on" "off" "onOff" "zero" "one" "default" 302 "expr" "subr" "let" "let?" "use" "accu" "push" "push1" 303 "pop" "cut" "del" "queue" "fifo" "idx" "lup" "cache" 304 "locale" "dirname" 305 ;; Property Access 306 "put" "get" "prop" ";" "=:" ":" "::" "putl" "getl" "wipe" ; 307 "meta" 308 ;; Predicates 309 "atom" "pair" "lst?" "num?" "sym?" "flg?" "sp?" "pat?" 310 "fun?" "box?" "str?" "ext?" "bool" "not" "==" "n==" "=" 311 "<>" "=0" "=T" "n0" "nT" "<" "<=" ">" ">=" "match" 312 ;; Arithmetics 313 "+" "-" "*" "/" "%" "*/" "**" "inc" "dec" ">>" "lt0" 314 "ge0" "gt0" "abs" "bit?" "&" "|" "x|" "sqrt" "seed" 315 "rand" "max" "min" "length" "size" "accu" "format" "pad" 316 "oct" "hex" "fmt64" "money" 317 ;; List Processing 318 "car" "cdr" "caar" "cadr" "cdar" "cddr" "caaar" "caadr" 319 "cadar" "caddr" "cdaar" "cdadr" "cddar" "cdddr" "cadddr" 320 "cddddr" "nth" "con" "cons" "conc" "circ" "rot" "list" 321 "need" "full" "make" "made" "chain" "link" "yoke" "copy" 322 "mix" "append" "delete" "delq" "replace" "insert" 323 "remove" "place" "strip" "split" "reverse" "flip" "trim" 324 "clip" "head" "tail" "stem" "fin" "last" "member" "memq" 325 "mmeq" "sect" "diff" "index" "offset" "assoc" "asoq" 326 "rank" "sort" "uniq" "group" "length" "size" "val" "set" 327 "xchg" "push" "push1" "pop" "cut" "queue" "fifo" "idx" 328 "balance" "get" "fill" "apply" "range" 329 ;; Control Flow 330 "load" "args" "next" "arg" "rest" "pass" "quote" "as" 331 "pid" "lit" "eval" "run" "macro" "curry" "def" "de" "dm" 332 "recur" "recurse" "undef" "box" "new" "type" "isa" 333 "method" "meth" "send" "try" "super" "extra" "with" 334 "bind" "job" "let" "let?" "use" "xor" "bool" "nil" "t" 335 "prog" "at" "catch" "throw" "finally" "!" "e" "$" "sys" 336 "call" "tick" "ipid" "opid" "kill" "quit" "task" "fork" 337 "pipe" "later" "timeout" "abort" "bye" 338 ;; Mapping 339 "apply" "pass" "maps" "map" "mapc" "maplist" "mapcar" 340 "mapcon" "mapcan" "filter" "extract" "seek" "find" "pick" 341 "cnt" "sum" "maxi" "mini" "fish" "by" 342 ;; Input/Output 343 "path" "in" "ipid" "out" "opid" "pipe" "ctl" "any" "sym" 344 "str" "load" "hear" "tell" "key" "poll" "peek" "char" 345 "skip" "eol" "eof" "from" "till" "line" "format" "scl" 346 "read" "print" "println" "printsp" "prin" "prinl" "msg" 347 "space" "beep" "tab" "flush" "rewind" "rd" "pr" "wr" 348 "rpc" "wait" "sync" "echo" "info" "file" "dir" "lines" 349 "open" "close" "port" "listen" "accept" "host" "connect" 350 "nagle" "udp" "script" "once" "rc" "pretty" "pp" "show" 351 "view" "here" "prEval" "mail" 352 ;; Object Orientation 353 "*Class" "class" "dm" "rel" "var" "var:" "new" "type" 354 "isa" "method" "meth" "send" "try" "object" "extend" 355 "super" "extra" "with" "This" 356 ;; Database 357 "pool" "journal" "id" "seq" "lieu" "lock" "begin" 358 "commit" "rollback" "mark" "free" "dbck" "rel" "dbs" 359 "dbs+" "db:" "fmt64" "tree" "root" "fetch" "store" 360 "count" "leaf" "minKey" "maxKey" "genKey" "useKey" "init" 361 "step" "scan" "iter" "prune" "zapTree" "chkTree" "db" 362 "aux" "collect" 363 ;; Pilog 364 "goal" "prove" "->" "unify" "?" 365 ;; Debugging 366 "pretty" "pp" "show" "loc" "debug" "vi" "ld" "trace" 367 "lint" "lintAll" "fmt64" 368 ;; System Functions 369 "cmd" "argv" "opt" "gc" "raw" "alarm" "protect" "heap" 370 "env" "up" "date" "time" "usec" "stamp" "dat$" "$dat" 371 "datSym" "datStr" "strDat" "expDat" "day" "week" "ultimo" 372 "tim$" "$tim" "telStr" "expTel" "locale" "allowed" 373 "allow" "pwd" "cd" "chdir" "ctty" "info" "dir" "dirname" 374 "call" "tick" "kill" "quit" "task" "fork" "pipe" 375 "timeout" "mail" "test" "bye" ) t ) 376 "\\>" ) 1 ) ) ) ) 377 "Gaudy expressions to highlight in Picolisp modes." ) 378 379 (defvar picolisp-font-lock-keywords picolisp-font-lock-keywords-1 380 "Default expressions to highlight in Picolisp modes." ) 381 382 (defconst picolisp-sexp-comment-syntax-table 383 (let ((st (make-syntax-table picolisp-mode-syntax-table))) 384 (modify-syntax-entry ?\n " " st) 385 (modify-syntax-entry ?# "." st) 386 st ) ) 387 388 (put 'lambda 'picolisp-doc-string-elt 2) 389 ;; Docstring's pos in a `define' depends on whether it's a var or fun def. 390 (put 'define 'picolisp-doc-string-elt 391 (lambda () 392 ;; The function is called with point right after "define". 393 (forward-comment (point-max)) 394 (if (eq (char-after) ?\() 2 0) ) ) 395 396 397 ;; Indentation functions 398 399 ;; Copied from lisp-indent-line, 400 ;; because Picolisp doesn't care about how many comment chars you use. 401 (defun picolisp-indent-line (&optional whole-exp) 402 "Indent current line as Picolisp code. 403 With argument, indent any additional lines of the same expression 404 rigidly along with this one." 405 (interactive "P") 406 (let ((indent (calculate-lisp-indent)) shift-amt end 407 (pos (- (point-max) (point))) 408 (beg (progn (beginning-of-line) (point))) ) 409 (skip-chars-forward " \t") 410 (if (or (null indent) (looking-at "\\s<\\s<\\s<")) 411 ;; Don't alter indentation of a ;;; comment line 412 ;; or a line that starts in a string. 413 (goto-char (- (point-max) pos)) 414 (if (listp indent) (setq indent (car indent))) 415 (setq shift-amt (- indent (current-column))) 416 (if (zerop shift-amt) 417 nil 418 (delete-region beg (point)) 419 (indent-to indent) ) ) 420 ;; If initial point was within line's indentation, 421 ;; position after the indentation. Else stay at same point in text. 422 (if (> (- (point-max) pos) (point)) 423 (goto-char (- (point-max) pos)) ) 424 ;; If desired, shift remaining lines of expression the same amount. 425 (and whole-exp (not (zerop shift-amt)) 426 (save-excursion 427 (goto-char beg) 428 (forward-sexp 1) 429 (setq end (point)) 430 (goto-char beg) 431 (forward-line 1) 432 (setq beg (point)) 433 (> end beg) ) 434 (indent-code-rigidly beg end shift-amt) ) ) ) 435 436 (defvar calculate-lisp-indent-last-sexp) 437 438 ;; Copied from lisp-indent-function, but with gets of 439 ;; picolisp-indent-{function,hook}, and minor modifications. 440 (defun picolisp-indent-function (indent-point state) 441 (picolisp-parensep) 442 (let ((normal-indent (current-column))) 443 (goto-char (1+ (elt state 1))) 444 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) 445 (if (and (elt state 2) 446 (not (looking-at "\"?\\sw\\|\\s_")) ) 447 ;; car of form doesn't seem to be a symbol 448 (progn 449 (if (not (> (save-excursion (forward-line 1) (point)) 450 calculate-lisp-indent-last-sexp ) ) 451 (progn (goto-char calculate-lisp-indent-last-sexp) 452 (beginning-of-line) 453 (parse-partial-sexp (point) 454 calculate-lisp-indent-last-sexp 0 t ) ) ) 455 ;; Indent under the list or under the first sexp on the same 456 ;; line as calculate-lisp-indent-last-sexp. Note that first 457 ;; thing on that line has to be complete sexp since we are 458 ;; inside the innermost containing sexp. 459 (backward-prefix-chars) 460 (current-column) ) 461 (let* ((function (buffer-substring (point) 462 (progn (forward-sexp 1) (point)) ) ) 463 (method (or (get (intern-soft function) 'picolisp-indent-function) 464 (get (intern-soft function) 'picolisp-indent-hook) 465 ;;(and picolisp-indent-style 'picolisp-indent-defform) 466 'picolisp-indent ) ) ) 467 (if (integerp method) 468 (lisp-indent-specform method state indent-point normal-indent) 469 (funcall (if (save-excursion 470 (let ((state9 (reverse (elt state 9)))) 471 (when (cadr state9) 472 (goto-char (+ 1 (cadr (reverse (elt state 9))))) 473 (and (looking-at "let\\|use") 474 (save-excursion 475 (forward-sexp) 476 (forward-sexp) 477 (backward-sexp) 478 (when (equal (point) (car state9)) 479 (looking-at "(") ) ) ) ) ) ) 480 'picolisp-indent-let 481 method ) 482 state indent-point normal-indent ) ) ) ) ) ) 483 484 485 ;;; Some functions are different in picoLisp 486 (defun picolisp-indent (state indent-point normal-indent) 487 (let ((lisp-body-indent picolisp-body-indent)) 488 (lisp-indent-defform state indent-point) ) ) 489 490 (defun picolisp-indent-let (state indent-point normal-indent) 491 (goto-char (cadr state)) 492 (forward-line 1) 493 (if (> (point) (elt state 2)) 494 (progn 495 (goto-char (car (cdr state))) 496 (+ 1 (current-column)) ) ) ) 497 498 499 ;;; This is to space closing parens when they close a previous line. 500 (defun picolisp-parensep () 501 (save-excursion 502 (condition-case nil ; This is to avoid fuck-ups when there are 503 (progn ; unbalanced expressions. 504 (up-list) 505 (back-to-indentation) 506 (while (and (re-search-forward ")" (line-end-position) t) 507 (< (point) (line-end-position)) ) 508 (if (and (not (picolisp-in-comment-p)) 509 (not (picolisp-in-string-p)) ) 510 (picolisp-delete-leading-whitespace) ) ) 511 (if (and (not (picolisp-in-comment-p)) 512 (not (picolisp-in-string-p)) ) 513 (picolisp-delete-leading-whitespace) ) ) 514 (error nil) ) ) ) 515 516 (defun picolisp-delete-leading-whitespace () 517 ;; This assumes that we're on the closing delimiter already. 518 (save-excursion 519 (backward-char) 520 (while (let ((syn (char-syntax (char-before)))) 521 (and (or (eq syn ?\ ) (eq syn ?-)) ; whitespace syntax 522 ;; The above line is a perfect example of why the 523 ;; following test is necessary. 524 (not (picolisp-in-char-p (1- (point)))) ) ) 525 (backward-delete-char 1) ) ) 526 (when (and (equal 'picolisp-mode major-mode) ; We don't want to screw-up 527 ; the formatting of other buffers making 528 ; use of paredit, do we? 529 (not (picolisp-in-string-p)) ) 530 (let ((another-line? (save-excursion 531 (backward-sexp) 532 (line-number-at-pos) ) ) ) 533 (if (< another-line? (line-number-at-pos)) 534 (save-excursion 535 (backward-char) 536 (when picolisp-parsep 537 (insert " ") ) ) ) ) ) ) 538 539 540 ;; Parser functions 541 542 (defun picolisp-current-parse-state () 543 "Return parse state of point from beginning of defun." 544 (let ((point (point))) 545 (beginning-of-defun) 546 ;; Calling PARSE-PARTIAL-SEXP will advance the point to its second 547 ;; argument (unless parsing stops due to an error, but we assume it 548 ;; won't in picolisp-mode). 549 (parse-partial-sexp (point) point) ) ) 550 551 (defun picolisp-in-string-p (&optional state) 552 "True if the parse state is within a double-quote-delimited string. 553 If no parse state is supplied, compute one from the beginning of the 554 defun to the point." 555 ;; 3. non-nil if inside a string (the terminator character, really) 556 (and (nth 3 (or state (picolisp-current-parse-state))) 557 t ) ) 558 (defun picolisp-in-comment-p (&optional state) 559 "True if parse state STATE is within a comment. 560 If no parse state is supplied, compute one from the beginning of the 561 defun to the point." 562 ;; 4. nil if outside a comment, t if inside a non-nestable comment, 563 ;; else an integer (the current comment nesting) 564 (and (nth 4 (or state (picolisp-current-parse-state))) 565 t ) ) 566 567 (defun picolisp-in-char-p (&optional argument) 568 "True if the point is immediately after a character literal. 569 A preceding escape character, not preceded by another escape character, 570 is considered a character literal prefix. (This works for elisp, 571 Common Lisp, and Scheme.) 572 Assumes that `picolisp-in-string-p' is false, so that it need not handle 573 long sequences of preceding backslashes in string escapes. (This 574 assumes some other leading character token -- ? in elisp, # in Scheme 575 and Common Lisp.)" 576 (let ((argument (or argument (point)))) 577 (and (eq (char-before argument) ?\\) 578 (not (eq (char-before (1- argument)) ?\\)) ) ) ) 579 580 (add-to-list 'auto-mode-alist '("\\.l$" . picolisp-mode)) 581 582 583 ;; The following two functions implement the K and Q (macro) 584 ;; functionality used in Vi while editing a buffer opened from the 585 ;; PicoLisp command-line with the 'edit' function. 586 587 (defun picolisp-edit-K () 588 "Write symbol at point with line number in last line of edit-buffer. 589 590 If the symbol is a transient symbol, write it with double-quotes, 591 otherwise as unquoted word. The output-format is: 592 593 \(<line-number> <symbol>\) 594 e.g. 595 \(50 edit\) 596 \(56 \"edit\"\) 597 598 when point is on the edit or \(transient\) \"edit\" symbol in the 599 PicoLisp sourcefile edit.l and `picolisp-edit-K' is called (the 600 line-numbers may be different in your version of edit.l). 601 602 Recognition of transient symbols works by getting the 603 text-property 'face' at point and checking if it is equal to 604 'font-lock-string-face'. Thus, this function works correctly only 605 if the edit-buffer is in an Emacs major-mode that fontifies 606 strings with 'font-lock-string-face' \(like `picolisp-mode' 607 does\)." 608 609 (interactive) 610 (save-excursion 611 (save-restriction 612 (widen) 613 (unless (mark 'FORCE) 614 (forward-word) 615 (forward-word -1) 616 (mark-word)) 617 (let* ((thing (thing-at-point 'word)) 618 (unit (get-selection-or-unit 'word)) 619 (line (line-number-at-pos)) 620 (transient-p 621 (string-equal (get-text-property (point) 'face) 622 "font-lock-string-face")) 623 (k-list nil)) 624 (setq k-list (list line 625 (if transient-p 626 (elt unit 0) 627 (make-symbol (elt unit 0))))) 628 (message "K-list: %S transient: %S" k-list transient-p) 629 (goto-char (max-char)) 630 (newline) 631 (insert (format "%S" k-list)) 632 (save-buffers-kill-terminal 1))))) 633 634 635 (defun picolisp-edit-Q () 636 "Write '(0)' in last line of PicoLisp edit-buffer." 637 (interactive) 638 (save-excursion 639 (save-restriction 640 (widen) 641 (goto-char (max-char)) 642 (newline) 643 (insert "(0)") 644 (save-buffers-kill-terminal 1)))) 645 646 647 ;; The following two functions have been written by Xah Lee and copied 648 ;; from: http://ergoemacs.org/emacs/elisp_get-selection-or-unit.html 649 650 (defun get-selection-or-unit (unit) 651 "Return the string and boundary of text selection or UNIT under cursor. 652 653 If `region-active-p' is true, then the region is the unit. Else, 654 it depends on the UNIT. See `unit-at-cursor' for detail about 655 UNIT. 656 657 Returns a vector [text a b], where text is the string and a and b 658 are its boundary. 659 660 Example usage: 661 (setq bds (get-selection-or-unit 'line)) 662 (setq inputstr (elt bds 0) p1 (elt bds 1) p2 (elt bds 2) )" 663 (interactive) 664 665 (let ((p1 (region-beginning)) (p2 (region-end))) 666 (if (region-active-p) 667 (vector (buffer-substring-no-properties p1 p2) p1 p2 ) 668 (unit-at-cursor unit) ) ) ) 669 670 ;; This function get-selection-or-unit gets you the text selection if 671 ;; there's one. If not, it calls unit-at-cursor. unit-at-cursor 672 673 (defun unit-at-cursor (unit) 674 "Return the string and boundary of UNIT under cursor. 675 676 Returns a vector [text a b], where text is the string and a and b are its boundary. 677 678 UNIT can be: 679 • 'word — sequence of 0 to 9, A to Z, a to z, and hyphen. 680 • 'glyphs — sequence of visible glyphs. Useful for file name, URL, …, that doesn't have spaces in it. 681 • 'line — delimited by “\\n”. 682 • 'block — delimited by “\\n\\n” or beginning/end of buffer. 683 • 'buffer — whole buffer. (respects `narrow-to-region') 684 • a vector [beginRegex endRegex] — The elements are regex strings used to determine the beginning/end of boundary chars. They are passed to `skip-chars-backward' and `skip-chars-forward'. For example, if you want paren as delimiter, use [\"^(\" \"^)\"] 685 686 Example usage: 687 (setq bds (unit-at-cursor 'line)) 688 (setq myText (elt bds 0) p1 (elt bds 1) p2 (elt bds 2) ) 689 690 This function is similar to `thing-at-point' and `bounds-of-thing-at-point'. 691 The main differences are: 692 • this function returns the text and the 2 boundaries as a vector in one shot. 693 • 'line always returns the line without end of line character, avoiding inconsistency when the line is at end of buffer. 694 • 'word does not depend on syntax table. 695 • 'block does not depend on syntax table." 696 (let (p1 p2) 697 (save-excursion 698 (cond 699 ( (eq unit 'word) 700 (let ((wordcharset "-A-Za-zÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ")) 701 (skip-chars-backward wordcharset) 702 (setq p1 (point)) 703 (skip-chars-forward wordcharset) 704 (setq p2 (point))) 705 ) 706 707 ( (eq unit 'glyphs) 708 (progn 709 (skip-chars-backward "[:graph:]") 710 (setq p1 (point)) 711 (skip-chars-forward "[:graph:]") 712 (setq p2 (point))) 713 ) 714 715 ( (eq unit 'buffer) 716 (progn 717 (setq p1 (point-min)) 718 (setq p2 (point-max)) 719 ) 720 ) 721 722 ((eq unit 'line) 723 (progn 724 (setq p1 (line-beginning-position)) 725 (setq p2 (line-end-position)))) 726 ((eq unit 'block) 727 (progn 728 (if (re-search-backward "\n\n" nil t) 729 (progn (forward-char 2) 730 (setq p1 (point) ) ) 731 (setq p1 (line-beginning-position) ) 732 ) 733 734 (if (re-search-forward "\n\n" nil t) 735 (progn (backward-char) 736 (setq p2 (point) )) 737 (setq p2 (line-end-position) ) ) )) 738 739 ((vectorp unit) 740 (let (p0) 741 (setq p0 (point)) 742 (skip-chars-backward (elt unit 0)) 743 (setq p1 (point)) 744 (goto-char p0) 745 (skip-chars-forward (elt unit 1)) 746 (setq p2 (point)))) 747 ) ) 748 749 (vector (buffer-substring-no-properties p1 p2) p1 p2 ) 750 ) ) 751 752 753 ;; tsm-mode 754 (require 'tsm) 755 756 (ignore-errors 757 (when tsm-lock 758 (font-lock-add-keywords 'picolisp-mode tsm-lock) 759 (font-lock-add-keywords 'inferior-picolisp-mode tsm-lock) ) ) 760 761 (provide 'picolisp)