machine_setup/nix/configuration/roles/emacs/files/emacs/elisp/base-functions.el

;; ========== Function to reload current file =================

(defun reload-file ()
    "Revert buffer without confirmation."
    (interactive)
    (revert-buffer :ignore-auto :noconfirm))

;; ===========================================================
;; ============= Run commands ================================
(defun run-command-on-buffer (cmd &rest args)
  "Run a command using the current buffer as stdin and replacing its contents if the command succeeds with the stdout from the command. This is useful for code formatters."
  (let (
        (stdout-buffer (generate-new-buffer "tmp-stdout" t))
        (full-cmd (append '(call-process-region nil nil cmd nil stdout-buffer nil) args))
        )
    (unwind-protect
        (let ((exit-status (eval full-cmd)))
          (if (eq exit-status 0)
              (save-excursion
                (replace-buffer-contents stdout-buffer)
                )
            (message "FAILED running command on buffer %s" (append (list cmd) args))
            )
          )
      (kill-buffer stdout-buffer)
      )
    )
  )

(defun run-command-on-buffer-require-output (cmd &rest args)
  "Run a command using the current buffer as stdin and replacing its contents if the command succeeds with the stdout from the command. This is useful for code formatters. This version only replaces the buffer contents if the command output some text."
  (let (
        (stdout-buffer (generate-new-buffer "tmp-stdout" t))
        (full-cmd (append '(call-process-region nil nil cmd nil stdout-buffer nil) args))
        )
    (unwind-protect
        (let ((exit-status (eval full-cmd)))
          (if (eq exit-status 0)
              (if (> (buffer-size stdout-buffer) 0)
                  (save-excursion
                    (replace-buffer-contents stdout-buffer)
                    )
                (message "No output from command on buffer %s" (append (list cmd) args))
                )
            (message "FAILED running command on buffer %s" (append (list cmd) args))
            )
          )
      (kill-buffer stdout-buffer)
      )
    )
  )

(defun run-command-in-directory (dir cmd &rest args)
  "Run a command in the specified directory. If the directory is nil, the directory of the file is used. The stdout result is trimmed of whitespace and returned."
  (let (
        (default-directory (or dir default-directory))
        (stdout-buffer (generate-new-buffer "tmp-stdout" t))
        (full-cmd (append '(call-process cmd nil (list stdout-buffer nil) nil) args))
        )
    (unwind-protect
        (let ((exit-status (condition-case nil (eval full-cmd) (file-missing nil))))
          (if (eq exit-status 0)
              (progn
                (with-current-buffer stdout-buffer
                  (string-trim (buffer-string))
                  )
                )
            )
          )
      (kill-buffer stdout-buffer)
      )
    )
  )

(defun load-directory (dir)
  (let ((load-it (lambda (f)
                   (load-file (concat (file-name-as-directory dir) f)))
                 ))
    (mapc load-it (directory-files dir nil "\\.el$"))))

(defun generate-vc-link ()
  (interactive)
  (or
   (generate-github-link)
   (generate-source-hut-link)
   )
  )

(defun generate-github-link ()
  "Generate a permalink to the current line."
  (interactive)
  (let (
        (current-rev (vc-working-revision buffer-file-name))
        (line-number (line-number-at-pos))
        (repository-url (vc-git-repository-url buffer-file-name))
        (relative-path (file-relative-name buffer-file-name (vc-root-dir)))
        )
    (save-match-data
      (and (string-match "\\(git@github\.com:\\|https://github\.com/\\)\\([^/]+\\)/\\([^.]+\\).git" repository-url)
           (let* (
                 (gh-org (match-string 2 repository-url))
                 (gh-repo (match-string 3 repository-url))
                 (full-url (format "https://github.com/%s/%s/blob/%s/%s?plain=1#L%s" gh-org gh-repo current-rev relative-path line-number))
                 )
             (message "%s" full-url)
             (kill-new full-url)
             t
             )
           )
      )
    )
  )

(defun generate-source-hut-link ()
  "Generate a permalink to the current line."
  (interactive)
  (let (
        (current-rev (vc-working-revision buffer-file-name))
        (line-number (line-number-at-pos))
        (repository-url (vc-git-repository-url buffer-file-name))
        (relative-path (file-relative-name buffer-file-name (vc-root-dir)))
        )
    (message "Using repo url %s" repository-url)
    (save-match-data
      (and (string-match "https://git.sr.ht/\\([^/]+\\)/\\([^/]+\\)" repository-url)
           (let* (
                 (sh-org (match-string 1 repository-url))
                 (sh-repo (match-string 2 repository-url))
                 (full-url (format "https://git.sr.ht/%s/%s/tree/%s/%s#L%s" sh-org sh-repo current-rev relative-path line-number))
                 )
             (message "%s" full-url)
             (kill-new full-url)
             t
             )
           )
      )
    )
  )

(defmacro when-linux (&rest body)
  "Execute only when on Linux."
  (declare (indent defun))
  `(when (eq system-type 'gnu/linux) ,@body))

(defmacro when-freebsd (&rest body)
  "Execute only when on FreeBSD."
  (declare (indent defun))
  `(when (eq system-type 'berkeley-unix) ,@body))

(provide 'base-functions)