Changeset 12169


Ignore:
Timestamp:
Jun 1, 2009, 3:41:09 AM (10 years ago)
Author:
gz
Message:

Bug #182: if a character typed with option key down turns out to be a
standard Common Lisp character, assume the user is trying to type that
character. If it turns out to be a non-standard character, obey
*option-as-meta* as before.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/cocoa-editor.lisp

    r12168 r12169  
    926926  (let* ((view (hemlock-view self))
    927927         ;; quote-p means handle characters natively
    928          (quote-p (and view (hi::hemlock-view-quote-next-p view)))
    929          (has-marked-text (#/hasMarkedText self))
    930          (flags (#/modifierFlags event)))
     928         (quote-p (and view (hi::hemlock-view-quote-next-p view))))
    931929    #+debug (log-debug "~&quote-p ~s event ~s" quote-p event)
    932     (when (and has-marked-text quote-p (not (eq quote-p :native)))
    933       (setf (hi::hemlock-view-quote-next-p view) nil)
    934       (setq quote-p nil))
    935     (cond ((or (eq quote-p :native)
    936                (and (not *option-is-meta*)
    937                     (logtest #$NSAlternateKeyMask flags)))
    938            (call-next-method event))
    939           ;; If a standalone dead key (e.g., ^ on a French keyboard)
    940           ;; was pressed, pass it through to the Cocoa text input system.
    941           ((and (zerop (#/length (#/characters event)))
    942                 (not (logtest #$NSAlternateKeyMask flags)))
    943            (call-next-method event))
    944           ((or (null view)
    945                (#/hasMarkedText self)
    946                (and quote-p (zerop (#/length (#/characters event)))))
     930    (cond ((or (null view) (#/hasMarkedText self) (eq quote-p :native))
     931           (when (and quote-p (not (eq quote-p :native)))       ;; Huh?
     932             (setf (hi::hemlock-view-quote-next-p view) nil))
    947933           (call-next-method event))
    948934          ((not (eventqueue-abort-pending-p self))
     
    950936             (if hemlock-key
    951937               (hi::handle-hemlock-event view hemlock-key)
    952                (call-next-method event)))))))
     938               (call-next-method event)))))))
    953939
    954940(defmethod hi::handle-hemlock-event :around ((view hi:hemlock-view) event)
     
    963949  (let* ((modifiers (#/modifierFlags event)))
    964950    (unless (logtest #$NSCommandKeyMask modifiers)
    965       (let* ((chars (if quote-p
    966                       (#/characters event)
    967                       (#/charactersIgnoringModifiers event)))
    968              (n (if (%null-ptr-p chars)
    969                   0
    970                   (#/length chars)))
    971              (c (and (eql n 1)
    972                      (#/characterAtIndex: chars 0))))
    973         (when c
    974           (let* ((bits 0)
    975                  (useful-modifiers (logandc2 modifiers
    976                                              (logior
    977                                               ;#$NSShiftKeyMask
    978                                               #$NSAlphaShiftKeyMask))))
    979             (unless quote-p
    980               (dolist (map hi:*modifier-translations*)
    981                 (when (logtest useful-modifiers (car map))
    982                   (setq bits (logior bits
    983                                      (hi:key-event-modifier-mask (cdr map)))))))
    984             (let* ((char (code-char c)))
    985               (when (and char (standard-char-p char))
    986                 (setq bits (logandc2 bits +shift-event-mask+)))
    987               (when (logtest #$NSAlphaShiftKeyMask modifiers)
    988                 (setf c (char-code (char-upcase char)))))
    989             (hi:make-key-event c bits)))))))
     951      (let* ((native-chars (#/characters event))
     952             (native-len (if (%null-ptr-p native-chars)
     953                           0
     954                           (#/length native-chars)))
     955             (native-c (and (eql 1 native-len)
     956                            (#/characterAtIndex: native-chars 0)))
     957             (option-p (logtest #$NSAlternateKeyMask modifiers)))
     958        ;; If a standalone dead key (e.g. ^'` on a French keyboard,) was pressed,
     959        ;; reverse the meaning of quote-p, i.e. use the system meaning if NOT quoted.
     960        ;; (I have no idea what makes standalone dead keys somehow different from
     961        ;; non-standalone dead keys).
     962        (when (and (not option-p) (eql 0 native-len))
     963          (setq quote-p (not quote-p)))
     964        (let ((c (if (or quote-p
     965                         (and option-p
     966                              (or (not *option-is-meta*)
     967                                  (and native-c
     968                                       (ccl::valid-char-code-p native-c)
     969                                       (standard-char-p (code-char (the ccl::valid-char-code native-c)))))
     970                              (setq quote-p t)))
     971                   native-c
     972                   (let ((chars (#/charactersIgnoringModifiers event)))
     973                     (and (not (%null-ptr-p chars))
     974                          (eql 1 (#/length chars))
     975                          (#/characterAtIndex: chars 0))))))
     976          (when c
     977            (let ((bits 0)
     978                  (useful-modifiers (logandc2 modifiers
     979                                              (logior
     980                                               ;;#$NSShiftKeyMask
     981                                               #$NSAlphaShiftKeyMask))))
     982              (unless quote-p
     983                (dolist (map hi:*modifier-translations*)
     984                  (when (logtest useful-modifiers (car map))
     985                    (setq bits (logior bits
     986                                       (hi:key-event-modifier-mask (cdr map)))))))
     987              (let* ((char (code-char c)))
     988                (when (and char (standard-char-p char))
     989                  (setq bits (logandc2 bits +shift-event-mask+)))
     990                (when (logtest #$NSAlphaShiftKeyMask modifiers)
     991                  (setf c (char-code (char-upcase char)))))
     992              (hi:make-key-event c bits))))))))
    990993
    991994;; For now, this is only used to abort i-search.  All actual mouse handling is done
Note: See TracChangeset for help on using the changeset viewer.