From: Leo Liu Date: Tue, 22 Apr 2014 08:36:30 +0000 (+0800) Subject: Fix prefix of last merge and restore deleted files X-Git-Url: https://code.delx.au/gnu-emacs-elpa/commitdiff_plain/3c1a6816100fb97f85cc07cac47f538e7a55ee73 Fix prefix of last merge and restore deleted files See discussion http://lists.gnu.org/archive/html/emacs-devel/2014-04/msg00311.html --- diff --git a/admin/README.rst b/admin/README.rst deleted file mode 100644 index 02ad57b5c..000000000 --- a/admin/README.rst +++ /dev/null @@ -1,123 +0,0 @@ -==================================== - Kill & Mark Things Easily in Emacs -==================================== - -.. image:: https://travis-ci.org/leoliu/easy-kill.svg?branch=master - :target: https://travis-ci.org/leoliu/easy-kill - :align: right - :alt: Travis CI build status - -Provide commands ``easy-kill`` and ``easy-mark`` to let users kill or -mark things easily. - -Comments, bug reports and patches are highly appreciated. - -easy-kill -~~~~~~~~~ - -``easy-kill`` is a drop-in replacement for ``kill-ring-save``. To Use: -:: - - (global-set-key [remap kill-ring-save] 'easy-kill) - -After this configuration, ``M-w`` serves as both a command and a -prefix key for other commands. ``M-w`` alone saves in the order of -active region, url, email and finally current line (See -``easy-kill-try-things``). As a prefix key: - -#. ``M-w w``: save word at point -#. ``M-w s``: save sexp at point -#. ``M-w l``: save list at point (enclosing sexp) -#. ``M-w d``: save defun at point -#. ``M-w f``: save file at point -#. ``M-w b``: save ``buffer-file-name`` or ``default-directory``. - ``-`` changes the kill to the directory name, ``+`` to full name - and ``0`` to basename. - -The following keys modify the selection: - -#. ``@``: append selection to previous kill and exit. For example, - ``M-w d @`` will append current function to last kill. -#. ``C-w``: kill selection and exit -#. ``+``, ``-`` and ``1..9``: expand/shrink selection -#. ``0`` shrink the selection to the intitial size i.e. before any - expansion -#. ``C-SPC``: turn selection into an active region -#. ``C-g``: abort -#. ``?``: help - -For example, ``M-w w`` saves current word, repeat ``w`` to expand the -kill to include the next word. ``5`` to include the next 5 words etc. -The other commands also follow this pattern. - -``+``/``-`` does expanding/shrinking according to the thing selected. -So for ``word`` the expansion is word-wise, for ``line`` line-wise, -for ``list`` or ``sexp``, list-wise. - -``list-wise`` expanding/shrinking work well in lispy modes (elisp, -Common Lisp, Scheme, Clojure etc.), smie-based modes (Prolog, SML, -Modula2, Shell, Ruby, Octave, CSS, SQL etc.), Org mode, Nxml mode and -Js2 mode. - -To copy the enclosing list in lispy modes, I used to do a lot of -``C-M-u C-M-SPC M-w``. Now the key sequence is replaced by ``M-w l`` -(save list at point) as shown in `screenshot -`_: - -.. figure:: http://i.imgur.com/8TNgPly.png - :target: http://i.imgur.com/8TNgPly.png - :alt: ``M-w l`` - -easy-mark -~~~~~~~~~ - -``easy-mark`` is similar to ``easy-kill`` but marks the region -immediately. It can be a handy replacement for ``mark-sexp`` allowing -``+``/``-`` to do list-wise expanding/shrinking and marks the whole -sexp even when in the middle of one. :: - - (global-set-key [remap mark-sexp] 'easy-mark) - -Install -~~~~~~~ - -``easy-kill`` is part of GNU ELPA and is also available on `MELPA -`_. - -Extensions -~~~~~~~~~~ - -New things can be defined by following package ``thingatpt.el``'s -convention, or by defining new functions named like -``easy-kill-on-THING-NAME``. See ``easy-kill-on-buffer-file-name`` and -``easy-kill-on-url`` for examples. - -NEWS -~~~~ - -0.9.3 -+++++ - -#. Key ``?`` in ``easy-kill`` or ``easy-mark`` prints help info. -#. ``M-w l`` can select the enclosing string. -#. ``easy-mark`` learns exchanging point & mark. -#. Key ``0`` now sets the selection to its initial size before any - expansion. -#. ``M-w l``, ``M-w s`` and list-wise ``+/-`` now work in Org mode. - -0.9.2 -+++++ - -#. ``-`` can move pass the first selection. -#. ``+``/``-`` on ``sexp`` no longer change ``thing`` to ``list`` -#. Mouse over the selection now shows description. -#. Echo js2 node name. -#. Append now uses sensible separator (customisable via - ``easy-kill-alist``). -#. The format of easy-kill-alist has changed. The old ``(CHAR . - THING)`` format is still supported but may be removed in future. - -Bugs -~~~~ - -https://github.com/leoliu/easy-kill/issues diff --git a/admin/archive-contents.el b/admin/archive-contents.el new file mode 100644 index 000000000..241f1ad10 --- /dev/null +++ b/admin/archive-contents.el @@ -0,0 +1,588 @@ +;;; archive-contents.el --- Auto-generate an Emacs Lisp package archive. -*- lexical-binding:t -*- + +;; Copyright (C) 2011-2014 Free Software Foundation, Inc + +;; Author: Stefan Monnier + +;; 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 . + +;;; Commentary: + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'lisp-mnt) +(require 'package) +(require 'pcase) + +(defconst archive-contents-subdirectory-regexp + "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)") + +(defconst archive-re-no-dot "\\`\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" + "Regular expression matching all files except \".\" and \"..\".") + +(defun archive--version-to-list (vers) + (when vers + (let ((l (version-to-list vers))) + ;; Signal an error for things like "1.02" which is parsed as "1.2". + (assert (equal vers (package-version-join l)) nil + "Unsupported version syntax %S" vers) + l))) + +(defun archive--convert-require (elt) + (list (car elt) + (archive--version-to-list (car (cdr elt))))) + +(defun archive--strip-rcs-id (str) + "Strip RCS version ID from the version string STR. +If the result looks like a dotted numeric version, return it. +Otherwise return nil." + (when str + (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str) + (setq str (substring str (match-end 0)))) + (condition-case nil + (if (archive--version-to-list str) + str) + (error str)))) + +(defun archive--delete-elc-files (dir &optional only-orphans) + "Recursively delete all .elc files in DIR. +Delete backup files also." + (dolist (f (directory-files dir t archive-re-no-dot)) + (cond ((file-directory-p f) + (archive--delete-elc-files f)) + ((or (and (string-match "\\.elc\\'" f) + (not (and only-orphans + (file-readable-p (replace-match ".el" t t f))))) + (backup-file-name-p f)) + (delete-file f))))) + +(defun batch-make-archive () + "Process package content directories and generate the archive-contents file." + (let ((packages '(1))) ; format-version. + (dolist (dir (directory-files default-directory nil archive-re-no-dot)) + (condition-case v + (if (not (file-directory-p dir)) + (message "Skipping non-package file %s" dir) + (let* ((pkg (file-name-nondirectory dir)) + (autoloads-file (expand-file-name (concat pkg "-autoloads.el") dir))) + ;; Omit autoloads and .elc files from the package. + (if (file-exists-p autoloads-file) + (delete-file autoloads-file)) + (archive--delete-elc-files dir) + (let ((metadata (archive--metadata dir pkg))) + ;; (nth 1 metadata) is nil for "org" which is the only package + ;; still using the "org-pkg.el file to specify the metadata. + (if (and (nth 1 metadata) + (< (string-to-number (nth 1 metadata)) 0)) + (progn ;; Negative version: don't publish this package yet! + (message "Package %s not released yet!" dir) + (delete-directory dir 'recursive)) + (push (if (car metadata) + (apply #'archive--process-simple-package + dir pkg (cdr metadata)) + (if (nth 1 metadata) + (apply #'archive--write-pkg-file + dir pkg (cdr metadata))) + (archive--process-multi-file-package dir pkg)) + packages))))) + ((debug error) (error "Error in %s: %S" dir v)))) + (with-temp-buffer + (pp (nreverse packages) (current-buffer)) + (write-region nil nil "archive-contents")))) + +(defconst archive--revno-re "[0-9a-f]+") + +(defun archive-prepare-packages (srcdir) + "Prepare the `packages' directory inside the Git checkout. +Expects to be called from within the `packages' directory. +\"Prepare\" here is for subsequent construction of the packages and archive, +so it is meant to refresh any generated files we may need. +Currently only refreshes the ChangeLog files." + (setq srcdir (file-name-as-directory (expand-file-name srcdir))) + (let* ((wit ".changelog-witness") + (prevno (with-temp-buffer + (insert-file-contents wit) + (if (looking-at (concat archive--revno-re "$")) + (match-string 0) + (error "Can't find previous revision name")))) + (new-revno + (or (with-temp-buffer + (let ((default-directory srcdir)) + (call-process "git" nil '(t) nil "rev-parse" "HEAD") + (goto-char (point-min)) + (when (looking-at (concat archive--revno-re "$")) + (match-string 0)))) + (error "Couldn't find the current revision's name"))) + (pkgs '())) + (unless (equal prevno new-revno) + (with-temp-buffer + (let ((default-directory srcdir)) + (unless (zerop (call-process "git" nil '(t) nil "diff" + "--dirstat=cumulative,0" + prevno)) + (error "Error signaled by git diff --dirstat %d" prevno))) + (goto-char (point-min)) + (while (re-search-forward "^[ \t.0-9%]* packages/\\([-[:alnum:]]+\\)/$" + nil t) + (push (match-string 1) pkgs)))) + (let ((default-directory (expand-file-name "packages/"))) + (dolist (pkg pkgs) + (condition-case v + (if (file-directory-p pkg) + (archive--make-changelog pkg (expand-file-name "packages/" + srcdir))) + (error (message "Error: %S" v))))) + (write-region new-revno nil wit nil 'quiet) + ;; Also update the ChangeLog of external packages. + (let ((default-directory (expand-file-name "packages/"))) + (dolist (dir (directory-files ".")) + (and (not (member dir '("." ".."))) + (file-directory-p dir) + (let ((index (expand-file-name + (concat "packages/" dir "/.git/index") + srcdir)) + (cl (expand-file-name "ChangeLog" dir))) + (and (file-exists-p index) + (or (not (file-exists-p cl)) + (file-newer-than-file-p index cl)))) + (archive--make-changelog + dir (expand-file-name "packages/" srcdir))))) + )) + +(defun archive--metadata (dir pkg) + "Return a list (SIMPLE VERSION DESCRIPTION REQ EXTRAS), +where SIMPLE is non-nil if the package is simple; +VERSION is the version string of the simple package; +DESCRIPTION is the brief description of the package; +REQ is a list of requirements; +EXTRAS is an alist with additional metadata. + +PKG is the name of the package and DIR is the directory where it is." + (let* ((mainfile (expand-file-name (concat pkg ".el") dir)) + (files (directory-files dir nil "\\.el\\'"))) + (setq files (delete (concat pkg "-pkg.el") files)) + (setq files (delete (concat pkg "-autoloads.el") files)) + (cond + ((file-exists-p mainfile) + (with-temp-buffer + (insert-file-contents mainfile) + (goto-char (point-min)) + (if (not (looking-at ";;;.*---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$")) + (error "Can't parse first line of %s" mainfile) + ;; Grab the other fields, which are not mandatory. + (let* ((description (match-string 1)) + (version + (or (archive--strip-rcs-id (lm-header "package-version")) + (archive--strip-rcs-id (lm-header "version")) + (unless (equal pkg "org") + (error "Missing `version' header")))) + (requires-str (lm-header "package-requires")) + (pt (lm-header "package-type")) + (simple (if pt (equal pt "simple") (= (length files) 1))) + (keywords (lm-keywords-list)) + (url (or (lm-header "url") + (format "http://elpa.gnu.org/packages/%s.html" pkg))) + (req + (if requires-str + (mapcar 'archive--convert-require + (car (read-from-string requires-str)))))) + (list simple version description req + ;; extra parameters + (list (cons :url url) + (cons :keywords keywords))))))) + (t + (error "Can find main file %s file in %s" mainfile dir))))) + +(defun archive--process-simple-package (dir pkg vers desc req extras) + "Deploy the contents of DIR into the archive as a simple package. +Rename DIR/PKG.el to PKG-VERS.el, delete DIR, and return the descriptor." + ;; Write DIR/foo.el to foo-VERS.el and delete DIR + (rename-file (expand-file-name (concat pkg ".el") dir) + (concat pkg "-" vers ".el")) + ;; Add the content of the ChangeLog. + (let ((cl (expand-file-name "ChangeLog" dir))) + (with-current-buffer (find-file-noselect (concat pkg "-" vers ".el")) + (goto-char (point-max)) + (re-search-backward "^;;;.*ends here") + (re-search-backward "^(provide") + (skip-chars-backward " \t\n") + (insert "\n\n;;;; ChangeLog:\n\n") + (let* ((start (point)) + (end (copy-marker start t))) + (condition-case nil + (insert-file-contents cl) + (file-error (message "Can't find %S's ChangeLog file" pkg))) + (goto-char end) + (unless (bolp) (insert "\n")) + (while (progn (forward-line -1) (>= (point) start)) + (insert ";; "))) + (set (make-local-variable 'backup-inhibited) t) + (basic-save-buffer) ;Less chatty than save-buffer. + (kill-buffer))) + (delete-directory dir t) + (cons (intern pkg) (vector (archive--version-to-list vers) + req desc 'single extras))) + +(defun archive--make-changelog (dir srcdir) + "Export Git log info of DIR into a ChangeLog file." + (message "Refreshing ChangeLog in %S" dir) + (let ((default-directory (file-name-as-directory (expand-file-name dir)))) + (with-temp-buffer + (set-buffer-multibyte nil) + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (if (file-readable-p "ChangeLog") (insert-file-contents "ChangeLog")) + (let ((old-md5 (md5 (current-buffer)))) + (erase-buffer) + (let ((default-directory + (file-name-as-directory (expand-file-name dir srcdir)))) + (call-process "git" nil (current-buffer) nil + "log" "--date=short" + "--format=%cd %aN <%ae>%n%n%w(80,8,8)%B%n" + ".")) + (tabify (point-min) (point-max)) + (goto-char (point-min)) + (while (re-search-forward "\n\n\n+" nil t) + (replace-match "\n\n")) + (if (equal old-md5 (md5 (current-buffer))) + (message "ChangeLog's md5 unchanged for %S" dir) + (write-region (point-min) (point-max) "ChangeLog" nil 'quiet))))))) + +(defun archive--alist-to-plist-args (alist) + (mapcar (lambda (x) + (if (and (not (consp x)) + (or (keywordp x) + (not (symbolp x)) + (memq x '(nil t)))) + x `',x)) + (apply #'nconc + (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist)))) + +(defun archive--plist-args-to-alist (plist) + (let (alist) + (while plist + (let ((value (cadr plist))) + (when value + (cl-assert (keywordp (car plist))) + (push (cons (car plist) + (if (eq 'quote (car-safe value)) (cadr value) value)) + alist))) + (setq plist (cddr plist))) + alist)) + +(defun archive--process-multi-file-package (dir pkg) + "Deploy the contents of DIR into the archive as a multi-file package. +Rename DIR/ to PKG-VERS/, and return the descriptor." + (let* ((exp (archive--multi-file-package-def dir pkg)) + (vers (nth 2 exp)) + (req-exp (nth 4 exp)) + (req (mapcar 'archive--convert-require + (if (eq 'quote (car-safe req-exp)) (nth 1 req-exp) + (when req-exp + (error "REQ should be a quoted constant: %S" + req-exp))))) + (extras (archive--plist-args-to-alist (nthcdr 5 exp)))) + (unless (equal (nth 1 exp) pkg) + (error (format "Package name %s doesn't match file name %s" + (nth 1 exp) pkg))) + (rename-file dir (concat pkg "-" vers)) + (cons (intern pkg) (vector (archive--version-to-list vers) + req (nth 3 exp) 'tar extras)))) + +(defun archive--multi-file-package-def (dir pkg) + "Return the `define-package' form in the file DIR/PKG-pkg.el." + (let ((pkg-file (expand-file-name (concat pkg "-pkg.el") dir))) + (with-temp-buffer + (unless (file-exists-p pkg-file) + (error "File not found: %s" pkg-file)) + (insert-file-contents pkg-file) + (goto-char (point-min)) + (read (current-buffer))))) + +(defun archive--refresh-pkg-file () + (let* ((dir (directory-file-name default-directory)) + (pkg (file-name-nondirectory dir))) + (apply #'archive--write-pkg-file dir pkg + (cdr (archive--metadata dir pkg))))) + +(defun archive--write-pkg-file (pkg-dir name version desc requires extras) + (let ((pkg-file (expand-file-name (concat name "-pkg.el") pkg-dir)) + (print-level nil) + (print-quoted t) + (print-length nil)) + (write-region + (concat (format ";; Generated package description from %s.el\n" + name) + (prin1-to-string + (nconc + (list 'define-package + name + version + desc + (list 'quote + ;; Turn version lists into string form. + (mapcar + (lambda (elt) + (list (car elt) + (package-version-join (cadr elt)))) + requires))) + (archive--alist-to-plist-args extras))) + "\n") + nil + pkg-file))) + +;;; Make the HTML pages for online browsing. + +(defun archive--html-header (title) + (format " + + + %s + + + +

