Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

マニュアルファイルの更新、それに伴うemacs.elのマイナーチェンジ

  • Loading branch information...
commit 24342feec75860f2689edcf9652000521a044659 1 parent 27d53cb
@kosh04 authored
Showing with 19,496 additions and 20,009 deletions.
  1. +12 −7 README.md
  2. +138 −380 init.lsp
  3. +481 −402 newlisp.el
  4. +18,865 −19,220 newlisp_manual.txt
View
19 README.md
@@ -15,6 +15,10 @@ init.lsp
--------
雑多な関数群。
+* nl-modules.git - その他モジュール
+
+ <http://github.com/kosh04/nl-modules>
+
newlisp.el
----------
@@ -22,20 +26,21 @@ Emacsで編集するための簡易メジャーモード。
何が出来るのか
-- newlispファイルの編集
-- newlisp プロセスの起動、操作
-- リージョンのEval (eval-region, eval-last-sexp)
+- ファイルの編集
+- プロセスの起動、操作
+- リージョンの評価 (eval-region, eval-last-sexp)
- シンタックスハイライト
+- 関数名の補完 (組み込み関数のみ)
-newlisp_manual.txt (v.10.1.0 rev 4)
+newlisp_manual.txt (v.10.1.7)
-----------------------------------
HTMLマニュアルをテキストに変換したもの。
-newLISP Manual and Reference - <http://www.newlisp.org/downloads/newlisp_manual.html>
-
-* newlisp_manual.txt.tar.gz - 上記のファイルを圧縮したもの
+newLISP Manual and Reference
+<http://www.newlisp.org/downloads/newlisp_manual.html>
+* newlisp_manual.txt.tar.gz - 上記のファイルを圧縮したもの (v.10.1.0 rev 4)
swank-newlisp.lsp
-----------------
View
518 init.lsp
@@ -1,44 +1,58 @@
-;;; -*- encoding: utf-8 -*-
-;;;
-;;; init.lsp --- newLISP initialization file
-;;;
+;;; init.lsp -*- encoding: utf-8 -*-
-(let ((e (env "NEWLISPDIR")))
- (when (and e (not (directory? e)))
- (println "warning: directory " e " not found.")))
-
-(constant 'stdin 0 'stdout 1 'stderr 2)
-
-(define (find-symbol str (cxt (context)))
- (sym str cxt nil))
-
-;; (protected? 'define) => true
-;; (primitive? 'define) => nil
-(define (builtin? symbol)
- (or (primitive? (eval symbol))
- (starts-with (string symbol) "$") ; $0 ... $15
- ;; or more symbols
- (member symbol '(nil true ostype MAIN Tree Class @))
- ))
-;; (define builtin? protected?)
+;; TODO:
+;; * newLISPコテコテの関数を使うべきか、なるべくLISP準拠にするべきか
-(define (user-symbols)
- (filter (lambda (s) (not (builtin? s)))
- (symbols)))
+;; NOTE:
+;; 他のライブラリが再定義する可能性があるので
+;; 以下は極力ここでは利用しないこと
+;; * 定数
+;; * Context
-(define (apropos str (do-print nil))
+(define (apropos str (do-print true))
"Return symbols that matches the regexp."
- (let (acc)
- (dolist (symbol (symbols))
- (if (find str (string symbol) 1)
- (push symbol acc -1)))
- (if (and acc do-print)
- (silent (dolist (i acc)
- (println i)))
- acc)))
-
-(define top-level reset)
-(define restart reset)
+ (let ((acc (find-all str (symbols) $it
+ (lambda (x y)
+ (regex x (name y))))))
+ (when (and acc do-print)
+ (dolist (item acc)
+ (cond
+ ((primitive? (eval item))
+ (println item "\t" "<primitive>"))
+ ((lambda? (eval item))
+ (println item "\t" "<lambda>"))
+ ((macro? (eval item))
+ (println item "\t" "<macro>"))
+ ("else"
+ (println item)))))
+ acc))
+
+(define (use libname)
+ (load (or (exists file?
+ (list
+ libname
+ (append (env "NEWLISPDIR") "/modules/" libname)
+ (append (env "HOME") "/share/newlisp/modules/" libname)
+ ))
+ (throw-error (list "No such module" libname)))))
+
+(define (load-guiserver (nomsg nil))
+ (unless nomsg (print "loading guiserver..."))
+ (load (append (env "NEWLISPDIR") "/guiserver.lsp"))
+ (gs:init)
+ (unless nomsg (print "done."))
+ true)
+
+;; @syntax (aif test then [else])
+(define-macro (aif)
+ "anaphoric if"
+ (let (it (eval (args 0)))
+ (if it
+ (eval (args 1))
+ (eval (cons 'begin (2 (args)))))))
+
+(define top-level (lambda () (reset nil)))
+(define restart (lambda () (reset true)))
(define (utf8?)
"Non-nil means newLISP is UTF-8 eoncoding are supported."
@@ -50,375 +64,119 @@
(define (getpid) (sys-info -3)) ; Return the Process ID of newLISP.
(define (getppid) (sys-info -4))
-(define newlisp-pid getpid)
;; (import "libc.so.6" "getpid")
-;; こちらは[parent]newlisp->[child]newlispではなくbash(emacs)->newlisp
+;; こっちは[parent-pid]sh or emacs -> [child-pid]newlisp
;; (import "libc.so.6" "getppid")
;; see newlisp.h
(define COMPARE_TYPE_MASK 0x000F)
-(define Cell:types
+(define type-of:types
'("bool" "bool" "integer" "float" "string"
"symbol" "context" "primitive" "cdecl" "stdcall"
"quote" "list" "lambda" "macro" "array"))
-(define (type-of x)
- (Cell:types (& COMPARE_TYPE_MASK ((dump x) 1))))
-
-(define (load-guiserver)
- (silent
- (print "loading guiserver...")
- (load (real-path (append (env "NEWLISPDIR") "/guiserver.lsp")))
- (gs:init)
- (print "done.")))
-
-(define (load-init)
- (load (real-path (string (env "NEWLISPDIR") "/init.lsp"))))
-
-(define declare (lambda-macro () nil))
-
-(define (xml-parse-file file parse-dtd parse-ns)
- (declare (ignore parse-dtd parse-dtd))
- (let ((tags (xml-type-tags)))
- (local (e)
- (xml-type-tags nil 'cdata '!-- nil)
- (if (catch (xml-parse (read-file file) (+ 1 2 8)) 'e)
- (begin (apply xml-type-tags tags) e)
- (begin (apply xml-type-tags tags) (throw-error e))))))
-
-;; (define (xml-parse-file file parse-dtd parse-ns)
-;; (let ((tags (xml-type-tags)))
-;; (unwind-protect
-;; (xml-parse (read-file file) (+ 1 2 8))
-;; (apply xml-type-tags tags))))
-
-(setq default-xml-type-tags (xml-type-tags))
-;; ファイルから読み込むと効かない?
-;; (xml-type-tags nil 'cdata '!-- nil)
-
-; (constant (global 'cdr) rest) ; 全ての名前空間で使えるように
-(define-macro (define-cl-function)
- (constant (global (args 0)) (eval (args 1))))
-(define (null x) (not (true? x)))
-;; (constant (global 't) true)
-;; (define car first)
-(define (car seq)
- (if (member seq '(nil ())) nil (first seq)))
-(define cdr rest)
-(define defconstant
- (lambda-macro ()
- (constant (args 0) (eval (args 1)))))
-(define export global)
-(define progn begin)
-(define (funcall f) (apply f (args)))
-(define let* letn)
-(define lexical-let letex) ; from Emacs cl-package
-(define intern sym) ; or make-symbol
-(define symbol-name name)
-(define char-code char) ; (char "A") => 65
-(define code-char char) ; (char 65) => "A"
-(define rplaca ; (rplaca x y)
- (lambda-macro ()
- (setf (first (eval (args 0))) (eval (args 1)))
- (eval (args 0))))
-(define rotatef swap)
-(define complement
- (lambda-macro ()
- (letex ((f (args 0)))
- (lambda ()
- (not (apply f (args)))))))
-(define identity
- (lambda-macro ()
- (eval (args 0))))
-
-(define read-from-string read-expr)
-
-;; Simple LOOP
+(define (type-of:type-of x)
+ (type-of:types (& COMPARE_TYPE_MASK ((dump x) 1))))
+
+;; simple loop
(define-macro (loop)
(let ((return throw))
- (catch (while true
- (map eval (args))))))
-
-(define printf format)
-
-;;; @@filesystem, pathname
-(define (merge-pathnames pathname (defaults "."))
- (real-path (cond ((file? pathname) pathname)
- ((starts-with pathname "~/")
- (append (env "HOME") (1 pathname)))
- ((regex "^[\\|/]" pathname) pathname)
- (true (append defaults "/" pathname)))))
-(define (user-homedir-pathname) (real-path))
-(define (pwd) (real-path))
-(define (namestring pathname) (merge-pathnames pathname))
-(define set-default-directory change-dir)
-;; (define cd change-dir)
-(define (cd path)
- (change-dir (or path (env "HOME") "/")))
-(define cat read-file)
-(define (file-exist-p pathname)
- (or (file? pathname)
- (directory? pathname)))
-(define (probe-file pathname)
- (and (file? pathname)
- (real-path pathname)))
-
-(define (file-length pathname)
- "Retun PATHNAMEs file size as byte."
- (nth 0 (file-info pathname)))
-
-(define (getenv variable) (env variable))
-(define (setenv variable value) (env variable value))
-;; (define getenv env)
-;; (define setenv env)
-
-;;; @@number
-(constant 'most-positive-fixnum 0x7fffffffffffffff)
-(constant 'most-negative-fixnum 0x8000000000000000)
-(defconstant pi (mul (atan 1) 4)) ; 3.141592654 (mul (acos 0) 2)
-(define equal =)
-(define incf inc)
-(define decf dec)
-(define (plusp number) (< 0 number)) ; or (> number) , (sgn number nil nil true)
-(define (minusp number) (< number 0)) ; or (< number) , (sgn number true nil nil)
-(define (ash i cnt) (sgn cnt (>> i (abs cnt)) i (<< i cnt)))
-(define logand &)
-(define logxor ^)
-(define logior |)
-(define lognot ~)
-(define expt pow)
-;; 全ての数が異なればtrue.
-(define (/= number)
- "true if NUMBER and rest numbers are different all. otherwise nil."
- (for-all (lambda (x) (not (= x number))) (args)))
-;; (/= 1 2 3 1) ; nil
-;; (!= 1 2 3 1) ; true ?
+ (catch (while true (map eval (args))))))
+
+;; (define (printf) (print (apply format (args))))
+(case ostype
+ ("Win32"
+ (import "msvcrt.dll" "printf")
+ (import "msvcrt.dll" "fflush"))
+ ("Linux"
+ (import "libc.so.6" "printf")
+ (import "libc.so.6" "fflush")))
;; treat integer operators (+-*/) as float operators (add sub mul div).
-;; (constant '+ add '- sub '* mul '/ div)
-
-;;; @@list
-(define intersection intersect)
-(define set-difference difference)
-(define butlast chop)
-(define (nthcdr n lst) (slice lst n))
-(define (common-lisp:last lst (n 1))
- ((- n) lst))
-(define every for-all)
-(define (some f lst)
- (dolist (obj lst (f obj))))
-(define position find)
-(define find-if exists)
-(define remove-duplicates unique)
-(define (remove item seq)
- (if (string? seq)
- (replace item seq "")
- (replace item seq)))
-;; (define (remove-if f seq) (filter (lambda (x) (not (f x))) seq))
-(define remove-if clean)
-(define remove-if-not filter)
-(define common-lisp:delete ; 破壊的な意味で
- (lambda-macro ()
- (if (string? (eval (args 1)))
- (replace (eval (args 0)) (eval (args 1)) "")
- (replace (eval (args 0)) (eval (args 1))))))
-(define (mapcar f lst)
- "syntax: (mapcar function list &rest more-lists)"
- (letn ((lists (cons lst (args)))
- (minlength (apply min (map length lists))))
- (apply map (cons f (map (lambda (x)
- (slice x 0 minlength))
- lists)))))
-;; (mapcar list '(1 2 3 4) '(10 nil 30) '(100 200 300 400 500 600))
-;; => ((1 10 100) (2 nil 200) (3 30 300))
-;; (map list '(1 2 3 4) '(10 nil 30) '(100 200 300 400 500 600))
-;; => ((1 10 100) (2 nil 200) (3 30 300) (4 nil 400))
-
-;;; @@sequence, regexp
-(define split-string parse)
-(define concat string)
-(define copy-seq copy)
-(define string-upcase upper-case)
-(define string-downcase lower-case)
-(define string-capitalize title-case)
-(define compile-regexp regex-comp)
-
-;; (subseq nil 0) => nil [CL]
-(define (subseq seq start end)
- (cond (end (slice seq start (- end start)))
- (true (slice seq start))))
-
-(define (string-match regexp str (start 0) end)
- (regex regexp (subseq str start end)))
-
-(define (substitute-string str pattern replacement)
- (replace pattern str replacement))
-
-(define (regex-quote regexp (extended nil))
- (let (acc)
- (dolist (x (explode regexp))
- (if (member x '("$" "^" "." "*" "[" "]" "\\" "+" "?"))
- (push "\\" acc -1))
- (push x acc -1))
- (apply string acc)))
-(define regexp-quote regex-quote)
-
-(define (string-equal string1 string2)
- "Compare two strings ignore case."
- (let ((PCRE_CASELESS 1))
- (list? (regex (string "^" (regex-quote string1) "$")
- string2
- PCRE_CASELESS))))
-
-(define (string-left-trim char-bag str)
- (if (string? char-bag)
- (setq char-bag (map char (explode char-bag))))
- (catch
- (dostring (c str)
- (unless (member c char-bag)
- (throw (slice str $idx))))))
-
-(define (string-right-trim char-bag str)
- (if (string? char-bag)
- (setq char-bag (map char (explode char-bag))))
- (catch
- (dostring (c (reverse (copy str)))
- (unless (member c char-bag)
- (throw (slice str 0 (- (length str) $idx)))))))
-
-(define (string-trim char-bag str)
- (string-right-trim char-bag (string-left-trim char-bag str)))
-
-;; (define (string-trim char-bag str) (trim str char-bag char-bag))
-;; (define (string-left-trim char-bag str) (trim str char-bag ""))
-;; (define (string-right-trim char-bag str) (trim str "" char-bag))
-
-(define (elt seq idx)
- (cond ((string? seq) (char seq idx))
- (true (seq idx))))
-
-;;; @@error
-(define error throw-error)
-
-;; (context 'ignore-errors)
-;; (define-macro (ignore-errors:ignore-errors)
-;; (letex ((body (cons 'begin (args))))
-;; (local (result)
-;; (if (catch body 'result) result nil))))
-;; (context MAIN)
-
-(define (prin1-to-string obj)
- (cond ((string? obj) (format"\"%s\"" (replace "\\" obj "\\\\")))
- ("else" (string obj))))
-
-(define-macro (ignore-errors)
- (eval-string (prin1-to-string (args 0)) (context) nil))
-
-(context 'unwind-protect)
-(define-macro (unwind-protect:unwind-protect)
- "syntax: (unwind-protext protected-form cleanup-form*)"
- (letex ((body (first (args)))
- (cleanup-form* (cons 'begin (rest (args)))))
- (local (*result*)
- (if (catch body '*result*)
- (begin cleanup-form* *result*)
- (begin cleanup-form* (print "\n" *result* "\n") nil))))) ; ? throw-error
-(context MAIN)
+;(constant '+ add '- sub '* mul '/ div)
+
+(define array->list array-list)
+
+(define (perm seq n)
+ "SEQから重複なしでランダムにN個の要素を選択する."
+ (let ((len (length seq)))
+ (slice (if (empty? seq)
+ seq
+ (select seq (randomize (sequence 0 (- len 1)))))
+ 0 (or n len))))
+;(perm "newLISP") => "LSwePIn"
-(define (pathname? str)
- (or (file? str)
- (directory? str)))
+(define (error)
+ (throw-error (apply format (args))))
-(define (curl url) (silent) (print (get-url url)))
-(define (curl--head url) (print (get-url url "header")) (silent))
+(define (errno)
+ (nth 0 (sys-error)))
+
+(define (curl url) (print (get-url url)) true)
+(define (curl--head url) (print (get-url url "header")) true)
(define curl-I curl--head)
;; (curl--head "http://www.newlisp.org/")
-(define *html-manual*
- (or (exists file?
- (list (string (env "NEWLISPDIR") "/newlisp_manual.html")
- "/usr/share/doc/newlisp/newlisp_manual.html"))
- "http://www.newlisp.org/newlisp_manual.html"))
-
-(define (arglist fname)
- (let ((def (eval fname)))
- (cond ((primitive? def)
- (setq fname (name fname))
- (if (find fname "|+*-")
- (push "\\" fname)) ; ex: "*" => "\\*"
- ;; 置換の順番間違えると s/&lt;/&amp;lt; になるので注意 (`&' は最初に置換)
- (replace "&" fname "&amp;")
- (replace "<" fname "&lt;")
- (replace ">" fname "&gt;")
- ;; 複数行だと見つからないな(xml-type-tags)
- (let ((html (join (find-all (format {<b>(syntax: \(%s[\) ].*?)</b>} fname)
- (read-file *html-manual*))
- "\n")))
- (replace "<.*?>" html "" 0)
- (replace "&lt;" html "<")
- (replace "&gt;" html ">")
- (replace "&amp;" html "&")
- (println html)
- ;; 見つかった?
- (not (empty? html))))
- ((or (lambda? def)
- (macro? def))
- ;; ユーザ定義の関数、マクロ
- ;; (args)が使われていて、引数が少ない可能性もあるので注意。特にマクロ
- (cons fname (first def))))))
-
-;; (setq
-;; PCRE_CASELESS 1
-;; PCRE_MULTILINE 2
-;; PCRE_DOTALL 4
-;; PCRE_EXTENDED 8
-;; PCRE_ANCHORED 16
-;; PCRE_DOLLAR_ENDONLY 32
-;; PCRE_EXTRA 64
-;; PCRE_NOTBOL 128
-;; PCRE_NOTEOL 256
-;; PCRE_UNGREEDY 512
-;; PCRE_NOTEMPTY 1024
-;; PCRE_UTF8 2048
-;; REPLACE_ONCE 0x8000
-;; PRECOMPILED 0x10000
-;; )
+(define nslookup net-lookup)
(define (shell-command-to-string str-process)
(join (exec str-process) "\n"))
-(define nslookup net-lookup)
-
-(define (getopt optstring (has-arg nil))
- "オプション引数の解析."
- (let ((pos (find optstring $main-args)))
- (if (and pos has-arg)
- (main-args (+ pos 1))
- (integer? pos))))
+;; destructuring-bind like
+;; syntax: (mapset <lambda-list> <expr> <form*>)
+(define-macro (mapset)
+ (eval (list 'local (args 0)
+ (list 'map 'set (list 'quote (args 0)) (args 1))
+ (cons 'begin (2 (args))))))
+;; (setf (get 'mapset 'lisp-indent-function) 2)
+
+(define (xml-parse-file file xml-option)
+ (xml-type-tags nil nil nil nil) ; or (nil cdata !-- nil)
+ (xml-parse (read-file file) (or xml-option (+ 1 2 4))))
+
+(define (%get-string addr (n 100))
+ "ADDRを配列のポインタとみなしてNバイト分読み込む."
+ (first (unpack (string "s" n) addr)))
+
+;; (expand-env "HOME=$HOME") => "HOME=/home/username"
+;; FIXME: "${HOME}"
+(define (expand-env str)
+ (dolist (e (env))
+ (replace (string "$" (e 0)) str (e 1)))
+ str)
+
+;; see `man ascii'
+(setq escape-char-name
+ '("NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" "BEL" "BS" "HT"
+ "LF" "VT" "FF" "CR" "SO" "SI" "DLE" "DC1" "DC2" "DC3" "DC4"
+ "NAK" "SYN" "ETB" "CAN" "EM" "SUB" "ESC" "FSGS" "RS" "US" "SPACE"))
-(when (= ostype "Win32")
-
- (import "user32.dll" "MessageBoxA")
- (define (message-box text (title "newLISP"))
- (let ((MB_OK 0))
- (MessageBoxA 0 text title MB_OK 1)))
-
- (import "kernel32.dll" "GetShortPathNameA")
- (define (get-short-path-name pathname)
- (unless (file-exist-p pathname)
- (throw-error (format "Pathname not found: %s" pathname)))
- (setq pathname (real-path pathname)) ; フルパスに正規化
- (letn ((len 512) (buf (dup "\000" len)))
- ;; 戻り値を有効活用するならこれ (ただし評価順序を間違えると落ちるので注意)
- ;; (0 (GetShortPathNameA pathname buf len) buf)
- (GetShortPathNameA pathname buf len)
- (trim buf)))
- ) ; end of (when (= ostype "Win32")
+(use "io.lsp")
+(use "files.lsp")
+(use "regex.lsp")
+(use "net.lsp")
+(use "argv.lsp")
+(use "arglist.lsp")
+;(use "legacy.lsp")
+;(use "iconv.lsp")
+(use "cl.lsp")
+(if (= ostype "Win32")
+ (use "winapi.lsp"))
-
;; (prompt-event (fn (ctx) (string ctx ":" (real-path) "> ")))
-(println "init.lsp loading...done")
+(unless (getopt "-q")
+ (println "init.lsp loading...done")
+ (println "current working directory: " (pwd)))
+
+(let ((e (env "NEWLISPDIR")))
+ (when (and e (not (directory? e)))
+ (println "warning: directory " e " not found.")))
+
+;; 起動時に引数指定でモジュールを読み込む
+;; $ newlisp -use FILENAME.lsp
+(aif (getopt "-use" true) (use it))
(context MAIN)
+
;;; init.lsp ends here
View
883 newlisp.el
@@ -1,402 +1,481 @@
-;;; newlisp.el -- newLISP editing mode for Emacs -*- coding:utf-8 -*-
-
-;;; Time-stamp: <2009-09-12T17:19:28JST>
-
-;; Author: Shigeru Kobayashi <shigeru.kb@gmail.com>
-;; Version: 0.1b
-;; Keywords: language,lisp
-
-;; This file is NOT part of GNU Emacs.
-
-;;; Commentary:
-
-;; LISP風軽量スクリプト言語`newLISP'を編集するための簡単なメジャーモードです。
-;;
-;; newLISP Home - http://www.newlisp.org/
-;;
-;; このファイルの最新バージョンはこちらにあります:
-;; http://github.com/kosh04/newlisp-files/tree/master
-
-;;; Usage:
-;; (require 'newlisp)
-;; (push '("\\.lsp$" . newlisp-mode) auto-mode-alist)
-;; (newlisp-mode-setup)
-
-;;; ChangeLog:
-;; 2009-07-05T20:16:05 version 0.1b
-;; - キーワードをnewLISP v10.1.0に追従
-;; - *variable* -> variable (Emacsの命名規則に従って変数名変更)
-;; 2009-06-05 version 0.1a
-;; - font-lock 若干修正
-;; - newlisp-mode-syntax-table 追加
-;; 2009-04-19 version 0.1
-;; - newlisp-mode, font-lock 追加
-;; 2008-12-15 version 0.01
-;; - 初版作成 (newlisp-mode)
-
-;;; Known Bugs:
-;; - 初回起動時の評価が表示されずに溜まってしまう場合がある
-;; - 2バイト文字を含むパスから起動することができない
-;; e.g. "c:/Documents and Settings/User/デスクトップ/"
-;; - newlisp.exeが$PATHにないとshell-command-to-stringを実行できない
-
-;; export PATH="$HOME/bin:$PATH"
-;; - emacsのシェルからの起動に必要
-;; (or (string-match #1=(expand-file-name "~/bin") #2=(getenv "PATH"))
-;; (setenv "PATH" (concat #1# ":" #2#)))
-;; - emacsからの起動に必要
-;; (add-to-list 'exec-path "~/bin")
-
-;;; Todo:
-;; - シンボル補完 (etags, complete-symbol, [d]abbrev)
-;; - pop-to-buffer は縦分割を好む人もいるかもしれない
-;; - elisp の書式チェック (checkdoc)
-;; - defcustom
-;; - 出力だけでなく入力も*newlisp*バッファに送るべきかもしれない
-;; - 全ては気の赴くままに
-
-;;; Code:
-(eval-when-compile
- (require 'cl))
-(require 'comint) ; comint-send-string
-
-;; (executable-find "newlisp")
-(defvar newlisp-command "newlisp"
- "newLISP execute binary filename.")
-
-;; (defvar newlisp-command-switches "")
-
-(defvar newlisp-process-coding-system '(utf-8 . utf-8)
- "Cons of coding systems used for process newLISP (input . output).
-If you use newLISP version UTF-8 support, Its value is '(utf-8 . utf-8).
-Otherwise maybe '(sjis . sjis).")
-
-(defun newlisp-process ()
- (let ((default-process-coding-system newlisp-process-coding-system))
- (get-buffer-process
- (make-comint "newlisp" newlisp-command nil
- ;; newlisp側では`~/'をホームディレクトリとして認識しないので
- ;; emacs側で展開しておく
- "-C" "-w" (expand-file-name default-directory)
- ))))
-
-(defun newlisp-show-repl (&optional no-focus)
- (interactive "P")
- (let ((obuf (current-buffer)))
- (pop-to-buffer (process-buffer (newlisp-process)))
- (if no-focus (pop-to-buffer obuf))))
-
-(defalias 'run-newlisp 'newlisp-show-repl)
-
-(defun newlisp-eval (str-sexp)
- "Eval newlisp s-expression."
- (interactive "snewLISP Eval: ")
- (let ((proc (newlisp-process)))
- (labels ((sendln (str)
- (comint-send-string proc (concat str "\n"))))
- (cond ((string-match "\n" str-sexp)
- (sendln "[cmd]")
- (sendln str-sexp)
- (sendln "[/cmd]"))
- (:else
- (sendln str-sexp))))
- (newlisp-show-repl t)))
-
-;; (defsetf process-filter set-process-filter)
-
-(defun newlisp-eval-region (from to)
- (interactive "r")
- (newlisp-eval (buffer-substring-no-properties from to)))
-
-(defun newlisp-eval-last-sexp ()
- (interactive)
- (let ((opoint (point)))
- (unwind-protect
- (newlisp-eval-region (progn
- ;; 'hoge
- (unless (looking-at "\\_<")
- (backward-sexp))
- (point))
- (progn
- (forward-sexp)
- (point)))
- (goto-char (max (point) opoint)))))
-
-(defun newlisp-eval-defun ()
- (interactive)
- (save-excursion
- (mark-defun)
- (newlisp-eval-region (region-beginning) (region-end))))
-
-(defun newlisp-load-file (file)
- (interactive (list
- (read-file-name "Load file: " (buffer-file-name))))
- (newlisp-eval (format "(load {%s})" (expand-file-name file))))
-
-(defun newlisp-restart-process ()
- "Restart a new clean newLISP process with same command-line params.
-This mode is not available on Win32."
- (interactive)
- (newlisp-eval "(reset true)"))
-
-(defun newlisp-kill-process (&optional force)
- (interactive "P")
- (if force
- (delete-process (newlisp-process))
- (newlisp-eval "(exit)")))
-
-;; eval sync
-(defun newlisp-eval-buffer (arg)
- (interactive "P")
- (setq arg (if arg (read-string "newLISP args: ") ""))
- (shell-command (format "%s \"%s\" %s"
- newlisp-command
- (buffer-file-name)
- arg)
- "*newLISP output*"))
-
-;; eval async
-(defun newlisp-execute-file (&optional cmd-args)
- (interactive (list (if current-prefix-arg
- (read-string "execute args: " )
- "")))
- ;; (setq arg (if arg (read-string "args: ") ""))
- (lexical-let ((outbuf (get-buffer-create "*newLISP output*")))
- (with-current-buffer outbuf (erase-buffer))
- (set-process-sentinel
- (start-process-shell-command "newlisp" outbuf
- newlisp-command
- (buffer-file-name)
- cmd-args)
- (lambda (process event)
- (cond ((zerop (buffer-size outbuf))
- (kill-buffer outbuf)
- (message "(no output)"))
- (:else
- (with-current-buffer outbuf
- (goto-char (point-min))
- (if (< (line-number-at-pos (point-max)) 5)
- (message "%s" (replace-regexp-in-string
- "\n+$" "" (buffer-string)))
- (pop-to-buffer (process-buffer process))))))))
- ))
-
-;; lisp.el:571
-(defun newlisp-complete-symbol (&optional predicate)
- "Perform completion on newLISP symbol preceding point."
- (interactive)
- (error "Undefined"))
-
-(defun newlisp-begin-cmd () (interactive) (insert "[cmd]") (comint-send-input))
-(defun newlisp-end-cmd () (interactive) (insert "[/cmd]") (comint-send-input))
-
-;; (define-key inferior-newlisp-mode-map "\C-c[" 'newlisp-begin-cmd)
-;; (define-key inferior-newlisp-mode-map "\C-c]" 'newlisp-end-cmd)
-
-;; Keyword List
-(eval-when (compile load eval)
- ;; newlisp-font-lock-keywords (lisp-font-lock-keywords)
- (defvar newlisp-primitive-keywords
- ;; newLISP v.10.1.0 on Linux IPv4 UTF-8
- ;; > (map name (filter (lambda (s) (primitive? (eval s))) (symbols MAIN)))
- ;; - define define-macro
- '("!" "!=" "$" "%" "&" "*" "+" "-" "/" ":" "<" "<<" "<=" "=" ">" ">=" ">>" "NaN?"
- "^" "abort" "abs" "acos" "acosh" "add" "address" "amb" "and" "append" "append-file"
- "apply" "args" "array" "array-list" "array?" "asin" "asinh" "assoc" "atan" "atan2"
- "atanh" "atom?" "base64-dec" "base64-enc" "bayes-query" "bayes-train" "begin" "beta"
- "betai" "bind" "binomial" "bits" "callback" "case" "catch" "ceil" "change-dir" "char"
- "chop" "clean" "close" "command-event" "cond" "cons" "constant" "context" "context?"
- "copy" "copy-file" "cos" "cosh" "count" "cpymem" "crc32" "crit-chi2" "crit-z" "current-line"
- "curry" "date" "date-value" "debug" "dec" "def-new" "default" ;; "define" "define-macro"
- "delete" "delete-file" "delete-url" "destroy" "det" "device" "difference" "directory"
- "directory?" "div" "do-until" "do-while" "doargs" "dolist" "dostring" "dotimes"
- "dotree" "dump" "dup" "empty?" "encrypt" "ends-with" "env" "erf" "error-event" "estack"
- "eval" "eval-string" "exec" "exists" "exit" "exp" "expand" "explode" "factor" "fft"
- "file-info" "file?" "filter" "find" "find-all" "first" "flat" "float" "float?" "floor"
- "flt" "for" "for-all" "fork" "format" "fv" "gammai" "gammaln" "gcd" "get-char" "get-float"
- "get-int" "get-long" "get-string" "get-url" "global" "global?" "if" "if-not" "ifft"
- "import" "inc" "index" "inf?" "int" "integer" "integer?" "intersect" "invert" "irr"
- "join" "lambda?" "last" "last-error" "legal?" "length" "let" "letex" "letn" "list"
- "list?" "load" "local" "log" "lookup" "lower-case" "macro?" "main-args" "make-dir"
- "map" "mat" "match" "max" "member" "min" "mod" "mul" "multiply" "name" "net-accept"
- "net-close" "net-connect" "net-error" "net-eval" "net-interface" "net-listen" "net-local"
- "net-lookup" "net-peek" "net-peer" "net-ping" "net-receive" "net-receive-from" "net-receive-udp"
- "net-select" "net-send" "net-send-to" "net-send-udp" "net-service" "net-sessions"
- "new" "nil?" "normal" "not" "now" "nper" "npv" "nth" "null?" "number?" "open" "or"
- "pack" "parse" "parse-date" "peek" "pipe" "pmt" "pop" "pop-assoc" "post-url" "pow"
- "pretty-print" "primitive?" "print" "println" "prob-chi2" "prob-z" "process" "prompt-event"
- "protected?" "push" "put-url" "pv" "quote" "quote?" "rand" "random" "randomize"
- "read-buffer" "read-char" "read-expr" "read-file" "read-key" "read-line" "read-utf8"
- "real-path" "receive" "ref" "ref-all" "regex" "regex-comp" "remove-dir" "rename-file"
- "replace" "reset" "rest" "reverse" "rotate" "round" "save" "search" "seed" "seek"
- "select" "semaphore" "send" "sequence" "series" "set" "set-locale" "set-ref" "set-ref-all"
- "setf" "setq" "sgn" "share" "signal" "silent" "sin" "sinh" "sleep" "slice" "sort"
- "source" "spawn" "sqrt" "starts-with" "string" "string?" "sub" "swap" "sym" "symbol?"
- "symbols" "sync" "sys-error" "sys-info" "tan" "tanh" "throw" "throw-error" "time"
- "time-of-day" "timer" "title-case" "trace" "trace-highlight" "transpose" "trim"
- "true?" "unicode" "unify" "unique" "unless" "unpack" "until" "upper-case" "utf8"
- "utf8len" "uuid" "wait-pid" "when" "while" "write-buffer" "write-char" "write-file"
- "write-line" "xfer-event" "xml-error" "xml-parse" "xml-type-tags" "zero?" "|" "~")
- "newLISP primitive keyword list.")
- (defvar newlisp-lambda-keywords
- '("define" "lambda" "fn" "define-macro" "lambda-macro"))
- (defvar newlisp-variable-keyword
- '("nil" "true" "ostype"
- "$args" "$idx" "$it" "$main-args" "$prompt-event"
- "$0" "$1" "$2" "$3" "$4" "$5" "$6" "$7" "$8" "$9"
- "$10" "$11" "$12" "$13" "$14" "$15"))
- (defvar newlisp-context-keyowrds
- '("Class" "MAIN" "Tree"))
- (defvar newlisp-tag-keywords
- '("[text]" "[/text]" "[cmd]" "[/cmd]"))
- (defvar newlisp-un*x-based-function-keywords
- '("peek" "fork" "wait-pid" "net-ping" "parse-date"))
- )
-
-(defun newlisp-mode-setup ()
- (setq newlisp-process-coding-system
- (let ((res (shell-command-to-string
- (format "%s -n -e \"%s\"" newlisp-command
- '(primitive? MAIN:utf8)))))
- (if (string-match "true" res)
- '(utf-8 . utf-8)
- '(shift_jis . shift_jis))))
- (setq newlisp-primitive-keywords
- (car (read-from-string
- (shell-command-to-string
- (format "%s -n -e \"%s\"" newlisp-command
- '(map name (filter (lambda (s) (primitive? (eval s)))
- (symbols MAIN))))))))
- t)
-
-(defmacro defindent (operator indentation)
- `(put ',operator 'lisp-indent-function ',indentation))
-
-(defindent define 1)
-(defindent fn 1)
-(defindent begin 0)
-(defindent local 1)
-(defindent letex 1)
-(defindent for 1)
-(defindent lambda-macro 1)
-(defindent define-macro 1)
-(defindent until 1)
-(defindent letn 1)
-(defindent dostring 1)
-
-(defvar newlisp-mode-hook nil)
-(defvar newlisp-mode-map
- (let ((map (make-sparse-keymap "newlisp")))
- (set-keymap-parent map lisp-mode-shared-map)
- map))
-(define-key newlisp-mode-map "\M-:" 'newlisp-eval)
-(define-key newlisp-mode-map "\e\C-x" 'newlisp-eval-defun)
-(define-key newlisp-mode-map "\C-x\C-e" 'newlisp-eval-last-sexp)
-(define-key newlisp-mode-map "\C-c\C-r" 'newlisp-eval-region)
-(define-key newlisp-mode-map "\C-c\C-l" 'newlisp-load-file)
-(define-key newlisp-mode-map "\C-c\C-z" 'newlisp-show-repl)
-(define-key newlisp-mode-map "\e\t" 'newlisp-complete-symbol) ; ESC TAB
-(define-key newlisp-mode-map [f5] 'newlisp-execute-file)
-(define-key newlisp-mode-map [(control c) f4] 'newlisp-kill-process) ; C-c f4
-(define-key newlisp-mode-map "\C-m" 'newline-and-indent)
-
-(defvar newlisp-mode-syntax-table
- (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
- ;; SYMBOL
- (modify-syntax-entry ?` "_ " table)
- (modify-syntax-entry ?, "_ " table)
- (modify-syntax-entry ?@ "_ " table)
- (modify-syntax-entry ?| "_ " table)
- (modify-syntax-entry ?\[ "_ " table)
- (modify-syntax-entry ?\] "_ " table)
- ;; STRING (match)
- (modify-syntax-entry ?\{ "(} " table)
- (modify-syntax-entry ?\} "){ " table)
- ;; COMMENT
- (modify-syntax-entry ?# "< " table)
- ;; ESCAPE
- ;; ?\\ は通常はエスケープ文字だが、{}で囲まれた文字列内の場合はリテラルになる
- table))
-
-;;;###autoload
-(defun newlisp-mode ()
- "Major mode for editing newLISP code to run in Emacs."
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'newlisp-mode
- mode-name "newLISP")
- (use-local-map newlisp-mode-map)
- (lisp-mode-variables)
- (set-syntax-table newlisp-mode-syntax-table)
- ;; (setq font-lock-defaults nil)
- ;; (set (make-local-variable 'font-lock-keywords-case-fold-search) nil)
- (run-mode-hooks 'newlisp-mode-hook))
-
-;; $ html2txt $NEWLISPDIR/newlisp_manual.html -o newlisp_manual.txt
-;; or use www browser [File] -> [Save Page As (Text)]
-(defvar newlisp-manual-text "newlisp_manual.txt")
-
-(defvar newlisp-manual-html
- (or (dolist (path (list "/usr/share/doc/newlisp/manual_frame.html"
- ;; When build newlisp `make install_home'
- "~/share/doc/newlisp/manual_frame.html"
- "C:/Program Files/newlisp/manual_frame.html"))
- (and (file-exists-p path)
- (return path)))
- "http://www.newlisp.org/downloads/manual_frame.html"))
-
-(defun newlisp-browse-manual ()
- (interactive)
- (browse-url-of-file newlisp-manual-html))
-
-(defsubst newlisp-keywords ()
- (append newlisp-primitive-keywords
- newlisp-lambda-keywords
- newlisp-un*x-based-function-keywords))
-
-(defun newlisp-browse-manual-from-text (str)
- (interactive
- ;; FIXME: "lambda?" が選択できない => C-q ?
- ;; 空文字("")いらない: REQUIRE-MATCH
- (list (completing-read "newLISP manual: " (newlisp-keywords) nil t
- (car (member (thing-at-point 'symbol)
- (newlisp-keywords))))))
- (let ((obuf (current-buffer)))
- (pop-to-buffer (find-file-noselect newlisp-manual-text))
- (toggle-read-only t)
- (let ((opoint (point)))
- (goto-char (point-min))
- (unless (search-forward-regexp
- ;; (foo)
- ;; (foo arg1 arg2 ...)
- ;; (foo-bar-baz) is no-need
- (concat "^\\*syntax: (" (regexp-quote str) "\s?")
- nil 'noerror)
- (goto-char opoint)
- (pop-to-buffer obuf)
- (message "Function Not Found: %s" str)))))
-
-(define-key newlisp-mode-map "\C-ch" 'newlisp-browse-manual-from-text)
-
-;; (put 'font-lock-add-keywords 'lisp-indent-function 1)
-;; lisp-mode.el:91
-(font-lock-add-keywords 'newlisp-mode
- (list
- ;; (list "\\<\\(FIXME\\):" 1 font-lock-warning-face 'prepend)
- (cons (eval-when-compile (regexp-opt newlisp-primitive-keywords 'words))
- font-lock-keyword-face)
- (cons (eval-when-compile (regexp-opt newlisp-lambda-keywords 'words))
- font-lock-function-name-face)
- (cons (eval-when-compile (regexp-opt newlisp-variable-keyword 'words))
- font-lock-constant-face)
- (cons (eval-when-compile (regexp-opt newlisp-context-keyowrds 'words))
- font-lock-type-face)
- (cons (eval-when-compile (regexp-opt newlisp-tag-keywords)) ; not 'words
- font-lock-preprocessor-face)
- (cons (eval-when-compile (regexp-opt newlisp-un*x-based-function-keywords 'words))
- font-lock-warning-face))
- )
-
-(provide 'newlisp)
-
-;;; newlisp.el ends here
+;;; newlisp.el -- newLISP editing mode for Emacs -*- coding:utf-8 -*-
+
+;; Copyright (C) 2008,2009 Shigeru Kobayashi
+
+;; Author: Shigeru Kobayashi <shigeru.kb@gmail.com>
+;; Version: 0.2
+;; Created: 2008-12-15
+;; Keywords: language,lisp
+;; URL: http://github.com/kosh04/newlisp-files/raw/master/newlisp.el
+
+;; This file is NOT part of GNU Emacs.
+
+;;; Commentary:
+;;
+;; LISP風軽量スクリプト言語`newLISP'を編集するための簡単なメジャーモードです。
+;;
+;; newLISP Home - http://www.newlisp.org/
+;;
+;; このファイルの最新バージョンはこちらにあります:
+;; http://github.com/kosh04/newlisp-files/tree/master
+
+;;; Installation:
+;;
+;; (require 'newlisp)
+;; (push '("\\.lsp$" . newlisp-mode) auto-mode-alist)
+;; (newlisp-mode-setup) ; if needed
+
+;;; ChangeLog:
+;;
+;; 2009-09-30 version 0.2
+;; - キーワード補完が出来るように
+;; 2009-07-05 version 0.1b
+;; - キーワードをnewLISP v10.1.0に追従
+;; - rename `*variable*' to `variable' (Emacsの命名規則に従って変数名変更)
+;; 2009-06-05 version 0.1a
+;; - font-lock 若干修正
+;; - newlisp-mode-syntax-table 追加
+;; 2009-04-19 version 0.1
+;; - newlisp-mode, font-lock 追加
+;; 2008-12-15 version 0.01
+;; - 初版作成 (newlisp-mode)
+
+;;; Known Bugs:
+;;
+;; - (newlisp-eval "(eval-string \"((define hex 0xff))\")") => ERR
+;; - 初回起動時の評価が出力されずに溜まってしまう場合がある
+;; - 2バイト文字を含むパスから起動することができない
+;; e.g. "c:/Documents and Settings/User/デスクトップ/"
+;; これは文字コードの違いが問題: sjis(windowsのパス名),utf-8(newlisp)
+;; - newlisp.exeが$PATHにないとshell-command-to-stringを実行できない
+;;
+;; export PATH="$HOME/bin:$PATH"
+;; - emacsのシェルからの起動に必要
+;; (or (string-match #1=(expand-file-name "~/bin") #2=(getenv "PATH"))
+;; (setenv "PATH" (concat #1# ":" #2#)))
+;; - emacsからの起動に必要
+;; (add-to-list 'exec-path "~/bin")
+
+;;; Todo:
+;;
+;; - シンボル補完 (etags, complete-symbol, [d]abbrev)
+;; - pop-to-buffer は縦分割を好む人もいるかもしれない
+;; - elisp の書式チェック (checkdoc)
+;; - defcustom
+;; - 出力だけでなく入力も*newlisp*バッファに送るべきかもしれない
+;; - lisp-modeから間借りしている機能は分割するべきかも
+;; - 全ては気の赴くままに
+
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'comint) ; comint-send-string
+
+(defgroup newlisp nil
+ "newlisp source code editing functions."
+ :group 'newlisp
+ :prefix "newlisp-" ; or "nl-" ?
+ :version "0.2")
+
+;; (executable-find "newlisp") or "/usr/bin/newlisp"
+(defcustom newlisp-command "newlisp"
+ "Filename to use to run newlisp."
+ :type 'string
+ :group 'newlisp)
+
+(defvar newlisp-switches "-C")
+
+(defvar newlisp-load-init-p t)
+
+(defvar newlisp-process-coding-system 'utf-8
+ "Coding system used for process newLISP.
+If you use newLISP version UTF-8 support, its value is `utf-8'.
+Otherwise maybe `shift_jis'.")
+
+(defun newlisp-process ()
+ "Return newlisp process object.
+If not running, then start new process."
+ (let ((default-process-coding-system
+ (cons #1=newlisp-process-coding-system #1#))
+ (switches (split-string newlisp-switches "\s")))
+ (if (null newlisp-load-init-p)
+ (pushnew "-n" switches :test #'equal))
+ (get-buffer-process
+ (apply #'make-comint "newlisp"
+ newlisp-command nil switches))))
+
+(defun newlisp-show-repl (&optional no-focus)
+ "Display newlisp process buffer."
+ (interactive "P")
+ (let ((obuf (current-buffer)))
+ (pop-to-buffer (process-buffer (newlisp-process)))
+ (if no-focus (pop-to-buffer obuf))))
+
+(defalias 'run-newlisp 'newlisp-show-repl)
+
+(defun newlisp-eval (str-sexp)
+ "Eval newlisp s-expression."
+ (interactive "snewLISP Eval: ")
+ (let ((proc (newlisp-process)))
+ (labels ((sendln (str)
+ (comint-send-string proc (concat str "\n"))))
+ (cond ((string-match "\n" str-sexp)
+ (sendln "[cmd]")
+ (sendln str-sexp)
+ (sendln "[/cmd]"))
+ (:else
+ (sendln str-sexp))))
+ (newlisp-show-repl t)))
+
+;; (defun newlisp-eval (str-sexp)
+;; "Eval newlisp s-expression."
+;; (interactive "snewLISP Eval: ")
+;; (let ((proc (newlisp-process)))
+;; (dolist (str (list "[cmd]\n"
+;; (concat str-sexp "\n")
+;; "[/cmd]\n"))
+;; (send-string proc str))
+;; ;; (send-string proc "\n")
+;; )
+;; (newlisp-show-repl t))
+
+(defun newlisp-eval-region (from to)
+ (interactive "r")
+ (newlisp-eval (buffer-substring-no-properties from to)))
+
+(defun newlisp-eval-last-sexp ()
+ (interactive)
+ (let ((opoint (point)))
+ (unwind-protect
+ (newlisp-eval-region (progn
+ ;; 'hoge
+ (unless (looking-at "\\_<")
+ (backward-sexp))
+ (point))
+ (progn
+ (forward-sexp)
+ (point)))
+ (goto-char (max (point) opoint)))))
+
+(defun newlisp-eval-defun ()
+ (interactive)
+ (save-excursion
+ (mark-defun)
+ (newlisp-eval-region (region-beginning) (region-end))))
+
+(defun newlisp-eval-buffer ()
+ (interactive)
+ (newlisp-eval-region (point-min) (point-max)))
+
+(defun newlisp-load-file (file)
+ "Load and translates newLISP from a FILE."
+ (interactive (list
+ (read-file-name "Load file: " (buffer-file-name))))
+ (newlisp-eval (format "(load {%s})" (expand-file-name file))))
+
+(defun newlisp-restart-process ()
+ "Restart a new clean newLISP process with same command-line params.
+This function is not available on Win32."
+ (interactive)
+ (newlisp-eval "(reset true)"))
+
+(defun newlisp-kill-process (&optional force)
+ "kill running process."
+ (interactive "P")
+ (if force
+ (delete-process (newlisp-process))
+ (newlisp-eval "(exit)")))
+
+;; eval sync
+;; (defun newlisp-eval-buffer (arg)
+;; (interactive "P")
+;; (setq arg (if arg (read-string "newLISP args: ") ""))
+;; (shell-command (format "%s \"%s\" %s"
+;; newlisp-command
+;; (buffer-file-name)
+;; arg)
+;; "*newLISP output*"))
+
+;; (newlisp-eval
+;; (concat "(eval-string \"" (buffer-string) "\")" ))
+
+;; eval async
+(defun newlisp-execute-file (&optional cmd-args)
+ (interactive (list (if current-prefix-arg
+ (read-string "execute args: " )
+ "")))
+ ;; (setq arg (if arg (read-string "args: ") ""))
+ (lexical-let ((outbuf (get-buffer-create "*newLISP output*")))
+ (with-current-buffer outbuf (erase-buffer))
+ (set-process-sentinel
+ (start-process-shell-command "newlisp" outbuf
+ newlisp-command
+ (buffer-file-name)
+ cmd-args)
+ (lambda (process event)
+ (cond ((zerop (buffer-size outbuf))
+ (kill-buffer outbuf)
+ (message "(no output)"))
+ (:else
+ (with-current-buffer outbuf
+ (goto-char (point-min))
+ (if (< (line-number-at-pos (point-max)) 5)
+ (message "%s" (replace-regexp-in-string
+ "\n+$" "" (buffer-string)))
+ (pop-to-buffer (process-buffer process))))))))
+ ))
+
+(defun newlisp-begin-cmd () (interactive) (insert "[cmd]") (comint-send-input))
+(defun newlisp-end-cmd () (interactive) (insert "[/cmd]") (comint-send-input))
+;; (define-key inferior-newlisp-mode-map "\C-c[" 'newlisp-begin-cmd)
+;; (define-key inferior-newlisp-mode-map "\C-c]" 'newlisp-end-cmd)
+
+;;
+;; Keyword List
+;;
+(eval-when (compile load eval)
+ ;; newlisp-font-lock-keywords (lisp-font-lock-keywords)
+ (defvar newlisp-primitive-keywords
+ ;; newLISP v.10.1.0 on Linux IPv4 UTF-8
+ ;; > (map name (filter (lambda (s) (primitive? (eval s))) (symbols MAIN)))
+ ;; - define define-macro
+ '("!" "!=" "$" "%" "&" "*" "+" "-" "/" ":" "<" "<<" "<=" "=" ">" ">=" ">>" "NaN?"
+ "^" "abort" "abs" "acos" "acosh" "add" "address" "amb" "and" "append" "append-file"
+ "apply" "args" "array" "array-list" "array?" "asin" "asinh" "assoc" "atan" "atan2"
+ "atanh" "atom?" "base64-dec" "base64-enc" "bayes-query" "bayes-train" "begin" "beta"
+ "betai" "bind" "binomial" "bits" "callback" "case" "catch" "ceil" "change-dir" "char"
+ "chop" "clean" "close" "command-event" "cond" "cons" "constant" "context" "context?"
+ "copy" "copy-file" "cos" "cosh" "count" "cpymem" "crc32" "crit-chi2" "crit-z" "current-line"
+ "curry" "date" "date-value" "debug" "dec" "def-new" "default" ;; "define" "define-macro"
+ "delete" "delete-file" "delete-url" "destroy" "det" "device" "difference" "directory"
+ "directory?" "div" "do-until" "do-while" "doargs" "dolist" "dostring" "dotimes"
+ "dotree" "dump" "dup" "empty?" "encrypt" "ends-with" "env" "erf" "error-event" "estack"
+ "eval" "eval-string" "exec" "exists" "exit" "exp" "expand" "explode" "factor" "fft"
+ "file-info" "file?" "filter" "find" "find-all" "first" "flat" "float" "float?" "floor"
+ "flt" "for" "for-all" "fork" "format" "fv" "gammai" "gammaln" "gcd" "get-char" "get-float"
+ "get-int" "get-long" "get-string" "get-url" "global" "global?" "if" "if-not" "ifft"
+ "import" "inc" "index" "inf?" "int" "integer" "integer?" "intersect" "invert" "irr"
+ "join" "lambda?" "last" "last-error" "legal?" "length" "let" "letex" "letn" "list"
+ "list?" "load" "local" "log" "lookup" "lower-case" "macro?" "main-args" "make-dir"
+ "map" "mat" "match" "max" "member" "min" "mod" "mul" "multiply" "name" "net-accept"
+ "net-close" "net-connect" "net-error" "net-eval" "net-interface" "net-listen" "net-local"
+ "net-lookup" "net-peek" "net-peer" "net-ping" "net-receive" "net-receive-from" "net-receive-udp"
+ "net-select" "net-send" "net-send-to" "net-send-udp" "net-service" "net-sessions"
+ "new" "nil?" "normal" "not" "now" "nper" "npv" "nth" "null?" "number?" "open" "or"
+ "pack" "parse" "parse-date" "peek" "pipe" "pmt" "pop" "pop-assoc" "post-url" "pow"
+ "pretty-print" "primitive?" "print" "println" "prob-chi2" "prob-z" "process" "prompt-event"
+ "protected?" "push" "put-url" "pv" "quote" "quote?" "rand" "random" "randomize"
+ "read-buffer" "read-char" "read-expr" "read-file" "read-key" "read-line" "read-utf8"
+ "real-path" "receive" "ref" "ref-all" "regex" "regex-comp" "remove-dir" "rename-file"
+ "replace" "reset" "rest" "reverse" "rotate" "round" "save" "search" "seed" "seek"
+ "select" "semaphore" "send" "sequence" "series" "set" "set-locale" "set-ref" "set-ref-all"
+ "setf" "setq" "sgn" "share" "signal" "silent" "sin" "sinh" "sleep" "slice" "sort"
+ "source" "spawn" "sqrt" "starts-with" "string" "string?" "sub" "swap" "sym" "symbol?"
+ "symbols" "sync" "sys-error" "sys-info" "tan" "tanh" "throw" "throw-error" "time"
+ "time-of-day" "timer" "title-case" "trace" "trace-highlight" "transpose" "trim"
+ "true?" "unicode" "unify" "unique" "unless" "unpack" "until" "upper-case" "utf8"
+ "utf8len" "uuid" "wait-pid" "when" "while" "write-buffer" "write-char" "write-file"
+ "write-line" "xfer-event" "xml-error" "xml-parse" "xml-type-tags" "zero?" "|" "~")
+ "newLISP primitive keyword list.")
+ (defvar newlisp-lambda-keywords
+ '("define" "lambda" "fn" "define-macro" "lambda-macro"))
+ (defvar newlisp-variable-keyword
+ '("nil" "true" "ostype"
+ "$args" "$idx" "$it" "$main-args" "$prompt-event"
+ "$0" "$1" "$2" "$3" "$4" "$5" "$6" "$7" "$8" "$9"
+ "$10" "$11" "$12" "$13" "$14" "$15"))
+ (defvar newlisp-context-keyowrds
+ '("Class" "MAIN" "Tree"))
+ (defvar newlisp-tag-keywords
+ '("[text]" "[/text]" "[cmd]" "[/cmd]"))
+ (defvar newlisp-un*x-based-function-keywords
+ '("peek" "fork" "wait-pid" "net-ping" "parse-date"))
+ )
+
+(defsubst newlisp-keywords ()
+ "Return newLISP keyword list as string."
+ (append newlisp-primitive-keywords
+ newlisp-lambda-keywords
+ (unless (eq system-type 'windows-nt)
+ newlisp-un*x-based-function-keywords)))
+
+(defvar newlisp-obarray
+ (let ((array (make-vector 401 0))) ; more than keyword size
+ (dolist (s (newlisp-keywords))
+ (intern s array))
+ array)
+ "newLISP symbol table.")
+
+(defsubst newlisp-find-symbol (string)
+ "Locates a symbol whose name is STRING in a newLISP symbols."
+ (intern-soft string newlisp-obarray))
+
+(defun newlisp-complete-symbol ()
+ (interactive "*")
+ (let ((emacs-lisp-mode-syntax-table newlisp-mode-syntax-table)
+ (obarray newlisp-obarray))
+ (lisp-complete-symbol (lambda (s)
+ (newlisp-find-symbol (symbol-name s))))))
+
+(defun newlisp-mode-setup ()
+ (setq newlisp-process-coding-system
+ (let ((res (shell-command-to-string
+ (format "%s -n -e \"%s\"" newlisp-command
+ '(primitive? MAIN:utf8)))))
+ (if (string-match "true" res)
+ 'utf-8 'shift_jis)))
+ (setq newlisp-primitive-keywords
+ (car (read-from-string
+ (shell-command-to-string
+ (format "%s -n -e \"%s\"" newlisp-command
+ '(map name (filter (lambda (s) (primitive? (eval s)))
+ (symbols MAIN))))))))
+ t)
+
+(defmacro defindent (operator indentation)
+ `(put ',operator 'lisp-indent-function ',indentation))
+
+(defindent define 1)
+(defindent fn 1)
+(defindent begin 0)
+(defindent local 1)
+(defindent letex 1)
+(defindent for 1)
+(defindent lambda-macro 1)
+(defindent define-macro 1)
+(defindent until 1)
+(defindent letn 1)
+(defindent dostring 1)
+(defindent doargs 1)
+(defindent dotree 1)
+
+(defvar newlisp-mode-hook nil)
+(defvar newlisp-mode-map
+ (let ((map (make-sparse-keymap "newlisp")))
+ (set-keymap-parent map lisp-mode-shared-map)
+ map))
+(define-key newlisp-mode-map "\M-:" 'newlisp-eval)
+(define-key newlisp-mode-map "\e\C-x" 'newlisp-eval-defun)
+(define-key newlisp-mode-map "\C-x\C-e" 'newlisp-eval-last-sexp)
+(define-key newlisp-mode-map "\C-c\C-r" 'newlisp-eval-region)
+(define-key newlisp-mode-map "\C-c\C-l" 'newlisp-load-file)
+(define-key newlisp-mode-map "\C-c\C-z" 'newlisp-show-repl)
+(define-key newlisp-mode-map "\e\t" 'newlisp-complete-symbol) ; ESC TAB
+;; (define-key newlisp-mode-map "\C-c\C-i" 'newlisp-complete-symbol)
+(define-key newlisp-mode-map [f5] 'newlisp-execute-file)
+(define-key newlisp-mode-map [(control c) f4] 'newlisp-kill-process) ; C-c f4
+(define-key newlisp-mode-map "\C-m" 'newline-and-indent)
+
+(defvar newlisp-mode-syntax-table
+ (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
+ ;; SYMBOL
+ (modify-syntax-entry ?` "_ " table)
+ (modify-syntax-entry ?, "_ " table)
+ (modify-syntax-entry ?@ "_ " table)
+ (modify-syntax-entry ?| "_ " table)
+ (modify-syntax-entry ?\[ "_ " table)
+ (modify-syntax-entry ?\] "_ " table)
+ ;; STRING (match)
+ (modify-syntax-entry ?\{ "(} " table)
+ (modify-syntax-entry ?\} "){ " table)
+ ;; COMMENT
+ (modify-syntax-entry ?# "< " table)
+ ;; ESCAPE
+ ;; ?\\ は通常はエスケープ文字だが、{}で囲まれた文字列内の場合はリテラルになる
+ table))
+
+;;;###autoload
+(defun newlisp-mode ()
+ "Major mode for newLISP files."
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'newlisp-mode
+ mode-name "newLISP")
+ (use-local-map newlisp-mode-map)
+ (lisp-mode-variables)
+ (set-syntax-table newlisp-mode-syntax-table)
+ ;; (set (make-local-variable (quote font-lock-defaults)) '(fn t nil nil fn))
+ ;; (set (make-local-variable 'font-lock-keywords-case-fold-search) nil)
+ (run-mode-hooks 'newlisp-mode-hook))
+
+;; $ html2txt $NEWLISPDIR/newlisp_manual.html -o newlisp_manual.txt
+;; or use www-browser [File] -> [Save Page As (Text)]
+(defvar newlisp-manual-text "newlisp_manual.txt")
+
+(defvar newlisp-manual-html
+ (or (dolist (path (list "/usr/share/doc/newlisp/manual_frame.html"
+ ;; When build newlisp `make install_home'
+ "~/share/doc/newlisp/manual_frame.html"
+ "C:/Program Files/newlisp/manual_frame.html"))
+ (if (file-exists-p path)
+ (return path)))
+ "http://www.newlisp.org/downloads/manual_frame.html"))
+
+(defun newlisp-browse-manual ()
+ (interactive)
+ (browse-url-of-file newlisp-manual-html))
+
+(defun newlisp-switch-to-manual ()
+ (interactive)
+ (if (file-exists-p #1=newlisp-manual-text)
+ (progn
+ (pop-to-buffer (find-file-noselect #1#))
+ (unless (eq major-mode 'newlisp-mode) (newlisp-mode))
+ (toggle-read-only t))
+ (error "manual %s not exist" #1#)))
+
+(defun newlisp-browse-manual-from-text (keyword)
+ (interactive
+ ;; FIXME: cannot select "lambda?" -> C-q ?
+ (list (let* ((s (newlisp-find-symbol (current-word))) ; (thing-at-point 'symbol)
+ (default (and s (symbol-name s))))
+ (completing-read (format "newLISP manual%s: "
+ (if default
+ (format " (default %s)" default)
+ ""))
+ (newlisp-keywords)
+ nil t nil nil default))))
+ (if (equal keyword "setf")
+ (setq keyword "setq"))
+ (newlisp-switch-to-manual)
+ (let ((opoint (point)))
+ (goto-char (point-min))
+ (unless (and (not (equal keyword ""))
+ (search-forward-regexp
+ ;; (foo)
+ ;; (foo ...)
+ ;; (foo-bar-baz) is NOT NEEDED
+ ;; (concat "^\\*syntax: (" (regexp-quote keyword) "\s?")
+ ;; e.g. " define ! <#destructive>"
+ ;; e.g. " define-macro"
+ (format "^ %s\s?" (regexp-quote keyword))
+ nil "noerror")
+ (progn (recenter 0) t))
+ (goto-char opoint))))
+
+(define-key newlisp-mode-map "\C-ch" 'newlisp-browse-manual-from-text)
+
+;; (setf (get 'font-lock-add-keywords 'lisp-indent-function) 1)
+;; lisp-mode.el:91
+(font-lock-add-keywords 'newlisp-mode
+ (list
+ ;; (list "\\<\\(FIXME\\):" 1 font-lock-warning-face 'prepend)
+ (cons (eval-when-compile (regexp-opt newlisp-primitive-keywords 'words)) font-lock-keyword-face)
+ ;; (eval-when-compile (regexp-opt newlisp-primitive-keywords 'words))
+ (cons (eval-when-compile (regexp-opt newlisp-lambda-keywords 'words))
+ font-lock-function-name-face)
+ (cons (eval-when-compile (regexp-opt newlisp-variable-keyword 'words))
+ font-lock-constant-face)
+ (cons (eval-when-compile (regexp-opt newlisp-context-keyowrds 'words))
+ font-lock-type-face)
+ (cons (eval-when-compile (regexp-opt newlisp-tag-keywords)) ; not 'words
+ font-lock-preprocessor-face)
+ (cons (eval-when-compile (regexp-opt newlisp-un*x-based-function-keywords 'words))
+ font-lock-warning-face))
+ )
+
+(provide 'newlisp)
+
+;;; newlisp.el ends here
View
38,085 newlisp_manual.txt
18,865 additions, 19,220 deletions not shown
Please sign in to comment.
Something went wrong with that request. Please try again.