Make prefix alternatives and other functions literate

This commit is contained in:
Ivan Malison 2016-06-06 17:23:07 -07:00
parent a651bcfb6b
commit 88cc27b890

View File

@ -27,14 +27,308 @@ Death to any gui elements in emacs! Do this EARLY so that emacs doesn't redispla
(when (fboundp 'scroll-bar-mode) (scroll-bar-mode -1)) (when (fboundp 'scroll-bar-mode) (scroll-bar-mode -1))
#+END_SRC #+END_SRC
* Custom emacs-lisp * Custom emacs-lisp
An emacs version predicate builder ** An emacs version predicate builder:
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defmacro emacs-version-predicate (major-version minor-version) (defmacro imalison:emacs-version-predicate (major-version minor-version)
`(lambda () `(lambda ()
(or (> emacs-major-version ,major-version) (or (> emacs-major-version ,major-version)
(and (>= emacs-major-version ,major-version) (and (>= emacs-major-version ,major-version)
(>= emacs-minor-version ,minor-version))))) (>= emacs-minor-version ,minor-version)))))
(defalias emacs24_4-p (emacs-version-predicate 24 4)) (defun imalison:check-emacs-version (major-version minor-version)
(funcall (imalison:emacs-version-predicate major-version minor-version)))
#+END_SRC
** Add a file to org-agenda-files in an idempotent way
#+BEGIN_SRC emacs-lisp
(defun imalison:add-to-org-agenda-files (incoming-files)
(setq org-agenda-files
(delete-dups
(cl-loop for filepath in (append org-agenda-files incoming-files)
when (and filepath (file-exists-p (file-truename filepath)))
collect (file-truename filepath)))))
#+END_SRC
** Compose functions taking arbitrarily many arguments and returning arbitrarily many arguments
#+BEGIN_SRC emacs-lisp
(defmacro imalison:compose (name &rest funcs)
"Build a new function with NAME that is the composition of FUNCS."
`(defun ,name (&rest args)
(imalison:compose-helper ,funcs)))
(defun imalison:make-list (thing)
(if (listp thing)
thing
(list thing)))
(defmacro imalison:compose-helper (funcs)
"Builds funcalls of FUNCS applied to the arg."
(if (equal (length funcs) 0)
(quote args)
`(apply ,(car funcs)
(imalison:make-list (imalison:compose-helper ,(cdr funcs))))))
#+END_SRC
** prefix-alternatives
Prefix alternatives is a macro that builds a function that selects one of a collection of functions that are provided to the macro based on the value of the prefix argument.
#+BEGIN_SRC emacs-lisp
(defmacro imalison:prefix-alternatives (name &rest alternatives)
`(defun ,name (arg)
(interactive "p")
(setq function
(cond
,@(progn
(let ((last-power 1))
(cl-loop for alternative in alternatives
collect `((eq arg ,last-power) (quote ,alternative))
do (setq last-power (* last-power 4)))))))
(setq function (or function)) ; Set a default value for function
(setq current-prefix-arg nil)
(call-interactively function)))
#+END_SRC
** TODO add commentary to the following
#+BEGIN_SRC emacs-lisp
(defun imalison:join-paths (&rest paths)
(substring (mapconcat 'file-name-as-directory paths nil) 0 -1))
(defun random-choice (choices)
(nth (random (length choices)) choices))
(defun display-prefix (arg)
"Display the value of the raw prefix arg."
(interactive "p")
(message "%s" arg))
(defmacro imalison:prefix-alternatives (name &rest alternatives)
`(defun ,name (arg)
(interactive "p")
(setq function
(cond
,@(progn
(let ((last-power 1))
(cl-loop for alternative in alternatives
collect `((eq arg ,last-power) (quote ,alternative))
do (setq last-power (* last-power 4)))))))
(setq function (or function)) ; Set a default value for function
(setq current-prefix-arg nil)
(call-interactively function)))
(defmacro imalison:let-advise-around (name &rest forms)
`(defun ,name (orig-func &rest args)
(let ,forms
(apply orig-func args))))
(defmacro imalison:dynamic-let-advise-around (name &rest getters)
`(defun ,name (orig-func &rest args)
(let ,(cl-loop for pair in getters
collect `(,(car pair) (funcall (quote ,(cadr pair)))))
(apply orig-func args))))
(defun imalison:uuid ()
(interactive)
(s-replace "\n" "" (shell-command-to-string "uuid")))
(defun imalison:disable-linum-mode ()
(linum-mode 0))
(defun imalison:disable-smartparens-mode ()
(smartparens-mode 0))
(defun imalison:insert-uuid ()
(interactive)
(insert (imalison:uuid)))
(defmacro suppress-messages (&rest forms)
`(flet ((message (&rest r) nil))
,@forms))
(defun imalison:compare-int-list (a b)
(when (and a b)
(cond ((> (car a) (car b)) 1)
((< (car a) (car b)) -1)
(t (imalison:compare-int-list (cdr a) (cdr b))))))
(defun imalison:get-lat-long ()
(condition-case _ex
(mapcar 'string-to-number (s-split "," (s-trim (shell-command-to-string
"whereami"))))
(error (list 37.7879312624533 -122.402388853402))))
(defun get-date-created-from-agenda-entry (agenda-entry)
(org-time-string-to-time
(org-entry-get (get-text-property 1 'org-marker agenda-entry) "CREATED")))
(defmacro defvar-setq (name value)
(if (boundp name)
`(setq ,name ,value)
`(defvar ,name ,value)))
(defun imalison:imenu-prefix-flattened (index)
(let ((flattened (imalison:flatten-imenu-index (cdr index))))
(cl-loop for sub-item in flattened
collect
`(,(concat (car index) "." (car sub-item)) . ,(cdr sub-item)))))
(defun imalison:flatten-imenu-index (index)
(let ((cdr-is-index (listp (cdr index))))
(cond ((not (stringp (car index))) (cl-mapcan
#'imalison:flatten-imenu-index index))
(cdr-is-index (imalison:imenu-prefix-flattened index))
(t (list index)))))
(defun imalison:make-imenu-index-flat ()
(let ((original-imenu-function imenu-create-index-function))
(setq imenu-create-index-function
(lambda ()
(imalison:flatten-imenu-index
(funcall original-imenu-function))))))
(defmacro defvar-if-non-existent (name value)
(unless (boundp name)
`(defvar ,name ,value)))
(defun eval-region-or-last-sexp ()
(interactive)
(if (region-active-p) (call-interactively 'eval-region)
(call-interactively 'eval-last-sexp)))
(defun undo-redo (&optional arg)
(interactive "P")
(if arg (undo-tree-redo) (undo-tree-undo)))
(defun up-list-region ()
(interactive)
(up-list) (set-mark-command nil) (backward-sexp))
(defun up-list-back ()
(interactive)
(up-list) (backward-sexp))
(defun unfill-paragraph (&optional region)
"Takes a multi-line paragraph and makes it into a single line of text."
(interactive (progn
(barf-if-buffer-read-only)
(list t)))
(let ((fill-column (point-max)))
(fill-paragraph nil region)))
(defun fill-or-unfill-paragraph (&optional unfill region)
"Fill paragraph (or REGION). With the prefix argument UNFILL,
unfill it instead."
(interactive (progn
(barf-if-buffer-read-only)
(list (if current-prefix-arg 'unfill) t)))
(let ((fill-column (if unfill (point-max) fill-column)))
(fill-paragraph nil region)))
(defun sudo-edit (&optional arg)
"Edit currently visited file as root.
With a prefix ARG prompt for a file to visit.
Will also prompt for a file to visit if current
buffer is not visiting a file."
(interactive "P")
(if (or arg (not buffer-file-name))
(find-file (concat "/sudo:root@localhost:"
(ido-read-file-name "Find file (as root): ")))
(find-alternate-file (concat "/sudo:root@localhost:" buffer-file-name))))
(defun frame-exists ()
(cl-find-if
(lambda (frame)
(assoc 'display (frame-parameters frame))) (frame-list)))
(defun imalison:copy-shell-command-on-region (start end command)
(interactive (list (region-beginning) (region-end)
(read-shell-command "Shell command on region: ")))
(let ((original-buffer (current-buffer)))
(with-temp-buffer
(let ((temp-buffer (current-buffer)))
(with-current-buffer original-buffer
(shell-command-on-region start end command temp-buffer))
(kill-ring-save (point-max) (point-min))))))
(defun imalison:shell-command-on-region-replace (start end command)
(interactive (list (region-beginning) (region-end)
(read-shell-command "Shell command on region: ")))
(shell-command-on-region start end command nil t))
(defun imalison:shell-command-on-region (arg)
(interactive "P")
(call-interactively (if arg 'imalison:shell-command-on-region-replace
'imalison:copy-shell-command-on-region)))
(defun make-frame-if-none-exists ()
(let* ((existing-frame (frame-exists)))
(if existing-frame
existing-frame
(make-frame-on-display (getenv "DISPLAY")))))
(defun make-frame-if-none-exists-and-focus ()
(make-frame-visible (select-frame (make-frame-if-none-exists))))
(defun copy-buffer-file-name ()
(interactive)
(add-string-to-kill-ring (file-name-nondirectory (buffer-file-name))))
(defun copy-buffer-file-path ()
(interactive)
(add-string-to-kill-ring (file-relative-name (buffer-file-name)
(projectile-project-root))))
(defun copy-full-file-path ()
(interactive)
(add-string-to-kill-ring (buffer-file-name)))
(defun add-string-to-kill-ring (string)
(with-temp-buffer
(insert string)
(kill-ring-save (point-max) (point-min))))
(defun open-pdf ()
(interactive)
(let ( (pdf-file (replace-regexp-in-string
"\.tex$" ".pdf" buffer-file-name)))
(shell-command (concat "open " pdf-file))))
(defun eval-and-replace ()
(interactive)
(backward-kill-sexp)
(condition-case nil
(prin1 (eval (read (current-kill 0)))
(current-buffer))
(error (message "Invalid expression")
(insert (current-kill 0)))))
(defun flatten-imenu-index (index)
(cl-mapcan
(lambda (x)
(if (listp (cdr x))
(cl-mapcar (lambda (item)
`(,(concat (car x) "/" (car item)) . ,(cdr item)))
(flatten-imenu-index (cdr x)))
(list x))) index))
(defun flatten-imenu-index-function (function)
(lambda () (flatten-imenu-index (funcall function))))
(defun flatten-current-imenu-index-function ()
(setq imenu-create-index-function
(flatten-imenu-index-function imenu-create-index-function)))
(defun notification-center (title message)
(flet ((encfn (s) (encode-coding-string s (keyboard-coding-system))))
(shell-command
(format "osascript -e 'display notification \"%s\" with title \"%s\"'"
(encfn message) (encfn title)))))
(defun growl-notify (title message)
(shell-command (format "grownotify -t %s -m %s" title message)))
(defun notify-send (title message)
(shell-command (format "notify-send -u critical %s %s" title message)))
(defvar notify-function
(cond ((eq system-type 'darwin) 'notification-center)
((eq system-type 'gnu/linux) 'notify-send)))
#+END_SRC #+END_SRC
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
@ -374,266 +668,6 @@ I use helm for almost all emacs completion
;; functions ;; functions
;; ============================================================================= ;; =============================================================================
(defun imalison:join-paths (&rest paths)
(substring (mapconcat 'file-name-as-directory paths nil) 0 -1))
(defmacro imalison:compose (name &rest funcs)
"Build a new function with NAME that is the composition of FUNCS."
`(defun ,name (&rest args)
(imalison:compose-helper ,funcs)))
(defun imalison:make-list (thing)
(if (listp thing)
thing
(list thing)))
(defmacro imalison:compose-helper (funcs)
"Builds funcalls of FUNCS applied to the arg."
(if (equal (length funcs) 0)
(quote args)
`(apply ,(car funcs)
(imalison:make-list (imalison:compose-helper ,(cdr funcs))))))
(defun random-choice (choices)
(nth (random (length choices)) choices))
(defun display-prefix (arg)
"Display the value of the raw prefix arg."
(interactive "p")
(message "%s" arg))
(defmacro imalison:prefix-alternatives (name &rest alternatives)
`(defun ,name (arg)
(interactive "p")
(setq function
(cond
,@(progn
(let ((last-power 1))
(cl-loop for alternative in alternatives
collect `((eq arg ,last-power) (quote ,alternative))
do (setq last-power (* last-power 4)))))))
(setq function (or function)) ; Set a default value for function
(setq current-prefix-arg nil)
(call-interactively function)))
(defmacro imalison:let-advise-around (name &rest forms)
`(defun ,name (orig-func &rest args)
(let ,forms
(apply orig-func args))))
(defmacro imalison:dynamic-let-advise-around (name &rest getters)
`(defun ,name (orig-func &rest args)
(let ,(cl-loop for pair in getters
collect `(,(car pair) (funcall (quote ,(cadr pair)))))
(apply orig-func args))))
(defun imalison:uuid ()
(interactive)
(s-replace "\n" "" (shell-command-to-string "uuid")))
(defun imalison:disable-linum-mode ()
(linum-mode 0))
(defun imalison:disable-smartparens-mode ()
(smartparens-mode 0))
(defun imalison:insert-uuid ()
(interactive)
(insert (imalison:uuid)))
(defmacro suppress-messages (&rest forms)
`(flet ((message (&rest r) nil))
,@forms))
(defun imalison:compare-int-list (a b)
(when (and a b)
(cond ((> (car a) (car b)) 1)
((< (car a) (car b)) -1)
(t (imalison:compare-int-list (cdr a) (cdr b))))))
(defun imalison:get-lat-long ()
(condition-case _ex
(mapcar 'string-to-number (s-split "," (s-trim (shell-command-to-string
"whereami"))))
(error (list 37.7879312624533 -122.402388853402))))
(defun get-date-created-from-agenda-entry (agenda-entry)
(org-time-string-to-time
(org-entry-get (get-text-property 1 'org-marker agenda-entry) "CREATED")))
(defmacro defvar-setq (name value)
(if (boundp name)
`(setq ,name ,value)
`(defvar ,name ,value)))
(defun imalison:imenu-prefix-flattened (index)
(let ((flattened (imalison:flatten-imenu-index (cdr index))))
(cl-loop for sub-item in flattened
collect
`(,(concat (car index) "." (car sub-item)) . ,(cdr sub-item)))))
(defun imalison:flatten-imenu-index (index)
(let ((cdr-is-index (listp (cdr index))))
(cond ((not (stringp (car index))) (cl-mapcan
#'imalison:flatten-imenu-index index))
(cdr-is-index (imalison:imenu-prefix-flattened index))
(t (list index)))))
(defun imalison:make-imenu-index-flat ()
(let ((original-imenu-function imenu-create-index-function))
(setq imenu-create-index-function
(lambda ()
(imalison:flatten-imenu-index
(funcall original-imenu-function))))))
(defmacro defvar-if-non-existent (name value)
(unless (boundp name)
`(defvar ,name ,value)))
(defun eval-region-or-last-sexp ()
(interactive)
(if (region-active-p) (call-interactively 'eval-region)
(call-interactively 'eval-last-sexp)))
(defun undo-redo (&optional arg)
(interactive "P")
(if arg (undo-tree-redo) (undo-tree-undo)))
(defun up-list-region ()
(interactive)
(up-list) (set-mark-command nil) (backward-sexp))
(defun up-list-back ()
(interactive)
(up-list) (backward-sexp))
(defun unfill-paragraph (&optional region)
"Takes a multi-line paragraph and makes it into a single line of text."
(interactive (progn
(barf-if-buffer-read-only)
(list t)))
(let ((fill-column (point-max)))
(fill-paragraph nil region)))
(defun fill-or-unfill-paragraph (&optional unfill region)
"Fill paragraph (or REGION). With the prefix argument UNFILL,
unfill it instead."
(interactive (progn
(barf-if-buffer-read-only)
(list (if current-prefix-arg 'unfill) t)))
(let ((fill-column (if unfill (point-max) fill-column)))
(fill-paragraph nil region)))
(defun sudo-edit (&optional arg)
"Edit currently visited file as root.
With a prefix ARG prompt for a file to visit.
Will also prompt for a file to visit if current
buffer is not visiting a file."
(interactive "P")
(if (or arg (not buffer-file-name))
(find-file (concat "/sudo:root@localhost:"
(ido-read-file-name "Find file (as root): ")))
(find-alternate-file (concat "/sudo:root@localhost:" buffer-file-name))))
(defun frame-exists ()
(cl-find-if
(lambda (frame)
(assoc 'display (frame-parameters frame))) (frame-list)))
(defun imalison:copy-shell-command-on-region (start end command)
(interactive (list (region-beginning) (region-end)
(read-shell-command "Shell command on region: ")))
(let ((original-buffer (current-buffer)))
(with-temp-buffer
(let ((temp-buffer (current-buffer)))
(with-current-buffer original-buffer
(shell-command-on-region start end command temp-buffer))
(kill-ring-save (point-max) (point-min))))))
(defun imalison:shell-command-on-region-replace (start end command)
(interactive (list (region-beginning) (region-end)
(read-shell-command "Shell command on region: ")))
(shell-command-on-region start end command nil t))
(defun imalison:shell-command-on-region (arg)
(interactive "P")
(call-interactively (if arg 'imalison:shell-command-on-region-replace
'imalison:copy-shell-command-on-region)))
(defun make-frame-if-none-exists ()
(let* ((existing-frame (frame-exists)))
(if existing-frame
existing-frame
(make-frame-on-display (getenv "DISPLAY")))))
(defun make-frame-if-none-exists-and-focus ()
(make-frame-visible (select-frame (make-frame-if-none-exists))))
(defun copy-buffer-file-name ()
(interactive)
(add-string-to-kill-ring (file-name-nondirectory (buffer-file-name))))
(defun copy-buffer-file-path ()
(interactive)
(add-string-to-kill-ring (file-relative-name (buffer-file-name)
(projectile-project-root))))
(defun copy-full-file-path ()
(interactive)
(add-string-to-kill-ring (buffer-file-name)))
(defun add-string-to-kill-ring (string)
(with-temp-buffer
(insert string)
(kill-ring-save (point-max) (point-min))))
(defun open-pdf ()
(interactive)
(let ( (pdf-file (replace-regexp-in-string
"\.tex$" ".pdf" buffer-file-name)))
(shell-command (concat "open " pdf-file))))
(defun eval-and-replace ()
(interactive)
(backward-kill-sexp)
(condition-case nil
(prin1 (eval (read (current-kill 0)))
(current-buffer))
(error (message "Invalid expression")
(insert (current-kill 0)))))
(defun flatten-imenu-index (index)
(cl-mapcan
(lambda (x)
(if (listp (cdr x))
(cl-mapcar (lambda (item)
`(,(concat (car x) "/" (car item)) . ,(cdr item)))
(flatten-imenu-index (cdr x)))
(list x))) index))
(defun flatten-imenu-index-function (function)
(lambda () (flatten-imenu-index (funcall function))))
(defun flatten-current-imenu-index-function ()
(setq imenu-create-index-function
(flatten-imenu-index-function imenu-create-index-function)))
(defun notification-center (title message)
(flet ((encfn (s) (encode-coding-string s (keyboard-coding-system))))
(shell-command
(format "osascript -e 'display notification \"%s\" with title \"%s\"'"
(encfn message) (encfn title)))))
(defun growl-notify (title message)
(shell-command (format "grownotify -t %s -m %s" title message)))
(defun notify-send (title message)
(shell-command (format "notify-send -u critical %s %s" title message)))
(defvar notify-function
(cond ((eq system-type 'darwin) 'notification-center)
((eq system-type 'gnu/linux) 'notify-send)))
;; ============================================================================= ;; =============================================================================
;; General Emacs Options ;; General Emacs Options
@ -1337,12 +1371,6 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(unless (boundp 'org-capture-templates) (unless (boundp 'org-capture-templates)
(defvar org-capture-templates nil)) (defvar org-capture-templates nil))
(defun imalison:add-to-org-agenda-files (incoming-files)
(setq org-agenda-files (delete-dups
(cl-loop for filepath in (append org-agenda-files incoming-files)
when (and filepath (file-exists-p (file-truename filepath)))
collect (file-truename filepath)))))
(imalison:add-to-org-agenda-files (imalison:add-to-org-agenda-files
(list imalison:org-gtd-file imalison:org-habits-file (list imalison:org-gtd-file imalison:org-habits-file
imalison:org-calendar-file)) imalison:org-calendar-file))
@ -2571,7 +2599,7 @@ Set the character used to represent spaces to ·, and the character used for tab
(imalison:restore-ansi-term-color-vector)) (imalison:restore-ansi-term-color-vector))
(when t (when t
(if (emacs24_4-p) (if
(advice-add 'load-theme :after #'imalison:after-load-theme) (advice-add 'load-theme :after #'imalison:after-load-theme)
(defadvice load-theme (after name activate) (defadvice load-theme (after name activate)
(imalison:after-load-theme)))) (imalison:after-load-theme))))