asoi

3 files changed, 67 insertions, 35 deletions

@@ -18,5 +18,17 @@
                                  "awful" "--development-mode" (buffer-file-name))))
     (t (message "Some awful error occurred!"))))
 
+(defun +chicken-indentation-insinuate ()
+  "Insinuate indentation from
+https://wiki.call-cc.org/emacs#tweaking-stock-scheme-mode-indentation."
+  (defun scheme-module-indent (state indent-point normal-indent) 0)
+  (put 'module 'scheme-indent-function 'scheme-module-indent)
+  (put 'and-let* 'scheme-indent-function 1)
+  (put 'parameterize 'scheme-indent-function 1)
+  (put 'handle-exceptions 'scheme-indent-function 1)
+  (put 'when 'scheme-indent-function 1)
+  (put 'unless 'scheme-indent-function 1)
+  (put 'match 'scheme-indent-function 1))
+
 (provide '+chicken)
 ;;; +chicken.el ends here
@@ -316,8 +316,9 @@ ARG is passed to `backward-kill-word'."
 
 (defun +save-some-buffers-p ()
   "Predicate for `save-some-buffers-default-predicate'.
-It returns nil with remote files."
-  (not (file-remote-p (buffer-file-name))))
+It returns nil with remote files and those without attached files."
+  (and (buffer-file-name)
+       (not (file-remote-p (buffer-file-name)))))
 
 ;; https://www.wwwtech.de/articles/2013/may/emacs:-jump-to-matching-paren-beginning-of-block
 (defun +goto-matching-paren (&optional arg)
@@ -333,6 +334,14 @@ It returns nil with remote files."
    ((looking-back "[\[\(\{]" 1) (backward-char) (forward-sexp arg))
    (t (up-list arg t t))))
 
+(defun +delete-window-or-bury-buffer ()
+  "Delete the current window, or bury the current buffer.
+If the current window is the only window, bury the buffer."
+  (interactive)
+  (condition-case e
+      (delete-window)
+    (t (bury-buffer))))
+
 
 ;;; Bindings
 
@@ -348,6 +357,7 @@ It returns nil with remote files."
 (global-set-key (kbd "C-x 4 n") #'clone-buffer)
 ;; https://christiantietze.de/posts/2022/07/shift-click-in-emacs-to-select/
 (global-set-key (kbd "S-<down-mouse-1>") #'mouse-set-mark)
+(global-set-key (kbd "C-x 0") #'+delete-window-or-bury-buffer)
 
 
 ;;; Required libraries
@@ -343,6 +343,7 @@ Return as a list."
       (+org-unsmartify)
       (+org-fix-blank-lines t)
       (org-align-tags t)
+      (org-hide-drawer-all)
       (when (buffer-narrowed-p)
         (goto-char (point-min))
         (forward-line 1)
@@ -731,39 +732,48 @@ When called with a prefix ARG, will still unconditionally call
 
 
 ;;; move org archives to a dedicated file
-(defun +org-archive-monthwise (archive-file)
-  (if (file-exists-p archive-file)
-      (with-current-buffer (find-file-noselect archive-file)
-        (let ((dir (file-name-directory (file-truename archive-file)))
-              (prog (make-progress-reporter (format "Archiving from %s..." archive-file)))
-              (keep-going t))
-          (goto-char (point-min))
-          (while keep-going
-            (when-let* ((time (or (org-entry-get (point) "ARCHIVE_TIME")
-                                  (org-get-deadline-time (point))))
-                        (parsed-time (and time
-                                          (org-parse-time-string time)))
-                        (refile-target (format "%s%02d-%02d.org"
-                                               dir
-                                               (decoded-time-year parsed-time)
-                                               (decoded-time-month parsed-time)))
-                        (title-str (format "#+title: Archive for %02d-%02d (%s)\n\n"
-                                           (decoded-time-year parsed-time)
-                                           (decoded-time-month parsed-time)
-                                           (file-truename archive-file))))
-              (unless (file-exists-p refile-target)
-                (with-current-buffer (find-file-noselect refile-target)
-                  (insert title-str)
-                  (save-buffer)))
-              (org-refile nil nil (list ""
-                                        refile-target
-                                        nil
-                                        0)))
-            (progress-reporter-update prog)
-            (org-next-visible-heading 1)
-            (when (>= (point) (point-max))
-              (setq keep-going nil)))))
-    (message "Archive file %s does not exist!" archive-file)))
+;; (defun +org-archive-monthwise (archive-file)
+;;   (if (file-exists-p archive-file)
+;;       (with-current-buffer (find-file-noselect archive-file)
+;;         (let ((dir (file-name-directory (file-truename archive-file)))
+;;               (prog (make-progress-reporter (format "Archiving from %s..." archive-file)))
+;;               (keep-going t))
+;;           (goto-char (point-min))
+;;           (while keep-going
+;;             (when-let* ((time (or (org-entry-get (point) "ARCHIVE_TIME")
+;;                                   (org-get-deadline-time (point))))
+;;                         (parsed-time (and time
+;;                                           (org-parse-time-string time)))
+;;                         (refile-target (format "%s%02d-%02d.org"
+;;                                                dir
+;;                                                (decoded-time-year parsed-time)
+;;                                                (decoded-time-month parsed-time)))
+;;                         (title-str (format "#+title: Archive for %02d-%02d (%s)\n\n"
+;;                                            (decoded-time-year parsed-time)
+;;                                            (decoded-time-month parsed-time)
+;;                                            (file-truename archive-file))))
+;;               (unless (file-exists-p refile-target)
+;;                 (with-current-buffer (find-file-noselect refile-target)
+;;                   (insert title-str)
+;;                   (save-buffer)))
+;;               (org-refile nil nil (list ""
+;;                                         refile-target
+;;                                         nil
+;;                                         0)))
+;;             (progress-reporter-update prog)
+;;             (org-next-visible-heading 1)
+;;             (when (>= (point) (point-max))
+;;               (setq keep-going nil)))))
+;;     (message "Archive file %s does not exist!" archive-file)))
+
+
+;;; +org-toggle-view-emphasis
+;; I thought this function was already written somewhere...
+(defun +org-toggle-view-emphasis ()
+  "Toggle `org-hide-emphasis-markers' and redraw the buffer."
+  (interactive)
+  (setq-local org-hide-emphasis-markers (not org-hide-emphasis-markers))
+  (font-lock-update))
 
 
 ;;; el-patch