Re: Making Emacs more newbie friendly

[floyd@barrow.com (Floyd L. Davidson)]

"Sean Richards" <somebody@nowhere.com> wrote:
>floyd@barrow.com (Floyd L. Davidson) writes:
>
>> I came up with a function to list only function key bindings.
>> All I need do is remember that a command exists, and that F2
>> will print a list of bindings to show how to access the command.
>
>Hi Floyd,
>
>Can you post the elisp that you use for this?

Sure... just be aware that I am no eLisp guru and that I use
XEmacs.  I'll post all the key bindings as I use it in XEmacs,
and the functions that I use in XEmacs (21.4.15).  That part I
know is operational.

I also have the same function for GNU's Emacs (21.3), but I have
not used it other than just having coded it up.  Hence it may
have quirks that shouldn't be there, or otherwise need honing.
(For example the XEmacs function has an ugly hack that does a
better job of sorting the results.  The Emacs version doesn't
have the ugly hack, just an ugly display...)

Probably this should be made into a package, but I have it all
defined in my ~/.xemacs/init.el file.

First there are a raft of key bindings that go with it.  The
idea is that F2 shows all fkey bindings, Sh-F2 shows all Sh-fkey
bindings, C-F2 shows all C-fkey bindings, and so on for every
available prefix keymap.

>From the init.el file (note that only the related key bindings are being
shown here, and in fact each keymap probably has other bindings too):

(defun  fld-describe-fkeys (&optional d1) ())

