dotemacs/utils/misc-defuns.el

;;; Misc defuns go here
;;; Code:
(require 'cl-macs)

;;;###autoload
(defun distopico:inhibit-message-advisor(orig-fun &rest args)
  "This silences `minibufer' output of `message' and `save' to the echo-area.
Only have effect when is not called interactively or `init-file-debug' it nil
and not prevent `ORIG-FUN' to log in *Messages* buffer.
this call `ORIG-FUN' without change the `ARGS'."
  (if (or init-file-debug
          (called-interactively-p 'any))
      (apply orig-fun args)
    (let ((inhibit-message t)
          (save-silently t))
      (apply orig-fun args))))

;;;###autoload
(defun distopico:inhibit-outputs-advisor(orig-fun &rest args)
  "Run `ORIG-FUN' with their `ARGS' without generating any output.
This silences output to anything that writes to `message', `load',
`write-region' and prevent `ORIG-FUN' to log in *Messages* buffer
or `minibufer', only have effect when is not called interactively
or `init-file-debug' it nil."
  (if (or init-file-debug
          (called-interactively-p 'any))
      (apply orig-fun args)
    (cl-letf ((orig-write-region (symbol-function 'write-region))
              (orig-load (symbol-function 'load)))
      (cl-letf (((symbol-function 'standard-output) (lambda (&rest _)))
		((symbol-function 'message) (lambda (&rest _)))
		((symbol-function 'load)
                 (lambda (file &optional noerror nomessage nosuffix must-suffix)
                   (funcall orig-load
                            file noerror t nosuffix must-suffix)))
		((symbol-function 'write-region)
                 (lambda (start end filename
				&optional append visit lockname mustbenew)
                   (unless visit (setq visit 'no-message))
                   (funcall orig-write-region
                            start end filename append visit lockname mustbenew))))
        (apply orig-fun args)))))

(defun distopico:pg-uline (ulinechar)
  "Underline the current or the previous line with ULINECHAR."
  (interactive "cUnderline with:")
  (if (looking-at "^$")
      (next-line -1))
  (end-of-line)
  (let ((linelen (current-column)))
    (insert "\n")
    (while (> linelen 0)
      (setq linelen (1- linelen))
      (insert ulinechar)))
  (insert "\n"))

(defun distopico:next-link ()
  "Move point to next link."
  (interactive)
  (condition-case nil
      (or (let ((next-link (shr-next-link)))
            (unless (equal next-link "No next link")
              next-link))
          ;; Works across all modes
          (org-next-link))
    (error nil)))

(defun distopico:previous-link ()
  "Move point to previous link."
  (interactive)
  (condition-case nil
      (or (let ((previous-link (shr-previous-link)))
            (unless (equal previous-link "No previous link")
              previous-link))
	  ;; Works across all modes
	  (org-previous-link))
    (error nil)))

(defun distopico:show-link-url ()
  "Return url of link at point."
  (interactive)
  (message (or (shr-url-at-point nil)
	       (thing-at-point-url-at-point t))))

(defun distopico:ignore-error-wrapper (func)
  "Return new function that ignore errors from `FUNC'.
The function wraps a function with `ignore-errors' macro."
  (let ((fn func))
    (lambda ()
      (interactive)
      (ignore-errors
        (funcall fn)))))

(defun toggle-margin-right ()
  "Toggle the right margin between `fill-column' or window width.
This command is convenient when reading novel, documentation."
  (interactive)
  (if (eq (cdr (window-margins)) nil)
      (set-window-margins nil 0 (- (window-body-width) fill-column))
    (set-window-margins nil 0 0) ) )

(defadvice indent-rigidly (after deactivate-mark-nil activate)
  "Adjust Margin"
  (if (called-interactively-p 'any)
      (setq deactivate-mark nil)))

(defun goto-line-with-feedback ()
  "Show line numbers temporarily, while prompting for the line number input"
  (interactive)
  (unwind-protect
      (progn
        (linum-mode 1)
        (call-interactively 'goto-line))
    (linum-mode -1)))

(defun open-line-and-indent ()
  (interactive)
  (newline-and-indent)
  (end-of-line 0)
  (indent-for-tab-command))

;; start a httpd-server in current directory
(defun httpd-start-here (directory port)
  (interactive (list (read-directory-name "Root directory: " default-directory nil t)
                     (read-number "Port: " 8017)))
  (setq httpd-root directory)
  (setq httpd-port port)
  (httpd-start)
  (browse-url (concat "http://localhost:" (number-to-string port) "/")))

;; Increase/decrease selective display
(defun inc-selective-display (arg)
  (interactive "P")
  (if (numberp arg)
      (set-selective-display arg)
    (if (numberp selective-display)
        (set-selective-display (+ 2 selective-display))
      (set-selective-display 2)))
  (create-temp-selective-display-keymap))

(defun dec-selective-display ()
  (interactive)
  (when (and (numberp selective-display)
             (> selective-display 2))
    (set-selective-display (- selective-display 2)))
  (create-temp-selective-display-keymap))

(defun clear-selective-display ()
  (interactive)
  (when (numberp selective-display)
    (set-selective-display nil)))

(defun create-temp-selective-display-keymap ()
  (set-temporary-overlay-map
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "+") 'inc-selective-display)
     (define-key map (kbd "-") 'dec-selective-display)
     (define-key map (kbd "0") 'clear-selective-display)
     map))
  (message "Type + to reveal more, - for less, 0 to reset."))

;; Add spaces and proper formatting to linum-mode. It uses more room than
;; necessary, but that's not a problem since it's only in use when going to
;; lines.
(setq linum-format (lambda (line)
                     (propertize
                      (format (concat " %"
                                      (number-to-string
                                       (length (number-to-string
                                                (line-number-at-pos (point-max)))))
                                      "d ")
                              line)
                      'face 'linum)))

(defun isearch-yank-selection ()
  "Put selection from buffer into search string."
  (interactive)
  (when (region-active-p)
    (deactivate-mark))
  (isearch-yank-internal (lambda () (mark))))

(defun region-as-string ()
  (buffer-substring (region-beginning)
                    (region-end)))

(defun isearch-forward-use-region ()
  (interactive)
  (when (region-active-p)
    (add-to-history 'search-ring (region-as-string))
    (deactivate-mark))
  (call-interactively 'isearch-forward))

(defun isearch-backward-use-region ()
  (interactive)
  (when (region-active-p)
    (add-to-history 'search-ring (region-as-string))
    (deactivate-mark))
  (call-interactively 'isearch-backward))

(defun view-url ()
  "Open a new buffer containing the contents of URL."
  (interactive)
  (let* ((default (thing-at-point-url-at-point))
         (url (read-from-minibuffer "URL: " default)))
    (switch-to-buffer (url-retrieve-synchronously url))
    (rename-buffer url t)
    ;; TODO: switch to nxml/nxhtml mode
    (cond ((search-forward "<?xml" nil t) (xml-mode))
          ((search-forward "<html" nil t) (html-mode)))))

(defun linkify-region-from-kill-ring (start end)
  (interactive "r")
  (let ((text (buffer-substring start end)))
    (delete-region start end)
    (insert "<a href=\"")
    (yank)
    (insert (concat "\">" text "</a>"))))

(defun buffer-to-html (buffer)
  (with-current-buffer (htmlize-buffer buffer)
    (buffer-string)))

(defun sudo-edit (&optional arg)
  (interactive "p")
  (if (or arg (not buffer-file-name))
      (find-file (concat "/sudo:root@localhost:" (ido-read-file-name "File: ")))
    (find-alternate-file (concat "/sudo:root@localhost:" buffer-file-name))))

(defun add-file-find-hook-with-pattern (pattern fn &optional contents)
  "Add a find-file-hook that calls FN for files where PATTERN
matches the file name, and optionally, where CONTENT matches file contents.
Both PATTERN and CONTENTS are matched as regular expressions."
  (lexical-let ((re-pattern pattern)
                (fun fn)
                (re-content contents))
    (add-hook 'find-file-hook
              (lambda ()
                (if (and
                     (string-match re-pattern (buffer-file-name))
                     (or (null re-content)
                         (string-match re-content
                                       (buffer-substring (point-min) (point-max)))))
                    (apply fun ()))))))

;; Fix kmacro-edit-lossage, it's normal implementation
;; is bound tightly to C-h
(defun kmacro-edit-lossage ()
  "Edit most recent 300 keystrokes as a keyboard macro."
  (interactive)
  (kmacro-push-ring)
  (edit-kbd-macro 'view-lossage))


(defun string-starts-with (s arg)
  "returns non-nil if string S starts with ARG.  Else nil."
  (cond ((>= (length s) (length arg))
         (string-equal (substring s 0 (length arg)) arg))
        (t nil)))

(provide 'misc-defuns)