From 2d2cab9d97d3e84e5b7158181523fe2c5bbffe85 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Sun, 16 Apr 2023 17:06:41 -0500 Subject: uhhh --- lisp/+link-hint.el | 83 ++++++++++++++++--------- lisp/+scratch.el | 75 +++++++++++++++++++++++ lisp/acdw-chat.el | 174 +++++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/acdw-mail.el | 113 +++++++++++++++++++++++++++++++++- lisp/acdw-org.el | 77 +++++++++++++++++------- lisp/acdw-web.el | 101 +++++++++++++++++++++++++------ lisp/acdw.el | 45 +++++++++++++- lisp/ical2org.el | 56 +++++++++++++++++ 8 files changed, 655 insertions(+), 69 deletions(-) create mode 100644 lisp/+scratch.el create mode 100644 lisp/acdw-chat.el create mode 100644 lisp/ical2org.el (limited to 'lisp') diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el index 469ed15..0e0b9b1 100644 --- a/lisp/+link-hint.el +++ b/lisp/+link-hint.el @@ -87,33 +87,62 @@ with the KEYWORD." +link-hint-open-secondary-types :multiple t) -(defun +link-hint-open-secondary-setup (&optional types) - "Define the `:open-secondary' link-hint type for TYPES. -If TYPES is nil, define it for `+link-hint-open-secondary-types'." - (dolist (type (or types +link-hint-open-secondary-types)) - (link-hint-define-type type - :open-secondary browse-url-secondary-browser-function - :open-secondary-multiple t))) - -(defun +link-hint-open-secondary () - "Open a link in the secondary browser." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :open-secondary))) - -(defun +link-hint-open-chrome-setup (&optional types) - "Define the `:open-chrome' link-hint type for TYPES. -If TYPES is nil, define it for `+link-hint-open-secondary-types'." - (dolist (type (or types +link-hint-open-secondary-types)) - (link-hint-define-type type - :open-chrome #'browse-url-chrome - :open-chrome-multiple t))) - -(defun +link-hint-open-chrome () - "Open a link with chrome." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :open-chrome))) +(progn + (dolist + (type + '(gnus-w3m-image-url gnus-w3m-url markdown-link mu4e-attachment mu4e-url notmuch-hello nov-link org-link shr-url text-url w3m-link w3m-message-link)) + (link-hint-define-type type :download + (function +browse-url-download) + :download-multiple t)) + (defun +link-hint-open:download nil "Download a link to `eww-download-directory'. + +Defined by `+link-hint-define'." + (interactive) + (avy-with link-hint-open-link + (link-hint--one :download))) + (defun +link-hint-open-multiple:download nil "Open multiple links with `+link-hint-open:download'. + +Defined by `+link-hint-define'." + (avy-with link-hint-open-multiple-links + (link-hint--multiple :download))) + (defun +link-hint-open-all:download nil "Open all visible links with `+link-hint-open:download'. + +Defined by `+link-hint-define'." + (avy-with link-hint-open-all-links + (link-hint--all :download)))) + +;; (defun +link-hint-open-secondary-setup (&optional types) +;; "Define the `:open-secondary' link-hint type for TYPES. +;; If TYPES is nil, define it for `+link-hint-open-secondary-types'." +;; (dolist (type (or types +link-hint-open-secondary-types)) +;; (link-hint-define-type type +;; :open-secondary browse-url-secondary-browser-function +;; :open-secondary-multiple t))) + +;; (defun +link-hint-open-secondary () +;; "Open a link in the secondary browser." +;; (interactive) +;; (avy-with link-hint-open-link +;; (link-hint--one :open-secondary))) + +(+link-hint-define-keyword :chrome #'browse-url-chrome + "Open a link with `browse-url-chrome'." + +link-hint-open-secondary-types + :multiple t) + +;; (defun +link-hint-open-chrome-setup (&optional types) +;; "Define the `:open-chrome' link-hint type for TYPES. +;; If TYPES is nil, define it for `+link-hint-open-secondary-types'." +;; (dolist (type (or types +link-hint-open-secondary-types)) +;; (link-hint-define-type type +;; :open-chrome #'browse-url-chrome +;; :open-chrome-multiple t))) + +;; (defun +link-hint-open-chrome () +;; "Open a link with chrome." +;; (interactive) +;; (avy-with link-hint-open-link +;; (link-hint--one :open-chrome))) (defun +link-hint-open-link (prefix) "Open a link. diff --git a/lisp/+scratch.el b/lisp/+scratch.el new file mode 100644 index 0000000..5d749c6 --- /dev/null +++ b/lisp/+scratch.el @@ -0,0 +1,75 @@ +;;; +scratch.el --- *scratch* improvements -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Case Duckworth + +;; Author: Case Duckworth +;; Keywords: convenience + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(defcustom +scratch-save-dir (locate-user-emacs-file "scratch.d") + "Where to save scratch files." + :type 'file) + +(defcustom +scratch-max-age (* 60 60 24 365) + "Maximum age of a saved scratch buffer. Default: one year." + :type 'natnum) + +(defun +scratch@immortal () + "Don't kill *scratch* with `kill-buffer'." + (if (equal (buffer-name) "*scratch*") + (progn (bury-buffer) nil) + t)) + +(defun +scratch-save (time-format) + "Save *scratch* buffer to `+scratch-save-dir'. +TIME-FORMAT will be used to name the buffer." + (interactive (list "%FT%H%z")) + (with-current-buffer (get-scratch-buffer-create) + (let ((buffer-file-name (expand-file-name (format "%s.%s" + (format-time-string + time-format) + (pcase major-mode + ('org-mode "org") + ('emacs-lisp-mode "el") + (_ "txt"))) + +scratch-save-dir))) + (unless (string-equal (buffer-substring (point-min) (point-max)) + initial-scratch-message) + (save-buffer 0))))) + +(defun +scratch-save-on-exit () + (+scratch-save "%FT%T%z") + (+scratch-clean)) + +(defun +scratch-clean () + "Clean up saved scratches. +Scratch files older than `+scratch-max-age' will be removed." + (dolist (f (directory-files +scratch-save-dir)) + (when (and (not (equal f ".")) + (not (equal f "..")) + (> (time-convert (file-attribute-modification-time + (file-attributes f)) + 'integer) + +scratch-max-age)) + (delete-file (expand-file-name f +scratch-save-dir) :trash)))) + +(provide '+scratch) +;;; +scratch.el ends here diff --git a/lisp/acdw-chat.el b/lisp/acdw-chat.el new file mode 100644 index 0000000..62dcf72 --- /dev/null +++ b/lisp/acdw-chat.el @@ -0,0 +1,174 @@ +;;; acdw-chat.el --- Chat applications (mostly jabber) -*- lexical-binding: t; -*- + +;;; Code: + +(defcustom jabber-prefix-width 10 + "Width of jabber prompts and other prefixes." + :type 'number + :group 'jabber) + +(defun jabber-ui-setup () + "Setup the `jabber' user interface." + (visual-fill-column-mode) + (electric-pair-local-mode -1) + (auto-fill-mode -1) + (setq-local wrap-prefix (make-string (+ 3 jabber-prefix-width) #x20) + visual-fill-column-extra-text-width `(,(+ 3 jabber-prefix-width) + . 1))) + +(defcustom jabber-biboumi-server "localhost" + "Biboumi server for `jabber-biboumi-muc-connect'." + :type 'string + :group 'jabber) + +(defcustom jabber-biboumi-irc-servers '("irc.libera.chat") + "IRC servers for the user to choose from with `jabber-biboumi-muc-connect'." + :type '(repeat string) + :group 'jabber) + +(defcustom jabber-biboumi-default-nick "" + "Default nick for biboumi rooms." + :type 'string + :group 'jabber) + +(defun jabber-biboumi-muc-connect (channel server nick &optional biboumi-server) + "Connect to a biboumi (IRC gateway) server MUC. +CHANNEL, SERVER, NICK, and BIBOUMI-SERVER are passed to +`jabber-muc-join'. If BIBOUMI-SERVER isn't given, +`jabber-biboumi-server' is used." + (interactive (list (concat "#" (string-remove-prefix "#" (read-string + "Channel: "))) + (completing-read "Server: " jabber-biboumi-irc-servers) + (read-string (format "Nick [%s]: " + jabber-biboumi-default-nick) + nil nil jabber-biboumi-default-nick))) + (let ((room (format "%s%%%s@%s" channel server (or biboumi-server + jabber-biboumi-server)))) + (if (assoc room *jabber-active-groupchats*) + (switch-to-buffer (jabber-muc-get-buffer room)) + (jabber-muc-join (jabber-read-account) + room + nick + 'popup)))) + +(defun jabber-group-yank-join-url () + "Yank a url for joining the focused group." + (interactive) + (let ((s (format "xmpp:%s?join" jabber-group))) + (kill-new s) + (message s))) + + +;;; Packages + +(use-package jabber + :load-path "~/src/emacs/jabber/" + :custom-face + (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign + :foreground unspecified + :weight normal))) + (jabber-activity-personal-face ((t :inherit jabber-chat-prompt-local + :foreground unspecified + :weight bold))) + (jabber-chat-prompt-local ((t :inherit minibuffer-prompt + :foreground unspecified + :weight normal + :slant italic))) + (jabber-chat-prompt-foreign ((t :inherit warning + :foreground unspecified + :weight normal))) + (jabber-chat-prompt-system ((t :inherit font-lock-doc-face + :foreground unspecified))) + (jabber-rare-time-face ((t :inherit font-lock-comment-face + :foreground unspecified + :underline nil))) + :bind-keymap ("C-c j" . jabber-global-keymap) + :bind (("C-c C-SPC" . jabber-activity-switch-to)) + :config + (setopt jabber-account-list '(("acdw@hmm.st")) + jabber-auto-reconnect t + jabber-biboumi-server "irc.hmm.st" + jabber-biboumi-irc-servers '("irc.libera.chat" + "irc.tilde.chat" + "tilde.town" + "m455.casa" + "irc.twitch.tv") + jabber-biboumi-default-nick "acdw" + jabber-last-read-marker (make-string fill-column ?.) + jabber-muc-decorate-presence-patterns + '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil) + ("Mode #.*" . jabber-muc-presence-dim) + ("." . jabber-muc-presence-dim)) + jabber-activity-make-strings #'jabber-activity-make-strings-shorten + jabber-rare-time-format " - - - - - - %H:%M %F" + jabber-muc-header-line-format + '(" " (:eval (replace-regexp-in-string "%" "%%" + (jabber-jid-displayname + jabber-group))) + " / " jabber-muc-topic) + ;; buffer name formats + jabber-chat-buffer-format "*xmpp* %n" + jabber-browse-buffer-format "*xmpp-browse* %n" + jabber-groupchat-buffer-format "*xmpp-muc* %n" + jabber-muc-private-buffer-format "*xmpp-muc-private* %n" + ;; "prompt" (speaker) formats + jabber-groupchat-prompt-format (format "%%>%dn . " jabber-prefix-width) + jabber-chat-local-prompt-format (format "%%>%dn . " jabber-prefix-width) + jabber-chat-foreign-prompt-format (format "%%>%dn . " jabber-prefix-width) + jabber-muc-private-foreign-prompt-format "\n%g/%n . ") + ;; jabber muc nick coloring + ;; wgreenhous | I found 1.5 ok for saturation and 2.0 for value (modus) + ;; (setopt jabber-muc-nick-value 1.0 + ;; jabber-muc-nick-saturation 1.0 + ;; jabber-muc-colorize-local t + ;; jabber-muc-colorize-foreign t) + ;; When changing the above values, make sure to + ;; (setq jabber-muc-participant-colors nil) + (add-hook 'jabber-chat-mode-hook #'jabber-ui-setup) + (keymap-global-set "C-x C-j" #'dired-jump) ; Extremely annoying fix + ;; For each binding in `jabber-global-keymap', also bind the non-control + ;; character (lowercase) + (map-keymap (lambda (key command) + (define-key jabber-global-keymap (vector (+ key #x60)) command)) + jabber-global-keymap) + (require 'jabber-httpupload nil t) + (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) + (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo) + (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo) + (add-hook 'jabber-alert-muc-hooks + (defun jabber@highlight-acdw (&optional _ _ buf _ _) + (when buf + (with-current-buffer buf + (let ((regexp (rx word-boundary + "acdw" ; maybe get from the config? + word-boundary))) + (hi-lock-unface-buffer regexp) + (highlight-regexp regexp 'jabber-chat-prompt-local)))))) + (add-hook 'jabber-chat-mode-hook + (defun jabber-chat@leave-when-kill () + (add-hook 'kill-buffer-hook + (defun @jabber-leave@kill () + (ignore-errors + (apply #'jabber-muc-leave (jabber-muc-argument-list)))) + nil :local))) + (when (fboundp 'jabber-chat-update-focus) + (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus)) + (with-eval-after-load 'consult + (defvar jabber-chat-buffer-source + `( :name "Jabber" + :hidden nil + :narrow ?j + :category buffer + :state ,#'consult--buffer-state + :items ,(lambda () + (mapcar #'buffer-name + (seq-filter (lambda (buf) + (with-current-buffer buf + (eq major-mode 'jabber-chat-mode))) + (buffer-list)))))) + (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append) + (consult-customize + consult-buffer :preview-key "M-."))) + +(provide 'acdw-chat) +;;; acdw-chat.el ends here diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el index 2a7d128..f8111e7 100644 --- a/lisp/acdw-mail.el +++ b/lisp/acdw-mail.el @@ -25,6 +25,10 @@ (defun +message-send-set-variables () "Set variables for `message-send' depending on the From: header. Useful in `message-send-hook'." + (unless +message-send-dispatch-rules + (load notmuch-init-file) + (or +message-send-dispatch-rules + (error "`+message-send-dispatch-rules' isn't set!"))) (let ((from (message-fetch-field "from"))) (cl-loop for (var . val) in (cl-loop for (address . bindings) in +message-send-dispatch-rules @@ -145,6 +149,112 @@ the saved search as well." ;;(user-error "Feature `async' not found!") (notmuch-poll))) +;;; https://kitchingroup.cheme.cmu.edu/blog/2015/09/04/Checking-for-email-attachments-before-you-send-email/ + +(defun email-says-attach-p () + "Return t if email suggests there could be an attachment." + (save-excursion + (goto-char (point-min)) + (re-search-forward "attach" nil t))) + +(defun email-has-attachment-p () + "Return t if the currently open email has an attachment." + (save-excursion + (goto-char (point-min)) + (re-search-forward "<#part" nil t))) + +(defun email-pre-send-check-attachment () + (when (and (email-says-attach-p) + (not (email-has-attachment-p))) + (unless + (y-or-n-p + "Your email suggests an attachment, but none was found. Send anyway?") + (error "No attachment. Aborting send.")))) + +;;; Process ical attachments + +(defun notmuch-save-ics () + "Save a .ics file in a message." + (interactive) + (with-current-notmuch-show-message + (notmuch-foreach-mime-part + (lambda (part) + (message "%S" part) + (when (and (listp part) + (or (equal "application/ics" (caadr part)) + ;; (equal "text/calendar" (caadr part)) + )) + (save-window-excursion + (let* ((filename "/tmp/notmuch.ics") + (buf (find-file-noselect filename))) + (delete-file filename) + (kill-buffer (get-file-buffer filename)) + (mm-save-part-to-file part filename) + (icalendar-import-file filename diary-file) + (kill-buffer buf))))) + (mm-dissect-buffer t t)))) + + +;;; Fixes + +;; https://nmbug.notmuchmail.org/nmweb/show/87bklhricc.fsf%40tethera.net + +(defun notmuch--indent-rigidly (start end count) + (cond + ((zerop count) t) + ((< count 0) (indent-rigidly start end count)) + (t + (save-excursion + (let ((startpt (progn (goto-char start) (line-beginning-position))) + (endpt (progn (goto-char end) (line-end-position))) + (spaces (spaces-string count))) + (goto-char startpt) + (while + (progn + (insert spaces) + (cl-incf endpt count) + (and (zerop (forward-line 1)) (bolp) + (<= (point) endpt))))))))) + +(with-eval-after-load 'notmuch-show + ;; Redefine `notmuch-show-lazy-part' --- XXX: this is the most braindead way + ;; of doing this + (defun notmuch-show-lazy-part (part-args button) + ;; Insert the lazy part after the button for the part. We would just + ;; move to the start of the new line following the button and insert + ;; the part but that point might have text properties (eg colours + ;; from a message header etc) so instead we start from the last + ;; character of the button by adding a newline and finish by + ;; removing the extra newline from the end of the part. + (save-excursion + (goto-char (button-end button)) + (insert "\n") + (let* ((inhibit-read-only t) + ;; We need to use markers for the start and end of the part + ;; because the part insertion functions do not guarantee + ;; to leave point at the end of the part. + (part-beg (copy-marker (point) nil)) + (part-end (copy-marker (point) t)) + ;; We have to save the depth as we can't find the depth + ;; when narrowed. + (depth (notmuch-show-get-depth))) + (save-restriction + (narrow-to-region part-beg part-end) + (delete-region part-beg part-end) + (apply #'notmuch-show-insert-bodypart-internal part-args) + (notmuch--indent-rigidly part-beg + part-end + (* notmuch-show-indent-messages-width depth))) + (goto-char part-end) + (delete-char 1) + (notmuch-show-record-part-information (cadr part-args) + (button-start button) + part-end) + ;; Create the overlay. If the lazy-part turned out to be empty/not + ;; showable this returns nil. + (notmuch-show-create-part-overlays button part-beg part-end)))) + ) + ;;; Packages @@ -173,7 +283,6 @@ the saved search as well." :preface (defdir notmuch/ (sync/ "emacs/notmuch/") "Notmuch configuration directory." :makedir) - :bind (("C-c m" . notmuch-mua-new-mail)) :config ;; Options (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t) @@ -196,6 +305,7 @@ the saved search as well." notmuch-saved-searches nil notmuch-poll-script "~/usr/scripts/syncmail" ; XXX: Deprecated option ) + (load notmuch-init-file) ;; Key bindings (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam) (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread) @@ -221,6 +331,7 @@ the saved search as well." (+notmuch-define-saved-search "all mail" "a" 'tree "*") ;; Hooks and advice (add-hook 'message-send-hook #'+message-send-set-variables) + (add-hook 'message-send-hook #'email-pre-send-check-attachment) (add-hook 'message-setup-hook #'+message-signature-setup) (autoload 'visual-fill-column-mode "visual-fill-column" nil t) (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode) diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 566deed..f961dda 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el @@ -202,6 +202,16 @@ If LIST is non-nil, return the result as a list instead of a string." (unless (eq (char-after) ?:) ":")) (when (org-at-heading-p) (org-align-tags)))))) + +;;; Misc. + +(defun org-clock-in-or-out (prefix) + "If clocked in, clock out. Otherwise, clock in." + (interactive "P") + (if (org-clocking-p) + (org-clock-out prefix) + (org-clock-in prefix))) + ;;; Faces @@ -225,10 +235,12 @@ If LIST is non-nil, return the result as a list instead of a string." :custom-face (org-level-1 ((t :inherit fixed-pitch :weight bold - :height 1.2))) + :slant italic + :height 1.0))) (org-level-2 ((t :inherit fixed-pitch :weight bold - :height 1.1))) + :slant italic + :height 1.0))) (org-level-3 ((t :inherit fixed-pitch :weight bold :height 1.0))) @@ -299,17 +311,20 @@ If LIST is non-nil, return the result as a list instead of a string." (sequence "|" "CANCELED(k@)") (sequence "MEETING(m)")) org-use-fast-todo-selection 'auto - org-use-speed-commands t) + org-use-speed-commands t + org-element-use-cache nil) ;; Keys (keymap-set org-mode-map "C-M-k" #'kill-paragraph) (keymap-set org-mode-map "C-M-t" #'transpose-paragraphs) (keymap-set org-mode-map "RET" #'+org-return-dwim) (keymap-set org-mode-map "S-" #'+org-table-copy-down|+org-return-dwim) + (keymap-unset org-mode-map "C-'" t) + (keymap-unset org-mode-map "C-," t) ;; Hooks (add-hook 'org-mode-hook (defun org-mode@setup () (when (require 'visual-fill-column nil t) - (setq-local visual-fill-column-extra-text-width '(8 . 8)) + (setq-local visual-fill-column-extra-text-width '(2 . 2)) (visual-fill-column-mode)) (variable-pitch-mode) (turn-off-auto-fill) @@ -325,19 +340,17 @@ If LIST is non-nil, return the result as a list instead of a string." 'org-mode `(;; List markers => org-indent (,(concat - "^[ ]*\\(\\(?:[-+]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)" - "\\(?:[ ]+\\|$\\)\\)" + "^[ ]*\\(\\(?:[-+]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)" + "\\(?:[ ]+\\|$\\)\\)" "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]" - "[ ]*\\)?" + "[ ]*\\)?" "\\(?:\\(\\[[ X-]\\]\\)" - "\\(?:[ ]+\\|$\\)\\)?") + "\\(?:[ ]+\\|$\\)\\)?") 0 'org-indent)))) (use-package org-clock - :bind (("M-" . org-clock-out) - :map org-mode-map - ("" . org-clock-in) - ("" . org-clock-out)) + :bind (:map org-mode-map + ("" . org-clock-in-or-out)) :config (setopt org-clock-clocked-in-display 'mode-line global-mode-string @@ -355,13 +368,11 @@ If LIST is non-nil, return the result as a list instead of a string." org-agenda-skip-scheduled-if-done t org-agenda-span 10 org-agenda-block-separator ?─ - org-agenda-time-grid - '((daily today require-timed) - (800 1000 1200 1400 1600 1800 2000) - " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") - org-agenda-current-time-string - "← now ─────────────────────────────────────────────────" - org-agenda-include-diary nil ; I use the org-diary features + org-agenda-time-grid '((daily today require-timed) + (800 1000 1200 1400 1600 1800 2000) + " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") + org-agenda-current-time-string "← now ───────────────" + org-agenda-include-diary t ; I use the org-diary features org-agenda-todo-ignore-deadlines 'near org-agenda-todo-ignore-scheduled 'future org-agenda-include-deadlines t @@ -371,7 +382,29 @@ If LIST is non-nil, return the result as a list instead of a string." org-agenda-skip-file-regexp "sync-conflict" org-agenda-inhibit-startup t org-agenda-sticky t - org-agenda-follow-indirect t) + org-agenda-follow-indirect t + org-stuck-projects '("TODO=\"WAIT\"" + ("TODO" "NEXT") + nil + "") + org-agenda-custom-commands + `(("c" "Click Here Digital To-do" + ((agenda "" ((org-agenda-overriding-header "Tasks") + (org-agenda-span 'fortnight) + (org-agenda-start-day "+0") + (org-agenda-skip-function + '(org-agenda-skip-subtree-if 'todo + '("WAIT" "MCKENZIE" "RACHEL"))))) + (stuck "" ((org-agenda-overriding-header "Waiting")))) + ((org-agenda-files ',(list (progn (require 'chd) + (chd/ "inbox-chd.org")))))))) + ;; Speedup agenda generation + ;; https://orgmode.org/manual/Speeding-Up-Your-Agendas.html + ;; https://orgmode.org/worg/agenda-optimization.html + (setopt org-agenda-dim-blocked-tasks nil + org-agenda-inhibit-startup t + org-agenda-use-tag-inheritance nil + org-agenda-ignore-properties '(effort appt stats category)) ;; Hooks and advice (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode) (add-hook 'org-agenda-mode-hook #'hl-line-mode) @@ -440,6 +473,7 @@ effect for exporting link types)." :custom-face (org-modern-label ((t :inherit fixed-pitch :height 1.0))) + :hook (org-mode-hook) :config (setopt org-modern-star nil org-modern-list '((43 . "◦") @@ -449,8 +483,7 @@ effect for exporting link types)." org-modern-hide-stars nil org-tags-column 0 org-modern-keyword nil - org-modern-table nil) - (global-org-modern-mode)) + org-modern-table nil)) (use-package org-taskwise :after org diff --git a/lisp/acdw-web.el b/lisp/acdw-web.el index 36a5ba4..40e1a3d 100644 --- a/lisp/acdw-web.el +++ b/lisp/acdw-web.el @@ -114,6 +114,9 @@ regexp that will not be regexp-quoted when matching against a url." (list :tag "Regexp" regexp) (string :tag "Literal string")))) +(with-eval-after-load 'custom-allowed + (add-to-list 'custom-allowed-variables '+browse-url-external-domains)) + (defun +browse-url-external-url-p (url) "Return t if URL is a member of `+browse-url-external-domains'. This function only tests URL's domain." @@ -125,6 +128,29 @@ This function only tests URL's domain." host) return t))) +(defun +browse-url-external-domain-add (domain &optional regexp?) + "Add DOMAIN to `+browse-url-external-domains'. +If REGEXP? is non-nil, it will note that the domain is a regexp. +This function will also save `custom-file' with the updated value." + (interactive (pcase current-prefix-arg + (`nil + (list (read-from-minibuffer "Domain: ") + nil)) + (`(4) + (list (read-from-minibuffer "Domain regex: ") + t)) + (_ + (list (read-from-minibuffer "Domain: ") + (y-or-n-p "Regex? "))))) + (let ((new (funcall (if regexp? #'list #'identity) + domain))) + (custom-set-variables + `(+browse-url-external-domains + ',(add-to-list '+browse-url-external-domains new))) + (with-current-buffer (find-file-noselect custom-file) + (custom-save-variables)) + (message "%s added to `+browse-url-external-domains'." + domain))) ;;; Downloading @@ -165,6 +191,34 @@ This function only tests URL's domain." ;;; Packages (use-package eww + :preface + (defun bookmark-eww--make () + "Make eww bookmark record." + `((filename . ,(plist-get eww-data :url)) + (title . ,(plist-get eww-data :title)) + (time . ,(current-time-string)) + (handler . ,#'bookmark-eww-handler) + (defaults . (,(concat + ;; url without the https and path + (replace-regexp-in-string + "/.*" "" + (replace-regexp-in-string + "\\`https?://" "" + (plist-get eww-data :url))) + " - " + ;; page title + (replace-regexp-in-string + "\\` +\\| +\\'" "" + (replace-regexp-in-string + "[\n\t\r ]+" " " + (plist-get eww-data :title)))))))) + (defun bookmark-eww-handler (bm) + "Handler for eww bookmarks." + (eww-browse-url (alist-get 'filename bm))) + (defun bookmark-eww--setup () + "Setup eww bookmark integration." + (setq-local bookmark-make-record-function #'bookmark-eww--make)) + :commands (eww eww-browse-url) :config (setopt eww-use-browse-url ".") (add-hook 'eww-mode-hook @@ -181,7 +235,12 @@ This function only tests URL's domain." browse-url-secondary-browser-function (or url (plist-get eww-data :url))) (:success (when (null url) (quit-window))) ; Interactive use - (t (signal (car e) (cdr e))))))) + (t (signal (car e) (cdr e)))))) + (add-hook 'eww-mode-hook #'bookmark-eww--setup) + (define-key eww-mode-map "b" #'bookmark-set) + (define-key eww-mode-map "B" #'bookmark-jump) + (define-key eww-mode-map (kbd "M-n") nil) + (define-key eww-mode-map (kbd "M-p") nil)) (use-package browse-url :demand t @@ -204,7 +263,8 @@ This function only tests URL's domain." . +browse-url-with-mpv) ;; Images (,(+browse-url-matches "pbs\\.twimg\\.com" - (rx "." (or "jpeg" "jpg" "png" "bmp" "webp") + (rx "." (or "jpeg" "jpg" "png" "pn" + "bmp" "webp") eos)) . +browse-url-with-mpv-image) ;; Blobs @@ -214,16 +274,18 @@ This function only tests URL's domain." (+browse-url-external-url-p . ,browse-url-secondary-browser-function)) ;; External domains - +browse-url-external-domains '("github.com" "gitlab.com" "codeberg.org" - "tildegit.org" "git.tilde.town" - "google.com" "imgur.com" "twitch.tv" - "pixelfed" "instagram.com" - "bibliogram.art" "reddit.com" - "teddit.net" "libreddit.de" - "streamable.com" "spotify.com" - "hetzner.cloud" "melpa.org" - "twitter.com" ("^t\\.co$") - "nitter.snopyta.org" "nitter.net")) + ;; +browse-url-external-domains + ;; '("github.com" "gitlab.com" "codeberg.org" + ;; "tildegit.org" "git.tilde.town" + ;; "google.com" "imgur.com" "twitch.tv" + ;; "pixelfed" "instagram.com" + ;; "bibliogram.art" "reddit.com" + ;; "teddit.net" "libreddit.de" + ;; "streamable.com" "spotify.com" + ;; "hetzner.cloud" "melpa.org" + ;; "twitter.com" ("^t\\.co$") + ;; "nitter.snopyta.org" "nitter.net") + ) ;; External browsers: firefox > chromium > chrome (when-let ((firefox (choose-executable "firefox" "firefox-esr"))) @@ -268,14 +330,16 @@ This function only tests URL's domain." :bind (("M-l M-l" . +link-hint-open-link) ("M-l l" . +link-hint-open-link) - ("M-l M-o" . +link-hint-open-secondary) - ("M-l o" . +link-hint-open-secondary) + ("M-l M-o" . +link-hint-open:secondary) + ("M-l o" . +link-hint-open:secondary) ("M-l M-m" . +link-hint-open-multiple-links) ("M-l m" . +link-hint-open-multiple-links) ("M-l M-w" . link-hint-copy-link) ("M-l w" . link-hint-copy-link) - ("M-l M-c" . +link-hint-open-chrome) - ("M-l c" . +link-hint-open-chrome)) + ("M-l M-c" . +link-hint-open:chrome) + ("M-l c" . +link-hint-open:chrome) + ("M-l M-d" . +link-hint-open:download) + ("M-l d" . +link-hint-open:download)) :config (require '+link-hint) (setopt link-hint-avy-style 'at-full @@ -286,8 +350,9 @@ This function only tests URL's domain." ;; another package's configuration, but I don't care enough to fix it. (setq link-hint-types (delq 'link-hint-completion-list-candidate link-hint-types)) - (+link-hint-open-secondary-setup) - (+link-hint-open-chrome-setup)) + ;; (+link-hint-open-secondary-setup) + ;; (+link-hint-open-chrome-setup) + ) (provide 'acdw-web) ;;; acdw-web.el ends here diff --git a/lisp/acdw.el b/lisp/acdw.el index 46079f6..63291d3 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -184,7 +184,9 @@ prefix ARG is non-nil; then it just saves them." (user-error "Buffer not attached to file")) (hack-dir-local-variables) (let ((print-level nil) - (print-length nil)) + (print-length nil) + (before-save-hook nil) + (after-save-hook nil)) (when-let ((new-words (cl-remove-if (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA ; where this came from @@ -330,5 +332,46 @@ include the time. When called with \\[universal-argument] (fill-paragraph-function nil)) (fill-paragraph))) +(defun fill-with-double-spaced-sentences-dwim (&optional start end) + "Fill paragraph or region, double-spacing sentences." + (interactive) + (let ((sentence-end-double-space t)) + (unless (region-active-p) + (mark-paragraph)) + (repunctuate-sentences :no-query + (region-beginning) + (region-end)) + (fill-region (region-beginning) + (region-end)))) + +(defun fill-with-double-spaced-sentences-dwim (&optional start end) + "Fill from START to END, double-spacing sentences. +If START to END aren't given, or if a region isn't in use, fill +the current paragraph." + (interactive "*r") + (let ((sentence-end-double-space t)) + (save-mark-and-excursion + (save-restriction + (unless (region-active-p) + (setq start (progn (start-of-paragraph-text) + (point)) + end (progn (end-of-paragraph-text) + (point)))) + (narrow-to-region start end) + (goto-char (point-min)) + (repunctuate-sentences :no-query) + (fill-region (point-min) + (point-max)))))) + +(defun acdw-elisp-package-prepare (&optional file) + "Do all the elisp-package-preparing stuff on FILE. +If FILE is nil or not given, do it on the current buffer." + (with-current-buffer (if file (find-file-noselect file) (current-buffer)) + (check-parens) + (checkdoc) + (package-lint-buffer) + ;; TODO: use `lm-commentary' to write to README.org + )) + (provide 'acdw) ;;; acdw.el ends here diff --git a/lisp/ical2org.el b/lisp/ical2org.el new file mode 100644 index 0000000..2716787 --- /dev/null +++ b/lisp/ical2org.el @@ -0,0 +1,56 @@ +;;; ical2org.el --- Run ical2org in Emacs -*- lexical-binding: t; -*- + +;;; Commentary: + +;; based on code from this reddit thread: +;; https://www.reddit.com/r/emacs/comments/8s1ion/ical2org_integrations/ +;; +;; see also: icalendar.org (converts to diary format, might be all I need) +;; +;; XXX: This code currently imports into gnus, which isn't what I want. + +;;; Code: + +(defun ical2org (&optional replace output-buffer) + "Run ical2org on contents of this buffer. +If REPLACE (interactive prefix argument), replace contents of the +buffer. If no REPLACE nor OUTPUT-BUFFER, output goes to +minibuffer." + (interactive "P") + (shell-command-on-region (point-min) (point-max) + "ical2org" + output-buffer + replace + "*ical2org errors*" + 'display-errors)) + +(defun ical2org-capture () + "Run `ical2org' on this buffer, then `org-capture' the result. +Leaves current buffer as-was afterwards." + (interactive) + (let ((buf (current-buffer)) + (ics (buffer-string))) + (ical2org 'replace) + (mark-whole-buffer) + (call-interactively #'org-capture) + (with-current-buffer buf + (delete-region (point-min) (point-max)) + (insert ics)))) + +(defun my-gnus-org-capture-icalendar () + "Capture any text/calendar invites with org." + (interactive) + (with-current-buffer gnus-article-buffer ;;; XXX + (save-excursion + (dolist (part gnus-article-mime-handle-alist) + (when (and (>= (length part) 3) + (listp (caddr part)) + (or (equal "application/ics" (caaddr part)) + (equal "text/calendar" (caaddr part)))) + (save-window-excursion + (gnus-mime-copy-part (cdr part)) + (ical2org-capture))))))) +(add-hook 'gnus-article-prepare-hook #'my-gnus-org-capture-icalendar) + +(provide 'ical2org) +;;; ical2org.el ends here -- cgit 1.4.1-21-gabe81