-shortcuts added to these cars. Adds the shortcuts to a free variable
-`tmm-short-cuts'."
- (mapcar (lambda (elt)
- (let ((str (car elt)) f b)
- (setq f (upcase (substring str 0 1)))
- ;; If does not work, try beginning of the other word
- (if (and (member f tmm-short-cuts)
- (string-match " \\([^ ]\\)" str))
- (setq f (upcase (substring
- str
- (setq b (match-beginning 1)) (1+ b)))))
- (if (member f tmm-short-cuts)
- elt
- (setq tmm-short-cuts (cons f tmm-short-cuts))
- (cons (concat f tmm-mid-prompt str) (cdr elt)))))
- (reverse list)))
+shortcuts added to these cars.
+Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
+ (let ((tmm-next-shortcut-digit ?0))
+ (mapcar 'tmm-add-one-shortcut (reverse list))))
+
+(defsubst tmm-add-one-shortcut (elt)
+;; uses the free vars tmm-next-shortcut-digit and tmm-short-cuts
+ (cond
+ ((eq (cddr elt) 'ignore)
+ (cons (concat " " (make-string (length tmm-mid-prompt) ?\-)
+ (car elt))
+ (cdr elt)))
+ (t
+ (let* ((str (car elt))
+ (paren (string-match "(" str))
+ (pos 0) (word 0) char)
+ (catch 'done ; ??? is this slow?
+ (while (and (or (not tmm-shortcut-words) ; no limit on words
+ (< word tmm-shortcut-words)) ; try n words
+ (setq pos (string-match "\\w+" str pos)) ; get next word
+ (not (and paren (> pos paren)))) ; don't go past "(binding.."
+ (if (or (= pos 0)
+ (/= (aref str (1- pos)) ?.)) ; avoid file extensions
+ (let ((shortcut-style
+ (if (listp tmm-shortcut-style) ; convert to list
+ tmm-shortcut-style
+ (list tmm-shortcut-style))))
+ (while shortcut-style ; try upcase and downcase variants
+ (setq char (funcall (car shortcut-style) (aref str pos)))
+ (if (not (memq char tmm-short-cuts)) (throw 'done char))
+ (setq shortcut-style (cdr shortcut-style)))))
+ (setq word (1+ word))
+ (setq pos (match-end 0)))
+ (while (<= tmm-next-shortcut-digit ?9) ; no letter shortcut, pick a digit
+ (setq char tmm-next-shortcut-digit)
+ (setq tmm-next-shortcut-digit (1+ tmm-next-shortcut-digit))
+ (if (not (memq char tmm-short-cuts)) (throw 'done char)))
+ (setq char nil))
+ (if char (setq tmm-short-cuts (cons char tmm-short-cuts)))
+ (cons (concat (if char (concat (char-to-string char) tmm-mid-prompt)
+ ;; keep them lined up in columns
+ (make-string (1+ (length tmm-mid-prompt)) ?\ ))
+ str)
+ (cdr elt))))))
+
+;; This returns the old map.
+(defun tmm-define-keys (minibuffer)
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map t)
+ (mapc
+ (lambda (c)
+ (if (listp tmm-shortcut-style)
+ (define-key map (char-to-string c) 'tmm-shortcut)
+ ;; only one kind of letters are shortcuts, so map both upcase and
+ ;; downcase input to the same
+ (define-key map (char-to-string (downcase c)) 'tmm-shortcut)
+ (define-key map (char-to-string (upcase c)) 'tmm-shortcut)))
+ tmm-short-cuts)
+ (if minibuffer
+ (progn
+ (define-key map [pageup] 'tmm-goto-completions)
+ (define-key map [prior] 'tmm-goto-completions)
+ (define-key map "\ev" 'tmm-goto-completions)
+ (define-key map "\C-n" 'next-history-element)
+ (define-key map "\C-p" 'previous-history-element)))
+ (prog1 (current-local-map)
+ (use-local-map (append map (current-local-map))))))
+
+(defun tmm-completion-delete-prompt ()
+ (set-buffer standard-output)
+ (goto-char 1)
+ (delete-region 1 (search-forward "Possible completions are:\n")))
+
+(defun tmm-remove-inactive-mouse-face ()
+ "Remove the mouse-face property from inactive menu items."
+ (let ((inhibit-read-only t)
+ (inactive-string
+ (concat " " (make-string (length tmm-mid-prompt) ?\-)))
+ next)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq next (next-single-char-property-change (point) 'mouse-face))
+ (when (looking-at inactive-string)
+ (remove-text-properties (point) next '(mouse-face))
+ (add-text-properties (point) next '(face tmm-inactive)))
+ (goto-char next)))
+ (set-buffer-modified-p nil)))