emacs自定义工具栏
(setq tool-bar-map (make-sparse-keymap))
要自定义工具栏，只需要修改tool-bar-map这个变量就可以了，一般我们可以用tool-bar-add-item这个函数来往tool- bar-map里添加工具项。
tool-bar-add-item的原型是这样的：
(tool-bar-add-item icon def key &rest props)
参数icon设置工具图标，emacs的工具栏可以使用XPM和PBM格式的图标，当emacs 有libxmp支持时会使用XPM格式，没有libxmp库时会寻找PBM格式的图标(Info上还说有XBM格式，我没搞清楚什么情况下使用XBM)。
在etc/images目录下可以看到emacs自带的图标一般都同时有XPM和PBM两种格式，就是为了在没有libxmp库时也能显示工具栏，因为如果我们只有xpm格式的图标而没有libxmp库时，emacs就不在工具栏上显示这个项了。所以我们自己做图标时最好XPM和PBM都准备一份。
icon参数的类型是字符串，只需要传主文件名就可以，扩展名emacs会自己加，比如对图标文件semantic.xpm写成”semantic”。
emacs会在image-load-path下查找图标文件，这个变量的值默认为(“…/etc/images/” data-directory load-path)，就是说它除了查找image目录外还会查找所有的load-path，所以如果我们有自己的图标目录，把它加到image- load-path或者load-path都可以。
图标的大小好像没有限制，emacs本身使用的图标是24×24像素的，如果使用了比它大的图标，整个工具栏会自动扩大。
参数def设置这个工具项被按下的执行什么命令，它的格式跟global-set-key里的command格式是一样的。
参数key用来给这个工具项指定一个key，这个key用于唯一标识这个工具项，所以在同一个keymap里key不能重复。
剩下的参数可以设置一些属性项，具体可以设置哪些属性可以看Info > elisp > Keymaps > Menu Keymaps > Defining Menus > Extended Menu Items。常用的几个属性有：
* :enable 这个属性的值是一个表达式，emacs对这个表达式求值，如果值为nil时，这个工具项会被禁用。
* :visible 这个属性控制这个工具项是否显示，它的类型与:enable是一样的。
* :help 这个属性类型是字符串，当鼠标在工具项上停留时会显示这个字符串。
其余的属性我没用过，也没仔细研究它们用来干什么。
举例来说，如果要添加一个工具项用来执行gdb命令，并且只有在c-mode或者c++-mode时才让它有效，可以这样：
(tool-bar-add-item "gud/run" 'gdb 'gdb
:enable '(memq major-mode '(c++-mode c-mode)))
这样会把gdb这个工具项添加到默认工具栏的最后，如果不想要emacs默认的工具栏，可以先执行(setq tool-bar-map (make-sparse-keymap))把默认的工具栏清空。
2010年6月10日星期四
2010年5月29日星期六
Scheme/Lisp map's usage
(map (lambda(x)
(* x x))
'(1 2 3))
(map (lambda(x y)
(* x y))
'(1 2 3)
'(4 5 6))
(for-each (lambda (x)
(display x)
(newline))
'(1 2 3))
(* x x))
'(1 2 3))
(map (lambda(x y)
(* x y))
'(1 2 3)
'(4 5 6))
(for-each (lambda (x)
(display x)
(newline))
'(1 2 3))
Scheme/Lisp require's usage
;;In computer programming, to execute a call.
(require (lib "process.ss"))
(system "date")
(require (lib "process.ss"))
(system "date")
Scheme/Lisp let and do usage
;; let is a variety lambda function, do treats as c inside the language for circulation.
(let ((in (open-input-file "hello")))
(do ((c (read-char in) (read-char in)))
((eqv? c #\l)
(close-input-port in))
(begin
(display c))
c))
(let ((in (open-input-file "hello")))
(do ((c (read-char in) (read-char in)))
((eqv? c #\l)
(close-input-port in))
(begin
(display c))
c))
Scheme中lambda表达式的形参表有3种
现在真正的介入正题吧，一个月来总结下自己所学的东西，和自己的感悟，首先，我来武汉研究的第一个程序，是lambda演算，当时的感觉很奇妙，该程序也 很好理解。也是很有趣的程序，很多程序员第一次接触Scheme的时候就是先学习的lambda演算，lambda本身就是一个匿名函数，而且 Scheme里面支持匿名函数，可以回顾下当时我的列子，如下：
(define foo (lambda (x)
(* x x)))
Scheme中lambda表达式的形参表有3种接收参数的方式:
1,定长,这种是最常见的,eg:
(define square (lambda (n) (* n n)))
(square 5)=>25
2,全定长,目前还没想通用处在哪里eg:
(define foo (lambda x x))
(foo 1 2 3)=>(1 2 3)
3,半定长,这种在很多语言中都有用到,比如C的printf函数eg:
(define f (lambda (x . y) (* x x)))
(f 10 20 30)=>100
通常函数由以下4个部分组成:
1,前继,n!(fac)
2,后续,(n-1)!(fac (- n 1))
3,测零,(= n 0)
4,不动点算子,1
(define foo (lambda (x)
(* x x)))
Scheme中lambda表达式的形参表有3种接收参数的方式:
1,定长,这种是最常见的,eg:
(define square (lambda (n) (* n n)))
(square 5)=>25
2,全定长,目前还没想通用处在哪里eg:
(define foo (lambda x x))
(foo 1 2 3)=>(1 2 3)
3,半定长,这种在很多语言中都有用到,比如C的printf函数eg:
(define f (lambda (x . y) (* x x)))
(f 10 20 30)=>100
通常函数由以下4个部分组成:
1,前继,n!(fac)
2,后续,(n-1)!(fac (- n 1))
3,测零,(= n 0)
4,不动点算子,1
Scheme/Lisp 倒序排列
尾递归实现倒序排序：
(define (foo x)
(let loop((n x) (l '()))
(if (null? (cdr n)) (append (list (car n)) l)
(loop (cdr n) (append (list (car n))l)))))
如：(foo '(1 2 3 4 5)) => (5 4 3 2 1)
等价于它的一般性递归排序：
(define (f x)
(if (null? (cdr x))
(list (car x))
(append (f (cdr x)) (list (car x)))))
如：(f '(1 2 3 4 5)) => (5 4 3 2 1)
(define (foo x)
(let loop((n x) (l '()))
(if (null? (cdr n)) (append (list (car n)) l)
(loop (cdr n) (append (list (car n))l)))))
如：(foo '(1 2 3 4 5)) => (5 4 3 2 1)
等价于它的一般性递归排序：
(define (f x)
(if (null? (cdr x))
(list (car x))
(append (f (cdr x)) (list (car x)))))
如：(f '(1 2 3 4 5)) => (5 4 3 2 1)
Scheme/Lisp 中的连续
(((call/cc (lambda (k) k))
(lambda (x) x))
"Hong!")
Scheme中的连续用call/cc 函数来实现！以上就是它的实例，看不懂可以去看我的笔记，PDF格式的这里可以下载的，去找找吧，笔记里面介绍了它的过程！
(lambda (x) x))
"Hong!")
Scheme中的连续用call/cc 函数来实现！以上就是它的实例，看不懂可以去看我的笔记，PDF格式的这里可以下载的，去找找吧，笔记里面介绍了它的过程！
Scheme/Lisp let,let*,letrec的使用
(let ((x 5))
(define foo (lambda (y) (bar x y)))
(define bar (lambda (a b) (+ (* a b) a)))
(foo (+ x 3)))
(let* ((yin ((lambda (foo) (display "@") foo)
(call/cc (lambda (bar) bar))))
(yang ((lambda (foo) (display "+") foo)
(call/cc (lambda (bar) bar)))))
(yin yang))
(letrec ((p (lambda (x)
(if (= x 100) 'Done
(begin
(display x)
(newline)
(p (+ x 1)))))))
(p 0))
以上就是这三个函数的使用实例，如果看不懂就先去学习SCHEME开发！
(define foo (lambda (y) (bar x y)))
(define bar (lambda (a b) (+ (* a b) a)))
(foo (+ x 3)))
(let* ((yin ((lambda (foo) (display "@") foo)
(call/cc (lambda (bar) bar))))
(yang ((lambda (foo) (display "+") foo)
(call/cc (lambda (bar) bar)))))
(yin yang))
(letrec ((p (lambda (x)
(if (= x 100) 'Done
(begin
(display x)
(newline)
(p (+ x 1)))))))
(p 0))
以上就是这三个函数的使用实例，如果看不懂就先去学习SCHEME开发！
Scheme/Lisp cond,if的使用 (use scheme's cond,if)
(define (abs x)
(cond ((< x 0) (- x))
(else x)))
等价的if
(define (abs x)
(if (< x 0)
(- x)
x))
它们是等价的，也就是说cond可以理解为C等高级语言的IF，不过在这里cond的写法不一样！
(cond ((< x 0) (- x))
(else x)))
等价的if
(define (abs x)
(if (< x 0)
(- x)
x))
它们是等价的，也就是说cond可以理解为C等高级语言的IF，不过在这里cond的写法不一样！
Scheme/Lisp IO/case's use
(let ((in (open-input-file "filename"))) (let loop((c (read-char in))) (case c ((#\# #\o) 'yes) ((#\! #\.) 'no) (else (loop (read-char in)))))) 读取一个文件当遇到＃,o则停止打印yes,遇到!,.则打印no~! |
Scheme/lisp 有理数的算术运算
(define (make-rat n d) (cons n d));;返回一个有理书,其分子是整数n,分母是整数d.
(define (number x) (car x));;返回有理数x的分子.
(define (denom x) (cdr x));;返回有理数x的分母.
;;规则表述如下几个过程
(define (add-rat x y)
(make-rat (+ (* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y))))
(define (sub-rat x y)
(make-rat (- (* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y))))
(define (mul-rat x y)
(make-rat (* (numer x) (numer y))
(* (denom x) (denom y))))
(define (div-rat x y)
(make-rat (* (numer x) (denom y))
(* (denom x) (numer y))))
(define (equal-rat? x y)
(= (* (numer x) (denom y))
(* (numer y) (denom x))))
;;打印分子,在/之后打印分母.
(define (print-rat x)
(newline)
(display "/")
(display (denom x)))
;;过程
(define onr-half (make-rat 1 2))
(print-rat one-half)
(define one-third (make-rat 1 3))
(print-rat (add-rat one-half one-third))
(print-rat (mul-rat one-half one-third))
(print-rat (add-rat one-third one-third))
(define (make-rat n d)
(let ((g (gcd n d)))
(cons (/ n g) (/ d g))))
(print-rat (add-rat one-third one-third))
(define (number x) (car x));;返回有理数x的分子.
(define (denom x) (cdr x));;返回有理数x的分母.
;;规则表述如下几个过程
(define (add-rat x y)
(make-rat (+ (* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y))))
(define (sub-rat x y)
(make-rat (- (* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y))))
(define (mul-rat x y)
(make-rat (* (numer x) (numer y))
(* (denom x) (denom y))))
(define (div-rat x y)
(make-rat (* (numer x) (denom y))
(* (denom x) (numer y))))
(define (equal-rat? x y)
(= (* (numer x) (denom y))
(* (numer y) (denom x))))
;;打印分子,在/之后打印分母.
(define (print-rat x)
(newline)
(display "/")
(display (denom x)))
;;过程
(define onr-half (make-rat 1 2))
(print-rat one-half)
(define one-third (make-rat 1 3))
(print-rat (add-rat one-half one-third))
(print-rat (mul-rat one-half one-third))
(print-rat (add-rat one-third one-third))
(define (make-rat n d)
(let ((g (gcd n d)))
(cons (/ n g) (/ d g))))
(print-rat (add-rat one-third one-third))
Scheme/Lisp 抛出异常！
Exceptions
Whenever a run-time error occurs, an exception is raised. Unless the exception is caught, then it is handled by printing a message associated with the exception, and then escaping from the computation.
> (/ 1 0)
/: division by zero
> (car 17)
car: expects argument of type; given 17
To catch an exception, use the with-handlers form:
(with-handlers ([predicate-expr handler-expr] ...)
body ...+)
Each predicate-expr in a handler determines a kind of exception that is caught by the with-handlers form, and the value representing the exception is passed to the handler procedure produced by handler-expr. The result of the handler-expr is the result of the with-handlers expression.
For example, a divide-by-zero error raises an instance of the exn:fail:contract:divide-by-zero structure type:
> (with-handlers ([exn:fail:contract:divide-by-zero?
(lambda (exn) +inf.0)])
(/ 1 0))
+inf.0
> (with-handlers ([exn:fail:contract:divide-by-zero?
(lambda (exn) +inf.0)])
(car 17))
car: expects argument of type; given 17
The error function is one way to raise your own exception. It packages an error message and other information into an exn:fail structure:
> (error "crash!")
crash!
> (with-handlers ([exn:fail? (lambda (exn) 'air-bag)])
(error "crash!"))
air-bag
The exn:fail:contract:divide-by-zero and exn:fail structure types are sub-types of the exn structure type. Exceptions raised by core forms and functions always raise an instance of exn or one of its sub-types, but an exception does not have to be represented by a structure. The raise function lets you raise any value as an exception:
> (raise 2)
uncaught exception: 2
> (with-handlers ([(lambda (v) (equal? v 2)) (lambda (v) 'two)])
(raise 2))
two
> (with-handlers ([(lambda (v) (equal? v 2)) (lambda (v) 'two)])
(/ 1 0))
/: division by zero
Multiple predicate-exprs in a with-handlers form let you handle different kinds of exceptions in different ways. The predicates are tried in order, and if none of them match, then the exception is propagated to enclosing contexts.
> (define (always-fail n)
(with-handlers ([even? (lambda (v) 'even)]
[positive? (lambda (v) 'positive)])
(raise n)))
> (always-fail 2)
even
> (always-fail 3)
positive
> (always-fail -3)
uncaught exception: -3
> (with-handlers ([negative? (lambda (v) 'negative)])
(always-fail -3))
negative
Using (lambda (v) #t) as a predicate captures all exceptions, of course:
> (with-handlers ([(lambda (v) #t) (lambda (v) 'oops)])
(car 17))
oops
Capturing all exceptions is usually a bad idea, however. If the user types Ctl-C in a terminal window or clicks the Stop button in DrScheme to interrupt a computation, then normally the exn:break exception should not be caught. To catch only exceptions that represent errors, use exn:fail? as the predicate:
> (with-handlers ([exn:fail? (lambda (v) 'oops)])
(car 17))
oops
> (with-handlers ([exn:fail? (lambda (v) 'oops)])
(break-thread (current-thread)) ; simulate Ctl-C
(car 17))
user break
Whenever a run-time error occurs, an exception is raised. Unless the exception is caught, then it is handled by printing a message associated with the exception, and then escaping from the computation.
> (/ 1 0)
/: division by zero
> (car 17)
car: expects argument of type
To catch an exception, use the with-handlers form:
(with-handlers ([predicate-expr handler-expr] ...)
body ...+)
Each predicate-expr in a handler determines a kind of exception that is caught by the with-handlers form, and the value representing the exception is passed to the handler procedure produced by handler-expr. The result of the handler-expr is the result of the with-handlers expression.
For example, a divide-by-zero error raises an instance of the exn:fail:contract:divide-by-zero structure type:
> (with-handlers ([exn:fail:contract:divide-by-zero?
(lambda (exn) +inf.0)])
(/ 1 0))
+inf.0
> (with-handlers ([exn:fail:contract:divide-by-zero?
(lambda (exn) +inf.0)])
(car 17))
car: expects argument of type
The error function is one way to raise your own exception. It packages an error message and other information into an exn:fail structure:
> (error "crash!")
crash!
> (with-handlers ([exn:fail? (lambda (exn) 'air-bag)])
(error "crash!"))
air-bag
The exn:fail:contract:divide-by-zero and exn:fail structure types are sub-types of the exn structure type. Exceptions raised by core forms and functions always raise an instance of exn or one of its sub-types, but an exception does not have to be represented by a structure. The raise function lets you raise any value as an exception:
> (raise 2)
uncaught exception: 2
> (with-handlers ([(lambda (v) (equal? v 2)) (lambda (v) 'two)])
(raise 2))
two
> (with-handlers ([(lambda (v) (equal? v 2)) (lambda (v) 'two)])
(/ 1 0))
/: division by zero
Multiple predicate-exprs in a with-handlers form let you handle different kinds of exceptions in different ways. The predicates are tried in order, and if none of them match, then the exception is propagated to enclosing contexts.
> (define (always-fail n)
(with-handlers ([even? (lambda (v) 'even)]
[positive? (lambda (v) 'positive)])
(raise n)))
> (always-fail 2)
even
> (always-fail 3)
positive
> (always-fail -3)
uncaught exception: -3
> (with-handlers ([negative? (lambda (v) 'negative)])
(always-fail -3))
negative
Using (lambda (v) #t) as a predicate captures all exceptions, of course:
> (with-handlers ([(lambda (v) #t) (lambda (v) 'oops)])
(car 17))
oops
Capturing all exceptions is usually a bad idea, however. If the user types Ctl-C in a terminal window or clicks the Stop button in DrScheme to interrupt a computation, then normally the exn:break exception should not be caught. To catch only exceptions that represent errors, use exn:fail? as the predicate:
> (with-handlers ([exn:fail? (lambda (v) 'oops)])
(car 17))
oops
> (with-handlers ([exn:fail? (lambda (v) 'oops)])
(break-thread (current-thread)) ; simulate Ctl-C
(car 17))
user break
Scheme/Lisp 模块
;;Scheme里面编写模块，模块以.ss为后缀名。
#lang scheme
(define foo (lambda (x)
(* x x)))
(provide foo)
------------------------------------------------------------------------------------
;;也可以写成多个模块加载进去，这样可以启动一个模块，
;;同时也把其他模块加载进去，这样的写法方便维护！
#lang scheme
(require "foo.ss")
(define foo1 (lambda (x)
(* x x x)))
(provide foo1)
(provide foo)
---------------------------------
#lang scheme
(define foo (lambda (x)
(* x x)))
(provide foo)
------------------------------------------------------------------------------------
;;也可以写成多个模块加载进去，这样可以启动一个模块，
;;同时也把其他模块加载进去，这样的写法方便维护！
#lang scheme
(require "foo.ss")
(define foo1 (lambda (x)
(* x x x)))
(provide foo1)
(provide foo)
---------------------------------
Scheme/Lisp 合同（强制类型）、通讯、多回值
例如程序：
#lang scheme
(provide/contract
(amount (and/c integer? positive?)) ;;约定类型必须是整数和正数
(sum (-> number? number? number?)));;约定sum参数是两个数字，返回一个数字
;;如果你定义amount为一个负数或字符串、小数则都会返回你违反了约定
;;broke the contract (and/c integer? positive?) on amount; expected <(and/c integer? positive?)>, given: 你定义的参数（如-100，那么这里就是-100）
(define amount 100)
;;然后定义sum进行计算，如果输入一个字符串(sum "name" 1)
;;则返回你违反了约定top-level broke the contract (-> number? number? number?) on sum; expected ;;, given: "name"
(define sum (lambda (x y)
(+ x y)))
;;其实这也是异常捕获，我们也可以自己定义一个如：
(with-handlers ([exn:fail:contract? (lambda (x) "the is wrong!")))
(sum "hello" 100))
;;现在则不会返回合同的约定了，将直接打印自己定义的匿名函数the is wrong!
今天除了学习写合同模块，还学习了使用IO/tcp协议在网络中通讯，跟我以前写的JAVA通讯录一样，属于C/S模式，不同的是，使用的语言不一样和写 法不一样，原理基本差不多。而scheme的最大好处就是不用编译，只要有解释器就能通讯，跟java一样需要加载模块，(require scheme/tcp)在scheme里面则是加载Scheme里面已经封装好了的TCP协议。
如client程序:
(require scheme/tcp) ;;加载TCP协议模块
(define list-of-env-var '(content-length query-string)) ;;定义一段话发送的时候可以直接调用此函数
(define-values (server->me me->server) ;;链接服务器
(tcp-connect "localhost" 8080)) ;;服务器地址和端口
(write list-of-env-var me->server);;写入消息给服务器，已经定义了一个函数 list-of-env-var 再此直接调用
(close-output-port me->server) ;;关闭输出流
(read server->me) ;;读取server发送给我的消息
(close-input-port server->me) 关闭输入流
如server程序:
(require scheme/tcp) ;;一样加载TCP协议模块
(define tcp-port-listener (tcp-listen 8080)) ;;监听8080端口
(define-values (client-me me-client) ;;连接客服机
(tcp-accept tcp-port-listener)) ;;接受client发送的消息
(read client->me) ;;读取client发给我的信息
(write "hello!" me->client) ;;向client发送消息
(close-output-port me->client);;关闭输出流
(tcp-close tcp-port-listener);;关闭监听端口
这样在linux系统或uinx系统下面，只要知道对方的服务器IP或域名，就能直接给他发消息了。
((lambda () (values 1 2 3 4))) ;;values接受多个参数。
;;values接受多个参数进行计算。
(call-with-values
(lambda () (values 1 2)) (lambda (x y) (+ x y)))
;;进行多个函数绑定值
(define-values (a s d f)(values 1 2 3 4))
;;使用多对进行计算，多回值。
(let-values (((x y) (values 1 2))
((n m) (values 3 4)))
(+ x y m n))
;;文件的发送读入和写入的函数
with-input-from-file
with-output-to-file
以上就是我今天学习的东西，还不错，很好玩，虽然这样的流程用JAVA实现过，但是使用Scheme来实现也是很有趣的。
#lang scheme
(provide/contract
(amount (and/c integer? positive?)) ;;约定类型必须是整数和正数
(sum (-> number? number? number?)));;约定sum参数是两个数字，返回一个数字
;;如果你定义amount为一个负数或字符串、小数则都会返回你违反了约定
;;broke the contract (and/c integer? positive?) on amount; expected <(and/c integer? positive?)>, given: 你定义的参数（如-100，那么这里就是-100）
(define amount 100)
;;然后定义sum进行计算，如果输入一个字符串(sum "name" 1)
;;则返回你违反了约定top-level broke the contract (-> number? number? number?) on sum; expected ;;
(define sum (lambda (x y)
(+ x y)))
;;其实这也是异常捕获，我们也可以自己定义一个如：
(with-handlers ([exn:fail:contract? (lambda (x) "the is wrong!")))
(sum "hello" 100))
;;现在则不会返回合同的约定了，将直接打印自己定义的匿名函数the is wrong!
今天除了学习写合同模块，还学习了使用IO/tcp协议在网络中通讯，跟我以前写的JAVA通讯录一样，属于C/S模式，不同的是，使用的语言不一样和写 法不一样，原理基本差不多。而scheme的最大好处就是不用编译，只要有解释器就能通讯，跟java一样需要加载模块，(require scheme/tcp)在scheme里面则是加载Scheme里面已经封装好了的TCP协议。
如client程序:
(require scheme/tcp) ;;加载TCP协议模块
(define list-of-env-var '(content-length query-string)) ;;定义一段话发送的时候可以直接调用此函数
(define-values (server->me me->server) ;;链接服务器
(tcp-connect "localhost" 8080)) ;;服务器地址和端口
(write list-of-env-var me->server);;写入消息给服务器，已经定义了一个函数 list-of-env-var 再此直接调用
(close-output-port me->server) ;;关闭输出流
(read server->me) ;;读取server发送给我的消息
(close-input-port server->me) 关闭输入流
如server程序:
(require scheme/tcp) ;;一样加载TCP协议模块
(define tcp-port-listener (tcp-listen 8080)) ;;监听8080端口
(define-values (client-me me-client) ;;连接客服机
(tcp-accept tcp-port-listener)) ;;接受client发送的消息
(read client->me) ;;读取client发给我的信息
(write "hello!" me->client) ;;向client发送消息
(close-output-port me->client);;关闭输出流
(tcp-close tcp-port-listener);;关闭监听端口
这样在linux系统或uinx系统下面，只要知道对方的服务器IP或域名，就能直接给他发消息了。
((lambda () (values 1 2 3 4))) ;;values接受多个参数。
;;values接受多个参数进行计算。
(call-with-values
(lambda () (values 1 2)) (lambda (x y) (+ x y)))
;;进行多个函数绑定值
(define-values (a s d f)(values 1 2 3 4))
;;使用多对进行计算，多回值。
(let-values (((x y) (values 1 2))
((n m) (values 3 4)))
(+ x y m n))
;;文件的发送读入和写入的函数
with-input-from-file
with-output-to-file
以上就是我今天学习的东西，还不错，很好玩，虽然这样的流程用JAVA实现过，但是使用Scheme来实现也是很有趣的。
Scheme/lisp 将打印出来的CGI变量写入文件中
#! /bin/sh
":"; exec /usr/bin/mzscheme -qr $0 $"@"
(display "content-type: text/plain")
(newline)
(newline)
(define my-list (cons (getenv "GATEWAY_INTERFACE")
(cons (getenv "SERVER_NAME")
(cons (getenv"SERVER_SOFTWARE")
(cons (getenv "ACCEPT")
(cons (getenv "ACCEPT_ENCODING")
(cons (getenv "ACCEPT_LANGUAGE")
(cons (getenv "AUTORIZATION")
(cons (getenv "FORM")
(cons (getenv "IF_MODIFIED_SINGCE")
(cons (getenv "PRAGMA")
(cons (getenv "REFFERER")
(cons (getenv "USER_AGENT")
(cons (getenv "REQUEST_METHOD")
(cons (getenv "QUERY_STRING")
(cons (getenv "CONTENT_LENGTH")
(cons (getenv "AUTH_TYPE")
(cons (getenv "CONTENT_FILE")
(cons (getenv "SCRPT_NAME")
(cons (getenv "REQUEST_METHOD")
(cons (getenv"REQUEST_LINE")
(cons (getenv "REMOTE_USER")
(cons (getenv "REMOTE_ADDR")
(cons (getenv "QUERY_STRING")
(cons (getenv"PATH_TRANSLATED")
(cons (getenv "PATH_INFO") '()))))))))))))))))))))))))))
(define my-out-list (lambda (x)
(begin
(display x)
(newline))))
(for-each my-out-list my-list)
(define my-getenv (lambda (x)
(display (getenv x))
(newline)
(newline)))
;;(for-each my-getenv my-list)
(define out-list (lambda (put-file list-name)
(let loop ((out-name list-name))
(if (null?(cdr out-name))(write (car out-name) put-file)
(begin
(write (car out-name)put-file)
(newline put-file)
(loop (cdr out-name)))))
(close-output-port put-file)))
(display "hello")
(define my-output-port (open-output-file "./server.info" #:exists 'truncate))
;;(write my-list my-output-port)
;;(close-output-port my-output-port)
(out-list my-output-port my-list)
":"; exec /usr/bin/mzscheme -qr $0 $"@"
(display "content-type: text/plain")
(newline)
(newline)
(define my-list (cons (getenv "GATEWAY_INTERFACE")
(cons (getenv "SERVER_NAME")
(cons (getenv"SERVER_SOFTWARE")
(cons (getenv "ACCEPT")
(cons (getenv "ACCEPT_ENCODING")
(cons (getenv "ACCEPT_LANGUAGE")
(cons (getenv "AUTORIZATION")
(cons (getenv "FORM")
(cons (getenv "IF_MODIFIED_SINGCE")
(cons (getenv "PRAGMA")
(cons (getenv "REFFERER")
(cons (getenv "USER_AGENT")
(cons (getenv "REQUEST_METHOD")
(cons (getenv "QUERY_STRING")
(cons (getenv "CONTENT_LENGTH")
(cons (getenv "AUTH_TYPE")
(cons (getenv "CONTENT_FILE")
(cons (getenv "SCRPT_NAME")
(cons (getenv "REQUEST_METHOD")
(cons (getenv"REQUEST_LINE")
(cons (getenv "REMOTE_USER")
(cons (getenv "REMOTE_ADDR")
(cons (getenv "QUERY_STRING")
(cons (getenv"PATH_TRANSLATED")
(cons (getenv "PATH_INFO") '()))))))))))))))))))))))))))
(define my-out-list (lambda (x)
(begin
(display x)
(newline))))
(for-each my-out-list my-list)
(define my-getenv (lambda (x)
(display (getenv x))
(newline)
(newline)))
;;(for-each my-getenv my-list)
(define out-list (lambda (put-file list-name)
(let loop ((out-name list-name))
(if (null?(cdr out-name))(write (car out-name) put-file)
(begin
(write (car out-name)put-file)
(newline put-file)
(loop (cdr out-name)))))
(close-output-port put-file)))
(display "hello")
(define my-output-port (open-output-file "./server.info" #:exists 'truncate))
;;(write my-list my-output-port)
;;(close-output-port my-output-port)
(out-list my-output-port my-list)
Scheme/Lisp CGI通讯，将访问的页面写入文本文件中
;;首先启动服务器
;;加载TCP协议模块
;; The lib we need
(require scheme/tcp)
;;监听90端口
;; Set a port for listening
(define tcp-port-listener (tcp-listen 90))
;;监听客户机发送的请求和消息，将客户机浏览的页面写入一个server.info文件里面。
(define listening (lambda ()
(define-values (client->me me->client)
(tcp-accept tcp-port-listener)) ;;监听90端口的信息
;;重新定义打开一个server.info文件
(set! output-file (open-output-file "server.info" #:exists 'truncate))
(let loop((me (read client->me))) ;;读取将客户机发送的消息保存到me
(cond
((eof-object? me) '()) ;;判断读取文件是否到了最后eof
((list? me) ;;判断是否是一个列表
(begin
(display "running")
;;将me的参数传个新定义的ls，进行判断是不是为空，然后写入server.info文件里面去。每写完一句，换行继续写。写完后关闭输入输出和监控 端口的流。
(let loop2((ls me))
(if (null? (cdr ls)) (write (car ls) output-file)
(begin
(display (car ls))
(newline)
(write (car ls) output-file)
(newline output-file)
(loop2 (cdr ls)))))))
(else
(begin
(display me)
(newline)
(loop (read client->me))))))
(close-output-port output-file)
(close-input-port client->me)
(close-output-port me->client)
(listening)))
;;CGI程序如下：
;;前面这段应该都知道是加载SCHEME解释器和文件类型
#!/bin/sh
":"; exec /usr/local/plt/bin/mzscheme -rq $0 "$@"
(display "content-type: text/plain")
(newline)
(newline)
;;定义一个输出列表，将打开一个文件server.info，将CGI变量写入该文件中
(define output-list (lambda (output-file list-name)
(let loop((out list-name))
(if (null? (cdr out)) (write (car out) output-file)
(begin
(write (car out) output-file)
(newline output-file)
(loop (cdr out)))))
(close-output-port output-file))) ;;关闭输出流
;;定义一个打开文件函数
(define output-port (open-output-file "server.info" #:exists 'truncate))
;;定义一个返回自身函数
(define new-display (lambda (n)
(begin
(display n)
(newline))))
(display "The following environment variables are not request-specific and are set for all requests:SERVER_SOFTWARE,SERVER_NAME,GATEWAY_INTERFACE")
(newline)
;;取CGI变量的值
(define non-request (cons (getenv "SERVER_SOFTWARE")
(cons (getenv "SERVER_NAME")
(cons (getenv "GATEWAY_INTERFACE") '()))))
(for-each new-display non-request)
(newline)
(display "The following environment variables are specific to the request being fulfilled by the gateway
program: SERVER_PROTOCOL,SERVER_PORT,SERVER_METHOD,PATH_INFO,PATH_TRANSLATED,SCRIPT_NAME,QUERY_STRING,
REMOTE_HOST,REMOTE_ADDR,AUTH_TYPE,REMOTE_USER_REMOTE_INDENT,CONTENT_TYPE,CONTENT_LENGTH")
(newline)
;;取CGI变量的值
(define request (cons (getenv "SERVER_PROTOCOL")
(cons (getenv "SERVER_PORT")
(cons (getenv "SERVER_METH0D")
(cons (getenv "PATH_INFO")
(cons (getenv "PATH_TRANSLATED")
(cons (getenv "SCRIPT_NAME")
(cons (getenv "QUERY_STRING")
(cons (getenv "REMOTE_HOST")
(cons (getenv "REMOTE_ADDR")
(cons (getenv "AUTH_TYPE")
(cons (getenv "REMOTE_USER")
(cons (getenv "REMOTE_INDENT")
(cons (getenv "CONTENT_TYPE")
(cons (getenv "CONTENT_LENGTH") '())))))))))))))))
(for-each new-display request)
;;取CGI变量HTTP_的值
(define HTTP-spec (cons (getenv "HTTP_ACCEPT")
(cons "HTTP_USER_AGENT" '())))
(for-each new-display HTTP-spec)
;(output-list output-port (append non-request (append request HTTP-spec)))
;; Client will try to connect the server,and port is 5566.
;;链接服务器，跟服务器取得联系。
(define-values (server->me me->server)
(tcp-connect "localhost" 90))
;; Send the server infos to tcp server
;;将 CGI的值传给server。
(write (append non-request (append request HTTP-spec)) me->server)
;; remember that if you are not going to close the port,your infos still
;; in buffers that will not send
;;关闭输出流
(close-output-port me->server)
;;加载TCP协议模块
;; The lib we need
(require scheme/tcp)
;;监听90端口
;; Set a port for listening
(define tcp-port-listener (tcp-listen 90))
;;监听客户机发送的请求和消息，将客户机浏览的页面写入一个server.info文件里面。
(define listening (lambda ()
(define-values (client->me me->client)
(tcp-accept tcp-port-listener)) ;;监听90端口的信息
;;重新定义打开一个server.info文件
(set! output-file (open-output-file "server.info" #:exists 'truncate))
(let loop((me (read client->me))) ;;读取将客户机发送的消息保存到me
(cond
((eof-object? me) '()) ;;判断读取文件是否到了最后eof
((list? me) ;;判断是否是一个列表
(begin
(display "running")
;;将me的参数传个新定义的ls，进行判断是不是为空，然后写入server.info文件里面去。每写完一句，换行继续写。写完后关闭输入输出和监控 端口的流。
(let loop2((ls me))
(if (null? (cdr ls)) (write (car ls) output-file)
(begin
(display (car ls))
(newline)
(write (car ls) output-file)
(newline output-file)
(loop2 (cdr ls)))))))
(else
(begin
(display me)
(newline)
(loop (read client->me))))))
(close-output-port output-file)
(close-input-port client->me)
(close-output-port me->client)
(listening)))
;;CGI程序如下：
;;前面这段应该都知道是加载SCHEME解释器和文件类型
#!/bin/sh
":"; exec /usr/local/plt/bin/mzscheme -rq $0 "$@"
(display "content-type: text/plain")
(newline)
(newline)
;;定义一个输出列表，将打开一个文件server.info，将CGI变量写入该文件中
(define output-list (lambda (output-file list-name)
(let loop((out list-name))
(if (null? (cdr out)) (write (car out) output-file)
(begin
(write (car out) output-file)
(newline output-file)
(loop (cdr out)))))
(close-output-port output-file))) ;;关闭输出流
;;定义一个打开文件函数
(define output-port (open-output-file "server.info" #:exists 'truncate))
;;定义一个返回自身函数
(define new-display (lambda (n)
(begin
(display n)
(newline))))
(display "The following environment variables are not request-specific and are set for all requests:SERVER_SOFTWARE,SERVER_NAME,GATEWAY_INTERFACE")
(newline)
;;取CGI变量的值
(define non-request (cons (getenv "SERVER_SOFTWARE")
(cons (getenv "SERVER_NAME")
(cons (getenv "GATEWAY_INTERFACE") '()))))
(for-each new-display non-request)
(newline)
(display "The following environment variables are specific to the request being fulfilled by the gateway
program: SERVER_PROTOCOL,SERVER_PORT,SERVER_METHOD,PATH_INFO,PATH_TRANSLATED,SCRIPT_NAME,QUERY_STRING,
REMOTE_HOST,REMOTE_ADDR,AUTH_TYPE,REMOTE_USER_REMOTE_INDENT,CONTENT_TYPE,CONTENT_LENGTH")
(newline)
;;取CGI变量的值
(define request (cons (getenv "SERVER_PROTOCOL")
(cons (getenv "SERVER_PORT")
(cons (getenv "SERVER_METH0D")
(cons (getenv "PATH_INFO")
(cons (getenv "PATH_TRANSLATED")
(cons (getenv "SCRIPT_NAME")
(cons (getenv "QUERY_STRING")
(cons (getenv "REMOTE_HOST")
(cons (getenv "REMOTE_ADDR")
(cons (getenv "AUTH_TYPE")
(cons (getenv "REMOTE_USER")
(cons (getenv "REMOTE_INDENT")
(cons (getenv "CONTENT_TYPE")
(cons (getenv "CONTENT_LENGTH") '())))))))))))))))
(for-each new-display request)
;;取CGI变量HTTP_的值
(define HTTP-spec (cons (getenv "HTTP_ACCEPT")
(cons "HTTP_USER_AGENT" '())))
(for-each new-display HTTP-spec)
;(output-list output-port (append non-request (append request HTTP-spec)))
;; Client will try to connect the server,and port is 5566.
;;链接服务器，跟服务器取得联系。
(define-values (server->me me->server)
(tcp-connect "localhost" 90))
;; Send the server infos to tcp server
;;将 CGI的值传给server。
(write (append non-request (append request HTTP-spec)) me->server)
;; remember that if you are not going to close the port,your infos still
;; in buffers that will not send
;;关闭输出流
(close-output-port me->server)
Scheme/Lisp 启动一个多线程！
前面写了IO流，现在继续我的学习练习代码，玩具级的程序，多线程的实现。
;;首先定义一个线程吧！
(define thd-one (thread
(lambda ()
(let loop ((m (thread-receive)))
(if (equal? m 'hello)
(kill-thread thd-one)
(loop (thread-receive))))))
;;呵呵，好了，测试下这个线程是否在运行
(thread-running? thd-one)
;;向线程发送消息
(thread-send thd-one 'hello)
;;在测试下线程是否还在运行
(thread-dend? thd-one)
;;这下应该死掉了吧，因为程序是这样设计的，当给线程发送消息的时候判断，该信息是什么，就比如一个命令，你向该线程发送一个杀死的命令，所以就这样死 掉了。
;;首先定义一个线程吧！
(define thd-one (thread
(lambda ()
(let loop ((m (thread-receive)))
(if (equal? m 'hello)
(kill-thread thd-one)
(loop (thread-receive))))))
;;呵呵，好了，测试下这个线程是否在运行
(thread-running? thd-one)
;;向线程发送消息
(thread-send thd-one 'hello)
;;在测试下线程是否还在运行
(thread-dend? thd-one)
;;这下应该死掉了吧，因为程序是这样设计的，当给线程发送消息的时候判断，该信息是什么，就比如一个命令，你向该线程发送一个杀死的命令，所以就这样死 掉了。
Scheme/Lisp 启动一个进程中启动多线程！
（define thd-a (thread (lambda ()
(let loop ((m (thread-receive)))
(cond
((equal? m 'hello!)
(thread-send thd-b 'nihao!))
((equal? m 'bye-bye!)
(kill-thread thd-a))
(else
(loop (thread-receive))))))))
(define thd-b (thread (lambda ()
(let loop ((n(thread-receive)))
(cond
((equal? n 'nihao!)
(thread-send thd-a 'hello!))
((equal? n 'bye-bye)
(kill-thread thd-b))
(else
(loop (thread-receive))))))))
(let loop ((m (thread-receive)))
(cond
((equal? m 'hello!)
(thread-send thd-b 'nihao!))
((equal? m 'bye-bye!)
(kill-thread thd-a))
(else
(loop (thread-receive))))))))
(define thd-b (thread (lambda ()
(let loop ((n(thread-receive)))
(cond
((equal? n 'nihao!)
(thread-send thd-a 'hello!))
((equal? n 'bye-bye)
(kill-thread thd-b))
(else
(loop (thread-receive))))))))
Scheme/Lisp 启动一个进程实现两个进程相互通讯
;首先加载TCP协议模块
（require Scheme/tcp)
;;定义一个server的线程
(define server (thread (lambda ()
(let ((thd (tcp-listen 8080)))
(let loop ((ready (tcp-accept-ready? thd)))
(if ready
(let-values (((in out) (tcp-accept thd)))
(read in)
(close-input-port in)
(write 'got-it out)
(close-output-port out)
(loop (tcp-accept-ready? thd)))))))))
;;然后一个客户机
(define client (thread (lambda ()
(let-values (((in out) (tcp-connect "localhost" 8080)))
(write "hello" out)
(close-output-port out)
(read in)
(close-input-port in)
(kill-thread client)))))
;;这个结合IO流的代码，也应该能看懂，前面文章我写的有IO的代码。
（require Scheme/tcp)
;;定义一个server的线程
(define server (thread (lambda ()
(let ((thd (tcp-listen 8080)))
(let loop ((ready (tcp-accept-ready? thd)))
(if ready
(let-values (((in out) (tcp-accept thd)))
(read in)
(close-input-port in)
(write 'got-it out)
(close-output-port out)
(loop (tcp-accept-ready? thd)))))))))
;;然后一个客户机
(define client (thread (lambda ()
(let-values (((in out) (tcp-connect "localhost" 8080)))
(write "hello" out)
(close-output-port out)
(read in)
(close-input-port in)
(kill-thread client)))))
;;这个结合IO流的代码，也应该能看懂，前面文章我写的有IO的代码。
Scheme/Lisp 定义一个类
;;定义一个类必须在类名字后面加%，这个是Scheme语法规定 object%是超类
(define email% (class object%
(init to from)
(define To to)
(define From from)
(super-new)
(define/public (send) (display From))
(define/public (receviver) (displayer To))
(define/public (change-sender new-sende-name)
(set! From new-sende-name))))
(define email-one (new email% (to 'hh) (from 'ss)));;定义第一个email
(define email-two (make-object email% 'fg 'bb));; 定义第二个,make-object 创建一个对象！
(send email-one sender) ;;发送第一个
(send email-two sender);;发送第二个
(send email-one change-sender 'xxxxx);;重新定义第一个
(define email% (class object%
(init to from)
(define To to)
(define From from)
(super-new)
(define/public (send) (display From))
(define/public (receviver) (displayer To))
(define/public (change-sender new-sende-name)
(set! From new-sende-name))))
(define email-one (new email% (to 'hh) (from 'ss)));;定义第一个email
(define email-two (make-object email% 'fg 'bb));; 定义第二个,make-object 创建一个对象！
(send email-one sender) ;;发送第一个
(send email-two sender);;发送第二个
(send email-one change-sender 'xxxxx);;重新定义第一个
订阅：
博文 (Atom)
