(repeat-mode 1) (setq recenter-positions '(0)) ;; recenter-positions: Controls where the point is placed when you recenter. Setting it to (0) makes C-l (recenter) and related scrolling functions move the point to the top. Values can include: 0 for top. 0.5 for middle (default behavior). 1.0 for bottom. (setq shell-file-name "/home/ff/.guix-profile/bin/zsh") ;; permite asignar shell, impacta ledger-mode (setq inferior-lisp-program "/usr/bin/sbcl") (setq enable-recursive-minibuffers t) (setq visual-fill-column-width 80) (defun display-system-info () (interactive) (let* ((disk-free (shell-command-to-string "df -h --output=avail /")) (ram-free (shell-command-to-string "free -h --si | awk '/Mem:/ {print $7}'")) (cpu-load (shell-command-to-string "top -bn1 | grep 'Cpu(s)' | awk '{print $2 + $4}'"))) (message "Disk free:%s RAM free: %s Load: %s%%" (nth 1 (split-string disk-free "\n")) (string-trim ram-free) (string-trim cpu-load)))) ;; Set the user's full name (setq user-full-name "dir..OLA38") ;; Set the user's email address (setq user-mail-address "directora.ola38@gmail.com") ;; from https://depp.brause.cc/dotemacs/ (setq initial-scratch-message "") (setq initial-major-mode 'emacs-lisp-mode) (setq-default indent-tabs-mode nil) (setq frame-title-format '("" invocation-name ": " (:eval (replace-regexp-in-string "^ +" "" (buffer-name))))) (setq save-interprogram-paste-before-kill t) (setq recenter-positions '(top middle bottom)) (setq bookmark-default-file "~/my_forest/t1_bookmarks.el") (setq use-short-answers t) (setq calculator-displayer '(std ?f t)) ;; from mastering emacs ;; window manager (setq switch-to-buffer-obey-display-actions t) (setq circe-default-part-message "Leaving" circe-default-quit-message "Leaving") (setq lui-track-behavior 'before-switch-to-buffer) (setq circe-color-nicks-everywhere t) (setq circe-color-nicks-pool-type '("#ffaf00" "#d75f00" "#d70000" "#00af00" "#5f00ff" "#0087ff" "#ff005f" "#8700d7")) ;; test john wingley https://github.com/jwiegley/dot-emacs/blob/139bec7647d760beaac6bf5f62406bdfb1fff1ca/init.org#L7896 (use-package emacs :custom-face (cursor ((t (:background "hotpink")))) (highlight ((t (:background "blue4")))) (minibuffer-prompt ((t (:foreground "grey80")))) (mode-line-inactive ((t (:background "gray20" :foreground "gray80")))) (nobreak-space ((t nil))) (variable-pitch ((t (:height 1.2 :family "Bookerly"))))) ;; ====minibuffer (use-package vertico :ensure t :config (setq vertico-cycle t) (setq vertico-resize nil) (vertico-mode 1)) (use-package orderless :ensure t :config (setq completion-styles '(orderless basic))) (use-package consult :ensure t :bind (;; A recursive grep ("M-s M-g" . consult-grep) ;; Search for files names recursively ("M-s M-f" . consult-find) ;; Search through the outline (headings) of the file ("M-s M-o" . consult-outline) ;; Search the current buffer ("M-s M-l" . consult-line) ;; Switch to another buffer, or bookmarked file, or recently ;; opened file. ("M-s M-b" . consult-buffer))) ;; Further reading: https://protesilaos.com/emacs/dotemacs#h:61863da4-8739-42ae-a30f-6e9d686e1995 (use-package embark :ensure t :bind (("C-." . embark-act) :map minibuffer-local-map ("C-c C-c" . embark-collect) ("C-c C-e" . embark-export))) (setq prefix-help-command #'embark-prefix-help-command) ;; The `embark-consult' package is glue code to tie together `embark' ;; and `consult'. (use-package embark-consult :ensure t :hook (embark-collect-mode . consult-preview-at-point-mode)) ;; The `wgrep' packages lets us edit the results of a grep search ;; while inside a `grep-mode' buffer. All we need is to toggle the ;; editable mode, make the changes, and then type C-c C-c to confirm ;; or C-c C-k to abort. ;; ;; Further reading: https://protesilaos.com/emacs/dotemacs#h:9a3581df-ab18-4266-815e-2edd7f7e4852 (use-package wgrep :ensure t :bind ( :map grep-mode-map ("e" . wgrep-change-to-wgrep-mode) ("C-x C-q" . wgrep-change-to-wgrep-mode) ("C-c C-c" . wgrep-finish-edit))) ;; Example configuration for Consult (use-package consult ;; Replace bindings. Lazily loaded due by `use-package'. :bind (;; C-c bindings in `mode-specific-map' ("C-c M-x" . consult-mode-command) ("C-c h" . consult-history) ("C-c k" . consult-kmacro) ("C-c m" . consult-man) ("C-c i" . consult-info) ([remap Info-search] . consult-info) ;; C-x bindings in `ctl-x-map' ("C-x M-:" . consult-complex-command) ;; orig. repeat-complex-command ("C-x b" . consult-buffer) ;; orig. switch-to-buffer ("C-x 4 b" . consult-buffer-other-window) ;; orig. switch-to-buffer-other-window ("C-x 5 b" . consult-buffer-other-frame) ;; orig. switch-to-buffer-other-frame ("C-x t b" . consult-buffer-other-tab) ;; orig. switch-to-buffer-other-tab ("C-x r b" . consult-bookmark) ;; orig. bookmark-jump ("C-x p b" . consult-project-buffer) ;; orig. project-switch-to-buffer ;; Custom M-# bindings for fast register access ("M-#" . consult-register-load) ("M-'" . consult-register-store) ;; orig. abbrev-prefix-mark (unrelated) ("C-M-#" . consult-register) ;; Other custom bindings ("M-y" . consult-yank-pop) ;; orig. yank-pop ;; M-g bindings in `goto-map' ("M-g e" . consult-compile-error) ("M-g f" . consult-flymake) ;; Alternative: consult-flycheck ("M-g g" . consult-goto-line) ;; orig. goto-line ("M-g M-g" . consult-goto-line) ;; orig. goto-line ("M-g o" . consult-outline) ;; Alternative: consult-org-heading ("M-g m" . consult-mark) ("M-g k" . consult-global-mark) ("M-g i" . consult-imenu) ("M-g I" . consult-imenu-multi) ;; M-s bindings in `search-map' ("M-s d" . consult-find) ;; Alternative: consult-fd ("M-s c" . consult-locate) ("M-s g" . consult-grep) ("M-s G" . consult-git-grep) ("M-s r" . consult-ripgrep) ("M-s l" . consult-line) ("M-s L" . consult-line-multi) ("M-s k" . consult-keep-lines) ("M-s u" . consult-focus-lines) ;; Isearch integration ("M-s e" . consult-isearch-history) :map isearch-mode-map ("M-e" . consult-isearch-history) ;; orig. isearch-edit-string ("M-s e" . consult-isearch-history) ;; orig. isearch-edit-string ("M-s l" . consult-line) ;; needed by consult-line to detect isearch ("M-s L" . consult-line-multi) ;; needed by consult-line to detect isearch ;; Minibuffer history :map minibuffer-local-map ("M-s" . consult-history) ;; orig. next-matching-history-element ("M-r" . consult-history)) ;; orig. previous-matching-history-element ;; Enable automatic preview at point in the *Completions* buffer. This is ;; relevant when you use the default completion UI. :hook (completion-list-mode . consult-preview-at-point-mode) ;; The :init configuration is always executed (Not lazy) :init ;; Optionally configure the register formatting. This improves the register ;; preview for `consult-register', `consult-register-load', ;; `consult-register-store' and the Emacs built-ins. (setq register-preview-delay 0.5 register-preview-function #'consult-register-format) ;; Optionally tweak the register preview window. ;; This adds thin lines, sorting and hides the mode line of the window. (advice-add #'register-preview :override #'consult-register-window) ;; Use Consult to select xref locations with preview (setq xref-show-xrefs-function #'consult-xref xref-show-definitions-function #'consult-xref) ;; Configure other variables and modes in the :config section, ;; after lazily loading the package. :config ;; Optionally configure preview. The default value ;; is 'any, such that any key triggers the preview. ;; (setq consult-preview-key 'any) ;; (setq consult-preview-key "M-.") ;; (setq consult-preview-key '("S-" "S-")) ;; For some commands and buffer sources it is useful to configure the ;; :preview-key on a per-command basis using the `consult-customize' macro. (consult-customize consult-theme :preview-key '(:debounce 0.2 any) consult-ripgrep consult-git-grep consult-grep consult-bookmark consult-recent-file consult-xref consult--source-bookmark consult--source-file-register consult--source-recent-file consult--source-project-recent-file ;; :preview-key "M-." :preview-key '(:debounce 0.4 any)) ;; Optionally configure the narrowing key. ;; Both < and C-+ work reasonably well. (setq consult-narrow-key "<") ;; "C-+" ;; Optionally make narrowing help available in the minibuffer. ;; You may want to use `embark-prefix-help-command' or which-key instead. ;; (define-key consult-narrow-map (vconcat consult-narrow-key "?") #'consult-narrow-help) ;; By default `consult-project-function' uses `project-root' from project.el. ;; Optionally configure a different project root function. ;;;; 1. project.el (the default) ;; (setq consult-project-function #'consult--default-project--function) ;;;; 2. vc.el (vc-root-dir) ;; (setq consult-project-function (lambda (_) (vc-root-dir))) ;;;; 3. locate-dominating-file ;; (setq consult-project-function (lambda (_) (locate-dominating-file "." ".git"))) ;;;; 4. projectile.el (projectile-project-root) ;; (autoload 'projectile-project-root "projectile") ;; (setq consult-project-function (lambda (_) (projectile-project-root))) ;;;; 5. No project support ;; (setq consult-project-function nil) ) (use-package orderless :ensure t :custom (completion-styles '(orderless basic)) (completion-category-overrides '((file (styles basic partial-completion))))) (setq completion-pcm-leading-wildcard t) ;; The built-in `savehist-mode' saves minibuffer histories. Vertico ;; can then use that information to put recently selected options at ;; the top. ;; ;; Further reading: https://protesilaos.com/emacs/dotemacs#h:25765797-27a5-431e-8aa4-cc890a6a913a ;; Persist history over Emacs restarts. Vertico sorts by history position. (use-package savehist :init (savehist-mode)) ;; The built-in `recentf-mode' keeps track of recently visited files. ;; You can then access those through the `consult-buffer' interface or ;; with `recentf-open'/`recentf-open-files'. ;; ;; I do not use this facility, because the files I care about are ;; either in projects or are bookmarked. (recentf-mode 1) ;; ;; Enable rich annotations using the Marginalia package ;; (use-package marginalia ;; ;; Bind `marginalia-cycle' locally in the minibuffer. To make the binding ;; ;; available in the *Completions* buffer, add it to the ;; ;; `completion-list-mode-map'. ;; :bind (:map minibuffer-local-map ;; ("M-A" . marginalia-cycle)) ;; ;; The :init section is always executed. ;; :init ;; ;; Marginalia must be activated in the :init section of use-package such that ;; ;; the mode gets enabled right away. Note that this forces loading the ;; ;; package. ;; (marginalia-mode)) (use-package color-theme :no-require t :init (deftheme midnight "midnight theme") (custom-theme-set-faces 'midnight '(default ((t (:background "black" :foreground "grey85")))) '(mouse ((t (:foreground "grey85")))) '(cursor ((t (:background "grey85")))) '(font-lock-comment-face ((t (:italic t :foreground "grey60")))) '(font-lock-string-face ((t (:foreground "Magenta")))) '(font-lock-keyword-face ((t (:foreground "Cyan")))) '(font-lock-warning-face ((t (:bold t :foreground "Pink")))) '(font-lock-constant-face ((t (:foreground "OliveDrab")))) '(font-lock-type-face ((t (:foreground "DarkCyan")))) '(font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) '(font-lock-function-name-face ((t (:foreground "SlateBlue")))) '(font-lock-builtin-face ((t (:foreground "SkyBlue")))) '(highline-face ((t (:background "grey12")))) '(setnu-line-number-face ((t (:background "Grey15" :foreground "White" :bold t)))) '(show-paren-match-face ((t (:background "grey30")))) '(region ((t (:background "grey15")))) '(highlight ((t (:background "grey15")))) '(ledger-font-xact-highlight-face ((t (:background "grey12")))) ;; fix ledger background '(secondary-selection ((t (:background "navy")))) '(widget-field-face ((t (:background "navy")))) '(widget-single-line-field-face ((t (:background "royalblue"))))) :config (enable-theme 'midnight)) ;;(fix-mode-line) ;;;; === mail (load-library "sendmail") ;; se llama para no tener que iniciar (mail) ;; ;(setq smtpmail-stream-type 'ssl) ;; (setq smtpmail-smtp-server "smtp.gmail.com") ;; (setq smtpmail-smtp-service 465) ;; ===== BROWSER (defun my-qutebrowser-edit () (markdown-mode) (auto-fill-mode -1) (setq require-final-newline nil)) (add-to-list 'auto-mode-alist '("\\`/tmp/qutebrowser-editor-" . my-qutebrowser-edit)) ;; ;; ====== EXWM ;; (desktop-save-mode 1) ;; (defun efs/exwm-update-class () ;; (exwm-workspace-rename-buffer exwm-class-name)) ;; (use-package exwm ;; :config ;; ;; Set the default number of workspaces ;; ;;(setq exwm-workspace-number 5) ;; ;; When window "class" updates, use it to set the buffer name ;; (add-hook 'exwm-update-class-hook #'efs/exwm-update-class) ;; ;; Rebind CapsLock to Ctrl ;; (start-process-shell-command "xmodmap" nil "xmodmap ~/.emacs.d/exwm/Xmodmap") ;; ;; Set the screen resolution (update this to be the correct resolution for your screen!) ;; (require 'exwm-randr) ;; (exwm-randr-enable) ;; ;; (start-process-shell-command "xrandr" nil "xrandr --output Virtual-1 --primary --mode 2048x1152 --pos 0x0 --rotate normal") ;; ;; Load the system tray before exwm-init ;; (require 'exwm-systemtray) ;; (exwm-systemtray-enable) ;; ;; These keys should always pass through to Emacs ;; (setq exwm-input-prefix-keys ;; '(?\C-x ;; ?\C-u ;; ;; ?\C-c ;; ?\C-h ;; ?\M-x ;; ?\M-` ;; ?\M-& ;; ?\M-: ;; ?\C-\M-j ;; Buffer list ;; ?\C-\ )) ;; Ctrl+Space ;; ;; Ctrl+Q will enable the next key to be sent directly ;; (define-key exwm-mode-map [?\C-q] 'exwm-input-send-next-key) ;; ;; Set up global key bindings. These always work, no matter the input state! ;; ;; Keep in mind that changing this list after EXWM initializes has no effect. ;; (setq exwm-input-global-keys ;; `( ;; ;; Reset to line-mode (C-c C-k switches to char-mode via exwm-input-release-keyboard) ;; ([?\s-r] . exwm-reset) ;; ;; Move between windows ;; ([s-left] . windmove-left) ;; ([s-right] . windmove-right) ;; ([s-up] . windmove-up) ;; ([s-down] . windmove-down) ;; ;; Launch applications via shell command ;; ([?\s-&] . (lambda (command) ;; (interactive (list (read-shell-command "$ "))) ;; (start-process-shell-command command nil command))) ;; ;; Switch workspace ;; ([?\s-w] . exwm-workspace-switch) ;; ([?\s-`] . (lambda () (interactive) (exwm-workspace-switch-create 0))) ;; ;; 's-N': Switch to certain workspace with Super (Win) plus a number key (0 - 9) ;; ,@(mapcar (lambda (i) ;; `(,(kbd (format "s-%d" i)) . ;; (lambda () ;; (interactive) ;; (exwm-workspace-switch-create ,i)))) ;; (number-sequence 0 9)))) ;; (exwm-enable) ;; ) ;; ==== WORKSPACES ;(beframe-mode 1) ;; This is the default value. Write here the names of buffers that ;; should not be beframed. ;(setq beframe-global-buffers '("*scratch*" "*Messages*" "*Backtrace*")) ;; Bind Beframe commands to a prefix key, such as C-c b: ;(define-key global-map (kbd "C-c b") beframe-prefix-map) ;; Remap CapsLock to Ctrl (start-process-shell-command "xmodmap" nil "xmodmap ~/.emacs.d/exwm/Xmodmap") (start-process-shell-command "setxkbmap" nil "setxkbmap -layout us -model pc105 -variant altgr-intl -option 'lalt:compose' -option ctrl:nocaps") (defun remap-keyboard () "Permite reconfigurar el teclado luego de reconectarlo" (interactive) (start-process-shell-command "setxkbmap" nil "setxkbmap -layout us -model pc105 -variant altgr-intl -option 'lalt:compose' -option ctrl:nocaps")) (defun remap-keyboard-reset () "Permite volver a la configuración inicial donde CAPS key funciona como mayuscula sostenida" (interactive) (start-process-shell-command "setxkbmap" nil "setxkbmap -layout us -option ''")) (start-process-shell-command "syncthing" nil "syncthing") ;; ===== TRANSLATE ;(require 'go-translate) ;(setq gts-translate-list '(("en" "es"))) ;; (setq gts-default-translator (gts-translator :engines (gts-bing-engine))) ;; (setq gts-default-translator ;; (gts-translator ;; :picker (gts-prompt-picker) ;; :engines (list (gts-bing-engine) (gts-google-engine)) ;; :render (gts-buffer-render))) ;; === BABEL ;; (org-babel-do-load-languages ;; 'org-babel-load-languages ;; '((emacs-lisp . t) ;; (ledger . t) ;; (sh . t) ;; (R . t))) ;; ;; === MAGIT (setq magit-repository-directories `(("~/Admin" . 2) ("~/Scripts" . 2) ("~/my_forest" . 2))) ;; (setq magit-repository-directories-depth 2) (setq magit-repolist-columns '(("Name" 25 magit-repolist-column-ident ()) ("Version" 25 magit-repolist-column-version ()) ;(;"D" 1 magit-repolist-column-dirty ()) ("BU" 3 magit-repolist-column-unpushed-to-upstream ((:right-align t) (:help-echo "Local changes not in upstream"))) ("Path" 99 magit-repolist-column-path ()))) ;; (with-eval-after-load 'magit-repos ;; ;; Avoid destructively modifying a list literal. ;; (let ((cols (copy-sequence magit-repolist-columns))) ;; (push '("D" 1 magit-repolist-column-dirty ()) ;; (nthcdr 2 cols)) ;; (setq magit-repolist-columns cols))) ;; === MODE-LINE (defun fix-mode-line () (interactive) (set-face-attribute 'mode-line nil :background "purple4" :foreground "green1" :box "dim gray") (set-face-attribute 'mode-line-inactive nil :background "black" :foreground "dim gray" :box "dim gray")) (setq display-time-format nil display-time-day-and-date t display-time-24hr-format t) ;;=== cosmetic (use-package spacious-padding :ensure t :custom (spacious-padding-subtle-mode-line t) :config (spacious-padding-mode 1)) (spacious-padding--disable-mode) (defun insert-today-date () "Insert today's date in YYYY/MM/DD format." (interactive) (insert (format-time-string "%Y/%m/%d"))) (defun backup-file-with-datetime (file) "Backup the given FILE by copying it with a timestamp appended to the name." (interactive "fSelect file to backup: ") (let* ((current-time (format-time-string "%Y%m%d_%H%M%S")) (backup-file (concat (file-name-directory file) "_backup_" (file-name-base file) "__" current-time (file-name-extension file t)))) (copy-file file backup-file) (message "Backup created: %s" backup-file))) (defun backup-cuentasOLA () (interactive) (backup-file-with-datetime "/home/ff/backupAdmin/ola38-git/cuentasOLA38.ldg") (backup-file-with-datetime "/home/ff/backupAdmin/ola38-git/plan_de_cuentas.ldg")) (defun backup-personales () (interactive) (backup-file-with-datetime "/home/ff/SyncDocs/capture.ldg") (backup-file-with-datetime "/home/ff/SyncDocs/FLC_informacion.ldg") (backup-file-with-datetime "/home/ff/SyncDocs/FLC_narracion.ldg")) (defun fix-ledger-theme () (interactive) (custom-set-faces '(ledger-font-xact-highlight-face ((t :background "#000000"))) '(ledger-font-posting-account-cleared-face ((t :foreground "dim gray"))) '(ledger-font-posting-account-face ((t :foreground "LightSalmon1"))) '(ledger-font-posting-amount-face ((t :foreground "gold1"))) '(ledger-font-comment-face ((t :foreground "#FFFFFF"))))) (defun reset-face-to-default (face) "Reset FACE to its default value." (custom-set-faces `(,face ((t (:inherit nil))))) (custom-reevaluate-setting face)) ;; Example usage: (defun reset-ledger-faces-to-default () (interactive) (progn (reset-face-to-default 'ledger-font-xact-highlight-face) (reset-face-to-default 'ledger-font-comment-face) (reset-face-to-default 'ledger-font-payee-uncleared-face) (reset-face-to-default 'ledger-font-posting-account-face) (reset-face-to-default 'ledger-font-posting-amount-face) (reset-face-to-default 'region))) (defun faceinfo () "Consulta la /face/ seleccionada" (interactive) (describe-face (face-at-point))) (defun ledger-faces-random () (interactive) (assign-random-color-to-faces '(ledger-font-comment-face ledger-font-payee-uncleared-face ledger-font-posting-account-face ledger-font-posting-amount-face))) (defun theme-faces-random () (interactive) (assign-random-color-to-faces '(font-lock-keyword-face font-lock-string-face font-lock-function-name-face font-lock-comment-face))) ;; Example usage ;;(assign-random-color-to-faces '(ledger-font-comment-face another-face yet-another-face)) (defun fix-ledger-theme-disable () (interactive) (custom-set-faces '(ledger-font-xact-highlight-face (( ))))) ;; (modus-themes-with-colors ;; (set-face-attribute 'mode-line nil ;; :background bg-sage ;; :foreground fg-main ;; :box green-cooler)) (defun query-theme () "Reporta el nombre del tema de algunos temas ¿porquéa algunos temas no reprtan el nombre?" (interactive) (print (mapconcat 'symbol-name custom-enabled-themes ""))) (defun deface () "Regresa el tamaño de la letra luego de haber sido modificada por algún tema" (interactive) (set-face-attribute 'default nil :height 100)) (defun fix-theme() "no funciona" (interactive) (custom-theme-set-faces (mapconcat 'symbol-name custom-enabled-themes "") '(font-lock-string-face ((t (:bold t :background "black" :foreground "seagreen" :weight semi-bold)))))) ;; ==== Windows (setq switch-to-buffer-in-dedicated-window "pop") (defun mp-toggle-window-dedication () "Toggles window dedication in the selected window." (interactive) (set-window-dedicated-p (selected-window) (not (window-dedicated-p (selected-window))))) ;; Push and pop window configurations (from J.wingley) (defvar saved-window-configuration nil) (defun push-window-configuration () (interactive) (push (current-window-configuration) saved-window-configuration)) (defun pop-window-configuration () (interactive) (let ((config (pop saved-window-configuration))) (if config (set-window-configuration config) (if (> (length (window-list)) 1) (delete-window) (bury-buffer))))) ;; Window rules from https://protesilaos.com/codelog/2024-02-08-emacs-window-rules-display-buffer-alist/ (setq display-buffer-alist '( ("\\*Ledger Report\\*" (display-buffer-reuse-window display-buffer-in-direction) (direction . left)) ;; ("\\.ldg" ;; (display-buffer-reuse-window)) ("\\*Libera Chat\\*" (display-buffer-reuse-window display-buffer-in-direction) (direction . left)) ("\\*Occur\\*" (display-buffer-reuse-window display-buffer-below-selected) ;; (dedicated . t) (window-height . fit-window-to-buffer)) ("\\*EMMS-TAGS\\*" (display-buffer-same-window)) )) ;;(setq display-buffer-alist nil) ;; panic ;; === EMMS (emms-all) (require 'emms-setup) (require 'emms-mark) (require 'emms-history) (require 'emms-volume) ;(emms-history-load) ;;(setq emms-history-start-playing nil) ;; queremos escuchar cuando se cargue el historial (setq emms-playlist-buffer-name "*Music*") ;;(require 'emms-player-simple) (require 'emms-source-file) (require 'emms-source-playlist) (emms-default-players) (setq emms-player-list '(emms-player-mpg123 emms-player-ogg123 emms-player-vlc emms-player-mplayer)) (require 'emms-player-simple) (define-emms-simple-player chuck '(file) "\\.ck$" "chuck") (define-emms-simple-player mpg123 '(file url) (emms-player-simple-regexp "mp3" "mp2") "mpg321") ;; ;; Define the ffplay player ;; (emms-player-set emms-player-ffplay 'regex "\\.\\(mp3\\|wav\\|flac\\|ogg\\|mp4\\|mkv\\)$") ;; (setq emms-player-ffplay-command-name "ffplay") ;; (setq emms-player-ffplay-parameters '("-nodisp" "-autoexit")) ;; ;; Add ffplay player to the list of available players in EMMS ;; (add-to-list 'emms-player-list 'emms-player-ffplay) ;; (require 'emms-player) ;; (define-emms-player "emms-chuck-remote" ;; :start 'emms-chuck-remote-start ;; :stop 'emms-chuck-remote-stop ;; :playablep 'emms-chuck-remote-playable-p) ;; (defun emms-chuck-remote-start () ;; (unless (get-process ``chuck-remote'') ;; (setq emms-chuck-remote-process ;; (start-process "chuck-remote-process" ;; "*chuck*" "chuck" "-R" "abc")) ;; (process-send-string "chuck-remote-process" ;; (concat "l " (emms-track-name track))) ;; (set-process-filter emms-chuck-remote-process 'emms-chuck-remote-filter))) (defun set-global-key-bindings (bindings) "Set multiple global key bindings from a list of (key . command) pairs." (dolist (binding bindings) (global-set-key (kbd (car binding)) (cdr binding)))) (set-global-key-bindings '(("C-c a" . windmove-left) ("C-z" . nil) ;; frame suspend ("C-v" . nil) ;; scroll down ("C-s" . swiper) ("M-/" . dabbrev-expand) ("" . tareas-layout) ("" . mail-layout) ("" . browser-layout) ("" . config-layout) ("" . dired-layout) ("" . ii) ("" . oo) ("" . capture-to-ledger) ("" . capture-alc-layout) ("" . cartera-layout) ("" . correo-layout) ("" . tareas-layout) ("C-c f b" . backward--invert-currency) ("C-c f t" . random-theme) ("C-c f r" . reposition-time-value) ("C-c f i" . (lambda () (interactive) (ledger-report "REG zettelkasten index" nil))) ("C-c f a" . (lambda () (interactive) (ledger-report "todo newline test" nil))) ("C-c w b" . balance-windows) ("C-c w ]" . (lambda () (interactive) (enlarge-window-horizontally 30))) ("C-c w [" . (lambda () (interactive) (shrink-window-horizontally 30))) ("C-c s a" . emms-add-file) ("C-c s f" . emms-add-dired) ("C-c s g" . emms-playlist-mode-go) ("C-c s m" . emms-mark-all) ("C-c s n" . emms-next) ("C-c s p" . emms-pause) ("C-c s t" . emms-mark-track) ("C-c s r" . emms-random) ("C-c s =" . emms-volume-raise) ("C-c s -" . emms-volume-lower) ("" . emms-previous) ("" . emms-next) ("" . emms-pause) ("" . emms-pause) ("" . emms-smart-browse) ("" . emms-next) ("" . emms-playlist-mode-go) )) ;; Keyboard shortcuts (global-set-key (kbd "") 'emms-previous) (global-set-key (kbd "") 'emms-next) (global-set-key (kbd "") 'emms-pause) (global-set-key (kbd "") 'emms-pause) ;;(global-set-key (kbd "") 'emms-smart-browse) (global-set-key (kbd "") 'emms-next) (global-set-key (kbd "") 'emms-playlist-mode-go) ;; ;; Define custom keybindings for various groups ;; (dolist (binding '((("C-c f b" . backward--invert-currency) ;; ("C-c f t" . random-theme) ;; ("C-c f r" . reposition-time-value) ;; ("C-c f i" . (lambda () (interactive) (ledger-report "REG zettelkasten index" nil))) ;; ("C-c f a" . (lambda () (interactive) (ledger-report "todo newline test" nil)))) ;; (("C-c w b" . balance-windows) ;; ("C-c w ]" . (lambda () (interactive) (enlarge-window-horizontally 30))) ;; ("C-c w [" . (lambda () (interactive) (shrink-window-horizontally 30)))) ;; (("C-c s a" . emms-add-file) ;; ("C-c s f" . emms-add-dired) ;; ("C-c s g" . emms-playlist-mode-go) ;; ("C-c s m" . emms-mark-all) ;; ("C-c s n" . emms-next) ;; ("C-c s p" . emms-pause) ;; ("C-c s t" . emms-mark-track) ;; ("C-c s r" . emms-random) ;; ("C-c s =" . emms-volume-raise) ;; ("C-c s -" . emms-volume-lower)))) ;; (dolist (pair binding) ;; (global-set-key (kbd (car pair)) (cdr pair)))) ;; (dolist (keys '(("C-c s o" 'scratch-buffer))) ;; (global-set-key '(kbd (car keys)) (cadr keys))) ;; (dolist (binding '((?a . emms-add-file) ;; (?f . emms-add-dired) ;; (?g . emms-playlist-mode-go) ;; (?m . emms-mark-all) ;; (?n . emms-next) ;; (?p . emms-pause) ;; (?t . emms-mark-track) ;; (?r . emms-random) ;; (?= . emms-volume-raise) ;; (?- . emms-volume-lower))) ;; (global-set-key (kbd (concat "C-c s " (char-to-string (car binding)))) (cdr binding))) (dolist (reg-file '((?e "~/.emacs") (?t "~/ola38/tareasAlc.ldg") (?c "~/SyncDocs/capture.ldg") (?u "~/my_forest/emacs_utilities.el") (?i "~/SyncDocs/ALC_informe.el") (?p "~/my_forest/panel_federico.el") (?n "~/SyncDocs/orgzly/notes.md"))) (set-register (car reg-file) (cons 'file (cadr reg-file)))) ;; (defun bookmark-store (name bookmark no-overwrite) ;; "Store a bookmark named NAME with data BOOKMARK. ;; If NO-OVERWRITE is non-nil, do not overwrite an existing bookmark with the same NAME." ;; (require 'bookmark) ;; Asegura que el sistema de bookmarks esté cargado ;; (let ((existing-bookmark (bookmark-get-bookmark name t))) ;; (when (and existing-bookmark no-overwrite) ;; (error "Bookmark \"%s\" already exists and NO-OVERWRITE is set" name))) ;; ;; Añadir la nueva definición a la lista de bookmarks ;; (setq bookmark-alist ;; (cons (cons 'name name bookmark) ;; (assq-delete-all name bookmark-alist))) ;; (bookmark-maybe-save-bookmark) ;; Guarda automáticamente la lista de bookmarks ;; (message "Bookmark \"%s\" stored successfully." name)) ;; (defun set-predefined-bookmark (name file position) ;; "Set a bookmark with NAME at POSITION in FILE." ;; (let ((bookmark `((filename . ,file) ;; (position . ,position) ;; (name . ,name) ;; (front-context-string . "") ;; (rear-context-string . "")))) ;; (bookmark-store name bookmark nil))) ;; ;; Lista de bookmarks predefinidos ;; (dolist (bookmark ;; '(("plan_de_cuentas" "~/ola38/plan_de_cuentas.ldg" 100) ;; ("agenda" "~/SyncDocs/orgzly/notes.md" 3) ;; ("todo" "~/my_forest/panel_federico.el" 100) ;; ("ediff_cuentasOLA38" "~/my_forest/panel_federico.el" 100) ;; ("informe_ALC" "~/my_forest/panel_federico.el" 100) ;; ("informe_FALopez" "~/my_forest/panel_federico.el" 292) ;; ("set_bookmarks" "~/my_forest/emacs_utilities.el" 835))) ;; (apply 'set-predefined-bookmark bookmark)) ;; (bookmark-set "plan_de_cuentas" "~/ola38/plan_de_cuentas.ldg" 100) (defun show-circle-of-fifths () "Display the Circle of Fifths with major/minor keys, alterations, and their names." (interactive) (let ((buffer-name "*Circle of Fifths*") (keys '("C" "G" "D" "A" "E" "B" "F#" "C#" "F" "Bb" "Eb" "Ab" "Db" "Gb" "Cb")) (alterations '((0 "Natural") (+1 "F#") (+2 "F#, C#") (+3 "F#, C#, G#") (+4 "F#, C#, G#, D#") (+5 "F#, C#, G#, D#, A#") (+6 "F#, C#, G#, D#, A#, E#") (+7 "F#, C#, G#, D#, A#, E#, B#") (-1 "Bb") (-2 "Bb, Eb") (-3 "Bb, Eb, Ab") (-4 "Bb, Eb, Ab, Db") (-5 "Bb, Eb, Ab, Db, Gb") (-6 "Bb, Eb, Ab, Db, Gb, Cb") (-7 "Bb, Eb, Ab, Db, Gb, Cb, Fb"))) ;; Adjust minor key mapping (minor-relative '("am" "em" "bm" "f#m" "c#m" "g#m" "d#m" "bbm" "fm" "cm" "gm" "dm"))) ;; Create and switch to the buffer (with-current-buffer (get-buffer-create buffer-name) (erase-buffer) (insert "Circle of Fifths\n") (insert (make-string 50 ?=) "\n\n") ;; Insert Major Keys (insert (propertize "Major Keys:\n" 'face '(:weight bold :underline t))) (dotimes (i (length keys)) (let* ((key (nth i keys)) (alteration (nth i alterations)) (count (car alteration)) (names (cadr alteration))) (insert (format "%-4s: %-15s %s\n" key (format "%d %s" count (if (> count 0) "sharp(s)" "flat(s)")) (if names (concat "(" names ")") ""))))) (insert "\n") ;; Insert Minor Keys (insert (propertize "Minor Keys (Relative):\n" 'face '(:weight bold :underline t))) (dotimes (i (length keys)) (let* ((minor-key (nth i minor-relative)) (alteration (nth i alterations)) (count (car alteration)) (names (cadr alteration))) (insert (format "%-4s: %-15s %s\n" minor-key (format "%d %s" count (if (> count 0) "sharp(s)" "flat(s)")) (if names (concat "(" names ")") "")))))) ;; Display buffer (display-buffer buffer-name))) ;; probamos la persistencia de los registros con (setopt savehist-additional-variables '(register-alist)) ;; alternativa para guardar registros y recuperarlos (defun save-registers-to-file () "Save registers to a file" (interactive) (with-temp-file "~/.emacs.d/registers.el" (prin1 register-alist (current-buffer)))) (defun load-registers-from-file () "Load registers from the file at startup" (interactive) (with-temp-buffer (insert-file-contents "~/.emacs.d/registers.el") (setq register-alist (read (current-buffer))))) ;; If you want `switch-to-buffer' and related to respect those rules ;; (I personally do not want this, because if I am switching to a ;; specific buffer in the current window, I probably have a good ;; reason for it): (setq switch-to-buffer-obey-display-actions t) ;; If you are in a window that is dedicated to its buffer and try to ;; `switch-to-buffer' there, tell Emacs to pop a new window instead of ;; using the current one: (setq switch-to-buffer-in-dedicated-window 'pop) ;; Other relevant variables which control when Emacs splits the frame ;; vertically or horizontally, with some sample values (do `M-x ;; describe-variable' and search for those variables to learn more ;; about them): (setq split-height-threshold 80) (setq split-width-threshold 125) ;;### ivy (setq ivy-use-virtual-buffers t) (setq ivy-count-format "(%d/%d) ") ;; ===== THEMES CUSTOMIZATION ;;(set-face-attribute 'ledger-font-xact-highlight-face nil :background "#001") (setq robin-hood-theme-region '(bg-only no-extend)) ;;https://protesilaos.com/emacs/modus-themes#h:c8605d37-66e1-42aa-986e-d7514c3af6fe ;; Blue background, neutral foreground, intense blue border (setq modus-themes-common-palette-overrides '((bg-mode-line-active bg-blue-subtle) (fg-mode-line-active fg-main) (border-mode-line-active unspecifier) (bg-region bg-sage) ; try to replace `bg-ochre' with `bg-lavender', `bg-sage' (fg-region unspecified))) ;; ==== LOAD THEME (add-to-list 'custom-theme-load-path "~/my_forest/") ;;(load-theme 'modus-vivendi-deuteranopia t) ;;(load-theme 'doom-meltbus t) ;;(load-theme 'doom-rouge t) ;;(load-theme 'dark-laptop t) ;; ef-duo-dark inicia con borde blanco? ;; (use-package ef-themes ;; :ensure t ;; :config ;; (load-theme 'wheatgrass t)) ;;(load-theme 'black t) ;; Do not extend `region' background past the end of the line. (custom-set-faces '(region ((t :extend nil)))) ;;;; FONTS / FACES (defun jmi/set-buffer-local-family (font-family) "Sets font in current buffer" (interactive "sFont Family: ") (defface tmp-buffer-local-face '((t :family font-family)) "Temporary buffer-local face") (buffer-face-set 'tmp-buffer-local-face)) ;; == test ;;(face-remap-add-relative 'ledger-font-xact-highlight-face 'Info-quoted) ;;(set-face-background 'default "#001") ;;(set-face-attribute 'ledger-font-xact-highlight-face nil :background "#001") ;; (set-face-attribute 'ledger-font-payee-uncleared-face nil :foreground "honeydew3") ;; (set-face-attribute 'ledger-font-posting-account-face nil :foreground "LightGoldenrod") ;; (set-face-attribute 'ledger-font-posting-account-cleared-face nil :foreground "DarkOliveGreen") ;; ===== GPG (setq auth-source-debug t) (setq epg-gpg-program "gpg2") ;; modes for file extension ==================== (add-to-list 'auto-mode-alist '("\\.ldg\\'" . ledger-mode)) (add-to-list 'auto-mode-alist '("\\.dat\\'" . ledger-mode)) (add-to-list 'auto-mode-alist '("\\.ck\\'" . chuck-mode)) ;; acces to ledger reports ;; (defun todo () ;; (interactive) ;; (ledger-report "todo newline test" nil)) ;; === visual fill column (setq visual-fill-column-width 110 visual-fill-column-center-text t) ;; ==== KEYS ;;(define-key mrepl-mode (kbd ",") nil) ;;(global-set-key (kbd "," ) nil) ;; REPL excecute command (global-set-key (kbd "C-c a") 'windmove-left) (global-set-key (kbd "C-z" ) nil) ;; frame suspend (global-set-key (kbd "C-v" ) nil) ;; scrol down (global-set-key (kbd "C-z" ) nil) ;; frame suspend (global-set-key (kbd "C-s" ) 'swiper) ;(global-set-key (kbd "") 'config-layout) (global-set-key (kbd "") 'tareas-layout) (global-set-key (kbd "") 'mail-layout) (global-set-key (kbd "") 'browser-layout) (global-set-key (kbd "") 'config-layout) (global-set-key (kbd "") 'dired-layout) (global-set-key (kbd "") 'ii) (global-set-key (kbd "") 'oo) (global-set-key (kbd "") 'capture-to-ledger) (global-set-key (kbd "") 'capture-alc-layout) (global-set-key (kbd "") 'cartera-layout) (global-set-key (kbd "") 'correo-layout) (global-set-key (kbd "") 'tareas-layout) (global-set-key (kbd "M-/") 'dabbrev-expand) ;; ===== LINE NUMBERS (global-display-line-numbers-mode 1) (setq display-line-numbers-type 'relative) (setq ledger-report-auto-refresh-sticky-cursor t) ;; keep cursor when refresh ;; Disable line numbers for some modes (dolist (mode '(org-mode-hook text-mode-hook term-mode-hook shell-mode-hook treemacs-mode-hook eshell-mode-hook)) (add-hook mode (lambda () (display-line-numbers-mode 0)))) ;; === hooks === (add-hook 'ledger-report-mode-hook 'toggle-word-wrap 1) ;;(add-hook 'ledger-report-mode-hook 'visual-fill-column-mode nil) (add-hook 'ledger-report-mode-hook 'visual-line-mode nil) (add-hook 'ledger-report-mode-hook 'display-line-numbers-mode 1) (add-hook 'ledger-mode-hook 'display-line-numbers-mode 1) ;; audio inits ;;(require 'pulseaudio-control) ;;(pulseaudio-control-default-keybindings) (defun my/update-lines (bunches pos keep) (cl-loop with dec = (if keep 0 1) for line being the hash-key of bunches using (hash-value positions) do (puthash line (cl-loop for p in positions if (< p pos) collect p else if (> p pos) collect (- p dec)) bunches))) (defun my/suggest-delete-line (line) (let ((len (length line))) (move-overlay selection (point) (+ (point) len)) (let* ((inhibit-quit t) (answer (with-local-quit (read-key (format "Delete '%s%s'? [y]es/[n]o" (substring line 0 (min len 13)) (cond ((> len 16) "...") ((> len 13) (substring line 13 len)) (t ""))))))) (when (= answer ?y) (delete-region (point) (progn (move-end-of-line 1) (forward-char) (point)))) answer))) (defun my/delete-duplicate-lines (beg end) "peligro borra el original" (interactive (if (region-active-p) (list (region-beginning) (region-end)) (list (point-min) (point-max)))) (let ((ignore-white (< (prefix-numeric-value current-prefix-arg) 1)) (ignore-blank (< (prefix-numeric-value current-prefix-arg) 4)) (bunches (make-hash-table :test 'equal)) (selection (make-overlay 1 1))) (overlay-put selection 'face 'secondary-selection) (save-excursion (goto-char beg) (move-beginning-of-line 1) (cl-loop for lnum = (count-lines (point-min) beg) then (1+ lnum) for line = (buffer-substring-no-properties (point) (progn (move-end-of-line 1) (point))) while (< (point) end) do (forward-char) (unless (or (and (string-match "[ \t]+" line) ignore-white) (and (string-match "^$" line) ignore-blank)) (puthash line (cons lnum (gethash line bunches)) bunches)))) (cl-loop for line being the hash-key of bunches using (hash-value positions) unless (cdr positions) do (remhash line bunches)) (cl-loop named :outer for line being the hash-key of bunches do (cl-loop for positions = (gethash line bunches) while positions do (cl-loop with continue = t for pos in positions while continue do (goto-char (point-min)) (forward-line pos) (recenter) (cl-case (my/suggest-delete-line line) (?\C-g (cl-return-from :outer)) (?y) (otherwise (setf continue nil))) (my/update-lines bunches pos continue)))) (delete-overlay selection))) (defun uniquify-all-lines-region (start end) "Find duplicate lines in region START to END keeping first occurrence." (interactive "*r") (save-excursion (let ((end (copy-marker end))) (while (progn (goto-char start) (re-search-forward "^\\(.*\\)\n\\(\\(.*\n\\)*\\)\\1\n" end t)) (replace-match "\\1\n\\2"))))) (defun uniquify-all-lines-buffer () "Delete duplicate lines in buffer and keep first occurrence." (interactive "*") (uniquify-all-lines-region (point-min) (point-max))) (defun find-and-remove-duplicate-lines-old () "Search for duplicate lines in the current buffer and ask for removal." (interactive) (let ((line-hash (make-hash-table :test 'equal)) (current-line "") (line-number 1)) (goto-char (point-min)) ;; Iterate through each line in the buffer (while (not (eobp)) (setq current-line (buffer-substring-no-properties (line-beginning-position) (line-end-position))) (if (gethash current-line line-hash) ;; If the line already exists in the hash table, ask for deletion (when (y-or-n-p (format "Duplicate line found at line %d: \"%s\". Delete? " line-number current-line)) (delete-region (line-beginning-position) (1+ (line-end-position)))) ;; Otherwise, add the line to the hash table (puthash current-line t line-hash)) (setq line-number (1+ line-number)) (forward-line 1)) (message "Duplicate check completed."))) (defun find-and-remove-duplicate-lines (&optional allow-empty-lines) "C-u M-x find-and ... Search for duplicate lines in the current buffer and ask for removal. If ALLOW-EMPTY-LINES is non-nil, white (empty) lines are ignored during duplicate detection." (interactive "P") (let ((line-hash (make-hash-table :test 'equal)) (current-line "") (line-number 1)) (goto-char (point-min)) ;; Iterate through each line in the buffer (while (not (eobp)) (setq current-line (buffer-substring-no-properties (line-beginning-position) (line-end-position))) ;; Skip empty lines if allow-empty-lines is true (unless (and allow-empty-lines (string-match-p "^\\s-*$" current-line)) (if (gethash current-line line-hash) ;; If the line already exists in the hash table, ask for deletion (when (y-or-n-p (format "Duplicate line found at line %d: \"%s\". Delete? " line-number current-line)) (delete-region (line-beginning-position) (1+ (line-end-position)))) ;; Otherwise, add the line to the hash table (puthash current-line t line-hash))) (setq line-number (1+ line-number)) (forward-line 1)) (message "Duplicate check completed."))) ;; doc: Esta función estructura un correo, en algunos casos, crea un comprobante en formato .txt, y agrega una transacción al archivo de contabilidad .ldg. ;; Para serpara los casos usamos ¿if else o cases? recibe un parametro que define los casos. el caso ola38 afecta ledger-asset, cta-destino, razón social nit destino, path, path2, write-region, compose-mail (defun corr (atribute) (when (atribute ola38) path "~/Dropbox/ALC/" path2 "~/ola38/pagos_OLA38.ldg") (when (atribute pNatural) path "~/Dropbox/pNatural/" path2 "~/Admin/cuentas.ldg")) (defun mail-at-point() "put thing-at-point in kill ring to compose a mail, we need to change to emacs-lisp-mode because foo.bar is threated as separated symbols in ledger-mode" (interactive) (let ((current-mode major-mode)) (unwind-protect (emacs-lisp-mode) (let ((string (thing-at-point 'symbol))) (kill-new string))) (funcall current-mode))) (defun remove-consecutive-empty-lines () "Remove consecutive empty lines in the current buffer." (interactive) (save-excursion (goto-char (point-min)) (while (re-search-forward "\n\n\n+" nil t) (replace-match "\n\n")))) (defun correo-ola38 () (interactive) (progn (setq paste (concat "\n" (read-from-minibuffer "Paste: ") "\n\n") period (read-from-minibuffer "Período: ") entity (read-from-minibuffer "Objeto/Entidad: ") cta-destino (read-from-minibuffer "Cta destino: ") nit-destino (read-from-minibuffer "NIT: ") razon-social (read-from-minibuffer "Razón social: ") ledger-val (read-from-minibuffer "Valor: ") val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" ledger-val) number-to-words (replace-regexp-in-string " " "" (shell-command-to-string (concat "numero_a_letras" " " val))) ledger-account " Expenses: " ledger-asset " Assets:Banco:ahorro:0609 " ;;razon-social "DISTRIBUIDORA DE EXTINTORES SIGLO XXI SA" tag1 (read-from-minibuffer "tag1: ") tag2 (read-from-minibuffer "tag2: ") subject (concat ":pago:" tag1 ":" tag2 ": " period " " entity ) tags (concat " -- " " pago " tag1 " " tag2 " " ) ext ".txt" date (format-time-string "%Y-%m-%d ") date-ledger (format-time-string "%Y/%m/%d ") ;;path "/tmp/" path "~/Dropbox/ALC/" path2 "~/ola38/pagos_OLA38.ldg" fpath (concat path date period " " entity " " "v " val " " tags ext)) (write-region paste nil fpath) ;; create empty file (write-region (concat "\n" date-ledger "PAGO " period " " entity "\n" " ; comprobante: EGRESOS No. \n ;\n" " ; EMPRESA: OLA38 S.A.S. NIT: 901429017-6 \n" " ; CIUDAD: Medellín \n ;\n" " ; ctaOrigen: 259-000006-09 \n" " ; ctaDestino: " cta-destino " \n ;\n" " ; PAGADO A: " razon-social "\n ;\n" " ; NIT: " nit-destino "\n ;\n" " ; DESCRIPCION: PAGO " period " " entity "\n ;\n" " ; EN LETRAS: " number-to-words "\n" " ; RETENCION: \n" ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append) ;; start smtp server, compose mail, send whith C-c C-c (setq smtpmail-stream-type 'ssl) (setq smtpmail-smtp-server "smtp.gmail.com") (setq smtpmail-smtp-service 465) (compose-mail "contacto.ola38@gmail.com" subject nil nil nil nil nil nil) (mail-text) (insert paste) (mml-attach-file fpath "text/x-patch" nil "attachment") )) (defun correo-ola38-opti-test () "Compose and send payment email with attachment." (interactive) (let* ((paste (concat "\n" (read-from-minibuffer "Paste: ") "\n\n")) (period (read-from-minibuffer "Período: ")) (entity (read-from-minibuffer "Objeto/Entidad: ")) (cta-destino (read-from-minibuffer "Cta destino: ")) (nit-destino (read-from-minibuffer "NIT: ")) (razon-social (read-from-minibuffer "Razón social: ")) (ledger-val (read-from-minibuffer "Valor: ")) (val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" ledger-val)) (number-to-words (shell-command-to-string (concat "numero_a_letras" " " val))) (ledger-account " Expenses: ") (ledger-asset " Assets:Banco:ahorro:0609 ") (tag1 (read-from-minibuffer "tag1: ")) (tag2 (read-from-minibuffer "tag2: ")) (subject (concat ":pago:" tag1 ":" tag2 ": " period " " entity)) (tags (concat " -- " " pago " tag1 " " tag2 " ")) (ext ".txt") (date (format-time-string "%Y-%m-%d ")) (date-ledger (format-time-string "%Y/%m/%d ")) (path "~/Dropbox/ALC/") (path2 "~/ola38/pagos_OLA38.ldg") (fpath (concat path date period " " entity " " "v " val " " tags ext))) (write-region paste nil fpath) (write-region (concat "\n" date-ledger "PAGO " period " " entity "\n" " ; comprobante: EGRESOS No. \n ;\n" " ; EMPRESA: OLA38 S.A.S. NIT: 901429017-6 \n" " ; CIUDAD: Medellín \n ;\n" " ; ctaOrigen: 259-000006-09 \n" " ; ctaDestino: " cta-destino " \n ;\n" " ; PAGADO A: " razon-social "\n ;\n" " ; NIT: " nit-destino "\n ;\n" " ; DESCRIPCION: PAGO " period " " entity "\n ;\n" " ; EN LETRAS: " number-to-words "\n" " ; RETENCION: \n" ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append) (setq smtpmail-stream-type 'ssl smtpmail-smtp-server "smtp.gmail.com" smtpmail-smtp-service 465) (compose-mail "contacto.ola38@gmail.com" subject nil nil nil nil nil nil) (mail-text) (insert paste) (mml-attach-file fpath "text/x-patch" nil "attachment"))) (defun correo-pNatural () (interactive ) (progn (setq paste (concat "\n" (read-from-minibuffer "Paste: ") "\n\n") period (read-from-minibuffer "Período: ") entity (read-from-minibuffer "Objeto/Entidad: ") ledger-val (read-from-minibuffer "Valor: ") val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" ledger-val) number-to-words (replace-regexp-in-string " " "" (shell-command-to-string (concat "numero_a_letras" " " val))) ledger-account " Expenses: " ledger-asset " Assets:Banco:ahorro:9350 " tag1 (read-from-minibuffer "tag1: ") tag2 (read-from-minibuffer "tag2: ") subject (concat ":pago:" tag1 ":" tag2 ": " period " " entity ) tags (concat " -- " "pago " tag1 " " tag2 " " ) ext ".txt" date (format-time-string "%Y-%m-%d ") date-ledger (format-time-string "%Y/%m/%d ") path "~/Dropbox/pNatural/" path2 "~/Admin/cuentas.ldg" fpath (concat path date period " " entity " " "v " val " " tags ext)) (write-region paste nil fpath) ;; create empty file (write-region (concat "\n" date-ledger "PAGO " period " " entity "\n" ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append) ;; start smtp server, compose mail, send whith C-c C-c (setq smtpmail-stream-type 'ssl) (setq smtpmail-smtp-server "smtp.gmail.com") (setq smtpmail-smtp-service 465) (compose-mail "fede2001@gmail.com" subject nil nil nil nil nil nil) (mail-text) (insert paste) (mml-attach-file fpath "text/x-patch" nil "attachment"))) (defun correo-personal () (interactive ) (progn (setq paste (concat "\n" (read-from-minibuffer "Paste: ") "\n\n") period (read-from-minibuffer "Período: ") entity (read-from-minibuffer "Objeto/Entidad: ") ledger-val (read-from-minibuffer "Valor: ") val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" ledger-val) number-to-words (replace-regexp-in-string " " "" (shell-command-to-string (concat "numero_a_letras" " " val))) ledger-account " Expenses: " ledger-asset " Assets:Banco:ahorro:8824 " tag1 (read-from-minibuffer "tag1: ") tag2 (read-from-minibuffer "tag2: ") subject (concat ":pago:" tag1 ":" tag2 ": " period " " entity ) tags (concat " -- " "pago " tag1 " " tag2 " " ) ext ".txt" date (format-time-string "%Y-%m-%d ") date-ledger (format-time-string "%Y/%m/%d ") path "~/Dropbox/yo/" path2 "~/Admin/cuentasFLC.ldg" fpath (concat path date period " " entity " " "v " val " " tags ext)) (write-region paste nil fpath) ;; create empty file (write-region (concat "\n" date-ledger "PAGO " period " " entity "\n" ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append) ;; start smtp server, compose mail, send whith C-c C-c (setq smtpmail-stream-type 'ssl) (setq smtpmail-smtp-server "smtp.gmail.com") (setq smtpmail-smtp-service 465) (compose-mail "fede2001@gmail.com" subject nil nil nil nil nil nil) (mail-text) (insert paste) (mml-attach-file fpath "text/x-patch" nil "attachment"))) (defun derivadons-pago () "A partir del comprobante genera una entrada en el archivo de contabilidad, archivo de texto con la información de pago, y envía correo. La entrada al archivo de contabilidad ej: cuentas.ldg es en formato ledger-cli, el archivo de información de pago es formato texto, extensión .txt y el nombre en formato AAAA-MM-DD v -- .txt el correo genera el asunto a partir de la información del comprobante, paga la información de pago y adjunta el archivo de texto correspondiente a la transacción" (interactive ) (progn (setq paste (concat "\n" (read-from-minibuffer "Pega información de pago: ") "\n\n") period (read-from-minibuffer "Período: ") entity (read-from-minibuffer "Objeto de pago/Entidad: ") ledger-val (read-from-minibuffer "Valor: ") val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" ledger-val) ;; convierte moneda a numero, $123,456.00 a 123456 number-to-words (replace-regexp-in-string " " "" (shell-command-to-string (concat "numero_a_letras" " " val))) ;; convierte numero a letras usando script "numero_a_letras" ledger-account " Expenses: " ;; cuenta a donde ingresa ledger-asset " Assets:Banco:ahorro:0609 " ;; cuenta de donde sale tag1 (read-from-minibuffer "tag1:") tag2 (read-from-minibuffer "tag2:") subject (concat ":pago:" tag1 ":" tag2 ": " period " " entity ) ;; asunto para el correo tags (concat " -- " tag1 " " tag2 " " ) ;; tags para el archivo .txt ext ".txt" date (format-time-string "%Y-%m-%d ") path "~/mi/ruta/comprobantes/" ;; ruta para guardar el archivo path2 "~/mi/ruta/cuentas.ldg" ;; ruta del archivo de contabilidad para agregar la entrada fpath (concat path date period " " entity " " "v " val " " tags ext)) ;; construye el nombre del archivo .txt (write-region paste nil fpath) ;; create empty file (write-region (concat "\n" date "PAGO " period " " entity "\n" ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append) ;; hace el ingreso con formato ledger-cli ;; inicia el servidor, conforma el correo, evia con C-c C-c (setq smtpmail-stream-type 'ssl) (setq smtpmail-smtp-server "smtp.gmail.com") (setq smtpmail-smtp-service 465) (mail) (compose-mail "miCorreo@gmail.com" subject nil nil nil nil nil nil) (mail-text) (insert paste) (mml-attach-file fpath "text/x-patch" nil "attachment") (mail-send))) ;; ===== CAPTURE (defun capture-to-ledger-region () (interactive) (let* ((alquem "nigredo") (date (format-time-string "%Y/%m/%d ")) (payee (if (use-region-p) (buffer-substring (region-beginning) (region-end)) "No payee selected")) (accounts "capture") (value "v3") (probabilidad "1") (impacto "1") (paste payee) ;; Use the same selected region for `doc` (context "") (path "~/SyncDocs/capture.ldg") (hash (hash-string-internal (concat date payee accounts value paste context)))) (write-region (concat "\n" "\n" date " " payee "\n" " ;; doc: " paste "\n" " ;; context: " context "\n" " ;; status: " alquem "\n" " ;; riesgo:: (" probabilidad "*" impacto ")" "\n" " ;; id: " hash "\n" " " accounts " " value "\n" " Time") nil path 'append))) (defun capture-to-ledger () (interactive) (let* ((alquem "nigredo") (date (format-time-string "%Y/%m/%d ")) (clipboard-content (current-kill 0)) (payee (car (split-string clipboard-content "\n"))) ; Use the first line for payee (paste (replace-regexp-in-string "\n" "\\\\n" clipboard-content)) ; Replace new lines with \n (accounts "capture") (value "v3") (probabilidad "1") (impacto "1") (context "") (path "~/SyncDocs/capture.ldg") (hash (hash-string-internal (concat date payee accounts value paste context)))) (write-region (concat "\n" "\n" date " " payee "\n" " ;; doc: " paste "\n" " ;; context: " context "\n" " ;; status: " alquem "\n" " ;; riesgo:: (" probabilidad "*" impacto ")" "\n" " ;; id: " hash "\n" " " accounts " " value "\n" " Time") nil path 'append) (find-file path))) (defun capture-to-ledger-asking () (interactive ) (let* ( (alquem "nigredo");;alquem (let ((options '("nigredo" "albedo" "citrinitas" "rubedo"))) ;; (completing-read "Selecciona: " options nil t))) (date (format-time-string "%Y/%m/%d ")) (payee (read-from-minibuffer "Payee: ")) (accounts "capture") ;;(read-from-minibuffer "Accounts: ")) (value "v3") ;;(read-from-minibuffer "Value: " "v3") ;; probabilidad (read-from-minibuffer "Probabilidad (1 improbable 4 muy probable): " "1") (probabilidad "1") ;; impacto (read-from-minibuffer "Impacto (1 sin impacto 4 alto impacto): " "1") (impacto "1") (paste (read-from-minibuffer "doc: ")) ;;src (read-from-minibuffer "Source: ") ;;context (read-from-minibuffer "Context: ") (context "") ;;url (read-from-minibuffer "url: ") (path "~/SyncDocs/capture.ldg") (hash (hash-string-internal (concat date payee accounts value paste context )))) (write-region (concat "\n" "\n" date " " payee "\n" " ;; doc: " paste "\n" " ;; context: " context "\n" " ;; status: " alquem "\n" " ;; riesgo:: (" probabilidad "*" impacto ")" "\n" " ;; id: " hash "\n" " " accounts " " value "\n" " Time") nil path 'append) )) (defun cuFLC () "Formatea con la convención de ledger una transacción" (interactive ) (let* ( (date (format-time-string "%Y/%m/%d ")) (payee (read-from-minibuffer "Payee: ")) (accounts "Expenses:") ;;(read-from-minibuffer "Accounts: ")) (value (read-from-minibuffer "Value: ")) (path "~/Admin/cuentasFLC.ldg")) (write-region (concat "\n" "\n" date " " payee "\n" " " accounts " " value ".00" "\n" " Assets:" " -" value ".00") nil path 'append))) ;; podría usar esto pero abre la el archivo literal sin encodig ;; (if (equal (read-from-minibuffer "Do you want to open the file? (y/n) ") "y") ;; (let ((filename (read-file-name "Enter file name: "))) ;; (with-current-buffer (find-file-noselect filename nil t) ;; (switch-to-buffer (current-buffer)) ;; (goto-char (point-max)) ;; (end-of-buffer))))) ;;; EDIT TEXT FUNCTIONS (defun delete-lines-containing-string-in-region (search-string start end) "Delete lines containing SEARCH-STRING in the selected region." (interactive "sEnter the string to search for: \nr") (save-restriction (narrow-to-region start end) (goto-char (point-min)) (while (search-forward search-string nil t) (beginning-of-line) (let ((begin (point))) (forward-line 1) (delete-region begin (point)))))) ;;; END EDIT TEXT FUNCTIONS (defun prosa_generico_pub() (interactive) (let* ((option '("math:dante" "orientacion:ledger" "ledger:report:galeria" "genrom" "produccion" "orientacion:guix" "sonido:directo")) (selected (completing-read "opcion: " option)) (status_options '("albedo" "nigredo")) (status_selected (completing-read "status: " status_options))) (progn (setenv "ACCOUNT" selected t) (setenv "STATUS" status_selected t) (ledger-report "PUB generico albedo" nil) (find-file (concat "/home/ff/Public/publica_" (getenv "ACCOUNT") ".org"))))) (defun prosa_generico_priv() (interactive) (let* ((option '("amor" "alc" "psico" "auxiliar_administrativa_contable:manual")) (selected (completing-read "opcion: " option))) (progn (setenv "ACCOUNT" selected t) (ledger-report "prosa generico priv" nil) (find-file (concat "/tmp/priv_" (getenv "ACCOUNT") ".org"))))) (defun prosa_generico_ola38() (interactive) (let* ((option '("auxiliar_administrativa_contable:manual" "referenciaOLA38" "ayuda:emacs")) (selected (completing-read "opcion: " option))) (progn (setenv "ACCOUNT" selected t) (ledger-report "prosa generico ola38" nil) (find-file (concat "~/SyncElvis/referencia_" (getenv "ACCOUNT") ".org"))))) (defun change-env () "change env based on user-selected options." (interactive) (let* ((option (completing-read "Opción: " '("aor" "dell" "lore")))) (setenv "PROFILE" option t))) ;;; OPTIMIZED BY GTP (defun prosa-generico () "Generate a generic prose report based on user-selected options." (interactive) (let* ((option (completing-read "Opción: " '("pub" "priv" "ola38"))) (selected (completing-read "Selecciona una opción: " (prosa-generico-options option)))) (pcase option ('pub (prosa-generico-pub selected)) ('priv (prosa-generico-priv selected)) ('ola38 (prosa-generico-ola38 selected))))) (defun prosa-generico-options (option) "Return the list of options based on the main option." (pcase option ('pub '("math:dante" "orientacion:ledger" "ledger:report:galeria" "genrom" "produccion" "sonido:directo" "scheme")) ('priv '("amor" "alc" "psico" "auxiliar_administrativa_contable:manual")) ('ola38 '("auxiliar_administrativa_contable:manual" "referenciaOLA38" "emacs")))) ;; test (prosa-generico-options 'ola38) (defun prosa-generico-pub (selected) "Generate a prose report for the 'pub' option with the selected account." (setenv "ACCOUNT" selected t) (setenv "STATUS" (completing-read "Status: " '("albedo" "nigredo"))) (ledger-report "PUB generico albedo opt" nil) (find-file (concat "/home/ff/Public/publica_" (getenv "ACCOUNT") ".org"))) (defun prosa-generico-priv (selected) "Generate a prose report for the 'priv' option with the selected account." (setenv "ACCOUNT" selected t) (ledger-report "prosa generico priv" nil) (find-file (concat "/tmp/priv_" (getenv "ACCOUNT") ".org"))) (defun prosa-generico-ola38 (selected) "Generate a prose report for the 'ola38' option with the selected account." (setenv "ACCOUNT" selected t) (ledger-report "prosa generico ola38" nil) (find-file (concat "~/SyncElvis/referencia_" (getenv "ACCOUNT") ".org"))) ;;; END OPTIMIZACION ;; (defun dired-occur (directory search-string) ;; "Search for SEARCH-STRING in the Dired buffer of DIRECTORY." ;; (interactive "DDirectory: \nsEnter search string: ") ;; (let ((buf (dired-noselect directory))) ;; (with-current-buffer buf ;; (occur search-string)) ;; (switch-to-buffer-other-window buf))) ;;;###autoload ;;; from: https://oremacs.com/2016/02/24/dired-rsync/ ;;; rsync -arvzu --progress se usa u para solo mandar las nuevas, sin u parece que las verifica (defun ora-dired-rsync (dest) (interactive (list (expand-file-name (read-file-name "Rsync to:" (dired-dwim-target-directory))))) ;; store all selected files into "files" list (let ((files (dired-get-marked-files nil current-prefix-arg)) ;; the rsync command (tmtxt/rsync-command "rsync -arvzu --progress ")) ;; add all selected file names as arguments ;; to the rsync command (dolist (file files) (setq tmtxt/rsync-command (concat tmtxt/rsync-command (shell-quote-argument file) " "))) ;; append the destination (setq tmtxt/rsync-command (concat tmtxt/rsync-command (shell-quote-argument dest))) ;; run the async shell command (async-shell-command tmtxt/rsync-command "*rsync*") ;; finally, switch to that window (other-window 1))) ;;(define-key dired-mode-map "Y" 'ora-dired-rsync) (defun show-functions-and-docstrings () "Show function names and their docstrings from the current buffer." (interactive) (let ((result-buffer (get-buffer-create "*Functions and Docstrings*")) (functions ())) (save-excursion (goto-char (point-min)) (while (re-search-forward "^(defun \\([^ ]+\\)" nil t) (let ((fn-name (match-string 1))) (when (fboundp (intern fn-name)) (let ((doc (documentation (intern fn-name)))) (push (format "%s: %s\n" fn-name doc) functions)))))) (with-current-buffer result-buffer (erase-buffer) (dolist (fn functions) (insert fn))) (display-buffer result-buffer))) (defun dired-occur (directory search-string) "Search for SEARCH-STRING in the Dired buffer of DIRECTORY." (let ((buf (dired-noselect directory))) (with-current-buffer buf (occur search-string)) (switch-to-buffer-other-window buf))) ;; Example non-interactive call ;;(dired-occur "~/Dropbox/ALC" "rentaALC") ;;example ;; (dired-ocurr "~/tmp" "*.pdf") (defun open-ola38-files () (interactive) (mapc #'find-file '("~/ola38/cuentasOLA38.ldg" "~/ola38/panel_dolly.el" "~/my_forest/panel_federico.el" "~/ola38/panel_doris.el" "~/SyncElvis/chat.txt" "~/ola38/chat.txt" "~/Admin/cuentas.ldg" "~/Admin/cuentasFLC.ldg" "~/Admin/SVE_pagos.ldg" "~/SyncElvis/reportes_ledger.el"))) (defun convert-date-string (date-str) "Convert date string from DD/MM/YYYY to YYYY/MM/DD." (if (string-match "\\([0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9][0-9][0-9]\\)" date-str) (format "%s/%s/%s" (match-string 3 date-str) ; Year (match-string 2 date-str) ; Month (match-string 1 date-str)) ; Day (error "Date string format is incorrect"))) ;; Example usage: ;(convert-date-string "31/12/2024") ; => "2024/12/31" (defun consecutivo-egreso-ola38 () (interactive) (let* ((value (shell-command-to-string "ledger -f $OLA38 reg banco --limit \"tag('egreso')\" --format \"%(tag('egreso'))\" --tail 1"))) (number-to-string (+ (string-to-number value) 1)))) ;;(consecutivo-egreso-ola38) (defun consecutivo-ingreso-ola38 () (interactive) (let* ((value (shell-command-to-string "ledger -f $OLA38 reg banco --limit \"tag('ingreso')\" --format \"%(tag('ingreso'))\" --tail 1"))) (number-to-string (+ (string-to-number value) 1)))) ;;(consecutivo-ingreso-ola38) (defvar nit-history '("901309711 PINTURA ELECTROSTATICA OCHOA LEON" "811014959 DISEÑOS CREATIVOS")) ;;(defvar cuentas-history '("Assets:clienteNacional:ochoa" "Expenses:viaticos:gasolina" )) (defun load-my-history-from-file (file) "Load history from FILE and return it as a list." (with-temp-buffer (insert-file-contents file) (read (buffer-string)))) (defun my-org-inline-css-hook (exporter) "Insert custom inline css" (when (eq exporter 'html) (let* ((dir (ignore-errors (file-name-directory (buffer-file-name)))) (path (concat dir "style.css")) (homestyle (or (null dir) (null (file-exists-p path)))) (final (if homestyle "~/ola38/default.css" path))) ;; <- set your own style file path (setq org-html-head-include-default-style nil) (setq org-html-head (concat "\n"))))) (add-hook 'org-export-before-processing-hook 'my-org-inline-css-hook) (defun get-nit-history () "FIX! do not use" (let ((nits (shell-command-to-string "ledger -f ~/ola38/cuentasOLA38.ldg reg --limit \"tag('NIT')\" --format \"%(tag('NIT')) %(tag('ORIGEN/DESTINO')) \n \" -p 2024 > \"~/ola38/nit-history.el \" " ) )))) ;; (get-nit-history) (defun format-ledger-transaction (data) "Format a ledger-cli transaction from comma-separated values." (let* ((fields (split-string data ",")) (comprobante (nth 2 fields)) (fecha (convert-date-string (nth 3 fields))) (nombre (nth 6 fields)) (moneda (nth 7 fields)) (valor-bruto (nth 8 fields)) (descuento (nth 9 fields)) (subtotal (nth 10 fields)) (iva (nth 11 fields)) (rete-fuente (nth 13 fields)) (total-neto (nth 16 fields))) ;; Format the ledger-cli transaction (format "%s %s\n ;; fact: %s\n ;; Identificación: %s\n ;; Sucursal: %s\n ;; Moneda: %s\n ;; Valor Bruto: -$%s\n ;; Descuento: %s\n ;; Subtotal: %s\n ;; Total-neto: $%s\n Revenues:Arriendos: -$%s\n Liabilities:CxP:impuesto:iva: $%s\n Assets:CxC:Impuesto:rtefte: $%s\n Assets:clienteNacional $%s\n Income:Sales\n" fecha nombre comprobante (nth 4 fields) (nth 5 fields) moneda valor-bruto descuento subtotal total-neto valor-bruto iva rete-fuente total-neto))) ;; Example usage: ; (format-ledger-transaction "n,Factura,FV-2-341,03/05/2024,811026990,0,SERVIMETALES FREY S.A.S.,COP, 13781093,0,13781093,2618407.67,0,482338.26,0,0,15917162.41") (defun get-marked-region (beg end) "message region or \"empty string\" if none highlighted .. from event jr https://stackoverflow.com/questions/10594208/how-do-i-get-the-region-selection-programmatically-in-emacs-lisp" (interactive (if (use-region-p) (list (region-beginning) (region-end)) (list nil nil))) (message "%s" (if (and beg end) (buffer-substring-no-properties beg end) "empty string"))) (defun paste-to-buffer () "Append the current clipboard contents to a selected open buffer. Adds an empty line before and after the content, reverts and opens the destination buffer." (interactive) (let* ((clipboard-content (concat "\n" (current-kill 0) "\n")) (buffer (completing-read "Select buffer: " (mapcar #'buffer-name (buffer-list))))) (with-current-buffer buffer (goto-char (point-max)) (insert clipboard-content) (save-buffer) (revert-buffer :ignore-auto :noconfirm)) (switch-to-buffer buffer) (message "Clipboard content appended to buffer: %s" buffer))) (defun paste-to () "Append the current clipboard contents to a selected open buffer." (interactive) (let* ((clipboard-content (current-kill 0)) (buffer (completing-read "Select buffer: " (mapcar #'buffer-name (buffer-list))))) (with-current-buffer buffer (goto-char (point-max)) (insert clipboard-content)) (message "Clipboard content appended to buffer: %s" buffer))) (defun paste-to-old() (interactive) (let* ((option '(("dellioTimelog.ldg" . "~/SyncDocs/dellioTimelog.ldg") ("tareasAlc.ldg" . "~/ola38/tareasAlc.ldg") ("tareaslorena.ldg" . "~/ola38/tareaslorena.ldg") ("cuentasFLC.ldg" . "~/Admin/cuentasFLC.ldg") ("FLC_informacion.ldg" . "~/SyncDocs/FLC_informacion.ldg") ("FLC_narracion.ldg" . "~/SyncDocs/FLC_narracion.ldg") ("ALC_informacion.ldg" . "~/SyncDocs/ALC_informacion.ldg") ("ALC_narracion.ldg" . "~/SyncDocs/ALC_narracion.ldg") ("tmp" . "/tmp/test.ldg"))) (path (completing-read "opcion: " option)) (string (current-kill 0 t))) (write-region (concat "\n\n" string) nil path 'append) (find-file path))) (defun anotate-audio-old () (interactive ) (progn (setq alquem "nigredo" date (format-time-string "%Y/%m/%d ") accounts "audio:anotate" ;;(read-from-minibuffer "Accounts: ") value "v3" ;;(read-from-minibuffer "Value: " "v3") ;; probabilidad (read-from-minibuffer "Probabilidad (1 improbable 4 muy probable): " "1") probabilidad "1" ;; impacto (read-from-minibuffer "Impacto (1 sin impacto 4 alto impacto): " "1") impacto "1" paste (read-from-minibuffer "doc: ") ;;src (read-from-minibuffer "Source: ") ;;context (read-from-minibuffer "Context: ") time emms-playing-time-string artist (emms-track-get (emms-playlist-current-selected-track) 'info-artist) track (emms-track-get (emms-playlist-current-selected-track) 'info-title) source (emms-track-get (emms-playlist-current-selected-track) 'name) payee (concat artist " - " track ) context "" ;;url (read-from-minibuffer "url: ") path "~/SyncDocs/capture.ldg") (write-region (concat "\n" "\n" date " " payee "\n" " ;; artist: " artist "\n" " ;; track: " track "\n" " ;; time:" time "\n" " ;; doc: " paste "\n" " ;; context: " context "\n" " ;; source: " source "\n" " ;; status: " alquem "\n" " ;; riesgo:: (" probabilidad "*" impacto ")" "\n" " ;; id: " (hash-string-internal (concat date payee accounts value paste context )) "\n" " " accounts " " value "\n" " Time") nil path 'append))) (defun anotate-audio () "Registra anotaciones sobre un track de audio sonando a través de emms" (interactive) (let* ((alquem "nigredo") (date (format-time-string "%Y/%m/%d ")) (accounts "audio:anotate") (value "v3") (probabilidad "1") (impacto "1") (paste (read-from-minibuffer "doc: ")) (time emms-playing-time-string) (artist (emms-track-get (emms-playlist-current-selected-track) 'info-artist)) (track (emms-track-get (emms-playlist-current-selected-track) 'info-title)) (source (emms-track-get (emms-playlist-current-selected-track) 'name)) (payee (concat artist " - " track)) (context "") (path "~/SyncDocs/capture.ldg") (id (hash-string-internal (concat date payee accounts value paste context)))) (write-region (concat "\n\n" date " " payee "\n" " ;; artist: " artist "\n" " ;; track: " track "\n" " ;; time: " time "\n" " ;; doc: " paste "\n" " ;; context: " context "\n" " ;; source: " source "\n" " ;; status: " alquem "\n" " ;; riesgo:: (" probabilidad "*" impacto ")\n" " ;; id: " id "\n" " " accounts " " value "\n" " Time") nil path 'append))) (defun anotate-audio-at-point () (interactive) (let* ((time emms-playing-time-string) (artist (emms-track-get (emms-playlist-current-selected-track) 'info-artist)) (track (emms-track-get (emms-playlist-current-selected-track) 'info-title))) (insert (concat "\n" time " " "'" artist "'" " - " "'" track "'" " cue: ")))) (defun ii () "Genera un ingreso con formato de tiempo para ledger" (interactive) (let* ((date (format-time-string "%Y/%m/%d %H:%M:%S")) (account (read-from-minibuffer "account: ")) (details (read-from-minibuffer "detalles: ")) (fpath "~/SyncDocs/dellioTimelog.ldg")) (write-region (concat "i " date " " account " " details "\n" ) nil fpath 'append))) (defun oo () "Genera una salida del formato tiempo de Ledger" (interactive) (let* ((date (format-time-string "%Y/%m/%d %H:%M:%S")) (details (read-from-minibuffer "detalles: ")) (fpath "~/SyncDocs/dellioTimelog.ldg")) (write-region (concat "o " date " " details "\n" ) nil fpath 'append))) ;;; ===== HASH (defun hash-string () "Compute the SHA-256 hash value of the argument." (interactive) (let ((short-hash (substring (secure-hash 'sha256 (read-from-minibuffer "String to hash: ")) 0 8))) (kill-new short-hash) ;; disponible en el clipoard (message "Short: %s " short-hash ))) (defun hash-string-internal (str) "Compute the SHA-256 hash value of the argument." (substring (secure-hash 'sha256 str) 0 8)) ;;(hash-string-internal "test") (defun hash-file () "Compute the SHA-256 hash value of the file at FILE-PATH." (interactive) (let ((file-path (completing-read "file-path: " #'read-file-name-internal nil t)) (context (read-from-minibuffer "context: "))) (let ((hash (secure-hash 'sha256 (find-file-noselect file-path))) (short-hash (substring (secure-hash 'sha256 (find-file-noselect file-path)) 0 8))) (kill-new short-hash) ;; disponible en el clipoard (message "Short: %s Context: %s \n Hash: %s" short-hash context hash)))) (defun my-rename-buffer-by-name (buffer-name new-name) "Rename a buffer specified by BUFFER-NAME to NEW-NAME." (let ((buffer (get-buffer buffer-name))) (when buffer (with-current-buffer buffer (rename-buffer new-name))))) (defun time-prepare-to-graph () (interactive) (goto-char (point-min)) (find-file "/tmp/time.txt") (flush-lines "^$" ) (goto-char (point-min)) (while (search-forward "s" nil t) (replace-match "" t) (forward-line (point-min))) (while (search-forward "," nil t) (replace-match "" t) (goto-line (point-min)))) ;; ====== ELFEED (defun elfeed-search-tag-hide-entry () "Add the 'hide' tag to the selected entry in Elfeed." (interactive) (when-let ((entry (elfeed-search-selected :single))) (elfeed-tag entry 'hide) (elfeed-search-update-entry entry) (elfeed-search-update--force))) ;; ====== MOUNT VOLUMES (defun list-unmounted-volumes () "List unmounted USB or hard disk volumes." (let ((output (shell-command-to-string "lsblk -lpf | awk '{print $1, $3}'"))) (if (string-empty-p output) (error "No unmounted volumes found") (split-string output "\n" t)))) (defun mount-selected-volume (device mount-point) "FIX mount -t ntfs-3g Mount the selected DEVICE to the specified MOUNT-POINT." (interactive (let* ((volumes (list-unmounted-volumes)) (device (completing-read "Select volume to mount: " volumes nil t)) (mount-point (read-directory-name "Mount point: "))) (list (car (split-string device " ")) mount-point))) (unless (file-directory-p mount-point) (make-directory mount-point t)) ;;(shell-command (format "sudo mount %s %s" device mount-point)) (message "Mounted %s to %s" device mount-point)) ;; ==== ENV ENTORNO (setenv "LEDGER_FILE" "~/SyncDocs/notelog_ALC_OLA38.ldg") (setenv "ACCOUNT" "orientacion") (setenv "DEST_FILE" (concat "prosa_de_" (getenv "ACCOUNT") ".html")) (getenv "DEST_FILE") (getenv "LEDGER_FILE") ;; ===== LAYOUTS ;;(require 'cl) (defun set-window-width (width) "Set the width of the current window to WIDTH columns." (let ((current-width (window-width)) (delta (- width (window-width)))) (if (> delta 0) (enlarge-window-horizontally delta) (shrink-window-horizontally (- delta))))) ;; Set the current window width to 100 columns ;;(set-window-width 100) (defun aeromostra-layout () (interactive) (find-file "~/Builds/algo0ritmos/participantes/federico/OSC.lisp") (delete-other-windows) (split-window-horizontally) (other-window 1) (find-file "~/Builds/algo0ritmos/participantes/federico/panel_lanzamientos_.lisp") (split-window-horizontally) (other-window 1) (find-file "~/Builds/algo0ritmos/participantes/federico/percent_distributed_patterns.lisp") (other-window 1) (split-window-vertically) (switch-to-buffer "*sly-mrepl for sbcl*") (forward-page)) (defun book-layout () (interactive) (find-file "~/Scripts/code_Practical_common_lisp.lisp") (delete-other-windows) (split-window-horizontally) (other-window 1) (find-file "~/SyncDocs/Peter Seibel - Practical Common Lisp -- ebook 2005 apress.epub") (other-window 1) (split-window-vertically) (switch-to-buffer "*sly-mrepl for sbcl*") (forward-page) (mapc 'disable-theme custom-enabled-themes) (load-theme 'poet-dark t)) (defun capture-layout () (interactive) (ledger-report "todo newline test" nil) (delete-other-windows) (split-window-horizontally) (pcase (getenv "PROFILE") ("aor" (enlarge-window-horizontally -70)) ("dell" (enlarge-window-horizontally -50))) (other-window 1) (find-file "~/SyncDocs/capture.ldg") (goto-char (point-max)) (split-window-horizontally) (find-file "~/SyncDocs/textos_largos_capturas.txt") (other-window 1) (pcase (getenv "PROFILE") ("aor" (enlarge-window-horizontally -70)) ("dell" (enlarge-window-horizontally -30))) (mapc 'disable-theme custom-enabled-themes) (load-theme 'poet-dark t)) (defun capture-alc-layout () (interactive) (find-file "~/SyncDocs/notelog_ALC_OLA38.ldg") (delete-other-windows) (split-window-horizontally) (other-window 1) (ledger-report "REG zettelkasten ALC" nil) (my-rename-buffer-by-name "*Ledger Report*" (concat "index" (number-to-string (random 88)))) (split-window-vertically) ;; (other-window 1) (ledger-report "REG riesgo ALC" nil) (other-window 1) (split-window-vertically) (find-file "~/SyncDocs/capture.ldg")) (defun causa-ola-layout () (interactive) (ledger-report "REG pagos para SVE ledger" nil) (delete-other-windows) (find-file-other-window "~/ola38/cuentasOLA38.ldg") (split-window-vertically) (find-file-other-window "~/ola38/pagos_OLA38.ldg") ;; Search in *Ledger Report* buffer (switch-to-buffer "pagos_OLA38.ldg") (enlarge-window -20) (switch-to-buffer "*Ledger Report*") ;; Window sizes by profile (pcase (getenv "PROFILE") ("aor" (enlarge-window-horizontally -65)) ("dell" (enlarge-window-horizontally -25)))) (defun correo-layout () (interactive) (switch-to-buffer "*scratch*") (delete-other-windows) (erase-buffer) (visual-fill-column-mode)) (defun cartera-layout () (interactive) (find-file "~/Admin/cuentas.ldg") (delete-other-windows) (split-window-horizontally) (other-window 1) (ledger-report "cartera por cliente" nil)) (defun config-layout () (interactive) (find-file "~/.emacs") (delete-other-windows) (split-window-horizontally) (enlarge-window-horizontally -50) (other-window 1) (find-file "~/my_forest/emacs_utilities.el") (other-window 1) (split-window-vertically) (switch-to-buffer "*scratch*") (forward-page) (other-window 2) ;;(mapc 'disable-theme custom-enabled-themes) (load-theme 'wheatgrass t) ) (defun consolida-layout () (interactive) (ledger-report "consolida 9350" nil) (delete-other-windows) (split-window-horizontally) (pcase (getenv "PROFILE") ("aor" (enlarge-window-horizontally -70)) ("dell" (enlarge-window-horizontally -30))) (other-window 1) (find-file "~/Admin/cuentas.ldg") (split-window-vertically) (other-window 1) (dired "~/Dropbox/ALC" "-laGh1v")) (defun circe-layout () (interactive) (switch-to-buffer "#un/loquer@Libera Chat") (delete-other-windows) (split-window-horizontally) (other-window 1) (switch-to-buffer "#clschool@Libera Chat") (split-window-vertically) (other-window 1) (switch-to-buffer "#ardour@Libera Chat") (other-window 1) (split-window-vertically) (switch-to-buffer "#guix@Libera Chat")) (defun citas-vencimientos-layout () (interactive) (ledger-report "citas vencimientos" nil) (pcase (getenv "PROFILE") ("aor" (set-window-width 100)) ("dell" (set-window-width 55)) ("lore" (set-window-width 100))) (switch-to-buffer "*Ledger Report*") (search-forward (format-time-string "%Y/%m/%d"))) (defun dired-layout () (interactive) (dired "~/Dropbox/ALC" "-laGh1vt") (delete-other-windows) (split-window-horizontally) (other-window 1) (dired "~/Dropbox/pNatural" "-laGh1vt") (split-window-vertically) (other-window 1) (dired "~/Dropbox/yo" "-laGh1vt") (other-window 1) (split-window-vertically) (dired "/tmp" "-laGh1vt")) (defun emms-layout () (interactive) (emms-playlist-mode-go) (delete-other-windows) (split-window-horizontally) (other-window 1) (dired "~/External/PUPI_1/fede/Music" "-laGh1vt") (split-window-vertically) (other-window 1) (emms-browser) (other-window 1) (split-window-vertically) (dired "~/SyncMusic/" "-laGh1vt")(forward-page)) (defun notelog-layout () "F8" (interactive) (find-file "~/SyncDocs/notelog.ldg") (delete-other-windows) (split-window-horizontally) (other-window 1) (ledger-report "prosa music" nil) (previous-multiframe-window)) (defun informe-layout () (interactive) (ledger-report "plot_estado_resultados_comparativo_ola38" nil) (delete-other-windows) (split-window-horizontally) (pcase (getenv "PROFILE") ("aor" (enlarge-window-horizontally -65)) ("dell" (enlarge-window-horizontally -30))) (other-window 1) (find-file "~/SyncDocs/ALC_informe.el")) (defun lisp-layout () (interactive) (find-file "~/SyncDocs/OSC.lisp") (delete-other-windows) (split-window-horizontally) (other-window 1) (find-file "~/Dropbox/org/eduLisp.lsp") (goto-line 48) (split-window-vertically) (other-window 1) (find-file "~/SyncDocs/lispEdu.lisp") (goto-line 48) (other-window 1) (split-window-vertically) (switch-to-buffer "*sly-mrepl for sbcl*") (forward-page)) (defun lisp-book-layout () (interactive) (find-file "~/Scripts/code_Practical_common_lisp.lisp") (delete-other-windows) (split-window-horizontally) (other-window 1) (find-file "~/SyncDocs/Peter Seibel - Practical Common Lisp -- ebook 2005 apress.epub") (other-window 1) (split-window-vertically) (switch-to-buffer "*sly-mrepl for sbcl*") (forward-page)) (defun pagos-layout () (interactive) (ledger-report "REG pagos para SVE ledger" nil) (delete-other-windows) (find-file-other-window "~/Admin/SVE_pagos para sve.ldg") (split-window-vertically) (find-file-other-window "~/ola38/tareaslorena.ldg") ;; Search in *Ledger Report* buffer (switch-to-buffer "tareaslorena.ldg") (enlarge-window -20) (switch-to-buffer "*Ledger Report*") ;; Window sizes by profile (pcase (getenv "PROFILE") ("aor" (enlarge-window-horizontally -65)) ("dell" (enlarge-window-horizontally -25)))) (setq buftest (current-buffer)) (defun timelog-layout () (interactive) (let ((oldbuf (current-buffer))) (progn (ledger-report "PLOT AWK horas" nil) ;;(delete-other-windows) ;;(split-window-horizontally) (pcase (getenv "PROFILE") ("aor" (enlarge-window-horizontally -90)) ("dell" (enlarge-window-horizontally -20))) (other-window 1) (switch-to-buffer oldbuf) (other-window 1) (split-window-vertically) (other-window 1) (switch-to-buffer "*vterm*") (goto-char (point-max)) (other-window 1) (split-window-horizontally) (pcase (getenv "PROFILE") ("aor" (enlarge-window-horizontally 70)) ("dell" (enlarge-window-horizontally 20))) (other-window 1) (find-file "~/SyncDocs/dellioTimelog.ldg") (goto-char (point-max)) (split-window-vertically) (find-file "~/SyncDocs/timelog.ldg") (switch-to-buffer-other-window "*vterm*")))) ;; ;(find-file "~/SyncDocs/dellioTimelog.ldg") (goto-char (point-max)) ;; (split-window-vertically)(split-window-vertically) ;; (ledger-report "PLOT AWK horas" nil) ;; (other-window 1) (find-file "~/SyncDocs/timelog.ldg") ;; (split-window-vertically) ;; (other-window 1) (switch-to-buffer "*vterm*") (goto-char (point-max))) (defun rename-reports () (interactive) ;;(kill-buffer "*Riesgo*") ;; verfify if existe (ledger-report "REG riesgo ALC" nil) (my-rename-buffer-by-name "*Ledger Report*" "*Riesgo*")) (defun sst-layout () (interactive) (delete-other-windows) ;; (split-window-horizontally) ;; (other-window 1) (ledger-report "REG PUB sst" nil) (delete-other-windows) (split-window-horizontally) (find-file "~/SyncElvis/estandares ola38 -- sst norma.ldg") (split-window-vertically) ;;(other-window 1) (find-file "~/SyncDocs/capture.ldg")(goto-char (point-max)) (other-window 1) (mapc 'disable-theme custom-enabled-themes) (load-theme 'poet-dark-monochrome )) (defun tareas-layout () (interactive) (setq ledger-post-amount-alignment-column 52) (reporte-tareas-por-riesgo) (delete-other-windows) (find-file-other-window "~/my_forest/panel_federico.el") (split-window-vertically) (find-file-other-window "~/SyncElvis/tareaslorena.ldg") ;; Search in *Ledger Report* buffer (switch-to-buffer "tareaslorena.ldg") (enlarge-window -20) (switch-to-buffer "*Ledger Report*") (let ((date (current-time)) (found nil) (max-days 10) (days-searched 0)) (goto-char (point-min)) (while (and (not found) (not (eobp)) (< days-searched max-days)) (if (search-forward (format-time-string "%Y/%m/%d" date) nil t) (setq found t) (setq date (time-add date (days-to-time +1))) (setq days-searched (1+ days-searched)) (goto-char (point-min)))) (if found (progn (goto-char (point-min)) (search-forward (format-time-string "%Y/%m/%d" date) nil t) (message "Found nearest date: %s" (format-time-string "%Y/%m/%d" date))) (message "No date found within the last %d days" max-days))) ;; Window sizes by profile (pcase (getenv "PROFILE") ("aor" (enlarge-window-horizontally -65)) ("dell" (enlarge-window-horizontally -25)))) (defun tareas-layout-opt () "Set up the 'tareas' layout for managing tasks and Ledger reports." (interactive) (setq ledger-post-amount-alignment-column 52) (reporte-tareas) (delete-other-windows) (split-window-horizontally) ;; Open relevant files in split windows (find-file-other-window "~/my_forest/panel_federico.el") (split-window-vertically) (find-file-other-window "~/SyncElvis/tareaslorena.ldg") ;; Adjust the window for tareaslorena.ldg (switch-to-buffer "tareaslorena.ldg") (enlarge-window -20) ;; Search for the nearest date in *Ledger Report* buffer (switch-to-buffer "*Ledger Report*") (let ((date (current-time)) (found nil) (max-days 10)) (goto-char (point-min)) (while (and (not found) (not (eobp)) (< max-days 10)) (if (search-forward (format-time-string "%Y/%m/%d" date) nil t) (setq found t) (setq date (time-add date (days-to-time +1))))) (if found (message "Found nearest date: %s" (format-time-string "%Y/%m/%d" date)) (message "No date found within the last %d days" max-days))) ;; Adjust window sizes based on profile (pcase (getenv "PROFILE") ("aor" (enlarge-window-horizontally -25)) ("dell" (enlarge-window-horizontally -25)))) ;; ==== mastodon (use-package mastodon :ensure t) (setq mastodon-instance-url "https://fosstodon.org/") (setq mastodon-active-user "son0p") ;;(setq mastodon-auth-source-file " ") ;; ===== IRC LOGS (defun leaders () (interactive) (highlight-strings-with-random-colors '("beach " "pjb " "x42 " "" "" "wasamasa" "robin" "las" "rgareus" "civodul" "rekado"))) (defun get-random-color () "Return a random color from the list of defined colors." (let* ((colors (defined-colors)) (random-color (nth (random (length colors)) colors))) random-color)) (defun highlight-strings-with-random-colors (strings) "Highlight each string in STRINGS with a random color in the current buffer." (save-excursion (dolist (str strings) (goto-char (point-min)) (let ((color (get-random-color))) (while (search-forward str nil t) (add-text-properties (match-beginning 0) (match-end 0) `(face (:foreground ,color)))))))) (defun highlight-predefined-strings-with-random-colors (strings) "Highlight each predefined string with a random color in the current buffer." (interactive) (let ((strings '("string1" "string2" "string3"))) ;; Replace with your list of strings (save-excursion (dolist (str strings) (goto-char (point-min)) (let ((color (get-random-color))) (while (search-forward str nil t) (add-text-properties (match-beginning 0) (match-end 0) `(face (:foreground ,color))))))))) (defun capture-to-list () "INCOMPLETA https://stackoverflow.com/questions/15393797/lisp-splitting-input-into-separate-strings" (interactive) (let* ((nicks (progn (search-forward "*** Names: ") (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t)))) (print (cons nicks)))) ;; mis funciones (defun invert-q() (interactive) (doom/forward-to-last-non-comment-or-eol) (search-backward "\$") (forward-char 1) (insert " ") (delete-char 1)) (defun number-to-time () "Cambia el formato, de un número de cuatro dígitos tipo 2114 a el formato de tiempo 21:14:00" (interactive) (forward-word -1) (forward-char 2) (insert ":") (forward-char 2) (insert ":") (insert "00")) (defun list-functions-in-file () "List all functions in the current buffer, sorted alphabetically." (interactive) (let ((functions '())) (save-excursion (goto-char (point-min)) (while (re-search-forward "^(defun \\([a-zA-Z0-9-]+\\)" nil t) (push (match-string 1) functions))) (if functions (progn (setq functions (sort functions 'string<)) ;; Sort alphabetically (with-output-to-temp-buffer "*Functions List*" (dolist (func functions) (princ (concat func "\n")))) (message "Functions listed in *Functions List* buffer.")) (message "No functions found in the file.")))) (defun reposition-time-value () (interactive) (end-of-line) (number-to-time) (forward-word -3) (kill-line) (er-go-to-column 13) (yank) (kill-word 3) (forward-line 1) (set-mark-command nil)) (defun increment-hour-by-position () "Change 'i' to 'o' and increment the hour in the date-time string format 'i YYYY/MM/DD HH:MM:SS' at the current point, then insert the result on the next line." (interactive) (beginning-of-line 1) (let ((start (point)) (end (+ (point) 20))) (when (looking-at "i \\([0-9]+/[0-9]+/[0-9]+ \\)\\([0-9]+\\)\\(:[0-9]+:[0-9]+\\)") (let* ((hour (string-to-number (match-string 2))) (new-hour (number-to-string (mod (+ hour 1) 24))) ;; Increment and handle 24-hour wrap-around (new-string (concat "o " (match-string 1) (format "%02d" (string-to-number new-hour)) (match-string 3)))) (end-of-line 1) (insert "\n" new-string))))) ;; Example usage: ;; place point somwhere in format "i 2024/06/07 11:42:07") ;; Expected output: "o 2024/06/07 12:42:07" (defun increment-number-at-point () (interactive) (skip-chars-backward "0-9") (or (looking-at "[0-9]+") (error "No number at point")) (replace-match (number-to-string (1+ (string-to-number (match-string 0)))))) (defun decrement-number-at-point () (interactive) (skip-chars-backward "0-9") (or (looking-at "[0-9]+") (error "No number at point")) (replace-match (number-to-string (1- (string-to-number (match-string 0)))))) (defun virtual-pyme() (interactive) (doom/backward-to-bol-or-indent) (forward-word 3) (kill-word 3) (search-forward "\$") (backward-char 1) (kill-visual-line) (forward-line 1) (doom/backward-to-bol-or-indent) (newline-and-indent) (forward-line -1) (insert " Revenues:noOper:reposicion ") (newline-and-indent) (doom/backward-to-bol-or-indent) (insert " Assets:9350 ") (yank) (newline-and-indent) (forward-line -2) (doom/forward-to-last-non-comment-or-eol) (insert " ") (yank) (search-backward "\$") (forward-char 1) (delete-char 1) (ledger-post-align-xact 0)) (defun procesa-Extracto() "Convert bancolombia->ledger format" (interactive) ;;(find-file "~/Admin/cuentas.ldg") ;;(find-file "~/Admin/cuentasFLC.ldg") ;;(find-file "/tmp/test.ldg") ;; test prog (goto-char (point-min)) (while (search-forward " " nil t) (replace-match " " t) (goto-line (point-min))) (goto-char (point-min)) (while (search-forward " BCA CLBIA POBLADO IMPTO GOBIERNO 4X1000" nil t) (replace-match " Impuesto 4xmil Expenses:noOper:4xmil:9350 Assets:Banco:ahorro:9350" t) (ledger-post-align-xact (point)) (goto-line (point-min))) (goto-char (point-min)) (while (search-forward " BCA CLBIA POBLADO RETENCION EN LA FUENTE" nil t) (replace-match " Impuesto Retención en la fuente Expenses:noOper:retefte:9350 Assets:Banco:ahorro:9350" t) (ledger-post-align-xact (point)) (goto-line (point-min))) (goto-char (point-min)) (while (search-forward " BCA CLBIA POBLADO PAGO PSE CORPORACION EDUCATIV Instituto Jorge Robledo" nil t) (replace-match " PSE Instituto Jorge Robledo \n Expenses:Colegio:dante \n Assets:9350 " t) (ledger-post-align-xact (point)) (goto-line (point-min))) (goto-char (point-min)) (while (search-forward " BCA CLBIA POBLADO IVA COMIS TRASLADO OTROS BCOS" nil t) (replace-match " Comisión traslado otro banco \n Expenses:noOper:comision:otroBanco \n Assets:Banco:ahorro:9350 " t) (ledger-post-align-xact (point)) (goto-char (point-min))) (while (search-forward " BCA CLBIA POBLADO COMISION TRASLADO OTROS BANCOS" nil t) (replace-match " Comisión traslado otro banco \n Expenses:noOper:comision:otroBanco \n Assets:Banco:ahorro:9350 " t) (ledger-post-align-xact (point)) (goto-char (point-min))) (while (search-forward " BCA CLBIA POBLADO TRASL A CTA CTE CUBRIR SOBREGI" nil t) (replace-match " Cubrir sobregiro \n Expenses:noOper:sobregiro \n Assets:Bancos:ahorro:9350 " t) (ledger-post-align-xact (point)) (goto-line (point-min))) (while (search-forward "PLAZA MAYOR ABONO INTERESES AHORROS" nil t) (replace-match " Interes ahorro \n Revenues:noOper:interes:ola \n Assets:ola " t) (ledger-post-align-xact (point)) (goto-line (point-min))) (while (search-forward " BCA CLBIA POBLADO PAGO CART HIPOT DEBITO AUTOM" nil t) (replace-match " PAGO credito hipotecario apto 1901 \n Liabilities:CxP:credito:5765 \n Assets:Banco:ahorro:9350 " t) (ledger-post-align-xact (point)) (goto-line (point-min))) (while (search-forward " BCA CLBIA POBLADO ABONO INTERESES AHORROS" nil t) (replace-match " Interes ahorro \n Revenues:noOper:interes:9350 \n Assets:Banco:ahorro:9350 " t) (ledger-post-align-xact (point)) (goto-line (point-min))) (while (search-forward " BCA CLBIA POBLADO PAGO LOPEZ CORREA FED98549000" nil t) (replace-match " Coomeva FED98549000 \n Expenses:salud:prepagada \n Assets:Banco:ahorro:9350 " t) (ledger-post-align-xact (point)) (goto-line (point-min)))) ;; (while (search-forward " BCA CLBIA POBLADO PAGO PROGRAMADO EPM SERVICIOS" nil t) ;; (replace-match " Pago Programado EPM \n Expenses:Servicios:epm \n Assets:Banco:ahorro:9350 " t) ;; (ledger-post-align-xact (point)) ;; (forward-word 1) ;; (backward-kill-word 1) ;; (forward-line -2) ;; (doom/forward-to-last-non-comment-or-eol) ;; (newline) ;; (insert " ;; ref: ") ;; (yank)) (defun procesa-Extracto-opt() "Convert bancolombia->ledger format" (interactive) ;; Define replacements as a list of cons cells (let ((replacements '((" " . " ") (" BCA CLBIA POBLADO IMPTO GOBIERNO 4X1000" . " Impuesto 4xmil\n Expenses:noOper:4xmil:9350 \n Assets:Banco:ahorro:9350") (" BCA CLBIA POBLADO RETENCION EN LA FUENTE" . " Impuesto Retención en la fuente\n Expenses:noOper:retefte:9350\n Assets:Banco:ahorro:9350") (" BCA CLBIA POBLADO PAGO PSE CORPORACION EDUCATIV Instituto Jorge Robledo" . " PSE Instituto Jorge Robledo\n Expenses:Colegio:dante\n Assets:9350") (" BCA CLBIA POBLADO IVA COMIS TRASLADO OTROS BCOS" . " Comisión traslado otro banco\n Expenses:noOper:comision:otroBanco\n Assets:Banco:ahorro:9350") (" BCA CLBIA POBLADO COMISION TRASLADO OTROS BANCOS" . " Comisión traslado otro banco\n Expenses:noOper:comision:otroBanco\n Assets:Banco:ahorro:9350") (" BCA CLBIA POBLADO TRASL A CTA CTE CUBRIR SOBREGI" . " Cubrir sobregiro\n Expenses:noOper:sobregiro\n Assets:Bancos:ahorro:9350") ("PLAZA MAYOR ABONO INTERESES AHORROS" . " Interes ahorro\n Revenues:noOper:interes:ola\n Assets:ola") (" BCA CLBIA POBLADO PAGO CART HIPOT DEBITO AUTOM" . " PAGO credito hipotecario apto 1901\n Liabilities:CxP:credito:5765\n Assets:Banco:ahorro:9350") (" BCA CLBIA POBLADO ABONO INTERESES AHORROS" . " Interes ahorro\n Revenues:noOper:interes:9350\n Assets:Banco:ahorro:9350") (" BCA CLBIA POBLADO PAGO LOPEZ CORREA FED98549000" . " Coomeva FED98549000\n Expenses:salud:prepagada\n Assets:Banco:ahorro:9350")))) (goto-char (point-min)) ;; Perform replacements (dolist (pair replacements) (let ((search (car pair)) (replace (cdr pair))) (while (search-forward search nil t) (replace-match replace t) (ledger-post-align-xact (point)) (goto-char (point-min))))))) (defun procesa-Extracto-opt-cases () "Convert bancolombia->ledger format with user-defined cases for account numbers." (interactive) ;; Ask the user for the case they want to apply (let ((case (completing-read "Choose the case (9350/8824/other): " '("9350" "8824" "other")))) ;; Define the account number based on the user's input (let ((account (cond ((string= case "9350") "9350") ((string= case "8824") "8824") ((string= case "other") (read-string "Enter the custom account number: ")) (t "9350")))) ;; Default to 9350 if no valid case is chosen ;; Define the replacements, dynamically inserting the account number (let ((replacements `((" " . " ") (" BCA CLBIA POBLADO IMPTO GOBIERNO 4X1000" . ,(concat " Impuesto 4xmil\n Expenses:noOper:4xmil:" account " \n Assets:Banco:ahorro:" account)) (" BCA CLBIA POBLADO RETENCION EN LA FUENTE" . ,(concat " Impuesto Retención en la fuente\n Expenses:noOper:retefte:" account "\n Assets:Banco:ahorro:" account)) (" BCA CLBIA POBLADO PAGO PSE CORPORACION EDUCATIV Instituto Jorge Robledo" . ,(concat " PSE Instituto Jorge Robledo\n Expenses:Colegio:dante\n Assets:" account)) (" BCA CLBIA POBLADO IVA COMIS TRASLADO OTROS BCOS" . ,(concat " Comisión traslado otro banco\n Expenses:noOper:comision:otroBanco\n Assets:Banco:ahorro:" account)) (" BCA CLBIA POBLADO COMISION TRASLADO OTROS BANCOS" . ,(concat " Comisión traslado otro banco\n Expenses:noOper:comision:otroBanco\n Assets:Banco:ahorro:" account)) (" BCA CLBIA POBLADO TRASL A CTA CTE CUBRIR SOBREGI" . ,(concat " Cubrir sobregiro\n Expenses:noOper:sobregiro\n Assets:Bancos:ahorro:" account)) ("PLAZA MAYOR ABONO INTERESES AHORROS" . " Interes ahorro\n Revenues:noOper:interes:ola\n Assets:ola") (" BCA CLBIA POBLADO PAGO CART HIPOT DEBITO AUTOM" . ,(concat " PAGO credito hipotecario apto 1901\n Liabilities:CxP:credito:5765\n Assets:Banco:ahorro:" account)) (" BCA CLBIA POBLADO ABONO INTERESES AHORROS" . ,(concat " Interes ahorro\n Revenues:noOper:interes:" account "\n Assets:Banco:ahorro:" account)) (" BCA CLBIA POBLADO PAGO LOPEZ CORREA FED98549000" . ,(concat " Coomeva FED98549000\n Expenses:salud:prepagada\n Assets:Banco:ahorro:" account))))) ;; Start processing the buffer (goto-char (point-min)) ;; Perform the replacements using the list of cons cells (dolist (pair replacements) (let ((search (car pair)) (replace (cdr pair))) (while (search-forward search nil t) (replace-match replace t) (ledger-post-align-xact (point)) (goto-char (point-min))))))))) (defun excel-to-ledger (input-buffer output-buffer) "Convert Excel-like data in INPUT-BUFFER to ledger-cli format in OUTPUT-BUFFER." (with-current-buffer input-buffer (goto-char (point-min)) ;; Skip the header line (forward-line 2) (let ((transactions '())) (while (not (eobp)) (let* ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position))) (fields (split-string line ",")) (cargo (nth 0 fields)) (tipo-contrato (nth 1 fields)) (horario (nth 2 fields)) (fecha-ingreso (nth 3 fields)) (centro-trabajo (nth 4 fields)) (codigo-planilla (nth 5 fields)) (id (nth 6 fields)) (nombres (nth 7 fields)) (apellidos (nth 8 fields)) (edad (nth 9 fields)) (rh (nth 10 fields)) (cedula (nth 11 fields)) (fecha-nacimiento (nth 12 fields)) (fecha-expedicion (nth 13 fields)) (lugar (nth 14 fields)) (direccion (nth 15 fields)) (telefono (nth 16 fields)) (correo (nth 17 fields)) (ibc (nth 18 fields)) (eps (nth 19 fields)) (puntaje-sisben (nth 20 fields)) (arl (nth 21 fields)) (riesgo (nth 22 fields)) (actividad-economica (nth 23 fields)) (pensiones (nth 24 fields)) (ccf (nth 25 fields)) (cesantias (nth 26 fields)) (metodo-pago (nth 27 fields)) (cta-bancaria (nth 28 fields)) (entidad (nth 29 fields)) (tipo-cuenta (nth 30 fields)) (direccion-sucursal (nth 31 fields)) (es-titular (nth 32 fields)) (cedula-titular (nth 33 fields))) (push (format "%s %s %s %s %s" fecha-ingreso nombres apellidos cargo tipo-contrato horario fecha-ingreso centro-trabajo codigo-planilla id nombres apellidos edad rh cedula fecha-nacimiento fecha-expedicion lugar direccion telefono correo ibc eps puntaje-sisben arl riesgo actividad-economica pensiones ccf cesantias metodo-pago cta-bancaria entidad tipo-cuenta direccion-sucursal es-titular cedula-titular) transactions)) (forward-line 1)) (with-current-buffer output-buffer (erase-buffer) (dolist (transaction transactions) (insert transaction "\n")))))) (defun excel-to-ledger (input-buffer output-buffer) "Convert Excel-like data in INPUT-BUFFER to ledger-cli format in OUTPUT-BUFFER." (with-current-buffer input-buffer (goto-char (point-min)) ;; Skip the header line (forward-line 1) (let ((transactions '())) (while (not (eobp)) (let* ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position))) (fields (split-string line ",")) (cargo (nth 2 fields)) (tipo-contrato (nth 3 fields)) (horario (nth 4 fields)) (fecha-ingreso (nth 5 fields)) (centro-trabajo (nth 6 fields)) (codigo-planilla (nth 7 fields)) (id (nth 8 fields)) (nombres (nth 9 fields)) (apellidos (nth 10 fields)) (edad (nth 11 fields)) (rh (nth 12 fields)) (cedula (nth 13 fields)) (fecha-nacimiento (nth 14 fields)) (fecha-expedicion (nth 15 fields)) (lugar (nth 16 fields)) (direccion (nth 17 fields)) (telefono (nth 18 fields)) (correo (nth 19 fields)) (ibc (nth 20 fields)) (eps (nth 21 fields)) (puntaje-sisben (nth 22 fields)) (arl (nth 23 fields)) (riesgo (nth 24 fields)) (actividad-economica (nth 25 fields)) (pensiones (nth 26 fields)) (ccf (nth 27 fields)) (cesantias (nth 28 fields)) (metodo-pago (nth 29 fields)) (cta-bancaria (nth 30 fields)) (entidad (nth 31 fields)) (tipo-cuenta (nth 32 fields)) (direccion-sucursal (nth 33 fields)) (es-titular (nth 34 fields)) (cedula-titular (nth 35 fields))) (add-to-list 'transactions (format "%s %s %s Assets:personal $%s ;; cargo: %s ;; tipo-contrato: %s ;; horario: %s ;; centro-trabajo: %s ;; codigo-planilla-soi: %s ;; id: %s ;; edad: %s ;; rh: %s ;; cedula: %s ;; fecha-nacimiento: %s ;; fecha-expedicion-cedula: %s ;; lugar-expedicion: %s ;; direccion: %s ;; telefono: %s ;; correo: %s ;; eps: %s ;; puntaje-sisben: %s ;; arl: %s ;; riesgo: %s ;; actividad-economica: %s ;; pensiones: %s ;; ccf: %s ;; cesantias: %s ;; metodo-pago: %s ;; cuenta-bancaria: %s ;; entidad: %s ;; tipo-cuenta: %s ;; sucursal: %s ;; es-titular: %s ;; cedula-titular: %s Time " fecha-ingreso nombres apellidos ibc cargo tipo-contrato horario centro-trabajo codigo-planilla id edad rh cedula fecha-nacimiento fecha-expedicion lugar direccion telefono correo eps puntaje-sisben arl riesgo actividad-economica pensiones ccf cesantias metodo-pago cta-bancaria entidad tipo-cuenta direccion-sucursal es-titular cedula-titular) t)) (forward-line 1)) (with-current-buffer output-buffer (erase-buffer) (dolist (transaction transactions) (insert transaction "\n")))))) ;; (excel-to-ledger "input-buffer-name" "output-buffer-name") (defun siigo-csv-to-ledger (input-buffer output-buffer) "Convert Excel-like data in INPUT-BUFFER to ledger-cli format in OUTPUT-BUFFER. NOTA: se esporta de siigo excel, de excel se exporta a valores separados por TABS y se reemplazan los TABS por ;;" (with-current-buffer input-buffer (goto-char (point-min)) ;; Skip the header line (forward-line 1) (let ((transactions '())) (while (not (eobp)) (let* ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position))) (fields (split-string line ";;")) (col01 (nth 1 fields)) (col02 (nth 2 fields)) (col03 (nth 3 fields)) (col04 (nth 4 fields)) (col05 (nth 5 fields)) (col06 (nth 6 fields)) (col07 (nth 7 fields)) (col08 (nth 8 fields)) (col09 (nth 9 fields)) (col10 (nth 10 fields)) (col11 (nth 11 fields)) (col12 (nth 12 fields)) (col13 (nth 13 fields)) (col14 (nth 14 fields)) (col15 (nth 15 fields)) (col16 (nth 16 fields)) (col17 (nth 17 fields))) ;; (test (+ 100000 (flat-money col15)))) (add-to-list 'transactions (concat col02 " " col01 " " col05 "\n" " ;; NIT: " col03 "\n" " ;; fact: " col01 "\n" " ;; doc: \n" " Revenues: $" col07 "\n" " Liabilities:CxP:impuesto:iva -$" col10 "\n" " Assets:CxC:Impuesto:rtefte $" col12 "\n" " Assets:clienteNacional: $" col15 "\n" " Liabilities:CxP:impuesto:rtefte -$0.0 ;; calcular" "\n" " Autorretencion \n" ) t)) (forward-line 1)) (with-current-buffer output-buffer (erase-buffer) (dolist (transaction transactions) (insert transaction "\n") (ledger-post-align-xact (point))))))) ;; (siigo-csv-to-ledger "input-buffer-name" "output-buffer-name") (defun flat-money (x) "Remove commas, quotes, and cents from the string X, then parse it as an integer." (let* ((cleaned (replace-regexp-in-string "[,\"]" "" x)) (without-cents (if (string-match "\\." cleaned) (substring cleaned 0 (match-beginning 0)) cleaned))) (string-to-number without-cents))) ;; Test the function ;;(let ((col16 "3,402,169.89")) ;; (string-to-number (flat-money col16))) ;; should return 1234567 (defun copy-buffer-file-path () "Copy the file path of the buffer's associated file to the clipboard. Raise an error if the buffer does not contain a file associated." (interactive) (let ((file-path (buffer-file-name))) (if file-path (progn (kill-new file-path) (message "Copied file path: %s" file-path)) (error "Buffer does not contain a file associated")))) ;; Usage: ;; Call the function `copy-buffer-file-path` when the point is in the buffer. (defun causa-generico-egreso() (interactive) (move-beginning-of-line 0) (forward-word 3) (kill-word 3) (search-forward "$" ) (backward-word 1) (newline) (insert " Expenses: ") (newline) (insert " Assets:Banco:ahorro:9350 ") (backward--invert-currency) (forward-word 3) (ledger-post-align-xact (point))) (defun causa-generico-ingreso() (interactive) (move-beginning-of-line 0) (forward-word 3) (kill-word 3) (search-forward "$" ) (backward-word 1) (newline) (insert " Revenues: ") (newline) (insert " Assets:Banco:ahorro:9350 ") (backward--invert-currency) (ledger-post-align-xact (point))) (defun causa-generico-assets-cliente() (interactive) (move-beginning-of-line 0) (forward-word 3) (kill-word 3) (search-forward "$" ) (backward-word 1) (newline) (insert " Assets:clienteNacional: ") (newline) (insert " Assets:Banco:ahorro:9350 ") (ledger-post-align-xact (point)) (backward--invert-currency)) (defun replace-in-string (what with in) (replace-regexp-in-string (regexp-quote what) with in nil 'literal)) (defun invierte_separador_punto () (interactive) (while (re-search-forward "\\,[0-9][0-9]$" nil t ) ;; verifica solo espacio o fin de línea (backward-char 3) (delete-char 1) (insert ".") )) (defun prepara_papeleta () "Solo reemplaza los separadores de miles y los asteriscos" (interactive) (while (re-search-forward "\\." nil t) (replace-match ",")) (goto-line (point-min)) (while (re-search-forward "*" nil t) (replace-match "")) (goto-line (point-min)) (invierte_separador_punto)) (defun ledger-toggle-current (&optional style) "Toggle the current thing at point with optional STYLE." (interactive) (if (or ledger-clear-whole-transactions (eq 'transaction (ledger-thing-at-point))) (let ((point-a -1) (point-b 0)) (save-excursion (forward-line) (goto-char (line-beginning-position)) (while (and (not (= point-a point-b)) (not (eolp)) (save-excursion (not (eq 'transaction (ledger-thing-at-point))))) (if (looking-at "\\s-+[*!]") (ledger-toggle-current-posting style)) (setq point-a (point)) (forward-line) (goto-char (line-beginning-position)) (setq point-b (point)))) (ledger-toggle-current-transaction style)) (ledger-toggle-current-posting style))) (defun procesa_recibo_individual () (interactive) (next-line 1) (kill-line 5) (next-line 3) (kill-line) (next-line 1) (kill-line)(next-line 1) (move-beginning-of-line 0) (delete-char -1) (insert " ") (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ") ;; cada bloque con espacio entrelazado (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ") (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ") (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ") (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ") (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1);;valor ;; dada una cantidad de la forma 1.000,00 se quiere invertir los separadores para que quede $1,000.00 (BUG: no se expande a $1.000.000,00) (move-beginning-of-line 0) (search-forward ":") (insert " $") (search-forward ".") (delete-char -1) (insert ",") (search-forward ",") (delete-char -1) (insert ".") (next-line 2) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ");; concepto (next-line 1) (kill-line) ;; referencia (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ") (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ") (next-line 1) (newline 3) (insert "================") (newline 3) ) (defun fix_cone () "Solo funciona para el primer grupo de miles de una cantidad con dos decimales ej. 1234.00 queda 1,234.00" (interactive) (next-line 1) (move-end-of-line 1) (forward-char -6) (insert ",") (ledger-post-align-xact (point)) (ledger-navigate-next-xact-or-directive)) (defun arregla_recibo_individual () (interactive) (next-line 48) (kill-line) (next-line -3) (move-end-of-line 0) (yank) (kill-line) (next-line 3) (kill-line) (next-line -48) (procesa_recibo_individual)) (defun get-point (symbol &optional arg) "get the point" (funcall symbol arg) (point)) (defun copy-thing (begin-of-thing end-of-thing &optional arg) "Copy thing between beg & end into kill ring." (save-excursion (let ((beg (get-point begin-of-thing 1)) (end (get-point end-of-thing arg))) (copy-region-as-kill beg end)))) (defun paste-to-mark (&optional arg) "Paste things to mark, or to the prompt in shell-mode." (unless (eq arg 1) (if (string= "shell-mode" major-mode) (comint-next-prompt 25535) (goto-char (mark))) (yank))) (defun copy-word (&optional arg) "Copy words at point into kill-ring" (interactive "P") (copy-thing 'backward-word 'forward-word arg) ;;(paste-to-mark arg) ) (defun copy-paragraph (&optional arg) "Copy paragraphes at point" (interactive "P") (copy-thing 'backward-paragraph 'forward-paragraph arg) (paste-to-mark arg) ) (defun copy-word-2 (&optional arg) "Copy words at point into kill-ring" (interactive "P") (let ((beg (progn (if (looking-back "[a-zA-Z0-9]" 1) (backward-word 1)) (point))) (end (progn (forward-word arg) (point)))) (copy-region-as-kill beg end))) (defun monta-pago-ledger (banco cuenta tipoCuenta id beneficiario referencia valor) (let* ((date (format-time-string "%Y/%m/%d ")) (text (concat "\n"date " " beneficiario "\n ;; id_pagador: 901429017 " "\n ;; cuenta_receptor: " cuenta "\n ;; tipo: " tipoCuenta "\n ;; banco: " banco "\n ;; id_receptor: " id "\n ;; referencia: " referencia "\n registro " valor "\n Time" ))) (insert text ))) (defun reverse-date () "Invierte el orden de una fecha de \"DD/MM/AAAA\" a \"AAAA/MM/DD\"" (interactive) (let* ((day (progn (set-mark-command nil) (forward-char 2) (kill-ring-save (mark) (point)) (current-kill 0 t))) (month (progn (forward-char 1) (set-mark-command nil) (forward-char 2) (kill-ring-save (mark) (point)) (current-kill 0 t))) (year (progn (forward-char 1) (set-mark-command nil) (forward-char 4) (kill-ring-save (mark) (point)) (current-kill 0 t))) (separator "\\")) (print (concat year "\\" month day)))) ;"DD/MM/AAAA" (defun importa-facturas-siigo (Tipo Comprobante Fecha Identificación Suc Nombre Moneda bruto Descuento Subtotal IVA Impoconsumo Retefuente ReteIVA ReteICA Total) (let* ( ))) ;;(org-agenda-convert-date "19/04/2024") (defun correo_desde_comprobante () "Desde una papeleta con miles y asteriscos corregidos, inserta en un libro de ledger, crea un archivo (TODO: completar la info), prepara un correo con adjunto, asunto y contenido" ;; BUG: si la cantidad es mayor a 999999 inserta punto en vez de coma en el segundo separador (interactive) (let* ((cuenta (progn (search-forward "cuenta:") (set-mark-command nil) (forward-word 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (beneficiario (progn (search-forward "beneficiario:") (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (cedula (progn (search-forward "Documento:") (set-mark-command nil) (forward-word 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (valor (progn (search-forward "Valor:") (forward-char 1) (set-mark-command nil) (forward-word 3) (kill-ring-save (mark) (point)) (current-kill 0 t))) (concepto (progn (search-forward "Concepto:") (forward-char 1) (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (recibo (progn (mark-paragraph 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (date (format-time-string "%Y-%m-%d ")) (date-ledger (format-time-string "%Y/%m/%d ")) (options '("ALC" "pNatural" "yo" "test")) (destino (completing-read "Selecciona: " options nil t)) (period (read-from-minibuffer "Período: ")) (cta-destino cuenta) (nit-destino cedula) (razon-social beneficiario) (ledger-val valor) (val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" ledger-val)) (number-to-words (replace-regexp-in-string " " "" (shell-command-to-string (concat "numero_a_letras" " " val)))) (ledger-account " Expenses: ") (tag1 (read-from-minibuffer "Tag: ")) (tags (concat " -- " " pago " tag1 )) (ext ".txt") (valor_plano (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" valor)) (subject (concat date ":pago:" tag1 ":" beneficiario " " concepto " v " valor_plano))) ;;(fpath (concat path date period " " beneficiario " " "v " val " " tags ext)) (pcase destino ("ALC" (progn (setq maildir "contacto.ola38@gmail.com" fpath (concat "~/Dropbox/ALC/" date period " " beneficiario " " "v " val " " tags ext) path2 "~/ola38/pagos_OLA38.ldg" ledger-asset " Assets:Banco:ahorro:0609 ") (write-region recibo nil fpath) ;; create empty file (write-region (concat "\n" date-ledger "PAGO " period " " beneficiario "\n" " ; comprobante: EGRESOS No. \n ;\n" " ; EMPRESA: OLA38 S.A.S. NIT: 901429017-6 \n" " ; CIUDAD: Medellín \n ;\n" " ; ctaOrigen: 25900000609 \n" " ; ctaDestino:" cta-destino " \n ;\n" " ; PAGADO A: " razon-social "\n ;\n" " ; NIT: " nit-destino "\n ;\n" " ; DESCRIPCION: PAGO " period " " beneficiario "\n ;\n" " ; EN LETRAS: " number-to-words "\n" " ; RETENCION: \n" ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append))) ("pNatural" (progn (setq maildir "fede2001@gmail.com" fpath (concat "~/Dropbox/pNatural/" date period " " beneficiario " " "v " val " " tags ext) path2 "~/Admin/cuentas.ldg" ledger-asset " Assets:Banco:ahorro:9350 ") (write-region paste nil fpath) ;; create empty file (write-region (concat "\n" date-ledger "PAGO " period " " beneficiario "\n" ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append))) ("yo" (progn (setq maildir "fede2001@gmail.com" fpath (concat "~/Dropbox/yo/" date period " " beneficiario " " "v " val " " tags ext) path2 "~/Admin/cuentasFLC.ldg" ledger-asset " Assets:Banco:ahorro:8824 ") (write-region paste nil fpath) ;; create empty file (write-region (concat "\n" date-ledger "PAGO " period " " beneficiario "\n" ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append))) (_ (message "nada"))) (compose-mail maildir subject nil nil nil nil nil nil) (mail-text) (insert (concat beneficiario "\n" "cuenta: " cuenta "\n" "valor: " valor "\n\n" recibo)) (mml-attach-file fpath "text/x-patch" nil "attachment"))) (setq my-email-addresses '("contacto.ola38@gmail.com" "financiera.ola38@gmail.com" "talentohumano.ola38@gmail.com" "gloriah@dafasesorias.com" "manuelita85@gmail.com" "gloriacorreadel@gmail.com" "clopezcorrea@gmail.com")) (defun correo-selecciona-de-lista () "Send an email by selecting from a list of email addresses and optionally adding an attachment." (interactive) (let* ((to-address (completing-read "Select recipient: " my-email-addresses)) (subject (read-string "Subject: ")) (body (read-string "Body: ")) (attachment (read-file-name "Select attachment (leave empty if none): " nil nil t))) (compose-mail to-address subject) (message-goto-body) (insert body) (when (and attachment (not (string= attachment ""))) (mml-attach-file attachment)) (message-goto-to))) ;; Example usage: M-x my-send-mail (defun correo-adiciona-recipiente-de-lista () "Send an email by selecting from a list of email addresses and optionally adding an attachment." (interactive) (let* ((to-address (completing-read "Select recipient: " my-email-addresses))) (goto-line 1) (move-end-of-line 1) (insert (concat ", " to-address)))) (defun correo_desde_papeleta () "Según los saltos se posiciona en la línea 1" ;; BUG: si la cantidad es mayor a 999999 inserta punto en vez de coma en el segundo separador (interactive) (prepara_papeleta) (let* ((operacion (progn (goto-line 7) (set-mark-command nil) (forward-word 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (fecha (progn (goto-line 8) (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (titulo (progn (goto-line 26) (forward-word 1) (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (cliente (progn (goto-line 35) (er-go-to-column 11) (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (cedula (progn (goto-line 39) (forward-word 1) (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (cantidad (progn (goto-line 95) (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (precio (progn (goto-line 99) (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (valor (progn (goto-line 103) (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (comision (progn (goto-line 107) (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (neto (progn (goto-line 122) (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (iva (progn (goto-line 126) (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (neto-iva (progn (goto-line 132) (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t))) (date (format-time-string "%Y-%m-%d ")) (date-ledger (format-time-string "%Y/%m/%d ")) (options '("ALC" "pNatural" "yo" "test")) (destino (completing-read "Selecciona: " options nil t)) (period (read-from-minibuffer "Período: ")) (val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" neto-iva)) (ledger-account " Expenses: ") (tag1 (read-from-minibuffer "Tag: ")) (tags (concat " -- " " pago " tag1 )) (ext ".txt") (valor_plano (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" neto-iva)) (paste (concat "\n" date-ledger operacion " " cantidad " " titulo " " cliente "\n" " Assets:accion " valor "\n" " Expenses:noOper:iva " iva "\n" " Expenses:noOper:comision:accion " comision "\n" ledger-asset "-" neto-iva "\n")) (subject (concat date ":papeleta:" tag1 ": " operacion " " cliente " v " valor_plano))) ;;(fpath (concat path date period " " beneficiario " " "v " val " " tags ext)) (pcase destino ("pNatural" (progn (setq maildir "fede2001@gmail.com" fpath (concat "~/Dropbox/pNatural/" date period " " cliente " " "v " val " " tags ext) path2 "~/Admin/Assets Acciones -- privado critico.ldg" ledger-asset " Assets:fondo ") (write-region paste nil fpath) ;; create empty file (write-region (concat "\n" date-ledger operacion " " cantidad " " titulo " " cliente "\n" " Assets:accion " valor "\n" " Expenses:noOper:iva " iva "\n" " Expenses:noOper:comision:accion " comision "\n" ledger-asset "-" neto-iva "\n") nil path2 'append))) (_ (message "nada"))) (compose-mail maildir subject nil nil nil nil nil nil) (mail-text) (insert (concat cliente "\n" "operacion: " operacion "\n" titulo " " cantidad "\n" "valor: " valor "\n\n" )) (mml-attach-file fpath "text/x-patch" nil "attachment"))) (defun correo_desde_papeleta-opt () "Compose and send email from papeleta information." (interactive) (prepara_papeleta) (let* ((operacion (extract-papeleta-info 7)) (fecha (extract-papeleta-info 8)) (titulo (extract-papeleta-info 26)) (cliente (extract-papeleta-info 35 11)) (cedula (extract-papeleta-info 39)) (cantidad (extract-papeleta-info 95)) (precio (extract-papeleta-info 99)) (valor (extract-papeleta-info 103)) (comision (extract-papeleta-info 107)) (neto (extract-papeleta-info 122)) (iva (extract-papeleta-info 126)) (neto-iva (extract-papeleta-info 132)) (date (format-time-string "%Y-%m-%d ")) (date-ledger (format-time-string "%Y/%m/%d ")) (options '("ALC" "pNatural" "yo" "test")) (destino (completing-read "Selecciona: " options nil t)) (period (read-from-minibuffer "Período: ")) (val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" neto-iva)) (ledger-account " Expenses: ") (tag1 (read-from-minibuffer "Tag: ")) (tags (concat " -- " " pago " tag1)) (ext ".txt") (valor-plano (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" neto-iva)) (paste (concat "\n" date-ledger operacion " " cantidad " " titulo " " cliente "\n" " Assets:accion " valor "\n" " Expenses:noOper:iva " iva "\n" " Expenses:noOper:comision:accion " comision "\n" ledger-asset "-" neto-iva "\n")) (subject (concat date ":papeleta:" tag1 ": " operacion " " cliente " v " valor-plano))) (pcase destino ("pNatural" (send-email-pNatural destino date operacion cantidad titulo cliente valor iva comision neto-iva paste path date-ledger tag1 tags ext)) (_ (message "nada"))))) (defun extract-papeleta-info (line &optional column) "Extract information from papeleta at LINE. If COLUMN is provided, move to that column." (goto-line line) (when column (er-go-to-column column)) (let ((beg (point))) (end-of-line) (buffer-substring-no-properties beg (point)))) (defun send-email-pNatural (destino date operacion cantidad titulo cliente valor iva comision neto-iva paste path date-ledger tag1 tags ext) "Send email to pNatural with papeleta information." (setq maildir "fede2001@gmail.com" fpath (concat "~/Dropbox/pNatural/" date period " " cliente " " "v " val " " tags ext) path2 "~/Admin/Assets Acciones -- privado critico.ldg" ledger-asset " Assets:fondo ") (write-region paste nil fpath) ;; create empty file (write-region (concat "\n" date-ledger operacion " " cantidad " " titulo " " cliente "\n" " Assets:accion " valor "\n" " Expenses:noOper:iva " iva "\n" " Expenses:noOper:comision:accion " comision "\n" ledger-asset "-" neto-iva "\n") nil path2 'append)) (defun correo_desde_comprobante_crudo_incompleta () ;; BUG: si la cantidad es mayor a 999999 inserta punto en vez de coma en el segundo separador (interactive) (let* ((cuenta_destino (progn (next-line 12) (move-beginning-of-line 1) (set-mark-command nil) (move-end-of-line 1) (kill-ring-save (mark) (point)) (current-kill 0 t)))))) (defun random-theme () "adapted from https://github.com/gopar/rand-theme" (interactive) (mapc 'disable-theme custom-enabled-themes) (setq theme (nth (random (length (custom-available-themes))) (custom-available-themes))) (load-theme theme) (message "Loaded Theme: %s" (symbol-name theme))) (defun fav-random-theme () "adapted from https://github.com/gopar/rand-theme" (interactive) (mapc 'disable-theme custom-enabled-themes) (setq theme (nth (random (length fav-themes)) fav-themes)) (load-theme theme) (message "Loaded Theme: %s" (symbol-name theme))) (defun fechas-pasado-a-hoy () "Reemplaza fechas de días pasados a hoy, no usar en contabilidad" (interactive) (let ((date (read-from-minibuffer "Fecha [AAAA/MM/DD]:"))) (progn (goto-char (point-min)) (while ;; (re-search-forward "\\(=2022/\\(11|10\\)/[0-9][0-9]\\)" nil t) (re-search-forward (concat "=" date) nil t) ;; mes ;; (re-search-forward "\\(=2021/[0-9][0-9]/[0-9][0-9]\\)" nil t) ;;(re-search-forward "=2022/12/06" nil t) ;; dia (replace-match (concat "=" (format-time-string "%Y/%m/%d")) t) (goto-line (point-min)))))) (fset 'dividendosGLO (kmacro-lambda-form [return ?\C-a ?\M-f ?\M-f ?\M-f ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ? ?D ?i ?v ?i ?d ?e ?n ?d ?o ?s ? return ?\; ? ?r ?e ?f ?: ? ?\M-f return backspace backspace ?R ?e ?v ?e ?n ?u ?e ?s ? ? left left ?: ?d ?i ?v ?i ?d ?e ?n ?d ?o ?s ? ?\C-f ?\C-f ?\C-f ?- ?\C-d ?\C-e return ?A ?s ?s ?e ?t ?s ?: ?9 ?3 ?9 ?2 ? ] 0 "%d")) (defun invert-currency () (interactive) (beginning-of-line) (search-forward "$" nil t) (forward-char -2) ; para incluir el caso -$ (if (search-forward "-" (cdr (bounds-of-thing-at-point 'line)) t) (replace-match "") (progn (search-forward "$" (cdr (bounds-of-thing-at-point 'line)) t) (forward-char -1) (insert "-"))) (line-move 1)) (defun agrega-centavos () "Agrega centavos .00 al final de la línea" (interactive) (end-of-line) (insert ".00") (forward-line 1)) (defun backward--invert-currency () (interactive) (let ((beg (progn (search-forward "$") (forward-char -2) (point))) (end (progn (end-of-line) (point)))) (copy-region-as-kill beg end) (line-move -1) ;; sube una línea (end-of-line) (insert " ") ;; ledger requiere separacion entre cantidad y cuenta (yank) (invert-currency) (forward-line -1) (ledger-post-align-xact beg))) (defun forward-copy-invert-currency () (interactive) (let ((beg (progn (search-forward "$") (forward-char -2) (point))) (end (progn (end-of-line) (point)))) (copy-region-as-kill beg end) (line-move 1) ;; sube una línea (end-of-line) (insert " ") ;; ledger requiere separacion entre cantidad y cuenta (yank) (invert-currency) (forward-line -1) (ledger-post-align-xact beg))) (defun backward--invert-currency () (interactive) (let ((beg (progn (search-forward "$") (forward-char -2) (point))) (end (progn (end-of-line) (point)))) (copy-region-as-kill beg end) (line-move -1) ;; sube una línea (end-of-line) (insert " ") ;; ledger requiere separacion entre cantidad y cuenta (yank) (invert-currency) (forward-line -1) (ledger-post-align-xact beg))) (defun time-to-flame () (interactive) ;;(goto-char (point-min)) (while (re-search-forward "s\s" nil t) ;; depende que exista un espacio luego de la s, poría borrar la s final si la cuenta termina en s BUG FIX (replace-match "" t) (goto-line (point-min))) (while (re-search-forward "," nil t) (replace-match "" t) (goto-line (point-min))) (while (re-search-forward ":" nil t) (replace-match ";" t) (goto-line (point-min))) (while (re-search-forward "alc;" nil t) (replace-match "" t) (goto-line (point-min))) ;;(delete-trailing-whitespace) ) (defun shift-date (date days) (format-time-string "%F" (time-add (time-to-seconds (days-to-time days)) (time-to-seconds (org-time-string-to-time date))))) (defun timelog () (interactive) (let* ((date (format-time-string "%Y/%m/%d %H:%M:%S")) (options '("i" "o")) (io (completing-read "Selecciona: " options nil t)) (account (read-from-minibuffer "account: ")) (details (read-from-minibuffer "detalles: ")) (fpath "~/SyncDocs/dellioTimelog.ldg") ) (write-region (concat io " " date " " account " " details "\n" ) nil fpath 'append) )) ;; (defun shift-dates (days) ;; "adapted from https://emacs.stackexchange.com/questions/37780/increment-days-months-dates-etc-within-buffer" ;; (interactive "nDays: ") ;; (save-excursion ;; ;;(goto-char (point-min)) ;; (beginning-of-line) ;; ( ;; ;(while (not (eobp)) ;; ;;(forward-char 1) ;; (when (looking-at iso8601--full-date-match) ;; (let ((date (shift-date (match-string 0) days))) ;; (save-excursion ;; (while (looking-at "[^\s\\|\n]") ;; (delete-char 1)) ;; (insert date)))))) (defun shift-dates (days) "adapted from https://emacs.stackexchange.com/questions/37780/increment-days-months-dates-etc-within-buffer" (interactive "nDays: ") (save-excursion ;;(goto-char (point-min)) (beginning-of-line) ( ;(while (not (eobp)) ;;(forward-char 1) (when (looking-at iso8601--full-date-match) (let ((date (shift-date (match-string 0) days))) (save-excursion (while (looking-at "[^\s\\|\n]") (delete-char 1)) (insert date))))))) ;; (defun shift-dates-internal (days) ;; (save-excursion ;; ;;(goto-char (point-min)) ;; (beginning-of-line) ;; (dotimes (i 2) ;; (search-forward "/" nil t) ;; (replace-match "-")) ;; ;(while (not (eobp)) ;; ;;(forward-char 1) ;; (beginning-of-line) ;; (when (looking-at iso8601--full-date-match) ;; (let ((date (shift-date (match-string 0) days))) ;; (save-excursion ;; (while (looking-at "[^\s\\|\n]") ;; (delete-char 1)) ;; (insert date)))) ;; (beginning-of-line) ;; (dotimes (i 2) ;; (search-forward "-" nil t) ;; (replace-match "/")))) (defun shift-one-day-backward () (interactive) (shift-dates-internal -1)) (defun irc-log-integrator () (interactive) (let ((channel (read-from-minibuffer "channel: " )) (date (read-from-minibuffer "Fecha [AAAA-MM-DD]: "))) (find-file "/tmp/1.txt") (erase-buffer) (find-file (concat "~/irclogs/#" channel "@libera%20chat_" date ".txt")) (let ((beg (progn (point-min))) (end (progn (point-max)))) (copy-region-as-kill beg end) (progn (find-file "/tmp/1.txt") (forward-line 2) (insert "\n\n;;;;;;;;;; \n;;;;;;;;;;\n\n ") (insert (concat date " ")) (yank) (goto-line (point-min)) (while (search-forward "[" nil t) (replace-match (concat date " ["))))) (find-file "/tmp/1.txt") (let ((beg (progn (point-min))) (end (progn (point-max)))) (copy-region-as-kill beg end)) (find-file (concat "~/SyncDocs/summary_" channel "_roll.txt")) (goto-line (point-max)) (yank) (irc-log-integrator))) (defun capture-currency-amount () (interactive) (let ((selection (progn (line-substring-with-bidi-context (progn (beginning-of-line) (search-forward "-$" nil t) (forward-char -2) ;; for -$ case (point)) (progn (end-of-line) (point)))))) (if (string-match-p (regexp-quote "-") selection) (progn (forward-line -1) (insert " ") (insert selection) (beggining-of-line) (search-forward "$" nil t) (forward-char -2) ;; for -$ case (while (search-forward "-" nil t) (replace-match "" t))) (progn (forward-line -1) (insert "-") (insert selection)) ))) (defun dividendos_sin_ref () (interactive) (beginning-of-line) (search-forward " BCA CLBIA POBLADO PAGO DE PROV VALORES BANCOLO" nil t) (replace-match " Dividendos \n Revenues:noOper:dividendos \n Assets:Bancos:ahorro:9392 " t) (let ((beg (progn (search-forward "$") (forward-char -2) (point))) (end (progn (end-of-line) (point)))) (copy-region-as-kill beg end) (line-move -1) ;; sube una línea (yank) (invert-currency) (forward-line -1) (ledger-post-align-xact beg))) ;; nice-to-have si el invierte el signo) ;;(kmacro-lambda-form [?\C-a ?\M-f ?\M-f ?\M-f ?\C-f ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?D ?i ?v ?i ?d ?e ?n ?d ?o ?s ? ?\C-a ?n ?\C-/ ?\C-n return ?\C-p ?\C-p ?\M-f ?\M-f ?\M-f ?\M-f return ? ? ?\C-b ?\C-b ?R ?e ?v ?e ?n ?u ?e ?s ?: ?n ?o ?O ?p ?e ?r ?: ?d ?i ?v ?i ?d ?e ?n ?d ?o ?s ? ?\C-e return ?A ?s ?s ?e ?t ?s ?: ?9 ?3 ?9 ?2 ? ] 0 "%d")) (fset 'Alianza-GLO (kmacro-lambda-form [?\C-a return ?\M-f ?\M-f ?\M-f ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\C-s ?$ ?\C-b return ?A ?s ?s ?e ?t ?s ?: ?9 ?3 ?9 ?2 ? ? ?\C-p ?\C-e return ?R ?e ?p ?o ?s ?i ?c ?i ?o ?n ?\C-n ?\C-s ?$ ?\C-b ?\C- ?\C-e ?\M-w ?\C-p ? ? ?\C-y ?\C-s ?\C-r ?$ ?\C-f ?\C-d ?\C-n ?\C-a ?\C-s ?$ ?\C-f ?\C-b ?\C-d ?\C-p ?\C-r ?$ ?\C-f ?\C-d ? ?\C-n ?\C-n] 0 "%d")) (fset 'Livin-GLO (kmacro-lambda-form [?\C-a ?\M-f ?\M-f ?\M-f ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?\C-s ?$ ?\C-a return ?\C-s ?$ ?\C-b return ?L ?i ?a ?b ?i ?l ?i ?t ?i ?e ?s ?: ?A ?r ?r ?i ?e ?n ?d ?o ?s ?: ?c ?a ?t ?y ? ? ?\C- ?\C-e ?\M-w return ?A ?s ?s ?e ?t ?s ?: ?9 ?3 ?9 ?2 ? ? ?\C-y ?\C-c ?\C-q ?\C-p ?\C-r ?$ ?\C-f ?- ?\C-d ] 0 "%d")) (fset 'Invierte-Signos-MACRO (kmacro-lambda-form [?\C-a ?\C-s ?$ ?\C-f ?\C-b ?- ?\C-d ?\C-n ?\C-r ?$ ?\C-f ?\C-d ? ?\C-a] 0 "%d")) (fset 'federico-paga-nomina-yakelin (kmacro-lambda-form [?\C-a ?\M-f ?\M-f ?\M-f ?\C-f ?\M-d ?\M-d ?\M-d ?\M-d ?\M-d ?P ?a ?g ?a ? ?Y ?a ?k ?e ?l ?i ?n ?\M-f ?\M-f ?\M-f return ? ? ?\C-b ?\C-b ?A ?s ?s ?e ?t ?s ?: ?9 ?3 ?5 ?0 ?\M-b ?\M-b return ? ? ?\C-p ?\C-f ?\C-f ?\C-p ? ? ?A ?s ?s ?e ?t ?s ?: ?c ?l ?i ?e ?n ?t ?e ?N ?a ?c ?i ?o ?n ?a ?l ?: ?f ?e ?d ?e ?r ?i ?c ?o ?: ?y ?a ?k ?e ?l ?i ?n] 0 "%d")) (fset 'Revenue:noOper:gasolina (kmacro-lambda-form [?\C-a ?\M-f ?\M-f ?\M-f ?\C-f ?\M-d ?\M-d ?\M-d ?\M-d ?G ?a ?s ?o ?l ?i ?n ?a ?\M-f ?\M-f return ? ? ?\C-b ?\C-b ?A ?s ?s ?e ?t ?s ?: ?9 ?3 ?5 ?0 ?\C-a return ? ? ?\C-p ? ? ?R ?e ?v ?e ?n ?u ?e ?s ?: ?n ?o ?O ?p ?e ?r ?: ?g ?a ?s ?o ?l ?i ?n ?a ?\C-a ?\C-p ?\C-a] 0 "%d")) (fset 'signo-hace-negativo (kmacro-lambda-form [?\C-s ?$ return ?- ?\C-d ?\C-a] 0 "%d")) (defvar xah-brackets '("“”" "()" "[]" "{}" "<>" "＜＞" "（）" "［］" "｛｝" "⦅⦆" "〚〛" "⦃⦄" "‹›" "«»" "「」" "〈〉" "《》" "【】" "〔〕" "⦗⦘" "『』" "〖〗" "〘〙" "｢｣" "⟦⟧" "⟨⟩" "⟪⟫" "⟮⟯" "⟬⟭" "⌈⌉" "⌊⌋" "⦇⦈" "⦉⦊" "❛❜" "❝❞" "❨❩" "❪❫" "❴❵" "❬❭" "❮❯" "❰❱" "❲❳" "〈〉" "⦑⦒" "⧼⧽" "﹙﹚" "﹛﹜" "﹝﹞" "⁽⁾" "₍₎" "⦋⦌" "⦍⦎" "⦏⦐" "⁅⁆" "⸢⸣" "⸤⸥" "⟅⟆" "⦓⦔" "⦕⦖" "⸦⸧" "⸨⸩" "｟｠") "A list of strings, each element is a string of 2 chars, the left bracket and a matching right bracket. Used by `xah-select-text-in-quote' and others.") (defconst xah-left-brackets (mapcar (lambda (x) (substring x 0 1)) xah-brackets) "List of left bracket chars. Each element is a string.") (defconst xah-right-brackets (mapcar (lambda (x) (substring x 1 2)) xah-brackets) "List of right bracket chars. Each element is a string.") (defun xah-backward-left-bracket () "Move cursor to the previous occurrence of left bracket. The list of brackets to jump to is defined by `xah-left-brackets'. URL `http://xahlee.info/emacs/emacs/emacs_navigating_keys_for_brackets.html' Version 2015-10-01" (interactive) (re-search-backward (regexp-opt xah-left-brackets) nil t)) (defun xah-forward-right-bracket () "Move cursor to the next occurrence of right bracket. The list of brackets to jump to is defined by `xah-right-brackets'. URL `http://xahlee.info/emacs/emacs/emacs_navigating_keys_for_brackets.html' Version 2015-10-01" (interactive) (re-search-forward (regexp-opt xah-right-brackets) nil t)) ;; ###### EMMS Global ;; ;; show everything (emms-browser-make-filter "all" 'ignore) ;; (defun emms-cache-delete () ;; interactive ;; (emms-cache-del t)) (defadvice emms-browser-next-mapping-type (after no-album (current-mapping)) (when (eq ad-return-value 'info-album) (setq ad-return-value 'info-title))) (defun toggle-album-display () (if (string= emms-browser-current-filter-name "singles") (ad-activate 'emms-browser-next-mapping-type) (ad-deactivate 'emms-browser-next-mapping-type))) (add-hook 'emms-browser-filter-changed-hook 'toggle-album-display) ;; ;; Set "all" as the default filter (emms-browser-set-filter (assoc "all" emms-browser-filters)) ;; show all files (no streamlists, etc) (emms-browser-make-filter "all-files" (emms-browser-filter-only-type 'file)) ;; ;; show only tracks in one folder (emms-browser-make-filter "SyncMusic" (emms-browser-filter-only-dir "~/SyncMusic/")) ;; ;; show only tracks in one folder (emms-browser-make-filter "Music" (emms-browser-filter-only-dir "~/Music/")) ;; show all tracks played in the last month (emms-browser-make-filter "last-month" (emms-browser-filter-only-recent 30)) ;; After executing the above commands, you can use M-x ;; emms-browser-show-all, emms-browser-show-80s, etc to toggle ;; between different collections. Alternatively you can use '<' and ;; '>' to cycle through the available filters. ;; The second argument to make-filter is a function which returns t if ;; a single track should be filtered. You can write your own filter ;; functions to check the type of a file, etc. ;; Some more examples: ;; show only tracks not played in the last year (emms-browser-make-filter "not-played" (lambda (track) (not (funcall (emms-browser-filter-only-recent 365) track)))) ;; ;; show all files that are not in the pending directory ;; (emms-browser-make-filter ;; "all" ;; (lambda (track) ;; (or ;; (funcall (emms-browser-filter-only-type 'file) track) ;; (not (funcall ;; (emms-browser-filter-only-dir "~/Media/pending") track))))) (setq-default emms-source-playlist-default-format 'native emms-playlist-mode-center-when-go t emms-playlist-default-major-mode 'emms-playlist-mode emms-show-format "NP: %s") ;;;; ;;; position of a letter in alphabet (require 'cl-lib) (setq letters '("0" "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z")) (defun letter-position () "Responde con la posición en el abecedario de la letra minúsicula que se ingrese" (interactive) (let ((position (cl-position (read-from-minibuffer "Which letter?: ") letters :test #'string=))) (if position (message "The position is %d" position) (message " not found in the array")))) ;;;; Code from leaders ;;; Time-stamp: <93/02/04 14:12:44 john> john sturdy http://www.cb1.com/~john/ (defun first-line-of-buffer () "Return as a string the first line in the current buffer." (save-excursion (goto-char (point-min)) (end-of-line) (buffer-substring (point-min) (point)))) (defun count-buffers (&optional display-anyway) "Display or return the number of buffers." (interactive) (let ( (buf-count (length (buffer-list))) ) (if (or (interactive-p) display-anyway) (message "%d buffers in this Emacs" buf-count)) buf-count)) ;;; end of buffer-misc.el (use-package hledger-mode :pin manual :after htmlize :load-path "packages/rest/hledger-mode/" :mode ("\\.journal\\'" "\\.hledger\\'") :commands hledger-enable-reporting :preface (defun hledger/next-entry () "Move to next entry and pulse." (interactive) (hledger-next-or-new-entry) (hledger-pulse-momentary-current-entry)) (defface hledger-warning-face '((((background dark)) :background "Red" :foreground "White") (((background light)) :background "Red" :foreground "White") (t :inverse-video t)) "Face for warning" :group 'hledger) (defun hledger/prev-entry () "Move to last entry and pulse." (interactive) (hledger-backward-entry) (hledger-pulse-momentary-current-entry)) :bind (("C-c j" . hledger-run-command) :map hledger-mode-map ("C-c e" . hledger-jentry) ("M-p" . hledger/prev-entry) ("M-n" . hledger/next-entry)) :init (setq hledger-jfile (expand-file-name "~/ola38/cuentasOLA38.ldg") hledger-email-secrets-file (expand-file-name "secrets.el" emacs-assets-directory)) ;; Expanded account balances in the overall monthly report are ;; mostly noise for me and do not convey any meaningful information. (setq hledger-show-expanded-report nil) (when (boundp 'my-hledger-service-fetch-url) (setq hledger-service-fetch-url my-hledger-service-fetch-url)) :config (add-hook 'hledger-view-mode-hook #'hl-line-mode) (add-hook 'hledger-view-mode-hook #'center-text-for-reading) (add-hook 'hledger-view-mode-hook (lambda () (run-with-timer 1 nil (lambda () (when (equal hledger-last-run-command "balancesheet") ;; highlight frequently changing accounts (highlight-regexp "^.*\\(savings\\|cash\\).*$") (highlight-regexp "^.*credit-card.*$" 'hledger-warning-face)))))) (add-hook 'hledger-mode-hook (lambda () (make-local-variable 'company-backends) (add-to-list 'company-backends 'hledger-company)))) (use-package hledger-input :pin manual :load-path "packages/rest/hledger-mode/" :bind (("C-c e" . hledger-capture) :map hledger-input-mode-map ("C-c C-b" . popup-balance-at-point)) :preface (defun popup-balance-at-point () "Show balance for account at point in a popup." (interactive) (if-let ((account (thing-at-point 'hledger-account))) (message (hledger-shell-command-to-string (format " balance -N %s " account))) (message "No account at point"))) :config (setq hledger-input-buffer-height 20) (add-hook 'hledger-input-post-commit-hook #'hledger-show-new-balances) (add-hook 'hledger-input-mode-hook #'auto-fill-mode) (add-hook 'hledger-input-mode-hook (lambda () (make-local-variable 'company-idle-delay) (setq-local company-idle-delay 0.1)))) ;; ====================== ;; ==== CALCULADORA ===== ;; ====================== (defun calcular-numero-original (valor porcentaje) "Calcula el número original dado un VALOR y su PORCENTAJE." (/ valor (/ porcentaje 100.0))) ;; (calcular-numero-original 16450000 3.5) (defun generate-chord-progression (root num-chords markov-weights) "Generate a random chord progression based on a ROOT note, NUM-CHORDS, and MARKOV-WEIGHTS. ROOT is the tonic of the progression (e.g., \"C\"). NUM-CHORDS specifies the number of chords to generate. MARKOV-WEIGHTS is an alist defining the probabilities of transitioning between chords. E.g., '((I . ((V . 50) (vi . 50))) (V . ((I . 40) (vi . 40) (IV . 20))))" (let* ((chord-sequence (list 'I)) ; Start with the tonic (I) (current-chord 'I)) (dotimes (_ (1- num-chords)) ; Generate remaining chords (let* ((transitions (alist-get current-chord markov-weights)) (next-chord (generate-next-chord transitions))) (push next-chord chord-sequence) (setq current-chord next-chord))) (mapcar (lambda (chord) (format "%s" (chord-to-symbol chord))) (nreverse chord-sequence)))) (defun generate-next-chord (transitions) "Randomly select the next chord based on TRANSITIONS weights." (let ((total-weight (apply '+ (mapcar 'cdr transitions))) (rand (random 100))) (cl-loop for (chord . weight) in transitions for cumulative-weight = (/ (* weight 100) total-weight) until (<= rand cumulative-weight) do (setq rand (- rand cumulative-weight)) finally return chord))) (defun chord-to-symbol (chord) "Convert a chord identifier (I, V, vi, etc.) to its Roman numeral string." (symbol-name chord)) ;; Example usage (setq markov-weights '((I . ((V . 50) (vi . 50))) (V . ((I . 40) (vi . 40) (IV . 20))) (vi . ((ii . 30) (IV . 70))) (IV . ((V . 60) (I . 40))) (ii . ((V . 100))))) (setq default-markov-weights '((I . ((V . 14) (vi . 14) (IV . 14) (ii . 14) (iii . 14) (VII . 14))) (V . ((I . 14) (vi . 14) (IV . 14) (ii . 14) (iii . 14) (VII . 14))) (vi . ((I . 14) (V . 14) (IV . 14) (ii . 14) (iii . 14) (VII . 14))) (IV . ((I . 14) (V . 14) (vi . 14) (ii . 14) (iii . 14) (VII . 14))) (ii . ((I . 14) (V . 14) (vi . 14) (IV . 14) (iii . 14) (VII . 14))) (iii . ((I . 14) (V . 14) (vi . 14) (IV . 14) (ii . 14) (VII . 14))) (VII . ((I . 14) (V . 14) (vi . 14) (IV . 14) (ii . 14) (iii . 14))))) (defun random-element-from-list (lst) "Select a random element from LST." (nth (random (length lst)) lst)) ;;(setq tonalities '("C" "C#" "D" "D#" "E" "F" "G" "A")) (setq tonalities '("C" "G" "D" "A" "E" "B" "F#" "C#" "F" "Bb" "Eb" "Ab" "Db" "Gb" "Cb")) (defun random-progression () (interactive) (let ((tone (random-element-from-list tonalities))) (print (cons tone (generate-chord-progression tone 4 default-markov-weights))))) (defun random-progression-to-file () (interactive) (let* ((tone (random-element-from-list tonalities)) (progression (generate-chord-progression tone 4 default-markov-weights)) (output (format "%s %s\n" tone (mapconcat #'identity progression " ")))) (with-temp-buffer (insert output) (append-to-file (point-min) (point-max) "~/SyncDocs/chord_progressions.txt")))) ;;(generate-chord-progression "C" 4 markov-weights)