~ubuntu-branches/ubuntu/hardy/uim/hardy

« back to all changes in this revision

Viewing changes to scm/plugin.scm

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2005-12-04 13:10:42 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20051204131042-ktzc8b17zi7a3cw8
Tags: 1:0.4.9.1-1
* New upstream release
* libuim0-nox, libuim-nox-dev, and libuim0-dbg-nox is now obsolete.
  Because libuim0 does not depends on X11. They now become dummy package,
  therefore you can safely remove them.
* Add --enable-debug in configure again.
* debian/patches/08_fix_privilage_escalation_CVE_2005_3149: disabled.
* Fix Error on purge because update-uim-config is not found.
  (closes: Bug#339345)
* uim-qt: New package for Qt utilities for uim. qt-immodule does not
  contained yet because of Debian's Qt3 does not support immodule and
  because uim does not recognize libqt4-dev's headers properly. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
;;;
 
2
;;; $Id:$
 
3
;;;
 
4
;;; plugin.scm: Plugin for uim.
 
5
;;;
 
6
;;; Copyright (c) 2005 uim Project http://uim.freedesktop.org/
 
7
;;;
 
8
;;; All rights reserved.
 
9
;;;
 
10
;;; Redistribution and use in source and binary forms, with or without
 
11
;;; modification, are permitted provided that the following conditions
 
12
;;; are met:
 
13
;;; 1. Redistributions of source code must retain the above copyright
 
14
;;;    notice, this list of conditions and the following disclaimer.
 
15
;;; 2. Redistributions in binary form must reproduce the above copyright
 
16
;;;    notice, this list of conditions and the following disclaimer in the
 
17
;;;    documentation and/or other materials provided with the distribution.
 
18
;;; 3. Neither the name of authors nor the names of its contributors
 
19
;;;    may be used to endorse or promote products derived from this software
 
20
;;;    without specific prior written permission.
 
21
;;;
 
22
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
 
23
;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 
24
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 
25
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
 
26
;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 
27
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 
28
;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 
29
;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 
30
;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 
31
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 
32
;;; SUCH DAMAGE.
 
33
;;;;
 
34
 
 
35
(require "util.scm")
 
36
 
 
37
(define uim-plugin-lib-load-path
 
38
   (if (is-set-ugid?)
 
39
       (list (string-append (sys-pkglibdir) "/plugin"))
 
40
       (filter string?
 
41
              (append (list (getenv "LIBUIM_PLUGIN_LIB_DIR")
 
42
                            (string-append (getenv "HOME") "/.uim.d/plugin")
 
43
                            (string-append (sys-pkglibdir) "/plugin"))
 
44
                      ;; XXX
 
45
                      (if (getenv "LD_LIBRARY_PATH")
 
46
                          (string-split (getenv "LD_LIBRARY_PATH") ":")
 
47
                          ())))))
 
48
 
 
49
(define uim-plugin-scm-load-path
 
50
  (if (is-set-ugid?)
 
51
      (list (sys-pkgdatadir))
 
52
      (filter string?
 
53
              (list (getenv "LIBUIM_SCM_FILES")
 
54
                    (string-append (getenv "HOME") "/.uim.d/plugin")
 
55
                    (sys-pkgdatadir)))))
 
56
 
 
57
(define plugin-alist ())
 
58
(define plugin-func-alist ())
 
59
 
 
60
(define-record 'plugin-entry
 
61
  '((name      "")
 
62
    ;;(desc      "")
 
63
    ;;(author    "")
 
64
    ;;(version   #f)
 
65
    (library   #f)
 
66
    (init-proc #f)
 
67
    (quit-proc #f)))
 
68
 
 
69
(define plugin-list-append
 
70
  (lambda (plugin-name library init quit)
 
71
   (let ((entry (plugin-entry-new plugin-name library init quit)))
 
72
     (set! plugin-alist
 
73
           (append plugin-alist (list entry))))))
 
74
 
 
75
(define plugin-list-delete
 
76
  (lambda (plugin-name)
 
77
    (set! plugin-alist
 
78
          (alist-delete plugin-name plugin-alist string=?))))
 
79
 
 
80
(define plugin-list-query
 
81
  (lambda (plugin-name)
 
82
    (assoc plugin-name plugin-alist)))
 
83
 
 
84
(define plugin-list-query-library
 
85
  (lambda (plugin-name)
 
86
    (let ((entry (plugin-list-query plugin-name)))
 
87
      (and entry
 
88
           (plugin-entry-library entry)))))
 
89
 
 
90
(define plugin-list-query-instance-init
 
91
  (lambda (plugin-name)
 
92
    (let ((entry (plugin-list-query plugin-name)))
 
93
      (and entry
 
94
           (plugin-entry-init-proc entry)))))
 
95
 
 
96
(define plugin-list-query-instance-quit
 
97
  (lambda (plugin-name)
 
98
    (let ((entry (plugin-list-query plugin-name)))
 
99
      (and entry
 
100
           (plugin-entry-quit-proc entry)))))
 
101
 
 
102
 
 
103
;; The name 'module' is adopted from a post from Hiroyuki. If you
 
104
;; feel bad about the meaning of 'module', post your opinion to
 
105
;; uim@fdo.
 
106
 
 
107
(define installed-im-module-list ())
 
108
(define currently-loading-module-name #f)
 
109
 
 
110
;;
 
111
;; TODO: write test for load-plugin
 
112
;; returns whether initialization is succeeded
 
113
(define require-module
 
114
  (lambda (module-name)
 
115
    (set! currently-loading-module-name module-name)
 
116
    (let ((succeeded (or (load-plugin module-name)
 
117
                         (try-require (string-append module-name ".scm")))))
 
118
      (set! currently-loading-module-name #f)
 
119
      succeeded)))
 
120
 
 
121
;; TODO: write test
 
122
(define load-module-conf
 
123
  (lambda ()
 
124
    (let* ((user-module-dir (string-append (getenv "HOME") "/.uim.d/plugin/"))
 
125
           (conf-file "installed-modules.scm")
 
126
           (user-conf-file (string-append user-module-dir conf-file)))
 
127
      (try-load conf-file)
 
128
      (if (is-set-ugid?)
 
129
          #f
 
130
          (if (not (getenv "LIBUIM_VANILLA"))
 
131
              (let ((orig-module-list installed-im-module-list)
 
132
                    (orig-enabled-list enabled-im-list))
 
133
                (and (try-load user-conf-file)
 
134
                     (set! installed-im-module-list
 
135
                           (append orig-module-list installed-im-module-list))
 
136
                     (set! enabled-im-list
 
137
                           (append orig-enabled-list enabled-im-list)))))))))
 
138
 
 
139
 
 
140
;; TODO: write test
 
141
(define load-enabled-modules
 
142
  (lambda ()
 
143
    (let* ((user-module-dir (string-append (getenv "HOME") "/.uim.d/plugin/"))
 
144
           (file "loader.scm")
 
145
           (user-file (string-append user-module-dir file)))
 
146
      (and (try-load file)
 
147
           (or (and (not (is-set-ugid?))
 
148
                    (try-load user-file))
 
149
               #t)))))