- (let ((next-shortcut-number 0))
- (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 we don't have an unique letter shortcut,
- ;; pick a digit as a shortcut instead.
- (if (member f tmm-short-cuts)
- (if (< next-shortcut-number 10)
- (setq f (format "%d" next-shortcut-number)
- next-shortcut-number (1+ next-shortcut-number))
- (setq f nil)))
- (if (null f)
- elt
- (setq tmm-short-cuts (cons f tmm-short-cuts))
- (cons (concat f tmm-mid-prompt str) (cdr elt)))))
- (reverse list))))
-
-(defun tmm-define-keys ()
- (mapcar (lambda (str)
- (define-key (current-local-map) str 'tmm-shortcut)
- (define-key (current-local-map) (downcase str) 'tmm-shortcut))
- tmm-short-cuts)
- (define-key (current-local-map) [pageup] 'tmm-goto-completions)
- (define-key (current-local-map) [prior] 'tmm-goto-completions)
- (define-key (current-local-map) "\ev" 'tmm-goto-completions)
- (define-key (current-local-map) "\C-n" 'next-history-element)
- (define-key (current-local-map) "\C-p" 'previous-history-element))
+ (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
+ (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")))