Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
116 lines (94 sloc) 3.83 KB
;; Blake DeMarcy; 2017/05/10: Public Domain code for GNU Emacs
;;
;; Some simple functions who read in strings, count their characters, and keep
;; a json file in sync with the stats. Several interactive functions are
;; provided that allow thoughts to be submitted, including `read-passwd',
;; the current buffer, or the active region in transient mark mode. These
;; functions print the newly counted chars to the minibuffer. Cute.
;;
;; This was inspired by my incessant, primal urges to spew depressing nonsense
;; in the general direction of other human beings. Using these functions, i can
;; dispose of my shitty feelings in an expressable but irrecoverable way.
;; This is probably the most satisfying way i can think of to shoot emotions
;; out into the void, and I've realized far too late how badly I've needed something
;; like this.
;; for cl-letf'ing json behaviour
(require 'cl)
(require 'json)
;; where to store counts
(defvar feels "~/.feels")
;; quips are the strings randomly generated from the summary
;; of chars counted.
(defvar quips "~/.quips")
;; a persistent spot for the last chars counted
(defvar last-quip "")
(defun load-feels ()
"If the file exists, decode it with the keys converted to character codes
and return it. Otherwise returns nil; the other functions will create the
file when writing it."
(when (file-exists-p feels)
(cl-letf (((symbol-function 'json-add-to-object)
(lambda (object key value)
(cons (cons (aref key 0) value) object))))
(json-read-file feels))))
(defun load-quips ()
"see `load-feels': returns the quips instead"
(when (file-exists-p quips)
(let ((json-array-type 'list))
(json-read-file quips))))
(defun update-feels (list string)
"Takes a list (or nil) and a string to count. Updates or creates an alist
where each `car' is a character point and each `cdr' is it's use count.
Writes the new data to the storage file, and returns the updated list."
(unless (string= string "")
(loop for char across string do
(condition-case nil
(incf (alist-get char list))
(error (push (cons char 1) list))))
(with-temp-file feels
(erase-buffer)
(cl-letf (((symbol-function 'json-encode-key)
(lambda (char)
(json-encode (string char)))))
(insert (json-encode list)))))
list)
(defun push-quip (quip)
"add a new quip to the head of the list"
(with-temp-file quips
(erase-buffer)
(insert (json-encode (append (list quip) (load-quips))))))
(defun diff-feels (updated original)
"returns a string of the characters incremented before and after processing.
take care to use a method like `copy-tree' before calling `update-feels' because
it modifies the input list in place."
(map 'string #'car
(map-filter
(lambda (char count)
(> count (or (alist-get char original) 0)))
updated)))
(defun submit-feels (&optional string no-message)
"Recieves or prompts for a string to submit to the counter function.
Does not return anything useful. Prints the updated characters (but
not their new counts) to the minibuffer."
(interactive)
(let* ((original (load-feels))
(updated (update-feels
(copy-tree original)
(or string (read-passwd "(??)> ")))))
(push-quip (setq last-quip (diff-feels updated original)))
(or no-message (message "%s" last-quip))
updated))
(defun submit-feels-dwim (prefix)
"Checks the following conditions in this order:
Active region? Submit the region.
Positive prefix arg? Submit the whole buffer.
No prefix, no region? Read from the minibuffer"
(interactive "p")
(submit-feels
(cond
((region-active-p)
(buffer-substring-no-properties
(region-beginning) (region-end)))
((/= prefix 1)
(buffer-substring-no-properties
(point-min) (point-max))))))