Function: which-key--process-page

which-key--process-page is a byte-compiled function defined in which-key.el.gz.

Signature

(which-key--process-page PAGES-OBJ)

Documentation

Add information to the basic list of key bindings.

Include, if applicable, the current prefix, the name of the current prefix, and a page count.

Source Code

;; Defined in /usr/src/emacs/lisp/which-key.el.gz
(defun which-key--process-page (pages-obj)
  "Add information to the basic list of key bindings.
Include, if applicable, the current prefix, the name of the current
prefix, and a page count."
  (let* ((page (car (which-key--pages-pages pages-obj)))
         (height (which-key--pages-height pages-obj))
         (n-pages (which-key--pages-num-pages pages-obj))
         (page-n (car (which-key--pages-page-nums pages-obj)))
         (prefix-desc (key-description (which-key--pages-prefix pages-obj)))
         (prefix-title (which-key--pages-prefix-title pages-obj))
         (full-prefix (which-key--full-prefix prefix-desc))
         (nxt-pg-hint (which-key--next-page-hint prefix-desc))
         ;; not used in left case
         (status-line
          (concat (which-key--propertize prefix-title 'face 'which-key-note-face)
                  (when (< 1 n-pages)
                    (which-key--propertize (format " (%s of %s)" page-n n-pages)
                                           'face 'which-key-note-face)))))
    (pcase which-key-show-prefix
      (`left
       (let* ((page-cnt (which-key--propertize (format "%s/%s" page-n n-pages)
                                               'face 'which-key-separator-face))
              (first-col-width (+ 2 (max (which-key--string-width full-prefix)
                                         (which-key--string-width page-cnt))))
              (prefix (format (concat "%-" (int-to-string first-col-width) "s")
                              full-prefix))
              (page-cnt (if (> n-pages 1)
                            (format
                             (concat "%-" (int-to-string first-col-width) "s")
                             page-cnt)
                          (make-string first-col-width ?\s)))
              lines first-line new-end)
         (if (= 1 height)
             (cons (concat prefix page) nil)
           (setq lines (split-string page "\n")
                 first-line (concat prefix (car lines) "\n" page-cnt)
                 new-end (concat "\n" (make-string first-col-width ?\s)))
           (cons
            (concat first-line (mapconcat #'identity (cdr lines) new-end))
            nil))))
      (`top
       (cons
        (concat (when (or (= 0 echo-keystrokes)
                          (not (eq which-key-side-window-location 'bottom)))
                  (concat full-prefix " "))
                status-line " " nxt-pg-hint "\n" page)
        nil))
      (`bottom
       (cons
        (concat page "\n"
                (when (or (= 0 echo-keystrokes)
                          (not (eq which-key-side-window-location 'bottom)))
                  (concat full-prefix " "))
                status-line " " nxt-pg-hint)
        nil))
      (`echo
       (cons page
             (lambda ()
               (which-key--echo
                (concat full-prefix (when prefix-desc " ")
                        status-line (when status-line " ")
                        nxt-pg-hint)))))
      (`mode-line
       (cons page
             (lambda ()
               (with-current-buffer which-key--buffer
                 (setq-local mode-line-format
                             (concat " " full-prefix
                                     " " status-line
                                     " " nxt-pg-hint))))))
      (_ (cons page nil)))))