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