You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

4169 lines
162 KiB

11 months ago
  1. (repeat-mode 1)
  2. (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.
  3. (setq shell-file-name "/home/ff/.guix-profile/bin/zsh") ;; permite asignar shell, impacta ledger-mode
  4. (setq inferior-lisp-program "/usr/bin/sbcl")
  5. (setq enable-recursive-minibuffers t)
  6. (setq visual-fill-column-width 80)
  7. (defun display-system-info ()
  8. (interactive)
  9. (let* ((disk-free (shell-command-to-string "df -h --output=avail /"))
  10. (ram-free (shell-command-to-string "free -h --si | awk '/Mem:/ {print $7}'"))
  11. (cpu-load (shell-command-to-string "top -bn1 | grep 'Cpu(s)' | awk '{print $2 + $4}'")))
  12. (message "Disk free:%s RAM free: %s Load: %s%%"
  13. (nth 1 (split-string disk-free "\n"))
  14. (string-trim ram-free)
  15. (string-trim cpu-load))))
  16. ;; Set the user's full name
  17. (setq user-full-name "dir..OLA38")
  18. ;; Set the user's email address
  19. (setq user-mail-address "directora.ola38@gmail.com")
  20. ;; from https://depp.brause.cc/dotemacs/
  21. (setq initial-scratch-message "")
  22. (setq initial-major-mode 'emacs-lisp-mode)
  23. (setq-default indent-tabs-mode nil)
  24. (setq frame-title-format
  25. '("" invocation-name ": " (:eval (replace-regexp-in-string
  26. "^ +" "" (buffer-name)))))
  27. (setq save-interprogram-paste-before-kill t)
  28. (setq recenter-positions '(top middle bottom))
  29. (setq bookmark-default-file "~/my_forest/t1_bookmarks.el")
  30. (setq use-short-answers t)
  31. (setq calculator-displayer '(std ?f t))
  32. ;; from mastering emacs
  33. ;; window manager
  34. (setq switch-to-buffer-obey-display-actions t)
  35. (setq circe-default-part-message "Leaving"
  36. circe-default-quit-message "Leaving")
  37. (setq lui-track-behavior 'before-switch-to-buffer)
  38. (setq circe-color-nicks-everywhere t)
  39. (setq circe-color-nicks-pool-type
  40. '("#ffaf00" "#d75f00" "#d70000" "#00af00"
  41. "#5f00ff" "#0087ff" "#ff005f" "#8700d7"))
  42. ;; test john wingley https://github.com/jwiegley/dot-emacs/blob/139bec7647d760beaac6bf5f62406bdfb1fff1ca/init.org#L7896
  43. (use-package emacs
  44. :custom-face
  45. (cursor ((t (:background "hotpink"))))
  46. (highlight ((t (:background "blue4"))))
  47. (minibuffer-prompt ((t (:foreground "grey80"))))
  48. (mode-line-inactive ((t (:background "gray20" :foreground "gray80"))))
  49. (nobreak-space ((t nil)))
  50. (variable-pitch ((t (:height 1.2 :family "Bookerly")))))
  51. ;; ====minibuffer
  52. (use-package vertico
  53. :ensure t
  54. :config
  55. (setq vertico-cycle t)
  56. (setq vertico-resize nil)
  57. (vertico-mode 1))
  58. (use-package orderless
  59. :ensure t
  60. :config
  61. (setq completion-styles '(orderless basic)))
  62. (use-package consult
  63. :ensure t
  64. :bind (;; A recursive grep
  65. ("M-s M-g" . consult-grep)
  66. ;; Search for files names recursively
  67. ("M-s M-f" . consult-find)
  68. ;; Search through the outline (headings) of the file
  69. ("M-s M-o" . consult-outline)
  70. ;; Search the current buffer
  71. ("M-s M-l" . consult-line)
  72. ;; Switch to another buffer, or bookmarked file, or recently
  73. ;; opened file.
  74. ("M-s M-b" . consult-buffer)))
  75. ;; Further reading: https://protesilaos.com/emacs/dotemacs#h:61863da4-8739-42ae-a30f-6e9d686e1995
  76. (use-package embark
  77. :ensure t
  78. :bind (("C-." . embark-act)
  79. :map minibuffer-local-map
  80. ("C-c C-c" . embark-collect)
  81. ("C-c C-e" . embark-export)))
  82. (setq prefix-help-command #'embark-prefix-help-command)
  83. ;; The `embark-consult' package is glue code to tie together `embark'
  84. ;; and `consult'.
  85. (use-package embark-consult
  86. :ensure t
  87. :hook
  88. (embark-collect-mode . consult-preview-at-point-mode))
  89. ;; The `wgrep' packages lets us edit the results of a grep search
  90. ;; while inside a `grep-mode' buffer. All we need is to toggle the
  91. ;; editable mode, make the changes, and then type C-c C-c to confirm
  92. ;; or C-c C-k to abort.
  93. ;;
  94. ;; Further reading: https://protesilaos.com/emacs/dotemacs#h:9a3581df-ab18-4266-815e-2edd7f7e4852
  95. (use-package wgrep
  96. :ensure t
  97. :bind ( :map grep-mode-map
  98. ("e" . wgrep-change-to-wgrep-mode)
  99. ("C-x C-q" . wgrep-change-to-wgrep-mode)
  100. ("C-c C-c" . wgrep-finish-edit)))
  101. ;; Example configuration for Consult
  102. (use-package consult
  103. ;; Replace bindings. Lazily loaded due by `use-package'.
  104. :bind (;; C-c bindings in `mode-specific-map'
  105. ("C-c M-x" . consult-mode-command)
  106. ("C-c h" . consult-history)
  107. ("C-c k" . consult-kmacro)
  108. ("C-c m" . consult-man)
  109. ("C-c i" . consult-info)
  110. ([remap Info-search] . consult-info)
  111. ;; C-x bindings in `ctl-x-map'
  112. ("C-x M-:" . consult-complex-command) ;; orig. repeat-complex-command
  113. ("C-x b" . consult-buffer) ;; orig. switch-to-buffer
  114. ("C-x 4 b" . consult-buffer-other-window) ;; orig. switch-to-buffer-other-window
  115. ("C-x 5 b" . consult-buffer-other-frame) ;; orig. switch-to-buffer-other-frame
  116. ("C-x t b" . consult-buffer-other-tab) ;; orig. switch-to-buffer-other-tab
  117. ("C-x r b" . consult-bookmark) ;; orig. bookmark-jump
  118. ("C-x p b" . consult-project-buffer) ;; orig. project-switch-to-buffer
  119. ;; Custom M-# bindings for fast register access
  120. ("M-#" . consult-register-load)
  121. ("M-'" . consult-register-store) ;; orig. abbrev-prefix-mark (unrelated)
  122. ("C-M-#" . consult-register)
  123. ;; Other custom bindings
  124. ("M-y" . consult-yank-pop) ;; orig. yank-pop
  125. ;; M-g bindings in `goto-map'
  126. ("M-g e" . consult-compile-error)
  127. ("M-g f" . consult-flymake) ;; Alternative: consult-flycheck
  128. ("M-g g" . consult-goto-line) ;; orig. goto-line
  129. ("M-g M-g" . consult-goto-line) ;; orig. goto-line
  130. ("M-g o" . consult-outline) ;; Alternative: consult-org-heading
  131. ("M-g m" . consult-mark)
  132. ("M-g k" . consult-global-mark)
  133. ("M-g i" . consult-imenu)
  134. ("M-g I" . consult-imenu-multi)
  135. ;; M-s bindings in `search-map'
  136. ("M-s d" . consult-find) ;; Alternative: consult-fd
  137. ("M-s c" . consult-locate)
  138. ("M-s g" . consult-grep)
  139. ("M-s G" . consult-git-grep)
  140. ("M-s r" . consult-ripgrep)
  141. ("M-s l" . consult-line)
  142. ("M-s L" . consult-line-multi)
  143. ("M-s k" . consult-keep-lines)
  144. ("M-s u" . consult-focus-lines)
  145. ;; Isearch integration
  146. ("M-s e" . consult-isearch-history)
  147. :map isearch-mode-map
  148. ("M-e" . consult-isearch-history) ;; orig. isearch-edit-string
  149. ("M-s e" . consult-isearch-history) ;; orig. isearch-edit-string
  150. ("M-s l" . consult-line) ;; needed by consult-line to detect isearch
  151. ("M-s L" . consult-line-multi) ;; needed by consult-line to detect isearch
  152. ;; Minibuffer history
  153. :map minibuffer-local-map
  154. ("M-s" . consult-history) ;; orig. next-matching-history-element
  155. ("M-r" . consult-history)) ;; orig. previous-matching-history-element
  156. ;; Enable automatic preview at point in the *Completions* buffer. This is
  157. ;; relevant when you use the default completion UI.
  158. :hook (completion-list-mode . consult-preview-at-point-mode)
  159. ;; The :init configuration is always executed (Not lazy)
  160. :init
  161. ;; Optionally configure the register formatting. This improves the register
  162. ;; preview for `consult-register', `consult-register-load',
  163. ;; `consult-register-store' and the Emacs built-ins.
  164. (setq register-preview-delay 0.5
  165. register-preview-function #'consult-register-format)
  166. ;; Optionally tweak the register preview window.
  167. ;; This adds thin lines, sorting and hides the mode line of the window.
  168. (advice-add #'register-preview :override #'consult-register-window)
  169. ;; Use Consult to select xref locations with preview
  170. (setq xref-show-xrefs-function #'consult-xref
  171. xref-show-definitions-function #'consult-xref)
  172. ;; Configure other variables and modes in the :config section,
  173. ;; after lazily loading the package.
  174. :config
  175. ;; Optionally configure preview. The default value
  176. ;; is 'any, such that any key triggers the preview.
  177. ;; (setq consult-preview-key 'any)
  178. ;; (setq consult-preview-key "M-.")
  179. ;; (setq consult-preview-key '("S-<down>" "S-<up>"))
  180. ;; For some commands and buffer sources it is useful to configure the
  181. ;; :preview-key on a per-command basis using the `consult-customize' macro.
  182. (consult-customize
  183. consult-theme :preview-key '(:debounce 0.2 any)
  184. consult-ripgrep consult-git-grep consult-grep
  185. consult-bookmark consult-recent-file consult-xref
  186. consult--source-bookmark consult--source-file-register
  187. consult--source-recent-file consult--source-project-recent-file
  188. ;; :preview-key "M-."
  189. :preview-key '(:debounce 0.4 any))
  190. ;; Optionally configure the narrowing key.
  191. ;; Both < and C-+ work reasonably well.
  192. (setq consult-narrow-key "<") ;; "C-+"
  193. ;; Optionally make narrowing help available in the minibuffer.
  194. ;; You may want to use `embark-prefix-help-command' or which-key instead.
  195. ;; (define-key consult-narrow-map (vconcat consult-narrow-key "?") #'consult-narrow-help)
  196. ;; By default `consult-project-function' uses `project-root' from project.el.
  197. ;; Optionally configure a different project root function.
  198. ;;;; 1. project.el (the default)
  199. ;; (setq consult-project-function #'consult--default-project--function)
  200. ;;;; 2. vc.el (vc-root-dir)
  201. ;; (setq consult-project-function (lambda (_) (vc-root-dir)))
  202. ;;;; 3. locate-dominating-file
  203. ;; (setq consult-project-function (lambda (_) (locate-dominating-file "." ".git")))
  204. ;;;; 4. projectile.el (projectile-project-root)
  205. ;; (autoload 'projectile-project-root "projectile")
  206. ;; (setq consult-project-function (lambda (_) (projectile-project-root)))
  207. ;;;; 5. No project support
  208. ;; (setq consult-project-function nil)
  209. )
  210. (use-package orderless
  211. :ensure t
  212. :custom
  213. (completion-styles '(orderless basic))
  214. (completion-category-overrides '((file (styles basic partial-completion)))))
  215. (setq completion-pcm-leading-wildcard t)
  216. ;; The built-in `savehist-mode' saves minibuffer histories. Vertico
  217. ;; can then use that information to put recently selected options at
  218. ;; the top.
  219. ;;
  220. ;; Further reading: https://protesilaos.com/emacs/dotemacs#h:25765797-27a5-431e-8aa4-cc890a6a913a
  221. ;; Persist history over Emacs restarts. Vertico sorts by history position.
  222. (use-package savehist
  223. :init
  224. (savehist-mode))
  225. ;; The built-in `recentf-mode' keeps track of recently visited files.
  226. ;; You can then access those through the `consult-buffer' interface or
  227. ;; with `recentf-open'/`recentf-open-files'.
  228. ;;
  229. ;; I do not use this facility, because the files I care about are
  230. ;; either in projects or are bookmarked.
  231. (recentf-mode 1)
  232. ;; ;; Enable rich annotations using the Marginalia package
  233. ;; (use-package marginalia
  234. ;; ;; Bind `marginalia-cycle' locally in the minibuffer. To make the binding
  235. ;; ;; available in the *Completions* buffer, add it to the
  236. ;; ;; `completion-list-mode-map'.
  237. ;; :bind (:map minibuffer-local-map
  238. ;; ("M-A" . marginalia-cycle))
  239. ;; ;; The :init section is always executed.
  240. ;; :init
  241. ;; ;; Marginalia must be activated in the :init section of use-package such that
  242. ;; ;; the mode gets enabled right away. Note that this forces loading the
  243. ;; ;; package.
  244. ;; (marginalia-mode))
  245. (use-package color-theme
  246. :no-require t
  247. :init
  248. (deftheme midnight
  249. "midnight theme")
  250. (custom-theme-set-faces
  251. 'midnight
  252. '(default ((t (:background "black" :foreground "grey85"))))
  253. '(mouse ((t (:foreground "grey85"))))
  254. '(cursor ((t (:background "grey85"))))
  255. '(font-lock-comment-face ((t (:italic t :foreground "grey60"))))
  256. '(font-lock-string-face ((t (:foreground "Magenta"))))
  257. '(font-lock-keyword-face ((t (:foreground "Cyan"))))
  258. '(font-lock-warning-face ((t (:bold t :foreground "Pink"))))
  259. '(font-lock-constant-face ((t (:foreground "OliveDrab"))))
  260. '(font-lock-type-face ((t (:foreground "DarkCyan"))))
  261. '(font-lock-variable-name-face ((t (:foreground "DarkGoldenrod"))))
  262. '(font-lock-function-name-face ((t (:foreground "SlateBlue"))))
  263. '(font-lock-builtin-face ((t (:foreground "SkyBlue"))))
  264. '(highline-face ((t (:background "grey12"))))
  265. '(setnu-line-number-face ((t (:background "Grey15" :foreground "White" :bold t))))
  266. '(show-paren-match-face ((t (:background "grey30"))))
  267. '(region ((t (:background "grey15"))))
  268. '(highlight ((t (:background "grey15"))))
  269. '(ledger-font-xact-highlight-face ((t (:background "grey12")))) ;; fix ledger background
  270. '(secondary-selection ((t (:background "navy"))))
  271. '(widget-field-face ((t (:background "navy"))))
  272. '(widget-single-line-field-face ((t (:background "royalblue")))))
  273. :config
  274. (enable-theme 'midnight))
  275. ;;(fix-mode-line)
  276. ;;;; === mail
  277. (load-library "sendmail") ;; se llama para no tener que iniciar (mail)
  278. ;; ;(setq smtpmail-stream-type 'ssl)
  279. ;; (setq smtpmail-smtp-server "smtp.gmail.com")
  280. ;; (setq smtpmail-smtp-service 465)
  281. ;; ===== BROWSER
  282. (defun my-qutebrowser-edit ()
  283. (markdown-mode)
  284. (auto-fill-mode -1)
  285. (setq require-final-newline nil))
  286. (add-to-list 'auto-mode-alist '("\\`/tmp/qutebrowser-editor-" . my-qutebrowser-edit))
  287. ;; ;; ====== EXWM
  288. ;; (desktop-save-mode 1)
  289. ;; (defun efs/exwm-update-class ()
  290. ;; (exwm-workspace-rename-buffer exwm-class-name))
  291. ;; (use-package exwm
  292. ;; :config
  293. ;; ;; Set the default number of workspaces
  294. ;; ;;(setq exwm-workspace-number 5)
  295. ;; ;; When window "class" updates, use it to set the buffer name
  296. ;; (add-hook 'exwm-update-class-hook #'efs/exwm-update-class)
  297. ;; ;; Rebind CapsLock to Ctrl
  298. ;; (start-process-shell-command "xmodmap" nil "xmodmap ~/.emacs.d/exwm/Xmodmap")
  299. ;; ;; Set the screen resolution (update this to be the correct resolution for your screen!)
  300. ;; (require 'exwm-randr)
  301. ;; (exwm-randr-enable)
  302. ;; ;; (start-process-shell-command "xrandr" nil "xrandr --output Virtual-1 --primary --mode 2048x1152 --pos 0x0 --rotate normal")
  303. ;; ;; Load the system tray before exwm-init
  304. ;; (require 'exwm-systemtray)
  305. ;; (exwm-systemtray-enable)
  306. ;; ;; These keys should always pass through to Emacs
  307. ;; (setq exwm-input-prefix-keys
  308. ;; '(?\C-x
  309. ;; ?\C-u
  310. ;; ;; ?\C-c
  311. ;; ?\C-h
  312. ;; ?\M-x
  313. ;; ?\M-`
  314. ;; ?\M-&
  315. ;; ?\M-:
  316. ;; ?\C-\M-j ;; Buffer list
  317. ;; ?\C-\ )) ;; Ctrl+Space
  318. ;; ;; Ctrl+Q will enable the next key to be sent directly
  319. ;; (define-key exwm-mode-map [?\C-q] 'exwm-input-send-next-key)
  320. ;; ;; Set up global key bindings. These always work, no matter the input state!
  321. ;; ;; Keep in mind that changing this list after EXWM initializes has no effect.
  322. ;; (setq exwm-input-global-keys
  323. ;; `(
  324. ;; ;; Reset to line-mode (C-c C-k switches to char-mode via exwm-input-release-keyboard)
  325. ;; ([?\s-r] . exwm-reset)
  326. ;; ;; Move between windows
  327. ;; ([s-left] . windmove-left)
  328. ;; ([s-right] . windmove-right)
  329. ;; ([s-up] . windmove-up)
  330. ;; ([s-down] . windmove-down)
  331. ;; ;; Launch applications via shell command
  332. ;; ([?\s-&] . (lambda (command)
  333. ;; (interactive (list (read-shell-command "$ ")))
  334. ;; (start-process-shell-command command nil command)))
  335. ;; ;; Switch workspace
  336. ;; ([?\s-w] . exwm-workspace-switch)
  337. ;; ([?\s-`] . (lambda () (interactive) (exwm-workspace-switch-create 0)))
  338. ;; ;; 's-N': Switch to certain workspace with Super (Win) plus a number key (0 - 9)
  339. ;; ,@(mapcar (lambda (i)
  340. ;; `(,(kbd (format "s-%d" i)) .
  341. ;; (lambda ()
  342. ;; (interactive)
  343. ;; (exwm-workspace-switch-create ,i))))
  344. ;; (number-sequence 0 9))))
  345. ;; (exwm-enable)
  346. ;; )
  347. ;; ==== WORKSPACES
  348. ;(beframe-mode 1)
  349. ;; This is the default value. Write here the names of buffers that
  350. ;; should not be beframed.
  351. ;(setq beframe-global-buffers '("*scratch*" "*Messages*" "*Backtrace*"))
  352. ;; Bind Beframe commands to a prefix key, such as C-c b:
  353. ;(define-key global-map (kbd "C-c b") beframe-prefix-map)
  354. ;; Remap CapsLock to Ctrl
  355. (start-process-shell-command "xmodmap" nil "xmodmap ~/.emacs.d/exwm/Xmodmap")
  356. (start-process-shell-command "setxkbmap" nil "setxkbmap -layout us -model pc105 -variant altgr-intl -option 'lalt:compose' -option ctrl:nocaps")
  357. (defun remap-keyboard ()
  358. "Permite reconfigurar el teclado luego de reconectarlo"
  359. (interactive)
  360. (start-process-shell-command "setxkbmap" nil "setxkbmap -layout us -model pc105 -variant altgr-intl -option 'lalt:compose' -option ctrl:nocaps"))
  361. (defun remap-keyboard-reset ()
  362. "Permite volver a la configuración inicial donde CAPS key funciona como mayuscula sostenida"
  363. (interactive)
  364. (start-process-shell-command "setxkbmap" nil "setxkbmap -layout us -option ''"))
  365. (start-process-shell-command "syncthing" nil "syncthing")
  366. ;; ===== TRANSLATE
  367. ;(require 'go-translate)
  368. ;(setq gts-translate-list '(("en" "es")))
  369. ;; (setq gts-default-translator (gts-translator :engines (gts-bing-engine)))
  370. ;; (setq gts-default-translator
  371. ;; (gts-translator
  372. ;; :picker (gts-prompt-picker)
  373. ;; :engines (list (gts-bing-engine) (gts-google-engine))
  374. ;; :render (gts-buffer-render)))
  375. ;; === BABEL
  376. ;; (org-babel-do-load-languages
  377. ;; 'org-babel-load-languages
  378. ;; '((emacs-lisp . t)
  379. ;; (ledger . t)
  380. ;; (sh . t)
  381. ;; (R . t)))
  382. ;; ;; === MAGIT
  383. (setq magit-repository-directories
  384. `(("~/Admin" . 2)
  385. ("~/Scripts" . 2)
  386. ("~/my_forest" . 2)))
  387. ;; (setq magit-repository-directories-depth 2)
  388. (setq magit-repolist-columns
  389. '(("Name" 25 magit-repolist-column-ident ())
  390. ("Version" 25 magit-repolist-column-version ())
  391. ;(;"D" 1 magit-repolist-column-dirty ())
  392. ("B<U" 3 magit-repolist-column-unpulled-from-upstream
  393. ((:right-align t)
  394. (:help-echo "Upstream changes not in branch")))
  395. ("B>U" 3 magit-repolist-column-unpushed-to-upstream
  396. ((:right-align t)
  397. (:help-echo "Local changes not in upstream")))
  398. ("Path" 99 magit-repolist-column-path ())))
  399. ;; (with-eval-after-load 'magit-repos
  400. ;; ;; Avoid destructively modifying a list literal.
  401. ;; (let ((cols (copy-sequence magit-repolist-columns)))
  402. ;; (push '("D" 1 magit-repolist-column-dirty ())
  403. ;; (nthcdr 2 cols))
  404. ;; (setq magit-repolist-columns cols)))
  405. ;; === MODE-LINE
  406. (defun fix-mode-line ()
  407. (interactive)
  408. (set-face-attribute 'mode-line nil
  409. :background "purple4"
  410. :foreground "green1"
  411. :box "dim gray")
  412. (set-face-attribute 'mode-line-inactive nil
  413. :background "black"
  414. :foreground "dim gray"
  415. :box "dim gray"))
  416. (setq display-time-format nil
  417. display-time-day-and-date t
  418. display-time-24hr-format t)
  419. ;;=== cosmetic
  420. (use-package spacious-padding
  421. :ensure t
  422. :custom
  423. (spacious-padding-subtle-mode-line t)
  424. :config
  425. (spacious-padding-mode 1))
  426. (spacious-padding--disable-mode)
  427. (defun insert-today-date ()
  428. "Insert today's date in YYYY/MM/DD format."
  429. (interactive)
  430. (insert (format-time-string "%Y/%m/%d")))
  431. (defun backup-file-with-datetime (file)
  432. "Backup the given FILE by copying it with a timestamp appended to the name."
  433. (interactive "fSelect file to backup: ")
  434. (let* ((current-time (format-time-string "%Y%m%d_%H%M%S"))
  435. (backup-file (concat (file-name-directory file)
  436. "_backup_"
  437. (file-name-base file)
  438. "__"
  439. current-time
  440. (file-name-extension file t))))
  441. (copy-file file backup-file)
  442. (message "Backup created: %s" backup-file)))
  443. (defun backup-cuentasOLA ()
  444. (interactive)
  445. (backup-file-with-datetime "/home/ff/backupAdmin/ola38-git/cuentasOLA38.ldg")
  446. (backup-file-with-datetime "/home/ff/backupAdmin/ola38-git/plan_de_cuentas.ldg"))
  447. (defun backup-personales ()
  448. (interactive)
  449. (backup-file-with-datetime "/home/ff/SyncDocs/capture.ldg")
  450. (backup-file-with-datetime "/home/ff/SyncDocs/FLC_informacion.ldg")
  451. (backup-file-with-datetime "/home/ff/SyncDocs/FLC_narracion.ldg"))
  452. (defun fix-ledger-theme ()
  453. (interactive)
  454. (custom-set-faces
  455. '(ledger-font-xact-highlight-face ((t :background "#000000")))
  456. '(ledger-font-posting-account-cleared-face ((t :foreground "dim gray")))
  457. '(ledger-font-posting-account-face ((t :foreground "LightSalmon1")))
  458. '(ledger-font-posting-amount-face ((t :foreground "gold1")))
  459. '(ledger-font-comment-face ((t :foreground "#FFFFFF")))))
  460. (defun reset-face-to-default (face)
  461. "Reset FACE to its default value."
  462. (custom-set-faces `(,face ((t (:inherit nil)))))
  463. (custom-reevaluate-setting face))
  464. ;; Example usage:
  465. (defun reset-ledger-faces-to-default ()
  466. (interactive)
  467. (progn
  468. (reset-face-to-default 'ledger-font-xact-highlight-face)
  469. (reset-face-to-default 'ledger-font-comment-face)
  470. (reset-face-to-default 'ledger-font-payee-uncleared-face)
  471. (reset-face-to-default 'ledger-font-posting-account-face)
  472. (reset-face-to-default 'ledger-font-posting-amount-face)
  473. (reset-face-to-default 'region)))
  474. (defun faceinfo ()
  475. "Consulta la /face/ seleccionada"
  476. (interactive)
  477. (describe-face (face-at-point)))
  478. (defun ledger-faces-random ()
  479. (interactive)
  480. (assign-random-color-to-faces '(ledger-font-comment-face
  481. ledger-font-payee-uncleared-face
  482. ledger-font-posting-account-face
  483. ledger-font-posting-amount-face)))
  484. (defun theme-faces-random ()
  485. (interactive)
  486. (assign-random-color-to-faces '(font-lock-keyword-face
  487. font-lock-string-face
  488. font-lock-function-name-face
  489. font-lock-comment-face)))
  490. ;; Example usage
  491. ;;(assign-random-color-to-faces '(ledger-font-comment-face another-face yet-another-face))
  492. (defun fix-ledger-theme-disable ()
  493. (interactive)
  494. (custom-set-faces
  495. '(ledger-font-xact-highlight-face (( )))))
  496. ;; (modus-themes-with-colors
  497. ;; (set-face-attribute 'mode-line nil
  498. ;; :background bg-sage
  499. ;; :foreground fg-main
  500. ;; :box green-cooler))
  501. (defun query-theme ()
  502. "Reporta el nombre del tema de algunos temas ¿porquéa algunos
  503. temas no reprtan el nombre?"
  504. (interactive)
  505. (print (mapconcat 'symbol-name custom-enabled-themes "")))
  506. (defun deface ()
  507. "Regresa el tamaño de la letra luego de haber sido modificada por algún tema"
  508. (interactive)
  509. (set-face-attribute 'default nil :height 100))
  510. (defun fix-theme()
  511. "no funciona"
  512. (interactive)
  513. (custom-theme-set-faces
  514. (mapconcat 'symbol-name custom-enabled-themes "")
  515. '(font-lock-string-face ((t (:bold t :background "black" :foreground "seagreen" :weight semi-bold))))))
  516. ;; ==== Windows
  517. (setq switch-to-buffer-in-dedicated-window "pop")
  518. (defun mp-toggle-window-dedication ()
  519. "Toggles window dedication in the selected window."
  520. (interactive)
  521. (set-window-dedicated-p (selected-window)
  522. (not (window-dedicated-p (selected-window)))))
  523. ;; Push and pop window configurations (from J.wingley)
  524. (defvar saved-window-configuration nil)
  525. (defun push-window-configuration ()
  526. (interactive)
  527. (push (current-window-configuration) saved-window-configuration))
  528. (defun pop-window-configuration ()
  529. (interactive)
  530. (let ((config (pop saved-window-configuration)))
  531. (if config
  532. (set-window-configuration config)
  533. (if (> (length (window-list)) 1)
  534. (delete-window)
  535. (bury-buffer)))))
  536. ;; Window rules from https://protesilaos.com/codelog/2024-02-08-emacs-window-rules-display-buffer-alist/
  537. (setq display-buffer-alist
  538. '(
  539. ("\\*Ledger Report\\*"
  540. (display-buffer-reuse-window
  541. display-buffer-in-direction)
  542. (direction . left))
  543. ;; ("\\.ldg"
  544. ;; (display-buffer-reuse-window))
  545. ("\\*Libera Chat\\*"
  546. (display-buffer-reuse-window
  547. display-buffer-in-direction)
  548. (direction . left))
  549. ("\\*Occur\\*"
  550. (display-buffer-reuse-window
  551. display-buffer-below-selected)
  552. ;; (dedicated . t)
  553. (window-height . fit-window-to-buffer))
  554. ("\\*EMMS-TAGS\\*"
  555. (display-buffer-same-window))
  556. ))
  557. ;;(setq display-buffer-alist nil) ;; panic
  558. ;; === EMMS
  559. (emms-all)
  560. (require 'emms-setup)
  561. (require 'emms-mark)
  562. (require 'emms-history)
  563. (require 'emms-volume)
  564. ;(emms-history-load)
  565. ;;(setq emms-history-start-playing nil) ;; queremos escuchar cuando se cargue el historial
  566. (setq emms-playlist-buffer-name "*Music*")
  567. ;;(require 'emms-player-simple)
  568. (require 'emms-source-file)
  569. (require 'emms-source-playlist)
  570. (emms-default-players)
  571. (setq emms-player-list '(emms-player-mpg123
  572. emms-player-ogg123
  573. emms-player-vlc
  574. emms-player-mplayer))
  575. (require 'emms-player-simple)
  576. (define-emms-simple-player chuck '(file) "\\.ck$" "chuck")
  577. (define-emms-simple-player mpg123 '(file url)
  578. (emms-player-simple-regexp "mp3" "mp2")
  579. "mpg321")
  580. ;; ;; Define the ffplay player
  581. ;; (emms-player-set emms-player-ffplay 'regex "\\.\\(mp3\\|wav\\|flac\\|ogg\\|mp4\\|mkv\\)$")
  582. ;; (setq emms-player-ffplay-command-name "ffplay")
  583. ;; (setq emms-player-ffplay-parameters '("-nodisp" "-autoexit"))
  584. ;; ;; Add ffplay player to the list of available players in EMMS
  585. ;; (add-to-list 'emms-player-list 'emms-player-ffplay)
  586. ;; (require 'emms-player)
  587. ;; (define-emms-player "emms-chuck-remote"
  588. ;; :start 'emms-chuck-remote-start
  589. ;; :stop 'emms-chuck-remote-stop
  590. ;; :playablep 'emms-chuck-remote-playable-p)
  591. ;; (defun emms-chuck-remote-start ()
  592. ;; (unless (get-process ``chuck-remote'')
  593. ;; (setq emms-chuck-remote-process
  594. ;; (start-process "chuck-remote-process"
  595. ;; "*chuck*" "chuck" "-R" "abc"))
  596. ;; (process-send-string "chuck-remote-process"
  597. ;; (concat "l " (emms-track-name track)))
  598. ;; (set-process-filter emms-chuck-remote-process 'emms-chuck-remote-filter)))
  599. (defun set-global-key-bindings (bindings)
  600. "Set multiple global key bindings from a list of (key . command) pairs."
  601. (dolist (binding bindings)
  602. (global-set-key (kbd (car binding)) (cdr binding))))
  603. (set-global-key-bindings
  604. '(("C-c a" . windmove-left)
  605. ("C-z" . nil) ;; frame suspend
  606. ("C-v" . nil) ;; scroll down
  607. ("C-s" . swiper)
  608. ("M-/" . dabbrev-expand)
  609. ("<f1>" . tareas-layout)
  610. ("<f2>" . mail-layout)
  611. ("<f3>" . browser-layout)
  612. ("<f4>" . config-layout)
  613. ("<f5>" . dired-layout)
  614. ("<f6>" . ii)
  615. ("<f7>" . oo)
  616. ("<f8>" . capture-to-ledger)
  617. ("<f9>" . capture-alc-layout)
  618. ("<f10>" . cartera-layout)
  619. ("<f11>" . correo-layout)
  620. ("<f12>" . tareas-layout)
  621. ("C-c f b" . backward--invert-currency)
  622. ("C-c f t" . random-theme)
  623. ("C-c f r" . reposition-time-value)
  624. ("C-c f i" . (lambda () (interactive) (ledger-report "REG zettelkasten index" nil)))
  625. ("C-c f a" . (lambda () (interactive) (ledger-report "todo newline test" nil)))
  626. ("C-c w b" . balance-windows)
  627. ("C-c w ]" . (lambda () (interactive) (enlarge-window-horizontally 30)))
  628. ("C-c w [" . (lambda () (interactive) (shrink-window-horizontally 30)))
  629. ("C-c s a" . emms-add-file)
  630. ("C-c s f" . emms-add-dired)
  631. ("C-c s g" . emms-playlist-mode-go)
  632. ("C-c s m" . emms-mark-all)
  633. ("C-c s n" . emms-next)
  634. ("C-c s p" . emms-pause)
  635. ("C-c s t" . emms-mark-track)
  636. ("C-c s r" . emms-random)
  637. ("C-c s =" . emms-volume-raise)
  638. ("C-c s -" . emms-volume-lower)
  639. ("<XF86AudioPrev>" . emms-previous)
  640. ("<XF86AudioNext>" . emms-next)
  641. ("<XF86AudioPlay>" . emms-pause)
  642. ("<pause>" . emms-pause)
  643. ("<XF86PrtScn>" . emms-smart-browse)
  644. ("<Scroll_Lock>" . emms-next)
  645. ("<XF86Calculator>" . emms-playlist-mode-go)
  646. ))
  647. ;; Keyboard shortcuts
  648. (global-set-key (kbd "<XF86AudioPrev>") 'emms-previous)
  649. (global-set-key (kbd "<XF86AudioNext>") 'emms-next)
  650. (global-set-key (kbd "<XF86AudioPlay>") 'emms-pause)
  651. (global-set-key (kbd "<pause>") 'emms-pause)
  652. ;;(global-set-key (kbd "<XF86PrtScn>") 'emms-smart-browse)
  653. (global-set-key (kbd "<Scroll_Lock>") 'emms-next)
  654. (global-set-key (kbd "<XF86Calculator>") 'emms-playlist-mode-go)
  655. ;; ;; Define custom keybindings for various groups
  656. ;; (dolist (binding '((("C-c f b" . backward--invert-currency)
  657. ;; ("C-c f t" . random-theme)
  658. ;; ("C-c f r" . reposition-time-value)
  659. ;; ("C-c f i" . (lambda () (interactive) (ledger-report "REG zettelkasten index" nil)))
  660. ;; ("C-c f a" . (lambda () (interactive) (ledger-report "todo newline test" nil))))
  661. ;; (("C-c w b" . balance-windows)
  662. ;; ("C-c w ]" . (lambda () (interactive) (enlarge-window-horizontally 30)))
  663. ;; ("C-c w [" . (lambda () (interactive) (shrink-window-horizontally 30))))
  664. ;; (("C-c s a" . emms-add-file)
  665. ;; ("C-c s f" . emms-add-dired)
  666. ;; ("C-c s g" . emms-playlist-mode-go)
  667. ;; ("C-c s m" . emms-mark-all)
  668. ;; ("C-c s n" . emms-next)
  669. ;; ("C-c s p" . emms-pause)
  670. ;; ("C-c s t" . emms-mark-track)
  671. ;; ("C-c s r" . emms-random)
  672. ;; ("C-c s =" . emms-volume-raise)
  673. ;; ("C-c s -" . emms-volume-lower))))
  674. ;; (dolist (pair binding)
  675. ;; (global-set-key (kbd (car pair)) (cdr pair))))
  676. ;; (dolist (keys '(("C-c s o" 'scratch-buffer)))
  677. ;; (global-set-key '(kbd (car keys)) (cadr keys)))
  678. ;; (dolist (binding '((?a . emms-add-file)
  679. ;; (?f . emms-add-dired)
  680. ;; (?g . emms-playlist-mode-go)
  681. ;; (?m . emms-mark-all)
  682. ;; (?n . emms-next)
  683. ;; (?p . emms-pause)
  684. ;; (?t . emms-mark-track)
  685. ;; (?r . emms-random)
  686. ;; (?= . emms-volume-raise)
  687. ;; (?- . emms-volume-lower)))
  688. ;; (global-set-key (kbd (concat "C-c s " (char-to-string (car binding)))) (cdr binding)))
  689. (dolist (reg-file '((?e "~/.emacs")
  690. (?t "~/ola38/tareasAlc.ldg")
  691. (?c "~/SyncDocs/capture.ldg")
  692. (?u "~/my_forest/emacs_utilities.el")
  693. (?i "~/SyncDocs/ALC_informe.el")
  694. (?p "~/my_forest/panel_federico.el")
  695. (?n "~/SyncDocs/orgzly/notes.md")))
  696. (set-register (car reg-file) (cons 'file (cadr reg-file))))
  697. ;; (defun bookmark-store (name bookmark no-overwrite)
  698. ;; "Store a bookmark named NAME with data BOOKMARK.
  699. ;; If NO-OVERWRITE is non-nil, do not overwrite an existing bookmark with the same NAME."
  700. ;; (require 'bookmark) ;; Asegura que el sistema de bookmarks esté cargado
  701. ;; (let ((existing-bookmark (bookmark-get-bookmark name t)))
  702. ;; (when (and existing-bookmark no-overwrite)
  703. ;; (error "Bookmark \"%s\" already exists and NO-OVERWRITE is set" name)))
  704. ;; ;; Añadir la nueva definición a la lista de bookmarks
  705. ;; (setq bookmark-alist
  706. ;; (cons (cons 'name name bookmark)
  707. ;; (assq-delete-all name bookmark-alist)))
  708. ;; (bookmark-maybe-save-bookmark) ;; Guarda automáticamente la lista de bookmarks
  709. ;; (message "Bookmark \"%s\" stored successfully." name))
  710. ;; (defun set-predefined-bookmark (name file position)
  711. ;; "Set a bookmark with NAME at POSITION in FILE."
  712. ;; (let ((bookmark `((filename . ,file)
  713. ;; (position . ,position)
  714. ;; (name . ,name)
  715. ;; (front-context-string . "")
  716. ;; (rear-context-string . ""))))
  717. ;; (bookmark-store name bookmark nil)))
  718. ;; ;; Lista de bookmarks predefinidos
  719. ;; (dolist (bookmark
  720. ;; '(("plan_de_cuentas" "~/ola38/plan_de_cuentas.ldg" 100)
  721. ;; ("agenda" "~/SyncDocs/orgzly/notes.md" 3)
  722. ;; ("todo" "~/my_forest/panel_federico.el" 100)
  723. ;; ("ediff_cuentasOLA38" "~/my_forest/panel_federico.el" 100)
  724. ;; ("informe_ALC" "~/my_forest/panel_federico.el" 100)
  725. ;; ("informe_FALopez" "~/my_forest/panel_federico.el" 292)
  726. ;; ("set_bookmarks" "~/my_forest/emacs_utilities.el" 835)))
  727. ;; (apply 'set-predefined-bookmark bookmark))
  728. ;; (bookmark-set "plan_de_cuentas" "~/ola38/plan_de_cuentas.ldg" 100)
  729. (defun show-circle-of-fifths ()
  730. "Display the Circle of Fifths with major/minor keys, alterations, and their names."
  731. (interactive)
  732. (let ((buffer-name "*Circle of Fifths*")
  733. (keys '("C" "G" "D" "A" "E" "B" "F#" "C#" "F" "Bb" "Eb" "Ab" "Db" "Gb" "Cb"))
  734. (alterations '((0 "Natural")
  735. (+1 "F#")
  736. (+2 "F#, C#")
  737. (+3 "F#, C#, G#")
  738. (+4 "F#, C#, G#, D#")
  739. (+5 "F#, C#, G#, D#, A#")
  740. (+6 "F#, C#, G#, D#, A#, E#")
  741. (+7 "F#, C#, G#, D#, A#, E#, B#")
  742. (-1 "Bb")
  743. (-2 "Bb, Eb")
  744. (-3 "Bb, Eb, Ab")
  745. (-4 "Bb, Eb, Ab, Db")
  746. (-5 "Bb, Eb, Ab, Db, Gb")
  747. (-6 "Bb, Eb, Ab, Db, Gb, Cb")
  748. (-7 "Bb, Eb, Ab, Db, Gb, Cb, Fb")))
  749. ;; Adjust minor key mapping
  750. (minor-relative '("am" "em" "bm" "f#m" "c#m" "g#m" "d#m"
  751. "bbm" "fm" "cm" "gm" "dm")))
  752. ;; Create and switch to the buffer
  753. (with-current-buffer (get-buffer-create buffer-name)
  754. (erase-buffer)
  755. (insert "Circle of Fifths\n")
  756. (insert (make-string 50 ?=) "\n\n")
  757. ;; Insert Major Keys
  758. (insert (propertize "Major Keys:\n" 'face '(:weight bold :underline t)))
  759. (dotimes (i (length keys))
  760. (let* ((key (nth i keys))
  761. (alteration (nth i alterations))
  762. (count (car alteration))
  763. (names (cadr alteration)))
  764. (insert (format "%-4s: %-15s %s\n"
  765. key
  766. (format "%d %s" count (if (> count 0) "sharp(s)" "flat(s)"))
  767. (if names (concat "(" names ")") "")))))
  768. (insert "\n")
  769. ;; Insert Minor Keys
  770. (insert (propertize "Minor Keys (Relative):\n" 'face '(:weight bold :underline t)))
  771. (dotimes (i (length keys))
  772. (let* ((minor-key (nth i minor-relative))
  773. (alteration (nth i alterations))
  774. (count (car alteration))
  775. (names (cadr alteration)))
  776. (insert (format "%-4s: %-15s %s\n"
  777. minor-key
  778. (format "%d %s" count (if (> count 0) "sharp(s)" "flat(s)"))
  779. (if names (concat "(" names ")") ""))))))
  780. ;; Display buffer
  781. (display-buffer buffer-name)))
  782. ;; probamos la persistencia de los registros con
  783. (setopt savehist-additional-variables '(register-alist))
  784. ;; alternativa para guardar registros y recuperarlos
  785. (defun save-registers-to-file ()
  786. "Save registers to a file"
  787. (interactive)
  788. (with-temp-file "~/.emacs.d/registers.el"
  789. (prin1 register-alist (current-buffer))))
  790. (defun load-registers-from-file ()
  791. "Load registers from the file at startup"
  792. (interactive)
  793. (with-temp-buffer
  794. (insert-file-contents "~/.emacs.d/registers.el")
  795. (setq register-alist (read (current-buffer)))))
  796. ;; If you want `switch-to-buffer' and related to respect those rules
  797. ;; (I personally do not want this, because if I am switching to a
  798. ;; specific buffer in the current window, I probably have a good
  799. ;; reason for it):
  800. (setq switch-to-buffer-obey-display-actions t)
  801. ;; If you are in a window that is dedicated to its buffer and try to
  802. ;; `switch-to-buffer' there, tell Emacs to pop a new window instead of
  803. ;; using the current one:
  804. (setq switch-to-buffer-in-dedicated-window 'pop)
  805. ;; Other relevant variables which control when Emacs splits the frame
  806. ;; vertically or horizontally, with some sample values (do `M-x
  807. ;; describe-variable' and search for those variables to learn more
  808. ;; about them):
  809. (setq split-height-threshold 80)
  810. (setq split-width-threshold 125)
  811. ;;### ivy
  812. (setq ivy-use-virtual-buffers t)
  813. (setq ivy-count-format "(%d/%d) ")
  814. ;; ===== THEMES CUSTOMIZATION
  815. ;;(set-face-attribute 'ledger-font-xact-highlight-face nil :background "#001")
  816. (setq robin-hood-theme-region '(bg-only no-extend))
  817. ;;https://protesilaos.com/emacs/modus-themes#h:c8605d37-66e1-42aa-986e-d7514c3af6fe
  818. ;; Blue background, neutral foreground, intense blue border
  819. (setq modus-themes-common-palette-overrides
  820. '((bg-mode-line-active bg-blue-subtle)
  821. (fg-mode-line-active fg-main)
  822. (border-mode-line-active unspecifier)
  823. (bg-region bg-sage) ; try to replace `bg-ochre' with `bg-lavender', `bg-sage'
  824. (fg-region unspecified)))
  825. ;; ==== LOAD THEME
  826. (add-to-list 'custom-theme-load-path "~/my_forest/")
  827. ;;(load-theme 'modus-vivendi-deuteranopia t)
  828. ;;(load-theme 'doom-meltbus t)
  829. ;;(load-theme 'doom-rouge t)
  830. ;;(load-theme 'dark-laptop t)
  831. ;; ef-duo-dark inicia con borde blanco?
  832. ;; (use-package ef-themes
  833. ;; :ensure t
  834. ;; :config
  835. ;; (load-theme 'wheatgrass t))
  836. ;;(load-theme 'black t)
  837. ;; Do not extend `region' background past the end of the line.
  838. (custom-set-faces
  839. '(region ((t :extend nil))))
  840. ;;;; FONTS / FACES
  841. (defun jmi/set-buffer-local-family (font-family)
  842. "Sets font in current buffer"
  843. (interactive "sFont Family: ")
  844. (defface tmp-buffer-local-face
  845. '((t :family font-family))
  846. "Temporary buffer-local face")
  847. (buffer-face-set 'tmp-buffer-local-face))
  848. ;; == test
  849. ;;(face-remap-add-relative 'ledger-font-xact-highlight-face 'Info-quoted)
  850. ;;(set-face-background 'default "#001")
  851. ;;(set-face-attribute 'ledger-font-xact-highlight-face nil :background "#001")
  852. ;; (set-face-attribute 'ledger-font-payee-uncleared-face nil :foreground "honeydew3")
  853. ;; (set-face-attribute 'ledger-font-posting-account-face nil :foreground "LightGoldenrod")
  854. ;; (set-face-attribute 'ledger-font-posting-account-cleared-face nil :foreground "DarkOliveGreen")
  855. ;; ===== GPG
  856. (setq auth-source-debug t)
  857. (setq epg-gpg-program "gpg2")
  858. ;; modes for file extension ====================
  859. (add-to-list 'auto-mode-alist '("\\.ldg\\'" . ledger-mode))
  860. (add-to-list 'auto-mode-alist '("\\.dat\\'" . ledger-mode))
  861. (add-to-list 'auto-mode-alist '("\\.ck\\'" . chuck-mode))
  862. ;; acces to ledger reports
  863. ;; (defun todo ()
  864. ;; (interactive)
  865. ;; (ledger-report "todo newline test" nil))
  866. ;; === visual fill column
  867. (setq visual-fill-column-width 110
  868. visual-fill-column-center-text t)
  869. ;; ==== KEYS
  870. ;;(define-key mrepl-mode (kbd ",") nil)
  871. ;;(global-set-key (kbd "," ) nil) ;; REPL excecute command
  872. (global-set-key (kbd "C-c a") 'windmove-left)
  873. (global-set-key (kbd "C-z" ) nil) ;; frame suspend
  874. (global-set-key (kbd "C-v" ) nil) ;; scrol down
  875. (global-set-key (kbd "C-z" ) nil) ;; frame suspend
  876. (global-set-key (kbd "C-s" ) 'swiper)
  877. ;(global-set-key (kbd "<f1>") 'config-layout)
  878. (global-set-key (kbd "<f1>") 'tareas-layout)
  879. (global-set-key (kbd "<f2>") 'mail-layout)
  880. (global-set-key (kbd "<f3>") 'browser-layout)
  881. (global-set-key (kbd "<f4>") 'config-layout)
  882. (global-set-key (kbd "<f5>") 'dired-layout)
  883. (global-set-key (kbd "<f6>") 'ii)
  884. (global-set-key (kbd "<f7>") 'oo)
  885. (global-set-key (kbd "<f8>") 'capture-to-ledger)
  886. (global-set-key (kbd "<f9>") 'capture-alc-layout)
  887. (global-set-key (kbd "<f10>") 'cartera-layout)
  888. (global-set-key (kbd "<f11>") 'correo-layout)
  889. (global-set-key (kbd "<f12>") 'tareas-layout)
  890. (global-set-key (kbd "M-/") 'dabbrev-expand)
  891. ;; ===== LINE NUMBERS
  892. (global-display-line-numbers-mode 1)
  893. (setq display-line-numbers-type 'relative)
  894. (setq ledger-report-auto-refresh-sticky-cursor t) ;; keep cursor when refresh
  895. ;; Disable line numbers for some modes
  896. (dolist (mode '(org-mode-hook
  897. text-mode-hook
  898. term-mode-hook
  899. shell-mode-hook
  900. treemacs-mode-hook
  901. eshell-mode-hook))
  902. (add-hook mode (lambda () (display-line-numbers-mode 0))))
  903. ;; === hooks ===
  904. (add-hook 'ledger-report-mode-hook 'toggle-word-wrap 1)
  905. ;;(add-hook 'ledger-report-mode-hook 'visual-fill-column-mode nil)
  906. (add-hook 'ledger-report-mode-hook 'visual-line-mode nil)
  907. (add-hook 'ledger-report-mode-hook 'display-line-numbers-mode 1)
  908. (add-hook 'ledger-mode-hook 'display-line-numbers-mode 1)
  909. ;; audio inits
  910. ;;(require 'pulseaudio-control)
  911. ;;(pulseaudio-control-default-keybindings)
  912. (defun my/update-lines (bunches pos keep)
  913. (cl-loop with dec = (if keep 0 1)
  914. for line being the hash-key of bunches
  915. using (hash-value positions) do
  916. (puthash
  917. line
  918. (cl-loop for p in positions
  919. if (< p pos) collect p
  920. else if (> p pos) collect (- p dec))
  921. bunches)))
  922. (defun my/suggest-delete-line (line)
  923. (let ((len (length line)))
  924. (move-overlay selection (point) (+ (point) len))
  925. (let* ((inhibit-quit t)
  926. (answer
  927. (with-local-quit
  928. (read-key
  929. (format "Delete '%s%s'? [y]es/[n]o"
  930. (substring line 0 (min len 13))
  931. (cond
  932. ((> len 16) "...")
  933. ((> len 13) (substring line 13 len))
  934. (t "")))))))
  935. (when (= answer ?y)
  936. (delete-region
  937. (point)
  938. (progn
  939. (move-end-of-line 1)
  940. (forward-char)
  941. (point))))
  942. answer)))
  943. (defun my/delete-duplicate-lines (beg end)
  944. "peligro borra el original"
  945. (interactive
  946. (if (region-active-p)
  947. (list (region-beginning) (region-end))
  948. (list (point-min) (point-max))))
  949. (let ((ignore-white (< (prefix-numeric-value current-prefix-arg) 1))
  950. (ignore-blank (< (prefix-numeric-value current-prefix-arg) 4))
  951. (bunches (make-hash-table :test 'equal))
  952. (selection (make-overlay 1 1)))
  953. (overlay-put selection 'face 'secondary-selection)
  954. (save-excursion
  955. (goto-char beg)
  956. (move-beginning-of-line 1)
  957. (cl-loop for lnum = (count-lines (point-min) beg)
  958. then (1+ lnum)
  959. for line = (buffer-substring-no-properties
  960. (point)
  961. (progn
  962. (move-end-of-line 1)
  963. (point)))
  964. while (< (point) end) do
  965. (forward-char)
  966. (unless
  967. (or (and (string-match "[ \t]+" line) ignore-white)
  968. (and (string-match "^$" line) ignore-blank))
  969. (puthash line (cons lnum (gethash line bunches)) bunches))))
  970. (cl-loop for line being the hash-key of bunches
  971. using (hash-value positions)
  972. unless (cdr positions) do
  973. (remhash line bunches))
  974. (cl-loop named :outer for line being the hash-key of bunches do
  975. (cl-loop for positions = (gethash line bunches)
  976. while positions do
  977. (cl-loop with continue = t
  978. for pos in positions
  979. while continue do
  980. (goto-char (point-min))
  981. (forward-line pos)
  982. (recenter)
  983. (cl-case (my/suggest-delete-line line)
  984. (?\C-g (cl-return-from :outer))
  985. (?y)
  986. (otherwise (setf continue nil)))
  987. (my/update-lines bunches pos continue))))
  988. (delete-overlay selection)))
  989. (defun uniquify-all-lines-region (start end)
  990. "Find duplicate lines in region START to END keeping first occurrence."
  991. (interactive "*r")
  992. (save-excursion
  993. (let ((end (copy-marker end)))
  994. (while
  995. (progn
  996. (goto-char start)
  997. (re-search-forward "^\\(.*\\)\n\\(\\(.*\n\\)*\\)\\1\n" end t))
  998. (replace-match "\\1\n\\2")))))
  999. (defun uniquify-all-lines-buffer ()
  1000. "Delete duplicate lines in buffer and keep first occurrence."
  1001. (interactive "*")
  1002. (uniquify-all-lines-region (point-min) (point-max)))
  1003. (defun find-and-remove-duplicate-lines-old ()
  1004. "Search for duplicate lines in the current buffer and ask for removal."
  1005. (interactive)
  1006. (let ((line-hash (make-hash-table :test 'equal))
  1007. (current-line "")
  1008. (line-number 1))
  1009. (goto-char (point-min))
  1010. ;; Iterate through each line in the buffer
  1011. (while (not (eobp))
  1012. (setq current-line (buffer-substring-no-properties
  1013. (line-beginning-position)
  1014. (line-end-position)))
  1015. (if (gethash current-line line-hash)
  1016. ;; If the line already exists in the hash table, ask for deletion
  1017. (when (y-or-n-p (format "Duplicate line found at line %d: \"%s\". Delete? "
  1018. line-number current-line))
  1019. (delete-region (line-beginning-position) (1+ (line-end-position))))
  1020. ;; Otherwise, add the line to the hash table
  1021. (puthash current-line t line-hash))
  1022. (setq line-number (1+ line-number))
  1023. (forward-line 1))
  1024. (message "Duplicate check completed.")))
  1025. (defun find-and-remove-duplicate-lines (&optional allow-empty-lines)
  1026. "C-u M-x find-and ... Search for duplicate lines in the current buffer and ask for removal.
  1027. If ALLOW-EMPTY-LINES is non-nil, white (empty) lines are ignored during duplicate detection."
  1028. (interactive "P")
  1029. (let ((line-hash (make-hash-table :test 'equal))
  1030. (current-line "")
  1031. (line-number 1))
  1032. (goto-char (point-min))
  1033. ;; Iterate through each line in the buffer
  1034. (while (not (eobp))
  1035. (setq current-line (buffer-substring-no-properties
  1036. (line-beginning-position)
  1037. (line-end-position)))
  1038. ;; Skip empty lines if allow-empty-lines is true
  1039. (unless (and allow-empty-lines
  1040. (string-match-p "^\\s-*$" current-line))
  1041. (if (gethash current-line line-hash)
  1042. ;; If the line already exists in the hash table, ask for deletion
  1043. (when (y-or-n-p (format "Duplicate line found at line %d: \"%s\". Delete? "
  1044. line-number current-line))
  1045. (delete-region (line-beginning-position) (1+ (line-end-position))))
  1046. ;; Otherwise, add the line to the hash table
  1047. (puthash current-line t line-hash)))
  1048. (setq line-number (1+ line-number))
  1049. (forward-line 1))
  1050. (message "Duplicate check completed.")))
  1051. ;; 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.
  1052. ;; 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
  1053. (defun corr (atribute)
  1054. (when (atribute ola38)
  1055. path "~/Dropbox/ALC/"
  1056. path2 "~/ola38/pagos_OLA38.ldg")
  1057. (when (atribute pNatural)
  1058. path "~/Dropbox/pNatural/"
  1059. path2 "~/Admin/cuentas.ldg"))
  1060. (defun mail-at-point()
  1061. "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"
  1062. (interactive)
  1063. (let ((current-mode major-mode))
  1064. (unwind-protect
  1065. (emacs-lisp-mode)
  1066. (let ((string (thing-at-point 'symbol)))
  1067. (kill-new string)))
  1068. (funcall current-mode)))
  1069. (defun remove-consecutive-empty-lines ()
  1070. "Remove consecutive empty lines in the current buffer."
  1071. (interactive)
  1072. (save-excursion
  1073. (goto-char (point-min))
  1074. (while (re-search-forward "\n\n\n+" nil t)
  1075. (replace-match "\n\n"))))
  1076. (defun correo-ola38 ()
  1077. (interactive)
  1078. (progn
  1079. (setq
  1080. paste (concat "\n" (read-from-minibuffer "Paste: ") "\n\n")
  1081. period (read-from-minibuffer "Período: ")
  1082. entity (read-from-minibuffer "Objeto/Entidad: ")
  1083. cta-destino (read-from-minibuffer "Cta destino: ")
  1084. nit-destino (read-from-minibuffer "NIT: ")
  1085. razon-social (read-from-minibuffer "Razón social: ")
  1086. ledger-val (read-from-minibuffer "Valor: ")
  1087. val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" ledger-val)
  1088. number-to-words (replace-regexp-in-string " " "" (shell-command-to-string (concat "numero_a_letras" " " val)))
  1089. ledger-account " Expenses: "
  1090. ledger-asset " Assets:Banco:ahorro:0609 "
  1091. ;;razon-social "DISTRIBUIDORA DE EXTINTORES SIGLO XXI SA"
  1092. tag1 (read-from-minibuffer "tag1: ")
  1093. tag2 (read-from-minibuffer "tag2: ")
  1094. subject (concat ":pago:" tag1 ":" tag2 ": " period " " entity )
  1095. tags (concat " -- " " pago " tag1 " " tag2 " " )
  1096. ext ".txt"
  1097. date (format-time-string "%Y-%m-%d ")
  1098. date-ledger (format-time-string "%Y/%m/%d ")
  1099. ;;path "/tmp/"
  1100. path "~/Dropbox/ALC/"
  1101. path2 "~/ola38/pagos_OLA38.ldg"
  1102. fpath (concat path date period " " entity " " "v " val " " tags ext))
  1103. (write-region paste nil fpath) ;; create empty file
  1104. (write-region (concat "\n" date-ledger "PAGO " period " " entity "\n"
  1105. " ; comprobante: EGRESOS No. \n ;\n"
  1106. " ; EMPRESA: OLA38 S.A.S. NIT: 901429017-6 \n"
  1107. " ; CIUDAD: Medellín \n ;\n"
  1108. " ; ctaOrigen: 259-000006-09 \n"
  1109. " ; ctaDestino: " cta-destino " \n ;\n"
  1110. " ; PAGADO A: " razon-social "\n ;\n"
  1111. " ; NIT: " nit-destino "\n ;\n"
  1112. " ; DESCRIPCION: PAGO " period " " entity "\n ;\n"
  1113. " ; EN LETRAS: " number-to-words "\n"
  1114. " ; RETENCION: \n"
  1115. ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append)
  1116. ;; start smtp server, compose mail, send whith C-c C-c
  1117. (setq smtpmail-stream-type 'ssl)
  1118. (setq smtpmail-smtp-server "smtp.gmail.com")
  1119. (setq smtpmail-smtp-service 465)
  1120. (compose-mail "contacto.ola38@gmail.com" subject nil nil nil nil nil nil)
  1121. (mail-text) (insert paste)
  1122. (mml-attach-file fpath "text/x-patch" nil "attachment")
  1123. ))
  1124. (defun correo-ola38-opti-test ()
  1125. "Compose and send payment email with attachment."
  1126. (interactive)
  1127. (let* ((paste (concat "\n" (read-from-minibuffer "Paste: ") "\n\n"))
  1128. (period (read-from-minibuffer "Período: "))
  1129. (entity (read-from-minibuffer "Objeto/Entidad: "))
  1130. (cta-destino (read-from-minibuffer "Cta destino: "))
  1131. (nit-destino (read-from-minibuffer "NIT: "))
  1132. (razon-social (read-from-minibuffer "Razón social: "))
  1133. (ledger-val (read-from-minibuffer "Valor: "))
  1134. (val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" ledger-val))
  1135. (number-to-words (shell-command-to-string (concat "numero_a_letras" " " val)))
  1136. (ledger-account " Expenses: ")
  1137. (ledger-asset " Assets:Banco:ahorro:0609 ")
  1138. (tag1 (read-from-minibuffer "tag1: "))
  1139. (tag2 (read-from-minibuffer "tag2: "))
  1140. (subject (concat ":pago:" tag1 ":" tag2 ": " period " " entity))
  1141. (tags (concat " -- " " pago " tag1 " " tag2 " "))
  1142. (ext ".txt")
  1143. (date (format-time-string "%Y-%m-%d "))
  1144. (date-ledger (format-time-string "%Y/%m/%d "))
  1145. (path "~/Dropbox/ALC/")
  1146. (path2 "~/ola38/pagos_OLA38.ldg")
  1147. (fpath (concat path date period " " entity " " "v " val " " tags ext)))
  1148. (write-region paste nil fpath)
  1149. (write-region (concat "\n" date-ledger "PAGO " period " " entity "\n"
  1150. " ; comprobante: EGRESOS No. \n ;\n"
  1151. " ; EMPRESA: OLA38 S.A.S. NIT: 901429017-6 \n"
  1152. " ; CIUDAD: Medellín \n ;\n"
  1153. " ; ctaOrigen: 259-000006-09 \n"
  1154. " ; ctaDestino: " cta-destino " \n ;\n"
  1155. " ; PAGADO A: " razon-social "\n ;\n"
  1156. " ; NIT: " nit-destino "\n ;\n"
  1157. " ; DESCRIPCION: PAGO " period " " entity "\n ;\n"
  1158. " ; EN LETRAS: " number-to-words "\n"
  1159. " ; RETENCION: \n"
  1160. ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append)
  1161. (setq smtpmail-stream-type 'ssl
  1162. smtpmail-smtp-server "smtp.gmail.com"
  1163. smtpmail-smtp-service 465)
  1164. (compose-mail "contacto.ola38@gmail.com" subject nil nil nil nil nil nil)
  1165. (mail-text) (insert paste)
  1166. (mml-attach-file fpath "text/x-patch" nil "attachment")))
  1167. (defun correo-pNatural ()
  1168. (interactive )
  1169. (progn
  1170. (setq
  1171. paste (concat "\n" (read-from-minibuffer "Paste: ") "\n\n")
  1172. period (read-from-minibuffer "Período: ")
  1173. entity (read-from-minibuffer "Objeto/Entidad: ")
  1174. ledger-val (read-from-minibuffer "Valor: ")
  1175. val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" ledger-val)
  1176. number-to-words (replace-regexp-in-string " " ""
  1177. (shell-command-to-string
  1178. (concat "numero_a_letras" " " val)))
  1179. ledger-account " Expenses: "
  1180. ledger-asset " Assets:Banco:ahorro:9350 "
  1181. tag1 (read-from-minibuffer "tag1: ")
  1182. tag2 (read-from-minibuffer "tag2: ")
  1183. subject (concat ":pago:" tag1 ":" tag2 ": " period " " entity )
  1184. tags (concat " -- " "pago " tag1 " " tag2 " " )
  1185. ext ".txt"
  1186. date (format-time-string "%Y-%m-%d ")
  1187. date-ledger (format-time-string "%Y/%m/%d ")
  1188. path "~/Dropbox/pNatural/"
  1189. path2 "~/Admin/cuentas.ldg"
  1190. fpath (concat path date period " " entity " " "v " val " " tags ext))
  1191. (write-region paste nil fpath) ;; create empty file
  1192. (write-region
  1193. (concat "\n" date-ledger "PAGO " period " " entity "\n"
  1194. ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append)
  1195. ;; start smtp server, compose mail, send whith C-c C-c
  1196. (setq smtpmail-stream-type 'ssl)
  1197. (setq smtpmail-smtp-server "smtp.gmail.com")
  1198. (setq smtpmail-smtp-service 465)
  1199. (compose-mail "fede2001@gmail.com" subject nil nil nil nil nil nil)
  1200. (mail-text) (insert paste)
  1201. (mml-attach-file fpath "text/x-patch" nil "attachment")))
  1202. (defun correo-personal ()
  1203. (interactive )
  1204. (progn
  1205. (setq
  1206. paste (concat "\n" (read-from-minibuffer "Paste: ") "\n\n")
  1207. period (read-from-minibuffer "Período: ")
  1208. entity (read-from-minibuffer "Objeto/Entidad: ")
  1209. ledger-val (read-from-minibuffer "Valor: ")
  1210. val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" ledger-val)
  1211. number-to-words (replace-regexp-in-string " " ""
  1212. (shell-command-to-string
  1213. (concat "numero_a_letras" " " val)))
  1214. ledger-account " Expenses: "
  1215. ledger-asset " Assets:Banco:ahorro:8824 "
  1216. tag1 (read-from-minibuffer "tag1: ")
  1217. tag2 (read-from-minibuffer "tag2: ")
  1218. subject (concat ":pago:" tag1 ":" tag2 ": " period " " entity )
  1219. tags (concat " -- " "pago " tag1 " " tag2 " " )
  1220. ext ".txt"
  1221. date (format-time-string "%Y-%m-%d ")
  1222. date-ledger (format-time-string "%Y/%m/%d ")
  1223. path "~/Dropbox/yo/"
  1224. path2 "~/Admin/cuentasFLC.ldg"
  1225. fpath (concat path date period " " entity " " "v " val " " tags ext))
  1226. (write-region paste nil fpath) ;; create empty file
  1227. (write-region
  1228. (concat "\n" date-ledger "PAGO " period " " entity "\n"
  1229. ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append)
  1230. ;; start smtp server, compose mail, send whith C-c C-c
  1231. (setq smtpmail-stream-type 'ssl)
  1232. (setq smtpmail-smtp-server "smtp.gmail.com")
  1233. (setq smtpmail-smtp-service 465)
  1234. (compose-mail "fede2001@gmail.com" subject nil nil nil nil nil nil)
  1235. (mail-text) (insert paste)
  1236. (mml-attach-file fpath "text/x-patch" nil "attachment")))
  1237. (defun derivadons-pago ()
  1238. "A partir del comprobante genera una entrada en el archivo de contabilidad,
  1239. archivo de texto con la información de pago, y envía correo.
  1240. La entrada al archivo de contabilidad ej: cuentas.ldg es en formato ledger-cli,
  1241. el archivo de información de pago es formato texto, extensión .txt y el nombre
  1242. en formato AAAA-MM-DD <período> <objeto de pago> v <valor> -- <tag1> <tag2>.txt
  1243. el correo genera el asunto a partir de la información del comprobante, paga
  1244. la información de pago y adjunta el archivo de texto correspondiente a la
  1245. transacción"
  1246. (interactive )
  1247. (progn
  1248. (setq
  1249. paste (concat "\n" (read-from-minibuffer "Pega información de pago: ") "\n\n")
  1250. period (read-from-minibuffer "Período: ")
  1251. entity (read-from-minibuffer "Objeto de pago/Entidad: ")
  1252. ledger-val (read-from-minibuffer "Valor: ")
  1253. val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" ledger-val) ;; convierte moneda a numero, $123,456.00 a 123456
  1254. number-to-words (replace-regexp-in-string " " ""
  1255. (shell-command-to-string
  1256. (concat "numero_a_letras" " " val))) ;; convierte numero a letras usando script "numero_a_letras"
  1257. ledger-account " Expenses: " ;; cuenta a donde ingresa
  1258. ledger-asset " Assets:Banco:ahorro:0609 " ;; cuenta de donde sale
  1259. tag1 (read-from-minibuffer "tag1:")
  1260. tag2 (read-from-minibuffer "tag2:")
  1261. subject (concat ":pago:" tag1 ":" tag2 ": " period " " entity ) ;; asunto para el correo
  1262. tags (concat " -- " tag1 " " tag2 " " ) ;; tags para el archivo .txt
  1263. ext ".txt"
  1264. date (format-time-string "%Y-%m-%d ")
  1265. path "~/mi/ruta/comprobantes/" ;; ruta para guardar el archivo
  1266. path2 "~/mi/ruta/cuentas.ldg" ;; ruta del archivo de contabilidad para agregar la entrada
  1267. fpath (concat path date period " " entity " " "v " val " " tags ext)) ;; construye el nombre del archivo .txt
  1268. (write-region paste nil fpath) ;; create empty file
  1269. (write-region
  1270. (concat "\n" date "PAGO " period " " entity "\n"
  1271. ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append) ;; hace el ingreso con formato ledger-cli
  1272. ;; inicia el servidor, conforma el correo, evia con C-c C-c
  1273. (setq smtpmail-stream-type 'ssl)
  1274. (setq smtpmail-smtp-server "smtp.gmail.com")
  1275. (setq smtpmail-smtp-service 465)
  1276. (mail)
  1277. (compose-mail "miCorreo@gmail.com" subject nil nil nil nil nil nil)
  1278. (mail-text) (insert paste)
  1279. (mml-attach-file fpath "text/x-patch" nil "attachment")
  1280. (mail-send)))
  1281. ;; ===== CAPTURE
  1282. (defun capture-to-ledger-region ()
  1283. (interactive)
  1284. (let* ((alquem "nigredo")
  1285. (date (format-time-string "%Y/%m/%d "))
  1286. (payee (if (use-region-p)
  1287. (buffer-substring (region-beginning) (region-end))
  1288. "No payee selected"))
  1289. (accounts "capture")
  1290. (value "v3")
  1291. (probabilidad "1")
  1292. (impacto "1")
  1293. (paste payee) ;; Use the same selected region for `doc`
  1294. (context "")
  1295. (path "~/SyncDocs/capture.ldg")
  1296. (hash (hash-string-internal (concat date payee accounts value paste context))))
  1297. (write-region
  1298. (concat "\n" "\n" date " " payee "\n"
  1299. " ;; doc: " paste "\n"
  1300. " ;; context: " context "\n"
  1301. " ;; status: " alquem "\n"
  1302. " ;; riesgo:: (" probabilidad "*" impacto ")" "\n"
  1303. " ;; id: " hash "\n"
  1304. " " accounts " " value "\n"
  1305. " Time") nil path 'append)))
  1306. (defun capture-to-ledger ()
  1307. (interactive)
  1308. (let* ((alquem "nigredo")
  1309. (date (format-time-string "%Y/%m/%d "))
  1310. (clipboard-content (current-kill 0))
  1311. (payee (car (split-string clipboard-content "\n"))) ; Use the first line for payee
  1312. (paste (replace-regexp-in-string "\n" "\\\\n" clipboard-content)) ; Replace new lines with \n
  1313. (accounts "capture")
  1314. (value "v3")
  1315. (probabilidad "1")
  1316. (impacto "1")
  1317. (context "")
  1318. (path "~/SyncDocs/capture.ldg")
  1319. (hash (hash-string-internal (concat date payee accounts value paste context))))
  1320. (write-region
  1321. (concat "\n" "\n" date " " payee "\n"
  1322. " ;; doc: " paste "\n"
  1323. " ;; context: " context "\n"
  1324. " ;; status: " alquem "\n"
  1325. " ;; riesgo:: (" probabilidad "*" impacto ")" "\n"
  1326. " ;; id: " hash "\n"
  1327. " " accounts " " value "\n"
  1328. " Time") nil path 'append)
  1329. (find-file path)))
  1330. (defun capture-to-ledger-asking ()
  1331. (interactive )
  1332. (let* (
  1333. (alquem "nigredo");;alquem (let ((options '("nigredo" "albedo" "citrinitas" "rubedo"))) ;; (completing-read "Selecciona: " options nil t)))
  1334. (date (format-time-string "%Y/%m/%d "))
  1335. (payee (read-from-minibuffer "Payee: "))
  1336. (accounts "capture") ;;(read-from-minibuffer "Accounts: "))
  1337. (value "v3") ;;(read-from-minibuffer "Value: " "v3")
  1338. ;; probabilidad (read-from-minibuffer "Probabilidad (1 improbable 4 muy probable): " "1")
  1339. (probabilidad "1")
  1340. ;; impacto (read-from-minibuffer "Impacto (1 sin impacto 4 alto impacto): " "1")
  1341. (impacto "1")
  1342. (paste (read-from-minibuffer "doc: "))
  1343. ;;src (read-from-minibuffer "Source: ")
  1344. ;;context (read-from-minibuffer "Context: ")
  1345. (context "")
  1346. ;;url (read-from-minibuffer "url: ")
  1347. (path "~/SyncDocs/capture.ldg")
  1348. (hash (hash-string-internal (concat date payee accounts value paste context ))))
  1349. (write-region
  1350. (concat "\n" "\n" date " " payee "\n"
  1351. " ;; doc: " paste "\n"
  1352. " ;; context: " context "\n"
  1353. " ;; status: " alquem "\n"
  1354. " ;; riesgo:: (" probabilidad "*" impacto ")" "\n"
  1355. " ;; id: " hash "\n"
  1356. " " accounts " " value "\n"
  1357. " Time") nil path 'append) ))
  1358. (defun cuFLC ()
  1359. "Formatea con la convención de ledger una transacción"
  1360. (interactive )
  1361. (let* (
  1362. (date (format-time-string "%Y/%m/%d "))
  1363. (payee (read-from-minibuffer "Payee: "))
  1364. (accounts "Expenses:") ;;(read-from-minibuffer "Accounts: "))
  1365. (value (read-from-minibuffer "Value: "))
  1366. (path "~/Admin/cuentasFLC.ldg"))
  1367. (write-region
  1368. (concat "\n" "\n" date " " payee "\n"
  1369. " " accounts " " value ".00" "\n"
  1370. " Assets:" " -" value ".00") nil path 'append)))
  1371. ;; podría usar esto pero abre la el archivo literal sin encodig
  1372. ;; (if (equal (read-from-minibuffer "Do you want to open the file? (y/n) ") "y")
  1373. ;; (let ((filename (read-file-name "Enter file name: ")))
  1374. ;; (with-current-buffer (find-file-noselect filename nil t)
  1375. ;; (switch-to-buffer (current-buffer))
  1376. ;; (goto-char (point-max))
  1377. ;; (end-of-buffer)))))
  1378. ;;; EDIT TEXT FUNCTIONS
  1379. (defun delete-lines-containing-string-in-region (search-string start end)
  1380. "Delete lines containing SEARCH-STRING in the selected region."
  1381. (interactive "sEnter the string to search for: \nr")
  1382. (save-restriction
  1383. (narrow-to-region start end)
  1384. (goto-char (point-min))
  1385. (while (search-forward search-string nil t)
  1386. (beginning-of-line)
  1387. (let ((begin (point)))
  1388. (forward-line 1)
  1389. (delete-region begin (point))))))
  1390. ;;; END EDIT TEXT FUNCTIONS
  1391. (defun prosa_generico_pub()
  1392. (interactive)
  1393. (let* ((option '("math:dante" "orientacion:ledger" "ledger:report:galeria" "genrom" "produccion" "orientacion:guix" "sonido:directo"))
  1394. (selected (completing-read "opcion: " option))
  1395. (status_options '("albedo" "nigredo"))
  1396. (status_selected (completing-read "status: " status_options)))
  1397. (progn
  1398. (setenv "ACCOUNT" selected t)
  1399. (setenv "STATUS" status_selected t)
  1400. (ledger-report "PUB generico albedo" nil)
  1401. (find-file (concat "/home/ff/Public/publica_" (getenv "ACCOUNT") ".org")))))
  1402. (defun prosa_generico_priv()
  1403. (interactive)
  1404. (let* ((option '("amor" "alc" "psico" "auxiliar_administrativa_contable:manual"))
  1405. (selected (completing-read "opcion: " option)))
  1406. (progn
  1407. (setenv "ACCOUNT" selected t)
  1408. (ledger-report "prosa generico priv" nil)
  1409. (find-file (concat "/tmp/priv_" (getenv "ACCOUNT") ".org")))))
  1410. (defun prosa_generico_ola38()
  1411. (interactive)
  1412. (let* ((option '("auxiliar_administrativa_contable:manual" "referenciaOLA38" "ayuda:emacs"))
  1413. (selected (completing-read "opcion: " option)))
  1414. (progn
  1415. (setenv "ACCOUNT" selected t)
  1416. (ledger-report "prosa generico ola38" nil)
  1417. (find-file (concat "~/SyncElvis/referencia_" (getenv "ACCOUNT") ".org")))))
  1418. (defun change-env ()
  1419. "change env based on user-selected options."
  1420. (interactive)
  1421. (let* ((option (completing-read "Opción: " '("aor" "dell" "lore"))))
  1422. (setenv "PROFILE" option t)))
  1423. ;;; OPTIMIZED BY GTP
  1424. (defun prosa-generico ()
  1425. "Generate a generic prose report based on user-selected options."
  1426. (interactive)
  1427. (let* ((option (completing-read "Opción: " '("pub" "priv" "ola38")))
  1428. (selected (completing-read "Selecciona una opción: " (prosa-generico-options option))))
  1429. (pcase option
  1430. ('pub (prosa-generico-pub selected))
  1431. ('priv (prosa-generico-priv selected))
  1432. ('ola38 (prosa-generico-ola38 selected)))))
  1433. (defun prosa-generico-options (option)
  1434. "Return the list of options based on the main option."
  1435. (pcase option
  1436. ('pub '("math:dante" "orientacion:ledger" "ledger:report:galeria" "genrom" "produccion" "sonido:directo" "scheme"))
  1437. ('priv '("amor" "alc" "psico" "auxiliar_administrativa_contable:manual"))
  1438. ('ola38 '("auxiliar_administrativa_contable:manual" "referenciaOLA38" "emacs"))))
  1439. ;; test (prosa-generico-options 'ola38)
  1440. (defun prosa-generico-pub (selected)
  1441. "Generate a prose report for the 'pub' option with the selected account."
  1442. (setenv "ACCOUNT" selected t)
  1443. (setenv "STATUS" (completing-read "Status: " '("albedo" "nigredo")))
  1444. (ledger-report "PUB generico albedo opt" nil)
  1445. (find-file (concat "/home/ff/Public/publica_" (getenv "ACCOUNT") ".org")))
  1446. (defun prosa-generico-priv (selected)
  1447. "Generate a prose report for the 'priv' option with the selected account."
  1448. (setenv "ACCOUNT" selected t)
  1449. (ledger-report "prosa generico priv" nil)
  1450. (find-file (concat "/tmp/priv_" (getenv "ACCOUNT") ".org")))
  1451. (defun prosa-generico-ola38 (selected)
  1452. "Generate a prose report for the 'ola38' option with the selected account."
  1453. (setenv "ACCOUNT" selected t)
  1454. (ledger-report "prosa generico ola38" nil)
  1455. (find-file (concat "~/SyncElvis/referencia_" (getenv "ACCOUNT") ".org")))
  1456. ;;; END OPTIMIZACION
  1457. ;; (defun dired-occur (directory search-string)
  1458. ;; "Search for SEARCH-STRING in the Dired buffer of DIRECTORY."
  1459. ;; (interactive "DDirectory: \nsEnter search string: ")
  1460. ;; (let ((buf (dired-noselect directory)))
  1461. ;; (with-current-buffer buf
  1462. ;; (occur search-string))
  1463. ;; (switch-to-buffer-other-window buf)))
  1464. ;;;###autoload
  1465. ;;; from: https://oremacs.com/2016/02/24/dired-rsync/
  1466. ;;; rsync -arvzu --progress se usa u para solo mandar las nuevas, sin u parece que las verifica
  1467. (defun ora-dired-rsync (dest)
  1468. (interactive
  1469. (list
  1470. (expand-file-name
  1471. (read-file-name
  1472. "Rsync to:"
  1473. (dired-dwim-target-directory)))))
  1474. ;; store all selected files into "files" list
  1475. (let ((files (dired-get-marked-files
  1476. nil current-prefix-arg))
  1477. ;; the rsync command
  1478. (tmtxt/rsync-command
  1479. "rsync -arvzu --progress "))
  1480. ;; add all selected file names as arguments
  1481. ;; to the rsync command
  1482. (dolist (file files)
  1483. (setq tmtxt/rsync-command
  1484. (concat tmtxt/rsync-command
  1485. (shell-quote-argument file)
  1486. " ")))
  1487. ;; append the destination
  1488. (setq tmtxt/rsync-command
  1489. (concat tmtxt/rsync-command
  1490. (shell-quote-argument dest)))
  1491. ;; run the async shell command
  1492. (async-shell-command tmtxt/rsync-command "*rsync*")
  1493. ;; finally, switch to that window
  1494. (other-window 1)))
  1495. ;;(define-key dired-mode-map "Y" 'ora-dired-rsync)
  1496. (defun show-functions-and-docstrings ()
  1497. "Show function names and their docstrings from the current buffer."
  1498. (interactive)
  1499. (let ((result-buffer (get-buffer-create "*Functions and Docstrings*"))
  1500. (functions ()))
  1501. (save-excursion
  1502. (goto-char (point-min))
  1503. (while (re-search-forward "^(defun \\([^ ]+\\)" nil t)
  1504. (let ((fn-name (match-string 1)))
  1505. (when (fboundp (intern fn-name))
  1506. (let ((doc (documentation (intern fn-name))))
  1507. (push (format "%s: %s\n" fn-name doc) functions))))))
  1508. (with-current-buffer result-buffer
  1509. (erase-buffer)
  1510. (dolist (fn functions)
  1511. (insert fn)))
  1512. (display-buffer result-buffer)))
  1513. (defun dired-occur (directory search-string)
  1514. "Search for SEARCH-STRING in the Dired buffer of DIRECTORY."
  1515. (let ((buf (dired-noselect directory)))
  1516. (with-current-buffer buf
  1517. (occur search-string))
  1518. (switch-to-buffer-other-window buf)))
  1519. ;; Example non-interactive call
  1520. ;;(dired-occur "~/Dropbox/ALC" "rentaALC")
  1521. ;;example
  1522. ;; (dired-ocurr "~/tmp" "*.pdf")
  1523. (defun open-ola38-files ()
  1524. (interactive)
  1525. (mapc #'find-file '("~/ola38/cuentasOLA38.ldg"
  1526. "~/ola38/panel_dolly.el"
  1527. "~/my_forest/panel_federico.el"
  1528. "~/ola38/panel_doris.el"
  1529. "~/SyncElvis/chat.txt"
  1530. "~/ola38/chat.txt"
  1531. "~/Admin/cuentas.ldg"
  1532. "~/Admin/cuentasFLC.ldg"
  1533. "~/Admin/SVE_pagos.ldg"
  1534. "~/SyncElvis/reportes_ledger.el")))
  1535. (defun convert-date-string (date-str)
  1536. "Convert date string from DD/MM/YYYY to YYYY/MM/DD."
  1537. (if (string-match "\\([0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9][0-9][0-9]\\)" date-str)
  1538. (format "%s/%s/%s"
  1539. (match-string 3 date-str) ; Year
  1540. (match-string 2 date-str) ; Month
  1541. (match-string 1 date-str)) ; Day
  1542. (error "Date string format is incorrect")))
  1543. ;; Example usage:
  1544. ;(convert-date-string "31/12/2024") ; => "2024/12/31"
  1545. (defun consecutivo-egreso-ola38 ()
  1546. (interactive)
  1547. (let* ((value (shell-command-to-string "ledger -f $OLA38 reg banco --limit \"tag('egreso')\" --format \"%(tag('egreso'))\" --tail 1")))
  1548. (number-to-string (+ (string-to-number value) 1))))
  1549. ;;(consecutivo-egreso-ola38)
  1550. (defun consecutivo-ingreso-ola38 ()
  1551. (interactive)
  1552. (let* ((value (shell-command-to-string "ledger -f $OLA38 reg banco --limit \"tag('ingreso')\" --format \"%(tag('ingreso'))\" --tail 1")))
  1553. (number-to-string (+ (string-to-number value) 1))))
  1554. ;;(consecutivo-ingreso-ola38)
  1555. (defvar nit-history '("901309711 PINTURA ELECTROSTATICA OCHOA LEON" "811014959 DISEÑOS CREATIVOS"))
  1556. ;;(defvar cuentas-history '("Assets:clienteNacional:ochoa" "Expenses:viaticos:gasolina" ))
  1557. (defun load-my-history-from-file (file)
  1558. "Load history from FILE and return it as a list."
  1559. (with-temp-buffer
  1560. (insert-file-contents file)
  1561. (read (buffer-string))))
  1562. (defun my-org-inline-css-hook (exporter)
  1563. "Insert custom inline css"
  1564. (when (eq exporter 'html)
  1565. (let* ((dir (ignore-errors (file-name-directory (buffer-file-name))))
  1566. (path (concat dir "style.css"))
  1567. (homestyle (or (null dir) (null (file-exists-p path))))
  1568. (final (if homestyle "~/ola38/default.css" path))) ;; <- set your own style file path
  1569. (setq org-html-head-include-default-style nil)
  1570. (setq org-html-head (concat
  1571. "<style type=\"text/css\">\n"
  1572. "<!--/*--><![CDATA[/*><!--*/\n"
  1573. (with-temp-buffer
  1574. (insert-file-contents final)
  1575. (buffer-string))
  1576. "/*]]>*/-->\n"
  1577. "</style>\n")))))
  1578. (add-hook 'org-export-before-processing-hook 'my-org-inline-css-hook)
  1579. (defun get-nit-history ()
  1580. "FIX! do not use"
  1581. (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 \" " ) ))))
  1582. ;; (get-nit-history)
  1583. (defun format-ledger-transaction (data)
  1584. "Format a ledger-cli transaction from comma-separated values."
  1585. (let* ((fields (split-string data ","))
  1586. (comprobante (nth 2 fields))
  1587. (fecha (convert-date-string (nth 3 fields)))
  1588. (nombre (nth 6 fields))
  1589. (moneda (nth 7 fields))
  1590. (valor-bruto (nth 8 fields))
  1591. (descuento (nth 9 fields))
  1592. (subtotal (nth 10 fields))
  1593. (iva (nth 11 fields))
  1594. (rete-fuente (nth 13 fields))
  1595. (total-neto (nth 16 fields)))
  1596. ;; Format the ledger-cli transaction
  1597. (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"
  1598. fecha
  1599. nombre
  1600. comprobante
  1601. (nth 4 fields)
  1602. (nth 5 fields)
  1603. moneda
  1604. valor-bruto
  1605. descuento
  1606. subtotal
  1607. total-neto
  1608. valor-bruto
  1609. iva
  1610. rete-fuente
  1611. total-neto)))
  1612. ;; Example usage:
  1613. ; (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")
  1614. (defun get-marked-region (beg end)
  1615. "message region or \"empty string\" if none highlighted ..
  1616. from event jr
  1617. https://stackoverflow.com/questions/10594208/how-do-i-get-the-region-selection-programmatically-in-emacs-lisp"
  1618. (interactive (if (use-region-p)
  1619. (list (region-beginning) (region-end))
  1620. (list nil nil)))
  1621. (message "%s" (if (and beg end)
  1622. (buffer-substring-no-properties beg end)
  1623. "empty string")))
  1624. (defun paste-to-buffer ()
  1625. "Append the current clipboard contents to a selected open buffer.
  1626. Adds an empty line before and after the content, reverts and opens the destination buffer."
  1627. (interactive)
  1628. (let* ((clipboard-content (concat "\n" (current-kill 0) "\n"))
  1629. (buffer (completing-read "Select buffer: " (mapcar #'buffer-name (buffer-list)))))
  1630. (with-current-buffer buffer
  1631. (goto-char (point-max))
  1632. (insert clipboard-content)
  1633. (save-buffer)
  1634. (revert-buffer :ignore-auto :noconfirm))
  1635. (switch-to-buffer buffer)
  1636. (message "Clipboard content appended to buffer: %s" buffer)))
  1637. (defun paste-to ()
  1638. "Append the current clipboard contents to a selected open buffer."
  1639. (interactive)
  1640. (let* ((clipboard-content (current-kill 0))
  1641. (buffer (completing-read "Select buffer: " (mapcar #'buffer-name (buffer-list)))))
  1642. (with-current-buffer buffer
  1643. (goto-char (point-max))
  1644. (insert clipboard-content))
  1645. (message "Clipboard content appended to buffer: %s" buffer)))
  1646. (defun paste-to-old()
  1647. (interactive)
  1648. (let* ((option '(("dellioTimelog.ldg" . "~/SyncDocs/dellioTimelog.ldg")
  1649. ("tareasAlc.ldg" . "~/ola38/tareasAlc.ldg")
  1650. ("tareaslorena.ldg" . "~/ola38/tareaslorena.ldg")
  1651. ("cuentasFLC.ldg" . "~/Admin/cuentasFLC.ldg")
  1652. ("FLC_informacion.ldg" . "~/SyncDocs/FLC_informacion.ldg")
  1653. ("FLC_narracion.ldg" . "~/SyncDocs/FLC_narracion.ldg")
  1654. ("ALC_informacion.ldg" . "~/SyncDocs/ALC_informacion.ldg")
  1655. ("ALC_narracion.ldg" . "~/SyncDocs/ALC_narracion.ldg")
  1656. ("tmp" . "/tmp/test.ldg")))
  1657. (path (completing-read "opcion: " option))
  1658. (string (current-kill 0 t)))
  1659. (write-region
  1660. (concat "\n\n" string) nil path 'append)
  1661. (find-file path)))
  1662. (defun anotate-audio-old ()
  1663. (interactive )
  1664. (progn
  1665. (setq
  1666. alquem "nigredo"
  1667. date (format-time-string "%Y/%m/%d ")
  1668. accounts "audio:anotate" ;;(read-from-minibuffer "Accounts: ")
  1669. value "v3" ;;(read-from-minibuffer "Value: " "v3")
  1670. ;; probabilidad (read-from-minibuffer "Probabilidad (1 improbable 4 muy probable): " "1")
  1671. probabilidad "1"
  1672. ;; impacto (read-from-minibuffer "Impacto (1 sin impacto 4 alto impacto): " "1")
  1673. impacto "1"
  1674. paste (read-from-minibuffer "doc: ")
  1675. ;;src (read-from-minibuffer "Source: ")
  1676. ;;context (read-from-minibuffer "Context: ")
  1677. time emms-playing-time-string
  1678. artist (emms-track-get (emms-playlist-current-selected-track) 'info-artist)
  1679. track (emms-track-get (emms-playlist-current-selected-track) 'info-title)
  1680. source (emms-track-get (emms-playlist-current-selected-track) 'name)
  1681. payee (concat artist " - " track )
  1682. context ""
  1683. ;;url (read-from-minibuffer "url: ")
  1684. path "~/SyncDocs/capture.ldg")
  1685. (write-region
  1686. (concat "\n" "\n" date " " payee "\n"
  1687. " ;; artist: " artist "\n"
  1688. " ;; track: " track "\n"
  1689. " ;; time:" time "\n"
  1690. " ;; doc: " paste "\n"
  1691. " ;; context: " context "\n"
  1692. " ;; source: " source "\n"
  1693. " ;; status: " alquem "\n"
  1694. " ;; riesgo:: (" probabilidad "*" impacto ")" "\n"
  1695. " ;; id: " (hash-string-internal (concat date payee accounts value paste context )) "\n"
  1696. " " accounts " " value "\n"
  1697. " Time") nil path 'append)))
  1698. (defun anotate-audio ()
  1699. "Registra anotaciones sobre un track de audio sonando a través de emms"
  1700. (interactive)
  1701. (let* ((alquem "nigredo")
  1702. (date (format-time-string "%Y/%m/%d "))
  1703. (accounts "audio:anotate")
  1704. (value "v3")
  1705. (probabilidad "1")
  1706. (impacto "1")
  1707. (paste (read-from-minibuffer "doc: "))
  1708. (time emms-playing-time-string)
  1709. (artist (emms-track-get (emms-playlist-current-selected-track) 'info-artist))
  1710. (track (emms-track-get (emms-playlist-current-selected-track) 'info-title))
  1711. (source (emms-track-get (emms-playlist-current-selected-track) 'name))
  1712. (payee (concat artist " - " track))
  1713. (context "")
  1714. (path "~/SyncDocs/capture.ldg")
  1715. (id (hash-string-internal (concat date payee accounts value paste context))))
  1716. (write-region
  1717. (concat "\n\n" date " " payee "\n"
  1718. " ;; artist: " artist "\n"
  1719. " ;; track: " track "\n"
  1720. " ;; time: " time "\n"
  1721. " ;; doc: " paste "\n"
  1722. " ;; context: " context "\n"
  1723. " ;; source: " source "\n"
  1724. " ;; status: " alquem "\n"
  1725. " ;; riesgo:: (" probabilidad "*" impacto ")\n"
  1726. " ;; id: " id "\n"
  1727. " " accounts " " value "\n"
  1728. " Time") nil path 'append)))
  1729. (defun anotate-audio-at-point ()
  1730. (interactive)
  1731. (let* ((time emms-playing-time-string)
  1732. (artist (emms-track-get (emms-playlist-current-selected-track) 'info-artist))
  1733. (track (emms-track-get (emms-playlist-current-selected-track) 'info-title)))
  1734. (insert (concat "\n" time " " "'" artist "'" " - " "'" track "'" " cue: "))))
  1735. (defun ii ()
  1736. "Genera un ingreso con formato de tiempo para ledger"
  1737. (interactive)
  1738. (let* ((date (format-time-string "%Y/%m/%d %H:%M:%S"))
  1739. (account (read-from-minibuffer "account: "))
  1740. (details (read-from-minibuffer "detalles: "))
  1741. (fpath "~/SyncDocs/dellioTimelog.ldg"))
  1742. (write-region (concat "i " date " " account " " details "\n" ) nil fpath 'append)))
  1743. (defun oo ()
  1744. "Genera una salida del formato tiempo de Ledger"
  1745. (interactive)
  1746. (let* ((date (format-time-string "%Y/%m/%d %H:%M:%S"))
  1747. (details (read-from-minibuffer "detalles: "))
  1748. (fpath "~/SyncDocs/dellioTimelog.ldg"))
  1749. (write-region (concat "o " date " " details "\n" ) nil fpath 'append)))
  1750. ;;; ===== HASH
  1751. (defun hash-string ()
  1752. "Compute the SHA-256 hash value of the argument."
  1753. (interactive)
  1754. (let ((short-hash
  1755. (substring (secure-hash 'sha256 (read-from-minibuffer "String to hash: ")) 0 8)))
  1756. (kill-new short-hash) ;; disponible en el clipoard
  1757. (message "Short: %s " short-hash )))
  1758. (defun hash-string-internal (str)
  1759. "Compute the SHA-256 hash value of the argument."
  1760. (substring (secure-hash 'sha256 str) 0 8))
  1761. ;;(hash-string-internal "test")
  1762. (defun hash-file ()
  1763. "Compute the SHA-256 hash value of the file at FILE-PATH."
  1764. (interactive)
  1765. (let ((file-path (completing-read "file-path: "
  1766. #'read-file-name-internal
  1767. nil
  1768. t))
  1769. (context (read-from-minibuffer "context: ")))
  1770. (let ((hash (secure-hash 'sha256 (find-file-noselect file-path)))
  1771. (short-hash (substring (secure-hash 'sha256 (find-file-noselect file-path)) 0 8)))
  1772. (kill-new short-hash) ;; disponible en el clipoard
  1773. (message "Short: %s Context: %s \n Hash: %s" short-hash context hash))))
  1774. (defun my-rename-buffer-by-name (buffer-name new-name)
  1775. "Rename a buffer specified by BUFFER-NAME to NEW-NAME."
  1776. (let ((buffer (get-buffer buffer-name)))
  1777. (when buffer
  1778. (with-current-buffer buffer
  1779. (rename-buffer new-name)))))
  1780. (defun time-prepare-to-graph ()
  1781. (interactive)
  1782. (goto-char (point-min))
  1783. (find-file "/tmp/time.txt")
  1784. (flush-lines "^$" )
  1785. (goto-char (point-min))
  1786. (while (search-forward "s" nil t)
  1787. (replace-match "" t)
  1788. (forward-line (point-min)))
  1789. (while (search-forward "," nil t)
  1790. (replace-match "" t)
  1791. (goto-line (point-min))))
  1792. ;; ====== ELFEED
  1793. (defun elfeed-search-tag-hide-entry ()
  1794. "Add the 'hide' tag to the selected entry in Elfeed."
  1795. (interactive)
  1796. (when-let ((entry (elfeed-search-selected :single)))
  1797. (elfeed-tag entry 'hide)
  1798. (elfeed-search-update-entry entry)
  1799. (elfeed-search-update--force)))
  1800. ;; ====== MOUNT VOLUMES
  1801. (defun list-unmounted-volumes ()
  1802. "List unmounted USB or hard disk volumes."
  1803. (let ((output (shell-command-to-string "lsblk -lpf | awk '{print $1, $3}'")))
  1804. (if (string-empty-p output)
  1805. (error "No unmounted volumes found")
  1806. (split-string output "\n" t))))
  1807. (defun mount-selected-volume (device mount-point)
  1808. "FIX mount -t ntfs-3g Mount the selected DEVICE to the specified MOUNT-POINT."
  1809. (interactive
  1810. (let* ((volumes (list-unmounted-volumes))
  1811. (device (completing-read "Select volume to mount: " volumes nil t))
  1812. (mount-point (read-directory-name "Mount point: ")))
  1813. (list (car (split-string device " ")) mount-point)))
  1814. (unless (file-directory-p mount-point)
  1815. (make-directory mount-point t))
  1816. ;;(shell-command (format "sudo mount %s %s" device mount-point))
  1817. (message "Mounted %s to %s" device mount-point))
  1818. ;; ==== ENV ENTORNO
  1819. (setenv "LEDGER_FILE" "~/SyncDocs/notelog_ALC_OLA38.ldg")
  1820. (setenv "ACCOUNT" "orientacion")
  1821. (setenv "DEST_FILE" (concat "prosa_de_" (getenv "ACCOUNT") ".html"))
  1822. (getenv "DEST_FILE")
  1823. (getenv "LEDGER_FILE")
  1824. ;; ===== LAYOUTS
  1825. ;;(require 'cl)
  1826. (defun set-window-width (width)
  1827. "Set the width of the current window to WIDTH columns."
  1828. (let ((current-width (window-width))
  1829. (delta (- width (window-width))))
  1830. (if (> delta 0)
  1831. (enlarge-window-horizontally delta)
  1832. (shrink-window-horizontally (- delta)))))
  1833. ;; Set the current window width to 100 columns
  1834. ;;(set-window-width 100)
  1835. (defun aeromostra-layout ()
  1836. (interactive)
  1837. (find-file "~/Builds/algo0ritmos/participantes/federico/OSC.lisp")
  1838. (delete-other-windows)
  1839. (split-window-horizontally)
  1840. (other-window 1)
  1841. (find-file "~/Builds/algo0ritmos/participantes/federico/panel_lanzamientos_.lisp")
  1842. (split-window-horizontally)
  1843. (other-window 1)
  1844. (find-file "~/Builds/algo0ritmos/participantes/federico/percent_distributed_patterns.lisp")
  1845. (other-window 1)
  1846. (split-window-vertically)
  1847. (switch-to-buffer "*sly-mrepl for sbcl*")
  1848. (forward-page))
  1849. (defun book-layout ()
  1850. (interactive)
  1851. (find-file "~/Scripts/code_Practical_common_lisp.lisp")
  1852. (delete-other-windows)
  1853. (split-window-horizontally)
  1854. (other-window 1)
  1855. (find-file "~/SyncDocs/Peter Seibel - Practical Common Lisp -- ebook 2005 apress.epub")
  1856. (other-window 1)
  1857. (split-window-vertically)
  1858. (switch-to-buffer "*sly-mrepl for sbcl*")
  1859. (forward-page)
  1860. (mapc 'disable-theme custom-enabled-themes) (load-theme 'poet-dark t))
  1861. (defun capture-layout ()
  1862. (interactive)
  1863. (ledger-report "todo newline test" nil)
  1864. (delete-other-windows) (split-window-horizontally)
  1865. (pcase (getenv "PROFILE")
  1866. ("aor" (enlarge-window-horizontally -70)) ("dell" (enlarge-window-horizontally -50)))
  1867. (other-window 1) (find-file "~/SyncDocs/capture.ldg") (goto-char (point-max))
  1868. (split-window-horizontally)
  1869. (find-file "~/SyncDocs/textos_largos_capturas.txt")
  1870. (other-window 1)
  1871. (pcase (getenv "PROFILE")
  1872. ("aor" (enlarge-window-horizontally -70)) ("dell" (enlarge-window-horizontally -30)))
  1873. (mapc 'disable-theme custom-enabled-themes) (load-theme 'poet-dark t))
  1874. (defun capture-alc-layout ()
  1875. (interactive)
  1876. (find-file "~/SyncDocs/notelog_ALC_OLA38.ldg")
  1877. (delete-other-windows)
  1878. (split-window-horizontally)
  1879. (other-window 1)
  1880. (ledger-report "REG zettelkasten ALC" nil)
  1881. (my-rename-buffer-by-name "*Ledger Report*" (concat "index" (number-to-string (random 88))))
  1882. (split-window-vertically)
  1883. ;; (other-window 1)
  1884. (ledger-report "REG riesgo ALC" nil)
  1885. (other-window 1)
  1886. (split-window-vertically)
  1887. (find-file "~/SyncDocs/capture.ldg"))
  1888. (defun causa-ola-layout ()
  1889. (interactive)
  1890. (ledger-report "REG pagos para SVE ledger" nil)
  1891. (delete-other-windows)
  1892. (find-file-other-window "~/ola38/cuentasOLA38.ldg")
  1893. (split-window-vertically)
  1894. (find-file-other-window "~/ola38/pagos_OLA38.ldg")
  1895. ;; Search in *Ledger Report* buffer
  1896. (switch-to-buffer "pagos_OLA38.ldg")
  1897. (enlarge-window -20)
  1898. (switch-to-buffer "*Ledger Report*")
  1899. ;; Window sizes by profile
  1900. (pcase (getenv "PROFILE")
  1901. ("aor" (enlarge-window-horizontally -65))
  1902. ("dell" (enlarge-window-horizontally -25))))
  1903. (defun correo-layout ()
  1904. (interactive)
  1905. (switch-to-buffer "*scratch*")
  1906. (delete-other-windows) (erase-buffer)
  1907. (visual-fill-column-mode))
  1908. (defun cartera-layout ()
  1909. (interactive)
  1910. (find-file "~/Admin/cuentas.ldg")
  1911. (delete-other-windows)
  1912. (split-window-horizontally)
  1913. (other-window 1)
  1914. (ledger-report "cartera por cliente" nil))
  1915. (defun config-layout ()
  1916. (interactive)
  1917. (find-file "~/.emacs")
  1918. (delete-other-windows) (split-window-horizontally)
  1919. (enlarge-window-horizontally -50)
  1920. (other-window 1)
  1921. (find-file "~/my_forest/emacs_utilities.el")
  1922. (other-window 1) (split-window-vertically)
  1923. (switch-to-buffer "*scratch*") (forward-page)
  1924. (other-window 2)
  1925. ;;(mapc 'disable-theme custom-enabled-themes) (load-theme 'wheatgrass t)
  1926. )
  1927. (defun consolida-layout ()
  1928. (interactive)
  1929. (ledger-report "consolida 9350" nil)
  1930. (delete-other-windows) (split-window-horizontally)
  1931. (pcase (getenv "PROFILE")
  1932. ("aor" (enlarge-window-horizontally -70)) ("dell" (enlarge-window-horizontally -30)))
  1933. (other-window 1)
  1934. (find-file "~/Admin/cuentas.ldg")
  1935. (split-window-vertically) (other-window 1)
  1936. (dired "~/Dropbox/ALC" "-laGh1v"))
  1937. (defun circe-layout ()
  1938. (interactive)
  1939. (switch-to-buffer "#un/loquer@Libera Chat")
  1940. (delete-other-windows) (split-window-horizontally)
  1941. (other-window 1)
  1942. (switch-to-buffer "#clschool@Libera Chat")
  1943. (split-window-vertically) (other-window 1)
  1944. (switch-to-buffer "#ardour@Libera Chat")
  1945. (other-window 1) (split-window-vertically)
  1946. (switch-to-buffer "#guix@Libera Chat"))
  1947. (defun citas-vencimientos-layout ()
  1948. (interactive)
  1949. (ledger-report "citas vencimientos" nil)
  1950. (pcase (getenv "PROFILE")
  1951. ("aor" (set-window-width 100))
  1952. ("dell" (set-window-width 55))
  1953. ("lore" (set-window-width 100)))
  1954. (switch-to-buffer "*Ledger Report*")
  1955. (search-forward (format-time-string "%Y/%m/%d")))
  1956. (defun dired-layout ()
  1957. (interactive)
  1958. (dired "~/Dropbox/ALC" "-laGh1vt")
  1959. (delete-other-windows)
  1960. (split-window-horizontally)
  1961. (other-window 1)
  1962. (dired "~/Dropbox/pNatural" "-laGh1vt")
  1963. (split-window-vertically)
  1964. (other-window 1)
  1965. (dired "~/Dropbox/yo" "-laGh1vt")
  1966. (other-window 1)
  1967. (split-window-vertically)
  1968. (dired "/tmp" "-laGh1vt"))
  1969. (defun emms-layout ()
  1970. (interactive)
  1971. (emms-playlist-mode-go)
  1972. (delete-other-windows)
  1973. (split-window-horizontally)
  1974. (other-window 1)
  1975. (dired "~/External/PUPI_1/fede/Music" "-laGh1vt")
  1976. (split-window-vertically)
  1977. (other-window 1)
  1978. (emms-browser)
  1979. (other-window 1)
  1980. (split-window-vertically)
  1981. (dired "~/SyncMusic/" "-laGh1vt")(forward-page))
  1982. (defun notelog-layout ()
  1983. "F8"
  1984. (interactive)
  1985. (find-file "~/SyncDocs/notelog.ldg")
  1986. (delete-other-windows) (split-window-horizontally)
  1987. (other-window 1)
  1988. (ledger-report "prosa music" nil)
  1989. (previous-multiframe-window))
  1990. (defun informe-layout ()
  1991. (interactive)
  1992. (ledger-report "plot_estado_resultados_comparativo_ola38" nil)
  1993. (delete-other-windows)
  1994. (split-window-horizontally)
  1995. (pcase (getenv "PROFILE")
  1996. ("aor" (enlarge-window-horizontally -65)) ("dell" (enlarge-window-horizontally -30)))
  1997. (other-window 1)
  1998. (find-file "~/SyncDocs/ALC_informe.el"))
  1999. (defun lisp-layout ()
  2000. (interactive)
  2001. (find-file "~/SyncDocs/OSC.lisp")
  2002. (delete-other-windows)
  2003. (split-window-horizontally)
  2004. (other-window 1)
  2005. (find-file "~/Dropbox/org/eduLisp.lsp")
  2006. (goto-line 48)
  2007. (split-window-vertically)
  2008. (other-window 1)
  2009. (find-file "~/SyncDocs/lispEdu.lisp")
  2010. (goto-line 48)
  2011. (other-window 1)
  2012. (split-window-vertically)
  2013. (switch-to-buffer "*sly-mrepl for sbcl*")
  2014. (forward-page))
  2015. (defun lisp-book-layout ()
  2016. (interactive)
  2017. (find-file "~/Scripts/code_Practical_common_lisp.lisp")
  2018. (delete-other-windows)
  2019. (split-window-horizontally)
  2020. (other-window 1)
  2021. (find-file "~/SyncDocs/Peter Seibel - Practical Common Lisp -- ebook 2005 apress.epub")
  2022. (other-window 1)
  2023. (split-window-vertically)
  2024. (switch-to-buffer "*sly-mrepl for sbcl*") (forward-page))
  2025. (defun pagos-layout ()
  2026. (interactive)
  2027. (ledger-report "REG pagos para SVE ledger" nil)
  2028. (delete-other-windows)
  2029. (find-file-other-window "~/Admin/SVE_pagos para sve.ldg")
  2030. (split-window-vertically)
  2031. (find-file-other-window "~/ola38/tareaslorena.ldg")
  2032. ;; Search in *Ledger Report* buffer
  2033. (switch-to-buffer "tareaslorena.ldg")
  2034. (enlarge-window -20)
  2035. (switch-to-buffer "*Ledger Report*")
  2036. ;; Window sizes by profile
  2037. (pcase (getenv "PROFILE")
  2038. ("aor" (enlarge-window-horizontally -65))
  2039. ("dell" (enlarge-window-horizontally -25))))
  2040. (setq buftest (current-buffer))
  2041. (defun timelog-layout ()
  2042. (interactive)
  2043. (let ((oldbuf (current-buffer)))
  2044. (progn
  2045. (ledger-report "PLOT AWK horas" nil)
  2046. ;;(delete-other-windows)
  2047. ;;(split-window-horizontally)
  2048. (pcase (getenv "PROFILE")
  2049. ("aor" (enlarge-window-horizontally -90)) ("dell" (enlarge-window-horizontally -20)))
  2050. (other-window 1)
  2051. (switch-to-buffer oldbuf)
  2052. (other-window 1)
  2053. (split-window-vertically)
  2054. (other-window 1)
  2055. (switch-to-buffer "*vterm*") (goto-char (point-max))
  2056. (other-window 1)
  2057. (split-window-horizontally)
  2058. (pcase (getenv "PROFILE")
  2059. ("aor" (enlarge-window-horizontally 70)) ("dell" (enlarge-window-horizontally 20)))
  2060. (other-window 1)
  2061. (find-file "~/SyncDocs/dellioTimelog.ldg") (goto-char (point-max))
  2062. (split-window-vertically)
  2063. (find-file "~/SyncDocs/timelog.ldg")
  2064. (switch-to-buffer-other-window "*vterm*"))))
  2065. ;; ;(find-file "~/SyncDocs/dellioTimelog.ldg") (goto-char (point-max))
  2066. ;; (split-window-vertically)(split-window-vertically)
  2067. ;; (ledger-report "PLOT AWK horas" nil)
  2068. ;; (other-window 1) (find-file "~/SyncDocs/timelog.ldg")
  2069. ;; (split-window-vertically)
  2070. ;; (other-window 1) (switch-to-buffer "*vterm*") (goto-char (point-max)))
  2071. (defun rename-reports ()
  2072. (interactive)
  2073. ;;(kill-buffer "*Riesgo*") ;; verfify if existe
  2074. (ledger-report "REG riesgo ALC" nil)
  2075. (my-rename-buffer-by-name "*Ledger Report*" "*Riesgo*"))
  2076. (defun sst-layout ()
  2077. (interactive)
  2078. (delete-other-windows)
  2079. ;; (split-window-horizontally)
  2080. ;; (other-window 1)
  2081. (ledger-report "REG PUB sst" nil)
  2082. (delete-other-windows) (split-window-horizontally)
  2083. (find-file "~/SyncElvis/estandares ola38 -- sst norma.ldg")
  2084. (split-window-vertically)
  2085. ;;(other-window 1)
  2086. (find-file "~/SyncDocs/capture.ldg")(goto-char (point-max))
  2087. (other-window 1)
  2088. (mapc 'disable-theme custom-enabled-themes) (load-theme 'poet-dark-monochrome ))
  2089. (defun tareas-layout ()
  2090. (interactive)
  2091. (setq ledger-post-amount-alignment-column 52)
  2092. (reporte-tareas-por-riesgo)
  2093. (delete-other-windows)
  2094. (find-file-other-window "~/my_forest/panel_federico.el")
  2095. (split-window-vertically)
  2096. (find-file-other-window "~/SyncElvis/tareaslorena.ldg")
  2097. ;; Search in *Ledger Report* buffer
  2098. (switch-to-buffer "tareaslorena.ldg")
  2099. (enlarge-window -20)
  2100. (switch-to-buffer "*Ledger Report*")
  2101. (let ((date (current-time))
  2102. (found nil)
  2103. (max-days 10)
  2104. (days-searched 0))
  2105. (goto-char (point-min))
  2106. (while (and (not found)
  2107. (not (eobp))
  2108. (< days-searched max-days))
  2109. (if (search-forward (format-time-string "%Y/%m/%d" date) nil t)
  2110. (setq found t)
  2111. (setq date (time-add date (days-to-time +1)))
  2112. (setq days-searched (1+ days-searched))
  2113. (goto-char (point-min))))
  2114. (if found
  2115. (progn
  2116. (goto-char (point-min))
  2117. (search-forward (format-time-string "%Y/%m/%d" date) nil t)
  2118. (message "Found nearest date: %s" (format-time-string "%Y/%m/%d" date)))
  2119. (message "No date found within the last %d days" max-days)))
  2120. ;; Window sizes by profile
  2121. (pcase (getenv "PROFILE")
  2122. ("aor" (enlarge-window-horizontally -65))
  2123. ("dell" (enlarge-window-horizontally -25))))
  2124. (defun tareas-layout-opt ()
  2125. "Set up the 'tareas' layout for managing tasks and Ledger reports."
  2126. (interactive)
  2127. (setq ledger-post-amount-alignment-column 52)
  2128. (reporte-tareas)
  2129. (delete-other-windows)
  2130. (split-window-horizontally)
  2131. ;; Open relevant files in split windows
  2132. (find-file-other-window "~/my_forest/panel_federico.el")
  2133. (split-window-vertically)
  2134. (find-file-other-window "~/SyncElvis/tareaslorena.ldg")
  2135. ;; Adjust the window for tareaslorena.ldg
  2136. (switch-to-buffer "tareaslorena.ldg")
  2137. (enlarge-window -20)
  2138. ;; Search for the nearest date in *Ledger Report* buffer
  2139. (switch-to-buffer "*Ledger Report*")
  2140. (let ((date (current-time))
  2141. (found nil)
  2142. (max-days 10))
  2143. (goto-char (point-min))
  2144. (while (and (not found)
  2145. (not (eobp))
  2146. (< max-days 10))
  2147. (if (search-forward (format-time-string "%Y/%m/%d" date) nil t)
  2148. (setq found t)
  2149. (setq date (time-add date (days-to-time +1)))))
  2150. (if found
  2151. (message "Found nearest date: %s" (format-time-string "%Y/%m/%d" date))
  2152. (message "No date found within the last %d days" max-days)))
  2153. ;; Adjust window sizes based on profile
  2154. (pcase (getenv "PROFILE")
  2155. ("aor" (enlarge-window-horizontally -25))
  2156. ("dell" (enlarge-window-horizontally -25))))
  2157. ;; ==== mastodon
  2158. (use-package mastodon
  2159. :ensure t)
  2160. (setq mastodon-instance-url "https://fosstodon.org/")
  2161. (setq mastodon-active-user "son0p")
  2162. ;;(setq mastodon-auth-source-file " ")
  2163. ;; ===== IRC LOGS
  2164. (defun leaders ()
  2165. (interactive)
  2166. (highlight-strings-with-random-colors '("beach " "pjb " "x42 " "<beach>" "<mfiano>" "wasamasa" "robin" "las" "rgareus" "civodul" "rekado")))
  2167. (defun get-random-color ()
  2168. "Return a random color from the list of defined colors."
  2169. (let* ((colors (defined-colors))
  2170. (random-color (nth (random (length colors)) colors)))
  2171. random-color))
  2172. (defun highlight-strings-with-random-colors (strings)
  2173. "Highlight each string in STRINGS with a random color in the current buffer."
  2174. (save-excursion
  2175. (dolist (str strings)
  2176. (goto-char (point-min))
  2177. (let ((color (get-random-color)))
  2178. (while (search-forward str nil t)
  2179. (add-text-properties
  2180. (match-beginning 0) (match-end 0)
  2181. `(face (:foreground ,color))))))))
  2182. (defun highlight-predefined-strings-with-random-colors (strings)
  2183. "Highlight each predefined string with a random color in the current buffer."
  2184. (interactive)
  2185. (let ((strings '("string1" "string2" "string3"))) ;; Replace with your list of strings
  2186. (save-excursion
  2187. (dolist (str strings)
  2188. (goto-char (point-min))
  2189. (let ((color (get-random-color)))
  2190. (while (search-forward str nil t)
  2191. (add-text-properties
  2192. (match-beginning 0) (match-end 0)
  2193. `(face (:foreground ,color)))))))))
  2194. (defun capture-to-list ()
  2195. "INCOMPLETA https://stackoverflow.com/questions/15393797/lisp-splitting-input-into-separate-strings"
  2196. (interactive)
  2197. (let* ((nicks (progn
  2198. (search-forward "*** Names: ")
  2199. (set-mark-command nil)
  2200. (move-end-of-line 1)
  2201. (kill-ring-save (mark) (point))
  2202. (current-kill 0 t))))
  2203. (print (cons nicks))))
  2204. ;; mis funciones
  2205. (defun invert-q()
  2206. (interactive)
  2207. (doom/forward-to-last-non-comment-or-eol)
  2208. (search-backward "\$")
  2209. (forward-char 1)
  2210. (insert " ")
  2211. (delete-char 1))
  2212. (defun number-to-time ()
  2213. "Cambia el formato, de un número de cuatro dígitos tipo 2114 a el formato de tiempo 21:14:00"
  2214. (interactive)
  2215. (forward-word -1)
  2216. (forward-char 2)
  2217. (insert ":")
  2218. (forward-char 2)
  2219. (insert ":")
  2220. (insert "00"))
  2221. (defun list-functions-in-file ()
  2222. "List all functions in the current buffer, sorted alphabetically."
  2223. (interactive)
  2224. (let ((functions '()))
  2225. (save-excursion
  2226. (goto-char (point-min))
  2227. (while (re-search-forward "^(defun \\([a-zA-Z0-9-]+\\)" nil t)
  2228. (push (match-string 1) functions)))
  2229. (if functions
  2230. (progn
  2231. (setq functions (sort functions 'string<)) ;; Sort alphabetically
  2232. (with-output-to-temp-buffer "*Functions List*"
  2233. (dolist (func functions)
  2234. (princ (concat func "\n"))))
  2235. (message "Functions listed in *Functions List* buffer."))
  2236. (message "No functions found in the file."))))
  2237. (defun reposition-time-value ()
  2238. (interactive)
  2239. (end-of-line)
  2240. (number-to-time)
  2241. (forward-word -3)
  2242. (kill-line)
  2243. (er-go-to-column 13)
  2244. (yank)
  2245. (kill-word 3)
  2246. (forward-line 1)
  2247. (set-mark-command nil))
  2248. (defun increment-hour-by-position ()
  2249. "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."
  2250. (interactive)
  2251. (beginning-of-line 1)
  2252. (let ((start (point))
  2253. (end (+ (point) 20)))
  2254. (when (looking-at "i \\([0-9]+/[0-9]+/[0-9]+ \\)\\([0-9]+\\)\\(:[0-9]+:[0-9]+\\)")
  2255. (let* ((hour (string-to-number (match-string 2)))
  2256. (new-hour (number-to-string (mod (+ hour 1) 24))) ;; Increment and handle 24-hour wrap-around
  2257. (new-string (concat "o " (match-string 1) (format "%02d" (string-to-number new-hour)) (match-string 3))))
  2258. (end-of-line 1)
  2259. (insert "\n" new-string)))))
  2260. ;; Example usage:
  2261. ;; place point somwhere in format "i 2024/06/07 11:42:07")
  2262. ;; Expected output: "o 2024/06/07 12:42:07"
  2263. (defun increment-number-at-point ()
  2264. (interactive)
  2265. (skip-chars-backward "0-9")
  2266. (or (looking-at "[0-9]+")
  2267. (error "No number at point"))
  2268. (replace-match (number-to-string (1+ (string-to-number (match-string 0))))))
  2269. (defun decrement-number-at-point ()
  2270. (interactive)
  2271. (skip-chars-backward "0-9")
  2272. (or (looking-at "[0-9]+")
  2273. (error "No number at point"))
  2274. (replace-match (number-to-string (1- (string-to-number (match-string 0))))))
  2275. (defun virtual-pyme()
  2276. (interactive)
  2277. (doom/backward-to-bol-or-indent)
  2278. (forward-word 3)
  2279. (kill-word 3)
  2280. (search-forward "\$")
  2281. (backward-char 1)
  2282. (kill-visual-line)
  2283. (forward-line 1)
  2284. (doom/backward-to-bol-or-indent)
  2285. (newline-and-indent)
  2286. (forward-line -1)
  2287. (insert " Revenues:noOper:reposicion ")
  2288. (newline-and-indent)
  2289. (doom/backward-to-bol-or-indent)
  2290. (insert " Assets:9350 ")
  2291. (yank)
  2292. (newline-and-indent)
  2293. (forward-line -2)
  2294. (doom/forward-to-last-non-comment-or-eol)
  2295. (insert " ")
  2296. (yank)
  2297. (search-backward "\$")
  2298. (forward-char 1)
  2299. (delete-char 1)
  2300. (ledger-post-align-xact 0))
  2301. (defun procesa-Extracto()
  2302. "Convert bancolombia->ledger format"
  2303. (interactive)
  2304. ;;(find-file "~/Admin/cuentas.ldg")
  2305. ;;(find-file "~/Admin/cuentasFLC.ldg")
  2306. ;;(find-file "/tmp/test.ldg")
  2307. ;; test prog
  2308. (goto-char (point-min))
  2309. (while (search-forward " " nil t)
  2310. (replace-match " " t)
  2311. (goto-line (point-min)))
  2312. (goto-char (point-min))
  2313. (while (search-forward " BCA CLBIA POBLADO IMPTO GOBIERNO 4X1000" nil t)
  2314. (replace-match " Impuesto 4xmil
  2315. Expenses:noOper:4xmil:9350
  2316. Assets:Banco:ahorro:9350" t)
  2317. (ledger-post-align-xact (point))
  2318. (goto-line (point-min)))
  2319. (goto-char (point-min))
  2320. (while (search-forward " BCA CLBIA POBLADO RETENCION EN LA FUENTE" nil t)
  2321. (replace-match " Impuesto Retención en la fuente
  2322. Expenses:noOper:retefte:9350
  2323. Assets:Banco:ahorro:9350" t)
  2324. (ledger-post-align-xact (point))
  2325. (goto-line (point-min)))
  2326. (goto-char (point-min))
  2327. (while (search-forward " BCA CLBIA POBLADO PAGO PSE CORPORACION EDUCATIV Instituto Jorge Robledo" nil t)
  2328. (replace-match " PSE Instituto Jorge Robledo \n Expenses:Colegio:dante \n Assets:9350 " t)
  2329. (ledger-post-align-xact (point))
  2330. (goto-line (point-min)))
  2331. (goto-char (point-min))
  2332. (while (search-forward " BCA CLBIA POBLADO IVA COMIS TRASLADO OTROS BCOS" nil t)
  2333. (replace-match " Comisión traslado otro banco \n Expenses:noOper:comision:otroBanco \n Assets:Banco:ahorro:9350 " t)
  2334. (ledger-post-align-xact (point))
  2335. (goto-char (point-min)))
  2336. (while (search-forward " BCA CLBIA POBLADO COMISION TRASLADO OTROS BANCOS" nil t)
  2337. (replace-match " Comisión traslado otro banco \n Expenses:noOper:comision:otroBanco \n Assets:Banco:ahorro:9350 " t)
  2338. (ledger-post-align-xact (point))
  2339. (goto-char (point-min)))
  2340. (while (search-forward " BCA CLBIA POBLADO TRASL A CTA CTE CUBRIR SOBREGI" nil t)
  2341. (replace-match " Cubrir sobregiro \n Expenses:noOper:sobregiro \n Assets:Bancos:ahorro:9350 " t)
  2342. (ledger-post-align-xact (point))
  2343. (goto-line (point-min)))
  2344. (while (search-forward "PLAZA MAYOR ABONO INTERESES AHORROS" nil t)
  2345. (replace-match " Interes ahorro \n Revenues:noOper:interes:ola \n Assets:ola " t)
  2346. (ledger-post-align-xact (point))
  2347. (goto-line (point-min)))
  2348. (while (search-forward " BCA CLBIA POBLADO PAGO CART HIPOT DEBITO AUTOM" nil t)
  2349. (replace-match " PAGO credito hipotecario apto 1901 \n Liabilities:CxP:credito:5765 \n Assets:Banco:ahorro:9350 " t)
  2350. (ledger-post-align-xact (point))
  2351. (goto-line (point-min)))
  2352. (while (search-forward " BCA CLBIA POBLADO ABONO INTERESES AHORROS" nil t)
  2353. (replace-match " Interes ahorro \n Revenues:noOper:interes:9350 \n Assets:Banco:ahorro:9350 " t)
  2354. (ledger-post-align-xact (point))
  2355. (goto-line (point-min)))
  2356. (while (search-forward " BCA CLBIA POBLADO PAGO LOPEZ CORREA FED98549000" nil t)
  2357. (replace-match " Coomeva FED98549000 \n Expenses:salud:prepagada \n Assets:Banco:ahorro:9350 " t)
  2358. (ledger-post-align-xact (point))
  2359. (goto-line (point-min))))
  2360. ;; (while (search-forward " BCA CLBIA POBLADO PAGO PROGRAMADO EPM SERVICIOS" nil t)
  2361. ;; (replace-match " Pago Programado EPM \n Expenses:Servicios:epm \n Assets:Banco:ahorro:9350 " t)
  2362. ;; (ledger-post-align-xact (point))
  2363. ;; (forward-word 1)
  2364. ;; (backward-kill-word 1)
  2365. ;; (forward-line -2)
  2366. ;; (doom/forward-to-last-non-comment-or-eol)
  2367. ;; (newline)
  2368. ;; (insert " ;; ref: ")
  2369. ;; (yank))
  2370. (defun procesa-Extracto-opt()
  2371. "Convert bancolombia->ledger format"
  2372. (interactive)
  2373. ;; Define replacements as a list of cons cells
  2374. (let ((replacements '((" " . " ")
  2375. (" BCA CLBIA POBLADO IMPTO GOBIERNO 4X1000" . " Impuesto 4xmil\n Expenses:noOper:4xmil:9350 \n Assets:Banco:ahorro:9350")
  2376. (" BCA CLBIA POBLADO RETENCION EN LA FUENTE" . " Impuesto Retención en la fuente\n Expenses:noOper:retefte:9350\n Assets:Banco:ahorro:9350")
  2377. (" BCA CLBIA POBLADO PAGO PSE CORPORACION EDUCATIV Instituto Jorge Robledo" . " PSE Instituto Jorge Robledo\n Expenses:Colegio:dante\n Assets:9350")
  2378. (" BCA CLBIA POBLADO IVA COMIS TRASLADO OTROS BCOS" . " Comisión traslado otro banco\n Expenses:noOper:comision:otroBanco\n Assets:Banco:ahorro:9350")
  2379. (" BCA CLBIA POBLADO COMISION TRASLADO OTROS BANCOS" . " Comisión traslado otro banco\n Expenses:noOper:comision:otroBanco\n Assets:Banco:ahorro:9350")
  2380. (" BCA CLBIA POBLADO TRASL A CTA CTE CUBRIR SOBREGI" . " Cubrir sobregiro\n Expenses:noOper:sobregiro\n Assets:Bancos:ahorro:9350")
  2381. ("PLAZA MAYOR ABONO INTERESES AHORROS" . " Interes ahorro\n Revenues:noOper:interes:ola\n Assets:ola")
  2382. (" BCA CLBIA POBLADO PAGO CART HIPOT DEBITO AUTOM" . " PAGO credito hipotecario apto 1901\n Liabilities:CxP:credito:5765\n Assets:Banco:ahorro:9350")
  2383. (" BCA CLBIA POBLADO ABONO INTERESES AHORROS" . " Interes ahorro\n Revenues:noOper:interes:9350\n Assets:Banco:ahorro:9350")
  2384. (" BCA CLBIA POBLADO PAGO LOPEZ CORREA FED98549000" . " Coomeva FED98549000\n Expenses:salud:prepagada\n Assets:Banco:ahorro:9350"))))
  2385. (goto-char (point-min))
  2386. ;; Perform replacements
  2387. (dolist (pair replacements)
  2388. (let ((search (car pair))
  2389. (replace (cdr pair)))
  2390. (while (search-forward search nil t)
  2391. (replace-match replace t)
  2392. (ledger-post-align-xact (point))
  2393. (goto-char (point-min)))))))
  2394. (defun procesa-Extracto-opt-cases ()
  2395. "Convert bancolombia->ledger format with user-defined cases for account numbers."
  2396. (interactive)
  2397. ;; Ask the user for the case they want to apply
  2398. (let ((case (completing-read "Choose the case (9350/8824/other): " '("9350" "8824" "other"))))
  2399. ;; Define the account number based on the user's input
  2400. (let ((account (cond
  2401. ((string= case "9350") "9350")
  2402. ((string= case "8824") "8824")
  2403. ((string= case "other") (read-string "Enter the custom account number: "))
  2404. (t "9350")))) ;; Default to 9350 if no valid case is chosen
  2405. ;; Define the replacements, dynamically inserting the account number
  2406. (let ((replacements
  2407. `((" " . " ")
  2408. (" BCA CLBIA POBLADO IMPTO GOBIERNO 4X1000" . ,(concat " Impuesto 4xmil\n Expenses:noOper:4xmil:" account " \n Assets:Banco:ahorro:" account))
  2409. (" BCA CLBIA POBLADO RETENCION EN LA FUENTE" . ,(concat " Impuesto Retención en la fuente\n Expenses:noOper:retefte:" account "\n Assets:Banco:ahorro:" account))
  2410. (" BCA CLBIA POBLADO PAGO PSE CORPORACION EDUCATIV Instituto Jorge Robledo" . ,(concat " PSE Instituto Jorge Robledo\n Expenses:Colegio:dante\n Assets:" account))
  2411. (" BCA CLBIA POBLADO IVA COMIS TRASLADO OTROS BCOS" . ,(concat " Comisión traslado otro banco\n Expenses:noOper:comision:otroBanco\n Assets:Banco:ahorro:" account))
  2412. (" BCA CLBIA POBLADO COMISION TRASLADO OTROS BANCOS" . ,(concat " Comisión traslado otro banco\n Expenses:noOper:comision:otroBanco\n Assets:Banco:ahorro:" account))
  2413. (" BCA CLBIA POBLADO TRASL A CTA CTE CUBRIR SOBREGI" . ,(concat " Cubrir sobregiro\n Expenses:noOper:sobregiro\n Assets:Bancos:ahorro:" account))
  2414. ("PLAZA MAYOR ABONO INTERESES AHORROS" . " Interes ahorro\n Revenues:noOper:interes:ola\n Assets:ola")
  2415. (" BCA CLBIA POBLADO PAGO CART HIPOT DEBITO AUTOM" . ,(concat " PAGO credito hipotecario apto 1901\n Liabilities:CxP:credito:5765\n Assets:Banco:ahorro:" account))
  2416. (" BCA CLBIA POBLADO ABONO INTERESES AHORROS" . ,(concat " Interes ahorro\n Revenues:noOper:interes:" account "\n Assets:Banco:ahorro:" account))
  2417. (" BCA CLBIA POBLADO PAGO LOPEZ CORREA FED98549000" . ,(concat " Coomeva FED98549000\n Expenses:salud:prepagada\n Assets:Banco:ahorro:" account)))))
  2418. ;; Start processing the buffer
  2419. (goto-char (point-min))
  2420. ;; Perform the replacements using the list of cons cells
  2421. (dolist (pair replacements)
  2422. (let ((search (car pair))
  2423. (replace (cdr pair)))
  2424. (while (search-forward search nil t)
  2425. (replace-match replace t)
  2426. (ledger-post-align-xact (point))
  2427. (goto-char (point-min)))))))))
  2428. (defun excel-to-ledger (input-buffer output-buffer)
  2429. "Convert Excel-like data in INPUT-BUFFER to ledger-cli format in OUTPUT-BUFFER."
  2430. (with-current-buffer input-buffer
  2431. (goto-char (point-min))
  2432. ;; Skip the header line
  2433. (forward-line 2)
  2434. (let ((transactions '()))
  2435. (while (not (eobp))
  2436. (let* ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
  2437. (fields (split-string line ","))
  2438. (cargo (nth 0 fields))
  2439. (tipo-contrato (nth 1 fields))
  2440. (horario (nth 2 fields))
  2441. (fecha-ingreso (nth 3 fields))
  2442. (centro-trabajo (nth 4 fields))
  2443. (codigo-planilla (nth 5 fields))
  2444. (id (nth 6 fields))
  2445. (nombres (nth 7 fields))
  2446. (apellidos (nth 8 fields))
  2447. (edad (nth 9 fields))
  2448. (rh (nth 10 fields))
  2449. (cedula (nth 11 fields))
  2450. (fecha-nacimiento (nth 12 fields))
  2451. (fecha-expedicion (nth 13 fields))
  2452. (lugar (nth 14 fields))
  2453. (direccion (nth 15 fields))
  2454. (telefono (nth 16 fields))
  2455. (correo (nth 17 fields))
  2456. (ibc (nth 18 fields))
  2457. (eps (nth 19 fields))
  2458. (puntaje-sisben (nth 20 fields))
  2459. (arl (nth 21 fields))
  2460. (riesgo (nth 22 fields))
  2461. (actividad-economica (nth 23 fields))
  2462. (pensiones (nth 24 fields))
  2463. (ccf (nth 25 fields))
  2464. (cesantias (nth 26 fields))
  2465. (metodo-pago (nth 27 fields))
  2466. (cta-bancaria (nth 28 fields))
  2467. (entidad (nth 29 fields))
  2468. (tipo-cuenta (nth 30 fields))
  2469. (direccion-sucursal (nth 31 fields))
  2470. (es-titular (nth 32 fields))
  2471. (cedula-titular (nth 33 fields)))
  2472. (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))
  2473. (forward-line 1))
  2474. (with-current-buffer output-buffer
  2475. (erase-buffer)
  2476. (dolist (transaction transactions)
  2477. (insert transaction "\n"))))))
  2478. (defun excel-to-ledger (input-buffer output-buffer)
  2479. "Convert Excel-like data in INPUT-BUFFER to ledger-cli format in OUTPUT-BUFFER."
  2480. (with-current-buffer input-buffer
  2481. (goto-char (point-min))
  2482. ;; Skip the header line
  2483. (forward-line 1)
  2484. (let ((transactions '()))
  2485. (while (not (eobp))
  2486. (let* ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
  2487. (fields (split-string line ","))
  2488. (cargo (nth 2 fields))
  2489. (tipo-contrato (nth 3 fields))
  2490. (horario (nth 4 fields))
  2491. (fecha-ingreso (nth 5 fields))
  2492. (centro-trabajo (nth 6 fields))
  2493. (codigo-planilla (nth 7 fields))
  2494. (id (nth 8 fields))
  2495. (nombres (nth 9 fields))
  2496. (apellidos (nth 10 fields))
  2497. (edad (nth 11 fields))
  2498. (rh (nth 12 fields))
  2499. (cedula (nth 13 fields))
  2500. (fecha-nacimiento (nth 14 fields))
  2501. (fecha-expedicion (nth 15 fields))
  2502. (lugar (nth 16 fields))
  2503. (direccion (nth 17 fields))
  2504. (telefono (nth 18 fields))
  2505. (correo (nth 19 fields))
  2506. (ibc (nth 20 fields))
  2507. (eps (nth 21 fields))
  2508. (puntaje-sisben (nth 22 fields))
  2509. (arl (nth 23 fields))
  2510. (riesgo (nth 24 fields))
  2511. (actividad-economica (nth 25 fields))
  2512. (pensiones (nth 26 fields))
  2513. (ccf (nth 27 fields))
  2514. (cesantias (nth 28 fields))
  2515. (metodo-pago (nth 29 fields))
  2516. (cta-bancaria (nth 30 fields))
  2517. (entidad (nth 31 fields))
  2518. (tipo-cuenta (nth 32 fields))
  2519. (direccion-sucursal (nth 33 fields))
  2520. (es-titular (nth 34 fields))
  2521. (cedula-titular (nth 35 fields)))
  2522. (add-to-list 'transactions (format "%s %s %s
  2523. Assets:personal $%s
  2524. ;; cargo: %s
  2525. ;; tipo-contrato: %s
  2526. ;; horario: %s
  2527. ;; centro-trabajo: %s
  2528. ;; codigo-planilla-soi: %s
  2529. ;; id: %s
  2530. ;; edad: %s
  2531. ;; rh: %s
  2532. ;; cedula: %s
  2533. ;; fecha-nacimiento: %s
  2534. ;; fecha-expedicion-cedula: %s
  2535. ;; lugar-expedicion: %s
  2536. ;; direccion: %s
  2537. ;; telefono: %s
  2538. ;; correo: %s
  2539. ;; eps: %s
  2540. ;; puntaje-sisben: %s
  2541. ;; arl: %s
  2542. ;; riesgo: %s
  2543. ;; actividad-economica: %s
  2544. ;; pensiones: %s
  2545. ;; ccf: %s
  2546. ;; cesantias: %s
  2547. ;; metodo-pago: %s
  2548. ;; cuenta-bancaria: %s
  2549. ;; entidad: %s
  2550. ;; tipo-cuenta: %s
  2551. ;; sucursal: %s
  2552. ;; es-titular: %s
  2553. ;; cedula-titular: %s
  2554. Time
  2555. " 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))
  2556. (forward-line 1))
  2557. (with-current-buffer output-buffer
  2558. (erase-buffer)
  2559. (dolist (transaction transactions)
  2560. (insert transaction "\n"))))))
  2561. ;; (excel-to-ledger "input-buffer-name" "output-buffer-name")
  2562. (defun siigo-csv-to-ledger (input-buffer output-buffer)
  2563. "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 ;;"
  2564. (with-current-buffer input-buffer
  2565. (goto-char (point-min))
  2566. ;; Skip the header line
  2567. (forward-line 1)
  2568. (let ((transactions '()))
  2569. (while (not (eobp))
  2570. (let* ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
  2571. (fields (split-string line ";;"))
  2572. (col01 (nth 1 fields))
  2573. (col02 (nth 2 fields))
  2574. (col03 (nth 3 fields))
  2575. (col04 (nth 4 fields))
  2576. (col05 (nth 5 fields))
  2577. (col06 (nth 6 fields))
  2578. (col07 (nth 7 fields))
  2579. (col08 (nth 8 fields))
  2580. (col09 (nth 9 fields))
  2581. (col10 (nth 10 fields))
  2582. (col11 (nth 11 fields))
  2583. (col12 (nth 12 fields))
  2584. (col13 (nth 13 fields))
  2585. (col14 (nth 14 fields))
  2586. (col15 (nth 15 fields))
  2587. (col16 (nth 16 fields))
  2588. (col17 (nth 17 fields)))
  2589. ;; (test (+ 100000 (flat-money col15))))
  2590. (add-to-list 'transactions (concat col02 " " col01 " " col05 "\n"
  2591. " ;; NIT: " col03 "\n"
  2592. " ;; fact: " col01 "\n"
  2593. " ;; doc: \n"
  2594. " Revenues: $" col07 "\n"
  2595. " Liabilities:CxP:impuesto:iva -$" col10 "\n"
  2596. " Assets:CxC:Impuesto:rtefte $" col12 "\n"
  2597. " Assets:clienteNacional: $" col15 "\n"
  2598. " Liabilities:CxP:impuesto:rtefte -$0.0 ;; calcular" "\n"
  2599. " Autorretencion \n"
  2600. ) t))
  2601. (forward-line 1))
  2602. (with-current-buffer output-buffer
  2603. (erase-buffer)
  2604. (dolist (transaction transactions)
  2605. (insert transaction "\n")
  2606. (ledger-post-align-xact (point)))))))
  2607. ;; (siigo-csv-to-ledger "input-buffer-name" "output-buffer-name")
  2608. (defun flat-money (x)
  2609. "Remove commas, quotes, and cents from the string X, then parse it as an integer."
  2610. (let* ((cleaned (replace-regexp-in-string "[,\"]" "" x))
  2611. (without-cents (if (string-match "\\." cleaned)
  2612. (substring cleaned 0 (match-beginning 0))
  2613. cleaned)))
  2614. (string-to-number without-cents)))
  2615. ;; Test the function
  2616. ;;(let ((col16 "3,402,169.89"))
  2617. ;; (string-to-number (flat-money col16))) ;; should return 1234567
  2618. (defun copy-buffer-file-path ()
  2619. "Copy the file path of the buffer's associated file to the clipboard.
  2620. Raise an error if the buffer does not contain a file associated."
  2621. (interactive)
  2622. (let ((file-path (buffer-file-name)))
  2623. (if file-path
  2624. (progn
  2625. (kill-new file-path)
  2626. (message "Copied file path: %s" file-path))
  2627. (error "Buffer does not contain a file associated"))))
  2628. ;; Usage:
  2629. ;; Call the function `copy-buffer-file-path` when the point is in the buffer.
  2630. (defun causa-generico-egreso()
  2631. (interactive)
  2632. (move-beginning-of-line 0)
  2633. (forward-word 3)
  2634. (kill-word 3)
  2635. (search-forward "$" )
  2636. (backward-word 1)
  2637. (newline)
  2638. (insert " Expenses: ")
  2639. (newline)
  2640. (insert " Assets:Banco:ahorro:9350 ")
  2641. (backward--invert-currency)
  2642. (forward-word 3)
  2643. (ledger-post-align-xact (point)))
  2644. (defun causa-generico-ingreso()
  2645. (interactive)
  2646. (move-beginning-of-line 0)
  2647. (forward-word 3)
  2648. (kill-word 3)
  2649. (search-forward "$" )
  2650. (backward-word 1)
  2651. (newline)
  2652. (insert " Revenues: ")
  2653. (newline)
  2654. (insert " Assets:Banco:ahorro:9350 ")
  2655. (backward--invert-currency)
  2656. (ledger-post-align-xact (point)))
  2657. (defun causa-generico-assets-cliente()
  2658. (interactive)
  2659. (move-beginning-of-line 0)
  2660. (forward-word 3)
  2661. (kill-word 3)
  2662. (search-forward "$" )
  2663. (backward-word 1)
  2664. (newline)
  2665. (insert " Assets:clienteNacional: ")
  2666. (newline)
  2667. (insert " Assets:Banco:ahorro:9350 ")
  2668. (ledger-post-align-xact (point))
  2669. (backward--invert-currency))
  2670. (defun replace-in-string (what with in)
  2671. (replace-regexp-in-string (regexp-quote what) with in nil 'literal))
  2672. (defun invierte_separador_punto ()
  2673. (interactive)
  2674. (while (re-search-forward "\\,[0-9][0-9]$" nil t ) ;; verifica solo espacio o fin de línea
  2675. (backward-char 3)
  2676. (delete-char 1)
  2677. (insert ".")
  2678. ))
  2679. (defun prepara_papeleta ()
  2680. "Solo reemplaza los separadores de miles y los asteriscos"
  2681. (interactive)
  2682. (while (re-search-forward "\\." nil t)
  2683. (replace-match ","))
  2684. (goto-line (point-min))
  2685. (while (re-search-forward "*" nil t)
  2686. (replace-match ""))
  2687. (goto-line (point-min))
  2688. (invierte_separador_punto))
  2689. (defun ledger-toggle-current (&optional style)
  2690. "Toggle the current thing at point with optional STYLE."
  2691. (interactive)
  2692. (if (or ledger-clear-whole-transactions
  2693. (eq 'transaction (ledger-thing-at-point)))
  2694. (let ((point-a -1)
  2695. (point-b 0))
  2696. (save-excursion
  2697. (forward-line)
  2698. (goto-char (line-beginning-position))
  2699. (while (and (not (= point-a point-b))
  2700. (not (eolp))
  2701. (save-excursion
  2702. (not (eq 'transaction (ledger-thing-at-point)))))
  2703. (if (looking-at "\\s-+[*!]")
  2704. (ledger-toggle-current-posting style))
  2705. (setq point-a (point))
  2706. (forward-line)
  2707. (goto-char (line-beginning-position))
  2708. (setq point-b (point))))
  2709. (ledger-toggle-current-transaction style))
  2710. (ledger-toggle-current-posting style)))
  2711. (defun procesa_recibo_individual ()
  2712. (interactive)
  2713. (next-line 1)
  2714. (kill-line 5)
  2715. (next-line 3)
  2716. (kill-line)
  2717. (next-line 1)
  2718. (kill-line)(next-line 1)
  2719. (move-beginning-of-line 0)
  2720. (delete-char -1) (insert " ")
  2721. (next-line 1)
  2722. (kill-line)
  2723. (next-line 1)
  2724. (kill-line)
  2725. (delete-char -1) (insert " ")
  2726. ;; cada bloque con espacio entrelazado
  2727. (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ")
  2728. (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ")
  2729. (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ")
  2730. (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ")
  2731. (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1)
  2732. (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1);;valor
  2733. ;; 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)
  2734. (move-beginning-of-line 0) (search-forward ":") (insert " $") (search-forward ".") (delete-char -1) (insert ",") (search-forward ",") (delete-char -1) (insert ".")
  2735. (next-line 2) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ");; concepto
  2736. (next-line 1) (kill-line) ;; referencia
  2737. (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ")
  2738. (next-line 1) (kill-line) (next-line 1) (kill-line) (delete-char -1) (insert " ")
  2739. (next-line 1)
  2740. (newline 3)
  2741. (insert "================")
  2742. (newline 3)
  2743. )
  2744. (defun fix_cone ()
  2745. "Solo funciona para el primer grupo de miles de una cantidad con dos decimales ej. 1234.00 queda 1,234.00"
  2746. (interactive)
  2747. (next-line 1)
  2748. (move-end-of-line 1)
  2749. (forward-char -6)
  2750. (insert ",")
  2751. (ledger-post-align-xact (point))
  2752. (ledger-navigate-next-xact-or-directive))
  2753. (defun arregla_recibo_individual ()
  2754. (interactive)
  2755. (next-line 48) (kill-line)
  2756. (next-line -3) (move-end-of-line 0) (yank)
  2757. (kill-line)
  2758. (next-line 3) (kill-line)
  2759. (next-line -48)
  2760. (procesa_recibo_individual))
  2761. (defun get-point (symbol &optional arg)
  2762. "get the point"
  2763. (funcall symbol arg)
  2764. (point))
  2765. (defun copy-thing (begin-of-thing end-of-thing &optional arg)
  2766. "Copy thing between beg & end into kill ring."
  2767. (save-excursion
  2768. (let ((beg (get-point begin-of-thing 1))
  2769. (end (get-point end-of-thing arg)))
  2770. (copy-region-as-kill beg end))))
  2771. (defun paste-to-mark (&optional arg)
  2772. "Paste things to mark, or to the prompt in shell-mode."
  2773. (unless (eq arg 1)
  2774. (if (string= "shell-mode" major-mode)
  2775. (comint-next-prompt 25535)
  2776. (goto-char (mark)))
  2777. (yank)))
  2778. (defun copy-word (&optional arg)
  2779. "Copy words at point into kill-ring"
  2780. (interactive "P")
  2781. (copy-thing 'backward-word 'forward-word arg)
  2782. ;;(paste-to-mark arg)
  2783. )
  2784. (defun copy-paragraph (&optional arg)
  2785. "Copy paragraphes at point"
  2786. (interactive "P")
  2787. (copy-thing 'backward-paragraph 'forward-paragraph arg)
  2788. (paste-to-mark arg)
  2789. )
  2790. (defun copy-word-2 (&optional arg)
  2791. "Copy words at point into kill-ring"
  2792. (interactive "P")
  2793. (let ((beg (progn (if (looking-back "[a-zA-Z0-9]" 1) (backward-word 1)) (point)))
  2794. (end (progn (forward-word arg) (point))))
  2795. (copy-region-as-kill beg end)))
  2796. (defun monta-pago-ledger (banco cuenta tipoCuenta id beneficiario referencia valor)
  2797. (let* ((date (format-time-string "%Y/%m/%d "))
  2798. (text (concat "\n"date " " beneficiario
  2799. "\n ;; id_pagador: 901429017 "
  2800. "\n ;; cuenta_receptor: " cuenta
  2801. "\n ;; tipo: " tipoCuenta
  2802. "\n ;; banco: " banco
  2803. "\n ;; id_receptor: " id
  2804. "\n ;; referencia: " referencia
  2805. "\n registro " valor
  2806. "\n Time"
  2807. )))
  2808. (insert text )))
  2809. (defun reverse-date ()
  2810. "Invierte el orden de una fecha de \"DD/MM/AAAA\" a \"AAAA/MM/DD\""
  2811. (interactive)
  2812. (let* ((day (progn
  2813. (set-mark-command nil)
  2814. (forward-char 2)
  2815. (kill-ring-save (mark) (point))
  2816. (current-kill 0 t)))
  2817. (month (progn
  2818. (forward-char 1)
  2819. (set-mark-command nil)
  2820. (forward-char 2)
  2821. (kill-ring-save (mark) (point))
  2822. (current-kill 0 t)))
  2823. (year (progn
  2824. (forward-char 1)
  2825. (set-mark-command nil)
  2826. (forward-char 4)
  2827. (kill-ring-save (mark) (point))
  2828. (current-kill 0 t)))
  2829. (separator "\\"))
  2830. (print (concat year "\\" month day))))
  2831. ;"DD/MM/AAAA"
  2832. (defun importa-facturas-siigo (Tipo Comprobante Fecha Identificación Suc Nombre Moneda bruto Descuento Subtotal IVA Impoconsumo Retefuente ReteIVA ReteICA Total)
  2833. (let* (
  2834. )))
  2835. ;;(org-agenda-convert-date "19/04/2024")
  2836. (defun correo_desde_comprobante ()
  2837. "Desde una papeleta con miles y asteriscos corregidos, inserta en un libro
  2838. de ledger, crea un archivo (TODO: completar la info), prepara un correo con
  2839. adjunto, asunto y contenido"
  2840. ;; BUG: si la cantidad es mayor a 999999 inserta punto en vez de coma en el segundo separador
  2841. (interactive)
  2842. (let* ((cuenta (progn
  2843. (search-forward "cuenta:")
  2844. (set-mark-command nil)
  2845. (forward-word 1)
  2846. (kill-ring-save (mark) (point))
  2847. (current-kill 0 t)))
  2848. (beneficiario (progn
  2849. (search-forward "beneficiario:")
  2850. (set-mark-command nil)
  2851. (move-end-of-line 1)
  2852. (kill-ring-save (mark) (point))
  2853. (current-kill 0 t)))
  2854. (cedula (progn
  2855. (search-forward "Documento:")
  2856. (set-mark-command nil)
  2857. (forward-word 1)
  2858. (kill-ring-save (mark) (point))
  2859. (current-kill 0 t)))
  2860. (valor (progn
  2861. (search-forward "Valor:")
  2862. (forward-char 1)
  2863. (set-mark-command nil)
  2864. (forward-word 3)
  2865. (kill-ring-save (mark) (point))
  2866. (current-kill 0 t)))
  2867. (concepto (progn
  2868. (search-forward "Concepto:")
  2869. (forward-char 1)
  2870. (set-mark-command nil)
  2871. (move-end-of-line 1)
  2872. (kill-ring-save (mark) (point))
  2873. (current-kill 0 t)))
  2874. (recibo (progn
  2875. (mark-paragraph 1)
  2876. (kill-ring-save (mark) (point))
  2877. (current-kill 0 t)))
  2878. (date (format-time-string "%Y-%m-%d "))
  2879. (date-ledger (format-time-string "%Y/%m/%d "))
  2880. (options '("ALC" "pNatural" "yo" "test"))
  2881. (destino (completing-read "Selecciona: " options nil t))
  2882. (period (read-from-minibuffer "Período: "))
  2883. (cta-destino cuenta)
  2884. (nit-destino cedula)
  2885. (razon-social beneficiario)
  2886. (ledger-val valor)
  2887. (val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" ledger-val))
  2888. (number-to-words (replace-regexp-in-string " " "" (shell-command-to-string (concat "numero_a_letras" " " val))))
  2889. (ledger-account " Expenses: ")
  2890. (tag1 (read-from-minibuffer "Tag: "))
  2891. (tags (concat " -- " " pago " tag1 ))
  2892. (ext ".txt")
  2893. (valor_plano (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" valor))
  2894. (subject (concat date ":pago:" tag1 ":" beneficiario " " concepto " v " valor_plano)))
  2895. ;;(fpath (concat path date period " " beneficiario " " "v " val " " tags ext))
  2896. (pcase destino
  2897. ("ALC" (progn
  2898. (setq
  2899. maildir "contacto.ola38@gmail.com"
  2900. fpath (concat "~/Dropbox/ALC/" date period " " beneficiario " " "v " val " " tags ext)
  2901. path2 "~/ola38/pagos_OLA38.ldg"
  2902. ledger-asset " Assets:Banco:ahorro:0609 ")
  2903. (write-region recibo nil fpath) ;; create empty file
  2904. (write-region (concat "\n" date-ledger "PAGO " period " " beneficiario "\n"
  2905. " ; comprobante: EGRESOS No. \n ;\n"
  2906. " ; EMPRESA: OLA38 S.A.S. NIT: 901429017-6 \n"
  2907. " ; CIUDAD: Medellín \n ;\n"
  2908. " ; ctaOrigen: 25900000609 \n"
  2909. " ; ctaDestino:" cta-destino " \n ;\n"
  2910. " ; PAGADO A: " razon-social "\n ;\n"
  2911. " ; NIT: " nit-destino "\n ;\n"
  2912. " ; DESCRIPCION: PAGO " period " " beneficiario "\n ;\n"
  2913. " ; EN LETRAS: " number-to-words "\n"
  2914. " ; RETENCION: \n"
  2915. ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append)))
  2916. ("pNatural" (progn
  2917. (setq
  2918. maildir "fede2001@gmail.com"
  2919. fpath (concat "~/Dropbox/pNatural/" date period " " beneficiario " " "v " val " " tags ext)
  2920. path2 "~/Admin/cuentas.ldg"
  2921. ledger-asset " Assets:Banco:ahorro:9350 ")
  2922. (write-region paste nil fpath) ;; create empty file
  2923. (write-region
  2924. (concat "\n" date-ledger "PAGO " period " " beneficiario "\n"
  2925. ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append)))
  2926. ("yo" (progn
  2927. (setq
  2928. maildir "fede2001@gmail.com"
  2929. fpath (concat "~/Dropbox/yo/" date period " " beneficiario " " "v " val " " tags ext)
  2930. path2 "~/Admin/cuentasFLC.ldg"
  2931. ledger-asset " Assets:Banco:ahorro:8824 ")
  2932. (write-region paste nil fpath) ;; create empty file
  2933. (write-region
  2934. (concat "\n" date-ledger "PAGO " period " " beneficiario "\n"
  2935. ledger-account ledger-val "\n" ledger-asset "-" ledger-val "\n") nil path2 'append)))
  2936. (_ (message "nada")))
  2937. (compose-mail maildir subject nil nil nil nil nil nil)
  2938. (mail-text) (insert (concat beneficiario "\n" "cuenta: " cuenta "\n" "valor: " valor "\n\n" recibo))
  2939. (mml-attach-file fpath "text/x-patch" nil "attachment")))
  2940. (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"))
  2941. (defun correo-selecciona-de-lista ()
  2942. "Send an email by selecting from a list of email addresses and optionally adding an attachment."
  2943. (interactive)
  2944. (let* ((to-address (completing-read "Select recipient: " my-email-addresses))
  2945. (subject (read-string "Subject: "))
  2946. (body (read-string "Body: "))
  2947. (attachment (read-file-name "Select attachment (leave empty if none): " nil nil t)))
  2948. (compose-mail to-address subject)
  2949. (message-goto-body)
  2950. (insert body)
  2951. (when (and attachment (not (string= attachment "")))
  2952. (mml-attach-file attachment))
  2953. (message-goto-to)))
  2954. ;; Example usage: M-x my-send-mail
  2955. (defun correo-adiciona-recipiente-de-lista ()
  2956. "Send an email by selecting from a list of email addresses and optionally adding an attachment."
  2957. (interactive)
  2958. (let* ((to-address (completing-read "Select recipient: " my-email-addresses)))
  2959. (goto-line 1)
  2960. (move-end-of-line 1)
  2961. (insert (concat ", " to-address))))
  2962. (defun correo_desde_papeleta ()
  2963. "Según los saltos se posiciona en la línea 1"
  2964. ;; BUG: si la cantidad es mayor a 999999 inserta punto en vez de coma en el segundo separador
  2965. (interactive)
  2966. (prepara_papeleta)
  2967. (let* ((operacion (progn
  2968. (goto-line 7)
  2969. (set-mark-command nil)
  2970. (forward-word 1)
  2971. (kill-ring-save (mark) (point))
  2972. (current-kill 0 t)))
  2973. (fecha (progn
  2974. (goto-line 8)
  2975. (set-mark-command nil)
  2976. (move-end-of-line 1)
  2977. (kill-ring-save (mark) (point))
  2978. (current-kill 0 t)))
  2979. (titulo (progn
  2980. (goto-line 26)
  2981. (forward-word 1)
  2982. (set-mark-command nil)
  2983. (move-end-of-line 1)
  2984. (kill-ring-save (mark) (point))
  2985. (current-kill 0 t)))
  2986. (cliente (progn
  2987. (goto-line 35)
  2988. (er-go-to-column 11)
  2989. (set-mark-command nil)
  2990. (move-end-of-line 1)
  2991. (kill-ring-save (mark) (point))
  2992. (current-kill 0 t)))
  2993. (cedula (progn
  2994. (goto-line 39)
  2995. (forward-word 1)
  2996. (set-mark-command nil)
  2997. (move-end-of-line 1)
  2998. (kill-ring-save (mark) (point))
  2999. (current-kill 0 t)))
  3000. (cantidad (progn
  3001. (goto-line 95)
  3002. (set-mark-command nil)
  3003. (move-end-of-line 1)
  3004. (kill-ring-save (mark) (point))
  3005. (current-kill 0 t)))
  3006. (precio (progn
  3007. (goto-line 99)
  3008. (set-mark-command nil)
  3009. (move-end-of-line 1)
  3010. (kill-ring-save (mark) (point))
  3011. (current-kill 0 t)))
  3012. (valor (progn
  3013. (goto-line 103)
  3014. (set-mark-command nil)
  3015. (move-end-of-line 1)
  3016. (kill-ring-save (mark) (point))
  3017. (current-kill 0 t)))
  3018. (comision (progn
  3019. (goto-line 107)
  3020. (set-mark-command nil)
  3021. (move-end-of-line 1)
  3022. (kill-ring-save (mark) (point))
  3023. (current-kill 0 t)))
  3024. (neto (progn
  3025. (goto-line 122)
  3026. (set-mark-command nil)
  3027. (move-end-of-line 1)
  3028. (kill-ring-save (mark) (point))
  3029. (current-kill 0 t)))
  3030. (iva (progn
  3031. (goto-line 126)
  3032. (set-mark-command nil)
  3033. (move-end-of-line 1)
  3034. (kill-ring-save (mark) (point))
  3035. (current-kill 0 t)))
  3036. (neto-iva (progn
  3037. (goto-line 132)
  3038. (set-mark-command nil)
  3039. (move-end-of-line 1)
  3040. (kill-ring-save (mark) (point))
  3041. (current-kill 0 t)))
  3042. (date (format-time-string "%Y-%m-%d "))
  3043. (date-ledger (format-time-string "%Y/%m/%d "))
  3044. (options '("ALC" "pNatural" "yo" "test"))
  3045. (destino (completing-read "Selecciona: " options nil t))
  3046. (period (read-from-minibuffer "Período: "))
  3047. (val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" neto-iva))
  3048. (ledger-account " Expenses: ")
  3049. (tag1 (read-from-minibuffer "Tag: "))
  3050. (tags (concat " -- " " pago " tag1 ))
  3051. (ext ".txt")
  3052. (valor_plano (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" neto-iva))
  3053. (paste (concat "\n" date-ledger operacion " " cantidad " " titulo " " cliente "\n"
  3054. " Assets:accion " valor "\n"
  3055. " Expenses:noOper:iva " iva "\n"
  3056. " Expenses:noOper:comision:accion " comision "\n"
  3057. ledger-asset "-" neto-iva "\n"))
  3058. (subject (concat date ":papeleta:" tag1 ": " operacion " " cliente " v " valor_plano)))
  3059. ;;(fpath (concat path date period " " beneficiario " " "v " val " " tags ext))
  3060. (pcase destino
  3061. ("pNatural" (progn
  3062. (setq
  3063. maildir "fede2001@gmail.com"
  3064. fpath (concat "~/Dropbox/pNatural/" date period " " cliente " " "v " val " " tags ext)
  3065. path2 "~/Admin/Assets Acciones -- privado critico.ldg"
  3066. ledger-asset " Assets:fondo ")
  3067. (write-region paste nil fpath) ;; create empty file
  3068. (write-region
  3069. (concat "\n" date-ledger operacion " " cantidad " " titulo " " cliente "\n"
  3070. " Assets:accion " valor "\n"
  3071. " Expenses:noOper:iva " iva "\n"
  3072. " Expenses:noOper:comision:accion " comision "\n"
  3073. ledger-asset "-" neto-iva "\n") nil path2 'append)))
  3074. (_ (message "nada")))
  3075. (compose-mail maildir subject nil nil nil nil nil nil)
  3076. (mail-text) (insert (concat cliente "\n" "operacion: " operacion "\n" titulo " " cantidad "\n" "valor: " valor "\n\n" ))
  3077. (mml-attach-file fpath "text/x-patch" nil "attachment")))
  3078. (defun correo_desde_papeleta-opt ()
  3079. "Compose and send email from papeleta information."
  3080. (interactive)
  3081. (prepara_papeleta)
  3082. (let* ((operacion (extract-papeleta-info 7))
  3083. (fecha (extract-papeleta-info 8))
  3084. (titulo (extract-papeleta-info 26))
  3085. (cliente (extract-papeleta-info 35 11))
  3086. (cedula (extract-papeleta-info 39))
  3087. (cantidad (extract-papeleta-info 95))
  3088. (precio (extract-papeleta-info 99))
  3089. (valor (extract-papeleta-info 103))
  3090. (comision (extract-papeleta-info 107))
  3091. (neto (extract-papeleta-info 122))
  3092. (iva (extract-papeleta-info 126))
  3093. (neto-iva (extract-papeleta-info 132))
  3094. (date (format-time-string "%Y-%m-%d "))
  3095. (date-ledger (format-time-string "%Y/%m/%d "))
  3096. (options '("ALC" "pNatural" "yo" "test"))
  3097. (destino (completing-read "Selecciona: " options nil t))
  3098. (period (read-from-minibuffer "Período: "))
  3099. (val (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" neto-iva))
  3100. (ledger-account " Expenses: ")
  3101. (tag1 (read-from-minibuffer "Tag: "))
  3102. (tags (concat " -- " " pago " tag1))
  3103. (ext ".txt")
  3104. (valor-plano (replace-regexp-in-string "\\$\\|\\,\\|\\.00" "" neto-iva))
  3105. (paste (concat "\n" date-ledger operacion " " cantidad " " titulo " " cliente "\n"
  3106. " Assets:accion " valor "\n"
  3107. " Expenses:noOper:iva " iva "\n"
  3108. " Expenses:noOper:comision:accion " comision "\n"
  3109. ledger-asset "-" neto-iva "\n"))
  3110. (subject (concat date ":papeleta:" tag1 ": " operacion " " cliente " v " valor-plano)))
  3111. (pcase destino
  3112. ("pNatural" (send-email-pNatural destino date operacion cantidad titulo cliente valor iva comision neto-iva paste path date-ledger tag1 tags ext))
  3113. (_ (message "nada")))))
  3114. (defun extract-papeleta-info (line &optional column)
  3115. "Extract information from papeleta at LINE. If COLUMN is provided, move to that column."
  3116. (goto-line line)
  3117. (when column (er-go-to-column column))
  3118. (let ((beg (point)))
  3119. (end-of-line)
  3120. (buffer-substring-no-properties beg (point))))
  3121. (defun send-email-pNatural (destino date operacion cantidad titulo cliente valor iva comision neto-iva paste path date-ledger tag1 tags ext)
  3122. "Send email to pNatural with papeleta information."
  3123. (setq
  3124. maildir "fede2001@gmail.com"
  3125. fpath (concat "~/Dropbox/pNatural/" date period " " cliente " " "v " val " " tags ext)
  3126. path2 "~/Admin/Assets Acciones -- privado critico.ldg"
  3127. ledger-asset " Assets:fondo ")
  3128. (write-region paste nil fpath) ;; create empty file
  3129. (write-region
  3130. (concat "\n" date-ledger operacion " " cantidad " " titulo " " cliente "\n"
  3131. " Assets:accion " valor "\n"
  3132. " Expenses:noOper:iva " iva "\n"
  3133. " Expenses:noOper:comision:accion " comision "\n"
  3134. ledger-asset "-" neto-iva "\n") nil path2 'append))
  3135. (defun correo_desde_comprobante_crudo_incompleta ()
  3136. ;; BUG: si la cantidad es mayor a 999999 inserta punto en vez de coma en el segundo separador
  3137. (interactive)
  3138. (let* ((cuenta_destino (progn
  3139. (next-line 12)
  3140. (move-beginning-of-line 1)
  3141. (set-mark-command nil)
  3142. (move-end-of-line 1)
  3143. (kill-ring-save (mark) (point))
  3144. (current-kill 0 t))))))
  3145. (defun random-theme ()
  3146. "adapted from https://github.com/gopar/rand-theme"
  3147. (interactive)
  3148. (mapc 'disable-theme custom-enabled-themes)
  3149. (setq theme (nth (random (length (custom-available-themes))) (custom-available-themes)))
  3150. (load-theme theme)
  3151. (message "Loaded Theme: %s" (symbol-name theme)))
  3152. (defun fav-random-theme ()
  3153. "adapted from https://github.com/gopar/rand-theme"
  3154. (interactive)
  3155. (mapc 'disable-theme custom-enabled-themes)
  3156. (setq theme (nth (random (length fav-themes)) fav-themes))
  3157. (load-theme theme)
  3158. (message "Loaded Theme: %s" (symbol-name theme)))
  3159. (defun fechas-pasado-a-hoy ()
  3160. "Reemplaza fechas de días pasados a hoy, no usar en contabilidad"
  3161. (interactive)
  3162. (let ((date (read-from-minibuffer "Fecha [AAAA/MM/DD]:")))
  3163. (progn
  3164. (goto-char (point-min))
  3165. (while
  3166. ;; (re-search-forward "\\(=2022/\\(11|10\\)/[0-9][0-9]\\)" nil t)
  3167. (re-search-forward (concat "=" date) nil t) ;; mes
  3168. ;; (re-search-forward "\\(=2021/[0-9][0-9]/[0-9][0-9]\\)" nil t)
  3169. ;;(re-search-forward "=2022/12/06" nil t) ;; dia
  3170. (replace-match (concat "=" (format-time-string "%Y/%m/%d")) t)
  3171. (goto-line (point-min))))))
  3172. (fset 'dividendosGLO
  3173. (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"))
  3174. (defun invert-currency ()
  3175. (interactive)
  3176. (beginning-of-line)
  3177. (search-forward "$" nil t)
  3178. (forward-char -2) ; para incluir el caso -$
  3179. (if (search-forward "-"
  3180. (cdr (bounds-of-thing-at-point 'line))
  3181. t)
  3182. (replace-match "")
  3183. (progn
  3184. (search-forward "$"
  3185. (cdr (bounds-of-thing-at-point 'line))
  3186. t)
  3187. (forward-char -1)
  3188. (insert "-")))
  3189. (line-move 1))
  3190. (defun agrega-centavos ()
  3191. "Agrega centavos .00 al final de la línea"
  3192. (interactive)
  3193. (end-of-line)
  3194. (insert ".00")
  3195. (forward-line 1))
  3196. (defun backward--invert-currency ()
  3197. (interactive)
  3198. (let ((beg (progn
  3199. (search-forward "$")
  3200. (forward-char -2)
  3201. (point)))
  3202. (end (progn
  3203. (end-of-line)
  3204. (point))))
  3205. (copy-region-as-kill beg end)
  3206. (line-move -1) ;; sube una línea
  3207. (end-of-line)
  3208. (insert " ") ;; ledger requiere separacion entre cantidad y cuenta
  3209. (yank)
  3210. (invert-currency)
  3211. (forward-line -1)
  3212. (ledger-post-align-xact beg)))
  3213. (defun forward-copy-invert-currency ()
  3214. (interactive)
  3215. (let ((beg (progn
  3216. (search-forward "$")
  3217. (forward-char -2)
  3218. (point)))
  3219. (end (progn
  3220. (end-of-line)
  3221. (point))))
  3222. (copy-region-as-kill beg end)
  3223. (line-move 1) ;; sube una línea
  3224. (end-of-line)
  3225. (insert " ") ;; ledger requiere separacion entre cantidad y cuenta
  3226. (yank)
  3227. (invert-currency)
  3228. (forward-line -1)
  3229. (ledger-post-align-xact beg)))
  3230. (defun backward--invert-currency ()
  3231. (interactive)
  3232. (let ((beg (progn
  3233. (search-forward "$")
  3234. (forward-char -2)
  3235. (point)))
  3236. (end (progn
  3237. (end-of-line)
  3238. (point))))
  3239. (copy-region-as-kill beg end)
  3240. (line-move -1) ;; sube una línea
  3241. (end-of-line)
  3242. (insert " ") ;; ledger requiere separacion entre cantidad y cuenta
  3243. (yank)
  3244. (invert-currency)
  3245. (forward-line -1)
  3246. (ledger-post-align-xact beg)))
  3247. (defun time-to-flame ()
  3248. (interactive)
  3249. ;;(goto-char (point-min))
  3250. (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
  3251. (replace-match "" t)
  3252. (goto-line (point-min)))
  3253. (while (re-search-forward "," nil t)
  3254. (replace-match "" t)
  3255. (goto-line (point-min)))
  3256. (while (re-search-forward ":" nil t)
  3257. (replace-match ";" t)
  3258. (goto-line (point-min)))
  3259. (while (re-search-forward "alc;" nil t)
  3260. (replace-match "" t)
  3261. (goto-line (point-min)))
  3262. ;;(delete-trailing-whitespace)
  3263. )
  3264. (defun shift-date (date days)
  3265. (format-time-string
  3266. "%F"
  3267. (time-add (time-to-seconds (days-to-time days))
  3268. (time-to-seconds (org-time-string-to-time date)))))
  3269. (defun timelog ()
  3270. (interactive)
  3271. (let* ((date (format-time-string "%Y/%m/%d %H:%M:%S"))
  3272. (options '("i" "o"))
  3273. (io (completing-read "Selecciona: " options nil t))
  3274. (account (read-from-minibuffer "account: "))
  3275. (details (read-from-minibuffer "detalles: "))
  3276. (fpath "~/SyncDocs/dellioTimelog.ldg")
  3277. )
  3278. (write-region (concat io " " date " " account " " details "\n" ) nil fpath 'append)
  3279. ))
  3280. ;; (defun shift-dates (days)
  3281. ;; "adapted from https://emacs.stackexchange.com/questions/37780/increment-days-months-dates-etc-within-buffer"
  3282. ;; (interactive "nDays: ")
  3283. ;; (save-excursion
  3284. ;; ;;(goto-char (point-min))
  3285. ;; (beginning-of-line)
  3286. ;; (
  3287. ;; ;(while (not (eobp))
  3288. ;; ;;(forward-char 1)
  3289. ;; (when (looking-at iso8601--full-date-match)
  3290. ;; (let ((date (shift-date (match-string 0) days)))
  3291. ;; (save-excursion
  3292. ;; (while (looking-at "[^\s\\|\n]")
  3293. ;; (delete-char 1))
  3294. ;; (insert date))))))
  3295. (defun shift-dates (days)
  3296. "adapted from https://emacs.stackexchange.com/questions/37780/increment-days-months-dates-etc-within-buffer"
  3297. (interactive "nDays: ")
  3298. (save-excursion
  3299. ;;(goto-char (point-min))
  3300. (beginning-of-line)
  3301. (
  3302. ;(while (not (eobp))
  3303. ;;(forward-char 1)
  3304. (when (looking-at iso8601--full-date-match)
  3305. (let ((date (shift-date (match-string 0) days)))
  3306. (save-excursion
  3307. (while (looking-at "[^\s\\|\n]")
  3308. (delete-char 1))
  3309. (insert date)))))))
  3310. ;; (defun shift-dates-internal (days)
  3311. ;; (save-excursion
  3312. ;; ;;(goto-char (point-min))
  3313. ;; (beginning-of-line)
  3314. ;; (dotimes (i 2)
  3315. ;; (search-forward "/" nil t)
  3316. ;; (replace-match "-"))
  3317. ;; ;(while (not (eobp))
  3318. ;; ;;(forward-char 1)
  3319. ;; (beginning-of-line)
  3320. ;; (when (looking-at iso8601--full-date-match)
  3321. ;; (let ((date (shift-date (match-string 0) days)))
  3322. ;; (save-excursion
  3323. ;; (while (looking-at "[^\s\\|\n]")
  3324. ;; (delete-char 1))
  3325. ;; (insert date))))
  3326. ;; (beginning-of-line)
  3327. ;; (dotimes (i 2)
  3328. ;; (search-forward "-" nil t)
  3329. ;; (replace-match "/"))))
  3330. (defun shift-one-day-backward ()
  3331. (interactive)
  3332. (shift-dates-internal -1))
  3333. (defun irc-log-integrator ()
  3334. (interactive)
  3335. (let ((channel (read-from-minibuffer "channel: " ))
  3336. (date (read-from-minibuffer "Fecha [AAAA-MM-DD]: ")))
  3337. (find-file "/tmp/1.txt")
  3338. (erase-buffer)
  3339. (find-file (concat "~/irclogs/#" channel "@libera%20chat_" date ".txt"))
  3340. (let ((beg (progn
  3341. (point-min)))
  3342. (end (progn
  3343. (point-max))))
  3344. (copy-region-as-kill beg end)
  3345. (progn
  3346. (find-file "/tmp/1.txt")
  3347. (forward-line 2)
  3348. (insert "\n\n;;;;;;;;;; \n;;;;;;;;;;\n\n ")
  3349. (insert (concat date " "))
  3350. (yank)
  3351. (goto-line (point-min))
  3352. (while (search-forward "[" nil t)
  3353. (replace-match (concat date " [")))))
  3354. (find-file "/tmp/1.txt")
  3355. (let ((beg (progn
  3356. (point-min)))
  3357. (end (progn
  3358. (point-max))))
  3359. (copy-region-as-kill beg end))
  3360. (find-file (concat "~/SyncDocs/summary_" channel "_roll.txt"))
  3361. (goto-line (point-max))
  3362. (yank)
  3363. (irc-log-integrator)))
  3364. (defun capture-currency-amount ()
  3365. (interactive)
  3366. (let ((selection
  3367. (progn
  3368. (line-substring-with-bidi-context (progn
  3369. (beginning-of-line)
  3370. (search-forward "-$" nil t)
  3371. (forward-char -2) ;; for -$ case
  3372. (point))
  3373. (progn
  3374. (end-of-line)
  3375. (point))))))
  3376. (if (string-match-p (regexp-quote "-") selection)
  3377. (progn
  3378. (forward-line -1)
  3379. (insert " ")
  3380. (insert selection)
  3381. (beggining-of-line)
  3382. (search-forward "$" nil t)
  3383. (forward-char -2) ;; for -$ case
  3384. (while (search-forward "-" nil t)
  3385. (replace-match "" t)))
  3386. (progn
  3387. (forward-line -1)
  3388. (insert "-")
  3389. (insert selection))
  3390. )))
  3391. (defun dividendos_sin_ref ()
  3392. (interactive)
  3393. (beginning-of-line)
  3394. (search-forward " BCA CLBIA POBLADO PAGO DE PROV VALORES BANCOLO" nil t)
  3395. (replace-match " Dividendos \n Revenues:noOper:dividendos \n Assets:Bancos:ahorro:9392 " t)
  3396. (let ((beg (progn
  3397. (search-forward "$")
  3398. (forward-char -2)
  3399. (point)))
  3400. (end (progn
  3401. (end-of-line)
  3402. (point))))
  3403. (copy-region-as-kill beg end)
  3404. (line-move -1) ;; sube una línea
  3405. (yank)
  3406. (invert-currency)
  3407. (forward-line -1)
  3408. (ledger-post-align-xact beg)))
  3409. ;; nice-to-have si el invierte el signo)
  3410. ;;(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"))
  3411. (fset 'Alianza-GLO
  3412. (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"))
  3413. (fset 'Livin-GLO
  3414. (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"))
  3415. (fset 'Invierte-Signos-MACRO
  3416. (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"))
  3417. (fset 'federico-paga-nomina-yakelin
  3418. (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"))
  3419. (fset 'Revenue:noOper:gasolina
  3420. (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"))
  3421. (fset 'signo-hace-negativo
  3422. (kmacro-lambda-form [?\C-s ?$ return ?- ?\C-d ?\C-a] 0 "%d"))
  3423. (defvar xah-brackets '("“”" "()" "[]" "{}" "<>" "<>" "()" "[]" "{}" "⦅⦆" "〚〛" "⦃⦄" "‹›" "«»" "「」" "〈〉" "《》" "【】" "〔〕" "⦗⦘" "『』" "〖〗" "〘〙" "「」" "⟦⟧" "⟨⟩" "⟪⟫" "⟮⟯" "⟬⟭" "⌈⌉" "⌊⌋" "⦇⦈" "⦉⦊" "❛❜" "❝❞" "❨❩" "❪❫" "❴❵" "❬❭" "❮❯" "❰❱" "❲❳" "〈〉" "⦑⦒" "⧼⧽" "﹙﹚" "﹛﹜" "﹝﹞" "⁽⁾" "₍₎" "⦋⦌" "⦍⦎" "⦏⦐" "⁅⁆" "⸢⸣" "⸤⸥" "⟅⟆" "⦓⦔" "⦕⦖" "⸦⸧" "⸨⸩" "⦅⦆")
  3424. "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.")
  3425. (defconst xah-left-brackets
  3426. (mapcar (lambda (x) (substring x 0 1)) xah-brackets)
  3427. "List of left bracket chars. Each element is a string.")
  3428. (defconst xah-right-brackets
  3429. (mapcar (lambda (x) (substring x 1 2)) xah-brackets)
  3430. "List of right bracket chars. Each element is a string.")
  3431. (defun xah-backward-left-bracket ()
  3432. "Move cursor to the previous occurrence of left bracket.
  3433. The list of brackets to jump to is defined by `xah-left-brackets'.
  3434. URL `http://xahlee.info/emacs/emacs/emacs_navigating_keys_for_brackets.html'
  3435. Version 2015-10-01"
  3436. (interactive)
  3437. (re-search-backward (regexp-opt xah-left-brackets) nil t))
  3438. (defun xah-forward-right-bracket ()
  3439. "Move cursor to the next occurrence of right bracket.
  3440. The list of brackets to jump to is defined by `xah-right-brackets'.
  3441. URL `http://xahlee.info/emacs/emacs/emacs_navigating_keys_for_brackets.html'
  3442. Version 2015-10-01"
  3443. (interactive)
  3444. (re-search-forward (regexp-opt xah-right-brackets) nil t))
  3445. ;; ###### EMMS Global
  3446. ;; ;; show everything
  3447. (emms-browser-make-filter "all" 'ignore)
  3448. ;; (defun emms-cache-delete ()
  3449. ;; interactive
  3450. ;; (emms-cache-del t))
  3451. (defadvice emms-browser-next-mapping-type
  3452. (after no-album (current-mapping))
  3453. (when (eq ad-return-value 'info-album)
  3454. (setq ad-return-value 'info-title)))
  3455. (defun toggle-album-display ()
  3456. (if (string= emms-browser-current-filter-name "singles")
  3457. (ad-activate 'emms-browser-next-mapping-type)
  3458. (ad-deactivate 'emms-browser-next-mapping-type)))
  3459. (add-hook 'emms-browser-filter-changed-hook 'toggle-album-display)
  3460. ;; ;; Set "all" as the default filter
  3461. (emms-browser-set-filter (assoc "all" emms-browser-filters))
  3462. ;; show all files (no streamlists, etc)
  3463. (emms-browser-make-filter
  3464. "all-files" (emms-browser-filter-only-type 'file))
  3465. ;; ;; show only tracks in one folder
  3466. (emms-browser-make-filter
  3467. "SyncMusic" (emms-browser-filter-only-dir "~/SyncMusic/"))
  3468. ;; ;; show only tracks in one folder
  3469. (emms-browser-make-filter
  3470. "Music" (emms-browser-filter-only-dir "~/Music/"))
  3471. ;; show all tracks played in the last month
  3472. (emms-browser-make-filter
  3473. "last-month" (emms-browser-filter-only-recent 30))
  3474. ;; After executing the above commands, you can use M-x
  3475. ;; emms-browser-show-all, emms-browser-show-80s, etc to toggle
  3476. ;; between different collections. Alternatively you can use '<' and
  3477. ;; '>' to cycle through the available filters.
  3478. ;; The second argument to make-filter is a function which returns t if
  3479. ;; a single track should be filtered. You can write your own filter
  3480. ;; functions to check the type of a file, etc.
  3481. ;; Some more examples:
  3482. ;; show only tracks not played in the last year
  3483. (emms-browser-make-filter "not-played"
  3484. (lambda (track)
  3485. (not (funcall (emms-browser-filter-only-recent 365) track))))
  3486. ;; ;; show all files that are not in the pending directory
  3487. ;; (emms-browser-make-filter
  3488. ;; "all"
  3489. ;; (lambda (track)
  3490. ;; (or
  3491. ;; (funcall (emms-browser-filter-only-type 'file) track)
  3492. ;; (not (funcall
  3493. ;; (emms-browser-filter-only-dir "~/Media/pending") track)))))
  3494. (setq-default
  3495. emms-source-playlist-default-format 'native
  3496. emms-playlist-mode-center-when-go t
  3497. emms-playlist-default-major-mode 'emms-playlist-mode
  3498. emms-show-format "NP: %s")
  3499. ;;;;
  3500. ;;; position of a letter in alphabet
  3501. (require 'cl-lib)
  3502. (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"))
  3503. (defun letter-position ()
  3504. "Responde con la posición en el abecedario de la letra minúsicula que se ingrese"
  3505. (interactive)
  3506. (let ((position (cl-position (read-from-minibuffer "Which letter?: ") letters :test #'string=)))
  3507. (if position
  3508. (message "The position is %d" position)
  3509. (message " not found in the array"))))
  3510. ;;;; Code from leaders
  3511. ;;; Time-stamp: <93/02/04 14:12:44 john> john sturdy http://www.cb1.com/~john/
  3512. (defun first-line-of-buffer ()
  3513. "Return as a string the first line in the current buffer."
  3514. (save-excursion
  3515. (goto-char (point-min))
  3516. (end-of-line)
  3517. (buffer-substring (point-min) (point))))
  3518. (defun count-buffers (&optional display-anyway)
  3519. "Display or return the number of buffers."
  3520. (interactive)
  3521. (let
  3522. (
  3523. (buf-count (length (buffer-list)))
  3524. )
  3525. (if (or (interactive-p) display-anyway)
  3526. (message "%d buffers in this Emacs" buf-count))
  3527. buf-count))
  3528. ;;; end of buffer-misc.el
  3529. (use-package hledger-mode
  3530. :pin manual
  3531. :after htmlize
  3532. :load-path "packages/rest/hledger-mode/"
  3533. :mode ("\\.journal\\'" "\\.hledger\\'")
  3534. :commands hledger-enable-reporting
  3535. :preface
  3536. (defun hledger/next-entry ()
  3537. "Move to next entry and pulse."
  3538. (interactive)
  3539. (hledger-next-or-new-entry)
  3540. (hledger-pulse-momentary-current-entry))
  3541. (defface hledger-warning-face
  3542. '((((background dark))
  3543. :background "Red" :foreground "White")
  3544. (((background light))
  3545. :background "Red" :foreground "White")
  3546. (t :inverse-video t))
  3547. "Face for warning"
  3548. :group 'hledger)
  3549. (defun hledger/prev-entry ()
  3550. "Move to last entry and pulse."
  3551. (interactive)
  3552. (hledger-backward-entry)
  3553. (hledger-pulse-momentary-current-entry))
  3554. :bind (("C-c j" . hledger-run-command)
  3555. :map hledger-mode-map
  3556. ("C-c e" . hledger-jentry)
  3557. ("M-p" . hledger/prev-entry)
  3558. ("M-n" . hledger/next-entry))
  3559. :init
  3560. (setq hledger-jfile
  3561. (expand-file-name "~/ola38/cuentasOLA38.ldg")
  3562. hledger-email-secrets-file (expand-file-name "secrets.el"
  3563. emacs-assets-directory))
  3564. ;; Expanded account balances in the overall monthly report are
  3565. ;; mostly noise for me and do not convey any meaningful information.
  3566. (setq hledger-show-expanded-report nil)
  3567. (when (boundp 'my-hledger-service-fetch-url)
  3568. (setq hledger-service-fetch-url
  3569. my-hledger-service-fetch-url))
  3570. :config
  3571. (add-hook 'hledger-view-mode-hook #'hl-line-mode)
  3572. (add-hook 'hledger-view-mode-hook #'center-text-for-reading)
  3573. (add-hook 'hledger-view-mode-hook
  3574. (lambda ()
  3575. (run-with-timer 1
  3576. nil
  3577. (lambda ()
  3578. (when (equal hledger-last-run-command
  3579. "balancesheet")
  3580. ;; highlight frequently changing accounts
  3581. (highlight-regexp "^.*\\(savings\\|cash\\).*$")
  3582. (highlight-regexp "^.*credit-card.*$"
  3583. 'hledger-warning-face))))))
  3584. (add-hook 'hledger-mode-hook
  3585. (lambda ()
  3586. (make-local-variable 'company-backends)
  3587. (add-to-list 'company-backends 'hledger-company))))
  3588. (use-package hledger-input
  3589. :pin manual
  3590. :load-path "packages/rest/hledger-mode/"
  3591. :bind (("C-c e" . hledger-capture)
  3592. :map hledger-input-mode-map
  3593. ("C-c C-b" . popup-balance-at-point))
  3594. :preface
  3595. (defun popup-balance-at-point ()
  3596. "Show balance for account at point in a popup."
  3597. (interactive)
  3598. (if-let ((account (thing-at-point 'hledger-account)))
  3599. (message (hledger-shell-command-to-string (format " balance -N %s "
  3600. account)))
  3601. (message "No account at point")))
  3602. :config
  3603. (setq hledger-input-buffer-height 20)
  3604. (add-hook 'hledger-input-post-commit-hook #'hledger-show-new-balances)
  3605. (add-hook 'hledger-input-mode-hook #'auto-fill-mode)
  3606. (add-hook 'hledger-input-mode-hook
  3607. (lambda ()
  3608. (make-local-variable 'company-idle-delay)
  3609. (setq-local company-idle-delay 0.1))))
  3610. ;; ======================
  3611. ;; ==== CALCULADORA =====
  3612. ;; ======================
  3613. (defun calcular-numero-original (valor porcentaje)
  3614. "Calcula el número original dado un VALOR y su PORCENTAJE."
  3615. (/ valor (/ porcentaje 100.0)))
  3616. ;; (calcular-numero-original 16450000 3.5)
  3617. (defun generate-chord-progression (root num-chords markov-weights)
  3618. "Generate a random chord progression based on a ROOT note, NUM-CHORDS, and MARKOV-WEIGHTS.
  3619. ROOT is the tonic of the progression (e.g., \"C\").
  3620. NUM-CHORDS specifies the number of chords to generate.
  3621. MARKOV-WEIGHTS is an alist defining the probabilities of transitioning between chords.
  3622. E.g., '((I . ((V . 50) (vi . 50))) (V . ((I . 40) (vi . 40) (IV . 20))))"
  3623. (let* ((chord-sequence (list 'I)) ; Start with the tonic (I)
  3624. (current-chord 'I))
  3625. (dotimes (_ (1- num-chords)) ; Generate remaining chords
  3626. (let* ((transitions (alist-get current-chord markov-weights))
  3627. (next-chord (generate-next-chord transitions)))
  3628. (push next-chord chord-sequence)
  3629. (setq current-chord next-chord)))
  3630. (mapcar (lambda (chord) (format "%s" (chord-to-symbol chord)))
  3631. (nreverse chord-sequence))))
  3632. (defun generate-next-chord (transitions)
  3633. "Randomly select the next chord based on TRANSITIONS weights."
  3634. (let ((total-weight (apply '+ (mapcar 'cdr transitions)))
  3635. (rand (random 100)))
  3636. (cl-loop for (chord . weight) in transitions
  3637. for cumulative-weight = (/ (* weight 100) total-weight)
  3638. until (<= rand cumulative-weight)
  3639. do (setq rand (- rand cumulative-weight))
  3640. finally return chord)))
  3641. (defun chord-to-symbol (chord)
  3642. "Convert a chord identifier (I, V, vi, etc.) to its Roman numeral string."
  3643. (symbol-name chord))
  3644. ;; Example usage
  3645. (setq markov-weights
  3646. '((I . ((V . 50) (vi . 50)))
  3647. (V . ((I . 40) (vi . 40) (IV . 20)))
  3648. (vi . ((ii . 30) (IV . 70)))
  3649. (IV . ((V . 60) (I . 40)))
  3650. (ii . ((V . 100)))))
  3651. (setq default-markov-weights '((I . ((V . 14) (vi . 14) (IV . 14) (ii . 14) (iii . 14) (VII . 14)))
  3652. (V . ((I . 14) (vi . 14) (IV . 14) (ii . 14) (iii . 14) (VII . 14)))
  3653. (vi . ((I . 14) (V . 14) (IV . 14) (ii . 14) (iii . 14) (VII . 14)))
  3654. (IV . ((I . 14) (V . 14) (vi . 14) (ii . 14) (iii . 14) (VII . 14)))
  3655. (ii . ((I . 14) (V . 14) (vi . 14) (IV . 14) (iii . 14) (VII . 14)))
  3656. (iii . ((I . 14) (V . 14) (vi . 14) (IV . 14) (ii . 14) (VII . 14)))
  3657. (VII . ((I . 14) (V . 14) (vi . 14) (IV . 14) (ii . 14) (iii . 14)))))
  3658. (defun random-element-from-list (lst)
  3659. "Select a random element from LST."
  3660. (nth (random (length lst)) lst))
  3661. ;;(setq tonalities '("C" "C#" "D" "D#" "E" "F" "G" "A"))
  3662. (setq tonalities '("C" "G" "D" "A" "E" "B" "F#" "C#" "F" "Bb" "Eb" "Ab" "Db" "Gb" "Cb"))
  3663. (defun random-progression ()
  3664. (interactive)
  3665. (let ((tone (random-element-from-list tonalities)))
  3666. (print (cons tone (generate-chord-progression tone 4 default-markov-weights)))))
  3667. (defun random-progression-to-file ()
  3668. (interactive)
  3669. (let* ((tone (random-element-from-list tonalities))
  3670. (progression (generate-chord-progression tone 4 default-markov-weights))
  3671. (output (format "%s %s\n" tone (mapconcat #'identity progression " "))))
  3672. (with-temp-buffer
  3673. (insert output)
  3674. (append-to-file (point-min) (point-max) "~/SyncDocs/chord_progressions.txt"))))
  3675. ;;(generate-chord-progression "C" 4 markov-weights)