;;; upper-case.el --- upper-case as a minor mode       -*- lexical-binding: t -*-

;; Copyright (C) 2014  Free Software Foundation, Inc.

;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Version: 1.0

;; 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 of the License, 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.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This was the caps-lock.el initially. I modified it to not doing
;; upcase in comments or strings. -- 2021-10-11 GB

;;; Code:

(defvar upper-case-commands
  '(self-insert-command)
  ;; "List of commands that are subject to `upper-case-mode'."
  )

;;;###autoload
(define-minor-mode upper-case-mode
  "Make self-inserting keys invert the capitalization."
  ;; :global nil
  :init-value nil
  :lighter " UPPER"
  (if upper-case-mode
      (add-hook 'pre-command-hook 'upper-case--pch nil t)
    (remove-hook 'pre-command-hook 'upper-case--pch t)))

(defun upper-case--pch ()
  (when (and (characterp last-command-event)
             (or (memq this-command upper-case-commands)
                 (eq this-command (key-binding [remap self-insert-command]))))
    (let ((face
           (or (get-text-property (point) 'face)
               ;; (get-text-property (max 1 (1- (point))) 'face)
               )))
      (setq xxx face)
      (setq yyy '(point))
      (setq last-command-event
            (condition-case nil
                (progn
                  (if (or
                       (let ((q (syntax-ppss))) (or (fourth q) (fifth q)))
                       (member face
                               '(font-lock-comment-face
                                 font-lock-comment-delimiter-face
                                 font-lock-string-face)))
                      last-command-event
                    (let ((up (upcase last-command-event)))
                      (if (eq up last-command-event)
                          (downcase last-command-event)
                        up))))
              (error last-command-event))))))

;;;; ChangeLog:

;; 2014-07-07  Stefan Monnier  <monnier@iro.umontreal.ca>
;; 
;; 	* upper-case: New package.
;; 


(provide 'upper-case)
;;; upper-case.el ends here