;;; custom-keymap.el --- Configure user key sequence bindings from a custom variable -*- lexical-binding:t -*-
;; Author: Viandant <viandant@langenst.de>
;; Package-Version: 20250906.1450
;; Package-Revision: d8db247fd8ce
;; Package-Requires: ((emacs "29.3"))
;; Keywords: internal keymap keyboard customization
;; URL: https://github.com/viandant/custom-keymap

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.

;;; Commentary:

;; This package allows users to maintain keybindings
;; in the customisation variable CUSTOM-KEYMAP-LIST.
;; The keybindings are activated in the globalised minor
;; mode CUSTOM-KEYMAP-MODE.
;;
;; Some auxiliary commands are provided:
;; CUSTOM-KEYMAP-SORT-ON-COMMANDS: sort CUSTOM-KEYMAP-LIST on commands
;; CUSTOM-KEYMAP-SORT-ON-KEY-SEQUENCES: sort CUSTOM-KEYMAP-LIST on key sequences
;; CUSTOM-KEYMAP-ADD: Interactively add an entry to CUSTOM-KEYMAP-LIST
;; CUSTOM-KEYMAP-DELETE: Interactively add an entry to CUSTOM-KEYMAP-LIST

;;; Code:

(defvar custom-keymap
  (let ((map (make-sparse-keymap)))
    map)
  "Keymap for `custom-keymap-mode'.")

