mirror of
https://github.com/pestctrl/emacs-config.git
synced 2026-02-16 08:14:15 +00:00
19 KiB
19 KiB
- Filter by top heading, but only top todo heading
- org-timeline at beginning of agenda buffer
- org-caldav bug
- Another org-caldav bug
- I don't like the help window behavior
- Org agenda supposedly has an option to make no timestamp on a date mean the end of the day
- org-mru-clock
- Scan Tags Indent
- gdb window layout custom
Filter by top heading, but only top todo heading
(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")))))org-timeline at beginning of agenda buffer
(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))))org-caldav bug
(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))))))))Another org-caldav bug
https://github.com/org-trello/org-trello/issues/258
(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))))))I don't like the help window behavior
(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"))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
(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)org-mru-clock
Include the tags dammit
(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))))Scan Tags Indent
(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)))gdb window layout custom
(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)))