/[clarity]/gui/start-gui.lisp
ViewVC logotype

Contents of /gui/start-gui.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Wed Aug 16 20:18:39 2006 UTC (7 years, 8 months ago) by skleinberg
File size: 4447 byte(s)
Initial import
1 ;;; -*- Mode: Lisp -*-
2
3 #|CLARITY: Common Lisp Data Alignment Repository
4 Copyright (c) 2006 Samantha Kleinberg
5 All rights reserved.
6
7 This library is free software; you can redistribute it and/or modify it under the terms of the GNU
8 Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the
9 License, or (at your option) any later version.
10
11 This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even
12 the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
13 General Public License for more details.
14
15 You should have received a copy of the GNU Lesser General Public License along with this library;
16 if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17
18 contact: Samantha AT Bioinformatics DOT nyu DOT edu
19 715 Broadway, 10th floor
20 New York, NY 10003|#
21
22 (in-package "CLARITY")
23
24 (eval-when (:compile-toplevel :load-toplevel :execute)
25 (require "sql")
26 (require "odbc"))
27
28
29 #.(sql:enable-sql-reader-syntax)
30
31
32 ;;; Environment setting functions.
33
34 (defun setup-clarity-logical-pathnames ()
35 (let* ((command (first system:*line-arguments-list*))
36 (executable-location
37 (make-pathname :name nil
38 :type nil
39 :defaults (pathname command)))
40 )
41 (setf (logical-pathname-translations "CLARITY")
42 `(("*.*" ,(make-pathname :name :wild
43 :type :wild
44 :defaults executable-location))
45 ("*.*.*" ,(make-pathname :name :wild
46 :type :wild
47 :version :wild
48 :defaults executable-location))
49 ("**;*.*" ,(merge-pathnames
50 (make-pathname :name :wild
51 :type :wild
52 :directory (list :relative :wild-inferiors))
53 executable-location))
54 ("**;*.*.*" ,(merge-pathnames
55 (make-pathname :name :wild
56 :type :wild
57 :version :wild
58 :directory (list :relative :wild-inferiors))
59 executable-location))
60 )
61 )))
62
63
64
65 ;;; Startup functions.
66
67
68 (defvar *clarity-init-file*
69 (make-pathname :name ".clarity-init"
70 :type nil
71 :defaults (user-homedir-pathname)))
72
73 (defvar *clarity-init-file-dos*
74 (make-pathname :name "_clarity-init"
75 :type nil
76 :defaults (user-homedir-pathname)))
77
78
79 (defun start-clarity-gui (&key(init-file (list *clarity-init-file*
80 *clarity-init-file-dos*))
81 data-file
82 (reset-logical-pathnames-p t)
83 )
84 (flet ((load-init-file (init-file)
85 (let ((*package* (find-package "CLARITY")))
86 (load init-file :print nil :verbose nil :if-does-not-exist nil)))
87 )
88 (etypecase init-file
89 (list (some #'load-init-file init-file))
90 ((or string pathname) (load-init-file init-file)))
91
92
93 (capi:display-message "Starting CLARITY.")
94
95 (clarity:make-clarity-handle)
96 (clarity:connect clarity::*current-clarity-handle* (clarity::start-setup-interface))
97 (capi:display-message "DBS connected.")
98
99 (let ((gui (make-instance 'clarity-interface
100 :clarity-handle clarity::*current-clarity-handle*)))
101 (capi:display gui)
102 (when reset-logical-pathnames-p
103 (setup-clarity-logical-pathnames))
104 (capi:execute-with-interface
105 gui
106 (lambda ()
107 (etypecase init-file
108 (list (some #'load-init-file init-file))
109 ((or string pathname) (load-init-file init-file)))
110 (when reset-logical-pathnames-p
111 (setup-clarity-logical-pathnames))
112
113 ))
114
115 (when data-file
116 (load data-file :print nil :verbose nil))
117 gui)))
118
119
120 #.(sql:disable-sql-reader-syntax)
121
122 ;;; end of file -- start-gui.lisp --

  ViewVC Help
Powered by ViewVC 1.1.5