nftable-migration
1;;; org-func.el --- -*- lexical-binding: t -*-
2;;
3
4;; https://endlessparentheses.com/updating-org-mode-include-statements-on-the-fly.html
5;;;###autoload
6(defun save-and-update-includes ()
7 "Update the line numbers of #+INCLUDE:s in current buffer.
8Only looks at INCLUDEs that have either :range-begin or :range-end.
9This function does nothing if not in `org-mode', so you can safely
10add it to `before-save-hook'."
11 (interactive)
12 (when (derived-mode-p 'org-mode)
13 (save-excursion
14 (goto-char (point-min))
15 (while (search-forward-regexp
16 "^\\s-*#\\+INCLUDE: *\"\\([^\"]+\\)\".*:range-\\(begin\\|end\\)"
17 nil 'noerror)
18 (let* ((file (expand-file-name (match-string-no-properties 1)))
19 lines begin end)
20 (forward-line 0)
21 (when (looking-at "^.*:range-begin *\"\\([^\"]+\\)\"")
22 (setq begin (match-string-no-properties 1)))
23 (when (looking-at "^.*:range-end *\"\\([^\"]+\\)\"")
24 (setq end (match-string-no-properties 1)))
25 (setq lines (decide-line-range file begin end))
26 (when lines
27 (if (looking-at ".*:lines *\"\\([-0-9]+\\)\"")
28 (replace-match lines :fixedcase :literal nil 1)
29 (goto-char (line-end-position))
30 (insert " :lines \"" lines "\""))))))))
31
32(defun decide-line-range (file begin end)
33 "Visit FILE and decide which lines to include.
34BEGIN and END are regexps which define the line range to use."
35 (let (l r)
36 (save-match-data
37 (with-temp-buffer
38 (insert-file-contents file)
39 (goto-char (point-min))
40 (if (null begin)
41 (setq l "")
42 (search-forward-regexp begin)
43 (setq l (line-number-at-pos (match-beginning 0))))
44 (if (null end)
45 (setq r "")
46 (search-forward-regexp end)
47 (setq r (1+ (line-number-at-pos (match-end 0)))))
48 (format "%s-%s" (+ l 1) (- r 1)))))) ;; Exclude wrapper
49
50(defun vde/get-outline-path (element)
51 "Return the outline path (as a list of titles) for ELEMENT, which is a headline."
52 (let (path)
53 (while (and element (eq (org-element-type element) 'headline))
54 (let ((title (org-element-property :title element)))
55 (when title
56 (push title path)))
57 (setq element (org-element-property :parent element)))
58 (reverse path)))
59
60;;;###autoload
61(defun vde/org-clock-in-any-heading ()
62 "Clock into any Org heading from `org-agenda-files' that is not DONE or CANCELED."
63 (interactive)
64 (let (headings)
65 (dolist (file org-agenda-files)
66 (when (file-exists-p file)
67 (with-current-buffer (find-file-noselect file)
68 (org-map-entries (lambda ()
69 (let* ((element (org-element-context))
70 (todo (org-element-property :todo-keyword element)))
71 (when (not (member todo '("DONE" "CANCELED")))
72 (let* ((path (vde/get-outline-path element)))
73 (push (list :path path
74 :file (buffer-file-name)
75 :position (point))
76 headings)))))
77 t 'file))))
78 (let* (candidates)
79 (dolist (h headings)
80 (let* ((path (plist-get h :path))
81 (path-str (mapconcat 'identity path " > "))
82 (file (plist-get h :file))
83 (candidate (format "%s : %s" path-str (file-name-nondirectory file)))
84 (data (list file (plist-get h :position))))
85 (push (cons candidate data) candidates)))
86 (let* ((selected-candidate (completing-read "Select heading: " candidates))
87 (matching (cl-find-if (lambda (c) (string= (car c) selected-candidate)) candidates)))
88 (when matching
89 (let* ((data (cdr matching))
90 (file (car data))
91 (pos (cadr data)))
92 (find-file file)
93 (goto-char pos)
94 (org-clock-in)))))))
95
96;;;###autoload
97(defun vde/org-next-visible-heading-or-link (&optional arg)
98 "Move to the next visible heading or link, whichever comes first.
99With prefix ARG and the point on a heading(link): jump over subsequent
100headings(links) to the next link(heading), respectively. This is useful
101to skip over a long series of consecutive headings(links)."
102 (interactive "P")
103 (let ((next-heading (save-excursion
104 (org-next-visible-heading 1)
105 (when (org-at-heading-p) (point))))
106 (next-link (save-excursion
107 (when (vde/org-next-visible-link) (point)))))
108 (when arg
109 (if (and (org-at-heading-p) next-link)
110 (setq next-heading nil)
111 (if (and (looking-at org-link-any-re) next-heading)
112 (setq next-link nil))))
113 (cond
114 ((and next-heading next-link) (goto-char (min next-heading next-link)))
115 (next-heading (goto-char next-heading))
116 (next-link (goto-char next-link)))))
117
118;;;###autoload
119(defun vde/org-previous-visible-heading-or-link (&optional arg)
120 "Move to the previous visible heading or link, whichever comes first.
121With prefix ARG and the point on a heading(link): jump over subsequent
122headings(links) to the previous link(heading), respectively. This is useful
123to skip over a long series of consecutive headings(links)."
124 (interactive "P")
125 (let ((prev-heading (save-excursion
126 (org-previous-visible-heading 1)
127 (when (org-at-heading-p) (point))))
128 (prev-link (save-excursion
129 (when (vde/org-next-visible-link t) (point)))))
130 (when arg
131 (if (and (org-at-heading-p) prev-link)
132 (setq prev-heading nil)
133 (if (and (looking-at org-link-any-re) prev-heading)
134 (setq prev-link nil))))
135 (cond
136 ((and prev-heading prev-link) (goto-char (max prev-heading prev-link)))
137 (prev-heading (goto-char prev-heading))
138 (prev-link (goto-char prev-link)))))
139
140;; Adapted from org-next-link to only consider visible links
141;;;###autoload
142(defun vde/org-next-visible-link (&optional search-backward)
143 "Move forward to the next visible link.
144When SEARCH-BACKWARD is non-nil, move backward."
145 (interactive)
146 (let ((pos (point))
147 (search-fun (if search-backward #'re-search-backward
148 #'re-search-forward)))
149 ;; Tweak initial position: make sure we do not match current link.
150 (cond
151 ((and (not search-backward) (looking-at org-link-any-re))
152 (goto-char (match-end 0)))
153 (search-backward
154 (pcase (org-in-regexp org-link-any-re nil t)
155 (`(,beg . ,_) (goto-char beg)))))
156 (catch :found
157 (while (funcall search-fun org-link-any-re nil t)
158 (let ((folded (org-invisible-p nil t)))
159 (when (or (not folded) (eq folded 'org-link))
160 (let ((context (save-excursion
161 (unless search-backward (forward-char -1))
162 (org-element-context))))
163 (pcase (org-element-lineage context '(link) t)
164 (link
165 (goto-char (org-element-property :begin link))
166 (throw :found t)))))))
167 (goto-char pos)
168 ;; No further link found
169 nil)))
170
171;;;###autoload
172(defun vde/org-shifttab (&optional arg)
173 "Move to the previous visible heading or link.
174If already at a heading, move first to its beginning. When inside a table,
175move to the previous field."
176 (interactive "P")
177 (cond
178 ((org-at-table-p) (call-interactively #'org-table-previous-field))
179 ((and (not (bolp)) (org-at-heading-p)) (beginning-of-line))
180 (t (call-interactively #'vde/org-previous-visible-heading-or-link))))
181
182;;;###autoload
183(defun vde/org-tab (&optional arg)
184 "Move to the next visible heading or link.
185When inside a table, re-align the table and move to the next field."
186 (interactive)
187 (cond
188 ((org-at-table-p) (org-table-justify-field-maybe)
189 (call-interactively #'org-table-next-field))
190 (t (call-interactively #'vde/org-next-visible-heading-or-link))))
191
192(provide 'org-func)
193;;; org-func.el ends here