michael/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

initial commit

Browse source
This commit is contained in:
Michael Moese 2025-06-06 15:44:19 +02:00
commit 1a2d326ed2
8 changed files with 5035 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

25
.gitignore vendored Normal file
View file

@ -0,0 +1,25 @@
# ELPA-Ordner mit den installierten Paketen ignorieren
elpa/
auto-save-list/
.cache/
# Backup-Dateien von Emacs ignorieren
*~
# Autosave-Dateien ignorieren
.#*
# Cache-Dateien, z.B. von org-mode, ignorieren
*.elc
*.cache
# Wenn du org-mode mit LaTeX benutzt, kannst du temporäre Dateien ignorieren
*.aux
*.log
*.out
*.toc
# Optional: Wenn du andere temporäre oder systembezogene Dateien hast
.DS_Store
.lsp-session-v1

137
init.el Normal file
View file

@ -0,0 +1,137 @@
(add-to-list 'load-path "~/.emacs.d/lisp/")
(normal-erase-is-backspace-mode 0)
(windmove-default-keybindings)
(require 'package)
(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/"))
(custom-set-variables
;; custom-set-variables was added by Custom.
;; If you edit it by hand, you could mess it up, so be careful.
;; Your init file should contain only one such instance.
;; If there is more than one, they won't work right.
'(custom-safe-themes
'("77f1e155387d355fbbb3b382a28da41cc709b2a1cc71e7ede03ee5c1859468d2" default))
'(lsp-perl-perl-inc ["./lib/"])
'(package-selected-packages
'(exec-path-from-shell company flycheck vterm minimap lsp-treemacs treemacs-magit treemacs lsp-mode magit whitespace-cleanup-mode request markdown-mode elmine kuronami-theme yaml-mode)))
(custom-set-faces
;; custom-set-faces was added by Custom.
;; If you edit it by hand, you could mess it up, so be careful.
;; Your init file should contain only one such instance.
;; If there is more than one, they won't work right.
'(minimap-font-face ((t (:height 5 :family "DejaVu Sans Mono")))))
(load-theme 'kuronami)
;; Disable the splash screen (to enable it agin, replace the t with 0)
(setq inhibit-splash-screen t)
;; Enable transient mark mode
(transient-mark-mode 1)
;;;;Org mode configuration
;; Enable Org mode
(require 'org)
;; Make Org mode work with files ending in .org
(add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
(setq org-todo-keywords
'((sequence "TODO" "IN-PROGRESS" "WAITING" "DONE")))
(require 'orgmine)
(add-hook 'org-mode-hook
(lambda () (if (assoc "om_project" org-keyword-properties)
(orgmine-mode))))
(setq org-link-abbrev-alist
'(("poo" . "https://progress.opensuse.org/")
;;...
))
(setq request-curl-options '("-k"))
(setq orgmine-servers
'(("poo" ; server name for this entry
(host . "https://progress.opensuse.org")
(api-key . "9fe3c1484c9bf956fce04ec67f08917b9ac2206d")
(issue-title-format . "[[redmine:issues/%{id}][#%{id}]] %{subject}")
(journal-title-format . "[[redmine:issues/%{id}#note-%{count}][V#%{id}-%{count}]] %{created_on} %{author}")
(version-title-format . "[[redmine:versions/%{id}][V#%{id}]] %{name}")
(tracker-title-format . "%{name}")
(project-title-format . "[[redmine:projects/%{identifier}][%{identifier}]] %{name}")
(user-name-format . "%{firstname} %{lastname}")
(default-todo-keyword . "NEW"))))
(require 'perltidy)
(fset 'perl-mode 'cperl-mode)
(add-hook 'fperl-mode-hook 'whitespace-cleanup-mode)
(setq cperl-invalid-face nil)
(setq cperl-indent-level 4)
(use-package exec-path-from-shell
:ensure t
:config
(exec-path-from-shell-initialize)
(exec-path-from-shell-copy-env "PERL5LIB"))
(use-package company
:ensure t
:config
(add-to-list 'company-backends 'company-capf)
(global-company-mode))
(use-package lsp-mode
:ensure t
:init
(setq lsp-keymap-prefix "C-c l")
:config
(add-hook 'c-mode-hook #'lsp)
(add-hook 'c++-mode-hook #'lsp)
(add-hook 'cperl-mode-hook #'lsp)
(setq lsp-clangd-binary-path "/usr/bin/clangd")
(setq lsp-client-clangd-args '("-j=4" "-background-index" "-log=error"))
(setq lsp-keymap-prefix "C-c C-l"))
;;;(add-to-list 'lsp-perl-perl-inc ("/Users/MMOESE/work/os-autoinst-distri-opensuse/lib" "/Users/MMOESE/work/os-autoinst-distri-opensuse/os-autoinst"))
(use-package treemacs
:ensure t)
(use-package treemacs-magit
:ensure t)
(use-package lsp-treemacs
:ensure t)
(use-package minimap
:ensure t
:config (setq minimap-window-location 'right))
(use-package flycheck
:ensure t
)
(lsp-treemacs-sync-mode 1)
(setq lsp-modeline-diagnostics-enable t)
(add-to-list 'display-buffer-alist
'("\*vterm\*"
(display-buffer-in-side-window)
(window-height . 0.25)
(side . bottom)
(slot . 0)))
(add-to-list 'display-buffer-alist
'("\*compilation\*"
(display-buffer-in-side-window)
(window-height . 0.25)
(side . bottom)
(slot . 0)))
(add-hook 'after-init-hook #'global-flycheck-mode)
;;;(add-hook 'after-init-hook #'treemacs)

416
lisp/elmine.el Normal file
View file

@ -0,0 +1,416 @@
;;; elmine.el --- Redmine API access via elisp.
;; Copyright (c) 2012 Arthur Leonard Andersen
;;
;; Author: Arthur Andersen <leoc.git@gmail.com>
;; URL: http://github.com/leoc/elmine
;; Version: 0.3.1
;; Keywords: tools
;; Package-Requires: ((s "1.10.0"))
;;
;; This file is not part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 3
;; of the License, or (at your option) any later version.
;;
;; This program 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 General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; `elmine` provides simple means of accessing the redmine Rest API
;; programmatically. This means that you do not have interactive
;; functions but functions that give and take list representations of
;; JSON objects of the redmine API.
;;; Code:
(require 'json)
(require 's)
(defun plist-merge (base new)
"Merges two plists. The keys of the second one will overwrite the old ones."
(let ((key (car new))
(val (cadr new))
(new (cddr new)))
(while (and key val)
(setq base (plist-put base key val))
(setq key (car new))
(setq val (cadr new))
(setq new (cddr new)))
base))
(defvar elmine/host nil
"The default host of the redmine.")
(defvar elmine/api-key nil
"The default API key for the redmine")
(defun elmine/get (plist key &rest keys)
"Execute `plist-get` recursively for `plist`.
Example:
(setq plist '(:a 3
:b (:c 12
:d (:e 31))))
(elmine/get plist \"a\")
;; => 3
(elmine/get plist :b)
;; => (:c 12 :d (:e 31))
(elmine/get plist :b :c)
;; => 12
(elmine/get plist :b :d :e)
;; => 31
(elmine/get plist :b :a)
;; => nil
(elmine/get plist :a :c)
;; => nil"
(save-match-data
(let ((ret (plist-get plist key)))
(while (and keys ret)
(if (listp ret)
(progn
(setq ret (elmine/get ret (car keys)))
(setq keys (cdr keys)))
(setq ret nil)))
ret)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HTTP functions using Emacs URL package ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun elmine/make-key (string)
(make-symbol (format ":%s" (s-dashed-words string))))
(defun elmine/ensure-string (object)
"Return a string representation of OBJECT."
(cond ((stringp object) object)
((keywordp object) (substring (format "%s" object) 1 nil))
((symbolp object) (symbol-name object))
((numberp object) (number-to-string object))
(t (pp-to-string object))))
(defun elmine/api-build-query-string (plist)
"Builds a query string from a given plist."
(if plist
(let (query-pairs)
(while plist
(let ((key (url-hexify-string (elmine/ensure-string (car plist))))
(val (url-hexify-string (elmine/ensure-string (cadr plist)))))
(setq query-pairs (cons (format "%s=%s" key val) query-pairs))
(setq plist (cddr plist))))
(concat "?" (s-join "&" query-pairs)))
""))
(defun elmine/api-build-url (path params)
"Creates a URL from a relative PATH, a plist of query PARAMS and
the dynamically bound `redmine-api-key` and `redmine-host` variables."
(let ((host (s-chop-suffix "/" redmine-host))
(query-str (elmine/api-build-query-string params)))
(concat host path query-str)))
(defun elmine/api-raw (method path data params)
"Perform a raw HTTP request with given METHOD, a relative PATH and a
plist of PARAMS for the query."
(let* ((redmine-host (if (boundp 'redmine-host)
redmine-host
elmine/host))
(redmine-api-key (if (boundp 'redmine-api-key)
redmine-api-key
elmine/api-key))
(url (elmine/api-build-url path params))
(url-request-method method)
(url-request-extra-headers
`(("Content-Type" . "application/json")
("X-Redmine-API-Key" . ,redmine-api-key)))
(url-request-data data)
header-end status header body)
(save-excursion
(switch-to-buffer (url-retrieve-synchronously url))
(beginning-of-buffer)
(setq header-end (save-excursion
(if (re-search-forward "^$" nil t)
(progn
(forward-char)
(point))
(point-max))))
(when (re-search-forward "^HTTP/\\(1\\.0\\|1\\.1\\) \\([0-9]+\\) \\([A-Za-z ]+\\)$" nil t)
(setq status (plist-put status :code (string-to-number (match-string 2))))
(setq status (plist-put status :text (match-string 3))))
(while (re-search-forward "^\\([^:]+\\): \\(.*\\)" header-end t)
(setq header (cons (match-string 1) (cons (match-string 2) header))))
(unless (eq header-end (point-max))
(setq body (url-unhex-string
(buffer-substring header-end (point-max)))))
(kill-buffer))
`(:status ,status
:header ,header
:body ,body)))
(defun elmine/api-get (element path &rest params)
"Perform an HTTP GET request and return a PLIST with the request information.
It returns the "
(let* ((params (if (listp (car params)) (car params) params))
(response (elmine/api-raw "GET" path nil params))
(object (elmine/api-decode (plist-get response :body)))
)
(if element
(plist-get object element)
object)))
(defun elmine/api-post (element object path &rest params)
"Does an http POST request and returns response status as symbol."
(let* ((params (if (listp (car params)) (car params) params))
(data (elmine/api-encode `(,element ,object)))
(response (elmine/api-raw "POST" path data params))
(object (elmine/api-decode (plist-get response :body))))
object))
(defun elmine/api-put (element object path &rest params)
"Does an http PUT request and returns the response status as symbol.
Either :ok or :unprocessible."
(let* ((params (if (listp (car params)) (car params) params))
(data (elmine/api-encode `(,element ,object)))
(response (elmine/api-raw "PUT" path data params))
(object (elmine/api-decode (plist-get response :body)))
(status (elmine/get response :status :code)))
(cond ((eq status 200) t)
((eq status 404)
(signal 'no-such-resource `(:response ,response))))))
(defun elmine/api-delete (path &rest params)
"Does an http DELETE request and returns the body of the response."
(let* ((params (if (listp (car params)) (car params) params))
(response (elmine/api-raw "DELETE" path nil params))
(status (elmine/get response :status :code)))
(cond ((eq status 200) t)
((eq status 404)
(signal 'no-such-resource `(:response ,response))))))
(defun elmine/api-get-all (element path &rest filters)
"Return list of ELEMENT items retrieved from PATH limited by FILTERS.
Limiting items by count can be done using `limit' in FILTERS:
- If `limit' is t, return all items.
- If `limit' is number, return items up to that count.
- Otherwise return up to 25 items (redmine api default)."
(let* ((initial-limit (plist-get filters :limit))
(initial-limit (when (or
(eq t initial-limit)
(numberp initial-limit))
initial-limit))
(limit (if (eq t initial-limit) 100 initial-limit))
(response-object (apply #'elmine/api-get nil path (plist-put filters :limit limit)))
(offset (elmine/get response-object :offset))
(limit (elmine/get response-object :limit))
(total-count (elmine/get response-object :total_count))
(issue-list (elmine/get response-object element)))
(if (and offset
limit
(< (+ offset limit) total-count)
(or (eq t initial-limit)
(and initial-limit (< (+ offset limit) initial-limit))))
(let* ((offset (+ offset limit))
(limit (if (eq t initial-limit)
t
(- initial-limit offset))))
(append issue-list (apply #'elmine/api-get-all element path
(plist-merge
filters
`(:offset ,offset :limit ,limit)))))
issue-list)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Simple JSON decode/encode functions ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun elmine/api-decode (json-string)
"Parses a JSON string and returns an object. Per default JSON objects are
going to be hashtables and JSON arrays are going to be lists."
(if (null json-string)
nil
(let ((json-object-type 'plist)
(json-array-type 'list))
(condition-case err
(json-read-from-string json-string)
(json-readtable-error
(message "%s: Could not parse json-string into an object. See %s"
(error-message-string err) json-string))))))
(defun elmine/api-encode (object)
"Return a JSON representation from the given object."
(let ((json-object-type 'plist)
(json-array-type 'list))
(condition-case err
(encode-coding-string (json-encode object) 'utf-8)
(json-readtable-error
(message "%s: Could not encode object into JSON string. See %s"
(error-message-string err) object)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; API functions to retrieve data from redmine ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun elmine/get-issues (&rest filters)
"Get a list of issues."
(apply #'elmine/api-get-all :issues "/issues.json" filters))
(defun elmine/get-issue (id &rest params)
"Get a specific issue via id."
(elmine/api-get :issue (format "/issues/%s.json" id) params))
(defun elmine/create-issue (&rest params)
"Create an issue.
You can create an issue with giving each of its parameters or simply passing
an issue object to this function."
(let ((object (if (listp (car params)) (car params) params)))
(elmine/api-post :issue object "/issues.json")))
(defun elmine/update-issue (object)
"Update an issue. The object passed to this function gets updated."
(let ((id (plist-get object :id)))
(elmine/api-put :issue object (format "/issues/%s.json" id))))
(defun elmine/delete-issue (id)
"Deletes an issue with a specific id."
(elmine/api-delete (format "/issues/%s.json" id)))
(defun elmine/get-issue-time-entries (issue-id &rest filters)
"Gets all time entries for a specific issue."
(apply #'elmine/api-get-all :time_entries
(format "/issues/%s/time_entries.json" issue-id) filters))
(defun elmine/get-issue-relations (issue-id)
"Get all relations for a specific issue."
(apply #'elmine/api-get-all :relations
(format "/issues/%s/relations.json" issue-id) nil))
(defun elmine/get-projects (&rest filters)
"Get a list with projects."
(apply #'elmine/api-get-all :projects "/projects.json" filters))
(defun elmine/get-project (project)
"Get a specific project."
(elmine/api-get :project (format "/projects/%s.json" project)))
(defun elmine/create-project (&rest params)
"Create a new project."
(let ((object (if (listp (car params)) (car params) params)))
(elmine/api-post :project object "/projects.json")))
(defun elmine/update-project (&rest params)
"Update a given project."
(let* ((object (if (listp (car params)) (car params) params))
(identifier (plist-get object :identifier)))
(elmine/api-put :project object
(format "/projects/%s.json" identifier))))
(defun elmine/delete-project (project)
"Deletes a project."
(elmine/api-delete (format "/projects/%s.json" project)))
(defun elmine/get-project-categories (project &rest filters)
"Get all categories for a project."
(apply #'elmine/api-get-all :issue_categories
(format "/projects/%s/issue_categories.json" project) filters))
(defun elmine/get-project-issues (project &rest filters)
"Get a list of issues for a specific project."
(apply #'elmine/api-get-all :issues
(format "/projects/%s/issues.json" project) filters))
(defun elmine/get-project-versions (project &rest filters)
"Get a list of versions for a specific project."
(apply #'elmine/api-get-all :versions
(format "/projects/%s/versions.json" project) filters))
(defun elmine/get-project-memberships (project &rest filters)
"Get PROJECT memberships limited by FILTERS."
(apply #'elmine/api-get-all :memberships
(format "/projects/%s/memberships.json" project) filters))
(defun elmine/get-version (id)
"Get a specific version."
(elmine/api-get :version (format "/versions/%s.json" id)))
(defun elmine/create-version (&rest params)
"Create a new version."
(let* ((object (if (listp (car params)) (car params) params))
(project (plist-get object :project_id)))
(elmine/api-post :version object
(format "/projects/%s/versions.json" project))))
(defun elmine/update-version (&rest params)
"Update a given version."
(let* ((object (if (listp (car params)) (car params) params))
(id (plist-get object :id)))
(elmine/api-put :version object
(format "/versions/%s.json" id))))
(defun elmine/get-issue-statuses ()
"Get a list of available issue statuses."
(elmine/api-get-all :issue_statuses "/issue_statuses.json"))
(defun elmine/get-issue-priorities (&rest params)
"Get a list of issue priorities."
(apply #'elmine/api-get-all :issue_priorities
"/enumerations/issue_priorities.json" params))
(defun elmine/get-trackers ()
"Get a list of tracker names and their IDs."
(elmine/api-get-all :trackers "/trackers.json"))
(defun elmine/get-issue-priorities ()
"Get a list of issue priorities and their IDs."
(elmine/api-get-all :issue_priorities "/enumerations/issue_priorities.json"))
(defun elmine/get-time-entries (&rest filters)
"Get a list of time entries."
(apply #'elmine/api-get-all :time_entries "/time_entries.json" filters))
(defun elmine/get-time-entry (id)
"Get a specific time entry."
(elmine/api-get :time_entry (format "/time_entries/%s.json" id)))
(defun elmine/get-time-entry-activities (&rest params)
"Get a list of time entry activities."
(apply #'elmine/api-get-all :time_entry_activities
"/enumerations/time_entry_activities.json" params))
(defun elmine/create-time-entry (&rest params)
"Create a new time entry"
(let* ((object (if (listp (car params)) (car params) params)))
(elmine/api-post :time_entry object "/time_entries.json")))
(defun elmine/update-time-entry (&rest params)
"Update a given time entry."
(let* ((object (if (listp (car params)) (car params) params))
(id (plist-get object :id)))
(elmine/api-put :time_entry object (format "/time_entries/%s.json" id))))
(defun elmine/delete-time-entry (id)
"Delete a specific time entry."
(elmine/api-delete (format "/time_entries/%s.json" id)))
(defun elmine/get-users (&rest filters)
"Get a list of users limited by FILTERS."
(apply #'elmine/api-get-all :users "/users.json" filters))
(defun elmine/get-user (user &rest params)
"Get USER. PARAMS can be used to retrieve additional details.
If USER is `current', get user whose credentials are used."
(elmine/api-get :user (format "/users/%s.json" user) params))
(provide 'elmine)
;;; elmine.el ends here

3411
lisp/orgmine.el Normal file
View file

File diff suppressed because it is too large Load diff

249
lisp/perltidy.el Normal file
View file

@ -0,0 +1,249 @@
;;; perltidy.el --- Tidy perl code
;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;;
;; Author: Ye Wenbin <wenbinye@gmail.com>
;; Maintainer: Kirill Babikhin <mrakobes86reg@yandex.ru>
;; Created: 22 Dec 2007
;; Version: 0.05
;; Keywords: tools, convenience, languages
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program 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 General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;; As the PBP(Perl Best Practice) suggest, put this to your ~/.perltidyrc:
;; ## .perltidyrc --- configuration for perltidy
;; # Max line width is 78 cols
;; -l=78
;; # Indent level is 4 cols
;; -i=4
;; # Continuation indent is 4 cols
;; -ci=4
;; # Output to STDOUT
;; -st
;; # Errors to STDERR
;; -se
;; # Maximal vertical tightness
;; -vt=2
;; # No extra indentation for closing brackets
;; -cti=0
;; # Medium parenthesis tightness
;; -pt=1
;; # Medium brace tightness
;; -bt=1
;; # Medium square bracket tightness
;; -sbt=1
;; # Medium block brace tightness
;; -bbt=1
;; # No space before semicolons
;; -nsfs
;; # Don't outdent long quoted strings
;; -nolq
;; # Break before all operators
;; -wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x="
;; Put this file into your load-path and the following into your ~/.emacs:
;; (require 'perltidy)
;;; Code:
(eval-when-compile
(require 'cl))
(defgroup perltidy nil
"Tidy perl code using perltidy"
:group 'tools
:group 'pde)
(defcustom perltidy-program "perltidy"
"*Program name of perltidy"
:type 'string
:group 'perltidy)
(defcustom perltidy-program-params
'(;; I/O control
"--standard-output"
"--standard-error-output"
"--force-read-binary"
"--quiet"
;; FORMATTING OPTIONS
"--no-check-syntax"
)
"*perltidy run options"
:type 'list
:group 'perltidy)
(defcustom perltidy-rcregex "\\.perltidyrc"
"perltidyrc file regex"
:type 'string
:group 'perltidy)
(defmacro perltidy-save-point (&rest body)
(declare (indent 0) (debug t))
`(let ((old-point (point)))
,@body
(goto-char old-point)))
;;;###autoload
(defun perltidy-region (beg end)
"Tidy perl code in the region."
(interactive "r")
(or (get 'perltidy-program 'has-perltidy)
(if (executable-find perltidy-program)
(put 'perltidy-program 'has-perltidy t)
(error "Seem perltidy is not installed")))
(perltidy-save-point
(let ((old-perltidy-env (getenv "PERLTIDY"))
(remote? (tramp-tramp-file-p buffer-file-name))
(perltidyrc (perltidy-find-perltidyrc buffer-file-truename))
(pertidyrc-remote (expand-file-name "perltidyrc-remote" temporary-file-directory))
(perltidy-run-list perltidy-program-params)
)
(if (and (bound-and-true-p remote?)
perltidyrc)
(progn
(require 'tramp-sh)
(tramp-sh-handle-copy-file perltidyrc pertidyrc-remote t)
(setq perltidyrc pertidyrc-remote)
(setq perltidy-run-list
(append perltidy-run-list
(list (concat "-pro=" pertidyrc-remote))))))
(apply #'call-process-region
(append (list beg end perltidy-program
t
t
t
)
perltidy-run-list)))
t))
;;;###autoload
(defun perltidy-buffer ()
"Call perltidy for whole buffer."
(interactive)
(perltidy-region (point-min) (point-max)))
;;;###autoload
(defun perltidy-subroutine ()
"Call perltidy for subroutine at point."
(interactive)
(save-excursion
(let ((current-point (point))
b e)
(setq b (progn (beginning-of-defun) (point)))
(when (and
(looking-at "\\s-*sub\\s-+")
(< b current-point)
(> (save-excursion
(setq e (progn (end-of-defun) (point))))
current-point))
(perltidy-region b e)))))
;;;###autoload
(defun perltidy-dwim-safe (arg)
"Perltidy Do What I Mean safe.
If region is active call perltidy on the region.
If inside subroutine, call perltidy on the subroutine,
otherwise stop."
(interactive "P")
(let ((buf (current-buffer))
beg end)
(cond ((and mark-active transient-mark-mode)
(setq beg (region-beginning)
end (region-end)))
((save-excursion
(let ((current-point (point))
b e)
(setq b (progn (beginning-of-defun) (point)))
(when (and
(looking-at "\\s-*sub\\s-+")
(< b current-point)
(> (save-excursion
(setq e (progn (end-of-defun) (point))))
current-point))
(setq beg b
end e)))))
(t (setq beg nil
end nil)))
(if (and beg
end)
(progn
(perltidy-region beg end)
(font-lock-fontify-buffer)))))
;;;###autoload
(defun perltidy-dwim (arg)
"Perltidy Do What I Mean.
If region is active call perltidy on the region.
If inside subroutine, call perltidy on the subroutine,
otherwise call perltidy for whole buffer."
(interactive "P")
(let ((buf (current-buffer))
beg end)
(cond ((and mark-active transient-mark-mode)
(setq beg (region-beginning)
end (region-end)))
((save-excursion
(let ((current-point (point))
b e)
(setq b (progn (beginning-of-defun) (point)))
(when (and
(looking-at "\\s-*sub\\s-+")
(< b current-point)
(> (save-excursion
(setq e (progn (end-of-defun) (point))))
current-point))
(setq beg b
end e)))))
(t (setq beg (point-min)
end (point-max))))
(perltidy-region beg end)
(font-lock-fontify-buffer)))
(defun perltidy-find-perltidyrc (&optional dir rcregex)
(unless dir (setq dir (buffer-file-name)))
(unless rcregex (setq rcregex perltidy-rcregex))
(setq dir (file-name-directory dir))
(let (rcfile)
(catch 'my-tag
(locate-dominating-file
dir
(lambda (parent)
(let ((rc (car (ignore-errors (directory-files parent t rcregex))))
(pparent (file-name-directory (directory-file-name parent))))
(setq rcfile rc)
(cond ((equal parent
pparent)
(if (= (length rc) 0)
(throw 'my-tag rc)
(throw 'my-tag nil)))
((and (= (length rc) 0)
(file-exists-p (expand-file-name "lib" pparent))
(file-directory-p (expand-file-name "lib" pparent)))
(setq rcfile (car (ignore-errors (directory-files pparent t rcregex))))
(throw 'my-tag rcfile))
(t rc))))))
rcfile))
(provide 'perltidy)
;;; perltidy.el ends here

792
lisp/s.el Normal file
View file

@ -0,0 +1,792 @@
;;; s.el --- The long lost Emacs string manipulation library. -*- lexical-binding: t -*-
;; Copyright (C) 2012-2022 Magnar Sveen
;; Author: Magnar Sveen <magnars@gmail.com>
;; Maintainer: Jason Milkins <jasonm23@gmail.com>
;; Version: 1.13.1
;; Keywords: strings
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program 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 General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; The long lost Emacs string manipulation library.
;;
;; See documentation on https://github.com/magnars/s.el#functions
;;; Code:
;; Silence byte-compiler
(defvar ucs-normalize-combining-chars) ; Defined in `ucs-normalize'
(autoload 'slot-value "eieio")
(defun s-trim-left (s)
"Remove whitespace at the beginning of S."
(declare (pure t) (side-effect-free t))
(save-match-data
(if (string-match "\\`[ \t\n\r]+" s)
(replace-match "" t t s)
s)))
(defun s-trim-right (s)
"Remove whitespace at the end of S."
(declare (pure t) (side-effect-free t))
(save-match-data
(if (string-match "[ \t\n\r]+\\'" s)
(replace-match "" t t s)
s)))
(defun s-trim (s)
"Remove whitespace at the beginning and end of S."
(declare (pure t) (side-effect-free t))
(s-trim-left (s-trim-right s)))
(defun s-collapse-whitespace (s)
"Convert all adjacent whitespace characters to a single space."
(declare (pure t) (side-effect-free t))
(replace-regexp-in-string "[ \t\n\r]+" " " s))
(defun s-unindent (s &optional bol)
"Unindent S which has BOL (beginning of line) indicators.
BOL will default to pipe. You can optionally supply your own."
(declare (pure t) (side-effect-free t))
(let ((case-fold-search nil)
(bol (or bol "|")))
(s-replace-regexp (concat "^[[:space:]]*" (regexp-quote bol)) "" s)))
(defun s-split (separator s &optional omit-nulls)
"Split S into substrings bounded by matches for regexp SEPARATOR.
If OMIT-NULLS is non-nil, zero-length substrings are omitted.
This is a simple wrapper around the built-in `split-string'."
(declare (side-effect-free t))
(save-match-data
(split-string s separator omit-nulls)))
(defun s-split-up-to (separator s n &optional omit-nulls)
"Split S up to N times into substrings bounded by matches for regexp SEPARATOR.
If OMIT-NULLS is non-nil, zero-length substrings are omitted.
See also `s-split'."
(declare (side-effect-free t))
(save-match-data
(let ((op 0)
(r nil))
(with-temp-buffer
(insert s)
(setq op (goto-char (point-min)))
(while (and (re-search-forward separator nil t)
(< 0 n))
(let ((sub (buffer-substring op (match-beginning 0))))
(unless (and omit-nulls
(equal sub ""))
(push sub r)))
(setq op (goto-char (match-end 0)))
(setq n (1- n)))
(let ((sub (buffer-substring op (point-max))))
(unless (and omit-nulls
(equal sub ""))
(push sub r))))
(nreverse r))))
(defun s-lines (s)
"Splits S into a list of strings on newline characters."
(declare (pure t) (side-effect-free t))
(s-split "\\(\r\n\\|[\n\r]\\)" s))
(defun s-join (separator strings)
"Join all the strings in STRINGS with SEPARATOR in between."
(declare (pure t) (side-effect-free t))
(mapconcat 'identity strings separator))
(defun s-concat (&rest strings)
"Join all the string arguments into one string."
(declare (pure t) (side-effect-free t))
(apply 'concat strings))
(defun s-prepend (prefix s)
"Concatenate PREFIX and S."
(declare (pure t) (side-effect-free t))
(concat prefix s))
(defun s-append (suffix s)
"Concatenate S and SUFFIX."
(declare (pure t) (side-effect-free t))
(concat s suffix))
(defun s-splice (needle n s)
"Splice NEEDLE into S at position N.
0 is the beginning of the string, -1 is the end."
(if (< n 0)
(let ((left (substring s 0 (+ 1 n (length s))))
(right (s-right (- -1 n) s)))
(concat left needle right))
(let ((left (s-left n s))
(right (substring s n (length s))))
(concat left needle right))))
(defun s-repeat (num s)
"Make a string of S repeated NUM times."
(declare (pure t) (side-effect-free t))
(let (ss)
(while (> num 0)
(setq ss (cons s ss))
(setq num (1- num)))
(apply 'concat ss)))
(defun s-chop-suffix (suffix s)
"Remove SUFFIX if it is at end of S."
(declare (pure t) (side-effect-free t))
(let ((pos (- (length suffix))))
(if (and (>= (length s) (length suffix))
(string= suffix (substring s pos)))
(substring s 0 pos)
s)))
(defun s-chop-suffixes (suffixes s)
"Remove SUFFIXES one by one in order, if they are at the end of S."
(declare (pure t) (side-effect-free t))
(while suffixes
(setq s (s-chop-suffix (car suffixes) s))
(setq suffixes (cdr suffixes)))
s)
(defun s-chop-prefix (prefix s)
"Remove PREFIX if it is at the start of S."
(declare (pure t) (side-effect-free t))
(let ((pos (length prefix)))
(if (and (>= (length s) (length prefix))
(string= prefix (substring s 0 pos)))
(substring s pos)
s)))
(defun s-chop-prefixes (prefixes s)
"Remove PREFIXES one by one in order, if they are at the start of S."
(declare (pure t) (side-effect-free t))
(while prefixes
(setq s (s-chop-prefix (car prefixes) s))
(setq prefixes (cdr prefixes)))
s)
(defun s-shared-start (s1 s2)
"Returns the longest prefix S1 and S2 have in common."
(declare (pure t) (side-effect-free t))
(let ((cmp (compare-strings s1 0 (length s1) s2 0 (length s2))))
(if (eq cmp t) s1 (substring s1 0 (1- (abs cmp))))))
(defun s-shared-end (s1 s2)
"Returns the longest suffix S1 and S2 have in common."
(declare (pure t) (side-effect-free t))
(let* ((l1 (length s1))
(l2 (length s2))
(search-length (min l1 l2))
(i 0))
(while (and (< i search-length)
(= (aref s1 (- l1 i 1)) (aref s2 (- l2 i 1))))
(setq i (1+ i)))
;; If I is 0, then it means that there's no common suffix between
;; S1 and S2.
;;
;; However, since (substring s (- 0)) will return the whole
;; string, `s-shared-end' should simply return the empty string
;; when I is 0.
(if (zerop i)
""
(substring s1 (- i)))))
(defun s-chomp (s)
"Remove one trailing `\\n`, `\\r` or `\\r\\n` from S."
(declare (pure t) (side-effect-free t))
(s-chop-suffixes '("\n" "\r") s))
(defun s-truncate (len s &optional ellipsis)
"If S is longer than LEN, cut it down and add ELLIPSIS to the end.
The resulting string, including ellipsis, will be LEN characters
long.
When not specified, ELLIPSIS defaults to ‘...’."
(declare (pure t) (side-effect-free t))
(unless ellipsis
(setq ellipsis "..."))
(if (> (length s) len)
(format "%s%s" (substring s 0 (- len (length ellipsis))) ellipsis)
s))
(defun s-word-wrap (len s)
"If S is longer than LEN, wrap the words with newlines."
(declare (side-effect-free t))
(save-match-data
(with-temp-buffer
(insert s)
(let ((fill-column len))
(fill-region (point-min) (point-max)))
(buffer-substring (point-min) (point-max)))))
(defun s-center (len s)
"If S is shorter than LEN, pad it with spaces so it is centered."
(declare (pure t) (side-effect-free t))
(let ((extra (max 0 (- len (length s)))))
(concat
(make-string (ceiling extra 2) ?\s)
s
(make-string (floor extra 2) ?\s))))
(defun s-pad-left (len padding s)
"If S is shorter than LEN, pad it with PADDING on the left."
(declare (pure t) (side-effect-free t))
(let ((extra (max 0 (- len (length s)))))
(concat (make-string extra (string-to-char padding))
s)))
(defun s-pad-right (len padding s)
"If S is shorter than LEN, pad it with PADDING on the right."
(declare (pure t) (side-effect-free t))
(let ((extra (max 0 (- len (length s)))))
(concat s
(make-string extra (string-to-char padding)))))
(defun s-left (len s)
"Returns up to the LEN first chars of S."
(declare (pure t) (side-effect-free t))
(if (> (length s) len)
(substring s 0 len)
s))
(defun s-right (len s)
"Returns up to the LEN last chars of S."
(declare (pure t) (side-effect-free t))
(let ((l (length s)))
(if (> l len)
(substring s (- l len) l)
s)))
(defun s-chop-left (len s)
"Remove the first LEN chars from S."
(let ((l (length s)))
(if (> l len)
(substring s len l)
"")))
(defun s-chop-right (len s)
"Remove the last LEN chars from S."
(let ((l (length s)))
(if (> l len)
(substring s 0 (- l len))
"")))
(defun s-ends-with? (suffix s &optional ignore-case)
"Does S end with SUFFIX?
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences.
Alias: `s-suffix?'"
(declare (pure t) (side-effect-free t))
(let ((start-pos (- (length s) (length suffix))))
(and (>= start-pos 0)
(eq t (compare-strings suffix nil nil
s start-pos nil ignore-case)))))
(defun s-starts-with? (prefix s &optional ignore-case)
"Does S start with PREFIX?
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences.
Alias: `s-prefix?'. This is a simple wrapper around the built-in
`string-prefix-p'."
(declare (pure t) (side-effect-free t))
(string-prefix-p prefix s ignore-case))
(defun s--truthy? (val)
(declare (pure t) (side-effect-free t))
(not (null val)))
(defun s-contains? (needle s &optional ignore-case)
"Does S contain NEEDLE?
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences."
(declare (pure t) (side-effect-free t))
(let ((case-fold-search ignore-case))
(s--truthy? (string-match-p (regexp-quote needle) s))))
(defun s-equals? (s1 s2)
"Is S1 equal to S2?
This is a simple wrapper around the built-in `string-equal'."
(declare (pure t) (side-effect-free t))
(string-equal s1 s2))
(defun s-less? (s1 s2)
"Is S1 less than S2?
This is a simple wrapper around the built-in `string-lessp'."
(declare (pure t) (side-effect-free t))
(string-lessp s1 s2))
(defun s-matches? (regexp s &optional start)
"Does REGEXP match S?
If START is non-nil the search starts at that index.
This is a simple wrapper around the built-in `string-match-p'."
(declare (side-effect-free t))
(s--truthy? (string-match-p regexp s start)))
(defun s-blank? (s)
"Is S nil or the empty string?"
(declare (pure t) (side-effect-free t))
(or (null s) (string= "" s)))
(defun s-blank-str? (s)
"Is S nil or the empty string or string only contains whitespace?"
(declare (pure t) (side-effect-free t))
(or (s-blank? s) (s-blank? (s-trim s))))
(defun s-present? (s)
"Is S anything but nil or the empty string?"
(declare (pure t) (side-effect-free t))
(not (s-blank? s)))
(defun s-presence (s)
"Return S if it's `s-present?', otherwise return nil."
(declare (pure t) (side-effect-free t))
(and (s-present? s) s))
(defun s-lowercase? (s)
"Are all the letters in S in lower case?"
(declare (side-effect-free t))
(let ((case-fold-search nil))
(not (string-match-p "[[:upper:]]" s))))
(defun s-uppercase? (s)
"Are all the letters in S in upper case?"
(declare (side-effect-free t))
(let ((case-fold-search nil))
(not (string-match-p "[[:lower:]]" s))))
(defun s-mixedcase? (s)
"Are there both lower case and upper case letters in S?"
(let ((case-fold-search nil))
(s--truthy?
(and (string-match-p "[[:lower:]]" s)
(string-match-p "[[:upper:]]" s)))))
(defun s-capitalized? (s)
"In S, is the first letter upper case, and all other letters lower case?"
(declare (side-effect-free t))
(let ((case-fold-search nil))
(s--truthy?
(string-match-p "^[[:upper:]][^[:upper:]]*$" s))))
(defun s-numeric? (s)
"Is S a number?"
(declare (pure t) (side-effect-free t))
(s--truthy?
(string-match-p "^[0-9]+$" s)))
(defun s-replace (old new s)
"Replaces OLD with NEW in S."
(declare (pure t) (side-effect-free t))
(replace-regexp-in-string (regexp-quote old) new s t t))
(defalias 's-replace-regexp 'replace-regexp-in-string)
(defun s--aget (alist key)
"Get the value of KEY in ALIST."
(declare (pure t) (side-effect-free t))
(cdr (assoc-string key alist)))
(defun s-replace-all (replacements s)
"REPLACEMENTS is a list of cons-cells. Each `car` is replaced with `cdr` in S."
(declare (pure t) (side-effect-free t))
(let ((case-fold-search nil))
(replace-regexp-in-string (regexp-opt (mapcar 'car replacements))
(lambda (it) (s--aget replacements it))
s t t)))
(defun s-downcase (s)
"Convert S to lower case.
This is a simple wrapper around the built-in `downcase'."
(declare (side-effect-free t))
(downcase s))
(defun s-upcase (s)
"Convert S to upper case.
This is a simple wrapper around the built-in `upcase'."
(declare (side-effect-free t))
(upcase s))
(defun s-capitalize (s)
"Convert S first word's first character to upper and the rest to lower case."
(declare (side-effect-free t))
(concat (upcase (substring s 0 1)) (downcase (substring s 1))))
(defun s-titleize (s)
"Convert in S each word's first character to upper and the rest to lower case.
This is a simple wrapper around the built-in `capitalize'."
(declare (side-effect-free t))
(capitalize s))
(defmacro s-with (s form &rest more)
"Threads S through the forms. Inserts S as the last item
in the first form, making a list of it if it is not a list
already. If there are more forms, inserts the first form as the
last item in second form, etc."
(declare (debug (form &rest [&or (function &rest form) fboundp])))
(if (null more)
(if (listp form)
`(,(car form) ,@(cdr form) ,s)
(list form s))
`(s-with (s-with ,s ,form) ,@more)))
(put 's-with 'lisp-indent-function 1)
(defun s-index-of (needle s &optional ignore-case)
"Returns first index of NEEDLE in S, or nil.
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences."
(declare (pure t) (side-effect-free t))
(let ((case-fold-search ignore-case))
(string-match-p (regexp-quote needle) s)))
(defun s-reverse (s)
"Return the reverse of S."
(declare (pure t) (side-effect-free t))
(save-match-data
(if (multibyte-string-p s)
(let ((input (string-to-list s))
output)
(require 'ucs-normalize)
(while input
;; Handle entire grapheme cluster as a single unit
(let ((grapheme (list (pop input))))
(while (memql (car input) ucs-normalize-combining-chars)
(push (pop input) grapheme))
(setq output (nconc (nreverse grapheme) output))))
(concat output))
(concat (nreverse (string-to-list s))))))
(defun s-match-strings-all (regex string)
"Return a list of matches for REGEX in STRING.
Each element itself is a list of matches, as per
`match-string'. Multiple matches at the same position will be
ignored after the first."
(declare (side-effect-free t))
(save-match-data
(let ((all-strings ())
(i 0))
(while (and (< i (length string))
(string-match regex string i))
(setq i (1+ (match-beginning 0)))
(let (strings
(num-matches (/ (length (match-data)) 2))
(match 0))
(while (/= match num-matches)
(push (match-string match string) strings)
(setq match (1+ match)))
(push (nreverse strings) all-strings)))
(nreverse all-strings))))
(defun s-matched-positions-all (regexp string &optional subexp-depth)
"Return a list of matched positions for REGEXP in STRING.
SUBEXP-DEPTH is 0 by default."
(declare (side-effect-free t))
(if (null subexp-depth)
(setq subexp-depth 0))
(save-match-data
(let ((pos 0) result)
(while (and (string-match regexp string pos)
(< pos (length string)))
(push (cons (match-beginning subexp-depth) (match-end subexp-depth)) result)
(setq pos (match-end 0)))
(nreverse result))))
(defun s-match (regexp s &optional start)
"When the given expression matches the string, this function returns a list
of the whole matching string and a string for each matched subexpressions.
Subexpressions that didn't match are represented by nil elements
in the list, except that non-matching subexpressions at the end
of REGEXP might not appear at all in the list. That is, the
returned list can be shorter than the number of subexpressions in
REGEXP plus one. If REGEXP did not match the returned value is
an empty list (nil).
When START is non-nil the search will start at that index."
(declare (side-effect-free t))
(save-match-data
(if (string-match regexp s start)
(let ((match-data-list (match-data))
result)
(while match-data-list
(let* ((beg (car match-data-list))
(end (cadr match-data-list))
(subs (if (and beg end) (substring s beg end) nil)))
(setq result (cons subs result))
(setq match-data-list
(cddr match-data-list))))
(nreverse result)))))
(defun s-slice-at (regexp s)
"Slices S up at every index matching REGEXP."
(declare (side-effect-free t))
(if (s-blank? s)
(list s)
(let (ss)
(while (not (s-blank? s))
(save-match-data
(let ((i (string-match regexp s 1)))
(if i
(setq ss (cons (substring s 0 i) ss)
s (substring s i))
(setq ss (cons s ss)
s "")))))
(nreverse ss))))
(defun s-split-words (s)
"Split S into list of words."
(declare (side-effect-free t))
(s-split
"[^[:word:]0-9]+"
(let ((case-fold-search nil))
(replace-regexp-in-string
"\\([[:lower:]]\\)\\([[:upper:]]\\)" "\\1 \\2"
(replace-regexp-in-string "\\([[:upper:]]\\)\\([[:upper:]][0-9[:lower:]]\\)" "\\1 \\2" s)))
t))
(defun s--mapcar-head (fn-head fn-rest list)
"Like MAPCAR, but applies a different function to the first element."
(if list
(cons (funcall fn-head (car list)) (mapcar fn-rest (cdr list)))))
(defun s-lower-camel-case (s)
"Convert S to lowerCamelCase."
(declare (side-effect-free t))
(s-join "" (s--mapcar-head 'downcase 'capitalize (s-split-words s))))
(defun s-upper-camel-case (s)
"Convert S to UpperCamelCase."
(declare (side-effect-free t))
(s-join "" (mapcar 'capitalize (s-split-words s))))
(defun s-snake-case (s)
"Convert S to snake_case."
(declare (side-effect-free t))
(s-join "_" (mapcar 'downcase (s-split-words s))))
(defun s-dashed-words (s)
"Convert S to dashed-words."
(declare (side-effect-free t))
(s-join "-" (mapcar 'downcase (s-split-words s))))
(defun s-spaced-words (s)
"Convert S to spaced words."
(declare (side-effect-free t))
(s-join " " (s-split-words s)))
(defun s-capitalized-words (s)
"Convert S to Capitalized words."
(declare (side-effect-free t))
(let ((words (s-split-words s)))
(s-join " " (cons (capitalize (car words)) (mapcar 'downcase (cdr words))))))
(defun s-titleized-words (s)
"Convert S to Titleized Words."
(declare (side-effect-free t))
(s-join " " (mapcar 's-titleize (s-split-words s))))
(defun s-word-initials (s)
"Convert S to its initials."
(declare (side-effect-free t))
(s-join "" (mapcar (lambda (ss) (substring ss 0 1))
(s-split-words s))))
;; Errors for s-format
(progn
(put 's-format-resolve
'error-conditions
'(error s-format s-format-resolve))
(put 's-format-resolve
'error-message
"Cannot resolve a template to values"))
(defun s-format (template replacer &optional extra)
"Format TEMPLATE with the function REPLACER.
REPLACER takes an argument of the format variable and optionally
an extra argument which is the EXTRA value from the call to
`s-format'.
Several standard `s-format' helper functions are recognized and
adapted for this:
(s-format \"${name}\" \\='gethash hash-table)
(s-format \"${name}\" \\='aget alist)
(s-format \"$0\" \\='elt sequence)
The REPLACER function may be used to do any other kind of
transformation."
(let ((saved-match-data (match-data)))
(unwind-protect
(replace-regexp-in-string
"\\$\\({\\([^}]+\\)}\\|[0-9]+\\)"
(lambda (md)
(let ((var
(let ((m (match-string 2 md)))
(if m m
(string-to-number (match-string 1 md)))))
(replacer-match-data (match-data)))
(unwind-protect
(let ((v
(cond
((eq replacer 'gethash)
(funcall replacer var extra))
((eq replacer 'aget)
(funcall 's--aget extra var))
((eq replacer 'elt)
(funcall replacer extra var))
((eq replacer 'oref)
(funcall #'slot-value extra (intern var)))
(t
(set-match-data saved-match-data)
(if extra
(funcall replacer var extra)
(funcall replacer var))))))
(if v (format "%s" v) (signal 's-format-resolve md)))
(set-match-data replacer-match-data))))
template
;; Need literal to make sure it works
t t)
(set-match-data saved-match-data))))
(defvar s-lex-value-as-lisp nil
"If `t' interpolate lisp values as lisp.
`s-lex-format' inserts values with (format \"%S\").")
(defun s-lex-fmt|expand (fmt)
"Expand FMT into lisp."
(declare (side-effect-free t))
(list 's-format fmt (quote 'aget)
(append '(list)
(mapcar
(lambda (matches)
(list
'cons
(cadr matches)
`(format
(if s-lex-value-as-lisp "%S" "%s")
,(intern (cadr matches)))))
(s-match-strings-all "${\\([^}]+\\)}" fmt)))))
(defmacro s-lex-format (format-str)
"`s-format` with the current environment.
FORMAT-STR may use the `s-format' variable reference to refer to
any variable:
(let ((x 1))
(s-lex-format \"x is: ${x}\"))
The values of the variables are interpolated with \"%s\" unless
the variable `s-lex-value-as-lisp' is `t' and then they are
interpolated with \"%S\"."
(declare (debug (form)))
(s-lex-fmt|expand format-str))
(defun s-count-matches (regexp s &optional start end)
"Count occurrences of `regexp' in `s'.
`start', inclusive, and `end', exclusive, delimit the part of `s' to
match. `start' and `end' are both indexed starting at 1; the initial
character in `s' is index 1.
This function starts looking for the next match from the end of the
previous match. Hence, it ignores matches that overlap a previously
found match. To count overlapping matches, use
`s-count-matches-all'."
(declare (side-effect-free t))
(save-match-data
(with-temp-buffer
(insert s)
(goto-char (point-min))
(count-matches regexp (or start 1) (or end (point-max))))))
(defun s-count-matches-all (regexp s &optional start end)
"Count occurrences of `regexp' in `s'.
`start', inclusive, and `end', exclusive, delimit the part of `s' to
match. `start' and `end' are both indexed starting at 1; the initial
character in `s' is index 1.
This function starts looking for the next match from the second
character of the previous match. Hence, it counts matches that
overlap a previously found match. To ignore matches that overlap a
previously found match, use `s-count-matches'."
(declare (side-effect-free t))
(let* ((anchored-regexp (format "^%s" regexp))
(match-count 0)
(i 0)
(narrowed-s (substring s (if start (1- start) 0)
(when end (1- end)))))
(save-match-data
(while (< i (length narrowed-s))
(when (s-matches? anchored-regexp (substring narrowed-s i))
(setq match-count (1+ match-count)))
(setq i (1+ i))))
match-count))
(defun s-wrap (s prefix &optional suffix)
"Wrap string S with PREFIX and optionally SUFFIX.
Return string S with PREFIX prepended. If SUFFIX is present, it
is appended, otherwise PREFIX is used as both prefix and
suffix."
(declare (pure t) (side-effect-free t))
(concat prefix s (or suffix prefix)))
;;; Aliases
(defalias 's-blank-p 's-blank?)
(defalias 's-blank-str-p 's-blank-str?)
(defalias 's-capitalized-p 's-capitalized?)
(defalias 's-contains-p 's-contains?)
(defalias 's-ends-with-p 's-ends-with?)
(defalias 's-equals-p 's-equals?)
(defalias 's-less-p 's-less?)
(defalias 's-lowercase-p 's-lowercase?)
(defalias 's-matches-p 's-matches?)
(defalias 's-mixedcase-p 's-mixedcase?)
(defalias 's-numeric-p 's-numeric?)
(defalias 's-prefix-p 's-starts-with?)
(defalias 's-prefix? 's-starts-with?)
(defalias 's-present-p 's-present?)
(defalias 's-starts-with-p 's-starts-with?)
(defalias 's-suffix-p 's-ends-with?)
(defalias 's-suffix? 's-ends-with?)
(defalias 's-uppercase-p 's-uppercase?)
(provide 's)
;;; s.el ends here

4
request/curl-cookie-jar Normal file
View file

@ -0,0 +1,4 @@
# Netscape HTTP Cookie File
# https://curl.se/docs/http-cookies.html
# This file was generated by libcurl! Edit at your own risk.

1
transient/history.el Normal file
View file

@ -0,0 +1 @@
nil