mirror of
https://github.com/pestctrl/emacs-config.git
synced 2026-02-16 08:14:15 +00:00
430 lines
19 KiB
Org Mode
430 lines
19 KiB
Org Mode
* Filter by top heading, but only top todo heading
|
|
#+begin_src emacs-lisp
|
|
(defun my/org-find-parent (pos)
|
|
(save-excursion
|
|
(with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
|
|
(when pos (goto-char pos))
|
|
;; Skip up to the topmost parent.
|
|
(while (save-excursion
|
|
(org-up-heading-safe)
|
|
(org-get-todo-state))
|
|
(org-up-heading-safe))
|
|
(ignore-errors (nth 4 (org-heading-components))))))
|
|
|
|
(defun org-agenda-filter-by-top-headline (strip)
|
|
"Keep only those lines that are descendants from the same top headline.
|
|
The top headline is that of the current line."
|
|
(interactive "P")
|
|
(if org-agenda-filtered-by-top-headline
|
|
(progn
|
|
(setq org-agenda-filtered-by-top-headline nil
|
|
org-agenda-top-headline-filter nil)
|
|
(org-agenda-filter-show-all-top-filter))
|
|
(let ((toph (my/org-find-parent (org-get-at-bol 'org-hd-marker))))
|
|
(if toph (org-agenda-filter-top-headline-apply toph strip)
|
|
(error "No top-level headline at point")))))
|
|
#+end_src
|
|
* org-timeline at beginning of agenda buffer
|
|
#+BEGIN_SRC emacs-lisp
|
|
(defun org-timeline-insert-timeline ()
|
|
"Insert graphical timeline into agenda buffer."
|
|
(unless (buffer-narrowed-p)
|
|
(goto-char (point-min))
|
|
(while (and (not (eq (get-text-property (line-beginning-position) 'org-agenda-type) 'agenda))
|
|
(not (eobp)))
|
|
(forward-line))
|
|
(forward-line)
|
|
(unless (eobp)
|
|
(let ((inhibit-read-only t))
|
|
(insert (org-timeline--generate-timeline))
|
|
(insert (propertize (concat "\n" (make-string (/ (window-width) 2) ?─)) 'face 'org-time-grid) "\n"))
|
|
;; enable `font-lock-mode' in agenda view to display the "chart"
|
|
(font-lock-mode))))
|
|
#+END_SRC
|
|
* org-caldav bug
|
|
#+BEGIN_SRC emacs-lisp
|
|
(defun org-caldav-skip-function (backend)
|
|
(when (eq backend 'icalendar)
|
|
(org-map-entries
|
|
(lambda ()
|
|
(let ((pt (save-excursion (apply 'org-agenda-skip-entry-if org-caldav-skip-conditions))))
|
|
(when (or pt
|
|
;;(org-get-repeat)
|
|
) ;; No repeating tasks
|
|
(org-todo 'none)
|
|
(let ((current-prefix-arg '(4)))
|
|
(call-interactively 'org-schedule)
|
|
(call-interactively 'org-deadline))))))))
|
|
#+END_SRC
|
|
* Another org-caldav bug
|
|
https://github.com/org-trello/org-trello/issues/258
|
|
#+BEGIN_SRC emacs-lisp
|
|
|
|
(defun url-http-end-of-document-sentinel (proc why)
|
|
;; Sentinel used to handle (i) terminated old HTTP/0.9 connections,
|
|
;; and (ii) closed connection due to reusing a HTTP connection which
|
|
;; we believed was still alive, but which the server closed on us.
|
|
;; We handle case (ii) by calling `url-http' again.
|
|
(url-http-debug "url-http-end-of-document-sentinel in buffer (%s)"
|
|
(process-buffer proc))
|
|
(url-http-idle-sentinel proc why)
|
|
(when (buffer-name (process-buffer proc))
|
|
(with-current-buffer (process-buffer proc)
|
|
(goto-char (point-min))
|
|
(cond ((not (looking-at "HTTP/"))
|
|
(if url-http-no-retry
|
|
;; HTTP/0.9 just gets passed back no matter what
|
|
(url-http-activate-callback)
|
|
;; Call `url-http' again if our connection expired.
|
|
(erase-buffer)
|
|
(let ((url-request-method url-http-method)
|
|
(url-request-extra-headers url-http-extra-headers)
|
|
(url-request-data url-http-data)
|
|
(url-using-proxy (url-find-proxy-for-url
|
|
url-current-object
|
|
(url-host url-current-object))))
|
|
(when url-using-proxy
|
|
(setq url-using-proxy
|
|
(url-generic-parse-url url-using-proxy)))
|
|
(if (string= "https" (url-type url-current-object))
|
|
(setq url-gateway-method 'tls))
|
|
(url-http url-current-object url-callback-function
|
|
url-callback-arguments (current-buffer)))))
|
|
((url-http-parse-headers)
|
|
(url-http-activate-callback))))))
|
|
|
|
#+END_SRC
|
|
* I don't like the help window behavior
|
|
#+BEGIN_SRC emacs-lisp
|
|
(defun my/goto-variable (var &optional file)
|
|
(when (eq file 'C-source)
|
|
(setq file (help-C-file-name var 'var)))
|
|
(let* ((location (find-variable-noselect var file))
|
|
(position (cdr location)))
|
|
(switch-to-buffer (car location))
|
|
(run-hooks 'find-function-after-hook)
|
|
(if position
|
|
(progn
|
|
;; Widen the buffer if necessary to go to this position.
|
|
(when (or (< position (point-min))
|
|
(> position (point-max)))
|
|
(widen))
|
|
(goto-char position))
|
|
(message "Unable to find location in file"))))
|
|
|
|
(define-button-type 'help-variable-def
|
|
:supertype 'help-xref
|
|
'help-function #'my/goto-variable
|
|
'help-echo (purecopy "mouse-2, RET: find variable's definition"))
|
|
|
|
(defun my/goto-function (fun &optional file type)
|
|
(or file
|
|
(setq file (find-lisp-object-file-name fun type)))
|
|
(if (not file)
|
|
(message "Unable to find defining file")
|
|
(require 'find-func)
|
|
(when (eq file 'C-source)
|
|
(setq file
|
|
(help-C-file-name (indirect-function fun) 'fun)))
|
|
;; Don't use find-function-noselect because it follows
|
|
;; aliases (which fails for built-in functions).
|
|
(let ((location
|
|
(find-function-search-for-symbol fun type file)))
|
|
(switch-to-buffer (car location))
|
|
(run-hooks 'find-function-after-hook)
|
|
(if (cdr location)
|
|
(goto-char (cdr location))
|
|
(message "Unable to find location in file")))))
|
|
|
|
(define-button-type 'help-function-def
|
|
:supertype 'help-xref
|
|
'help-function #'my/goto-function
|
|
'help-echo (purecopy "mouse-2, RET: find function's definition"))
|
|
#+END_SRC
|
|
* Org agenda supposedly has an option to make no timestamp on a date mean the end of the day
|
|
However, the behavior reflected is not so. Therefore, I have added some code to manually add the end-of-day timestamp manually
|
|
#+BEGIN_SRC emacs-lisp
|
|
(setq org-sort-agenda-notime-is-late t)
|
|
|
|
(defun my-org-agenda-entry-get-agenda-timestamp (pom)
|
|
"Retrieve timestamp information for sorting agenda views.
|
|
Given a point or marker POM, returns a cons cell of the timestamp
|
|
and the timestamp type relevant for the sorting strategy in
|
|
`org-agenda-sorting-strategy-selected'."
|
|
(let (ts ts-date-type)
|
|
(save-match-data
|
|
(cond ((org-em 'scheduled-up 'scheduled-down
|
|
org-agenda-sorting-strategy-selected)
|
|
(setq ts (org-entry-get pom "SCHEDULED")
|
|
ts-date-type " scheduled"))
|
|
((org-em 'deadline-up 'deadline-down
|
|
org-agenda-sorting-strategy-selected)
|
|
(setq ts (org-entry-get pom "DEADLINE")
|
|
ts-date-type " deadline"))
|
|
((org-em 'ts-up 'ts-down
|
|
org-agenda-sorting-strategy-selected)
|
|
(setq ts (org-entry-get pom "TIMESTAMP")
|
|
ts-date-type " timestamp"))
|
|
((org-em 'tsia-up 'tsia-down
|
|
org-agenda-sorting-strategy-selected)
|
|
(setq ts (org-entry-get pom "TIMESTAMP_IA")
|
|
ts-date-type " timestamp_ia"))
|
|
((org-em 'timestamp-up 'timestamp-down
|
|
org-agenda-sorting-strategy-selected)
|
|
(setq ts (or (org-entry-get pom "SCHEDULED")
|
|
(org-entry-get pom "DEADLINE")
|
|
(org-entry-get pom "TIMESTAMP")
|
|
(org-entry-get pom "TIMESTAMP_IA"))
|
|
ts-date-type ""))
|
|
(t (setq ts-date-type "")))
|
|
(cons (when ts
|
|
(ignore-errors
|
|
(org-time-string-to-seconds
|
|
(if (string-match-p ":" ts)
|
|
ts
|
|
(let ((s (substring ts 0 (1- (length ts))))) ;; Added code here
|
|
(concat s
|
|
" 23:59>"))))))
|
|
ts-date-type))))
|
|
|
|
(advice-add 'org-agenda-entry-get-agenda-timestamp
|
|
:override
|
|
#'my-org-agenda-entry-get-agenda-timestamp)
|
|
#+END_SRC
|
|
* org-mru-clock
|
|
Include the tags dammit
|
|
#+begin_src emacs-lisp
|
|
(defun org-mru-clock-format-entry ()
|
|
"Return the parent heading string appended to the heading at point."
|
|
(let* ((this (org-get-heading 'no-tags 'no-todo))
|
|
(parent
|
|
(save-excursion
|
|
(org-up-heading-safe)
|
|
(concat (org-get-heading 'no-tags 'no-todo)
|
|
" "
|
|
(string-join (org-get-tags-at) ","))))
|
|
(parent-post (if parent
|
|
(format " (%s)" parent)
|
|
""))
|
|
(with-parent (concat this parent-post)))
|
|
(if org-mru-clock-keep-formatting
|
|
with-parent
|
|
(substring-no-properties with-parent))))
|
|
#+end_src
|
|
* Scan Tags Indent
|
|
#+BEGIN_SRC emacs-lisp
|
|
(defun get-parent-indent-level ()
|
|
(save-excursion
|
|
(let ((levels 0))
|
|
(while (and (org-up-heading-safe)
|
|
(org-get-todo-state))
|
|
(incf levels))
|
|
levels)))
|
|
|
|
(defun org-scan-tags (action matcher todo-only &optional start-level)
|
|
"Scan headline tags with inheritance and produce output ACTION.
|
|
|
|
ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
|
|
or `agenda' to produce an entry list for an agenda view. It can also be
|
|
a Lisp form or a function that should be called at each matched headline, in
|
|
this case the return value is a list of all return values from these calls.
|
|
|
|
MATCHER is a function accepting three arguments, returning
|
|
a non-nil value whenever a given set of tags qualifies a headline
|
|
for inclusion. See `org-make-tags-matcher' for more information.
|
|
As a special case, it can also be set to t (respectively nil) in
|
|
order to match all (respectively none) headline.
|
|
|
|
When TODO-ONLY is non-nil, only lines with a TODO keyword are
|
|
included in the output.
|
|
|
|
START-LEVEL can be a string with asterisks, reducing the scope to
|
|
headlines matching this string."
|
|
(require 'org-agenda)
|
|
(let* ((re (concat "^"
|
|
(if start-level
|
|
;; Get the correct level to match
|
|
(concat "\\*\\{" (number-to-string start-level) "\\} ")
|
|
org-outline-regexp)
|
|
" *\\(\\<\\("
|
|
(mapconcat #'regexp-quote org-todo-keywords-1 "\\|")
|
|
"\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))
|
|
(props (list 'face 'default
|
|
'done-face 'org-agenda-done
|
|
'undone-face 'default
|
|
'mouse-face 'highlight
|
|
'org-not-done-regexp org-not-done-regexp
|
|
'org-todo-regexp org-todo-regexp
|
|
'org-complex-heading-regexp org-complex-heading-regexp
|
|
'help-echo
|
|
(format "mouse-2 or RET jump to Org file %S"
|
|
(abbreviate-file-name
|
|
(or (buffer-file-name (buffer-base-buffer))
|
|
(buffer-name (buffer-base-buffer)))))))
|
|
(org-map-continue-from nil)
|
|
lspos tags tags-list
|
|
(tags-alist (list (cons 0 org-file-tags)))
|
|
(llast 0) rtn rtn1 level category i txt
|
|
todo marker entry priority
|
|
ts-date ts-date-type ts-date-pair)
|
|
(unless (or (member action '(agenda sparse-tree)) (functionp action))
|
|
(setq action (list 'lambda nil action)))
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(when (eq action 'sparse-tree)
|
|
(org-overview)
|
|
(org-remove-occur-highlights))
|
|
(while (let (case-fold-search)
|
|
(re-search-forward re nil t))
|
|
(setq org-map-continue-from nil)
|
|
(catch :skip
|
|
;; Ignore closing parts of inline tasks.
|
|
(when (and (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p))
|
|
(throw :skip t))
|
|
(setq todo
|
|
;; TODO: is the 1-2 difference a bug?
|
|
(when (match-end 1) (match-string-no-properties 2))
|
|
tags (when (match-end 4) (match-string-no-properties 4)))
|
|
(goto-char (setq lspos (match-beginning 0)))
|
|
(setq level (org-reduced-level (org-outline-level))
|
|
category (org-get-category))
|
|
(when (eq action 'agenda)
|
|
(setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
|
|
ts-date (car ts-date-pair)
|
|
ts-date-type (cdr ts-date-pair)))
|
|
(setq i llast llast level)
|
|
;; remove tag lists from same and sublevels
|
|
(while (>= i level)
|
|
(when (setq entry (assoc i tags-alist))
|
|
(setq tags-alist (delete entry tags-alist)))
|
|
(setq i (1- i)))
|
|
;; add the next tags
|
|
(when tags
|
|
(setq tags (org-split-string tags ":")
|
|
tags-alist
|
|
(cons (cons level tags) tags-alist)))
|
|
;; compile tags for current headline
|
|
(setq tags-list
|
|
(if org-use-tag-inheritance
|
|
(apply 'append (mapcar 'cdr (reverse tags-alist)))
|
|
tags)
|
|
org-scanner-tags tags-list)
|
|
(when org-use-tag-inheritance
|
|
(setcdr (car tags-alist)
|
|
(mapcar (lambda (x)
|
|
(setq x (copy-sequence x))
|
|
(org-add-prop-inherited x))
|
|
(cdar tags-alist))))
|
|
(when (and tags org-use-tag-inheritance
|
|
(or (not (eq t org-use-tag-inheritance))
|
|
org-tags-exclude-from-inheritance))
|
|
;; Selective inheritance, remove uninherited ones.
|
|
(setcdr (car tags-alist)
|
|
(org-remove-uninherited-tags (cdar tags-alist))))
|
|
(when (and
|
|
|
|
;; eval matcher only when the todo condition is OK
|
|
(and (or (not todo-only) (member todo org-todo-keywords-1))
|
|
(if (functionp matcher)
|
|
(let ((case-fold-search t) (org-trust-scanner-tags t))
|
|
(funcall matcher todo tags-list level))
|
|
matcher))
|
|
|
|
;; Call the skipper, but return t if it does not
|
|
;; skip, so that the `and' form continues evaluating.
|
|
(progn
|
|
(unless (eq action 'sparse-tree) (org-agenda-skip))
|
|
t)
|
|
|
|
;; Check if timestamps are deselecting this entry
|
|
(or (not todo-only)
|
|
(and (member todo org-todo-keywords-1)
|
|
(or (not org-agenda-tags-todo-honor-ignore-options)
|
|
(not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))
|
|
|
|
;; select this headline
|
|
(cond
|
|
((eq action 'sparse-tree)
|
|
(and org-highlight-sparse-tree-matches
|
|
(org-get-heading) (match-end 0)
|
|
(org-highlight-new-match
|
|
(match-beginning 1) (match-end 1)))
|
|
(org-show-context 'tags-tree))
|
|
((eq action 'agenda)
|
|
(setq txt (org-agenda-format-item
|
|
""
|
|
(concat
|
|
(if (eq org-tags-match-list-sublevels 'indented)
|
|
(make-string (get-parent-indent-level) ?.) "")
|
|
(org-get-heading))
|
|
(make-string level ?\s)
|
|
category
|
|
tags-list)
|
|
priority (org-get-priority txt))
|
|
(goto-char lspos)
|
|
(setq marker (org-agenda-new-marker))
|
|
(org-add-props txt props
|
|
'org-marker marker 'org-hd-marker marker 'org-category category
|
|
'todo-state todo
|
|
'ts-date ts-date
|
|
'priority priority
|
|
'type (concat "tagsmatch" ts-date-type))
|
|
(push txt rtn))
|
|
((functionp action)
|
|
(setq org-map-continue-from nil)
|
|
(save-excursion
|
|
(setq rtn1 (funcall action))
|
|
(push rtn1 rtn)))
|
|
(t (user-error "Invalid action")))
|
|
|
|
;; if we are to skip sublevels, jump to end of subtree
|
|
(unless org-tags-match-list-sublevels
|
|
(org-end-of-subtree t)
|
|
(backward-char 1))))
|
|
;; Get the correct position from where to continue
|
|
(if org-map-continue-from
|
|
(goto-char org-map-continue-from)
|
|
(and (= (point) lspos) (end-of-line 1)))))
|
|
(when (and (eq action 'sparse-tree)
|
|
(not org-sparse-tree-open-archived-trees))
|
|
(org-hide-archived-subtrees (point-min) (point-max)))
|
|
(nreverse rtn)))
|
|
#+END_SRC
|
|
* gdb window layout custom
|
|
#+begin_src emacs-lisp
|
|
(defun gdb-setup-windows ()
|
|
"Layout the window pattern for option `gdb-many-windows'."
|
|
(gdb-get-buffer-create 'gdb-locals-buffer)
|
|
(gdb-get-buffer-create 'gdb-stack-buffer)
|
|
(gdb-get-buffer-create 'gdb-breakpoints-buffer)
|
|
(set-window-dedicated-p (selected-window) nil)
|
|
(switch-to-buffer gud-comint-buffer)
|
|
(delete-other-windows)
|
|
(let ((win0 (selected-window))
|
|
(win1 (split-window nil ( / ( * (window-height) 3) 4)))
|
|
(win2 (split-window nil ( / (window-height) 3)))
|
|
(win3 (split-window-right)))
|
|
(gdb-set-window-buffer (gdb-locals-buffer-name) nil win3)
|
|
(select-window win2)
|
|
(set-window-buffer
|
|
win2
|
|
(if gud-last-last-frame
|
|
(gud-find-file (car gud-last-last-frame))
|
|
(if gdb-main-file
|
|
(gud-find-file gdb-main-file)
|
|
;; Put buffer list in window if we
|
|
;; can't find a source file.
|
|
(list-buffers-noselect))))
|
|
(setq gdb-source-window (selected-window))
|
|
(let ((win4 (split-window-right)))
|
|
(gdb-set-window-buffer
|
|
(gdb-get-buffer-create 'gdb-disassembly-buffer) nil win4))
|
|
(select-window win1)
|
|
(gdb-set-window-buffer (gdb-stack-buffer-name))
|
|
(let ((win5 (split-window-right)))
|
|
(gdb-set-window-buffer (if gdb-show-threads-by-default
|
|
(gdb-threads-buffer-name)
|
|
(gdb-breakpoints-buffer-name))
|
|
nil win5))
|
|
(select-window win0)))
|
|
#+end_src
|