%s

\n" + title title)) + +(defun archive--html-bytes-format (bytes) ;Aka memory-usage-format. + (setq bytes (/ bytes 1024.0)) + (let ((units '(;; "B" + "kB" "MB" "GB" "TB"))) + (while (>= bytes 1024) + (setq bytes (/ bytes 1024.0)) + (setq units (cdr units))) + (cond + ;; ((integerp bytes) (format "%4d%s" bytes (car units))) + ((>= bytes 100) (format "%4.0f%s" bytes (car units))) + ((>= bytes 10) (format "%4.1f%s" bytes (car units))) + (t (format "%4.2f%s" bytes (car units)))))) + +(defun archive--get-prop (prop name srcdir mainsrcfile) + (let ((kprop (intern (format ":%s" (downcase prop))))) + (or + (let ((pkgdescfile (expand-file-name (format "%s-pkg.el" name) + srcdir))) + (when (file-readable-p pkgdescfile) + (with-temp-buffer + (insert-file-contents pkgdescfile) + (let ((desc (read (current-buffer)))) + (plist-get (cdr desc) kprop))))) + (when (file-readable-p mainsrcfile) + (with-temp-buffer + (insert-file-contents mainsrcfile) + (lm-header prop)))))) + +(defun archive--get-section (hsection fsection srcdir mainsrcfile) + (when (consp fsection) + (while (cdr-safe fsection) + (setq fsection + (if (file-readable-p (expand-file-name (car fsection) srcdir)) + (car fsection) + (cdr fsection)))) + (when (consp fsection) (setq fsection (car fsection)))) + (cond + ((file-readable-p (expand-file-name fsection srcdir)) + (with-temp-buffer + (insert-file-contents (expand-file-name fsection srcdir)) + (buffer-string))) + ((file-readable-p mainsrcfile) + (with-temp-buffer + (insert-file-contents mainsrcfile) + (let ((start (lm-section-start hsection))) + (when start + (insert + (prog1 + (buffer-substring start (lm-section-end hsection)) + (erase-buffer))) + (emacs-lisp-mode) + (goto-char (point-min)) + (delete-region (point) (line-beginning-position 2)) + (uncomment-region (point-min) (point-max)) + (when (looking-at "^\\([ \t]*\n\\)+") + (replace-match "")) + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (delete-region (point) (point-max)) + (buffer-string))))))) + +(defun archive--quote (txt) + (replace-regexp-in-string "<" "<" + (replace-regexp-in-string "&" "&" txt))) + +(defun archive--insert-repolinks (name srcdir mainsrcfile url) + (if url + (insert (format "

Origin: %s

\n" + url (archive--quote url))) + (let* ((externals + (with-temp-buffer + (insert-file-contents + (expand-file-name "../../../elpa/externals-list" srcdir)) + (read (current-buffer)))) + (external (eq :external (nth 1 (assoc name externals)))) + (git-sv "http://git.savannah.gnu.org/") + (urls (if external + '("cgit/emacs/elpa.git/?h=externals/" + "gitweb/?p=emacs/elpa.git;a=shortlog;h=refs/heads/externals/") + '("cgit/emacs/elpa.git/tree/packages/" + "gitweb/?p=emacs/elpa.git;a=tree;f=packages/")))) + (insert (format + (concat "

Browse repository: %s" + " or %s

\n") + (concat git-sv (nth 0 urls) name) + 'CGit + (concat git-sv (nth 1 urls) name) + 'Gitweb))))) + +(defun archive--html-make-pkg (pkg files) + (let* ((name (symbol-name (car pkg))) + (latest (package-version-join (aref (cdr pkg) 0))) + (srcdir (expand-file-name name "../../build/packages")) + (mainsrcfile (expand-file-name (format "%s.el" name) srcdir)) + (desc (aref (cdr pkg) 2))) + (with-temp-buffer + (insert (archive--html-header (format "GNU ELPA - %s" name))) + (insert (format "

Description: %s

\n" (archive--quote desc))) + (let* ((file (cdr (assoc latest files))) + (attrs (file-attributes file))) + (insert (format "

Latest: %s, %s, %s

\n" + file (archive--quote file) + (format-time-string "%Y-%b-%d" (nth 5 attrs)) + (archive--html-bytes-format (nth 7 attrs))))) + (let ((maint (archive--get-prop "Maintainer" name srcdir mainsrcfile))) + (when maint + (insert (format "

Maintainer: %s

\n" (archive--quote maint))))) + (archive--insert-repolinks name srcdir mainsrcfile + (cdr (assoc :url (aref (cdr pkg) 4)))) + (let ((rm (archive--get-section + "Commentary" '("README" "README.rst" + ;; Most README.md files seem to be currently + ;; worse than the Commentary: section :-( + ;; "README.md" + "README.org") + srcdir mainsrcfile))) + (when rm + (write-region rm nil (concat name "-readme.txt")) + (insert "

Full description

\n" (archive--quote rm)
+                  "\n
\n"))) + (unless (< (length files) 2) + (insert (format "

Old versions

\n")) + (dolist (file files) + (unless (equal (pop file) latest) + (let ((attrs (file-attributes file))) + (insert (format "\n" + file (archive--quote file) + (format-time-string "%Y-%b-%d" (nth 5 attrs)) + (archive--html-bytes-format (nth 7 attrs))))))) + (insert "
%s%s%s
\n")) + (let ((news (archive--get-section + "News" '("NEWS" "NEWS.rst" "NEWS.md" "NEWS.org") + srcdir mainsrcfile))) + (when news + (insert "

News

