aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/tmm.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/tmm.el')
-rw-r--r--lisp/tmm.el109
1 files changed, 72 insertions, 37 deletions
diff --git a/lisp/tmm.el b/lisp/tmm.el
index 168dbdd14dc..aa47012c642 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -133,6 +133,11 @@ specify nil for this variable."
133 :type '(choice integer (const nil)) 133 :type '(choice integer (const nil))
134 :group 'tmm) 134 :group 'tmm)
135 135
136(defface tmm-inactive
137 '((t :inherit shadow))
138 "Face used for inactive menu items."
139 :group 'tmm)
140
136;;;###autoload 141;;;###autoload
137(defun tmm-prompt (menu &optional in-popup default-item) 142(defun tmm-prompt (menu &optional in-popup default-item)
138 "Text-mode emulation of calling the bindings in keymap. 143 "Text-mode emulation of calling the bindings in keymap.
@@ -193,7 +198,14 @@ Its value should be an event that has a binding in MENU."
193 (eq (car-safe (cdr (car tail))) 'menu-item))) 198 (eq (car-safe (cdr (car tail))) 'menu-item)))
194 (setq index-of-default (1+ index-of-default))) 199 (setq index-of-default (1+ index-of-default)))
195 (setq tail (cdr tail))))) 200 (setq tail (cdr tail)))))
196 (setq history (reverse (mapcar 'car tmm-km-list))) 201 (let ((prompt (concat "^." (regexp-quote tmm-mid-prompt))))
202 (setq history
203 (reverse (delq nil
204 (mapcar
205 (lambda (elt)
206 (if (string-match prompt (car elt))
207 (car elt)))
208 tmm-km-list)))))
197 (setq history-len (length history)) 209 (setq history-len (length history))
198 (setq history (append history history history history)) 210 (setq history (append history history history history))
199 (setq tmm-c-prompt (nth (- history-len 1 index-of-default) history)) 211 (setq tmm-c-prompt (nth (- history-len 1 index-of-default) history))
@@ -259,37 +271,43 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
259 271
260(defsubst tmm-add-one-shortcut (elt) 272(defsubst tmm-add-one-shortcut (elt)
261;; uses the free vars tmm-next-shortcut-digit and tmm-short-cuts 273;; uses the free vars tmm-next-shortcut-digit and tmm-short-cuts
262 (let* ((str (car elt)) 274 (cond
263 (paren (string-match "(" str)) 275 ((eq (cddr elt) 'ignore)
264 (pos 0) (word 0) char) 276 (cons (concat " " (make-string (length tmm-mid-prompt) ?\-)
265 (catch 'done ; ??? is this slow? 277 (car elt))
266 (while (and (or (not tmm-shortcut-words) ; no limit on words 278 (cdr elt)))
267 (< word tmm-shortcut-words)) ; try n words 279 (t
268 (setq pos (string-match "\\w+" str pos)) ; get next word 280 (let* ((str (car elt))
269 (not (and paren (> pos paren)))) ; don't go past "(binding.." 281 (paren (string-match "(" str))
270 (if (or (= pos 0) 282 (pos 0) (word 0) char)
271 (/= (aref str (1- pos)) ?.)) ; avoid file extensions 283 (catch 'done ; ??? is this slow?
272 (let ((shortcut-style 284 (while (and (or (not tmm-shortcut-words) ; no limit on words
273 (if (listp tmm-shortcut-style) ; convert to list 285 (< word tmm-shortcut-words)) ; try n words
274 tmm-shortcut-style 286 (setq pos (string-match "\\w+" str pos)) ; get next word
275 (list tmm-shortcut-style)))) 287 (not (and paren (> pos paren)))) ; don't go past "(binding.."
276 (while shortcut-style ; try upcase and downcase variants 288 (if (or (= pos 0)
277 (setq char (funcall (car shortcut-style) (aref str pos))) 289 (/= (aref str (1- pos)) ?.)) ; avoid file extensions
278 (if (not (memq char tmm-short-cuts)) (throw 'done char)) 290 (let ((shortcut-style
279 (setq shortcut-style (cdr shortcut-style))))) 291 (if (listp tmm-shortcut-style) ; convert to list
280 (setq word (1+ word)) 292 tmm-shortcut-style
281 (setq pos (match-end 0))) 293 (list tmm-shortcut-style))))
282 (while (<= tmm-next-shortcut-digit ?9) ; no letter shortcut, pick a digit 294 (while shortcut-style ; try upcase and downcase variants
283 (setq char tmm-next-shortcut-digit) 295 (setq char (funcall (car shortcut-style) (aref str pos)))
284 (setq tmm-next-shortcut-digit (1+ tmm-next-shortcut-digit)) 296 (if (not (memq char tmm-short-cuts)) (throw 'done char))
285 (if (not (memq char tmm-short-cuts)) (throw 'done char))) 297 (setq shortcut-style (cdr shortcut-style)))))
286 (setq char nil)) 298 (setq word (1+ word))
287 (if char (setq tmm-short-cuts (cons char tmm-short-cuts))) 299 (setq pos (match-end 0)))
288 (cons (concat (if char (concat (char-to-string char) tmm-mid-prompt) 300 (while (<= tmm-next-shortcut-digit ?9) ; no letter shortcut, pick a digit
289 ;; keep them lined up in columns 301 (setq char tmm-next-shortcut-digit)
290 (make-string (1+ (length tmm-mid-prompt)) ?\ )) 302 (setq tmm-next-shortcut-digit (1+ tmm-next-shortcut-digit))
291 str) 303 (if (not (memq char tmm-short-cuts)) (throw 'done char)))
292 (cdr elt)))) 304 (setq char nil))
305 (if char (setq tmm-short-cuts (cons char tmm-short-cuts)))
306 (cons (concat (if char (concat (char-to-string char) tmm-mid-prompt)
307 ;; keep them lined up in columns
308 (make-string (1+ (length tmm-mid-prompt)) ?\ ))
309 str)
310 (cdr elt))))))
293 311
294;; This returns the old map. 312;; This returns the old map.
295(defun tmm-define-keys (minibuffer) 313(defun tmm-define-keys (minibuffer)
@@ -319,9 +337,27 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
319 (goto-char 1) 337 (goto-char 1)
320 (delete-region 1 (search-forward "Possible completions are:\n"))) 338 (delete-region 1 (search-forward "Possible completions are:\n")))
321 339
340(defun tmm-remove-inactive-mouse-face ()
341 "Remove the mouse-face property from inactive menu items."
342 (let ((inhibit-read-only t)
343 (inactive-string
344 (concat " " (make-string (length tmm-mid-prompt) ?\-)))
345 next)
346 (save-excursion
347 (goto-char (point-min))
348 (while (not (eobp))
349 (setq next (next-single-char-property-change (point) 'mouse-face))
350 (when (looking-at inactive-string)
351 (remove-text-properties (point) next '(mouse-face))
352 (add-text-properties (point) next '(face tmm-inactive)))
353 (goto-char next)))
354 (set-buffer-modified-p nil)))
355
322(defun tmm-add-prompt () 356(defun tmm-add-prompt ()
323 (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt) 357 (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt)
324 (add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t) 358 (add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t)
359 (unless tmm-c-prompt
360 (error "No active menu entries"))
325 (let ((win (selected-window))) 361 (let ((win (selected-window)))
326 (setq tmm-old-mb-map (tmm-define-keys t)) 362 (setq tmm-old-mb-map (tmm-define-keys t))
327 ;; Get window and hide it for electric mode to get correct size 363 ;; Get window and hide it for electric mode to get correct size
@@ -334,8 +370,9 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
334 (with-output-to-temp-buffer "*Completions*" 370 (with-output-to-temp-buffer "*Completions*"
335 (display-completion-list completions)) 371 (display-completion-list completions))
336 (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt)) 372 (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt))
373 (set-buffer "*Completions*")
374 (tmm-remove-inactive-mouse-face)
337 (when tmm-completion-prompt 375 (when tmm-completion-prompt
338 (set-buffer "*Completions*")
339 (let ((buffer-read-only nil)) 376 (let ((buffer-read-only nil))
340 (goto-char (point-min)) 377 (goto-char (point-min))
341 (insert tmm-completion-prompt)))) 378 (insert tmm-completion-prompt))))
@@ -345,7 +382,6 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
345 (Electric-pop-up-window "*Completions*") 382 (Electric-pop-up-window "*Completions*")
346 (with-current-buffer "*Completions*" 383 (with-current-buffer "*Completions*"
347 (setq tmm-old-comp-map (tmm-define-keys nil)))) 384 (setq tmm-old-comp-map (tmm-define-keys nil))))
348
349 (insert tmm-c-prompt))) 385 (insert tmm-c-prompt)))
350 386
351(defun tmm-delete-map () 387(defun tmm-delete-map ()
@@ -438,7 +474,7 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
438 (setq km (and (eval visible) km))) 474 (setq km (and (eval visible) km)))
439 (setq enable (plist-get plist :enable)) 475 (setq enable (plist-get plist :enable))
440 (if enable 476 (if enable
441 (setq km (and (eval enable) km))) 477 (setq km (if (eval enable) km 'ignore)))
442 (and str 478 (and str
443 (consp (nth 3 elt)) 479 (consp (nth 3 elt))
444 (stringp (cdr (nth 3 elt))) ; keyseq cache 480 (stringp (cdr (nth 3 elt))) ; keyseq cache
@@ -467,8 +503,7 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
467 ;; Verify that the command is enabled; 503 ;; Verify that the command is enabled;
468 ;; if not, don't mention it. 504 ;; if not, don't mention it.
469 (when (and km (symbolp km) (get km 'menu-enable)) 505 (when (and km (symbolp km) (get km 'menu-enable))
470 (unless (eval (get km 'menu-enable)) 506 (setq km (if (eval (get km 'menu-enable)) km 'ignore)))
471 (setq km nil)))
472 (and km str 507 (and km str
473 (or (assoc str tmm-km-list) 508 (or (assoc str tmm-km-list)
474 (push (cons str (cons event km)) tmm-km-list)))))) 509 (push (cons str (cons event km)) tmm-km-list))))))