2021-11-22 05:57:41 +00:00
;;; +org.el -*- lexical-binding: t; -*-
2021-09-14 03:09:56 +00:00
2021-03-12 23:20:49 +00:00
;;; Code:
2021-09-14 03:09:56 +00:00
( require 'org )
( require 'org-element )
( require 'ox )
2022-02-17 05:11:16 +00:00
;;; org-return-dwim - [[https://github.com/alphapapa/unpackaged.el][unpackaged]] and [[http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/][kitchin]]
2021-03-12 23:20:49 +00:00
2021-11-22 05:57:41 +00:00
( defun +org-element-descendant-of ( type element )
2021-03-12 23:20:49 +00:00
" Return non-nil if ELEMENT is a descendant of TYPE.
TYPE should be an element type, like ` item ' or ` paragraph '.
2021-04-13 22:44:52 +00:00
ELEMENT should be a list like that returned by ` org-element-context '. "
2021-03-12 23:20:49 +00:00
;; MAYBE: Use `org-element-lineage'.
( when-let* ( ( parent ( org-element-property :parent element ) ) )
( or ( eq type ( car parent ) )
2021-11-22 05:57:41 +00:00
( +org-element-descendant-of type parent ) ) ) )
2021-03-12 23:20:49 +00:00
2021-11-22 05:57:41 +00:00
( defun +org-return-dwim ( &optional prefix )
2021-09-14 03:09:56 +00:00
" A helpful replacement for `org-return' . With PREFIX, call `org-return' .
2021-03-12 23:20:49 +00:00
On headings, move point to position after entry content. In
lists, insert a new item or end the list, with checkbox if
appropriate. In tables, insert a new row or end the table. "
( interactive " P " )
2021-04-14 22:06:59 +00:00
;; Auto-fill if enabled
( when auto-fill-function
( if ( listp auto-fill-function )
( dolist ( func auto-fill-function )
( funcall func ) )
( funcall auto-fill-function ) ) )
2021-09-14 03:09:56 +00:00
( if prefix
2021-08-20 22:27:54 +00:00
;; Handle prefix args
2021-09-14 03:09:56 +00:00
( pcase prefix
2021-08-20 22:27:54 +00:00
( ' ( 4 ) ( newline ) )
( ' ( 16 ) ( newline 2 ) )
;; this is ... not ideal. but whatever.
2021-09-14 03:09:56 +00:00
( _ ( newline prefix ) ) )
2021-03-12 23:20:49 +00:00
( cond
2021-04-12 22:58:33 +00:00
;; Act depending on context around point.
2021-08-20 22:28:09 +00:00
( ( and org-return-follows-link
( eq 'link ( car ( org-element-context ) ) ) )
;; Link: Open it.
( org-open-at-point-global ) )
2021-04-12 22:58:33 +00:00
( ( org-at-heading-p )
2021-04-13 22:44:52 +00:00
;; Heading: Move to position after entry content.
;; NOTE: This is probably the most interesting feature of this function.
2021-04-12 22:58:33 +00:00
( let ( ( heading-start ( org-entry-beginning-position ) ) )
( goto-char ( org-entry-end-position ) )
( cond ( ( and ( org-at-heading-p )
( = heading-start ( org-entry-beginning-position ) ) )
;; Entry ends on its heading; add newline after
( end-of-line )
( insert " \n \n " ) )
( t
;; Entry ends after its heading; back up
( forward-line -1 )
( end-of-line )
( when ( org-at-heading-p )
;; At the same heading
( forward-line )
( insert " \n " )
( forward-line -1 ) )
2021-09-14 03:09:56 +00:00
( while ( not
( looking-back
( rx ( repeat 3 ( seq ( optional blank ) " \n " ) ) )
nil ) )
2021-04-12 22:58:33 +00:00
( insert " \n " ) )
( forward-line -1 ) ) ) ) )
( ( org-at-item-checkbox-p )
;; Checkbox: Insert new item with checkbox.
( org-insert-todo-heading nil ) )
( ( org-in-item-p )
2021-04-13 22:45:11 +00:00
;; Plain list
( let* ( ( context ( org-element-context ) )
( first-item-p ( eq 'plain-list ( car context ) ) )
( itemp ( eq 'item ( car context ) ) )
2022-02-19 00:18:37 +00:00
( emptyp ( or
;; Empty list item (regular)
( eq ( org-element-property :contents-begin context )
( org-element-property :contents-end context ) )
;; Empty list item (definition)
;; This seems to work, with minimal testing. -- 2022-02-17
( looking-at " *:: " ) ) )
2021-04-13 22:45:11 +00:00
( item-child-p
2021-11-22 05:57:41 +00:00
( +org-element-descendant-of 'item context ) ) )
2021-04-13 22:45:11 +00:00
;; The original function from unpackaged just tested the (or ...) test
;; in this cond, in an if. However, that doesn't auto-end nested
;; lists. So I made this form a cond and added the (and...) test in
;; the first position, which is clunky (the delete-region... stuff
;; comes twice) and might not be needed. More testing, obviously, but
;; for now, it works well enough.
( cond ( ( and itemp emptyp )
( delete-region ( line-beginning-position ) ( line-end-position ) )
2021-04-14 22:06:59 +00:00
( insert " \n \n " ) )
2021-04-13 22:45:11 +00:00
( ( or first-item-p
( and itemp ( not emptyp ) )
item-child-p )
( org-insert-item ) )
( t ( delete-region ( line-beginning-position ) ( line-end-position ) )
2021-04-14 22:06:59 +00:00
( insert " \n " ) ) ) ) )
2021-04-12 22:58:33 +00:00
( ( when ( fboundp 'org-inlinetask-in-task-p )
( org-inlinetask-in-task-p ) )
;; Inline task: Don't insert a new heading.
( org-return ) )
( ( org-at-table-p )
( cond ( ( save-excursion
( beginning-of-line )
;; See `org-table-next-field'.
( cl-loop with end = ( line-end-position )
for cell = ( org-element-table-cell-parser )
2021-04-13 22:44:52 +00:00
always ( equal ( org-element-property :contents-begin cell )
( org-element-property :contents-end cell ) )
2021-04-12 22:58:33 +00:00
while ( re-search-forward " | " end t ) ) )
;; Empty row: end the table.
2021-04-13 22:44:52 +00:00
( delete-region ( line-beginning-position ) ( line-end-position ) )
2021-04-12 22:58:33 +00:00
( org-return ) )
( t
;; Non-empty row: call `org-return'.
( org-return ) ) ) )
( t
;; All other cases: call `org-return'.
( org-return ) ) ) ) )
2021-03-12 23:20:49 +00:00
2021-11-22 05:57:41 +00:00
( defun +org-table-copy-down ( n )
" Call `org-table-copy-down' , or `org-return' outside of a table.
N is passed to the functions. "
( interactive " p " )
( if ( org-table-check-inside-data-field 'noerror )
( org-table-copy-down n )
( +org-return-dwim n ) ) )
;;; org-fix-blank-lines - unpackaged.el
( defun +org-fix-blank-lines ( &optional prefix )
2021-09-14 03:09:56 +00:00
" Ensure blank lines around headings.
Optional PREFIX argument operates on the entire buffer.
Drawers are included with their headings. "
2021-03-12 23:20:49 +00:00
( interactive " P " )
2022-04-24 20:00:41 +00:00
( let ( ( org-element-use-cache nil ) )
( org-map-entries ( lambda ( )
( let ( ( beg ( org-entry-beginning-position ) )
( end ( org-entry-end-position ) ) )
( org-with-wide-buffer
;; `org-map-entries' narrows the buffer, which
;; prevents us from seeing newlines before the
;; current heading, so we do this part widened.
( while ( not ( looking-back " \n \n " nil ) )
;; Insert blank lines before heading.
( insert " \n " ) ) )
;; Insert blank lines before entry content
( forward-line )
( while ( and ( org-at-planning-p )
( < ( point ) ( point-max ) ) )
;; Skip planning lines
( forward-line ) )
( while ( re-search-forward
org-drawer-regexp end t )
;; Skip drawers. You might think that
;; `org-at-drawer-p' would suffice, but for
;; some reason it doesn't work correctly when
;; operating on hidden text. This works, taken
;; from `org-agenda-get-some-entry-text'.
( re-search-forward " ^[ \t ]*:END:.* \n ? " end t )
( goto-char ( match-end 0 ) ) )
( unless ( or ( = ( point ) ( point-max ) )
( org-at-heading-p )
( looking-at-p " \n " ) )
( insert " \n " ) ) ) )
t
( if prefix
nil
'tree ) ) ) )
2021-03-12 23:20:49 +00:00
2021-11-22 05:57:41 +00:00
;;; org-count-words
2021-04-12 22:58:33 +00:00
2021-11-22 05:57:41 +00:00
( defun +org-count-words-stupidly ( start end &optional limit )
2021-08-13 22:06:36 +00:00
" Count words between START and END, ignoring a lot.
Since this function is, for some reason, pricy, the optional
parameter LIMIT sets a word limit at which to stop counting.
2021-08-14 23:00:12 +00:00
Once the function hits that number, it 'll return -LIMIT
2021-08-13 22:06:36 +00:00
instead of the true count. "
2021-08-07 20:07:04 +00:00
( interactive ( list nil nil ) )
( cond ( ( not ( called-interactively-p 'any ) )
2021-08-13 22:06:36 +00:00
( let ( ( words 0 )
( continue t ) )
2021-08-07 20:07:04 +00:00
( save-excursion
( save-restriction
( narrow-to-region start end )
( goto-char ( point-min ) )
2021-08-13 22:06:36 +00:00
( while ( and continue
( < ( point ) ( point-max ) ) )
2021-08-07 20:07:04 +00:00
( cond
;; Ignore comments
( ( or ( org-at-comment-p )
( org-in-commented-heading-p ) )
( forward-line ) )
;; Ignore headings
( ( or ( org-at-heading-p ) )
( forward-line ) )
2021-10-06 21:50:40 +00:00
;; Ignore property and log drawers
2021-08-07 20:07:04 +00:00
( ( or ( looking-at org-drawer-regexp )
( looking-at org-clock-drawer-re ) )
2021-08-16 14:12:06 +00:00
( search-forward " :END: " nil :noerror )
( forward-line ) )
2021-10-06 21:50:40 +00:00
;; Ignore DEADLINE and SCHEDULED keywords
( ( or ( looking-at org-deadline-regexp )
2021-10-06 22:04:25 +00:00
( looking-at org-scheduled-regexp )
( looking-at org-closed-time-regexp ) )
2021-10-06 21:50:40 +00:00
( forward-line ) )
2021-08-14 23:00:12 +00:00
;; Ignore tables
( ( org-at-table-p ) ( forward-line ) )
;; Ignore hyperlinks, but count the descriptions
2021-09-14 03:09:56 +00:00
( ( looking-at org-link-bracket-re )
2021-08-14 23:00:12 +00:00
( when-let ( ( desc ( match-string-no-properties 5 ) ) )
( save-match-data
( setq words ( + words
( length ( remove " "
( org-split-string
desc " \\ W " ) ) ) ) ) ) )
( goto-char ( match-end 0 ) ) )
;; Ignore source blocks
2021-09-09 21:40:45 +00:00
( ( org-in-src-block-p ) ( forward-line ) )
2021-09-28 15:01:38 +00:00
;; Ignore blank lines
( ( looking-at " ^$ " )
( forward-line ) )
2021-08-07 20:07:04 +00:00
;; Count everything else
2021-08-14 23:00:12 +00:00
( t
;; ... unless it's in a few weird contexts
( let ( ( contexts ( org-context ) ) )
( cond ( ( or ( assoc :todo-keyword contexts )
( assoc :priority contexts )
( assoc :keyword contexts )
( assoc :checkbox contexts ) )
( forward-word-strictly ) )
2021-11-22 05:57:41 +00:00
2021-08-14 23:00:12 +00:00
( t ( setq words ( 1+ words ) )
( if ( and limit
( > words limit ) )
( setq words ( - limit )
continue nil ) )
( forward-word-strictly ) ) ) ) ) ) ) ) )
2021-08-07 20:07:04 +00:00
words ) )
( ( use-region-p )
( message " %d words in region "
2021-11-22 05:57:41 +00:00
( +org-count-words-stupidly ( region-beginning )
2021-08-07 20:07:04 +00:00
( region-end ) ) ) )
( t
( message " %d words in buffer "
2021-11-22 05:57:41 +00:00
( +org-count-words-stupidly ( point-min )
2021-08-07 20:07:04 +00:00
( point-max ) ) ) ) ) )
2021-11-22 05:57:41 +00:00
;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/
2021-06-02 03:30:05 +00:00
2022-02-03 00:28:45 +00:00
( defun +org-insert--get-title-and-headings ( url )
" Retrieve title and headings from URL.
Return as a list. "
( with-current-buffer ( url-retrieve-synchronously url )
( let ( ( dom ( libxml-parse-html-region ( point-min ) ( point-max ) ) ) )
( cl-remove-if
( lambda ( i ) ( string= i " " ) )
( apply #' append ( mapcar ( lambda ( tag )
( mapcar #' dom-text
( dom-by-tag dom tag ) ) )
' ( title h1 h2 h3 h4 h5 h6 ) ) ) ) ) ) )
2022-01-07 23:30:46 +00:00
( defun +org-insert-link-dwim ( &optional interactivep )
2021-06-02 03:30:05 +00:00
" Like `org-insert-link' but with personal dwim preferences. "
2022-01-07 23:30:46 +00:00
( interactive ' ( t ) )
2021-06-02 03:30:05 +00:00
( let* ( ( point-in-link ( org-in-regexp org-link-any-re 1 ) )
( clipboard-url ( when ( string-match-p
( rx ( sequence bos
( or " http "
" gemini "
2022-02-17 05:11:16 +00:00
" gopher "
" tel "
" mailto " ) ) )
2021-06-02 03:30:05 +00:00
( current-kill 0 ) )
( current-kill 0 ) ) )
( region-content ( when ( region-active-p )
( buffer-substring-no-properties ( region-beginning )
2022-01-07 23:30:46 +00:00
( region-end ) ) ) )
2022-02-03 00:28:45 +00:00
( org-link ( when ( and clipboard-url ( not point-in-link ) )
2022-01-07 23:30:46 +00:00
( org-link-make-string
2022-01-31 23:27:21 +00:00
( string-trim clipboard-url )
2022-01-07 23:30:46 +00:00
( or region-content
2022-02-03 00:28:45 +00:00
( let ( ( clipboard-headings
( +org-insert--get-title-and-headings clipboard-url ) ) )
( read-string " title (edit): "
( completing-read
" title: " clipboard-headings
nil nil nil nil ( car clipboard-headings ) ) ) ) ) ) ) ) )
2022-01-07 23:30:46 +00:00
( if interactivep
( cond ( ( and region-content clipboard-url ( not point-in-link ) )
( delete-region ( region-beginning ) ( region-end ) )
( insert org-link ) )
( ( and clipboard-url ( not point-in-link ) )
( insert org-link ) )
( t
( call-interactively 'org-insert-link ) ) )
org-link ) ) )
2021-06-02 03:30:05 +00:00
2021-11-22 05:57:41 +00:00
;;; Navigate headings with widening
( defun +org-next-heading-widen ( arg )
2021-09-14 03:09:56 +00:00
" Find the ARGth next org heading, widening if necessary. "
2021-08-27 04:30:43 +00:00
( interactive " p " )
2021-09-01 22:15:36 +00:00
( let ( ( current-point ( point ) )
( point-target ( if ( > arg 0 ) ( point-max ) ( point-min ) ) ) )
( org-next-visible-heading arg )
( when ( and ( buffer-narrowed-p )
( = ( point ) point-target )
( or ( and ( > arg 0 ) )
( and ( < arg 0 )
( = ( point ) current-point ) ) ) )
( widen )
( org-next-visible-heading arg ) ) ) )
2021-08-27 04:30:43 +00:00
2021-11-22 05:57:41 +00:00
( defun +org-previous-heading-widen ( arg )
2021-09-14 03:09:56 +00:00
" Find the ARGth previous org heading, widening if necessary. "
2021-08-27 04:30:43 +00:00
( interactive " p " )
2021-11-22 05:57:41 +00:00
( +org-next-heading-widen ( - arg ) ) )
2021-09-01 22:16:29 +00:00
2021-11-22 05:57:41 +00:00
;;; Hooks & Advice
2021-10-07 23:23:13 +00:00
2022-01-24 19:24:50 +00:00
( defvar +org-before-save-prettify-buffer t
" Prettify org buffers before saving. " )
( put '+org-before-save-prettify-buffer 'safe-local-variable #' booleanp )
2021-11-22 05:57:41 +00:00
( defun +org-before-save@prettify-buffer ( )
2022-01-24 19:24:50 +00:00
( when +org-before-save-prettify-buffer
( save-mark-and-excursion
2022-04-24 20:00:58 +00:00
( +org-unsmartify )
( +org-fix-blank-lines t )
( org-align-tags t )
( when ( buffer-narrowed-p )
( goto-char ( point-min ) )
( forward-line 1 )
( org-narrow-to-subtree ) ) ) ) )
2021-10-07 23:23:13 +00:00
2021-11-22 05:57:41 +00:00
( defun +org-delete-backward-char ( N )
" Keep tables aligned while deleting N characters backward.
When deleting backwards, in tables this function will insert
whitespace in front of the next \"|\" separator, to keep the
table aligned. The table will still be marked for re-alignment
if the field did fill the entire column, because, in this case
the deletion might narrow the column. "
( interactive " p " )
( save-match-data
( org-check-before-invisible-edit 'delete-backward )
( if ( and ( = N 1 )
( not overwrite-mode )
( not ( org-region-active-p ) )
( not ( eq ( char-before ) ?| ) )
( save-excursion ( skip-chars-backward " \t " ) ( not ( bolp ) ) )
( looking-at-p " .*?| " )
( org-at-table-p ) )
( progn ( forward-char -1 ) ( org-delete-char 1 ) )
( backward-delete-char-untabify N )
( org-fix-tags-on-the-fly ) ) ) )
2021-09-14 03:09:56 +00:00
2021-12-13 16:29:50 +00:00
;;; Smarter {super,sub}scripts
;; https://old.reddit.com/r/emacs/comments/qzlzm0/what_are_your_top_key_bindings_rebindings_minor/hmwyhm3/
;; I don't use this currently because I found out about
;; `org-pretty-entities-include-sub-superscripts', which really does exactly
;; what I wanted.
2022-02-17 05:11:57 +00:00
( defface +org-script-markers ' ( ( t ( :inherit shadow ) ) )
2021-12-13 16:29:50 +00:00
" Face to be used for sub/superscripts markers i.e., ^, _, {, }. " )
;; Hiding the super and subscript markers is extremely annoying
;; since any remotely complex equation becomes a chore. And leaving
;; it not raised is jarring to the eye. So this fontifies the
;; buffer just like how auctex does -- use a muted colour to
;; highlight the markup and raise the script.
( defun +org-raise-scripts ( limit )
" Differences from `org-raise-scripts' are:
- It doesn 't actually hide the markup used for super and subscript.
- It uses a custom face to highlight the markup: +org-script-markers.
- It doesn 't require ` org-pretty-entities ' to be t. "
( when ( and org-pretty-entities-include-sub-superscripts
( re-search-forward
( if ( eq org-use-sub-superscripts t )
org-match-substring-regexp
org-match-substring-with-braces-regexp )
limit t ) )
( let* ( ( pos ( point ) ) table-p comment-p
( mpos ( match-beginning 3 ) )
( emph-p ( get-text-property mpos 'org-emphasis ) )
( link-p ( get-text-property mpos 'mouse-face ) )
( keyw-p ( eq 'org-special-keyword ( get-text-property mpos 'face ) ) ) )
( goto-char ( point-at-bol ) )
( setq table-p ( looking-at-p org-table-dataline-regexp )
comment-p ( looking-at-p " ^[ \t ]*#[ +] " ) )
( goto-char pos )
;; Handle a_b^c
( when ( member ( char-after ) ' ( ?_ ?^ ) ) ( goto-char ( 1- pos ) ) )
( unless ( or comment-p emph-p link-p keyw-p )
( put-text-property ( match-beginning 3 ) ( match-end 0 )
'display
( if ( equal ( char-after ( match-beginning 2 ) ) ?^ )
;; (nth (if table-p 3 1) org-script-display)
( nth 3 org-script-display )
;; (nth (if table-p 2 0) org-script-display)
( nth 2 org-script-display ) ) )
( put-text-property ( match-beginning 2 ) ( match-end 2 )
2022-02-17 05:11:57 +00:00
'face '+org-script-markers )
2021-12-13 16:29:50 +00:00
( when ( and ( eq ( char-after ( match-beginning 3 ) ) ?{ )
( eq ( char-before ( match-end 3 ) ) ?} ) )
( put-text-property ( match-beginning 3 ) ( 1+ ( match-beginning 3 ) )
'face '+org-script-markers )
( put-text-property ( 1- ( match-end 3 ) ) ( match-end 3 )
'face '+org-script-markers ) ) )
t ) ) )
2021-12-18 00:31:24 +00:00
;; Extra link types
( defun +org-tel-open ( number _ )
" Notify the user of what phone NUMBER to call. "
( message " Call: %s " number ) )
2022-02-07 04:16:51 +00:00
( defun +org-sms-open ( number _ )
" Notify the user of what phone NUMBER to text. "
( message " SMS: %s " number ) )
2022-01-07 00:01:27 +00:00
;; Make a horizontal rule!
( defun +org-horizontal-rule ( )
" Make a horizontal rule after the current line. "
( interactive nil org-mode )
( unless ( eq ( line-beginning-position ) ( line-end-position ) )
( end-of-line )
( newline ) )
( dotimes ( _ fill-column )
( insert " - " ) ) )
2022-01-07 23:30:46 +00:00
;; Follow links, DWIM style
( defun +org-open-at-point-dwim ( &optional arg )
" Open thing at point, or if there isn't something, list things. "
( interactive " P " )
( save-excursion
2022-01-17 19:45:32 +00:00
( let* ( ( this-char-type ( org-element-type ( org-element-context ) ) )
2022-01-11 05:52:02 +00:00
( prev-char-type ( ignore-errors
( save-excursion
( backward-char )
( org-element-type ( org-element-context ) ) ) ) )
2022-01-07 23:30:46 +00:00
( types ' ( citation citation-reference clock comment comment-block
footnote-definition footnote-reference headline
inline-src-block inlinetask keyword link
node-property planning src-block timestamp ) )
( type this-char-type ) )
( when ( and ( memq this-char-type types ) ( memq prev-char-type types ) )
( backward-char )
( setq type prev-char-type ) ) ; what the fuckckckckck
2022-01-18 23:18:06 +00:00
;; Okay, so this ^ is pretty janky and doesn't /really/ work that well,
;; especially on DEADLINE (and probably SCHEDULED) lines. However, since
;; I really just want to open the list of URLs /most of the time/, I'm
;; fixing it like this instead.
( unless ( and ( memq type types )
2022-02-17 05:11:57 +00:00
( ignore-errors ( org-open-at-point arg )
t ) )
2022-01-07 23:30:46 +00:00
( while ( not
( progn
( org-back-to-heading )
( car ( org-offer-links-in-entry ( current-buffer ) ( point ) 1 ) ) ) )
( org-up-heading-all 1 ) )
( org-open-at-point arg ) ) ) ) )
2022-01-17 23:12:34 +00:00
;;; Open local HTML files with `browse-url'
( defun +org-open-html ( file-path link-string )
" Open FILE-PATH with `browse-url' .
This function is intended to use with ` org-file-apps '. See the
2022-01-19 00:16:01 +00:00
documentation of that function for a description of the two
arguments here, FILE-PATH and LINK-STRING. "
2022-01-17 23:12:34 +00:00
( message " Opening %s (%s)... " file-path link-string )
( browse-url file-path ) )
2022-01-19 00:16:01 +00:00
( defun +org-insert-horizontal-rule ( prefix )
" Insert a horizontal rule (-----) after the current line.
With PREFIX, insert before the current line. "
( interactive " P " )
( if prefix
( move-beginning-of-line nil )
( move-end-of-line nil )
( forward-line 1 ) )
( insert " ----- \n " ) )
;;; Make code snippets in org-mode easier to type
;; http://mbork.pl/2022-01-17_Making_code_snippets_in_Org-mode_easier_to_type
( defun +org-insert-backtick ( )
" Insert a backtick using `org-self-insert-command' . "
( interactive )
( setq last-command-event ?` )
( call-interactively #' org-self-insert-command ) )
( defvar-local +org-insert-tilde-language nil
" Default language name in the current Org file.
If nil , ` org-insert-tilde ' after 2 tildes inserts an \"example\"
block. If a string, it inserts a \"src\" block with the given
language name. " )
( defun +org-insert-tilde ( )
" Insert a tilde using `org-self-insert-command' . "
( interactive )
( if ( string= ( buffer-substring-no-properties ( - ( point ) 3 ) ( point ) )
" \n ~~ " )
( progn ( delete-char -2 )
( if +org-insert-tilde-language
( insert ( format " #+begin_src %s \n #+end_src "
+org-insert-tilde-language ) )
( insert " #+begin_example \n #+end_example " ) )
( forward-line -1 )
( if ( string= +org-insert-tilde-language " " )
( move-end-of-line nil )
;;(org-edit-special) ; Useful really only with splits.
) )
( setq last-command-event ?~ )
( call-interactively #' org-self-insert-command ) ) )
2022-02-17 05:12:02 +00:00
;;; Better org faces
;; see `org-emphasis-alist'
( defface org-bold ' ( ( t ( :weight bold ) ) )
" Bold face in `org-mode' documents. " )
( defface org-italic ' ( ( t ( :slant italic ) ) )
" Italic face in `org-mode' documents. " )
( defface org-underline ' ( ( t ( :underline t ) ) )
" Underline face in `org-mode' documents. " )
( defface org-strikethrough ' ( ( t ( :strike-through t ) ) )
" Strike-through face for `org-mode' documents. " )
;; `org-verbatim' and `org-code' are apparently already things, so we skip them
;; here.
2022-02-23 16:16:48 +00:00
;;; Copy org trees as HTML
;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]].
( defun +org-export-clip-to-html
( &optional async subtreep visible-only body-only ext-plist post-process )
" Export region to HTML, and copy it to the clipboard.
Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST,
and POST-PROCESS are passed to ` org-export-to-file '. "
2022-03-12 02:04:05 +00:00
( interactive ) ; XXX: hould this be interactive?
2022-02-23 16:16:48 +00:00
( message " Exporting Org to HTML... " )
( let ( ( org-tmp-file " /tmp/org.html " ) )
( org-export-to-file 'html org-tmp-file
async subtreep visible-only body-only ext-plist post-process )
( start-process " xclicp " " *xclip* "
" xclip " " -verbose "
" -i " org-tmp-file
" -t " " text/html "
" -selection " " clipboard " ) )
( message " Exporting Org to HTML...done. " ) )
;; Specialized functions
( defun +org-export-clip-subtree-to-html ( )
" Export current subtree to HTML. "
( interactive )
2022-02-28 15:40:33 +00:00
( +org-export-clip-to-html nil :subtree ) )
2022-02-23 16:16:48 +00:00
2022-04-02 18:54:19 +00:00
;;; Unsmartify quotes and dashes and stuff.
( defun +org-unsmartify ( )
" Replace \" smart \" punctuation with their \" dumb \" counterparts. "
( interactive )
( save-excursion
( goto-char ( point-min ) )
( while ( re-search-forward " [“”‘’–—] " nil t )
( let ( ( replace ( pcase ( match-string 0 )
( ( or " “ " " ” " ) " \" " )
( ( or " ‘ " " ’ " ) " ' " )
( " – " " -- " )
( " — " " --- " ) ) ) )
( replace-match replace nil nil ) ) ) ) )
2022-04-27 13:36:35 +00:00
;;; Toggle org-hide-emphasis-markers
( define-minor-mode +org-show-mode
" Show emphasis markers and full links in `org-mode' . "
:lighter " /*/ "
( setq org-hide-emphasis-markers ( not +org-show-mode )
org-link-descriptive ( not +org-show-mode ) )
( funcall ( if +org-show-mode
#' remove-from-invisibility-spec
#' add-to-invisibility-spec )
' ( org-link ) )
( font-lock-update ) )
;;; go forward and backward in the tree, ~ cleanly ~
;; https://stackoverflow.com/a/25201697/10756297
2022-04-27 13:37:11 +00:00
( defun +org-show-next-heading-tidily ( )
" Show next entry, keeping other entries closed. "
( interactive )
( if ( save-excursion ( end-of-line ) ( outline-invisible-p ) )
( progn ( org-show-entry ) ( show-children ) )
( outline-next-heading )
( unless ( and ( bolp ) ( org-on-heading-p ) )
( org-up-heading-safe )
( hide-subtree )
( user-error " Boundary reached " ) )
( org-overview )
( org-reveal t )
( org-show-entry )
( recenter-top-bottom )
( show-children )
( recenter-top-bottom 1 ) ) )
( defun +org-show-previous-heading-tidily ( )
" Show previous entry, keeping other entries closed. "
( interactive )
( let ( ( pos ( point ) ) )
( outline-previous-heading )
( unless ( and ( < ( point ) pos ) ( bolp ) ( org-on-heading-p ) )
( goto-char pos )
( hide-subtree )
( user-error " Boundary reached " ) )
( org-overview )
( org-reveal t )
( org-show-entry )
( recenter-top-bottom )
( show-children )
( recenter-top-bottom 1 ) ) )
;;; Make `org-flag-region' (which folds subtrees) recognize
;; [[https://teddit.net/r/orgmode/comments/u3du0v/how_to_make_orgcycle_respect_and_always_show_the/][from u/yantar92]]
;; (advice-add 'org-flag-region :around #'org-flag-region@unfold-page-breaks)
( defun org-flag-region@unfold-page-breaks ( oldfun from to flag &optional spec )
" ADVICE to unfold all the page-break lines inside a folded region. "
( funcall oldfun from to flag spec )
( when ( and flag ( not ( eq 'visible spec ) ) )
( org-with-point-at from
( while ( re-search-forward " \n \u 000c \n " to t )
( org-flag-region ( match-beginning 0 ) ( match-end 0 ) t 'visible ) ) ) ) )
2021-11-22 05:57:41 +00:00
( provide '+org )
;;; +org.el ends here