rainbow-fart.el

   1 ;;; rainbow-fart.el --- Checks the keywords of code to play suitable sounds -*- lexical-binding: t; -*-
   2
   3 ;; Authors: stardiviner <numbchild@gmail.com>
   4 ;; Package-Requires: ((emacs "25.1") (flycheck "32-cvs"))
   5 ;; Package-Version: 0.1
   6 ;; Keywords: tools
   7 ;; homepage: https://repo.or.cz/emacs-rainbow-fart.git
   8
   9 ;; rainbow-fart is free software; you can redistribute it and/or modify it
  10 ;; under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 3, or (at your option)
  12 ;; any later version.
  13 ;;
  14 ;; rainbow-fart is distributed in the hope that it will be useful, but WITHOUT
  15 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  16 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  17 ;; License for more details.
  18 ;;
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24 ;;
  25 ;; Usage:
  26 ;; (add-hook 'after-init-hook #'rainbow-fart-mode)
  27
  28 ;;; Code:
  29 \f
  30 (require 'flycheck)
  31 (require 'url)
  32 (require 'json)
  33
  34 (defgroup rainbow-fart nil
  35   "rainbow-fart-mode customize group."
  36   :prefix "rainbow-fart-"
  37   :group 'rainbow-fart)
  38
  39 (defcustom rainbow-fart-voices-directory
  40   (concat (file-name-directory (or load-file-name buffer-file-name)) "voices/")
  41   "The directory of voices."
  42   :type 'string
  43   :safe #'stringp
  44   :group 'rainbow-fart)
  45
  46 (defcustom rainbow-fart-keyword-interval (* 60 5)
  47   "The time interval in seconds of rainbow-fart play voice for keywords.
  48 If it is nil, will play sound for every keywords."
  49   :type 'number
  50   :safe #'numberp
  51   :group 'rainbow-fart)
  52
  53 (defcustom rainbow-fart-time-interval (* 60 15)
  54   "The time interval in seconds of rainbow-fart play voice for hours.
  55 If it's nil, the hours remind will not started."
  56   :type 'number
  57   :safe #'numberp
  58   :group 'rainbow-fart)
  59
  60 (defcustom rainbow-fart-recorder-template nil
  61   "The command line template to record voice file.
  62
  63 %f will be replaced to the voice file name."
  64   :type 'string
  65   :safe #'stringp
  66   :group 'rainbow-fart)
  67
  68 (defcustom rainbow-fart-ignore-modes nil
  69   "A list of major modes which will enable rainbow-fart-mode."
  70   :type 'list
  71   :safe #'listp
  72   :group 'rainbow-fart)
  73
  74 (defvar rainbow-fart--playing nil
  75   "The status of rainbow-fart playing.")
  76
  77 (defvar rainbow-fart--play-last-time nil
  78   "The last time of rainbow-fart play.")
  79
  80 (defcustom rainbow-fart-voice-pack-alist '((t . "JustKowalski"))
  81   "A list of model voice packs."
  82   :type 'alist
  83   :safe #'listp
  84   :group 'rainbow-fart)
  85
  86 ;;; TODO Support multiple voice packs data structure.
  87 (defvar rainbow-fart-manifest-alist nil
  88   "An alist of model voice pack's manifest info.")
  89
  90 ;;; TODO Support multiple voice packs data structure.
  91 (defcustom rainbow-fart-keyword-voices-alist '()
  92   "An alist of pairs of programming language keywords and voice filenames."
  93   :type 'alist
  94   :safe #'listp
  95   :group 'rainbow-fart)
  96
  97 ;;; Parsing voice pack manifest.json
  98
  99 (defun rainbow-fart-voice-pack-find-json-files (voice-pack)
 100   "Find voice package manifest.json and contributes.json two files."
 101   (let ((voice-model-dir (expand-file-name voice-pack rainbow-fart-voices-directory)))
 102     (if (file-exists-p (expand-file-name "contributes.json" voice-model-dir))
 103         (list
 104          (expand-file-name "manifest.json" voice-model-dir)
 105          (expand-file-name "contributes.json" voice-model-dir))
 106       (list (expand-file-name "manifest.json" voice-model-dir) nil))))
 107
 108 (defun rainbow-fart-voice-pack-parse-manifest (two-json)
 109   "Read in manifest.json file."
 110   (let* ((manifest-json-file (car two-json))
 111          (contributes-json-file (cadr two-json))
 112          (manifest (json-read-file manifest-json-file))
 113          (name (alist-get 'name manifest))
 114          (display-name (alist-get 'display-name manifest))
 115          (version (alist-get 'version manifest))
 116          (author (alist-get 'author manifest))
 117          ;; (description (alist-get 'description manifest))
 118          ;; (avatar (alist-get 'avatar manifest))           ; "avatar.jpg"
 119          ;; (avatar-dark (alist-get 'avatar-dark manifest)) ; "avatar-dark.jpg"
 120          (languages (alist-get 'languages manifest))     ; vector ["python"]
 121          ;; (locale (alist-get 'locale manifest))           ; "zh"
 122          ;; (gender (alist-get 'gender manifest))           ; "female"
 123          ;; `contributes' is a vector of keywords, voices and texts.
 124          (contributes (or (alist-get 'contributes manifest) ; "contributes" is in "manifest.json"
 125                           ;; "contributes" is in another file "contributes.json"
 126                           (alist-get 'contributes (json-read-file contributes-json-file)))))
 127     (setq rainbow-fart-manifest-alist manifest)
 128     (message "Loading rainbow-fart voice pack: %s (%s) by %s." name version author)
 129     (when (vectorp contributes)
 130       ;; reset voices alist
 131       (setq rainbow-fart-keyword-voices-alist nil)
 132       ;; NOTE `contributes' is a vector. Can't use `loop' to iterate.
 133       ;; append to data structure
 134       (mapc
 135        (lambda (definition-alist)
 136          (let ((keywords (mapcar #'identity (alist-get 'keywords definition-alist)))
 137                (voices (mapcar #'identity (alist-get 'voices definition-alist)))
 138                (texts (mapcar #'identity (alist-get 'texts definition-alist))))
 139            (mapc
 140             (lambda (key-str)
 141               (if-let ((keyword (string-trim key-str)))
 142                   (add-to-list 'rainbow-fart-keyword-voices-alist (cons keyword voices) 'append)))
 143             keywords)))
 144        contributes))
 145     (message "The rainbow-fart voice pack model: {%s} loaded." display-name)))
 146
 147 ;; initialize with default voice pack.
 148 (rainbow-fart-voice-pack-parse-manifest
 149  (rainbow-fart-voice-pack-find-json-files (alist-get 't rainbow-fart-voice-pack-alist)))
 150
 151 ;;; Play
 152
 153 (defun rainbow-fart--get-media-uri (keyword)
 154   "Get media uri based on KEYWORD."
 155   (when-let ((uris (cdr (assoc keyword rainbow-fart-keyword-voices-alist))))
 156     (let ((uri (nth (random (length uris)) uris))
 157           (voice-model-directory
 158            (expand-file-name (alist-get 't rainbow-fart-voice-pack-alist) rainbow-fart-voices-directory)))
 159       (if (url-type (url-generic-parse-url uri))
 160           uri
 161         (let ((uri (expand-file-name uri voice-model-directory)))
 162           (when (file-exists-p uri)
 163             uri))))))
 164
 165 (defun rainbow-fart--play (keyword)
 166   "A private function to play voice for matched KEYWORD."
 167   (unless (or rainbow-fart--playing
 168               (when rainbow-fart-keyword-interval
 169                 (not (if rainbow-fart--play-last-time
 170                          (> (- (float-time) rainbow-fart--play-last-time)
 171                             rainbow-fart-keyword-interval)
 172                        (setq rainbow-fart--play-last-time (float-time))))))
 173     (when-let ((uri (rainbow-fart--get-media-uri keyword))
 174                (command (or
 175                          (executable-find "mpg123")
 176                          (executable-find "mplayer")
 177                          (executable-find "mpv"))))
 178       (setq rainbow-fart--playing t)
 179       (make-process :name "rainbow-fart"
 180                     :command `(,command ,uri)
 181                     :buffer " *rainbow-fart*"
 182                     :sentinel (lambda (_ __)
 183                                 (setq rainbow-fart--playing nil)
 184                                 (setq rainbow-fart--play-last-time (float-time)))))))
 185 ;;; prefix detection
 186
 187 (defun rainbow-fart-get-prefix (regexp &optional expression limit)
 188   (when (looking-back regexp limit)
 189     (or (match-string-no-properties (or expression 0)) "")))
 190
 191 (defun rainbow-fart--post-self-insert ()
 192   "A hook function on `post-self-insert-hook' to play audio."
 193   (when (and (derived-mode-p 'prog-mode)
 194              (not (memq major-mode rainbow-fart-ignore-modes)))
 195     (let* ((prefix (save-excursion
 196                      ;; support prefix like "if(", "if (", "=>" etc keywords following punctuation.
 197                      (or (rainbow-fart-get-prefix "\\(?1:\\_<[^\\ ].\\_>\\)\\ ?[[:punct:]]?" 1)
 198                          (progn (goto-char (- (point) 1)) (thing-at-point 'symbol)))))
 199            (face (get-text-property (- (point) 1) 'face)))
 200       (when (or (memq face '(font-lock-keyword-face))
 201                 (null face))
 202         (rainbow-fart--play prefix)))))
 203
 204 ;;; linter like `flycheck'
 205
 206 (defun rainbow-fart--linter-display-error (err)
 207   "Play voice for `flycheck-error' ERR."
 208   (let ((level (flycheck-error-level err)))
 209     (rainbow-fart--play level)))
 210
 211 (defun rainbow-fart--linter-display-errors (errors)
 212   "A function to report ERRORS used as replacement of linter like `flycheck' and `flymake'."
 213   (rainbow-fart--play
 214    (mapc #'rainbow-fart--linter-display-error
 215          (seq-uniq
 216           (seq-mapcat #'flycheck-related-errors errors)))))
 217
 218 ;;; timer
 219
 220 (defun rainbow-fart--timing ()
 221   "Play voice for current time quantum."
 222   (let* ((time (format-time-string "%H:%M"))
 223          (pair (split-string time ":"))
 224          (hour (string-to-number (car pair))))
 225     (cond
 226      ((and (>= hour 05) (<= hour 08))     ; 05:00 -- 08:00
 227       "morning")
 228      ((and (>= hour 08) (<= hour 10))     ; 08:00 -- 10:00
 229       "hour")
 230      ((and (>= hour 10) (<= hour 11))     ; 10:00 -- 11:00
 231       "before_noon")
 232      ((and (>= hour 11) (<= hour 13))     ; 11:00 -- 13:00
 233       "noon")
 234      ((and (>= hour 13) (<= hour 15))     ; 13:00 -- 15:00
 235       "hour")
 236      ((and (>= hour 15) (<= hour 17))     ; 15:00 -- 17:00
 237       "afternoon")
 238      ((and (>= hour 18) (<= hour 22))     ; 18:00 -- 21:00
 239       "evening")
 240      ((or (>= hour 23) (<= hour 01))     ; 23:00 -- 01:00
 241       "midnight"))))
 242
 243 (defun rainbow-fart--timing-remind ()
 244   "Remind you in specific time quantum."
 245   (when (and rainbow-fart--play-last-time
 246              (> (- (float-time) rainbow-fart--play-last-time) rainbow-fart-time-interval))
 247     (rainbow-fart--play (rainbow-fart--timing))
 248     (setq rainbow-fart--play-last-time (float-time))))
 249
 250 (defvar rainbow-fart--timer nil)
 251
 252 ;;;###autoload
 253 (defun rainbow-fart-record-voice-for-keyword ()
 254   "Record a voice file which stored under the voice model directory."
 255   (interactive)
 256   (unless rainbow-fart-recorder-template
 257     (error "The variable rainbow-fart-recorder-template is undefined!"))
 258   (let* ((keyword (read-string "what keyword do you want to recorded for: " (thing-at-point 'symbol)))
 259          (model-directory (expand-file-name (alist-get 't rainbow-fart-voice-pack-alist) rainbow-fart-voices-directory))
 260          (voice-file-name (format "%s-%s.mp3" keyword (float-time)))
 261          (voice-file-path (expand-file-name voice-file-name model-directory))
 262          (record-cmd (replace-regexp-in-string "%f" voice-file-path rainbow-fart-recorder-template)))
 263     (shell-command record-cmd))
 264   ;; TODO write new audio file and keyword to contributions JSON file.
 265   )
 266
 267
 268 ;;;###autoload
 269 (define-minor-mode rainbow-fart-mode
 270   "A global minor mode add an encourager when you programming.
 271 Usage: (add-hook 'after-init-hook #'rainbow-fart-mode)"
 272   :init-value nil
 273   :lighter nil
 274   :group 'rainbow-fart
 275   :global t
 276   (if rainbow-fart-mode
 277       (progn
 278         (add-hook 'post-self-insert-hook #'rainbow-fart--post-self-insert t t)
 279         (advice-add (eval 'flycheck-display-errors-function)
 280                     :before 'rainbow-fart--linter-display-errors)
 281         (when (and rainbow-fart-time-interval
 282                    ;; only when media audio file available.
 283                    (rainbow-fart--get-media-uri "noon"))
 284           (setq rainbow-fart--timer
 285                 (run-with-timer 0 rainbow-fart-time-interval 'rainbow-fart--timing-remind))))
 286     (remove-hook 'post-self-insert-hook #'rainbow-fart--post-self-insert t)
 287     (advice-remove (eval 'flycheck-display-errors-function)
 288                    'rainbow-fart--linter-display-errors)
 289     (when (timerp rainbow-fart--timer)
 290       (cancel-timer rainbow-fart--timer))
 291     ;; reset rainbow-fart playing status after toggled `rainbow-fart-mode'.
 292     (setq rainbow-fart--playing nil)))
 293
 294 \f
 295
 296 (provide 'rainbow-fart)
 297
 298 ;;; rainbow-fart.el ends here