Install some more packages

This commit is contained in:
Gergely Polonkai 2016-09-26 19:37:47 +02:00
parent b8052b9da2
commit 2df53f2a7a
28 changed files with 3192 additions and 1 deletions

View File

@ -0,0 +1,73 @@
;;; ascii-art-to-unicode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "ascii-art-to-unicode" "ascii-art-to-unicode.el"
;;;;;; (22505 22834 381650 654000))
;;; Generated autoloads from ascii-art-to-unicode.el
(autoload 'aa2u "ascii-art-to-unicode" "\
Convert simple ASCII art line drawings to Unicode.
Specifically, perform the following replacements:
- (hyphen) BOX DRAWINGS LIGHT HORIZONTAL
| (vertical bar) BOX DRAWINGS LIGHT VERTICAL
+ (plus) (one of)
BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
BOX DRAWINGS LIGHT DOWN AND RIGHT
BOX DRAWINGS LIGHT DOWN AND LEFT
BOX DRAWINGS LIGHT UP AND RIGHT
BOX DRAWINGS LIGHT UP AND LEFT
BOX DRAWINGS LIGHT VERTICAL AND RIGHT
BOX DRAWINGS LIGHT VERTICAL AND LEFT
BOX DRAWINGS LIGHT UP AND HORIZONTAL
BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
BOX DRAWINGS LIGHT UP
BOX DRAWINGS LIGHT DOWN
BOX DRAWINGS LIGHT LEFT
BOX DRAWINGS LIGHT RIGHT
QUESTION MARK
More precisely, hyphen and vertical bar are substituted unconditionally,
first, and plus is substituted with a character depending on its north,
south, east and west neighbors.
NB: Actually, `aa2u' can also use \"HEAVY\" instead of \"LIGHT\",
depending on the value of variable `aa2u-uniform-weight'.
This command operates on either the active region,
or the accessible portion otherwise.
\(fn BEG END &optional INTERACTIVE)" t nil)
(autoload 'aa2u-rectangle "ascii-art-to-unicode" "\
Like `aa2u' on the region-rectangle.
When called from a program the rectangle's corners
are START (top left) and END (bottom right).
\(fn START END)" t nil)
(autoload 'aa2u-mark-as-text "ascii-art-to-unicode" "\
Set property `aa2u-text' of the text from START to END.
This prevents `aa2u' from misinterpreting \"|\", \"-\" and \"+\"
in that region as lines and intersections to be replaced.
Prefix arg means to remove property `aa2u-text', instead.
\(fn START END &optional UNMARK)" t nil)
(autoload 'aa2u-mark-rectangle-as-text "ascii-art-to-unicode" "\
Like `aa2u-mark-as-text' on the region-rectangle.
When called from a program the rectangle's corners
are START (top left) and END (bottom right).
\(fn START END &optional UNMARK)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; ascii-art-to-unicode-autoloads.el ends here

View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "ascii-art-to-unicode" "1.9" "a small artist adjunct" 'nil :url "http://www.gnuvola.org/software/aa2u/" :keywords '("ascii" "unicode" "box-drawing"))

View File

@ -0,0 +1,510 @@
;;; ascii-art-to-unicode.el --- a small artist adjunct -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
;; Version: 1.9
;; Keywords: ascii, unicode, box-drawing
;; URL: http://www.gnuvola.org/software/aa2u/
;; 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 command `aa2u' converts simple ASCII art line drawings in
;; the {active,accessible} region of the current buffer to Unicode.
;; Command `aa2u-rectangle' is like `aa2u', but works on rectangles.
;;
;; Example use case:
;; - M-x artist-mode RET
;; - C-c C-a r ; artist-select-op-rectangle
;; - (draw two rectangles)
;;
;; +---------------+
;; | |
;; | +-------+--+
;; | | | |
;; | | | |
;; | | | |
;; +-------+-------+ |
;; | |
;; | |
;; | |
;; +----------+
;;
;; - C-c C-c ; artist-mode-off (optional)
;; - C-x n n ; narrow-to-region
;; - M-x aa2u RET
;;
;; ┌───────────────┐
;; │ │
;; │ ┌───────┼──┐
;; │ │ │ │
;; │ │ │ │
;; │ │ │ │
;; └───────┼───────┘ │
;; │ │
;; │ │
;; │ │
;; └──────────┘
;;
;; Much easier on the eyes now!
;;
;; Normally, lines are drawn with the `LIGHT' weight. If you set var
;; `aa2u-uniform-weight' to symbol `HEAVY', you will see, instead:
;;
;; ┏━━━━━━━━━━━━━━━┓
;; ┃ ┃
;; ┃ ┏━━━━━━━╋━━┓
;; ┃ ┃ ┃ ┃
;; ┃ ┃ ┃ ┃
;; ┃ ┃ ┃ ┃
;; ┗━━━━━━━╋━━━━━━━┛ ┃
;; ┃ ┃
;; ┃ ┃
;; ┃ ┃
;; ┗━━━━━━━━━━┛
;;
;; To protect particular |, - or + characters from conversion,
;; you can set the property `aa2u-text' on that text with command
;; `aa2u-mark-as-text'. A prefix arg clears the property, instead.
;; (You can use `describe-text-properties' to check.) For example:
;;
;; ┌───────────────────┐
;; │ │
;; │ |\/| │
;; │ `Oo' --Oop Ack! │
;; │ ^&-MM. │
;; │ │
;; └─────────┬─────────┘
;; │
;; """""""""
;;
;; Command `aa2u-mark-rectangle-as-text' is similar, for rectangles.
;;
;; Tip: For best results, you should make sure all the tab characaters
;; are converted to spaces. See: `untabify', `indent-tabs-mode'.
;;; Code:
(require 'cl-lib)
(require 'pcase)
(autoload 'apply-on-rectangle "rect")
(defvar aa2u-uniform-weight 'LIGHT
"A symbol, either `LIGHT' or `HEAVY'.
This specifies the weight of all the lines.")
;;;---------------------------------------------------------------------------
;;; support
(defsubst aa2u--text-p (pos)
(get-text-property pos 'aa2u-text))
(defun aa2u-ucs-bd-uniform-name (&rest components)
"Return a string naming UCS char w/ WEIGHT and COMPONENTS.
The string begins with \"BOX DRAWINGS\"; followed by the weight
as per variable `aa2u-uniform-weight', followed by COMPONENTS,
a list of one or two symbols from the set:
VERTICAL
HORIZONTAL
DOWN
UP
RIGHT
LEFT
If of length two, the first element in COMPONENTS should be
the \"Y-axis\" (VERTICAL, DOWN, UP). In that case, the returned
string includes \"AND\" between the elements of COMPONENTS.
Lastly, all words are separated by space (U+20)."
(format "BOX DRAWINGS %s %s"
aa2u-uniform-weight
(mapconcat 'symbol-name components
" AND ")))
(defun aa2u-1c (stringifier &rest components)
"Apply STRINGIFIER to COMPONENTS; return the UCS char w/ this name.
The char is a string (of length one), with two properties:
aa2u-stringifier
aa2u-components
Their values are STRINGIFIER and COMPONENTS, respectively."
(let ((s (string (cdr (assoc-string (apply stringifier components)
(ucs-names))))))
(propertize s
'aa2u-stringifier stringifier
'aa2u-components components)))
(defun aa2u-phase-1 ()
(cl-flet
((gsr (was name)
(goto-char (point-min))
(let ((now (aa2u-1c 'aa2u-ucs-bd-uniform-name name)))
(while (search-forward was nil t)
(unless (aa2u--text-p (match-beginning 0))
(replace-match now t t))))))
(gsr "|" 'VERTICAL)
(gsr "-" 'HORIZONTAL)))
(defun aa2u-replacement (pos)
(let ((cc (- pos (line-beginning-position))))
(cl-flet*
((ok (name pos)
(when (or
;; Infer LIGHTness between "snug" ?+es.
;; |
;; +-----------++--+ +
;; | somewhere ++--+---+-+----+
;; +-+---------+ nowhere |+--+
;; + +---------++
;; | +---|
(eq ?+ (char-after pos))
;; Require properly directional neighborliness.
(memq (cl-case name
((UP DOWN) 'VERTICAL)
((LEFT RIGHT) 'HORIZONTAL))
(get-text-property pos 'aa2u-components)))
name))
(v (name dir) (let ((bol (line-beginning-position dir))
(eol (line-end-position dir)))
(when (< cc (- eol bol))
(ok name (+ bol cc)))))
(h (name dir) (let ((bol (line-beginning-position))
(eol (line-end-position))
(pos (+ pos dir)))
(unless (or (> bol pos)
(<= eol pos))
(ok name pos))))
(two-p (ls) (= 2 (length ls)))
(just (&rest args) (delq nil args)))
(apply 'aa2u-1c
'aa2u-ucs-bd-uniform-name
(just (pcase (just (v 'UP 0)
(v 'DOWN 2))
((pred two-p) 'VERTICAL)
(`(,vc) vc)
(_ nil))
(pcase (just (h 'LEFT -1)
(h 'RIGHT 1))
((pred two-p) 'HORIZONTAL)
(`(,hc) hc)
(_ nil)))))))
(defun aa2u-phase-2 ()
(goto-char (point-min))
(let (changes)
;; (phase 2.1 -- what WOULD change)
;; This is for the benefit of aa2u-replacement ok, which
;; otherwise (monolithic phase 2) would need to convert the
;; "properly directional neighborliness" impl from a simple
;; memq to an intersction.
(while (search-forward "+" nil t)
(let ((p (point)))
(unless (aa2u--text-p (1- p))
(push (cons p (or (aa2u-replacement (1- p))
"?"))
changes))))
;; (phase 2.2 -- apply changes)
(dolist (ch changes)
(goto-char (car ch))
(delete-char -1)
(insert (cdr ch)))))
(defun aa2u-phase-3 ()
(remove-text-properties (point-min) (point-max)
(list 'aa2u-stringifier nil
'aa2u-components nil)))
;;;---------------------------------------------------------------------------
;;; commands
;;;###autoload
(defun aa2u (beg end &optional interactive)
"Convert simple ASCII art line drawings to Unicode.
Specifically, perform the following replacements:
- (hyphen) BOX DRAWINGS LIGHT HORIZONTAL
| (vertical bar) BOX DRAWINGS LIGHT VERTICAL
+ (plus) (one of)
BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
BOX DRAWINGS LIGHT DOWN AND RIGHT
BOX DRAWINGS LIGHT DOWN AND LEFT
BOX DRAWINGS LIGHT UP AND RIGHT
BOX DRAWINGS LIGHT UP AND LEFT
BOX DRAWINGS LIGHT VERTICAL AND RIGHT
BOX DRAWINGS LIGHT VERTICAL AND LEFT
BOX DRAWINGS LIGHT UP AND HORIZONTAL
BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
BOX DRAWINGS LIGHT UP
BOX DRAWINGS LIGHT DOWN
BOX DRAWINGS LIGHT LEFT
BOX DRAWINGS LIGHT RIGHT
QUESTION MARK
More precisely, hyphen and vertical bar are substituted unconditionally,
first, and plus is substituted with a character depending on its north,
south, east and west neighbors.
NB: Actually, `aa2u' can also use \"HEAVY\" instead of \"LIGHT\",
depending on the value of variable `aa2u-uniform-weight'.
This command operates on either the active region,
or the accessible portion otherwise."
(interactive "r\np")
;; This weirdness, along w/ the undocumented "p" in the interactive
;; form, is to allow M-x aa2u (interactive invocation) w/ no region
;; selected to default to the accessible portion (as documented), which
;; was the norm in ascii-art-to-unicode.el prior to 1.5. A bugfix,
;; essentially. This is ugly, unfortunately -- is there a better way?!
(when (and interactive (not (region-active-p)))
(setq beg (point-min)
end (point-max)))
(save-excursion
(save-restriction
(widen)
(narrow-to-region beg end)
(aa2u-phase-1)
(aa2u-phase-2)
(aa2u-phase-3))))
;;;###autoload
(defun aa2u-rectangle (start end)
"Like `aa2u' on the region-rectangle.
When called from a program the rectangle's corners
are START (top left) and END (bottom right)."
(interactive "r")
(let* ((was (delete-extract-rectangle start end))
(now (with-temp-buffer
(insert-rectangle was)
(aa2u (point) (mark))
(extract-rectangle (point-min) (point-max)))))
(goto-char (min start end))
(insert-rectangle now)))
;;;###autoload
(defun aa2u-mark-as-text (start end &optional unmark)
"Set property `aa2u-text' of the text from START to END.
This prevents `aa2u' from misinterpreting \"|\", \"-\" and \"+\"
in that region as lines and intersections to be replaced.
Prefix arg means to remove property `aa2u-text', instead."
(interactive "r\nP")
(funcall (if unmark
'remove-text-properties
'add-text-properties)
start end
'(aa2u-text t)))
;;;###autoload
(defun aa2u-mark-rectangle-as-text (start end &optional unmark)
"Like `aa2u-mark-as-text' on the region-rectangle.
When called from a program the rectangle's corners
are START (top left) and END (bottom right)."
(interactive "r\nP")
(apply-on-rectangle
(lambda (scol ecol unmark)
(let ((p (point)))
(aa2u-mark-as-text (+ p scol) (+ p ecol) unmark)))
start end
unmark))
;;;---------------------------------------------------------------------------
;;; that's it
;;;; ChangeLog:
;; 2014-05-29 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] Release: 1.9
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Version]: Bump
;; to "1.9".
;;
;; 2014-05-29 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] Mention TAB infelicity.
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Commentary]:
;; ...here.
;;
;; 2014-05-29 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] Update homepage; drop other links.
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [URL]: New
;; header.
;; [Commentary]: Remove the HACKING and Tip Jar links.
;;
;; 2014-05-29 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] New command: aa2u-mark-rectangle-as-text
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el: Arrange to
;; autoload "rect" for apply-on-rectangle.
;; (aa2u-mark-rectangle-as-text): New command, w/ autoload cookie.
;;
;; 2014-05-24 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u maint] Mention TAB infelicity in HACKING; nfc.
;;
;; 2014-05-21 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] Release: 1.8
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Version]: Bump
;; to "1.8".
;;
;; 2014-05-21 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] New command: aa2u-mark-as-text
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el
;; (aa2u--text-p): New defsubst.
;; (aa2u-phase-1, aa2u-phase-2): If the character in question is
;; aa2u--text-p, just ignore it.
;; (aa2u-mark-as-text): New command, w/ autoload cookie.
;;
;; 2014-05-21 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u int] Add abstraction: gsr
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el
;; (aa2u-phase-1 gsr): New internal func.
;;
;; 2014-05-21 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] Declare package keywords.
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Keywords]: New
;; header.
;;
;; 2014-05-21 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u maint] Add Maintainer header per top-level README; nfc.
;;
;; 2014-05-11 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] Release: 1.7
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Version]: Bump
;; to "1.7".
;;
;; 2014-05-11 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] New command: aa2u-rectangle
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el
;; (aa2u-rectangle): New command.
;;
;; 2014-05-11 Andreas Schwab <schwab@linux-m68k.org>
;;
;; ascii-art-to-unicode.el (aa2u-replacement): Use cl-case instead of
;; case.
;;
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; fixup! [aa2u] Make weight dynamically customizable.
;;
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u maint] Update HACKING; nfc.
;;
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] Make weight dynamically customizable.
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el
;; (aa2u-uniform-weight): New defvar.
;; (aa2u-ucs-bd-uniform-name): Don't take arg WEIGHT; instead, consult
;; aa2u-uniform-weight.
;; (aa2u-phase-1, aa2u-replacement): Update calls to
;; aa2u-ucs-bd-uniform-name.
;; (aa2u): Mention new var in docstring.
;;
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u int] Compute vertical/horizontal components separately.
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el
;; (aa2u-replacement ok): Recognize UP, DOWN, LEFT, RIGHT instead
;; of n, s, w, e.
;; (aa2u-replacement two-p): New internal func.
;; (aa2u-replacement just): Likewise.
;; (aa2u-replacement): Don't glom everything for one pcase; instead,
;; construct args to aa2u-ucs-bd-uniform-name by computing vertical and
;; horizontal components separately.
;;
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u int] Don't use cl-labels when cl-flet* will do.
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el
;; (aa2u-replacement): ...here.
;;
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u int] Add "Tip Jar" URL in Commentary; nfc.
;;
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u maint] Extract NEWS and HACKING to separate files; nfc.
;;
;; 2014-05-08 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] Release: 1.6
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Version]: Bump
;; to "1.6".
;;
;; 2014-05-08 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] Fix bug: Make M-x aa2u operate on accessible portion.
;;
;; Regression introduced 2014-04-03, "Make aa2u region-aware".
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el (aa2u): Take
;; optional arg INTERACTIVE; add "p" to interactive form; when
;; INTERACTIVE and region is not active, set BEG, END.
;;
;; 2014-04-03 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] Release: 1.5
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Version]: Bump
;; to "1.5".
;;
;; 2014-04-03 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; [aa2u] Make aa2u region-aware.
;;
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el (aa2u): Take
;; args BEG and END; use "r" in interactive spec; don't bother w/
;; internal func do-it!.
;;
;; 2014-01-14 Thien-Thi Nguyen <ttn@gnu.org>
;;
;; New package: ascii-art-to-unicode
;;
;; * packages/ascii-art-to-unicode/: New dir.
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el: New file.
;;
(provide 'ascii-art-to-unicode)
;;; ascii-art-to-unicode.el ends here

View File

@ -0,0 +1,16 @@
;;; hyde-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil nil ("hyde-git.el" "hyde-md.el" "hyde-pkg.el"
;;;;;; "hyde.el" "sample-dot-hyde.el") (22505 22510 45690 975000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; hyde-autoloads.el ends here

View File

@ -0,0 +1,96 @@
;;; hyde-git.el
;; Copyright (C) 2004 Noufal Ibrahim <noufal at nibrahim.net.in>
;;
;; This program is not part of Gnu Emacs
;;
;; hyde-git.el 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, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
(defcustom hyde/git/remote
"origin"
"The remote which should be pushed to"
:group 'hyde)
(defcustom hyde/git/remote-branch
"master"
"The name of the branch on the remote which should be pushed to"
:group 'hyde)
(defun hyde/git/uncommittedp (repo file)
"Returns true if there are uncommitted changes for the current file"
(let (
(cmd (format "cd '%s' && git diff-files --quiet '%s' > /dev/null" (expand-file-name repo) file))
)
(= (shell-command cmd) 1)))
(defun hyde/git/unpushedp (repo file)
"Returns true if there are unpushed changes for the current file"
(let (
(cmd
(format "cd '%s' && git log --exit-code %s/%s..HEAD '%s' > /dev/null" (expand-file-name repo) hyde/git/remote hyde/git/remote-branch file)
))
(= (shell-command cmd) 1)))
(defun hyde/git/pushedp (repo file)
"Returns true if there are no uncommitted changes in the file"
(not (hyde/git/uncommittedp repo file)))
(defun hyde/git/add (repo file)
"Adds the given file to the repository"
(let ((cmd (format "cd '%s' && git add '%s' > /dev/null" (expand-file-name repo) file)))
(shell-command cmd)))
(defun hyde/git/delete (repo file)
"Deletes a given file from the repository"
(let ((cmd (format "cd '%s' && git rm '%s' > /dev/null" (expand-file-name repo) file)))
(shell-command cmd)))
(defun hyde/git/commit (repo files commit-message)
"Commits the given files to the repository"
(if files
;; If files gives, add each one and then commit it.
(progn
;; Add each of the files in the list
(dolist (f files)
(message (concat "Dealing with " f))
(let ((cmd (format "cd '%s' && git add '%s'" (expand-file-name repo) f)))
(progn
(message (concat "Running " cmd))
(shell-command cmd))))
;; Commit them
(let ((cmd (format "cd '%s' && git commit -m '%s' > /dev/null" (expand-file-name repo) commit-message)))
(progn
(message (concat "Running " cmd))
(shell-command cmd))))
;; Otherwise, simply commit. Don't add.
(let ((cmd (format "cd '%s' && git commit -m '%s' > /dev/null" (expand-file-name repo) commit-message)))
(shell-command cmd))))
(defun hyde/git/push (repo)
"Pushes the repository"
(let ((cmd (format "cd '%s' && git push %s %s > /dev/null" (expand-file-name repo) hyde/git/remote hyde/git/remote-branch)))
(message cmd)
(shell-command cmd)))
(defun hyde/git/rename (base from to)
"Rename the file in BASE from FROM to TO"
(let ((cmd (format "cd '%s' && git mv '%s' '%s' > /dev/null" (expand-file-name base) from to)))
(shell-command cmd)))
(provide 'hyde-git)
;;; hyde-git.el ends here

View File

@ -0,0 +1,96 @@
;;; hyde-md.el
;; Copyright (C) 2004 Noufal Ibrahim <noufal at nibrahim.net.in>
;;
;; This program is not part of Gnu Emacs
;;
;; hyde-md.el 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, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
(defun hyde-markdown-processp (asset)
"Returns true if an asset is to be processed"
(and (not (string-prefix-p "http://" asset))
(not (string-prefix-p "https://" asset))
(not (string-prefix-p hyde-images-dir asset))))
(defun hyde-markdown-process-assets ()
(save-excursion
(goto-char (point-min))
(while (re-search-forward "!\\[\\(.*?\\)\\](\\(.*?\\))" nil t)
(let ((asset (match-string-no-properties 2)))
(message (format "Found : %s" asset))
(if (hyde-markdown-processp asset)
(progn
;; First copy over the asset properly to the images directory
(let ((new-name (hyde-markdown-copy-over-asset asset hyde-home)))
(message (format "Complete match is %s" (match-string-no-properties 0)))
(message (format "Copied over to %s" new-name))
;; rewrite the URL in the markdown file
(message (format "Replacing with %s" (format "![\\1](%s)" new-name)))
(let ((p (copy-marker (point) t)))
(replace-match (format "![\\1](%s)" new-name))
(goto-char p)))))))))
(defun hyde-markdown-create-target-filename (sourcefile target_dir)
(let* ((target_file (strip-string (shell-command-to-string (format "basename %s" sourcefile))))
(target (format "%s/%s" target_dir target_file))
(cntr 1))
(progn
(while (file-exists-p target)
(setq target (format "%s/%d-%s" target_dir cntr target_file))
(setq cntr (1+ cntr)))
target)))
(defun hyde-markdown-copy-over-asset (asset hyde-home)
(let (
(full-target (hyde-markdown-create-target-filename asset hyde-images-dir))
)
(progn
(copy-file asset full-target)
(concat "/"
(replace-regexp-in-string (format "%s/?" (regexp-quote hyde-home)) "" full-target)))))
(defun hyde-markdown-end-edit ()
"Function called signifying the end of the editing session"
(interactive)
(hyde-markdown-process-assets)
(save-buffer (current-buffer))
(hyde/vc-commit hyde-home
(append (hyde/hyde-get-post-assets (buffer-file-name (current-buffer))) (list (buffer-file-name (current-buffer))))
(concat "Updating " (buffer-name (current-buffer))))
(bury-buffer)
(hyde/load-posts)
nil)
(defun hyde-markdown-insert-image (image desc)
(interactive "fImage file:
sDescription: ")
(insert (format "![%s](%s)" desc (expand-file-name image))))
(define-derived-mode hyde-markdown-mode markdown-mode "Hyde-markdown"
"Markdown mode with a few extra bindings for convenience"
(define-key hyde-markdown-mode-map (kbd "C-c C-c") 'hyde-markdown-end-edit)
(define-key hyde-markdown-mode-map (kbd "C-c C-i") 'hyde-markdown-insert-image))
(defun hyde-markdown-activate-mode (hyde-buffer)
(hyde-markdown-mode)
(set (make-local-variable 'hyde-home)
(buffer-local-value 'hyde-home hyde-buffer)))
(provide 'hyde-md)
;;; hyde-md.el ends here

View File

@ -0,0 +1,4 @@
(define-package "hyde" "20160507.2008" "Major mode to help create and manage Jekyll blogs" 'nil)
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@ -0,0 +1,524 @@
;;; hyde.el --- Major mode to help create and manage Jekyll blogs
;; Copyright (C) 2004 Noufal Ibrahim <noufal at nibrahim.net.in>
;;
;; This program is not part of Gnu Emacs
;;
;; hyde.el 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, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
;; Requirements
(require 'hyde-git)
(require 'hyde-md)
(require 'easymenu)
;; Constants for internal use
(defconst hyde/hyde-version "0.3a"
"Hyde version")
;; Internal customisable variables
(defcustom hyde-custom-params
nil
"Params which will be added to each new post"
:type 'list
:group 'hyde)
(defcustom hyde-mode-hook nil
"Hook called by \"hyde-mode\""
:type 'hook
:group 'hyde)
(defcustom hyde-deploy-dir
"_site"
"Directory which needs to be deployed"
:type 'string
:group 'hyde)
(defcustom hyde-posts-dir
"_posts"
"Directory which contains the list of posts"
:type 'string
:group 'hyde)
(defcustom hyde-drafts-dir
"_drafts"
"Directory which contains post drafts"
:type 'string
:group 'hyde)
(defcustom hyde-images-dir
"images"
"Directory which contains images embedded on the blog"
:type 'string
:group 'hyde)
(defcustom hyde/jekyll-command
"jekyll"
"Command to run jekyll to create the blog"
:type 'string
:group 'hyde)
(defcustom hyde/serve-command
"jekyll serve"
"Command to serve jekyll to the localhost"
:type 'string
:group 'hyde)
(defvar hyde/serve-process nil "Process to keep track of serve")
(defcustom hyde/deploy-command
"rsync -vr _site/* nkv@ssh.hcoop.net:/afs/hcoop.net/user/n/nk/nkv/public_html/nibrahim.net.in/"
"Command used to deploy the site to the actual server"
:type 'string
:group 'hyde)
;; Faces and font-locking
(defface hyde-header-face
'(
(((type tty) (class color)) (:foreground "blue" :background "gray"))
(((type graphic) (class color)) (:foreground "blue" :background "gray"))
(t (:foreground "blue" :background "gray"))
)
"Face for a hyde header"
:group 'hyde)
(defface hyde-committed-face
'(
(((type tty) (class color)) (:foreground "blue"))
(((type graphic) (class color)) (:foreground "blue"))
(t (:foreground "blue"))
)
"Face for a file that has been committed"
:group 'hyde)
(defface hyde-modified-face
'(
(((type tty) (class color)) (:foreground "red"))
(((type graphic) (class color)) (:foreground "red"))
(t (:foreground "red"))
)
"Face for a file that has been modified but not committed"
:group 'hyde)
(defface hyde-unsaved-face
'(
(((type tty) (class color)) (:foreground "black" :background "red"))
(((type graphic) (class color)) (:foreground "black" :background "red"))
(t (:foreground "black" :background "red"))
)
"Face for a file that has been modified but not even saved"
:group 'hyde)
(defface hyde-pushed-face
'(
(((type tty) (class color)) (:foreground "green"))
(((type graphic) (class color)) (:foreground "green"))
(t (:foreground "green"))
)
"Face for a file that has been pushed to the remote repo"
:group 'hyde)
(defvar hyde-header-face 'hyde-header-face "Face for a hyde header")
(defvar hyde-committed-face 'hyde-committed-face)
(defvar hyde-modified-face 'hyde-modified-face)
(defvar hyde-unsaved-face 'hyde-unsaved-face )
(defvar hyde-pushed-face 'hyde-pushed-face)
(defconst hyde-font-lock-keywords
(list
'("^::.*" . hyde-header-face)
'("^C :.*" . hyde-committed-face)
'("^M :.*" . hyde-modified-face)
'("^E :.*" . hyde-unsaved-face)
'("^\\. :.*" . hyde-pushed-face)
)
"Font lock keywords for Hyde mode")
;; Version control abstraction
(defalias 'hyde/vc-uncommittedp 'hyde/git/uncommittedp "Command to check whether a file has uncommitted changes")
(defalias 'hyde/vc-unpushedp 'hyde/git/unpushedp "Command to check whether a file has unpushed changes")
(defalias 'hyde/vc-pushedp 'hyde/git/pushedp "Command to check whether a file has pushed changes")
(defalias 'hyde/vc-add 'hyde/git/add "Command to add a file to the DVCS")
(defalias 'hyde/vc-commit 'hyde/git/commit "Command to add a file to the DVCS")
(defalias 'hyde/vc-push 'hyde/git/push "Command to push the repository")
(defalias 'hyde/vc-rename 'hyde/git/rename "Command to rename files")
(defalias 'hyde/vc-delete 'hyde/git/delete "Command to delete file from the DVCS")
(defun hyde/hyde-file-local-uncommitted-changed (dir file)
"Return whether the given file in the given dir is uncommitted"
(hyde/vc-uncommittedp (concat hyde-home "/" dir) file))
(defun hyde/hyde-file-committed-not-pushed (dir file)
"Return whether the given file in the given dir is unpushed"
(hyde/vc-unpushedp (concat hyde-home "/" dir) file))
(defun hyde/hyde-file-committed-pushed (dir file)
"Return whether the given file in the given dir is pushed"
(hyde/vc-pushedp (concat hyde-home "/" dir) file))
(defun hyde/hyde-add-file (file)
"Stages the given file for commit."
(hyde/vc-add (concat hyde-home "/" hyde-posts-dir) file))
(defun hyde/hyde-delete-file (dir file)
"Deletes the given version controlled file"
(let* (
(post-file-name (strip-string (concat dir "/" file)))
(file-buffer (get-file-buffer (concat hyde-home "/" post-file-name)))
)
(if file-buffer (kill-buffer file-buffer))
(hyde/vc-delete hyde-home post-file-name)))
(defun hyde/hyde-rename-file (from to)
"Renames the given version controlled file from to to"
(hyde/vc-rename hyde-home from to))
(defun hyde/hyde-commit-post (pos commit-message)
"Commits the changes in the repository"
(interactive "d\nMCommit message : ")
(let* (
(post-file-name (nth
1
(split-string (strip-string (thing-at-point 'line)) " : ")))
(dir (get-text-property pos 'dir))
(post-full-path (concat hyde-home "/" dir "/" post-file-name))
)
(hyde/vc-commit (concat hyde-home "/" dir)
(append (hyde/hyde-get-post-assets post-full-path) (list post-file-name))
commit-message)
(hyde/load-posts)))
(defun hyde/hyde-push ()
"Publishes the changes to the remote repository"
(interactive)
(hyde/vc-push hyde-home)
(hyde/load-posts))
(defun hyde/run-jekyll ()
"Runs jekyll on the directory"
(interactive)
(shell-command (format "cd %s && %s" (expand-file-name hyde-home) hyde/jekyll-command)))
(defun hyde/stop-serve ()
"Stops jekyll serve if running"
(interactive)
(when hyde/serve-process
(delete-process hyde/serve-process)
(setq hyde/serve-process nil)))
(defun hyde/serve ()
"Serves jekyll to localhost in an asynchronous process. If
already started, stops and restarts."
(interactive)
(hyde/stop-serve)
(setq hyde/serve-process
(start-process-shell-command "hyde/serve" "*hyde/serve*"
(format "cd %s && %s" (expand-file-name hyde-home) hyde/serve-command))))
(defun hyde/deploy ()
"Deploys the generated website (should be run after hyde/run-jekyll"
(interactive)
(shell-command (format "cd %s && %s" (expand-file-name hyde-home) hyde/deploy-command)))
;; Utility functions
(defun hyde/hyde-file-local-unsaved-changed (dir file)
"Returns true if and only if the given file contains unsaved changes"
(let (
(buffer (get-file-buffer file))
)
(if buffer
(buffer-modified-p buffer)
nil)))
(defun strip-string (str)
"Returns STR with all trailing whitespaces gone"
(replace-regexp-in-string "\n$" "" str))
(defun hyde/file-status (dir file)
"Returns an letter indicating the status of the file as far as
hyde is concerned
Committed means that the changes have been committed into your DVCS
Pushed out means that they have been pushed to a safe remote repo (github, bitbucket etc.)
Status indicators are as follows:
. Committed and pushed
C Committed but not yet pushed
M Local saved changes (uncommitted)
E Local unsaved changes"
(or
(and (hyde/hyde-file-local-unsaved-changed dir file) "E")
(and (hyde/hyde-file-local-uncommitted-changed dir file) "M")
(and (hyde/hyde-file-committed-not-pushed dir file) "C")
(and (hyde/hyde-file-committed-pushed dir file) ".")))
(defun hyde/list-format-posts (dir)
"Gets the lists of posts from the given directory, formats them
properly and returns them so that they can be presented to the
user"
(let* (
(posts-dir (concat (expand-file-name hyde-home) "/" dir))
(posts (directory-files posts-dir nil ".*md\\|.*markdown" nil)))
(map 'list (lambda (f) (format "%s : %s" (hyde/file-status dir f) f)) posts)))
(defun hyde/hyde-get-post-assets (post)
(save-excursion
(with-current-buffer (find-file post)
(goto-char (point-min))
(let ((assets '()))
(while (re-search-forward "!\\[\\(.*?\\)\\](\\(.*?\\))" nil t)
;; TBD don't try to process http assets.
(add-to-list 'assets (concat
(strip-string (shell-command-to-string (format "dirname %s" post)))
"/"
(match-string-no-properties 2))))
assets))))
(defun hyde/promote-to-post (pos)
"Promotes the post under the cursor from a draft to a post"
(interactive "d")
(let (
(post-file-name (nth
1
(split-string (strip-string (thing-at-point 'line)) " : ")))
(dir (get-text-property pos 'dir)))
(if (equal dir hyde-drafts-dir)
(progn
;; Move over post assets
(dolist (asset (hyde/hyde-get-post-assets (concat dir "/" post-file-name)))
(progn
(message (concat "Asset is : " asset))
(hyde/hyde-rename-file asset
(format "%s%s" hyde-home
(replace-regexp-in-string "_drafts" "" asset)))))
;; Move over the actual post
(hyde/hyde-rename-file (concat dir "/" post-file-name)
(concat hyde-posts-dir "/" (format-time-string "%Y-%m-%d-") post-file-name))))
(hyde/vc-commit hyde-home
'()
(concat "Promoting " post-file-name))
(hyde/load-posts)))
(defun hyde/open-post-maybe (pos)
"Opens the post under cursor in the editor"
(interactive "d")
(let (
(post-file-name (nth
1
(split-string (strip-string (thing-at-point 'line)) " : ")))
(dir (get-text-property pos 'dir)))
(let ((hyde-buffer (current-buffer)))
(find-file
(strip-string (concat hyde-home "/" dir "/" post-file-name)))
(hyde-markdown-activate-mode hyde-buffer))))
(defun hyde/new-post (title)
"Creates a new post"
(interactive "MEnter post title: ")
(let ((post-file-name (expand-file-name (format "%s/%s/%s.markdown"
hyde-home hyde-drafts-dir (concat
(downcase (replace-regexp-in-string " " "_" title))))))
(hyde-buffer (current-buffer)))
(save-excursion
(find-file post-file-name)
(insert "---\n")
(insert "layout: post\n")
(insert (format "title: \"%s\"\n" title))
(dolist (l hyde-custom-params)
(insert (format "%s: %s\n"
(first l)
(eval (second l)))))
(insert "---\n\n")
(save-buffer))
(hyde/hyde-add-file post-file-name)
(find-file post-file-name)
;; hyde-home not available in markdown buffer (FIXME)
(hyde-markdown-activate-mode hyde-buffer)))
(defun hyde/delete-post (pos)
(interactive "d")
(let* (
(post-file-name (nth
1
(split-string (strip-string (thing-at-point 'line)) " : ")))
(dir (get-text-property pos 'dir))
)
(hyde/hyde-delete-file dir post-file-name)
(hyde/vc-commit hyde-home '() (concat "Deleting " post-file-name))
(hyde/load-posts)))
(defun hyde/quit ()
"Quits hyde"
(interactive)
(kill-buffer (current-buffer)))
;; Keymaps
(defvar hyde-mode-map
(let
((hyde-mode-map (make-sparse-keymap)))
(define-key hyde-mode-map (kbd "n") 'hyde/new-post)
(define-key hyde-mode-map (kbd "g") 'hyde/load-posts)
(define-key hyde-mode-map (kbd "c") 'hyde/hyde-commit-post)
(define-key hyde-mode-map (kbd "P") 'hyde/hyde-push)
(define-key hyde-mode-map (kbd "j") 'hyde/run-jekyll)
(define-key hyde-mode-map (kbd "s") 'hyde/serve)
(define-key hyde-mode-map (kbd "k") 'hyde/stop-serve)
(define-key hyde-mode-map (kbd "d") 'hyde/deploy)
(define-key hyde-mode-map (kbd "D") 'hyde/delete-post)
(define-key hyde-mode-map (kbd "p") 'hyde/promote-to-post)
(define-key hyde-mode-map (kbd "q") 'hyde/quit)
(define-key hyde-mode-map (kbd "RET") 'hyde/open-post-maybe)
hyde-mode-map)
"Keymap for Hyde")
;; Menu
(easy-menu-define hyde-mode-menu hyde-mode-map
"Hyde menu"
'("Hyde"
["New post" hyde/new-post t]
["Open post" hyde/open-post-maybe t]
["Commit post" hyde/hyde-commit-post t]
["Promote post" hyde/promote-to-post t]
["Delete post" hyde/delete-post t]
"---"
["Refresh" hyde/load-posts t]
["Run Jekyll" hyde/run-jekyll t]
["(Re)start server" hyde/serve t]
["Stop server" hyde/stop-serve t]
"---"
["Deploy" hyde/deploy t]
["Push" hyde/hyde-push t]
["Quit" hyde/quit t]
))
(defun hyde/load-posts ()
"Load up the posts and present them to the user"
(interactive)
;; Clear the buffer
(toggle-read-only -1)
(delete-region (point-min) (point-max))
;; Insert headers
(insert ":: Editing blog at:" hyde-home "\n")
(insert ":: Posts\n")
;; Insert posts from posts directory
(let
((posts (hyde/list-format-posts hyde-posts-dir)))
(dolist (post posts)
(progn
(save-excursion
(insert (concat post "\n")))
(put-text-property (point) (+ (point) (length post)) 'dir hyde-posts-dir)
(forward-line))))
;; Inserts post for the drafts directory
(insert "\n:: Drafts\n")
(let
((posts (hyde/list-format-posts hyde-drafts-dir)))
(dolist (post posts)
(progn
(save-excursion
(insert (concat post "\n")))
(put-text-property (point) (+ (point) (length post)) 'dir hyde-drafts-dir)
(forward-line))))
;; Insert footer
(insert (concat "\n\n:: Hyde version " hyde/hyde-version "\n"))
(insert "Key:\n-----\n . Committed and pushed\n C Committed but not yet pushed\n M Local saved changes (uncommitted)\n E Local unsaved changes\n")
(toggle-read-only 1))
(defun hyde/read-config (hyde-home)
"Loads up the config file to set the blog deployment and other information"
(let (
(config-file (expand-file-name ".hyde.el" hyde-home))
)
(if (not (file-exists-p config-file))
(error (format "Config file '%s' is missing. Won't continue" config-file)))
(message (format "Loading %s" config-file))
(load-file config-file)
))
(defun hyde/setup-directories (home)
"Create expected directories if they don't exist"
(let
(
(drafts-dir (expand-file-name hyde-drafts-dir home))
)
(if (and (not (file-exists-p drafts-dir))
(yes-or-no-p (format "%s doesn't exist; create it? " drafts-dir)))
(make-directory drafts-dir t))))
(defun hyde/hyde-mode (home)
"The Hyde major mode to edit Jekyll posts.
\\{hyde-mode-map}"
(kill-all-local-variables)
(dolist (x '(hyde-deploy-dir
hyde-posts-dir
hyde-drafts-dir
hyde/jekyll-command
hyde/deploy-command
hyde/git/remote
hyde/git/remote-branch))
(make-variable-buffer-local x))
(set (make-local-variable 'hyde-home) home)
(use-local-map hyde-mode-map)
(set (make-local-variable 'font-lock-defaults) '(hyde-font-lock-keywords))
(setq major-mode 'hyde/hyde-mode
mode-name "Hyde"
default-directory home)
(hyde/read-config hyde-home)
(hyde/setup-directories hyde-home)
(hyde/load-posts)
(hl-line-mode t)
;; Create directories for images
(let ((draft-images-dir (concat hyde-home hyde-drafts-dir "/" hyde-images-dir))
(posts-images-dir (concat hyde-home "/" hyde-images-dir)))
(progn
(message (concat "Drafts image dir :"draft-images-dir))
(message (concat "Posts image dir :"posts-images-dir))
(if (not (file-exists-p draft-images-dir))
(make-directory draft-images-dir))
(if (not (file-exists-p posts-images-dir))
(make-directory posts-images-dir))))
(run-hooks hyde-mode-hook))
;; Entry point
(defun hyde (&optional home)
"Enters hyde mode"
(interactive)
(let* (
(jekyll-root (or home
(hyde/ask-for-jekyll-root)))
(hyde-buffer (concat "*Hyde:" jekyll-root "*"))
)
(switch-to-buffer (get-buffer-create hyde-buffer))
(hyde/hyde-mode jekyll-root)))
(defun hyde/ask-for-jekyll-root ()
(or (vc-find-root (buffer-file-name) "_config.yml")
(read-directory-name "Jekyll root: ")))
(provide 'hyde)
;;; hyde.el ends here

View File

@ -0,0 +1,9 @@
(setq hyde/git/remote "upstream" ; The name of the remote to which we should push
hyde/git/remote "master" ; The name of the branch on which your blog resides
hyde/deploy-command "rsync -vr _site/* nkv@ssh.hcoop.net:/afs/hcoop.net/user/n/nk/nkv/public_html/nibrahim.net.in/" ; Command to deploy
hyde-custom-params '(("category" "personal")
("tags" "")
("cover" "false")
("cover-image" ""))
)

View File

@ -0,0 +1,88 @@
;;; mc-compare.el --- Compare texts in multiple-cursors mode.
;; Copyright (c) 2013 Akinori MUSHA
;;
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;; SUCH DAMAGE.
;; Author: Akinori MUSHA <knu@iDaemons.org>
;; URL: https://github.com/knu/mc-extras.el
;; Created: 16 Aug 2013
;; Package-Requires: ((multiple-cursors "1.2.1"))
;; Keywords: editing, cursors
;;; Commentary:
;;
;; This library contains functions to compare texts in
;; multiple-cursors mode.
;;
;; Suggested key bindings are as follows:
;;
;; (define-key mc/keymap (kbd "C-. =") 'mc/compare-chars)
;;; Code:
(require 'cl)
(require 'multiple-cursors-core)
;;;###autoload
(defun mc/compare-chars (&optional arg)
"Compare the character at point with that at each fake cursor, and move forward as far as they all match.
With an optional argument, move backwards by calling `mc/compare-chars-backward'.
This command pushes the mark before moving cursors."
(interactive "P")
(if arg (mc/compare-chars-backward)
(mc/compare-chars-forward)))
(add-to-list 'mc--default-cmds-to-run-once 'mc/compare-chars)
;;;###autoload
(defun mc/compare-chars-forward ()
"Compare the character at point with that at each fake cursor, and move forward as far as they all match.
This command pushes the mark before moving cursors."
(interactive)
(let (current-prefix-arg)
(mc/execute-command-for-all-cursors 'push-mark-command)
(while (loop for cursor in (mc/all-fake-cursors)
with c = (following-char)
always (char-equal (char-after (overlay-start cursor)) c))
(mc/execute-command-for-all-cursors 'forward-char))))
(add-to-list 'mc--default-cmds-to-run-once 'mc/compare-chars-forward)
;;;###autoload
(defun mc/compare-chars-backward ()
"Backwards version of `mc/compare-chars-forward'."
(interactive)
(let (current-prefix-arg)
(mc/execute-command-for-all-cursors 'push-mark-command)
(while (loop for cursor in (mc/all-fake-cursors)
with c = (preceding-char)
always (char-equal (char-before (overlay-start cursor)) c))
(mc/execute-command-for-all-cursors 'backward-char))))
(add-to-list 'mc--default-cmds-to-run-once 'mc/compare-chars-backward)
(provide 'mc-compare)
;;; mc-compare.el ends here

View File

@ -0,0 +1,153 @@
;;; mc-cua.el --- Make multiple-cursors interact with CUA mode.
;; Copyright (c) 2013 Akinori MUSHA
;;
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;; SUCH DAMAGE.
;; Author: Akinori MUSHA <knu@iDaemons.org>
;; URL: https://github.com/knu/mc-extras.el
;; Created: 16 Jul 2013
;; Package-Requires: ((multiple-cursors "1.2.1"))
;; Keywords: editing, cursors
;;; Commentary:
;;
;; This library contains functions to make multiple-cursors interact
;; with CUA mode.
;;
;; Suggested key bindings are as follows:
;;
;; (define-key cua--rectangle-keymap (kbd "C-. C-,") 'mc/cua-rectangle-to-multiple-cursors)
;;
;; To enable interaction between multiple cursors and CUA rectangle
;; copy & paste:
;;
;; (mc/cua-rectangle-setup)
;;; Code:
(require 'cl)
(require 'multiple-cursors-core)
(require 'cua-rect)
;;;###autoload
(defun mc/cua-rectangle-to-multiple-cursors ()
"Turn CUA rectangle mode into multiple-cursors mode, keeping insert positions and selections."
(interactive)
(let ((right (cua--rectangle-right-side))
rows)
(cua--rectangle-operation
'clear nil t nil nil
(lambda (s e _l _r)
(setq rows
(append rows
(list (cons (+ 0 s) (+ 0 e)))))))
(cua--cancel-rectangle)
(if rows
(let ((mark-row `(lambda (row)
,@(if right
'((push-mark (car row))
(goto-char (cdr row)))
'((push-mark (cdr row))
(goto-char (car row))))
(setq transient-mark-mode (cons 'only transient-mark-mode))
(activate-mark)
(setq deactivate-mark nil)))
(top (car rows))
(rest (cdr rows)))
(loop for row in rest do
(mc/save-excursion
(funcall mark-row row)
(mc/create-fake-cursor-at-point)))
(funcall mark-row top)
(mc/maybe-multiple-cursors-mode)))))
(add-to-list 'mc--default-cmds-to-run-once 'mc/cua-rectangle-to-multiple-cursors)
;;
;; Build a CUA rectangle from entries copied with multiple cursors.
;;
(defadvice mc--maybe-set-killed-rectangle
(around mc/cua-set-last-killed-rectangle)
"Set `cua--last-killed-rectangle' as well as `killed-rectangle'."
(if (boundp 'cua--last-killed-rectangle)
(let ((orig-entries killed-rectangle))
ad-do-it
(when (not (eq orig-entries killed-rectangle))
(setq cua--last-killed-rectangle
(cons (car kill-ring) killed-rectangle))))
ad-do-it))
;;
;; Let each of multiple cursors paste the corresponding line of the
;; last killed rectangle.
;;
(defvar mc/cua-saved-kill-ring nil)
(defadvice current-kill
(before mc/cua-remember-kill-ring)
"Remember `kill-ring' before interprogram-paste."
(setq mc/cua-saved-kill-ring kill-ring))
(defadvice current-kill
(after mc/cua-clear-last-killed-rectangle-on-interprogram-paste)
"Clear `cua--last-killed-rectangle' on interprogram paste."
(and (= n 0)
interprogram-paste-function
(boundp 'cua--last-killed-rectangle)
cua--last-killed-rectangle
(not (eq mc/cua-saved-kill-ring kill-ring))
(setq cua--last-killed-rectangle nil))
(setq mc/cua-saved-kill-ring nil))
(defadvice cua-paste
(before mc/cua-divide-rectangle-into-lines)
"Let each of multiple cursors paste the corresponding line of the last killed rectangle."
(and (null arg) ;; Currently no support for register 0-9.
(or (null kill-ring)
(current-kill 0)) ;; Take interprogram paste into account.
cua--last-killed-rectangle
multiple-cursors-mode
(let ((rect (cdr cua--last-killed-rectangle)))
(mc/for-each-cursor-ordered
(let ((kill-ring (overlay-get cursor 'kill-ring))
(kill-ring-yank-pointer (overlay-get cursor 'kill-ring-yank-pointer)))
(kill-new (or (pop rect) ""))
(overlay-put cursor 'kill-ring kill-ring)
(overlay-put cursor 'kill-ring-yank-pointer kill-ring-yank-pointer)))
(setq cua--last-killed-rectangle nil))))
;;;###autoload
(defun mc/cua-rectangle-setup ()
"Enable interaction between multiple cursors and CUA rectangle copy & paste."
(ad-activate 'mc--maybe-set-killed-rectangle)
(ad-activate 'current-kill)
(ad-activate 'cua-paste))
(provide 'mc-cua)
;;; mc-cua.el ends here

View File

@ -0,0 +1,109 @@
;;; mc-extras-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "mc-compare" "mc-compare.el" (22505 23283 261594
;;;;;; 850000))
;;; Generated autoloads from mc-compare.el
(autoload 'mc/compare-chars "mc-compare" "\
Compare the character at point with that at each fake cursor, and move forward as far as they all match.
With an optional argument, move backwards by calling `mc/compare-chars-backward'.
This command pushes the mark before moving cursors.
\(fn &optional ARG)" t nil)
(autoload 'mc/compare-chars-forward "mc-compare" "\
Compare the character at point with that at each fake cursor, and move forward as far as they all match.
This command pushes the mark before moving cursors.
\(fn)" t nil)
(autoload 'mc/compare-chars-backward "mc-compare" "\
Backwards version of `mc/compare-chars-forward'.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "mc-cua" "mc-cua.el" (22505 23283 253594 853000))
;;; Generated autoloads from mc-cua.el
(autoload 'mc/cua-rectangle-to-multiple-cursors "mc-cua" "\
Turn CUA rectangle mode into multiple-cursors mode, keeping insert positions and selections.
\(fn)" t nil)
(autoload 'mc/cua-rectangle-setup "mc-cua" "\
Enable interaction between multiple cursors and CUA rectangle copy & paste.
\(fn)" nil nil)
;;;***
;;;### (autoloads nil "mc-freeze" "mc-freeze.el" (22505 23283 269594
;;;;;; 849000))
;;; Generated autoloads from mc-freeze.el
(autoload 'mc/freeze-fake-cursors "mc-freeze" "\
Freeze fake cursors for later reactivation.
With ARG or when there is no fake cursor, create a fake cursor at
point before freezing fake cursors.
\(fn &optional ARG)" t nil)
(autoload 'mc/unfreeze-fake-cursors "mc-freeze" "\
Unfreeze frozen fake cursors.
\(fn)" t nil)
(autoload 'mc/freeze-fake-cursors-dwim "mc-freeze" "\
Freeze or unfreeze fake cursors depending on the current state.
With ARG, always create a fake cursor at point then freeze fake
cursors.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil "mc-rect" "mc-rect.el" (22505 23283 277594
;;;;;; 850000))
;;; Generated autoloads from mc-rect.el
(autoload 'mc/rect-rectangle-to-multiple-cursors "mc-rect" "\
Turn rectangle-mark-mode into multiple-cursors mode, keeping selections.
\(fn START END)" t nil)
;;;***
;;;### (autoloads nil "mc-remove" "mc-remove.el" (22505 23283 273594
;;;;;; 850000))
;;; Generated autoloads from mc-remove.el
(autoload 'mc/remove-current-cursor "mc-remove" "\
Remove the current cursor by replacing the next fake cursor with the real cursor.
\(fn)" t nil)
(autoload 'mc/remove-duplicated-cursors "mc-remove" "\
Remove duplicated fake cursors, including ones that overlap the real cursor.
\(fn)" t nil)
;;;***
;;;### (autoloads nil nil ("mc-extras-pkg.el" "mc-extras.el") (22505
;;;;;; 23283 265594 849000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; mc-extras-autoloads.el ends here

View File

@ -0,0 +1,7 @@
(define-package "mc-extras" "20150218.234" "Extra functions for multiple-cursors mode."
'((multiple-cursors "1.2.1"))
:url "https://github.com/knu/mc-extras.el" :keywords
'("editing" "cursors"))
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@ -0,0 +1,78 @@
;;; mc-extras.el --- Extra functions for multiple-cursors mode.
;; Copyright (c) 2013-2015 Akinori MUSHA
;;
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;; SUCH DAMAGE.
;; Author: Akinori MUSHA <knu@iDaemons.org>
;; URL: https://github.com/knu/mc-extras.el
;; Created: 4 Sep 2013
;; Version: 1.2.1
;; Package-Requires: ((multiple-cursors "1.2.1"))
;; Keywords: editing, cursors
;;; Commentary:
;;
;; This package contains extra functions for multiple-cursors mode.
;;
;; Here is a list of the interactive commands provided by mc-extras:
;;
;; * mc/compare-chars
;; * mc/compare-chars-backward
;; * mc/compare-chars-forward
;; * mc/cua-rectangle-to-multiple-cursors
;; * mc/rect-rectangle-to-multiple-cursors
;; * mc/remove-current-cursor
;; * mc/remove-duplicated-cursors
;;
;; Suggested key bindings are as follows:
;;
;; (define-key mc/keymap (kbd "C-. C-d") 'mc/remove-current-cursor)
;; (define-key mc/keymap (kbd "C-. d") 'mc/remove-duplicated-cursors)
;;
;; (define-key mc/keymap (kbd "C-. =") 'mc/compare-chars)
;;
;; ;; Emacs 24.4+ comes with rectangle-mark-mode.
;; (define-key rectangle-mark-mode-map (kbd "C-. C-,") 'mc/rect-rectangle-to-multiple-cursors)
;;
;; (define-key cua--rectangle-keymap (kbd "C-. C-,") 'mc/cua-rectangle-to-multiple-cursors)
;;
;; To enable interaction between multiple cursors and CUA rectangle
;; copy & paste:
;;
;; (mc/cua-rectangle-setup)
;;; Code:
(require 'multiple-cursors)
(require 'mc-compare)
(require 'mc-cua)
(if (featurep 'rectangle-mark-mode)
(require 'mc-rect))
(require 'mc-remove)
(provide 'mc-extras)
;;; mc-extras.el ends here

View File

@ -0,0 +1,129 @@
;;; mc-freeze.el --- Freeze and unfreeze fake cursors in multiple-cursors mode.
;; Copyright (c) 2015 Akinori MUSHA
;;
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;; SUCH DAMAGE.
;; Author: Akinori MUSHA <knu@iDaemons.org>
;; URL: https://github.com/knu/mc-extras.el
;; Created: 18 Feb 2015
;; Package-Requires: ((multiple-cursors "1.2.1"))
;; Keywords: editing, cursors
;;; Commentary:
;;
;; This library contains functions to temporarily freeze fake cursors
;; for later reactivation so you can move the real cursor alone in
;; `multiple-cursors-mode'.
;;
;; Suggested key binding is as follows:
;;
;; (global-set-key (kbd "C-. C-.") 'mc/freeze-fake-cursors-dwim)
;;; Code:
(eval-when-compile
(require 'cl))
(require 'multiple-cursors-core)
(defvar mc-freeze--frozen-cursors nil
"Keeps a list of frozen fake cursors to be reactivated later.")
(make-variable-buffer-local 'mc-freeze--frozen-cursors)
(defun mc-freeze--frozen-cursor-p (ov)
(eq (overlay-get ov 'type) 'mc-freeze--frozen-cursor))
(defun mc-freeze--frozen-cursor-at-pos-p (pos)
(loop for ov in (overlays-at pos)
thereis (mc-freeze--frozen-cursor-p ov)))
(defun mc-freeze--add-frozen-cursor (pos)
(or
(mc-freeze--frozen-cursor-at-pos-p pos)
(let ((ov (make-overlay pos (1+ pos) nil nil nil)))
(overlay-put ov 'type 'mc-freeze--frozen-cursor)
(overlay-put ov 'face 'mc/cursor-face)
(add-to-list 'mc-freeze--frozen-cursors ov))))
;;;###autoload
(defun mc/freeze-fake-cursors (&optional arg)
"Freeze fake cursors for later reactivation.
With ARG or when there is no fake cursor, create a fake cursor at
point before freezing fake cursors."
(interactive "P")
(when (or arg
(and
(null mc-freeze--frozen-cursors)
(= (mc/num-cursors) 1)))
(mc/create-fake-cursor-at-point))
(when (> (mc/num-cursors) 1)
(mc/for-each-fake-cursor
(mc-freeze--add-frozen-cursor (overlay-start cursor)))
(mc/remove-fake-cursors)
(message "Time stop!")))
(add-to-list 'mc--default-cmds-to-run-once 'mc/freeze-fake-cursors)
;;;###autoload
(defun mc/unfreeze-fake-cursors ()
"Unfreeze frozen fake cursors."
(interactive)
(loop for ov in mc-freeze--frozen-cursors do
(let ((pos (overlay-start ov)))
(delete-overlay ov)
(and (/= pos (point))
(loop for o in (overlays-at pos)
never (mc/fake-cursor-p o))
(mc/save-excursion
(goto-char pos)
(mc/create-fake-cursor-at-point)))))
(setq mc-freeze--frozen-cursors nil)
(mc/maybe-multiple-cursors-mode)
;; Prevent the fake cursors from moving via mc's post-command-hook
(setq this-original-command nil)
(message "And time resumes."))
(add-to-list 'mc--default-cmds-to-run-once 'mc/unfreeze-fake-cursors)
;;;###autoload
(defun mc/freeze-fake-cursors-dwim (&optional arg)
"Freeze or unfreeze fake cursors depending on the current state.
With ARG, always create a fake cursor at point then freeze fake
cursors."
(interactive "P")
(cond ((> (mc/num-cursors) 1)
(mc/freeze-fake-cursors arg))
((or arg
(null mc-freeze--frozen-cursors))
(mc/freeze-fake-cursors t))
(t
(mc/unfreeze-fake-cursors))))
(add-to-list 'mc--default-cmds-to-run-once 'mc/freeze-fake-cursors-dwim)
(provide 'mc-freeze)
;;; mc-freeze.el ends here

View File

@ -0,0 +1,85 @@
;;; mc-rect.el --- Make multiple-cursors interact with rectangle selection.
;; Copyright (c) 2015 Akinori MUSHA
;;
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;; SUCH DAMAGE.
;; Author: Akinori MUSHA <knu@iDaemons.org>
;; URL: https://github.com/knu/mc-extras.el
;; Created: 22 Jan 2015
;; Package-Requires: ((multiple-cursors "1.2.1"))
;; Keywords: editing, cursors
;;; Commentary:
;;
;; This library contains functions to make multiple-cursors interact
;; with rectangle selection.
;;
;; Suggested key bindings are as follows:
;;
;; (define-key rectangle-mark-mode-map (kbd "C-. C-,") 'mc/rect-rectangle-to-multiple-cursors)
;;; Code:
(require 'cl)
(require 'multiple-cursors-core)
;;;###autoload
(defun mc/rect-rectangle-to-multiple-cursors (start end)
"Turn rectangle-mark-mode into multiple-cursors mode, keeping selections."
(interactive "*r")
(let* ((current-line (line-beginning-position))
(reversed (= (current-column)
(min
(save-excursion
(goto-char end)
(current-column))
(save-excursion
(goto-char start)
(current-column)))))
(mark-row `(lambda (startcol endcol)
(let ((markcol ,(if reversed 'endcol 'startcol))
(pointcol ,(if reversed 'startcol 'endcol)))
(move-to-column markcol)
(push-mark (point))
(move-to-column pointcol)
(setq transient-mark-mode (cons 'only transient-mark-mode))
(activate-mark)
(setq deactivate-mark nil)))))
(apply-on-rectangle
'(lambda (startcol endcol)
(if (= (point) current-line)
(funcall mark-row startcol endcol)
(mc/save-excursion
(funcall mark-row startcol endcol)
(mc/create-fake-cursor-at-point))))
start end)
(mc/maybe-multiple-cursors-mode)))
(add-to-list 'mc--default-cmds-to-run-once 'mc/rect-rectangle-to-multiple-cursors)
(provide 'mc-rect)
;;; mc-rect.el ends here

View File

@ -0,0 +1,82 @@
;;; mc-remove.el --- Functions to remove cursors in multiple-cursors mode.
;; Copyright (c) 2013-2015 Akinori MUSHA
;;
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;; SUCH DAMAGE.
;; Author: Akinori MUSHA <knu@iDaemons.org>
;; URL: https://github.com/knu/mc-extras.el
;; Created: 12 Jul 2013
;; Package-Requires: ((multiple-cursors "1.2.1"))
;; Keywords: editing, cursors
;;; Commentary:
;;
;; This library contains functions to remove cursors in
;; multiple-cursors mode.
;;
;; Suggested key bindings are as follows:
;;
;; (define-key mc/keymap (kbd "C-. C-d") 'mc/remove-current-cursor)
;; (define-key mc/keymap (kbd "C-. d") 'mc/remove-duplicated-cursors)
;;; Code:
(require 'cl)
(require 'multiple-cursors-core)
;;;###autoload
(defun mc/remove-current-cursor ()
"Remove the current cursor by replacing the next fake cursor with the real cursor."
(interactive)
(let ((next-cursor
(or (mc/next-fake-cursor-after-point)
(mc/prev-fake-cursor-before-point)
(error "This is the only cursor."))))
(mapc 'mc/remove-fake-cursor
(remove-if-not 'mc/fake-cursor-p
(overlays-at (point))))
(mc/pop-state-from-overlay next-cursor)))
(add-to-list 'mc--default-cmds-to-run-once 'mc/remove-current-cursor)
;;;###autoload
(defun mc/remove-duplicated-cursors ()
"Remove duplicated fake cursors, including ones that overlap the real cursor."
(interactive)
(mapc 'mc/remove-fake-cursor
(loop with seen = (list (point))
for cursor in (mc/all-fake-cursors)
for start = (overlay-start cursor)
append
(if (loop for pos in seen thereis (= pos start))
(list cursor)
(setq seen (cons start seen))
nil))))
(add-to-list 'mc--default-cmds-to-run-once 'mc/remove-duplicated-cursors)
(provide 'mc-remove)
;;; mc-remove.el ends here

View File

@ -0,0 +1,38 @@
;;; org-jekyll-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "org-jekyll" "org-jekyll.el" (22505 22508 389691
;;;;;; 181000))
;;; Generated autoloads from org-jekyll.el
(autoload 'org-jekyll-export-current-entry "org-jekyll" "\
\(fn)" t nil)
(autoload 'org-jekyll-export-blog "org-jekyll" "\
Export all entries in project files that have a :blog: keyword
and an :on: datestamp. Property drawers are exported as
front-matters, outline entry title is the exported document
title.
\(fn)" t nil)
(autoload 'org-jekyll-export-project "org-jekyll" "\
Export all entries in project files that have a :blog: keyword
and an :on: datestamp. Property drawers are exported as
front-matters, outline entry title is the exported document
title.
\(fn PROJECT-NAME)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; org-jekyll-autoloads.el ends here

View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "org-jekyll" "20130508.239" "Export jekyll-ready posts form org-mode entries" '((org "8.0")) :url "http://juanreyero.com/open/org-jekyll/" :keywords '("hypermedia"))

View File

@ -0,0 +1,257 @@
;;; org-jekyll.el --- Export jekyll-ready posts form org-mode entries
;;;
;;; Author: Juan Reyero
;;; Version: 0.4
;; Package-Version: 20130508.239
;;; Keywords: hypermedia
;;; Package-Requires: ((org "8.0"))
;;; Homepage: http://juanreyero.com/open/org-jekyll/
;;; Repository: http://github.com/juanre/org-jekyll
;;; Public clone: git://github.com/juanre/org-jekyll.git
;;;
;;; Commentary:
;;;
;;; Extract subtrees from your org-publish project files that have
;;; a :blog: keyword and an :on: property with a timestamp, and
;;; export them to a subdirectory _posts of your project's publishing
;;; directory in the year-month-day-title.html format that Jekyll
;;; expects. Properties are passed over as yaml front-matter in the
;;; exported files. The title of the subtree is the title of the
;;; entry. The title of the post is a link to the post's page.
;;;
;;; Look at http://orgmode.org/worg/org-tutorials/org-jekyll.html for
;;; more info on how to integrate org-mode with Jekyll, and for the
;;; inspiration of the main function down there.
;;;
;;; Code:
;;(require 'ox-html)
(defvar org-jekyll-category nil
"Specify a property which, if defined in the entry, is used as
a category: the post is written to category/_posts. Ignored if
nil. Use \"lang\" if you want to send posts in different
languages to different directories.")
(defvar org-jekyll-lang-subdirs nil
"Make it an assoc list indexed by language if you want to
bypass the category subdir definition and build blog subdirs per
language.")
(defvar org-jekyll-localize-dir nil
"If non-nil and the lang property is set in the entry,
org-jekyll will look for a lang.yml file in this directory and
include it in the front matter of the exported entry.")
(defvar org-jekyll-new-buffers nil
"Buffers created to visit org-publish project files looking for blog posts.")
(defun org-jekyll-publish-dir (project &optional category)
"Where does the project go, by default a :blog-publishing-directory
entry in the org-publish-project-alist."
(princ category)
(if org-jekyll-lang-subdirs
(let ((pdir (plist-get (cdr project) :blog-publishing-directory))
(langdir (cdr (assoc category org-jekyll-lang-subdirs))))
(if langdir
(concat pdir (cdr (assoc category org-jekyll-lang-subdirs))
"_posts/")
(let ((ppdir (plist-get (cdr project) :blog-publishing-directory)))
(unless ppdir
(setq ppdir (plist-get (cdr project) :publishing-directory)))
(concat ppdir
(if category (concat category "/") "")
"_posts/"))))
(let ((pdir (plist-get (cdr project) :blog-publishing-directory)))
(unless pdir
(setq pdir (plist-get (cdr project) :publishing-directory)))
(concat pdir
(if category (concat category "/") "")
"_posts/"))))
(defun org-jekyll-site-root (project)
"Site root, like http://yoursite.com, from which blog
permalinks follow. Needed to replace entry titles with
permalinks that RSS agregators and google buzz know how to
follow. Looks for a :site-root entry in the org-publish-project-alist."
(or (plist-get (cdr project) :site-root)
""))
(defun org-get-jekyll-file-buffer (file)
"Get a buffer visiting FILE. If the buffer needs to be
created, add it to the list of buffers which might be released
later. Copied from org-get-agenda-file-buffer, and modified
the list that holds buffers to release."
(let ((buf (org-find-base-buffer-visiting file)))
(if buf
buf
(progn (setq buf (find-file-noselect file))
(if buf (push buf org-jekyll-new-buffers))
buf))))
(defun org-jekyll-slurp-yaml (fname)
(remove "---" (if (file-exists-p fname)
(split-string (with-temp-buffer
(insert-file-contents fname)
(buffer-string))
"\n" t))))
(defun ensure-directories-exist (fname)
(let ((dir (file-name-directory fname)))
(unless (file-accessible-directory-p dir)
(make-directory dir t)))
fname)
(defun org-jekyll-sanitize-string (str project)
(if (plist-get (cdr project) :jekyll-sanitize-permalinks)
(progn (setq str (downcase str))
(dolist (c '(("á" . "a")
("é" . "e")
("í" . "i")
("ó" . "o")
("ú" . "u")
("à" . "a")
("è" . "e")
("ì" . "i")
("ò" . "o")
("ù" . "u")
("ñ" . "n")
("ç" . "s")
("\\$" . "S")
("" . "E")))
(setq str (replace-regexp-in-string (car c) (cdr c) str)))
(replace-regexp-in-string "[^abcdefghijklmnopqrstuvwxyz-]" ""
(replace-regexp-in-string " +" "-" str)))
str))
(defun org-jekyll-export-entry (project)
(let* ((props (org-entry-properties nil 'standard))
(time (cdr (or (assoc "on" props)
(assoc "ON" props))))
(lang (cdr (or (assoc "lang" props)
(assoc "LANG" props))))
(category (if org-jekyll-category
(cdr (assoc org-jekyll-category props))
nil))
(yaml-front-matter (copy-alist props)))
(unless (assoc "layout" yaml-front-matter)
(push '("layout" . "post") yaml-front-matter))
(when time
(let* ((heading (org-get-heading t))
(title (replace-regexp-in-string "[:=\(\)\?]" ""
(replace-regexp-in-string
"[ \t]" "-" heading)))
(str-time (and (string-match "\\([[:digit:]\-]+\\) " time)
(match-string 1 time)))
(to-file (format "%s-%s.html" str-time
(org-jekyll-sanitize-string title project)))
(org-buffer (current-buffer))
(yaml-front-matter (cons (cons "title" heading)
yaml-front-matter))
html)
(org-narrow-to-subtree)
(let ((level (- (org-reduced-level (org-outline-level)) 1))
(top-level org-html-toplevel-hlevel)
(contents (buffer-substring (point-min) (point-max)))
(site-root (org-jekyll-site-root project)))
;; Without the promotion the header with which the headline
;; is exported depends on the level. With the promotion it
;; fails when the entry is not visible (ie, within a folded
;; entry).
(dotimes (n level nil) (org-promote-subtree))
(setq html
(replace-regexp-in-string
(format "<h%d id=\"sec-1\">\\(.+\\)</h%d>"
top-level top-level)
(format
"<h%d id=\"sec-1\"><a href=\"%s{{ page.url }}\">\\1</a></h%d>"
top-level site-root top-level)
(with-current-buffer
(org-html-export-as-html nil t t t
'(:tags nil
:table-of-contents nil))
(buffer-string))))
(set-buffer org-buffer)
(delete-region (point-min) (point-max))
(insert contents)
(save-buffer))
(widen)
(with-temp-file (ensure-directories-exist
(expand-file-name
to-file (org-jekyll-publish-dir project category)))
(when yaml-front-matter
(insert "---\n")
(mapc (lambda (pair)
(insert (format "%s: %s\n" (car pair) (cdr pair))))
yaml-front-matter)
(if (and org-jekyll-localize-dir lang)
(mapc (lambda (line)
(insert (format "%s\n" line)))
(org-jekyll-slurp-yaml (concat org-jekyll-localize-dir
lang ".yml"))))
(insert "---\n\n"))
(insert html))))))
; Evtl. needed to keep compiler happy:
(declare-function org-publish-get-project-from-filename "org-publish"
(filename &optional up))
;;;###autoload
(defun org-jekyll-export-current-entry ()
(interactive)
(save-excursion
(let ((project (org-publish-get-project-from-filename buffer-file-name)))
(org-back-to-heading t)
(org-jekyll-export-entry project))))
;;;###autoload
(defun org-jekyll-export-blog ()
"Export all entries in project files that have a :blog: keyword
and an :on: datestamp. Property drawers are exported as
front-matters, outline entry title is the exported document
title. "
(interactive)
(save-excursion
(setq org-jekyll-new-buffers nil)
(let ((project (org-publish-get-project-from-filename (buffer-file-name))))
(mapc
(lambda (jfile)
(if (string= (file-name-extension jfile) "org")
(with-current-buffer (org-get-jekyll-file-buffer jfile)
;; It fails for non-visible entries, CONTENT visibility
;; mode ensures that all of them are visible.
(message (concat "org-jekyll: publishing " jfile ))
(org-content)
(org-map-entries (lambda () (org-jekyll-export-entry project))
"blog|BLOG"))))
(org-publish-get-base-files project)))
(org-release-buffers org-jekyll-new-buffers)))
;;;###autoload
(defun org-jekyll-export-project (project-name)
"Export all entries in project files that have a :blog: keyword
and an :on: datestamp. Property drawers are exported as
front-matters, outline entry title is the exported document
title. "
(interactive)
(save-excursion
(setq org-jekyll-new-buffers nil)
(let ((project (assoc project-name org-publish-project-alist)))
(mapc
(lambda (jfile)
(if (string= (file-name-extension jfile) (plist-get (cdr project)
:base-extension))
(with-current-buffer (org-get-jekyll-file-buffer jfile)
;; It fails for non-visible entries, CONTENT visibility
;; mode ensures that all of them are visible.
(message (concat "org-jekyll: publishing " jfile ))
(org-content)
(org-map-entries (lambda () (org-jekyll-export-entry project))
"blog|BLOG"))))
(org-publish-get-base-files project)))
(org-release-buffers org-jekyll-new-buffers)))
(provide 'org-jekyll)
;;; org-jekyll.el ends here

View File

@ -0,0 +1,6 @@
HACKING
flower.el
xpm-compose.el
xpm-ops.el
xpm-palette.el
xpm-ui.el

170
elpa/xpm-1.0.3/ChangeLog Normal file
View File

@ -0,0 +1,170 @@
2014-06-13 Thien-Thi Nguyen <ttn@gnu.org>
[xpm] Release: 1.0.3
* packages/xpm/xpm.el [Version]: Bump to "1.0.3".
2014-06-13 Thien-Thi Nguyen <ttn@gnu.org>
[xpm int] Make wip more visible; inhibit their distribution.
* packages/xpm/xpm-compose.el: New file.
* packages/xpm/xpm-ops.el: New file.
* packages/xpm/xpm-palette.el: New file.
* packages/xpm/xpm-ui.el: New file.
* packages/xpm/.elpaignore: Update.
2014-06-13 Thien-Thi Nguyen <ttn@gnu.org>
[xpm maint] Don't mention HACKING in Commentary; nfc.
2014-06-13 Thien-Thi Nguyen <ttn@gnu.org>
[xpm] Clarify function descriptions.
* packages/xpm/xpm.el (xpm-grok)
(xpm-generate-buffer, xpm-put-points): ...here.
* packages/xpm/xpm-m2z.el (xpm-m2z-ellipse): ...here.
2014-06-13 Thien-Thi Nguyen <ttn@gnu.org>
[xpm int] Use cl-assert, not assert; drop cl requirement.
* packages/xpm/xpm-m2z.el: No longer require cl.
(xpm-m2z-ellipse): Combine center coord components
integerp check; use cl-assert instead of assert.
2014-06-13 Thien-Thi Nguyen <ttn@gnu.org>
[xpm int] Use cl-* names; drop cl requirement.
* packages/xpm/xpm.el: No longer require cl.
(xpm-grok): Use cl-list*, not list*.
(xpm-raster): Use cl-rotatef, not rotatef.
2014-06-13 Thien-Thi Nguyen <ttn@gnu.org>
[xpm int] Use cl-destructuring-bind, not destructuring-bind.
* packages/xpm/xpm.el (xpm-grok, xpm-raster): ...here.
2014-06-13 Thien-Thi Nguyen <ttn@gnu.org>
[xpm] Document disabled undo.
* packages/xpm/xpm.el (xpm-generate-buffer): ...in this func.
2014-06-13 Thien-Thi Nguyen <ttn@gnu.org>
[xpm int] Whitespace munging; nfc.
Somehow the keyboard macro used to do s/loop/cl-loop/g a moment ago
introduced extra newlines in some places...
2014-06-13 Thien-Thi Nguyen <ttn@gnu.org>
[xpm] Fix typo.
* packages/xpm/xpm.el (xpm-put-points): ...here.
2014-06-13 Thien-Thi Nguyen <ttn@gnu.org>
[xpm maint] Add Author, Maintainer headers; nfc.
2014-06-13 Thien-Thi Nguyen <ttn@gnu.org>
[xpm int] Add abstraction: form
* packages/xpm/flower.el (flower form): New internal func.
2014-06-13 Thien-Thi Nguyen <ttn@gnu.org>
[xpm int] Use cl-loop instead of loop.
* packages/xpm/flower.el: ...throughout.
* packages/xpm/xpm-m2z.el: Likewise.
* packages/xpm/xpm.el: Likewise.
2014-05-30 Thien-Thi Nguyen <ttn@gnu.org>
[xpm] Release: 1.0.2
* packages/xpm/xpm.el [Version]: Bump to "1.0.2".
2014-05-30 Thien-Thi Nguyen <ttn@gnu.org>
[xpm] Add homepage URL; drop other links.
* packages/xpm/xpm.el [URL]: New header.
[Commentary]: Remove the HACKING and Tip Jar links.
2014-05-21 Thien-Thi Nguyen <ttn@gnu.org>
[xpm] Release: 1.0.1
* packages/xpm/xpm.el [Version]: Bump to "1.0.1".
2014-05-21 Thien-Thi Nguyen <ttn@gnu.org>
[xpm] Declare package keywords.
* packages/xpm/xpm.el [Keywords]: New header.
2014-05-21 Thien-Thi Nguyen <ttn@gnu.org>
[xpm] Fix byte-compilation bugs.
* packages/xpm/xpm-m2z.el: Require cl when compiling.
* packages/xpm/xpm.el: Likewise. Also, add "manual" autoload for
image-toggle-display.
2014-05-19 Thien-Thi Nguyen <ttn@gnu.org>
[xpm maint] Add some perf ideas to HACKING; nfc.
2014-05-18 Thien-Thi Nguyen <ttn@gnu.org>
[xpm] Release: 1.0.0
* packages/xpm/xpm.el [Version]: Bump to "1.0.0".
2014-05-18 Thien-Thi Nguyen <ttn@gnu.org>
[xpm int] Doc fix.
* packages/xpm/xpm-m2z.el (xpm-m2z-ellipse): ...here.
2014-05-18 Thien-Thi Nguyen <ttn@gnu.org>
[xpm int] Don't bother w/ rows outside form bb.
* packages/xpm/xpm.el (xpm-raster): ...here.
2014-05-18 Thien-Thi Nguyen <ttn@gnu.org>
[xpm int] Compute bool-vector length exactly once.
* packages/xpm/xpm.el (xpm-raster): ...here.
2014-05-18 Thien-Thi Nguyen <ttn@gnu.org>
[xpm maint] Add HACKING; nfc.
2014-05-17 Thien-Thi Nguyen <ttn@gnu.org>
[xpm maint] Add debugging aid Emacs Lisp file.
* packages/xpm/flower.el: New file.
* packages/xpm/.elpaignore: Update.
2014-05-17 Thien-Thi Nguyen <ttn@gnu.org>
[xpm] Add Emacs Lisp files.
* packages/xpm/xpm.el: New file.
* packages/xpm/xpm-m2z.el: New file.
2014-05-16 Thien-Thi Nguyen <ttn@gnu.org>
[xpm maint] Add .elpaignore and NEWS files; nfc.

27
elpa/xpm-1.0.3/NEWS Normal file
View File

@ -0,0 +1,27 @@
NEWS for xpm.el (et al)
See the end for copying conditions.
- 1.0.3 | 2014-06-13
- improved docstrings
- 1.0.2 | 2014-05-30
- new homepage: http://www.gnuvola.org/software/xpm/
- 1.0.1 | 2014-05-21
- byte-compilation bugfix
- 1.0.0 | 2014-05-18
- initial release
Local Variables:
mode: outline
outline-regexp: "\\([ ][ ]\\)*- "
End:
_____________________________________________________________________
Copyright (C) 2014 Free Software Foundation, Inc.
Copying and distribution of this file, with or without modification,
are permitted provided the copyright notice and this notice are preserved.

View File

@ -0,0 +1,90 @@
;;; xpm-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "xpm" "xpm.el" (22505 22832 957650 831000))
;;; Generated autoloads from xpm.el
(autoload 'xpm-grok "xpm" "\
Analyze buffer and prepare internal data structures.
When called as a command, display in the echo area a
summary of image dimensions, cpp and palette.
Set buffer-local variable `xpm--gg' and return its value.
Normally, preparation includes making certain parts of the
buffer intangible. Optional arg SIMPLE non-nil inhibits that.
\(fn &optional SIMPLE)" t nil)
(autoload 'xpm-generate-buffer "xpm" "\
Return a new buffer in XPM image format.
In this buffer, undo is disabled (see `buffer-enable-undo').
NAME is the buffer and XPM name. For best interoperation
with other programs, NAME should be a valid C identifier.
WIDTH, HEIGHT and CPP are integers that specify the image
width, height and characters/pixel, respectively.
PALETTE is an alist ((PX . COLOR) ...), where PX is either
a character or string of length CPP, and COLOR is a string.
If COLOR includes a space, it is included directly,
otherwise it is automatically prefixed with \"c \".
For example, to produce palette fragment:
\"X c blue\",
\"Y s border c green\",
you can specify PALETTE as:
((?X . \"blue\")
(?Y . \"s border c green\"))
This example presumes CPP is 1.
\(fn NAME WIDTH HEIGHT CPP PALETTE)" nil nil)
;;;***
;;;### (autoloads nil "xpm-m2z" "xpm-m2z.el" (22505 22832 961650
;;;;;; 831000))
;;; Generated autoloads from xpm-m2z.el
(autoload 'xpm-m2z-ellipse "xpm-m2z" "\
Return an ellipse with center (CX,CY) and radii RX and RY.
Both CX and CY must be non-integer, preferably
precisely half-way between integers, e.g., 13/2 => 6.5.
The ellipse is represented as a list of unique XPM coords,
with the \"span\", i.e., (- HI LO -1), of the extreme X and Y
components equal to twice the rounded (to integer) value of
RX and RY, respectively. For example:
(xpm-m2z-ellipse 1.5 3.5 5.8 4.2)
=> list of length 20
min max span
X -3 6 10
Y 0 7 8
The span is always an even number. As a special case, if the
absolute value of RX or RY is less than 1, the value is nil.
\(fn CX CY RX RY)" nil nil)
(autoload 'xpm-m2z-circle "xpm-m2z" "\
Like `xpm-m2z-ellipse' with a shared radius RADIUS.
\(fn CX CY RADIUS)" nil nil)
;;;***
;;;### (autoloads nil nil ("xpm-pkg.el") (22505 22832 973650 829000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; xpm-autoloads.el ends here

101
elpa/xpm-1.0.3/xpm-m2z.el Normal file
View File

@ -0,0 +1,101 @@
;;; xpm-m2z.el --- (% span 2) => 0 -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;; Maintainer: Thien-Thi Nguyen <ttn@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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Although artist.el is wonderful, it doesn't (yet) do subpixel-centered
;; circles (or ellipses). Those shapes are always rendered with an odd
;; "span", i.e., (% (- HI LO -1) 2) => 1, since the origin is *on* an
;; integral coordinate (i.e., intersection of row and column).
;;
;; This file provides funcs `xpm-m2z-ellipse' and `xpm-m2z-circle' to
;; locally rectify the current situation ("m2z" means "modulo 2 => 0"),
;; with the hope that eventually a generalization can be worked back
;; into artist.el, perhaps as a subpixel-center minor mode of some sort.
;;; Code:
(require 'artist)
(require 'cl-lib)
;;;###autoload
(defun xpm-m2z-ellipse (cx cy rx ry)
"Return an ellipse with center (CX,CY) and radii RX and RY.
Both CX and CY must be non-integer, preferably
precisely half-way between integers, e.g., 13/2 => 6.5.
The ellipse is represented as a list of unique XPM coords,
with the \"span\", i.e., (- HI LO -1), of the extreme X and Y
components equal to twice the rounded (to integer) value of
RX and RY, respectively. For example:
(xpm-m2z-ellipse 1.5 3.5 5.8 4.2)
=> list of length 20
min max span
X -3 6 10
Y 0 7 8
The span is always an even number. As a special case, if the
absolute value of RX or RY is less than 1, the value is nil."
(cl-assert (and (not (integerp cx))
(not (integerp cy)))
nil "Integer component in center coordinate: (%S,%S)"
cx cy)
(unless (or (> 1 (abs rx))
(> 1 (abs ry)))
(cl-flet*
((offset (coord idx)
(- (aref coord idx) 0.5))
(normal (coord)
;; flip axes: artist (ROW,COL) to xpm (X,Y)
(cons
(offset coord 1) ; 1: COL -> car: X
(offset coord 0))) ; 0: ROW -> cdr: Y
(placed (origin scale n)
(truncate (+ origin (* scale n))))
(orient (coords quadrant)
(cl-loop
with (sx . sy) = quadrant
for (x . y) in coords
collect (cons (placed cx sx x)
(placed cy sy y)))))
(delete-dups
(cl-loop
with coords = (mapcar
#'normal
(artist-ellipse-generate-quadrant
;; Specify row first; artist.el is like that.
;; (That's why normal does what it does...)
ry rx))
for quadrant ; these are in order: I-IV
in '(( 1 . 1) ; todo: "manually" remove single
(-1 . 1) ; (border point) overlaps;
(-1 . -1) ; avoid delete-dups
( 1 . -1))
append (orient coords quadrant))))))
;;;###autoload
(defun xpm-m2z-circle (cx cy radius)
"Like `xpm-m2z-ellipse' with a shared radius RADIUS."
(xpm-m2z-ellipse cx cy radius radius))
(provide 'xpm-m2z)
;;; xpm-m2z.el ends here

View File

@ -0,0 +1,2 @@
;; Generated package description from xpm.el
(define-package "xpm" "1.0.3" "edit XPM images" 'nil :url "http://www.gnuvola.org/software/xpm/" :keywords '("multimedia" "xpm"))

437
elpa/xpm-1.0.3/xpm.el Normal file
View File

@ -0,0 +1,437 @@
;;; xpm.el --- edit XPM images -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
;; Version: 1.0.3
;; Keywords: multimedia, xpm
;; URL: http://www.gnuvola.org/software/xpm/
;; 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:
;; This package makes editing XPM images easy (and maybe fun).
;; Editing is done directly on the (textual) image format,
;; for maximal cohesion w/ the Emacs Way.
;;
;; Coordinates have the form (X . Y), with X from 0 to (width-1),
;; and Y from 0 to (height-1), inclusive, in the 4th quadrant;
;; i.e., X grows left to right, Y top to bottom, origin top-left.
;;
;; (0,0) … (width-1,0)
;; ⋮ ⋮
;; (0,height-1) … (width-1,height-1)
;;
;; In xpm.el (et al), "px" stands for "pixel", a non-empty string
;; in the external representation of the image. The px length is
;; the image's "cpp" (characters per pixel). The "palette" is a
;; set of associations between a px and its "color", which is an
;; alist with symbolic TYPE and and string CVALUE. TYPE is one of:
;;
;; c -- color (most common)
;; s -- symbolic
;; g -- grayscale
;; g4 -- four-level grayscale
;; m -- monochrome
;;
;; and CVALUE is a string, e.g., "blue" or "#0000FF". Two images
;; are "congruent" if their width, height and cpp are identical.
;;
;; This package was originally conceived for non-interactive use,
;; so its design is spartan at the core. However, we plan to add
;; a XPM mode in a future release; monitor the homepage for updates.
;;
;; For now, the features (w/ correspondingly-named files) are:
;; - xpm -- edit XPM images
;; - xpm-m2z -- ellipse/circle w/ fractional center
;;
;; Some things are autoloaded. Which ones? Use the source, Luke!
;; (Alternatively, just ask on help-gnu-emacs (at gnu dot org).)
;;; Code:
(require 'cl-lib)
(autoload 'image-toggle-display "image-mode" t) ; hmm is this TRT?
(defvar xpm-raster-inhibit-continuity-optimization nil
"Non-nil disables a heuristic in `xpm-raster' filling.
Normally, if you pass a well-formed (closed, no edge crossings)
shape to `xpm-raster', then you can ignore this variable.")
(cl-defstruct (xpm--gg ; gathered gleanings
(:type vector) ; no :named so no predicate
(:conc-name xpm--)
(:constructor xpm--make-gg)
(:copier xpm--copy-gg))
(w :read-only t) (h :read-only t) (cpp :read-only t)
pinfo ; (MARKER . HASH-TABLE)
(origin :read-only t)
(y-mult :read-only t)
flags)
(defvar xpm--gg nil
"Various bits for xpm.el (et al) internal use.")
;;;###autoload
(defun xpm-grok (&optional simple)
"Analyze buffer and prepare internal data structures.
When called as a command, display in the echo area a
summary of image dimensions, cpp and palette.
Set buffer-local variable `xpm--gg' and return its value.
Normally, preparation includes making certain parts of the
buffer intangible. Optional arg SIMPLE non-nil inhibits that."
(interactive)
(unless (or
;; easy
(and (boundp 'image-type)
(eq 'xpm image-type))
;; hard
(save-excursion
(goto-char (point-min))
(string= "/* XPM */"
(buffer-substring-no-properties
(point) (line-end-position)))))
(error "Buffer not an XPM image"))
(when (eq 'image-mode major-mode)
(image-toggle-display))
(let ((ht (make-hash-table :test 'equal))
pinfo gg)
(save-excursion
(goto-char (point-min))
(search-forward "{")
(skip-chars-forward "^\"")
(cl-destructuring-bind (w h nc cpp &rest rest)
(read (format "(%s)" (read (current-buffer))))
(ignore rest) ; for now
(forward-line 1)
(setq pinfo (point-marker))
(cl-loop
repeat nc
do (let ((p (1+ (point))))
(puthash (buffer-substring-no-properties
p (+ p cpp))
;; Don't bother w/ CVALUE for now.
t ht)
(forward-line 1)))
(setq pinfo (cons pinfo ht))
(skip-chars-forward "^\"")
(forward-char 1)
(set (make-local-variable 'xpm--gg)
(setq gg (xpm--make-gg
:w w :h h :cpp cpp
:pinfo pinfo
:origin (point-marker)
:y-mult (+ 4 (* cpp w)))))
(unless simple
(let ((mod (buffer-modified-p))
(inhibit-read-only t))
(cl-flet
((suppress (span &rest more)
(let ((p (point)))
(add-text-properties
(- p span) p (cl-list*
'intangible t
more)))))
(suppress 1)
(cl-loop
repeat h
do (progn (forward-char (+ 4 (* w cpp)))
(suppress 4)))
(suppress 2 'display "\n")
(push 'intangible-sides (xpm--flags gg)))
(set-buffer-modified-p mod)))
(when (called-interactively-p 'interactive)
(message "%dx%d, %d cpp, %d colors in palette"
w h cpp (hash-table-count ht)))))
gg))
(defun xpm--gate ()
(or xpm--gg
(xpm-grok)
(error "Sorry, xpm confused")))
(cl-defmacro xpm--w/gg (names from &body body)
(declare (indent 2))
`(let* ((gg ,from)
,@(mapcar (lambda (name)
`(,name (,(intern (format "xpm--%s" name))
gg)))
`,names))
,@body))
;;;###autoload
(defun xpm-generate-buffer (name width height cpp palette)
"Return a new buffer in XPM image format.
In this buffer, undo is disabled (see `buffer-enable-undo').
NAME is the buffer and XPM name. For best interoperation
with other programs, NAME should be a valid C identifier.
WIDTH, HEIGHT and CPP are integers that specify the image
width, height and characters/pixel, respectively.
PALETTE is an alist ((PX . COLOR) ...), where PX is either
a character or string of length CPP, and COLOR is a string.
If COLOR includes a space, it is included directly,
otherwise it is automatically prefixed with \"c \".
For example, to produce palette fragment:
\"X c blue\",
\"Y s border c green\",
you can specify PALETTE as:
((?X . \"blue\")
(?Y . \"s border c green\"))
This example presumes CPP is 1."
(let ((buf (generate-new-buffer name)))
(with-current-buffer buf
(buffer-disable-undo)
(cl-flet
((yep (s &rest args)
(insert (apply 'format s args) "\n")))
(yep "/* XPM */")
(yep "static char * %s[] = {" name)
(yep "\"%d %d %d %d\"," width height (length palette) cpp)
(cl-loop
for (px . color) in palette
do (yep "\"%s %s\","
(if (characterp px)
(string px)
px)
(if (string-match " " color)
color
(concat "c " color))))
(cl-loop
with s = (format "%S,\n" (make-string (* cpp width) 32))
repeat height
do (insert s))
(delete-char -2)
(yep "};")
(xpm-grok t)))
buf))
(defun xpm-put-points (px x y)
"Place PX at coordinate(s) (X,Y).
If both X and Y are vectors of length N, then place N points
using the pairwise vector elements. If one of X or Y is a vector
of length N and the other component is an integer, then pair the
vector elements with the integer component and place N points.
If one of X or Y is a pair (LOW . HIGH), take it to be equivalent
to specfiying a vector [LOW ... HIGH]. For example, (3 . 8) is
equivalent to [3 4 5 6 7 8]. If one component is a pair, the
other must be an integer -- the case where both X and Y are pairs
is not supported.
Silently ignore out-of-range coordinates."
(xpm--w/gg (w h cpp origin y-mult) (xpm--gate)
(when (and (stringp px) (= 1 cpp))
(setq px (aref px 0)))
(cl-flet*
((out (col row)
(or (> 0 col) (<= w col)
(> 0 row) (<= h row)))
(pos (col row)
(goto-char (+ origin (* cpp col) (* y-mult row))))
(jam (col row len)
(pos col row)
(insert-char px len)
(delete-char len))
(rep (col row len)
(pos col row)
(if (= 1 cpp)
(insert-char px len)
(cl-loop
repeat len
do (insert px)))
(delete-char (* cpp len)))
(zow (col row)
(unless (out col row)
(rep col row 1))))
(pcase (cons (type-of x) (type-of y))
(`(cons . integer) (let* ((beg (max 0 (car x)))
(end (min (1- w) (cdr x)))
(len (- end beg -1)))
(unless (or (> 1 len)
(out beg y))
(if (< 1 cpp)
;; general
(rep beg y len)
;; fast(er) path
(when (stringp px)
(setq px (aref px 0)))
(jam beg y len)))))
(`(integer . cons) (cl-loop
for two from (car y) to (cdr y)
do (zow x two)))
(`(vector . integer) (cl-loop
for one across x
do (zow one y)))
(`(integer . vector) (cl-loop
for two across y
do (zow x two)))
(`(vector . vector) (cl-loop
for one across x
for two across y
do (zow one two)))
(`(integer . integer) (zow x y))
(_ (error "Bad coordinates: X %S, Y %S"
x y))))))
(defun xpm-raster (form edge &optional fill)
"Rasterize FORM with EDGE pixel (character or string).
FORM is a list of coordinates that comprise a closed shape.
Optional arg FILL specifies a fill pixel, or t to fill with EDGE.
If FORM is not closed or has inopportune vertical-facing
concavities, filling might give bad results. For those cases,
see variable `xpm-raster-inhibit-continuity-optimization'."
(when (eq t fill)
(setq fill edge))
(xpm--w/gg (h) (xpm--gate)
(let* ((v (make-vector h nil))
(x-min (caar form)) ; (maybe) todo: xpm--bb
(x-max x-min)
(y-min (cdar form))
(y-max y-min)
(use-in-map (not xpm-raster-inhibit-continuity-optimization))
;; These are bool-vectors to keep track of both internal
;; (filled and its "next" (double-buffering)) and external
;; state, on a line-by-line basis.
int nin
ext)
(cl-loop
for (x . y) in form
do (setq x-min (min x-min x)
x-max (max x-max x)
y-min (min y-min y)
y-max (max y-max y))
unless (or (> 0 y)
(<= h y))
do (push x (aref v y)))
(cl-flet
((span (lo hi)
(- hi lo -1))
(norm (n)
(- n x-min))
(rset (bv start len value)
(cl-loop
for i from start repeat len
do (aset bv i value)))
(scan (bv start len yes no)
(cl-loop
for i from start repeat len
when (aref bv i)
return yes
finally return no)))
(let ((len (span x-min x-max)))
(setq int (make-bool-vector len nil)
nin (make-bool-vector len nil)
ext (make-bool-vector len t)))
(cl-loop
with (ls
in-map-ok
in-map)
for y from (1- y-min) to y-max
when (setq ls (and (< -1 y)
(> h y)
(sort (aref v y) '>)))
do (cl-loop
with acc = (list (car ls))
for maybe in (cdr ls)
do (let* ((was (car acc))
(already (consp was)))
(cond ((/= (1- (if already
(car was)
was))
maybe)
(push maybe acc))
(already
(setcar was maybe))
(t
(setcar acc (cons maybe was)))))
finally do
(when fill
(let ((was (length in-map))
(now (length acc)))
(unless (setq in-map-ok
(and (= was now)
;; heuristic: Avoid being fooled
;; by simulataneous crossings.
(cl-evenp was)))
(setq in-map (make-bool-vector now nil)))))
finally do
(cl-loop
with (x rangep beg nx end len nb in)
for gap from 0
while acc
do (setq x (pop acc))
do (xpm-put-points edge x y)
do (when fill
(setq rangep (consp x))
(when (zerop gap)
(rset ext 0 (norm (if rangep
(car x)
x))
t))
(if rangep
(cl-destructuring-bind (b . e) x
(rset ext (norm b) (span b e) nil))
(aset ext (norm x) nil))
(when acc
(setq beg (1+ (if rangep
(cdr x)
x))
nx (car acc)
end (1- (if (consp nx)
(car nx)
nx))
len (span beg end)
nb (norm beg)
in (cond ((and use-in-map in-map-ok)
(aref in-map gap))
(in (scan int nb len t nil))
(t (scan ext nb len nil t))))
(unless in-map-ok
(aset in-map gap in))
(if (not in)
(rset ext nb len t)
(rset nin nb len t)
(xpm-put-points fill (cons beg end) y))))
finally do (when fill
(cl-rotatef int nin)
(fillarray nin nil)))))))))
(defun xpm-as-xpm (&rest props)
"Return the XPM image (via `create-image') of the buffer.
PROPS are additional image properties to place on
the new XPM. See info node `(elisp) XPM Images'."
(apply 'create-image (buffer-substring-no-properties
(point-min) (point-max))
'xpm t props))
(defun xpm-finish (&rest props)
"Like `xpm-as-xpm', but also kill the buffer afterwards."
(prog1 (apply 'xpm-as-xpm props)
(kill-buffer nil)))
(provide 'xpm)
;;; xpm.el ends here

View File

@ -62,7 +62,7 @@
("e6h" . "http://www.e6h.org/packages/")))) ("e6h" . "http://www.e6h.org/packages/"))))
'(package-selected-packages '(package-selected-packages
(quote (quote
(smart-mode-line-powerline-theme yaml-mode xlicense wakatime-mode vala-mode sass-mode nyan-mode muse markdown-mode mark magit-gh-pulls magit-gerrit json-mode js2-mode jinja2-mode helm-make helm-gtags helm-flyspell helm-ag go-mode gitignore-mode gitconfig-mode git-gutter ggtags fiplr erlang django-mode company-shell company-quickhelp company-c-headers coffee-mode buffer-move ag))) (helm-google helm-projectile helm-spotify helm-swoop helm-unicode id-manager identica-mode mc-extras multiple-cursors electric-spacing flycheck-clojure flycheck-pkg-config focus git-messenger gitconfig github-notifier gnome-calendar gnugo google helm-chrome helm-company helm-flycheck clojure-quick-repls electric-case emamux flycheck drag-stuff django-manage clojure-mode hyde org-jekyll smart-mode-line-powerline-theme yaml-mode xlicense wakatime-mode vala-mode sass-mode nyan-mode muse markdown-mode mark magit-gh-pulls magit-gerrit json-mode js2-mode jinja2-mode helm-make helm-gtags helm-flyspell helm-ag go-mode gitignore-mode gitconfig-mode git-gutter ggtags fiplr erlang django-mode company-shell company-quickhelp company-c-headers coffee-mode buffer-move ag)))
'(safe-local-variable-values '(safe-local-variable-values
(quote (quote
((company-clang-arguments "-I.." "-I/home/polesz/jhbuild/install/include/atk-1.0" "-I/home/polesz/jhbuild/install/include/at-spi-2.0" "-I/home/polesz/jhbuild/install/include/at-spi2-atk/2.0" "-I/home/polesz/jhbuild/install/include/cairo" "-I/home/polesz/jhbuild/install/include/gdk-pixbuf-2.0" "-I/home/polesz/jhbuild/install/include/gio-unix-2.0/" "-I/home/polesz/jhbuild/install/include/glib-2.0" "-I/home/polesz/jhbuild/install/include/gtk-3.0" "-I/home/polesz/jhbuild/install/include/harfbuzz" "-I/home/polesz/jhbuild/install/include/libgda-5.0" "-I/home/polesz/jhbuild/install/include/libgda-5.0/libgda" "-I/home/polesz/jhbuild/install/include/librsvg-2.0" "-I/home/polesz/jhbuild/install/include/libsoup-2.4" "-I/home/polesz/jhbuild/install/include/pango-1.0" "-I/home/polesz/jhbuild/install/include/swe-glib" "-I/home/polesz/jhbuild/install/include/webkitgtk-4.0" "-I/home/polesz/jhbuild/install/lib/glib-2.0/include" "-I/usr/include/dbus-1.0" "-I/usr/include/freetype2" "-I/usr/include/libdrm" "-I/usr/include/libpng16" "-I/usr/include/libxml2" "-I/usr/include/pixman-1" "-I/usr/lib64/dbus-1.0/include") ((company-clang-arguments "-I.." "-I/home/polesz/jhbuild/install/include/atk-1.0" "-I/home/polesz/jhbuild/install/include/at-spi-2.0" "-I/home/polesz/jhbuild/install/include/at-spi2-atk/2.0" "-I/home/polesz/jhbuild/install/include/cairo" "-I/home/polesz/jhbuild/install/include/gdk-pixbuf-2.0" "-I/home/polesz/jhbuild/install/include/gio-unix-2.0/" "-I/home/polesz/jhbuild/install/include/glib-2.0" "-I/home/polesz/jhbuild/install/include/gtk-3.0" "-I/home/polesz/jhbuild/install/include/harfbuzz" "-I/home/polesz/jhbuild/install/include/libgda-5.0" "-I/home/polesz/jhbuild/install/include/libgda-5.0/libgda" "-I/home/polesz/jhbuild/install/include/librsvg-2.0" "-I/home/polesz/jhbuild/install/include/libsoup-2.4" "-I/home/polesz/jhbuild/install/include/pango-1.0" "-I/home/polesz/jhbuild/install/include/swe-glib" "-I/home/polesz/jhbuild/install/include/webkitgtk-4.0" "-I/home/polesz/jhbuild/install/lib/glib-2.0/include" "-I/usr/include/dbus-1.0" "-I/usr/include/freetype2" "-I/usr/include/libdrm" "-I/usr/include/libpng16" "-I/usr/include/libxml2" "-I/usr/include/pixman-1" "-I/usr/lib64/dbus-1.0/include")