\n" (archive--quote news) "\n
\n"))) + (insert "\n") + (write-region (point-min) (point-max) (concat name ".html"))))) + +(defun archive--html-make-index (pkgs) + (with-temp-buffer + (insert (archive--html-header "GNU ELPA Packages")) + (insert "\n") + (insert "\n") + (dolist (pkg pkgs) + (insert (format "\n" + (car pkg) (car pkg) + (package-version-join (aref (cdr pkg) 0)) + (aref (cdr pkg) 2)))) + (insert "
PackageVersionDescription
%s%s%s
\n") + (write-region (point-min) (point-max) "index.html"))) + +(defun batch-html-make-index () + (let ((packages (make-hash-table :test #'equal)) + (archive-contents + (with-temp-buffer + (insert-file-contents "archive-contents") + (goto-char (point-min)) + ;; Skip the first element which is a version number. + (cdr (read (current-buffer)))))) + (dolist (file (directory-files default-directory nil)) + (cond + ((member file '("." ".." "elpa.rss" "index.html" "archive-contents"))) + ((string-match "\\.html\\'" file)) + ((string-match "-readme\\.txt\\'" file) + (let ((name (substring file 0 (match-beginning 0)))) + (puthash name (gethash name packages) packages))) + ((string-match "-\\([0-9][^-]*\\)\\.\\(tar\\|el\\)\\'" file) + (let ((name (substring file 0 (match-beginning 0))) + (version (match-string 1 file))) + (push (cons version file) (gethash name packages)))) + (t (message "Unknown file %S" file)))) + (dolist (pkg archive-contents) + (archive--html-make-pkg pkg (gethash (symbol-name (car pkg)) packages))) + ;; FIXME: Add (old?) packages that are in `packages' but not in + ;; archive-contents. + (archive--html-make-index archive-contents))) + +;;; Maintain external packages. + +(defconst archive--elpa-git-url "git://git.sv.gnu.org/emacs/elpa") + +(defun archive-add/remove/update-externals () + (let ((exts (with-current-buffer (find-file-noselect "externals-list") + (goto-char (point-min)) + (read (current-buffer))))) + (let ((default-directory (expand-file-name "packages/"))) + ;; Remove "old/odd" externals. + (dolist (dir (directory-files ".")) + (cond + ((member dir '("." "..")) nil) + ((assoc dir exts) nil) + ((file-directory-p (expand-file-name (format "%s/.git" dir))) + (let ((status + (with-temp-buffer + (let ((default-directory (file-name-as-directory + (expand-file-name dir)))) + (call-process "git" nil t nil "status" "--porcelain") + (buffer-string))))) + (if (zerop (length status)) + (progn (delete-directory dir 'recursive t) + (message "Deleted all of %s" dir)) + (message "Keeping leftover unclean %s:\n%s" dir status)))))) + (pcase-dolist (`(,dir ,kind ,_url) exts) + (cond + ((eq kind :subtree) nil) ;Nothing to do. + ((not (eq kind :external)) + (message "Unknown external package kind `%S' for %s" kind dir)) + ((not (file-exists-p dir)) + (let* ((branch (concat "externals/" dir)) + (output + (with-temp-buffer + ;; FIXME: Use git-new-workdir! + (call-process "git" nil t nil "clone" + "--reference" ".." "--branch" branch + archive--elpa-git-url dir) + (buffer-string)))) + (message "Cloning branch %s:\n%s" dir output))) + ((not (file-directory-p (concat dir "/.git"))) + (message "%s is in the way of an external, please remove!" dir)) + (t + (let ((default-directory (file-name-as-directory + (expand-file-name dir)))) + (with-temp-buffer + (message "Running git pull in %S" default-directory) + (call-process "git" nil t nil "pull") + (message "Updated %s:%s" dir (buffer-string)))) + )))))) + +(provide 'archive-contents) +;;; archive-contents.el ends here diff --git a/admin/easy-kill.el b/admin/easy-kill.el deleted file mode 100644 index 5db68238e..000000000 --- a/admin/easy-kill.el +++ /dev/null @@ -1,832 +0,0 @@ -;;; easy-kill.el --- kill & mark things easily -*- lexical-binding: t; -*- - -;; Copyright (C) 2013-2014 Free Software Foundation, Inc. - -;; Author: Leo Liu -;; Version: 0.9.3 -;; Package-Requires: ((emacs "24") (cl-lib "0.5")) -;; Keywords: killing, convenience -;; Created: 2013-08-12 -;; URL: https://github.com/leoliu/easy-kill - -;; 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 . - -;;; Commentary: - -;; `easy-kill' aims to be a drop-in replacement for `kill-ring-save'. -;; -;; To use: (global-set-key [remap kill-ring-save] 'easy-kill) - -;; `easy-mark' is similar to `easy-kill' but marks the region -;; immediately. It can be a handy replacement for `mark-sexp' allowing -;; `+'/`-' to do list-wise expanding/shrinking. -;; -;; To use: (global-set-key [remap mark-sexp] 'easy-mark) - -;; Please send bug reports or feature requests to: -;; https://github.com/leoliu/easy-kill/issues - -;;; Code: - -(require 'cl-lib) -(require 'thingatpt) -(eval-when-compile (require 'cl)) ;For `defsetf'. - -(eval-and-compile - (cond - ((fboundp 'set-transient-map) nil) - ((fboundp 'set-temporary-overlay-map) ; new in 24.3 - (defalias 'set-transient-map 'set-temporary-overlay-map)) - (t - (defun set-transient-map (map &optional keep-pred) - (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map")) - (overlaysym (make-symbol "t")) - (alist (list (cons overlaysym map))) - (clearfun - `(lambda () - (unless ,(cond ((null keep-pred) nil) - ((eq t keep-pred) - `(eq this-command - (lookup-key ',map - (this-command-keys-vector)))) - (t `(funcall ',keep-pred))) - (set ',overlaysym nil) ;Just in case. - (remove-hook 'pre-command-hook ',clearfunsym) - (setq emulation-mode-map-alists - (delq ',alist emulation-mode-map-alists)))))) - (set overlaysym overlaysym) - (fset clearfunsym clearfun) - (add-hook 'pre-command-hook clearfunsym) - (push alist emulation-mode-map-alists)))))) - -(defcustom easy-kill-alist '((?w word " ") - (?s sexp "\n") - (?l list "\n") - (?f filename "\n") - (?d defun "\n\n") - (?e line "\n") - (?b buffer-file-name)) - "A list of (CHAR THING APPEND). -CHAR is used immediately following `easy-kill' to select THING. -APPEND is optional and if non-nil specifies the separator (a -string) for appending current selection to previous kill. - -Note: each element can also be (CHAR . THING) but this is -deprecated." - :type '(repeat (list character symbol - (choice string (const :tag "None" nil)))) - :group 'killing) - -(defcustom easy-kill-try-things '(url email line) - "A list of things for `easy-kill' to try." - :type '(repeat symbol) - :group 'killing) - -(defcustom easy-mark-try-things '(url email sexp) - "A list of things for `easy-mark' to try." - :type '(repeat symbol) - :group 'killing) - -(defface easy-kill-selection '((t (:inherit secondary-selection))) - "Faced used to highlight kill candidate." - :group 'killing) - -(defface easy-kill-origin '((t (:inverse-video t :inherit error))) - "Faced used to highlight the origin." - :group 'killing) - -(defvar easy-kill-base-map - (let ((map (make-sparse-keymap))) - (define-key map "-" 'easy-kill-shrink) - (define-key map "+" 'easy-kill-expand) - (define-key map "=" 'easy-kill-expand) - (define-key map "@" 'easy-kill-append) - ;; Note: didn't pick C-h because it is a very useful prefix key. - (define-key map "?" 'easy-kill-help) - (define-key map [remap set-mark-command] 'easy-kill-mark-region) - (define-key map [remap kill-region] 'easy-kill-region) - (define-key map [remap keyboard-quit] 'easy-kill-abort) - (define-key map [remap exchange-point-and-mark] - 'easy-kill-exchange-point-and-mark) - (mapc (lambda (d) - (define-key map (number-to-string d) 'easy-kill-digit-argument)) - (number-sequence 0 9)) - map)) - -(defvar easy-kill-inhibit-message nil) - -(defun easy-kill-echo (format-string &rest args) - "Same as `message' except not writing to *Messages* buffer. -Do nothing if `easy-kill-inhibit-message' is non-nil." - (unless easy-kill-inhibit-message - (let (message-log-max) - (apply 'message format-string args)))) - -(defun easy-kill-trim (s &optional how) - (let ((wchars "[ \t\n\r\f\v]*")) - (pcase how - (`left (and (string-match (concat "\\`" wchars) s) - (substring s (match-end 0)))) - (`right (substring s 0 (string-match-p (concat wchars "\\'") s))) - (_ (easy-kill-trim (easy-kill-trim s 'left) 'right))))) - -(defun easy-kill-mode-sname (m) - (cl-check-type m (and (or symbol string) (not boolean))) - (cl-etypecase m - (symbol (easy-kill-mode-sname (symbol-name m))) - (string (substring m 0 (string-match-p "\\(?:-minor\\)?-mode\\'" m))))) - -(defun easy-kill-fboundp (name) - "Like `fboundp' but NAME can be string or symbol. -The value is the function's symbol if non-nil." - (cl-etypecase name - (string (easy-kill-fboundp (intern-soft name))) - (symbol (and (fboundp name) name)))) - -(defun easy-kill-pair-to-list (pair) - (pcase pair - (`nil nil) - (`(,beg . ,end) (list beg end)) - (_ (signal 'wrong-type-argument (list pair "Not a dot pair"))))) - -(defun easy-kill-interprogram-cut (text) - "Make non-empty TEXT available to other programs." - (cl-check-type text string) - (and interprogram-cut-function - (not (equal text "")) - (funcall interprogram-cut-function text))) - -(defun easy-kill-map () - "Build the keymap according to `easy-kill-alist'." - (let ((map (make-sparse-keymap))) - (set-keymap-parent map easy-kill-base-map) - (mapc (lambda (c) - ;; (define-key map (vector meta-prefix-char c) 'easy-kill-select) - (define-key map (char-to-string c) 'easy-kill-thing)) - (mapcar 'car easy-kill-alist)) - map)) - -(defun easy-kill--fmt (x y &optional z) - (cl-etypecase x - (character (easy-kill--fmt - (single-key-description x) - (symbol-name y) - (and z (let ((print-escape-newlines t)) - (prin1-to-string z))))) - (string (with-output-to-string - (princ x) - (princ (make-string (- 16 (mod (length x) 16)) ?\s)) - (princ y) - (when z - (princ (make-string (- 16 (mod (length y) 16)) ?\s)) - (princ z)))))) - -(defun easy-kill-help () - (interactive) - (help-setup-xref '(easy-kill-help) (called-interactively-p 'any)) - (with-help-window (help-buffer) - (princ (concat (make-string 15 ?=) " ")) - (princ "Easy Kill/Mark Key Bindings ") - (princ (concat (make-string 15 ?=) "\n\n")) - (princ (easy-kill--fmt "Key" "Thing" "Separator")) - (princ "\n") - (princ (easy-kill--fmt "---" "-----" "---------")) - (princ "\n\n") - (princ (mapconcat (lambda (x) (pcase x - (`(,c ,thing ,sep) - (easy-kill--fmt c thing sep)) - ((or `(,c ,thing) `(,c . ,thing)) - (easy-kill--fmt c thing)))) - easy-kill-alist "\n")) - (princ "\n\n") - (princ (substitute-command-keys "\\{easy-kill-base-map}")))) - -(defvar easy-kill-candidate nil) - -(defun easy-kill--bounds () - (cons (overlay-start easy-kill-candidate) - (overlay-end easy-kill-candidate))) - -;;; Note: gv-define-setter not available in 24.1 and 24.2 -;; (gv-define-setter easy-kill--bounds (val) -;; (macroexp-let2 macroexp-copyable-p v val -;; `(move-overlay easy-kill-candidate (car ,v) (cdr ,v)))) - -(defsetf easy-kill--bounds () (v) - `(let ((tmp ,v)) - (move-overlay easy-kill-candidate (car tmp) (cdr tmp)))) - -(defmacro easy-kill-get (prop) - "Get the value of the kill candidate's property PROP. -Use `setf' to change property value." - (pcase prop - (`start '(overlay-start easy-kill-candidate)) - (`end '(overlay-end easy-kill-candidate)) - (`bounds '(easy-kill--bounds)) - (`buffer '(overlay-buffer easy-kill-candidate)) - (`properties '(append (list 'start (easy-kill-get start)) - (list 'end (easy-kill-get end)) - (list 'buffer (easy-kill-get buffer)) - (overlay-properties easy-kill-candidate))) - (_ `(overlay-get easy-kill-candidate ',prop)))) - -(defun easy-kill-init-candidate (n &optional mark) - ;; Manipulate `easy-kill-candidate' directly during initialisation; - ;; should use `easy-kill-get' elsewhere. - (let ((o (make-overlay (point) (point)))) - (unless mark - (overlay-put o 'face 'easy-kill-selection)) - (overlay-put o 'origin (point)) - (overlay-put o 'help-echo #'easy-kill-describe-candidate) - ;; Use higher priority to avoid shadowing by, for example, - ;; `hl-line-mode'. - (overlay-put o 'priority 999) - (when mark - (overlay-put o 'mark 'start) - (let ((i (make-overlay (point) (point)))) - (overlay-put i 'priority (1+ (overlay-get o 'priority))) - (overlay-put i 'face 'easy-kill-origin) - (overlay-put i 'as (propertize " " 'face 'easy-kill-origin)) - (overlay-put o 'origin-indicator i))) - (setq easy-kill-candidate o) - (save-restriction - ;; Work around http://debbugs.gnu.org/15808; not needed in 24.4. - (narrow-to-region (max (point-min) (- (point) 1000)) - (min (point-max) (+ (point) 1000))) - (let ((easy-kill-inhibit-message t)) - (cl-dolist (thing easy-kill-try-things) - (easy-kill-thing thing n) - (or (string= (easy-kill-candidate) "") - (cl-return))))) - o)) - -(defun easy-kill-indicate-origin () - (let ((i (easy-kill-get origin-indicator)) - (origin (easy-kill-get origin))) - (cond - ((not (overlayp i)) nil) - ((= origin (point)) - (overlay-put i 'after-string nil)) - ((memq (char-after origin) '(?\t ?\n)) - (overlay-put i 'after-string (overlay-get i 'as))) - (t (move-overlay i origin (1+ origin)) - (overlay-put i 'after-string nil))))) - -(defun easy-kill-candidate () - "Get the kill candidate as a string. -If the overlay specified by variable `easy-kill-candidate' has -non-zero length, it is the string covered by the overlay. -Otherwise, it is the value of the overlay's candidate property." - (with-current-buffer (easy-kill-get buffer) - (or (pcase (easy-kill-get bounds) - (`(,_x . ,_x) (easy-kill-get candidate)) - (`(,beg . ,end) (filter-buffer-substring beg end))) - ""))) - -(defun easy-kill-describe-candidate (&rest _) - "Return a string that describes current kill candidate." - (let* ((props (cl-loop for k in '(thing start end origin) - with all = (easy-kill-get properties) - ;; Allow describe-PROP to provide customised - ;; description. - for dk = (intern-soft (format "describe-%s" k)) - for dv = (and dk (plist-get all dk)) - for v = (or (if (functionp dv) (funcall dv) dv) - (plist-get all k)) - when v collect (format "%s:\t%s" k v))) - (txt (mapconcat #'identity props "\n"))) - (format "cmd:\t%s\n%s" - (if (easy-kill-get mark) "easy-mark" "easy-kill") - txt))) - -(defun easy-kill-adjust-candidate (thing &optional beg end) - "Adjust kill candidate to THING, BEG, END. -If BEG is a string, shrink the overlay to zero length and set its -candidate property instead." - (setf (easy-kill-get thing) thing) - (cond ((stringp beg) - (setf (easy-kill-get bounds) (cons (point) (point))) - (setf (easy-kill-get candidate) beg) - (let ((easy-kill-inhibit-message nil)) - (easy-kill-echo "%s" beg))) - (t - (setf (easy-kill-get bounds) (cons (or beg (easy-kill-get start)) - (or end (easy-kill-get end)))))) - (cond ((easy-kill-get mark) - (easy-kill-mark-region) - (easy-kill-indicate-origin)) - (t - (easy-kill-interprogram-cut (easy-kill-candidate))))) - -(defun easy-kill-save-candidate () - (unless (string= (easy-kill-candidate) "") - ;; Don't modify the clipboard here since it is called in - ;; `pre-command-hook' per `easy-kill-activate-keymap' and will - ;; confuse `yank' if it is current command. Also - ;; `easy-kill-adjust-candidate' already did that. - (let ((interprogram-cut-function nil) - (interprogram-paste-function nil)) - (kill-new (if (and (easy-kill-get append) kill-ring) - (cl-labels ((join (x sep y) - (if sep (concat (easy-kill-trim x 'right) - sep - (easy-kill-trim y 'left)) - (concat x y)))) - (join (car kill-ring) - (nth 2 (cl-rassoc (easy-kill-get thing) - easy-kill-alist :key #'car)) - (easy-kill-candidate))) - (easy-kill-candidate)) - (easy-kill-get append))) - t)) - -(defun easy-kill-destroy-candidate () - (let ((hook (make-symbol "easy-kill-destroy-candidate"))) - (fset hook `(lambda () - (let ((o ,easy-kill-candidate)) - (when o - (let ((i (overlay-get o 'origin-indicator))) - (and (overlayp i) (delete-overlay i))) - (delete-overlay o))) - (remove-hook 'post-command-hook ',hook))) - ;; Run in `post-command-hook' so that exit commands can still use - ;; `easy-kill-candidate'. - (add-hook 'post-command-hook hook))) - -(defun easy-kill-expand () - (interactive) - (easy-kill-thing nil '+)) - -(defun easy-kill-digit-argument (n) - "Expand selection by N number of things. -If N is 0 shrink the selection to the initial size before any -expansion." - (interactive - (list (- (logand (if (integerp last-command-event) - last-command-event - (get last-command-event 'ascii-character)) - ?\177) - ?0))) - (easy-kill-thing nil n)) - -(defun easy-kill-shrink () - (interactive) - (easy-kill-thing nil '-)) - -(defun easy-kill-thing-handler (base mode) - "Get the handler for MODE or nil if none is defined. -For example, if BASE is \"easy-kill-on-list\" and MODE is -nxml-mode `nxml:easy-kill-on-list', `easy-kill-on-list:nxml' are -checked in order. The former is never defined in this package and -is safe for users to customise. If neither is defined continue -checking on the parent mode. Finally `easy-kill-on-list' is -checked." - (or (and mode (or (easy-kill-fboundp - (concat (easy-kill-mode-sname mode) ":" base)) - (easy-kill-fboundp - (concat base ":" (easy-kill-mode-sname mode))))) - (let ((parent (get mode 'derived-mode-parent))) - (and parent (easy-kill-thing-handler base parent))) - (easy-kill-fboundp base))) - -(defun easy-kill-bounds-of-thing-at-point (thing) - "Easy Kill wrapper for `bounds-of-thing-at-point'." - (pcase (easy-kill-thing-handler - (format "easy-kill-bounds-of-%s-at-point" thing) - major-mode) - ((and (pred functionp) fn) (funcall fn)) - (_ (bounds-of-thing-at-point thing)))) - -(defun easy-kill-thing-forward-1 (thing &optional n) - "Easy Kill wrapper for `forward-thing'." - (pcase (easy-kill-thing-handler - (format "easy-kill-thing-forward-%s" thing) - major-mode) - ((and (pred functionp) fn) (funcall fn n)) - (_ (forward-thing thing n)))) - -;; Helper for `easy-kill-thing'. -(defun easy-kill-thing-forward (n) - (when (and (easy-kill-get thing) (/= n 0)) - (let* ((step (if (cl-minusp n) -1 +1)) - (thing (easy-kill-get thing)) - (bounds1 (or (easy-kill-pair-to-list - (easy-kill-bounds-of-thing-at-point thing)) - (list (point) (point)))) - (start (easy-kill-get start)) - (end (easy-kill-get end)) - (front (or (car (cl-set-difference (list end start) bounds1)) - (pcase step - (`-1 start) - (`1 end)))) - (new-front (save-excursion - (goto-char front) - (with-demoted-errors - (dotimes (_ (abs n)) - (easy-kill-thing-forward-1 thing step))) - (point)))) - (pcase (and (/= front new-front) - (sort (cons new-front bounds1) #'<)) - (`(,start ,_ ,end) - (easy-kill-adjust-candidate thing start end) - t))))) - -(defun easy-kill-thing (&optional thing n inhibit-handler) - ;; N can be -, + and digits - (interactive - (list (pcase (assq last-command-event easy-kill-alist) - (`(,_ ,th . ,_) th) - (`(,_ . ,th) th)) - (prefix-numeric-value current-prefix-arg))) - (let* ((thing (or thing (easy-kill-get thing))) - (n (or n 1)) - (handler (and (not inhibit-handler) - (easy-kill-thing-handler (format "easy-kill-on-%s" thing) - major-mode)))) - (when (easy-kill-get mark) - (goto-char (easy-kill-get origin))) - (cond - (handler (funcall handler n)) - ((or (memq n '(+ -)) - (and (eq thing (easy-kill-get thing)) - (not (zerop n)))) - (easy-kill-thing-forward (pcase n - (`+ 1) - (`- -1) - (_ n)))) - (t (pcase (easy-kill-bounds-of-thing-at-point thing) - (`nil (easy-kill-echo "No `%s'" thing)) - (`(,start . ,end) - (easy-kill-adjust-candidate thing start end) - (unless (zerop n) - (easy-kill-thing-forward (1- n))))))) - (when (easy-kill-get mark) - (easy-kill-adjust-candidate (easy-kill-get thing))))) - -(put 'easy-kill-abort 'easy-kill-exit t) -(defun easy-kill-abort () - (interactive) - (when (easy-kill-get mark) - ;; The after-string may interfere with `goto-char'. - (overlay-put (easy-kill-get origin-indicator) 'after-string nil) - (goto-char (easy-kill-get origin)) - (setq deactivate-mark t)) - (ding)) - -(put 'easy-kill-region 'easy-kill-exit t) -(defun easy-kill-region () - "Kill current selection and exit." - (interactive "*") - (pcase (easy-kill-get bounds) - (`(,_x . ,_x) (easy-kill-echo "Empty region")) - (`(,beg . ,end) (kill-region beg end)))) - -(put 'easy-kill-mark-region 'easy-kill-exit t) -(defun easy-kill-mark-region () - (interactive) - (pcase (easy-kill-get bounds) - (`(,_x . ,_x) - (easy-kill-echo "Empty region")) - (`(,beg . ,end) - (pcase (if (eq (easy-kill-get mark) 'end) - (list end beg) (list beg end)) - (`(,m ,pt) - (set-mark m) - (goto-char pt))) - (activate-mark)))) - -(defun easy-kill-exchange-point-and-mark () - (interactive) - (exchange-point-and-mark) - (setf (easy-kill-get mark) - (if (eq (point) (easy-kill-get start)) - 'end 'start))) - -(put 'easy-kill-append 'easy-kill-exit t) -(defun easy-kill-append () - (interactive) - (setf (easy-kill-get append) t) - (when (easy-kill-save-candidate) - (easy-kill-interprogram-cut (car kill-ring)) - (setq deactivate-mark t) - (easy-kill-echo "Appended"))) - -(defun easy-kill-exit-p (cmd) - (and (symbolp cmd) (get cmd 'easy-kill-exit))) - -(defun easy-kill-activate-keymap () - (let ((map (easy-kill-map))) - (set-transient-map - map - (lambda () - ;; Prevent any error from activating the keymap forever. - (condition-case err - (or (and (not (easy-kill-exit-p this-command)) - (or (eq this-command - (lookup-key map (this-single-command-keys))) - (let ((cmd (key-binding - (this-single-command-keys) nil t))) - (command-remapping cmd nil (list map))))) - (ignore - (easy-kill-destroy-candidate) - (unless (or (easy-kill-get mark) (easy-kill-exit-p this-command)) - (easy-kill-save-candidate)))) - (error (message "%s:%s" this-command (error-message-string err)) - nil)))))) - -;;;###autoload -(defun easy-kill (&optional n) - "Kill thing at point in the order of region, url, email and line. -Temporally activate additional key bindings as follows: - - letters => select or expand selection according to `easy-kill-alist'; - 1..9 => expand selection by that number; - 0 => shrink to the initial selection; - +,=/- => expand or shrink selection; - @ => append selection to previous kill; - ? => help; - C-w => kill selection; - C-SPC => turn selection into an active region; - C-g => abort; - others => save selection and exit." - (interactive "p") - (if (use-region-p) - (if (fboundp 'rectangle-mark-mode) ; New in 24.4 - (with-no-warnings - (kill-ring-save (region-beginning) (region-end) t)) - (kill-ring-save (region-beginning) (region-end))) - (easy-kill-init-candidate n) - (setf (easy-kill-get append) (eq last-command 'kill-region)) - (when (zerop (buffer-size)) - (easy-kill-echo "Warn: `easy-kill' activated in empty buffer")) - (easy-kill-activate-keymap))) - -;;;###autoload -(defalias 'easy-mark-sexp 'easy-mark - "Use `easy-mark' instead. The alias may be removed in future.") - -;;;###autoload -(defun easy-mark (&optional n) - "Similar to `easy-kill' (which see) but for marking." - (interactive "p") - (let ((easy-kill-try-things easy-mark-try-things)) - (easy-kill-init-candidate n 'mark) - (easy-kill-activate-keymap) - (unless (easy-kill-get thing) - (setf (easy-kill-get thing) 'sexp) - (easy-kill-thing 'sexp n)))) - -;;;; Extended things - -;;; Handler for `buffer-file-name'. - -(defun easy-kill-on-buffer-file-name (n) - "Get `buffer-file-name' or `default-directory'. -If N is zero, remove the directory part; -, remove the file name -part; +, full path." - (if (easy-kill-get mark) - (easy-kill-echo "Not supported in `easy-mark'") - (pcase (or buffer-file-name default-directory) - (`nil (easy-kill-echo "No `buffer-file-name'")) - (file (let* ((file (directory-file-name file)) - (text (pcase n - (`- (file-name-directory file)) - (`0 (file-name-nondirectory file)) - (_ file)))) - (easy-kill-adjust-candidate 'buffer-file-name text)))))) - -;;; Handler for `defun-name'. - -(defun easy-kill-on-defun-name (_n) - "Get current defun name." - (if (easy-kill-get mark) - (easy-kill-echo "Not supported in `easy-mark'") - (pcase (add-log-current-defun) - (`nil (easy-kill-echo "No `defun-name' at point")) - (name (easy-kill-adjust-candidate 'defun-name name))))) - -;;; Handler for `url'. - -(defun easy-kill-on-url (&optional _n) - "Get url at point or from char properties. -Char properties `help-echo', `shr-url' and `w3m-href-anchor' are -inspected." - (if (or (easy-kill-get mark) (easy-kill-bounds-of-thing-at-point 'url)) - (easy-kill-thing 'url nil t) - (cl-labels ((get-url (text) - (when (stringp text) - (with-temp-buffer - (insert text) - (pcase (easy-kill-bounds-of-thing-at-point 'url) - (`(,beg . ,end) (buffer-substring beg end))))))) - (cl-dolist (p '(help-echo shr-url w3m-href-anchor)) - (pcase (get-char-property-and-overlay (point) p) - (`(,text . ,ov) - (pcase (or (get-url text) - (get-url (and ov (overlay-get ov p)))) - ((and url (guard url)) - (easy-kill-adjust-candidate 'url url) - (cl-return url))))))))) - -;;; `defun' - -;; Work around http://debbugs.gnu.org/17247 -(defun easy-kill-thing-forward-defun (&optional n) - (pcase (or n 1) - ((pred cl-minusp) (beginning-of-defun (- n))) - (n (end-of-defun n)))) - -;;; Handler for `sexp' and `list'. - -(defun easy-kill-bounds-of-list-at-point () - (let ((bos (and (nth 3 (syntax-ppss)) ;bounds of string - (save-excursion - (easy-kill-backward-up) - (easy-kill-bounds-of-thing-at-point 'sexp)))) - (b (bounds-of-thing-at-point 'list)) - (b1-in-b2 (lambda (b1 b2) - (and (> (car b1) (car b2)) - (< (cdr b1) (cdr b2)))))) - (cond - ((not b) bos) - ((not bos) b) - ((= (car b) (point)) bos) - ((funcall b1-in-b2 b bos) b) - (t bos)))) - -(defvar up-list-fn) ; Dynamically bound - -(defun easy-kill-backward-up () - (let ((ppss (syntax-ppss))) - (condition-case nil - (progn - (funcall (or (bound-and-true-p up-list-fn) #'up-list) -1) - ;; `up-list' may jump to another string. - (when (and (nth 3 ppss) (< (point) (nth 8 ppss))) - (goto-char (nth 8 ppss)))) - (scan-error (and (nth 3 ppss) (goto-char (nth 8 ppss))))))) - -(defun easy-kill-forward-down (point &optional bound) - (condition-case nil - (progn - (easy-kill-backward-up) - (backward-prefix-chars) - (if (and (or (not bound) (> (point) bound)) - (/= point (point))) - (easy-kill-forward-down (point) bound) - (goto-char point))) - (scan-error (goto-char point)))) - -(defun easy-kill-bounds-of-list (n) - (save-excursion - (pcase n - (`+ (goto-char (easy-kill-get start)) - (easy-kill-backward-up)) - (`- (easy-kill-forward-down (point) (easy-kill-get start))) - (_ (error "Unsupported argument `%s'" n))) - (easy-kill-bounds-of-thing-at-point 'sexp))) - -(defun easy-kill-on-list (n) - (pcase n - ((or `+ `-) - (pcase (easy-kill-bounds-of-list n) - (`(,beg . ,end) - (easy-kill-adjust-candidate 'list beg end)))) - (_ (easy-kill-thing 'list n t)))) - -(defun easy-kill-on-sexp (n) - (pcase n - ((or `+ `-) - (unwind-protect (easy-kill-thing 'list n) - (setf (easy-kill-get thing) 'sexp))) - (_ (easy-kill-thing 'sexp n t)))) - -;;; nxml support for list-wise +/- - -(defvar nxml-sexp-element-flag) - -(defun easy-kill-on-list:nxml (n) - (let ((nxml-sexp-element-flag t) - (up-list-fn 'nxml-up-element)) - (cond - ((memq n '(+ -)) - (pcase (easy-kill-bounds-of-list n) - (`(,beg . ,end) (easy-kill-adjust-candidate 'list beg end)))) - ((and (eq 'list (easy-kill-get thing)) - (not (zerop n))) - (let ((new-end (save-excursion - (goto-char (easy-kill-get end)) - (forward-sexp n) - (point)))) - (when (and new-end (/= new-end (easy-kill-get end))) - (easy-kill-adjust-candidate 'list nil new-end)))) - (t (save-excursion - (ignore-errors (easy-kill-backward-up)) - (easy-kill-thing 'sexp n t) - (setf (easy-kill-get thing) 'list)))))) - -;;; org support for list-wise +/- - -(defun easy-kill-bounds-of-list-at-point:org () - (eval-and-compile (require 'org-element)) - (let ((x (org-element-at-point))) - (cons (org-element-property :begin x) - (org-element-property :end x)))) - -(defun easy-kill-bounds-of-sexp-at-point:org () - (pcase (list (point) (easy-kill-bounds-of-list-at-point:org)) - (`(,beg (,beg . ,end)) - (cons beg end)) - (_ (bounds-of-thing-at-point 'sexp)))) - -(defun easy-kill-thing-forward-list:org (&optional n) - (pcase (or n 1) - (`0 nil) - (n (dotimes (_ (abs n)) - (condition-case nil - (if (cl-minusp n) - (org-backward-element) - (org-forward-element)) - (error (pcase (easy-kill-bounds-of-thing-at-point 'list) - (`(,beg . ,end) - (goto-char (if (cl-minusp n) beg end)))))))))) - -(defun easy-kill-org-up-element (&optional n) - ;; Make `org-up-element' more like `up-list'. - (pcase (or n 1) - (`0 nil) - (n (ignore-errors - (dotimes (_ (abs n)) - (pcase (list (point) (easy-kill-bounds-of-thing-at-point 'list)) - (`(,_beg (,_beg . ,_)) (org-up-element)) - (`(,_ (,beg . ,_)) (goto-char beg))))) - (when (cl-plusp n) - (goto-char (cdr (easy-kill-bounds-of-thing-at-point 'list))))))) - -(defun easy-kill-on-list:org (n) - (pcase n - ((or `+ `-) - (pcase (let ((up-list-fn #'easy-kill-org-up-element)) - (easy-kill-bounds-of-list n)) - (`(,beg . ,end) (easy-kill-adjust-candidate 'list beg end)))) - (_ (easy-kill-thing 'list n t))) - (pcase (save-excursion - (goto-char (easy-kill-get start)) - (org-element-type (org-element-at-point))) - (`nil nil) - (type (setf (easy-kill-get describe-thing) - (lambda () - (format "%s (%s)" (easy-kill-get thing) type))) - (easy-kill-echo "%s" type)))) - -;;; js2 support for list-wise +/- - -(defun easy-kill-find-js2-node (beg end &optional inner) - (eval-and-compile (require 'js2-mode nil t)) - (let* ((node (js2-node-at-point)) - (last-node node)) - (while (progn - (if (or (js2-ast-root-p node) - (and (<= (js2-node-abs-pos node) beg) - (>= (js2-node-abs-end node) end) - (or inner - (not (and (= (js2-node-abs-pos node) beg) - (= (js2-node-abs-end node) end)))))) - nil - (setq last-node node - node (js2-node-parent node)) - t))) - (if inner last-node node))) - -(defun easy-kill-on-list:js2 (n) - (let ((node (pcase n - ((or `+ `-) - (easy-kill-find-js2-node (easy-kill-get start) - (easy-kill-get end) - (eq n '-))) - ((guard (and (eq 'list (easy-kill-get thing)) - (not (zerop n)))) - (error "List forward not supported in js2-mode")) - (_ (js2-node-at-point))))) - (easy-kill-adjust-candidate 'list - (js2-node-abs-pos node) - (js2-node-abs-end node)) - (setf (easy-kill-get describe-thing) - ;; Also used by `sexp' so delay computation until needed. - (lambda () - (format "%s (%s)" (easy-kill-get thing) (js2-node-short-name node)))) - (easy-kill-echo "%s" (js2-node-short-name node)))) - -(provide 'easy-kill) -;;; easy-kill.el ends here diff --git a/admin/forward-diffs.py b/admin/forward-diffs.py new file mode 100755 index 000000000..b073ed25f --- /dev/null +++ b/admin/forward-diffs.py @@ -0,0 +1,432 @@ +#!/usr/bin/python +### forward-diffs.py --- forward emacs-diffs mails to maintainers + +## Copyright (C) 2012-2013 Free Software Foundation, Inc. + +## Author: Glenn Morris +## Maintainer: emacs-devel@gnu.org + +## 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 . + +### Commentary: + +## Forward emails from an emacs-diffs style mailing list to the +## maintainer(s) of the modified files. + +## Two modes of operation: + +## 1) Create the maintfile (really this is just an optimization): +## forward-diffs.py --create -p packagesdir -m maintfile + +## You can start with an empty maintfile and normal operation in 2) +## will append information as needed. + +## 2) Call from eg procmail to forward diffs. Example usage: + +## :0c +## * ^TO_emacs-elpa-diffs@gnu\.org +## | forward-diffs.py -p packagedir -m maintfile -l logfile \ +## -o overmaint -s sender + +## where + +## packagedir = /path/to/packages +## sender = your email address +## logfile = file to write log to (you might want to rotate/compress/examine it) +## maintfile = file listing files and their maintainers, with format: +## +## package1/file1 email1 +## package2/file2 email2,email3 +## package3 email4 +## +## Use "nomail" for the email field to not send a mail. +## An entry that is a directory applies to all files in that directory +## that do not have specific maintainers. +## +## overmaint = like maintfile, but takes precedence over it. + +### Code: + +import optparse +import sys +import re +import email +import smtplib +import datetime +import os + + +## Scan FILE for Author or Maintainer (preferred) headers. +## Return a list of all email addresses found in MAINTS. +def scan_file(file, maints): + + try: + fd = open( file, 'r') + except Exception as err: + lfile.write('Error opening file %s: %s\n' % (file, str(err))) + return 1 + + ## Max number of lines to scan looking for a maintainer. + ## (20 seems to be the highest at present). + max_lines = 50 + nline = 0 + cont = 0 + type = "" + + for line in fd: + + nline += 1 + + if ( nline > max_lines ): break + + ## Try and de-obfuscate. Worth it? + line = re.sub( '(?i) AT ', '@', line ) + line = re.sub( '(?i) DOT ', '.', line ) + + if cont: # continued header? + reg = re.match( ('%s[ \t]+[^:]*??' % prefix), line, re.I ) + if not reg: # not a continued header + cont = 0 + prefix = "" + if ( type == "maint" ): break + type = "" + + ## Check for one header immediately after another. + if not cont: + reg = re.match( '([^ ]+)? *(Author|Maintainer)s?: .*??', line, re.I ) + + + if not reg: continue + + if cont: + email = reg.group(1) + maints.append(email) + else: + cont = 1 + prefix = reg.group(1) or "" + type = reg.group(2) + email = reg.group(3) + type = "maint" if re.search( 'Maintainer', type, re.I ) else "auth" + ## maints = [] does the wrong thing. + if type == "maint": del maints[:] + maints.append(email) + + fd.close() + + +## Scan all the files under dir for maintainer information. +## Write to stdout, or optional argument outfile (which is overwritten). +def scan_dir(dir, outfile=None): + + dir = re.sub( '/+$', '', dir) + '/' # ensure trailing / + + if not os.path.isdir(dir): + sys.stderr.write('No such directory: %s\n' % dir) + sys.exit(1) + + fd = 0 + if outfile: + try: + fd = open( outfile, 'w' ) + except Exception as err: + sys.stderr.write("Error opening `%s': %s\n" % (outfile, str(err))) + sys.exit(1) + + + for dirpath, dirnames, filenames in os.walk(dir): + for file in filenames: + path = os.path.join(dirpath, file) + maints = [] + scan_file(path, maints) + ## This would skip printing empty maints. + ## That would mean we would scan the file each time for no reason. + ## But empty maintainers are an error at present. + if not maints: continue + path = re.sub( '^%s' % dir, '', path ) + string = "%-50s %s\n" % (path, ",".join(maints)) + if fd: + fd.write(string) + else: + print string, + + if fd: fd.close() + + +usage="""usage: %prog <-p /path/to/packages> <-m maintfile> + <-l logfile -s sender|--create> [-o overmaintfile] [--prefix prefix] + [--sendmail] [--debug] +Take an emacs-diffs mail on stdin, and forward it to the maintainer(s).""" + +parser = optparse.OptionParser() +parser.set_usage ( usage ) +parser.add_option( "-m", dest="maintfile", default=None, + help="file listing packages and maintainers") +parser.add_option( "-l", dest="logfile", default=None, + help="file to append output to") +parser.add_option( "-o", dest="overmaintfile", default=None, + help="override file listing packages and maintainers") +parser.add_option( "-p", dest="packagedir", default=None, + help="path to packages directory") +parser.add_option( "-s", dest="sender", default=None, + help="sender address for forwards") +parser.add_option( "--create", dest="create", default=False, + action="store_true", help="create maintfile") +parser.add_option( "--no-scan", dest="noscan", default=True, + action="store_true", + help="don't scan for maintainers; implies --no-update") +parser.add_option( "--no-update", dest="noupdate", default=False, + action="store_true", + help="do not update the maintfile") +parser.add_option( "--prefix", dest="prefix", default="packages/", + help="prefix to remove from modified file name [default: %default]") +parser.add_option( "--sendmail", dest="sendmail", default=False, + action="store_true", help="use sendmail rather than smtp") +parser.add_option( "--debug", dest="debug", default=False, + action="store_true", help="debug only, do not send mail") + + +( opts, args ) = parser.parse_args() + + +if not opts.maintfile: + parser.error('No maintfile specified') + +if not opts.packagedir: + parser.error('No packagedir specified') + +if not os.path.isdir(opts.packagedir): + sys.stderr.write('No such directory: %s\n' % opts.packagedir) + sys.exit(1) + + +if not opts.create: + if not opts.logfile: + parser.error('No logfile specified') + + if not opts.sender: + parser.error('No sender specified') + + +try: + lfile = open( opts.logfile, 'a' ) +except Exception as err: + sys.stderr.write('Error opening logfile: %s\n' % str(err)) + sys.exit(1) + + +try: + mfile = open( opts.maintfile, 'r' ) +except Exception as err: + lfile.write('Error opening maintfile: %s\n' % str(err)) + sys.exit(1) + +## Create the maintfile. +if opts.create: + scan_dir( opts.packagedir, opts.maintfile ) + sys.exit() + + +## Each element is package/file: maint1, maint2, ... +maints = {} + +for line in mfile: + if re.match( '#| *$', line ): continue + ## FIXME error here if empty maintainer. + (pfile, maint) = line.split() + maints[pfile] = maint.split(',') + +mfile.close() + + +if opts.overmaintfile: + try: + ofile = open( opts.overmaintfile, 'r' ) + except Exception as err: + lfile.write('Error opening overmaintfile: %s\n' % str(err)) + sys.exit(1) + + for line in ofile: + if re.match( '#| *$', line ): continue + (pfile, maint) = line.split() + maints[pfile] = maint.split(',') + + ofile.close() + + +stdin = sys.stdin + +text = stdin.read() + + +resent_via = 'GNU Emacs diff forwarder' + +message = email.message_from_string( text ) + +(msg_name, msg_from) = email.utils.parseaddr( message['from'] ) + +lfile.write('\nDate: %s\n' % str(datetime.datetime.now())) +lfile.write('Message-ID: %s\n' % message['message-id']) +lfile.write('From: %s\n' % msg_from) + +if resent_via == message['x-resent-via']: + lfile.write('Mail loop; aborting\n') + sys.exit(1) + + +start = False +pfiles_seen = [] +maints_seen = [] + +for line in text.splitlines(): + + # Look for and process things that look like (Git): + # + # Summary of changes: + # packages/vlf/vlf.el | 2 +- + # 1 files changed, 1 insertions(+), 1 deletions(-) + + #BZR: if re.match( 'modified:$', line ): + if re.match( 'Summary of changes:$', line ): + start = True + continue + + if not start: continue + + ## An empty line or a line with non-empty first character. + if re.match( '( *$|[^ ])', line ): break + # Any line that doesn't match the diffstat format (Git). + if not re.match( ' [^ ]+ +\| ', line ): + lfile.write('Stop scanning at: %s\n' % line) + break + + if opts.prefix: + #BZR: reg = re.match( '%s([^ ]+)' % opts.prefix, line.strip() ) + reg = re.match( ' %s([^ ]+)' % opts.prefix, line ) + if not reg: + lfile.write('Skip: %s\n' % line) + continue + pfile = reg.group(1) + else: + pfile = line.strip() + + + lfile.write('File: %s\n' % pfile) + + ## Should not be possible for files (rather than packages)... + if pfile in pfiles_seen: + lfile.write('Already seen this file\n') + continue + + pfiles_seen.append(pfile) + + + if not pfile in maints: + + lfile.write('Unknown maintainer\n') + + if not opts.noscan: + + lfile.write('Scanning file...\n') + thismaint = [] + thisfile = os.path.join( opts.packagedir, pfile ) + # scan_file( thisfile, thismaint ) + + if thismaint: + maints[pfile] = thismaint + + ## Append maintainer to file. + if not opts.noupdate: + try: + mfile = open( opts.maintfile, 'a' ) + string = "%-50s %s\n" % (pfile, ",".join(thismaint)) + mfile.write(string) + mfile.close() + lfile.write('Appended to maintfile\n') + except Exception as err: + lfile.write('Error appending to maintfile: %s\n' % + str(err)) + + ## Didn't scan, or scanning did not work. + ## Look for a directory maintainer. + if not pfile in maints: + lfile.write('No file maintainer, trying directories...\n') + while True: + (pfile, tail) = os.path.split(pfile) + if not pfile: break + if pfile in maints: break + + + if not pfile in maints: + lfile.write('No maintainer, skipping\n') + continue + + + for maint in maints[pfile]: + + lfile.write('Maint: %s\n' % maint) + + + if maint in maints_seen: + lfile.write('Already seen this maintainer\n') + continue + + maints_seen.append(maint) + + + if maint == "nomail": + lfile.write('Not resending, no mail is requested\n') + continue + + + if maint == msg_from: + lfile.write('Not resending, since maintainer = committer\n') + continue + + + forward = message + forward.add_header('X-Resent-Via', resent_via) + forward.add_header('Resent-To', maint) + forward.add_header('Resent-From', opts.sender) + + lfile.write('Resending via %s...\n' % ('sendmail' + if opts.sendmail else 'smtp') ) + + + if opts.debug: continue + + + if opts.sendmail: + s = os.popen("/usr/sbin/sendmail -i -f %s %s" % + (opts.sender, maint), "w") + s.write(forward.as_string()) + status = s.close() + if status: + lfile.write('Sendmail exit status: %s\n' % status) + + else: + + try: + s = smtplib.SMTP('localhost') + except Exception as err: + lfile.write('Error opening smtp: %s\n' % str(err)) + sys.exit(1) + + try: + s.sendmail(opts.sender, maint, forward.as_string()) + except Exception as err: + lfile.write('Error sending smtp: %s\n' % str(err)) + + s.quit() + +### forward-diffs.py ends here diff --git a/admin/org-synch.el b/admin/org-synch.el new file mode 100644 index 000000000..cc7e92390 --- /dev/null +++ b/admin/org-synch.el @@ -0,0 +1,22 @@ +(defun org-synch (package-file) + (let* ((archive-file "archive-contents") + (package-name 'org) + (date (substring package-file 4 12)) + (date-int (string-to-number date)) + contents entry) + (unless (and (integerp date-int) + (> date-int 20100000) + (< date-int 21000000)) + (error "Package date is bad")) + (unless (file-exists-p package-file) + (error "No package file found")) + (when (file-exists-p archive-file) + (find-file archive-file) + (setq contents (read (current-buffer)) + entry (assq package-name contents)) + (unless entry + (error "No entry for %s in archive-contents" package-name)) + (aset (cdr entry) 0 (version-to-list date)) + (erase-buffer) + (insert (pp-to-string contents) "\n") + (save-buffer 0)))) diff --git a/admin/org-synch.sh b/admin/org-synch.sh new file mode 100755 index 000000000..02696b25e --- /dev/null +++ b/admin/org-synch.sh @@ -0,0 +1,15 @@ +#!/bin/sh + +# this script expects $1 to be the download directory and $2 to have org-synch.el + +PATH="/bin:/usr/bin:/usr/local/bin:${PATH}" + +pkgname=`curl -s http://orgmode.org/elpa/|perl -ne 'push @f, $1 if m/(org-\d{8}\.tar)/; END { @f = sort @f; print "$f[-1]\n"}'` + +cd $1 +wget -q http://orgmode.org/elpa/${pkgname} -O ${pkgname}-tmp +if [ -f ${pkgname}-tmp ]; then + rm -f org*.tar + mv ${pkgname}-tmp ${pkgname} && \ + emacs -batch -l $2/org-synch.el --eval "(org-synch \"${pkgname}\")" +fi diff --git a/admin/overmaint.txt b/admin/overmaint.txt new file mode 100644 index 000000000..328d1aaff --- /dev/null +++ b/admin/overmaint.txt @@ -0,0 +1,12 @@ +# This file lists files and the email addresses of their maintainers. +# It is used by the forward-diffs.py script. +# This file overrides the automatically generated maintfile. +# Use nomail to suppress sending mail. +# File names are relative to the packages/ directory. +# Lines starting with # are ignored. +# Examples: +#some-package/some-file.el nomail +#some-package/otherfile.el none@example.com + +register-alist/register-list.el bzg@gnu.org +windresize/windresize.el.el bzg@gnu.org diff --git a/admin/update-archive.sh b/admin/update-archive.sh new file mode 100755 index 000000000..91e99f9fa --- /dev/null +++ b/admin/update-archive.sh @@ -0,0 +1,106 @@ +#!/bin/sh -x + +makelog="" +buildir="$(pwd)" + +export LANG=C +case "$1" in + "--batch") + makelog="$(pwd)/make.log" + exec >"$makelog" 2>&1 + ;; +esac + +# Send an email to warn about a problem. +signal_error () { + title="$*" + if [ "" = "$makelog" ]; then + echo "Error: $title" + else + mx_gnu_org="$(host -t mx gnu.org | sed 's/.*[ ]//')" + (sleep 5; echo "HELO elpa.gnu.org" + sleep 1; echo "MAIL FROM: " + sleep 1; echo "RCPT TO: " + sleep 1; echo "DATA" + sleep 1; cat < +To: emacs-elpa-diffs@gnu.org +Subject: $title + +ENDDOC + cat "$makelog" + echo "."; sleep 1) | telnet "$mx_gnu_org" smtp + fi + exit 1 +} + + +cd ../elpa + +# Fetch changes. +git pull || signal_error "git pull failed" + +# Remember we're inside the "elpa" branch which we don't want to trust, +# So always refer to the makefile and admins files from $builddir". + +# Setup and update externals. +emacs --batch -l "$buildir/admin/archive-contents.el" \ + -f archive-add/remove/update-externals + +make -f "$buildir/GNUmakefile" check_copyrights || + signal_error "check_copyright failed" + +cd "$buildir" + +rsync -av --delete \ + --exclude=ChangeLog \ + --exclude=.git \ + --exclude='*.elc' \ + --exclude='*~' \ + --exclude='*-autoloads.el' \ + ../elpa/packages ./ + +# Refresh the ChangeLog files. This needs to be done in +# the source tree, because it needs the VCS data! +emacs -batch -l admin/archive-contents.el \ + -eval '(archive-prepare-packages "../elpa")' + + +rm -rf archive # In case there's one left over! +make archive-full || { + signal_error "make archive-full failed" +} +latest="emacs-packages-latest.tgz" +(cd archive + GZIP=--best tar zcf "$latest" packages) +(cd ../ + mkdir -p staging/packages + # Not sure why we have `staging-old', but let's keep it for now. + rm -rf staging-old + cp -a staging staging-old + # Move new files into place but don't throw out old package versions. + for f in build/archive/packages/*; do + dst="staging/packages/$(basename "$f")" + # Actually, let's never overwrite an existing version. So changes can + # be installed without causing a new package to be built until the + # version field is changed. Some files need to be excluded from the + # "immutable" policy, most importantly "archive-contents" + # and "*-readme.txt". + case $dst in + */archive-contents | *-readme.txt ) mv "$f" "$dst" ;; + * ) if [ -r "$dst" ] + then rm "$f" + else + # FIXME: Announce the new package/version on + # gnu.emacs.sources! + mv "$f" "$dst" + fi ;; + esac + done + mv build/archive/"$latest" staging/ + rm -rf build/archive) + +# Make the HTML and readme.txt files. +(cd ../staging/packages + emacs --batch -l ../../build/admin/archive-contents.el \ + --eval '(batch-html-make-index)') diff --git a/admin/.elpaignore b/packages/easy-kill/.elpaignore similarity index 100% rename from admin/.elpaignore rename to packages/easy-kill/.elpaignore diff --git a/admin/.travis.yml b/packages/easy-kill/.travis.yml similarity index 100% rename from admin/.travis.yml rename to packages/easy-kill/.travis.yml diff --git a/admin/Makefile b/packages/easy-kill/Makefile similarity index 100% rename from admin/Makefile rename to packages/easy-kill/Makefile diff --git a/packages/easy-kill/README.rst b/packages/easy-kill/README.rst index ef660aa3e..02ad57b5c 100644 --- a/packages/easy-kill/README.rst +++ b/packages/easy-kill/README.rst @@ -2,6 +2,11 @@ Kill & Mark Things Easily in Emacs ==================================== +.. image:: https://travis-ci.org/leoliu/easy-kill.svg?branch=master + :target: https://travis-ci.org/leoliu/easy-kill + :align: right + :alt: Travis CI build status + Provide commands ``easy-kill`` and ``easy-mark`` to let users kill or mark things easily. @@ -34,9 +39,12 @@ The following keys modify the selection: #. ``@``: append selection to previous kill and exit. For example, ``M-w d @`` will append current function to last kill. #. ``C-w``: kill selection and exit -#. ``+``, ``-`` and ``0..9``: expand/shrink selection +#. ``+``, ``-`` and ``1..9``: expand/shrink selection +#. ``0`` shrink the selection to the intitial size i.e. before any + expansion #. ``C-SPC``: turn selection into an active region #. ``C-g``: abort +#. ``?``: help For example, ``M-w w`` saves current word, repeat ``w`` to expand the kill to include the next word. ``5`` to include the next 5 words etc. @@ -48,7 +56,8 @@ for ``list`` or ``sexp``, list-wise. ``list-wise`` expanding/shrinking work well in lispy modes (elisp, Common Lisp, Scheme, Clojure etc.), smie-based modes (Prolog, SML, -Modula2, Shell, Ruby, Octave, CSS, SQL etc.), Nxml mode and Js2 mode. +Modula2, Shell, Ruby, Octave, CSS, SQL etc.), Org mode, Nxml mode and +Js2 mode. To copy the enclosing list in lispy modes, I used to do a lot of ``C-M-u C-M-SPC M-w``. Now the key sequence is replaced by ``M-w l`` @@ -86,6 +95,16 @@ convention, or by defining new functions named like NEWS ~~~~ +0.9.3 ++++++ + +#. Key ``?`` in ``easy-kill`` or ``easy-mark`` prints help info. +#. ``M-w l`` can select the enclosing string. +#. ``easy-mark`` learns exchanging point & mark. +#. Key ``0`` now sets the selection to its initial size before any + expansion. +#. ``M-w l``, ``M-w s`` and list-wise ``+/-`` now work in Org mode. + 0.9.2 +++++ diff --git a/packages/easy-kill/easy-kill.el b/packages/easy-kill/easy-kill.el index 8195bfc42..5db68238e 100644 --- a/packages/easy-kill/easy-kill.el +++ b/packages/easy-kill/easy-kill.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2013-2014 Free Software Foundation, Inc. ;; Author: Leo Liu -;; Version: 0.9.2 +;; Version: 0.9.3 ;; Package-Requires: ((emacs "24") (cl-lib "0.5")) ;; Keywords: killing, convenience ;; Created: 2013-08-12 @@ -70,14 +70,13 @@ (add-hook 'pre-command-hook clearfunsym) (push alist emulation-mode-map-alists)))))) -(defcustom easy-kill-alist - '((?w word " ") - (?s sexp "\n") - (?l list "\n") - (?f filename "\n") - (?d defun "\n\n") - (?e line "\n") - (?b buffer-file-name)) +(defcustom easy-kill-alist '((?w word " ") + (?s sexp "\n") + (?l list "\n") + (?f filename "\n") + (?d defun "\n\n") + (?e line "\n") + (?b buffer-file-name)) "A list of (CHAR THING APPEND). CHAR is used immediately following `easy-kill' to select THING. APPEND is optional and if non-nil specifies the separator (a @@ -113,24 +112,18 @@ deprecated." (define-key map "+" 'easy-kill-expand) (define-key map "=" 'easy-kill-expand) (define-key map "@" 'easy-kill-append) + ;; Note: didn't pick C-h because it is a very useful prefix key. + (define-key map "?" 'easy-kill-help) (define-key map [remap set-mark-command] 'easy-kill-mark-region) (define-key map [remap kill-region] 'easy-kill-region) (define-key map [remap keyboard-quit] 'easy-kill-abort) + (define-key map [remap exchange-point-and-mark] + 'easy-kill-exchange-point-and-mark) (mapc (lambda (d) (define-key map (number-to-string d) 'easy-kill-digit-argument)) (number-sequence 0 9)) map)) -(defun easy-kill-map () - "Build the keymap according to `easy-kill-alist'." - (let ((map (make-sparse-keymap))) - (set-keymap-parent map easy-kill-base-map) - (mapc (lambda (c) - ;; (define-key map (vector meta-prefix-char c) 'easy-kill-select) - (define-key map (char-to-string c) 'easy-kill-thing)) - (mapcar 'car easy-kill-alist)) - map)) - (defvar easy-kill-inhibit-message nil) (defun easy-kill-echo (format-string &rest args) @@ -148,6 +141,12 @@ Do nothing if `easy-kill-inhibit-message' is non-nil." (`right (substring s 0 (string-match-p (concat wchars "\\'") s))) (_ (easy-kill-trim (easy-kill-trim s 'left) 'right))))) +(defun easy-kill-mode-sname (m) + (cl-check-type m (and (or symbol string) (not boolean))) + (cl-etypecase m + (symbol (easy-kill-mode-sname (symbol-name m))) + (string (substring m 0 (string-match-p "\\(?:-minor\\)?-mode\\'" m))))) + (defun easy-kill-fboundp (name) "Like `fboundp' but NAME can be string or symbol. The value is the function's symbol if non-nil." @@ -168,9 +167,52 @@ The value is the function's symbol if non-nil." (not (equal text "")) (funcall interprogram-cut-function text))) +(defun easy-kill-map () + "Build the keymap according to `easy-kill-alist'." + (let ((map (make-sparse-keymap))) + (set-keymap-parent map easy-kill-base-map) + (mapc (lambda (c) + ;; (define-key map (vector meta-prefix-char c) 'easy-kill-select) + (define-key map (char-to-string c) 'easy-kill-thing)) + (mapcar 'car easy-kill-alist)) + map)) + +(defun easy-kill--fmt (x y &optional z) + (cl-etypecase x + (character (easy-kill--fmt + (single-key-description x) + (symbol-name y) + (and z (let ((print-escape-newlines t)) + (prin1-to-string z))))) + (string (with-output-to-string + (princ x) + (princ (make-string (- 16 (mod (length x) 16)) ?\s)) + (princ y) + (when z + (princ (make-string (- 16 (mod (length y) 16)) ?\s)) + (princ z)))))) + +(defun easy-kill-help () + (interactive) + (help-setup-xref '(easy-kill-help) (called-interactively-p 'any)) + (with-help-window (help-buffer) + (princ (concat (make-string 15 ?=) " ")) + (princ "Easy Kill/Mark Key Bindings ") + (princ (concat (make-string 15 ?=) "\n\n")) + (princ (easy-kill--fmt "Key" "Thing" "Separator")) + (princ "\n") + (princ (easy-kill--fmt "---" "-----" "---------")) + (princ "\n\n") + (princ (mapconcat (lambda (x) (pcase x + (`(,c ,thing ,sep) + (easy-kill--fmt c thing sep)) + ((or `(,c ,thing) `(,c . ,thing)) + (easy-kill--fmt c thing)))) + easy-kill-alist "\n")) + (princ "\n\n") + (princ (substitute-command-keys "\\{easy-kill-base-map}")))) + (defvar easy-kill-candidate nil) -(defvar easy-kill-append nil) -(defvar easy-kill-mark nil) (defun easy-kill--bounds () (cons (overlay-start easy-kill-candidate) @@ -195,21 +237,23 @@ Use `setf' to change property value." (`buffer '(overlay-buffer easy-kill-candidate)) (`properties '(append (list 'start (easy-kill-get start)) (list 'end (easy-kill-get end)) + (list 'buffer (easy-kill-get buffer)) (overlay-properties easy-kill-candidate))) (_ `(overlay-get easy-kill-candidate ',prop)))) -(defun easy-kill-init-candidate (n) +(defun easy-kill-init-candidate (n &optional mark) ;; Manipulate `easy-kill-candidate' directly during initialisation; ;; should use `easy-kill-get' elsewhere. (let ((o (make-overlay (point) (point)))) - (unless easy-kill-mark + (unless mark (overlay-put o 'face 'easy-kill-selection)) (overlay-put o 'origin (point)) (overlay-put o 'help-echo #'easy-kill-describe-candidate) ;; Use higher priority to avoid shadowing by, for example, ;; `hl-line-mode'. (overlay-put o 'priority 999) - (when easy-kill-mark + (when mark + (overlay-put o 'mark 'start) (let ((i (make-overlay (point) (point)))) (overlay-put i 'priority (1+ (overlay-get o 'priority))) (overlay-put i 'face 'easy-kill-origin) @@ -262,7 +306,9 @@ Otherwise, it is the value of the overlay's candidate property." (plist-get all k)) when v collect (format "%s:\t%s" k v))) (txt (mapconcat #'identity props "\n"))) - (format "cmd:\t%s\n%s" (if easy-kill-mark "easy-mark" "easy-kill") txt))) + (format "cmd:\t%s\n%s" + (if (easy-kill-get mark) "easy-mark" "easy-kill") + txt))) (defun easy-kill-adjust-candidate (thing &optional beg end) "Adjust kill candidate to THING, BEG, END. @@ -277,9 +323,11 @@ candidate property instead." (t (setf (easy-kill-get bounds) (cons (or beg (easy-kill-get start)) (or end (easy-kill-get end)))))) - (cond (easy-kill-mark (easy-kill-mark-region) - (easy-kill-indicate-origin)) - (t (easy-kill-interprogram-cut (easy-kill-candidate))))) + (cond ((easy-kill-get mark) + (easy-kill-mark-region) + (easy-kill-indicate-origin)) + (t + (easy-kill-interprogram-cut (easy-kill-candidate))))) (defun easy-kill-save-candidate () (unless (string= (easy-kill-candidate) "") @@ -289,7 +337,7 @@ candidate property instead." ;; `easy-kill-adjust-candidate' already did that. (let ((interprogram-cut-function nil) (interprogram-paste-function nil)) - (kill-new (if (and easy-kill-append kill-ring) + (kill-new (if (and (easy-kill-get append) kill-ring) (cl-labels ((join (x sep y) (if sep (concat (easy-kill-trim x 'right) sep @@ -300,7 +348,7 @@ candidate property instead." easy-kill-alist :key #'car)) (easy-kill-candidate))) (easy-kill-candidate)) - easy-kill-append)) + (easy-kill-get append))) t)) (defun easy-kill-destroy-candidate () @@ -321,6 +369,9 @@ candidate property instead." (easy-kill-thing nil '+)) (defun easy-kill-digit-argument (n) + "Expand selection by N number of things. +If N is 0 shrink the selection to the initial size before any +expansion." (interactive (list (- (logand (if (integerp last-command-event) last-command-event @@ -333,12 +384,45 @@ candidate property instead." (interactive) (easy-kill-thing nil '-)) +(defun easy-kill-thing-handler (base mode) + "Get the handler for MODE or nil if none is defined. +For example, if BASE is \"easy-kill-on-list\" and MODE is +nxml-mode `nxml:easy-kill-on-list', `easy-kill-on-list:nxml' are +checked in order. The former is never defined in this package and +is safe for users to customise. If neither is defined continue +checking on the parent mode. Finally `easy-kill-on-list' is +checked." + (or (and mode (or (easy-kill-fboundp + (concat (easy-kill-mode-sname mode) ":" base)) + (easy-kill-fboundp + (concat base ":" (easy-kill-mode-sname mode))))) + (let ((parent (get mode 'derived-mode-parent))) + (and parent (easy-kill-thing-handler base parent))) + (easy-kill-fboundp base))) + +(defun easy-kill-bounds-of-thing-at-point (thing) + "Easy Kill wrapper for `bounds-of-thing-at-point'." + (pcase (easy-kill-thing-handler + (format "easy-kill-bounds-of-%s-at-point" thing) + major-mode) + ((and (pred functionp) fn) (funcall fn)) + (_ (bounds-of-thing-at-point thing)))) + +(defun easy-kill-thing-forward-1 (thing &optional n) + "Easy Kill wrapper for `forward-thing'." + (pcase (easy-kill-thing-handler + (format "easy-kill-thing-forward-%s" thing) + major-mode) + ((and (pred functionp) fn) (funcall fn n)) + (_ (forward-thing thing n)))) + ;; Helper for `easy-kill-thing'. (defun easy-kill-thing-forward (n) (when (and (easy-kill-get thing) (/= n 0)) (let* ((step (if (cl-minusp n) -1 +1)) (thing (easy-kill-get thing)) - (bounds1 (or (easy-kill-pair-to-list (bounds-of-thing-at-point thing)) + (bounds1 (or (easy-kill-pair-to-list + (easy-kill-bounds-of-thing-at-point thing)) (list (point) (point)))) (start (easy-kill-get start)) (end (easy-kill-get end)) @@ -349,15 +433,8 @@ candidate property instead." (new-front (save-excursion (goto-char front) (with-demoted-errors - (cl-labels ((forward-defun (s) - (pcase s - (`-1 (beginning-of-defun 1)) - (`+1 (end-of-defun 1))))) - (dotimes (_ (abs n)) - ;; Work around http://debbugs.gnu.org/17247 - (if (eq thing 'defun) - (forward-defun step) - (forward-thing thing step))))) + (dotimes (_ (abs n)) + (easy-kill-thing-forward-1 thing step))) (point)))) (pcase (and (/= front new-front) (sort (cons new-front bounds1) #'<)) @@ -365,25 +442,6 @@ candidate property instead." (easy-kill-adjust-candidate thing start end) t))))) -(defun easy-kill-thing-handler (thing mode) - "Get the handler for THING or nil if none is defined. -For example, if THING is list and MODE is nxml-mode -`nxml:easy-kill-on-list', `easy-kill-on-list:nxml' are checked in -order. The former is never defined in this package and is safe -for users to customise. If neither is defined continue checking -on the parent mode. Finally `easy-kill-on-list' is checked." - (cl-labels ((sname (m) (cl-etypecase m - (symbol (sname (symbol-name m))) - (string (substring m 0 (string-match-p - "\\(?:-minor\\)?-mode\\'" m)))))) - (let ((parent (get mode 'derived-mode-parent))) - (or (and mode (or (easy-kill-fboundp - (format "%s:easy-kill-on-%s" (sname mode) thing)) - (easy-kill-fboundp - (format "easy-kill-on-%s:%s" thing (sname mode))))) - (and parent (easy-kill-thing-handler thing parent)) - (easy-kill-fboundp (format "easy-kill-on-%s" thing)))))) - (defun easy-kill-thing (&optional thing n inhibit-handler) ;; N can be -, + and digits (interactive @@ -394,29 +452,32 @@ on the parent mode. Finally `easy-kill-on-list' is checked." (let* ((thing (or thing (easy-kill-get thing))) (n (or n 1)) (handler (and (not inhibit-handler) - (easy-kill-thing-handler thing major-mode)))) - (when easy-kill-mark + (easy-kill-thing-handler (format "easy-kill-on-%s" thing) + major-mode)))) + (when (easy-kill-get mark) (goto-char (easy-kill-get origin))) (cond (handler (funcall handler n)) - ((or (eq thing (easy-kill-get thing)) - (memq n '(+ -))) + ((or (memq n '(+ -)) + (and (eq thing (easy-kill-get thing)) + (not (zerop n)))) (easy-kill-thing-forward (pcase n (`+ 1) (`- -1) (_ n)))) - (t (pcase (bounds-of-thing-at-point thing) + (t (pcase (easy-kill-bounds-of-thing-at-point thing) (`nil (easy-kill-echo "No `%s'" thing)) (`(,start . ,end) (easy-kill-adjust-candidate thing start end) - (easy-kill-thing-forward (1- n)))))) - (when easy-kill-mark + (unless (zerop n) + (easy-kill-thing-forward (1- n))))))) + (when (easy-kill-get mark) (easy-kill-adjust-candidate (easy-kill-get thing))))) (put 'easy-kill-abort 'easy-kill-exit t) (defun easy-kill-abort () (interactive) - (when easy-kill-mark + (when (easy-kill-get mark) ;; The after-string may interfere with `goto-char'. (overlay-put (easy-kill-get origin-indicator) 'after-string nil) (goto-char (easy-kill-get origin)) @@ -438,14 +499,24 @@ on the parent mode. Finally `easy-kill-on-list' is checked." (`(,_x . ,_x) (easy-kill-echo "Empty region")) (`(,beg . ,end) - (set-mark beg) - (goto-char end) + (pcase (if (eq (easy-kill-get mark) 'end) + (list end beg) (list beg end)) + (`(,m ,pt) + (set-mark m) + (goto-char pt))) (activate-mark)))) +(defun easy-kill-exchange-point-and-mark () + (interactive) + (exchange-point-and-mark) + (setf (easy-kill-get mark) + (if (eq (point) (easy-kill-get start)) + 'end 'start))) + (put 'easy-kill-append 'easy-kill-exit t) (defun easy-kill-append () (interactive) - (setq easy-kill-append t) + (setf (easy-kill-get append) t) (when (easy-kill-save-candidate) (easy-kill-interprogram-cut (car kill-ring)) (setq deactivate-mark t) @@ -469,7 +540,7 @@ on the parent mode. Finally `easy-kill-on-list' is checked." (command-remapping cmd nil (list map))))) (ignore (easy-kill-destroy-candidate) - (unless (or easy-kill-mark (easy-kill-exit-p this-command)) + (unless (or (easy-kill-get mark) (easy-kill-exit-p this-command)) (easy-kill-save-candidate)))) (error (message "%s:%s" this-command (error-message-string err)) nil)))))) @@ -480,9 +551,11 @@ on the parent mode. Finally `easy-kill-on-list' is checked." Temporally activate additional key bindings as follows: letters => select or expand selection according to `easy-kill-alist'; - 0..9 => expand selection by that number; + 1..9 => expand selection by that number; + 0 => shrink to the initial selection; +,=/- => expand or shrink selection; @ => append selection to previous kill; + ? => help; C-w => kill selection; C-SPC => turn selection into an active region; C-g => abort; @@ -493,9 +566,8 @@ Temporally activate additional key bindings as follows: (with-no-warnings (kill-ring-save (region-beginning) (region-end) t)) (kill-ring-save (region-beginning) (region-end))) - (setq easy-kill-mark nil) - (setq easy-kill-append (eq last-command 'kill-region)) (easy-kill-init-candidate n) + (setf (easy-kill-get append) (eq last-command 'kill-region)) (when (zerop (buffer-size)) (easy-kill-echo "Warn: `easy-kill' activated in empty buffer")) (easy-kill-activate-keymap))) @@ -509,8 +581,7 @@ Temporally activate additional key bindings as follows: "Similar to `easy-kill' (which see) but for marking." (interactive "p") (let ((easy-kill-try-things easy-mark-try-things)) - (setq easy-kill-mark t) - (easy-kill-init-candidate n) + (easy-kill-init-candidate n 'mark) (easy-kill-activate-keymap) (unless (easy-kill-get thing) (setf (easy-kill-get thing) 'sexp) @@ -524,7 +595,7 @@ Temporally activate additional key bindings as follows: "Get `buffer-file-name' or `default-directory'. If N is zero, remove the directory part; -, remove the file name part; +, full path." - (if easy-kill-mark + (if (easy-kill-get mark) (easy-kill-echo "Not supported in `easy-mark'") (pcase (or buffer-file-name default-directory) (`nil (easy-kill-echo "No `buffer-file-name'")) @@ -539,7 +610,7 @@ part; +, full path." (defun easy-kill-on-defun-name (_n) "Get current defun name." - (if easy-kill-mark + (if (easy-kill-get mark) (easy-kill-echo "Not supported in `easy-mark'") (pcase (add-log-current-defun) (`nil (easy-kill-echo "No `defun-name' at point")) @@ -551,13 +622,13 @@ part; +, full path." "Get url at point or from char properties. Char properties `help-echo', `shr-url' and `w3m-href-anchor' are inspected." - (if (or easy-kill-mark (bounds-of-thing-at-point 'url)) + (if (or (easy-kill-get mark) (easy-kill-bounds-of-thing-at-point 'url)) (easy-kill-thing 'url nil t) (cl-labels ((get-url (text) (when (stringp text) (with-temp-buffer (insert text) - (pcase (bounds-of-thing-at-point 'url) + (pcase (easy-kill-bounds-of-thing-at-point 'url) (`(,beg . ,end) (buffer-substring beg end))))))) (cl-dolist (p '(help-echo shr-url w3m-href-anchor)) (pcase (get-char-property-and-overlay (point) p) @@ -568,8 +639,32 @@ inspected." (easy-kill-adjust-candidate 'url url) (cl-return url))))))))) +;;; `defun' + +;; Work around http://debbugs.gnu.org/17247 +(defun easy-kill-thing-forward-defun (&optional n) + (pcase (or n 1) + ((pred cl-minusp) (beginning-of-defun (- n))) + (n (end-of-defun n)))) + ;;; Handler for `sexp' and `list'. +(defun easy-kill-bounds-of-list-at-point () + (let ((bos (and (nth 3 (syntax-ppss)) ;bounds of string + (save-excursion + (easy-kill-backward-up) + (easy-kill-bounds-of-thing-at-point 'sexp)))) + (b (bounds-of-thing-at-point 'list)) + (b1-in-b2 (lambda (b1 b2) + (and (> (car b1) (car b2)) + (< (cdr b1) (cdr b2)))))) + (cond + ((not b) bos) + ((not bos) b) + ((= (car b) (point)) bos) + ((funcall b1-in-b2 b bos) b) + (t bos)))) + (defvar up-list-fn) ; Dynamically bound (defun easy-kill-backward-up () @@ -600,7 +695,7 @@ inspected." (easy-kill-backward-up)) (`- (easy-kill-forward-down (point) (easy-kill-get start))) (_ (error "Unsupported argument `%s'" n))) - (bounds-of-thing-at-point 'sexp))) + (easy-kill-bounds-of-thing-at-point 'sexp))) (defun easy-kill-on-list (n) (pcase n @@ -628,7 +723,8 @@ inspected." ((memq n '(+ -)) (pcase (easy-kill-bounds-of-list n) (`(,beg . ,end) (easy-kill-adjust-candidate 'list beg end)))) - ((eq 'list (easy-kill-get thing)) + ((and (eq 'list (easy-kill-get thing)) + (not (zerop n))) (let ((new-end (save-excursion (goto-char (easy-kill-get end)) (forward-sexp n) @@ -640,6 +736,60 @@ inspected." (easy-kill-thing 'sexp n t) (setf (easy-kill-get thing) 'list)))))) +;;; org support for list-wise +/- + +(defun easy-kill-bounds-of-list-at-point:org () + (eval-and-compile (require 'org-element)) + (let ((x (org-element-at-point))) + (cons (org-element-property :begin x) + (org-element-property :end x)))) + +(defun easy-kill-bounds-of-sexp-at-point:org () + (pcase (list (point) (easy-kill-bounds-of-list-at-point:org)) + (`(,beg (,beg . ,end)) + (cons beg end)) + (_ (bounds-of-thing-at-point 'sexp)))) + +(defun easy-kill-thing-forward-list:org (&optional n) + (pcase (or n 1) + (`0 nil) + (n (dotimes (_ (abs n)) + (condition-case nil + (if (cl-minusp n) + (org-backward-element) + (org-forward-element)) + (error (pcase (easy-kill-bounds-of-thing-at-point 'list) + (`(,beg . ,end) + (goto-char (if (cl-minusp n) beg end)))))))))) + +(defun easy-kill-org-up-element (&optional n) + ;; Make `org-up-element' more like `up-list'. + (pcase (or n 1) + (`0 nil) + (n (ignore-errors + (dotimes (_ (abs n)) + (pcase (list (point) (easy-kill-bounds-of-thing-at-point 'list)) + (`(,_beg (,_beg . ,_)) (org-up-element)) + (`(,_ (,beg . ,_)) (goto-char beg))))) + (when (cl-plusp n) + (goto-char (cdr (easy-kill-bounds-of-thing-at-point 'list))))))) + +(defun easy-kill-on-list:org (n) + (pcase n + ((or `+ `-) + (pcase (let ((up-list-fn #'easy-kill-org-up-element)) + (easy-kill-bounds-of-list n)) + (`(,beg . ,end) (easy-kill-adjust-candidate 'list beg end)))) + (_ (easy-kill-thing 'list n t))) + (pcase (save-excursion + (goto-char (easy-kill-get start)) + (org-element-type (org-element-at-point))) + (`nil nil) + (type (setf (easy-kill-get describe-thing) + (lambda () + (format "%s (%s)" (easy-kill-get thing) type))) + (easy-kill-echo "%s" type)))) + ;;; js2 support for list-wise +/- (defun easy-kill-find-js2-node (beg end &optional inner) @@ -665,7 +815,8 @@ inspected." (easy-kill-find-js2-node (easy-kill-get start) (easy-kill-get end) (eq n '-))) - ((guard (eq 'list (easy-kill-get thing))) + ((guard (and (eq 'list (easy-kill-get thing)) + (not (zerop n)))) (error "List forward not supported in js2-mode")) (_ (js2-node-at-point))))) (easy-kill-adjust-candidate 'list diff --git a/admin/test.el b/packages/easy-kill/test.el similarity index 100% rename from admin/test.el rename to packages/easy-kill/test.el