mirror of
https://github.com/pestctrl/emacs-config.git
synced 2026-06-14 12:21:20 +00:00
35 KiB
35 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
- org-clock-out resolve dangling clock time
- Modifications to the switch buffer functions
- Don't colorize joins and leaves
- Auto commit when saving org files
- ivy-occur take up whole buffer
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 my/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)
" *\\(" (regexp-opt org-todo-keywords-1 'words) "\\)?"
" *\\(.*?\\)\\([ \t]:\\(?:" org-tag-re ":\\)+\\)?[ \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 (and (match-end 1) (match-string-no-properties 1)))
(setq tags (and (match-end 4) (org-trim (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)))
(defun my/org-tags-view (&optional todo-only match)
"Show all headlines for all `org-agenda-files' matching a TAGS criterion.
The prefix arg TODO-ONLY limits the search to TODO entries."
(interactive "P")
(when org-agenda-overriding-arguments
(setq todo-only (car org-agenda-overriding-arguments)
match (nth 1 org-agenda-overriding-arguments)))
(let* ((org-tags-match-list-sublevels
org-tags-match-list-sublevels)
(completion-ignore-case t)
(org--matcher-tags-todo-only todo-only)
rtn rtnall files file pos matcher
buffer)
(when (and (stringp match) (not (string-match "\\S-" match)))
(setq match nil))
(catch 'exit
;; TODO: this code is repeated a lot...
(when org-agenda-sticky
(setq org-agenda-buffer-name
(if (stringp match)
(format "*Org Agenda(%s:%s)*"
(or org-keys (or (and todo-only "M") "m")) match)
(format "*Org Agenda(%s)*" (or (and todo-only "M") "m")))))
(setq matcher (org-make-tags-matcher match))
;; Prepare agendas (and `org-tag-alist-for-agenda') before
;; expanding tags within `org-make-tags-matcher'
(org-agenda-prepare (concat "TAGS " match))
(setq match (car matcher)
matcher (cdr matcher))
(org-compile-prefix-format 'tags)
(org-set-sorting-strategy 'tags)
(setq org-agenda-query-string match)
(setq org-agenda-redo-command
(list 'org-tags-view
`(quote ,org--matcher-tags-todo-only)
`(if current-prefix-arg nil ,org-agenda-query-string)))
(setq files (org-agenda-files nil 'ifmode)
rtnall nil)
(while (setq file (pop files))
(catch 'nextfile
(org-check-agenda-file file)
(setq buffer (if (file-exists-p file)
(org-get-agenda-file-buffer file)
(error "No such file %s" file)))
(if (not buffer)
;; If file does not exist, error message to agenda
(setq rtn (list
(format "ORG-AGENDA-ERROR: No such org-file %s" file))
rtnall (append rtnall rtn))
(with-current-buffer buffer
(unless (derived-mode-p 'org-mode)
(error "Agenda file %s is not in Org mode" file))
(save-excursion
(save-restriction
(if (eq buffer org-agenda-restrict)
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
(setq rtn (org-scan-tags 'agenda
matcher
org--matcher-tags-todo-only))
(setq rtnall (append rtnall rtn))))))))
(org-agenda--insert-overriding-header
(with-temp-buffer
(insert "Headlines with TAGS match: ")
(add-text-properties (point-min) (1- (point))
(list 'face 'org-agenda-structure
'short-heading
(concat "Match: " match)))
(setq pos (point))
(insert match "\n")
(add-text-properties pos (1- (point)) (list 'face 'org-warning))
(setq pos (point))
(unless org-agenda-multi
(insert (substitute-command-keys
"Press \
\\<org-agenda-mode-map>`\\[universal-argument] \\[org-agenda-redo]' \
to search again\n")))
(add-text-properties pos (1- (point))
(list 'face 'org-agenda-structure))
(buffer-string)))
(org-agenda-mark-header-line (point-min))
(when rtnall
(insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties
(point-min) (point-max)
`(org-agenda-type tags
org-last-args (,org--matcher-tags-todo-only ,match)
org-redo-cmd ,org-agenda-redo-command
org-series-cmd ,org-cmd))
(org-agenda-finalize)
(setq buffer-read-only t))))
(advice-add 'org-scan-tags
:override
#'my/org-scan-tags)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)))org-clock-out resolve dangling clock time
(defun my/org-clock-out (&optional switch-to-state fail-quietly at-time)
"Stop the currently running clock.
Throw an error if there is no running clock and FAIL-QUIETLY is nil.
With a universal prefix, prompt for a state to switch the clocked out task
to, overriding the existing value of `org-clock-out-switch-to-state'."
(interactive "P")
(catch 'exit
(when (not (org-clocking-p))
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(setq frame-title-format org-frame-title-format-backup)
(force-mode-line-update)
(if fail-quietly (throw 'exit t) (user-error "No active clock")))
(let ((org-clock-out-switch-to-state
(if switch-to-state
(completing-read "Switch to state: "
(with-current-buffer
(marker-buffer org-clock-marker)
org-todo-keywords-1)
nil t "DONE")
org-clock-out-switch-to-state))
(now (org-current-time org-clock-rounding-minutes))
ts te s h m remove)
(setq org-clock-out-time (or at-time now)) ;; This line is changed from now to (or at-time now)
(save-excursion ; Do not replace this with `with-current-buffer'.
(with-no-warnings (set-buffer (org-clocking-buffer)))
(save-restriction
(widen)
(goto-char org-clock-marker)
(beginning-of-line 1)
(if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp))
(equal (match-string 1) org-clock-string))
(setq ts (match-string 2))
(if fail-quietly (throw 'exit nil) (error "Clock start time is gone")))
(goto-char (match-end 0))
(delete-region (point) (point-at-eol))
(insert "--")
(setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive))
(setq s (- (float-time
(apply #'encode-time (org-parse-time-string te)))
(float-time
(apply #'encode-time (org-parse-time-string ts))))
h (floor (/ s 3600))
s (- s (* 3600 h))
m (floor (/ s 60))
s (- s (* 60 s)))
(insert " => " (format "%2d:%02d" h m))
(move-marker org-clock-marker nil)
(move-marker org-clock-hd-marker nil)
;; Possibly remove zero time clocks. However, do not add
;; a note associated to the CLOCK line in this case.
(cond ((and org-clock-out-remove-zero-time-clocks
(= (+ h m) 0))
(setq remove t)
(delete-region (line-beginning-position)
(line-beginning-position 2)))
(org-log-note-clock-out
(org-add-log-setup
'clock-out nil nil nil
(concat "# Task: " (org-get-heading t) "\n\n"))))
(when org-clock-mode-line-timer
(cancel-timer org-clock-mode-line-timer)
(setq org-clock-mode-line-timer nil))
(when org-clock-idle-timer
(cancel-timer org-clock-idle-timer)
(setq org-clock-idle-timer nil))
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(setq frame-title-format org-frame-title-format-backup)
(when org-clock-out-switch-to-state
(save-excursion
(org-back-to-heading t)
(let ((org-clock-out-when-done nil))
(cond
((functionp org-clock-out-switch-to-state)
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp))
(let ((newstate (funcall org-clock-out-switch-to-state
(match-string 2))))
(when newstate (org-todo newstate))))
((and org-clock-out-switch-to-state
(not (looking-at (concat org-outline-regexp "[ \t]*"
org-clock-out-switch-to-state
"\\>"))))
(org-todo org-clock-out-switch-to-state))))))
(force-mode-line-update)
(message (concat "Clock stopped at %s after "
(org-duration-from-minutes (+ (* 60 h) m)) "%s")
te (if remove " => LINE REMOVED" ""))
(run-hooks 'org-clock-out-hook)
(unless (org-clocking-p)
(setq org-clock-current-task nil)))))))
(defun my/org-clock-resolve-clock
(clock resolve-to clock-out-time close restart fail-quietly)
"Resolve CLOCK given the time RESOLVE-TO, and the present.
CLOCK is a cons cell of the form (MARKER START-TIME)."
(let ((org-clock-resolving-clocks t)
;; If the clocked entry contained only a clock and possibly
;; the associated drawer, and we either cancel it or clock it
;; out, `org-clock-out-remove-zero-time-clocks' may clear all
;; contents, and leave point on the /next/ headline. We store
;; the current entry location to be able to get back here when
;; we need to clock in again the previously clocked task.
(heading (org-with-point-at (car clock)
(org-back-to-heading t)
(point-marker))))
(pcase resolve-to
(`nil
(org-clock-clock-cancel clock)
(when (and restart (not org-clock-clocking-in))
(org-with-point-at heading (org-clock-in))))
(`now
(cond
(restart (error "RESTART is not valid here"))
((or close org-clock-clocking-in)
(org-clock-clock-out clock fail-quietly))
((org-is-active-clock clock) nil)
(t (org-clock-clock-in clock t))))
((pred (time-less-p (current-time)))
;; ^ NOTE: Here and in other `time-less-p' calls, we use
;; (current-time) rather than nil for Emacs 24 compatibility.
(error "RESOLVE-TO must refer to a time in the past"))
(_
(when restart (error "RESTART is not valid here"))
(org-clock-clock-out clock fail-quietly (or clock-out-time resolve-to))
(cond
(org-clock-clocking-in nil)
(close
(setq org-clock-leftover-time (and (null clock-out-time) resolve-to))
(move-marker org-clock-marker nil))
(t
(org-with-point-at heading
(org-clock-in nil (and clock-out-time resolve-to)))))))))
(advice-add 'org-clock-out
:override
#'my/org-clock-out)
(advice-add 'org-clock-resolve-clock
:override
#'my/org-clock-resolve-clock)Modifications to the switch buffer functions
(defvar switch-buffer-functions--in-minibuffer nil)
;;;###autoload
(defun switch-buffer-functions-run ()
"Run `switch-buffer-functions' if needed.
This function checks the result of `current-buffer', and run
`switch-buffer-functions' when it has been changed from
the last buffer.
This function should be hooked to `post-command-hook'."
(when (and switch-buffer-functions--in-minibuffer
(member this-command '(exit-minibuffer minibuffer-keyboard-quit ivy-alt-done)))
(setq switch-buffer-functions--in-minibuffer nil))
(if (member this-command '(eval-expression counsel-M-x ivy-switch-buffer edebug-eval-expression counsel-grep-or-swiper)) ;; counsel-M-x doesn't work...
(setq switch-buffer-functions--in-minibuffer t)
(unless (or (eq (current-buffer)
switch-buffer-functions--last-buffer))
(let ((current (current-buffer))
(previous switch-buffer-functions--last-buffer))
(setq switch-buffer-functions--last-buffer
current)
(run-hook-with-args 'switch-buffer-functions
previous
current)))))Don't colorize joins and leaves
Makes for easier reading
(defvar dont-colorize-these-commands '("JOIN" "PART" "QUIT"))
(defun erc-colorize-privmsgs ()
"Function used in `erc-insert-modify-hook' to apply the same face to a
message coming from a user."
(erc-find-parsed-property)
(let* ((vector (erc-get-parsed-vector (point)))
(nickuserhost (erc-get-parsed-vector-nick vector))
(nickname (and nickuserhost
(nth 0 (erc-parse-user nickuserhost))))
(match-face (erc-colorize-color nickname)))
(when (and match-face
(not (member (erc-response.command vector)
dont-colorize-these-commands)))
(erc-button-add-face (point-min) (point-max) match-face))))
(advice-add #'erc-colorize-message
:override
#'erc-colorize-privmsgs)Auto commit when saving org files
(defvar org-agenda-auto-commit nil)
(defconst org-agenda-git-repo-path (expand-file-name "~/MEGA/org/2019-05-agenda"))
(defun my/toggle-auto-commit ()
(interactive)
(setq org-agenda-auto-commit (not org-agenda-auto-commit)))
(defun auto-commit-agenda (&optional arg)
(when-let (f (buffer-file-name))
(let ((fname (expand-file-name f))
(sfname (buffer-name)))
(when (and org-agenda-auto-commit
(string-prefix-p org-agenda-git-repo-path
fname)
(magit-anything-modified-p t fname)
(not (magit-merge-in-progress-p))
(or (string= (magit-get-current-branch)
"master")
(progn
(magit-git-command-topdir "git checkout master")
(string= (magit-get-current-branch)
"master"))))
(save-window-excursion
(magit-stage-file fname)
(magit-commit-create `("-m" ,(format "\"%s\" modified, %s"
sfname (current-time-string)))))))))
(advice-add #'save-buffer
:after
#'auto-commit-agenda)ivy-occur take up whole buffer
(defun my/ivy-occur (&rest _)
(interactive)
(let ((buffer (current-buffer)))
(delete-window)
(switch-to-buffer buffer)))
;;(advice-add #'ivy-occur :override #'my/ivy-occur)
;;(advice-remove #'ivy-occur #'my/ivy-occur)