(defun custom-keymap-fset-dummy (funsym)
  "Set the function of FUNSYM to a dummy function if not already bound."
  (if (not (fboundp funsym))
      (let ((error-message (format "The function %s has not yet been loaded" funsym)))
	(fset funsym
	      (eval `(lambda () (interactive) (error ,error-message)))))))

(defun custom-keymap-set-list (sym val)
  "Function called each time the CUSTOM-KEYMAP-LIST is customised.
Update the keybindings in CUSTOM-KEYMAP according to VAL.
Then set the toplevel value of SYM to VAL."
  (unless (boundp 'custom-keymap-list) (defvar custom-keymap-list nil))
  ;;Remove all keys that are no longer set in the custom variable.
  (mapc
   (lambda (pair)
     (if (assoc (car pair) val)
	 nil
       (define-key custom-keymap (car pair) nil t)))
   (eval sym))
  (mapc (lambda (pair)
	  (let
	      ((keyseq (car pair))
	       (funsym (cdr pair)))
	    (custom-keymap-fset-dummy funsym)
	    (define-key custom-keymap keyseq funsym)))
	val)
  (set-default-toplevel-value sym val))

;;;###autoload
(defcustom custom-keymap-list nil
  "Pairs of key sequences and functions to be bound to the keys."
  :type '(alist :key-type key-sequence :value-type function)
  :group 'custom-keymap-mode
  :set 'custom-keymap-set-list)


(defun custom-keymap-bind-dummy-function ()
  "Bind a dummy function to all unbound symbols in CUSTOM-KEYMAP-LIST.
If key sequences are bound to functions that are only loaded on demand,
CUSTOM-KEYMAP-LIST will not conform to its reqired type.  The customisaiton
dialoge will then refuse to format the current value nicely.
After running this function all symbols will have function definitions
and the customisation dialogue will look nice again."
  (interactive)
  (mapc
   (lambda (keyseq-funsym) (custom-keymap-fset-dummy (cdr keyseq-funsym)))
   custom-keymap-list))

;;;###autoload
(define-minor-mode custom-keymap-mode
    "Minor mode with the only purpose to activate the `custom-keymap'.

`custom-keymap' is a keymap that is modified by customising
`custom-keymap-list'.  So you can use `customize-variable' with
`custom-keymap-list' to edit your key bindings.  Thus they will be
presented in a conveniently readable and editable way.
`custom-keymap-list' is an assoc list of key sequences and commands
\(represented as there symbols).  Customisations of this list will
immediately become active if `global-custom-keymap-mode' is enabled.

So you can add this line to your `.emacs' initialisation file to
automatically activate your bindings every time you start emacs:

`(global-custom-keymap-mode 1)'

After some time `custom-keymap-list' might grow and become unorganised.
Therefore, two auxiliary commands are provided to sort the list on
commands resp. key sequences:

- `custom-keymap-sort-on-commands'
- `custom-keymap-sort-on-key-sequences'

You may find it more convenient to add and delete entries using these
commands:

- `custom-keymap-add'

   prompts for a key sequence and warns you in case the key sequence
   is  already bound to a function.  You can then decide to select another
   key sequence.  Next the command prompts for a command, the default
   being the symbol at point.  If not aborted during the prompts a
   pair is built from user input and added to `custom-keymap-list'.  The
   new setting is activated and saved to the initialisation file.

- `custom-keymap-delete'

   prompts for a command with the default set to the symbol at point.
   All entries for this command are deleted from `custom-keymap-list'.
   The new setting is activated and saved to the initialisation file."
  :global t
  :keymap custom-keymap
  :group 'custom-keymap-mode)

(defun custom-keymap-mode-turn-on ()
  "Turn on `custom-keymap-mode'."
  (custom-keymap-mode 1)
  nil)

;;;###autoload
(define-globalized-minor-mode global-custom-keymap-mode custom-keymap-mode  custom-keymap-mode-turn-on
    :group 'custom-keymap-mode
    (message "global-custom-keymap-mode switched."))

;;;###autoload
(defun custom-keymap-sort-on-commands ()
  "Sort CUSTOM-KEYMAP-LIST on commands."
  (interactive)
  (customize-save-variable 'custom-keymap-list
			   (sort custom-keymap-list :key #'cdr)))

;;;###autoload
(defun custom-keymap-sort-on-key-sequences ()
  "Sort CUSTOM-KEYMAP-LIST on key sequences."
  (interactive)
  (customize-save-variable 'custom-keymap-list
			   (sort custom-keymap-list :key (lambda (p) (vconcat (car p))))))

(defun custom-keymap-read-command ()
  "Read a command with default from the symbol at point."
  (let*
      ((sym (symbol-at-point))
       (default-cmd
	(if (commandp sym) sym nil))
       (command-prompt
	(if default-cmd
	    (format "Command (default: %s): " default-cmd)
	  "Command: ")))
    (read-command command-prompt default-cmd)))

(defun custom-keymap-read-key-sequence ()
  "Read a key sequence without echo keystroke help."
  (let ((echo-keystrokes-help nil)
	(cursor-in-echo-area t)
	(result nil))
    (while (null result)
      (let*
	  ((keyseq (read-key-sequence "Key sequence to bind to (C-g to quit): " nil t))
	   (existing-binding (key-binding keyseq)))
	(if (eq (seq-elt keyseq (1- (seq-length keyseq))) ?\a)
	    (setq quit-flag t)
	  (setq result
		(if existing-binding
		    (if (y-or-n-p (format "%s already runs the command %S. Overwrite old setting?" (key-description keyseq) existing-binding))
			keyseq nil)
		  keyseq)))))
    result))

;; (defun custom-keymap-read-function-symbol--interactive (funsym)
;;   "Interactively read a function FUNSYM symbol and return it."
;;   (interactive "aFunction: ")
;;   funsym)

;;;###autoload
(defun custom-keymap-add (keyseq funsym)
  "Add pair (KEYSEQ . FUNSYM) to CUSTOM-KEYMAP-LIST and save it.
This will cause function symbol FUNSYM to be bound to
key sequence KEYSEQ if mode CUSTOM-KEYMAP-MODE is active."
  ;; We want this:
  ;; (interactive "kKey sequence: \naKey sequence to bind to: ")
  ;; but without the misleading '(C-h for help)' in the prompt when reading KEYSEQ.
  ;; Therefore it gets more complicated:
  (interactive
   (list (custom-keymap-read-key-sequence)
	 (custom-keymap-read-command)))
  (if (null keyseq)
      (message "Aborted.")
    (progn
      (customize-save-variable 'custom-keymap-list
			       (cons (cons keyseq funsym)
				     (assoc-delete-all keyseq custom-keymap-list)))
      (message "%s bound to %S." funsym (key-description keyseq)))))

;;;###autoload
(defun custom-keymap-delete (funsym)
  "Delete all pairs (_ . FUNSYM) from CUSTOM-KEYMAP-LIST and save it.
This will cause the function symbol FUNSYM no longer to be bound to
the key sequence previously associated to it in CUSTOM-KEYMAP-LIST.
If the key sequence has a binding outside CUSTOM-KEYMAP-LIST, this one
may become active again."
  ;; We want this:
  ;; (interactive "kKey sequence: \naKey sequence to bind to: ")
  ;; but without the misleading '(C-h for help)' in the prompt when reading KEYSEQ.
  ;; Therefore it gets more complicated:
  (interactive
   (list (custom-keymap-read-command)))
  (if (null (rassoc funsym custom-keymap-list))
      (message "Command %s does not occur in CUSTOM-KEYMAP-LIST. Nothing will happen." funsym)
    (progn
      (customize-save-variable 'custom-keymap-list
			       (rassq-delete-all funsym custom-keymap-list)))
    (message "All entries with %s removed." funsym)))

(provide 'custom-keymap)
;;; custom-keymap.el ends here
