changeset 267: |
f3d814fb136a |
parent: |
255000153a76
|
child: |
c4682fedd73d |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Sat, 06 Apr 2024 22:53:46 -0400 |
permissions: |
-rw-r--r-- |
description: |
db upgrades, alik, ignoring c files (for now) |
1 ;;; default.el --- default config -*- lexical-binding: t -*- 5 (put 'upcase-region 'disabled nil) 6 (put 'list-threads 'disabled nil) 7 (put 'list-timers 'disabled nil) 8 (setq show-paren-context-when-offscreen 'overlay) 13 auto-save-list-file-prefix (expand-file-name "auto-save/." user-emacs-directory) 14 tramp-auto-save-directory (expand-file-name "auto-save/tramp/" user-emacs-directory) 16 mml-attach-file-at-the-end t 17 dired-mouse-drag-files t 18 confirm-kill-emacs nil 19 confirm-kill-processes nil 21 display-time-format "%Y-%m-%d %H:%M" 22 ring-bell-function 'ignore 23 completion-ignore-case t 24 ;; NOTE 2023-11-04: you need to add the following lines to ~/.gnupg/gpg-agent.conf: 25 ;; allow-emacs-pinentry 26 ;; allow-loopback-pinentry 27 epg-pinentry-mode 'loopback 30 shr-max-image-proportion 0.6 32 shr-discard-aria-hidden t 33 bookmark-default-file (expand-file-name "bookmarks" user-emacs-directory) 34 project-list-file (expand-file-name "projects" user-emacs-directory) 36 project-file-history-behavior 'relativize 37 emms-directory (expand-file-name "emms" user-emacs-directory) 38 gnus-cache-directory (expand-file-name "gnus" user-emacs-directory) 39 url-cache-directory (expand-file-name "url" user-emacs-directory) 40 tab-always-indent 'complete 42 ;; NOTE 2023-11-04: EXPERIMENTAL 43 ediff-floating-control-frame t 44 register-use-preview nil 45 shr-use-xwidgets-for-media t 46 browse-url-browser-function 'browse-url-default-browser 47 eww-auto-rename-buffer 'title 48 eww-search-prefix "https://duckduckgo.com/html?q=" 52 (defvar user-custom-file (expand-file-name (format "%s.el" user-login-name) user-emacs-directory)) 53 (defvar user-home-directory (expand-file-name "~")) 54 (defvar user-lab-directory (expand-file-name "lab" user-home-directory)) 55 (defvar user-stash-directory (expand-file-name "stash" user-home-directory)) 56 (defvar user-store-directory (expand-file-name "store" user-home-directory)) 57 (defvar user-shed-directory (expand-file-name "shed" user-home-directory)) 58 (defvar user-mail-directory (expand-file-name "mail" user-home-directory)) 59 (defvar user-media-directory (expand-file-name "media" user-home-directory)) 61 (defvar default-theme 'leuven-dark) 62 (defvar company-source-directory (join-paths user-lab-directory "comp")) 63 (defvar company-domain "compiler.company") 64 (defvar company-name "The Compiler Company, LLC") 65 (defvar company-vc-domain "vc.compiler.company") 66 (defvar company-home "the.compiler.company") 69 (defun load-default-theme () (interactive) (load-theme default-theme)) 71 (add-hook 'after-init-hook #'load-default-theme) 74 (with-eval-after-load 'package 75 (setq package-archives 76 '(("gnu" . "https://elpa.gnu.org/packages/") 77 ("nongnu" . "https://elpa.nongnu.org/nongnu/") 78 ("melpa" . "https://melpa.org/packages/")) 79 use-package-always-ensure t 80 use-package-expand-minimally t) 82 eglot-x ;; LSP extensions 83 org-web-tools ;; web parsing 85 all-the-icons all-the-icons-dired all-the-icons-ibuffer ;; icons 87 corfu orderless cape ;; completion 88 slime ;; common lisp server 92 which-key ;; key helper 95 (package-install-selected-packages t)) 98 (require 'exec-path-from-shell) 99 (exec-path-from-shell-copy-env "SSH_AGENT_PID") 100 (exec-path-from-shell-copy-env "SSH_AUTH_SOCK") 101 (exec-path-from-shell-copy-env "PATH") 102 (add-to-list 'exec-path (expand-file-name "~/.cargo/bin/")) 103 (add-to-list 'exec-path (expand-file-name "~/.local/bin/")) 104 (add-to-list 'exec-path "/bin/") 105 (add-to-list 'exec-path "/usr/local/sbin/") 109 :init (global-corfu-mode)) 112 ;; Bind dedicated completion commands 113 ;; Alternative prefix keys: C-c p, M-p, M-+, ... 114 :bind (("C-c p p" . completion-at-point) ;; capf 115 ("C-c p t" . complete-tag) ;; etags 116 ("C-c p d" . cape-dabbrev) ;; or dabbrev-completion 117 ("C-c p h" . cape-history) 118 ("C-c p f" . cape-file) 119 ("C-c p k" . cape-keyword) 120 ("C-c p s" . cape-elisp-symbol) 121 ("C-c p e" . cape-elisp-block) 122 ("C-c p a" . cape-abbrev) 123 ("C-c p l" . cape-line) 124 ("C-c p w" . cape-dict) 125 ("C-c p :" . cape-emoji) 126 ("C-c p \\" . cape-tex) 127 ("C-c p _" . cape-tex) 128 ("C-c p ^" . cape-tex) 129 ("C-c p &" . cape-sgml) 130 ("C-c p r" . cape-rfc1345)) 132 ;; Add to the global default value of `completion-at-point-functions' which is 133 ;; used by `completion-at-point'. The order of the functions matters, the 134 ;; first function returning a result wins. Note that the list of buffer-local 135 ;; completion functions takes precedence over the global list. 136 ;; (add-to-list 'completion-at-point-functions #'cape-dabbrev) 137 ;; (add-to-list 'completion-at-point-functions #'cape-abbrev) 138 ;; (add-to-list 'completion-at-point-functions #'cape-history) 139 ;; (add-to-list 'completion-at-point-functions #'cape-keyword) 140 ;; (add-to-list 'completion-at-point-functions #'cape-file) 141 ;; (add-to-list 'completion-at-point-functions #'cape-line) 142 ;; (add-to-list 'completion-at-point-functions #'cape-elisp-block) 143 ;; (add-to-list 'completion-at-point-functions #'cape-tex) 144 ;; (add-to-list 'completion-at-point-functions #'cape-sgml) 145 ;; (add-to-list 'completion-at-point-functions #'cape-rfc1345) 146 ;; (add-to-list 'completion-at-point-functions #'cape-dict) 147 ;; (add-to-list 'completion-at-point-functions #'cape-elisp-symbol) 148 ;; (add-to-list 'completion-at-point-functions #'cape-emoji) 151 (use-package orderless 153 (completion-styles '(orderless basic partial-completion shorthand flex)) 154 (completion-category-overrides '((file (styles basic partial-completion))))) 157 (setopt desktop-dirname (expand-file-name "sessions" user-emacs-directory)) 160 (setq multisession-storage 'sqlite) 163 (kill-ring-deindent-mode) 166 ;; use rhg, fallback to hg. see hgrc 167 (if (file-exists-p "~/.local/bin/rhg") 168 (setq hg-binary "~/.local/bin/rhg")) 173 (use-package lisp-mode 176 inferior-lisp-program "sbcl --dynamic-space-size=8G" 177 scheme-program-name "gsi" 178 guile-program "guile" 179 cmulisp-program "lisp" 185 (require 'slime-autoloads) 186 (require 'slime-cape) 187 (setq slime-contribs '(slime-fancy 191 slime-enclosing-context 199 ;; slime-typeout-frame 201 ;; slime-highlight-edits 203 (put 'make-instance 'common-lisp-indent-function 1) 204 (put 'reinitialize-instance 'common-lisp-indent-function 1) 205 (add-hook 'slime-mode-hook #'slime-cape-maybe-enable) 206 (add-hook 'slime-repl-mode-hook #'slime-cape-maybe-enable) 208 (defvar slime-toggle nil) 209 (defun slime-toggle () 210 "toggle between lisp file and slime-repl" 212 (unless (slime-connected-p) (slime)) 213 (if (eq major-mode 'slime-repl-mode) 214 (setq slime-toggle (pop-to-buffer (or slime-toggle (read-buffer "lisp file: ")))) 216 (setq slime-toggle (current-buffer)) 219 ;; X11-only (mcclim requires clx) 220 (defun clouseau-inspect (string) 221 "Inspect a lisp value with Clouseau. make sure to load clouseau 222 with a custom core or in your init file before using this 223 function: '(ql:quickload :clouseau)'." 225 (list (slime-read-from-minibuffer 226 "Inspect value (evaluated): " 227 (slime-sexp-at-point)))) 228 (let ((inspector 'cl-user::*clouseau-inspector*)) 231 (cl:defvar ,inspector nil) 232 ;; (Re)start the inspector if necessary. 233 (cl:unless (cl:and (clim:application-frame-p ,inspector) 234 (clim-internals::frame-process ,inspector)) 235 (cl:setf ,inspector (cl:nth-value 1 (clouseau:inspect nil :new-process t)))) 236 ;; Tell the inspector to visualize the correct datum. 237 (cl:setf (clouseau:root-object ,inspector :run-hook-p t) 238 (cl:eval (cl:read-from-string ,string))) 242 ;; (define-key slime-prefix-map (kbd "i") 'clouseau-inspect) 243 (setq slime-threads-update-interval 1)) 246 (with-eval-after-load 'eglot 247 (unless (package-installed-p 'eglot-x) 248 (package-vc-install '(eglot-x :url "https://vc.compiler.company/packy/eglot-x.git"))) 250 (add-to-list 'eglot-server-programs 251 '((rust-ts-mode rust-mode) . 252 ("rust-analyzer" :initializationOptions (:check (:command "clippy"))))) 256 (add-hook 'rust-mode-hook 'eglot-ensure) 258 (setq rust-rustfmt-switches nil 259 rust-indent-offset 2) 262 (setq python-indent-offset 2) 263 (add-hook 'python-mode-hook 'eglot-ensure) 266 (setq js-indent-level 2) 269 (setq sh-basic-offset 2) 272 (use-package graphviz-dot-mode 274 (setq graphviz-dot-indent-width 2)) 276 (defcustom prog-comment-keywords 277 '("TODO" "REVIEW" "FIX" "HACK" "RESEARCH") 278 "List of strings with comment keywords." 281 (defcustom prog-comment-timestamp-format-concise "%F" 282 "Specifier for date in `prog-comment-timestamp-keyword'. 283 Refer to the doc string of `format-time-string' for the available 287 (defcustom prog-comment-timestamp-format-verbose "%F %T %z" 288 "Like `prog-comment-timestamp-format-concise', but longer." 292 (defun prog-comment-dwim (arg) 293 "Flexible, do-what-I-mean commenting. 295 If region is active and ARG is either a numeric argument greater 296 than one or a universal prefix (\\[universal-argument]), then 297 apply `comment-kill' on all comments in the region. 299 If the region is active and no ARG is supplied, or is equal to a 300 numeric prefix of 1, then toggle the comment status of the region. 302 Else toggle the comment status of the line at point. With a 303 numeric prefix ARG, do so for ARGth lines (negative prefix 304 operates on the lines before point)." 307 ((and (> arg 1) (use-region-p)) 308 (let* ((beg (region-beginning)) 310 (num (count-lines beg end))) 313 (comment-kill num)))) 315 (comment-or-uncomment-region (region-beginning) (region-end))) 317 (save-excursion (comment-line (or arg 1)))))) 319 (defvar prog-comment--keyword-hist '() 320 "Input history of selected comment keywords.") 322 (defun prog-comment--keyword-prompt (keywords) 323 "Prompt for candidate among KEYWORDS." 324 (let ((def (car prog-comment--keyword-hist))) 326 (format "Select keyword [%s]: " def) 327 keywords nil nil nil 'prog-comment--keyword-hist def))) 331 (defun prog-comment-timestamp-keyword (keyword &optional verbose) 332 "Add timestamped comment with KEYWORD. 334 When called interactively, the list of possible keywords is that 335 of `prog-comment-keywords', though it is possible to 336 input arbitrary text. 338 If point is at the beginning of the line or if line is empty (no 339 characters at all or just indentation), the comment is started 340 there in accordance with `comment-style'. Any existing text 341 after the point will be pushed to a new line and will not be 342 turned into a comment. 344 If point is anywhere else on the line, the comment is indented 345 with `comment-indent'. 347 The comment is always formatted as 'DELIMITER KEYWORD DATE:', 348 with the date format being controlled by the variable 349 `prog-comment-timestamp-format-concise'. 351 With optional VERBOSE argument (such as a prefix argument 352 `\\[universal-argument]'), use an alternative date format, as 353 specified by `prog-comment-timestamp-format-verbose'." 356 (prog-comment--keyword-prompt prog-comment-keywords) 358 (let* ((date (if verbose 359 comment-timestamp-format-verbose 360 prog-comment-timestamp-format-concise)) 361 (string (format "%s %s: " keyword (format-time-string date))) 364 ((or (eq beg (point-at-bol)) 365 (default-line-regexp-p 'empty)) 366 (let* ((maybe-newline (unless (default-line-regexp-p 'empty 1) "\n"))) 367 ;; NOTE 2021-07-24: we use this `insert' instead of 368 ;; `comment-region' because of a yet-to-be-determined bug that 369 ;; traps `undo' to the two states between the insertion of the 370 ;; string and its transformation into a comment. 372 (concat comment-start 373 ;; NOTE 2021-07-24: See function `comment-add' for 377 (string-to-char comment-start)) 381 (indent-region beg (point)) 383 (save-excursion (insert maybe-newline))))) 386 (insert (concat " " string)))))) 392 (defun toggle-macro-recording () 394 (if defining-kbd-macro 396 (start-kbd-macro nil))) 398 (defun play-macro-if-not-playing () 400 (if defining-kbd-macro 402 (call-last-kbd-macro))) 405 ;; - additional register vtypes: buffer 406 (defun decrement-register (number register) 407 "Subtract NUMBER from the contents of register REGISTER. 408 Interactively, NUMBER is the prefix arg." 409 (interactive "p\ncDecrement register: ") 410 (increment-register (- number) register)) 412 (defun copy-register (a b) 413 "Copy register A to B." 415 (list (register-read-with-preview "From register: ") 416 (register-read-with-preview "To register: "))) 417 (set-register b (get-register a))) 419 (defun buffer-to-register (register &optional delete) 420 "Put current buffer in register - this would also work for 421 just buffers, as switch-to-buffer can use both, but it 422 facilitates for easier saving/restoring of registers." 423 (interactive "cPut current buffername in register: \nP.") 424 (set-register register (cons 'buffer (buffer-name (current-buffer))))) 426 (defun file-to-register (register &optional delete) 427 "This is better than put-buffer-in-register for file-buffers, because a closed 428 file can be opened again, but does not work for no-file-buffers." 429 (interactive "cPut the filename of current buffer in register: \nP") 430 (set-register register (cons 'file (buffer-file-name (current-buffer))))) 432 (defun file-query-to-register (register &optional delete) 435 (register-read-with-preview "File query to register: "))) 436 (set-register register (list 'file-query (buffer-file-name (current-buffer)) (point)))) 438 ;; additional register-val handlers 439 ;; (cl-defmethod register-val-jump-to :around ((val cons) delete) 441 ;; (t (cl-call-next-method val delete)))) 444 (defun outline-hook (&optional rx) 445 "Enable `outline-minor-mode' and set `outline-regexp'." 446 (when rx (setq-local outline-regexp rx)) 447 (outline-minor-mode 1)) 449 (setq outline-minor-mode-use-buttons nil) 451 (defun add-outline-hook (mode &optional rx) 452 (let ((sym (symb mode "-hook"))) 453 (add-hook sym (lambda () (outline-hook rx))))) 455 (defmacro outline-hooks (&rest pairs) 456 `(mapc (lambda (x) (add-outline-hook (car x) (cadr x))) ',pairs)) 458 (outline-hooks (asm-mode ";;;+") 460 (rust-mode "\\(//!\\|////+\\)") 462 (sh-script-mode "###+") 463 (makefile-mode "###+") 474 (defcustom default-scratch-buffer-mode 'lisp-interaction-mode 475 "Default major mode for new scratch buffers" 478 ;; Adapted from the `scratch.el' package by Ian Eure. 479 (defun default-scratch-list-modes () 480 "List known major modes." 481 (cl-loop for sym the symbols of obarray 482 for name = (symbol-name sym) 483 when (and (functionp sym) 484 (not (member sym minor-mode-list)) 485 (string-match "-mode$" name) 486 (not (string-match "--" name))) 489 (defun default-scratch-buffer-setup (region &optional mode) 490 "Add contents to `scratch' buffer and name it accordingly. 492 REGION is added to the contents to the new buffer. 494 Use the current buffer's major mode by default. With optional 495 MODE use that major mode instead." 496 (let* ((major (or mode major-mode)) 497 (string (format "Scratch buffer for: %s\n\n" major)) 498 (text (concat string region)) 499 (buf (format "*Scratch for %s*" major))) 500 (with-current-buffer (get-buffer-create buf) 504 (goto-char (point-min)) 505 (comment-region (point-at-bol) (point-at-eol))) 507 (pop-to-buffer buf))) 510 (defun default-scratch-buffer (&optional arg) 511 "Produce a bespoke scratch buffer matching current major mode. 513 With optional ARG as a prefix argument (\\[universal-argument]), 514 use `default-scratch-buffer-mode'. 516 With ARG as a double prefix argument, prompt for a major mode 519 If region is active, copy its contents to the new scratch 522 (let* ((default-mode default-scratch-buffer-mode) 523 (modes (default-scratch-list-modes)) 524 (region (with-current-buffer (current-buffer) 525 (if (region-active-p) 526 (buffer-substring-no-properties 531 (pcase (prefix-numeric-value arg) 533 (setq m (intern (completing-read "Select major mode: " modes nil t))) 534 (default-scratch-buffer-setup region m))) 535 (4 (default-scratch-buffer-setup region default-mode)) 536 (_ (default-scratch-buffer-setup region))))) 539 (defun scratch-new () 540 "create a new scratch buffer. (could be *scratch* - *scratchN*)" 547 (if (= n 0) "" (int-to-string n)) 550 (get-buffer bufname))) 551 (switch-to-buffer (get-buffer-create bufname)) 552 (insert initial-scratch-message) 553 (lisp-interaction-mode))) 556 (defun set-no-process-query-on-exit () 557 (let ((proc (get-buffer-process (current-buffer)))) 558 (when (processp proc) 559 (set-process-query-on-exit-flag proc nil)))) 561 (add-hook 'shell-mode-hook 'set-no-process-query-on-exit) 562 (add-hook 'term-exec-hook 'set-no-process-query-on-exit) 566 "Open a new instance of eshell." 570 (setq eshell-highlight-prompt t 571 eshell-hist-ignoredups t 572 eshell-save-history-on-exit t 573 eshell-prefer-lisp-functions nil 574 eshell-destroy-buffer-when-process-dies t) 576 (add-hook 'eshell-mode-hook 578 (eshell/alias "d" "dired $1") 579 (eshell/alias "ff" "find-file $1") 580 (eshell/alias "hgfe" "hg-fast-export.sh"))) 582 (defun eshell/clear () 583 "Clear the eshell buffer." 584 (let ((inhibit-read-only t)) 586 (eshell-send-input))) 588 (defun eshell-quit-or-delete-char (arg) 590 (if (and (eolp) (looking-back eshell-prompt-regexp)) 592 (eshell-life-is-too-much) ; Why not? (eshell/exit) 595 (delete-forward-char arg))) 597 (add-hook 'eshell-mode-hook 599 (bind-keys :map eshell-mode-map 600 ("C-d" . eshell-quit-or-delete-char)))) 602 (defun eshell-next-prompt (n) 603 "Move to end of Nth next prompt in the buffer. See `eshell-prompt-regexp'." 605 (re-search-forward eshell-prompt-regexp nil t n) 606 (when eshell-highlight-prompt 607 (while (not (get-text-property (line-beginning-position) 'read-only) ) 608 (re-search-forward eshell-prompt-regexp nil t n))) 609 (eshell-skip-prompt)) 611 (defun eshell-previous-prompt (n) 612 "Move to end of Nth previous prompt in the buffer. See `eshell-prompt-regexp'." 615 (eshell-next-prompt (- n))) 617 (defun eshell-insert-history () 618 "Displays the eshell history to select and insert back into your eshell." 620 (insert (ido-completing-read "Eshell history: " 622 (ring-elements eshell-history-ring))))) 625 (setopt tramp-default-method "ssh" 626 tramp-default-user user-login-name 627 tramp-default-host "localhost") 630 (setq org-todo-keywords 631 '((type "TBD(0!)" "TODO(t!)" "|") 633 (sequence "FIND(q!)" "READ(r@!)" "WATCH(W@!)" "|") 634 (sequence "RESEARCH(s!)" "RECORD(e!)" "|") 635 (sequence "OUTLINE(O!)" "RESEARCH(A!)" "DRAFT(M!)" "REVIEW(R!)" "|") 636 (sequence "FIX(i!)" "TEST(t!)" "|") 637 (type "GOTO(g!)" "HACK(h!)" "NOTE(n!)" "CODE(c!)" "LINK(l!)" "|") 638 (type "KLUDGE(k@!)" "|") 639 (sequence "|" "DONE(d!)" "NOPE(x@!)" "FOUND(f@!)"))) 641 (setq org-capture-templates 642 '(("t" "task" entry (file "inbox.org") "* %^{title}\n- %?" :prepend t) 643 ("1" "current-task-item" item (clock) "%i%?") 644 ("2" "current-task-checkbox" checkitem (clock) "%i%?") 645 ("3" "current-task-region" plain (clock) "%i" :immediate-finish t :empty-lines 1) 646 ("4" "current-task-kill" plain (clock) "%c" :immediate-finish t :empty-lines 1) 647 ("l" "log" item (file+headline "log.org" "log") "%U %?" :prepend t) 648 ("s" "secret" table-line (file+function "krypt" org-ask-location) "| %^{key} | %^{val} |" :immediate-finish t :kill-buffer t) 649 ("n" "note" plain (file+function "notes.org" org-ask-location) "%?") 650 ("i" "idea" entry (file "inbox.org") "* OUTLINE %?\n:notes:\n:end:\n- _outline_ [/]\n - [ ] \n - [ ] \n- _refs_" :prepend t) 651 ("b" "bug" entry (file "inbox.org") "* FIX %?\n- _review_\n- _fix_\n- _test_" :prepend t) 652 ("r" "research" entry (file "inbox.org") "* RESEARCH %?\n:notes:\n:end:\n- _refs_" :prepend t))) 653 (setq org-html-htmlize-output-type 'css 654 org-html-head-include-default-style nil 656 org-ascii-text-width 80) 658 (org-crypt-use-before-save-magic) 660 (setq org-structure-template-alist 662 ("e" . "src emacs-lisp") 665 ("h" . "export html") 674 (setopt org-preview-latex-image-directory "~/.emacs.d/.cache/ltximg" 675 org-latex-image-default-width "8cm" 676 org-refile-use-cache t 677 org-refile-allow-creating-parent-nodes 'confirm 679 org-refile-targets '((nil :maxlevel . 3) 680 (org-agenda-files :maxlevel . 3)) 681 org-confirm-babel-evaluate nil 682 org-src-fontify-natively t 683 org-src-tabs-act-natively t 684 org-footnote-section nil 685 org-log-into-drawer t 686 org-log-states-order-reversed nil 687 org-clock-persist 'history) 689 (add-hook 'after-init-hook #'org-clock-persistence-insinuate) 691 (defun org-todo-at-date (date) 692 "create a todo entry for a given date." 693 (interactive (list (org-time-string-to-time (org-read-date)))) 694 (cl-flet ((org-current-effective-time (&rest r) date) 695 (org-today (&rest r) (time-to-days date))) 696 (cond ((eq major-mode 'org-mode) (org-todo)) 697 ((eq major-mode 'org-agenda-mode) (org-agenda-todo))))) 699 (defun org-ask-location () 700 "prompt for a location\"\"" 701 (let* ((org-refile-targets '((nil :maxlevel . 9))) 702 (hd (condition-case nil 703 (car (org-refile-get-location)) 704 (error (car org-refile-history))))) 705 (goto-char (point-min)) 706 (outline-next-heading) 707 (if (re-search-forward 708 (format org-complex-heading-regexp-format (regexp-quote hd)) 710 (goto-char (point-at-bol)) 711 (goto-char (point-max)) 712 (or (bolp) (insert "\n")) 713 (insert "* " hd "\n"))) 716 (defun org-capture-fileref-snippet (f type headers func-name) 718 (buffer-substring-no-properties (mark) (- (point) 1))) 719 (file-name (buffer-file-name)) 720 (file-base (file-name-nondirectory file-name)) 721 (line-number (line-number-at-pos (region-beginning))) 722 (initial-txt (if (null func-name) 723 (format "From [[file:%s::%s][%s]]:" 724 file-name line-number file-base) 725 (format "From ~%s~ (in [[file:%s::%s][%s]]):" 726 func-name file-name line-number 732 #+END_%s" initial-txt type headers code-snippet type))) 734 (defun org-capture-clip-snippet (f) 735 "Given a file, F, this captures the currently selected text 736 within an Org EXAMPLE block and a backlink to the file." 737 (with-current-buffer (find-buffer-visiting f) 738 (org-capture-fileref-snippet f "EXAMPLE" "" nil))) 740 (defun org-capture-code-snippet (f) 741 "Given a file, F, this captures the currently selected text 742 within an Org SRC block with a language based on the current mode 743 and a backlink to the function and the file." 744 (with-current-buffer (find-buffer-visiting f) 745 (let ((org-src-mode (replace-regexp-in-string "-mode" "" (format "%s" major-mode))) 746 (func-name (which-function))) 747 (org-capture-fileref-snippet f "SRC" org-src-mode func-name)))) 749 (defun region-to-clocked-task (start end) 750 "Copies the selected text to the currently clocked in org-mode task." 752 (org-capture-string (buffer-substring-no-properties start end) "3")) 754 (setq org-global-properties 755 '(quote (("EFFORT_ALL" . "0:15 0:30 0:45 1:00 2:00 3:00 4:00 5:00 6:00 0:00") 756 ("STYLE_ALL" . "habit")))) 758 (defun org-mode-ask-effort () 759 "Ask for an effort estimate when clocking in." 760 (unless (org-entry-get (point) "Effort") 764 (org-entry-get-multivalued-property (point) "Effort")))) 765 (unless (equal effort "") 766 (org-set-property "Effort" effort))))) 768 (add-hook 'org-clock-in-prepare-hook 769 'org-mode-ask-effort) 772 (defun org-adjust-tags-column-reset-tags () 773 "In org-mode buffers it will reset tag position according to 776 (not (string= (buffer-name) "*Remember*")) 777 (eql major-mode 'org-mode)) 778 (let ((b-m-p (buffer-modified-p))) 781 (goto-char (point-min)) 782 (command-execute 'outline-next-visible-heading) 783 ;; disable (message) that org-set-tags generates 784 (flet ((message (&rest ignored) nil)) 786 (set-buffer-modified-p b-m-p)) 790 (defun org-align-all-tables () 791 "align all tables in current buffer" 793 (org-table-map-tables 'org-table-align 'quietly)) 795 (defun org-remove-redundant-tags () 796 "Remove redundant tags of headlines in current buffer. 798 A tag is considered redundant if it is local to a headline and 799 inherited by a parent headline." 801 (when (eq major-mode 'org-mode) 805 (let ((alltags (split-string (or (org-entry-get (point) "ALLTAGS") "") ":")) 807 (dolist (tag alltags) 808 (if (get-text-property 0 'inherited tag) 809 (push tag inherited) (push tag local))) 811 (if (member tag inherited) (org-toggle-tag tag 'off))))) 814 (defvar org-agenda-overriding-header) 815 (defvar org-agenda-sorting-strategy) 816 (defvar org-agenda-restrict) 817 (defvar org-agenda-restrict-begin) 818 (defvar org-agenda-restrict-end) 821 (defun org-agenda-reschedule-to-today () 823 (flet ((org-read-date (&rest rest) (current-time))) 824 (call-interactively 'org-agenda-schedule))) 826 ;; Patch org-mode to use vertical splitting 827 (defadvice org-prepare-agenda (after org-fix-split) 828 (toggle-window-split)) 829 (ad-activate 'org-prepare-agenda) 831 (add-hook 'org-agenda-mode-hook (lambda () (hl-line-mode 1))) 833 (defun org-agenda-log-mode-colorize-block () 834 "Set different line spacing based on clock time duration." 836 (let* ((colors (cl-case (alist-get 'background-mode (frame-parameters)) 838 (list "#F6B1C3" "#FFFF9D" "#BEEB9F" "#ADD5F7")) 840 (list "#aa557f" "DarkGreen" "DarkSlateGray" "DarkSlateBlue")))) 843 (nconc colors colors) 844 (goto-char (point-min)) 845 (while (setq pos (next-single-property-change (point) 'duration)) 847 (when (and (not (equal pos (point-at-eol))) 848 (setq duration (org-get-at-bol 'duration))) 849 ;; larger duration bar height 850 (let ((line-height (if (< duration 15) 1.0 (+ 0.5 (/ duration 30)))) 851 (ov (make-overlay (point-at-bol) (1+ (point-at-eol))))) 852 (overlay-put ov 'face `(:background ,(car colors) :foreground "black")) 853 (setq colors (cdr colors)) 854 (overlay-put ov 'line-height line-height) 855 (overlay-put ov 'line-spacing (1- line-height)))))))) 857 (add-hook 'org-agenda-finalize-hook #'org-agenda-log-mode-colorize-block) 860 (defun org-agenda-current-subtree-or-region (only-todos) 861 "Display an agenda view for the current subtree or region. 862 With prefix, display only TODO-keyword items." 864 (let ((starting-point (point)) 866 (with-current-buffer (or (buffer-base-buffer (current-buffer)) 870 (setq header "Region") 871 (put 'org-agenda-files 'org-restrict (list (buffer-file-name (current-buffer)))) 872 (setq org-agenda-restrict (current-buffer)) 873 (move-marker org-agenda-restrict-begin (region-beginning)) 874 (move-marker org-agenda-restrict-end 876 ;; If point is at beginning of line, include 877 ;; heading on that line by moving forward 1. 878 (goto-char (1+ (region-end))) 879 (org-end-of-subtree)))) 880 ;; No region; restrict to subtree. 883 ;; In case the command was called from an indirect buffer, set point 884 ;; in the base buffer to the same position while setting restriction. 886 (goto-char starting-point) 887 (setq header "Subtree") 888 (org-agenda-set-restriction-lock)))) 889 ;; NOTE: Unlike other agenda commands, binding `org-agenda-sorting-strategy' 890 ;; around `org-search-view' seems to have no effect. 891 (let ((org-agenda-sorting-strategy '(priority-down timestamp-up)) 892 (org-agenda-overriding-header header)) 893 (org-search-view (if only-todos t nil) "*")) 894 (org-agenda-remove-restriction-lock t) 898 (setq tempo-interactive t) 901 ;; default.el ends here