From 0d342f0aee3f2f800e486c0051dabe718a7b2841 Mon Sep 17 00:00:00 2001 From: Tom Willemsen Date: Wed, 23 Mar 2011 11:14:27 +0100 Subject: I don't like nxhtml --- emacs.d/nxhtml/util/new-key-seq-widget.el | 312 ------------------------------ 1 file changed, 312 deletions(-) delete mode 100644 emacs.d/nxhtml/util/new-key-seq-widget.el (limited to 'emacs.d/nxhtml/util/new-key-seq-widget.el') diff --git a/emacs.d/nxhtml/util/new-key-seq-widget.el b/emacs.d/nxhtml/util/new-key-seq-widget.el deleted file mode 100644 index 7ace679..0000000 --- a/emacs.d/nxhtml/util/new-key-seq-widget.el +++ /dev/null @@ -1,312 +0,0 @@ -;;; new-key-seq-widget.el --- New key-sequence widget for Emacs -;; -;; Author: Lennart Borgman (lennart O borgman A gmail O com) -;; Created: Tue Dec 25 23:00:43 2007 -;; Version: -;; Last-Updated: -;; URL: -;; Keywords: -;; Compatibility: -;; -;; Features that might be required by this library: -;; -;; None -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; New version of Kim's Emacs key-sequence widget. For inclusion in -;; Emacs I hope. -;; -;; Fix-me: check what was included. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Change log: -;; -;; I do not know how much I have changed, but I keep it together here -;; for simplicity. -;; -;; Note: I have named made `widget-key-sequence-map' a constant for -;; the moment. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth -;; Floor, Boston, MA 02110-1301, USA. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Code: - -(require 'wid-edit) -(require 'edmacro) - -;;; I'm not sure about what this is good for? KFS. -;; -;;; This should probably be for customize-set-value etc, but it is not -;;; used. Or for the widget editing, but it is not used there -;;; either. /Lennart -(defvar widget-key-sequence-prompt-value-history nil - "History of input to `widget-key-sequence-prompt-value'.") - -(defvar widget-key-sequence-default-value [ignore] - "Default value for an empty key sequence.") - -(defconst widget-key-sequence-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map widget-field-keymap) - (define-key map [(control ?q)] 'widget-key-sequence-read-event) - (define-key map [(control ?t)] 'widget-key-sequence-toggle-input-format) - map)) - -(defvar widget-key-sequence-input-formats '(key-description vector)) - -(defcustom widget-key-sequence-default-input-format 'key-description - "Format used to edit key sequences. -This is the format shown and edited in a key-sequence widget." - :type '(choice (const :tag "Key description" 'key-description) - (const :tag "Vector" 'vector)) - :group 'widgets) - -(define-widget 'key-sequence 'restricted-sexp - "A key sequence." - :prompt-value 'widget-field-prompt-value - :prompt-internal 'widget-symbol-prompt-internal -; :prompt-match 'fboundp ;; What was this good for? KFS - :prompt-history 'widget-key-sequence-prompt-value-history - :action 'widget-field-action - :match-alternatives '(stringp vectorp) - :format "%{%t%}: %v" - :validate 'widget-key-sequence-validate - :value-to-internal 'widget-key-sequence-value-to-internal - :value-to-external 'widget-key-sequence-value-to-external - :value widget-key-sequence-default-value - :keymap widget-key-sequence-map - :help-echo "C-q: insert KEY, EVENT, or CODE; C-t: toggle format" - :tag "Key sequence") - - -;;; Leave these here for testing: -;; (edmacro-parse-keys "C-x h" t) => [24 104] -;; (key-description-to-vector "C-x h" ) => [(control 120) 104] -;; (key-description (key-description-to-vector "C-x h")) => "C-x h" -;; (key-description (edmacro-parse-keys "C-x h")) => "C-x h" -;; (key-description [M-mouse-1]) => -;; (edmacro-parse-keys "") => [M-mouse-1] - -;; (event-modifiers 'mouse-1) => (click mouse-1 mouse-1 mouse-1 mouse-1 mouse-1) -;; (event-modifiers 'M-mouse-1) => -;; (event-modifiers '(mouse-1)) => (click mouse-1 mouse-1 mouse-1 mouse-1 mouse-1) -;; (event-modifiers '(down-mouse-1)) => (click mouse-1 mouse-1 mouse-1 mouse-1 mouse-1) -;; (event-modifiers '(S-down-mouse-1)) => (shift down) -;; (event-modifiers 'S-down-mouse-1) => (shift down) -;; (event-modifiers 'down-mouse-1) => (click mouse-1 mouse-1 mouse-1 mouse-1 mouse-1) -;; (event-modifiers '(down-mouse-1)) => (click mouse-1 mouse-1 mouse-1 mouse-1 mouse-1) -;; (let ((m (make-sparse-keymap))) (define-key m [(down mouse-1)] 'hej)) -(defun key-description-to-vector (kd) - "Convert human readable key description KD to vector format. -KD should be in the format returned by `key-description'." - (let ((v - (vconcat - (mapcar (lambda (k) - ;; Fix-me: temporarily clean the event here: - (when (symbolp k) - (let ((esem (get k 'event-symbol-element-mask))) (when esem (lwarn t :warning "kd=%s, k=%s, esem=%s" kd k esem))) - (put k 'event-symbol-element-mask nil)) - (let ((m (event-modifiers k)) - (b (event-basic-type k))) - (setq m (delq 'click m)) - (if m - (nconc m (list b)) - b))) - ;; fix-me: does not always work for menu and tool - ;; bar event because they may contains spaces. - (edmacro-parse-keys kd t)))) - (m (make-sparse-keymap)) - ) - ;; Test before returning it: - (define-key m v 'test) - v)) - -(defun widget-key-sequence-current-input-format () - (let ((fmt (or (widget-get (widget-at (point)) :key-sequence-format) - widget-key-sequence-default-input-format))) - fmt)) - -(defun widget-key-sequence-toggle-input-format () - "Toggle key sequence input format." - (interactive) - (let* ((widget (widget-at (point))) - (value (widget-apply widget :value-get)) - (first (string-to-char value)) - (old-fmt - (let ((fmt (or (widget-get widget :key-sequence-format) - widget-key-sequence-default-input-format))) - fmt)) - (new-fmt - (let ((m (cdr (memq old-fmt widget-key-sequence-input-formats)))) - (if m (car m) (car widget-key-sequence-input-formats)))) - (new-value - (cond - ((eq new-fmt 'key-description) - (setq value (replace-regexp-in-string "\\` *\\(.*?\\) *\\'" "\\1" value)) - (if (string= value "") - "" - (key-description (read value)))) - ((eq new-fmt 'vector) - (format "%S" (key-description-to-vector value))) - (t - (error "Bad key seq format spec: %s" new-fmt)))) - (state (widget-get (widget-get widget :parent) :custom-state)) - ) - (widget-put widget :key-sequence-format new-fmt) - (setq new-value (propertize new-value 'face 'highlight)) - (widget-apply widget :value-set new-value) - (widget-setup) - (widget-put (widget-get widget :parent) :custom-state state) - (cond - ((eq new-fmt 'key-description) - (message "Switched to human readable format")) - ((eq new-fmt 'vector) - (message "Switched to vector format")) - (t - (error "Uh? format=%s" new-fmt))))) - - -(defun widget-key-sequence-read-event (ev) - "Read event or char code and put description in widget. -The events may come from keyboard, mouse, menu or tool bar. - -If the event is a mouse event then multiple entries will be -entered. It is not possible to know which one is wanted. Please -remove those not wanted! - -If 0-7 is pressed then code for an event is prompted for." - (interactive (list - (let ((inhibit-quit t) quit-flag) - (unless (eq 'key-description - (widget-key-sequence-current-input-format)) - (error "Wrong input format, please do C-t first")) - (read-event "Insert KEY, EVENT, or CODE: ")))) - (lwarn t :warning "=====> ev=%s" ev) - (let ((tr (and (keymapp function-key-map) - (lookup-key function-key-map (vector ev))))) - (insert (if (= (char-before) ?\s) "" " ")) - ;; Fix-me: change to check for ? instead of 0-7 to allow char - ;; literal input format - (when (and (integerp ev) - (or (and (<= ?0 ev) (< ev (+ ?0 (min 10 read-quoted-char-radix)))) - (and (<= ?a (downcase ev)) - (< (downcase ev) (+ ?a -10 (min 36 read-quoted-char-radix)))))) - (setq unread-command-events (cons ev unread-command-events) - ev (read-quoted-char (format "Enter code (radix %d)" read-quoted-char-radix)) - tr nil) - (if (and (integerp ev) (not (characterp ev))) - (insert (char-to-string ev)))) ;; throw invalid char error - (setq ev (key-description (list ev))) - (when (arrayp tr) - (setq tr (key-description (list (aref tr 0)))) - (when (y-or-n-p (format "Key %s is translated to %s -- use %s? " ev tr tr)) - (setq ev tr) - ;;(setq ev2 nil) - )) - (insert ev " ") - (when (or (string-match "mouse-" ev) - (string-match "menu-bar" ev) - (string-match "tool-bar" ev)) - (let ((ev2 (read-event nil nil (* 0.001 double-click-time)))) - (while ev2 - (lwarn t :warning "(stringp ev2)=%s, (sequencp ev2)=%s, (symbolp ev2)=%s, ev2=%S" (stringp ev2) (sequencep ev2) (symbolp ev2) ev2) - (if nil ;(memq 32 (append (symbol-name ev2) nil)) ;; Fix-me: contains space - (insert ?\" (symbol-name ev2) ?\") - (insert (key-description (list ev2)))) - (insert " ") - (setq ev2 (read-event nil nil (* 0.001 double-click-time)))))))) - -(defun widget-key-sequence-validate (widget) - "Validate the internal value of the widget. -Actually there is nothing to validate here. The internal value -is always valid, but it is however maybe not what the user -expects. Because of this the internal format is rewritten when -the user gives the value in a way that is not the normal -representation of it. A warning is also shown then." - (condition-case err - (let* ((int-val (widget-apply widget :value-get)) - (def-desc (key-description (edmacro-parse-keys int-val))) - (fmt (or (widget-get widget :key-sequence-format) - widget-key-sequence-default-input-format))) - ;; Normalize and compare with default description - (setq int-val - (replace-regexp-in-string " *" " " int-val t)) - (setq int-val - (replace-regexp-in-string "\\` *\\(.*?\\) *\\'" "\\1" int-val t)) - (unless (or - (eq fmt 'vector) - (string= int-val def-desc)) - ;; Replace with the default description if it is different - ;; so the user sees what the value actually means: - (widget-apply widget :value-set def-desc) - (lwarn t :warning - (concat "Key description %s means the same as %s\n" - "\tTip: You can type C-q to insert a key or event") - int-val def-desc) - ) - ;; Return nil if there a no problem validating - nil) - (error (widget-put widget :error (error-message-string err)) - (lwarn t :warning "invalid %S: %s" widget (error-message-string err)) - ;; Return widget if there was an error - widget))) - -(defun widget-key-sequence-value-to-internal (widget value) - (if (widget-apply widget :match value) - (if (equal value widget-key-sequence-default-value) - "" - (let ((fmt (or (widget-get widget :key-sequence-format) - widget-key-sequence-default-input-format))) - (if (eq fmt 'vector) - (format "%S" value) - (key-description value)))) - value)) - -(defun widget-key-sequence-value-to-external (widget value) - (if (stringp value) - (if (string-match "\\`[[:space:]]*\\'" value) - widget-key-sequence-default-value - ;; Give a better error message and a trace back on debug: - (condition-case err - (let* ((fmt (or (widget-get widget :key-sequence-format) - widget-key-sequence-default-input-format)) - (first (string-to-char value))) - (cond - ((eq fmt 'vector) - (read value) - ) - (t - (key-description-to-vector value)))) - (error (error "Bad value: %s" (error-message-string err))))) - value)) - -;; (customize-option 'new-key-seq-widget-test) -(defcustom new-key-seq-widget-test [] - "Testing only!" - :type 'key-sequence - :group 'widgets) - - (provide 'new-key-seq-widget) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; new-key-seq-widget.el ends here -- cgit v1.2.3-54-g00ecf