Hello,
I am working on the LKB as previosly mentioned. Q: Do
command-tables have to be a list per the specs of CLIM? The lkb
has code that uses it as a symbol but it is not a list, and I
would like to understand how to make it work and not just
compile. With sbcl plus some threads, I got it to compile.
Checking, I will read sources and manuals again. Thanks in
advance for any help.
http://lingo.stanford.edu/ LKB is the source site of the project
as I best understand their organization. I applied to the
delph-in develop mailing list to ask them about their code as I
try it out. Just making sure I am not making beginner's or
other foolish mistakes.
John Towler
Hello,
I sent a post not being subscribed about the LKB. I just wanted
to let folk know that the LKB from http://lingo.stanford.edu/,
written from an Allegro CL platform compiles with McCLIM and
some fixes/kludges on sbcl-1.3.1 completely with all of the code
cited as Allegro dependent working without porting CLM (Motif
from ftp.x.org/R5contrib). Clisp-2.49 is being worked on in
parallel and interleaving the two. The developers list it as
being open source, CL, requiring cltl2 (assumed now), Motif, and
CLIM, all of which Allegro CL gives them. I got this to this
significant point, and I wanted people concerned about McCLIM
and grammar development environments to be informed.
I found that there is a chunk of stuff about code involving
threading and multiprocessing mixed into the Allegro based code.
I used bordeaux-threads and looked at clocc/src/port/proc.lisp
and I will need to rework and make sure the intended stuff runs
like Un*x processes. sbcl has something now or in process. I
intend to make it run in the direction chosen by clocc, to have
it abstracted away from the particular CL.
This will add to my experience, not a problem. My original
problem about command-tables in McCLIM was solved by using
defvar ... nil and at one point giving () as an argument to
:command-table in the top-level code stuff. I don't know enough
to be able to discuss it, but I made chunks of progress, and I
wanted to thank the moderator for posting my query, and for all
of the people who work/ed on McCLIM for their indirect
contribution. I will be going through it again and fixing the
thread/process/function uses for CLIM objects, to get it
running, and then I will go back and organize the resulting
changes and make patch files etc. Odds are my fixes to get it
to compile and load messed up a chunk of CLIM stuff. tty only I
discovered several years ago works with sbcl, and clisp. I run
NetBSD-6.1.4 on a Dell D610 laptop for the most part. I just
wanted to get to working with grammars of natural language. The
project has a self-made open source license, and my changes will
be open source to fit with this and my beliefs about that
topic. Thanks again.
Sincerely,
John R. Towler
jtowler(a)soncom.com
NetBSD-6.1.4, sbcl-1.3.1 (now out), clisp-2.49 with NetBSD
pkgsrc patches to be more current with their developing code
base. cmucl for NetBSD i86 stops on lisp pathname errors and
because it doesn't just compile, I moved back to sbcl, clisp.
Sorry about the verbosity.
Tim Moore or whoever knows better. Mr. Moore is mentioned in the
comments to mcclim/commands.lisp. I am not subscribed to the list, this
may well bounce, and I shall try to check with gmane to see how this
could be dealt with.
This is from the Lkb (http://lingo.stanford.edu/) compilation
which was developed with CLIM on Allegro CL and linux and Motif(r).
I run NetBSD (6.1.4 currently) on a Dell D610 laptop and I am
using clisp-2.49 with patches to be more current from NetBSD's
pkgsrc.
This is adjusting the lkb.system file to run the compilation
throught the Allegro specific CLIM based code in a directory ACL_specific.
- Compiling source file
; "/usr/local/home/jtowler/lisp/delph-in/Lkb2012/src/ACL_specific/topmenu.lsp"
;; Compiling file /usr/local/home/jtowler/lisp/delph-in/Lkb2012/src/ACL_specific/topmenu.lsp ...
*** - CAR: LKB-TOP-COMMAND-TABLE is not a list
The following restarts are available:
ABORT :R1 Abort main loop
I read a little documentation and source code. I have not
written tons of lisp code so these may be beginner's issues. The
Lkb is open source but I am not sure I can read Allegro manuals.
Not a problem, just more to work around. mcclim/command.lisp was
helpful as was the mcclim-paper.pdf from a Lisp conference or
something that is around.
The source at issue is the following:
The problem is the error is thrown when some function I can't
find is running through lkb-top-command-table but the standard
commands.lisp taken code is not making lkb-top-command-table a
list. Attempts to stick in a defvar or a setq or change the order of
the defmethod and defgeneric forms, all just kludges to make something
work, failed. Defing them to always true stubs shows the error problem
with car.
This is in (defgeneric construct-menu *), and (defmethod ccpnstruct-menu
*) below in the included topmenu.lsp file.
How can I with a better mcclim or better command-table code make this
work to get to the next fix for the Allegro specific code.
This in the end runs a Grammar Development Environment for
natural language syntax and semantics using Head Driven Phrase
Structure Grammar. I would like to run it without Allegro CL but
with an open source CLIM.
Thanks in advance for any suggestions.
John R. Towler
jtowler(a)soncom.com
-------------------------topmenu.lsp--LICENSE is an open source license------
;;; Copyright (c) 1991-2001 John Carroll, Ann Copestake, Robert Malouf, Stephan Oepen
;;; see LICENSE for conditions
;;; MCL port
;;; split old toplevel.lsp into toplevel.lsp which should be generic CL
;;; and this file which has the commands to create the actual menu
;;; ACL port - redefine menu commands
;;; split file again - menus.lsp is independent between ACL and MCL
;;; Note - this file now must be read in before any of the other
;;; CLIM files which associate menus etc with *lkb-top-frame*
(in-package :clim-user)
(eval-when (compile load eval)
(merge-text-styles '(:sans-serif nil nil) *default-text-style*)
(export '(*lkb-top-frame* *lkb-top-stream*
*last-directory*
set-up-lkb-interaction
enable-type-interactions disable-type-interactions)))
(defvar *lkb-menu-type* :core)
(defvar *lkb-top-frame* nil)
(defvar *lkb-top-stream* nil)
(defvar *lkb-top-process* nil)
(defvar *last-directory* nil)
(defvar *complete-lisp-close* nil)
;;; Top level menus etc
(defvar *lkb-menu-disabled-list* nil
"Kludge because of MCL bug!!!!")
(defvar *lkb-menu-grammar-file-list* nil)
(defvar *lkb-menu-mrs-list* nil)
(defvar *lkb-menu* nil)
;; Classes for abstract menus, with methods for turning them into real
;; clim (or emacs?) menus
(defclass menu-thing ()
((menu-title :initarg :menu-title
:type string
:accessor menu-title)
(available-p :initarg :available-p
:accessor available-p)))
(defclass menu (menu-thing)
((menu-items :initarg :menu-items
:accessor menu-items)))
(defclass menu-item (menu-thing)
((menu-value :initarg :value
:accessor menu-value)))
;; Create a leaf menu item
(defun make-menu-item (&key name value available-p)
(let ((menu (make-instance 'menu-item
:menu-title name
:value value
:available-p available-p)))
(unless (or (eql available-p :always)
(and (eql available-p :grammar)
lkb::*current-grammar-load-file*))
(push (intern (concatenate 'string "COM-" name))
*lkb-menu-disabled-list*))
(when (eql available-p :grammar)
(push (intern (concatenate 'string "COM-" name))
*lkb-menu-grammar-file-list*))
(when (eql available-p :mrs)
(push (intern (concatenate 'string "COM-" name))
*lkb-menu-mrs-list*))
menu))
;; Create a sub-menu
(defun make-lkb-submenu-item (&key menu-title menu-items available-p)
(let ((menu (make-instance 'menu
:menu-title menu-title
:menu-items menu-items
:available-p available-p)))
(unless (eql available-p :always)
(push (intern (concatenate 'string "MENU-" menu-title))
*lkb-menu-disabled-list*))
(when (eql available-p :mrs)
(push (intern (concatenate 'string "MENU-" menu-title))
*lkb-menu-mrs-list*))
menu))
;; Process menu description
(defgeneric construct-menu (menu &optional rest))
(defmethod construct-menu ((menu menu) &optional table)
(let ((new-table (make-command-table
(intern (concatenate 'string "MENU-" (menu-title menu)))
:errorp nil)))
(push new-table (command-table-inherit-from
(find-command-table 'lkb-top-command-table)))
(add-menu-item-to-command-table table
(menu-title menu)
:menu
new-table
:errorp nil)
(mapc #'(lambda (submenu)
(construct-menu submenu new-table))
(menu-items menu))))
(defmethod construct-menu ((menu menu-item) &optional table)
(let ((name (intern (concatenate 'string "COM-" (menu-title menu)))))
(eval `(define-command (,name
:menu ,(menu-title menu)
:command-table ,table) ()
(handler-case
(funcall (quote ,(menu-value menu)))
#+:allegro
(excl:interrupt-signal (condition)
(format t "~%Interrupted"))
;; placeholder - we need a way
;; of generating an interrupt which will
;; affect these processes
(storage-condition (condition)
(format t "~%Memory allocation problem: ~A~%" condition))
(error (condition)
(format t "~%Error: ~A~%" condition))
(serious-condition (condition)
(format t "~%Something nasty: ~A~%" condition)))))))
#|
(defun construct-menu (menu)
(apply #'concatenate 'string
(nconc
(list "("
(prin1-to-string (slot-value menu 'menu-title))
" ")
(mapcar #'construct-menu-1 (slot-value menu 'menu-items))
(list ")"))))
(defun construct-menu-1 (menu)
(if (lkb-menu-item-p menu)
(apply #'concatenate 'string
(nconc
(list "("
(prin1-to-string (lkb-menu-item-menu-title menu))
" ")
(mapcar #'construct-menu-1
(lkb-menu-item-menu-items menu))
(list ")")))
(format nil "[ ~S ~A t ]"
(first menu)
(string-downcase (string (third menu))))))
|#
;; Create lkb interaction frame
(defun expand-lkb-menu nil
(setf *lkb-menu-type* :big)
(set-up-lkb-interaction))
(defun shrink-lkb-menu nil
(setf *lkb-menu-type* :core)
(set-up-lkb-interaction))
(defun set-up-lkb-interaction (&optional system-type)
(unless system-type
(setf system-type (or *lkb-menu-type* :core)))
;; remove any old commands
(setf *lkb-menu-disabled-list* nil)
(setf *lkb-menu-mrs-list* nil)
(ecase system-type
(:core (create-mini-lkb-system-menu))
(:big (create-big-lkb-system-menu)))
#|
(:full (create-lkb-system-menu))
(:yadu (create-yadu-system-menu)))
|#
(unless (EXT:getenv "LKB_GUI_EXTERNAL")
(set-up-clim-interaction)))
(defun set-up-clim-interaction ()
;; Flush old commands
(let ((table (find-command-table 'lkb-top-command-table :errorp nil)))
(when table
(let ((menu-items nil))
;; Note - removing items inside the mapping function
;; does not always work - hence the fudge
(map-over-command-table-menu-items
#'(lambda (name char item)
(declare (ignore char item))
(pushnew name menu-items))
table)
(dolist (name menu-items)
(remove-menu-item-from-command-table table name)))
(map-over-command-table-commands
#'(lambda (name)
(unless (eql name 'COM-CLOSE-TO-REPLACE)
(remove-command-from-command-table name table)))
table
:inherited nil)))
(setf (command-table-inherit-from
(find-command-table 'lkb-top-command-table))
nil)
;; make sure we have a way out
(setf (command-table-inherit-from
(find-command-table 'lkb-top-command-table))
(list (make-command-table 'menu-quit :errorp nil)))
(define-command (com-quit :menu "Click to confirm quit"
:command-table menu-quit) ()
(setq *complete-lisp-close* t)
(frame-exit *application-frame*))
(add-menu-item-to-command-table 'lkb-top-command-table
"Quit"
:menu
'menu-quit
:errorp t)
(define-command
(com-close-to-replace :command-table lkb-top-command-table) ()
(frame-exit *application-frame*))
;; add correct menu items
(dolist (submenu (menu-items *lkb-menu*))
(construct-menu submenu 'lkb-top-command-table))
;; go to it
(start-lkb-frame))
;; Top-level CLIM frame
(define-application-frame lkb-top ()
(standard-application-frame)
(:panes
(display
(outlining (:thickness 1 :record-p t)
(spacing (:thickness 1 :record-p t)
(scrolling (:scroll-bars :both :record-p t)
(make-pane 'application-pane
:name "lkb-pane"
:text-cursor nil
:end-of-line-action :allow
:borders nil
:background +white+
:foreground +black+
:draw t
:record-p t
:display-time t))))))
(:layouts
(default display))
(:geometry :width 550 :height 200)
(:command-table lkb-top-command-table))
(defun start-lkb-frame ()
(let ((old-frame *lkb-top-frame*))
(setf *lkb-top-process*
(mp:join-thread "start-lkb-frame"
#'run-lkb-top-menu
#+:allegro
excl::*initial-terminal-io*
#-:allegro *terminal-io*))
;; note - if this is being called from a command in the old frame it's
;; important this is the last action ...
(when old-frame
(execute-frame-command old-frame '(com-close-to-replace)))))
(defun run-lkb-top-menu (background-stream)
;; define this function so that stuff can be called on exit from LKB
(let ((frame (make-application-frame 'lkb-top)))
(dolist (command *lkb-menu-disabled-list*)
(setf (command-enabled command frame) nil))
(setf *lkb-top-frame* frame)
(setf *lkb-top-stream* (get-frame-pane *lkb-top-frame* 'display))
;; crude way of seeing whether this is being called when we already have a
;; grammar
(when lkb::*current-grammar-load-file*
(enable-type-interactions))
(setf lkb::*lkb-background-stream* background-stream)
(unwind-protect
(run-frame-top-level frame)
(when *complete-lisp-close*
;;
;; with the latest set of CLIM patches, it appears we need to rebind the
;; standard streams to avoid an `operation on closed stream' error(),
;; while shutting down the Lisp. not quite sure why, but alas.
;; (8-feb-08; oe)
#+:allegro
(let* ((stream excl:*initial-terminal-io*)
(*standard-output* stream)
(*debug-io* stream)
(*terminal-io* stream)
(*standard-input* stream)
(*error-output* stream)
(*query-io* stream)
(*trace-output* stream))
(excl:exit 0 :no-unwind t :quiet t))
#+:lispworks
(lw:quit :ignore-errors-p t)
#-(or :allegro :lispworks)
(error "no known mechanism to shutdown Lisp (see `topmenu.lsp'")))))
#|
(defun user-exit-lkb-frame (frame)
;; Check if user really wants to do this. By default, exit Lisp as
;; well. For stand-alone application, always exit Lisp as well.
(if (lep:lep-is-running)
(let ((result (lkb::ask-user-for-multiple-choice "Really exit?"
'Lisp 'LKB 'Cancel)))
(cond ((eq result 'lkb) (frame-exit frame))
((eq result 'lisp)
(setf *complete-lisp-close* t)
(frame-exit frame))
(t nil)))
(when (lkb::lkb-y-or-n-p "Really exit the system?")
(setf *complete-lisp-close* t)
(frame-exit frame))))
(defun restart-lkb-function nil
(lkb::read-psort-index-file)
(setf *last-directory* nil)
(set-up-lkb-interaction))
|#
(defun restart-lkb-window nil
(setf *last-directory* nil)
(set-up-lkb-interaction))
#+:allegro
(defun dump-lkb nil
(if lkb::*current-grammar-load-file*
(progn (lkb::lkb-beep)
(format t "~%Dump system will not work after a grammar has been loaded"))
(let ((image-location
(lkb::ask-user-for-new-pathname
(format nil
"File for image (local file advised)"))))
(when image-location
;;; apparently 5.0 requires that the file be .dxl
;;; this lets the user give another type - since they may know more
;;; than I do, but issues a warning message
#+(and :allegro (version>= 5 0))
(let ((image-type (pathname-type image-location)))
(unless image-type
(setf image-location
(merge-pathnames image-location
(make-pathname :type "dxl"))))
(when image-type
(unless (equal image-type "dxl")
(format t
"~%Warning - image type was ~A when dxl was expected"
image-type))))
(setf excl:*restart-init-function* #'restart-lkb-window)
(excl:dumplisp :name image-location)
(lkb::lkb-beep)
(format t "~%Image saved~%")
nil))))
(defun enable-type-interactions nil
;; it may only work from within the application frame
(dolist (command *lkb-menu-disabled-list*)
(if (or lkb::*mrs-loaded* (not (member command *lkb-menu-mrs-list*)))
(setf (command-enabled command *lkb-top-frame*) t))))
(defun disable-type-interactions nil
(when clim-user::*lkb-top-frame*
;; this is called when a type file is being redefined it may only
;; work from within the application frame
(dolist (command *lkb-menu-disabled-list*)
(unless (member command *lkb-menu-grammar-file-list*)
(setf (command-enabled command *lkb-top-frame*) nil)))))
(defun enable-grammar-reload-interactions nil
(dolist (command *lkb-menu-grammar-file-list*)
(setf (command-enabled command *lkb-top-frame*) t)))
(defun enable-mrs-interactions nil
(when lkb::*mrs-loaded*
(dolist (command *lkb-menu-mrs-list*)
(setf (command-enabled command *lkb-top-frame*) t))))
;;; functions called from top level menu which are time
;;; consuming
(defun parse-sentences-batch nil
;;; for MCL this can just be parse-sentences
(mp:join-thread "Batch parse" #'lkb::parse-sentences))
;; Direct output to LKB window, if present
(defun invoke-with-output-to-top (body)
(unwind-protect
(let ((*standard-output* *lkb-top-stream*)
;;
;; _fix_me_
;; we believe that debug output from the CLIM patches may cause a
;; force-output() on *debug-io* to raise an error(), when running
;; in a background process. (13-feb-08; oe)
;;
#-:logon
(*debug-io* *lkb-top-stream*)
;; (*terminal-io* *lkb-top-stream*)
(*standard-input* *lkb-top-stream*)
(*error-output* *lkb-top-stream*)
(*query-io* *lkb-top-stream*)
(*trace-output* *lkb-top-stream*))
(when (not (eq mp:current-thread *lkb-top-process*))
(mp:process-add-arrest-reason *lkb-top-process* :output))
(setf (stream-recording-p *standard-output*) t)
(funcall body))
(mp:process-revoke-arrest-reason *lkb-top-process* :output)))
