machine_setup/ansible/roles/emacs/files/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-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)