;;; -*- mode: emacs-lisp; coding: raw-text; buffer-file-coding-system: raw-text; coding-system-for-read: raw-text; coding-system-for-write: raw-text; -*-
;
;------------------------------------------------------------------

(setq ql-request-user-debug-p 'nil)

{when ql-request-user-debug-p
 (if load-in-progress
  (message "Loading \"%s\"..." load-file-name)
  (message "This buffer contains file \"%s\"." (buffer-file-name))
 )
)

;------------------------------------------------------------------
;
; Request one char (key) reply from user.
; Acceptable replies are specified by the list of strings
; representing character equivalent classes, e.g. ("yY", "nN", "qQ").
; Returns the first character of the string corresponding to user reply,
; i.e. in the example above it returns 'y' if user has pressed 'y' or 'Y',
; 'n' --- for 'n' or 'N' and so on.
;
;;;###autoload
(defun ql-request-key-from-user (the-replies-list the-prompt)
 "Request one char (key) reply from user.\nAcceptable replies are specified by the list of strings\nrepresenting character equivalent classes, e.g. (\"yY\", \"nN\", \"qQ\").\nReturns the first character of the string corresponding to user reply,\ni.e. in the example above it returns 'y' if user has pressed 'y' or 'Y',\n'n' -- for 'n' or 'N' and so on.\nNeeds prompt string as the second argument."
 (let ((s-i))
  (setq s-i
   (catch 'user-error
    (if (not (stringp the-prompt))
     (progn
      (message "The second argument (a prompt) must be a string")
      (throw 'user-error '(nil 1))
     )
    )
    (if (null the-replies-list)
     (progn
      (message "The first argument is nil, must be a list of possible replies (strings)")
      (throw 'user-error '(nil 2))
     )
    )
    (if (not (listp the-replies-list))
     (progn
      (message "The first argument must be a list of possible replies (strings)")
      (throw 'user-error '(nil 3))
     )
    )
    (let ((i 0) (i-s))
     ; Check the replies list.
     (dolist (i-s the-replies-list)
      (setq i (1+ i))
      (if ql-request-user-debug-p (message "%d: %S" i i-s))	; debugging
      (if (null i-s)
       (progn
        (message "The replies string number %d is nil" i)
        (throw 'user-error '(mil 4))
       )
       ; else: i-s != 'nil
       (if (stringp i-s)
        (if (equal 0 (length i-s))
         (progn
          (message "The replies string number %d is empty" i)
          (throw 'user-error '(nil 5))
         )
        )
        ; else: i-s is not a string
        (progn
         (message "The replies string number %d turns out not to be a string" i)
         (throw 'user-error '(nil 6))
        )
       )
      )
     )
     (if (< i 2)
      (progn
       (message "The replies strings list has the only element (no alternative answers allowed)")
       (throw 'user-error '(nil 7))
      )
     )
     (cons 't i)
    )
   )
  )
  (if ql-request-user-debug-p (message "Got from catch: %S" s-i))	; debugging
  (if s-i
   (if (cdr s-i)
    (if (null (car s-i))
     'nil	; there were errors, return nil
     ; ekse : Arrived here normally (no errors)
     ; (cdr s-i) -- number of reply character equivalent classes
     (let
      ((got-key 'nil)
       (i)
      )
      (catch 'got-reply
       (while (null got-key)
        (if (setq got-key (read-char-exclusive the-prompt))
         (progn
          (dolist (i the-replies-list)
           (if (string-match-p (char-to-string got-key) i)
            (progn
             (setq got-key (aref i 0))
             (throw 'got-reply got-key)
            )
           )
          )
          (setq got-key 'nil)
         )
        )
       )
      )
     )
    )
    ; else: s-i has no cdr
    (error "WEIRD! Got s-i with nil cdr")
    'nil
   )
   ; else: s-i is nil
   (error "WEIRD! Got nil s-i")
   'nil
  )
 )
)
; (ql-request-key-from-user   1 "[y/n]: ")
; (ql-request-key-from-user  "" "[y/n]: ")
; (ql-request-key-from-user '() "[y/n]: ")
; (ql-request-key-from-user '("yY")                          "[y/n/q]: ")
; (ql-request-key-from-user '("yY1 \n\r" "nN0" "qQ")         1)
; (ql-request-key-from-user '("yY1 \n\r" "nN0" "" "qQ")      "[y/n/q]: ")
; (ql-request-key-from-user '("yY1 \n\r" "nN0" (1 2 3) "qQ") "[y/n/q]: ")
; (ql-request-key-from-user '("yY1 \n\r" "nN0" "qQ\u0004")   "[y/n/q]: ")

;------------------------------------------------------------------
;
; Request confirmation [y/n]. Return 't on 'y', 'nil otherwise.
;;;###autoload
(defun ql-request-confirmation (the-prompt)
 "Request confirmation for an action ('y' for yes). Needs prompt string as arg."
 (interactive)
 (if (and (not (null the-prompt)) (not (stringp the-prompt)))
  (progn
   (lwarn emacs :error "The prompt must be a string")
   'nil	; This is an error clause! Must have means to indicate error!
  )
  ; else: the prompt is not null and it is a string
  (if (equal 0 (length the-prompt)) (setq the-prompt "[y/n]? "))
  (equal ?y (ql-request-key-from-user '("yY1 \n\r" "nN0") the-prompt))
 )
)
; (ql-request-confirmation "Well? ")

(provide 'ql-request-user-char-f)
(provide 'ql-request-confirmation-f)

;------------------------------------------------------------------

(when (and ql-request-user-debug-p load-in-progress)
 (message "Loading \"%s\"... done" load-file-name)
)

;------------------------------------------------------------------
;
; (setq buffer-file-coding-system	'raw-text)
; (setq coding-system-for-read		'raw-text)
; (setq coding-system-for-write		'raw-text)
;
;;; Local Variables:
;;; mode: emacs-lisp
;;; coding:                    raw-text
;;; coding-system-for-read:    raw-text
;;; coding-system-for-write:   raw-text
;;; buffer-file-coding-system: raw-text
;;; End: