Install some more packages
This commit is contained in:
parent
b8052b9da2
commit
2df53f2a7a
@ -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
|
@ -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"))
|
510
elpa/ascii-art-to-unicode-1.9/ascii-art-to-unicode.el
Normal file
510
elpa/ascii-art-to-unicode-1.9/ascii-art-to-unicode.el
Normal 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
|
16
elpa/hyde-20160507.2008/hyde-autoloads.el
Normal file
16
elpa/hyde-20160507.2008/hyde-autoloads.el
Normal 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
|
96
elpa/hyde-20160507.2008/hyde-git.el
Normal file
96
elpa/hyde-20160507.2008/hyde-git.el
Normal 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
|
96
elpa/hyde-20160507.2008/hyde-md.el
Normal file
96
elpa/hyde-20160507.2008/hyde-md.el
Normal 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
|
4
elpa/hyde-20160507.2008/hyde-pkg.el
Normal file
4
elpa/hyde-20160507.2008/hyde-pkg.el
Normal 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:
|
524
elpa/hyde-20160507.2008/hyde.el
Normal file
524
elpa/hyde-20160507.2008/hyde.el
Normal 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
|
9
elpa/hyde-20160507.2008/sample-dot-hyde.el
Normal file
9
elpa/hyde-20160507.2008/sample-dot-hyde.el
Normal 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" ""))
|
||||
)
|
||||
|
88
elpa/mc-extras-20150218.234/mc-compare.el
Normal file
88
elpa/mc-extras-20150218.234/mc-compare.el
Normal 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
|
153
elpa/mc-extras-20150218.234/mc-cua.el
Normal file
153
elpa/mc-extras-20150218.234/mc-cua.el
Normal 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
|
109
elpa/mc-extras-20150218.234/mc-extras-autoloads.el
Normal file
109
elpa/mc-extras-20150218.234/mc-extras-autoloads.el
Normal 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
|
7
elpa/mc-extras-20150218.234/mc-extras-pkg.el
Normal file
7
elpa/mc-extras-20150218.234/mc-extras-pkg.el
Normal 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:
|
78
elpa/mc-extras-20150218.234/mc-extras.el
Normal file
78
elpa/mc-extras-20150218.234/mc-extras.el
Normal 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
|
129
elpa/mc-extras-20150218.234/mc-freeze.el
Normal file
129
elpa/mc-extras-20150218.234/mc-freeze.el
Normal 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
|
85
elpa/mc-extras-20150218.234/mc-rect.el
Normal file
85
elpa/mc-extras-20150218.234/mc-rect.el
Normal 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
|
82
elpa/mc-extras-20150218.234/mc-remove.el
Normal file
82
elpa/mc-extras-20150218.234/mc-remove.el
Normal 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
|
38
elpa/org-jekyll-20130508.239/org-jekyll-autoloads.el
Normal file
38
elpa/org-jekyll-20130508.239/org-jekyll-autoloads.el
Normal 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
|
2
elpa/org-jekyll-20130508.239/org-jekyll-pkg.el
Normal file
2
elpa/org-jekyll-20130508.239/org-jekyll-pkg.el
Normal 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"))
|
257
elpa/org-jekyll-20130508.239/org-jekyll.el
Normal file
257
elpa/org-jekyll-20130508.239/org-jekyll.el
Normal 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
|
6
elpa/xpm-1.0.3/.elpaignore
Normal file
6
elpa/xpm-1.0.3/.elpaignore
Normal 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
170
elpa/xpm-1.0.3/ChangeLog
Normal 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
27
elpa/xpm-1.0.3/NEWS
Normal 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.
|
90
elpa/xpm-1.0.3/xpm-autoloads.el
Normal file
90
elpa/xpm-1.0.3/xpm-autoloads.el
Normal 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
101
elpa/xpm-1.0.3/xpm-m2z.el
Normal 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
|
2
elpa/xpm-1.0.3/xpm-pkg.el
Normal file
2
elpa/xpm-1.0.3/xpm-pkg.el
Normal 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
437
elpa/xpm-1.0.3/xpm.el
Normal 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
|
2
init.el
2
init.el
@ -62,7 +62,7 @@
|
||||
("e6h" . "http://www.e6h.org/packages/"))))
|
||||
'(package-selected-packages
|
||||
(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
|
||||
(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")
|
||||
|
Loading…
Reference in New Issue
Block a user