From 6bd3184b2f10313021b93cb9e7e8d45c32e0916b Mon Sep 17 00:00:00 2001 From: Roger Gonzalez Date: Sat, 18 Mar 2023 16:44:35 -0300 Subject: Changed fish_variables --- .config/doom/config.el | 449 +++++++++++++ .config/doom/custom-packages/deferred.el | 971 +++++++++++++++++++++++++++++ .config/doom/custom-packages/ox-slack.el | 366 +++++++++++ .config/doom/custom-packages/screenshot.el | 460 ++++++++++++++ .config/doom/init.el | 200 ++++++ .config/doom/packages.el | 63 ++ 6 files changed, 2509 insertions(+) create mode 100644 .config/doom/config.el create mode 100644 .config/doom/custom-packages/deferred.el create mode 100644 .config/doom/custom-packages/ox-slack.el create mode 100644 .config/doom/custom-packages/screenshot.el create mode 100644 .config/doom/init.el create mode 100644 .config/doom/packages.el (limited to '.config/doom') diff --git a/.config/doom/config.el b/.config/doom/config.el new file mode 100644 index 00000000..5bfa1e1e --- /dev/null +++ b/.config/doom/config.el @@ -0,0 +1,449 @@ +;;; $DOOMDIR/config.el -*- lexical-binding: t; -*- + +;; Place your private configuration here! Remember, you do not need to run 'doom +;; sync' after modifying this file! + + +;; Some functionality uses this to identify you, e.g. GPG configuration, email +;; clients, file templates and snippets. +(setq user-full-name "Roger Gonzalez" + user-mail-address "roger@rogs.me") + +;; Add custom packages +(add-to-list 'load-path "~/.config/doom/custom-packages") + +;; Load custom packages +(require 'screenshot) +(require 'ox-slack) +(require 'deferred) + +;; Doom exposes five (optional) variables for controlling fonts in Doom. Here +;; are the three important ones: +;; +;; + `doom-font' +;; + `doom-variable-pitch-font' +;; + `doom-big-font' -- used for `doom-big-font-mode'; use this for +;; presentations or streaming. +;; +;; They all accept either a font-spec, font string ("Input Mono-12"), or xlfd +;; font string. You generally only need these two: +;; (setq doom-font (font-spec :family "monospace" :size 12 :weight 'semi-light) +;; doom-variable-pitch-font (font-spec :family "sans" :size 13)) + +;; (setq doom-font (font-spec :family "Mononoki Nerd Font" :size 14) +;; doom-variable-pitch-font (font-spec :family "sans") +;; doom-big-font (font-spec :family "Mononoki Nerd Font" :size 24)) +(setq doom-font (font-spec :family "MesloLGS NF" :size 14) + doom-variable-pitch-font (font-spec :family "sans") + doom-big-font (font-spec :family "MesloLGS NF" :size 24)) + +;; There are two ways to load a theme. Both assume the theme is installed and +;; available. You can either set `doom-theme' or manually load a theme with the +;; `load-theme' function. This is the default: +(after! doom-themes + (setq doom-themes-enable-bold t + doom-themes-enable-italic t)) +(custom-set-faces! + '(font-lock-comment-face :slant italic) + '(font-lock-keyword-face :slant italic)) +(setq doom-theme 'doom-badger) + +;; If you use `org' and don't want your org files in the default location below, +;; change `org-directory'. It must be set before org loads! +(setq org-directory "~/org/") + +;; This determines the style of line numbers in effect. If set to `nil', line +;; numbers are disabled. For relative line numbers, set this to `relative'. +(setq display-line-numbers-type 'relative) + + +;; Here are some additional functions/macros that could help you configure Doom: +;; +;; - `load!' for loading external *.el files relative to this one +;; - `use-package!' for configuring packages +;; - `after!' for running code after a package has loaded +;; - `add-load-path!' for adding directories to the `load-path', relative to +;; this file. Emacs searches the `load-path' when you load packages with +;; `require' or `use-package'. +;; - `map!' for binding new keys +;; +;; To get information about any of these functions/macros, move the cursor over +;; the highlighted symbol at press 'K' (non-evil users must press 'C-c c k'). +;; This will open documentation for it, including demos of how they are used. +;; +;; You can also try 'gd' (or 'C-c c d') to jump to their definition and see how +;; they are implemented. +;; HTTP Statuses for Helm +(defvar helm-httpstatus-source + '((name . "HTTP STATUS") + (candidates . (("100 Continue") ("101 Switching Protocols") + ("102 Processing") ("200 OK") + ("201 Created") ("202 Accepted") + ("203 Non-Authoritative Information") ("204 No Content") + ("205 Reset Content") ("206 Partial Content") + ("207 Multi-Status") ("208 Already Reported") + ("300 Multiple Choices") ("301 Moved Permanently") + ("302 Found") ("303 See Other") + ("304 Not Modified") ("305 Use Proxy") + ("307 Temporary Redirect") ("400 Bad Request") + ("401 Unauthorized") ("402 Payment Required") + ("403 Forbidden") ("404 Not Found") + ("405 Method Not Allowed") ("406 Not Acceptable") + ("407 Proxy Authentication Required") ("408 Request Timeout") + ("409 Conflict") ("410 Gone") + ("411 Length Required") ("412 Precondition Failed") + ("413 Request Entity Too Large") + ("414 Request-URI Too Large") + ("415 Unsupported Media Type") + ("416 Request Range Not Satisfiable") + ("417 Expectation Failed") ("418 I'm a teapot") + ("421 Misdirected Request") + ("422 Unprocessable Entity") ("423 Locked") + ("424 Failed Dependency") ("425 No code") + ("426 Upgrade Required") ("428 Precondition Required") + ("429 Too Many Requests") + ("431 Request Header Fields Too Large") + ("449 Retry with") ("500 Internal Server Error") + ("501 Not Implemented") ("502 Bad Gateway") + ("503 Service Unavailable") ("504 Gateway Timeout") + ("505 HTTP Version Not Supported") + ("506 Variant Also Negotiates") + ("507 Insufficient Storage") ("509 Bandwidth Limit Exceeded") + ("510 Not Extended") + ("511 Network Authentication Required"))) + (action . message))) + +(defun helm-httpstatus () + (interactive) + (helm-other-buffer '(helm-httpstatus-source) "*helm httpstatus*")) + +;; Org Mode +(after! org + ;; Include diary + (setq org-agenda-include-diary t) + ;; Logs + (setq org-log-state-notes-insert-after-drawers nil + org-log-into-drawer "LOGBOOK" + org-log-done 'time + org-log-repeat 'time + org-log-redeadline 'note + org-log-reschedule 'note) + ;; Keyword and faces + (setq-default org-todo-keywords + '((sequence "REPEAT(r)" "NEXT(n@/!)" "DELEGATED(e@/!)" "TODO(t@/!)" "WAITING(w@/!)" "SOMEDAY(s@/!)" "PROJ(p)" "|" "DONE(d@)" "CANCELLED(c@/!)" "FORWARDED(f@)"))) + (setq-default org-todo-keyword-faces + '( + ( "REPEAT" . (:foreground "white" :background "indigo" :weight bold)) + ( "NEXT" . (:foreground "red" :background "orange" :weight bold)) + ( "DELEGATED" . (:foreground "white" :background "blue" :weight bold)) + ( "TODO" . (:foreground "white" :background "violet" :weight bold)) + ( "WAITING" (:foreground "white" :background "#A9BE00" :weight bold)) + ( "SOMEDAY" . (:foreground "white" :background "#00807E" :weight bold)) + ( "PROJ" . (:foreground "white" :background "deeppink3" :weight bold)) + ( "DONE" . (:foreground "white" :background "forest green" :weight bold)) + ( "CANCELLED" . (:foreground "light gray" :slant italic)) + ( "FORWARDED" . (:foreground "light gray" :slant italic)) + )) + (setq org-fontify-done-headline t) + (setq org-fontify-todo-headline t) + ;; Priorities + ;; A: Do it now + ;; B: Decide when to do it + ;; C: Delegate it + ;; D: Just an idea + (setq org-highest-priority ?A) + (setq org-lowest-priority ?D) + (setq org-default-priority ?B) + (setq org-priority-faces '((?A . (:foreground "white" :background "dark red" :weight bold)) + (?B . (:foreground "white" :background "dark green" :weight bold)) + (?C . (:foreground "yellow")) + (?D . (:foreground "gray")))) + ;; Capture templates + (setq org-capture-templates + (quote + ( + ("G" "Define a goal" entry (file+headline "~/org/capture.org" "Capture") (file "~/org/templates/goal.org") :empty-lines-after 1) + ("R" "REPEAT entry" entry (file+headline "~/org/capture.org" "Capture") (file "~/org/templates/repeat.org") :empty-lines-before 1) + ("N" "NEXT entry" entry (file+headline "~/org/capture.org" "Capture") (file "~/org/templates/next.org") :empty-lines-before 1) + ("T" "TODO entry" entry (file+headline "~/org/capture.org" "Capture") (file "~/org/templates/todo.org") :empty-lines-before 1) + ("W" "WAITING entry" entry (file+headline "~/org/capture.org" "Capture") (file "~/org/templates/waiting.org") :empty-lines-before 1) + ("S" "SOMEDAY entry" entry (file+headline "~/org/capture.org" "Capture") (file "~/org/templates/someday.org") :empty-lines-before 1) + ("P" "PROJ entry" entry (file+headline "~/org/capture.org" "Capture") (file "~/org/templates/proj.org") :empty-lines-before 1) + ("B" "Book on the to-read-list" entry (file+headline "~/org/private.org" "Libros para leer") (file "~/org/templates/book.org") :empty-lines-after 2) + ("p" "Create a daily plan") + ("pP" "Daily plan private" plain (file+olp+datetree "~/org/plan-free.org") (file "~/org/templates/dailyplan.org") :immediate-finish t :jump-to-captured t) + ("pW" "Daily plan prometeo" plain (file+olp+datetree "~/org/plan-work.org") (file "~/org/templates/dailyplan.org") :immediate-finish t :jump-to-captured t) + ("j" "Journal entry") + ("jP" "Journal entry private private" entry (file+olp+datetree "~/org/journal-private.org") "** %U - %^{Heading}") + ("jW" "Journal entry work " entry (file+olp+datetree "~/org/journal-work.org") "** %U - %^{Heading}") + ("d" "Create a deployment") + ("dF" "Deploy features" plain (file+olp+datetree "~/org/deploy-features.org") (file "~/org/templates/deployment.org") :immediate-finish t :jump-to-captured t) + ("dB" "Deploy bugs" plain (file+olp+datetree "~/org/deploy-bugs.org") (file "~/org/templates/deployment.org") :immediate-finish t :jump-to-captured t) + ))) + ;; Custom agenda views + (setq org-agenda-custom-commands + (quote + ( + ("A" . "Agendas") + ("AT" "Daily overview" + ((tags-todo "URGENT" + ((org-agenda-overriding-header "Urgent Tasks"))) + (tags-todo "RADAR" + ((org-agenda-overriding-header "On my radar"))) + (tags-todo "PHONE+TODO=\"NEXT\"" + ((org-agenda-overriding-header "Phone Calls"))) + (tags-todo "COMPANY" + ((org-agenda-overriding-header "Cuquitoni"))) + (tags-todo "SHOPPING" + ((org-agenda-overriding-header "Shopping"))) + (tags-todo "Depth=\"Deep\"/NEXT" + ((org-agenda-overriding-header "Next Actions requiring deep work"))) + (agenda "" + ((org-agenda-overriding-header "Today") + (org-agenda-span 1) + (org-agenda-start-day "1d") + (org-agenda-sorting-strategy + (quote + (time-up priority-down))))) + nil nil)) + ("AW" "Weekly overview" agenda "" + ((org-agenda-overriding-header "Weekly overview"))) + ("AM" "Monthly overview" agenda "" + ((org-agenda-overriding-header "Monthly overview")) + (org-agenda-span + (quote month)) + (org-deadline-warning-days 0) + (org-agenda-sorting-strategy + (quote + (time-up priority-down tag-up)))) + ("W" . "Weekly Review Helper") + ("Wn" "New tasks" tags "NEW" + ((org-agenda-overriding-header "NEW Tasks"))) + ("Wd" "Check DELEGATED tasks" todo "DELEGATED" + ((org-agenda-overriding-header "DELEGATED tasks"))) + ("Ww" "Check WAITING tasks" todo "WAITING" + ((org-agenda-overriding-header "WAITING tasks"))) + ("Ws" "Check SOMEDAY tasks" todo "SOMEDAY" + ((org-agenda-overriding-header "SOMEDAY tasks"))) + ("Wf" "Check finished tasks" todo "DONE|CANCELLED|FORWARDED" + ((org-agenda-overriding-header "Finished tasks"))) + ("WP" "Planing ToDos (unscheduled) only" todo "TODO|NEXT" + ((org-agenda-overriding-header "To plan") + (org-agenda-skip-function + (quote + (org-agenda-skip-entry-if + (quote scheduled) + (quote deadline))))))) + )) + ;; + ;; Enforce ordered tasks + (setq org-enforce-todo-dependencies t) + (setq org-enforce-todo-checkbox-dependencies t) + (setq org-track-ordered-property-with-tag t) + + ;; Org bullets + (require 'org-bullets) + (add-hook 'org-mode-hook (lambda () (org-bullets-mode 1))) + + ;; Org recur + (use-package org-recur + :hook ((org-mode . org-recur-mode) + (org-agenda-mode . org-recur-agenda-mode)) + :demand t + :config + (define-key org-recur-mode-map (kbd "C-c d") 'org-recur-finish) + + ;; Rebind the 'd' key in org-agenda (default: `org-agenda-day-view'). + (define-key org-recur-agenda-mode-map (kbd "C-c d") 'org-recur-finish) + (define-key org-recur-agenda-mode-map (kbd "C-c 0") 'org-recur-schedule-today) + + (setq org-recur-finish-done t + org-recur-finish-archive t)) + + ;; Truncate lines to 105 chars + ;; Why 105 chars? Because that's the max my screen can handle on vertical split + (add-hook 'org-mode-hook #'auto-fill-mode) + (setq-default fill-column 105) + + ;; Custom ORG functions + ;; Refresh org-agenda after rescheduling a task. + (defun org-agenda-refresh () + "Refresh all `org-agenda' buffers." + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (derived-mode-p 'org-agenda-mode) + (org-agenda-maybe-redo))))) + + (defadvice org-schedule (after refresh-agenda activate) + "Refresh org-agenda." + (org-agenda-refresh)) + + (defun org-focus-private() "Set focus on private things." + (interactive) + (setq org-agenda-files '("~/org/private.org")) + (message "Focusing on private Org files")) + (defun org-focus-work() "Set focus on work things." + (interactive) + (setq org-agenda-files '("~/org/work.org")) + (message "Focusing on work Org files")) + (defun org-focus-all() "Set focus on all things." + (interactive) + (setq org-agenda-files '("~/org/")) + (message "Focusing on all Org files")) + + (defun my/org-add-ids-to-headlines-in-file () + "Add ID properties to all headlines in the current file which +do not already have one." + (interactive) + (org-map-entries 'org-id-get-create)) + (add-hook 'org-mode-hook + (lambda () + (add-hook 'before-save-hook + 'my/org-add-ids-to-headlines-in-file nil 'local))) + (defun my/copy-idlink-to-clipboard() "Copy an ID link with the +headline to killring, if no ID is there then create a new unique +ID. This function works only in org-mode or org-agenda buffers. + +The purpose of this function is to easily construct id:-links to +org-mode items. If its assigned to a key it saves you marking the +text and copying to the killring." + (interactive) + (when (eq major-mode 'org-agenda-mode) ;if we are in agenda mode we switch to orgmode + (org-agenda-show) + (org-agenda-goto)) + (when (eq major-mode 'org-mode) ; do this only in org-mode buffers + (setq mytmphead (nth 4 (org-heading-components))) + (setq mytmpid (funcall 'org-id-get-create)) + (setq mytmplink (format "[[id:%s][%s]]" mytmpid mytmphead)) + (kill-new mytmplink) + (message "Copied %s to killring (clipboard)" mytmplink) + )) + + (global-set-key (kbd "") 'my/copy-idlink-to-clipboard) + + (defun org-reset-checkbox-state-maybe () + "Reset all checkboxes in an entry if the `RESET_CHECK_BOXES' property is set" + (interactive "*") + (if (org-entry-get (point) "RESET_CHECK_BOXES") + (org-reset-checkbox-state-subtree))) + + (defun org-checklist () + (when (member org-state org-done-keywords) ;; org-state dynamically bound in org.el/org-todo + (org-reset-checkbox-state-maybe))) + + (add-hook 'org-after-todo-state-change-hook 'org-checklist)) + + ;; Save all org buffers on each save + ;; (add-hook 'auto-save-hook 'org-save-all-org-buffers) + ;; (add-hook 'after-save-hook 'org-save-all-org-buffers)) + +;; My own menu +(map! :leader + (:prefix-map ("a" . "applications") + :desc "HTTP Status cheatsheet" "h" #'helm-httpstatus) + (:prefix-map ("ao" . "org") + :desc "Org focus work" "w" #'org-focus-work + :desc "Org focus private" "p" #'org-focus-private + :desc "Org focus all" "a" #'org-focus-all + )) + +;; Python + +(require 'auto-virtualenv) +(after! python + :init + (add-hook 'python-mode-hook 'auto-virtualenv-set-virtualenv) + (setq enable-local-variables :all)) + +(elpy-enable) +(after! elpy + (set-company-backend! 'elpy-mode + '(elpy-company-backend :with company-files company-yasnippet))) +(setq elpy-rpc-timeout 10) +(remove-hook 'elpy-modules 'elpy-module-flymake) + +(use-package flycheck + :config + (setq-default flycheck-disabled-checkers '(python-pylint))) + +;; LSP config +(after! lsp-mode + (setq lsp-diagnostic-package :none) + (setq lsp-headerline-breadcrumb-enable t) + (setq lsp-headerline-breadcrumb-icons-enable t)) + +(after! lsp-ui + (setq lsp-ui-doc-enable t)) + +;; (add-hook 'prog-mode-hook (lambda () (symbol-overlay-mode t))) + + +;; Create new spikes, saved for later +;; (defun certn/new-spike () +;; "Create a new org spike in ~/org/Lazer/Certn/." +;; (interactive) +;; (let ((name (read-string "Ticket: "))) +;; (expand-file-name (format "%s.org" name) "~/org/Lazer/Certn/Spikes"))) + + +;; Dashboard mode +;;(use-package dashboard + ;;:init ;; tweak dashboard config before loading it + ;;(setq dashboard-set-heading-icons t) + ;;(setq dashboard-set-file-icons t) + ;;(setq dashboard-center-content nil) ;; set to 't' for centered content + ;;(setq dashboard-items '((recents . 5) + ;;(bookmarks . 5) + ;;(projects . 5))) + ;;(setq dashboard-set-navigator t) + ;;:config + ;;(dashboard-setup-startup-hook) + ;;(dashboard-modify-heading-icons '((recents . "file-text") + ;;(bookmarks . "book")))) +;;(setq initial-buffer-choice (lambda () (get-buffer-create "*dashboard*"))) +;;(setq doom-fallback-buffer-name "*dashboard*") + +(defun my/html2org-clipboard () + "Convert clipboard contents from HTML to Org and then paste (yank)." + (interactive) + (kill-new (shell-command-to-string "timeout 1 xclip -selection clipboard -o -t text/html | pandoc -f html -t json | pandoc -f json -t org --wrap=none")) + (yank) + (message "Pasted HTML in org")) +(define-key org-mode-map (kbd "") 'my/html2org-clipboard) + +;; Clipmon as emacs clipboard manager +(global-set-key (kbd "M-y") 'helm-show-kill-ring) +(add-to-list 'after-init-hook 'clipmon-mode-start) +(defadvice clipmon--on-clipboard-change (around stop-clipboard-parsing activate) (let ((interprogram-cut-function nil)) ad-do-it)) +(setq clipmon-timer-interval 1) + +;; Jenkins +(require 'butler) +(add-to-list 'butler-server-list + '(jenkins "prometeo-jenkins" + (server-address . "http://jenkins.prometeoapi") + (auth-file . "~/.authinfo.gpg"))) + +(defun my/jenkins-verify () + "Check if my current Jenkinsfile has the correct format" + (interactive) + (projectile-with-default-dir (projectile-acquire-root) + (message (shell-command-to-string "/usr/bin/python ~/.doom.d/scripts/check_jenkinsfile.py")))) + +(after! groovy-mode + (define-key groovy-mode-map (kbd "") 'my/jenkins-verify)) + +(setq forge-alist '(("github.com-underarmour" "api.github.com" "github.com" forge-github-repository) + ("github.com" "api.github.com" "github.com" forge-github-repository) + ("gitlab.com" "gitlab.com/api/v4" "gitlab.com" forge-gitlab-repository) + ("salsa.debian.org" "salsa.debian.org/api/v4" "salsa.debian.org" forge-gitlab-repository) + ("framagit.org" "framagit.org/api/v4" "framagit.org" forge-gitlab-repository) + ("gitlab.gnome.org" "gitlab.gnome.org/api/v4" "gitlab.gnome.org" forge-gitlab-repository) + ("codeberg.org" "codeberg.org/api/v1" "codeberg.org" forge-gitea-repository) + ("code.orgmode.org" "code.orgmode.org/api/v1" "code.orgmode.org" forge-gogs-repository) + ("bitbucket.org" "api.bitbucket.org/2.0" "bitbucket.org" forge-bitbucket-repository) + ("git.savannah.gnu.org" nil "git.savannah.gnu.org" forge-cgit**-repository) + ("git.kernel.org" nil "git.kernel.org" forge-cgit-repository) + ("repo.or.cz" nil "repo.or.cz" forge-repoorcz-repository) + ("git.suckless.org" nil "git.suckless.org" forge-stagit-repository) + ("git.sr.ht" nil "git.sr.ht" forge-srht-repository))) diff --git a/.config/doom/custom-packages/deferred.el b/.config/doom/custom-packages/deferred.el new file mode 100644 index 00000000..041c90b0 --- /dev/null +++ b/.config/doom/custom-packages/deferred.el @@ -0,0 +1,971 @@ +;;; deferred.el --- Simple asynchronous functions for emacs lisp -*- lexical-binding: t; -*- + +;; Copyright (C) 2010-2016 SAKURAI Masashi + +;; Author: SAKURAI Masashi +;; Version: 0.5.1 +;; Keywords: deferred, async +;; Package-Requires: ((emacs "24.4")) +;; URL: https://github.com/kiwanami/emacs-deferred + +;; 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 . + +;;; Commentary: + +;; 'deferred.el' is a simple library for asynchronous tasks. +;; [https://github.com/kiwanami/emacs-deferred] + +;; The API is almost the same as JSDeferred written by cho45. See the +;; JSDeferred and Mochikit.Async web sites for further documentations. +;; [https://github.com/cho45/jsdeferred] +;; [http://mochikit.com/doc/html/MochiKit/Async.html] + +;; A good introduction document (JavaScript) +;; [http://cho45.stfuawsc.com/jsdeferred/doc/intro.en.html] + +;;; Samples: + +;; ** HTTP Access + +;; (require 'url) +;; (deferred:$ +;; (deferred:url-retrieve "http://www.gnu.org") +;; (deferred:nextc it +;; (lambda (buf) +;; (insert (with-current-buffer buf (buffer-string))) +;; (kill-buffer buf)))) + +;; ** Invoking command tasks + +;; (deferred:$ +;; (deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png") +;; (deferred:nextc it +;; (lambda (x) (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg"))) +;; (deferred:nextc it +;; (lambda (x) +;; (insert-image (create-image (expand-file-name "b.jpg") 'jpeg nil))))) + +;; See the readme for further API documentation. + +;; ** Applications + +;; *Inertial scrolling for Emacs +;; [https://github.com/kiwanami/emacs-inertial-scroll] + +;; This program makes simple multi-thread function, using +;; deferred.el. + +(require 'cl-lib) +(require 'subr-x) + +(declare-function pp-display-expression 'pp) + +(defvar deferred:version nil "deferred.el version") +(setq deferred:version "0.5.0") + +;;; Code: + +(defmacro deferred:aand (test &rest rest) + "[internal] Anaphoric AND." + (declare (debug ("test" form &rest form))) + `(let ((it ,test)) + (if it ,(if rest `(deferred:aand ,@rest) 'it)))) + +(defmacro deferred:$ (&rest elements) + "Anaphoric function chain macro for deferred chains." + (declare (debug (&rest form))) + `(let (it) + ,@(cl-loop for i in elements + collect + `(setq it ,i)) + it)) + +(defmacro deferred:lambda (args &rest body) + "Anaphoric lambda macro for self recursion." + (declare (debug ("args" form &rest form))) + (let ((argsyms (cl-loop repeat (length args) collect (cl-gensym)))) + `(lambda (,@argsyms) + (let (self) + (setq self (lambda( ,@args ) ,@body)) + (funcall self ,@argsyms))))) + +(cl-defmacro deferred:try (d &key catch finally) + "Try-catch-finally macro. This macro simulates the +try-catch-finally block asynchronously. CATCH and FINALLY can be +nil. Because of asynchrony, this macro does not ensure that the +task FINALLY should be called." + (let ((chain + (if catch `((deferred:error it ,catch))))) + (when finally + (setq chain (append chain `((deferred:watch it ,finally))))) + `(deferred:$ ,d ,@chain))) + +(defun deferred:setTimeout (f msec) + "[internal] Timer function that emulates the `setTimeout' function in JS." + (run-at-time (/ msec 1000.0) nil f)) + +(defun deferred:cancelTimeout (id) + "[internal] Timer cancellation function that emulates the `cancelTimeout' function in JS." + (cancel-timer id)) + +(defun deferred:run-with-idle-timer (sec f) + "[internal] Wrapper function for run-with-idle-timer." + (run-with-idle-timer sec nil f)) + +(defun deferred:call-lambda (f &optional arg) + "[internal] Call a function with one or zero argument safely. +The lambda function can define with zero and one argument." + (condition-case err + (funcall f arg) + ('wrong-number-of-arguments + (display-warning 'deferred "\ +Callback that takes no argument may be specified. +Passing callback with no argument is deprecated. +Callback must take one argument. +Or, this error is coming from somewhere inside of the callback: %S" err) + (condition-case nil + (funcall f) + ('wrong-number-of-arguments + (signal 'wrong-number-of-arguments (cdr err))))))) ; return the first error + +;; debug + +(eval-and-compile + (defvar deferred:debug nil "Debug output switch.")) +(defvar deferred:debug-count 0 "[internal] Debug output counter.") + +(defmacro deferred:message (&rest args) + "[internal] Debug log function." + (when deferred:debug + `(progn + (with-current-buffer (get-buffer-create "*deferred:debug*") + (save-excursion + (goto-char (point-max)) + (insert (format "%5i %s\n" deferred:debug-count (format ,@args))))) + (cl-incf deferred:debug-count)))) + +(defun deferred:message-mark () + "[internal] Debug log function." + (interactive) + (deferred:message "==================== mark ==== %s" + (format-time-string "%H:%M:%S" (current-time)))) + +(defun deferred:pp (d) + (require 'pp) + (deferred:$ + (deferred:nextc d + (lambda (x) + (pp-display-expression x "*deferred:pp*"))) + (deferred:error it + (lambda (e) + (pp-display-expression e "*deferred:pp*"))) + (deferred:nextc it + (lambda (_x) (pop-to-buffer "*deferred:pp*"))))) + +(defvar deferred:debug-on-signal nil +"If non nil, the value `debug-on-signal' is substituted this +value in the `condition-case' form in deferred +implementations. Then, Emacs debugger can catch an error occurred +in the asynchronous tasks.") + +(defmacro deferred:condition-case (var protected-form &rest handlers) + "[internal] Custom condition-case. See the comment for +`deferred:debug-on-signal'." + (declare (debug condition-case) + (indent 2)) + `(let ((debug-on-signal + (or debug-on-signal deferred:debug-on-signal))) + (condition-case ,var + ,protected-form + ,@handlers))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Back end functions of deferred tasks + +(defvar deferred:tick-time 0.001 + "Waiting time between asynchronous tasks (second). +The shorter waiting time increases the load of Emacs. The end +user can tune this parameter. However, applications should not +modify it because the applications run on various environments.") + +(defvar deferred:queue nil + "[internal] The execution queue of deferred objects. +See the functions `deferred:post-task' and `deferred:worker'.") + +(defmacro deferred:pack (a b c) + `(cons ,a (cons ,b ,c))) + +(defun deferred:schedule-worker () + "[internal] Schedule consuming a deferred task in the execution queue." + (run-at-time deferred:tick-time nil 'deferred:worker)) + +(defun deferred:post-task (d which &optional arg) + "[internal] Add a deferred object to the execution queue +`deferred:queue' and schedule to execute. +D is a deferred object. WHICH is a symbol, `ok' or `ng'. ARG is +an argument value for execution of the deferred task." + (push (deferred:pack d which arg) deferred:queue) + (deferred:message "QUEUE-POST [%s]: %s" + (length deferred:queue) (deferred:pack d which arg)) + (deferred:schedule-worker) + d) + +(defun deferred:clear-queue () + "Clear the execution queue. For test and debugging." + (interactive) + (deferred:message "QUEUE-CLEAR [%s -> 0]" (length deferred:queue)) + (setq deferred:queue nil)) + +(defun deferred:worker () + "[internal] Consume a deferred task. +Mainly this function is called by timer asynchronously." + (when deferred:queue + (let* ((pack (car (last deferred:queue))) + (d (car pack)) + (which (cadr pack)) + (arg (cddr pack)) value) + (setq deferred:queue (nbutlast deferred:queue)) + (condition-case err + (setq value (deferred:exec-task d which arg)) + (error + (deferred:message "ERROR : %s" err) + (message "deferred error : %s" err))) + value))) + +(defun deferred:flush-queue! () + "Call all deferred tasks synchronously. For test and debugging." + (let (value) + (while deferred:queue + (setq value (deferred:worker))) + value)) + +(defun deferred:sync! (d) + "Wait for the given deferred task. For test and debugging. +Error is raised if it is not processed within deferred chain D." + (progn + (let ((last-value 'deferred:undefined*) + uncaught-error) + (deferred:try + (deferred:nextc d + (lambda (x) (setq last-value x))) + :catch + (lambda (err) (setq uncaught-error err))) + (while (and (eq 'deferred:undefined* last-value) + (not uncaught-error)) + (sit-for 0.05) + (sleep-for 0.05)) + (when uncaught-error + (deferred:resignal uncaught-error)) + last-value))) + + + +;; Struct: deferred +;; +;; callback : a callback function (default `deferred:default-callback') +;; errorback : an errorback function (default `deferred:default-errorback') +;; cancel : a canceling function (default `deferred:default-cancel') +;; next : a next chained deferred object (default nil) +;; status : if 'ok or 'ng, this deferred has a result (error) value. (default nil) +;; value : saved value (default nil) +;; +(cl-defstruct deferred + (callback 'deferred:default-callback) + (errorback 'deferred:default-errorback) + (cancel 'deferred:default-cancel) + next status value) + +(defun deferred:default-callback (i) + "[internal] Default callback function." + (identity i)) + +(defun deferred:default-errorback (err) + "[internal] Default errorback function." + (deferred:resignal err)) + +(defun deferred:resignal (err) + "[internal] Safely resignal ERR as an Emacs condition. + +If ERR is a cons (ERROR-SYMBOL . DATA) where ERROR-SYMBOL has an +`error-conditions' property, it is re-signaled unchanged. If ERR +is a string, it is signaled as a generic error using `error'. +Otherwise, ERR is formatted into a string as if by `print' before +raising with `error'." + (cond ((and (listp err) + (symbolp (car err)) + (get (car err) 'error-conditions)) + (signal (car err) (cdr err))) + ((stringp err) + (error "%s" err)) + (t + (error "%S" err)))) + +(defun deferred:default-cancel (d) + "[internal] Default canceling function." + (deferred:message "CANCEL : %s" d) + (setf (deferred-callback d) 'deferred:default-callback) + (setf (deferred-errorback d) 'deferred:default-errorback) + (setf (deferred-next d) nil) + d) + +(defvar deferred:onerror nil + "Default error handler. This value is nil or a function that + have one argument for the error message.") + +(defun deferred:exec-task (d which &optional arg) + "[internal] Executing deferred task. If the deferred object has +next deferred task or the return value is a deferred object, this +function adds the task to the execution queue. +D is a deferred object. WHICH is a symbol, `ok' or `ng'. ARG is +an argument value for execution of the deferred task." + (deferred:message "EXEC : %s / %s / %s" d which arg) + (when (null d) (error "deferred:exec-task was given a nil.")) + (let ((callback (if (eq which 'ok) + (deferred-callback d) + (deferred-errorback d))) + (next-deferred (deferred-next d))) + (cond + (callback + (deferred:condition-case err + (let ((value (deferred:call-lambda callback arg))) + (cond + ((deferred-p value) + (deferred:message "WAIT NEST : %s" value) + (if next-deferred + (deferred:set-next value next-deferred) + value)) + (t + (if next-deferred + (deferred:post-task next-deferred 'ok value) + (setf (deferred-status d) 'ok) + (setf (deferred-value d) value) + value)))) + (error + (cond + (next-deferred + (deferred:post-task next-deferred 'ng err)) + (deferred:onerror + (deferred:call-lambda deferred:onerror err)) + (t + (deferred:message "ERROR : %S" err) + (message "deferred error : %S" err) + (setf (deferred-status d) 'ng) + (setf (deferred-value d) err) + err))))) + (t ; <= (null callback) + (cond + (next-deferred + (deferred:exec-task next-deferred which arg)) + ((eq which 'ok) arg) + (t ; (eq which 'ng) + (deferred:resignal arg))))))) + +(defun deferred:set-next (prev next) + "[internal] Connect deferred objects." + (setf (deferred-next prev) next) + (cond + ((eq 'ok (deferred-status prev)) + (setf (deferred-status prev) nil) + (let ((ret (deferred:exec-task + next 'ok (deferred-value prev)))) + (if (deferred-p ret) ret + next))) + ((eq 'ng (deferred-status prev)) + (setf (deferred-status prev) nil) + (let ((ret (deferred:exec-task next 'ng (deferred-value prev)))) + (if (deferred-p ret) ret + next))) + (t + next))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Basic functions for deferred objects + +(defun deferred:new (&optional callback) + "Create a deferred object." + (if callback + (make-deferred :callback callback) + (make-deferred))) + +(defun deferred:callback (d &optional arg) + "Start deferred chain with a callback message." + (deferred:exec-task d 'ok arg)) + +(defun deferred:errorback (d &optional arg) + "Start deferred chain with an errorback message." + (deferred:exec-task d 'ng arg)) + +(defun deferred:callback-post (d &optional arg) + "Add the deferred object to the execution queue." + (deferred:post-task d 'ok arg)) + +(defun deferred:errorback-post (d &optional arg) + "Add the deferred object to the execution queue." + (deferred:post-task d 'ng arg)) + +(defun deferred:cancel (d) + "Cancel all callbacks and deferred chain in the deferred object." + (deferred:message "CANCEL : %s" d) + (funcall (deferred-cancel d) d) + d) + +(defun deferred:status (d) + "Return a current status of the deferred object. The returned value means following: +`ok': the callback was called and waiting for next deferred. +`ng': the errorback was called and waiting for next deferred. + nil: The neither callback nor errorback was not called." + (deferred-status d)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Basic utility functions + +(defun deferred:succeed (&optional arg) + "Create a synchronous deferred object." + (let ((d (deferred:new))) + (deferred:exec-task d 'ok arg) + d)) + +(defun deferred:fail (&optional arg) + "Create a synchronous deferred object." + (let ((d (deferred:new))) + (deferred:exec-task d 'ng arg) + d)) + +(defun deferred:next (&optional callback arg) + "Create a deferred object and schedule executing. This function +is a short cut of following code: + (deferred:callback-post (deferred:new callback))." + (let ((d (if callback + (make-deferred :callback callback) + (make-deferred)))) + (deferred:callback-post d arg) + d)) + +(defun deferred:nextc (d callback) + "Create a deferred object with OK callback and connect it to the given deferred object." + (let ((nd (make-deferred :callback callback))) + (deferred:set-next d nd))) + +(defun deferred:error (d callback) + "Create a deferred object with errorback and connect it to the given deferred object." + (let ((nd (make-deferred :errorback callback))) + (deferred:set-next d nd))) + +(defun deferred:watch (d callback) + "Create a deferred object with watch task and connect it to the given deferred object. +The watch task CALLBACK can not affect deferred chains with +return values. This function is used in following purposes, +simulation of try-finally block in asynchronous tasks, progress +monitoring of tasks." + (let* ((callback callback) + (normal (lambda (x) (ignore-errors (deferred:call-lambda callback x)) x)) + (err (lambda (e) + (ignore-errors (deferred:call-lambda callback e)) + (deferred:resignal e)))) + (let ((nd (make-deferred :callback normal :errorback err))) + (deferred:set-next d nd)))) + +(defun deferred:wait (msec) + "Return a deferred object scheduled at MSEC millisecond later." + (let ((d (deferred:new)) (start-time (float-time)) timer) + (deferred:message "WAIT : %s" msec) + (setq timer (deferred:setTimeout + (lambda () + (deferred:exec-task d 'ok + (* 1000.0 (- (float-time) start-time))) + nil) msec)) + (setf (deferred-cancel d) + (lambda (x) + (deferred:cancelTimeout timer) + (deferred:default-cancel x))) + d)) + +(defun deferred:wait-idle (msec) + "Return a deferred object which will run when Emacs has been +idle for MSEC millisecond." + (let ((d (deferred:new)) (start-time (float-time)) timer) + (deferred:message "WAIT-IDLE : %s" msec) + (setq timer + (deferred:run-with-idle-timer + (/ msec 1000.0) + (lambda () + (deferred:exec-task d 'ok + (* 1000.0 (- (float-time) start-time))) + nil))) + (setf (deferred-cancel d) + (lambda (x) + (deferred:cancelTimeout timer) + (deferred:default-cancel x))) + d)) + +(defun deferred:call (f &rest args) + "Call the given function asynchronously." + (deferred:next + (lambda (_x) + (apply f args)))) + +(defun deferred:apply (f &optional args) + "Call the given function asynchronously." + (deferred:next + (lambda (_x) + (apply f args)))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Utility functions + +(defun deferred:empty-p (times-or-seq) + "[internal] Return non-nil if TIMES-OR-SEQ is the number zero or nil." + (or (and (numberp times-or-seq) (<= times-or-seq 0)) + (and (sequencep times-or-seq) (= (length times-or-seq) 0)))) + +(defun deferred:loop (times-or-seq func) + "Return a iteration deferred object." + (deferred:message "LOOP : %s" times-or-seq) + (if (deferred:empty-p times-or-seq) (deferred:next) + (let* (items (rd + (cond + ((numberp times-or-seq) + (cl-loop for i from 0 below times-or-seq + with ld = (deferred:next) + do + (push ld items) + (setq ld + (let ((i i)) + (deferred:nextc ld + (lambda (_x) (deferred:call-lambda func i))))) + finally return ld)) + ((sequencep times-or-seq) + (cl-loop for i in (append times-or-seq nil) ; seq->list + with ld = (deferred:next) + do + (push ld items) + (setq ld + (let ((i i)) + (deferred:nextc ld + (lambda (_x) (deferred:call-lambda func i))))) + finally return ld))))) + (setf (deferred-cancel rd) + (lambda (x) (deferred:default-cancel x) + (cl-loop for i in items + do (deferred:cancel i)))) + rd))) + +(defun deferred:trans-multi-args (args self-func list-func main-func) + "[internal] Check the argument values and dispatch to methods." + (cond + ((and (= 1 (length args)) (consp (car args)) (not (functionp (car args)))) + (let ((lst (car args))) + (cond + ((or (null lst) (null (car lst))) + (deferred:next)) + ((deferred:aand lst (car it) (or (functionp it) (deferred-p it))) + ;; a list of deferred objects + (funcall list-func lst)) + ((deferred:aand lst (consp it)) + ;; an alist of deferred objects + (funcall main-func lst)) + (t (error "Wrong argument type. %s" args))))) + (t (funcall self-func args)))) + +(defun deferred:parallel-array-to-alist (lst) + "[internal] Translation array to alist." + (cl-loop for d in lst + for i from 0 below (length lst) + collect (cons i d))) + +(defun deferred:parallel-alist-to-array (alst) + "[internal] Translation alist to array." + (cl-loop for pair in + (sort alst (lambda (x y) + (< (car x) (car y)))) + collect (cdr pair))) + +(defun deferred:parallel-func-to-deferred (alst) + "[internal] Normalization for parallel and earlier arguments." + (cl-loop for pair in alst + for d = (cdr pair) + collect + (progn + (unless (deferred-p d) + (setf (cdr pair) (deferred:next d))) + pair))) + +(defun deferred:parallel-main (alst) + "[internal] Deferred alist implementation for `deferred:parallel'. " + (deferred:message "PARALLEL" ) + (let ((nd (deferred:new)) + (len (length alst)) + values) + (cl-loop for pair in + (deferred:parallel-func-to-deferred alst) + with cd ; current child deferred + do + (let ((name (car pair))) + (setq cd + (deferred:nextc (cdr pair) + (lambda (x) + (push (cons name x) values) + (deferred:message "PARALLEL VALUE [%s/%s] %s" + (length values) len (cons name x)) + (when (= len (length values)) + (deferred:message "PARALLEL COLLECTED") + (deferred:post-task nd 'ok (nreverse values))) + nil))) + (deferred:error cd + (lambda (e) + (push (cons name e) values) + (deferred:message "PARALLEL ERROR [%s/%s] %s" + (length values) len (cons name e)) + (when (= (length values) len) + (deferred:message "PARALLEL COLLECTED") + (deferred:post-task nd 'ok (nreverse values))) + nil)))) + nd)) + +(defun deferred:parallel-list (lst) + "[internal] Deferred list implementation for `deferred:parallel'. " + (deferred:message "PARALLEL" ) + (let* ((pd (deferred:parallel-main (deferred:parallel-array-to-alist lst))) + (rd (deferred:nextc pd 'deferred:parallel-alist-to-array))) + (setf (deferred-cancel rd) + (lambda (x) (deferred:default-cancel x) + (deferred:cancel pd))) + rd)) + +(defun deferred:parallel (&rest args) + "Return a deferred object that calls given deferred objects or +functions in parallel and wait for all callbacks. The following +deferred task will be called with an array of the return +values. ARGS can be a list or an alist of deferred objects or +functions." + (deferred:message "PARALLEL : %s" args) + (deferred:trans-multi-args args + 'deferred:parallel 'deferred:parallel-list 'deferred:parallel-main)) + +(defun deferred:earlier-main (alst) + "[internal] Deferred alist implementation for `deferred:earlier'. " + (deferred:message "EARLIER" ) + (let ((nd (deferred:new)) + (len (length alst)) + value results) + (cl-loop for pair in + (deferred:parallel-func-to-deferred alst) + with cd ; current child deferred + do + (let ((name (car pair))) + (setq cd + (deferred:nextc (cdr pair) + (lambda (x) + (push (cons name x) results) + (cond + ((null value) + (setq value (cons name x)) + (deferred:message "EARLIER VALUE %s" (cons name value)) + (deferred:post-task nd 'ok value)) + (t + (deferred:message "EARLIER MISS [%s/%s] %s" (length results) len (cons name value)) + (when (eql (length results) len) + (deferred:message "EARLIER COLLECTED")))) + nil))) + (deferred:error cd + (lambda (e) + (push (cons name e) results) + (deferred:message "EARLIER ERROR [%s/%s] %s" (length results) len (cons name e)) + (when (and (eql (length results) len) (null value)) + (deferred:message "EARLIER FAILED") + (deferred:post-task nd 'ok nil)) + nil)))) + nd)) + +(defun deferred:earlier-list (lst) + "[internal] Deferred list implementation for `deferred:earlier'. " + (deferred:message "EARLIER" ) + (let* ((pd (deferred:earlier-main (deferred:parallel-array-to-alist lst))) + (rd (deferred:nextc pd (lambda (x) (cdr x))))) + (setf (deferred-cancel rd) + (lambda (x) (deferred:default-cancel x) + (deferred:cancel pd))) + rd)) + + +(defun deferred:earlier (&rest args) + "Return a deferred object that calls given deferred objects or +functions in parallel and wait for the first callback. The +following deferred task will be called with the first return +value. ARGS can be a list or an alist of deferred objects or +functions." + (deferred:message "EARLIER : %s" args) + (deferred:trans-multi-args args + 'deferred:earlier 'deferred:earlier-list 'deferred:earlier-main)) + +(defmacro deferred:timeout (timeout-msec timeout-form d) + "Time out macro on a deferred task D. If the deferred task D +does not complete within TIMEOUT-MSEC, this macro cancels the +deferred task and return the TIMEOUT-FORM." + `(deferred:earlier + (deferred:nextc (deferred:wait ,timeout-msec) + (lambda (x) ,timeout-form)) + ,d)) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Application functions + +(defvar deferred:uid 0 "[internal] Sequence number for some utilities. See the function `deferred:uid'.") + +(defun deferred:uid () + "[internal] Generate a sequence number." + (cl-incf deferred:uid)) + +(defun deferred:buffer-string (strformat buf) + "[internal] Return a string in the buffer with the given format." + (format strformat + (with-current-buffer buf (buffer-string)))) + +(defun deferred:process (command &rest args) + "A deferred wrapper of `start-process'. Return a deferred +object. The process name and buffer name of the argument of the +`start-process' are generated by this function automatically. +The next deferred object receives stdout and stderr string from +the command process." + (deferred:process-gen 'start-process command args)) + +(defun deferred:process-shell (command &rest args) + "A deferred wrapper of `start-process-shell-command'. Return a deferred +object. The process name and buffer name of the argument of the +`start-process-shell-command' are generated by this function automatically. +The next deferred object receives stdout and stderr string from +the command process." + (deferred:process-gen 'start-process-shell-command command args)) + +(defun deferred:process-buffer (command &rest args) + "A deferred wrapper of `start-process'. Return a deferred +object. The process name and buffer name of the argument of the +`start-process' are generated by this function automatically. +The next deferred object receives stdout and stderr buffer from +the command process." + (deferred:process-buffer-gen 'start-process command args)) + +(defun deferred:process-shell-buffer (command &rest args) + "A deferred wrapper of `start-process-shell-command'. Return a deferred +object. The process name and buffer name of the argument of the +`start-process-shell-command' are generated by this function automatically. +The next deferred object receives stdout and stderr buffer from +the command process." + (deferred:process-buffer-gen 'start-process-shell-command command args)) + +(defun deferred:process-gen (f command args) + "[internal]" + (let ((pd (deferred:process-buffer-gen f command args)) d) + (setq d (deferred:nextc pd + (lambda (buf) + (prog1 + (with-current-buffer buf (buffer-string)) + (kill-buffer buf))))) + (setf (deferred-cancel d) + (lambda (_x) + (deferred:default-cancel d) + (deferred:default-cancel pd))) + d)) + +(defun deferred:process-buffer-gen (f command args) + "[internal]" + (let ((d (deferred:next)) (uid (deferred:uid))) + (let ((proc-name (format "*deferred:*%s*:%s" command uid)) + (buf-name (format " *deferred:*%s*:%s" command uid)) + (pwd default-directory) + (env process-environment) + (con-type process-connection-type) + (nd (deferred:new)) proc-buf proc) + (deferred:nextc d + (lambda (_x) + (setq proc-buf (get-buffer-create buf-name)) + (condition-case err + (let ((default-directory pwd) + (process-environment env) + (process-connection-type con-type)) + (setq proc + (if (null (car args)) + (apply f proc-name buf-name command nil) + (apply f proc-name buf-name command args))) + (set-process-sentinel + proc + (lambda (proc event) + (unless (process-live-p proc) + (if (zerop (process-exit-status proc)) + (deferred:post-task nd 'ok proc-buf) + (let ((msg (format "Deferred process exited abnormally:\n command: %s\n exit status: %s %s\n event: %s\n buffer contents: %S" + command + (process-status proc) + (process-exit-status proc) + (string-trim-right event) + (if (buffer-live-p proc-buf) + (with-current-buffer proc-buf + (buffer-string)) + "(unavailable)")))) + (kill-buffer proc-buf) + (deferred:post-task nd 'ng msg)))))) + (setf (deferred-cancel nd) + (lambda (x) (deferred:default-cancel x) + (when proc + (kill-process proc) + (kill-buffer proc-buf))))) + (error (deferred:post-task nd 'ng err))) + nil)) + nd))) + +(defmacro deferred:processc (d command &rest args) + "Process chain of `deferred:process'." + `(deferred:nextc ,d + (lambda (,(cl-gensym)) (deferred:process ,command ,@args)))) + +(defmacro deferred:process-bufferc (d command &rest args) + "Process chain of `deferred:process-buffer'." + `(deferred:nextc ,d + (lambda (,(cl-gensym)) (deferred:process-buffer ,command ,@args)))) + +(defmacro deferred:process-shellc (d command &rest args) + "Process chain of `deferred:process'." + `(deferred:nextc ,d + (lambda (,(cl-gensym)) (deferred:process-shell ,command ,@args)))) + +(defmacro deferred:process-shell-bufferc (d command &rest args) + "Process chain of `deferred:process-buffer'." + `(deferred:nextc ,d + (lambda (,(cl-gensym)) (deferred:process-shell-buffer ,command ,@args)))) + +;; Special variables defined in url-vars.el. +(defvar url-request-data) +(defvar url-request-method) +(defvar url-request-extra-headers) + +(declare-function url-http-symbol-value-in-buffer "url-http" + (symbol buffer &optional unbound-value)) + +(declare-function deferred:url-param-serialize "request" (params)) + +(declare-function deferred:url-escape "request" (val)) + +(eval-after-load "url" + ;; for url package + ;; TODO: proxy, charaset + ;; List of gloabl variables to preserve and restore before url-retrieve call + '(let ((url-global-variables '(url-request-data + url-request-method + url-request-extra-headers))) + + (defun deferred:url-retrieve (url &optional cbargs silent inhibit-cookies) + "A wrapper function for url-retrieve. The next deferred +object receives the buffer object that URL will load +into. Values of dynamically bound 'url-request-data', 'url-request-method' and +'url-request-extra-headers' are passed to url-retrieve call." + (let ((nd (deferred:new)) + buf + (local-values (mapcar (lambda (symbol) (symbol-value symbol)) url-global-variables))) + (deferred:next + (lambda (_x) + (cl-progv url-global-variables local-values + (condition-case err + (setq buf + (url-retrieve + url (lambda (_xx) (deferred:post-task nd 'ok buf)) + cbargs silent inhibit-cookies)) + (error (deferred:post-task nd 'ng err))) + nil))) + (setf (deferred-cancel nd) + (lambda (_x) + (when (buffer-live-p buf) + (kill-buffer buf)))) + nd)) + + (defun deferred:url-delete-header (buf) + (with-current-buffer buf + (let ((pos (url-http-symbol-value-in-buffer + 'url-http-end-of-headers buf))) + (when pos + (delete-region (point-min) (1+ pos))))) + buf) + + (defun deferred:url-delete-buffer (buf) + (when (and buf (buffer-live-p buf)) + (kill-buffer buf)) + nil) + + (defun deferred:url-get (url &optional params &rest args) + "Perform a HTTP GET method with `url-retrieve'. PARAMS is +a parameter list of (key . value) or key. ARGS will be appended +to deferred:url-retrieve args list. The next deferred +object receives the buffer object that URL will load into." + (when params + (setq url + (concat url "?" (deferred:url-param-serialize params)))) + (let ((d (deferred:$ + (apply 'deferred:url-retrieve url args) + (deferred:nextc it 'deferred:url-delete-header)))) + (deferred:set-next + d (deferred:new 'deferred:url-delete-buffer)) + d)) + + (defun deferred:url-post (url &optional params &rest args) + "Perform a HTTP POST method with `url-retrieve'. PARAMS is +a parameter list of (key . value) or key. ARGS will be appended +to deferred:url-retrieve args list. The next deferred +object receives the buffer object that URL will load into." + (let ((url-request-method "POST") + (url-request-extra-headers + (append url-request-extra-headers + '(("Content-Type" . "application/x-www-form-urlencoded")))) + (url-request-data (deferred:url-param-serialize params))) + (let ((d (deferred:$ + (apply 'deferred:url-retrieve url args) + (deferred:nextc it 'deferred:url-delete-header)))) + (deferred:set-next + d (deferred:new 'deferred:url-delete-buffer)) + d))) + + (defun deferred:url-escape (val) + "[internal] Return a new string that is VAL URI-encoded." + (unless (stringp val) + (setq val (format "%s" val))) + (url-hexify-string + (encode-coding-string val 'utf-8))) + + (defun deferred:url-param-serialize (params) + "[internal] Serialize a list of (key . value) cons cells +into a query string." + (when params + (mapconcat + 'identity + (cl-loop for p in params + collect + (cond + ((consp p) + (concat + (deferred:url-escape (car p)) "=" + (deferred:url-escape (cdr p)))) + (t + (deferred:url-escape p)))) + "&"))) + )) + + +(provide 'deferred) +;;; deferred.el ends here diff --git a/.config/doom/custom-packages/ox-slack.el b/.config/doom/custom-packages/ox-slack.el new file mode 100644 index 00000000..7f930277 --- /dev/null +++ b/.config/doom/custom-packages/ox-slack.el @@ -0,0 +1,366 @@ +;;; ox-slack.el --- Slack Exporter for org-mode -*- lexical-binding: t; -*- + + +;; Copyright (C) 2018 Matt Price + +;; Author: Matt Price +;; Keywords: org, slack, outlines +;; Package-Version: 0.1.1 +;; Package-Requires: ((emacs "24") (org "9.1.4") (ox-gfm "1.0")) +;; URL: https://github.com/titaniumbones/ox-slack + +;; This file is not part of GNU Emacs. + +;; 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 . + +;;; Commentary: + +;; This library implements a Slack backend for the Org +;; exporter, based on the `md' and `gfm' back-ends. + +;;; Code: + +(require 'ox-gfm) + +(org-export-define-derived-backend 'slack 'gfm + ;; for now, I just have this commented out + ;; might be better to create a defcustom to + ;; decide whether to add this to the export dispatcher + ;; :menu-entry + ;; '(?s "Export to Slack syntax" + ;; ((?s "To temporary buffer" + ;; (lambda (a s v b) (org-slack-export-as-slack a s v))) + ;; (?S "To file" (lambda (a s v b) (org-slack-export-to-slack a s v))) + ;; (?o "To file and open" + ;; (lambda (a s v b) + ;; (if a (org-slack-export-to-slack t s v) + ;; (org-open-file (org-slack-export-to-slack nil s v))))))) + :translate-alist + '( + (bold . org-slack-bold) + (code . org-slack-code) + (headline . org-slack-headline) + (inner-template . org-slack-inner-template) + (italic . org-slack-italic) + (link . org-slack-link) + (plain-text . org-slack-plain-text) + (src-block . org-slack-src-block) + (strike-through . org-slack-strike-through) + (timestamp . org-slack-timestamp))) + +;; timestamp +(defun org-slack-timestamp (timestamp contents info) + "Transcode TIMESTAMP element into Slack format. +CONTENTS is the timestamp contents. INFO is a plist used as a +ocmmunications channel." + (org-html-plain-text (org-timestamp-translate timestamp) info)) + +;; headline +(defun org-slack-headline (headline contents info) + "Transcode HEADLINE element into Markdown format. +CONTENTS is the headline contents. INFO is a plist used as +a communication channel." + (unless (org-element-property :footnote-section-p headline) + (let* ((level (org-export-get-relative-level headline info)) + (title (org-export-data (org-element-property :title headline) info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword + headline))) + (and todo (concat (org-export-data todo info) " "))))) + (tags (and (plist-get info :with-tags) + (let ((tag-list (org-export-get-tags headline info))) + (and tag-list + (concat " " (org-make-tag-string tag-list)))))) + (priority + (and (plist-get info :with-priority) + (let ((char (org-element-property :priority headline))) + (and char (format "[#%c] " char))))) + ;; Headline text without tags. + (heading (concat todo priority title))) + (format "*%s*\n\n%s" title contents) + ))) + +;; link +(defun org-slack-link (link contents info) + "Transcode LINK object into Markdown format. + CONTENTS is the link's description. INFO is a plist used as + a communication channel." + (let ((link-org-files-as-md + (lambda (raw-path) + ;; Treat links to `file.org' as links to `file.md'. + (if (string= ".org" (downcase (file-name-extension raw-path "."))) + (concat (file-name-sans-extension raw-path) ".md") + raw-path))) + (type (org-element-property :type link))) + (cond + ;; Link type is handled by a special function. + ((org-export-custom-protocol-maybe link contents 'md)) + ((member type '("custom-id" "id" "fuzzy")) + (let ((destination (if (string= type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (pcase (org-element-type destination) + (`plain-text ; External file. + (let ((path (funcall link-org-files-as-md destination))) + (if (not contents) (format "%s>" path) + (format "[%s](%s)" contents path)))) + (`headline + (format + ;; "[%s](#%s)" + "[%s]" + ;; Description. + (cond ((org-string-nw-p contents)) + ((org-export-numbered-headline-p destination info) + (mapconcat #'number-to-string + (org-export-get-headline-number destination info) + ".")) + (t (org-export-data (org-element-property :title destination) + info))) + ;; Reference. + ;; (or (org-element-property :CUSTOM_ID destination) + ;; (org-export-get-reference destination info)) + )) + (_ + (let ((description + (or (org-string-nw-p contents) + (let ((number (org-export-get-ordinal destination info))) + (cond + ((not number) nil) + ((atom number) (number-to-string number)) + (t (mapconcat #'number-to-string number "."))))))) + (when description + (format "[%s]" + description + ;; (org-export-get-reference destination info) + ))))))) + ((org-export-inline-image-p link org-html-inline-image-rules) + (let ((path (let ((raw-path (org-element-property :path link))) + (cond ((not (equal "file" type)) (concat type ":" raw-path)) + ((not (file-name-absolute-p raw-path)) raw-path) + (t (expand-file-name raw-path))))) + (caption (org-export-data + (org-export-get-caption + (org-export-get-parent-element link)) info))) + (format "![img](%s)" + (if (not (org-string-nw-p caption)) path + (format "%s \"%s\"" path caption))))) + ((string= type "coderef") + (let ((ref (org-element-property :path link))) + (format (org-export-get-coderef-format ref contents) + (org-export-resolve-coderef ref info)))) + ((equal type "radio") contents) + (t (let* ((raw-path (org-element-property :path link)) + (path + (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((string= type "file") + (org-export-file-uri (funcall link-org-files-as-md raw-path))) + (t raw-path)))) + (if (not contents) (format "%s" path) + (format "[%s](%s)" contents path))))))) + +(defun org-slack-verbatim (_verbatim contents _info) + "Transcode VERBATIM from Org to Slack. + CONTENTS is the text with bold markup. INFO is a plist holding + contextual information." + (format "`%s`" contents)) + +(defun org-slack-code (code _contents info) + "Return a CODE object from Org to SLACK. + CONTENTS is nil. INFO is a plist holding contextual + information." + (format "`%s`" + (org-element-property :value code))) + + ;;;; Italic + +(defun org-slack-italic (_italic contents _info) + "Transcode italic from Org to SLACK. + CONTENTS is the text with italic markup. INFO is a plist holding + contextual information." + (format "_%s_" contents)) + + ;;; Bold +(defun org-slack-bold (_bold contents _info) + "Transcode bold from Org to SLACK. + CONTENTS is the text with bold markup. INFO is a plist holding + contextual information." + (format "*%s*" contents)) + + +;;;; Strike-through +(defun org-slack-strike-through (_strike-through contents _info) + "Transcode STRIKE-THROUGH from Org to SLACK. + CONTENTS is text with strike-through markup. INFO is a plist + holding contextual information." + (format "~%s~" contents)) + + +(defun org-slack-inline-src-block (inline-src-block _contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to SLACK. + CONTENTS holds the contents of the item. INFO is a plist holding + contextual information." + (format "`%s`" + (org-element-property :value inline-src-block))) + +;;;; Src Block +(defun org-slack-src-block (src-block contents info) + "Transcode SRC-BLOCK element into Github Flavored Markdown format. + CONTENTS is nil. INFO is a plist used as a communication + channel." + (let* ((lang (org-element-property :language src-block)) + (code (org-export-format-code-default src-block info)) + (prefix (concat "```" "\n")) + (suffix "```")) + (concat prefix code suffix))) + +;;;; Quote Block +(defun org-slack-quote-block (_quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to SLACK. + CONTENTS holds the contents of the block. INFO is a plist + holding contextual information." + (org-slack--indent-string contents (plist-get info :slack-quote-margin))) + + +(defun org-slack-inner-template (contents info) + "Return body of document after converting it to Markdown syntax. + CONTENTS is the transcoded contents string. INFO is a plist + holding export options." + ;; Make sure CONTENTS is separated from table of contents and + ;; footnotes with at least a blank line. + (concat + ;; Table of contents. + ;; (let ((depth (plist-get info :with-toc))) + ;; (when depth + ;; (concat (org-md--build-toc info (and (wholenump depth) depth)) "\n"))) + ;; Document contents. + contents + "\n" + ;; Footnotes section. + (org-md--footnote-section info))) + +;;;; Plain text +(defun org-slack-plain-text (text info) + "Transcode a TEXT string into Markdown format. + TEXT is the string to transcode. INFO is a plist holding + contextual information." + ;; (when (plist-get info :with-smart-quotes) + ;; (setq text (org-export-activate-smart-quotes text :html info))) + ;; The below series of replacements in `text' is order sensitive. + ;; Protect `, *, _, and \ + ;; (setq text (replace-regexp-in-string "[`*_\\]" "\\\\\\&" text)) + ;; Protect ambiguous #. This will protect # at the beginning of + ;; a line, but not at the beginning of a paragraph. See + ;; `org-md-paragraph'. + (setq text (replace-regexp-in-string "\n#" "\n\\\\#" text)) + ;; Protect ambiguous ! + (setq text (replace-regexp-in-string "\\(!\\)\\[" "\\\\!" text nil nil 1)) + ;; ;; Handle special strings, if required. + ;; (when (plist-get info :with-special-strings) + ;; (setq text (org-html-convert-special-strings text))) + ;; Handle break preservation, if required. + (when (plist-get info :preserve-breaks) + (setq text (replace-regexp-in-string "[ \t]*\n" " \n" text))) + ;; Return value. + text) + +;;; End-user functions + +;;;###autoload +(defun org-slack-export-as-slack + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a text buffer. + + If narrowing is active in the current buffer, only export its + narrowed part. + + If a region is active, export that region. + + A non-nil optional argument ASYNC means the process should happen + asynchronously. The resulting buffer should be accessible + through the `org-export-stack' interface. + + When optional argument SUBTREEP is non-nil, export the sub-tree + at point, extracting information from the headline properties + first. + + When optional argument VISIBLE-ONLY is non-nil, don't export + contents of hidden elements. + + When optional argument BODY-ONLY is non-nil, strip title and + table of contents from output. + + EXT-PLIST, when provided, is a property list with external + parameters overriding Org default settings, but still inferior to + file-local settings. + + Export is done in a buffer named \"*Org SLACK Export*\", which + will be displayed when `org-export-show-temporary-export-buffer' + is non-nil." + (interactive) + (org-export-to-buffer 'slack "*Org SLACK Export*" + async subtreep visible-only body-only ext-plist (lambda () (text-mode)))) + +;;;###autoload +(defun org-slack-export-to-slack + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a text file. + + If narrowing is active in the current buffer, only export its + narrowed part. + + If a region is active, export that region. + + A non-nil optional argument ASYNC means the process should happen + asynchronously. The resulting file should be accessible through + the `org-export-stack' interface. + + When optional argument SUBTREEP is non-nil, export the sub-tree + at point, extracting information from the headline properties + first. + + When optional argument VISIBLE-ONLY is non-nil, don't export + contents of hidden elements. + + When optional argument BODY-ONLY is non-nil, strip title and + table of contents from output. + + EXT-PLIST, when provided, is a property list with external + parameters overriding Org default settings, but still inferior to + file-local settings. + + Return output file's name." + (interactive) + (let ((file (org-export-output-file-name ".txt" subtreep))) + (org-export-to-file 'slack file + async subtreep visible-only body-only ext-plist))) + +;;;###autoload +(defun org-slack-export-to-clipboard-as-slack () + "Export region to slack, and copy to the kill ring for pasting into other programs." + (interactive) + (let* ((org-export-with-toc nil) + (org-export-with-smart-quotes nil)) + (kill-new (org-export-as 'slack) )) + ) + +;; (org-export-register-backend 'slack) +(provide 'ox-slack) + +;; Local variables: +;; coding: utf-8 +;; End: + +;;; ox-slack.el ends here diff --git a/.config/doom/custom-packages/screenshot.el b/.config/doom/custom-packages/screenshot.el new file mode 100644 index 00000000..f16f0247 --- /dev/null +++ b/.config/doom/custom-packages/screenshot.el @@ -0,0 +1,460 @@ +;;; screenshot.el --- Swiftly grab images of your code -*- lexical-binding: t -*- + +;; Copyright (C) 2020 TEC + +;; Author: TEC +;; Maintainer: TEC +;; Homepage: https://github.com/tecosaur/screenshot +;; Version: 0.1.0 +;; Keywords: convenience, screenshot +;; Package-Requires: ((emacs "27") (transient "0.2.0") (posframe "0.8.3")) + +;; This file is not part of GNU Emacs. + +;;; License: + +;; 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, 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; Convenience package for creating images of the current region or buffer. +;; Requires `imagemagick' for some visual post-processing, and `xclip' for +;; copying images to the clipboard. + +;;; Code: + +(require 'transient) +(require 'posframe) + +(defgroup screenshot () + "Customise group for Screenshot." + :group 'convenience) + +(defvar screenshot--buffer nil + "The buffer last used to create a screenshot.") + +(defcustom screenshot-buffer-creation-hook nil + "Hook run after creating a buffer for screenshots. +Run after hardcoded setup, but before the screenshot is captured." + :type 'hook + :group 'screenshot) + +(defvar screenshot--region-beginning nil + "Start of the region forming the screenshot.") +(defvar screenshot--region-end nil + "End of the region forming the screenshot.") + +(defvar screenshot--tmp-file nil + "An intermediate target file for the screenshot.") + +(defvar screenshot--first-line-number nil + "The first line contained in the screenshot.") + +(defvar screenshot--total-lines nil + "The total number of lines contained in the screenshot.") + +;;; Generated variables + +;;; Screenshot parameters + +(eval-when-compile + (defmacro screenshot--define-infix (key name description type default + &rest reader) + "Define infix with KEY, NAME, DESCRIPTION, TYPE, DEFAULT and READER as arguments." + `(progn + (defcustom ,(intern (concat "screenshot-" name)) ,default + ,description + :type ,type + :group 'screenshot) + (transient-define-infix ,(intern (concat "screenshot--set-" name)) () + "Set `screenshot--theme' from a popup buffer." + :class 'transient-lisp-variable + :variable ',(intern (concat "screenshot-" name)) + :key ,key + :description ,description + :argument ,(concat "--" name) + :reader (lambda (&rest _) ,@reader)))) + + (screenshot--define-infix + "-l" "line-numbers-p" "Show line numbers" + 'boolean nil + (not screenshot-line-numbers-p)) + + (screenshot--define-infix + "-L" "relative-line-numbers-p" "Relative line numbers within the screenshot" + 'boolean nil + (not screenshot-relative-line-numbers-p)) + + (screenshot--define-infix + "-t" "text-only-p" "Use a text-only version of the buffer" + 'boolean nil + (not screenshot-text-only-p)) + + (screenshot--define-infix + "-T" "truncate-lines-p" "Truncate lines beyond the screenshot width" + 'boolean nil + (not screenshot-truncate-lines-p)) + + (declare-function counsel-fonts "ext:counsel-fonts") + + (declare-function ivy-read "ext:ivy-read") + + (screenshot--define-infix + "-ff" "font-family" "Font family to use" + 'string (let ((font (face-attribute 'default :font))) + (if (eq font 'unspecified) "monospace" + (symbol-name (font-get font :family)))) + (if (fboundp #'counsel-fonts) + (ivy-read "Font: " (delete-dups (font-family-list)) + :preselect screenshot-font-family + :require-match t + :history 'counsel-fonts-history + :caller 'counsel-fonts) + (completing-read "Font: " (delete-dups (font-family-list))))) + + (screenshot--define-infix + "-fs" "font-size" "Font size (pt)" + 'number 14 + (read-number "Font size in pt: " screenshot-font-size)) + +;;;; Frame + + (screenshot--define-infix + "-b" "border-width" "Border width in pixels" + 'integer 20 + (read-number "Border width in px: " screenshot-border-width)) + + (screenshot--define-infix + "-r" "radius" "Rounded corner radius" + 'integer 10 + (read-number "Border radius in px: " screenshot-radius)) + + (screenshot--define-infix + "-w" "min-width" "Minimum width, in columns" + 'integer 40 + (read-number "Minimum width (columns): " screenshot-min-width)) + + (screenshot--define-infix + "-W" "max-width" "Maximum width, in columns" + 'integer 120 + (read-number "Maximum width (columns): " screenshot-max-width)) + +;;;; Shadow + + (screenshot--define-infix + "-s" "shadow-radius" "Radius of the shadow in pixels" + 'integer 12 + (read-number "Shadow width in px: " screenshot-shadow-radius)) + + (screenshot--define-infix + "-i" "shadow-intensity" "Intensity of the shadow" + 'integer 80 + (read-number "Shadow intensity: " screenshot-shadow-intensity)) + + (screenshot--define-infix + "-c" "shadow-color" "Color of the shadow" + 'color "#333" + (read-string "Shadow color: " screenshot-shadow-color)) + + (screenshot--define-infix + "-x" "shadow-offset-horizontal" "Shadow horizontal offset" + 'integer -8 + (read-number "Shadow horizontal offset in px: " screenshot-shadow-offset-horizontal)) + + (screenshot--define-infix + "-y" "shadow-offset-vertical" "Shadow vertical offset" + 'integer 5 + (read-number "Shadow vertical offset in px: " screenshot-shadow-offset-vertical))) + +;;; Main function + +;;;###autoload +(defun screenshot (beg end &optional upload-text) + "Take a screenshot of the current region or buffer. + +Region included in screenshot is the active selection, interactively, +or given by BEG and END. Buffer is used if region spans 0-1 characters. + +When a universal argument is given, UPLOAD-TEXT is non-nil. +Then the text of the region/buffer is uploaded, and the URL is copied to clipboard." + (interactive (if (region-active-p) + (list (region-beginning) (region-end) (when current-prefix-arg t)) + (list (point-min) (point-max) (when current-prefix-arg t)))) + + (if upload-text + (screenshot-text-upload beg end) + (deactivate-mark) + (screenshot--set-screenshot-region beg end) + (setq screenshot--tmp-file + (make-temp-file "screenshot-" nil ".png")) + (call-interactively #'screenshot-transient))) + +(defvar screenshot-text-upload-function #'screenshot-ixio-upload + "Function to use to upload text. + +Must take a start and end position for the current buffer, and +return a URL.") + +(defun screenshot-text-upload (beg end) + "Upload the region from BEG to END, and copy the upload URL to the clipboard." + (message "Uploading text...") + (let ((url + (funcall screenshot-text-upload-function beg end))) + (gui-select-text url) + (message "Screenshot uploaded, link copied to clipboard (%s)" url))) + +(defun screenshot-ixio-upload (beg end) + "Upload the region from BEG to END to ix.io, and return the URL." + (let ((output (generate-new-buffer "ixio")) url) + (shell-command-on-region beg end + (format "curl -F 'ext:1=%s' -F 'f:1=<-' ix.io 2>/dev/null" + (file-name-extension (or (buffer-file-name) " .txt"))) + output) + (setq url (string-trim-right (with-current-buffer output (buffer-string)))) + (kill-buffer output) + url)) + +;;; Screenshot capturing + +(defun screenshot--set-screenshot-region (beg end) + "Use the region from BEG to END to determine the relevant region to capture. +Also records useful information like the total number of lines contained, +and the line number of the first line of the region." + (when (or (= beg end) (= (1+ beg) end)) + (setq beg (point-min) + end (point-max))) + (save-excursion + (goto-char beg) + (when (string-match-p "\\`\\s-*$" (thing-at-point 'line)) + (forward-line 1) + (setq beg (line-beginning-position))) + (back-to-indentation) + (when (= beg (point)) + (setq beg (line-beginning-position))) + (goto-char end) + (when (string-match-p "\\`\\s-*$" (thing-at-point 'line)) + (forward-line -1) + (setq end (line-end-position)))) + (setq screenshot--region-beginning beg + screenshot--region-end end + screenshot--first-line-number (line-number-at-pos beg) + screenshot--total-lines (- (line-number-at-pos end) (line-number-at-pos beg) -1))) + +(defun screenshot--setup-buffer () + "Modify the current buffer to make it appropriate for screenshotting." + (setq-local face-remapping-alist '((line-number-current-line line-number) + (show-paren-match nil) + (region nil)) + line-spacing 0.1) + (when (bound-and-true-p hl-line-mode) (hl-line-mode -1)) + (when (bound-and-true-p solaire-mode) (solaire-mode -1)) + (run-hooks 'screenshot-buffer-creation-hook)) + +(defvar screenshot--text-only-buffer + (with-current-buffer (generate-new-buffer " *screenshot") + (screenshot--setup-buffer) + (when prettify-symbols-mode + (prettify-symbols-mode -1)) + (current-buffer)) + "A text-only buffer for use in creating screenshots.") + +(defun screenshot--format-text-only-buffer (beg end) + "Insert text from BEG to END in the current buffer, into the screenshot text-only buffer." + ;; include indentation if `beg' is where indentation starts + (let ((s (string-trim-right (buffer-substring beg end)))) + (with-current-buffer (setq screenshot--buffer screenshot--text-only-buffer) + (buffer-face-set :family screenshot-font-family + :height (* 10 screenshot-font-size)) + (erase-buffer) + (insert s) + (indent-rigidly (point-min) (point-max) + (- (indent-rigidly--current-indentation + (point-min) (point-max)))) + (current-buffer)))) + +(defun screenshot--narrowed-clone-buffer (beg end) + "Create a clone of the current buffer, narrowed to the region from BEG to END. +This buffer then then set up to be used for a screenshot." + (with-current-buffer (clone-indirect-buffer " *screenshot-clone" nil t) + (narrow-to-region beg end) + (screenshot--setup-buffer) + (buffer-face-set :family screenshot-font-family + :height (* 10 screenshot-font-size)) + (current-buffer))) + +;;; Screenshot processing + +(defun screenshot--process () + "Perform the screenshot process. + +Create a buffer for the screenshot, use `x-export-frames' to create the image, +and process it." + (setq screenshot--buffer + (if screenshot-text-only-p + (screenshot--format-text-only-buffer screenshot--region-beginning screenshot--region-end) + (screenshot--narrowed-clone-buffer screenshot--region-beginning screenshot--region-end))) + + (let ((frame (posframe-show + screenshot--buffer + :position (point-min) + :internal-border-width screenshot-border-width + :min-width screenshot-min-width + :width screenshot-max-width + :min-height screenshot--total-lines + :lines-truncate screenshot-truncate-lines-p + :poshandler #'posframe-poshandler-point-bottom-left-corner + :hidehandler #'posframe-hide))) + (with-current-buffer screenshot--buffer + (setq-local display-line-numbers screenshot-line-numbers-p) + (when screenshot-text-only-p + (setq-local display-line-numbers-offset + (if screenshot-relative-line-numbers-p + 0 (1- screenshot--first-line-number)))) + (font-lock-ensure (point-min) (point-max)) + (redraw-frame frame) + (with-temp-file screenshot--tmp-file + (insert (x-export-frames frame 'png)))) + (posframe-hide screenshot--buffer)) + (unless screenshot-text-only-p + (kill-buffer screenshot--buffer)) + (screenshot--post-process screenshot--tmp-file)) + +(defcustom screenshot-post-process-hook + (when (executable-find "pngquant") + (list (defun screenshot--compress-file (file) + (call-process "pngquant" nil nil nil "-f" "-o" file file)))) + "Functions to be called on the output file after processing. +Must take a single argument, the file name, and operate in-place." + :type 'function + :group 'screenshot) + +(defun screenshot--post-process (file) + "Apply any image post-processing to FILE." + (when (or (> screenshot-radius 0) + (> screenshot-shadow-radius 0)) + (let ((result + (shell-command-to-string + (format "convert '%1$s' \\( +clone -alpha extract \\ +\\( -size %2$dx%2$d xc:black -draw 'fill white circle %2$d,%2$d %2$d,0' -write mpr:arc +delete \\) \\ +\\( mpr:arc \\) -gravity northwest -composite \\ +\\( mpr:arc -flip \\) -gravity southwest -composite \\ +\\( mpr:arc -flop \\) -gravity northeast -composite \\ +\\( mpr:arc -rotate 180 \\) -gravity southeast -composite \\) \\ +-alpha off -compose CopyOpacity -composite -compose over \\ +\\( +clone -background '%3$s' -shadow %4$dx%5$d+%6$d+%7$d \\) \\ ++swap -background none -layers merge '%1$s'" + file + screenshot-radius + screenshot-shadow-color + screenshot-shadow-intensity + screenshot-shadow-radius + screenshot-shadow-offset-horizontal + screenshot-shadow-offset-vertical)))) + (unless (string= result "") + (error "Could not apply imagemagick commands to image:\n%s" result)))) + (run-hook-with-args 'screenshot-post-process-hook file)) + +;;; Screenshot actions + +(eval-when-compile + (defmacro screenshot--def-action (name &rest body) + "Define action NAME to be performed from the transient interface. +BODY is executed after `screenshot-process' is called." + `(defun ,(intern (concat "screenshot-" name)) (&optional _args) + "Screenshot action to be performed from the transient interface." + (interactive + (list (transient-args 'screenshot-transient))) + (screenshot--process) + ,@body)) + + (screenshot--def-action + "save" + (rename-file + screenshot--tmp-file + (concat (file-name-sans-extension + (or (buffer-file-name) + (expand-file-name "screenshot"))) + ".png") + t) + (message "Screenshot saved")) + + (screenshot--def-action + "save-as" + (rename-file + screenshot--tmp-file + (read-file-name "Save as: " (file-name-directory (or (buffer-file-name) default-directory))) + 1) + (message "Screenshot saved")) + + (screenshot--def-action + "copy" + (call-process "xclip" nil nil nil + "-selection" "clipboard" + "-target" "image/png" + "-in" screenshot--tmp-file) + (delete-file screenshot--tmp-file) + (message "Screenshot copied")) + + (defcustom screenshot-upload-fn nil + "Function or string which provides a method to upload a file. +If a function, it must take a filename and returns a URL to it. +If a string, it is formatted with the file name, and run as a shell command. + +Note: you have to define this yourself, there is no default." + :type '(choice function string) + :group 'screenshot) + + (screenshot--def-action + "upload" + (if (not screenshot-upload-fn) + (error "No upload function defined") + (message "Uploading...") + (let ((url + (pcase screenshot-upload-fn + ((pred functionp) (funcall screenshot-upload-fn screenshot--tmp-file)) + ((pred stringp) (string-trim-right (shell-command-to-string (format screenshot-upload-fn screenshot--tmp-file)))) + (_ (error "Upload function is not a function or string!"))))) + (gui-select-text url) + (message "Screenshot uploaded, link copied to clipboard (%s)" url))) + (delete-file screenshot--tmp-file))) + +;;; Screenshot transient + +(transient-define-prefix screenshot-transient () + ["Code" + (screenshot--set-line-numbers-p) + (screenshot--set-relative-line-numbers-p) + (screenshot--set-text-only-p) + (screenshot--set-truncate-lines-p) + (screenshot--set-font-family) + (screenshot--set-font-size)] + ["Frame" + (screenshot--set-border-width) + (screenshot--set-radius) + (screenshot--set-min-width) + (screenshot--set-max-width)] + ["Shadow" + (screenshot--set-shadow-radius) + (screenshot--set-shadow-intensity) + (screenshot--set-shadow-color) + (screenshot--set-shadow-offset-horizontal) + (screenshot--set-shadow-offset-vertical)] + ["Action" + ("s" "Save" screenshot-save) + ("S" "Save as" screenshot-save-as) + ("c" "Copy" screenshot-copy) + ("u" "Upload" screenshot-upload)]) + +(provide 'screenshot) +;;; screenshot.el ends here diff --git a/.config/doom/init.el b/.config/doom/init.el new file mode 100644 index 00000000..91a808e9 --- /dev/null +++ b/.config/doom/init.el @@ -0,0 +1,200 @@ +;;; init.el -*- lexical-binding: t; -*- + +;; This file controls what Doom modules are enabled and what order they load +;; in. Remember to run 'doom sync' after modifying it! + +;; NOTE Press 'SPC h d h' (or 'C-h d h' for non-vim users) to access Doom's +;; documentation. There you'll find a link to Doom's Module Index where all +;; of our modules are listed, including what flags they support. + +;; NOTE Move your cursor over a module's name (or its flags) and press 'K' (or +;; 'C-c c k' for non-vim users) to view its documentation. This works on +;; flags as well (those symbols that start with a plus). +;; +;; Alternatively, press 'gd' (or 'C-c c d') on a module to browse its +;; directory (for easy access to its source code). + +(doom! :input + ;;bidi ; (tfel ot) thgir etirw uoy gnipleh + ;;chinese + ;;japanese + ;;layout ; auie,ctsrnm is the superior home row + + :completion + company ; the ultimate code completion backend + helm ; the *other* search engine for love and life + ;;ido ; the other *other* search engine... + ivy ; a search engine for love and life + ;; vertico ; the search engine of the future + + :ui + ;;deft ; notational velocity for Emacs + doom ; what makes DOOM look the way it does + doom-dashboard ; a nifty splash screen for Emacs + doom-quit ; DOOM quit-message prompts when you quit Emacs + (emoji +unicode) ; 🙂 + hl-todo ; highlight TODO/FIXME/NOTE/DEPRECATED/HACK/REVIEW + ;;hydra + indent-guides ; highlighted indent columns + ;;ligatures ; ligatures and symbols to make your code pretty again + minimap ; show a map of the code on the side + modeline ; snazzy, Atom-inspired modeline, plus API + nav-flash ; blink cursor line after big motions + ;;neotree ; a project drawer, like NERDTree for vim + ophints ; highlight the region an operation acts on + (popup +defaults) ; tame sudden yet inevitable temporary windows + ;;tabs ; a tab bar for Emacs + treemacs ; a project drawer, like neotree but cooler + ;;unicode ; extended unicode support for various languages + (vc-gutter +pretty) ; vcs diff in the fringe + vi-tilde-fringe ; fringe tildes to mark beyond EOB + ;;window-select ; visually switch windows + workspaces ; tab emulation, persistence & separate workspaces + ;;zen ; distraction-free coding or writing + + :editor + (evil +everywhere); come to the dark side, we have cookies + file-templates ; auto-snippets for empty files + fold ; (nigh) universal code folding + ;;(format +onsave) ; automated prettiness + ;;god ; run Emacs commands without modifier keys + ;;lispy ; vim for lisp, for people who don't like vim + multiple-cursors ; editing in many places at once + ;;objed ; text object editing for the innocent + ;;parinfer ; turn lisp into python, sort of + ;;rotate-text ; cycle region at point between text candidates + snippets ; my elves. They type so I don't have to + ;;word-wrap ; soft wrapping with language-aware indent + + :emacs + (dired +icons) ; making dired pretty [functional] + electric ; smarter, keyword-based electric-indent + (ibuffer +icons) ; interactive buffer management + undo ; persistent, smarter undo for your inevitable mistakes + vc ; version-control and Emacs, sitting in a tree + + :term + ;;eshell ; the elisp shell that works everywhere + ;;shell ; simple shell REPL for Emacs + ;;term ; basic terminal emulator for Emacs + vterm ; the best terminal emulation in Emacs + + :checkers + syntax ; tasing you for every semicolon you forget + ;;(spell +flyspell) ; tasing you for misspelling mispelling + ;;grammar ; tasing grammar mistake every you make + + :tools + ;;ansible + ;;biblio ; Writes a PhD for you (citation needed) + debugger ; FIXME stepping through code, to help you add bugs + ;;direnv + docker + ;;editorconfig ; let someone else argue about tabs vs spaces + ;;ein ; tame Jupyter notebooks with emacs + (eval +overlay) ; run code, run (also, repls) + ;;gist ; interacting with github gists + lookup ; navigate your code and its documentation + lsp ; M-x vscode + (magit +forge) ; a git porcelain for Emacs + make ; run make tasks from Emacs + ;;pass ; password manager for nerds + ;;pdf ; pdf enhancements + ;;prodigy ; FIXME managing external services & code builders + ;;rgb ; creating color strings + ;;taskrunner ; taskrunner for all your projects + terraform ; infrastructure as code + ;;tmux ; an API for interacting with tmux + ;;tree-sitter ; syntax and parsing, sitting in a tree... + ;;upload ; map local to remote projects via ssh/ftp + + :os + ;; (:if IS-MAC macos) ; improve compatibility with macOS + ;;tty ; improve the terminal Emacs experience + + :lang + ;;agda ; types of types of types of types... + ;;beancount ; mind the GAAP + ;;(cc +lsp) ; C > C++ == 1 + ;;clojure ; java with a lisp + ;;common-lisp ; if you've seen one lisp, you've seen them all + ;;coq ; proofs-as-programs + ;;crystal ; ruby at the speed of c + ;;csharp ; unity, .NET, and mono shenanigans + ;;data ; config/data formats + ;;(dart +flutter) ; paint ui and not much else + ;;dhall + ;;elixir ; erlang done right + ;;elm ; care for a cup of TEA? + emacs-lisp ; drown in parentheses + ;;erlang ; an elegant language for a more civilized age + ;;ess ; emacs speaks statistics + ;;factor + ;;faust ; dsp, but you get to keep your soul + ;;fortran ; in FORTRAN, GOD is REAL (unless declared INTEGER) + ;;fsharp ; ML stands for Microsoft's Language + ;;fstar ; (dependent) types and (monadic) effects and Z3 + ;;gdscript ; the language you waited for + ;;(go +lsp) ; the hipster dialect + ;;(graphql +lsp) ; Give queries a REST + ;;(haskell +lsp) ; a language that's lazier than I am + ;;hy ; readability of scheme w/ speed of python + ;;idris ; a language you can depend on + json ; At least it ain't XML + ;;(java +lsp) ; the poster child for carpal tunnel syndrome + javascript ; all(hope(abandon(ye(who(enter(here)))))) + ;;julia ; a better, faster MATLAB + ;;kotlin ; a better, slicker Java(Script) + ;;latex ; writing papers in Emacs has never been so fun + ;;lean ; for folks with too much to prove + ;;ledger ; be audit you can be + ;;lua ; one-based indices? one-based indices + markdown ; writing docs for people to ignore + ;;nim ; python + lisp at the speed of c + ;;nix ; I hereby declare "nix geht mehr!" + ;;ocaml ; an objective camel + (org + +hugo + +roam2 + +pandoc) ; organize your plain life in plain text + ;;php ; perl's insecure younger brother + ;;plantuml ; diagrams for confusing people more + ;;purescript ; javascript, but functional + (python +lsp) ; beautiful is better than ugly + ;;qt ; the 'cutest' gui framework ever + ;;racket ; a DSL for DSLs + ;;raku ; the artist formerly known as perl6 + rest ; Emacs as a REST client + ;;rst ; ReST in peace + ;;(ruby +rails) ; 1.step {|i| p "Ruby is #{i.even? ? 'love' : 'life'}"} + ;;(rust +lsp) ; Fe2O3.unwrap().unwrap().unwrap().unwrap() + ;;scala ; java, but good + ;;(scheme +guile) ; a fully conniving family of lisps + (sh + +lsp + +powershell + +fish) ; she sells {ba,z,fi}sh shells on the C xor + ;;sml + ;;solidity ; do you need a blockchain? No. + ;;swift ; who asked for emoji variables? + ;;terra ; Earth and Moon in alignment for performance. + web ; the tubes + yaml ; JSON, but readable + ;;zig ; C, but simpler + + :email + ;;(mu4e +org +gmail) + ;;notmuch + ;;(wanderlust +gmail) + + :app + ;;calendar + ;;emms + ;;everywhere ; *leave* Emacs!? You must be joking + ;;irc ; how neckbeards socialize + ;;(rss +org) ; emacs as an RSS reader + ;;twitter ; twitter client https://twitter.com/vnought + + :config + ;;literate + (default +bindings +smartparens)) diff --git a/.config/doom/packages.el b/.config/doom/packages.el new file mode 100644 index 00000000..61ebc378 --- /dev/null +++ b/.config/doom/packages.el @@ -0,0 +1,63 @@ +;; -*- no-byte-compile: t; -*- +;;; $DOOMDIR/packages.el + +;; To install a package with Doom you must declare them here and run 'doom sync' +;; on the command line, then restart Emacs for the changes to take effect -- or +;; use 'M-x doom/reload'. + + +;; To install SOME-PACKAGE from MELPA, ELPA or emacsmirror: +;(package! some-package) + +;; To install a package directly from a remote git repo, you must specify a +;; `:recipe'. You'll find documentation on what `:recipe' accepts here: +;; https://github.com/radian-software/straight.el#the-recipe-format +;(package! another-package +; :recipe (:host github :repo "username/repo")) + +;; If the package you are trying to install does not contain a PACKAGENAME.el +;; file, or is located in a subdirectory of the repo, you'll need to specify +;; `:files' in the `:recipe': +;(package! this-package +; :recipe (:host github :repo "username/repo" +; :files ("some-file.el" "src/lisp/*.el"))) + +;; If you'd like to disable a package included with Doom, you can do so here +;; with the `:disable' property: +;(package! builtin-package :disable t) + +;; You can override the recipe of a built in package without having to specify +;; all the properties for `:recipe'. These will inherit the rest of its recipe +;; from Doom or MELPA/ELPA/Emacsmirror: +;(package! builtin-package :recipe (:nonrecursive t)) +;(package! builtin-package-2 :recipe (:repo "myfork/package")) + +;; Specify a `:branch' to install a package from a particular branch or tag. +;; This is required for some packages whose default branch isn't 'master' (which +;; our package manager can't deal with; see radian-software/straight.el#279) +;(package! builtin-package :recipe (:branch "develop")) + +;; Use `:pin' to specify a particular commit to install. +;(package! builtin-package :pin "1a2b3c4d5e") + + +;; Doom's packages are pinned to a specific commit and updated from release to +;; release. The `unpin!' macro allows you to unpin single packages... +;(unpin! pinned-package) +;; ...or multiple packages +;(unpin! pinned-package another-pinned-package) +;; ...Or *all* packages (NOT RECOMMENDED; will likely break things) +;(unpin! t) + +(package! auto-virtualenv) +(package! org-bullets) +(package! idle-highlight-mode) +(package! symbol-overlay) +(package! elpy) +(package! groovy-mode) +(package! org-recur) +(package! ox-gfm) +(package! ox-clip) +(package! dashboard) +(package! clipmon) +(package! butler) -- cgit v1.2.3