diff options
author | Stephane Glondu <steph@glondu.net> | 2010-07-21 09:46:51 +0200 |
---|---|---|
committer | Stephane Glondu <steph@glondu.net> | 2010-07-21 09:46:51 +0200 |
commit | 5b7eafd0f00a16d78f99a27f5c7d5a0de77dc7e6 (patch) | |
tree | 631ad791a7685edafeb1fb2e8faeedc8379318ae /ide/uim/coqide.scm | |
parent | da178a880e3ace820b41d38b191d3785b82991f5 (diff) |
Imported Upstream snapshot 8.3~beta0+13298
Diffstat (limited to 'ide/uim/coqide.scm')
-rw-r--r-- | ide/uim/coqide.scm | 277 |
1 files changed, 277 insertions, 0 deletions
diff --git a/ide/uim/coqide.scm b/ide/uim/coqide.scm new file mode 100644 index 00000000..62355ac2 --- /dev/null +++ b/ide/uim/coqide.scm @@ -0,0 +1,277 @@ +;;; coqide.scm -- Emacs-style Latin characters translation +;;; +;;; Copyright (c) 2003-2009 uim Project http://code.google.com/p/uim/ +;;; +;;; All rights reserved. +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. +;;; 3. Neither the name of authors nor the names of its contributors +;;; may be used to endorse or promote products derived from this software +;;; without specific prior written permission. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND +;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE +;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +;;; SUCH DAMAGE. +;;;; + +;; This input method implements character composition rules for the +;; Latin letters used in European languages. The rules, defined in +;; the file coqide-rules.scm, have been adapted from GNU Emacs 22. + +(require "util.scm") +(require "rk.scm") +(require "coqide-rules.scm") +(require-custom "generic-key-custom.scm") +(require-custom "coqide-custom.scm") + +(define coqide-context-rec-spec + (append + context-rec-spec + '((on #f) + (rkc #f) + (show-cands #f)))) +(define-record 'coqide-context coqide-context-rec-spec) +(define coqide-context-new-internal coqide-context-new) + +(define (coqide-context-new id im) + (let ((lc (coqide-context-new-internal id im)) + (rkc (rk-context-new (symbol-value coqide-rules) #f #f))) + (coqide-context-set-widgets! lc coqide-widgets) + (coqide-context-set-rkc! lc rkc) + lc)) + +(define (coqide-current-translation lc) + (let ((rkc (coqide-context-rkc lc))) + (or (rk-peek-terminal-match rkc) + (and (not (null? (rk-context-seq rkc))) + (list (rk-pending rkc)))))) + +(define (coqide-current-string lc) + (let ((trans (coqide-current-translation lc))) + (if trans (car trans) ""))) + +(define (coqide-context-clear lc) + (rk-flush (coqide-context-rkc lc))) + +(define (coqide-context-flush lc) + (let ((str (coqide-current-string lc))) + (if (not (equal? str "")) (im-commit lc str)) + (coqide-context-clear lc))) + +(define (coqide-open-candidates-window lc height) + (if (coqide-context-show-cands lc) + (im-deactivate-candidate-selector lc)) + (im-activate-candidate-selector lc height height) + (im-select-candidate lc 0) + (coqide-context-set-show-cands! lc #t)) + +(define (coqide-close-candidates-window lc) + (if (coqide-context-show-cands lc) + (im-deactivate-candidate-selector lc)) + (coqide-context-set-show-cands! lc #f)) + +(define (coqide-update-preedit lc) + (if (coqide-context-on lc) + (let ((trans (coqide-current-translation lc)) + (ltrans 0)) + (im-clear-preedit lc) + (if trans + (begin (im-pushback-preedit lc + preedit-underline + (car trans)) + (set! ltrans (length trans)))) + (im-pushback-preedit lc + preedit-cursor + "") + (im-update-preedit lc) + (if (> ltrans 1) + (coqide-open-candidates-window lc ltrans) + (coqide-close-candidates-window lc))))) + +(define (coqide-prepare-activation lc) + (coqide-context-flush lc) + (coqide-update-preedit lc)) + +(register-action 'action_coqide_off + (lambda (lc) + (list + 'off + "a" + (N_ "CoqIDE mode off") + (N_ "CoqIDE composition off"))) + (lambda (lc) + (not (coqide-context-on lc))) + (lambda (lc) + (coqide-prepare-activation lc) + (coqide-context-set-on! lc #f))) + +(register-action 'action_coqide_on + (lambda (lc) + (list + 'on + "à" + (N_ "CoqIDE mode on") + (N_ "CoqIDE composition on"))) + (lambda (lc) + (coqide-context-on lc)) + (lambda (lc) + (coqide-prepare-activation lc) + (coqide-context-set-on! lc #t))) + +(define coqide-input-mode-actions + '(action_coqide_off action_coqide_on)) + +(define coqide-widgets '(widget_coqide_input_mode)) + +(define default-widget_coqide_input_mode 'action_coqide_on) + +(register-widget 'widget_coqide_input_mode + (activity-indicator-new coqide-input-mode-actions) + (actions-new coqide-input-mode-actions)) + +(define coqide-context-list '()) + +(define (coqide-init-handler id im arg) + (let ((lc (coqide-context-new id im))) + (set! coqide-context-list (cons lc coqide-context-list)) + lc)) + +(define (coqide-release-handler lc) + (let ((rkc (coqide-context-rkc lc))) + (set! coqide-context-list + ;; (delete lc coqide-context-list eq?) does not work + (remove (lambda (c) (eq? (coqide-context-rkc c) rkc)) + coqide-context-list)))) + +(define coqide-control-key? + (let ((shift-or-no-modifier? (make-key-predicate '("<Shift>" "")))) + (lambda (key key-state) + (not (shift-or-no-modifier? -1 key-state))))) + +(define (coqide-proc-on-state lc key key-state) + (let ((rkc (coqide-context-rkc lc)) + (cur-trans (coqide-current-translation lc))) + (cond + + ((or (coqide-off-key? key key-state) + (and coqide-esc-turns-off? (eq? key 'escape))) + (coqide-context-flush lc) + (if (eq? key 'escape) + (im-commit-raw lc)) + (coqide-context-set-on! lc #f) + (coqide-close-candidates-window lc) + (im-clear-preedit lc) + (im-update-preedit lc)) + + ((coqide-backspace-key? key key-state) + (if (not (rk-backspace rkc)) + (im-commit-raw lc))) + + ((coqide-control-key? key key-state) + (coqide-context-flush lc) + (im-commit-raw lc)) + + ((and (ichar-numeric? key) + (coqide-context-show-cands lc) + (let ((idx (- (numeric-ichar->integer key) 1))) + (if (= idx -1) (set! idx 9)) + (and (>= idx 0) (< idx (length cur-trans)) + (begin + (im-commit lc (nth idx cur-trans)) + (coqide-context-clear lc) + #t))))) + + (else + (let* ((key-str (if (symbol? key) + (symbol->string key) + (charcode->string key))) + (cur-seq (rk-context-seq rkc)) + (res (rk-push-key! rkc key-str)) + (new-seq (rk-context-seq rkc)) + (new-trans (coqide-current-translation lc))) + (if (equal? new-seq (cons key-str cur-seq)) + (if (not (or (rk-partial? rkc) (> (length new-trans) 1))) + (begin (im-commit lc (car (rk-peek-terminal-match rkc))) + (coqide-context-clear lc))) + (begin (if (not (null? cur-seq)) (im-commit lc (car cur-trans))) + (if (null? new-seq) (im-commit-raw lc))))))))) + +(define (coqide-proc-off-state lc key key-state) + (if (coqide-on-key? key key-state) + (coqide-context-set-on! lc #t) + (im-commit-raw lc))) + +(define (coqide-key-press-handler lc key key-state) + (if (coqide-context-on lc) + (coqide-proc-on-state lc key key-state) + (coqide-proc-off-state lc key key-state)) + (coqide-update-preedit lc)) + +(define (coqide-key-release-handler lc key key-state) + (if (or (ichar-control? key) + (not (coqide-context-on lc))) + ;; don't discard key release event for apps + (im-commit-raw lc))) + +(define (coqide-reset-handler lc) + (coqide-context-clear lc)) + +(define (coqide-get-candidate-handler lc idx accel-enum-hint) + (let* ((candidates (coqide-current-translation lc)) + (candidate (nth idx candidates))) + (list candidate (digit->string (+ idx 1)) ""))) + +;; Emacs does nothing on focus-out +;; TODO: this should be configurable +(define (coqide-focus-out-handler lc) + #f) + +(define (coqide-place-handler lc) + (coqide-update-preedit lc)) + +(define (coqide-displace-handler lc) + (coqide-context-flush lc) + (coqide-update-preedit lc)) + +(register-im + 'coqide + "" + "UTF-8" + coqide-im-name-label + coqide-im-short-desc + #f + coqide-init-handler + coqide-release-handler + context-mode-handler + coqide-key-press-handler + coqide-key-release-handler + coqide-reset-handler + coqide-get-candidate-handler + #f + context-prop-activate-handler + #f + #f + coqide-focus-out-handler + coqide-place-handler + coqide-displace-handler +) + +;; Local Variables: +;; mode: scheme +;; coding: utf-8 +;; End: |