;;;
;;;  Global Function keymap
;;;
(define-key global-map  [f1]  'help-command)
(define-key global-map  [f2]  'fld-describe-fkeys)

;;;
;;;  Help keymap
;;;
(define-key help-map "0"  'fld-describe-all-fkeys)
(define-key help-map "1"  'fld-describe-fkeys)
(define-key help-map "2"  'fld-describe-sh-fkeys)
(define-key help-map "3"  'fld-describe-m-fkeys)
(define-key help-map "4"  'fld-describe-m-qstn-fkeys)
(define-key help-map "5"  'fld-describe-c-fkeys)
(define-key help-map "6"  'fld-describe-c-c-fkeys)
(define-key help-map "7"  'fld-describe-c-h-fkeys)
(define-key help-map [f2] 'fld-describe-c-h-fkeys)
(define-key help-map "8"  'fld-describe-c-x-fkeys)

;;;; The above allows this to be accessed not just with the F2
;;;; key, but also with F1, which of course prompts for further
;;;; input.  Any of the above will then run the specified
;;;; command.

;;;
;;;  ESC + Function keymap
;;;
(define-key esc-map  [f1]  'help-command)
(define-key esc-map  [f2]  'fld-describe-m-fkeys)

;;;
;;; Sh-Function keymap
;;;
(define-key global-map  [(shift f1)]  'help-command)
(define-key global-map  [(shift f2)]  'fld-describe-sh-fkeys)

;;;
;;; C-Function keymap
;;;
(define-key global-map  [(control f1)]  'help-command)
(define-key global-map  [(control f2)]  'fld-describe-c-fkeys)

;;;
;;; C-c Function keymap
;;;
(define-key Ctl-C-keymap  [f1]  'help-command)
(define-key Ctl-C-keymap  [f2]  'fld-describe-c-c-fkeys)

;;;
;;; C-x Function keymap
;;;
(define-key ctl-x-map  [f1]  'help-command)
(define-key ctl-x-map  [f2]  'fld-describe-c-x-fkeys)

;;;
;;; Define at least one fkey in each keymap, just to
;;; show up when fld-describe-all-fkeys is called.
;;;
(define-key Ctl-C-keymap [f1]    'keyboard-quit)
(define-key ctl-x-map    [f1]    'keyboard-quit)
(global-set-key [(shift f1)]     'keyboard-quit)
(global-set-key [(control f1)]   'keyboard-quit)

;;;  Individual functions to describe each function key set.
;;;  This is necessary in order that the key binding listed
;;;  for each f2 function key is meaningful.  If a lambda
;;;  function is used the binding shows up as "Anonymous
;;;  Compiled Function" in XEmacs and ?? in GNU Emacs.

(defun fld-describe-all-fkeys ()
"Describe All Function Key Bindings.  See fld-describe-fkeys."
(interactive)
(fld-describe-fkeys 0))

(defun fld-describe-sh-fkeys ()
"Describe Shift-Function Key Bindings.  See fld-describe-fkeys."
(interactive)
(fld-describe-fkeys 2))

(defun fld-describe-m-fkeys ()
"Describe Meta-Function Key Bindings.  See fld-describe-fkeys."
(interactive)
(fld-describe-fkeys 3))

(defun fld-describe-m-qstn-fkeys ()
"Describe Meta-? Function Key Bindings.  See fld-describe-fkeys."
(interactive)
(fld-describe-fkeys 4))

(defun fld-describe-c-fkeys ()
"Describe Cntl-Function Key Bindings.  See fld-describe-fkeys."
(interactive)
(fld-describe-fkeys 5))

(defun fld-describe-c-c-fkeys ()
"Describe C-c Function Key Bindings.  See fld-describe-fkeys."
(interactive)
(fld-describe-fkeys 6))

(defun fld-describe-c-h-fkeys ()
"Describe C-h Function Key Bindings.  See fld-describe-fkeys."
(interactive)
(fld-describe-fkeys 7))

(defun fld-describe-c-x-fkeys ()
"Describe C-x Function Key Bindings.  See fld-describe-fkeys."
(interactive)
(fld-describe-fkeys 8))

;;;
;;;  Show function key bindings
;;;
(defun fld-describe-fkeys (&optional flag)
"Describe function key bindings.  With optional flag, only a selected
set of function keys are described.  The following table indicates
which flag correspond to which sets of function keys:
     Flag    Key Sequence
      0            all
      1      f1     - f12
      2      Sh-f1  - Sh-f12
      3      M-f1   - M-f12
      4      M-? f1 - M-? f12
      5      C-f1   - C-f12
      6      C-c f1 - C-c f12
      7      C-h f1 - C-h f12
      8      C-x f1 - C-x f12"

  (interactive "p")

  (with-displaying-help-buffer (lambda ()
    (let ((buffer (current-buffer))
          (minor minor-mode-map-alist)
          (extent-maps (mapcar-extents
                        'extent-keymap
                        nil (current-buffer) (point) (point) nil 'keymap))
          (local (current-local-map))
          (pattern  "f[0-9][ \t0-2]")
          (shadow '()))

      (cond
       ((eq flag 1) (setq pattern "^f[0-9][ \t0-2]"      ))
       ((eq flag 2) (setq pattern "^Sh-f[0-9][ \t0-2]"   ))
       ((eq flag 3) (setq pattern "^M-f[0-9][ \t0-2]"    ))
       ((eq flag 4) (setq pattern "^M-\\? f[0-9][ \t0-2]"))
       ((eq flag 5) (setq pattern "^C-f[0-9][ \t0-2]"    ))
       ((eq flag 6) (setq pattern "^C-c f[0-9][ \t0-2]"  ))
       ((eq flag 7) (setq pattern "^C-h f[0-9][ \t0-2]"  ))
       ((eq flag 8) (setq pattern "^C-x f[0-9][ \t0-2]"  ))
       (t           (setq pattern "f[0-9][ \t0-2]"       )))

      (set-buffer standard-output)
      ;; find all key bindings
      (while extent-maps
        (describe-bindings-internal
         (car extent-maps) nil shadow nil nil)
        (setq shadow (cons (car extent-maps) shadow)
              extent-maps (cdr extent-maps)))
      (while minor
        (let ((sym (car (car minor)))
              (map (cdr (car minor))))
          (if (symbol-value-in-buffer sym buffer nil)
              (progn
                (describe-bindings-internal map nil shadow nil nil)
                (setq shadow (cons map shadow))))
          (setq minor (cdr minor))))
      (if local
          (progn
            (describe-bindings-internal local nil shadow nil nil)
            (setq shadow (cons local shadow))))
      (describe-bindings-internal (current-global-map) nil shadow nil nil)
      (when function-key-map
        (describe-bindings-internal function-key-map nil nil nil nil))
      ;; edit out all but what we want to see
      (save-excursion
        (let ((end 0))
          (untabify (point-min) (point-max))
          (goto-char (point-max))
          (while (not (eq (point) (point-min)))
            (progn
              (delete-blank-lines)  ; gets all but one
              (delete-blank-lines)  ; gets that one
              (beginning-of-line)

              ;; empty line (at eof)
              (when (eq (point) (point-at-eol)) (forward-line -1))

              ;; only search the first 10 characters
              (setq end (point-at-eol))
              (when (< (+ 10 (point)) (point-at-eol)) (setq end (+ 10 (point))))

              ;; look for function key designators
              (when (not (re-search-forward pattern end t))
                (progn  ; kill everything that isn't
                  (beginning-of-line)
                  (setq end (point-at-eol 1))
                  (delete-region (point) end)))
              (forward-line -1)
              (beginning-of-line))))
        (delete-region (point-min) (point-at-eol))
        ;; reconfigure our list so that it sorts the right way
        (goto-char (point-min))
        (while (re-search-forward "f1 [^ ]" nil t)
          (progn
            (goto-char (+ 2 (match-beginning 0)))
            (insert "z")))
        (goto-char (point-min))
        (replace-string "f1 " "f01 " nil)
        (goto-char (point-min))
        (replace-string "f2" "f02" nil)
        (goto-char (point-min))
        (replace-string "f3" "f03" nil)
        (goto-char (point-min))
        (replace-string "f4" "f04" nil)
        (goto-char (point-min))
        (replace-string "f5" "f05" nil)
        (goto-char (point-min))
        (replace-string "f6" "f06" nil)
        (goto-char (point-min))
        (replace-string "f7" "f07" nil)
        (goto-char (point-min))
        (replace-string "f8" "f08" nil)
        (goto-char (point-min))
        (replace-string "f9" "f09" nil)
        (sort-lines nil (point-min) (point-max)))

      ;; now put back the right names
      (goto-char (point-min))
      (replace-string "f0" "f" nil)
      (goto-char (point-min))
      (replace-string "f1z" "f1")

      ;; give the buffer an appropriate title
      (let ((title "Function Key Bindings"))
        (cond
         ((eq flag 1) (setq title ""        ))
         ((eq flag 2) (setq title "Shift-"  ))
         ((eq flag 3) (setq title "Meta-"   ))
         ((eq flag 4) (setq title "Meta-? " ))
         ((eq flag 5) (setq title "Cntl-"   ))
         ((eq flag 6) (setq title "Cntl-c " ))
         ((eq flag 7) (setq title "Cntl-h " ))
         ((eq flag 8) (setq title "Cntl-x " ))
         (t           (setq title "All "    )))

        (goto-char (point-min))
        (insert (concat "  " title "Function Key Bindings\n")))
        (set-buffer buffer)
        standard-output))
    "Function Key Bindings"))

The Emacs function:

;;;
;;;  Show function key bindings
;;;
(defun fld-describe-fkeys (&optional flag)
"Describe function key bindings.  With optional flag, only a selected
set of function keys are described.  The following table indicates
which flag correspond to which sets of function keys:
     Flag    Key Sequence
      0            all
      1      <f1>       - <f12>
      2      <S-f1>     - <S-f12>
      3      ESC <f1>   - ESC <f12
      4      ESC ? <f1> - ESC ? <f12>
      5      <C-f1>     - <C-f12>
      6      C-c <f1>   - C-c <f12>
      7      C-h <f1>   - C-h <f12>
      8      C-x <f1>   - C-x <f12>"

  (interactive "p")
  (let ((buffer (current-buffer))
       (prefix nil)
       (pattern  ""))

    (cond
     ((eq flag 1) (setq pattern "^<f[0-9][>1-2][> \t]"         ))
     ((eq flag 2) (setq pattern "^<S-f[0-9][>1-2][> \t]"       ))
     ((eq flag 3) (setq pattern "^ESC <f[0-9][>1-2][> \t]"     ))
     ((eq flag 4) (setq pattern "^ESC \\? <f[0-9][>1-2][> \t]" ))
     ((eq flag 5) (setq pattern "^<C-f[0-9][>1-2][> \t]"       ))
     ((eq flag 6) (setq pattern "^C-c <f[0-9][>1-2][> \t]"     ))
     ((eq flag 7) (setq pattern "^C-h <f[0-9][>1-2][> \t]"     ))
     ((eq flag 8) (setq pattern "^C-x <f[0-9][>1-2][> \t]"     ))
     (t           (setq pattern "[<-]f[0-9][>1-2][> \t]"       )))

    (setq buffer (current-buffer))
    (with-current-buffer buffer
      (describe-bindings-internal  nil prefix))
    (with-current-buffer "*Help*"
      (help-setup-xref
       (list #'describe-bindings prefix buffer)
       (interactive-p)))
    (with-current-buffer "*Help*"
      (progn
        (view-mode -1)
        (let ((end 0))
          (goto-char (point-max))
          (while (not (eq (point) (point-min)))
            (progn
              (delete-blank-lines)  ; gets all but one
              (delete-blank-lines)  ; gets that one
              (beginning-of-line)

              ;; empty lines (at eof)
              (while (eq (point) (point-at-eol)) (forward-line -1))

              ;; only search the first 10 characters
              (setq end (point-at-eol))
              (when (< (+ 10 (point)) (point-at-eol)) (setq end (+ 10 (point))))

              ;; look for function key designators
              (when (not (re-search-forward pattern end t))
                  (progn  ; kill everything that isn't
                    (setq end (point-at-eol nil))
                    (delete-region (point) end))))
            (beginning-of-line)
            (forward-line -1))
          (delete-region (point-min) (point-at-eol))
          (replace-string "f1>" "f01>" nil (point-min)(point-max))
          (replace-string "f2>" "f02>" nil (point-min)(point-max))
          (replace-string "f3>" "f03>" nil (point-min)(point-max))
          (replace-string "f4>" "f04>" nil (point-min)(point-max))
          (replace-string "f5>" "f05>" nil (point-min)(point-max))
          (replace-string "f6>" "f06>" nil (point-min)(point-max))
          (replace-string "f7>" "f07>" nil (point-min)(point-max))
          (replace-string "f8>" "f08>" nil (point-min)(point-max))
          (replace-string "f9>" "f09>" nil (point-min)(point-max))
          (sort-lines nil (point-min) (point-max))

          ;; give the buffer an appropriate title
          (let ((title "Function Key Bindings"))
            (cond
             ((eq flag 1) (setq title ""        ))
             ((eq flag 2) (setq title "Shift-"  ))
             ((eq flag 3) (setq title "Meta-"   ))
             ((eq flag 4) (setq title "Meta-? " ))
             ((eq flag 5) (setq title "Cntl-"   ))
             ((eq flag 6) (setq title "Cntl-c " ))
             ((eq flag 7) (setq title "Cntl-h " ))
             ((eq flag 8) (setq title "Cntl-x " ))
             (t           (setq title "All "    )))

            (goto-char (point-min))
            (insert (concat "  " title "Function Key Bindings\n"))))))))

-- 
Floyd L. Davidson           <http://web.newsguy.com/floyd_davidson>
Ukpeagvik (Barrow, Alaska)                         floyd@barrow.com