Function: tmm-add-one-shortcut
tmm-add-one-shortcut is a byte-compiled function defined in tmm.el.gz.
Signature
(tmm-add-one-shortcut ELT)
Source Code
;; Defined in /usr/src/emacs/lisp/tmm.el.gz
(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-search "(" str))
(word 0) pos 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
(dolist (shortcut-style ; try upcase and downcase variants
(if (listp tmm-shortcut-style) ; convert to list
tmm-shortcut-style
(list tmm-shortcut-style)))
(setq char (funcall shortcut-style (aref str pos)))
(if (not (memq char tmm-short-cuts)) (throw 'done char))))
(setq word (1+ word))
(setq pos (match-end 0)))
;; A nil value for pos means that the shortcut is not inside the
;; string of the menu entry.
(setq pos nil)
(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
(if tmm-shortcut-inside-entry
(if char
(if pos
;; A character inside the menu entry.
(let ((res (copy-sequence str)))
(aset res pos char)
(add-text-properties pos (1+ pos) '(face highlight) res)
res)
;; A fallback digit character: place it in front of the
;; menu entry. We need to shorten the spaces between
;; the menu entry and the keybinding by two spaces
;; because we added two characters at the front (one
;; digit and one space) and this would cause a
;; misalignment otherwise.
(tmm--shorten-space-width
(concat (propertize (char-to-string char) 'face 'highlight)
" " str)))
(make-string 2 ?\s))
(concat (if char (concat (char-to-string char) tmm-mid-prompt)
;; Keep them lined up in columns.
(make-string (1+ (length tmm-mid-prompt)) ?\s))
str))
(cdr elt))))))