From a6e13143590bfb7ce9e62edc0b2ea79e2f2c3f88 Mon Sep 17 00:00:00 2001 From: Krzysztof Drewniak Date: Sun, 13 Nov 2011 17:04:09 -0600 Subject: [PATCH 3/3] The backspace key now functions correctly. A new function `menu-backspace' has been defined which removes a single character from the menu search string. The function `menu-backspace' is bound to DEL by default in *menu-map* . --- menu.lisp | 50 ++++++++++++++++++++++++++++++-------------------- 1 files changed, 30 insertions(+), 20 deletions(-) diff --git a/menu.lisp b/menu.lisp index 5eddd92..8169deb 100644 --- a/menu.lisp +++ b/menu.lisp @@ -48,6 +48,8 @@ (define-key m (kbd "SunPageDown") 'menu-page-down) (define-key m (kbd "J") 'menu-page-down) + (define-key m (kbd "DEL") 'menu-backspace) + (define-key m (kbd "C-g") 'menu-abort) (define-key m (kbd "ESC") 'menu-abort) (define-key m (kbd "RET") 'menu-finish) @@ -131,8 +133,8 @@ on current view and new selection." (throw :menu-quit nil)) (defun get-input-char (key) - "If @var{key} is a character suitable for menu completion (e.g. not -backspace or F9), return it otherwise return nil" + "If @var{key} is a character suitable for menu completion (e.g. +not backspace or F9), return it otherwise return nil" (let ((char (xlib:keysym->character *display* (key-keysym key)))) (if (or (key-mods-p key) (null char) (not (characterp char))) @@ -144,29 +146,37 @@ backspace or F9), return it otherwise return nil" (first element) element)) +(defun menu-backspace (menu) + (when (> (fill-pointer (menu-state-current-input menu)) 0) + (vector-pop (menu-state-current-input menu)) + (check-menu-complete menu nil))) + (defun check-menu-complete (menu key-seq) "If the use entered a key not mapped in @var{*menu-map}, check if - he's trying to type an entry's name. Match is case insensitive as - long as the user types lower-case characters." - (let ((input-char (get-input-char key-seq))) +he's trying to type an entry's name. Match is case insensitive as +long as the user types lower-case characters. If @var{key-seq} is +nil, some other function has manipulated the current-input and is +requesting a re-computation of the match." + (let ((input-char (and key-seq (get-input-char key-seq)))) (when input-char - (vector-push-extend input-char (menu-state-current-input menu)) + (vector-push-extend input-char (menu-state-current-input menu))) + (when (or input-char (not key-seq)) (do* ((cur-pos 0 (1+ cur-pos)) - (rest-elem (menu-state-table menu) - (cdr rest-elem)) - (cur-elem (car rest-elem) (car rest-elem)) - (cur-elem-name (menu-element-name cur-elem) (menu-element-name cur-elem)) - (current-input-length (length (menu-state-current-input menu))) - (match-regex (ppcre:create-scanner (menu-state-current-input menu) - :case-insensitive-mode - (string= (string-downcase (menu-state-current-input menu)) - (menu-state-current-input menu))))) - ((not cur-elem)) - (when (and (>= (length cur-elem-name) current-input-length) - (ppcre:scan match-regex cur-elem-name)) - (setf (menu-state-selected menu) cur-pos) + (rest-elem (menu-state-table menu) + (cdr rest-elem)) + (cur-elem (car rest-elem) (car rest-elem)) + (cur-elem-name (menu-element-name cur-elem) (menu-element-name cur-elem)) + (current-input-length (length (menu-state-current-input menu))) + (match-regex (ppcre:create-scanner (menu-state-current-input menu) + :case-insensitive-mode + (string= (string-downcase (menu-state-current-input menu)) + (menu-state-current-input menu))))) + ((not cur-elem)) + (when (and (>= (length cur-elem-name) current-input-length) + (ppcre:scan match-regex cur-elem-name)) + (setf (menu-state-selected menu) cur-pos) (bound-check-menu menu) - (return)))))) + (return)))))) (defun select-from-menu (screen table &optional prompt (initial-selection 0)) -- 1.7.4.1