Removed .doom.d, moved to .config/doom
This commit is contained in:
parent
6bd3184b2f
commit
fb6ba70d71
GPG Key ID:
C7ECE9C6C36EC2E6
@ -1,431 +0,0 @@
|
|||||||
;;; $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 "~/.doom.d/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 2)
|
|
||||||
("R" "REPEAT entry" entry (file+headline "~/org/capture.org" "Capture") (file "~/org/templates/repeat.org") :empty-lines-before 2)
|
|
||||||
("N" "NEXT entry" entry (file+headline "~/org/capture.org" "Capture") (file "~/org/templates/next.org") :empty-lines-before 2)
|
|
||||||
("T" "TODO entry" entry (file+headline "~/org/capture.org" "Capture") (file "~/org/templates/todo.org") :empty-lines-before 2)
|
|
||||||
("W" "WAITING entry" entry (file+headline "~/org/capture.org" "Capture") (file "~/org/templates/waiting.org") :empty-lines-before 2)
|
|
||||||
("S" "SOMEDAY entry" entry (file+headline "~/org/capture.org" "Capture") (file "~/org/templates/someday.org") :empty-lines-before 2)
|
|
||||||
("P" "PROJ entry" entry (file+headline "~/org/capture.org" "Capture") (file "~/org/templates/proj.org") :empty-lines-before 2)
|
|
||||||
("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 work" 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")))
|
|
||||||
(defun org-focus-work() "Set focus on work things."
|
|
||||||
(interactive)
|
|
||||||
(setq org-agenda-files '("~/org/work.org")))
|
|
||||||
(defun org-focus-all() "Set focus on all things."
|
|
||||||
(interactive)
|
|
||||||
(setq org-agenda-files '("~/org/")))
|
|
||||||
|
|
||||||
(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 "<f5>") '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 "<f4>") '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 "<f4>") 'my/jenkins-verify))
|
|
||||||
@ -1,971 +0,0 @@
|
|||||||
;;; deferred.el --- Simple asynchronous functions for emacs lisp -*- lexical-binding: t; -*-
|
|
||||||
|
|
||||||
;; Copyright (C) 2010-2016 SAKURAI Masashi
|
|
||||||
|
|
||||||
;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
|
|
||||||
;; 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 <http://www.gnu.org/licenses/>.
|
|
||||||
|
|
||||||
;;; 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<KEY . VALUE>" )
|
|
||||||
(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<LIST>" )
|
|
||||||
(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<KEY . VALUE>" )
|
|
||||||
(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<LIST>" )
|
|
||||||
(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
|
|
||||||
@ -1,366 +0,0 @@
|
|||||||
;;; 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 <http://www.gnu.org/licenses/>.
|
|
||||||
|
|
||||||
;;; 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 ""
|
|
||||||
(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
|
|
||||||
@ -1,460 +0,0 @@
|
|||||||
;;; screenshot.el --- Swiftly grab images of your code -*- lexical-binding: t -*-
|
|
||||||
|
|
||||||
;; Copyright (C) 2020 TEC
|
|
||||||
|
|
||||||
;; Author: TEC <http://github/tecosaur>
|
|
||||||
;; Maintainer: TEC <tec@tecosaur.com>
|
|
||||||
;; 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 <http://www.gnu.org/licenses/>.
|
|
||||||
|
|
||||||
;;; 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
|
|
||||||
200
.doom.d/init.el
200
.doom.d/init.el
@ -1,200 +0,0 @@
|
|||||||
;;; 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 ; 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 ; 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))
|
|
||||||
@ -1,65 +0,0 @@
|
|||||||
;; -*- 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/raxod502/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 raxod502/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)
|
|
||||||
|
|
||||||
;; (package! lsp-python-ms :disable t)
|
|
||||||
@ -1,3 +0,0 @@
|
|||||||
JENKINS_URL=http://my-jenkins.url
|
|
||||||
JENKINS_USER=myusername
|
|
||||||
JENKINS_PASS=mypassword
|
|
||||||
@ -1,25 +0,0 @@
|
|||||||
#!/usr/bin/env python3
|
|
||||||
|
|
||||||
import os
|
|
||||||
import requests
|
|
||||||
|
|
||||||
from dotenv import load_dotenv
|
|
||||||
|
|
||||||
load_dotenv()
|
|
||||||
|
|
||||||
JENKINS_URL = os.environ.get("JENKINS_URL")
|
|
||||||
JENKINS_USER = os.environ.get("JENKINS_USER")
|
|
||||||
JENKINS_PASS = os.environ.get("JENKINS_PASS")
|
|
||||||
|
|
||||||
files = {
|
|
||||||
"jenkinsfile": (None, open("Jenkinsfile", "rb")),
|
|
||||||
}
|
|
||||||
|
|
||||||
try:
|
|
||||||
response = requests.post(
|
|
||||||
f"{JENKINS_URL}/pipeline-model-converter/validate",
|
|
||||||
files=files,
|
|
||||||
auth=(JENKINS_USER, JENKINS_PASS))
|
|
||||||
print(response.text)
|
|
||||||
except requests.exceptions.ConnectionError:
|
|
||||||
print("Jenkins can't be found. Is the VPN on?")
|
|
||||||
@ -1 +0,0 @@
|
|||||||
(icalendar-import-file "/tmp/calendar/personal-calendar.ics" "~/.emacs.d/.local/cache/diary")
|
|
||||||
@ -1,22 +0,0 @@
|
|||||||
#!/bin/bash
|
|
||||||
# This is a cron that runs every 15 mins and populates my emacs diary file with my calendar items
|
|
||||||
|
|
||||||
# Downloading calendar
|
|
||||||
echo "Downloading Calendar"
|
|
||||||
mkdir -p /tmp/calendar
|
|
||||||
cd /tmp/calendar
|
|
||||||
wget "https://cloud.rogs.me/remote.php/dav/public-calendars/kRMMJ2CArQeCPzRi/?export" -O "personal-calendar.ics" -c
|
|
||||||
wget "https://files-f1.motorsportcalendars.com/f1-calendar_qualifying_sprint_gp.ics" -O "f1.ics" -c
|
|
||||||
|
|
||||||
# Merge the calendars
|
|
||||||
cat f1.ics >> personal-calendar.ics
|
|
||||||
|
|
||||||
#Generating the file
|
|
||||||
|
|
||||||
echo "#Generating the file"
|
|
||||||
rm ~/.emacs.d/.local/cache/diary
|
|
||||||
emacs --batch -l ~/.doom.d/scripts/ics-to-org.el
|
|
||||||
|
|
||||||
echo "#Deleting everything"
|
|
||||||
#Deleting everything
|
|
||||||
rm -r /tmp/calendar
|
|
||||||
Loading…
x
Reference in New Issue
Block a user