#+PROPERTY: header-args :tangle "~/.emacs.d/my-redefs.el" :comments both

* 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
* 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
* Modifications to the switch buffer functions
  #+begin_src emacs-lisp
    (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)))))
  #+end_src
* Don't colorize joins and leaves
  Makes for easier reading
  #+begin_src emacs-lisp
    (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)
  #+end_src
* Auto commit when saving org files
#+begin_src emacs-lisp
  (defvar org-agenda-auto-commit nil)
  (defconst org-agenda-git-repo-path (expand-file-name "~/MEGA/org/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)
#+end_src
* ivy-occur take up whole buffer
  #+begin_src emacs-lisp
    (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)
  #+end_src
* org clock added new time prompt and new away prompt
#+begin_src emacs-lisp
  (defun my/org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
    "Resolve an open Org clock.
  An open clock was found, with `dangling' possibly being non-nil.
  If this function was invoked with a prefix argument, non-dangling
  open clocks are ignored.  The given clock requires some sort of
  user intervention to resolve it, either because a clock was left
  dangling or due to an idle timeout.  The clock resolution can
  either be:

    (a) deleted, the user doesn't care about the clock
    (b) restarted from the current time (if no other clock is open)
    (c) closed, giving the clock X minutes
    (d) closed and then restarted
    (e) resumed, as if the user had never left

  The format of clock is (CONS MARKER START-TIME), where MARKER
  identifies the buffer and position the clock is open at (and
  thus, the heading it's under), and START-TIME is when the clock
  was started."
    (cl-assert clock)
    (let* ((ch
            (save-window-excursion
              (save-excursion
                (unless org-clock-resolving-clocks-due-to-idleness
                  (org-clock-jump-to-current-clock clock))
                (unless org-clock-resolve-expert
                  (with-output-to-temp-buffer "*Org Clock*"
                    (princ (format-message "Select a Clock Resolution Command:

  i/q      Ignore this question; the same as keeping all the idle time.

  k/K      Keep X minutes of the idle time (default is all).  If this
           amount is less than the default, you will be clocked out
           that many minutes after the time that idling began, and then
           clocked back in at the present time.

  t/T      Like `k', but will ask you to specify a time (when you got
           distracted away), instead of a number of minutes.

  g/G      Indicate that you \"got back\" X minutes ago.  This is quite
           different from `k': it clocks you out from the beginning of
           the idle period and clock you back in X minutes ago.

  a/A      Like `g', except don't take the idle timer into account.

  s/S      Subtract the idle time from the current clock.  This is the
           same as keeping 0 minutes.

  C        Cancel the open timer altogether.  It will be as though you
           never clocked in.

  j/J      Jump to the current clock, to make manual adjustments.

  For all these options, using uppercase makes your final state
  to be CLOCKED OUT."))))
                (org-fit-window-to-buffer (get-buffer-window "*Org Clock*"))
                (let (char-pressed)
                  (while (or (null char-pressed)
                             (and (not (memq char-pressed
                                             '(?k ?K ?g ?G ?s ?S ?C
                                                  ?j ?J ?i ?q ?t ?T
                                                  ?a ?A)))
                                  (or (ding) t)))
                    (setq char-pressed
                          (read-char (concat (funcall prompt-fn clock)
                                             " [jkKtTgGaASscCiq]? ")
                                     nil 45)))
                  (and (not (memq char-pressed '(?i ?q))) char-pressed)))))
           (default
             (floor (org-time-convert-to-integer (org-time-since last-valid))
                    60))
           (keep
            (or (and (memq ch '(?k ?K))
                     (read-number "Keep how many minutes? " default))
                (and (memq ch '(?t ?T))
                     (floor
                      (/ (float-time
                          (org-time-subtract (org-read-date t t) last-valid))
                         60)))))
           (gotback
            (and (memq ch '(?g ?G))
                 (read-number "Got back how many minutes ago? " default)))
           (away
            (and (memq ch '(?a ?A))
                 (read-number "Been away for how long? " default)))
           (subtractp (memq ch '(?s ?S)))
           (barely-started-p (org-time-less-p
                              (org-time-subtract last-valid (cdr clock))
                              45))
           (start-over (and subtractp barely-started-p)))
      (cond
       ((memq ch '(?j ?J))
        (if (eq ch ?J)
            (org-clock-resolve-clock clock 'now nil t nil fail-quietly))
        (org-clock-jump-to-current-clock clock))
       ((or (null ch)
            (not (memq ch '(?k ?K ?g ?G ?s ?S ?C ?t ?T ?a ?A))))
        (message ""))
       (t
        (org-clock-resolve-clock
         clock (cond
                ((or (eq ch ?C)
                     ;; If the time on the clock was less than a minute before
                     ;; the user went away, and they've ask to subtract all the
                     ;; time...
                     start-over)
                 nil)
                ((or subtractp
                     (and gotback (= gotback 0)))
                 last-valid)
                ((or (and keep (= keep default))
                     (and gotback (= gotback default)))
                 'now)
                (keep
                 (org-time-add last-valid (* 60 keep)))
                (away
                 (org-time-subtract (org-time-since 0) (* 60 away)))
                (gotback
                 (org-time-since (* 60 gotback)))
                (t
                 (error "Unexpected, please report this as a bug")))
         (and gotback last-valid)
         (memq ch '(?K ?G ?S ?T ?A))
         (and start-over
              (not (memq ch '(?K ?G ?S ?C))))
         fail-quietly)))))

  (advice-add #'org-clock-resolve
              :override
              #'my/org-clock-resolve)
#+end_src
