12
回答
Common Lisp 求助
华为云4核8G,高性能云服务器,免费试用   
; 一些辅助函数
(require :asdf)
(defun loadlib (mod)
  (asdf:oos 'asdf:load-op mod))

(defun reload ()
  (load "web.lisp"))
(defun restart-web ()
  (progn
    (reload)
    (start-web)))

; load 需要的库  
(loadlib :html-template)
(loadlib :hunchentoot)

; 设置 hunchentoot 编码
(defvar *utf-8* (flex:make-external-format :utf-8 :eol-style :lf))
(setq hunchentoot:*hunchentoot-default-external-format* *utf-8*)
; 设置url handler 转发表
(push (hunchentoot:create-prefix-dispatcher "/hello" 'hello) hunchentoot:*dispatch-table*)
        
; 页面控制器函数
(defun hello ()
  (setf (hunchentoot:content-type*) "text/html; charset=utf-8")
  (with-output-to-string (stream)
    (html-template:fill-and-print-template
     #p"index.tmpl"
     (list :name "Lisp程序员")
     :stream stream)))
; 启动服务器
(defun start-web (&optional (port 4444))
  (hunchentoot:start (make-instance 'hunchentoot:acceptor :port port)))

index.tmpl

<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<html>
  <head>
    <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
    <title>Test Lisp Web</title>
  </head>
  <body>
    <h1>Lisp web开发实例</h1>
    hi, <!-- TMPL_VAR name -->
  </body>
</html>

编译没问题

(start-web)调用后访问http://localhost:4444是没问题的,就是访问不到http://localhost:4444/hello

举报
北落
发帖于6年前 12回/1K+阅

以下是问题补充:

  • @北落 :问题已经解决果然是路径的问题 把index.tmpl替换成实际的路径就没问题了,比如我的路径是 #P"d:/lispbox-0.7/newTest/index.tmpl" (6年前)
共有12个答案 最后回答: 3年前

ansi common lisp, Graham 第十六章, 書的網有全部的碼

 *** web ***


(defmacro as (tag content)
  `(format t "<~(~A~)>~A</~(~A~)>" 
             ',tag ,content ',tag))

(defmacro with (tag &rest body)
  `(progn
     (format t "~&<~(~A~)>~%" ',tag)
     ,@body
     (format t "~&</~(~A~)>~%" ',tag)))

(defun brs (&optional (n 1))
  (fresh-line)
  (dotimes (i n)
    (princ "<br>"))
  (terpri))


(defun html-file (base)
  (format nil "~(~A~).html" base))

(defmacro page (name title &rest body)
  (let ((ti (gensym)))
    `(with-open-file (*standard-output*
                      (html-file ,name)
                      :direction :output
                      :if-exists :supersede)
       (let ((,ti ,title))
         (as title ,ti)
         (with center
           (as h2 (string-upcase ,ti)))
         (brs 3)
         ,@body))))


(defmacro with-link (dest &rest body)
  `(progn
     (format t "<a href=\"~A\">" (html-file ,dest))
     ,@body
     (princ "</a>")))

(defun link-item (dest text)
  (princ "<li>")
  (with-link dest
    (princ text)))

(defun button (dest text)
  (princ "[ ")
  (with-link dest
    (princ text))
  (format t " ]~%"))


(defun map3 (fn lst)
  (labels ((rec (curr prev next left)
             (funcall fn curr prev next)
             (when left
               (rec (car left) 
                    curr 
                    (cadr left) 
                    (cdr left)))))
    (when lst
      (rec (car lst) nil (cadr lst) (cdr lst)))))


(defparameter *sections* nil)

(defstruct item
  id title text)

(defstruct section
  id title items)

(defmacro defitem (id title text)
  `(setf ,id
         (make-item :id     ',id
                    :title  ,title
                    :text   ,text)))

(defmacro defsection (id title &rest items)
  `(setf ,id
         (make-section :id    ',id
                       :title ,title
                       :items (list ,@items))))

(defun defsite (&rest sections)
  (setf *sections* sections))


(defconstant contents "contents")
(defconstant index    "index")

(defun gen-contents (&optional (sections *sections*))
  (page contents contents
    (with ol
      (dolist (s sections)
        (link-item (section-id s) (section-title s))
        (brs 2))
      (link-item index (string-capitalize index)))))

(defun gen-index (&optional (sections *sections*))
  (page index index
    (with ol
      (dolist (i (all-items sections))
        (link-item (item-id i) (item-title i))
        (brs 2)))))

(defun all-items (sections)
  (let ((is nil))
    (dolist (s sections)
      (dolist (i (section-items s))
        (setf is (merge 'list (list i) is #'title<))))
    is))

(defun title< (x y)
  (string-lessp (item-title x) (item-title y)))


(defun gen-site ()
  (map3 #'gen-section *sections*)
  (gen-contents)
  (gen-index))

(defun gen-section (sect <sect sect>)
  (page (section-id sect) (section-title sect)
    (with ol
      (map3 #'(lambda (item <item item>)
                (link-item (item-id item)
                           (item-title item))
                (brs 2)
                (gen-item sect item <item item>))
            (section-items sect)))
    (brs 3)
    (gen-move-buttons (if <sect (section-id <sect))
                      contents
                      (if sect> (section-id sect>)))))

(defun gen-item (sect item <item item>)
  (page (item-id item) (item-title item)
    (princ (item-text item))
    (brs 3)
    (gen-move-buttons (if <item (item-id <item))
                      (section-id sect)
                      (if item> (item-id item>)))))

(defun gen-move-buttons (back up forward)
  (if back (button back "Back"))
  (if up (button up "Up"))
  (if forward (button forward "Forward")))

--- 共有 1 条评论 ---
北落感谢,我看我的这个代码问题貌似是出在 html-template上,有可能是路径的问题。 6年前 回复

land of lisp, Barski 第十三章, 書的網有全部的碼

; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation; version 2 of the License.
;
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
;
; Partial Author: Conrad Barski, M.D.
; Parts Adapted with permission from http.lisp by Ron Garret

(defun decode-param (s)
   (labels ((f (lst)
               (when lst
                 (case (car lst)
                     (#\% (cons (code-char (parse-integer (coerce (list (cadr lst) (caddr lst)) 'string) :radix 16 :junk-allowed t))
                                (f (cdddr lst))))
                     (#\+ (cons #\space (f (cdr lst))))
                     (otherwise (cons (car lst) (f (cdr lst))))))))
       (coerce (f (coerce s 'list)) 'string)))

(defun parse-params (s) 
   (let* ((i1 (position #\= s))
          (i2 (position #\& s))) 
      (cond (i1 (cons (cons (intern (string-upcase (subseq s 0 i1)))
                            (decode-param (subseq s (1+ i1) i2)))
                      (and i2 (parse-params (subseq s (1+ i2))))))
            ((equal s "") nil)
            (t s))))

(defun parse-url (s) 
  (let* ((url (subseq s
                      (+ 2 (position #\space s)) 
                      (position #\space s :from-end t)))
         (x (position #\? url)))
     (if x
         (cons (subseq url 0 x) (parse-params (subseq url (1+ x))))
         (cons url '()))))

(defun get-header (stream)
  (let* ((s (read-line stream))
         (h (let ((i (position #\: s)))
               (when i 
                     (cons (intern (string-upcase (subseq s 0 i)))
                           (subseq s (+ i 2)))))))
     (when h
        (cons h (get-header stream)))))

(defun get-content-params (stream header)
  (let ((content (assoc 'content-length header)))
    (when content
      (parse-params (read-sequence (make-string (read content)) stream)))))

(defun serve (request-handler)
  (let ((socket (socket-server 8080)))
    (unwind-protect
       (loop (with-open-stream (stream (socket-accept socket))
                 (let* ((url    (parse-url (read-line stream)))
                        (path   (car url))
                        (header (get-header stream))
                        (params (append (cdr url) 
                                        (get-content-params stream header)))
                        (*standard-output* stream))
                   (funcall request-handler path header params))))
       (socket-server-close socket))))

(defun hello-request-handler (path header params)
  (if (equal path "greeting")
      (let ((name (assoc 'name params)))
        (if (not name)
            (princ "<form>What is your name?<input name='name' /></form>")
            (format t "Nice to meet you, ~a!" (cdr name))))
      (princ "Sorry... I don't know that page.")))

各位大神,你们的lisp编译环境怎么整出来的?我已经折腾好几天了,学common lisp连编译器都安装不了,真是郁闷的紧啊!
--- 共有 2 条评论 ---
_李龙我现在就差一点点了,就是slime安装的问题了,不是说lispinbox过时了吗? 5年前 回复
北落建议用linux环境,windows的话就用lispinbox吧 5年前 回复

我最近也准备学lisp,但是在安装编译器时却出现了问题。我用得是xp的系统我也安装了emacs,sbcl,可是在安装slime时却一直安装不了,我在d盘根下建了个home文件夹,在home里建了bin,owner两个文件夹,然后把emacs,sbcl安装到D:/home/bin/然后在site-lisp里建了个site-start.el文件夹,在其中输入(setenv "HOME""D:/home/Owner/")然后生成了.emacs,安装sbcl,重启计算机,然后开始安装slime

在emacs里打开.emacs,输入

结果同



是一样的


我试过很多命令,结果都一样

我实在想不出什么地方有问题,可能到处都是问题,请帮忙指点一下!期待大神您的回复解答,谢谢!

--- 共有 4 条评论 ---
_李龙回复 @张海明 : 谢谢你!我已经安装了lispbox了! 5年前 回复
烟波网上里有lispbox,实际就是emacs+slime,解压后直接使用,环境都是配置好的。需要的话我发你份也行,大约80M,很好用 5年前 回复
_李龙@北落 谢谢!我正在用quicklisp进行安装但还是显示permission denied,我已经决定学习lisp了,就要学下去,我相信lisp很强大 5年前 回复
北落好久不弄lisp了,也不是太清楚了。我装的时候是用quicklisp进行安装的,没有出现问题。你可以试试,可以找个emacs配置好的配置文件拿来用。如果是看了黑客与画家有了学习的话建议放弃或者学习scheme或者从newlisp入手。如果非要学cl的话windows还是用lisp in box吧,都是配置好的直接用。或者转投linux吧 5年前 回复
顶部