From 093ffa5fbf7143f4668bb0a3dc9659a5cc836e12 Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Sat, 17 Jun 2023 17:20:29 +1000 Subject: Moving things one level deeper To ease gnu stow usage. Now we can do stow -t ~ emacs --- emacs/.emacs.d/lisp/my/my-utils.el | 409 +++++++++++++++++++++++++++++++++++++ 1 file changed, 409 insertions(+) create mode 100644 emacs/.emacs.d/lisp/my/my-utils.el (limited to 'emacs/.emacs.d/lisp/my/my-utils.el') diff --git a/emacs/.emacs.d/lisp/my/my-utils.el b/emacs/.emacs.d/lisp/my/my-utils.el new file mode 100644 index 0000000..7f36fae --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-utils.el @@ -0,0 +1,409 @@ +;;; my-utils.el -- Basic utilities used by other extensions -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles is free software: you can redistribute it and/or modify it under +;; the terms of the GNU Affero General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; dotfiles is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General +;; Public License for more details. + +;; You should have received a copy of the GNU Affero General Public +;; License along with dotfiles. If not, see . + +;;; Commentary: + +;; Basic utilities used by other extensions. + +;;; Code: + + +;; time and date +(defun my-date-part (td) + (nthcdr 3 td)) + +(defun my-tomorrow () + (decode-time (time-add 86400 (current-time)))) + +(defun my-skip-http-header () + (goto-char (point-min)) + (re-search-forward "\r?\n\r?\n")) + +(defun my-seq-random-element (xs) + "Returns a random element of sequence." + (elt xs (random (length xs)))) + +(defun my-delete-http-header () + (delete-region (point-min) (progn (my-skip-http-header) (point)))) + +(defun my-get-current-line-no-properties () + (save-excursion + (let ((beg (progn (beginning-of-line) + (point))) + (end (progn (beginning-of-line 2) + (point)))) + (buffer-substring-no-properties beg (1- end))))) + +(defun my-sudo-find-file () + (interactive) + (let* ((maybe-filename (thing-at-point 'filename t)) + (matched (and maybe-filename + (string-match "^\\(.*/\\)\\(.*\\)$" maybe-filename))) + (file (read-file-name + "Open as root: " + (and matched (match-string 1 maybe-filename)) nil nil + (and matched (match-string 2 maybe-filename))))) + (unless (file-writable-p file) + (find-file (concat "/sudo::" file))))) + +(defvar my-url-regexp + (concat + "~?\\<\\([-a-zA-Z0-9+&@#/%?=~_|!:,.;]*\\)" + "[.@]" + "\\([-a-zA-Z0-9+&@#/%?=~_|!:,.;]+\\)\\>/?") + "Regular expression to match (most?) URLs or email addresses.") + + +(defun my-clean-property-value (value) + (when value + (replace-regexp-in-string + "\n" ", " + (string-trim (replace-regexp-in-string " " "_" value) + "[ \t\n\r_]+" "[ \t\n\r_]+")))) + +;; rewriting urls +(defvar my-max-url-rewrite 100 "Max number of URL redirect") +(defun my-rewrite-url (url) + (let ((new-url url) + (tmp-url) + (i 0)) + (catch 'done + (while (< i my-max-url-rewrite) + (setq tmp-url (my-rewrite-url-once new-url)) + (when (equal tmp-url new-url) (throw 'done nil)) + (setq new-url tmp-url + i (1+ i)))) + (unless (equal url new-url) + (message "Rewriting %s to %s" url new-url)) + new-url)) + +(defvar my-simple-url-rewrites + '((:name http-to-https + :description "Rewrite http to https." + :from "^http://\\(.*\\)$" + :to "https://%s" + :parts (1)) + (:name ddg-result + :description "duckduckgo result transform." + :from "^https://duckduckgo.com/l/\\?uddg=\\(.*\\)&rut=.*$" + :to "%s" + :parts (1) + :match-processor url-unhex-string) + (:name youtube-to-yewtu-be + :description "youtube to yewtu.be" + :from "^https://\\(www\\.\\)?youtube.com/\\(.*\\)$" + :to "https://yewtu.be/%s" + :parts (2)) + (:name reddit-to-teddit + :description "Reddit to Teddit" + :from "^https://\\(www\\.\\|old\\.\\)?reddit.com/\\(.*\\)$" + :to "https://teddit.net/%s" + :parts (2)) + (:name twitter-to-nitter + :description "Twitter to nitter." + :from "^https://twitter.com/\\(.*\\)$" + :to "https://nitter.eu/%s" + :parts (1)) + (:name google-to-ddg + :description "Google to duckduckgo" + :from "^https://www.google.com/search\\?q=\\(.*\\)$" + :to "https://html.duckduckgo.com/html?q=%s" + :parts (1)) + (:name php-manual-to-english + :descripton "PHP manual to English" + :from "^https://www.php.net/manual/../\\(.*\\)$" + :to "https://www.php.net/manual/en/%s" + :parts (1)) + (:name google-sheets-to-csv + :description "Google sheets to csv" + :from "https://docs.google.com/spreadsheets/\\(.*\\)/.*" + :to "https://docs.google.com/spreadsheets/%s/export?format=csv" + :parts (1)) + (:name google-docs-to-odt + :description "Google docs to odt" + :from "https://docs.google.com/document/\\(.*\\)/.*" + :to "https://docs.google.com/document/%s/export?format=odt" + :parts (1)) + (:name utm-remover-not-last + :description "Removing a utm_foo query that is not the last query" + :from "\\(.*\\)\\butm_[a-z_]+=[^&]*&\\(.*\\)" + :to "%s%s" + :parts (1 2)) + (:name utm-remover-last + :description "Removing a utm_foo query that is the last query" + :from "\\(.*\\)[&?]utm_[a-z_]+=[^#]*\\(.*\\)" + :to "%s%s" + :parts (1 2)))) + +(defun my-simple-rewrite-function-name (data) + (intern (format "my-simple-url-rewrite-%s" + (plist-get data :name)))) + +(defmacro my-def-simple-rewrite (data) + (let ((processor (plist-get data :match-processor))) + `(defun ,(my-simple-rewrite-function-name data) (url) + ,(plist-get data :description) + (when (string-match ,(plist-get data :from) url) + ,(append `(format ,(plist-get data :to)) + (mapcar (lambda (part) + (if processor + `(,processor (match-string ,part url)) + `(match-string ,part url))) + (plist-get data :parts))))))) + +;; TODO: why do we need an eval here? +;; Because we are using plist-get in the defmacro +(dolist (data my-simple-url-rewrites) + (eval `(my-def-simple-rewrite ,data))) + +(defvar my-url-rewrite-functions + (mapcar 'my-simple-rewrite-function-name my-simple-url-rewrites)) + +(defun my-rewrite-url-once (url) + (let* ((rewriters my-url-rewrite-functions) + (rewritten) (rewriter) (result)) + (while (and rewriters (not rewritten)) + (setq rewriter (car rewriters) + rewriters (cdr rewriters) + rewritten (funcall rewriter url))) + (or rewritten url))) + +(defun my-shell-command-output (command) + (let ((inhibit-message t)) + (if (= 0 + (shell-command command)) + (with-current-buffer shell-command-buffer-name + (string-trim (buffer-string))) + (error (with-current-buffer shell-command-buffer-name + (string-trim (buffer-string))))))) + +;; mailman utils +(defun my-mailman-to-listinfo-url (url) + (when (string-match "^\\(.*\\)/archive/html/\\(.*\\)" url) + (format "%s/mailman/listinfo/%s" + (match-string 1 url) (match-string 2 url)))) + +(defun my-mailman-to-archive-url (url) + (when (string-match "^\\(.*\\)/mailman/listinfo/\\(.*\\)" url) + (format "%s/archive/html/%s" + (match-string 1 url) (match-string 2 url)))) + +;; filenames + +(defun my-make-filename (name &optional sep) + "Convert name to filename by replacing special chars with sep." + (unless sep (setq sep "-")) + (replace-regexp-in-string "[[:punct:][:space:]\n\r]+" sep + (string-trim name))) + +(defun my-make-filename-from-url (url) + (let* ((urlobj (url-generic-parse-url url)) + (filename (url-filename urlobj)) + (host (url-host urlobj))) + (replace-regexp-in-string + "^-+" "" + (replace-regexp-in-string + "-+$" "" (my-make-filename (concat host "-" filename)))))) + +(defun my-clean-property-key (key) + (when key + (let ((new-key + (replace-regexp-in-string + "[ \t\n\r_]+" "-" (string-trim + (replace-regexp-in-string " " "_" key))))) + (cond ((string-match "Publication-date" new-key) + "Published") + ((string= new-key "Publication") "Published") + ((string= new-key "出版時間") "Published") + ((string= new-key "出生") "Born") + ((string= new-key "逝世") "Died") + ((string= new-key "Formed") "Founded") + ((string-match "^成立" new-key) "Founded") + ((string= new-key "网站") "Website") + ((string= new-key "網站") "Website") + ((string= new-key "出版日期") "Published") + ((string= new-key "Author") "Authors") + ((string= new-key "作者") "Authors") + ((string= new-key "Designer") "Designers") + ((string-match "Directed" new-key) "Director") + ((string= new-key "Created-by") "Director") + ((string-match "导演" new-key) "Director") + ((string-match "[Rr]elease-date" new-key) "Released") + ((string-match "上映日期" new-key) "Released") + ((string-match "[Oo]riginal-release" new-key) "Released") + ((string-match "[Ii]nitial-release" new-key) "Released") + ((string-match "^Release$" new-key) "Released") + ((string-match "^Developer" new-key) "Developers") + ((string-match "^Repository" new-key) "Source") + ((string-match "^URL" new-key) "Website") + ((string-match "^Official-website" new-key) "Website") + (t new-key))))) + +(defun my-parse-colon-separated-output (buffer) + (with-current-buffer buffer + (goto-char (point-min)) + (let ((result) (field) (value)) + (while (not (eobp)) + (if (re-search-forward "\\(.*?\\)\\ +:" nil t) + (progn + (setq field + (replace-regexp-in-string + "[()]" "" + (replace-regexp-in-string "\\ " "-" (match-string 1)))) + (re-search-forward "\\ *\\(.*?\\)\n") + (setq value (match-string 1)) + (push (cons field value) result)) + (message "Failed search in parsing!") + (goto-char (point-max)))) + result))) + +(defvar my-docs-root-dir nil "Root directory of documentation") +(defun my-get-list-of-docs () + (directory-files my-docs-root-dir nil directory-files-no-dot-files-regexp)) + +(defmacro my-with-default-directory (dir &rest body) + "Run BODY with the default directory." + (declare (indent 1) (debug t)) + `(let ((saved default-directory)) + (setq default-directory ,dir) + ,@body + (setq default-directory saved))) + +(defun my-call-process-with-torsocks + (program &optional infile destination display &rest args) + (apply 'call-process + (append (list "torsocks" infile destination display program) args))) + +(defun my-start-process-with-torsocks (no-tor name buffer program &rest program-args) + (if no-tor + (apply 'start-process (append (list name buffer program) program-args)) + (apply 'start-process + (append (list name buffer "torsocks" program) program-args)))) + +(defun my-touch-new-file (filename) + "Touch a new file." + (with-temp-buffer (write-file filename))) + +(defvar my-extension-types + '((audio . ("asf" "cue" "flac" "m4a" "m4r" "mid" "mp3" "ogg" "opus" + "wav" "wma")) + (video . ("avi" "m4v" "mkv" "mp4" "mpg" "ogg" "ogv" "rmvb" "webm" "wmv")))) + +;;; files +(defun my-rename-and-symlink-back (file newname ok-if-already-exists) + (when (directory-name-p newname) + (setq newname (concat newname (file-name-nondirectory file)))) + (rename-file file newname ok-if-already-exists) + (make-symbolic-link newname file ok-if-already-exists) + newname) + +(defun my-rewrite-url-advice (args) + (let ((url (car args))) + (setcar args (my-rewrite-url url))) + args) + +(defun my-server-p () + "nonnil if the emacs is a server or daemon" + (and (boundp 'server-process) server-process)) + +;; cleaning utilities +(defun my-extract-year (text) + (if (string-match "\\([0-9]\\{4\\}\\)" text) + (match-string 1 text) + "")) + +(defun my-rename-file-and-buffer (name) + "Apply NAME to current file and rename its buffer. +Do not try to make a new directory or anything fancy." + (interactive + (list (read-file-name "Rename current file to: "))) + (let ((file (buffer-file-name))) + (if (vc-registered file) + (vc-rename-file file name) + (rename-file file name)) + (set-visited-file-name name t t))) + +(defun my-delete-file-and-kill-buffer () + "Delete the buffer and the file + +Only accept if the file is vc-registered (easy to recover from mistakes)" + (interactive) + (let ((file (buffer-file-name))) + (unless (vc-registered file) + (error "Cannot delete file not under vc")) + (vc-revert-file file) + (vc-refresh-state) + (vc-delete-file file)) + (kill-buffer)) + +;;; Some of the following functions are adapted from prot-dotfiles +;;;###autoload +(defun my-keyboard-quit-dwim () + "Do-What-I-Mean behaviour for a general `keyboard-quit'. + +The generic `keyboard-quit' does not do the expected thing when +the minibuffer is open. Whereas we want it to close the +minibuffer, even without explicitly focusing it. + +The DWIM behaviour of this command is as follows: + +- When the region is active, disable it. +- When a minibuffer is open, but not focused, close the minibuffer. +- When the Completions buffer is selected, close it. +- In every other case use the regular `keyboard-quit'." + (interactive) + (cond + ((region-active-p) + (keyboard-quit)) + ((derived-mode-p 'completion-list-mode) + (delete-completion-window)) + ((> (minibuffer-depth) 0) + (abort-recursive-edit)) + (t + (keyboard-quit)))) + +;; The `my-line-regexp-p' and `my--line-regexp-alist' +;; are contributed by Gabriel: . +(defvar my--line-regexp-alist + '((empty . "[\s\t]*$") + (indent . "^[\s\t]+") + (non-empty . "^.+$") + (list . "^\\([\s\t#*+]+\\|[0-9]+[^\s]?[).]+\\)") + (heading . "^[=-]+")) + "Alist of regexp types used by `my-line-regexp-p'.") + +(defun my-line-regexp-p (type &optional n) + "Test for TYPE on line. +TYPE is the car of a cons cell in +`my--line-regexp-alist'. It matches a regular +expression. + +With optional N, search in the Nth line from point." + (save-excursion + (goto-char (line-beginning-position)) + (and (not (bobp)) + (or (beginning-of-line n) t) + (save-match-data + (looking-at + (alist-get type my--line-regexp-alist)))))) + +(provide 'my-utils) -- cgit v1.2.3