home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / uim / uim-module-manager.scm < prev    next >
Encoding:
Text File  |  2010-11-07  |  6.1 KB  |  173 lines

  1. ;;; uim-module-manager.scm: Part of uim-module-manager, it's not a part of libuim.
  2. ;;;
  3. ;;; Copyright (c) 2005-2009 uim Project http://code.google.com/p/uim/
  4. ;;;
  5. ;;; All rights reserved.
  6. ;;;
  7. ;;; Redistribution and use in source and binary forms, with or without
  8. ;;; modification, are permitted provided that the following conditions
  9. ;;; are met:
  10. ;;; 1. Redistributions of source code must retain the above copyright
  11. ;;;    notice, this list of conditions and the following disclaimer.
  12. ;;; 2. Redistributions in binary form must reproduce the above copyright
  13. ;;;    notice, this list of conditions and the following disclaimer in the
  14. ;;;    documentation and/or other materials provided with the distribution.
  15. ;;; 3. Neither the name of authors nor the names of its contributors
  16. ;;;    may be used to endorse or promote products derived from this software
  17. ;;;    without specific prior written permission.
  18. ;;;
  19. ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
  20. ;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  21. ;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  22. ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
  23. ;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  24. ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  25. ;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  26. ;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  27. ;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  28. ;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  29. ;;; SUCH DAMAGE.
  30. ;;;;
  31.  
  32. (require "util.scm")
  33. (require "im.scm")
  34. (require "lazy-load.scm")
  35.  
  36. (define stub-im-list '())  ;; dummy
  37.  
  38. (define prepare-installed-im-list
  39.   (lambda ()
  40.     (let ((orig-enabled-im-list enabled-im-list)
  41.       (orig-require require))
  42.       (set! enabled-im-list ())  ;; enable all IMs
  43.       (set! im-list ()) ;; reset im-list
  44.       ;; XXX temporary solution to register all IM in a file
  45.       (set! require
  46.         (lambda (file)
  47.           (let* ((loaded-sym (string->symbol
  48.                   (string-append "*" file "-loaded*")))
  49.              (reloaded-sym (string->symbol
  50.                     (string-append "*" file "-reloaded*"))))
  51.         (cond
  52.          ((symbol-bound? reloaded-sym)
  53.           loaded-sym)
  54.          ((try-load file)
  55.           (eval (list 'define loaded-sym #t)
  56.             (interaction-environment))
  57.           (eval (list 'define reloaded-sym #t)
  58.             (interaction-environment))
  59.           loaded-sym)
  60.          (else
  61.           #f)))))
  62.       (for-each require-module installed-im-module-list)
  63.       (set! require orig-require)
  64.       (set! enabled-im-list orig-enabled-im-list)
  65.       (reverse (delete 'direct (map im-name im-list))))))
  66.  
  67. (define add-modules-to-module-list
  68.   (lambda (modules current-module-list)
  69.     (append
  70.      (filter
  71.       (lambda (module)
  72.     ;; Test if the module is valid
  73.     (if (require-module (symbol->string module))
  74.         #t
  75.         (begin (display (string-append "Warning: Module "
  76.                        (symbol->string module)
  77.                        " is not a correct module.\n"))
  78.            #f)))
  79.       (remove
  80.        (lambda (module)
  81.      (if (memq module current-module-list)
  82.          (begin (display (string-append "Warning: Module "
  83.                         (symbol->string module)
  84.                         " is already registered\n"))
  85.             #t)
  86.          #f))
  87.        modules))
  88.      current-module-list)))
  89.  
  90. (define remove-modules-from-module-list
  91.   (lambda (removing-modules current-module-list)
  92.     (remove
  93.      (lambda (module)
  94.        (if (memq module removing-modules)
  95.        #t
  96.        #f))
  97.      current-module-list)))
  98.  
  99. ;; This function is called with 'uim-module-manager --register'
  100. (define register-modules
  101.   (lambda (module-names)
  102.     (let* ((modules (map string->symbol module-names))
  103.        (current-module-list (map string->symbol installed-im-module-list))
  104.        (revised-module-list (add-modules-to-module-list modules
  105.                  current-module-list)))
  106.       (update-all-files revised-module-list))))
  107.  
  108. ;; This function is called with 'uim-module-manager --unregister'
  109. (define unregister-modules
  110.   (lambda (module-names)
  111.     (let* ((modules (map string->symbol module-names))
  112.        (current-module-list (map string->symbol installed-im-module-list))
  113.        (revised-module-list (remove-modules-from-module-list 
  114.                  modules
  115.                  current-module-list)))
  116.       (update-all-files revised-module-list))))
  117.  
  118. (define unregister-all-modules
  119.   (lambda (dummy)
  120.     (update-all-files '())))
  121.  
  122. (define update-all-files
  123.   (lambda (module-list)
  124.     (update-installed-modules-scm module-list)
  125.     (update-loader-scm module-list)))
  126.  
  127. (define update-loader-scm
  128.   (lambda (module-list)
  129.     (set! installed-im-module-list (map symbol->string module-list))
  130.     (write-loader.scm
  131.      (string-append
  132.       "(define stub-im-rec-spec\n"
  133.       "  '((name        #f)\n"
  134.       "    (lang        \"\")\n"
  135.       "    (encoding    \"\")\n"
  136.       "    (name-label  \"\")\n"
  137.       "    (short-desc  \"\")\n"
  138.       "    (module-name \"\")))\n"
  139.       "(define-record 'stub-im stub-im-rec-spec)\n\n"
  140.       "(define stub-im-list\n"
  141.       "  '(\n"
  142.       (string-join (stub-im-generate-all-stub-im-list) "\n")
  143.       "    ))\n\n"
  144.       "(for-each (lambda (stub)\n"
  145.       "            (if (memq (stub-im-name stub) enabled-im-list)\n"
  146.       "                (if enable-lazy-loading?\n"
  147.       "                    (apply register-stub-im stub)\n"
  148.       "                    (require-module (stub-im-module-name stub)))))\n"
  149.       "          stub-im-list)\n"
  150.       ))))
  151.  
  152. (define update-installed-modules-scm
  153.   (lambda (module-list)
  154.     (set! installed-im-module-list (map symbol->string module-list))
  155.     (try-require "custom.scm")
  156.     (set! installed-im-list (prepare-installed-im-list))
  157.     (write-installed-modules.scm
  158.      (string-append
  159.       ";; The described order of input methods affects which IM is preferred\n"
  160.       ";; at the default IM selection process for each locale. i.e.  list\n"
  161.       ";; preferable IM first for each language\n"
  162.       "(define installed-im-module-list "
  163.       (custom-list-as-literal installed-im-module-list)
  164.       ")\n"
  165.       "(define installed-im-list "
  166.       (custom-list-as-literal installed-im-list)
  167.       ")\n"
  168.       "(define enabled-im-list installed-im-list)\n"))))
  169.  
  170.  
  171. (prealloc-heaps-for-heavy-job)
  172. (verbose 1)
  173.