gergely/my-emacs-d
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove some packages

Browse Source 
I never actually used them, and some of them were installed only as
dependencies.
This commit is contained in:
Gergely Polonkai 2016-10-14 12:16:59 +02:00
parent 5feea2e7f0
commit 27a15c5513
120 changed files with 0 additions and 48615 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
elpa/buffer-move-20160615.1103/buffer-move-autoloads.el
View File

@ -1,53 +0,0 @@
;;; buffer-move-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "buffer-move" "buffer-move.el" (22387 29375
;;;;;; 754161 271000))
;;; Generated autoloads from buffer-move.el
(autoload 'buf-move-up "buffer-move" "\
Swap the current buffer and the buffer above the split.
If there is no split, ie now window above the current one, an
error is signaled.
\(fn)" t nil)
(autoload 'buf-move-down "buffer-move" "\
Swap the current buffer and the buffer under the split.
If there is no split, ie now window under the current one, an
error is signaled.
\(fn)" t nil)
(autoload 'buf-move-left "buffer-move" "\
Swap the current buffer and the buffer on the left of the split.
If there is no split, ie now window on the left of the current
one, an error is signaled.
\(fn)" t nil)
(autoload 'buf-move-right "buffer-move" "\
Swap the current buffer and the buffer on the right of the split.
If there is no split, ie now window on the right of the current
one, an error is signaled.
\(fn)" t nil)
(autoload 'buf-move "buffer-move" "\
Begin moving the current buffer to different windows.
Use the arrow keys to move in the desired direction. Pressing
any other key exits this function.
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; buffer-move-autoloads.el ends here

1
elpa/buffer-move-20160615.1103/buffer-move-pkg.el
View File

@ -1 +0,0 @@
(define-package "buffer-move" "20160615.1103" "easily swap buffers" 'nil :url "https://github.com/lukhas/buffer-move" :keywords '("lisp" "convenience"))

179
elpa/buffer-move-20160615.1103/buffer-move.el
View File

@ -1,179 +0,0 @@
;;; buffer-move.el --- easily swap buffers
;; Copyright (C) 2004-2014 Lucas Bonnet <lucas@rincevent.net>
;; Copyright (C) 2014 Mathis Hofer <mathis@fsfe.org>
;; Copyright (C) 2014-2015 Geyslan G. Bem <geyslan@gmail.com>
;; Authors: Lucas Bonnet <lucas@rincevent.net>
;; Geyslan G. Bem <geyslan@gmail.com>
;; Mathis Hofer <mathis@fsfe.org>
;; Keywords: lisp,convenience
;; Package-Version: 20160615.1103
;; Version: 0.6.2
;; URL : https://github.com/lukhas/buffer-move
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; 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.
;;; Commentary:
;; This file is for lazy people wanting to swap buffers without
;; typing C-x b on each window. This is useful when you have :
;; +--------------+-------------+
;; | | |
;; | #emacs | #gnus |
;; | | |
;; +--------------+-------------+
;; | |
;; | .emacs |
;; | |
;; +----------------------------+
;; and you want to have :
;; +--------------+-------------+
;; | | |
;; | #gnus | .emacs |
;; | | |
;; +--------------+-------------+
;; | |
;; | #emacs |
;; | |
;; +----------------------------+
;; With buffer-move, just go in #gnus, do buf-move-left, go to #emacs
;; (which now should be on top right) and do buf-move-down.
;; To use it, simply put a (require 'buffer-move) in your ~/.emacs and
;; define some keybindings. For example, i use :
;; (global-set-key (kbd "<C-S-up>") 'buf-move-up)
;; (global-set-key (kbd "<C-S-down>") 'buf-move-down)
;; (global-set-key (kbd "<C-S-left>") 'buf-move-left)
;; (global-set-key (kbd "<C-S-right>") 'buf-move-right)
;; Alternatively, you may let the current window switch back to the previous
;; buffer, instead of swapping the buffers of both windows. Set the
;; following customization variable to 'move to activate this behavior:
;; (setq buffer-move-behavior 'move)
;;; Code:
(require 'windmove)
(defconst buffer-move-version "0.6.1"
"Version of buffer-move.el")
(defgroup buffer-move nil
"Swap buffers without typing C-x b on each window"
:group 'tools)
(defcustom buffer-move-behavior 'swap
"If set to 'swap (default), the buffers will be exchanged
(i.e. swapped), if set to 'move, the current window is switch back to the
previously displayed buffer (i.e. the buffer is moved)."
:group 'buffer-move
:type 'symbol)
(defcustom buffer-move-stay-after-swap nil
"If set to non-nil, point will stay in the current window
so it will not be moved when swapping buffers. This setting
only has effect if `buffer-move-behavior' is set to 'swap."
:group 'buffer-move
:type 'boolean)
(defun buf-move-to (direction)
"Helper function to move the current buffer to the window in the given
direction (with must be 'up, 'down', 'left or 'right). An error is
thrown, if no window exists in this direction."
(let* ((other-win (windmove-find-other-window direction))
(buf-this-buf (window-buffer (selected-window))))
(if (null other-win)
(error "No window in this direction")
(if (window-dedicated-p other-win)
(error "The window in this direction is dedicated"))
(if (string-match "^ \\*Minibuf" (buffer-name (window-buffer other-win)))
(error "The window in this direction is the Minibuf"))
(if (eq buffer-move-behavior 'move)
;; switch selected window to previous buffer (moving)
(switch-to-prev-buffer (selected-window))
;; switch selected window to buffer of other window (swapping)
(set-window-buffer (selected-window) (window-buffer other-win))
)
;; switch other window to this buffer
(set-window-buffer other-win buf-this-buf)
(when (or (null buffer-move-stay-after-swap)
(eq buffer-move-behavior 'move))
(select-window other-win)))))
;;;###autoload
(defun buf-move-up ()
"Swap the current buffer and the buffer above the split.
If there is no split, ie now window above the current one, an
error is signaled."
;; "Switches between the current buffer, and the buffer above the
;; split, if possible."
(interactive)
(buf-move-to 'up))
;;;###autoload
(defun buf-move-down ()
"Swap the current buffer and the buffer under the split.
If there is no split, ie now window under the current one, an
error is signaled."
(interactive)
(buf-move-to 'down))
;;;###autoload
(defun buf-move-left ()
"Swap the current buffer and the buffer on the left of the split.
If there is no split, ie now window on the left of the current
one, an error is signaled."
(interactive)
(buf-move-to 'left))
;;;###autoload
(defun buf-move-right ()
"Swap the current buffer and the buffer on the right of the split.
If there is no split, ie now window on the right of the current
one, an error is signaled."
(interactive)
(buf-move-to 'right))
;;;###autoload
(defun buf-move ()
"Begin moving the current buffer to different windows.
Use the arrow keys to move in the desired direction. Pressing
any other key exits this function."
(interactive)
(let ((map (make-sparse-keymap)))
(dolist (x '(("<up>" . buf-move-up)
("<left>" . buf-move-left)
("<down>" . buf-move-down)
("<right>" . buf-move-right)))
(define-key map (read-kbd-macro (car x)) (cdr x)))
(set-transient-map map t)))
(provide 'buffer-move)
;;; buffer-move.el ends here

22
elpa/django-manage-20160818.1912/django-manage-autoloads.el
View File

@ -1,22 +0,0 @@
;;; django-manage-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "django-manage" "django-manage.el" (22501 5677
;;;;;; 768491 198000))
;;; Generated autoloads from django-manage.el
(autoload 'django-manage "django-manage" "\
Minor mode for handling Django's manage.py
\(fn &optional ARG)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; django-manage-autoloads.el ends here

1
elpa/django-manage-20160818.1912/django-manage-pkg.el
View File

@ -1 +0,0 @@
(define-package "django-manage" "20160818.1912" "Django minor mode for commanding manage.py" '((hydra "0.13.2")) :keywords '("languages"))

319
elpa/django-manage-20160818.1912/django-manage.el
View File

@ -1,319 +0,0 @@
;;; django-manage.el --- Django minor mode for commanding manage.py
;; Copyright (C) 2015 Daniel Gopar
;; Author: Daniel Gopar <gopardaniel@yahoo.com>
;; Package-Requires: ((hydra "0.13.2"))
;; Package-Version: 20160818.1912
;; Version: 0.1
;; Keywords: languages
;; This file is NOT part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Simple package to be to be able to control `manage.py', the standard
;; file that every Django project comes with. You are able to call any
;; command with `django-manage-command' plus it comes with code
;; completion so third party plugins will also be completed.
;;; Code:
(condition-case nil
(require 'python)
(error
(require 'python-mode)))
(require 'hydra)
(defcustom django-manage-shell-preference 'pyshell
"What shell to use."
:type 'symbol
:options '(eshell term pyshell)
:group 'shell)
(defcustom django-manage-server-ipaddr "127.0.0.1"
"What address Django will use when running the dev server."
:type 'string
:group 'server)
(defcustom django-manage-server-port "8000"
"What port Django will use when running the dev server."
:type 'string
:group 'server)
(defcustom django-manage-prompt-for-command nil
"When non-nil will ask for confirmation on command.
Will affect every function other than `django-manage-command'."
:type 'boolean
:group 'django-manage)
(defcustom django-manage-root ""
"The directory where 'manage.py' lives."
:type 'string
:group 'django-manage)
(make-local-variable 'django-manage-root)
(defun django-manage-root ()
"Return the root directory of Django project."
;; Check if projectile is in use, and if it is. Return root directory
(if (not (string= django-manage-root ""))
django-manage-root
(if (fboundp 'projectile-project-root)
(projectile-project-root)
;; Try looking for the directory holding 'manage.py'
(locate-dominating-file default-directory "manage.py"))))
(defun django-manage-python-command ()
"Return Python version to use with args."
(if (boundp 'python-shell-interpreter)
(concat python-shell-interpreter " " python-shell-interpreter-args)
;; For old python.el
(mapconcat 'identity (cons python-python-command python-python-command-args) " ")))
(defun django-manage-get-commands ()
"Return list of django commands."
(let ((help-output
(shell-command-to-string (concat python-shell-interpreter " "
(shell-quote-argument (django-manage-root)) "manage.py -h"))))
(setq dj-commands-str
(with-temp-buffer
(progn
(insert help-output)
(beginning-of-buffer)
(delete-region (point) (search-forward "Available subcommands:" nil nil nil))
;; cleanup [auth] and stuff
(beginning-of-buffer)
(save-excursion
(replace-regexp "\\[.*\\]" ""))
(buffer-string))))
;; get a list of commands from the output of manage.py -h
;; What would be the pattern to optimize this ?
(setq dj-commands-str (s-split "\n" dj-commands-str))
(setq dj-commands-str (-remove (lambda (x) (string= x "")) dj-commands-str))
(setq dj-commands-str (mapcar (lambda (x) (s-trim x)) dj-commands-str))
(sort dj-commands-str 'string-lessp)))
(defun django-manage-command (command &optional no-prompt)
"Allow to run any `manage.py' command.
Argument COMMAND command for django to run.
Optional Argument NO-PROMPT if non-nil will *not* ask if you wish to pass extra arguments."
;; nil nil: enable user to exit with any command. Still, he can not edit a completed choice.
(interactive (list (completing-read "Command: " (django-manage-get-commands) nil nil)))
(if (not no-prompt)
;; Now ask to edit the command. How to do the two actions at once ?
(setq command (read-shell-command "Run command like this: " command)))
(compile (concat (django-manage-python-command) " "
(shell-quote-argument (django-manage-root)) "manage.py " command)))
(defun django-manage-makemigrations (&optional app-name)
"Run \"makemigrations app-name\", will prompt for \"app-name\".
You can leave blank to simply run \"makemigrations\".
To choose arguments call `django-manage-command'.
Optional argument APP-NAME name of django app create migrations."
(interactive "sName: ")
(django-manage-command (concat "makemigrations " app-name)
(not django-manage-prompt-for-command)))
(defun django-manage-flush ()
"Run \"flush --noinput\". To choose arguments call `django-manage-command'."
(interactive)
(django-manage-command "flush --noinput"
(not django-manage-prompt-for-command)))
(defun django-manage-runserver ()
"Start the development server. To change what address and port to use,
customize `django-manage-server-ipaddr' and `django-manage-server-port'
If you want to pass arguments, then call `django-manage-command'"
(interactive)
(let ((parent-dir (file-name-base (substring (django-manage-root) 0 -1))))
(compile (concat (django-manage-python-command) " "
(shell-quote-argument (django-manage-root)) "manage.py runserver "
django-manage-server-ipaddr ":" django-manage-server-port))
(with-current-buffer "*compilation*"
(rename-buffer (format "*runserver[%s]*" parent-dir)))))
(defun django-manage-migrate ()
"Run \"migrate\". To choose arguments call `django-manage-command'."
(interactive)
(django-manage-command "migrate"
(not django-manage-prompt-for-command)))
(defun django-manage-assets-rebuild ()
"Run \"assets rebuild\". To choose arguments call `django-manage-command'."
(interactive)
(django-manage-command "assets rebuild"
(not django-manage-prompt-for-command)))
(defun django-manage-startapp (name)
"Run \"startapp name\". Will prompt for name of app.
To choose arguments call `django-manage-command'.
Argument NAME name of app to create."
(interactive "sName:")
(django-manage-command (concat "startapp " name)
(not django-manage-prompt-for-command)))
(defun django-manage-makemessages ()
"Run \"makemessages --all --symlinks\".
To pass arguments call `django-manage-command'."
(interactive)
(django-manage-command "makemessages --all --symlinks"
(not django-manage-prompt-for-command)))
(defun django-manage-compilemessages ()
"Run \"compilemessages\". To pass arguments call `django-manage-command'."
(interactive)
(django-manage-command "compilemessages"
(not django-manage-prompt-for-command)))
(defun django-manage-test (name)
"Run \"test name\". Will prompt for Django app name to test.
To pass arguments call `django-manage-command'.
Argument NAME name of django app to test."
(interactive "sTest app:")
(django-manage-command (concat "test " name)
(not django-manage-prompt-for-command)))
(defun django-manage--prep-shell (pref-shell)
"Prepare the shell with users preference.
Argument PREF-SHELL users shell of choice"
;; If a preexisting shell buffer exists return that one. If not create it
(let* ((parent-dir (file-name-base (substring (django-manage-root) 0 -1)))
(default-directory (django-manage-root))
(buffer-shell-name
(format (if (string= pref-shell "shell") "*Django Shell[%s]*" "*Django DBshell[%s]*") parent-dir)))
;; If it exists return it
(if (get-buffer buffer-shell-name)
(switch-to-buffer buffer-shell-name)
;; Shell didn't exist, so let's create it
(if (eq 'term django-manage-shell-preference)
(term (concat (django-manage-python-command) " "
(shell-quote-argument (django-manage-root)) "manage.py " pref-shell)))
(if (eq 'eshell django-manage-shell-preference)
(progn
(unless (get-buffer eshell-buffer-name)
(eshell))
(insert (concat (django-manage-python-command) " "
(shell-quote-argument (django-manage-root)) "manage.py " pref-shell))
(eshell-send-input)))
(if (eq 'pyshell django-manage-shell-preference)
(let ((setup-code "os.environ.setdefault(\"DJANGO_SETTINGS_MODULE\", \"%s.settings\")")
(cmd ";from django.core.management import execute_from_command_line")
(exe (if (string= pref-shell "shell")
";import django;django.setup()"
(format ";execute_from_command_line(['manage.py', '%s'])" pref-shell))))
(run-python (python-shell-parse-command))
(python-shell-send-string (concat (format setup-code parent-dir) cmd exe))
(switch-to-buffer (python-shell-get-buffer))))
(rename-buffer buffer-shell-name))))
(defun django-manage-shell ()
"Start Python shell with Django already configured."
(interactive)
(django-manage--prep-shell "shell"))
(defun django-manage-dbshell ()
"Start Database shell."
(interactive)
(django-manage--prep-shell "dbshell"))
(defun django-manage-insert-transpy (from to &optional buffer)
"Wraps highlighted region in _(...) for i18n.
Argument FROM start point TO wrap.
Optional argument BUFFER end point to wrap."
;; From http://garage.pimentech.net/libcommonDjango_django_emacs/
;; Modified a little
(interactive "*r")
(save-excursion
(save-restriction
(narrow-to-region from to)
(goto-char from)
(iso-iso2sgml from to)
(insert "_(")
(goto-char (point-max))
(insert ")")
(point-max))))
(defhydra django-manage-hydra (:color blue
:hint nil)
"
Manage.py
--------------------------------------------------
_mm_: Enter manage.py commnand _r_: runserver _f_: Flush _t_: Run rest
_ma_: Makemigrations _sa_: Start new app _i_: Insert transpy
_mg_: Migrate _ss_: Run shell _a_: Rebuild Assets
_me_: Make messages _sd_: Run DB Shell _c_: Compile messages
_q_: Cancel
"
("mm" django-manage-command)
("ma" django-manage-makemigrations)
("mg" django-manage-migrate)
("me" django-manage-makemessages)
("r" django-manage-runserver "Start server")
("sa" django-manage-startapp)
("ss" django-manage-shell)
("sd" django-manage-dbshell)
("f" django-manage-flush)
("a" django-manage-assets-rebuild)
("c" django-manage-compilemessages)
("t" django-manage-test)
("i" django-manage-insert-transpy)
("q" nil "cancel"))
(defvar django-manage-map
(let ((map (make-keymap)))
(define-key map (kbd "C-c C-x") 'django-manage-hydra/body)
map))
(defun django-manage-setup ()
"Determine whether to start minor mode or not."
(when (and (stringp buffer-file-name)
(locate-dominating-file default-directory "manage.py"))
(django-manage)))
;;;###autoload
(define-minor-mode django-manage
"Minor mode for handling Django's manage.py"
:lighter " Manage"
:keymap django-manage-map)
(easy-menu-define django-manage-menu django-manage-map "Django menu"
'("Django"
["Start an app" django-manage-startapp t]
["Run tests" django-manage-test t]
["Make migrations" django-manage-makemigrations t]
["Flush database" django-manage-flush t]
["Runserver" django-manage-runserver t]
["Run database migrations" django-manage-migrate t]
["Rebuild assets" django-manage-assets-rebuild t]
["Make translations" django-manage-makemessages t]
["Compile translations" django-manage-compilemessages t]
["Open Python shell" django-manage-shell t]
["Open database shell" django-manage-dbshell t]
["Run other command" django-manage-command t]
"-"
["Insert translation mark" django-manage-insert-transpy t]))
(easy-menu-add django-manage-menu django-manage-map)
(provide 'django-manage)
;;; django-manage.el ends here

159
elpa/erlang-20161007.57/erlang-autoloads.el
View File

@ -1,159 +0,0 @@
;;; erlang-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "erlang" "erlang.el" (22523 21259 84519 501000))
;;; Generated autoloads from erlang.el
(autoload 'erlang-mode "erlang" "\
Major mode for editing Erlang source files in Emacs.
It knows about syntax and comment, it can indent code, it is capable
of fontifying the source file, the TAGS commands are aware of Erlang
modules, and the Erlang man pages can be accessed.
Should this module, \"erlang.el\", be installed properly, Erlang mode
is activated whenever an Erlang source or header file is loaded into
Emacs. To indicate this, the mode line should contain the word
\"Erlang\".
The main feature of Erlang mode is indentation, press TAB and the
current line will be indented correctly.
Comments starting with only one `%' are indented to the column stored
in the variable `comment-column'. Comments starting with two `%':s
are indented with the same indentation as code. Comments starting
with at least three `%':s are indented to the first column.
However, Erlang mode contains much more, this is a list of the most
useful commands:
TAB - Indent the line.
C-c C-q - Indent current function.
M-; - Create a comment at the end of the line.
M-q - Fill a comment, i.e. wrap lines so that they (hopefully)
will look better.
M-a - Goto the beginning of an Erlang clause.
M-C-a - Ditto for function.
M-e - Goto the end of an Erlang clause.
M-C-e - Ditto for function.
M-h - Mark current Erlang clause.
M-C-h - Ditto for function.
C-c C-z - Start, or switch to, an inferior Erlang shell.
C-c C-k - Compile current file.
C-x ` - Next error.
, - Electric comma.
; - Electric semicolon.
Erlang mode check the name of the file against the module name when
saving, whenever a mismatch occurs Erlang mode offers to modify the
source.
The variable `erlang-electric-commands' controls the electric
commands. To deactivate all of them, set it to nil.
There exists a large number of commands and variables in the Erlang
module. Please press `M-x apropos RET erlang RET' to see a complete
list. Press `C-h f name-of-function RET' and `C-h v name-of-variable
RET'to see the full description of functions and variables,
respectively.
On entry to this mode the contents of the hook `erlang-mode-hook' is
executed.
Please see the beginning of the file `erlang.el' for more information
and examples of hooks.
Other commands:
\\{erlang-mode-map}
\(fn)" t nil)
(dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript" "\\.hrl$" "\\.xrl$" "\\.yrl" "/ebin/.+\\.app")) (add-to-list 'auto-mode-alist (cons r 'erlang-mode)))
(autoload 'erlang-find-tag "erlang" "\
Like `find-tag'. Capable of retrieving Erlang modules.
Tags can be given on the forms `tag', `module:', `module:tag'.
\(fn MODTAGNAME &optional NEXT-P REGEXP-P)" t nil)
(autoload 'erlang-find-tag-other-window "erlang" "\
Like `find-tag-other-window' but aware of Erlang modules.
\(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
(autoload 'erlang-shell "erlang" "\
Start a new Erlang shell.
The variable `erlang-shell-function' decides which method to use,
default is to start a new Erlang host. It is possible that, in the
future, a new shell on an already running host will be started.
\(fn)" t nil)
(autoload 'run-erlang "erlang" "Start a new Erlang shell." t)
(autoload 'erlang-compile "erlang" "\
Compile Erlang module in current buffer.
\(fn)" t nil)
(autoload 'inferior-erlang "erlang" "\
Run an inferior Erlang.
With prefix command, prompt for command to start Erlang with.
This is just like running Erlang in a normal shell, except that
an Emacs buffer is used for input and output.
\\<comint-mode-map>
The command line history can be accessed with \\[comint-previous-input] and \\[comint-next-input].
The history is saved between sessions.
Entry to this mode calls the functions in the variables
`comint-mode-hook' and `erlang-shell-mode-hook' with no arguments.
The following commands imitate the usual Unix interrupt and
editing control characters:
\\{erlang-shell-mode-map}
\(fn &optional COMMAND)" t nil)
;;;***
;;;### (autoloads nil "erlang-edoc" "erlang-edoc.el" (22523 21259
;;;;;; 104519 648000))
;;; Generated autoloads from erlang-edoc.el
(autoload 'erlang-edoc-mode "erlang-edoc" "\
Toggle Erlang-Edoc mode on or off.
With a prefix argument ARG, enable Erlang-Edoc mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
\\{erlang-edoc-mode-map}
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil "erlang-start" "erlang-start.el" (22523 21259
;;;;;; 64519 353000))
;;; Generated autoloads from erlang-start.el
(let ((a '("\\.erl\\'" . erlang-mode)) (b '("\\.hrl\\'" . erlang-mode))) (or (assoc (car a) auto-mode-alist) (setq auto-mode-alist (cons a auto-mode-alist))) (or (assoc (car b) auto-mode-alist) (setq auto-mode-alist (cons b auto-mode-alist))))
(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode))
(let ((erl-ext '(".jam" ".vee" ".beam"))) (while erl-ext (let ((cie completion-ignored-extensions)) (while (and cie (not (string-equal (car cie) (car erl-ext)))) (setq cie (cdr cie))) (if (null cie) (setq completion-ignored-extensions (cons (car erl-ext) completion-ignored-extensions)))) (setq erl-ext (cdr erl-ext))))
;;;***
;;;### (autoloads nil nil ("erlang-eunit.el" "erlang-flymake.el"
;;;;;; "erlang-pkg.el" "erlang-skels-old.el" "erlang-skels.el" "erlang-test.el"
;;;;;; "erlang_appwiz.el") (22523 21259 100519 619000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; erlang-autoloads.el ends here

172
elpa/erlang-20161007.57/erlang-edoc.el
View File

@ -1,172 +0,0 @@
;;; erlang-edoc.el --- EDoc support for Erlang mode -*- lexical-binding: t; -*-
;; %CopyrightBegin%
;;
;; Copyright Ericsson AB 1996-2016. All Rights Reserved.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;
;; %CopyrightEnd%
;;; Commentary:
;; Ref: http://www.erlang.org/doc/apps/edoc/users_guide.html
;;
;; To use: (add-hook 'erlang-mode-hook 'erlang-edoc-mode)
;;; Code:
(defcustom erlang-edoc-indent-level 2
"Indentation level of xhtml in Erlang edoc."
:safe 'integerp
:group 'erlang)
(defvar erlang-edoc-generic-tags
'("clear" "docfile" "end" "headerfile" "todo" "TODO" "type")
"Tags that can be used anywhere within a module.")
(defvar erlang-edoc-overview-tags
'("author" "copyright" "reference" "see" "since" "title" "version")
"Tags that can be used in an overview file.")
(defvar erlang-edoc-module-tags
'("author" "copyright" "deprecated" "doc" "hidden" "private" "reference"
"see" "since" "version")
"Tags that can be used before a module declaration.")
(defvar erlang-edoc-function-tags
'("deprecated" "doc" "equiv" "hidden" "private" "see" "since" "spec"
"throws" "type")
"Tags that can be used before a function definition.")
(defvar erlang-edoc-predefined-macros
'("date" "docRoot" "link" "module" "package" "section" "time"
"type" "version"))
(defface erlang-edoc-tag '((t (:inherit font-lock-constant-face)))
"Face used to highlight edoc tags."
:group 'erlang)
(defface erlang-edoc-macro '((t (:inherit font-lock-preprocessor-face)))
"Face used to highlight edoc macros."
:group 'erlang)
(defface erlang-edoc-verbatim
'((t (:family "Monospace" :inherit font-lock-keyword-face)))
"Face used to highlight verbatim text."
:group 'erlang)
(defface erlang-edoc-todo '((t (:inherit font-lock-warning-face)))
"Face used to highlight edoc macros."
:group 'erlang)
(defface erlang-edoc-heading '((t (:inherit bold)))
"Face used to highlight edoc headings."
:group 'erlang)
(defvar erlang-edoc-font-lock-keywords
'(("^%+\\s-*\\(@\\w+\\)\\_>" 1 'erlang-edoc-tag prepend)
("^%+\\s-*" ("{\\(@\\w+\\)\\_>" nil nil (1 'erlang-edoc-macro prepend)))
("^%+\\s-*" ("\\(?:@@\\)*\\(@[@{}]\\)" nil nil (1 'escape-glyph prepend)))
("^%+\\s-*@\\(deprecated\\)\\_>" 1 font-lock-warning-face prepend)
;; http://www.erlang.org/doc/apps/edoc/chapter.html#Wiki_notation
("^%+\\s-*" ("[^`]`\\([^`]?\\|[^`].*?[^']\\)'"
(forward-char -1) nil (1 'erlang-edoc-verbatim prepend)))
("^%+\\s-*" ("\\[\\(\\(?:https?\\|file\\|ftp\\)://[^][]+\\)\\]"
nil nil (1 'link prepend)))
("^%+\\s-*\\(?:\\(?1:@todo\\|@TODO\\)\\_>\\|\\(?1:TODO\\):\\)"
1 'erlang-edoc-todo prepend)
("^%+\\s-*\\(\\(=\\{2,4\\}\\)[^=\n].*[^=\n]\\2\\)\\s-*$"
1 'erlang-edoc-heading prepend)))
(defun erlang-edoc-xml-context ()
"Parse edoc x(ht)ml context at comment start of current line."
(eval-and-compile (require 'xmltok))
(save-excursion
(beginning-of-line)
(when (looking-at "^%+\\s-*")
(let ((pt (match-end 0)) context)
(forward-comment (- (point)))
(while (< (point) pt)
(xmltok-forward)
(cond ((eq xmltok-type 'start-tag)
(push (cons xmltok-type xmltok-start) context))
((eq xmltok-type 'end-tag)
(pop context))))
(goto-char pt)
(xmltok-forward)
(push (car (memq xmltok-type '(start-tag end-tag))) context)
context))))
(defun erlang-edoc-indent-line ()
(let ((context (erlang-edoc-xml-context)))
(when context
(save-excursion
(beginning-of-line)
(re-search-forward "^%+\\s-*" (line-end-position))
(when (or (car context) (cadr context))
(let ((pad (when (cadr context)
(save-excursion
(goto-char (cdr (cadr context)))
(- (current-column)
(progn
(beginning-of-line)
(skip-chars-forward "%")
(current-column)))))))
(just-one-space (cond ((not pad) 1)
((eq (car context) 'end-tag) pad)
(t (+ erlang-edoc-indent-level pad)))))))
(when (looking-back "^%*\\s-*" (line-beginning-position))
(re-search-forward "\\=%*\\s-*")))))
(defun erlang-edoc-before-module-declaration-p ()
(save-excursion
(beginning-of-line)
(forward-comment (point-max))
(or (eobp) (re-search-forward "^-module\\s-*(" nil t))))
(defun erlang-edoc-completion-at-point ()
(when (eq (syntax-ppss-context (syntax-ppss)) 'comment)
(save-excursion
(skip-syntax-backward "w_")
(when (= (preceding-char) ?@)
(let* ((is-tag (looking-back "^%+\\s-*@" (line-beginning-position)))
(beg (point))
(end (progn (skip-syntax-forward "w_") (point)))
(table (cond
((not is-tag)
erlang-edoc-predefined-macros)
((erlang-edoc-before-module-declaration-p)
(append erlang-edoc-module-tags
erlang-edoc-generic-tags))
(t (append erlang-edoc-function-tags
erlang-edoc-generic-tags)))))
(list beg end table))))))
;;;###autoload
(define-minor-mode erlang-edoc-mode nil
:lighter " EDoc"
(cond (erlang-edoc-mode
(add-hook 'erlang-indent-line-hook #'erlang-edoc-indent-line nil t)
(font-lock-add-keywords nil erlang-edoc-font-lock-keywords t)
(add-hook 'completion-at-point-functions
#'erlang-edoc-completion-at-point nil t))
(t
(remove-hook 'erlang-indent-line-hook #'erlang-edoc-indent-line t)
(font-lock-remove-keywords nil erlang-edoc-font-lock-keywords)
(remove-hook 'completion-at-point-functions
#'erlang-edoc-completion-at-point t)))
(jit-lock-refontify))
(provide 'erlang-edoc)
;;; erlang-edoc.el ends here

453
elpa/erlang-20161007.57/erlang-eunit.el
View File

@ -1,453 +0,0 @@
;;
;; %CopyrightBegin%
;;
;; Copyright Ericsson AB 2009-2016. All Rights Reserved.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;
;; %CopyrightEnd%
;;;
;;; Purpose: Provide EUnit utilities.
;;;
;;; Author: Klas Johansson
(eval-when-compile
(require 'cl))
(defvar erlang-eunit-src-candidate-dirs '("../src" ".")
"*Name of directories which to search for source files matching
an EUnit test file. The first directory in the list will be used,
if there is no match.")
(defvar erlang-eunit-test-candidate-dirs '("../test" ".")
"*Name of directories which to search for EUnit test files matching
a source file. The first directory in the list will be used,
if there is no match.")
(defvar erlang-eunit-autosave nil
"*Set to non-nil to automtically save unsaved buffers before running tests.
This is useful, reducing the save-compile-load-test cycle to one keychord.")
(defvar erlang-eunit-recent-info '((mode . nil) (module . nil) (test . nil) (cover . nil))
"Info about the most recent running of an EUnit test representation.")
(defvar erlang-error-regexp-alist
'(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2)))
"*Patterns for matching Erlang errors.")
;;;
;;; Switch between src/EUnit test buffers
;;;
(defun erlang-eunit-toggle-src-and-test-file-other-window ()
"Switch to the src file if the EUnit test file is the current
buffer and vice versa"
(interactive)
(if (erlang-eunit-test-file-p buffer-file-name)
(erlang-eunit-open-src-file-other-window buffer-file-name)
(erlang-eunit-open-test-file-other-window buffer-file-name)))
;;;
;;; Open the EUnit test file which corresponds to a src file
;;;
(defun erlang-eunit-open-test-file-other-window (src-file-path)
"Open the EUnit test file which corresponds to a src file"
(find-file-other-window (erlang-eunit-test-filename src-file-path)))
;;;
;;; Open the src file which corresponds to the an EUnit test file
;;;
(defun erlang-eunit-open-src-file-other-window (test-file-path)
"Open the src file which corresponds to the an EUnit test file"
(find-file-other-window (erlang-eunit-src-filename test-file-path)))
;;; Return the name and path of the EUnit test file
;;, (input may be either the source filename itself or the EUnit test filename)
(defun erlang-eunit-test-filename (file-path)
(if (erlang-eunit-test-file-p file-path)
file-path
(erlang-eunit-rewrite-filename file-path erlang-eunit-test-candidate-dirs)))
;;; Return the name and path of the source file
;;, (input may be either the source filename itself or the EUnit test filename)
(defun erlang-eunit-src-filename (file-path)
(if (erlang-eunit-src-file-p file-path)
file-path
(erlang-eunit-rewrite-filename file-path erlang-eunit-src-candidate-dirs)))
;;; Rewrite a filename from the src or test filename to the other
(defun erlang-eunit-rewrite-filename (orig-file-path candidate-dirs)
(or (erlang-eunit-locate-buddy orig-file-path candidate-dirs)
(erlang-eunit-buddy-file-path orig-file-path (car candidate-dirs))))
;;; Search for a file's buddy file (a source file's EUnit test file,
;;; or an EUnit test file's source file) in a list of candidate
;;; directories.
(defun erlang-eunit-locate-buddy (orig-file-path candidate-dirs)
(when candidate-dirs
(let ((buddy-file-path (erlang-eunit-buddy-file-path
orig-file-path
(car candidate-dirs))))
(if (file-readable-p buddy-file-path)
buddy-file-path
(erlang-eunit-locate-buddy orig-file-path (cdr candidate-dirs))))))
(defun erlang-eunit-buddy-file-path (orig-file-path buddy-dir-name)
(let* ((orig-dir-name (file-name-directory orig-file-path))
(buddy-dir-name (file-truename
(filename-join orig-dir-name buddy-dir-name)))
(buddy-base-name (erlang-eunit-buddy-basename orig-file-path)))
(filename-join buddy-dir-name buddy-base-name)))
;;; Return the basename of the buddy file:
;;; /tmp/foo/src/x.erl --> x_tests.erl
;;; /tmp/foo/test/x_tests.erl --> x.erl
(defun erlang-eunit-buddy-basename (file-path)
(let ((src-module-name (erlang-eunit-source-module-name file-path)))
(cond
((erlang-eunit-src-file-p file-path)
(concat src-module-name "_tests.erl"))
((erlang-eunit-test-file-p file-path)
(concat src-module-name ".erl")))))
;;; Checks whether a file is a source file or not
(defun erlang-eunit-src-file-p (file-path)
(not (erlang-eunit-test-file-p file-path)))
;;; Checks whether a file is a EUnit test file or not
(defun erlang-eunit-test-file-p (file-path)
(erlang-eunit-string-match-p "^\\(.+\\)_tests.erl$" file-path))
;;; Return the module name of the source file
;;; /tmp/foo/src/x.erl --> x
;;; /tmp/foo/test/x_tests.erl --> x
(defun erlang-eunit-source-module-name (file-path)
(interactive)
(let ((module-name (erlang-eunit-module-name file-path)))
(if (string-match "^\\(.+\\)_tests$" module-name)
(substring module-name (match-beginning 1) (match-end 1))
module-name)))
;;; Return the module name of the file
;;; /tmp/foo/src/x.erl --> x
;;; /tmp/foo/test/x_tests.erl --> x_tests
(defun erlang-eunit-module-name (file-path)
(interactive)
(file-name-sans-extension (file-name-nondirectory file-path)))
;;; Older emacsen don't have string-match-p.
(defun erlang-eunit-string-match-p (regexp string &optional start)
(if (fboundp 'string-match-p) ;; appeared in emacs 23
(string-match-p regexp string start)
(save-match-data ;; fallback for earlier versions of emacs
(string-match regexp string start))))
;;; Join filenames
(defun filename-join (dir file)
(if (or (= (elt file 0) ?/)
(= (car (last (append dir nil))) ?/))
(concat dir file)
(concat dir "/" file)))
;;; Get info about the most recent running of EUnit
(defun erlang-eunit-recent (key)
(cdr (assq key erlang-eunit-recent-info)))
;;; Record info about the most recent running of EUnit
;;; Known modes are 'module-mode and 'test-mode
(defun erlang-eunit-record-recent (mode module test)
(setcdr (assq 'mode erlang-eunit-recent-info) mode)
(setcdr (assq 'module erlang-eunit-recent-info) module)
(setcdr (assq 'test erlang-eunit-recent-info) test))
;;; Record whether the most recent running of EUnit included cover
;;; compilation
(defun erlang-eunit-record-recent-compile (under-cover)
(setcdr (assq 'cover erlang-eunit-recent-info) under-cover))
;;; Determine options for EUnit.
(defun erlang-eunit-opts ()
(if current-prefix-arg ", [verbose]" ""))
;;; Determine current test function
(defun erlang-eunit-current-test ()
(save-excursion
(erlang-end-of-function 1)
(erlang-beginning-of-function 1)
(erlang-name-of-function)))
(defun erlang-eunit-simple-test-p (test-name)
(if (erlang-eunit-string-match-p "^\\(.+\\)_test$" test-name) t nil))
(defun erlang-eunit-test-generator-p (test-name)
(if (erlang-eunit-string-match-p "^\\(.+\\)_test_$" test-name) t nil))
;;; Run one EUnit test
(defun erlang-eunit-run-test (module-name test-name)
(let ((command
(cond ((erlang-eunit-simple-test-p test-name)
(format "eunit:test({%s, %s}%s)."
module-name test-name (erlang-eunit-opts)))
((erlang-eunit-test-generator-p test-name)
(format "eunit:test({generator, %s, %s}%s)."
module-name test-name (erlang-eunit-opts)))
(t (format "%% WARNING: '%s' is not a test function" test-name)))))
(erlang-eunit-record-recent 'test-mode module-name test-name)
(erlang-eunit-inferior-erlang-send-command command)))
;;; Run EUnit tests for the current module
(defun erlang-eunit-run-module-tests (module-name)
(let ((command (format "eunit:test(%s%s)." module-name (erlang-eunit-opts))))
(erlang-eunit-record-recent 'module-mode module-name nil)
(erlang-eunit-inferior-erlang-send-command command)))
(defun erlang-eunit-compile-and-run-recent ()
"Compile the source and test files and repeat the most recent EUnit test run.
With prefix arg, compiles for debug and runs tests with the verbose flag set."
(interactive)
(case (erlang-eunit-recent 'mode)
('test-mode
(erlang-eunit-compile-and-test
'erlang-eunit-run-test (list (erlang-eunit-recent 'module)
(erlang-eunit-recent 'test))))
('module-mode
(erlang-eunit-compile-and-test
'erlang-eunit-run-module-tests (list (erlang-eunit-recent 'module))
(erlang-eunit-recent 'cover)))
(t (error "EUnit has not yet been run. Please run a test first."))))
(defun erlang-eunit-cover-compile ()
"Cover compile current module."
(interactive)
(let* ((erlang-compile-extra-opts
(append (list 'debug_info) erlang-compile-extra-opts))
(module-name
(erlang-add-quotes-if-needed
(erlang-eunit-module-name buffer-file-name)))
(compile-command
(format "cover:compile_beam(%s)." module-name)))
(erlang-compile)
(if (erlang-eunit-last-compilation-successful-p)
(erlang-eunit-inferior-erlang-send-command compile-command))))
(defun erlang-eunit-analyze-coverage ()
"Analyze the data collected by cover tool for the module in the
current buffer.
Assumes that the module has been cover compiled prior to this
call. This function will do two things: print the number of
covered and uncovered functions in the erlang shell and display a
new buffer called *<module name> coverage* which shows the source
code along with the coverage analysis results."
(interactive)
(let* ((module-name (erlang-add-quotes-if-needed
(erlang-eunit-module-name buffer-file-name)))
(tmp-filename (make-temp-file "cover"))
(analyze-command (format "cover:analyze_to_file(%s, \"%s\"). "
module-name tmp-filename))
(buf-name (format "*%s coverage*" module-name)))
(erlang-eunit-inferior-erlang-send-command analyze-command)
;; The purpose of the following snippet is to get the result of the
;; analysis from a file into a new buffer (or an old, if one with
;; the specified name already exists). Also we want the erlang-mode
;; *and* view-mode to be enabled.
(save-excursion
(let ((buf (get-buffer-create (format "*%s coverage*" module-name))))
(set-buffer buf)
(setq buffer-read-only nil)
(insert-file-contents tmp-filename nil nil nil t)
(if (= (buffer-size) 0)
(kill-buffer buf)
;; FIXME: this would be a good place to enable (emacs-mode)
;; to get some nice syntax highlighting in the
;; coverage report, but it doesn't play well with
;; flymake. Leave it off for now.
(view-buffer buf))))
(delete-file tmp-filename)))
(defun erlang-eunit-compile-and-run-current-test ()
"Compile the source and test files and run the current EUnit test.
With prefix arg, compiles for debug and runs tests with the verbose flag set."
(interactive)
(let ((module-name (erlang-add-quotes-if-needed
(erlang-eunit-module-name buffer-file-name)))
(test-name (erlang-eunit-current-test)))
(erlang-eunit-compile-and-test
'erlang-eunit-run-test (list module-name test-name))))
(defun erlang-eunit-compile-and-run-module-tests ()
"Compile the source and test files and run all EUnit tests in the module.
With prefix arg, compiles for debug and runs tests with the verbose flag set."
(interactive)
(let ((module-name (erlang-add-quotes-if-needed
(erlang-eunit-source-module-name buffer-file-name))))
(erlang-eunit-compile-and-test
'erlang-eunit-run-module-tests (list module-name))))
;;; Compile source and EUnit test file and finally run EUnit tests for
;;; the current module
(defun erlang-eunit-compile-and-test (test-fun test-args &optional under-cover)
"Compile the source and test files and run the EUnit test suite.
If under-cover is set to t, the module under test is compile for
code coverage analysis. If under-cover is left out or not set,
coverage analysis is disabled. The result of the code coverage
is both printed to the erlang shell (the number of covered vs
uncovered functions in a module) and written to a buffer called
*<module> coverage* (which shows the source code for the module
and the number of times each line is covered).
With prefix arg, compiles for debug and runs tests with the verbose flag set."
(erlang-eunit-record-recent-compile under-cover)
(let ((src-filename (erlang-eunit-src-filename buffer-file-name))
(test-filename (erlang-eunit-test-filename buffer-file-name)))
;; The purpose of out-maneuvering `save-some-buffers', as is done
;; below, is to ask the question about saving buffers only once,
;; instead of possibly several: one for each file to compile,
;; for instance for both x.erl and x_tests.erl.
(save-some-buffers erlang-eunit-autosave)
(flet ((save-some-buffers (&optional any) nil))
;; Compilation of the source file is mandatory (the file must
;; exist, otherwise the procedure is aborted). Compilation of the
;; test file on the other hand, is optional, since eunit tests may
;; be placed in the source file instead. Any compilation error
;; will prevent the subsequent steps to be run (hence the `and')
(and (erlang-eunit-compile-file src-filename under-cover)
(if (file-readable-p test-filename)
(erlang-eunit-compile-file test-filename)
t)
(apply test-fun test-args)
(if under-cover
(save-excursion
(set-buffer (find-file-noselect src-filename))
(erlang-eunit-analyze-coverage)))))))
(defun erlang-eunit-compile-and-run-module-tests-under-cover ()
"Compile the source and test files and run the EUnit test suite and measure
code coverage.
With prefix arg, compiles for debug and runs tests with the verbose flag set."
(interactive)
(let ((module-name (erlang-add-quotes-if-needed
(erlang-eunit-source-module-name buffer-file-name))))
(erlang-eunit-compile-and-test
'erlang-eunit-run-module-tests (list module-name) t)))
(defun erlang-eunit-compile-file (file-path &optional under-cover)
(if (file-readable-p file-path)
(save-excursion
(set-buffer (find-file-noselect file-path))
;; In order to run a code coverage analysis on a
;; module, we have two options:
;;
;; * either compile the module with cover:compile instead of the
;; regular compiler
;;
;; * or first compile the module with the regular compiler (but
;; *with* debug_info) and then compile it for coverage
;; analysis using cover:compile_beam.
;;
;; We could accomplish the first by changing the
;; erlang-compile-erlang-function to cover:compile, but there's
;; a risk that that's used for other purposes. Therefore, a
;; safer alternative (although with more steps) is to add
;; debug_info to the list of compiler options and go for the
;; second alternative.
(if under-cover
(erlang-eunit-cover-compile)
(erlang-compile))
(erlang-eunit-last-compilation-successful-p))
(let ((msg (format "Could not read %s" file-path)))
(erlang-eunit-inferior-erlang-send-command
(format "%% WARNING: %s" msg))
(error msg))))
(defun erlang-eunit-last-compilation-successful-p ()
(save-excursion
(set-buffer inferior-erlang-buffer)
(goto-char compilation-parsing-end)
(erlang-eunit-all-list-elems-fulfill-p
(lambda (re) (let ((continue t)
(result t))
(while continue ; ignore warnings, stop at errors
(if (re-search-forward re (point-max) t)
(if (erlang-eunit-is-compilation-warning)
t
(setq result nil)
(setq continue nil))
(setq result t)
(setq continue nil)))
result))
(mapcar (lambda (e) (car e)) erlang-error-regexp-alist))))
(defun erlang-eunit-is-compilation-warning ()
(erlang-eunit-string-match-p
"[0-9]+: Warning:"
(buffer-substring (line-beginning-position) (line-end-position))))
(defun erlang-eunit-all-list-elems-fulfill-p (pred list)
(let ((matches-p t))
(while (and list matches-p)
(if (not (funcall pred (car list)))
(setq matches-p nil))
(setq list (cdr list)))
matches-p))
;;; Evaluate a command in an erlang buffer
(defun erlang-eunit-inferior-erlang-send-command (command)
"Evaluate a command in an erlang buffer."
(interactive "P")
(inferior-erlang-prepare-for-input)
(inferior-erlang-send-command command)
(sit-for 0) ;; redisplay
(inferior-erlang-wait-prompt))
;;;====================================================================
;;; Key bindings
;;;====================================================================
(defconst erlang-eunit-key-bindings
'(("\C-c\C-et" erlang-eunit-toggle-src-and-test-file-other-window)
("\C-c\C-ek" erlang-eunit-compile-and-run-module-tests)
("\C-c\C-ej" erlang-eunit-compile-and-run-current-test)
("\C-c\C-el" erlang-eunit-compile-and-run-recent)
("\C-c\C-ec" erlang-eunit-compile-and-run-module-tests-under-cover)
("\C-c\C-ev" erlang-eunit-cover-compile)
("\C-c\C-ea" erlang-eunit-analyze-coverage)))
(defun erlang-eunit-add-key-bindings ()
(dolist (binding erlang-eunit-key-bindings)
(erlang-eunit-bind-key (car binding) (cadr binding))))
(defun erlang-eunit-bind-key (key function)
(erlang-eunit-ensure-keymap-for-key key)
(local-set-key key function))
(defun erlang-eunit-ensure-keymap-for-key (key-seq)
(let ((prefix-keys (butlast (append key-seq nil)))
(prefix-seq ""))
(while prefix-keys
(setq prefix-seq (concat prefix-seq (make-string 1 (car prefix-keys))))
(setq prefix-keys (cdr prefix-keys))
(if (not (keymapp (lookup-key (current-local-map) prefix-seq)))
(local-set-key prefix-seq (make-sparse-keymap))))))
(add-hook 'erlang-mode-hook 'erlang-eunit-add-key-bindings)
(provide 'erlang-eunit)
;; erlang-eunit ends here

103
elpa/erlang-20161007.57/erlang-flymake.el
View File

@ -1,103 +0,0 @@
;; erlang-flymake.el
;;
;; Syntax check erlang source code on the fly (integrates with flymake).
;;
;; Start using flymake with erlang by putting the following somewhere
;; in your .emacs file:
;;
;; (require 'erlang-flymake)
;;
;; Flymake is rather eager and does its syntax checks frequently by
;; default and if you are bothered by this, you might want to put the
;; following in your .emacs as well:
;;
;; (erlang-flymake-only-on-save)
;;
;; There are a couple of variables which control the compilation options:
;; * erlang-flymake-get-code-path-dirs-function
;; * erlang-flymake-get-include-dirs-function
;; * erlang-flymake-extra-opts
;;
;; This code is inspired by http://www.emacswiki.org/emacs/FlymakeErlang.
(require 'flymake)
(eval-when-compile
(require 'cl))
(defvar erlang-flymake-command
"erlc"
"The command that will be used to perform the syntax check")
(defvar erlang-flymake-get-code-path-dirs-function
'erlang-flymake-get-code-path-dirs
"Return a list of ebin directories to add to the code path.")
(defvar erlang-flymake-get-include-dirs-function
'erlang-flymake-get-include-dirs
"Return a list of include directories to add to the compiler options.")
(defvar erlang-flymake-extra-opts
(list "+warn_obsolete_guard"
"+warn_unused_import"
"+warn_shadow_vars"
"+warn_export_vars"
"+strong_validation"
"+report")
"A list of options that will be passed to the compiler")
(defun erlang-flymake-only-on-save ()
"Trigger flymake only when the buffer is saved (disables syntax
check on newline and when there are no changes)."
(interactive)
;; There doesn't seem to be a way of disabling this; set to the
;; largest int available as a workaround (most-positive-fixnum
;; equates to 8.5 years on my machine, so it ought to be enough ;-) )
(setq flymake-no-changes-timeout most-positive-fixnum)
(setq flymake-start-syntax-check-on-newline nil))
(defun erlang-flymake-get-code-path-dirs ()
(list (concat (erlang-flymake-get-app-dir) "ebin")))
(defun erlang-flymake-get-include-dirs ()
(list (concat (erlang-flymake-get-app-dir) "include")
(concat (erlang-flymake-get-app-dir) "deps")))
(defun erlang-flymake-get-app-dir ()
(let ((src-path (file-name-directory (buffer-file-name))))
(file-name-directory (directory-file-name src-path))))
(defun erlang-flymake-init ()
(let* ((temp-file
(flet ((flymake-get-temp-dir () (erlang-flymake-temp-dir)))
(flymake-init-create-temp-buffer-copy
'flymake-create-temp-with-folder-structure)))
(code-dir-opts
(erlang-flymake-flatten
(mapcar (lambda (dir) (list "-pa" dir))
(funcall erlang-flymake-get-code-path-dirs-function))))
(inc-dir-opts
(erlang-flymake-flatten
(mapcar (lambda (dir) (list "-I" dir))
(funcall erlang-flymake-get-include-dirs-function))))
(compile-opts
(append inc-dir-opts
code-dir-opts
erlang-flymake-extra-opts)))
(list erlang-flymake-command (append compile-opts (list temp-file)))))
(defun erlang-flymake-temp-dir ()
;; Squeeze the user's name in there in order to make sure that files
;; for two users who are working on the same computer (like a linux
;; box) don't collide
(format "%s/flymake-%s" temporary-file-directory user-login-name))
(defun erlang-flymake-flatten (list)
(apply #'append list))
(add-to-list 'flymake-allowed-file-name-masks
'("\\.erl\\'" erlang-flymake-init))
(add-hook 'erlang-mode-hook 'flymake-mode)
(provide 'erlang-flymake)
;; erlang-flymake ends here

4
elpa/erlang-20161007.57/erlang-pkg.el
View File

@ -1,4 +0,0 @@
(define-package "erlang" "20161007.57" "Erlang major mode" 'nil)
;; Local Variables:
;; no-byte-compile: t
;; End:

1268
elpa/erlang-20161007.57/erlang-skels-old.el
View File

File diff suppressed because it is too large Load Diff

1926
elpa/erlang-20161007.57/erlang-skels.el
View File

File diff suppressed because it is too large Load Diff

125
elpa/erlang-20161007.57/erlang-start.el
View File

@ -1,125 +0,0 @@
;; erlang-start.el --- Load this file to initialize the Erlang package.
;; Copyright (C) 1998 Ericsson Telecom AB
;; Author: Anders Lindgren
;; Version: 2.3
;; Keywords: erlang, languages, processes
;; Created: 1996-09-18
;; Date: 1998-03-16
;;; Commentary:
;; Introduction:
;; ------------
;;
;; This package provides support for the programming language Erlang.
;; The package provides an editing mode with lots of bells and
;; whistles, compilation support, and it makes it possible for the
;; user to start Erlang shells that run inside Emacs.
;;
;; See the Erlang distribution for full documentation of this package.
;; Installation:
;; ------------
;;
;; Place this file in Emacs load path, byte-compile it, and add the
;; following line to the appropriate init file:
;;
;; (require 'erlang-start)
;;
;; The full documentation contains much more extensive description of
;; the installation procedure.
;; Reporting Bugs:
;; --------------
;;
;; Please send bug reports to the following email address:
;; support@erlang.ericsson.se
;;
;; Please state as exactly as possible:
;; - Version number of Erlang Mode (see the menu), Emacs, Erlang,
;; and of any other relevant software.
;; - What the expected result was.
;; - What you did, preferably in a repeatable step-by-step form.
;; - A description of the unexpected result.
;; - Relevant pieces of Erlang code causing the problem.
;; - Personal Emacs customisations, if any.
;;
;; Should the Emacs generate an error, please set the emacs variable
;; `debug-on-error' to `t'. Repeat the error and enclose the debug
;; information in your bug-report.
;;
;; To set the variable you can use the following command:
;; M-x set-variable RET debug-on-error RET t RET
;;; Code:
;;
;; Declare functions in "erlang.el".
;;
(autoload 'erlang-mode "erlang" "Major mode for editing Erlang code." t)
(autoload 'erlang-version "erlang"
"Return the current version of Erlang mode." t)
(autoload 'erlang-shell "erlang" "Start a new Erlang shell." t)
(autoload 'run-erlang "erlang" "Start a new Erlang shell." t)
(autoload 'erlang-compile "erlang"
"Compile Erlang module in current buffer." t)
(autoload 'erlang-man-module "erlang"
"Find manual page for MODULE." t)
(autoload 'erlang-man-function "erlang"
"Find manual page for NAME, where NAME is module:function." t)
(autoload 'erlang-find-tag "erlang"
"Like `find-tag'. Capable of retreiving Erlang modules.")
(autoload 'erlang-find-tag-other-window "erlang"
"Like `find-tag-other-window'. Capable of retreiving Erlang modules.")
(autoload 'erlang-edoc-mode "erlang-edoc" "Toggle Erlang-Edoc mode on or off." t)
;;
;; Associate files extensions ".erl" and ".hrl" with Erlang mode.
;;
;;;###autoload
(let ((a '("\\.erl\\'" . erlang-mode))
(b '("\\.hrl\\'" . erlang-mode)))
(or (assoc (car a) auto-mode-alist)
(setq auto-mode-alist (cons a auto-mode-alist)))
(or (assoc (car b) auto-mode-alist)
(setq auto-mode-alist (cons b auto-mode-alist))))
;;
;; Associate files using interpreter "escript" with Erlang mode.
;;
;;;###autoload
(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode))
;;
;; Ignore files ending in ".jam", ".vee", and ".beam" when performing
;; file completion.
;;
;;;###autoload
(let ((erl-ext '(".jam" ".vee" ".beam")))
(while erl-ext
(let ((cie completion-ignored-extensions))
(while (and cie (not (string-equal (car cie) (car erl-ext))))
(setq cie (cdr cie)))
(if (null cie)
(setq completion-ignored-extensions
(cons (car erl-ext) completion-ignored-extensions))))
(setq erl-ext (cdr erl-ext))))
;;
;; The end.
;;
(provide 'erlang-start)
;; erlang-start.el ends here.

184
elpa/erlang-20161007.57/erlang-test.el
View File

@ -1,184 +0,0 @@
;;; erlang-test.el -*- lexical-binding: t; coding: utf-8-unix -*-
;;; Unit tests for erlang.el.
;; Author: Johan Claesson
;; Created: 2016-05-07
;; Keywords: erlang, languages
;; %CopyrightBegin%
;;
;; Copyright Ericsson AB 2016. All Rights Reserved.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;
;; %CopyrightEnd%
;;; Commentary:
;; This library require GNU Emacs 25 or later.
;;; Code:
(require 'ert)
(require 'cl-lib)
(require 'erlang)
(defvar erlang-test-code
'((nil . "-module(erlang_test).")
(nil . "-import(lists, [map/2]).")
(nil . "-compile(export_all).")
("SYMBOL" . "-define(SYMBOL, value).")
("MACRO" . "-define(MACRO(X), X + X).")
("struct" . "-record(struct, {until,maps,are,everywhere}).")
("function". "function() -> #struct{}."))
"Alist of erlang test code.
Each entry have the format (TAGNAME . ERLANG_CODE). If TAGNAME
is nil there is no definitions in the ERLANG_CODE. The
ERLANG_CODE is a single line of erlang code. These lines will be
concatenated to form an erlang file to test on.")
(ert-deftest erlang-test-tags ()
(let* ((dir (make-temp-file "erlang-test" t))
(erlang-file (expand-file-name "erlang_test.erl" dir))
(tags-file (expand-file-name "TAGS" dir))
(old-tags-file-name (default-value 'tags-file-name))
(old-tags-table-list (default-value 'tags-table-list))
tags-file-name
tags-table-list
tags-table-set-list
erlang-buffer
erlang-mode-hook
prog-mode-hook
erlang-shell-mode-hook
tags-add-tables)
(unwind-protect
(progn
(setq-default tags-file-name nil)
(setq-default tags-table-list nil)
(erlang-test-create-erlang-file erlang-file)
(erlang-test-compile-tags erlang-file tags-file)
(setq erlang-buffer (find-file-noselect erlang-file))
(with-current-buffer erlang-buffer
(setq-local tags-file-name tags-file))
;; Setting global tags-file-name is a workaround for
;; GNU Emacs bug#23164.
(setq tags-file-name tags-file)
(erlang-test-complete-at-point tags-file)
(erlang-test-completion-table)
(erlang-test-xref-find-definitions erlang-file erlang-buffer))
(when (buffer-live-p erlang-buffer)
(kill-buffer erlang-buffer))
(let ((tags-buffer (find-buffer-visiting tags-file)))
(when (buffer-live-p tags-buffer)
(kill-buffer tags-buffer)))
(when (file-exists-p dir)
(delete-directory dir t))
(setq-default tags-file-name old-tags-file-name)
(setq-default tags-table-list old-tags-table-list))))
(defun erlang-test-create-erlang-file (erlang-file)
(with-temp-file erlang-file
(cl-loop for (_ . code) in erlang-test-code
do (insert code "\n"))))
(defun erlang-test-compile-tags (erlang-file tags-file)
(should (zerop (call-process "etags" nil nil nil
"-o" tags-file
erlang-file))))
(defun erlang-test-completion-table ()
(let ((erlang-replace-etags-tags-completion-table t))
(setq tags-completion-table nil)
(tags-completion-table))
(should (equal (sort tags-completion-table #'string-lessp)
(sort (erlang-expected-completion-table) #'string-lessp))))
(defun erlang-expected-completion-table ()
(append (cl-loop for (symbol . _) in erlang-test-code
when (stringp symbol)
append (list symbol (concat "erlang_test:" symbol)))
(list "erlang_test:" "erlang_test:module_info")))
(defun erlang-test-xref-find-definitions (erlang-file erlang-buffer)
(cl-loop for (tagname . code) in erlang-test-code
for line = 1 then (1+ line)
do (when tagname
(switch-to-buffer erlang-buffer)
(xref-find-definitions tagname)
(erlang-test-verify-pos erlang-file line)
(xref-find-definitions (concat "erlang_test:" tagname))
(erlang-test-verify-pos erlang-file line)))
(xref-find-definitions "erlang_test:")
(erlang-test-verify-pos erlang-file 1))
(defun erlang-test-verify-pos (expected-file expected-line)
(should (string-equal (file-truename expected-file)
(file-truename (buffer-file-name))))
(should (eq expected-line (line-number-at-pos)))
(should (= (point-at-bol) (point))))
(defun erlang-test-complete-at-point (tags-file)
(with-temp-buffer
(erlang-mode)
(setq-local tags-file-name tags-file)
(insert "\nerlang_test:fun")
(erlang-complete-tag)
(should (looking-back "erlang_test:function"))
(insert "\nfun")
(erlang-complete-tag)
(should (looking-back "function"))
(insert "\nerlang_")
(erlang-complete-tag)
(should (looking-back "erlang_test:"))))
(ert-deftest erlang-test-compile-options ()
(erlang-test-format-opt t
"t")
(erlang-test-format-opt nil
"nil")
(erlang-test-format-opt (cons 1 2)
"{1, 2}")
(erlang-test-format-opt (list 1)
"[1]")
(erlang-test-format-opt (list 1 2)
"[1, 2]")
(erlang-test-format-opt (list 1 2 3)
"[1, 2, 3]")
(erlang-test-format-opt 'symbol
"symbol")
(erlang-test-format-opt "string"
"\"string\"")
(erlang-test-format-opt []
"{}")
(erlang-test-format-opt [1]
"{1}")
(erlang-test-format-opt [1 2]
"{1, 2}")
(erlang-test-format-opt [1 2 (3 [4 5 6] 7)]
"{1, 2, [3, {4, 5, 6}, 7]}"))
(defun erlang-test-format-opt (elisp &optional expected-erlang)
(let ((erlang (inferior-erlang-format-opt elisp)))
(message "%s -> %s" elisp erlang)
(when expected-erlang
(should (equal erlang expected-erlang)))
erlang))
(provide 'erlang-test)
;;; erlang-test.el ends here

5941
elpa/erlang-20161007.57/erlang.el
View File

File diff suppressed because it is too large Load Diff

1345
elpa/erlang-20161007.57/erlang_appwiz.el
View File

File diff suppressed because it is too large Load Diff

65
elpa/fiplr-20140723.2345/fiplr-autoloads.el
View File

@ -1,65 +0,0 @@
;;; fiplr-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "fiplr" "fiplr.el" (22297 19831 573825 595000))
;;; Generated autoloads from fiplr.el
(autoload 'fiplr-find-file "fiplr" "\
Runs a completing prompt to find a file from the project.
The root of the project is the return value of `fiplr-root'.
\(fn)" t nil)
(autoload 'fiplr-find-file-other-window "fiplr" "\
Runs a completing prompt to find a file from the project.
The root of the project is the return value of `fiplr-root'. The
file is opened using `find-file-other-window'.
\(fn)" t nil)
(autoload 'fiplr-find-file-other-frame "fiplr" "\
Runs a completing prompt to find a file from the project.
The root of the project is the return value of `fiplr-root'. The
file is opened using `find-file-other-frame'.
\(fn)" t nil)
(autoload 'fiplr-find-directory "fiplr" "\
Runs a completing prompt to find a directory from the project.
The root of the project is the return value of `fiplr-root'.
\(fn)" t nil)
(autoload 'fiplr-find-directory-other-window "fiplr" "\
Runs a completing prompt to find a directory from the project.
The root of the project is the return value of `fiplr-root'. The
directory is opened using `dired-other-window'.
\(fn)" t nil)
(autoload 'fiplr-find-directory-other-frame "fiplr" "\
Runs a completing prompt to find a directory from the project.
The root of the project is the return value of `fiplr-root'. The
directory is opened using `dired-other-frame'.
\(fn)" t nil)
(autoload 'fiplr-clear-cache "fiplr" "\
Clears the internal caches used by fiplr so the project is searched again.
\(fn)" t nil)
;;;***
;;;### (autoloads nil nil ("fiplr-pkg.el") (22297 19831 829667 665000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; fiplr-autoloads.el ends here

6
elpa/fiplr-20140723.2345/fiplr-pkg.el
View File

@ -1,6 +0,0 @@
(define-package "fiplr" "20140723.2345" "Fuzzy Search for Files in Projects"
'((grizzl "0.1.0")
(cl-lib "0.1")))
;; Local Variables:
;; no-byte-compile: t
;; End:

346
elpa/fiplr-20140723.2345/fiplr.el
View File

@ -1,346 +0,0 @@
;;; fiplr.el --- Fuzzy finder for files in a project.
;; Copyright © 2013 Chris Corbyn
;;
;; Author: Chris Corbyn <chris@w3style.co.uk>
;; URL: https://github.com/d11wtq/fiplr
;; Version: 0.2.8
;; Keywords: convenience, usability, project
;; This file is NOT part of GNU Emacs.
;;; --- License
;; Licensed under the same terms as Emacs.
;;; --- Commentary
;; Overview:
;;
;; Fiplr makes it really easy to find files anywhere within your entire
;; project by using a cached directory tree and delegating to grizzl.el
;; while you search the tree.
;;
;; M-x fiplr-find-file
;;
;; By default it looks through all the parent directories of the file you're
;; editing until it finds a .git, .hg, .bzr or .svn directory. You can
;; customize this list of root markers by setting `fiplr-root-markers'.
;;
;; (setq fiplr-root-markers '(".git" ".svn"))
;;
;; Some files are ignored from the directory tree because they are not text
;; files, or simply to speed up the search. The default list can be
;; customized by setting `fiplr-ignored-globs'.
;;
;; (setq fiplr-ignored-globs '((directories (".git" ".svn"))
;; (files ("*.jpg" "*.png" "*.zip" "*~"))))
;;
;; These globs are used by the UNIX `find' command's -name flag.
;;
;; Usage:
;;
;; Find files: M-x fiplr-find-file
;; Find directories: M-x fiplr-find-directory
;; Clear caches: M-x fiplr-clear-cache
;;
;; For convenience, bind "C-x f" to `fiplr-find-file':
;;
;; (global-set-key (kbd "C-x f") 'fiplr-find-file)
;;
;; Because fiplr caches the project tree, you may sometimes wish to clear the
;; cache while searching. Use "C-c r" to do this.
(eval-when-compile
(require 'cl-lib)
(require 'grizzl))
;;; --- Package Configuration
(defvar *fiplr-caches* '((files) (directories))
"Internal caches used by fiplr.")
(defvar *fiplr-default-root-markers* '(".git" ".svn" ".hg" ".bzr")
"A list of files/directories to look for that mark a project root.")
(defvar *fiplr-default-ignored-globs*
'((directories (".git" ".svn" ".hg" ".bzr"))
(files (".#*" "*~" "*.so" "*.jpg" "*.png" "*.gif" "*.pdf" "*.gz" "*.zip")))
"An alist of files and directories to exclude from searches.")
(defgroup fiplr nil
"Configuration options for fiplr - find in project."
:group 'convenience)
(defcustom fiplr-root-markers *fiplr-default-root-markers*
"A list of files or directories that are found at the root of a project."
:type '(repeat string)
:group 'fiplr)
(defcustom fiplr-ignored-globs *fiplr-default-ignored-globs*
"An alist of glob patterns to exclude from search results."
:type '(alist :key-type symbol :value-type (repeat string))
:group 'fiplr)
(defcustom fiplr-list-files-function 'fiplr-list-files
"A function receiving DIR, TYPE and IGNORED, returning a list of files.
DIR is the directory under which to locate files (recursively).
TYPE is one of the symboles 'FILES or 'DIRECTORIES.
IGNORED is an alist of glob patterns to exclude. Its keys are 'DIRECTORIES
and 'FILES, so that entire directories can be excluded.
This setting allows for cross-platform compatibility by abstracting away the
details of locating files in a directory tree. The default uses a GNU/BSD
compatible `find' command.
This function is only invoked once, when building the search index."
:type 'function
:group 'fiplr)
;;; --- Public Functions
;;;###autoload
(defun fiplr-find-file ()
"Runs a completing prompt to find a file from the project.
The root of the project is the return value of `fiplr-root'."
(interactive)
(fiplr-find-file-in-directory (fiplr-root) fiplr-ignored-globs))
;;;###autoload
(defun fiplr-find-file-other-window ()
"Runs a completing prompt to find a file from the project.
The root of the project is the return value of `fiplr-root'. The
file is opened using `find-file-other-window'."
(interactive)
(fiplr-find-file-in-directory (fiplr-root) fiplr-ignored-globs
#'find-file-other-window))
;;;###autoload
(defun fiplr-find-file-other-frame ()
"Runs a completing prompt to find a file from the project.
The root of the project is the return value of `fiplr-root'. The
file is opened using `find-file-other-frame'."
(interactive)
(fiplr-find-file-in-directory (fiplr-root) fiplr-ignored-globs
#'find-file-other-frame))
;;;###autoload
(defun fiplr-find-directory ()
"Runs a completing prompt to find a directory from the project.
The root of the project is the return value of `fiplr-root'."
(interactive)
(fiplr-find-directory-in-directory (fiplr-root) fiplr-ignored-globs))
;;;###autoload
(defun fiplr-find-directory-other-window ()
"Runs a completing prompt to find a directory from the project.
The root of the project is the return value of `fiplr-root'. The
directory is opened using `dired-other-window'."
(interactive)
(fiplr-find-directory-in-directory (fiplr-root) fiplr-ignored-globs
#'dired-other-window))
;;;###autoload
(defun fiplr-find-directory-other-frame ()
"Runs a completing prompt to find a directory from the project.
The root of the project is the return value of `fiplr-root'. The
directory is opened using `dired-other-frame'."
(interactive)
(fiplr-find-directory-in-directory (fiplr-root) fiplr-ignored-globs
#'dired-other-frame))
;;;###autoload
(defun fiplr-clear-cache ()
"Clears the internal caches used by fiplr so the project is searched again."
(interactive)
(setq *fiplr-caches*
(list (list 'files)
(list 'directories))))
;;; --- Minor Mode Definition
(defvar *fiplr-keymap* (make-sparse-keymap)
"Internal keymap used by the minor-mode in fiplr.")
(define-key *fiplr-keymap* (kbd "C-c r") 'fiplr-reload-list)
(define-minor-mode fiplr-mode
"Toggle the internal mode used by fiplr."
nil
" fiplr"
*fiplr-keymap*)
;;; --- Private Macros
(defmacro fiplr-cache (type)
"Get the internal cache used by fiplr for files of TYPE."
`(cdr (assoc ,type *fiplr-caches*)))
;;; --- Private Functions
(defun fiplr-root ()
"Locate the root of the project by walking up the directory tree.
The first directory containing one of fiplr-root-markers is the root.
If no root marker is found, the current working directory is used."
(let ((cwd (if (buffer-file-name)
(directory-file-name
(file-name-directory (buffer-file-name)))
(file-truename "."))))
(or (fiplr-find-root cwd fiplr-root-markers)
cwd)))
(defun fiplr-find-root (path root-markers)
"Tail-recursive part of project-root."
(let* ((this-dir (file-name-as-directory (file-truename path)))
(parent-dir (expand-file-name (concat this-dir "..")))
(system-root-dir (expand-file-name "/")))
(cond
((fiplr-root-p path root-markers) this-dir)
((equal system-root-dir this-dir) nil)
(t (fiplr-find-root parent-dir root-markers)))))
(defun fiplr-anyp (pred seq)
"True if any value in SEQ matches PRED."
(catch 'found
(cl-map nil (lambda (v)
(when (funcall pred v)
(throw 'found v)))
seq)))
(defun fiplr-root-p (path root-markers)
"Predicate to check if the given directory is a project root."
(let ((dir (file-name-as-directory path)))
(fiplr-anyp (lambda (marker)
(file-exists-p (concat dir marker)))
root-markers)))
(defun fiplr-list-files-shell-command (type path ignored-globs)
"Builds the `find' command to locate all project files & directories.
PATH is the base directory to recurse from.
IGNORED-GLOBS is an alist with keys 'DIRECTORIES and 'FILES."
(let* ((type-abbrev
(lambda (assoc-type)
(cl-case assoc-type
('directories "d")
('files "f"))))
(name-matcher
(lambda (glob)
(mapconcat 'identity
`("-name" ,(shell-quote-argument glob))
" ")))
(grouped-name-matchers
(lambda (type)
(mapconcat 'identity
`(,(shell-quote-argument "(")
,(mapconcat (lambda (v) (funcall name-matcher v))
(cadr (assoc type ignored-globs))
" -o ")
,(shell-quote-argument ")"))
" ")))
(matcher
(lambda (assoc-type)
(mapconcat 'identity
`(,(shell-quote-argument "(")
"-type"
,(funcall type-abbrev assoc-type)
,(funcall grouped-name-matchers assoc-type)
,(shell-quote-argument ")"))
" "))))
(mapconcat 'identity
`("find"
"-L"
,(shell-quote-argument (directory-file-name path))
,(funcall matcher 'directories)
"-prune"
"-o"
"-not"
,(funcall matcher 'files)
"-type"
,(funcall type-abbrev type)
"-print")
" ")))
(defun fiplr-list-files (type path ignored-globs)
"Expands to a flat list of files/directories found under PATH.
The first parameter TYPE is the symbol 'DIRECTORIES or 'FILES."
(let* ((prefix (file-name-as-directory (file-truename path)))
(prefix-length (length prefix))
(list-string
(shell-command-to-string (fiplr-list-files-shell-command
type
prefix
ignored-globs))))
(reverse (cl-reduce (lambda (acc file)
(if (> (length file) prefix-length)
(cons (substring file prefix-length) acc)
acc))
(split-string list-string "[\r\n]+" t)
:initial-value '()))))
(defun fiplr-reload-list ()
"Clear caches and reload the file listing."
(interactive)
(when (minibufferp)
(exit-minibuffer))
(fiplr-clear-cache)
(funcall last-command))
(defun fiplr-report-progress (n total)
"Show the number of files processed in the message area."
(when (= 0 (mod n 1000))
(message (format "Indexing (%d/%d)" n total))))
(defun fiplr-find-file-in-directory
(path ignored-globs &optional find-file-function)
"Locate a file under the specified PATH.
If the directory has been searched previously, the cache is used.
Use FIND-FILE-FUNCTION to open the selected file, or `find-file'
if FIND-FILE-FUNCTION is `nil'."
(let* ((root-dir (file-name-as-directory path))
(index (fiplr-get-index 'files root-dir ignored-globs))
(file (minibuffer-with-setup-hook
(lambda ()
(fiplr-mode 1))
(grizzl-completing-read (format "Find in project (%s)" root-dir)
index))))
(if (eq this-command 'fiplr-reload-list) ; exited for reload
(fiplr-reload-list)
(funcall (or find-file-function #'find-file)
(concat root-dir file)))))
(defun fiplr-find-directory-in-directory
(path ignored-globs &optional dired-function)
"Locate a directory and run dired under the specified PATH.
If the directory has been searched previously, the cache is used.
Use DIRED-FUNCTION to open the selected file, or `dired' if
DIRED-FUNCTION is `nil'."
(let* ((root-dir (file-name-as-directory path))
(index (fiplr-get-index 'directories root-dir ignored-globs))
(dir (minibuffer-with-setup-hook
(lambda ()
(fiplr-mode 1))
(grizzl-completing-read (format "Dired in project (%s)" root-dir)
index))))
(if (eq this-command 'fiplr-reload-list) ; exited for reload
(fiplr-reload-list)
(funcall (or dired-function #'dired) (concat root-dir dir)))))
(defun fiplr-get-index (type path ignored-globs)
"Internal function to lazily get a fiplr fuzzy search index."
(let ((fiplr-cache-key (cons path ignored-globs)))
(unless (assoc fiplr-cache-key (fiplr-cache type))
(message (format "Scanning... (%s)" path))
(push (cons fiplr-cache-key
(grizzl-make-index (funcall fiplr-list-files-function
type
path
ignored-globs)
:progress-fn #'fiplr-report-progress))
(fiplr-cache type)))
(cdr (assoc fiplr-cache-key (fiplr-cache type)))))
(provide 'fiplr)
;;; fiplr.el ends here

269
elpa/gh-20160728.1525/gh-api.el
View File

@ -1,269 +0,0 @@
;;; gh-api.el --- api definition for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'json)
(require 'gh-profile)
(require 'gh-url)
(require 'gh-auth)
(require 'gh-cache)
(require 'logito)
(defgroup gh-api nil
"Github API."
:group 'gh)
(defcustom gh-api-username-filter 'gh-api-enterprise-username-filter
"Filter to apply to usernames to build URL components"
:type 'function
:group 'gh-api)
;;;###autoload
(defclass gh-api ()
((sync :initarg :sync :initform t)
(cache :initarg :cache :initform nil)
(base :initarg :base :type string)
(profile :initarg :profile :type string)
(auth :initarg :auth :initform nil)
(data-format :initarg :data-format)
(num-retries :initarg :num-retries :initform 0)
(log :initarg :log :initform nil)
(cache-cls :initform gh-cache :allocation :class))
"Github API")
(defmethod logito-log ((api gh-api) level tag string &rest objects)
(apply 'logito-log (oref api :log) level tag string objects))
(defmethod initialize-instance ((api gh-api) &rest args)
(call-next-method))
(defmethod gh-api-set-default-auth ((api gh-api) auth)
(let ((auth (or (oref api :auth) auth))
(cache (oref api :cache))
(classname (symbol-name (funcall (if (fboundp 'eieio-object-class)
'eieio-object-class
'object-class)
api))))
(oset api :auth auth)
(unless (or (null cache)
(and (eieio-object-p cache)
(object-of-class-p cache 'gh-cache)))
(oset api :cache (make-instance
(oref api cache-cls)
:object-name
(format "gh/%s/%s"
classname
(gh-api-get-username api)))))))
(defmethod gh-api-expand-resource ((api gh-api)
resource)
resource)
(defun gh-api-enterprise-username-filter (username)
(replace-regexp-in-string (regexp-quote ".") "-" username))
(defmethod gh-api-get-username ((api gh-api))
(let ((username (oref (oref api :auth) :username)))
(funcall gh-api-username-filter username)))
;;;###autoload
(defclass gh-api-v3 (gh-api)
((data-format :initarg :data-format :initform :json))
"Github API v3")
(defcustom gh-api-v3-authenticator 'gh-oauth-authenticator
"Authenticator for Github API v3"
:type '(choice (const :tag "Password" gh-password-authenticator)
(const :tag "OAuth" gh-oauth-authenticator))
:group 'gh-api)
(defmethod initialize-instance ((api gh-api-v3) &rest args)
(call-next-method)
(let ((gh-profile-current-profile (gh-profile-current-profile)))
(oset api :profile (gh-profile-current-profile))
(oset api :base (gh-profile-url))
(gh-api-set-default-auth api
(or (oref api :auth)
(funcall gh-api-v3-authenticator "auth")))))
;;;###autoload
(defclass gh-api-request (gh-url-request)
((default-response-cls :allocation :class :initform gh-api-response)))
;;;###autoload
(defclass gh-api-response (gh-url-response)
())
(defun gh-api-json-decode (repr)
(if (or (null repr) (string= repr ""))
'empty
(let ((json-array-type 'list))
(json-read-from-string repr))))
(defun gh-api-json-encode (json)
(json-encode-list json))
(defmethod gh-url-response-set-data ((resp gh-api-response) data)
(call-next-method resp (gh-api-json-decode data)))
;;;###autoload
(defclass gh-api-paged-request (gh-api-request)
((default-response-cls :allocation :class :initform gh-api-paged-response)
(page-limit :initarg :page-limit :initform -1)))
;;;###autoload
(defclass gh-api-paged-response (gh-api-response)
())
(defmethod gh-api-paging-links ((resp gh-api-paged-response))
(let ((links-header (cdr (assoc "Link" (oref resp :headers)))))
(when links-header
(loop for item in (split-string links-header ", ")
when (string-match "^<\\(.*\\)>; rel=\"\\(.*\\)\"" item)
collect (cons (match-string 2 item)
(match-string 1 item))))))
(defmethod gh-url-response-set-data ((resp gh-api-paged-response) data)
(let ((previous-data (oref resp :data))
(next (cdr (assoc "next" (gh-api-paging-links resp)))))
(call-next-method)
(oset resp :data (append previous-data (oref resp :data)))
(when (and next (not (equal 304 (oref resp :http-status))))
(let* ((req (oref resp :-req))
(last-page-limit (oref req :page-limit))
(this-page-limit (if (numberp last-page-limit) (- last-page-limit 1) -1)))
(oset req :page-limit this-page-limit)
(unless (eq (oref req :page-limit) 0)
;; We use an explicit check for 0 since -1 indicates that
;; paging should continue forever.
(oset resp :data-received nil)
(oset req :url next)
;; Params need to be set to nil because the next uri will
;; already have query params. If params are non-nil this will
;; cause another set of params to be added to the end of the
;; string which will override the params that are set in the
;; next link.
(oset req :query nil)
(gh-url-run-request req resp))))))
(defmethod gh-api-authenticated-request
((api gh-api) transformer method resource &optional data params page-limit)
(let* ((fmt (oref api :data-format))
(headers (cond ((eq fmt :form)
'(("Content-Type" .
"application/x-www-form-urlencoded")))
((eq fmt :json)
'(("Content-Type" .
"application/json")))))
(cache (oref api :cache))
(key (list resource
method
(sha1 (format "%s" transformer))))
(cache-key (and cache
(member method (oref cache safe-methods))
key))
(has-value (and cache-key (pcache-has cache cache-key)))
(value (and has-value (pcache-get cache cache-key)))
(is-outdated (and has-value (gh-cache-outdated-p cache cache-key)))
(etag (and is-outdated (gh-cache-etag cache cache-key)))
(req
(and (or (not has-value)
is-outdated)
(gh-auth-modify-request
(oref api :auth)
;; TODO: use gh-api-paged-request only when needed
(make-instance 'gh-api-paged-request
:method method
:url (concat (oref api :base)
(gh-api-expand-resource
api resource))
:query params
:headers (if etag
(cons (cons "If-None-Match" etag)
headers)
headers)
:data (or (and (eq fmt :json)
(gh-api-json-encode data))
(and (eq fmt :form)
(gh-url-form-encode data))
"")
:page-limit page-limit)))))
(cond ((and has-value ;; got value from cache
(not is-outdated))
(make-instance 'gh-api-response :data-received t :data value))
(cache-key ;; no value, but cache exists and method is safe
(let ((resp (make-instance (oref req default-response-cls)
:transform transformer)))
(gh-url-run-request req resp)
(gh-url-add-response-callback
resp (make-instance 'gh-api-callback :cache cache :key cache-key
:revive etag))
resp))
(cache ;; unsafe method, cache exists
(pcache-invalidate cache key)
(gh-url-run-request req (make-instance
(oref req default-response-cls)
:transform transformer)))
(t ;; no cache involved
(gh-url-run-request req (make-instance
(oref req default-response-cls)
:transform transformer))))))
;;;###autoload
(defclass gh-api-callback (gh-url-callback)
((cache :initarg :cache)
(key :initarg :key)
(revive :initarg :revive)))
(defmethod gh-url-callback-run ((cb gh-api-callback) resp)
(let ((cache (oref cb :cache))
(key (oref cb :key)))
(if (and (oref cb :revive) (equal (oref resp :http-status) 304))
(progn
(gh-cache-revive cache key)
(oset resp :data (pcache-get cache key)))
(pcache-put cache key (oref resp :data))
(gh-cache-set-etag cache key
(cdr (assoc "ETag" (oref resp :headers)))))))
(define-obsolete-function-alias 'gh-api-add-response-callback
'gh-url-add-response-callback "0.6.0")
(provide 'gh-api)
;;; gh-api.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

174
elpa/gh-20160728.1525/gh-auth.el
View File

@ -1,174 +0,0 @@
;;; gh-auth.el --- authentication for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-profile)
(require 'gh-common)
(require 'gh-url)
(defgroup gh-auth nil
"Github authentication."
:group 'gh)
(defvar gh-auth-alist nil)
(defun gh-auth-remember (profile key value)
(let ((cell (assoc profile gh-auth-alist)))
(when (not cell)
(setq cell (cons profile nil))
(setq gh-auth-alist (append gh-auth-alist (list cell))))
(setcdr cell (plist-put (cdr cell) key value))))
(defun gh-auth-get-username ()
(let* ((profile (gh-profile-current-profile))
(user (or (plist-get (cdr (assoc profile gh-auth-alist)) :username)
(plist-get (cdr (assoc profile gh-profile-alist)) :username)
(gh-config "user"))))
(when (not user)
(setq user (read-string "GitHub username: "))
(gh-set-config "user" user))
(gh-auth-remember profile :username user)
user))
(defun gh-auth-get-password (&optional remember)
(let* ((profile (gh-profile-current-profile))
(pass (or (plist-get (cdr (assoc profile gh-auth-alist)) :password)
(plist-get (cdr (assoc profile gh-profile-alist)) :password)
(gh-config "password"))))
(when (not pass)
(setq pass (read-passwd "GitHub password: "))
(gh-set-config "password" pass))
(when remember
(gh-auth-remember profile :password pass))
pass))
(declare-function 'gh-oauth-auth-new "gh-oauth")
(defun gh-auth-get-oauth-token ()
(let* ((profile (gh-profile-current-profile))
(token (or (plist-get (cdr (assoc profile gh-auth-alist)) :token)
(plist-get (cdr (assoc profile gh-profile-alist)) :token)
(gh-config "oauth-token"))))
(when (not token)
(let* ((api (make-instance 'gh-oauth-api))
(tok (and (fboundp 'gh-oauth-auth-new)
(oref (oref (funcall 'gh-oauth-auth-new api
'(user repo gist)) :data)
:token))))
(setq token (or tok (read-string "GitHub OAuth token: ")))
(gh-set-config "oauth-token" token)))
(gh-auth-remember profile :token token)
token))
;;;###autoload
(defclass gh-authenticator ()
((username :initarg :username :initform nil))
"Abstract authenticator")
(defmethod initialize-instance ((auth gh-authenticator) &rest args)
(call-next-method)
(or (oref auth :username)
(oset auth :username (gh-auth-get-username))))
(defmethod gh-auth-modify-request ((auth gh-authenticator) req)
req)
;;;###autoload
(defclass gh-auth-2fa-callback (gh-url-callback)
((req :initarg :req :initform nil))
"2-factor callback")
(defmethod gh-url-callback-run ((cb gh-auth-2fa-callback) resp)
(when (equal (oref resp :http-status) 401)
(let* ((otp-header "X-GitHub-OTP")
(h (assoc otp-header (oref resp :headers))))
(when (and h (string-prefix-p "required;" (cdr h)))
(let ((otp (read-from-minibuffer "Enter dual-factor auth code: "))
(req (oref cb :req)))
;; reset resp
(oset resp :data nil)
(oset resp :data-received nil)
(object-add-to-list req :headers
(cons otp-header otp))
(gh-url-run-request req resp))))))
;;;###autoload
(defclass gh-password-authenticator (gh-authenticator)
((password :initarg :password :protection :private :initform nil)
(remember :allocation :class :initform t)
(2fa-cls :initform gh-auth-2fa-callback :allocation :class))
"Password-based authenticator")
(defmethod initialize-instance ((auth gh-password-authenticator) &rest args)
(call-next-method)
(or (oref auth :password)
(oset auth :password (gh-auth-get-password (oref auth remember)))))
(defmethod gh-auth-modify-request ((auth gh-password-authenticator) req)
(object-add-to-list req :headers
(cons "Authorization"
(concat "Basic "
(base64-encode-string
(format "%s:%s" (oref auth :username)
(encode-coding-string
(oref auth :password) 'utf-8))))))
(object-add-to-list req :install-callbacks
(make-instance (oref auth 2fa-cls) :req req))
req)
;;;###autoload
(defclass gh-oauth-authenticator (gh-authenticator)
((token :initarg :token :protection :private :initform nil))
"Oauth-based authenticator")
(defmethod initialize-instance ((auth gh-oauth-authenticator) &rest args)
(call-next-method)
(or (oref auth :token)
(oset auth :token (gh-auth-get-oauth-token))))
(defmethod gh-auth-modify-request ((auth gh-oauth-authenticator) req)
(object-add-to-list req :headers
(cons "Authorization"
(format "token %s" (oref auth :token))))
req)
(provide 'gh-auth)
;; to avoid circular dependencies...
(require 'gh-oauth)
;;; gh-auth.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

255
elpa/gh-20160728.1525/gh-autoloads.el
View File

@ -1,255 +0,0 @@
;;; gh-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "gh-api" "gh-api.el" (22454 5329 956436 690000))
;;; Generated autoloads from gh-api.el
(require 'eieio)
(eieio-defclass-autoload 'gh-api 'nil "gh-api" "Github API")
(eieio-defclass-autoload 'gh-api-v3 '(gh-api) "gh-api" "Github API v3")
(eieio-defclass-autoload 'gh-api-request '(gh-url-request) "gh-api" nil)
(eieio-defclass-autoload 'gh-api-response '(gh-url-response) "gh-api" nil)
(eieio-defclass-autoload 'gh-api-paged-request '(gh-api-request) "gh-api" nil)
(eieio-defclass-autoload 'gh-api-paged-response '(gh-api-response) "gh-api" nil)
(eieio-defclass-autoload 'gh-api-callback '(gh-url-callback) "gh-api" nil)
;;;***
;;;### (autoloads nil "gh-auth" "gh-auth.el" (22454 5330 384446 754000))
;;; Generated autoloads from gh-auth.el
(require 'eieio)
(eieio-defclass-autoload 'gh-authenticator 'nil "gh-auth" "Abstract authenticator")
(eieio-defclass-autoload 'gh-auth-2fa-callback '(gh-url-callback) "gh-auth" "2-factor callback")
(eieio-defclass-autoload 'gh-password-authenticator '(gh-authenticator) "gh-auth" "Password-based authenticator")
(eieio-defclass-autoload 'gh-oauth-authenticator '(gh-authenticator) "gh-auth" "Oauth-based authenticator")
;;;***
;;;### (autoloads nil "gh-cache" "gh-cache.el" (22454 5330 226443
;;;;;; 38000))
;;; Generated autoloads from gh-cache.el
(require 'eieio)
(eieio-defclass-autoload 'gh-cache '(pcache-repository) "gh-cache" nil)
(eieio-defclass-autoload 'gh-cache-entry '(pcache-entry) "gh-cache" nil)
;;;***
;;;### (autoloads nil "gh-comments" "gh-comments.el" (22454 5329
;;;;;; 753431 916000))
;;; Generated autoloads from gh-comments.el
(require 'eieio)
(eieio-defclass-autoload 'gh-comments-api-mixin 'nil "gh-comments" :abstract)
;;;***
;;;### (autoloads nil "gh-common" "gh-common.el" (22454 5330 91439
;;;;;; 864000))
;;; Generated autoloads from gh-common.el
(require 'eieio)
(autoload 'gh-marshal-default-spec "gh-common" "\
\(fn SLOT)" nil nil)
(autoload 'gh-defclass "gh-common" "\
\(fn NAME SUPERCLASS SLOTS &rest OPTIONS-AND-DOC)" nil t)
(gh-defclass gh-object nil nil)
(gh-defclass gh-ref-object (gh-object) ((id :initarg :id) (url :initarg :url) (html-url :initarg :html-url)))
(gh-defclass gh-user (gh-ref-object) ((login :initarg :login) (gravatar-url :initarg :gravatar-url)) "Github user object")
(gh-defclass gh-comment (gh-ref-object) ((body :initarg :body) (user :initarg :user :initform nil :marshal-type gh-user) (created-at :initarg :created_at) (updated-at :initarg :updated_at)) "Github comment object")
;;;***
;;;### (autoloads nil "gh-gist" "gh-gist.el" (22454 5329 821433 515000))
;;; Generated autoloads from gh-gist.el
(require 'eieio)
(eieio-defclass-autoload 'gh-gist-api '(gh-api-v3) "gh-gist" "Gist API")
(gh-defclass gh-gist-gist-stub (gh-object) ((files :initarg :files :type list :initform nil :marshal-type (list gh-gist-gist-file)) (public :initarg :public :marshal-type bool) (description :initarg :description)) "Class for user-created gist objects")
(gh-defclass gh-gist-history-change (gh-object) ((total :initarg :total) (additions :initarg :additions) (deletions :initarg :deletions)))
(gh-defclass gh-gist-history-entry (gh-object) ((user :initarg :user :initform nil :marshal-type gh-user) (version :initarg :version) (committed :initarg :committed :marshal ((alist . committed_at))) (change :initarg :change :marshal ((alist . change_status)) :marshal-type gh-gist-history-change) (url :initarg :url)))
(gh-defclass gh-gist-fork-entry (gh-ref-object) ((user :initarg :user :initform nil :marshal-type gh-user) (created :initarg :created :marshal ((alist . created_at))) (updated :initarg :updated :marshal ((alist . updated_at)))))
(gh-defclass gh-gist-gist (gh-ref-object gh-gist-gist-stub) ((date :initarg :date :marshal ((alist . created_at))) (update :initarg :update :marshal ((alist . updated_at))) (push-url :initarg :push-url :marshal ((alist . git_push_url))) (pull-url :initarg :pull-url :marshal ((alist . git_pull_url))) (comments :initarg :comments) (user :initarg :user :initform nil :marshal-type gh-user :marshal ((alist . owner))) (history :initarg :history :initform nil :type list :marshal-type (list gh-gist-history-entry)) (forks :initarg :forks :initform nil :type list :marshal-type (list gh-gist-fork-entry))) "Gist object")
(gh-defclass gh-gist-gist-file (gh-object) ((filename :initarg :filename) (size :initarg :size) (url :initarg :url :marshal ((alist . raw_url))) (content :initarg :content)))
;;;***
;;;### (autoloads nil "gh-issue-comments" "gh-issue-comments.el"
;;;;;; (22454 5330 158441 440000))
;;; Generated autoloads from gh-issue-comments.el
(require 'eieio)
;;;***
;;;### (autoloads nil "gh-issues" "gh-issues.el" (22454 5330 260443
;;;;;; 838000))
;;; Generated autoloads from gh-issues.el
(require 'eieio)
(eieio-defclass-autoload 'gh-issues-api '(gh-api-v3 gh-comments-api-mixin) "gh-issues" "Github Issues api")
(gh-defclass gh-issues-issue (gh-ref-object) ((number :initarg :number) (state :initarg :state) (title :initarg :title) (body :initarg :body) (user :initarg :user :initform nil :marshal-type gh-user) (labels :initarg :labels :initform nil :marshal-type (list gh-issues-label)) (assignee :initarg :assignee :initform nil :marshal-type gh-user) (milestone :initarg :milestone :initform nil :marshal-type gh-issues-milestone) (comments :initarg :comments :initform 0) (pull-request :initarg :pull-request :marshal-type gh-issues-pull-request) (closed-at :initarg :created-at) (created-at :initarg :created-at) (updated-at :initarg :updated-at)) "issues request")
(gh-defclass gh-issues-pull-request (gh-object) ((html-url :initarg :html-url) (diff-url :initarg :diff-url) (patch-url :initarg :patch-url)))
(gh-defclass gh-issues-label (gh-ref-object) ((name :initarg :name) (color :initarg :color)))
(gh-defclass gh-issues-milestone (gh-ref-object) ((number :initarg :number) (state :initarg :state) (title :initarg :title) (description :initarg :description) (creator :initarg :creator :initform nil :marshal-type gh-user) (open-issues :initarg :open-issues) (closed-issues :initarg :closed-issues) (created-at :initarg :created-at) (due-on :initarg :due-on)) "github milestone")
(gh-defclass gh-issues-comment (gh-comment) nil)
;;;***
;;;### (autoloads nil "gh-oauth" "gh-oauth.el" (22454 5329 791432
;;;;;; 810000))
;;; Generated autoloads from gh-oauth.el
(require 'eieio)
(eieio-defclass-autoload 'gh-oauth-api '(gh-api-v3) "gh-oauth" "OAuth API")
(eieio-defclass-autoload 'gh-oauth-password-authenticator '(gh-password-authenticator) "gh-oauth" nil)
(gh-defclass gh-oauth-authorization (gh-ref-object) ((scopes :initarg :scopes) (token :initarg :token) (app :initarg :app :initform nil :marshal-type gh-oauth-app) (updated-at :initarg :updated-at) (created-at :initarg :created-at)))
(gh-defclass gh-oauth-app (gh-object) ((url :initarg :url) (name :initarg :name)))
;;;***
;;;### (autoloads nil "gh-orgs" "gh-orgs.el" (22454 5330 124440 640000))
;;; Generated autoloads from gh-orgs.el
(require 'eieio)
(eieio-defclass-autoload 'gh-orgs-api '(gh-api-v3) "gh-orgs" "Orgs API")
(gh-defclass gh-orgs-org-stub (gh-ref-object) ((login :initarg :login) (avatar-url :initarg :avatar-url) (description :initarg :description)))
(gh-defclass gh-orgs-plan (gh-object) ((name :initarg :name) (space :initarg :space) (private-repos :initarg :private-repos)))
(gh-defclass gh-orgs-org (gh-orgs-org-stub) ((name :initarg :name) (company :initarg :company) (blog :initarg :blog) (location :initarg :location) (email :initarg :email) (public-repos :initarg :public-repos) (public-gists :initarg :public-gists) (followers :initarg :followers) (following :initarg :following) (created-at :initarg :created-at) (type :initarg :type) (total-private-repos :initarg :total-private-repos) (owned-private-repos :initarg :owned-private-repos) (private-gists :initarg :private-gists) (disk-usage :initarg :disk-usage) (collaborators :initarg :collaborators) (billing-email :initarg :billing-email) (plan :initarg :plan :initform nil :marshal-type gh-orgs-plan)) "Class for GitHub organizations")
;;;***
;;;### (autoloads nil "gh-pull-comments" "gh-pull-comments.el" (22454
;;;;;; 5330 339445 696000))
;;; Generated autoloads from gh-pull-comments.el
(require 'eieio)
;;;***
;;;### (autoloads nil "gh-pulls" "gh-pulls.el" (22454 5330 294444
;;;;;; 637000))
;;; Generated autoloads from gh-pulls.el
(require 'eieio)
(eieio-defclass-autoload 'gh-pulls-cache '(gh-cache) "gh-pulls" nil)
(eieio-defclass-autoload 'gh-pulls-api '(gh-api-v3 gh-comments-api-mixin) "gh-pulls" "Git pull requests API")
(gh-defclass gh-pulls-comment (gh-comment) ((path :initarg :path) (diff-hunk :initarg :diff-hunk) (position :initarg :position) (original-position :initarg :original-position) (commit-id :initarg :commit-id) (original-commit-id :initarg :original-commit-id) (in-reply-to :initarg :in-reply-to :initform nil)))
(gh-defclass gh-pulls-request-stub (gh-ref-object) ((diff-url :initarg :diff-url) (patch-url :initarg :patch-url) (issue-url :initarg :issue-url) (number :initarg :number) (state :initarg :state) (title :initarg :title) (body :initarg :body) (created-at :initarg :created-at) (updated-at :initarg :updated-at) (closed-at :initarg :closed-at) (merged-at :initarg :merged-at) (head :initarg :head :initform nil :marshal-type gh-repos-ref) (base :initarg :base :initform nil :marshal-type gh-repos-ref)))
(gh-defclass gh-pulls-request (gh-pulls-request-stub) ((merged :initarg :merged) (mergeable :initarg :mergeable) (merged-by :initarg :merged-by) (comments :initarg :comments) (user :initarg :user :initform nil :marshal-type gh-user) (commits :initarg :commits) (additions :initarg :additions) (deletions :initarg :deletions) (changed-files :initarg :changed-files)) "Git pull requests API")
;;;***
;;;### (autoloads nil "gh-repos" "gh-repos.el" (22454 5330 192442
;;;;;; 239000))
;;; Generated autoloads from gh-repos.el
(require 'eieio)
(eieio-defclass-autoload 'gh-repos-api '(gh-api-v3) "gh-repos" "Repos API")
(gh-defclass gh-repos-repo-stub (gh-object) ((name :initarg :name) (description :initarg :description) (homepage :initarg :homepage) (private :initarg :private)) "Class for user-created repository objects")
(gh-defclass gh-repos-repo (gh-ref-object gh-repos-repo-stub) ((clone-url :initarg :clone-url) (git-url :initarg :git-url) (ssh-url :initarg :ssh-url) (svn-url :initarg :svn-url) (mirror-url :initarg :mirror-url) (owner :initarg :owner :initform nil :marshal-type gh-user) (full-name :initarg :full-name) (language :initarg :language) (fork :initarg :fork) (forks :initarg :forks) (forks-count :initarg :forks-count) (watchers :initarg :watchers) (watchers-count :initarg :watchers-count) (stargazers-count :initarg :stargazers-count) (size :initarg :size) (master-branch :initarg :master-branch) (open-issues :initarg :open-issues) (pushed-at :initarg :pushed-at) (created-at :initarg :created-at) (updated-at :initarg :updated-at) (organisation :initarg :organisation :initform nil :marshal-type gh-user) (parent :initarg :parent :marshal-type gh-repos-repo) (source :initarg :source :marshal-type gh-repos-repo) (has-issues :initarg :has-issues) (has-wiki :initarg :has-wiki) (has-downloads :initarg :has-downloads)) "Class for GitHub repositories")
(gh-defclass gh-repos-ref (gh-object) ((label :initarg :label) (ref :initarg :ref :initform nil) (sha :initarg :sha :initform nil) (user :initarg :user :initform nil :marshal-type gh-user) (repo :initarg :repo :initform nil :marshal-type gh-repos-repo)))
;;;***
;;;### (autoloads nil "gh-search" "gh-search.el" (22454 5329 866434
;;;;;; 573000))
;;; Generated autoloads from gh-search.el
(eieio-defclass-autoload 'gh-search-api '(gh-api-v3) "gh-search" nil)
;;;***
;;;### (autoloads nil "gh-url" "gh-url.el" (22454 5329 685430 317000))
;;; Generated autoloads from gh-url.el
(require 'eieio)
(eieio-defclass-autoload 'gh-url-request 'nil "gh-url" nil)
(eieio-defclass-autoload 'gh-url-response 'nil "gh-url" nil)
(eieio-defclass-autoload 'gh-url-callback 'nil "gh-url" nil)
;;;***
;;;### (autoloads nil "gh-users" "gh-users.el" (22454 5330 46438
;;;;;; 806000))
;;; Generated autoloads from gh-users.el
(require 'eieio)
(eieio-defclass-autoload 'gh-users-api '(gh-api-v3) "gh-users" "Users API")
(gh-defclass gh-users-user (gh-user) ((gravatar-id :initarg :gravatar-id) (html-url :initarg :html-url) (followers-url :initarg :followers-url) (following-url :initarg :following-url) (gists-url :initarg :gists-url) (starred-url :initarg :starred-url) (subscriptions-url :initarg :subscriptions-url) (organizations-url :initarg :organizations-url) (repos-url :initarg :repos-url) (events-url :initarg :events-url) (received-events-url :initarg :received-events-url) (type :initarg :type) (site-admin :initarg :site-admin) (name :initarg :name) (company :initarg :company) (blog :initarg :blog) (location :initarg :location) (email :initarg :email) (hireable :initarg :hireable) (bio :initarg :bio) (public-repos :initarg :public-repos) (public-gists :initarg :public-gists) (followers :initarg :followers) (following :initarg :following) (created-at :initarg :created-at) (update-at :initarg :update-at)))
;;;***
;;;### (autoloads nil nil ("gh-pkg.el" "gh-profile.el" "gh.el") (22454
;;;;;; 5330 1437 747000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; gh-autoloads.el ends here

138
elpa/gh-20160728.1525/gh-cache.el
View File

@ -1,138 +0,0 @@
;;; gh-cache.el --- caching for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'pcache)
(defconst gh-cache-outdated-expiration-delay (* 60 60 24))
(defconst gh-cache-internal-version-constant 4)
(defconst gh-cache-version-constant
(format "%s/gh-%s" pcache-version-constant gh-cache-internal-version-constant))
;;;###autoload
(defclass gh-cache (pcache-repository)
((version-constant :allocation :class)
(entries :initarg :entries :initform (make-hash-table :test 'equal))
(safe-methods :allocation :class :initform ("HEAD" "GET" "OPTIONS" "TRACE"))
(invalidation-chain :allocation :class :initform nil)
(entry-cls :initarg :entry-cls :initform gh-cache-entry)))
(oset-default 'gh-cache version-constant gh-cache-version-constant)
;;;###autoload
(defclass gh-cache-entry (pcache-entry)
((etag :initarg :etag :initform nil)
(outdated :initarg :outdated :initform nil)
;; (ttl :initarg :ttl :initform 0)
))
(defmethod pcache-invalidate :after ((cache gh-cache) key)
(let ((resource (car key)))
(pcache-map cache #'(lambda (k v)
(when (equal (car k) resource)
(pcache-invalidate cache k))))
(dolist (next (oref cache invalidation-chain))
(let ((nextresource
(replace-regexp-in-string (car next) (cdr next) resource)))
(when (not (equal nextresource resource))
(pcache-map cache #'(lambda (k v)
(when (equal (car k) nextresource)
(pcache-invalidate cache k)))))))))
(defmethod pcache-get ((cache gh-cache) key &optional default)
(let* ((table (oref cache :entries))
(entry (gethash key table)))
(if (not entry)
default
(unless (pcache-entry-valid-p entry)
(oset entry :outdated t))
(oref entry :value))))
(defmethod pcache-has ((cache pcache-repository) key)
(let* ((default (make-symbol ":nil"))
(table (oref cache :entries))
(entry (gethash key table default)))
(not (eq entry default))))
(defmethod pcache-purge-invalid ((cache gh-cache))
(let ((table (oref cache :entries)))
(maphash #'(lambda (k e)
(unless (gh-cache-expired-p e)
(remhash k table)))
table)
(pcache-save cache)))
(defmethod gh-cache-outdated-p ((cache gh-cache) key)
(let* ((table (oref cache :entries))
(entry (gethash key table)))
(and entry
(oref entry :outdated))))
(defmethod gh-cache-expired-p ((cache gh-cache) key)
(let* ((table (oref cache :entries))
(entry (gethash key table)))
(and (gh-cache-outdated-p cache key)
(not
(let ((time (float-time (current-time))))
(< time (+ gh-cache-outdated-expiration-delay
(oref entry :timestamp))))))))
(defmethod gh-cache-revive ((cache gh-cache) key)
(let* ((table (oref cache :entries))
(entry (gethash key table)))
(and entry
(oset entry :outdated nil)
(oset entry :timestamp (float-time (current-time)))
t)))
(defmethod gh-cache-etag ((cache gh-cache) key)
(let* ((table (oref cache :entries))
(entry (gethash key table)))
(and entry
(oref entry :etag))))
(defmethod gh-cache-set-etag ((cache gh-cache) key etag)
(let* ((table (oref cache :entries))
(entry (gethash key table)))
(and entry
(oset entry :etag etag))))
(provide 'gh-cache)
;;; gh-cache.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

71
elpa/gh-20160728.1525/gh-comments.el
View File

@ -1,71 +0,0 @@
;;; gh-comments.el --- support for comment-enabled APIs
;; Copyright (C) 2014-2015 Yann Hodique
;; Author: Yann Hodique <hodiquey@vmware.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-common)
(require 'gh-api)
;;;###autoload
(defclass gh-comments-api-mixin ()
((comment-cls :allocation :class :initform gh-comment))
:abstract t)
(defmethod gh-comments-list ((api gh-comments-api-mixin) base)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api comment-cls)) "GET"
(format "%s/comments" (gh-ref-object-base base))))
(defmethod gh-comments-get ((api gh-comments-api-mixin) base comment-id)
(gh-api-authenticated-request
api (gh-object-reader (oref api comment-cls)) "GET"
(format "%s/comments/%s" (gh-ref-object-base base) comment-id)))
(defmethod gh-comments-update ((api gh-comments-api-mixin) base comment-id comment)
(gh-api-authenticated-request
api (gh-object-reader (oref api comment-cls)) "PATCH"
(format "%s/comments/%s" (gh-ref-object-base base) comment-id)
(gh-comment-req-to-update comment)))
(defmethod gh-comments-new ((api gh-comments-api-mixin) base comment)
(gh-api-authenticated-request
api (gh-object-reader (oref api comment-cls)) "POST"
(format "%s/comments" (gh-ref-object-base base))
(gh-comment-req-to-update comment)))
(defmethod gh-comments-delete ((api gh-comments-api-mixin) base comment-id)
(gh-api-authenticated-request
api nil "DELETE"
(format "%s/comments/%s" (gh-ref-object-base base) comment-id)))
(provide 'gh-comments)
;;; gh-comments.el ends here

152
elpa/gh-20160728.1525/gh-common.el
View File

@ -1,152 +0,0 @@
;;; gh-common.el --- common objects for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'dash)
(require 'marshal)
(require 's)
(require 'gh-profile)
(defgroup gh nil
"Github API client libraries."
:group 'applications)
;;; Helper functions
(defun gh-read (obj field)
(cdr (assoc field obj)))
(defun gh-namespaced-key (key)
(let ((profile (gh-profile-current-profile)))
(concat "github."
(if (string= profile gh-profile-default-profile)
""
(concat profile "."))
key)))
(defun gh-config (key)
"Returns a GitHub specific value from the global Git config."
(let ((strip (lambda (string)
(if (> (length string) 0)
(substring string 0 (- (length string) 1))))))
(funcall strip (gh-command-to-string "config" (gh-namespaced-key key)))))
(defun gh-set-config (key value)
"Sets a GitHub specific value to the global Git config."
(gh-command-to-string "config" "--global" (gh-namespaced-key key) value))
(defun gh-command-to-string (&rest args)
(let ((git (executable-find "git")))
(with-output-to-string
(apply 'process-file git nil standard-output nil args))))
;;; Base classes for common objects
;;;###autoload
(defun gh-marshal-default-spec (slot)
(let ((slot-name (symbol-name slot)))
(list (cons 'alist
(intern (s-replace "-" "_" slot-name))))))
;;;###autoload
(defmacro gh-defclass (name superclass slots &rest options-and-doc)
`(marshal-defclass ,name ,superclass ,slots ,@options-and-doc
:marshal-default-spec gh-marshal-default-spec))
;;;###autoload
(gh-defclass gh-object ()
())
(defmethod gh-object-read :static ((obj gh-object) data)
(let ((target (if (object-p obj) obj
(make-instance obj))))
(when data
(gh-object-read-into target data))
target))
(defmethod gh-object-reader :static ((obj gh-object))
(apply-partially 'gh-object-read obj))
(defmethod gh-object-list-read :static ((obj gh-object) data)
(mapcar (gh-object-reader obj) data))
(defmethod gh-object-list-reader :static ((obj gh-object))
(apply-partially 'gh-object-list-read obj))
(defmethod gh-object-read-into ((obj gh-object) data)
(unmarshal obj data 'alist))
(defmethod slot-unbound ((obj gh-object) cls slot-name fn)
(if (eq fn 'oref) nil
(call-next-method)))
;;;###autoload
(gh-defclass gh-ref-object (gh-object)
((id :initarg :id)
(url :initarg :url)
(html-url :initarg :html-url)))
(defmethod gh-ref-object-base ((obj gh-ref-object))
(let ((url (oref obj :url)))
(--> (s-split "/" url t)
(-slice it 2)
(s-join "/" it)
(concat "/" it))))
(defmethod gh-ref-object-base (obj)
(if (stringp obj) obj
(error "illegal input for `gh-ref-object-base'")))
;;;###autoload
(gh-defclass gh-user (gh-ref-object)
((login :initarg :login)
(gravatar-url :initarg :gravatar-url))
"Github user object")
;;;###autoload
(gh-defclass gh-comment (gh-ref-object)
((body :initarg :body)
(user :initarg :user :initform nil :marshal-type gh-user)
(created-at :initarg :created_at)
(updated-at :initarg :updated_at))
"Github comment object")
(defmethod gh-comment-req-to-update ((req gh-comment))
`(("body" . ,(oref req :body))))
(provide 'gh-common)
;;; gh-common.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

176
elpa/gh-20160728.1525/gh-gist.el
View File

@ -1,176 +0,0 @@
;;; gh-gist.el --- gist module for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
;;;###autoload
(defclass gh-gist-api (gh-api-v3)
((gist-cls :allocation :class :initform gh-gist-gist))
"Gist API")
;;;###autoload
(gh-defclass gh-gist-gist-stub (gh-object)
((files :initarg :files :type list :initform nil :marshal-type (list gh-gist-gist-file))
(public :initarg :public :marshal-type bool)
(description :initarg :description))
"Class for user-created gist objects")
;;;###autoload
(gh-defclass gh-gist-history-change (gh-object)
((total :initarg :total)
(additions :initarg :additions)
(deletions :initarg :deletions)))
;;;###autoload
(gh-defclass gh-gist-history-entry (gh-object)
((user :initarg :user :initform nil :marshal-type gh-user)
(version :initarg :version)
(committed :initarg :committed :marshal ((alist . committed_at)))
(change :initarg :change :marshal ((alist . change_status))
:marshal-type gh-gist-history-change)
(url :initarg :url)))
;;;###autoload
(gh-defclass gh-gist-fork-entry (gh-ref-object)
((user :initarg :user :initform nil :marshal-type gh-user)
(created :initarg :created :marshal ((alist . created_at)))
(updated :initarg :updated :marshal ((alist . updated_at)))))
;;;###autoload
(gh-defclass gh-gist-gist (gh-ref-object gh-gist-gist-stub)
((date :initarg :date :marshal ((alist . created_at)))
(update :initarg :update :marshal ((alist . updated_at)))
(push-url :initarg :push-url :marshal ((alist . git_push_url)))
(pull-url :initarg :pull-url :marshal ((alist . git_pull_url)))
(comments :initarg :comments)
(user :initarg :user :initform nil :marshal-type gh-user :marshal ((alist . owner)))
(history :initarg :history :initform nil :type list :marshal-type (list gh-gist-history-entry))
(forks :initarg :forks :initform nil :type list :marshal-type (list gh-gist-fork-entry)))
"Gist object")
;;;###autoload
(gh-defclass gh-gist-gist-file (gh-object)
((filename :initarg :filename)
(size :initarg :size)
(url :initarg :url :marshal ((alist . raw_url)))
(content :initarg :content)))
(defmethod gh-gist-gist-to-obj ((gist gh-gist-gist-stub))
(let ((files (mapcar #'gh-gist-gist-file-to-obj (oref gist :files))))
`(("description" . ,(oref gist :description))
("public" . ,(oref gist :public))
,@(and files (list (cons "files" files))))))
(defmethod gh-gist-gist-has-files ((gist gh-gist-gist-stub))
(not (memq nil (mapcar (lambda (f)
(oref f :content)) (oref gist :files)))))
(defmethod gh-gist-gist-file-to-obj ((file gh-gist-gist-file))
(let* ((filename (oref file :filename))
(content (oref file :content))
(file (if content
`(("filename" . ,filename)
("content" . ,content))
nil)))
(cons filename file)))
(defmethod gh-gist-list ((api gh-gist-api) &optional username)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api gist-cls)) "GET"
(format "/users/%s/gists" (or username (gh-api-get-username api)))))
(defmethod gh-gist-list-public ((api gh-gist-api))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api gist-cls)) "GET" "/gists/public"))
(defmethod gh-gist-list-starred ((api gh-gist-api))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api gist-cls)) "GET" "/gists/starred"))
(defmethod gh-gist-get ((api gh-gist-api) gist-or-id)
(let (id transformer)
(if (stringp gist-or-id)
(setq id gist-or-id
transformer (gh-object-reader (oref api gist-cls)))
(setq id (oref gist-or-id :id)
transformer (gh-object-reader gist-or-id)))
(gh-api-authenticated-request
api transformer "GET" (format "/gists/%s" id))))
(defmethod gh-gist-new ((api gh-gist-api) gist-stub)
(gh-api-authenticated-request
api (gh-object-reader (oref api gist-cls)) "POST" "/gists"
(gh-gist-gist-to-obj gist-stub)))
(defmethod gh-gist-edit ((api gh-gist-api) gist)
(gh-api-authenticated-request
api (gh-object-reader (oref api gist-cls)) "PATCH"
(format "/gists/%s"
(oref gist :id))
(gh-gist-gist-to-obj gist)))
(defmethod gh-gist-set-star ((api gh-gist-api) gist-or-id star)
(let ((id (if (stringp gist-or-id) gist-or-id
(oref gist-or-id :id))))
(gh-api-authenticated-request
api 'ignore (if star "PUT" "DELETE")
(format "/gists/%s/star" id))))
(defmethod gh-gist-get-star ((api gh-gist-api) gist-or-id)
(let ((id (if (stringp gist-or-id) gist-or-id
(oref gist-or-id :id))))
(gh-api-authenticated-request
api 'ignore "GET" (format "/gists/%s/star" id))))
(defmethod gh-gist-fork ((api gh-gist-api) gist-or-id)
(let ((id (if (stringp gist-or-id) gist-or-id
(oref gist-or-id :id))))
(gh-api-authenticated-request
api (gh-object-reader (oref api gist-cls)) "POST"
(format "/gists/%s/forks" id))))
(defmethod gh-gist-delete ((api gh-gist-api) gist-or-id)
(let ((id (if (stringp gist-or-id) gist-or-id
(oref gist-or-id :id))))
(gh-api-authenticated-request
api 'ignore "DELETE" (format "/gists/%s" id))))
(provide 'gh-gist)
;;; gh-gist.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

72
elpa/gh-20160728.1525/gh-issue-comments.el
View File

@ -1,72 +0,0 @@
;;; gh-issue-comments.el --- issue comments api for github
;; Copyright (C) 2014 Travis Thieman
;; Author: Travis Thieman <travis.thieman@gmail.com>
;; Keywords:
;; 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:
;; TODOS:
;; * Support listing all comments in a repository
;; Basic usage:
;; (setf api (gh-issue-comments-api "api" :sync nil :cache nil :num-retries 1))
;; (setf comments (gh-issue-comments-list api "user" "repo" "issue id"))
;; (setq my-comment (make-instance 'gh-issue-comments-comment :body "This is great!"))
;; (gh-issue-comments-new api "user" "repo" "issue id" my-comment)
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
(require 'gh-issues)
(let ((ver "1.0.0"))
(define-obsolete-function-alias
'gh-issue-comments-api 'gh-issues-api ver)
(define-obsolete-function-alias
'gh-issue-comments-comment 'gh-issues-comment ver)
(define-obsolete-function-alias
'gh-issue-comments-req-to-update 'gh-comment-req-to-update ver)
(define-obsolete-function-alias
'gh-issue-comments-list 'gh-issues-comments-list ver)
(define-obsolete-function-alias
'gh-issue-comments-get 'gh-issues-comments-get ver)
(define-obsolete-function-alias
'gh-issue-comments-update 'gh-issues-comments-update ver)
(define-obsolete-function-alias
'gh-issue-comments-new 'gh-issues-comments-new ver)
(define-obsolete-function-alias
'gh-issue-comments-delete 'gh-issues-comments-delete ver))
(provide 'gh-issue-comments)
;;; gh-issue-comments.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

281
elpa/gh-20160728.1525/gh-issues.el
View File

@ -1,281 +0,0 @@
;;; gh-issues.el --- issues api for github
;; Copyright (C) 2014-2015 Yann Hodique
;; Copyright (C) 2014 Travis Thieman
;; Copyright (C) 2012 Raimon Grau
;; Author: Raimon Grau <raimonster@gmail.com>
;; Keywords:
;; 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:
;; Basic usage:
;; (setf api (gh-issues-api "api" :sync nil :cache nil :num-retries 1))
;; (setf issues (gh-issues-list api "user" "repo"))
;; (last (oref issues data)) ; get one issue
;; (setq mi (make-instance 'gh-issues-issue :body "issue body" :title "issue title"))
;; (gh-issues-issue-new api "user" "repo" mi)
;; (setf comments (gh-issues-comments-list api "user" "repo" "issue id"))
;; (setq my-comment (make-instance 'gh-issues-comment :body "This is great!"))
;; (gh-issues-comments-new api "user" "repo" "issue id" my-comment)
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-comments)
(require 'gh-common)
(require 'gh-repos)
;;;###autoload
(defclass gh-issues-api (gh-api-v3 gh-comments-api-mixin)
((issue-cls :allocation :class :initform gh-issues-issue)
(milestone-cls :allocation :class :initform gh-issues-milestone)
(label-cls :allocation :class :initform gh-issues-label)
(comment-cls :allocation :class :initform gh-issues-comment))
"Github Issues api")
;;;###autoload
(gh-defclass gh-issues-issue (gh-ref-object)
((number :initarg :number)
(state :initarg :state)
(title :initarg :title)
(body :initarg :body)
(user :initarg :user :initform nil :marshal-type gh-user)
(labels :initarg :labels :initform nil :marshal-type (list gh-issues-label))
(assignee :initarg :assignee :initform nil :marshal-type gh-user)
(milestone :initarg :milestone :initform nil :marshal-type gh-issues-milestone)
(comments :initarg :comments :initform 0)
(pull-request :initarg :pull-request :marshal-type gh-issues-pull-request)
(closed-at :initarg :created-at)
(created-at :initarg :created-at)
(updated-at :initarg :updated-at))
"issues request")
;;;###autoload
(gh-defclass gh-issues-pull-request (gh-object)
((html-url :initarg :html-url)
(diff-url :initarg :diff-url)
(patch-url :initarg :patch-url)))
;;;###autoload
(gh-defclass gh-issues-label (gh-ref-object)
((name :initarg :name)
(color :initarg :color)))
(defmethod gh-issues-label-req-to-update ((label gh-issues-label))
`(("name" . ,(oref label :name))
("color" . ,(oref label :color))))
;;;###autoload
(gh-defclass gh-issues-milestone (gh-ref-object)
((number :initarg :number)
(state :initarg :state)
(title :initarg :title)
(description :initarg :description)
(creator :initarg :creator :initform nil :marshal-type gh-user)
(open-issues :initarg :open-issues )
(closed-issues :initarg :closed-issues)
(created-at :initarg :created-at)
(due-on :initarg :due-on))
"github milestone")
;;;###autoload
(gh-defclass gh-issues-comment (gh-comment)
())
(defmethod gh-issues-issue-list ((api gh-issues-api) user repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api issue-cls)) "GET"
(format "/repos/%s/%s/issues" user repo)))
(defmethod gh-issues-milestone-list ((api gh-issues-api) user repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api milestone-cls)) "GET"
(format "/repos/%s/%s/milestones" user repo)))
(defmethod gh-issues-milestone-get ((api gh-issues-api) user repo id)
(gh-api-authenticated-request
api (gh-object-reader (oref api milestone-cls)) "GET"
(format "/repos/%s/%s/milestones/%s" user repo id)))
(defmethod gh-issues-milestone-new ((api gh-issues-api) user repo milestone)
(gh-api-authenticated-request
api (gh-object-reader (oref api milestone-cls)) "POST"
(format "/repos/%s/%s/milestones" user repo)
(gh-issues-milestone-req-to-update milestone)))
(defmethod gh-issues-milestone-update ((api gh-issues-api) user repo
id milestone)
(gh-api-authenticated-request
api (gh-object-reader (oref api milestone-cls)) "PATCH"
(format "/repos/%s/%s/milestones/%s" user repo id)
(gh-issues-milestone-req-to-update milestone)))
(defmethod gh-issues-milestone-req-to-update ((milestone gh-issues-milestone))
(let ((state (oref milestone :state))
(description (oref milestone :description))
(due-on (oref milestone :due-on))
(to-update `(("title" . ,(oref milestone :title)))))
(when state (nconc to-update `(("state" . ,state))))
(when description (nconc to-update `(("description" . ,description))))
(when due-on (nconc to-update `(("due_on" . ,due-on))))
to-update))
(defmethod gh-issues-issue-get ((api gh-issues-api) user repo id)
(gh-api-authenticated-request
api (gh-object-reader (oref api issue-cls)) "GET"
(format "/repos/%s/%s/issues/%s" user repo id)))
(defmethod gh-issues-issue-req-to-update ((req gh-issues-issue))
(let ((assignee (oref req :assignee))
;; (labels (oref req labels))
(milestone (oref req :milestone))
(to-update `(("title" . ,(oref req :title))
("state" . ,(oref req :state))
("body" . ,(oref req :body)))))
;; (when labels (nconc to-update `(("labels" . ,(oref req labels) ))))
(when milestone
(nconc to-update `(("milestone" . ,(oref milestone :number)))))
(when assignee
(nconc to-update `(("assignee" . ,(oref assignee :login)))))
to-update))
(defmethod gh-issues-issue-update ((api gh-issues-api) user repo id req)
(gh-api-authenticated-request
api (gh-object-reader (oref api issue-cls)) "PATCH"
(format "/repos/%s/%s/issues/%s" user repo id)
(gh-issues-issue-req-to-update req)))
(defmethod gh-issues-issue-new ((api gh-issues-api) user repo issue)
(gh-api-authenticated-request
api (gh-object-reader (oref api issue-cls)) "POST"
(format "/repos/%s/%s/issues" user repo)
(gh-issues-issue-req-to-update issue)))
;;; Labels
(defmethod gh-issues-label-get ((api gh-issues-api) user repo name)
(gh-api-authenticated-request
api (gh-object-reader (oref api label-cls)) "GET"
(format "/repos/%s/%s/labels/%s" user repo name)))
(defmethod gh-issues-label-list ((api gh-issues-api) user repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api label-cls)) "GET"
(format "/repos/%s/%s/labels" user repo )))
(defmethod gh-issues-label-new ((api gh-issues-api) user repo req)
(gh-api-authenticated-request
api (gh-object-reader (oref api label-cls)) "POST"
(format "/repos/%s/%s/labels" user repo)
(gh-issues-label-req-to-update req)))
(defmethod gh-issues-label-update ((api gh-issues-api) user repo req)
(gh-api-authenticated-request
api (gh-object-reader (oref api label-cls)) "POST"
(format "/repos/%s/%s/labels/%s" user repo (oref req :name))
(gh-issues-label-req-to-update req)))
(defmethod gh-issues-label-delete ((api gh-issues-api) user repo name)
(gh-api-authenticated-request
api (gh-object-reader (oref api label-cls)) "DELETE"
(format "/repos/%s/%s/labels/%s" user repo name)))
(defmethod gh-issues-labels-in-issue ((api gh-issues-api) user repo
issue-or-issue-id)
(let ((issue-id (gh-issues--issue-id issue-or-issue-id)))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api label-cls)) "GET"
(format "/repos/%s/%s/issues/%s/labels" user repo issue-id))))
(defmethod gh-issues-labels-add-to-issue ((api gh-issues-api) user repo
issue-or-issue-id labels)
(let ((issue-id (gh-issues--issue-id issue-or-issue-id)))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api label-cls)) "PUT"
(format "/repos/%s/%s/issues/%s/labels" user repo issue-id)
(mapcar #'gh-issues--label-name labels))))
(defmethod gh-issues-labels-remove-all-from-issue ((api gh-issues-api) user repo
issue-or-issue-id )
(let ((issue-id (gh-issues--issue-id issue-or-issue-id)))
(gh-api-authenticated-request
api (lambda (x) x) "DELETE"
(format "/repos/%s/%s/issues/%s/labels" user repo issue-id))))
(defmethod gh-issues-labels-in-milestone ((api gh-issues-api) user repo
milestone-or-milestone-id)
(let ((milestone-id (gh-issues--milestone-id milestone-or-milestone-id)))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api label-cls)) "GET"
(format "/repos/%s/%s/milestones/%s/labels" user repo milestone-id))))
;;; Comments
(defmethod gh-issues-comments-list ((api gh-issues-api) user repo issue-id)
(gh-comments-list api (format "/repos/%s/%s/issues/%s" user repo issue-id)))
(defmethod gh-issues-comments-get ((api gh-issues-api) user repo comment-id)
(gh-comments-get api (format "/repos/%s/%s/issues" user repo) comment-id))
(defmethod gh-issues-comments-update ((api gh-issues-api)
user repo comment-id comment)
(gh-comments-update api (format "/repos/%s/%s/issues" user repo)
comment-id (gh-comment-req-to-update comment)))
(defmethod gh-issues-comments-new ((api gh-issues-api)
user repo issue-id comment)
(gh-comments-new api (format "/repos/%s/%s/issues/%s" user repo issue-id)
(gh-comment-req-to-update comment)))
(defmethod gh-issues-comments-delete ((api gh-issues-api) user repo comment-id)
(gh-comments-delete api (format "/repos/%s/%s/issues" user repo) comment-id))
;;; helpers
(defun gh-issues--issue-id (issue-or-issue-id)
(if (eieio-object-p issue-or-issue-id)
(oref issue-or-issue-id :id)
issue-or-issue-id))
(defun gh-issues--milestone-id (milestone-or-milestone-id)
(if (eieio-object-p milestone-or-milestone-id)
(oref milestone-or-milestone-id :id)
milestone-or-milestone-id))
(defun gh-issues--label-name (label-or-label-name)
(if (eieio-object-p label-or-label-name)
(oref label-or-label-name :name)
label-or-label-name))
(provide 'gh-issues)
;;; gh-issues.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

97
elpa/gh-20160728.1525/gh-oauth.el
View File

@ -1,97 +0,0 @@
;;; gh-oauth.el --- oauth module for gh.el
;; Copyright (C) 2012 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
;;;###autoload
(defclass gh-oauth-api (gh-api-v3)
((auth-cls :allocation :class :initform gh-oauth-authorization))
"OAuth API")
;;;###autoload
(defclass gh-oauth-password-authenticator (gh-password-authenticator)
((remember :allocation :class :initform nil)))
(defmethod initialize-instance ((api gh-oauth-api) &rest args)
;; force password authentication for this API
(let ((gh-api-v3-authenticator 'gh-oauth-password-authenticator))
(call-next-method)))
;;;###autoload
(gh-defclass gh-oauth-authorization (gh-ref-object)
((scopes :initarg :scopes)
(token :initarg :token)
(app :initarg :app :initform nil :marshal-type gh-oauth-app)
(updated-at :initarg :updated-at)
(created-at :initarg :created-at)))
;;;###autoload
(gh-defclass gh-oauth-app (gh-object)
((url :initarg :url)
(name :initarg :name)))
(defmethod gh-oauth-auth-list ((api gh-oauth-api))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api auth-cls)) "GET"
(format "/authorizations")))
(defmethod gh-oauth-auth-get ((api gh-oauth-api) id)
(gh-api-authenticated-request
api (gh-object-reader (oref api auth-cls)) "GET"
(format "/authorizations/%s" id)))
(defmethod gh-oauth-auth-new ((api gh-oauth-api) &optional scopes)
(gh-api-authenticated-request
api (gh-object-reader (oref api auth-cls)) "POST"
(format "/authorizations") (list (cons 'scopes scopes)
(cons 'note (format "gh.el - %s"
(system-name))))))
(defmethod gh-oauth-auth-update ((api gh-oauth-api) id &optional scopes)
(gh-api-authenticated-request
api (gh-object-reader (oref api auth-cls)) "PATCH"
(format "/authorizations/%s" id) (list (cons 'scopes scopes))))
(defmethod gh-oauth-auth-delete ((api gh-oauth-api) id)
(gh-api-authenticated-request
api nil "DELETE" (format "/authorizations/%s" id)))
(provide 'gh-oauth)
;;; gh-oauth.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

113
elpa/gh-20160728.1525/gh-orgs.el
View File

@ -1,113 +0,0 @@
;;; gh-org.el --- orgs module for gh.el
;; Copyright (C) 2012 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
;;;###autoload
(defclass gh-orgs-api (gh-api-v3)
((org-cls :allocation :class :initform gh-orgs-org))
"Orgs API")
;;;###autoload
(gh-defclass gh-orgs-org-stub (gh-ref-object)
((login :initarg :login)
(avatar-url :initarg :avatar-url)
(description :initarg :description)))
;;;###autoload
(gh-defclass gh-orgs-plan (gh-object)
((name :initarg :name)
(space :initarg :space)
(private-repos :initarg :private-repos)))
;;;###autoload
(gh-defclass gh-orgs-org (gh-orgs-org-stub)
((name :initarg :name)
(company :initarg :company)
(blog :initarg :blog)
(location :initarg :location)
(email :initarg :email)
(public-repos :initarg :public-repos)
(public-gists :initarg :public-gists)
(followers :initarg :followers)
(following :initarg :following)
(created-at :initarg :created-at)
(type :initarg :type)
(total-private-repos :initarg :total-private-repos)
(owned-private-repos :initarg :owned-private-repos)
(private-gists :initarg :private-gists)
(disk-usage :initarg :disk-usage)
(collaborators :initarg :collaborators)
(billing-email :initarg :billing-email)
(plan :initarg :plan :initform nil :marshal-type gh-orgs-plan))
"Class for GitHub organizations")
(defmethod gh-orgs-org-to-obj ((org gh-orgs-org))
`(,@(when (slot-boundp org :billing-email)
(list (cons "billing_email" (oref org :billing-email))))
,@(when (slot-boundp org :blog)
(list (cons "blog" (oref org :blog))))
,@(when (slot-boundp org :company)
(list (cons "company" (oref org :company))))
,@(when (slot-boundp org :email)
(list (cons "email" (oref org :email))))
,@(when (slot-boundp org :location)
(list (cons "location" (oref org :location))))
,@(when (slot-boundp org :name)
(list (cons "name" (oref org :name))))))
(defmethod gh-orgs-list ((api gh-orgs-api) &optional username)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api org-cls)) "GET"
(format "/users/%s/orgs" (or username (gh-api-get-username api)))))
(defmethod gh-orgs-get ((api gh-orgs-api) org)
(gh-api-authenticated-request
api (gh-object-reader (oref api org-cls)) "GET"
(format "/orgs/%s" org)))
(defmethod gh-orgs-update ((api gh-orgs-api) org-obj)
(gh-api-authenticated-request
api (gh-object-reader (oref api org-cls)) "PATCH"
(format "/orgs/%s" (oref org-obj :login))
(apply 'gh-orgs-org-to-obj org-obj nil)))
(provide 'gh-orgs)
;;; gh-org.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

10
elpa/gh-20160728.1525/gh-pkg.el
View File

@ -1,10 +0,0 @@
(define-package "gh" "20160728.1525" "A GitHub library for Emacs"
'((emacs "24.3")
(s "1.9.0")
(dash "2.9.0")
(pcache "0.4.1")
(logito "0.1")
(marshal "0.6.3")))
;; Local Variables:
;; no-byte-compile: t
;; End:

103
elpa/gh-20160728.1525/gh-profile.el
View File

@ -1,103 +0,0 @@
;;; gh-profile.el --- profile support for gh.el
;; Copyright (C) 2013 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
(require 'rx)
(require 'url-parse)
(defgroup gh-profile nil
"Github profile."
:group 'gh)
(defun gh-profile-remote-regexp (domain)
(eval
`(rx bol (or ,(concat "git@" domain ":")
(and (or "git" "ssh" "http" "https") "://"
(* nonl) (? "@") ,domain "/"))
(and (group (* nonl)) "/" (group (* nonl))) (? ".git"))))
(defcustom gh-profile-alist `(("github"
:url "https://api.github.com"
:remote-regexp
,(gh-profile-remote-regexp "github.com")))
"List of profiles for Github access. List every Github
Enterprise server and/or Github accounts you have access
to here."
:type '(alist :key-type string
:value-type (plist :key-type (choice (const :url)
(const :username)
(const :password)
(const :token)
(const :remote-regexp))
:value-type string))
:group 'gh-profile)
(defun gh-profile-get-remote-regexp (profile)
(let* ((profile-plist (cdr (assoc profile gh-profile-alist)))
(regexp (plist-get profile-plist :remote-regexp)))
(if regexp
regexp
;; try to guess remote format (just use the hostname)
(let* ((url (url-generic-parse-url (plist-get profile-plist :url)))
(host (url-host url)))
(gh-profile-remote-regexp host)))))
(defcustom gh-profile-default-profile "github"
"Default profile. This needs to be a key present in
`gh-profile-alist'"
:type 'string
:group 'gh-profile)
(defvar gh-profile-current-profile nil)
(make-variable-buffer-local 'gh-profile-current-profile)
(defun gh-profile-current-profile ()
(or gh-profile-current-profile
gh-profile-default-profile))
(defun gh-profile-url ()
(plist-get (cdr (assoc (or gh-profile-current-profile
gh-profile-default-profile)
gh-profile-alist)) :url))
(defun gh-profile-completing-read ()
(let ((profiles (mapcar #'car gh-profile-alist)))
(if (> (length profiles) 1)
(completing-read "Github profile: " profiles nil t nil nil (first profiles))
(car profiles))))
(defun gh-profile-get-remote-profile (remote-url)
(loop for (id . props) in gh-profile-alist
if (string-match (gh-profile-get-remote-regexp id)
remote-url)
return id))
(provide 'gh-profile)
;;; gh-profile.el ends here

78
elpa/gh-20160728.1525/gh-pull-comments.el
View File

@ -1,78 +0,0 @@
;;; gh-pull-comments.el --- pull request comments api for github
;; Copyright (C) 2014 Toni Reina
;; Author: Toni Reina <areina0@gmail.com>
;; Keywords:
;; 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:
;; TODOS:
;; * Support listing all comments in a repository
;; Basic usage:
;; (setf api (gh-pull-comments-api "api" :sync nil :cache nil :num-retries 1))
;; (setf comments (gh-pull-comments-list api "user" "repo" "pull request id"))
;; (setq my-comment (make-instance 'gh-pull-comments-comment
;; :body "This is great!"
;; :path "README.md"
;; :position 2
;; :commit-id "commit sha"))
;; (gh-pull-comments-new api "user" "repo" "pull request id" my-comment)
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
(require 'gh-pulls)
(let ((ver "1.0.0"))
(define-obsolete-function-alias
'gh-pull-comments-api 'gh-pulls-api ver)
(define-obsolete-function-alias
'gh-pull-comments-comment 'gh-pulls-comment ver)
(define-obsolete-function-alias
'gh-pull-comments-req-to-update 'gh-comment-req-to-update ver)
(define-obsolete-function-alias
'gh-pull-comments-req-to-create 'gh-pulls-comment-req-to-create)
(define-obsolete-function-alias
'gh-pull-comments-list 'gh-pulls-comments-list ver)
(define-obsolete-function-alias
'gh-pull-comments-get 'gh-pulls-comments-get ver)
(define-obsolete-function-alias
'gh-pull-comments-update 'gh-pulls-comments-update ver)
(define-obsolete-function-alias
'gh-pull-comments-new 'gh-pulls-comments-new ver)
(define-obsolete-function-alias
'gh-pull-comments-delete 'gh-pulls-comments-delete ver))
(provide 'gh-pull-comments)
;;; gh-pull-comments.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

166
elpa/gh-20160728.1525/gh-pulls.el
View File

@ -1,166 +0,0 @@
;;; gh-pulls.el --- pull requests module for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-comments)
(require 'gh-common)
(require 'gh-repos)
;;;###autoload
(defclass gh-pulls-cache (gh-cache)
((invalidation-chain :allocation :class
:initform '(("^/repos/.*/.*/pulls$" . "\0")
("^/repos/.*/.*/pulls/.*$" . "\0")))))
;;;###autoload
(defclass gh-pulls-api (gh-api-v3 gh-comments-api-mixin)
((cache-cls :allocation :class :initform gh-pulls-cache)
(req-cls :allocation :class :initform gh-pulls-request)
(comment-cls :allocation :class :initform gh-pulls-comment))
"Git pull requests API")
;;;###autoload
(gh-defclass gh-pulls-comment (gh-comment)
((path :initarg :path)
(diff-hunk :initarg :diff-hunk)
(position :initarg :position)
(original-position :initarg :original-position)
(commit-id :initarg :commit-id)
(original-commit-id :initarg :original-commit-id)
(in-reply-to :initarg :in-reply-to :initform nil)))
(defmethod gh-pulls-comment-req-to-create ((req gh-pulls-comment))
(let ((in-reply-to (oref req in-reply-to))
(to-update `(("body" . ,(oref req body)))))
(if in-reply-to
(nconc to-update `(("in_reply_to" . ,in-reply-to)))
(nconc to-update `(("commit_id" . ,(oref req commit-id))
("path" . ,(oref req path))
("position" . ,(oref req position)))))
to-update))
;;;###autoload
(gh-defclass gh-pulls-request-stub (gh-ref-object)
((diff-url :initarg :diff-url)
(patch-url :initarg :patch-url)
(issue-url :initarg :issue-url)
(number :initarg :number)
(state :initarg :state)
(title :initarg :title)
(body :initarg :body)
(created-at :initarg :created-at)
(updated-at :initarg :updated-at)
(closed-at :initarg :closed-at)
(merged-at :initarg :merged-at)
(head :initarg :head :initform nil :marshal-type gh-repos-ref)
(base :initarg :base :initform nil :marshal-type gh-repos-ref)))
;;;###autoload
(gh-defclass gh-pulls-request (gh-pulls-request-stub)
((merged :initarg :merged)
(mergeable :initarg :mergeable)
(merged-by :initarg :merged-by)
(comments :initarg :comments)
(user :initarg :user :initform nil :marshal-type gh-user)
(commits :initarg :commits)
(additions :initarg :additions)
(deletions :initarg :deletions)
(changed-files :initarg :changed-files))
"Git pull requests API")
(defmethod gh-pulls-req-to-new ((req gh-pulls-request))
(let ((head (oref req :head))
(base (oref req :base)))
`(("title" . ,(oref req :title))
("body" . ,(oref req :body))
("head" . ,(or (oref head :ref) (oref head :sha)))
("base" . ,(or (oref base :ref) (oref base :sha))))))
(defmethod gh-pulls-req-to-update ((req gh-pulls-request-stub))
`(("title" . ,(oref req :title))
("body" . ,(oref req :body))
("state" . ,(oref req :state))))
(defmethod gh-pulls-list ((api gh-pulls-api) user repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api req-cls)) "GET"
(format "/repos/%s/%s/pulls" user repo)))
(defmethod gh-pulls-get ((api gh-pulls-api) user repo id)
(gh-api-authenticated-request
api (gh-object-reader (oref api req-cls)) "GET"
(format "/repos/%s/%s/pulls/%s" user repo id)))
(defmethod gh-pulls-new ((api gh-pulls-api) user repo req)
(gh-api-authenticated-request
api (gh-object-reader (oref api req-cls)) "POST"
(format "/repos/%s/%s/pulls" user repo)
(gh-pulls-req-to-new req)))
(defmethod gh-pulls-update ((api gh-pulls-api) user repo id req)
(gh-api-authenticated-request
api (gh-object-reader (oref api req-cls)) "PATCH"
(format "/repos/%s/%s/pulls/%s" user repo id)
(gh-pulls-req-to-update req)))
;;; Comments
(defmethod gh-pulls-comments-list ((api gh-pulls-api) user repo pull-id)
(gh-comments-list api (format "/repos/%s/%s/pulls/%s" user repo pull-id)))
(defmethod gh-pulls-comments-get ((api gh-pulls-api) user repo comment-id)
(gh-comments-get api (format "/repos/%s/%s/pulls" user repo) comment-id))
(defmethod gh-pulls-comments-update ((api gh-pulls-api)
user repo comment-id comment)
(gh-comments-update api (format "/repos/%s/%s/pulls" user repo)
comment-id (gh-comment-req-to-update comment)))
(defmethod gh-pulls-comments-new ((api gh-pulls-api)
user repo pull-id comment)
(gh-comments-new api (format "/repos/%s/%s/pulls/%s" user repo pull-id)
(gh-pulls-comment-req-to-create comment)))
(defmethod gh-pulls-comments-delete ((api gh-pulls-api) user repo comment-id)
(gh-comments-delete api (format "/repos/%s/%s/pulls" user repo) comment-id))
(provide 'gh-pulls)
;;; gh-pulls.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

350
elpa/gh-20160728.1525/gh-repos.el
View File

@ -1,350 +0,0 @@
;;; gh-repos.el --- repos module for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
;;;###autoload
(defclass gh-repos-api (gh-api-v3)
((repo-cls :allocation :class :initform gh-repos-repo)
(user-cls :allocation :class :initform gh-user))
"Repos API")
;;;###autoload
(gh-defclass gh-repos-repo-stub (gh-object)
((name :initarg :name)
(description :initarg :description)
(homepage :initarg :homepage)
(private :initarg :private))
"Class for user-created repository objects")
;;;###autoload
(gh-defclass gh-repos-repo (gh-ref-object gh-repos-repo-stub)
((clone-url :initarg :clone-url)
(git-url :initarg :git-url)
(ssh-url :initarg :ssh-url)
(svn-url :initarg :svn-url)
(mirror-url :initarg :mirror-url)
(owner :initarg :owner :initform nil :marshal-type gh-user)
(full-name :initarg :full-name)
(language :initarg :language)
(fork :initarg :fork)
(forks :initarg :forks)
(forks-count :initarg :forks-count)
(watchers :initarg :watchers)
(watchers-count :initarg :watchers-count)
(stargazers-count :initarg :stargazers-count)
(size :initarg :size)
(master-branch :initarg :master-branch)
(open-issues :initarg :open-issues)
(pushed-at :initarg :pushed-at)
(created-at :initarg :created-at)
(updated-at :initarg :updated-at)
(organisation :initarg :organisation :initform nil :marshal-type gh-user)
(parent :initarg :parent :marshal-type gh-repos-repo)
(source :initarg :source :marshal-type gh-repos-repo)
(has-issues :initarg :has-issues)
(has-wiki :initarg :has-wiki)
(has-downloads :initarg :has-downloads))
"Class for GitHub repositories")
;;;###autoload
(gh-defclass gh-repos-ref (gh-object)
((label :initarg :label)
(ref :initarg :ref :initform nil)
(sha :initarg :sha :initform nil)
(user :initarg :user :initform nil :marshal-type gh-user)
(repo :initarg :repo :initform nil :marshal-type gh-repos-repo)))
(defmethod gh-repos-user-list ((api gh-repos-api) &optional username)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api repo-cls)) "GET"
(format "/users/%s/repos" (or username (gh-api-get-username api)))))
(defmethod gh-repos-org-list ((api gh-repos-api) org)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api repo-cls)) "GET"
(format "/orgs/%s/repos" org)))
(defmethod gh-repos-repo-to-obj ((repo gh-repos-repo-stub)
&rest caps)
(let ((has_issues (plist-member caps :issues))
(has_wiki (plist-member caps :wiki))
(has_downloads (plist-member caps :downloads)))
`(("name" . ,(oref repo :name))
,@(when (slot-boundp repo :homepage)
(list (cons "homepage" (oref repo :homepage))))
,@(when (slot-boundp repo :description)
(list (cons "description" (oref repo :description))))
,@(when (slot-boundp repo :private)
(list (cons "public" (not (oref repo :private)))))
,@(when has_issues
(list (cons "has_issues" (plist-get caps :issues))))
,@(when has_wiki
(list (cons "has_wiki" (plist-get caps :wiki))))
,@(when has_downloads
(list (cons "has_downloads" (plist-get caps :downloads)))))))
(defmethod gh-repos-repo-new ((api gh-repos-api) repo-stub
&optional org &rest caps)
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "POST"
(if org (format "/orgs/%s/repos" org)
"/user/repos")
(apply 'gh-repos-repo-to-obj repo-stub caps)))
(defmethod gh-repos-repo-get ((api gh-repos-api) repo-id &optional user)
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "GET"
(format "/repos/%s/%s"
(or user (gh-api-get-username api))
repo-id)))
(defmethod gh-repos-repo-update ((api gh-repos-api) repo-stub
&optional user &rest caps)
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "PATCH"
(format "/repos/%s/%s"
(or user (gh-api-get-username api))
(oref repo-stub :name))
(apply 'gh-repos-repo-to-obj repo-stub caps)))
(defmethod gh-repos-repo-rename ((api gh-repos-api) repo-stub new-name
&optional user)
(let ((new-stub (make-instance 'gh-repos-repo-stub :name new-name)))
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "PATCH"
(format "/repos/%s/%s"
(or user (gh-api-get-username api))
(oref repo-stub :name))
(gh-repos-repo-to-obj new-stub))))
(defmethod gh-repos-repo-delete ((api gh-repos-api) repo-id
&optional user)
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "DELETE"
(format "/repos/%s/%s"
(or user (gh-api-get-username api))
repo-id)))
;; TODO gh-repos-repo-move
(defmethod gh-repos-repo-contributors ((api gh-repos-api) repo)
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "GET"
(format "/repos/%s/%s/contributors"
(oref (oref repo :owner) :login)
(oref repo :name))))
;;; TODO: generate some useful objects with the return values
(defmethod gh-repos-repo-languages ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "GET" (format "/repos/%s/%s/languages"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-repo-teams ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "GET" (format "/repos/%s/%s/teams"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-repo-tags ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "GET" (format "/repos/%s/%s/tags"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-repo-branches ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "GET" (format "/repos/%s/%s/branches"
(oref (oref repo :owner) :login)
(oref repo :name))))
;;; TODO gh-repos-repo-branch-commits
;;; Collaborators sub-API
(defmethod gh-repos-collaborators-list ((api gh-repos-api) repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api user-cls)) "GET" (format "/repos/%s/%s/collaborators"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-collaborators-p ((api gh-repos-api) repo user)
(eq (oref (gh-api-authenticated-request
api nil "GET"
(format "/repos/%s/%s/collaborators/%s"
(oref (oref repo :owner) :login)
(oref repo :name)
user))
:http-status)
204))
(defmethod gh-repos-collaborators-add ((api gh-repos-api) repo user)
(gh-api-authenticated-request
api nil "PUT"
(format "/repos/%s/%s/collaborators/%s"
(oref (oref repo :owner) :login)
(oref repo :name)
user)))
(defmethod gh-repos-collaborators-delete ((api gh-repos-api) repo user)
(gh-api-authenticated-request
api nil "DELETE"
(format "/repos/%s/%s/collaborators/%s"
(oref (oref repo :owner) :login)
(oref repo :name)
user)))
;;; TODO Comments sub-API
;;; TODO Commits sub-API
;;; TODO Contents sub-API
;;; TODO Downloads sub-API
;;; Forks sub-API
(defmethod gh-repos-forks-list ((api gh-repos-api) repo &optional recursive)
(let ((resp (gh-api-authenticated-request
api (gh-object-list-reader (oref api repo-cls)) "GET"
(format "/repos/%s/%s/forks"
(oref (oref repo :owner) :login)
(oref repo :name)))))
(when recursive
(let ((forks (oref resp :data)))
(oset resp :data
(apply 'nconc forks
(mapcar
(lambda (f)
(oref (gh-repos-forks-list api f t) data))
forks)))))
resp))
(defmethod gh-repos-fork ((api gh-repos-api) repo &optional org)
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "POST"
(format "/repos/%s/%s/forks"
(oref (oref repo :owner) :login)
(oref repo :name))
nil (when org `(("org" . ,org)))))
;;; TODO Keys sub-API
;;; TODO Hooks sub-API
;;; TODO Merging sub-API
;;; Starring sub-API
(defmethod gh-repos-stargazers ((api gh-repos-api) repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api user-cls)) "GET"
(format "/repos/%s/%s/stargazers"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-starred-list ((api gh-repos-api) &optional username)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api repo-cls)) "GET"
(format "/users/%s/starred" (or username (gh-api-get-username api)))))
(defmethod gh-repos-starred-p ((api gh-repos-api) repo)
(eq (oref (gh-api-authenticated-request
api nil "GET"
(format "/user/starred/%s/%s"
(oref (oref repo :owner) :login)
(oref repo :name)))
:http-status)
204))
(defmethod gh-repos-star ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "PUT"
(format "/user/starred/%s/%s"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-unstar ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "DELETE"
(format "/user/starred/%s/%s"
(oref (oref repo :owner) :login)
(oref repo :name))))
;;; TODO Statuses sub-API
;;; Watching sub-API
(defmethod gh-repos-watchers ((api gh-repos-api) repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api user-cls)) "GET"
(format "/repos/%s/%s/subscribers"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-watched-list ((api gh-repos-api) &optional username)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api repo-cls)) "GET"
(format "/users/%s/subscriptions"
(or username (gh-api-get-username api)))))
(defmethod gh-repos-watched-p ((api gh-repos-api) repo)
(eq (oref (gh-api-authenticated-request
api nil "GET"
(format "/user/subscriptions/%s/%s"
(oref (oref repo :owner) :login)
(oref repo :name)))
:http-status)
204))
(defmethod gh-repos-watch ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "PUT"
(format "/user/subscriptions/%s/%s"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-unwatch ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "DELETE"
(format "/user/subscriptions/%s/%s"
(oref (oref repo :owner) :login)
(oref repo :name))))
(provide 'gh-repos)
;;; gh-repos.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

62
elpa/gh-20160728.1525/gh-search.el
View File

@ -1,62 +0,0 @@
;;; gh-search.el --- repository search for gh.el
;; Copyright (C) 2016 Ivan Malison
;; Author: Ivan Malison <IvanMalison@gmail.com>
;; 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:
;;
;;; Code:
(require 'gh-users)
(require 'gh-repos)
;;;###autoload
(defclass gh-search-api (gh-api-v3)
((repo-cls :allocation :class :initform gh-repos-repo)
(user-cls :allocation :class :initform gh-users-user)))
(defmacro gh-search-method-builder (method-name uri process-result-function)
`(defmethod ,method-name ((search-api gh-search-api)
query-string &optional page-limit
&rest additional-arguments)
(unless (and (stringp query-string) (> (length query-string) 1))
(error "a non-empty query string must be provided to github search"))
(gh-api-authenticated-request
search-api
(apply-partially (quote ,process-result-function) search-api)
"GET" ,uri nil
`((q . ,query-string) ,@additional-arguments) page-limit)))
(defmacro gh-search-process-method-builder (method-name class-symbol)
`(defmethod ,method-name ((search-api gh-search-api) data)
(unless (listp data)
(error "Did not recieve a list from the search query"))
(let ((items (assoc 'items data)))
(unless items
(error "Search query did not return items"))
(gh-object-list-read (oref search-api ,class-symbol) (cdr items)))))
(gh-search-process-method-builder gh-process-repo-search-result repo-cls)
(gh-search-process-method-builder gh-process-user-search-result user-cls)
(gh-search-method-builder gh-search-repos "/search/repositories"
gh-process-repo-search-result)
(gh-search-method-builder gh-search-users "/search/users"
gh-process-user-search-result)
(provide 'gh-search)
;;; gh-search.el ends here

193
elpa/gh-20160728.1525/gh-url.el
View File

@ -1,193 +0,0 @@
;;; gh-url.el --- url wrapper for gh.el
;; Copyright (C) 2012 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'url-http)
;;;###autoload
(defclass gh-url-request ()
((method :initarg :method :type string)
(url :initarg :url :type string)
(query :initarg :query :initform nil)
(headers :initarg :headers :initform nil)
(data :initarg :data :initform "" :type string)
(async :initarg :async :initform nil)
(num-retries :initarg :num-retries :initform 0)
(install-callbacks :initarg :install-callbacks :initform nil)
(default-response-cls :allocation :class :initform gh-url-response)))
;;;###autoload
(defclass gh-url-response ()
((data-received :initarg :data-received :initform nil)
(data :initarg :data :initform nil)
(headers :initarg :headers :initform nil)
(http-status :initarg :http-status :initform nil)
(callbacks :initarg :callbacks :initform nil)
(transform :initarg :transform :initform nil)
(-req :initarg :-req :initform nil)))
(defmethod gh-url-response-set-data ((resp gh-url-response) data)
(let ((transform (oref resp :transform)))
(oset resp :data
(if transform
(funcall transform data)
data))
(oset resp :data-received t)))
;;;###autoload
(defclass gh-url-callback ()
nil)
(defmethod gh-url-callback-run ((cb gh-url-callback) resp)
nil)
(defmethod gh-url-response-run-callbacks ((resp gh-url-response))
(let ((copy-list (lambda (list)
(if (consp list)
(let ((res nil))
(while (consp list) (push (pop list) res))
(prog1 (nreverse res) (setcdr res list)))
(car list)))))
(let ((data (oref resp :data)))
(dolist (cb (funcall copy-list (oref resp :callbacks)))
(cond ((and (object-p cb)
(object-of-class-p cb 'gh-url-callback))
(gh-url-callback-run cb resp))
((or (functionp cb) (symbolp cb))
(funcall cb data))
(t (apply (car cb) data (cdr cb))))
(object-remove-from-list resp :callbacks cb))))
resp)
(defmethod gh-url-add-response-callback ((resp gh-url-response) callback)
(object-add-to-list resp :callbacks callback t)
(if (oref resp :data-received)
(gh-url-response-run-callbacks resp)
resp))
;;; code borrowed from nicferrier's web.el
(defun gh-url-parse-headers (data)
(let* ((headers nil)
(header-lines (split-string data "\n"))
(status-line (car header-lines)))
(when (string-match
"HTTP/\\([0-9.]+\\) \\([0-9]\\{3\\}\\)\\( \\(.*\\)\\)*"
status-line)
(push (cons 'status-version (match-string 1 status-line)) headers)
(push (cons 'status-code (match-string 2 status-line)) headers)
(push (cons 'status-string
(or (match-string 4 status-line) ""))
headers))
(loop for line in (cdr header-lines)
if (string-match
"^\\([A-Za-z0-9.-]+\\):[ ]*\\(.*\\)"
line)
do
(let ((name (match-string 1 line))
(value (match-string 2 line)))
(push (cons name value) headers)))
headers))
(defmethod gh-url-response-finalize ((resp gh-url-response))
(when (oref resp :data-received)
(gh-url-response-run-callbacks resp)))
(defmethod gh-url-response-init ((resp gh-url-response)
buffer)
(declare (special url-http-end-of-headers))
(unwind-protect
(with-current-buffer buffer
(let ((headers (gh-url-parse-headers
(buffer-substring
(point-min) (1+ url-http-end-of-headers)))))
(oset resp :headers headers)
(oset resp :http-status (read (cdr (assoc 'status-code headers)))))
(goto-char (1+ url-http-end-of-headers))
(let ((raw (buffer-substring (point) (point-max))))
(gh-url-response-set-data resp raw)))
(kill-buffer buffer))
(gh-url-response-finalize resp)
resp)
(defun gh-url-set-response (status req-resp)
(set-buffer-multibyte t)
(destructuring-bind (req resp) req-resp
(let ((responses-req (clone req))
(num (oref req :num-retries)))
(oset resp :-req responses-req)
(if (or (null num) (zerop num))
(gh-url-response-init resp (current-buffer))
(condition-case err
(gh-url-response-init resp (current-buffer))
(error
(oset req :num-retries (1- num))
(gh-url-run-request req resp)))))))
(defun gh-url-form-encode (form)
(mapconcat (lambda (x) (format "%s=%s" (car x) (cdr x)))
form "&"))
(defun gh-url-params-encode (form)
(concat "?" (gh-url-form-encode form)))
(defmethod gh-url-run-request ((req gh-url-request) &optional resp)
(let ((url-registered-auth-schemes
'(("basic" ignore . 4))) ;; don't let default handlers kick in
(url-privacy-level 'high)
(url-request-method (oref req :method))
(url-request-data (oref req :data))
(url-request-extra-headers (oref req :headers))
(url (concat (oref req :url)
(let ((params (oref req :query)))
(if params
(gh-url-params-encode params)
"")))))
(if (oref req :async)
(let* ((resp (or resp (make-instance (oref req default-response-cls))))
(req-resp (list req resp)))
(with-current-buffer
(url-retrieve url 'gh-url-set-response (list req-resp))
(set (make-local-variable 'url-registered-auth-schemes)
url-registered-auth-schemes)))
(let* ((resp (or resp (make-instance (oref req default-response-cls))))
(req-resp (list req resp)))
(with-current-buffer (url-retrieve-synchronously url)
(gh-url-set-response nil req-resp)))))
(mapc (lambda (cb)
(gh-url-add-response-callback resp cb))
(oref req :install-callbacks))
resp)
(provide 'gh-url)
;;; gh-url.el ends here

86
elpa/gh-20160728.1525/gh-users.el
View File

@ -1,86 +0,0 @@
;;; gh-users.el --- users module for gh.el
;; Copyright (C) 2013 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
;;;###autoload
(defclass gh-users-api (gh-api-v3)
((users-cls :allocation :class :initform gh-users-user))
"Users API")
;;;###autoload
(gh-defclass gh-users-user (gh-user)
((gravatar-id :initarg :gravatar-id)
(html-url :initarg :html-url)
(followers-url :initarg :followers-url)
(following-url :initarg :following-url)
(gists-url :initarg :gists-url)
(starred-url :initarg :starred-url)
(subscriptions-url :initarg :subscriptions-url)
(organizations-url :initarg :organizations-url)
(repos-url :initarg :repos-url)
(events-url :initarg :events-url)
(received-events-url :initarg :received-events-url)
(type :initarg :type)
(site-admin :initarg :site-admin)
(name :initarg :name)
(company :initarg :company)
(blog :initarg :blog)
(location :initarg :location)
(email :initarg :email)
(hireable :initarg :hireable)
(bio :initarg :bio)
(public-repos :initarg :public-repos)
(public-gists :initarg :public-gists)
(followers :initarg :followers)
(following :initarg :following)
(created-at :initarg :created-at)
(update-at :initarg :update-at)))
(defmethod gh-users-get ((api gh-users-api) &optional username)
(gh-api-authenticated-request
api (gh-object-reader (oref api users-cls)) "GET"
(if username
(format "/users/%s" username)
"/user")))
(defmethod gh-users-list ((api gh-users-api))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api users-cls)) "GET"
"/users"))
(provide 'gh-users)
;;; gh-users.el ends here

39
elpa/gh-20160728.1525/gh.el
View File

@ -1,39 +0,0 @@
;;; gh.el --- Github API client libraries
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yhodique@gmail.com>
;; Keywords:
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(require 'gh-gist)
(require 'gh-pulls)
(require 'gh-issues)
(require 'gh-users)
(provide 'gh)
;;; gh.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

36
elpa/github-notifier-20160702.2112/github-notifier-autoloads.el
View File

@ -1,36 +0,0 @@
;;; github-notifier-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "github-notifier" "github-notifier.el" (22500
;;;;;; 1786 648025 550000))
;;; Generated autoloads from github-notifier.el
(defalias 'github-notifier 'github-notifier-mode)
(defvar github-notifier-mode nil "\
Non-nil if Github-Notifier mode is enabled.
See the command `github-notifier-mode' for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `github-notifier-mode'.")
(custom-autoload 'github-notifier-mode "github-notifier" nil)
(autoload 'github-notifier-mode "github-notifier" "\
Toggle github notifications count display in mode line (Github Notifier mode).
With a prefix argument ARG, enable Github Notifier mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
\(fn &optional ARG)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; github-notifier-autoloads.el ends here

1
elpa/github-notifier-20160702.2112/github-notifier-pkg.el
View File

@ -1 +0,0 @@
(define-package "github-notifier" "20160702.2112" "Displays your GitHub notifications unread count in mode-line" '((emacs "24")) :url "https://github.com/xuchunyang/github-notifier.el" :keywords '("github" "mode-line"))

243
elpa/github-notifier-20160702.2112/github-notifier.el
View File

@ -1,243 +0,0 @@
;;; github-notifier.el --- Displays your GitHub notifications unread count in mode-line -*- lexical-binding: t; -*-
;; Copyright (C) 2015, 2016 Chunyang Xu
;; Author: Chunyang Xu <xuchunyang56@gmail.com>
;; URL: https://github.com/xuchunyang/github-notifier.el
;; Package-Version: 20160702.2112
;; Package-Requires: ((emacs "24"))
;; Keywords: github, mode-line
;; Version: 0.1
;; 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 is a global minor-mode. Turn it on everywhere with:
;;
;; M-x github-notifier-mode
;;; Code:
(require 'url)
(require 'json)
(defgroup github-notifier nil
"Github Notifier"
:group 'emacs)
;;; Custom
(defcustom github-notifier-token nil
"Access token to get Github Notifications.
To generate an access token, visit
URL `https://github.com/settings/tokens/new?scopes=notifications&description=github-notifier.el'
This is similar to how erc or jabber handle authentication in
emacs, but the following disclaimer always worth reminding.
DISCLAIMER
When you save this variable, DON'T WRITE IT ANYWHERE PUBLIC. This
token grants (very) limited access to your account.
END DISCLAIMER
If nil, Github-Notifier will ask you and remember your token via
`customize-save-variable'."
:type '(choice (string :tag "Token")
(const :tag "Ask me" nil))
:group 'github-notifier)
(defcustom github-notifier-mode-line
'(:eval
(let (unread-text help-text)
(cond ((null github-notifier-unread-count)
(setq unread-text "-?"
help-text "The Github notifications number is unknown."))
((zerop github-notifier-unread-count)
(setq unread-text ""
help-text "Good job, you don't have unread notification."))
(t
(setq unread-text (format "-%d%s" github-notifier-unread-count
(if (github-notifier-notifications-checked) "*" ""))
help-text (if (= github-notifier-unread-count 1)
"You have 1 unread notification.\nmouse-1 Read it on Github."
(format "You have %d unread notifications.\nmouse-1 Read them on Github."
github-notifier-unread-count)))))
(propertize (concat " GH" unread-text)
'help-echo help-text
'local-map github-notifier-mode-line-map
'mouse-face 'mode-line-highlight)))
"Mode line lighter for Github Notifier."
:type 'sexp
:risky t
:group 'github-notifier)
(defcustom github-notifier-update-interval 60
"Seconds after which the github notifications count will be updated."
:type 'integer
:group 'github-notifier)
(defcustom github-notifier-only-participating nil
"If non-nil, only counts notifications in which the user is directly participating or mentioned."
:type 'boolean
:group 'github-notifier)
(defcustom github-notifier-enterprise-domain nil
"Domain to Github installation.
Can be overriden to support Enterprise installations"
:type 'string
:group 'github-notifier)
;;; Variables
(defvar github-notifier-unread-count nil
"Github notifications unread count.
Normally, this is a number, however, nil means unknown by Emacs.")
(defvar github-notifier-unread-json nil
"JSON object contains latest (to github-notifier) unread notifications.")
(defvar github-notifier-update-hook nil
"Run by `github-notifier-update-cb'.
Functions added to this hook takes one argument, the unread
notification json object BEFORE updating. Accordingly,
`github-notifier-unread-json' stores the unread notification json
AFTER updating.")
(defvar github-notifier-mode-line-map
(let ((map (make-sparse-keymap)))
(define-key map [mode-line mouse-1] 'github-notifier-visit-github)
map))
(defvar github-notifier-last-notification nil)
(defvar github-notifier-last-notification-checked nil)
(defvar github-notifier-update-timer nil)
;;; Function
(defun github-notifier-get-url (path &optional api-request)
"Get URL to Github endpoint.
Get a url to PATH on Github or Github enterprise if
`github-enterprise-domain' is set. If API-REQUEST is true it
will return an API."
(let ((url
(if github-notifier-enterprise-domain
(concat github-notifier-enterprise-domain (when api-request "/api/v3"))
(concat (when api-request "api.") "github.com"))))
(concat "https://" url path)))
;; FIXME: Even we use `url-retrieve' to retrieve network asynchronously, Emacs
;; still gets blocked frequently (?), especially when the network situation is
;; bad, once it blocks Emacs, you have to wait to it gets finised or interrupt
;; it by hitting C-g many times. This is very annoying.
;;
;; Maybe we can try to invoke curl(1) as asynchronous process.
(defun github-notifier-update-cb (_status)
(set-buffer-multibyte t)
(goto-char (point-min))
(if (not (string-match "200 OK" (buffer-string)))
(progn (message "[github-notifier] Problem connecting to the server")
(setq github-notifier-unread-count nil))
(re-search-forward "^$" nil 'move)
(let (json-str
(old-count github-notifier-unread-count)
(old-json github-notifier-unread-json))
(setq json-str (buffer-substring-no-properties (point) (point-max))
github-notifier-unread-json (json-read-from-string json-str))
(setq github-notifier-unread-count (length github-notifier-unread-json))
(when (> github-notifier-unread-count 0)
(setq github-notifier-last-notification (cdr (assoc 'updated_at (elt github-notifier-unread-json 0)))))
(unless (and (equal old-count github-notifier-unread-count)
(github-notifier-notifications-checked))
(force-mode-line-update t))
(run-hook-with-args 'github-notifier-update-hook old-json)
;; Debug
;; (setq a-json-string json-str)
;; (message "Github notification %d unread, updated at %s"
;; github-notifier-unread-count (current-time-string))
))
;; Debug
;; (display-buffer (current-buffer))
(kill-buffer)
(when github-notifier-mode
(setq github-notifier-update-timer
(run-at-time github-notifier-update-interval nil #'github-notifier-update))))
(defun github-notifier-update (&optional force)
"Update `github-notifier-unread-count'."
(when (or force github-notifier-mode)
(let ((url-request-extra-headers `(("Authorization" .
,(format "token %s" github-notifier-token))))
(url (github-notifier-get-url (concat "/notifications"
(when github-notifier-only-participating
"?participating=true")) t)))
(condition-case error-data
(url-retrieve url #'github-notifier-update-cb nil t t)
(error
(message "Error retrieving github notification from %s: %s" url error-data)
(when github-notifier-mode
(setq github-notifier-update-timer
(run-at-time github-notifier-update-interval nil #'github-notifier-update))))))))
(defun github-notifier-visit-github ()
(interactive)
(browse-url (github-notifier-get-url "/notifications"))
(setq github-notifier-last-notification-checked (format-time-string "%FT%TZ" (current-time) t))
(force-mode-line-update t))
(defun github-notifier-notifications-checked ()
(and github-notifier-unread-count (> github-notifier-unread-count 0)
github-notifier-last-notification github-notifier-last-notification-checked
(string< github-notifier-last-notification github-notifier-last-notification-checked)))
;;; Glboal Minor-mode
;;;###autoload
(defalias 'github-notifier 'github-notifier-mode)
;;;###autoload
(define-minor-mode github-notifier-mode
"Toggle github notifications count display in mode line (Github Notifier mode).
With a prefix argument ARG, enable Github Notifier mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil."
:global t :group 'github-notifier
(unless github-notifier-token
(setq github-notifier-token
(with-temp-buffer
(when (or
(= 0 (call-process "git" nil t nil "config" "github-notifier.oauth-token"))
(= 0 (call-process "git" nil t nil "config" "github.oauth-token")))
(buffer-substring 1 (progn (goto-char 1) (line-end-position)))))))
(unless (stringp github-notifier-token)
(browse-url (github-notifier-get-url "/settings/tokens/new?scopes=notifications&description=github-notifier.el"))
(let (token)
(unwind-protect
(setq token (read-string "Paste Your Access Token: "))
(if (stringp token)
(customize-save-variable 'github-notifier-token token)
(message "No Access Token")
(setq github-notifier-mode nil)))))
(unless global-mode-string
(setq global-mode-string '("")))
(if (not github-notifier-mode)
(progn
(setq global-mode-string
(delq 'github-notifier-mode-line global-mode-string))
(when github-notifier-update-timer
(cancel-timer github-notifier-update-timer)
(setq github-notifier-update-timer nil)))
(add-to-list 'global-mode-string 'github-notifier-mode-line t)
(github-notifier-update)))
(provide 'github-notifier)
;;; github-notifier.el ends here

551
elpa/go-mode-20161013.1055/go-guru.el
View File

@ -1,551 +0,0 @@
;;; go-guru.el --- Integration of the Go 'guru' analysis tool into Emacs.
;; Copyright 2016 The Go Authors. All rights reserved.
;; Use of this source code is governed by a BSD-style
;; license that can be found in the LICENSE file.
;; Version: 0.1
;; Package-Requires: ((go-mode "1.3.1") (cl-lib "0.5"))
;; Keywords: tools
;;; Commentary:
;; To enable the Go guru in Emacs, use this command to download,
;; build, and install the tool in $GOROOT/bin:
;;
;; $ go get golang.org/x/tools/cmd/guru
;;
;; Verify that the tool is on your $PATH:
;;
;; $ guru -help
;; Go source code guru.
;; Usage: guru [flags] <mode> <position>
;; ...
;;
;; Then copy this file to a directory on your `load-path',
;; and add this to your ~/.emacs:
;;
;; (require 'go-guru)
;;
;; Inside a buffer of Go source code, select an expression of
;; interest, and type `C-c C-o d' (for "describe") or run one of the
;; other go-guru-xxx commands. If you use `menu-bar-mode', these
;; commands are available from the Guru menu.
;;
;; To enable identifier highlighting mode in a Go source buffer, use:
;;
;; (go-guru-hl-identifier-mode)
;;
;; To enable it automatically in all Go source buffers,
;; add this to your ~/.emacs:
;;
;; (add-hook 'go-mode-hook #'go-guru-hl-identifier-mode)
;;
;; See http://golang.org/s/using-guru for more information about guru.
;;; Code:
(require 'compile)
(require 'easymenu)
(require 'go-mode)
(require 'json)
(require 'simple)
(require 'cl-lib)
(defgroup go-guru nil
"Options specific to the Go guru."
:group 'go)
(defcustom go-guru-command "guru"
"The Go guru command."
:type 'string
:group 'go-guru)
(defcustom go-guru-scope ""
"The scope of the analysis. See `go-guru-set-scope'."
:type 'string
:group 'go-guru)
(defvar go-guru--scope-history
nil
"History of values supplied to `go-guru-set-scope'.")
(defcustom go-guru-build-tags ""
"Build tags passed to guru."
:type 'string
:group 'go-guru)
(defface go-guru-hl-identifier-face
'((t (:inherit highlight)))
"Face used for highlighting identifiers in `go-guru-hl-identifier'."
:group 'go-guru)
(defcustom go-guru-debug nil
"Print debug messages when running guru."
:type 'boolean
:group 'go-guru)
(defcustom go-guru-hl-identifier-idle-time 0.5
"How long to wait after user input before highlighting the current identifier."
:type 'float
:group 'go-guru)
(defvar go-guru--current-hl-identifier-idle-time
0
"The current delay for hl-identifier-mode.")
(defvar go-guru--hl-identifier-timer
nil
"The global timer used for highlighting identifiers.")
(defvar go-guru--last-enclosing
nil
"The remaining enclosing regions of the previous go-expand-region invocation.")
;; Extend go-mode-map.
(let ((m (define-prefix-command 'go-guru-map)))
(define-key m "d" #'go-guru-describe)
(define-key m "f" #'go-guru-freevars)
(define-key m "i" #'go-guru-implements)
(define-key m "c" #'go-guru-peers) ; c for channel
(define-key m "r" #'go-guru-referrers)
(define-key m "j" #'go-guru-definition) ; j for jump
(define-key m "p" #'go-guru-pointsto)
(define-key m "s" #'go-guru-callstack) ; s for stack
(define-key m "e" #'go-guru-whicherrs) ; e for error
(define-key m "<" #'go-guru-callers)
(define-key m ">" #'go-guru-callees)
(define-key m "x" #'go-guru-expand-region)) ;; x for expand
(define-key go-mode-map (kbd "C-c C-o") #'go-guru-map)
(easy-menu-define go-guru-mode-menu go-mode-map
"Menu for Go Guru."
'("Guru"
["Jump to Definition" go-guru-definition t]
["Show Referrers" go-guru-referrers t]
["Show Free Names" go-guru-freevars t]
["Describe Expression" go-guru-describe t]
["Show Implements" go-guru-implements t]
"---"
["Show Callers" go-guru-callers t]
["Show Callees" go-guru-callees t]
["Show Callstack" go-guru-callstack t]
"---"
["Show Points-To" go-guru-pointsto t]
["Show Which Errors" go-guru-whicherrs t]
["Show Channel Peers" go-guru-peers t]
"---"
["Set pointer analysis scope..." go-guru-set-scope t]))
;;;###autoload
(defun go-guru-set-scope ()
"Set the scope for the Go guru, prompting the user to edit the previous scope.
The scope restricts analysis to the specified packages.
Its value is a comma-separated list of patterns of these forms:
golang.org/x/tools/cmd/guru # a single package
golang.org/x/tools/... # all packages beneath dir
... # the entire workspace.
A pattern preceded by '-' is negative, so the scope
encoding/...,-encoding/xml
matches all encoding packages except encoding/xml."
(interactive)
(let ((scope (read-from-minibuffer "Go guru scope: "
go-guru-scope
nil
nil
'go-guru--scope-history)))
(if (string-equal "" scope)
(error "You must specify a non-empty scope for the Go guru"))
(setq go-guru-scope scope)))
(defun go-guru--set-scope-if-empty ()
(if (string-equal "" go-guru-scope)
(go-guru-set-scope)))
(defun go-guru--json (mode)
"Execute the Go guru in the specified MODE, passing it the
selected region of the current buffer, requesting JSON output.
Parse and return the resulting JSON object."
;; A "what" query works even in a buffer without a file name.
(let* ((filename (file-truename (or buffer-file-name "synthetic.go")))
(cmd (go-guru--command mode filename '("-json")))
(buf (current-buffer))
;; Use temporary buffers to avoid conflict with go-guru--start.
(json-buffer (generate-new-buffer "*go-guru-json-output*"))
(input-buffer (generate-new-buffer "*go-guru-json-input*")))
(unwind-protect
;; Run guru, feeding it the input buffer (modified files).
(with-current-buffer input-buffer
(go-guru--insert-modified-files)
(unless (buffer-file-name buf)
(go-guru--insert-modified-file filename buf))
(let ((exitcode (apply #'call-process-region
(append (list (point-min)
(point-max)
(car cmd) ; guru
nil ; delete
json-buffer ; output
nil) ; display
(cdr cmd))))) ; args
(with-current-buffer json-buffer
(unless (zerop exitcode)
;; Failed: use buffer contents (sans final \n) as an error.
(error "%s" (buffer-substring (point-min) (1- (point-max)))))
;; Success: parse JSON.
(goto-char (point-min))
(json-read))))
;; Clean up temporary buffers.
(kill-buffer json-buffer)
(kill-buffer input-buffer))))
(define-compilation-mode go-guru-output-mode "Go guru"
"Go guru output mode is a variant of `compilation-mode' for the
output of the Go guru tool."
(set (make-local-variable 'compilation-error-screen-columns) nil)
(set (make-local-variable 'compilation-filter-hook) #'go-guru--compilation-filter-hook)
(set (make-local-variable 'compilation-start-hook) #'go-guru--compilation-start-hook))
(defun go-guru--compilation-filter-hook ()
"Post-process a blob of input to the go-guru-output buffer."
;; For readability, truncate each "file:line:col:" prefix to a fixed width.
;; If the prefix is longer than 20, show "…/last/19chars.go".
;; This usually includes the last segment of the package name.
;; Hide the line and column numbers.
(let ((start compilation-filter-start)
(end (point)))
(goto-char start)
(unless (bolp)
;; TODO(adonovan): not quite right: the filter may be called
;; with chunks of output containing incomplete lines. Moving to
;; beginning-of-line may cause duplicate post-processing.
(beginning-of-line))
(setq start (point))
(while (< start end)
(let ((p (search-forward ": " end t)))
(if (null p)
(setq start end) ; break out of loop
(setq p (1- p)) ; exclude final space
(let* ((posn (buffer-substring-no-properties start p))
(flen (cl-search ":" posn)) ; length of filename
(filename (if (< flen 19)
(substring posn 0 flen)
(concat "…" (substring posn (- flen 19) flen)))))
(put-text-property start p 'display filename)
(forward-line 1)
(setq start (point))))))))
(defun go-guru--compilation-start-hook (proc)
"Erase default output header inserted by `compilation-mode'."
(with-current-buffer (process-buffer proc)
(let ((inhibit-read-only t))
(beginning-of-buffer)
(delete-region (point) (point-max)))))
(defun go-guru--start (mode)
"Start an asynchronous Go guru process for the specified query
MODE, passing it the selected region of the current buffer, and
feeding its standard input with the contents of all modified Go
buffers. Its output is handled by `go-guru-output-mode', a
variant of `compilation-mode'."
(or buffer-file-name
(error "Cannot use guru on a buffer without a file name"))
(let* ((filename (file-truename buffer-file-name))
(cmd (mapconcat #'shell-quote-argument (go-guru--command mode filename) " "))
(process-connection-type nil) ; use pipe (not pty) so EOF closes stdin
(procbuf (compilation-start cmd 'go-guru-output-mode)))
(with-current-buffer procbuf
(setq truncate-lines t)) ; the output is neater without line wrapping
(with-current-buffer (get-buffer-create "*go-guru-input*")
(erase-buffer)
(go-guru--insert-modified-files)
(process-send-region procbuf (point-min) (point-max))
(process-send-eof procbuf))
procbuf))
(defun go-guru--command (mode filename &optional flags)
"Return a command and argument list for a Go guru query of MODE, passing it
the selected region of the current buffer. FILENAME is the
effective name of the current buffer."
(let* ((posn (if (use-region-p)
(format "%s:#%d,#%d"
filename
(1- (go--position-bytes (region-beginning)))
(1- (go--position-bytes (region-end))))
(format "%s:#%d"
filename
(1- (go--position-bytes (point))))))
(cmd (append (list go-guru-command
"-modified"
"-scope" go-guru-scope
(format "-tags=%s" (mapconcat 'identity go-guru-build-tags ",")))
flags
(list mode
posn))))
;; Log the command to *Messages*, for debugging.
(when go-guru-debug
(message "go-guru--command: %s" cmd)
(message nil)) ; clear/shrink minibuffer
cmd))
(defun go-guru--insert-modified-files ()
"Insert the contents of each modified Go buffer into the
current buffer in the format specified by guru's -modified flag."
(mapc #'(lambda (b)
(and (buffer-modified-p b)
(buffer-file-name b)
(string= (file-name-extension (buffer-file-name b)) "go")
(go-guru--insert-modified-file (buffer-file-name b) b)))
(buffer-list)))
(defun go-guru--insert-modified-file (name buffer)
(insert (format "%s\n%d\n" name (go-guru--buffer-size-bytes buffer)))
(insert-buffer-substring buffer))
(defun go-guru--buffer-size-bytes (&optional buffer)
"Return the number of bytes in the current buffer.
If BUFFER, return the number of characters in that buffer instead."
(with-current-buffer (or buffer (current-buffer))
(string-bytes (buffer-substring (point-min)
(point-max)))))
(defun go-guru--goto-byte (offset)
"Go to the OFFSETth byte in the buffer."
(goto-char (byte-to-position offset)))
(defun go-guru--goto-byte-column (offset)
"Go to the OFFSETth byte in the current line."
(goto-char (byte-to-position (+ (position-bytes (point-at-bol)) (1- offset)))))
(defun go-guru--goto-pos (posn)
"Find the file containing the position POSN (of the form `file:line:col')
set the point to it, switching the current buffer."
(let ((file-line-pos (split-string posn ":")))
(find-file (car file-line-pos))
(goto-char (point-min))
(forward-line (1- (string-to-number (cadr file-line-pos))))
(go-guru--goto-byte-column (string-to-number (cl-caddr file-line-pos)))))
(defun go-guru--goto-pos-no-file (posn)
"Given `file:line:col', go to the line and column. The file
component will be ignored."
(let ((file-line-pos (split-string posn ":")))
(goto-char (point-min))
(forward-line (1- (string-to-number (cadr file-line-pos))))
(go-guru--goto-byte-column (string-to-number (cl-caddr file-line-pos)))))
;;;###autoload
(defun go-guru-callees ()
"Show possible callees of the function call at the current point."
(interactive)
(go-guru--set-scope-if-empty)
(go-guru--start "callees"))
;;;###autoload
(defun go-guru-callers ()
"Show the set of callers of the function containing the current point."
(interactive)
(go-guru--set-scope-if-empty)
(go-guru--start "callers"))
;;;###autoload
(defun go-guru-callstack ()
"Show an arbitrary path from a root of the call graph to the
function containing the current point."
(interactive)
(go-guru--set-scope-if-empty)
(go-guru--start "callstack"))
;;;###autoload
(defun go-guru-definition ()
"Jump to the definition of the selected identifier."
(interactive)
(or buffer-file-name
(error "Cannot use guru on a buffer without a file name"))
(let* ((res (go-guru--json "definition"))
(desc (cdr (assoc 'desc res))))
(push-mark)
(ring-insert find-tag-marker-ring (point-marker))
(go-guru--goto-pos (cdr (assoc 'objpos res)))
(message "%s" desc)))
;;;###autoload
(defun go-guru-describe ()
"Describe the selected syntax, its kind, type and methods."
(interactive)
(go-guru--start "describe"))
;;;###autoload
(defun go-guru-pointsto ()
"Show what the selected expression points to."
(interactive)
(go-guru--set-scope-if-empty)
(go-guru--start "pointsto"))
;;;###autoload
(defun go-guru-implements ()
"Describe the 'implements' relation for types in the package
containing the current point."
(interactive)
(go-guru--start "implements"))
;;;###autoload
(defun go-guru-freevars ()
"Enumerate the free variables of the current selection."
(interactive)
(go-guru--start "freevars"))
;;;###autoload
(defun go-guru-peers ()
"Enumerate the set of possible corresponding sends/receives for
this channel receive/send operation."
(interactive)
(go-guru--set-scope-if-empty)
(go-guru--start "peers"))
;;;###autoload
(defun go-guru-referrers ()
"Enumerate all references to the object denoted by the selected
identifier."
(interactive)
(go-guru--start "referrers"))
;;;###autoload
(defun go-guru-whicherrs ()
"Show globals, constants and types to which the selected
expression (of type 'error') may refer."
(interactive)
(go-guru--set-scope-if-empty)
(go-guru--start "whicherrs"))
(defun go-guru-what ()
"Run a 'what' query and return the parsed JSON response as an
association list."
(go-guru--json "what"))
(defun go-guru--hl-symbols (posn face id)
"Highlight the symbols at the positions POSN by creating
overlays with face FACE. The attribute 'go-guru-overlay on the
overlays will be set to ID."
(save-excursion
(mapc (lambda (pos)
(go-guru--goto-pos-no-file pos)
(let ((x (make-overlay (point) (+ (point) (length (current-word))))))
(overlay-put x 'go-guru-overlay id)
(overlay-put x 'face face)))
posn)))
;;;###autoload
(defun go-guru-unhighlight-identifiers ()
"Remove highlights from previously highlighted identifier."
(remove-overlays nil nil 'go-guru-overlay 'sameid))
;;;###autoload
(defun go-guru-hl-identifier ()
"Highlight all instances of the identifier under point. Removes
highlights from previously highlighted identifier."
(interactive)
(go-guru-unhighlight-identifiers)
(go-guru--hl-identifier))
(defun go-guru--hl-identifier ()
"Highlight all instances of the identifier under point."
(let ((posn (cdr (assoc 'sameids (go-guru-what)))))
(go-guru--hl-symbols posn 'go-guru-hl-identifier-face 'sameid)))
(defun go-guru--hl-identifiers-function ()
"Function run after an idle timeout, highlighting the
identifier at point, if necessary."
(when go-guru-hl-identifier-mode
(unless (go-guru--on-overlay-p 'sameid)
;; Ignore guru errors. Otherwise, we might end up with an error
;; every time the timer runs, e.g. because of a malformed
;; buffer.
(condition-case nil
(go-guru-hl-identifier)
(error nil)))
(unless (eq go-guru--current-hl-identifier-idle-time go-guru-hl-identifier-idle-time)
(go-guru--hl-set-timer))))
(defun go-guru--hl-set-timer ()
(if go-guru--hl-identifier-timer
(cancel-timer go-guru--hl-identifier-timer))
(setq go-guru--current-hl-identifier-idle-time go-guru-hl-identifier-idle-time)
(setq go-guru--hl-identifier-timer (run-with-idle-timer
go-guru-hl-identifier-idle-time
t
#'go-guru--hl-identifiers-function)))
;;;###autoload
(define-minor-mode go-guru-hl-identifier-mode
"Highlight instances of the identifier at point after a short
timeout."
:group 'go-guru
(if go-guru-hl-identifier-mode
(progn
(go-guru--hl-set-timer)
;; Unhighlight if point moves off identifier
(add-hook 'post-command-hook #'go-guru--hl-identifiers-post-command-hook nil t)
;; Unhighlight any time the buffer changes
(add-hook 'before-change-functions #'go-guru--hl-identifiers-before-change-function nil t))
(remove-hook 'post-command-hook #'go-guru--hl-identifiers-post-command-hook t)
(remove-hook 'before-change-functions #'go-guru--hl-identifiers-before-change-function t)
(go-guru-unhighlight-identifiers)))
(defun go-guru--on-overlay-p (id)
"Return whether point is on a guru overlay of type ID."
(cl-find-if (lambda (el) (eq (overlay-get el 'go-guru-overlay) id)) (overlays-at (point))))
(defun go-guru--hl-identifiers-post-command-hook ()
(if (and go-guru-hl-identifier-mode
(not (go-guru--on-overlay-p 'sameid)))
(go-guru-unhighlight-identifiers)))
(defun go-guru--hl-identifiers-before-change-function (_beg _end)
(go-guru-unhighlight-identifiers))
;; TODO(dominikh): a future feature may be to cycle through all uses
;; of an identifier.
(defun go-guru--enclosing ()
"Return a list of enclosing regions."
(cdr (assoc 'enclosing (go-guru-what))))
(defun go-guru--enclosing-unique ()
"Return a list of enclosing regions, with duplicates removed.
Two regions are considered equal if they have the same start and
end point."
(let ((enclosing (go-guru--enclosing)))
(cl-remove-duplicates enclosing
:from-end t
:test (lambda (a b)
(and (= (cdr (assoc 'start a))
(cdr (assoc 'start b)))
(= (cdr (assoc 'end a))
(cdr (assoc 'end b))))))))
(defun go-guru-expand-region ()
"Expand region to the next enclosing syntactic unit."
(interactive)
(let* ((enclosing (if (eq last-command #'go-guru-expand-region)
go-guru--last-enclosing
(go-guru--enclosing-unique)))
(block (if (> (length enclosing) 0) (elt enclosing 0))))
(when block
(go-guru--goto-byte (1+ (cdr (assoc 'start block))))
(set-mark (byte-to-position (1+ (cdr (assoc 'end block)))))
(setq go-guru--last-enclosing (cl-subseq enclosing 1))
(message "Region: %s" (cdr (assoc 'desc block)))
(setq deactivate-mark nil))))
(provide 'go-guru)
;; Local variables:
;; indent-tabs-mode: t
;; tab-width: 8
;; End
;;; go-guru.el ends here

209
elpa/go-mode-20161013.1055/go-mode-autoloads.el
View File

@ -1,209 +0,0 @@
;;; go-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads nil "go-guru" "go-guru.el" (22528 41395 701074
;;;;;; 26000))
;;; Generated autoloads from go-guru.el
(autoload 'go-guru-set-scope "go-guru" "\
Set the scope for the Go guru, prompting the user to edit the previous scope.
The scope restricts analysis to the specified packages.
Its value is a comma-separated list of patterns of these forms:
golang.org/x/tools/cmd/guru # a single package
golang.org/x/tools/... # all packages beneath dir
... # the entire workspace.
A pattern preceded by '-' is negative, so the scope
encoding/...,-encoding/xml
matches all encoding packages except encoding/xml.
\(fn)" t nil)
(autoload 'go-guru-callees "go-guru" "\
Show possible callees of the function call at the current point.
\(fn)" t nil)
(autoload 'go-guru-callers "go-guru" "\
Show the set of callers of the function containing the current point.
\(fn)" t nil)
(autoload 'go-guru-callstack "go-guru" "\
Show an arbitrary path from a root of the call graph to the
function containing the current point.
\(fn)" t nil)
(autoload 'go-guru-definition "go-guru" "\
Jump to the definition of the selected identifier.
\(fn)" t nil)
(autoload 'go-guru-describe "go-guru" "\
Describe the selected syntax, its kind, type and methods.
\(fn)" t nil)
(autoload 'go-guru-pointsto "go-guru" "\
Show what the selected expression points to.
\(fn)" t nil)
(autoload 'go-guru-implements "go-guru" "\
Describe the 'implements' relation for types in the package
containing the current point.
\(fn)" t nil)
(autoload 'go-guru-freevars "go-guru" "\
Enumerate the free variables of the current selection.
\(fn)" t nil)
(autoload 'go-guru-peers "go-guru" "\
Enumerate the set of possible corresponding sends/receives for
this channel receive/send operation.
\(fn)" t nil)
(autoload 'go-guru-referrers "go-guru" "\
Enumerate all references to the object denoted by the selected
identifier.
\(fn)" t nil)
(autoload 'go-guru-whicherrs "go-guru" "\
Show globals, constants and types to which the selected
expression (of type 'error') may refer.
\(fn)" t nil)
(autoload 'go-guru-unhighlight-identifiers "go-guru" "\
Remove highlights from previously highlighted identifier.
\(fn)" nil nil)
(autoload 'go-guru-hl-identifier "go-guru" "\
Highlight all instances of the identifier under point. Removes
highlights from previously highlighted identifier.
\(fn)" t nil)
(autoload 'go-guru-hl-identifier-mode "go-guru" "\
Highlight instances of the identifier at point after a short
timeout.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil "go-mode" "go-mode.el" (22528 41395 693074
;;;;;; 32000))
;;; Generated autoloads from go-mode.el
(autoload 'go-mode "go-mode" "\
Major mode for editing Go source text.
This mode provides (not just) basic editing capabilities for
working with Go code. It offers almost complete syntax
highlighting, indentation that is almost identical to gofmt and
proper parsing of the buffer content to allow features such as
navigation by function, manipulation of comments or detection of
strings.
In addition to these core features, it offers various features to
help with writing Go code. You can directly run buffer content
through gofmt, read godoc documentation from within Emacs, modify
and clean up the list of package imports or interact with the
Playground (uploading and downloading pastes).
The following extra functions are defined:
- `gofmt'
- `godoc' and `godoc-at-point'
- `go-import-add'
- `go-remove-unused-imports'
- `go-goto-arguments'
- `go-goto-docstring'
- `go-goto-function'
- `go-goto-function-name'
- `go-goto-imports'
- `go-goto-return-values'
- `go-goto-method-receiver'
- `go-play-buffer' and `go-play-region'
- `go-download-play'
- `godef-describe' and `godef-jump'
- `go-coverage'
- `go-set-project'
- `go-reset-gopath'
If you want to automatically run `gofmt' before saving a file,
add the following hook to your emacs configuration:
\(add-hook 'before-save-hook #'gofmt-before-save)
If you want to use `godef-jump' instead of etags (or similar),
consider binding godef-jump to `M-.', which is the default key
for `find-tag':
\(add-hook 'go-mode-hook (lambda ()
(local-set-key (kbd \"M-.\") #'godef-jump)))
Please note that godef is an external dependency. You can install
it with
go get github.com/rogpeppe/godef
If you're looking for even more integration with Go, namely
on-the-fly syntax checking, auto-completion and snippets, it is
recommended that you look at flycheck
\(see URL `https://github.com/flycheck/flycheck') or flymake in combination
with goflymake (see URL `https://github.com/dougm/goflymake'), gocode
\(see URL `https://github.com/nsf/gocode'), go-eldoc
\(see URL `github.com/syohex/emacs-go-eldoc') and yasnippet-go
\(see URL `https://github.com/dominikh/yasnippet-go')
\(fn)" t nil)
(add-to-list 'auto-mode-alist (cons "\\.go\\'" 'go-mode))
(autoload 'gofmt-before-save "go-mode" "\
Add this to .emacs to run gofmt on the current buffer when saving:
(add-hook 'before-save-hook 'gofmt-before-save).
Note that this will cause go-mode to get loaded the first time
you save any file, kind of defeating the point of autoloading.
\(fn)" t nil)
(autoload 'godoc "go-mode" "\
Show Go documentation for QUERY, much like M-x man.
\(fn QUERY)" t nil)
(autoload 'go-download-play "go-mode" "\
Download a paste from the playground and insert it in a Go buffer.
Tries to look for a URL at point.
\(fn URL)" t nil)
;;;***
;;;### (autoloads nil nil ("go-mode-pkg.el") (22528 41395 685074
;;;;;; 38000))
;;;***
(provide 'go-mode-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; go-mode-autoloads.el ends here

5
elpa/go-mode-20161013.1055/go-mode-pkg.el
View File

@ -1,5 +0,0 @@
(define-package "go-mode" "20161013.1055" "Major mode for the Go programming language" 'nil :url "https://github.com/dominikh/go-mode.el" :keywords
'("languages" "go"))
;; Local Variables:
;; no-byte-compile: t
;; End:

2069
elpa/go-mode-20161013.1055/go-mode.el
View File

File diff suppressed because it is too large Load Diff

69
elpa/grizzl-20160818.37/grizzl-autoloads.el
View File

@ -1,69 +0,0 @@
;;; grizzl-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "grizzl" "grizzl.el" (22454 5325 478331 394000))
;;; Generated autoloads from grizzl.el
(autoload 'grizzl-make-index "grizzl" "\
Makes an index from the list STRINGS for use with `grizzl-search'.
If :PROGRESS-FN is given as a keyword argument, it is called repeatedly
with integers N and TOTAL.
If :CASE-SENSITIVE is specified as a non-nil keyword argument, the index
will be created case-sensitive, otherwise it will be case-insensitive.
\(fn STRINGS &rest OPTIONS)" nil nil)
(autoload 'grizzl-search "grizzl" "\
Fuzzy searches for TERM in INDEX prepared with `grizzl-make-index'.
OLD-RESULT may be specified as an existing search result to increment from.
The result can be read with `grizzl-result-strings'.
\(fn TERM INDEX &optional OLD-RESULT)" nil nil)
(autoload 'grizzl-result-count "grizzl" "\
Returns the number of matches present in RESULT.
\(fn RESULT)" nil nil)
(autoload 'grizzl-result-strings "grizzl" "\
Returns the ordered list of matched strings in RESULT, using INDEX.
If the :START option is specified, results are read from the given offset.
If the :END option is specified, up to :END results are returned.
\(fn RESULT INDEX &rest OPTIONS)" nil nil)
(autoload 'grizzl-completing-read "grizzl" "\
Performs a completing-read in the minibuffer using INDEX to fuzzy search.
Each key pressed in the minibuffer filters down the list of matches.
\(fn PROMPT INDEX)" nil nil)
(autoload 'grizzl-selected-result "grizzl" "\
Get the selected string from INDEX in a `grizzl-completing-read'.
\(fn INDEX)" nil nil)
(autoload 'grizzl-set-selection+1 "grizzl" "\
Move the selection up one row in `grizzl-completing-read'.
\(fn)" t nil)
(autoload 'grizzl-set-selection-1 "grizzl" "\
Move the selection down one row in `grizzl-completing-read'.
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; grizzl-autoloads.el ends here

2
elpa/grizzl-20160818.37/grizzl-pkg.el
View File

@ -1,2 +0,0 @@
;;; -*- no-byte-compile: t -*-
(define-package "grizzl" "20160818.37" "Fast fuzzy search index for Emacs." '((cl-lib "0.5") (emacs "24.3")) :url "https://github.com/grizzl/grizzl" :keywords '("convenience" "usability"))

404
elpa/grizzl-20160818.37/grizzl.el
View File

@ -1,404 +0,0 @@
;;; grizzl.el --- Fast fuzzy search index for Emacs. -*- lexical-binding: t -*-
;; Copyright © 2013-2014 Chris Corbyn
;; Copyright © 2015 Bozhidar Batsov
;;
;; Author: Chris Corbyn <chris@w3style.co.uk>
;; Maintainer: Bozhidar Batsov <bozhidar@batsov.com>
;; URL: https://github.com/grizzl/grizzl
;; Package-Version: 20160818.37
;; Version: 0.1.2
;; Keywords: convenience, usability
;; Package-Requires: ((cl-lib "0.5") (emacs "24.3"))
;; 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/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Grizzl provides a fuzzy completion framework for general purpose
;; use in Emacs Lisp projects.
;;
;; grizzl provides the underlying data structures and sesrch
;; algorithm without any UI attachment. At the core, a fuzzy search
;; index is created from a list of strings, using `grizzl-make-index'.
;; A fuzzy search term is then used to get a result from this index
;; with `grizzl-search'. Because grizzl considers the usage of a
;; fuzzy search index to operate in real-time as a user enters a
;; search term in the minibuffer, the framework optimizes for this use
;; case. Any result can be passed back into `grizzl-search' as a hint
;; to continue searching. The search algorithm is able to understand
;; insertions and deletions and therefore minimizes the work it needs
;; to do in this case. The intended use here is to collect a result
;; on each key press and feed that result into the search for the next
;; key press. Once a search is complete, the matched strings are then
;; read, using `grizzl-result-strings'. The results are ordered on the
;; a combination of the Levenshtein Distance and a character-proximity
;; scoring calculation. This means shorter strings are favoured, but
;; adjacent letters are more heavily favoured.
;;
;; It is assumed that the index will be re-used across multiple
;; searches on larger sets of data.
;;
;; Call `grizzl-completing-read' with an index returned by
;; `grizzl-make-index':
;;
;; (defvar *index* (grizzl-make-index '("one" "two" "three")))
;; (grizzl-completing-read "Number: " *index*)
;;
;; When the user hits ENTER, either one of the strings is returned on
;; success, or nil of nothing matched.
;;
;; The arrow keys can be used to navigate within the results.
;;; Code:
(eval-when-compile
(require 'cl-lib))
;;; --- Public Functions
;;;###autoload
(defun grizzl-make-index (strings &rest options)
"Makes an index from the list STRINGS for use with `grizzl-search'.
If :PROGRESS-FN is given as a keyword argument, it is called repeatedly
with integers N and TOTAL.
If :CASE-SENSITIVE is specified as a non-nil keyword argument, the index
will be created case-sensitive, otherwise it will be case-insensitive."
(let ((lookup-table (make-hash-table))
(total-strs (length strings))
(case-sensitive (plist-get options :case-sensitive))
(progress-fn (plist-get options :progress-fn))
(string-data (vconcat (mapcar (lambda (s)
(cons s (length s)))
strings))))
(cl-reduce (lambda (list-offset str)
(grizzl-index-insert str list-offset lookup-table
:case-sensitive case-sensitive)
(when progress-fn
(funcall progress-fn (1+ list-offset) total-strs))
(1+ list-offset))
strings
:initial-value 0)
(maphash (lambda (_char str-map)
(maphash (lambda (list-offset locations)
(puthash list-offset (reverse locations) str-map))
str-map)) lookup-table)
`((case-sensitive . ,case-sensitive)
(lookup-table . ,lookup-table)
(string-data . ,string-data))))
;;;###autoload
(defun grizzl-search (term index &optional old-result)
"Fuzzy searches for TERM in INDEX prepared with `grizzl-make-index'.
OLD-RESULT may be specified as an existing search result to increment from.
The result can be read with `grizzl-result-strings'."
(let* ((cased-term (if (grizzl-index-case-sensitive-p index)
term
(downcase term)))
(result (grizzl-rewind-result cased-term index old-result))
(matches (copy-hash-table (grizzl-result-matches result)))
(from-pos (length (grizzl-result-term result)))
(remainder (substring cased-term from-pos))
(lookup-table (grizzl-lookup-table index)))
(cl-reduce (lambda (acc-res ch)
(let ((sub-table (gethash ch lookup-table)))
(if (not sub-table)
(clrhash matches)
(grizzl-search-increment sub-table matches))
(grizzl-cons-result cased-term matches acc-res)))
remainder
:initial-value result)))
;;;###autoload
(defun grizzl-result-count (result)
"Returns the number of matches present in RESULT."
(hash-table-count (grizzl-result-matches result)))
;;;###autoload
(defun grizzl-result-strings (result index &rest options)
"Returns the ordered list of matched strings in RESULT, using INDEX.
If the :START option is specified, results are read from the given offset.
If the :END option is specified, up to :END results are returned."
(let* ((matches (grizzl-result-matches result))
(strings (grizzl-index-strings index))
(loaded '()))
(maphash (lambda (string-offset _char-offset)
(push string-offset loaded))
matches)
(let* ((ordered (sort loaded
(lambda (a b)
(< (cadr (gethash a matches))
(cadr (gethash b matches))))))
(start (or (plist-get options :start) 0))
(end (min (plist-get options :end) (length ordered)))
(best (if (or start end)
(cl-delete-if-not 'identity
(cl-subseq ordered start end))
ordered)))
(mapcar (lambda (n)
(car (elt strings n)))
best))))
;;; --- Private Functions
(defun grizzl-cons-result (term matches results)
"Build a new result for TERM and hash-table MATCHES consed with RESULTS."
(cons (cons term matches) results))
(defun grizzl-rewind-result (term index result)
"Adjusts RESULT according to TERM, ready for a new search."
(if result
(let* ((old-term (grizzl-result-term result))
(new-len (length term))
(old-len (length old-term)))
(if (and (>= new-len old-len)
(string-equal old-term (substring term 0 old-len)))
result
(grizzl-rewind-result term index (cdr result))))
(grizzl-cons-result "" (grizzl-base-matches index) nil)))
(defun grizzl-base-matches (index)
"Returns the full set of matches in INDEX, with an out-of-bound offset."
(let ((matches (make-hash-table)))
(cl-reduce (lambda (n s-len)
(puthash n (list -1 0 (cdr s-len)) matches)
(1+ n))
(grizzl-index-strings index)
:initial-value 0)
matches))
(defun grizzl-result-term (result)
"Returns the search term used to find the matches in RESULT."
(car (car result)))
(defun grizzl-result-matches (result)
"Returns the internal hash used to track the matches in RESULT."
(cdar result))
(defun grizzl-index-insert (string list-offset index &rest options)
"Inserts STRING at LIST-OFFSET into INDEX."
(let ((case-sensitive (plist-get options :case-sensitive)))
(cl-reduce (lambda (char-offset cs-char)
(let* ((char (if case-sensitive
cs-char
(downcase cs-char)))
(str-map (or (gethash char index)
(puthash char (make-hash-table) index)))
(offsets (gethash list-offset str-map)))
(puthash list-offset
(cons char-offset offsets)
str-map)
(1+ char-offset)))
string
:initial-value 0)))
(defun grizzl-lookup-table (index)
"Returns the lookup table portion of INDEX."
(cdr (assoc 'lookup-table index)))
(defun grizzl-index-strings (index)
"Returns the vector of strings stored in INDEX."
(cdr (assoc 'string-data index)))
(defun grizzl-index-case-sensitive-p (index)
"Predicate to test of INDEX is case-sensitive."
(cdr (assoc 'case-sensitive index)))
(defun grizzl-search-increment (sub-table result)
"Use the search lookup table to filter already-accumulated results."
(cl-flet ((next-offset (key current sub-table)
(cl-find-if (lambda (v)
(> v current))
(gethash key sub-table))))
(maphash (lambda (k v)
(let* ((oldpos (car v))
(oldrank (cadr v))
(len (cl-caddr v))
(newpos (next-offset k oldpos sub-table)))
(if newpos
(puthash k (list newpos
(grizzl-inc-rank oldrank oldpos newpos len)
len)
result)
(remhash k result))))
result)))
(defun grizzl-inc-rank (oldrank oldpos newpos len)
"Increment the current match distance as a new char is matched."
(let ((distance (if (< oldpos 0) 1 (- newpos oldpos))))
(+ oldrank (* len (* distance distance)))))
;;; --- Configuration Variables
(defvar *grizzl-read-max-results* 10
"The maximum number of results to show in `grizzl-completing-read'.")
;;; --- Runtime Processing Variables
(defvar *grizzl-current-result* nil
"The search result in `grizzl-completing-read'.")
(defvar *grizzl-current-selection* 0
"The selected offset in `grizzl-completing-read'.")
(defface grizzl-selection-face
`((((class color) (background light))
(:foreground "red"))
(((class color) (background dark))
(:foreground "red"))
(t (:foreground "red")))
"Face for selected result."
:group 'grizzl-mode)
(defface grizzl-prompt-face
`((t :inherit 'mode-line-inactive))
"Face used for grizzl prompt."
:group 'grizzl-mode)
;;; --- Minor Mode Definition
(defvar *grizzl-keymap* (make-sparse-keymap)
"Internal keymap used by the minor-mode in `grizzl-completing-read'.")
(define-key *grizzl-keymap* (kbd "<up>") 'grizzl-set-selection+1)
(define-key *grizzl-keymap* (kbd "C-p") 'grizzl-set-selection+1)
(define-key *grizzl-keymap* (kbd "<down>") 'grizzl-set-selection-1)
(define-key *grizzl-keymap* (kbd "C-n") 'grizzl-set-selection-1)
(define-minor-mode grizzl-mode
"Toggle the internal mode used by `grizzl-completing-read'."
nil
" Grizzl"
*grizzl-keymap*)
;;; --- Public Functions
;;;###autoload
(defun grizzl-completing-read (prompt index)
"Performs a completing-read in the minibuffer using INDEX to fuzzy search.
Each key pressed in the minibuffer filters down the list of matches."
(minibuffer-with-setup-hook
(lambda ()
(setq *grizzl-current-result* nil)
(setq *grizzl-current-selection* 0)
(grizzl-mode 1)
(let* ((hookfun (lambda ()
(setq *grizzl-current-result*
(grizzl-search (minibuffer-contents)
index
*grizzl-current-result*))
(grizzl-display-result index prompt)))
(exitfun (lambda ()
(grizzl-mode -1)
(remove-hook 'post-command-hook hookfun t))))
(add-hook 'minibuffer-exit-hook exitfun nil t)
(add-hook 'post-command-hook hookfun nil t)))
(let ((read-value (read-from-minibuffer ">>> ")))
(or (grizzl-selected-result index) read-value))))
;;;###autoload
(defun grizzl-selected-result (index)
"Get the selected string from INDEX in a `grizzl-completing-read'."
(elt (grizzl-result-strings *grizzl-current-result* index
:start 0
:end *grizzl-read-max-results*)
(grizzl-current-selection)))
;;;###autoload
(defun grizzl-set-selection+1 ()
"Move the selection up one row in `grizzl-completing-read'."
(interactive)
(grizzl-move-selection 1))
;;;###autoload
(defun grizzl-set-selection-1 ()
"Move the selection down one row in `grizzl-completing-read'."
(interactive)
(grizzl-move-selection -1))
;;; --- Private Functions
(defun grizzl-move-selection (delta)
"Move the selection by DELTA rows in `grizzl-completing-read'."
(setq *grizzl-current-selection* (+ (grizzl-current-selection) delta))
(when (not (= (grizzl-current-selection) *grizzl-current-selection*))
(beep)))
(defun grizzl-display-result (index prompt)
"Renders a series of overlays to list the matches in the result."
(let* ((matches (grizzl-result-strings *grizzl-current-result* index
:start 0
:end *grizzl-read-max-results*)))
(delete-all-overlays)
(overlay-put (make-overlay (point-min) (point-min))
'before-string
(format "%s\n%s\n"
(mapconcat 'identity
(grizzl-map-format-matches matches)
"\n")
(grizzl-format-prompt-line prompt)))
(set-window-text-height nil (max 3 (+ 2 (length matches))))))
(defun grizzl-map-format-matches (matches)
"Convert the set of string MATCHES into propertized text objects."
(if (= 0 (length matches))
(list (propertize "-- NO MATCH --" 'face 'outline-3))
(cdr (cl-reduce (lambda (acc str)
(let* ((idx (car acc))
(lst (cdr acc))
(sel (= idx (grizzl-current-selection))))
(cons (1+ idx)
(cons (grizzl-format-match str sel) lst))))
matches
:initial-value '(0)))))
(defun grizzl-format-match (match-str selected)
"Default match string formatter in `grizzl-completing-read'.
MATCH-STR is the string in the selection list and SELECTED is non-nil
if this is the current selection."
(let ((margin (if selected "> " " "))
(face (if selected 'grizzl-selection-face 'default)))
(propertize (format "%s%s" margin match-str) 'face face)))
(defun grizzl-format-prompt-line (prompt)
"Returns a string to render a full-width prompt in `grizzl-completing-read'."
(let* ((count (grizzl-result-count *grizzl-current-result*))
(match-info (format " (%d candidate%s) ---- *-"
count (if (= count 1) "" "s"))))
(concat (propertize (format "-*%s *-" prompt) 'face 'grizzl-prompt-face)
(propertize " "
'face 'grizzl-prompt-face
'display `(space :align-to (- right
,(1+ (length match-info)))))
(propertize match-info 'face 'grizzl-prompt-face))))
(defun grizzl-current-selection ()
"Get the currently selected index in `grizzl-completing-read'."
(let ((max-selection
(min (1- *grizzl-read-max-results*)
(1- (grizzl-result-count *grizzl-current-result*)))))
(max 0 (min max-selection *grizzl-current-selection*))))
(provide 'grizzl)
;;; grizzl.el ends here

39
elpa/helm-make-20160807.1756/helm-make-autoloads.el
View File

@ -1,39 +0,0 @@
;;; helm-make-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "helm-make" "helm-make.el" (22454 5313 194042
;;;;;; 549000))
;;; Generated autoloads from helm-make.el
(autoload 'helm-make "helm-make" "\
Call \"make -j ARG target\". Target is selected with completion.
\(fn &optional ARG)" t nil)
(autoload 'helm-make-reset-cache "helm-make" "\
Reset cache, see `helm-make-cache-targets'.
\(fn)" t nil)
(autoload 'helm-make-projectile "helm-make" "\
Call `helm-make' for `projectile-project-root'.
ARG specifies the number of cores.
By default `helm-make-projectile' will look in `projectile-project-root'
followed by `projectile-project-root'/build, for a makefile.
You can specify an additional directory to search for a makefile by
setting the buffer local variable `helm-make-build-dir'.
\(fn &optional ARG)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; helm-make-autoloads.el ends here

2
elpa/helm-make-20160807.1756/helm-make-pkg.el
View File

@ -1,2 +0,0 @@
;;; -*- no-byte-compile: t -*-
(define-package "helm-make" "20160807.1756" "Select a Makefile target with helm" '((helm "1.5.3") (projectile "0.11.0")) :url "https://github.com/abo-abo/helm-make" :keywords '("makefile"))

315
elpa/helm-make-20160807.1756/helm-make.el
View File

@ -1,315 +0,0 @@
;;; helm-make.el --- Select a Makefile target with helm
;; Copyright (C) 2014 Oleh Krehel
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; URL: https://github.com/abo-abo/helm-make
;; Package-Version: 20160807.1756
;; Version: 0.2.0
;; Package-Requires: ((helm "1.5.3") (projectile "0.11.0"))
;; Keywords: makefile
;; This file is not part of GNU Emacs
;; This file 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, 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.
;; For a full copy of the GNU General Public License
;; see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; A call to `helm-make' will give you a `helm' selection of this directory
;; Makefile's targets. Selecting a target will call `compile' on it.
;;; Code:
(require 'helm)
(require 'helm-multi-match)
(declare-function ivy-read "ext:ivy")
(defgroup helm-make nil
"Select a Makefile target with helm."
:group 'convenience)
(defcustom helm-make-do-save nil
"If t, save all open buffers visiting files from Makefile's directory."
:type 'boolean
:group 'helm-make)
(defcustom helm-make-build-dir ""
"Specify a build directory for an out of source build.
The path should be relative to the project root.
When non-nil `helm-make-projectile' will first look in that directory for a
makefile."
:type '(string)
:group 'helm-make)
(make-variable-buffer-local 'helm-make-build-dir)
(defcustom helm-make-sort-targets nil
"Whether targets shall be sorted.
If t, targets will be sorted as a final step before calling the
completion method.
HINT: If you are facing performance problems set this to nil.
This might be the case, if there are thousand of targets."
:type 'boolean
:group 'helm-make)
(defcustom helm-make-cache-targets nil
"Whether to cache the targets or not.
If t, cache targets of Makefile. If `helm-make' or `helm-make-projectile'
gets called for the same Makefile again, and the Makefile hasn't changed
meanwhile, i.e. the modification time is `equal' to the cached one, reuse
the cached targets, instead of recomputing them. If nil do nothing.
You can reset the cache by calling `helm-make-reset-db'."
:type 'boolean
:group 'helm-make)
(defcustom helm-make-executable "make"
"Store the name of make executable."
:type 'string
:group 'helm-make)
(defcustom helm-make-require-match t
"When non-nil, don't allow selecting a target that's not on the list."
:type 'boolean)
(defcustom helm-make-named-buffer nil
"When non-nil, name compilation buffer based on make target."
:type 'boolean)
(defcustom helm-make-comint nil
"When non-nil, run helm-make in Comint mode instead of Compilation mode."
:type 'boolean)
(defvar helm-make-command nil
"Store the make command.")
(defvar helm-make-target-history nil
"Holds the recently used targets.")
(defvar helm-make-makefile-names '("Makefile" "makefile" "GNUmakefile")
"List of Makefile names which make recognizes.
An exception is \"GNUmakefile\", only GNU make unterstand it.")
(defun helm--make-action (target)
"Make TARGET."
(let* ((make-command (format helm-make-command target))
(compile-buffer (compile make-command helm-make-comint)))
(when helm-make-named-buffer
(helm--make-rename-buffer compile-buffer target))))
(defun helm--make-rename-buffer (buffer target)
"Rename the compilation BUFFER based on the make TARGET."
(let ((buffer-name (format "*compilation (%s)*" target)))
(when (get-buffer-window buffer-name)
(delete-window (get-buffer-window buffer-name)))
(when (get-buffer buffer-name)
(kill-buffer buffer-name))
(with-current-buffer buffer
(rename-buffer buffer-name))))
(defcustom helm-make-completion-method 'helm
"Method to select a candidate from a list of strings."
:type '(choice
(const :tag "Helm" helm)
(const :tag "Ido" ido)
(const :tag "Ivy" ivy)))
;;;###autoload
(defun helm-make (&optional arg)
"Call \"make -j ARG target\". Target is selected with completion."
(interactive "p")
(setq helm-make-command (format "%s -j%d %%s" helm-make-executable arg))
(let ((makefile (helm--make-makefile-exists default-directory)))
(if makefile
(helm--make makefile)
(error "No Makefile in %s" default-directory))))
(defun helm--make-target-list-qp (makefile)
"Return the target list for MAKEFILE by parsing the output of \"make -nqp\"."
(let ((default-directory (file-name-directory
(expand-file-name makefile)))
targets target)
(with-temp-buffer
(insert
(shell-command-to-string
"make -nqp __BASH_MAKE_COMPLETION__=1 .DEFAULT 2>/dev/null"))
(goto-char (point-min))
(unless (re-search-forward "^# Files" nil t)
(error "Unexpected \"make -nqp\" output"))
(while (re-search-forward "^\\([^%$:#\n\t ]+\\):\\([^=]\\|$\\)" nil t)
(setq target (match-string 1))
(unless (or (save-excursion
(goto-char (match-beginning 0))
(forward-line -1)
(looking-at "^# Not a target:"))
(string-match "^\\([/a-zA-Z0-9_. -]+/\\)?\\." target))
(push target targets))))
targets))
(defun helm--make-target-list-default (makefile)
"Return the target list for MAKEFILE by parsing it."
(let (targets)
(with-temp-buffer
(insert-file-contents makefile)
(goto-char (point-min))
(while (re-search-forward "^\\([^: \n]+\\):" nil t)
(let ((str (match-string 1)))
(unless (string-match "^\\." str)
(push str targets)))))
targets))
(defcustom helm-make-list-target-method 'default
"Method of obtaining the list of Makefile targets."
:type '(choice
(const :tag "Default" default)
(const :tag "make -qp" qp)))
(defun helm--make-makefile-exists (base-dir &optional dir-list)
"Check if one of `helm-make-makefile-names' exist in BASE-DIR.
Returns the absolute filename to the Makefile, if one exists,
otherwise nil.
If DIR-LIST is non-nil, also search for `helm-make-makefile-names'."
(let* ((default-directory (file-truename base-dir))
(makefiles
(progn
(unless (and dir-list (listp dir-list))
(setq dir-list (list "")))
(let (result)
(dolist (dir dir-list)
(dolist (makefile helm-make-makefile-names)
(push (expand-file-name makefile dir) result)))
(reverse result)))))
(cl-find-if 'file-exists-p makefiles)))
(defvar helm-make-db (make-hash-table :test 'equal)
"An alist of Makefile and corresponding targets.")
(cl-defstruct helm-make-dbfile
targets
modtime
sorted)
(defun helm--make-cached-targets (makefile)
"Return cached targets of MAKEFILE.
If there are no cached targets for MAKEFILE, the MAKEFILE modification
time has changed, or `helm-make-cache-targets' is nil, parse the MAKEFILE,
and cache targets of MAKEFILE, if `helm-make-cache-targets' is t."
(let* ((att (file-attributes makefile 'integer))
(modtime (if att (nth 5 att) nil))
(entry (gethash makefile helm-make-db nil))
(new-entry (make-helm-make-dbfile))
(targets (cond
((and helm-make-cache-targets
entry
(equal modtime (helm-make-dbfile-modtime entry))
(helm-make-dbfile-targets entry))
(helm-make-dbfile-targets entry))
(t
(delete-dups (if (eq helm-make-list-target-method 'default)
(helm--make-target-list-default makefile)
(helm--make-target-list-qp makefile)))))))
(when helm-make-sort-targets
(unless (and helm-make-cache-targets
entry
(helm-make-dbfile-sorted entry))
(setq targets (sort targets 'string<)))
(setf (helm-make-dbfile-sorted new-entry) t))
(when helm-make-cache-targets
(setf (helm-make-dbfile-targets new-entry) targets
(helm-make-dbfile-modtime new-entry) modtime)
(puthash makefile new-entry helm-make-db))
targets))
;;;###autoload
(defun helm-make-reset-cache ()
"Reset cache, see `helm-make-cache-targets'."
(interactive)
(clrhash helm-make-db))
(defun helm--make (makefile)
"Call make for MAKEFILE."
(when helm-make-do-save
(let* ((regex (format "^%s" default-directory))
(buffers
(cl-remove-if-not
(lambda (b)
(let ((name (buffer-file-name b)))
(and name
(string-match regex (expand-file-name name)))))
(buffer-list))))
(mapc
(lambda (b)
(with-current-buffer b
(save-buffer)))
buffers)))
(let ((targets (helm--make-cached-targets makefile))
(default-directory (file-name-directory makefile)))
(delete-dups helm-make-target-history)
(cl-case helm-make-completion-method
(helm
(helm :sources
`((name . "Targets")
(candidates . ,targets)
(action . helm--make-action))
:history 'helm-make-target-history
:preselect (when helm-make-target-history
(format "^%s$" (car helm-make-target-history)))))
(ivy
(ivy-read "Target: "
targets
:history 'helm-make-target-history
:preselect (car helm-make-target-history)
:action 'helm--make-action
:require-match helm-make-require-match))
(ido
(let ((target (ido-completing-read
"Target: " targets
nil nil nil
'helm-make-target-history)))
(when target
(helm--make-action target)))))))
;;;###autoload
(defun helm-make-projectile (&optional arg)
"Call `helm-make' for `projectile-project-root'.
ARG specifies the number of cores.
By default `helm-make-projectile' will look in `projectile-project-root'
followed by `projectile-project-root'/build, for a makefile.
You can specify an additional directory to search for a makefile by
setting the buffer local variable `helm-make-build-dir'."
(interactive "p")
(require 'projectile)
(setq helm-make-command (format "%s -j%d %%s" helm-make-executable arg))
(let ((makefile (helm--make-makefile-exists
(projectile-project-root)
(if (and (stringp helm-make-build-dir)
(not (string-match-p "\\`[ \t\n\r]*\\'" helm-make-build-dir)))
`(,helm-make-build-dir "" "build")
`(,@helm-make-build-dir "" "build")))))
(if makefile
(helm--make makefile)
(error "No Makefile found for project %s" (projectile-project-root)))))
(provide 'helm-make)
;;; helm-make.el ends here

15
elpa/ht-20160911.1900/ht-autoloads.el
View File

@ -1,15 +0,0 @@
;;; ht-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("ht.el") (22490 24933 409230 911000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; ht-autoloads.el ends here

1
elpa/ht-20160911.1900/ht-pkg.el
View File

@ -1 +0,0 @@
(define-package "ht" "20160911.1900" "The missing hash table library for Emacs" '((dash "2.12.0")) :keywords '("hash table" "hash map" "hash"))

280
elpa/ht-20160911.1900/ht.el
View File

@ -1,280 +0,0 @@
;;; ht.el --- The missing hash table library for Emacs
;; Copyright (C) 2013 Wilfred Hughes
;; Author: Wilfred Hughes <me@wilfred.me.uk>
;; Version: 2.2
;; Package-Version: 20160911.1900
;; Keywords: hash table, hash map, hash
;; Package-Requires: ((dash "2.12.0"))
;; 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 missing hash table library for Emacs.
;;
;; See documentation at https://github.com/Wilfred/ht.el
;;; Code:
(require 'dash)
(defmacro ht (&rest pairs)
"Create a hash table with the key-value pairs given.
Keys are compared with `equal'.
\(fn (KEY-1 VALUE-1) (KEY-2 VALUE-2) ...)"
(let* ((table-symbol (make-symbol "ht-temp"))
(assignments
(mapcar
(lambda (pair) `(ht-set! ,table-symbol ,@pair))
pairs)))
`(let ((,table-symbol (ht-create)))
,@assignments
,table-symbol)))
(defun ht-create (&optional test)
"Create an empty hash table.
TEST indicates the function used to compare the hash
keys. Default is `equal'. It can be `eq', `eql', `equal' or a
user-supplied test created via `define-hash-table-test'."
(make-hash-table :test (or test 'equal)))
(defun ht<-alist (alist &optional test)
"Create a hash table with initial values according to ALIST.
TEST indicates the function used to compare the hash
keys. Default is `equal'. It can be `eq', `eql', `equal' or a
user-supplied test created via `define-hash-table-test'."
(let ((h (ht-create test)))
;; the first key-value pair in an alist gets precedence, so we
;; start from the end of the list:
(dolist (pair (reverse alist) h)
(let ((key (car pair))
(value (cdr pair)))
(ht-set! h key value)))))
(defalias 'ht-from-alist 'ht<-alist)
(defun ht<-plist (plist &optional test)
"Create a hash table with initial values according to PLIST.
TEST indicates the function used to compare the hash
keys. Default is `equal'. It can be `eq', `eql', `equal' or a
user-supplied test created via `define-hash-table-test'."
(let ((h (ht-create test)))
(dolist (pair (-partition 2 plist) h)
(let ((key (car pair))
(value (cadr pair)))
(ht-set! h key value)))))
(defalias 'ht-from-plist 'ht<-plist)
(defun ht-get (table key &optional default)
"Look up KEY in TABLE, and return the matching value.
If KEY isn't present, return DEFAULT (nil if not specified)."
(gethash key table default))
(defun ht-set! (table key value)
"Associate KEY in TABLE with VALUE."
(puthash key value table)
nil)
(defalias 'ht-set 'ht-set!)
(defun ht-update! (table from-table)
"Update TABLE according to every key-value pair in FROM-TABLE."
(maphash
(lambda (key value) (puthash key value table))
from-table)
nil)
(defalias 'ht-update 'ht-update!)
(defun ht-merge (&rest tables)
"Crete a new tables that includes all the key-value pairs from TABLES.
If multiple have tables have the same key, the value in the last
table is used."
(let ((merged (ht-create)))
(mapc (lambda (table) (ht-update! merged table)) tables)
merged))
(defun ht-remove! (table key)
"Remove KEY from TABLE."
(remhash key table))
(defalias 'ht-remove 'ht-remove!)
(defun ht-clear! (table)
"Remove all keys from TABLE."
(clrhash table)
nil)
(defalias 'ht-clear 'ht-clear!)
(defun ht-map (function table)
"Apply FUNCTION to each key-value pair of TABLE, and make a list of the results.
FUNCTION is called with two arguments, KEY and VALUE."
(let (results)
(maphash
(lambda (key value)
(push (funcall function key value) results))
table)
results))
(defmacro ht-amap (form table)
"Anaphoric version of `ht-map'.
For every key-value pair in TABLE, evaluate FORM with the
variables KEY and VALUE bound."
`(ht-map (lambda (key value) ,form) ,table))
(defun ht-keys (table)
"Return a list of all the keys in TABLE."
(ht-amap key table))
(defun ht-values (table)
"Return a list of all the values in TABLE."
(ht-amap value table))
(defun ht-items (table)
"Return a list of two-element lists '(key value) from TABLE."
(ht-amap (list key value) table))
(defalias 'ht-each 'maphash
"Apply FUNCTION to each key-value pair of TABLE.
Returns nil, used for side-effects only.")
(defmacro ht-aeach (form table)
"Anaphoric version of `ht-each'.
For every key-value pair in TABLE, evaluate FORM with the
variables key and value bound."
`(ht-each (lambda (key value) ,form) ,table))
(defun ht->plist (table)
"Return a flat list '(key1 value1 key2 value2...) from TABLE.
Note that hash tables are unordered, so this cannot be an exact
inverse of `ht<-plist'. The following is not guaranteed:
\(let ((data '(a b c d)))
(equalp data
(ht->plist (ht<-plist data))))"
(apply 'append (ht-items table)))
(defalias 'ht-to-plist 'ht->plist)
(defun ht-copy (table)
"Return a shallow copy of TABLE (keys and values are shared)."
(copy-hash-table table))
(defun ht->alist (table)
"Return a list of two-element lists '(key . value) from TABLE.
Note that hash tables are unordered, so this cannot be an exact
inverse of `ht<-alist'. The following is not guaranteed:
\(let ((data '((a . b) (c . d))))
(equalp data
(ht->alist (ht<-alist data))))"
(ht-amap (cons key value) table))
(defalias 'ht-to-alist 'ht->alist)
(defalias 'ht? 'hash-table-p)
(defalias 'ht-p 'hash-table-p)
(defun ht-contains? (table key)
"Return 't if TABLE contains KEY."
(not (eq (ht-get table key 'ht--not-found) 'ht--not-found)))
(defalias 'ht-contains-p 'ht-contains?)
(defun ht-size (table)
"Return the actual number of entries in TABLE."
(hash-table-count table))
(defun ht-empty? (table)
"Return true if the actual number of entries in TABLE is zero."
(zerop (ht-size table)))
(defun ht-select (function table)
"Return a hash table containing all entries in TABLE for which
FUNCTION returns a truthy value.
FUNCTION is called with two arguments, KEY and VALUE."
(let ((results (ht-create)))
(ht-each
(lambda (key value)
(when (funcall function key value)
(ht-set! results key value)))
table)
results))
(defun ht-reject (function table)
"Return a hash table containing all entries in TABLE for which
FUNCTION returns a falsy value.
FUNCTION is called with two arguments, KEY and VALUE."
(let ((results (ht-create)))
(ht-each
(lambda (key value)
(unless (funcall function key value)
(ht-set! results key value)))
table)
results))
(defun ht-reject! (function table)
"Delete entries from TABLE for which FUNCTION returns a falsy value.
FUNCTION is called with two arguments, KEY and VALUE."
(ht-each
(lambda (key value)
(when (funcall function key value)
(remhash key table)))
table)
nil)
(defalias 'ht-delete-if 'ht-reject!)
(defun ht-find (function table)
"Return (key, value) from TABLE for which FUNCTION returns a truthy value.
Return nil otherwise.
FUNCTION is called with two arguments, KEY and VALUE."
(catch 'break
(ht-each
(lambda (key value)
(when (funcall function key value)
(throw 'break (list key value))))
table)))
(defun ht-equal? (table1 table2)
"Return t if TABLE1 and TABLE2 have the same keys and values.
Does not compare equality predicates."
(let ((keys1 (ht-keys table1))
(keys2 (ht-keys table2))
(sentinel (make-symbol "ht-sentinel")))
(and (equal (length keys1) (length keys2))
(--all?
(equal (ht-get table1 it)
(ht-get table2 it sentinel))
keys1))))
(defalias 'ht-equal-p 'ht-equal?)
(provide 'ht)
;;; ht.el ends here

75
elpa/hydra-20160913.216/hydra-autoloads.el
View File

@ -1,75 +0,0 @@
;;; hydra-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "hydra" "hydra.el" (22501 5659 447421 78000))
;;; Generated autoloads from hydra.el
(autoload 'defhydra "hydra" "\
Create a Hydra - a family of functions with prefix NAME.
NAME should be a symbol, it will be the prefix of all functions
defined here.
BODY has the format:
(BODY-MAP BODY-KEY &rest BODY-PLIST)
DOCSTRING will be displayed in the echo area to identify the
Hydra. When DOCSTRING starts with a newline, special Ruby-style
substitution will be performed by `hydra--format'.
Functions are created on basis of HEADS, each of which has the
format:
(KEY CMD &optional HINT &rest PLIST)
BODY-MAP is a keymap; `global-map' is used quite often. Each
function generated from HEADS will be bound in BODY-MAP to
BODY-KEY + KEY (both are strings passed to `kbd'), and will set
the transient map so that all following heads can be called
though KEY only. BODY-KEY can be an empty string.
CMD is a callable expression: either an interactive function
name, or an interactive lambda, or a single sexp (it will be
wrapped in an interactive lambda).
HINT is a short string that identifies its head. It will be
printed beside KEY in the echo erea if `hydra-is-helpful' is not
nil. If you don't even want the KEY to be printed, set HINT
explicitly to nil.
The heads inherit their PLIST from BODY-PLIST and are allowed to
override some keys. The keys recognized are :exit and :bind.
:exit can be:
- nil (default): this head will continue the Hydra state.
- t: this head will stop the Hydra state.
:bind can be:
- nil: this head will not be bound in BODY-MAP.
- a lambda taking KEY and CMD used to bind a head.
It is possible to omit both BODY-MAP and BODY-KEY if you don't
want to bind anything. In that case, typically you will bind the
generated NAME/body command. This command is also the return
result of `defhydra'.
\(fn NAME BODY &optional DOCSTRING &rest HEADS)" nil t)
(put 'defhydra 'lisp-indent-function 'defun)
;;;***
;;;### (autoloads nil nil ("hydra-examples.el" "hydra-ox.el" "hydra-pkg.el"
;;;;;; "lv.el") (22501 5659 473131 612000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; hydra-autoloads.el ends here

386
elpa/hydra-20160913.216/hydra-examples.el
View File

@ -1,386 +0,0 @@
;;; hydra-examples.el --- Some applications for Hydra
;; Copyright (C) 2015 Free Software Foundation, Inc.
;; Author: Oleh Krehel
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; These are the sample Hydras.
;;
;; If you want to use them plainly, set `hydra-examples-verbatim' to t
;; before requiring this file. But it's probably better to only look
;; at them and use them as templates for building your own.
;;; Code:
(require 'hydra)
;;* Examples
;;** Example 1: text scale
(when (bound-and-true-p hydra-examples-verbatim)
(defhydra hydra-zoom (global-map "<f2>")
"zoom"
("g" text-scale-increase "in")
("l" text-scale-decrease "out")))
;; This example generates three commands:
;;
;; `hydra-zoom/text-scale-increase'
;; `hydra-zoom/text-scale-decrease'
;; `hydra-zoom/body'
;;
;; In addition, two of them are bound like this:
;;
;; (global-set-key (kbd "<f2> g") 'hydra-zoom/text-scale-increase)
;; (global-set-key (kbd "<f2> l") 'hydra-zoom/text-scale-decrease)
;;
;; Note that you can substitute `global-map' with e.g. `emacs-lisp-mode-map' if you need.
;; The functions generated will be the same, except the binding code will change to:
;;
;; (define-key emacs-lisp-mode-map [f2 103]
;; (function hydra-zoom/text-scale-increase))
;; (define-key emacs-lisp-mode-map [f2 108]
;; (function hydra-zoom/text-scale-decrease))
;;** Example 2: move window splitter
(when (bound-and-true-p hydra-examples-verbatim)
(defhydra hydra-splitter (global-map "C-M-s")
"splitter"
("h" hydra-move-splitter-left)
("j" hydra-move-splitter-down)
("k" hydra-move-splitter-up)
("l" hydra-move-splitter-right)))
;;** Example 3: jump to error
(when (bound-and-true-p hydra-examples-verbatim)
(defhydra hydra-error (global-map "M-g")
"goto-error"
("h" first-error "first")
("j" next-error "next")
("k" previous-error "prev")
("v" recenter-top-bottom "recenter")
("q" nil "quit")))
;; This example introduces only one new thing: since the command
;; passed to the "q" head is nil, it will quit the Hydra without doing
;; anything. Heads that quit the Hydra instead of continuing are
;; referred to as having blue :color. All the other heads have red
;; :color, unless other is specified.
;;** Example 4: toggle rarely used modes
(when (bound-and-true-p hydra-examples-verbatim)
(defvar whitespace-mode nil)
(global-set-key
(kbd "C-c C-v")
(defhydra hydra-toggle-simple (:color blue)
"toggle"
("a" abbrev-mode "abbrev")
("d" toggle-debug-on-error "debug")
("f" auto-fill-mode "fill")
("t" toggle-truncate-lines "truncate")
("w" whitespace-mode "whitespace")
("q" nil "cancel"))))
;; Note that in this case, `defhydra' returns the `hydra-toggle-simple/body'
;; symbol, which is then passed to `global-set-key'.
;;
;; Another new thing is that both the keymap and the body prefix are
;; skipped. This means that `defhydra' will bind nothing - that's why
;; `global-set-key' is necessary.
;;
;; One more new thing is that you can assign a :color to the body. All
;; heads will inherit this color. The code above is very much equivalent to:
;;
;; (global-set-key (kbd "C-c C-v a") 'abbrev-mode)
;; (global-set-key (kbd "C-c C-v d") 'toggle-debug-on-error)
;;
;; The differences are:
;;
;; * You get a hint immediately after "C-c C-v"
;; * You can cancel and call a command immediately, e.g. "C-c C-v C-n"
;; is equivalent to "C-n" with Hydra approach, while it will error
;; that "C-c C-v C-n" isn't bound with the usual approach.
;;** Example 5: mini-vi
(defun hydra-vi/pre ()
(set-cursor-color "#e52b50"))
(defun hydra-vi/post ()
(set-cursor-color "#ffffff"))
(when (bound-and-true-p hydra-examples-verbatim)
(global-set-key
(kbd "C-z")
(defhydra hydra-vi (:pre hydra-vi/pre :post hydra-vi/post :color amaranth)
"vi"
("l" forward-char)
("h" backward-char)
("j" next-line)
("k" previous-line)
("m" set-mark-command "mark")
("a" move-beginning-of-line "beg")
("e" move-end-of-line "end")
("d" delete-region "del" :color blue)
("y" kill-ring-save "yank" :color blue)
("q" nil "quit")))
(hydra-set-property 'hydra-vi :verbosity 1))
;; This example introduces :color amaranth. It's similar to red,
;; except while you can quit red with any binding which isn't a Hydra
;; head, you can quit amaranth only with a blue head. So you can quit
;; this mode only with "d", "y", "q" or "C-g".
;;
;; Another novelty are the :pre and :post handlers. :pre will be
;; called before each command, while :post will be called when the
;; Hydra quits. In this case, they're used to override the cursor
;; color while Hydra is active.
;;** Example 6: selective global bind
(when (bound-and-true-p hydra-examples-verbatim)
(defhydra hydra-next-error (global-map "C-x")
"next-error"
("`" next-error "next")
("j" next-error "next" :bind nil)
("k" previous-error "previous" :bind nil)))
;; This example will bind "C-x `" in `global-map', but it will not
;; bind "C-x j" and "C-x k".
;; You can still "C-x `jjk" though.
;;** Example 7: toggle with Ruby-style docstring
(defvar whitespace-mode nil)
(defhydra hydra-toggle (:color pink)
"
_a_ abbrev-mode: %`abbrev-mode
_d_ debug-on-error: %`debug-on-error
_f_ auto-fill-mode: %`auto-fill-function
_t_ truncate-lines: %`truncate-lines
_w_ whitespace-mode: %`whitespace-mode
"
("a" abbrev-mode nil)
("d" toggle-debug-on-error nil)
("f" auto-fill-mode nil)
("t" toggle-truncate-lines nil)
("w" whitespace-mode nil)
("q" nil "quit"))
;; Recommended binding:
;; (global-set-key (kbd "C-c C-v") 'hydra-toggle/body)
;; Here, using e.g. "_a_" translates to "a" with proper face.
;; More interestingly:
;;
;; "foobar %`abbrev-mode" means roughly (format "foobar %S" abbrev-mode)
;;
;; This means that you actually see the state of the mode that you're changing.
;;** Example 8: the whole menu for `Buffer-menu-mode'
(defhydra hydra-buffer-menu (:color pink
:hint nil)
"
^Mark^ ^Unmark^ ^Actions^ ^Search
^^^^^^^^----------------------------------------------------------------- (__)
_m_: mark _u_: unmark _x_: execute _R_: re-isearch (oo)
_s_: save _U_: unmark up _b_: bury _I_: isearch /------\\/
_d_: delete ^ ^ _g_: refresh _O_: multi-occur / | ||
_D_: delete up ^ ^ _T_: files only: % -28`Buffer-menu-files-only^^ * /\\---/\\
_~_: modified ^ ^ ^ ^ ^^ ~~ ~~
"
("m" Buffer-menu-mark)
("u" Buffer-menu-unmark)
("U" Buffer-menu-backup-unmark)
("d" Buffer-menu-delete)
("D" Buffer-menu-delete-backwards)
("s" Buffer-menu-save)
("~" Buffer-menu-not-modified)
("x" Buffer-menu-execute)
("b" Buffer-menu-bury)
("g" revert-buffer)
("T" Buffer-menu-toggle-files-only)
("O" Buffer-menu-multi-occur :color blue)
("I" Buffer-menu-isearch-buffers :color blue)
("R" Buffer-menu-isearch-buffers-regexp :color blue)
("c" nil "cancel")
("v" Buffer-menu-select "select" :color blue)
("o" Buffer-menu-other-window "other-window" :color blue)
("q" quit-window "quit" :color blue))
;; Recommended binding:
;; (define-key Buffer-menu-mode-map "." 'hydra-buffer-menu/body)
;;** Example 9: s-expressions in the docstring
;; You can inline s-expresssions into the docstring like this:
(defvar dired-mode-map)
(declare-function dired-mark "dired")
(when (bound-and-true-p hydra-examples-verbatim)
(require 'dired)
(defhydra hydra-marked-items (dired-mode-map "")
"
Number of marked items: %(length (dired-get-marked-files))
"
("m" dired-mark "mark")))
;; This results in the following dynamic docstring:
;;
;; (format "Number of marked items: %S\n"
;; (length (dired-get-marked-files)))
;;
;; You can use `format'-style width specs, e.g. % 10(length nil).
;;** Example 10: apropos family
(defhydra hydra-apropos (:color blue
:hint nil)
"
_a_propos _c_ommand
_d_ocumentation _l_ibrary
_v_ariable _u_ser-option
^ ^ valu_e_"
("a" apropos)
("d" apropos-documentation)
("v" apropos-variable)
("c" apropos-command)
("l" apropos-library)
("u" apropos-user-option)
("e" apropos-value))
;; Recommended binding:
;; (global-set-key (kbd "C-c h") 'hydra-apropos/body)
;;** Example 11: rectangle-mark-mode
(require 'rect)
(defhydra hydra-rectangle (:body-pre (rectangle-mark-mode 1)
:color pink
:post (deactivate-mark))
"
^_k_^ _d_elete _s_tring
_h_ _l_ _o_k _y_ank
^_j_^ _n_ew-copy _r_eset
^^^^ _e_xchange _u_ndo
^^^^ ^ ^ _p_aste
"
("h" rectangle-backward-char nil)
("l" rectangle-forward-char nil)
("k" rectangle-previous-line nil)
("j" rectangle-next-line nil)
("e" hydra-ex-point-mark nil)
("n" copy-rectangle-as-kill nil)
("d" delete-rectangle nil)
("r" (if (region-active-p)
(deactivate-mark)
(rectangle-mark-mode 1)) nil)
("y" yank-rectangle nil)
("u" undo nil)
("s" string-rectangle nil)
("p" kill-rectangle nil)
("o" nil nil))
;; Recommended binding:
;; (global-set-key (kbd "C-x SPC") 'hydra-rectangle/body)
;;** Example 12: org-agenda-view
(defun org-agenda-cts ()
(and (eq major-mode 'org-agenda-mode)
(let ((args (get-text-property
(min (1- (point-max)) (point))
'org-last-args)))
(nth 2 args))))
(defhydra hydra-org-agenda-view (:hint none)
"
_d_: ?d? day _g_: time grid=?g? _a_: arch-trees
_w_: ?w? week _[_: inactive _A_: arch-files
_t_: ?t? fortnight _f_: follow=?f? _r_: clock report=?r?
_m_: ?m? month _e_: entry text=?e? _D_: include diary=?D?
_y_: ?y? year _q_: quit _L__l__c_: log = ?l?"
("SPC" org-agenda-reset-view)
("d" org-agenda-day-view (if (eq 'day (org-agenda-cts)) "[x]" "[ ]"))
("w" org-agenda-week-view (if (eq 'week (org-agenda-cts)) "[x]" "[ ]"))
("t" org-agenda-fortnight-view (if (eq 'fortnight (org-agenda-cts)) "[x]" "[ ]"))
("m" org-agenda-month-view (if (eq 'month (org-agenda-cts)) "[x]" "[ ]"))
("y" org-agenda-year-view (if (eq 'year (org-agenda-cts)) "[x]" "[ ]"))
("l" org-agenda-log-mode (format "% -3S" org-agenda-show-log))
("L" (org-agenda-log-mode '(4)))
("c" (org-agenda-log-mode 'clockcheck))
("f" org-agenda-follow-mode (format "% -3S" org-agenda-follow-mode))
("a" org-agenda-archives-mode)
("A" (org-agenda-archives-mode 'files))
("r" org-agenda-clockreport-mode (format "% -3S" org-agenda-clockreport-mode))
("e" org-agenda-entry-text-mode (format "% -3S" org-agenda-entry-text-mode))
("g" org-agenda-toggle-time-grid (format "% -3S" org-agenda-use-time-grid))
("D" org-agenda-toggle-diary (format "% -3S" org-agenda-include-diary))
("!" org-agenda-toggle-deadlines)
("[" (let ((org-agenda-include-inactive-timestamps t))
(org-agenda-check-type t 'timeline 'agenda)
(org-agenda-redo)
(message "Display now includes inactive timestamps as well")))
("q" (message "Abort") :exit t)
("v" nil))
;; Recommended binding:
;; (define-key org-agenda-mode-map "v" 'hydra-org-agenda-view/body)
;;* Helpers
(require 'windmove)
(defun hydra-move-splitter-left (arg)
"Move window splitter left."
(interactive "p")
(if (let ((windmove-wrap-around))
(windmove-find-other-window 'right))
(shrink-window-horizontally arg)
(enlarge-window-horizontally arg)))
(defun hydra-move-splitter-right (arg)
"Move window splitter right."
(interactive "p")
(if (let ((windmove-wrap-around))
(windmove-find-other-window 'right))
(enlarge-window-horizontally arg)
(shrink-window-horizontally arg)))
(defun hydra-move-splitter-up (arg)
"Move window splitter up."
(interactive "p")
(if (let ((windmove-wrap-around))
(windmove-find-other-window 'up))
(enlarge-window arg)
(shrink-window arg)))
(defun hydra-move-splitter-down (arg)
"Move window splitter down."
(interactive "p")
(if (let ((windmove-wrap-around))
(windmove-find-other-window 'up))
(shrink-window arg)
(enlarge-window arg)))
(defvar rectangle-mark-mode)
(defun hydra-ex-point-mark ()
"Exchange point and mark."
(interactive)
(if rectangle-mark-mode
(rectangle-exchange-point-and-mark)
(let ((mk (mark)))
(rectangle-mark-mode 1)
(goto-char mk))))
(provide 'hydra-examples)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; hydra-examples.el ends here

127
elpa/hydra-20160913.216/hydra-ox.el
View File

@ -1,127 +0,0 @@
;;; hydra-ox.el --- Org mode export widget implemented in Hydra
;; Copyright (C) 2015 Free Software Foundation, Inc.
;; Author: Oleh Krehel
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; This shows how a complex dispatch menu can be built with Hydra.
;;; Code:
(require 'hydra)
(require 'org)
(declare-function org-html-export-as-html 'ox-html)
(declare-function org-html-export-to-html 'ox-html)
(declare-function org-latex-export-as-latex 'ox-latex)
(declare-function org-latex-export-to-latex 'ox-latex)
(declare-function org-latex-export-to-pdf 'ox-latex)
(declare-function org-ascii-export-as-ascii 'ox-ascii)
(declare-function org-ascii-export-to-ascii 'ox-ascii)
(defhydradio hydra-ox ()
(body-only "Export only the body.")
(export-scope "Export scope." [buffer subtree])
(async-export "When non-nil, export async.")
(visible-only "When non-nil, export visible only")
(force-publishing "Toggle force publishing"))
(defhydra hydra-ox-html (:color blue)
"ox-html"
("H" (org-html-export-as-html
hydra-ox/async-export
(eq hydra-ox/export-scope 'subtree)
hydra-ox/visible-only
hydra-ox/body-only)
"As HTML buffer")
("h" (org-html-export-to-html
hydra-ox/async-export
(eq hydra-ox/export-scope 'subtree)
hydra-ox/visible-only
hydra-ox/body-only) "As HTML file")
("o" (org-open-file
(org-html-export-to-html
hydra-ox/async-export
(eq hydra-ox/export-scope 'subtree)
hydra-ox/visible-only
hydra-ox/body-only)) "As HTML file and open")
("b" hydra-ox/body "back")
("q" nil "quit"))
(defhydra hydra-ox-latex (:color blue)
"ox-latex"
("L" org-latex-export-as-latex "As LaTeX buffer")
("l" org-latex-export-to-latex "As LaTeX file")
("p" org-latex-export-to-pdf "As PDF file")
("o" (org-open-file (org-latex-export-to-pdf)) "As PDF file and open")
("b" hydra-ox/body "back")
("q" nil "quit"))
(defhydra hydra-ox-text (:color blue)
"ox-text"
("A" (org-ascii-export-as-ascii
nil nil nil nil
'(:ascii-charset ascii))
"As ASCII buffer")
("a" (org-ascii-export-to-ascii
nil nil nil nil
'(:ascii-charset ascii))
"As ASCII file")
("L" (org-ascii-export-as-ascii
nil nil nil nil
'(:ascii-charset latin1))
"As Latin1 buffer")
("l" (org-ascii-export-to-ascii
nil nil nil nil
'(:ascii-charset latin1))
"As Latin1 file")
("U" (org-ascii-export-as-ascii
nil nil nil nil
'(:ascii-charset utf-8))
"As UTF-8 buffer")
("u" (org-ascii-export-to-ascii
nil nil nil nil
'(:ascii-charset utf-8))
"As UTF-8 file")
("b" hydra-ox/body "back")
("q" nil "quit"))
(defhydra hydra-ox ()
"
_C-b_ Body only: % -15`hydra-ox/body-only^^^ _C-v_ Visible only: %`hydra-ox/visible-only
_C-s_ Export scope: % -15`hydra-ox/export-scope _C-f_ Force publishing: %`hydra-ox/force-publishing
_C-a_ Async export: %`hydra-ox/async-export
"
("C-b" (hydra-ox/body-only) nil)
("C-v" (hydra-ox/visible-only) nil)
("C-s" (hydra-ox/export-scope) nil)
("C-f" (hydra-ox/force-publishing) nil)
("C-a" (hydra-ox/async-export) nil)
("h" hydra-ox-html/body "Export to HTML" :exit t)
("l" hydra-ox-latex/body "Export to LaTeX" :exit t)
("t" hydra-ox-text/body "Export to Plain Text" :exit t)
("q" nil "quit"))
(define-key org-mode-map (kbd "C-c C-,") 'hydra-ox/body)
(provide 'hydra-ox)
;;; hydra-ox.el ends here

7
elpa/hydra-20160913.216/hydra-pkg.el
View File

@ -1,7 +0,0 @@
(define-package "hydra" "20160913.216" "Make bindings that stick around."
'((cl-lib "0.5"))
:url "https://github.com/abo-abo/hydra" :keywords
'("bindings"))
;; Local Variables:
;; no-byte-compile: t
;; End:

1273
elpa/hydra-20160913.216/hydra.el
View File

File diff suppressed because it is too large Load Diff

117
elpa/hydra-20160913.216/lv.el
View File

@ -1,117 +0,0 @@
;;; lv.el --- Other echo area
;; Copyright (C) 2015 Free Software Foundation, Inc.
;; Author: Oleh Krehel
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; This package provides `lv-message' intended to be used in place of
;; `message' when semi-permanent hints are needed, in order to not
;; interfere with Echo Area.
;;
;; "Я тихо-тихо пiдглядаю,
;; І тiшуся собi, як бачу то,
;; Шо страшить i не пiдпускає,
;; А iншi п’ють тебе, як воду пiсок."
;; -- Андрій Кузьменко, L.V.
;;; Code:
(defgroup lv nil
"The other echo area."
:group 'minibuffer
:group 'hydra)
(defcustom lv-use-separator nil
"Whether to draw a line between the LV window and the Echo Area."
:group 'lv
:type 'boolean)
(defface lv-separator
'((((class color) (background light)) :background "grey80")
(((class color) (background dark)) :background "grey30"))
"Face used to draw line between the lv window and the echo area.
This is only used if option `lv-use-separator' is non-nil.
Only the background color is significant."
:group 'lv)
(defvar lv-wnd nil
"Holds the current LV window.")
(defun lv-window ()
"Ensure that LV window is live and return it."
(if (window-live-p lv-wnd)
lv-wnd
(let ((ori (selected-window))
buf)
(prog1 (setq lv-wnd
(select-window
(let ((ignore-window-parameters t))
(split-window
(frame-root-window) -1 'below))))
(if (setq buf (get-buffer " *LV*"))
(switch-to-buffer buf)
(switch-to-buffer " *LV*")
(set-window-hscroll lv-wnd 0)
(setq window-size-fixed t)
(setq mode-line-format nil)
(setq cursor-type nil)
(set-window-dedicated-p lv-wnd t)
(set-window-parameter lv-wnd 'no-other-window t))
(select-window ori)))))
(defvar golden-ratio-mode)
(defvar lv-force-update nil
"When non-nil, `lv-message' will refresh even for the same string.")
(defun lv-message (format-string &rest args)
"Set LV window contents to (`format' FORMAT-STRING ARGS)."
(let* ((str (apply #'format format-string args))
(n-lines (cl-count ?\n str))
deactivate-mark
golden-ratio-mode)
(with-selected-window (lv-window)
(unless (and (string= (buffer-string) str)
(null lv-force-update))
(delete-region (point-min) (point-max))
(insert str)
(when (and (window-system) lv-use-separator)
(unless (looking-back "\n" nil)
(insert "\n"))
(insert
(propertize "__" 'face 'lv-separator 'display '(space :height (1)))
(propertize "\n" 'face 'lv-separator 'line-height t)))
(set (make-local-variable 'window-min-height) n-lines)
(setq truncate-lines (> n-lines 1))
(let ((window-resize-pixelwise t)
(window-size-fixed nil))
(fit-window-to-buffer nil nil 1)))
(goto-char (point-min)))))
(defun lv-delete-window ()
"Delete LV window and kill its buffer."
(when (window-live-p lv-wnd)
(let ((buf (window-buffer lv-wnd)))
(delete-window lv-wnd)
(kill-buffer buf))))
(provide 'lv)
;;; lv.el ends here

15
elpa/logito-20120225.1255/logito-autoloads.el
View File

@ -1,15 +0,0 @@
;;; logito-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("logito.el") (22221 60700 987613 744000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; logito-autoloads.el ends here

1
elpa/logito-20120225.1255/logito-pkg.el
View File

@ -1 +0,0 @@
(define-package "logito" "20120225.1255" "logging library for Emacs" '((eieio "1.3")) :keywords '("lisp" "tool"))

98
elpa/logito-20120225.1255/logito.el
View File

@ -1,98 +0,0 @@
;;; logito.el --- logging library for Emacs
;; Copyright (C) 2012 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords: lisp, tool
;; Package-Version: 20120225.1255
;; Version: 0.1
;; Package-Requires: ((eieio "1.3"))
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This module provides logging facility for Emacs
;;; Code:
(eval-when-compile
(require 'cl))
(require 'eieio)
(defclass logito-object ()
((level :initarg :level :initform nil)))
(defmethod logito-insert-log ((log logito-object) format &rest objects)
"Base implementation, do nothing")
(defmethod logito-should-log ((log logito-object) level)
(let ((l (oref log :level)))
(and (integerp l)
(<= level l))))
(defmethod logito-log ((log logito-object) level tag string &rest objects)
(when (logito-should-log log level)
(apply 'logito-insert-log log (format "[%s] %s" tag string) objects)))
(defmethod logito-log (log level tag string &rest objects)
"Fallback implementation, do nothing. This allows in particular
to pass nil as the log object."
nil)
(defclass logito-message-object (logito-object)
())
(defmethod logito-insert-log ((log logito-message-object) format &rest objects)
(apply 'message format objects))
(defclass logito-buffer-object (logito-object)
((buffer :initarg :buffer :initform nil)))
(defmethod logito-should-log ((log logito-buffer-object) level)
(and (oref log :buffer)
(call-next-method)))
(defmethod logito-insert-log ((log logito-buffer-object) format &rest objects)
(let ((buffer (get-buffer-create (oref log :buffer))))
(with-current-buffer buffer
(goto-char (point-max))
(insert (apply 'format format objects) "\n\n"))))
(defmacro logito-def-level (sym val &optional pkg)
"Define a constant logito-<SYM>-level and a macro logito:<SYM>
associated with this level."
(let* ((pkg (or pkg 'logito))
(const (intern (format "%s:%s-level"
(symbol-name pkg) (symbol-name sym))))
(mac (intern (format "%s:%s"
(symbol-name pkg) (symbol-name sym)))))
`(progn
(defconst ,const ,val)
(defmacro ,mac (log string &rest objects)
(append
(list 'logito-log log ,const '',sym string)
objects)))))
;; built-in log levels
(logito-def-level error 0)
(logito-def-level info 5)
(logito-def-level verbose 10)
(logito-def-level debug 15)
(provide 'logito)
;;; logito.el ends here

33
elpa/marshal-20160807.1954/marshal-autoloads.el
View File

@ -1,33 +0,0 @@
;;; marshal-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "marshal" "marshal.el" (22454 5328 305397 868000))
;;; Generated autoloads from marshal.el
(autoload 'marshal "marshal" "\
\(fn OBJ TYPE)" nil nil)
(autoload 'unmarshal "marshal" "\
\(fn OBJ BLOB TYPE)" nil nil)
(autoload 'marshal-defclass "marshal" "\
\(fn NAME SUPERCLASS SLOTS &rest OPTIONS-AND-DOC)" nil t)
(function-put 'marshal-defclass 'lisp-indent-function '2)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; marshal-autoloads.el ends here

2
elpa/marshal-20160807.1954/marshal-pkg.el
View File

@ -1,2 +0,0 @@
;;; -*- no-byte-compile: t -*-
(define-package "marshal" "20160807.1954" "eieio extension for automatic (un)marshalling" '((eieio "1.4") (json "1.3") (ht "2.1")) :url "https://github.com/sigma/marshal.el" :keywords '("eieio"))

492
elpa/marshal-20160807.1954/marshal.el
View File

@ -1,492 +0,0 @@
;;; marshal.el --- eieio extension for automatic (un)marshalling
;; Copyright (C) 2015 Yann Hodique
;; Author: Yann Hodique <hodiquey@vmware.com>
;; Keywords: eieio
;; Package-Version: 20160807.1954
;; Version: 0.7.0
;; URL: https://github.com/sigma/marshal.el
;; Package-Requires: ((eieio "1.4") (json "1.3") (ht "2.1"))
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Inspired by Go tagged structs. 'alist, 'plist and 'json drivers are
;; provided, but implementing others just requires to inherit from
;; `marshal-driver'.
;; Sometimes the types are not enough (for example with lists, whose elements
;; are not explicitly typed. In those cases, a small extension on top of types
;; can be used. Like for example :marshal-type (list string)
;; Examples:
;; 1. Regular use:
;; (marshal-defclass plop ()
;; ((foo :initarg :foo :type string :marshal ((alist . field_foo)))
;; (bar :initarg :bar :type integer :marshal ((alist . field_bar)))
;; (baz :initarg :baz :type integer :marshal ((alist . field_baz)))))
;; (marshal-defclass plopi ()
;; ((alpha :marshal ((alist . field_alpha)))
;; (beta :type plop :marshal ((alist . field_beta)))))
;; (marshal (make-instance 'plop :foo "ok" :bar 42) 'alist)
;; => '((field_bar . 42) (field_foo . "ok"))
;; (unmarshal 'plop '((field_foo . "plop") (field_bar . 0) (field_baz . 1)) 'alist)
;; => '[object plop "plop" "plop" 0 1]
;; (marshal
;; (unmarshal 'plopi '((field_alpha . 42)
;; (field_beta . ((field_foo . "plop")
;; (field_bar . 0)
;; (field_baz . 1)))) 'alist)
;; 'alist)
;; => '((field_beta (field_baz . 1) (field_bar . 0) (field_foo . "plop")) (field_alpha . 42))
;; 2. Objects involving lists:
;; (marshal-defclass foo/tree ()
;; ((root :initarg :id :marshal ((plist . :root)))
;; (leaves :initarg :leaves :marshal ((plist . :leaves)) :marshal-type (list foo/tree))))
;; (marshal (make-instance 'foo/tree :id 0
;; :leaves (list (make-instance 'foo/tree :id 1)
;; (make-instance 'foo/tree :id 2
;; :leaves (list (make-instance 'foo/tree :id 3)))))
;; 'plist)
;; => (:root 0 :leaves ((:root 1) (:root 2 :leaves ((:root 3)))))
;; (unmarshal 'foo/tree '(:root 0 :leaves ((:root 1) (:root 2 :leaves ((:root 3))))) 'plist)
;; => [object foo/tree "foo/tree" 0
;; ([object foo/tree "foo/tree" 1 nil]
;; [object foo/tree "foo/tree" 2
;; ([object foo/tree "foo/tree" 3 nil])])]
;; 3. Json
;; (marshal (make-instance 'foo/tree :id 0
;; :leaves (list (make-instance 'foo/tree :id 1)
;; (make-instance 'foo/tree :id 2
;; :leaves (list (make-instance 'foo/tree :id 3)))))
;; 'json)
;; => "{\"leaves\":[{\"root\":1},{\"leaves\":[{\"root\":3}],\"root\":2}],\"root\":0}"
;; (unmarshal 'foo/tree "{\"leaves\":[{\"root\":1},{\"leaves\":[{\"root\":3}],\"root\":2}],\"root\":0}" 'json)
;; => [object foo/tree "foo/tree" 0
;; ([object foo/tree "foo/tree" 1 nil]
;; [object foo/tree "foo/tree" 2
;; ([object foo/tree "foo/tree" 3 nil])])]
;;; Code:
(require 'json)
(require 'eieio)
(require 'ht)
;;; eieio backward-compatibility
(dolist (sym '(object-class object-p oref oset))
(let ((new-sym (intern (concat "eieio-" (symbol-name sym)))))
(unless (fboundp new-sym)
(fset new-sym sym))))
;;; json hotfix
(when (json-alist-p '(((foo))))
(defun json-alist-p (list)
(while (consp list)
(setq list (if (and (consp (car list)) (atom (caar list)))
(cdr list)
'not-alist)))
(null list)))
;;; Defined drivers
(defvar marshal-drivers nil "Alist of drivers")
(defun marshal-register-driver (type driver)
(add-to-list 'marshal-drivers (cons type driver)))
;;; Marshalling driver interface
(defclass marshal-driver ()
((input :initarg :input)
(output :initarg :output)))
(defmethod marshal-open ((obj marshal-driver) &optional input)
(if input
(oset obj :input input)
(oset obj :output nil)))
(defmethod marshal-write ((obj marshal-driver) path value)
(unless (slot-boundp obj :output)
(error "Driver has not been opened in write mode")))
(defmethod marshal-read ((obj marshal-driver) path)
(unless (slot-boundp obj :input)
(error "Driver has not been opened in read mode")))
(defmethod marshal-close ((obj marshal-driver))
(when (slot-boundp obj :output)
(oref obj :output)))
(defmethod marshal-guess-type :static ((obj marshal-driver) blob)
(cond ((null blob) nil)
((booleanp blob) 'bool)
((stringp blob) 'string)
((numberp blob) 'number)
((listp blob) 'list)
((ht? blob) 'hash)))
(defmethod marshal-preprocess ((obj marshal-driver) blob)
blob)
(defmethod marshal-postprocess ((obj marshal-driver) blob)
blob)
(defmethod marshal-unmarshal-null :static ((obj marshal-driver))
nil)
(defmethod marshal-marshal-null :static ((obj marshal-driver))
nil)
(defmethod marshal-unmarshal-string :static ((obj marshal-driver) s)
(format "%s" s))
(defmethod marshal-marshal-string :static ((obj marshal-driver) s)
s)
(defmethod marshal-unmarshal-number :static ((obj marshal-driver) i)
i)
(defmethod marshal-marshal-number :static ((obj marshal-driver) i)
i)
(defmethod marshal-unmarshal-bool :static ((obj marshal-driver) b)
(equal b t))
(defmethod marshal-marshal-bool :static ((obj marshal-driver) b)
(equal b t))
(defmethod marshal-unmarshal-list :static ((obj marshal-driver) l l-type)
(let ((type (or (and (object-p obj) (eieio-object-class obj))
obj)))
(cons (unmarshal-internal (when (consp l-type)
(cadr l-type))
(car l) type)
(unmarshal-internal l-type (cdr l) type))))
(defmethod marshal-marshal-list :static ((obj marshal-driver) l)
(unless (null l)
(let ((type (or (and (object-p obj) (eieio-object-class obj))
obj)))
(cons (marshal-internal (car l) type)
(marshal-internal (cdr l) type)))))
(defmethod marshal-unmarshal-hash :static ((obj marshal-driver) h h-type)
(let ((type (or (and (object-p obj) (eieio-object-class obj))
obj))
(k-type (when (consp h-type) (nth 1 h-type)))
(v-type (when (consp h-type) (nth 2 h-type))))
(ht<-alist
(mapcar (lambda (item)
(cons (unmarshal-internal k-type (car item) type)
(unmarshal-internal v-type (cdr item) type))) h))))
(defmethod marshal-marshal-hash :static ((obj marshal-driver) h)
(unless (ht-empty? h)
(let ((type (or (and (object-p obj) (eieio-object-class obj))
obj)))
(mapcar (lambda (item)
(cons (marshal-internal (car item) type)
(marshal-internal (cadr item) type)))
(ht-items h)))))
;;; alist-based driver
(defclass marshal-driver-alist (marshal-driver)
())
(defmethod marshal-write ((obj marshal-driver-alist) path value)
(call-next-method)
(object-add-to-list obj :output (cons path value)))
(defmethod marshal-read ((obj marshal-driver-alist) path)
(call-next-method)
(cdr (assoc path (oref obj :input))))
;;; json driver
(defclass marshal-driver-json (marshal-driver-alist)
())
(defmethod marshal-preprocess ((obj marshal-driver-json) blob)
(let ((json-array-type 'list)
(json-object-type 'alist))
(json-read-from-string (call-next-method))))
(defmethod marshal-postprocess ((obj marshal-driver-json) blob)
(json-encode (call-next-method)))
(defmethod marshal-unmarshal-bool :static ((obj marshal-driver-json) b)
(not (eq b json-false)))
(defmethod marshal-marshal-bool :static ((obj marshal-driver-json) b)
(or b json-false))
;;; plist-based driver
(defclass marshal-driver-plist (marshal-driver)
())
(defmethod marshal-write ((obj marshal-driver-plist) path value)
(call-next-method)
(oset obj :output (plist-put (oref obj :output) path value)))
(defmethod marshal-read ((obj marshal-driver-plist) path)
(call-next-method)
(plist-get (oref obj :input) path))
;;; helper functions
(defun marshal--alist-add (alist key value &optional append)
(let ((existing (assoc key alist)))
(if (not existing)
(cons (cons key value) alist)
(setcdr existing (if append
(append (cdr existing) value)
value))
alist)))
(defun marshal--alist-merge (alist1 alist2 &optional append)
(let ((res alist1))
(if alist2
(let* ((pair (car alist2))
(x (car pair))
(y (cdr pair)))
(marshal--alist-merge
(marshal--alist-add alist1 x y append)
(cdr alist2)))
alist1)))
(defun marshal--transpose-alist2 (l)
(let (res
(rows l))
(while rows
(let* ((row (car rows))
(x (car row))
(cols (cdr row)))
(while cols
(let* ((col (car cols))
(y (car col))
(z (cdr col))
(target (or (assoc y res)
(let ((p (cons y nil)))
(setq res (push p res))
p))))
(setcdr target (cons (cons x z) (cdr target))))
(setq cols (cdr cols))))
(setq rows (cdr rows)))
res))
;;; base-class for serializable objects
(defclass marshal-base ()
((-marshal-info :allocation :class :initform nil :protection :protected)
(-type-info :allocation :class :initform nil :protection :protected)))
(defmethod marshal-get-marshal-info :static ((obj marshal-base))
nil)
(defmethod marshal-get-type-info :static ((obj marshal-base))
nil)
(defun marshal-get-driver (type)
(let ((cls (or (and (class-p type) type)
(cdr (assoc type marshal-drivers))
'marshal-driver)))
(make-instance cls)))
(defmethod marshal-internal ((obj marshal-base) type &optional hint)
(let* ((type (or (and (class-p type)
(car (rassoc type marshal-drivers)))
type))
(driver (marshal-get-driver type))
(marshal-info (cdr (assoc type (marshal-get-marshal-info obj)))))
(marshal-open driver)
(when marshal-info
(dolist (s (object-slots obj))
(let ((path (cdr (assoc s marshal-info))))
(when (and path
(slot-boundp obj s))
(marshal-write driver path
(marshal-internal
(eieio-oref obj s)
type
(cdr (assoc s (marshal-get-type-info obj)))))))))
(marshal-close driver)))
(defmethod marshal-internal ((obj nil) type &optional hint)
(let ((driver (marshal-get-driver type)))
(cond ((and (null hint) (null obj))
(marshal-marshal-null driver))
((or (eq obj t)
(and (null obj) (eq hint 'bool)))
(marshal-marshal-bool driver obj))
((stringp obj)
(marshal-marshal-string driver obj))
((numberp obj)
(marshal-marshal-number driver obj))
((listp obj)
(marshal-marshal-list driver obj))
((ht? obj)
(marshal-marshal-hash driver obj)))))
;;;###autoload
(defun marshal (obj type)
(let ((driver (marshal-get-driver type)))
(marshal-postprocess driver
(marshal-internal obj type))))
(defmethod unmarshal--obj ((obj marshal-base) blob type)
(let ((driver (marshal-get-driver type))
(marshal-info (cdr (assoc type (marshal-get-marshal-info obj)))))
(marshal-open driver blob)
(when (and marshal-info blob)
(dolist (s (object-slots obj))
(let ((path (cdr (assoc s marshal-info))))
(when path
(eieio-oset obj s
(unmarshal-internal
(cdr (assoc s (marshal-get-type-info obj)))
(marshal-read driver path)
type))))))
(marshal-close driver)
obj))
(defun unmarshal-internal (obj blob type)
(let ((obj (if (class-p obj)
(make-instance obj)
obj)))
(unmarshal--internal obj blob type)))
(defmethod unmarshal--internal ((obj nil) blob type)
(let* ((driver (marshal-get-driver type))
(obj (or obj (marshal-guess-type driver blob))))
(cond ((or (null obj) (null blob))
(marshal-unmarshal-null driver))
((eq obj 'bool)
(marshal-unmarshal-bool driver blob))
((eq obj 'string)
(marshal-unmarshal-string driver blob))
((memq obj '(number integer))
(marshal-unmarshal-number driver blob))
((or (eq obj 'list)
(and (consp obj) (eq (car obj) 'list)))
(marshal-unmarshal-list driver blob obj))
((or (eq obj 'hash)
(and (consp obj) (eq (car obj) 'hash)))
(marshal-unmarshal-hash driver blob obj)))))
(defmethod unmarshal--internal ((obj marshal-base) blob type)
(let ((type (or (and (class-p type)
(car (rassoc type marshal-drivers)))
type)))
(unmarshal--obj obj blob type)))
;;;###autoload
(defun unmarshal (obj blob type)
(let ((driver (marshal-get-driver type)))
(unmarshal-internal obj (marshal-preprocess driver blob) type)))
;;;###autoload
(defmacro marshal-defclass (name superclass slots &rest options-and-doc)
(declare (debug t) (indent 2))
(let* ((options (if (stringp (car options-and-doc))
(cdr options-and-doc)
options-and-doc))
(default-spec-func (or (plist-get options :marshal-default-spec)
'ignore))
(base-cls (or (plist-get options :marshal-base-cls)
'marshal-base))
(marshal-info (marshal--transpose-alist2
(remove nil
(mapcar
(lambda (s)
(let ((name (car s)))
(let ((marshal
(or (plist-get (cdr s) :marshal)
(funcall default-spec-func name))))
(when marshal
(cons name
(mapcar
(lambda (p)
(if (consp p)
p
(cons p name)))
marshal))))))
slots))))
(type-info (remove nil
(mapcar (lambda (s)
(let ((name (car s)))
(let ((type (or (plist-get (cdr s) :marshal-type)
(plist-get (cdr s) :type))))
(when type
(cons name type)))))
slots))))
`(progn
(defclass ,name (,@superclass ,base-cls)
(,@slots)
,@options-and-doc)
(defmethod marshal-get-marshal-info :static ((obj ,name))
(let ((cls (if (eieio-object-p obj)
(eieio-object-class obj)
obj)))
(get cls :marshal-info)))
(put ',name :marshal-info ',marshal-info)
(dolist (cls ',superclass)
(put ',name :marshal-info
(marshal--alist-merge (get ',name :marshal-info)
(marshal-get-marshal-info cls) t)))
(defmethod marshal-get-type-info :static ((obj ,name))
(let ((cls (if (eieio-object-p obj)
(eieio-object-class obj)
obj)))
(get cls :type-info)))
(put ',name :type-info ',type-info)
(dolist (cls ',superclass)
(put ',name :type-info
(marshal--alist-merge (get ',name :type-info)
(marshal-get-type-info cls) t)))
,name)))
;;; Default drivers
(marshal-register-driver 'alist 'marshal-driver-alist)
(marshal-register-driver 'plist 'marshal-driver-plist)
(marshal-register-driver 'json 'marshal-driver-json)
(provide 'marshal)
;;; marshal.el ends here

40
elpa/muse-3.20/ChangeLog
View File

@ -1,40 +0,0 @@
2012-10-30 Stefan Monnier <monnier@iro.umontreal.ca>
Clean up copyright notices.
2011-07-30 Chong Yidong <cyd@stupidchicken.com>
Add Texinfo files for muse package.
2011-07-01 Chong Yidong <cyd@stupidchicken.com>
Remove version numbers from filenames in packages/ dir.
2011-06-30 Chong Yidong <cyd@stupidchicken.com>
Remove version numbers in packages/ directory
2011-01-09 Chong Yidong <cyd@stupidchicken.com>
Make Muse's *-link faces inherit from the basic link face.
* packages/muse-3.20/muse-colors.el (muse-link, muse-bad-link):
Inherit from link face.
2010-11-20 Ted Zlatanov <tzz@lifelogs.com>
* COPYING, ChangeLog, README, admin/org-synch.el,
admin/org-synch.sh, admin/package-update.sh: Initial import.
* packages/archive-contents, packages/auctex-11.86,
packages/auctex-readme.txt, packages/company-0.5/,
packages/company-readme.txt, packages/elpa.rss,
packages/js2-mode-20090814.el, packages/js2-mode-readme.txt,
packages/muse-3.20/, packages/muse-readme.txt,
packages/org-readme.txt, packages/rainbow-mode-0.1.el,
packages/rainbow-mode-readme.txt: Renamed from the root directory.
2010-11-18 ELPA admin
Initial repository contents

7
elpa/muse-3.20/README
View File

@ -1,7 +0,0 @@
Muse is a tool for easily authoring and publishing documents. It
allows for rapid prototyping of hyperlinked text, which may then be
exported to multiple output formats, such as HTML, LaTeX, and Texinfo.
The markup rules used by Muse are intended to be very friendly to
people familiar with Emacs. See the included manual for more
information.

217
elpa/muse-3.20/cgi.el
View File

@ -1,217 +0,0 @@
;;; cgi.el -- Using Emacs for CGI scripting
;; Copyright (C) 2000, 2006, 2012 Free Software Foundation, Inc.
;; Author: Eric Marsden <emarsden@laas.fr>
;; Michael Olson <mwolson@gnu.org> (slight modifications)
;; Keywords: CGI web scripting slow
;; Version: 0.3
;; Time-stamp: <2001-08-24 emarsden>
;; 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, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA.
;;; Commentary:
;; People who like this sort of thing will find this the sort of
;; thing they like. -- Abraham Lincoln
;;
;;
;; Overview ==========================================================
;;
;; A simple library for the Common Gateway Interface for Emacs,
;; allowing you to service requests for non static web pages in elisp.
;; Provides routines for decoding arguments to GET- and POST-type CGI
;; requests.
;;
;; Usage: place a shell script such as the following in your web
;; server's CGI directory (typically called something like
;; /var/www/cgi-bin/):
;;
;; ,-------------------------------------------------------------------
;; | #!/bin/sh
;; |
;; | emacs -batch -l cgi.el -f cgi-calendar
;; `-------------------------------------------------------------------
;;
;; (`cgi-calendar' is a sample elisp CGI script provided at the end of
;; this file).
;;
;; Alternatively, if you're running version 2.x of the linux kernel
;; you could make .elc files directly executable via the binfmt_misc
;; mechanism and run them straight from the cgi-bin directory.
;;
;; Efficiency would be improved by having Emacs bind to the http
;; service port and spawn a thread per connection. Extending Emacs to
;; support server sockets and multithreading is left as an exercise
;; for the reader.
;;
;; References:
;; * rfc1738 "Uniform Resource Locators"
;; * rfc1630 "Universal Resource Identifiers in WWW"
;;
;; Thanks to Christoph Conrad <christoph.conrad@gmx.de> for pointing
;; out a bug in the URI-decoding.
;;; Code:
(eval-when-compile
(require 'cl)
(require 'calendar))
(defconst cgi-url-unreserved-chars '(
?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m
?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M
?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
?\$ ?\- ?\_ ?\. ?\! ?\~ ?\* ?\' ?\( ?\) ?\,))
(defun cgi-int-char (i)
(if (fboundp 'int-char) (int-char i) i))
(defun cgi-hex-char-p (ch)
(declare (character ch))
(let ((hexchars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
?A ?B ?C ?D ?E ?F)))
(member (upcase ch) hexchars)))
;; decode %xx to the corresponding character and + to ' '
(defun cgi-decode-string (str)
(do ((i 0)
(len (length str))
(decoded '()))
((>= i len) (concat (nreverse decoded)))
(let ((ch (aref str i)))
(cond ((eq ?+ ch)
(push ?\ decoded)
(incf i))
((and (eq ?% ch)
(< (+ i 2) len)
(cgi-hex-char-p (aref str (+ i 1)))
(cgi-hex-char-p (aref str (+ i 2))))
(let ((hex (string-to-number (substring str (+ i 1) (+ i 3)) 16)))
(push (cgi-int-char hex) decoded)
(incf i 3)))
(t (push ch decoded)
(incf i))))))
(defun cgi-position (item seq &optional start end)
(or start (setq start 0))
(or end (setq end (length seq)))
(while (and (< start end)
(not (equal item (aref seq start))))
(setq start (1+ start)))
(and (< start end) start))
;; Parse "foo=x&bar=y+re" into (("foo" . "x") ("bar" . "y re"))
;; Substrings are plus-decoded and then URI-decoded.
(defun cgi-decode (q)
(when q
(flet ((split-= (str)
(let ((pos (or (cgi-position ?= str) 0)))
(cons (cgi-decode-string (substring str 0 pos))
(cgi-decode-string (substring str (+ pos 1)))))))
(mapcar #'split-= (split-string q "&")))))
(defun cgi-lose (fmt &rest args)
(let ((why (apply #'format fmt args)))
(message "Script error: %s" why) ; to error_log
(princ "Content-type: text/html\n\n") ; to browser
(princ "<html><head><title>Script error</title></head>\r\n")
(princ "<body><h1>Script error</h1>\r\n<p>\r\n")
(princ why)
(princ "\r\n</body></html>\r\n")
(kill-emacs 0)))
(defmacro cgi-evaluate (&rest forms)
`(condition-case why
(princ (with-output-to-string ,@forms))
(error (cgi-lose "Emacs Lisp error: %s" why))))
(defun cgi-arguments ()
(let ((method (getenv "REQUEST_METHOD"))
req buf)
(cond ((null method)
(cgi-lose "No request method specified"))
((string= "GET" method)
(unless (getenv "QUERY_STRING")
(cgi-lose "No query string for GET request"))
(cgi-decode (getenv "QUERY_STRING")))
((string= "POST" method)
(setq req (getenv "CONTENT_LENGTH"))
(unless req
(cgi-lose "No content-length for POST request"))
(setq buf (get-buffer-create " *cgi*"))
(set-buffer buf)
(erase-buffer)
(loop for i from 1 to (string-to-number req)
do (insert (read-event)))
(cgi-decode (buffer-string)))
(t
(cgi-lose "Can't handle request method %s" method)))))
;; ====================================================================
;; a sample application: calendar via the web. If invoked without
;; arguments, presents a calendar for the three months around the
;; current date. You can request a calendar for a specific period by
;; specifying the year and the month in the query string:
;;
;; ~$ lynx -dump 'http://localhost/cgi-bin/cal?year=1975&month=6'
;;
;; When run in batch mode, text normally displayed in the echo area
;; (via `princ' for example) goes to stdout, and thus to the browser.
;; Text output using `message' goes to stderr, and thus normally to
;; your web server's error_log.
;; ====================================================================
(eval-and-compile
(if (fboundp 'calendar-extract-month)
(defalias 'cgi-calendar-extract-month 'calendar-extract-month)
(defalias 'cgi-calendar-extract-month 'extract-calendar-month))
(if (fboundp 'calendar-extract-year)
(defalias 'cgi-calendar-extract-year 'calendar-extract-year)
(defalias 'cgi-calendar-extract-year 'extract-calendar-year))
(if (fboundp 'calendar-generate)
(defalias 'cgi-calendar-generate 'calendar-generate)
(defalias 'cgi-calendar-generate 'generate-calendar)))
(defun cgi-calendar-string ()
(require 'calendar)
(let* ((args (cgi-arguments))
(now (calendar-current-date))
(mnth (cdr (assoc "month" args)))
(month (if mnth (string-to-number mnth)
(cgi-calendar-extract-month now)))
(yr (cdr (assoc "year" args)))
(year (if yr (string-to-number yr)
(cgi-calendar-extract-year now))))
(with-temp-buffer
(cgi-calendar-generate month year)
(buffer-string))))
(defun cgi-calendar ()
(cgi-evaluate
(princ "Content-type: text/html\n\n")
(princ "<html><head><title>Emacs calendar</title></head>\r\n")
(princ "<body> <h1>Emacs calendar</h1>\r\n")
(princ "<pre>\r\n")
(princ (cgi-calendar-string))
(princ "\r\n</pre></body></html>\r\n")))
(provide 'cgi)
;;; cgi.el ends here

18
elpa/muse-3.20/dir
View File

@ -1,18 +0,0 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "?" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Muse: (muse). Authoring and publishing environment for Emacs.

19
elpa/muse-3.20/htmlize-hack.el
View File

@ -1,19 +0,0 @@
;; This file provides a fix for htmlize.el and Emacs 23.
;; To use it, add the path to this directory to your load path and
;; add (require 'htmlize-hack) to your Emacs init file.
(require 'htmlize)
(when (equal htmlize-version "1.34")
(defun htmlize-face-size (face)
;; The size (height) of FACE, taking inheritance into account.
;; Only works in Emacs 21 and later.
(let ((size-list
(loop
for f = face then (face-attribute f :inherit)
until (or (null f) (eq f 'unspecified))
for h = (face-attribute f :height)
collect (if (eq h 'unspecified) nil h))))
(reduce 'htmlize-merge-size (cons nil size-list)))))
(provide 'htmlize-hack)

288
elpa/muse-3.20/httpd.el
View File

@ -1,288 +0,0 @@
;;; httpd.el -- A web server in Emacs Lisp
;; Copyright (C) 2001, 2003, 2006, 2012 Free Software Foundation, Inc.
;; Author: Eric Marsden <emarsden@laas.fr>
;; John Wiegley <johnw@gnu.org>
;; Michael Olson <mwolson@gnu.org> (slight modifications)
;; Version: 1.1
;; Keywords: games
;; 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, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA.
;;
;; The latest version of this package should be available from
;;
;; <URL:http://purl.org/net/emarsden/home/downloads/>
;;; Commentary:
;; httpd.el is an HTTP server embedded in the Emacs. It can handle GET
;; and HEAD requests; adding support for POST should not be too
;; difficult. By default, httpd.el will listen on server side Emacs
;; sockets for HTTP requests.
;;
;; I have only tested this code with Emacs; it may need modifications
;; to work with XEmacs.
;;
;; This version has been modified to work with GNU Emacs 21 and 22.
;;
;;; Acknowledgements:
;;
;; httpd.el was inspired by pshttpd, an HTTP server written in
;; Postscript by Anders Karlsson <URL:http://www.pugo.org:8080/>.
;;
;; Thanks to John Wiegley and Cyprian Adam Laskowski.
;;; Code:
(defvar httpd-document-root "/var/www")
(defvar httpd-path-handlers '()
"Alist of (path-regexp . handler) forms.
If a GET request is made for an URL whose path component matches
a PATH-REGEXP, the corresponding handler is called to generate
content.")
(defvar httpd-mime-types-alist
'(("html" . "text/html; charset=iso-8859-1")
("txt" . "text/plain; charset=iso-8859-1")
("jpg" . "image/jpeg")
("jpeg" . "image/jpeg")
("gif" . "image/gif")
("png" . "image/png")
("tif" . "image/tiff")
("tiff" . "image/tiff")
("css" . "text/css")
("gz" . "application/octet-stream")
("ps" . "application/postscript")
("pdf" . "application/pdf")
("eps" . "application/postscript")
("tar" . "application/x-tar")
("rpm" . "application/x-rpm")
("zip" . "application/zip")
("mp3" . "audio/mpeg")
("mp2" . "audio/mpeg")
("mid" . "audio/midi")
("midi" . "audio/midi")
("wav" . "audio/x-wav")
("au" . "audio/basic")
("ram" . "audio/pn-realaudio")
("ra" . "audio/x-realaudio")
("mpg" . "video/mpeg")
("mpeg" . "video/mpeg")
("qt" . "video/quicktime")
("mov" . "video/quicktime")
("avi" . "video/x-msvideo")))
(defun httpd-mime-type (filename)
(or (cdr (assoc (file-name-extension filename) httpd-mime-types-alist))
"text/plain"))
(put 'httpd-exception 'error-conditions '(httpd-exception error))
(defun defhttpd-exception (name code msg)
(put name 'error-conditions (list name 'httpd-exception 'error))
(put name 'httpd-code code)
(put name 'httpd-msg msg))
(defhttpd-exception 'httpd-moved/perm 301 "Moved permanently")
(defhttpd-exception 'httpd-moved/temp 302 "Moved temporarily")
(defhttpd-exception 'httpd-bad-request 400 "Bad request")
(defhttpd-exception 'httpd-forbidden 403 "Forbidden")
(defhttpd-exception 'httpd-file-not-found 404 "Not found")
(defhttpd-exception 'httpd-method-forbidden 405 "Method not allowed")
(defhttpd-exception 'httpd-unimplemented 500 "Internal server error")
(defhttpd-exception 'httpd-unimplemented 501 "Not implemented")
(defhttpd-exception 'httpd-unimplemented 503 "Service unavailable")
(defvar httpd-endl "\r\n")
(defvar httpd-process nil)
(defvar httpd-bytes-sent nil) ; only used with `httpd-process'
(defvar httpd-log-accesses t)
(defun httpd-add-handler (path-regexp handler)
(push (cons path-regexp handler) httpd-path-handlers))
(defun httpd-try-internal-handler (path &optional cont)
(catch 'result
(dolist (elem httpd-path-handlers)
(let ((regexp (car elem))
(handler (cdr elem)))
(if (string-match regexp path)
(throw 'result (funcall handler path cont)))))))
(defun httpd-date-stamp ()
(format-time-string "[%d/%b/%Y %H:%M:%S %z]"))
(defun httpd-log (&rest strings)
(if httpd-log-accesses
(save-excursion
(goto-char (point-max))
(with-current-buffer (get-buffer-create "*httpd access_log*")
(mapc 'insert strings)))))
(defun httpd-send-data (&rest strings)
(dolist (s strings)
(send-string httpd-process s)
(if httpd-bytes-sent
(setq httpd-bytes-sent (+ httpd-bytes-sent (length s))))))
(defun httpd-send (code msg &rest strings)
(httpd-log (number-to-string code) " ")
(apply 'httpd-send-data
"HTTP/1.0 " (number-to-string code) " " msg httpd-endl
strings))
(defun httpd-send-eof ()
(httpd-log (number-to-string httpd-bytes-sent) "\n")
(process-send-eof httpd-process))
(defun httpd-send-file (filename)
(with-temp-buffer
(insert-file-contents filename)
(httpd-send-data (buffer-string))))
(defun httpd-lose (code msg)
(httpd-send code msg
"Content-Type: text/html" httpd-endl
"Connection: close" httpd-endl
httpd-endl
"<html><head><title>Error</title></head>" httpd-endl
"<body><h1>" msg "</h1>" httpd-endl
"<p>" msg httpd-endl
"</body></html>" httpd-endl)
(httpd-send-eof))
(defun httpd-handle-redirect (req where)
"Redirect the client to new location WHERE."
(httpd-send 301 "Moved permanently"
"Location: " where httpd-endl
"URI: " where httpd-endl
"Connection: close" httpd-endl
httpd-endl)
(httpd-send-eof))
(defun httpd-handle-GET+HEAD (path &optional want-data req)
(if (zerop (length path))
(setq path "index.html"))
;; could use `expand-file-name' here instead of `concat', but we
;; don't want tilde expansion, etc.
(let ((filename (concat httpd-document-root "/" path))
modified-since)
(cond ((httpd-try-internal-handler path) t)
((file-directory-p filename)
(httpd-handle-redirect path (concat "http://" (system-name) "/"
path "/")))
((file-readable-p filename)
(let ((attrs (file-attributes filename)))
(if (and (string-match "^If-Modified-Since:\\s-+\\(.+\\)" req)
(setq modified-since
(apply 'encode-time
(parse-time-string (match-string 1 req))))
(time-less-p (nth 5 attrs) modified-since))
(httpd-send 304 "Not modified"
"Server: Emacs/httpd.el" httpd-endl
"Connection: close" httpd-endl
httpd-endl)
(httpd-send 200 "OK"
"Server: Emacs/httpd.el" httpd-endl
"Connection: close" httpd-endl
"MIME-Version: 1.0" httpd-endl
"Content-Type: "
(httpd-mime-type filename) httpd-endl
"Content-Length: "
(number-to-string (nth 7 attrs)) httpd-endl
httpd-endl)
(if want-data
(httpd-send-file filename)))
(httpd-send-eof)))
(t (signal 'httpd-file-not-found path)))))
(defun httpd-handle-request (req &optional cont)
(httpd-log (car (process-contact httpd-process)) " - - "
(httpd-date-stamp) " \"")
(if (not (string-match ".+" req))
(progn
(httpd-log "\"")
(error "HTTP request was empty"))
(let ((request (match-string 0 req)))
(httpd-log request "\" ")
(cond
((string-match "\\.\\." request)
;; reject requests containing ".." in the path. Should really
;; URI-decode first.
(signal 'httpd-forbidden request))
((string-match "\\`\\(GET\\|HEAD\\|POST\\)\\s-/\\(\\S-*\\)" request)
(let ((kind (match-string 1 request))
(arg (match-string 2 request)))
(if (string= kind "POST")
(unless (httpd-try-internal-handler arg cont)
(signal 'httpd-unimplemented arg))
(httpd-handle-GET+HEAD arg (string= kind "GET") req))))
(t (signal 'httpd-bad-request request))))))
(defun httpd-serve (proc string)
(let ((httpd-process proc)
(httpd-bytes-sent 0))
(condition-case why
(httpd-handle-request string)
(httpd-exception
(httpd-lose (get (car why) 'httpd-code)
(get (car why) 'httpd-msg)))
;; Comment out these two lines if you want to catch errors
;; inside Emacs itself.
(error
(httpd-lose 500 (format "Emacs Lisp error: %s" why)))
)))
(defun httpd-start (&optional port)
(interactive (list (read-string "Serve Web requests on port: " "8080")))
(if (null port)
(setq port 8080)
(if (stringp port)
(setq port (string-to-number port))))
(if httpd-process
(delete-process httpd-process))
(setq httpd-process
(if (fboundp 'make-network-process)
(make-network-process :name "httpd"
:buffer (generate-new-buffer "httpd")
:host 'local :service port
:server t :noquery t
:filter 'httpd-serve)
(and (fboundp 'open-network-stream-server)
(open-network-stream-server "httpd"
(generate-new-buffer "httpd")
port nil 'httpd-serve))))
(if (and (processp httpd-process)
(eq (process-status httpd-process) 'listen))
(message "httpd.el is listening on port %d" port)))
(defun httpd-stop ()
(interactive)
(when httpd-process
(message "httpd.el server on port %d has stopped"
(cadr (process-contact httpd-process)))
(delete-process httpd-process)
(setq httpd-process nil)))
(provide 'httpd)
;;; httpd.el ends here

277
elpa/muse-3.20/muse-autoloads.el
View File

@ -1,277 +0,0 @@
;;; muse-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "muse" "muse.el" (21705 22861 643843 136000))
;;; Generated autoloads from muse.el
(add-to-list 'auto-mode-alist '("\\.muse\\'" . muse-mode-choose-mode))
;;;***
;;;### (autoloads nil "muse-blosxom" "muse-blosxom.el" (21705 22862
;;;;;; 348828 281000))
;;; Generated autoloads from muse-blosxom.el
(autoload 'muse-blosxom-new-entry "muse-blosxom" "\
Start a new blog entry with given CATEGORY.
The filename of the blog entry is derived from TITLE.
The page will be initialized with the current date and TITLE.
\(fn CATEGORY TITLE)" t nil)
;;;***
;;;### (autoloads nil "muse-colors" "muse-colors.el" (21705 22862
;;;;;; 65834 245000))
;;; Generated autoloads from muse-colors.el
(autoload 'muse-colors-toggle-inline-images "muse-colors" "\
Toggle display of inlined images on/off.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "muse-import-docbook" "muse-import-docbook.el"
;;;;;; (21705 22862 962815 340000))
;;; Generated autoloads from muse-import-docbook.el
(autoload 'muse-import-docbook "muse-import-docbook" "\
Convert the Docbook buffer SRC to Muse, writing output in the DEST buffer.
\(fn SRC DEST)" t nil)
(autoload 'muse-import-docbook-files "muse-import-docbook" "\
Convert the Docbook file SRC to Muse, writing output to the DEST file.
\(fn SRC DEST)" t nil)
;;;***
;;;### (autoloads nil "muse-import-latex" "muse-import-latex.el"
;;;;;; (21705 22861 560844 887000))
;;; Generated autoloads from muse-import-latex.el
(autoload 'muse-import-latex "muse-import-latex" "\
\(fn)" t nil)
;;;***
;;;### (autoloads nil "muse-mode" "muse-mode.el" (21705 22863 3814
;;;;;; 476000))
;;; Generated autoloads from muse-mode.el
(autoload 'muse-mode "muse-mode" "\
Muse is an Emacs mode for authoring and publishing documents.
\\{muse-mode-map}
\(fn)" t nil)
(autoload 'muse-mode-choose-mode "muse-mode" "\
Turn the proper Emacs Muse related mode on for this file.
\(fn)" nil nil)
(autoload 'muse-insert-list-item "muse-mode" "\
Insert a list item at the current point, taking into account
your current list type and indentation level.
\(fn)" t nil)
(autoload 'muse-increase-list-item-indentation "muse-mode" "\
Increase the indentation of the current list item.
\(fn)" t nil)
(autoload 'muse-decrease-list-item-indentation "muse-mode" "\
Decrease the indentation of the current list item.
\(fn)" t nil)
(autoload 'muse-insert-relative-link-to-file "muse-mode" "\
Insert a relative link to a file, with optional description, at point.
\(fn)" t nil)
(autoload 'muse-edit-link-at-point "muse-mode" "\
Edit the current link.
Do not rename the page originally referred to.
\(fn)" t nil)
(autoload 'muse-browse-result "muse-mode" "\
Visit the current page's published result.
\(fn STYLE &optional OTHER-WINDOW)" t nil)
(autoload 'muse-follow-name-at-point "muse-mode" "\
Visit the link at point.
\(fn &optional OTHER-WINDOW)" t nil)
(autoload 'muse-follow-name-at-point-other-window "muse-mode" "\
Visit the link at point in other window.
\(fn)" t nil)
(autoload 'muse-next-reference "muse-mode" "\
Move forward to next Muse link or URL, cycling if necessary.
\(fn)" t nil)
(autoload 'muse-previous-reference "muse-mode" "\
Move backward to the next Muse link or URL, cycling if necessary.
In case of Emacs x <= 21 and ignoring of intangible properties (see
`muse-mode-intangible-links').
This function is not entirely accurate, but it's close enough.
\(fn)" t nil)
(autoload 'muse-what-changed "muse-mode" "\
Show the unsaved changes that have been made to the current file.
\(fn)" t nil)
(autoload 'muse-search-with-command "muse-mode" "\
Search for the given TEXT string in the project directories
using the specified command.
\(fn TEXT)" t nil)
(autoload 'muse-search "muse-mode" "\
Search for the given TEXT using the default grep command.
\(fn)" t nil)
(autoload 'muse-find-backlinks "muse-mode" "\
Grep for the current pagename in all the project directories.
\(fn)" t nil)
(autoload 'muse-index "muse-mode" "\
Display an index of all known Muse pages.
\(fn)" t nil)
(autoload 'muse-insert-tag "muse-mode" "\
Insert a tag interactively with a blank line after it.
\(fn TAG)" t nil)
(autoload 'muse-list-edit-minor-mode "muse-mode" "\
This is a global minor mode for editing files with lists.
It is meant to be used with other major modes, and not with Muse mode.
Interactively, with no prefix argument, toggle the mode.
With universal prefix ARG turn mode on.
With zero or negative ARG turn mode off.
This minor mode provides the Muse keybindings for editing lists,
and support for filling lists properly.
It recognizes not only Muse-style lists, which use the \"-\"
character or numbers, but also lists that use asterisks or plus
signs. This should make the minor mode generally useful.
Definition lists and footnotes are also recognized.
Note that list items may omit leading spaces, for compatibility
with modes that set `left-margin', such as
`debian-changelog-mode'.
\\{muse-list-edit-minor-mode-map}
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil "muse-project" "muse-project.el" (21705 22862
;;;;;; 680821 283000))
;;; Generated autoloads from muse-project.el
(autoload 'muse-project-find-file "muse-project" "\
Open the Muse page given by NAME in PROJECT.
If COMMAND is non-nil, it is the function used to visit the file.
If DIRECTORY is non-nil, it is the directory in which the page
will be created if it does not already exist. Otherwise, the
first directory within the project's fileset is used.
\(fn NAME PROJECT &optional COMMAND DIRECTORY)" t nil)
(autoload 'muse-project-publish-this-file "muse-project" "\
Publish the currently-visited file according to `muse-project-alist',
prompting if more than one style applies.
If FORCE is given, publish the file even if it is up-to-date.
If STYLE is given, use that publishing style rather than
prompting for one.
\(fn &optional FORCE STYLE)" t nil)
(autoload 'muse-project-publish "muse-project" "\
Publish the pages of PROJECT that need publishing.
\(fn PROJECT &optional FORCE)" t nil)
;;;***
;;;### (autoloads nil "muse-protocols" "muse-protocols.el" (21705
;;;;;; 22862 389827 417000))
;;; Generated autoloads from muse-protocols.el
(autoload 'muse-browse-url "muse-protocols" "\
Handle URL with the function specified in `muse-url-protocols'.
If OTHER-WINDOW is non-nil, open in a different window.
\(fn URL &optional OTHER-WINDOW)" t nil)
;;;***
;;;### (autoloads nil "muse-publish" "muse-publish.el" (21705 22862
;;;;;; 730820 230000))
;;; Generated autoloads from muse-publish.el
(autoload 'muse-publish-region "muse-publish" "\
Apply the given STYLE's markup rules to the given region.
The result is placed in a new buffer that includes TITLE in its name.
\(fn BEG END &optional TITLE STYLE)" t nil)
(autoload 'muse-publish-file "muse-publish" "\
Publish the given FILE in a particular STYLE to OUTPUT-DIR.
If the argument FORCE is nil, each file is only published if it is
newer than the published version. If the argument FORCE is non-nil,
the file is published no matter what.
\(fn FILE STYLE &optional OUTPUT-DIR FORCE)" t nil)
(autoload 'muse-publish-this-file "muse-publish" "\
Publish the currently-visited file.
Prompt for both the STYLE and OUTPUT-DIR if they are not
supplied.
\(fn STYLE OUTPUT-DIR &optional FORCE)" t nil)
;;;***
;;;### (autoloads nil nil ("cgi.el" "htmlize-hack.el" "httpd.el"
;;;;;; "muse-backlink.el" "muse-book.el" "muse-context.el" "muse-docbook.el"
;;;;;; "muse-groff.el" "muse-html.el" "muse-http.el" "muse-ikiwiki.el"
;;;;;; "muse-import-xml.el" "muse-ipc.el" "muse-journal.el" "muse-latex.el"
;;;;;; "muse-latex2png.el" "muse-pkg.el" "muse-poem.el" "muse-regexps.el"
;;;;;; "muse-texinfo.el" "muse-wiki.el" "muse-xml-common.el" "muse-xml.el")
;;;;;; (21705 22863 153833 598000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; muse-autoloads.el ends here

327
elpa/muse-3.20/muse-backlink.el
View File

@ -1,327 +0,0 @@
;;; muse-backlink.el --- backlinks for Muse
;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Jim Ottaway <j.ottaway@lse.ac.uk>
;; Keywords:
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Hierarchical backlink insertion into new muse pages.
;;
;; To add:
;;
;; (require 'muse-backlink)
;; (muse-backlink-install)
;;
;; To control what gets backlinked, modify
;; `muse-backlink-exclude-backlink-regexp' and
;; `muse-backlink-exclude-backlink-parent-regexp'.
;;
;; To stop backlinking temporarily:
;; (setq muse-backlink-create-backlinks nil)
;;
;; To remove the backlink functionality completely:
;;
;; (muse-backlink-remove)
;;; Contributors:
;;; Code:
(require 'muse)
(require 'muse-project)
(eval-when-compile (require 'muse-mode))
(eval-and-compile
(if (< emacs-major-version 22)
(progn
;; Swiped from Emacs 22.0.50.4
(defvar muse-backlink-split-string-default-separators "[ \f\t\n\r\v]+"
"The default value of separators for `split-string'.
A regexp matching strings of whitespace. May be locale-dependent
\(as yet unimplemented). Should not match non-breaking spaces.
Warning: binding this to a different value and using it as default is
likely to have undesired semantics.")
(defun muse-backlink-split-string (string &optional separators omit-nulls)
"Split STRING into substrings bounded by matches for SEPARATORS.
The beginning and end of STRING, and each match for SEPARATORS, are
splitting points. The substrings matching SEPARATORS are removed, and
the substrings between the splitting points are collected as a list,
which is returned.
If SEPARATORS is non-nil, it should be a regular expression matching text
which separates, but is not part of, the substrings. If nil it defaults to
`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and
OMIT-NULLS is forced to t.
If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so
that for the default value of SEPARATORS leading and trailing whitespace
are effectively trimmed). If nil, all zero-length substrings are retained,
which correctly parses CSV format, for example.
Note that the effect of `(split-string STRING)' is the same as
`(split-string STRING split-string-default-separators t)'). In the rare
case that you wish to retain zero-length substrings when splitting on
whitespace, use `(split-string STRING split-string-default-separators)'.
Modifies the match data; use `save-match-data' if necessary."
(let ((keep-nulls (not (if separators omit-nulls t)))
(rexp (or separators muse-backlink-split-string-default-separators))
(start 0)
notfirst
(list nil))
(while (and (string-match rexp string
(if (and notfirst
(= start (match-beginning 0))
(< start (length string)))
(1+ start) start))
(< start (length string)))
(setq notfirst t)
(if (or keep-nulls (< start (match-beginning 0)))
(setq list
(cons (substring string start (match-beginning 0))
list)))
(setq start (match-end 0)))
(if (or keep-nulls (< start (length string)))
(setq list
(cons (substring string start)
list)))
(nreverse list))))
(defalias 'muse-backlink-split-string 'split-string)))
(defgroup muse-backlink nil
"Hierarchical backlinking for Muse."
:group 'muse)
(defcustom muse-backlink-create-backlinks t
"When non-nil, create hierarchical backlinks in new Muse pages.
For control over which pages will receive backlinks, see
`muse-backlink-exclude-backlink-parent-regexp' and
`muse-backlink-exclude-backlink-regexp'."
:type 'boolean
:group 'muse-backlink)
(defcustom muse-backlink-avoid-bad-links t
"When non-nil, avoid bad links when backlinking."
:type 'boolean
:group 'muse-backlink)
;; The default for exclusion stops backlinks from being added to and
;; from planner day pages.
(defcustom muse-backlink-exclude-backlink-parent-regexp
"^[0-9][0-9][0-9][0-9]\\.[0-9][0-9]\\.[0-9][0-9]$"
"Regular expression matching pages whose children should not have backlinks."
:type 'regexp
:group 'muse-backlink)
(defcustom muse-backlink-exclude-backlink-regexp
"^[0-9][0-9][0-9][0-9]\\.[0-9][0-9]\\.[0-9][0-9]$"
"Regular expression matching pages that should not have backlinks."
:type 'regexp
:group 'muse-backlink)
(defcustom muse-backlink-separator "/"
"String that separates backlinks.
Should be something that will not appear as a substring in an explicit
link that has no description."
:type 'string
:group 'muse-backlink)
(defcustom muse-backlink-before-string "backlinks: "
"String to come before the backlink list."
:type 'string
:group 'muse-backlink)
(defcustom muse-backlink-after-string ""
"String to come after the backlink list."
:type 'string
:group 'muse-backlink)
(defcustom muse-backlink-separator "/"
"String that separates backlinks.
Should be something that will not appear as a substring in an explicit
link that has no description."
:type 'string
:group 'muse-backlink)
(defcustom muse-backlink-regexp
(concat "^"
(regexp-quote muse-backlink-before-string)
"\\("
(regexp-quote muse-backlink-separator)
".+\\)"
(regexp-quote muse-backlink-after-string))
;; Really, I want something like this, but I can't make it work:
;; (concat "^\\("
;; (regexp-quote muse-backlink-separator)
;; "\\(?:"
;; muse-explicit-link-regexp
;; "\\)\\)+")
"Regular expression to match backlinks in a buffer.
Match 1 is the list of backlinks without `muse-backlink-before-string'
and `muse-backlink-after-string'."
:type 'regexp
:group 'muse-backlink)
(defun muse-backlink-goto-insertion-point ()
"Find the right place to add backlinks."
(goto-char (point-min))
(when (looking-at "\\(?:^#.+[ \t]*\n\\)+")
(goto-char (match-end 0))))
(defun muse-backlink-get-current ()
"Return a list of backlinks in the current buffer."
(save-excursion
(goto-char (point-min))
(when (re-search-forward muse-backlink-regexp nil t)
(muse-backlink-split-string
(match-string 1)
(regexp-quote muse-backlink-separator) t))))
(defun muse-backlink-format-link-list (links)
"Format the list of LINKS as backlinks."
(concat muse-backlink-separator
(mapconcat #'identity links muse-backlink-separator)))
(defun muse-backlink-insert-links (links)
"Insert backlinks to LINKS into the current page.
LINKS is a list of links ordered by ancestry, with the parent as the
last element."
(muse-backlink-goto-insertion-point)
(insert muse-backlink-before-string
(muse-backlink-format-link-list links)
muse-backlink-after-string
;; Could have this in the after string, but they might get
;; deleted.
"\n\n"))
(defun muse-backlink-unsaved-page-p (page project)
"Return non-nil if PAGE is in PROJECT but has not been saved."
(member
page
(mapcar
#'(lambda (b)
(with-current-buffer b
(and (derived-mode-p 'muse-mode)
(equal muse-current-project project)
(not (muse-project-page-file
(muse-page-name)
muse-current-project))
(muse-page-name))))
(buffer-list))))
(defvar muse-backlink-links nil
"Internal variable.
The links to insert in the forthcomingly visited muse page.")
(defvar muse-backlink-pending nil
"Internal variable.")
(defvar muse-backlink-parent-buffer nil
"Internal variable.
The parent buffer of the forthcomingly visited muse page.")
;;; Attach hook to the derived mode hook, to avoid problems such as
;;; planner-prepare-file thinking that the buffer needs no template.
(defun muse-backlink-get-mode-hook ()
(derived-mode-hook-name major-mode))
(defun muse-backlink-insert-hook-func ()
"Insert backlinks into the current buffer and clean up."
(when (and muse-backlink-links
muse-backlink-pending
(string= (car muse-backlink-links) (muse-page-name)))
(muse-backlink-insert-links (cdr muse-backlink-links))
(when muse-backlink-avoid-bad-links
(save-buffer)
(when muse-backlink-parent-buffer
(with-current-buffer muse-backlink-parent-buffer
(font-lock-fontify-buffer))))
(setq muse-backlink-links nil
muse-backlink-parent-buffer nil
muse-backlink-pending nil)
(remove-hook (muse-backlink-get-mode-hook) #'muse-backlink-insert-hook-func)))
(defun muse-backlink-handle-link (link)
"When appropriate, arrange for backlinks on visiting LINK."
(when (and muse-backlink-create-backlinks
(not muse-backlink-pending)
(memq this-command
'(muse-follow-name-at-point muse-follow-name-at-mouse))
(not muse-publishing-p)
(not (and (boundp 'muse-colors-fontifying-p)
muse-colors-fontifying-p)))
(require 'muse-mode)
(setq
muse-backlink-links
(save-match-data
(let* ((orig-link (or link (match-string 1)))
(link (if (string-match "#" orig-link)
(substring orig-link 0 (match-beginning 0))
orig-link)))
(unless
(or (not muse-current-project)
(string-match muse-url-regexp orig-link)
(string-match muse-image-regexp orig-link)
(and (boundp 'muse-wiki-interwiki-regexp)
(string-match muse-wiki-interwiki-regexp
orig-link))
;; Don't add a backlink if the page already
;; exists, whether it has been saved or not.
(or (muse-project-page-file link muse-current-project)
(muse-backlink-unsaved-page-p link muse-current-project))
(string-match muse-backlink-exclude-backlink-parent-regexp
(muse-page-name))
(string-match muse-backlink-exclude-backlink-regexp link))
;; todo: Hmm. This will only work if the child page is the
;; same mode as the parent page.
(add-hook (muse-backlink-get-mode-hook) #'muse-backlink-insert-hook-func)
(setq muse-backlink-pending t)
(when muse-backlink-avoid-bad-links
(setq muse-backlink-parent-buffer (current-buffer))
(unless (muse-project-page-file
(muse-page-name) muse-current-project)
;; It must be modified...
(save-buffer)))
(cons link
(append (muse-backlink-get-current)
(list (muse-make-link (muse-page-name))))))))))
;; Make sure we always return nil
nil)
(defun muse-backlink-install ()
"Add backlinking functionality to muse-mode."
(add-to-list 'muse-explicit-link-functions #'muse-backlink-handle-link))
(defun muse-backlink-remove ()
"Remove backlinking functionality from muse-mode."
(setq muse-explicit-link-functions
(delq #'muse-backlink-handle-link muse-explicit-link-functions)))
(provide 'muse-backlink)
;;; muse-backlink.el ends here

306
elpa/muse-3.20/muse-blosxom.el
View File

@ -1,306 +0,0 @@
;;; muse-blosxom.el --- publish a document tree for serving by (py)Blosxom
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Michael Olson <mwolson@gnu.org>
;; Date: Wed, 23 March 2005
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; The Blosxom publishing style publishes a tree of categorised files
;; to a mirrored tree of stories to be served by blosxom.cgi or
;; pyblosxom.cgi.
;;
;; Serving entries with (py)blosxom
;; --------------------------------
;;
;; Each Blosxom file must include `#date yyyy-mm-dd', or optionally
;; the longer `#date yyyy-mm-dd-hh-mm', a title (using the `#title'
;; directive) plus whatever normal content is desired.
;;
;; The date directive is not used directly by (py)blosxom or this
;; program. You need to find two additional items to make use of this
;; feature.
;;
;; 1. A script to gather date directives from the entire blog tree
;; into a single file. The file must associate a blog entry with
;; a date.
;;
;; 2. A plugin for (py)blosxom that reads this file.
;;
;; These 2 things are provided for pyblosxom in the contrib/pyblosxom
;; subdirectory. `getstamps.py' provides the 1st service, while
;; `hardcodedates.py' provides the second service. Eventually it is
;; hoped that a blosxom plugin and script will be found/written.
;;
;; Alternately, the pyblosxom metadate plugin may be used. On the
;; plus side, there is no need to run a script to gather the date. On
;; the downside, each entry is read twice rather than once when the
;; page is rendered. Set the value of muse-blosxom-use-metadate to
;; non-nil to enable adding a #postdate directive to all published
;; files. You can do this by:
;;
;; M-x customize-variable RET muse-blosxom-use-metadate RET
;;
;; With the metadate plugin installed in pyblosxom, the date set in
;; this directive will be used instead of the file's modification
;; time. The plugin is included with Muse at
;; contrib/pyblosxom/metadate.py.
;;
;; Generating a Muse project entry
;; -------------------------------
;;
;; Muse-blosxom has some helper functions to make specifying
;; muse-blosxom projects a lot easier. An example follows.
;;
;; (setq muse-project-alist
;; `(("blog"
;; (,@(muse-project-alist-dirs "~/path/to/blog-entries")
;; :default "index")
;; ,@(muse-project-alist-styles "~/path/to/blog-entries"
;; "~/public_html/blog"
;; "blosxom-xhtml")
;; )))
;;
;; Note that we need a backtick instead of a single quote on the
;; second line of this example.
;;
;; Creating new blog entries
;; -------------------------
;;
;; There is a function called `muse-blosxom-new-entry' that will
;; automate the process of making a new blog entry. To make use of
;; it, do the following.
;;
;; - Customize `muse-blosxom-base-directory' to the location that
;; your blog entries are stored.
;;
;; - Assign the `muse-blosxom-new-entry' function to a key sequence.
;; I use the following code to assign this function to `C-c p l'.
;;
;; (global-set-key "\C-cpl" 'muse-blosxom-new-entry)
;;
;; - You should create your directory structure ahead of time under
;; your base directory. These directories, which correspond with
;; category names, may be nested.
;;
;; - When you enter this key sequence, you will be prompted for the
;; category of your entry and its title. Upon entering this
;; information, a new file will be created that corresponds with
;; the title, but in lowercase letters and having special
;; characters converted to underscores. The title and date
;; directives will be inserted automatically.
;;
;; Using tags
;; ----------
;;
;; If you wish to keep all of your blog entries in one directory and
;; use tags to classify your entries, set `muse-blosxom-use-tags' to
;; non-nil.
;;
;; For this to work, you will need to be using the PyBlosxom plugin at
;; http://pyblosxom.sourceforge.net/blog/registry/meta/Tags.
;;; Contributors:
;; Gary Vaughan (gary AT gnu DOT org) is the original author of
;; `emacs-wiki-blosxom.el', which is the ancestor of this file.
;; Brad Collins (brad AT chenla DOT org) ported this file to Muse.
;; Björn Lindström (bkhl AT elektrubadur DOT se) made many valuable
;; suggestions.
;; Sasha Kovar (sasha AT arcocene DOT org) fixed
;; muse-blosxom-new-entry when using tags and also implemented support
;; for the #postdate directive.
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse Blosxom Publishing
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-project)
(require 'muse-publish)
(require 'muse-html)
(defgroup muse-blosxom nil
"Options controlling the behavior of Muse Blosxom publishing.
See `muse-blosxom' for more information."
:group 'muse-publish)
(defcustom muse-blosxom-extension ".txt"
"Default file extension for publishing Blosxom files."
:type 'string
:group 'muse-blosxom)
(defcustom muse-blosxom-header
"<lisp>(concat (muse-publishing-directive \"title\") \"\\n\"
(when muse-blosxom-use-metadate
(let ((date (muse-publishing-directive \"date\")))
(when date (concat \"#postdate \"
(muse-blosxom-format-date date) \"\\n\"))))
(when muse-blosxom-use-tags
(let ((tags (muse-publishing-directive \"tags\")))
(when tags (concat \"#tags \" tags \"\\n\")))))</lisp>"
"Header used for publishing Blosxom files. This may be text or a filename."
:type 'string
:group 'muse-blosxom)
(defcustom muse-blosxom-footer ""
"Footer used for publishing Blosxom files. This may be text or a filename."
:type 'string
:group 'muse-blosxom)
(defcustom muse-blosxom-base-directory "~/Blog"
"Base directory of blog entries.
This is the top-level directory where your Muse blog entries may be found."
:type 'directory
:group 'muse-blosxom)
(defcustom muse-blosxom-use-tags nil
"Determine whether or not to enable use of the #tags directive.
If you wish to keep all of your blog entries in one directory and
use tags to classify your entries, set `muse-blosxom-use-tags' to
non-nil.
For this to work, you will need to be using the PyBlosxom plugin
at http://pyblosxom.sourceforge.net/blog/registry/meta/Tags."
:type 'boolean
:group 'muse-blosxom)
(defcustom muse-blosxom-use-metadate nil
"Determine whether or not to use the #postdate directive.
If non-nil, published entries include the original date (as specified
in the muse #date line) which can be read by the metadate PyBlosxom
plugin.
For this to work, you will need to be using the PyBlosxom plugin
at http://pyblosxom.sourceforge.net/blog/registry/date/metadate."
:type 'boolean
:group 'muse-blosxom)
;; Maintain (published-file . date) alist, which will later be written
;; to a timestamps file; not implemented yet.
(defvar muse-blosxom-page-date-alist nil)
(defun muse-blosxom-update-page-date-alist ()
"Add a date entry to `muse-blosxom-page-date-alist' for this page."
(when muse-publishing-current-file
;; Make current file be relative to base directory
(let ((rel-file
(concat
(file-name-as-directory
(or (muse-publishing-directive "category")
(file-relative-name
(file-name-directory
(expand-file-name muse-publishing-current-file))
(file-truename muse-blosxom-base-directory))))
(file-name-nondirectory muse-publishing-current-file))))
;; Strip the file extension
(when muse-ignored-extensions-regexp
(setq rel-file (save-match-data
(and (string-match muse-ignored-extensions-regexp
rel-file)
(replace-match "" t t rel-file)))))
;; Add to page-date alist
(add-to-list
'muse-blosxom-page-date-alist
`(,rel-file . ,(muse-publishing-directive "date"))))))
;; Enter a new blog entry
(defun muse-blosxom-title-to-file (title)
"Derive a file name from the given TITLE.
Feel free to overwrite this if you have a different concept of what
should be allowed in a filename."
(muse-replace-regexp-in-string (concat "[^-." muse-regexp-alnum "]")
"_" (downcase title)))
(defun muse-blosxom-format-date (date)
"Convert a date string to PyBlosxom metadate plugin format."
(apply #'format "%s-%s-%s %s:%s" (split-string date "-")))
;;;###autoload
(defun muse-blosxom-new-entry (category title)
"Start a new blog entry with given CATEGORY.
The filename of the blog entry is derived from TITLE.
The page will be initialized with the current date and TITLE."
(interactive
(list
(if muse-blosxom-use-tags
(let ((tag "foo")
(tags nil))
(while (progn (setq tag (read-string "Tag (RET to continue): "))
(not (string= tag "")))
(add-to-list 'tags tag t))
tags)
(funcall muse-completing-read-function
"Category: "
(mapcar 'list (muse-project-recurse-directory
muse-blosxom-base-directory))))
(read-string "Title: ")))
(let ((file (muse-blosxom-title-to-file title)))
(muse-project-find-file
file "blosxom" nil
(if muse-blosxom-use-tags
(directory-file-name muse-blosxom-base-directory)
(concat (directory-file-name muse-blosxom-base-directory)
"/" category))))
(goto-char (point-min))
(insert "#date " (format-time-string "%Y-%m-%d-%H-%M")
"\n#title " title)
(if muse-blosxom-use-tags
(if (> (length category) 0)
(insert (concat "\n#tags " (mapconcat #'identity category ","))))
(unless (string= category "")
(insert (concat "\n#category " category))))
(insert "\n\n")
(forward-line 2))
;;; Register the Muse Blosxom Publisher
(muse-derive-style "blosxom-html" "html"
:suffix 'muse-blosxom-extension
:link-suffix 'muse-html-extension
:header 'muse-blosxom-header
:footer 'muse-blosxom-footer
:after 'muse-blosxom-update-page-date-alist
:browser 'find-file)
(muse-derive-style "blosxom-xhtml" "xhtml"
:suffix 'muse-blosxom-extension
:link-suffix 'muse-xhtml-extension
:header 'muse-blosxom-header
:footer 'muse-blosxom-footer
:after 'muse-blosxom-update-page-date-alist
:browser 'find-file)
(provide 'muse-blosxom)
;;; muse-blosxom.el ends here

284
elpa/muse-3.20/muse-book.el
View File

@ -1,284 +0,0 @@
;;; muse-book.el --- publish entries into a compilation
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Contributors:
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse Book Publishing
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-publish)
(require 'muse-project)
(require 'muse-latex)
(require 'muse-regexps)
(defgroup muse-book nil
"Module for publishing a series of Muse pages as a complete book.
Each page will become a separate chapter in the book, unless the
style keyword :nochapters is used, in which case they are all run
together as if one giant chapter."
:group 'muse-publish)
(defcustom muse-book-before-publish-hook nil
"A hook run in the book buffer before it is marked up."
:type 'hook
:group 'muse-book)
(defcustom muse-book-after-publish-hook nil
"A hook run in the book buffer after it is marked up."
:type 'hook
:group 'muse-book)
(defcustom muse-book-latex-header
"\\documentclass{book}
\\usepackage[english]{babel}
\\usepackage[latin1]{inputenc}
\\usepackage[T1]{fontenc}
\\begin{document}
\\title{<lisp>(muse-publishing-directive \"title\")</lisp>}
\\author{<lisp>(muse-publishing-directive \"author\")</lisp>}
\\date{<lisp>(muse-publishing-directive \"date\")</lisp>}
\\maketitle
\\tableofcontents\n"
"Header used for publishing books to LaTeX. This may be text or a filename."
:type 'string
:group 'muse-book)
(defcustom muse-book-latex-footer
"<lisp>(muse-latex-bibliography)</lisp>
\\end{document}"
"Footer used for publishing books to LaTeX. This may be text or a filename."
:type 'string
:group 'muse-book)
(defun muse-book-publish-chapter (title entry style &optional nochapters)
"Publish the chapter TITLE for the file ENTRY using STYLE.
TITLE is a string, ENTRY is a cons of the form (PAGE-NAME .
FILE), and STYLE is a Muse style list.
This routine does the same basic work as `muse-publish-markup-buffer',
but treating the page as if it were a single chapter within a book."
(let ((muse-publishing-directives (list (cons "title" title)))
(muse-publishing-current-file (cdr entry))
(beg (point)) end)
(muse-insert-file-contents (cdr entry))
(setq end (copy-marker (point-max) t))
(muse-publish-markup-region beg end (car entry) style)
(goto-char beg)
(unless (or nochapters
(muse-style-element :nochapters style))
(insert "\n")
(muse-insert-markup (muse-markup-text 'chapter))
(insert (let ((chap (muse-publishing-directive "title")))
(if (string= chap title)
(car entry)
chap)))
(muse-insert-markup (muse-markup-text 'chapter-end))
(insert "\n\n"))
(save-restriction
(narrow-to-region beg end)
(muse-publish-markup (or title "")
'((100 "<\\(lisp\\)>" 0
muse-publish-markup-tag)))
(muse-style-run-hooks :after style))
(goto-char end)))
(defun muse-book-publish-p (project target)
"Determine whether the book in PROJECT is out-of-date."
(let ((pats (cadr project)))
(catch 'publish
(while pats
(if (symbolp (car pats))
(if (eq :book-end (car pats))
(throw 'publish nil)
;; skip past symbol-value pair
(setq pats (cddr pats)))
(dolist (entry (muse-project-file-entries (car pats)))
(when (and (not (muse-project-private-p (cdr entry)))
(file-newer-than-file-p (cdr entry) target))
(throw 'publish t)))
(setq pats (cdr pats)))))))
(defun muse-book-get-directives (file)
"Interpret any publishing directives contained in FILE.
This is meant to be called in a temp buffer that will later be
used for publishing."
(save-restriction
(narrow-to-region (point) (point))
(unwind-protect
(progn
(muse-insert-file-contents file)
(muse-publish-markup
"attributes"
`(;; Remove leading and trailing whitespace from the file
(100 "\\(\\`\n+\\|\n+\\'\\)" 0 "")
;; Remove trailing whitespace from all lines
(200 ,(concat "[" muse-regexp-blank "]+$") 0 "")
;; Handle any leading #directives
(300 "\\`#\\([a-zA-Z-]+\\)\\s-+\\(.+\\)\n+"
0 muse-publish-markup-directive))))
(delete-region (point-min) (point-max)))))
(defun muse-book-publish-project
(project book title style &optional output-dir force)
"Publish PROJECT under the name BOOK with the given TITLE and STYLE.
BOOK should be a page name, i.e., letting the style determine the
prefix and/or suffix. The book is published to OUTPUT-DIR. If FORCE
is nil, the book is only published if at least one of its component
pages has changed since it was last published."
(interactive
(let ((project (muse-read-project "Publish project as book: " nil t)))
(append (list project
(read-string "Basename of book (without extension): ")
(read-string "Title of book: "))
(muse-publish-get-info))))
(setq project (muse-project project))
(let ((muse-current-project project))
;; See if any of the project's files need saving first
(muse-project-save-buffers project)
;; Publish the book
(muse-book-publish book style output-dir force title)))
(defun muse-book-publish (file style &optional output-dir force title)
"Publish FILE as a book with the given TITLE and STYLE.
The book is published to OUTPUT-DIR. If FORCE is nil, the book
is only published if at least one of its component pages has
changed since it was last published."
;; Cleanup some of the arguments
(let ((style-name style))
(setq style (muse-style style))
(unless style
(error "There is no style '%s' defined" style-name)))
;; Publish each page in the project as a chapter in one large book
(let* ((output-path (muse-publish-output-file file output-dir style))
(output-suffix (muse-style-element :osuffix style))
(target output-path)
(project muse-current-project)
(published nil))
(when output-suffix
(setq target (concat (muse-path-sans-extension target)
output-suffix)))
;; Unless force is non-nil, determine if the book needs publishing
(if (and (not force)
(not (muse-book-publish-p project target)))
(message "The book \"%s\" is up-to-date." file)
;; Create the book from all its component parts
(muse-with-temp-buffer
(let ((style-final (muse-style-element :final style t))
(style-header (muse-style-element :header style))
(style-footer (muse-style-element :footer style))
(muse-publishing-current-style style)
(muse-publishing-directives
(list (cons "title" (or title (muse-page-name file)))
(cons "date" (format-time-string "%B %e, %Y"))))
(muse-publishing-p t)
(muse-current-project project)
(pats (cadr project))
(nochapters nil))
(run-hooks 'muse-before-book-publish-hook)
(let ((style-final style-final)
(style-header style-header)
(style-footer style-footer))
(unless title
(muse-book-get-directives file)
(setq title (muse-publishing-directive "title")))
(while pats
(if (symbolp (car pats))
(cond
((eq :book-part (car pats))
(insert "\n")
(muse-insert-markup (muse-markup-text 'part))
(insert (cadr pats))
(muse-insert-markup (muse-markup-text 'part-end))
(insert "\n")
(setq pats (cddr pats)))
((eq :book-chapter (car pats))
(insert "\n")
(muse-insert-markup (muse-markup-text 'chapter))
(insert (cadr pats))
(muse-insert-markup (muse-markup-text 'chapter-end))
(insert "\n")
(setq pats (cddr pats)))
((eq :nochapters (car pats))
(setq nochapters t
pats (cddr pats)))
((eq :book-style (car pats))
(setq style (muse-style (cadr pats)))
(setq style-final (muse-style-element :final style t)
style-header (muse-style-element :header style)
style-footer (muse-style-element :footer style)
muse-publishing-current-style style)
(setq pats (cddr pats)))
((eq :book-funcall (car pats))
(funcall (cadr pats))
(setq pats (cddr pats)))
((eq :book-end (car pats))
(setq pats nil))
(t
(setq pats (cddr pats))))
(let ((entries (muse-project-file-entries (car pats))))
(while (and entries (car entries) (caar entries))
(unless (muse-project-private-p (cdar entries))
(muse-book-publish-chapter title (car entries)
style nochapters)
(setq published t))
(setq entries (cdr entries))))
(setq pats (cdr pats)))))
(goto-char (point-min))
(if style-header (muse-insert-file-or-string style-header file))
(goto-char (point-max))
(if style-footer (muse-insert-file-or-string style-footer file))
(run-hooks 'muse-after-book-publish-hook)
(if (muse-write-file output-path)
(if style-final
(funcall style-final file output-path target))
(setq published nil)))))
(if published
(message "The book \"%s\" has been published." file))
published))
;;; Register the Muse BOOK Publishers
(muse-derive-style "book-latex" "latex"
:header 'muse-book-latex-header
:footer 'muse-book-latex-footer
:publish 'muse-book-publish)
(muse-derive-style "book-pdf" "pdf"
:header 'muse-book-latex-header
:footer 'muse-book-latex-footer
:publish 'muse-book-publish)
(provide 'muse-book)
;;; muse-book.el ends here

1019
elpa/muse-3.20/muse-colors.el
View File

File diff suppressed because it is too large Load Diff

458
elpa/muse-3.20/muse-context.el
View File

@ -1,458 +0,0 @@
;;; muse-context.el --- publish entries in ConTeXt or PDF format
;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Jean Magnan de Bornier (jean@bornier.net)
;; Created: 16-Apr-2007
;; Emacs Muse 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, or (at your
;; option) any later version.
;; This file when loaded allows you to publish .muse files as ConTeXt
;; files or as pdf files, using respectively the "context" and
;; "context-pdf" styles. It is far from being perfect, so any feedback
;; will be welcome and any mistake hopefully fixed.
;;; Author:
;; Jean Magnan de Bornier, who based this file on muse-latex.el and
;; made the context, context-pdf, context-slides, and
;; context-slides-pdf Muse publishing styles.
;; 16 Avril 2007
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse ConTeXt Publishing
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-publish)
(defgroup muse-context nil
"Rules for marking up a Muse file as a ConTeXt article."
:group 'muse-publish)
(defcustom muse-context-extension ".tex"
"Default file extension for publishing ConTeXt files."
:type 'string
:group 'muse-context)
(defcustom muse-context-pdf-extension ".pdf"
"Default file extension for publishing ConTeXt files to PDF."
:type 'string
:group 'muse-context)
(defcustom muse-context-pdf-program "texexec --pdf"
"The program that is called to generate PDF content from ConTeXt content."
:type 'string
:group 'muse-context)
(defcustom muse-context-pdf-cruft '(".pgf" ".tmp" ".tui" ".tuo" ".toc" ".log")
"Extensions of files to remove after generating PDF output successfully."
:type 'string
:group 'muse-context)
(defcustom muse-context-header
"\\setupinteraction [state=start]
\\usemodule[tikz]
\\usemodule[bib]\n
<lisp>(muse-context-setup-bibliography)</lisp>
\\setuppublications[]\n
\\setuppublicationlist[]\n\\setupcite[]\n
\\starttext
\\startalignment[center]
\\blank[2*big]
{\\tfd <lisp>(muse-publishing-directive \"title\")</lisp>}
\\blank[3*medium]
{\\tfa <lisp>(muse-publishing-directive \"author\")</lisp>}
\\blank[2*medium]
{\\tfa <lisp>(muse-publishing-directive \"date\")</lisp>}
\\blank[3*medium]
\\stopalignment
<lisp>(and muse-publish-generate-contents
(not muse-context-permit-contents-tag)
\"\\\\placecontent\n\\\\page[yes]\")</lisp>\n\n"
"Header used for publishing ConTeXt files. This may be text or a filename."
:type 'string
:group 'muse-context)
(defcustom muse-context-footer "<lisp>(muse-context-bibliography)</lisp>
\\stoptext\n"
"Footer used for publishing ConTeXt files. This may be text or a filename."
:type 'string
:group 'muse-context)
(defcustom muse-context-markup-regexps
`(;; numeric ranges
(10000 "\\([0-9]+\\)-\\([0-9]+\\)" 0 "\\1--\\2")
;; be careful of closing quote pairs
(10100 "\"'" 0 "\"\\\\-'"))
"List of markup regexps for identifying regions in a Muse page.
For more on the structure of this list, see `muse-publish-markup-regexps'."
:type '(repeat (choice
(list :tag "Markup rule"
integer
(choice regexp symbol)
integer
(choice string function symbol))
function))
:group 'muse-context)
(defcustom muse-context-markup-functions
'((table . muse-context-markup-table))
"An alist of style types to custom functions for that kind of text.
For more on the structure of this list, see
`muse-publish-markup-functions'."
:type '(alist :key-type symbol :value-type function)
:group 'muse-context)
(defcustom muse-context-markup-strings
'((image-with-desc . "\\placefigure[][]{%3%}{\\externalfigure[%1%.%2%]}")
(image . "\\placefigure[][]{}{\\externalfigure[%s.%s]}")
(image-link . "\\useURL[aa][%s][][%1%] \\from[aa]")
(anchor-ref . "\\goto{%2%}{}[%1%]")
(url . "\\useURL[aa][%s][][%s] \\from[aa]")
(url-and-desc . "\\useURL[bb][%s][][%s]\\from[bb]\\footnote{%1%}")
(link . "\\goto{%2%}[program(%1%)]\\footnote{%1%}")
(link-and-anchor . "\\useexternaldocument[%4%][%4%][] \\at{%3%, page}{}[%4%::%2%]\\footnote{%1%}")
(email-addr . "\\useURL[mail][mailto:%s][][%s]\\from[mail]")
(anchor . "\\reference[%s] ")
(emdash . "---")
(comment-begin . "\\doifmode{comment}{")
(comment-end . "}")
(rule . "\\blank[medium]\\hrule\\blank[medium]")
(no-break-space . "~")
(enddots . "\\ldots ")
(dots . "\\dots ")
(part . "\\part{")
(part-end . "}")
(chapter . "\\chapter{")
(chapter-end . "}")
(section . "\\section{")
(section-end . "}")
(subsection . "\\subsection{")
(subsection-end . "}")
(subsubsection . "\\subsubsection{")
(subsubsection-end . "}")
(section-other . "\\subsubsubject{")
(section-other-end . "}")
(footnote . "\\footnote{")
(footnote-end . "}")
(footnotetext . "\\footnotetext[%d]{")
(begin-underline . "\\underbar{")
(end-underline . "}")
(begin-literal . "\\type{")
(end-literal . "}")
(begin-emph . "{\\em ")
(end-emph . "}")
(begin-more-emph . "{\\bf ")
(end-more-emph . "}")
(begin-most-emph . "{\\bf {\\em ")
(end-most-emph . "}}")
(begin-example . "\\starttyping")
(end-example . "\\stoptyping")
(begin-center . "\\startalignment[center]\n")
(end-center . "\n\\stopalignment")
(begin-quote . "\\startquotation\n")
(end-quote . "\n\\stopquotation")
(begin-cite . "\\cite[authoryear][")
(begin-cite-author . "\\cite[author][")
(begin-cite-year . "\\cite[year][")
(end-cite . "]")
(begin-uli . "\\startitemize\n")
(end-uli . "\n\\stopitemize")
(begin-uli-item . "\\item ")
(begin-oli . "\\startitemize[n]\n")
(end-oli . "\n\\stopitemize")
(begin-oli-item . "\\item ")
(begin-dl . "\\startitemize\n")
(end-dl . "\n\\stopitemize")
(begin-ddt . "\\head ")
(end-ddt . "\n")
(begin-verse . "\\blank[big]")
(end-verse-line . "\\par")
(verse-space . "\\fixedspaces ~~")
(end-verse . "\\blank[big]"))
"Strings used for marking up text.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles."
:type '(alist :key-type symbol :value-type string)
:group 'muse-context)
(defcustom muse-context-slides-header
"\\usemodule[<lisp>(if (string-equal (muse-publishing-directive \"module\") nil) \"pre-01\" (muse-publishing-directive \"module\"))</lisp>]
\\usemodule[tikz]
\\usemodule[newmat]
\\setupinteraction [state=start]
\\starttext
\\TitlePage { <lisp>(muse-publishing-directive \"title\")</lisp>
\\blank[3*medium]
\\tfa <lisp>(muse-publishing-directive \"author\")</lisp>
\\blank[2*medium]
\\tfa <lisp>(muse-publishing-directive \"date\")</lisp>}"
"Header for publishing a presentation (slides) using ConTeXt.
Any of the predefined modules, which are available in the
tex/context/base directory, can be used by writing a \"module\"
directive at the top of the muse file; if no such directive is
provided, module pre-01 is used. Alternatively, you can use your
own style (\"mystyle\", in this example) by replacing
\"\\usemodule[]\" with \"\\input mystyle\".
This may be text or a filename."
:type 'string
:group 'muse-context)
(defcustom muse-context-slides-markup-strings
'((section . "\\Topic {")
(subsection . "\\page \n{\\bf ")
(subsubsection . "{\\em "))
"Strings used for marking up text in ConTeXt slides."
:type '(alist :key-type symbol :value-type string)
:group 'muse-context)
(defcustom muse-context-markup-specials-document
'((?\\ . "\\textbackslash{}")
(?\_ . "\\textunderscore{}")
(?\< . "\\switchtobodyfont[small]")
(?\> . "\\switchtobodyfont[big]")
(?^ . "\\^")
(?\~ . "\\~")
(?\@ . "\\@")
(?\$ . "\\$")
(?\% . "\\%")
(?\{ . "\\{")
(?\} . "\\}")
(?\& . "\\&")
(?\# . "\\#"))
"A table of characters which must be represented specially.
These are applied to the entire document, sans already-escaped
regions."
:type '(alist :key-type character :value-type string)
:group 'muse-context)
(defcustom muse-context-markup-specials-example
'()
"A table of characters which must be represented specially.
These are applied to <example> regions.
With the default interpretation of <example> regions, no specials
need to be escaped."
:type '(alist :key-type character :value-type string)
:group 'muse-context)
(defcustom muse-context-markup-specials-literal
'()
"A table of characters which must be represented specially.
This applies to =monospaced text= and <code> regions."
:type '(alist :key-type character :value-type string)
:group 'muse-context)
(defcustom muse-context-markup-specials-url
'((?\\ . "\\textbackslash")
(?\_ . "\\_")
(?\< . "\\<")
(?\> . "\\>")
(?\$ . "\\$")
(?\% . "\\%")
(?\{ . "\\{")
(?\} . "\\}")
(?\& . "\\&")
(?\# . "\\#"))
"A table of characters which must be represented specially.
These are applied to URLs."
:type '(alist :key-type character :value-type string)
:group 'muse-context)
(defcustom muse-context-markup-specials-image
'((?\\ . "\\textbackslash") ; cannot find suitable replacement
(?\< . "\\<")
(?\> . "\\>")
(?\$ . "\\$")
(?\% . "\\%")
(?\{ . "\\{")
(?\} . "\\}")
(?\& . "\\&")
(?\# . "\\#") ; cannot find suitable replacement
)
"A table of characters which must be represented specially.
These are applied to image filenames."
:type '(alist :key-type character :value-type string)
:group 'muse-context)
(defun muse-context-decide-specials (context)
"Determine the specials to escape, depending on the CONTEXT argument."
(cond ((memq context '(underline emphasis document url-desc verbatim
footnote))
muse-context-markup-specials-document)
((eq context 'image)
muse-context-markup-specials-image)
((memq context '(email url))
muse-context-markup-specials-url)
((eq context 'literal)
muse-context-markup-specials-literal)
((eq context 'example)
muse-context-markup-specials-example)
(t (error "Invalid context argument '%s' in muse-context" context))))
(defun muse-context-markup-table ()
(let* ((table-info (muse-publish-table-fields (match-beginning 0)
(match-end 0)))
(row-len (car table-info))
(field-list (cdr table-info)))
(when table-info
(muse-insert-markup "\\starttable[|"
(mapconcat 'symbol-name (make-vector row-len 'l)
"|") "|]\n \\HL\n \\VL ")
(dolist (fields field-list)
(let ((type (car fields)))
(setq fields (cdr fields))
(when (= type 3)
(muse-insert-markup ""))
(insert (car fields))
(setq fields (cdr fields))
(dolist (field fields)
(muse-insert-markup " \\VL ")
(insert field))
(muse-insert-markup "\\VL\\NR\n \\HL\n \\VL ")
(when (= type 2)
(muse-insert-markup " "))))
(muse-insert-markup "\\stoptable\n")
(while (search-backward "VL \\stoptable" nil t)
(replace-match "stoptable" nil t)))))
(defun muse-context-fixup-dquotes ()
"Fixup double quotes."
(goto-char (point-min))
(let ((open t))
(while (search-forward "\"" nil t)
(unless (get-text-property (match-beginning 0) 'read-only)
(when (or (bobp)
(eq (char-before) ?\n))
(setq open t))
(if open
(progn
(replace-match "``")
(setq open nil))
(replace-match "''")
(setq open t))))))
(defcustom muse-context-permit-contents-tag nil
"If nil, ignore <contents> tags. Otherwise, insert table of contents.
Most of the time, it is best to have a table of contents on the
first page, with a new page immediately following. To make this
work with documents published in both HTML and ConTeXt, we need to
ignore the <contents> tag.
If you don't agree with this, then set this option to non-nil,
and it will do what you expect."
:type 'boolean
:group 'muse-context)
(defun muse-context-fixup-citations ()
"Replace semicolons in multi-head citations with colons."
(goto-char (point-min))
(while (re-search-forward "\\\\cite.?\\[" nil t)
(let ((start (point))
(end (re-search-forward "]")))
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
(while (re-search-forward ";" nil t)
(replace-match ","))))))
(defun muse-context-munge-buffer ()
(muse-context-fixup-dquotes)
(muse-context-fixup-citations)
(when (and muse-context-permit-contents-tag
muse-publish-generate-contents)
(goto-char (car muse-publish-generate-contents))
(muse-insert-markup "\\placecontent")))
(defun muse-context-bibliography ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "\\\\cite.?\\[" nil t)
"\\completepublications[criterium=all]"
"")))
(defun muse-context-setup-bibliography ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "\\\\cite.?\\[" nil t)
(concat
"\\usemodule[bibltx]\n\\setupbibtex [database="
(muse-publishing-directive "bibsource") "]")
"")))
(defun muse-context-pdf-browse-file (file)
(shell-command (concat "open " file)))
(defun muse-context-pdf-generate (file output-path final-target)
(apply
#'muse-publish-transform-output
file output-path final-target "PDF"
(function
(lambda (file output-path)
(let* ((fnd (file-name-directory output-path))
(command (format "%s \"%s\""
muse-context-pdf-program
(file-relative-name file fnd)))
(times 0)
(default-directory fnd)
result)
;; XEmacs can sometimes return a non-number result. We'll err
;; on the side of caution by continuing to attempt to generate
;; the PDF if this happens and treat the final result as
;; successful.
(while (and (< times 2)
(or (not (numberp result))
(not (eq result 0))
;; table of contents takes 2 passes
;; (file-readable-p
;; (muse-replace-regexp-in-string
;; "\\.tex\\'" ".toc" file t t))
))
(setq result (shell-command command)
times (1+ times)))
(if (or (not (numberp result))
(eq result 0))
t
nil))))
muse-context-pdf-cruft))
(muse-define-style "context"
:suffix 'muse-context-extension
:regexps 'muse-context-markup-regexps
:functions 'muse-context-markup-functions
:strings 'muse-context-markup-strings
:specials 'muse-context-decide-specials
:after 'muse-context-munge-buffer
:header 'muse-context-header
:footer 'muse-context-footer
:browser 'find-file)
(muse-derive-style "context-pdf" "context"
:final 'muse-context-pdf-generate
:browser 'muse-context-pdf-browse-file
:link-suffix 'muse-context-pdf-extension
:osuffix 'muse-context-pdf-extension)
(muse-derive-style "context-slides" "context"
:header 'muse-context-slides-header
:strings 'muse-context-slides-markup-strings)
(muse-derive-style "context-slides-pdf" "context-pdf"
:header 'muse-context-slides-header
:strings 'muse-context-slides-markup-strings)
(provide 'muse-context)
;;; muse-context.el ends here

352
elpa/muse-3.20/muse-docbook.el
View File

@ -1,352 +0,0 @@
;;; muse-docbook.el --- publish DocBook files
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Contributors:
;; Dale P. Smith (dpsm AT en DOT com) improved the markup
;; significantly and made many valuable suggestions.
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse DocBook XML Publishing
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-publish)
(require 'muse-regexps)
(require 'muse-xml-common)
(defgroup muse-docbook nil
"Options controlling the behavior of Muse DocBook XML publishing.
See `muse-docbook' for more information."
:group 'muse-publish)
(defcustom muse-docbook-extension ".xml"
"Default file extension for publishing DocBook XML files."
:type 'string
:group 'muse-docbook)
(defcustom muse-docbook-header
"<?xml version=\"1.0\" encoding=\"<lisp>
(muse-docbook-encoding)</lisp>\"?>
<!DOCTYPE article PUBLIC \"-//OASIS//DTD DocBook V4.2//EN\"
\"http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd\"<lisp>(muse-docbook-entities)</lisp>>
<article>
<articleinfo>
<title><lisp>(muse-publishing-directive \"title\")</lisp></title>
<author><lisp>(muse-docbook-get-author
(muse-publishing-directive \"author\"))</lisp></author>
<pubdate><lisp>(muse-publishing-directive \"date\")</lisp></pubdate>
</articleinfo>
<!-- Page published by Emacs Muse begins here -->\n"
"Header used for publishing DocBook XML files.
This may be text or a filename."
:type 'string
:group 'muse-docbook)
(defcustom muse-docbook-footer "
<!-- Page published by Emacs Muse ends here -->
<lisp>(muse-docbook-bibliography)</lisp></article>\n"
"Footer used for publishing DocBook XML files.
This may be text or a filename."
:type 'string
:group 'muse-docbook)
(defcustom muse-docbook-markup-regexps
`(;; Beginning of doc, end of doc, or plain paragraph separator
(10000 ,(concat "\\(\\(\n\\(?:[" muse-regexp-blank "]*\n\\)*"
"\\([" muse-regexp-blank "]*\n\\)\\)"
"\\|\\`\\s-*\\|\\s-*\\'\\)")
3 muse-docbook-markup-paragraph))
"List of markup rules for publishing a Muse page to DocBook XML.
For more on the structure of this list, see `muse-publish-markup-regexps'."
:type '(repeat (choice
(list :tag "Markup rule"
integer
(choice regexp symbol)
integer
(choice string function symbol))
function))
:group 'muse-docbook)
(defcustom muse-docbook-markup-functions
'((anchor . muse-xml-markup-anchor)
(table . muse-xml-markup-table))
"An alist of style types to custom functions for that kind of text.
For more on the structure of this list, see
`muse-publish-markup-functions'."
:type '(alist :key-type symbol :value-type function)
:group 'muse-docbook)
(defcustom muse-docbook-markup-strings
'((image-with-desc . "<mediaobject>
<imageobject>
<imagedata fileref=\"%1%.%2%\" format=\"%2%\" />
</imageobject>
<caption><para>%3%</para></caption>
</mediaobject>")
(image . "<inlinemediaobject><imageobject>
<imagedata fileref=\"%1%.%2%\" format=\"%2%\" />
</imageobject></inlinemediaobject>")
(image-link . "<ulink url=\"%1%\"><inlinemediaobject><imageobject>
<imagedata fileref=\"%2%.%3%\" format=\"%3%\" />
</imageobject></inlinemediaobject></ulink>")
(anchor-ref . "<link linkend=\"%s\">%s</link>")
(url . "<ulink url=\"%s\">%s</ulink>")
(link . "<ulink url=\"%s\">%s</ulink>")
(link-and-anchor . "<ulink url=\"%s#%s\">%s</ulink>")
(email-addr . "<email>%s</email>")
(anchor . "<anchor id=\"%s\" />\n")
(emdash . "%s&mdash;%s")
(comment-begin . "<!-- ")
(comment-end . " -->")
(rule . "")
(no-break-space . "&nbsp;")
(enddots . "....")
(dots . "...")
(section . "<section><title>")
(section-end . "</title>")
(subsection . "<section><title>")
(subsection-end . "</title>")
(subsubsection . "<section><title>")
(subsubsection-end . "</title>")
(section-other . "<section><title>")
(section-other-end . "</title>")
(section-close . "</section>")
(footnote . "<footnote><para>")
(footnote-end . "</para></footnote>")
(begin-underline . "")
(end-underline . "")
(begin-literal . "<systemitem>")
(end-literal . "</systemitem>")
(begin-emph . "<emphasis>")
(end-emph . "</emphasis>")
(begin-more-emph . "<emphasis role=\"strong\">")
(end-more-emph . "</emphasis>")
(begin-most-emph . "<emphasis role=\"strong\"><emphasis>")
(end-most-emph . "</emphasis></emphasis>")
(begin-verse . "<literallayout>\n")
(verse-space . " ")
(end-verse . "</literallayout>")
(begin-example . "<programlisting>")
(end-example . "</programlisting>")
(begin-center . "<para role=\"centered\">\n")
(end-center . "\n</para>")
(begin-quote . "<blockquote>\n")
(end-quote . "\n</blockquote>")
(begin-cite . "<citation role=\"%s\">")
(begin-cite-author . "<citation role=\"%s\">A:")
(begin-cite-year . "<citation role=\"%s\">Y:")
(end-cite . "</citation>")
(begin-quote-item . "<para>")
(end-quote-item . "</para>")
(begin-uli . "<itemizedlist mark=\"bullet\">\n")
(end-uli . "\n</itemizedlist>")
(begin-uli-item . "<listitem><para>")
(end-uli-item . "</para></listitem>")
(begin-oli . "<orderedlist>\n")
(end-oli . "\n</orderedlist>")
(begin-oli-item . "<listitem><para>")
(end-oli-item . "</para></listitem>")
(begin-dl . "<variablelist>\n")
(end-dl . "\n</variablelist>")
(begin-dl-item . "<varlistentry>\n")
(end-dl-item . "\n</varlistentry>")
(begin-ddt . "<term>")
(end-ddt . "</term>")
(begin-dde . "<listitem><para>")
(end-dde . "</para></listitem>")
(begin-table . "<informaltable>\n")
(end-table . "</informaltable>")
(begin-table-group . " <tgroup cols='%s'>\n")
(end-table-group . " </tgroup>\n")
(begin-table-row . " <row>\n")
(end-table-row . " </row>\n")
(begin-table-entry . " <entry>")
(end-table-entry . "</entry>\n"))
"Strings used for marking up text.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles."
:type '(alist :key-type symbol :value-type string)
:group 'muse-docbook)
(defcustom muse-docbook-encoding-default 'utf-8
"The default Emacs buffer encoding to use in published files.
This will be used if no special characters are found."
:type 'symbol
:group 'muse-docbook)
(defcustom muse-docbook-charset-default "utf-8"
"The default DocBook XML charset to use if no translation is
found in `muse-docbook-encoding-map'."
:type 'string
:group 'muse-docbook)
(defun muse-docbook-encoding ()
(muse-xml-transform-content-type
(or (and (boundp 'buffer-file-coding-system)
buffer-file-coding-system)
muse-docbook-encoding-default)
muse-docbook-charset-default))
(defun muse-docbook-markup-paragraph ()
(catch 'bail-out
(let ((end (copy-marker (match-end 0) t)))
(goto-char (match-beginning 0))
(when (save-excursion
(save-match-data
(and (not (get-text-property (max (point-min) (1- (point)))
'muse-no-paragraph))
(re-search-backward
"<\\(/?\\)\\(para\\|footnote\\|literallayout\\)[ >]"
nil t)
(cond ((string= (match-string 2) "literallayout")
(and (not (string= (match-string 1) "/"))
(throw 'bail-out t)))
((string= (match-string 2) "para")
(and
(not (string= (match-string 1) "/"))
;; don't mess up nested lists
(not (and (muse-looking-back "<listitem>")
(throw 'bail-out t)))))
((string= (match-string 2) "footnote")
(string= (match-string 1) "/"))
(t nil)))))
(when (get-text-property (1- (point)) 'muse-end-list)
(goto-char (previous-single-property-change (1- (point))
'muse-end-list)))
(muse-insert-markup "</para>"))
(goto-char end))
(cond
((eobp)
(unless (bolp)
(insert "\n")))
((get-text-property (point) 'muse-no-paragraph)
(forward-char 1)
nil)
((eq (char-after) ?\<)
(when (looking-at (concat "<\\(emphasis\\|systemitem\\|inlinemediaobject"
"\\|u?link\\|anchor\\|email\\)[ >]"))
(muse-insert-markup "<para>")))
(t
(muse-insert-markup "<para>")))))
(defun muse-docbook-get-author (&optional author)
"Split the AUTHOR directive into separate fields.
AUTHOR should be of the form: \"Firstname Other Names Lastname\",
and anything after `Firstname' is optional."
(setq author (save-match-data (split-string author)))
(let ((num-el (length author)))
(cond ((eq num-el 1)
(concat "<firstname>" (car author) "</firstname>"))
((eq num-el 2)
(concat "<firstname>" (nth 0 author) "</firstname>"
"<surname>" (nth 1 author) "</surname>"))
((eq num-el 3)
(concat "<firstname>" (nth 0 author) "</firstname>"
"<othername>" (nth 1 author) "</othername>"
"<surname>" (nth 2 author) "</surname>"))
(t
(let (first last)
(setq first (car author))
(setq author (nreverse (cdr author)))
(setq last (car author))
(setq author (nreverse (cdr author)))
(concat "<firstname>" first "</firstname>"
"<othername>"
(mapconcat 'identity author " ")
"</othername>"
"<surname>" last "</surname>"))))))
(defun muse-docbook-fixup-images ()
(goto-char (point-min))
(while (re-search-forward (concat "<imagedata fileref=\"[^\"]+\""
" format=\"\\([^\"]+\\)\" />$")
nil t)
(replace-match (upcase (match-string 1)) t t nil 1)))
(defun muse-docbook-fixup-citations ()
;; remove the role attribute if there is no role
(goto-char (point-min))
(while (re-search-forward "<\\(citation role=\"nil\"\\)>" nil t)
(replace-match "citation" t t nil 1))
;; replace colons in multi-head citations with semicolons
(goto-char (point-min))
(while (re-search-forward "<citation.*>" nil t)
(let ((start (point))
(end (re-search-forward "</citation>")))
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
(while (re-search-forward "," nil t)
(replace-match ";"))))))
(defun muse-docbook-munge-buffer ()
(muse-docbook-fixup-images)
(muse-docbook-fixup-citations))
(defun muse-docbook-entities ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "<citation" nil t)
(concat
" [\n<!ENTITY bibliography SYSTEM \""
(if (string-match ".short$" (muse-page-name))
(substring (muse-page-name) 0 -6)
(muse-page-name))
".bib.xml\">\n]")
"")))
(defun muse-docbook-bibliography ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "<citation" nil t)
"&bibliography;\n"
"")))
(defun muse-docbook-finalize-buffer ()
(when (boundp 'buffer-file-coding-system)
(when (memq buffer-file-coding-system '(no-conversion undecided-unix))
;; make it agree with the default charset
(setq buffer-file-coding-system muse-docbook-encoding-default))))
;;; Register the Muse DocBook XML Publisher
(muse-define-style "docbook"
:suffix 'muse-docbook-extension
:regexps 'muse-docbook-markup-regexps
:functions 'muse-docbook-markup-functions
:strings 'muse-docbook-markup-strings
:specials 'muse-xml-decide-specials
:before-end 'muse-docbook-munge-buffer
:after 'muse-docbook-finalize-buffer
:header 'muse-docbook-header
:footer 'muse-docbook-footer
:browser 'find-file)
(provide 'muse-docbook)
;;; muse-docbook.el ends here

274
elpa/muse-3.20/muse-groff.el
View File

@ -1,274 +0,0 @@
;;; muse-groff.el --- publish groff -mom -mwww files
;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Andrew J. Korty (ajk AT iu DOT edu)
;; Date: Tue 5-Jul-2005
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Contributors:
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse Publishing Using groff -mom -mwww
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-publish)
(defgroup muse-groff nil
"Rules for marking up a Muse file with groff -mom -mwww macros."
:group 'muse-publish)
(defcustom muse-groff-extension ".groff"
"Default file extension for publishing groff -mom -mwww files."
:type 'string
:group 'muse-groff)
(defcustom muse-groff-pdf-extension ".pdf"
"Default file extension for publishing groff -mom -mwww files to PDF."
:type 'string
:group 'muse-groff)
(defcustom muse-groff-header
".TITLE \"<lisp>(muse-publishing-directive \"title\")</lisp>\"
.SUBTITLE \"<lisp>(muse-publishing-directive \"date\")</lisp>\"
.AUTHOR \"<lisp>(muse-publishing-directive \"author\")</lisp>\"
.PRINTSTYLE TYPESET
.de list
. LIST \\$1
. SHIFT_LIST \\$2
..
.PARA_INDENT 0
.START
<lisp>(and muse-publish-generate-contents \".TOC\n\")</lisp>\n"
"Header used for publishing groff -mom -mwww files."
:type '(choice string file)
:group 'muse-groff)
(defcustom muse-groff-footer " "
"Footer used for publishing groff -mom -mwww files."
:type '(choice string file)
:group 'muse-groff)
(defcustom muse-groff-markup-regexps
`((10400 ,(concat "\\(\n</\\(blockquote\\|center\\)>\\)?\n"
"\\(["
muse-regexp-blank
"]*\n\\)+\\(<\\(blockquote\\|center\\)>\n\\)?")
0 muse-groff-markup-paragraph))
"List of markup regexps for identifying regions in a Muse page.
For more on the structure of this list, see `muse-publish-markup-regexps'."
:type '(repeat (choice
(list :tag "Markup rule"
integer
(choice regexp symbol)
integer
(choice string function symbol))
function))
:group 'muse-groff)
(defcustom muse-groff-markup-functions
'((table . muse-groff-markup-table))
"An alist of style types to custom functions for that kind of text.
For more on the structure of this list, see
`muse-publish-markup-functions'."
:type '(alist :key-type symbol :value-type function)
:group 'muse-groff)
(defcustom muse-groff-markup-tags
'()
"A list of tag specifications, for specially marking up GROFF."
:type '(repeat (list (string :tag "Markup tag")
(boolean :tag "Expect closing tag" :value t)
(boolean :tag "Parse attributes" :value nil)
(boolean :tag "Nestable" :value nil)
function))
:group 'muse-groff)
(defcustom muse-groff-markup-strings
`((image-with-desc . "\n.MPIMG -R %s.%s\n")
(image . "\n.MPIMG -R %s.%s\n")
(image-link . "\n.\\\" %s\n.MPIMG -R %s.%s")
(url . "\n.URL %s %s\n\\z")
(link . "\n.URL %s %s\n\\z")
(email-addr . "\f[C]%s\f[]")
(emdash . "\\(em")
(rule . "\n.RULE\n")
(no-break-space . "\\h")
(line-break . "\\p")
(enddots . "....")
(dots . "...")
;; (part . "\\part{")
;; (part-end . "}")
;; (chapter . "\\chapter{")
;; (chapter-end . "}")
(section . ".HEAD \"")
(section-end . "\"")
(subsection . ".SUBHEAD \"")
(subsection-end . "\"")
(subsubsection . ".PARAHEAD \"")
(subsubsection-end . "\"")
;; (footnote . "\\c\n.FOOTNOTE\n")
;; (footnote-end . "\n.FOOTNOTE OFF\n")
;; (footnotemark . "\\footnotemark[%d]")
;; (footnotetext . "\\footnotetext[%d]{")
;; (footnotetext-end . "}")
(begin-underline . "\n.UNDERSCORE \"")
(end-underline . "\"\n")
(begin-literal . "\\fC")
(end-literal . "\\fP")
(begin-emph . "\\fI")
(end-emph . "\\fP")
(begin-more-emph . "\\fB")
(end-more-emph . "\\fP")
(begin-most-emph . "\\f(BI")
(end-most-emph . "\\fP")
(begin-verse . ".QUOTE")
(end-verse . ".QUOTE OFF")
(begin-center . "\n.CENTER\n")
(end-center . "\n.QUAD L\n")
(begin-example . ,(concat
".QUOTE_FONT CR\n.QUOTE_INDENT 1\n"".QUOTE_SIZE -2\n"
".UNDERLINE_QUOTES OFF\n.QUOTE"))
(end-example . ".QUOTE OFF")
(begin-quote . ".BLOCKQUOTE")
(end-quote . ".BLOCKQUOTE OFF")
(begin-cite . "")
(begin-cite-author . "")
(begin-cite-year . "")
(end-cite . "")
(begin-uli . ".list BULLET\n.SHIFT_LIST 2m\n.ITEM\n")
(end-uli . "\n.LIST OFF")
(begin-oli . ".list DIGIT\n.SHIFT_LIST 2m\n.ITEM\n")
(end-oli . "\n.LIST OFF")
(begin-ddt . "\\fB")
(begin-dde . "\\fP\n.IR 4P\n")
(end-ddt . ".IRX CLEAR"))
"Strings used for marking up text.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles."
:type '(alist :key-type symbol :value-type string)
:group 'muse-groff)
(defcustom muse-groff-markup-specials
'((?\\ . "\\e"))
"A table of characters which must be represented specially."
:type '(alist :key-type character :value-type string)
:group 'muse-groff)
(defun muse-groff-markup-paragraph ()
(let ((end (copy-marker (match-end 0) t)))
(goto-char (1+ (match-beginning 0)))
(delete-region (point) end)
(unless (looking-at "\.\\(\\(\\(SUB\\|PARA\\)?HEAD \\)\\|RULE$\\)")
(muse-insert-markup ".ALD .5v\n.PP\n.ne 2\n"))))
(defun muse-groff-protect-leading-chars ()
"Protect leading periods and apostrophes from being interpreted as
command characters."
(while (re-search-forward "^[.']" nil t)
(replace-match "\\\\&\\&" t)))
(defun muse-groff-concat-lists ()
"Join like lists."
(let ((type "")
arg begin)
(while (re-search-forward "^\.LIST[ \t]+\\(.*\\)\n" nil t)
(setq arg (match-string 1))
(if (string= arg "OFF")
(setq begin (match-beginning 0))
(if (and begin (string= type arg))
(delete-region begin (match-end 0))
(setq type arg
begin 0))))))
(defun muse-groff-fixup-dquotes ()
"Fixup double quotes."
(let ((open t))
(while (search-forward "\"" nil t)
(unless (get-text-property (match-beginning 0) 'read-only)
(if (and (bolp) (eq (char-before) ?\n))
(setq open t))
(if open
(progn
(replace-match "``")
(setq open nil))
(replace-match "''")
(setq open t))))))
(defun muse-groff-prepare-buffer ()
(goto-char (point-min))
(muse-groff-protect-leading-chars))
(defun muse-groff-munge-buffer ()
(goto-char (point-min))
(muse-groff-concat-lists))
(defun muse-groff-pdf-browse-file (file)
(shell-command (concat "open " file)))
(defun muse-groff-pdf-generate (file output-path final-target)
(muse-publish-transform-output
file output-path final-target "PDF"
(function
(lambda (file output-path)
(let ((command
(format
(concat "file=%s; ext=%s; cd %s && cp $file$ext $file.ref && "
"groff -mom -mwww -t $file$ext > $file.ps && "
"pstopdf $file.ps")
(file-name-sans-extension file)
muse-groff-extension
(file-name-directory output-path))))
(shell-command command))))
".ps"))
;;; Register the Muse GROFF Publisher
(muse-define-style "groff"
:suffix 'muse-groff-extension
:regexps 'muse-groff-markup-regexps
;;; :functions 'muse-groff-markup-functions
:strings 'muse-groff-markup-strings
:tags 'muse-groff-markup-tags
:specials 'muse-groff-markup-specials
:before 'muse-groff-prepare-buffer
:before-end 'muse-groff-munge-buffer
:header 'muse-groff-header
:footer 'muse-groff-footer
:browser 'find-file)
(muse-derive-style "groff-pdf" "groff"
:final 'muse-groff-pdf-generate
:browser 'muse-groff-pdf-browse-file
:osuffix 'muse-groff-pdf-extension)
(provide 'muse-groff)
;;; muse-groff.el ends here
;;
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

754
elpa/muse-3.20/muse-html.el
View File

@ -1,754 +0,0 @@
;;; muse-html.el --- publish to HTML and XHTML
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Contributors:
;; Zhiqiang Ye (yezq AT mail DOT cbi DOT pku DOT edu DOT cn) suggested
;; appending an 'encoding="..."' fragment to the first line of the
;; sample publishing header so that when editing the resulting XHTML
;; file, Emacs would use the proper encoding.
;; Sun Jiyang (sunyijiang AT gmail DOT com) came up with the idea for
;; the <src> tag and provided an implementation for emacs-wiki.
;; Charles Wang (wcy123 AT gmail DOT com) provided an initial
;; implementation of the <src> tag for Muse.
;; Clinton Ebadi (clinton AT unknownlamer DOT org) provided further
;; ideas for the implementation of the <src> tag.
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse HTML Publishing
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-publish)
(require 'muse-regexps)
(require 'muse-xml-common)
(defgroup muse-html nil
"Options controlling the behavior of Muse HTML publishing."
:group 'muse-publish)
(defcustom muse-html-extension ".html"
"Default file extension for publishing HTML files."
:type 'string
:group 'muse-html)
(defcustom muse-xhtml-extension ".html"
"Default file extension for publishing XHTML files."
:type 'string
:group 'muse-html)
(defcustom muse-html-style-sheet
"<style type=\"text/css\">
body {
background: white; color: black;
margin-left: 3%; margin-right: 7%;
}
p { margin-top: 1% }
p.verse { margin-left: 3% }
.example { margin-left: 3% }
h2 {
margin-top: 25px;
margin-bottom: 0px;
}
h3 { margin-bottom: 0px; }
</style>"
"Store your stylesheet definitions here.
This is used in `muse-html-header'.
You can put raw CSS in here or a <link> tag to an external stylesheet.
This text may contain <lisp> markup tags.
An example of using <link> is as follows.
<link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\" href=\"/default.css\">"
:type 'string
:group 'muse-html)
(defcustom muse-xhtml-style-sheet
"<style type=\"text/css\">
body {
background: white; color: black;
margin-left: 3%; margin-right: 7%;
}
p { margin-top: 1% }
p.verse { margin-left: 3% }
.example { margin-left: 3% }
h2 {
margin-top: 25px;
margin-bottom: 0px;
}
h3 { margin-bottom: 0px; }
</style>"
"Store your stylesheet definitions here.
This is used in `muse-xhtml-header'.
You can put raw CSS in here or a <link> tag to an external stylesheet.
This text may contain <lisp> markup tags.
An example of using <link> is as follows.
<link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\" href=\"/default.css\" />"
:type 'string
:group 'muse-html)
(defcustom muse-html-header
"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">
<html>
<head>
<title><lisp>
(concat (muse-publishing-directive \"title\")
(let ((author (muse-publishing-directive \"author\")))
(if (not (string= author (user-full-name)))
(concat \" (by \" author \")\"))))</lisp></title>
<meta name=\"generator\" content=\"muse.el\">
<meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\"
content=\"<lisp>muse-html-meta-content-type</lisp>\">
<lisp>
(let ((maintainer (muse-style-element :maintainer)))
(when maintainer
(concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\">\")))
</lisp><lisp>
(muse-style-element :style-sheet muse-publishing-current-style)
</lisp>
</head>
<body>
<h1><lisp>
(concat (muse-publishing-directive \"title\")
(let ((author (muse-publishing-directive \"author\")))
(if (not (string= author (user-full-name)))
(concat \" (by \" author \")\"))))</lisp></h1>
<!-- Page published by Emacs Muse begins here -->\n"
"Header used for publishing HTML files. This may be text or a filename."
:type 'string
:group 'muse-html)
(defcustom muse-html-footer "
<!-- Page published by Emacs Muse ends here -->
</body>
</html>\n"
"Footer used for publishing HTML files. This may be text or a filename."
:type 'string
:group 'muse-html)
(defcustom muse-xhtml-header
"<?xml version=\"1.0\" encoding=\"<lisp>
(muse-html-encoding)</lisp>\"?>
<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
<html xmlns=\"http://www.w3.org/1999/xhtml\">
<head>
<title><lisp>
(concat (muse-publishing-directive \"title\")
(let ((author (muse-publishing-directive \"author\")))
(if (not (string= author (user-full-name)))
(concat \" (by \" author \")\"))))</lisp></title>
<meta name=\"generator\" content=\"muse.el\" />
<meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\"
content=\"<lisp>muse-html-meta-content-type</lisp>\" />
<lisp>
(let ((maintainer (muse-style-element :maintainer)))
(when maintainer
(concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\" />\")))
</lisp><lisp>
(muse-style-element :style-sheet muse-publishing-current-style)
</lisp>
</head>
<body>
<h1><lisp>
(concat (muse-publishing-directive \"title\")
(let ((author (muse-publishing-directive \"author\")))
(if (not (string= author (user-full-name)))
(concat \" (by \" author \")\"))))</lisp></h1>
<!-- Page published by Emacs Muse begins here -->\n"
"Header used for publishing XHTML files. This may be text or a filename."
:type 'string
:group 'muse-html)
(defcustom muse-xhtml-footer "
<!-- Page published by Emacs Muse ends here -->
</body>
</html>\n"
"Footer used for publishing XHTML files. This may be text or a filename."
:type 'string
:group 'muse-html)
(defcustom muse-html-anchor-on-word nil
"When true, anchors surround the closest word. This allows you
to select them in a browser (i.e. for pasting), but has the
side-effect of marking up headers in multiple colors if your
header style is different from your link style."
:type 'boolean
:group 'muse-html)
(defcustom muse-html-table-attributes
" class=\"muse-table\" border=\"2\" cellpadding=\"5\""
"The attribute to be used with HTML <table> tags.
Note that Muse supports insertion of raw HTML tags, as long
as you wrap the region in <literal></literal>."
:type 'string
:group 'muse-html)
(defcustom muse-html-markup-regexps
`(;; Beginning of doc, end of doc, or plain paragraph separator
(10000 ,(concat "\\(\\(\n\\(?:[" muse-regexp-blank "]*\n\\)*"
"\\([" muse-regexp-blank "]*\n\\)\\)"
"\\|\\`\\s-*\\|\\s-*\\'\\)")
;; this is somewhat repetitive because we only require the
;; line just before the paragraph beginning to be not
;; read-only
3 muse-html-markup-paragraph))
"List of markup rules for publishing a Muse page to HTML.
For more on the structure of this list, see `muse-publish-markup-regexps'."
:type '(repeat (choice
(list :tag "Markup rule"
integer
(choice regexp symbol)
integer
(choice string function symbol))
function))
:group 'muse-html)
(defcustom muse-html-markup-functions
'((anchor . muse-html-markup-anchor)
(table . muse-html-markup-table)
(footnote . muse-html-markup-footnote))
"An alist of style types to custom functions for that kind of text.
For more on the structure of this list, see
`muse-publish-markup-functions'."
:type '(alist :key-type symbol :value-type function)
:group 'muse-html)
(defcustom muse-html-markup-strings
'((image-with-desc . "<table class=\"image\" width=\"100%%\">
<tr><td align=\"center\"><img src=\"%1%.%2%\" alt=\"%3%\"></td></tr>
<tr><td align=\"center\" class=\"image-caption\">%3%</td></tr>
</table>")
(image . "<img src=\"%s.%s\" alt=\"\">")
(image-link . "<a class=\"image-link\" href=\"%s\">
<img src=\"%s.%s\"></a>")
(anchor-ref . "<a href=\"#%s\">%s</a>")
(url . "<a href=\"%s\">%s</a>")
(link . "<a href=\"%s\">%s</a>")
(link-and-anchor . "<a href=\"%s#%s\">%s</a>")
(email-addr . "<a href=\"mailto:%s\">%s</a>")
(anchor . "<a name=\"%1%\" id=\"%1%\">")
(emdash . "%s&mdash;%s")
(comment-begin . "<!-- ")
(comment-end . " -->")
(rule . "<hr>")
(fn-sep . "<hr>\n")
(no-break-space . "&nbsp;")
(line-break . "<br>")
(enddots . "....")
(dots . "...")
(section . "<h2>")
(section-end . "</h2>")
(subsection . "<h3>")
(subsection-end . "</h3>")
(subsubsection . "<h4>")
(subsubsection-end . "</h4>")
(section-other . "<h5>")
(section-other-end . "</h5>")
(begin-underline . "<u>")
(end-underline . "</u>")
(begin-literal . "<code>")
(end-literal . "</code>")
(begin-cite . "<span class=\"citation\">")
(begin-cite-author . "<span class=\"citation-author\">")
(begin-cite-year . "<span class=\"citation-year\">")
(end-cite . "</span>")
(begin-emph . "<em>")
(end-emph . "</em>")
(begin-more-emph . "<strong>")
(end-more-emph . "</strong>")
(begin-most-emph . "<strong><em>")
(end-most-emph . "</em></strong>")
(begin-verse . "<p class=\"verse\">\n")
(verse-space . "&nbsp;&nbsp;")
(end-verse-line . "<br>")
(end-last-stanza-line . "<br>")
(empty-verse-line . "<br>")
(end-verse . "</p>")
(begin-example . "<pre class=\"example\">")
(end-example . "</pre>")
(begin-center . "<center>\n<p>")
(end-center . "</p>\n</center>")
(begin-quote . "<blockquote>\n")
(end-quote . "\n</blockquote>")
(begin-quote-item . "<p class=\"quoted\">")
(end-quote-item . "</p>")
(begin-uli . "<ul>\n")
(end-uli . "\n</ul>")
(begin-uli-item . "<li>")
(end-uli-item . "</li>")
(begin-oli . "<ol>\n")
(end-oli . "\n</ol>")
(begin-oli-item . "<li>")
(end-oli-item . "</li>")
(begin-dl . "<dl>\n")
(end-dl . "\n</dl>")
(begin-ddt . "<dt><strong>")
(end-ddt . "</strong></dt>")
(begin-dde . "<dd>")
(end-dde . "</dd>")
(begin-table . "<table%s>\n")
(end-table . "</table>")
(begin-table-row . " <tr>\n")
(end-table-row . " </tr>\n")
(begin-table-entry . " <%s>")
(end-table-entry . "</%s>\n"))
"Strings used for marking up text as HTML.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles."
:type '(alist :key-type symbol :value-type string)
:group 'muse-html)
(defcustom muse-xhtml-markup-strings
'((image-with-desc . "<table class=\"image\" width=\"100%%\">
<tr><td align=\"center\"><img src=\"%1%.%2%\" alt=\"%3%\" /></td></tr>
<tr><td align=\"center\" class=\"image-caption\">%3%</td></tr>
</table>")
(image . "<img src=\"%s.%s\" alt=\"\" />")
(image-link . "<a class=\"image-link\" href=\"%s\">
<img src=\"%s.%s\" alt=\"\" /></a>")
(rule . "<hr />")
(fn-sep . "<hr />\n")
(line-break . "<br />")
(begin-underline . "<span style=\"text-decoration: underline;\">")
(end-underline . "</span>")
(begin-center . "<p style=\"text-align: center;\">\n")
(end-center . "\n</p>")
(end-verse-line . "<br />")
(end-last-stanza-line . "<br />")
(empty-verse-line . "<br />"))
"Strings used for marking up text as XHTML.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles.
If a markup rule is not found here, `muse-html-markup-strings' is
searched."
:type '(alist :key-type symbol :value-type string)
:group 'muse-html)
(defcustom muse-xhtml1.1-markup-strings
'((anchor . "<a id=\"%s\">"))
"Strings used for marking up text as XHTML 1.1.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles.
If a markup rule is not found here, `muse-xhtml-markup-strings'
and `muse-html-markup-strings' are searched."
:type '(alist :key-type symbol :value-type string)
:group 'muse-html)
(defcustom muse-html-markup-tags
'(("class" t t t muse-html-class-tag)
("div" t t t muse-html-div-tag)
("src" t t nil muse-html-src-tag))
"A list of tag specifications, for specially marking up HTML."
:type '(repeat (list (string :tag "Markup tag")
(boolean :tag "Expect closing tag" :value t)
(boolean :tag "Parse attributes" :value nil)
(boolean :tag "Nestable" :value nil)
function))
:group 'muse-html)
(defcustom muse-html-meta-http-equiv "Content-Type"
"The http-equiv attribute used for the HTML <meta> tag."
:type 'string
:group 'muse-html)
(defcustom muse-html-meta-content-type "text/html"
"The content type used for the HTML <meta> tag.
If you are striving for XHTML 1.1 compliance, you may want to
change this to \"application/xhtml+xml\"."
:type 'string
:group 'muse-html)
(defcustom muse-html-meta-content-encoding (if (featurep 'mule)
'detect
"iso-8859-1")
"The charset to append to the HTML <meta> tag.
If set to the symbol 'detect, use `muse-html-encoding-map' to try
and determine the HTML charset from emacs's coding. If set to a
string, this string will be used to force a particular charset"
:type '(choice string symbol)
:group 'muse-html)
(defcustom muse-html-encoding-default 'iso-8859-1
"The default Emacs buffer encoding to use in published files.
This will be used if no special characters are found."
:type 'symbol
:group 'muse-html)
(defcustom muse-html-charset-default "iso-8859-1"
"The default HTML meta charset to use if no translation is found in
`muse-html-encoding-map'."
:type 'string
:group 'muse-html)
(defcustom muse-html-src-allowed-modes t
"Modes that we allow the <src> tag to colorize.
If t, permit the <src> tag to colorize any mode.
If a list of mode names, such as '(\"html\" \"latex\"), and the
lang argument to <src> is not in the list, then use fundamental
mode instead."
:type '(choice (const :tag "Any" t)
(repeat (string :tag "Mode")))
:group 'muse-html)
(defun muse-html-insert-anchor (anchor)
"Insert an anchor, either around the word at point, or within a tag."
(skip-chars-forward (concat muse-regexp-blank "\n"))
(if (looking-at (concat "<\\([^" muse-regexp-blank "/>\n]+\\)>"))
(let ((tag (match-string 1)))
(goto-char (match-end 0))
(muse-insert-markup (muse-markup-text 'anchor anchor))
(when muse-html-anchor-on-word
(or (and (search-forward (format "</%s>" tag)
(muse-line-end-position) t)
(goto-char (match-beginning 0)))
(forward-word 1)))
(muse-insert-markup "</a>"))
(muse-insert-markup (muse-markup-text 'anchor anchor))
(when muse-html-anchor-on-word
(forward-word 1))
(muse-insert-markup "</a>\n")))
(defun muse-html-markup-anchor ()
(unless (get-text-property (match-end 1) 'muse-link)
(save-match-data
(muse-html-insert-anchor (match-string 2)))
(match-string 1)))
(defun muse-html-markup-paragraph ()
(let ((end (copy-marker (match-end 0) t)))
(goto-char (match-beginning 0))
(when (save-excursion
(save-match-data
(and (not (get-text-property (max (point-min) (1- (point)))
'muse-no-paragraph))
(re-search-backward "<\\(/?\\)p[ >]" nil t)
(not (string-equal (match-string 1) "/")))))
(when (get-text-property (1- (point)) 'muse-end-list)
(goto-char (previous-single-property-change (1- (point))
'muse-end-list)))
(muse-insert-markup "</p>"))
(goto-char end))
(cond
((eobp)
(unless (bolp)
(insert "\n")))
((get-text-property (point) 'muse-no-paragraph)
(forward-char 1)
nil)
((eq (char-after) ?\<)
(cond
((looking-at "<\\(em\\|strong\\|code\\|span\\)[ >]")
(muse-insert-markup "<p>"))
((looking-at "<a ")
(if (looking-at "<a[^>\n]+><img")
(muse-insert-markup "<p class=\"image-link\">")
(muse-insert-markup "<p>")))
((looking-at "<img[ >]")
(muse-insert-markup "<p class=\"image\">"))
(t
(forward-char 1)
nil)))
((muse-looking-back "\\(</h[1-4]>\\|<hr>\\)\n\n")
(muse-insert-markup "<p class=\"first\">"))
(t
(muse-insert-markup "<p>"))))
(defun muse-html-markup-footnote ()
(cond
((get-text-property (match-beginning 0) 'muse-link)
nil)
((= (muse-line-beginning-position) (match-beginning 0))
(prog1
(let ((text (match-string 1)))
(muse-insert-markup
(concat "<p class=\"footnote\">"
"<a class=\"footnum\" name=\"fn." text
"\" href=\"#fnr." text "\">"
text ".</a>")))
(save-excursion
(save-match-data
(let* ((beg (goto-char (match-end 0)))
(end (and (search-forward "\n\n" nil t)
(prog1
(copy-marker (match-beginning 0))
(goto-char beg)))))
(while (re-search-forward (concat "^["
muse-regexp-blank
"]+\\([^\n]\\)")
end t)
(replace-match "\\1" t)))))
(replace-match "")))
(t (let ((text (match-string 1)))
(muse-insert-markup
(concat "<sup><a class=\"footref\" name=\"fnr." text
"\" href=\"#fn." text "\">"
text "</a></sup>")))
(replace-match ""))))
(defun muse-html-markup-table ()
(muse-xml-markup-table muse-html-table-attributes))
;; Handling of tags for HTML
(defun muse-html-strip-links (string)
"Remove all HTML links from STRING."
(muse-replace-regexp-in-string "\\(<a .*?>\\|</a>\\)" "" string nil t))
(defun muse-html-insert-contents (depth)
"Scan the current document and generate a table of contents at point.
DEPTH indicates how many levels of headings to include. The default is 2."
(let ((max-depth (or depth 2))
(index 1)
base contents l end)
(save-excursion
(goto-char (point-min))
(search-forward "Page published by Emacs Muse begins here" nil t)
(catch 'done
(while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t)
(unless (and (get-text-property (point) 'read-only)
(not (get-text-property (match-beginning 0)
'muse-contents)))
(remove-text-properties (match-beginning 0) (match-end 0)
'(muse-contents nil))
(setq l (1- (string-to-number (match-string 1))))
(if (null base)
(setq base l)
(if (< l base)
(throw 'done t)))
(when (<= l max-depth)
;; escape specials now before copying the text, so that we
;; can deal sanely with both emphasis in titles and
;; special characters
(goto-char (match-end 2))
(setq end (point-marker))
(muse-publish-escape-specials (match-beginning 2) end
nil 'document)
(muse-publish-mark-read-only (match-beginning 2) end)
(setq contents (cons (cons l (buffer-substring-no-properties
(match-beginning 2) end))
contents))
(set-marker end nil)
(goto-char (match-beginning 2))
(muse-html-insert-anchor (concat "sec" (int-to-string index)))
(setq index (1+ index)))))))
(setq index 1 contents (nreverse contents))
(let ((depth 1) (sub-open 0) (p (point)))
(muse-insert-markup "<div class=\"contents\">\n<dl>\n")
(while contents
(muse-insert-markup "<dt>\n"
"<a href=\"#sec" (int-to-string index) "\">"
(muse-html-strip-links (cdar contents))
"</a>\n"
"</dt>\n")
(setq index (1+ index)
depth (caar contents)
contents (cdr contents))
(when contents
(cond
((< (caar contents) depth)
(let ((idx (caar contents)))
(while (< idx depth)
(muse-insert-markup "</dl>\n</dd>\n")
(setq sub-open (1- sub-open)
idx (1+ idx)))))
((> (caar contents) depth) ; can't jump more than one ahead
(muse-insert-markup "<dd>\n<dl>\n")
(setq sub-open (1+ sub-open))))))
(while (> sub-open 0)
(muse-insert-markup "</dl>\n</dd>\n")
(setq sub-open (1- sub-open)))
(muse-insert-markup "</dl>\n</div>\n")
(muse-publish-mark-read-only p (point)))))
(defun muse-html-denote-headings ()
"Place a text property on any headings in the current buffer.
This allows the headings to be picked up later on if publishing a
table of contents."
(save-excursion
(goto-char (point-min))
(search-forward "Page published by Emacs Muse begins here" nil t)
(while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t)
(unless (get-text-property (point) 'read-only)
(add-text-properties (match-beginning 0) (match-end 0)
'(muse-contents t))))))
(defun muse-html-class-tag (beg end attrs)
(let ((name (cdr (assoc "name" attrs))))
(when name
(goto-char beg)
(muse-insert-markup "<span class=\"" name "\">")
(save-excursion
(goto-char end)
(muse-insert-markup "</span>")))))
(defun muse-html-div-tag (beg end attrs)
"Publish a <div> tag for HTML."
(let ((id (cdr (assoc "id" attrs)))
(style (cdr (assoc "style" attrs))))
(when (or id style)
(goto-char beg)
(if (null id)
(muse-insert-markup "<div style=\"" style "\">")
(muse-insert-markup "<div id=\"" id "\">"))
(save-excursion
(goto-char end)
(muse-insert-markup "</div>")))))
(defun muse-html-src-tag (beg end attrs)
"Publish the region using htmlize.
The language to use may be specified by the \"lang\" attribute.
Muse will look for a function named LANG-mode, where LANG is the
value of the \"lang\" attribute.
This tag requires htmlize 1.34 or later in order to work."
(if (condition-case nil
(progn
(require 'htmlize)
(if (fboundp 'htmlize-region-for-paste)
nil
(muse-display-warning
(concat "The `htmlize-region-for-paste' function was not"
" found.\nThis is available in htmlize.el 1.34"
" or later."))
t))
(error nil t))
;; if htmlize.el was not found, treat this like an example tag
(muse-publish-example-tag beg end)
(muse-publish-ensure-block beg end)
(let* ((lang (cdr (assoc "lang" attrs)))
(mode (or (and (not (eq muse-html-src-allowed-modes t))
(not (member lang muse-html-src-allowed-modes))
'fundamental-mode)
(intern-soft (concat lang "-mode"))))
(text (muse-delete-and-extract-region beg end))
(htmltext
(with-temp-buffer
(insert text)
(if (functionp mode)
(funcall mode)
(fundamental-mode))
(font-lock-fontify-buffer)
;; silence the byte-compiler
(when (fboundp 'htmlize-region-for-paste)
;; transform the region to HTML
(htmlize-region-for-paste (point-min) (point-max))))))
(save-restriction
(narrow-to-region (point) (point))
(insert htmltext)
(goto-char (point-min))
(re-search-forward "<pre\\([^>]*\\)>\n?" nil t)
(replace-match "<pre class=\"src\">")
(goto-char (point-max))
(muse-publish-mark-read-only (point-min) (point-max))))))
;; Register the Muse HTML Publisher
(defun muse-html-browse-file (file)
(browse-url (concat "file:" file)))
(defun muse-html-encoding ()
(if (stringp muse-html-meta-content-encoding)
muse-html-meta-content-encoding
(muse-xml-transform-content-type
(or (and (boundp 'buffer-file-coding-system)
buffer-file-coding-system)
muse-html-encoding-default)
muse-html-charset-default)))
(defun muse-html-prepare-buffer ()
(make-local-variable 'muse-html-meta-http-equiv)
(set (make-local-variable 'muse-html-meta-content-type)
(if (save-match-data
(string-match "charset=" muse-html-meta-content-type))
muse-html-meta-content-type
(concat muse-html-meta-content-type "; charset="
(muse-html-encoding)))))
(defun muse-html-munge-buffer ()
(if muse-publish-generate-contents
(progn
(goto-char (car muse-publish-generate-contents))
(muse-html-insert-contents (cdr muse-publish-generate-contents))
(setq muse-publish-generate-contents nil))
(muse-html-denote-headings)))
(defun muse-html-finalize-buffer ()
(when (and (boundp 'buffer-file-coding-system)
(memq buffer-file-coding-system '(no-conversion undecided-unix)))
;; make it agree with the default charset
(setq buffer-file-coding-system muse-html-encoding-default)))
;;; Register the Muse HTML and XHTML Publishers
(muse-define-style "html"
:suffix 'muse-html-extension
:regexps 'muse-html-markup-regexps
:functions 'muse-html-markup-functions
:strings 'muse-html-markup-strings
:tags 'muse-html-markup-tags
:specials 'muse-xml-decide-specials
:before 'muse-html-prepare-buffer
:before-end 'muse-html-munge-buffer
:after 'muse-html-finalize-buffer
:header 'muse-html-header
:footer 'muse-html-footer
:style-sheet 'muse-html-style-sheet
:browser 'muse-html-browse-file)
(muse-derive-style "xhtml" "html"
:suffix 'muse-xhtml-extension
:strings 'muse-xhtml-markup-strings
:header 'muse-xhtml-header
:footer 'muse-xhtml-footer
:style-sheet 'muse-xhtml-style-sheet)
;; xhtml1.0 is an alias for xhtml
(muse-derive-style "xhtml1.0" "xhtml")
;; xhtml1.1 has some quirks that need attention from us
(muse-derive-style "xhtml1.1" "xhtml"
:strings 'muse-xhtml1.1-markup-strings)
(provide 'muse-html)
;;; muse-html.el ends here

239
elpa/muse-3.20/muse-http.el
View File

@ -1,239 +0,0 @@
;;; muse-http.el --- publish HTML files over HTTP
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Contributors:
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Publishing HTML over HTTP (using httpd.el)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-html)
(require 'muse-project)
(require 'httpd)
(require 'cgi)
(defgroup muse-http nil
"Options controlling the behavior of Emacs Muse over HTTP."
:group 'press)
(defcustom muse-http-maintainer (concat "webmaster@" (system-name))
"The maintainer address to use for the HTTP 'From' field."
:type 'string
:group 'muse-http)
(defcustom muse-http-publishing-style "html"
"The style to use when publishing projects over http."
:type 'string
:group 'muse-http)
(defcustom muse-http-max-cache-size 64
"The number of pages to cache when serving over HTTP.
This only applies if set while running the persisted invocation
server. See main documentation for the `muse-http'
customization group."
:type 'integer
:group 'muse-http)
(defvar muse-buffer-mtime nil)
(make-variable-buffer-local 'muse-buffer-mtime)
(defun muse-sort-buffers (l r)
(let ((l-mtime (with-current-buffer l muse-buffer-mtime))
(r-mtime (with-current-buffer r muse-buffer-mtime)))
(cond
((and (null l-mtime) (null r-mtime)) l)
((null l-mtime) r)
((null r-mtime) l)
(t (muse-time-less-p r-mtime l-mtime)))))
(defun muse-winnow-list (entries &optional predicate)
"Return only those ENTRIES for which PREDICATE returns non-nil."
(let ((flist (list t)))
(let ((entry entries))
(while entry
(if (funcall predicate (car entry))
(nconc flist (list (car entry))))
(setq entry (cdr entry))))
(cdr flist)))
(defun muse-http-prune-cache ()
"If the page cache has become too large, prune it."
(let* ((buflist
(sort (muse-winnow-list (buffer-list)
(function
(lambda (buf)
(with-current-buffer buf
muse-buffer-mtime))))
'muse-sort-buffers))
(len (length buflist)))
(while (> len muse-http-max-cache-size)
(kill-buffer (car buflist))
(setq len (1- len)))))
(defvar muse-http-serving-p nil)
(defun muse-http-send-buffer (&optional modified code msg)
"Markup and send the contents of the current buffer via HTTP."
(httpd-send (or code 200) (or msg "OK")
"Server: muse.el/" muse-version httpd-endl
"Connection: close" httpd-endl
"MIME-Version: 1.0" httpd-endl
"Date: " (format-time-string "%a, %e %b %Y %T %Z")
httpd-endl
"From: " muse-http-maintainer httpd-endl)
(when modified
(httpd-send-data "Last-Modified: "
(format-time-string "%a, %e %b %Y %T %Z" modified)
httpd-endl))
(httpd-send-data "Content-Type: text/html; charset=iso-8859-1" httpd-endl
"Content-Length: " (number-to-string (1- (point-max)))
httpd-endl httpd-endl
(buffer-string))
(httpd-send-eof))
(defun muse-http-reject (title msg &optional annotation)
(muse-with-temp-buffer
(insert msg ".\n")
(if annotation
(insert annotation "\n"))
(muse-publish-markup-buffer title muse-http-publishing-style)
(muse-http-send-buffer nil 404 msg)))
(defun muse-http-prepare-url (target explicit)
(save-match-data
(unless (or (not explicit)
(string-match muse-url-regexp target)
(string-match muse-image-regexp target)
(string-match muse-file-regexp target))
(setq target (concat "page?" target
"&project=" muse-http-serving-p))))
(muse-publish-read-only target))
(defun muse-http-render-page (name)
"Render the Muse page identified by NAME.
When serving from a dedicated Emacs process (see the httpd-serve
script), a maximum of `muse-http-max-cache-size' pages will be
cached in memory to speed up serving time."
(let ((file (muse-project-page-file name muse-http-serving-p))
(muse-publish-url-transforms
(cons 'muse-http-prepare-url muse-publish-url-transforms))
(inhibit-read-only t))
(when file
(with-current-buffer (get-buffer-create file)
(let ((modified-time (nth 5 (file-attributes file)))
(muse-publishing-current-file file)
muse-publishing-current-style)
(when (or (null muse-buffer-mtime)
(muse-time-less-p muse-buffer-mtime modified-time))
(erase-buffer)
(setq muse-buffer-mtime modified-time))
(goto-char (point-max))
(when (bobp)
(muse-insert-file-contents file t)
(let ((styles (cddr (muse-project muse-http-serving-p)))
style)
(while (and styles (null style))
(let ((include-regexp
(muse-style-element :include (car styles)))
(exclude-regexp
(muse-style-element :exclude (car styles))))
(when (and (or (and (null include-regexp)
(null exclude-regexp))
(if include-regexp
(string-match include-regexp file)
(not (string-match exclude-regexp file))))
(not (muse-project-private-p file)))
(setq style (car styles))
(while (muse-style-element :base style)
(setq style
(muse-style (muse-style-element :base style))))
(if (string= (car style) muse-http-publishing-style)
(setq style (car styles))
(setq style nil))))
(setq styles (cdr styles)))
(muse-publish-markup-buffer
name (or style muse-http-publishing-style))))
(set-buffer-modified-p nil)
(muse-http-prune-cache)
(current-buffer))))))
(defun muse-http-transmit-page (name)
"Render the Muse page identified by NAME.
When serving from a dedicated Emacs process (see the httpd-serve
script), a maximum of `muse-http-max-cache-size' pages will be
cached in memory to speed up serving time."
(let ((inhibit-read-only t)
(buffer (muse-http-render-page name)))
(if buffer
(with-current-buffer buffer
(muse-http-send-buffer muse-buffer-mtime)))))
(defvar httpd-vars nil)
(defsubst httpd-var (var)
"Return value of VAR as a URL variable. If VAR doesn't exist, nil."
(cdr (assoc var httpd-vars)))
(defsubst httpd-var-p (var)
"Return non-nil if VAR was passed as a URL variable."
(not (null (assoc var httpd-vars))))
(defun muse-http-serve (page &optional content)
"Serve the given PAGE from this press server."
;; index.html is really a reference to the project home page
(if (and muse-project-alist
(string-match "\\`index.html?\\'" page))
(setq page (concat "page?"
(muse-get-keyword :default
(cadr (car muse-project-alist))))))
;; handle the actual request
(let ((vc-follow-symlinks t)
(muse-publish-report-threshhold nil)
muse-http-serving-p
httpd-vars)
(save-excursion
;; process any CGI variables, if cgi.el is available
(if (string-match "\\`\\([^&]+\\)&" page)
(setq httpd-vars (cgi-decode (substring page (match-end 0)))
page (match-string 1 page)))
(unless (setq muse-http-serving-p (httpd-var "project"))
(let ((project (car muse-project-alist)))
(setq muse-http-serving-p (car project))
(setq httpd-vars (cons (cons "project" (car project))
httpd-vars))))
(if (and muse-http-serving-p
(string-match "\\`page\\?\\(.+\\)" page))
(muse-http-transmit-page (match-string 1 page))))))
(if (featurep 'httpd)
(httpd-add-handler "\\`\\(index\\.html?\\|page\\(\\?\\|\\'\\)\\)"
'muse-http-serve))
(provide 'muse-http)
;;; muse-http.el ends here

219
elpa/muse-3.20/muse-ikiwiki.el
View File

@ -1,219 +0,0 @@
;;; muse-ikiwiki.el --- integrate with Ikiwiki
;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Contributors:
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse Ikiwiki Integration
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse)
(require 'muse-html)
(require 'muse-ipc)
(require 'muse-publish)
(eval-when-compile
(require 'muse-colors))
(defgroup muse-ikiwiki nil
"Options controlling the behavior of Muse integration with Ikiwiki."
:group 'muse-publish)
(defcustom muse-ikiwiki-header ""
"Header used for publishing Ikiwiki output files.
This may be text or a filename."
:type 'string
:group 'muse-ikiwiki)
(defcustom muse-ikiwiki-footer ""
"Footer used for publishing Ikiwiki output files.
This may be text or a filename."
:type 'string
:group 'muse-ikiwiki)
(defcustom muse-ikiwiki-markup-regexps
`(;; Ikiwiki directives
(1350 ,(concat "\\(\\\\?\\)\\[\\[!""\\(?:-\\|\\w\\)+"
"\\([" muse-regexp-blank "\n]+"
"\\(?:\\(?:\\(?:-\\|\\w\\)+=\\)?"
"\\(?:\"\"\".*?\"\"\"\\|\"[^\"]+\""
"\\|[^]" muse-regexp-blank "\n]+\\)"
"[" muse-regexp-blank "\n]*\\)*\\)?\\]\\]")
0 muse-ikiwiki-markup-directive))
"List of markup rules for publishing Ikiwiki markup on Muse pages.
For more on the structure of this list, see `muse-publish-markup-regexps'."
:type '(repeat (choice
(list :tag "Markup rule"
integer
(choice regexp symbol)
integer
(choice string function symbol))
function))
:group 'muse-ikiwiki)
;;; Publishing
(defun muse-ikiwiki-markup-directive ()
"Handle publishing of an Ikiwiki directive."
(unless (get-text-property (match-beginning 0) 'read-only)
(add-text-properties (match-beginning 0) (match-end 0)
'(muse-no-paragraph t))
(muse-publish-mark-read-only (match-beginning 0) (match-end 0))))
(defun muse-ikiwiki-publish-buffer (name title &optional style)
"Publish a buffer for Ikiwki.
The name of the corresponding file is NAME.
The name of the style is given by STYLE. It defaults to \"ikiwiki\"."
(unless style (setq style "ikiwiki"))
(unless title (setq title (muse-page-name name)))
(let ((muse-batch-publishing-p t)
(muse-publishing-current-file name)
(muse-publishing-current-output-path name)
(muse-publishing-current-style style)
(font-lock-verbose nil)
(vc-handled-backends nil)) ; don't activate VC when publishing files
(run-hooks 'muse-before-publish-hook)
(let ((muse-inhibit-before-publish-hook t))
(muse-publish-markup-buffer title style))))
(defun muse-ikiwiki-publish-file (file name &optional style)
"Publish a single file for Ikiwiki.
The name of the real file is NAME, and the name of the temporary
file containing the content is FILE.
The name of the style is given by STYLE. It defaults to \"ikiwiki\"."
(if (not (stringp file))
(message "Error: No file given to publish")
(unless style
(setq style "ikiwiki"))
(let ((output-path file)
(target file)
(vc-handled-backends nil) ; don't activate VC when publishing files
auto-mode-alist
muse-current-output-style)
(setq auto-mode-alist
(delete (cons (concat "\\." muse-file-extension "\\'")
'muse-mode-choose-mode)
auto-mode-alist))
(setq muse-current-output-style (list :base style :path file))
(muse-with-temp-buffer
(muse-insert-file-contents file)
(muse-ikiwiki-publish-buffer name nil style)
(when (muse-write-file output-path t)
(muse-style-run-hooks :final style file output-path target))))))
(defun muse-ikiwiki-start-server (port)
"Start Muse IPC server, initializing with the client on PORT."
(muse-ipc-start "foo" #'muse-ikiwiki-publish-buffer port))
;;; Colors
(defface muse-ikiwiki-directive
'((((class color) (background light))
(:foreground "dark green"))
(((class color) (background dark))
(:foreground "green")))
"Face for Ikiwiki directives."
:group 'muse-ikiwiki)
(defun muse-colors-ikiwiki-directive ()
"Color ikiwiki directives."
(let ((start (match-beginning 0)))
(unless (or (eq (get-text-property start 'invisible) 'muse)
(get-text-property start 'muse-comment)
(get-text-property start 'muse-directive))
;; beginning of line or space or symbol
(save-excursion
(and
(catch 'valid
(while t
(skip-chars-forward "^\"]" muse-colors-region-end)
(cond ((eq (point) (point-max))
(throw 'valid nil))
((> (point) muse-colors-region-end)
(throw 'valid nil))
((eq (char-after) ?\")
(if (and (< (1+ (point)) muse-colors-region-end)
(eq (char-after (1+ (point))) ?\"))
(if (and (< (+ 2 (point)) muse-colors-region-end)
(eq (char-after (+ 2 (point))) ?\"))
;; triple-quote
(progn
(forward-char 3)
(or (and (looking-at "\"\"\"")
(goto-char (match-end 0)))
(re-search-forward
"\"\"\"" muse-colors-region-end t)
(throw 'valid nil)))
;; empty quotes (""), which are invalid
(throw 'valid nil))
;; quote with content
(forward-char 1)
(skip-chars-forward "^\"" muse-colors-region-end)
(when (eq (char-after) ?\")
(forward-char 1))))
((eq (char-after) ?\])
(forward-char 1)
(when (and (< (point) muse-colors-region-end)
(eq (char-after (point)) ?\]))
(forward-char 1)
(throw 'valid t)))
(t (throw 'valid nil)))))
;; found a valid directive
(let ((end (point)))
;; remove flyspell overlays
(when (fboundp 'flyspell-unhighlight-at)
(let ((cur start))
(while (> end cur)
(flyspell-unhighlight-at cur)
(setq cur (1+ cur)))))
(add-text-properties start end
'(face muse-ikiwiki-directive
muse-directive t muse-no-flyspell t))
(when (progn
(goto-char start)
(skip-chars-forward "^\n" end)
(and (eq (char-after) ?\n)
(not (= (point) end))))
(add-text-properties start end
'(font-lock-multiline t)))))))))
(defun muse-ikiwiki-insinuate-colors ()
(add-to-list 'muse-colors-markup
'("\\[\\[!" ?\[ muse-colors-ikiwiki-directive)
nil))
(eval-after-load "muse-colors" '(muse-ikiwiki-insinuate-colors))
;; Styles
(muse-derive-style "ikiwiki" "xhtml"
:header 'muse-ikiwiki-header
:footer 'muse-ikiwiki-footer
:regexps 'muse-ikiwiki-markup-regexps)
(provide 'muse-ikiwiki)
;;; muse-ikiwiki.el ends here

137
elpa/muse-3.20/muse-import-docbook.el
View File

@ -1,137 +0,0 @@
;;; muse-import-docbook.el --- convert Docbook XML into Muse format
;; Copyright (C) 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Elena Pomohaci <e.pomohaci@gmail.com>
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; It works only for article type docbook docs and recognize
;; followings elements: article, sect1, sect2, sect3, title,
;;; Contributors:
;;; Code:
(require 'muse-import-xml)
(defvar muse-import-docbook-prefix "muse-import-docbook-"
"The name prefix for tag functions")
(defvar muse-import-docbook-para-indent "\n\n"
"Para elements indentation (0, less than 6 spaces, more than 6 spaces)")
(defun muse-import-docbook-reset-para-indent ()
(setq muse-import-docbook-para-indent "\n\n"))
;;;###autoload
(defun muse-import-docbook (src dest)
"Convert the Docbook buffer SRC to Muse, writing output in the DEST buffer."
(interactive "bDocbook buffer:\nBMuse buffer:")
(setq muse-import-xml-prefix muse-import-docbook-prefix)
(setq muse-import-xml-generic-function-name "muse-import-xml-node")
(muse-import-xml src dest))
;;;###autoload
(defun muse-import-docbook-files (src dest)
"Convert the Docbook file SRC to Muse, writing output to the DEST file."
(interactive "fDocbook file:\nFMuse file:")
(with-temp-file dest
(muse-import-docbook (find-file-noselect src) (current-buffer))))
;;; element specific functions
(defun muse-import-docbook-get-title (node)
(let ((tit (car (xml-get-children node 'title))))
(insert (car (cddr tit)) ?\n ?\n)
(muse-import-xml-parse-tree (xml-node-children (remove tit node)))))
(defun muse-import-docbook-article (node)
"Article conversion function"
(muse-import-xml-node node))
(defun muse-import-docbook-articleinfo (node)
"Article conversion function"
(insert "#title ")
(muse-import-docbook-get-title node)
(insert ?\n))
(defalias 'muse-import-docbook-appendix 'muse-import-docbook-article)
(defalias 'muse-import-docbook-appendixinfo 'muse-import-docbook-articleinfo)
(defun muse-import-docbook-sect1 (node)
"Section 1 conversion function"
(insert ?\n "* ")
(muse-import-docbook-get-title node))
(defun muse-import-docbook-sect2 (node)
"Section 2 conversion function"
(insert ?\n "** ")
(muse-import-docbook-get-title node))
(defun muse-import-docbook-sect3 (node)
"Section 3 conversion function"
(insert ?\n "*** ")
(muse-import-docbook-get-title node))
(defun muse-import-docbook-graphic (node)
"Graphic conversion function. Image format is forced to PNG"
(let ((name (xml-get-attribute node 'fileref)))
(insert "\n[[img/" name ".png][" name "]]")))
(defun muse-import-docbook-para (node)
(insert muse-import-docbook-para-indent)
(muse-import-xml-node node))
(defun muse-import-docbook-emphasis (node)
(insert "*")
(muse-import-xml-node node)
(insert "*"))
(defun muse-import-docbook-quote (node)
(insert "\"")
(muse-import-xml-node node)
(insert "\""))
(defun muse-import-docbook-blockquote (node)
(setq muse-import-docbook-para-indent "\n\n ")
(muse-import-xml-node node)
(muse-import-docbook-reset-para-indent))
(defun muse-import-docbook-member (node)
(insert "\n> ")
(muse-import-xml-node node))
(defun muse-import-docbook-bridgehead (node)
(insert "\n* ")
(muse-import-xml-node node))
(provide 'muse-import-docbook)
;;; muse-import-docbook.el ends here

149
elpa/muse-3.20/muse-import-latex.el
View File

@ -1,149 +0,0 @@
;;; muse-import-latex.el --- convert a LaTex file into a Muse file
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Helper commands for converting a LaTeX file into a Muse file.
;;; Contributors:
;;; Code:
(require 'muse)
(require 'muse-regexps)
(defun muse-i-l-write-citation (note author citation pages)
(save-excursion
(goto-char (point-max))
(if (= note 1)
(insert "\nFootnotes:\n\n"))
(let ((beg (point)))
(insert "\n[" (number-to-string note) "] " author)
(if (and citation pages)
(insert ", " citation ", " pages))
(insert "\n")
(goto-char beg)
(while (re-search-forward (concat "p.\\\\[" muse-regexp-blank "\n]+")
nil t)
(replace-match "p."))
(goto-char beg)
(while (re-search-forward "--" nil t)
(replace-match "-")))))
(defun muse-i-l-write-footnote (note text)
(save-excursion
(goto-char (point-max))
(if (= note 1)
(insert "\nFootnotes:\n\n"))
(insert "\n[" (number-to-string note) "] " text ?\n)))
;;;###autoload
(defun muse-import-latex ()
(interactive)
(goto-char (point-min))
(while (not (eobp))
(cond
((or (looking-at "^\\\\documentclass")
(looking-at "^\\\\input")
(looking-at "^\\\\begin{document}")
(looking-at "^\\\\end{document}")
(looking-at "^\\\\author")
(looking-at "^\\\\\\(med\\|big\\|small\\)skip")
(looking-at "^\\\\maketitle"))
(delete-region (point) (muse-line-end-position)))
((looking-at "^\\\\title{\\(.+\\)}")
(delete-region (match-end 1) (muse-line-end-position))
(delete-region (point) (match-beginning 1))
(insert "#title ")))
(forward-line))
(goto-char (point-min))
(while (re-search-forward "\\\\\\(l\\)?dots{}" nil t)
(replace-match (concat (and (string= (match-string 1) "l") ".")
"...")))
(goto-char (point-min))
(while (re-search-forward "\\(``\\|''\\)" nil t)
(replace-match "\""))
(goto-char (point-min))
(while (re-search-forward "---" nil t)
(replace-match " -- "))
(goto-char (point-min))
(while (re-search-forward "\\\\tableofcontents" nil t)
(replace-match "<contents>"))
(goto-char (point-min))
(while (re-search-forward "\\\\\\\\" nil t)
(replace-match ""))
(goto-char (point-min))
(while (re-search-forward "\\\\\\(sub\\)?section{\\([^}]+\\)}" nil t)
(replace-match (concat (if (string= (match-string 1) "sub")
"**" "*")
" " (match-string 2))))
(goto-char (point-min))
(while (re-search-forward "\\\\\\(begin\\|end\\){verse}" nil t)
(replace-match (concat "<" (if (string= (match-string 1) "end") "/")
"verse>")))
(goto-char (point-min))
(while (re-search-forward "\\\\\\(begin\\|end\\){quote}\n" nil t)
(replace-match ""))
(goto-char (point-min))
(while (re-search-forward
"\\\\\\(emph\\|textbf\\){\\([^}]+?\\)\\(\\\\/\\)?}" nil t)
(replace-match
(if (string= (match-string 1) "emph") "*\\2*" "**\\2**")))
(let ((footnote-index 1))
(goto-char (point-min))
(while (re-search-forward
(concat "\\\\\\(q\\)?\\(footnote\\|excerpt\\)\\(np\\)?"
"\\({\\([^}]+\\)}\\)?"
"\\({\\([^}]+\\)}{\\([^}]+\\)}\\)?{\\([^}]+\\)}") nil t)
(let ((beg (match-beginning 0))
(end (match-end 0)))
(unless (string= (match-string 2) "footnote")
(if (null (match-string 1))
(insert " " (match-string 9))
(let ((b (point)) e)
(insert "\"" (match-string 9) "\"")
(setq e (point-marker))
(save-match-data
(save-excursion
(goto-char b)
(while (< (point) e)
(if (looking-at "\\s-+")
(delete-region (match-beginning 0)
(match-end 0)))
(forward-line))))
(set-marker e nil))))
(insert "[" (number-to-string footnote-index) "]")
(if (string= (match-string 2) "footnote")
(muse-i-l-write-footnote footnote-index (match-string 9))
(muse-i-l-write-citation footnote-index (match-string 5)
(match-string 7) (match-string 8)))
(setq footnote-index (1+ footnote-index))
(delete-region beg end))))
(goto-char (point-min))
(while (looking-at "\n") (delete-char 1))
(goto-char (point-min))
(while (re-search-forward "\n\n+" nil t)
(replace-match "\n\n")))
(provide 'muse-import-latex)
;;; muse-import-latex.el ends here

88
elpa/muse-3.20/muse-import-xml.el
View File

@ -1,88 +0,0 @@
;;; muse-import-xml.el --- common to all from-xml converters
;; Copyright (C) 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Elena Pomohaci <e.pomohaci@gmail.com>
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Contributors:
;;; Code:
(provide 'muse-import-xml)
(require 'xml)
(require 'muse)
(defvar muse-import-xml-prefix ""
"The name prefix for tag functions")
(defvar muse-import-xml-generic-function-name "muse-import-xml-generic"
"The generic function name")
(defun muse-import-xml-convert-to-list (buf)
"Convert xml BUF in a xml-list"
(with-temp-buffer
(insert-buffer-substring buf)
(goto-char (point-min))
(while (re-search-forward ">[ \n\t]*<" nil t)
(replace-match "><" nil nil)) ; clean all superfluous blank characters
(xml-parse-region (point-min)
(point-max)
(current-buffer))))
(defun muse-import-xml-generic (node)
"The generic function called when there is no node specific function."
(let ((name (xml-node-name node)))
(insert "<" (symbol-name name) ">")
(muse-import-xml-node node)
(insert "</" (symbol-name name) ">")))
(defun muse-import-xml-parse-tree (lst)
"Parse an xml tree list"
(mapc #'muse-import-xml-parse-node lst))
(defun muse-import-xml-parse-node (node)
"Parse a xml tree node"
(if (stringp node)
(insert (muse-replace-regexp-in-string "^[ \t]+" "" node))
(let ((fname (intern-soft (concat muse-import-xml-prefix
(symbol-name (xml-node-name node))))))
(if (functionp fname)
(funcall fname node)
(funcall (intern muse-import-xml-generic-function-name) node)))))
(defun muse-import-xml-node (node)
"Default node function"
(muse-import-xml-parse-tree (xml-node-children node)))
(defun muse-import-xml (src dest)
"Convert the xml SRC buffer in a muse DEST buffer"
(set-buffer (get-buffer-create dest))
(when (fboundp 'muse-mode)
(muse-mode))
(muse-import-xml-parse-tree (muse-import-xml-convert-to-list src)))
;;; muse-import-xml.el ends here

194
elpa/muse-3.20/muse-ipc.el
View File

@ -1,194 +0,0 @@
;;; muse-ipc.el --- publish Muse documents from other processes
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This file is still in alpha state. Not for production use!
;;; Contributors:
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse Inter-Process Communication
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(eval-when-compile (require 'cl))
(require 'muse)
(require 'muse-publish)
(defgroup muse-ipc nil
"Options controlling the behavior of Muse's IPC module."
:group 'muse-publish)
(defcustom muse-ipc-timeout 60
"Maximum time to wait for a client to respond."
:group 'muse-ipc
:type 'number)
(defcustom muse-ipc-ignore-done nil
"If non-nil, ignore any 'done' messages that we get from clients."
:group 'muse-ipc
:type 'boolean)
(defvar muse-ipc-server-port nil
"Port of the Emacs server.")
(defvar muse-ipc-server-process nil
"Process of the Emacs server.")
(defvar muse-ipc-server-registered nil
"Whether we have successfully registered our port with the client.")
(defun muse-ipc-init-filter (proc string)
"Handle data from client while initiating a connection."
(unless muse-ipc-server-registered
(when (string-match "\\`ok$" string)
(setq muse-ipc-server-registered t))))
(defun muse-ipc-delete-client (proc)
"Delete a client."
(let ((buffer (process-get proc :buffer)))
(when (and buffer (buffer-live-p buffer))
(with-current-buffer buffer
(set-buffer-modified-p nil))
(kill-buffer buffer)))
(when (eq (process-status proc) 'open)
(delete-process proc)))
(defun* muse-ipc-server-filter (proc string)
"Handle data from a client after it connects."
;; Authenticate
(unless (process-get proc :authenticated)
(if (and (string-match "\\`begin \\(.+\\)$" string)
(equal (match-string 1 string)
(process-get proc :shared-secret)))
(progn
(setq string (substring string (match-end 0)))
(process-put proc :authenticated t)
(process-send-string proc "ok\n"))
(process-send-string proc "nok\n")
(delete-process proc))
(return-from muse-ipc-server-filter))
;; Handle case where the client is sending data to be published
(when (process-get proc :sending-data)
(with-current-buffer (process-get proc :buffer)
(insert string)
(let ((buf-len (1- (point)))
(expected-len (process-get proc :data-bytes)))
(cond ((= buf-len expected-len)
(process-put proc :sending-data nil))
((> buf-len expected-len)
(process-send-string proc "nok\n")
(muse-ipc-delete-client proc)))))
(return-from muse-ipc-server-filter))
;; Dispatch commands
(cond
((string-match "\\`done$" string)
;; done, close the server
(unless muse-ipc-ignore-done
(muse-ipc-stop-server)))
((string-match "\\`name \\(.+\\)$" string)
;; set name
(process-put proc :file-name (match-string 1 string))
(process-send-string proc "ok\n"))
((string-match "\\`title \\(.+\\)$" string)
;; set title
(process-put proc :title (match-string 1 string))
(process-send-string proc "ok\n"))
(t
;; unrecognized command
(process-send-string proc "nok\n"))))
(defun muse-ipc-stop-server ()
"Stop Muse IPC server and reset connection data."
(stop-process muse-ipc-server-process)
(delete-process muse-ipc-server-process)
(setq muse-ipc-server-port nil)
(setq muse-ipc-server-process nil))
(defun muse-ipc-start (shared-secret publish-fn client-port &optional server-port)
"Start an IPC connection and send a response to CLIENT-PORT.
If SERVER-PORT is provided, start the IPC server on that port, otherwise
choose a random port.
SHARED-SECRET is used as a very minimal security measure to
authenticate the Muse IPC server during initialization, and also
any incoming clients once the server is started.
PUBLISH-FN is the function which should be called in buffer of
the received contents. It should transform the buffer into a
published state. It must take at least two arguments. The first
argument is the full path of the file that the contents
correspond with. The second argument is the title to use when
publishing the file."
(when (stringp client-port)
(setq client-port (string-to-number client-port)))
(when (stringp server-port)
(setq server-port (string-to-number server-port)))
(setq muse-ipc-server-process
(make-network-process
:name "muse-ipc"
:buffer nil
:host 'local :service (or server-port t)
:server t :noquery t :nowait t
:plist (list :authenticated nil :shared-secret shared-secret
:publish-fn publish-fn)
:filter 'muse-ipc-server-filter))
(unless muse-ipc-server-process
(error "Error: Could not start Muse IPC Server process"))
(set-process-coding-system muse-ipc-server-process
'raw-text-unix 'raw-text-unix)
(setq muse-ipc-server-port
(number-to-string
(cadr (process-contact muse-ipc-server-process))))
(let ((client-proc
(make-network-process
:name "muse-ipc-client"
:buffer nil
:host 'local :service client-port
:noquery t
:filter 'muse-ipc-init-filter)))
(setq muse-ipc-server-registered nil)
(process-send-string client-proc
(concat "begin " shared-secret "\n"))
(accept-process-output client-proc muse-ipc-timeout nil t)
(unless muse-ipc-server-registered
(error "Error: Did not register listener"))
(process-send-string client-proc
(concat "port " muse-ipc-server-port "\n"))
(stop-process client-proc)
(delete-process client-proc))
;; Accept process output until the server dies
(while muse-ipc-server-process (accept-process-output nil 1)))
(provide 'muse-ipc)
;;; muse-ipc.el ends here

774
elpa/muse-3.20/muse-journal.el
View File

@ -1,774 +0,0 @@
;;; muse-journal.el --- keep and publish a journal
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; The module facilitates the keeping and publication of a journal.
;; When publishing to HTML, it assumes the form of a web log, or blog.
;;
;; The input format for each entry is as follows:
;;
;; * 20040317: Title of entry
;;
;; Text for the entry.
;;
;; <qotd>
;; "You know who you are. It comes down to a simple gut check: You
;; either love what you do or you don't. Period." -- P. Bronson
;; </qotd>
;;
;; The "qotd", or Quote of the Day, is entirely optional. When
;; generated to HTML, this entry is rendered as:
;;
;; <div class="entry">
;; <div class="entry-qotd">
;; <h3>Quote of the Day:</h3>
;; <p>"You know who you are. It comes down to a simple gut
;; check: You either love what you do or you don't. Period."
;; -- P. Bronson</p>
;; </div>
;; <div class="entry-body">
;; <div class="entry-head">
;; <div class="entry-date">
;; <span class="date">March 17, 2004</span>
;; </div>
;; <div class="entry-title">
;; <h2>Title of entry</h2>
;; </div>
;; </div>
;; <div class="entry-text">
;; <p>Text for the entry.</p>
;; </div>
;; </div>
;; </div>
;;
;; The plurality of "div" tags makes it possible to display the
;; entries in any form you wish, using a CSS style.
;;
;; Also, an .RDF file can be generated from your journal by publishing
;; it with the "rdf" style. It uses the first two sentences of the
;; first paragraph of each entry as its "description", and
;; autogenerates tags for linking to the various entries.
;;; Contributors:
;; René Stadler (mail AT renestadler DOT de) provided a patch that
;; causes dates in RSS feeds to be generated in a format that RSS
;; readers can parse.
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse Journal Publishing
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-publish)
(require 'muse-html)
(require 'muse-latex)
(require 'muse-book)
(defgroup muse-journal nil
"Rules for transforming a journal into its final form."
:group 'muse-publish)
(defcustom muse-journal-heading-regexp
"\\(?:\\([0-9]+\\)\\(?:: \\)?\\)?\\(.+?\\)?"
"A regexp that matches a journal heading.
Paren group 1 is the ISO date, group 2 is the optional category,
and group 3 is the optional heading for the entry."
:type 'regexp
:group 'muse-journal)
(defcustom muse-journal-date-format "%a, %e %b %Y"
"Date format to use for journal entries."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-html-heading-regexp
(concat "^<h2[^>\n]*>" muse-journal-heading-regexp "</h2>$")
"A regexp that matches a journal heading from an HTML document.
Paren group 1 is the ISO date, group 2 is the optional category,
and group 3 is the optional heading for the entry."
:type 'regexp
:group 'muse-journal)
(defcustom muse-journal-rss-heading-regexp
(concat "^\\* " muse-journal-heading-regexp "$")
"A regexp that matches a journal heading from an HTML document.
Paren group 1 is the ISO date, group 2 is the optional category,
and group 3 is the optional heading for the entry."
:type 'regexp
:group 'muse-journal)
(defcustom muse-journal-html-entry-template
"<div class=\"entry\">
<a name=\"%anchor%\" style=\"text-decoration: none\">&nbsp;</a>
<div class=\"entry-body\">
<div class=\"entry-head\">
<div class=\"entry-date\">
<span class=\"date\">%date%</span>
</div>
<div class=\"entry-title\">
<h2>%title%</h2>
</div>
</div>
<div class=\"entry-text\">
<div class=\"entry-qotd\">
<p>%qotd%</p>
</div>
%text%
</div>
</div>
</div>\n\n"
"Template used to publish individual journal entries as HTML.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-latex-section
"\\section*{%title% \\hfill {\\normalsize %date%}}
\\addcontentsline{toc}{chapter}{%title%}"
"Template used to publish a LaTeX section."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-latex-subsection
"\\subsection*{%title%}
\\addcontentsline{toc}{section}{%title%}"
"Template used to publish a LaTeX subsection."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-markup-tags
'(("qotd" t nil nil muse-journal-qotd-tag))
"A list of tag specifications, for specially marking up Journal entries.
See `muse-publish-markup-tags' for more info.
This is used by journal-latex and its related styles, as well as
the journal-rss-entry style, which both journal-rdf and
journal-rss use."
:type '(repeat (list (string :tag "Markup tag")
(boolean :tag "Expect closing tag" :value t)
(boolean :tag "Parse attributes" :value nil)
(boolean :tag "Nestable" :value nil)
function))
:group 'muse-journal)
;; FIXME: This doesn't appear to be used.
(defun muse-journal-generate-pages ()
(let ((output-dir (muse-style-element :path)))
(goto-char (point-min))
(while (re-search-forward muse-journal-heading-regexp nil t)
(let* ((date (match-string 1))
(category (match-string 1))
(category-file (concat output-dir category "/index.html"))
(heading (match-string 1)))
t))))
(defcustom muse-journal-rdf-extension ".rdf"
"Default file extension for publishing RDF (RSS 1.0) files."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-base-url ""
"The base URL of the website referenced by the RDF file."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-header
"<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
xmlns=\"http://purl.org/rss/1.0/\"
xmlns:dc=\"http://purl.org/dc/elements/1.1/\">
<channel rdf:about=\"<lisp>(concat (muse-style-element :base-url)
(muse-publish-link-name))</lisp>\">
<title><lisp>(muse-publishing-directive \"title\")</lisp></title>
<link><lisp>(concat (muse-style-element :base-url)
(concat (muse-page-name)
muse-html-extension))</lisp></link>
<description><lisp>(muse-publishing-directive \"desc\")</lisp></description>
<items>
<rdf:Seq>
<rdf:li resource=\"<lisp>
(concat (muse-style-element :base-url)
(concat (muse-page-name)
muse-html-extension))</lisp>\"/>
</rdf:Seq>
</items>
</channel>\n"
"Header used for publishing RDF (RSS 1.0) files.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-footer
"</rdf:RDF>\n"
"Footer used for publishing RDF (RSS 1.0) files.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-date-format
"%Y-%m-%dT%H:%M:%S"
"Date format to use for RDF entries."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-entry-template
"\n <item rdf:about=\"%link%#%anchor%\">
<title>%title%</title>
<description>
%desc%
</description>
<link>%link%#%anchor%</link>
<dc:date>%date%</dc:date>
<dc:creator>%maintainer%</dc:creator>
</item>\n"
"Template used to publish individual journal entries as RDF.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-summarize-entries nil
"If non-nil, include only summaries in the RDF file, not the full data.
The default is nil, because this annoys some subscribers."
:type 'boolean
:group 'muse-journal)
(defcustom muse-journal-rss-extension ".xml"
"Default file extension for publishing RSS 2.0 files."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-base-url ""
"The base URL of the website referenced by the RSS file."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-header
"<\?xml version=\"1.0\" encoding=\"<lisp>
(muse-html-encoding)</lisp>\"?>
<rss version=\"2.0\">
<channel>
<title><lisp>(muse-publishing-directive \"title\")</lisp></title>
<link><lisp>(concat (muse-style-element :base-url)
(concat (muse-page-name)
muse-html-extension))</lisp></link>
<description><lisp>(muse-publishing-directive \"desc\")</lisp></description>
<language>en-us</language>
<generator>Emacs Muse</generator>\n\n"
"Header used for publishing RSS 2.0 files. This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-footer
"\n\n </channel>
</rss>\n"
"Footer used for publishing RSS 2.0 files. This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-date-format
"%a, %d %b %Y %H:%M:%S %Z"
"Date format to use for RSS 2.0 entries."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-entry-template
"\n <item>
<title>%title%</title>
<link>%link%#%anchor%</link>
<description>%desc%</description>
<author><lisp>(muse-publishing-directive \"author\")</lisp></author>
<pubDate>%date%</pubDate>
<guid>%link%#%anchor%</guid>
%enclosure%
</item>\n"
"Template used to publish individual journal entries as RSS 2.0.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-enclosure-types-alist
'(("mp3" . "audio/mpeg"))
"File types that are accepted as RSS enclosures.
This is an alist that maps file extension to content type.
Useful for podcasting."
:type '(alist :key-type string :value-type string)
:group 'muse-journal)
(defcustom muse-journal-rss-summarize-entries nil
"If non-nil, include only summaries in the RSS file, not the full data.
The default is nil, because this annoys some subscribers."
:type 'boolean
:group 'muse-journal)
(defcustom muse-journal-rss-markup-regexps
'((10000 muse-explicit-link-regexp 0 "\\2"))
"List of markup rules for publishing a Muse journal page to RSS 2.0.
For more information on the structure of this list, see
`muse-publish-markup-regexps'."
:type '(repeat (choice
(list :tag "Markup rule"
integer
(choice regexp symbol)
integer
(choice string function symbol))
function))
:group 'muse-journal)
(defcustom muse-journal-rss-markup-functions
'((email . ignore)
(link . ignore)
(url . ignore))
"An alist of style types to custom functions for that kind of text.
For more on the structure of this list, see
`muse-publish-markup-functions'."
:type '(alist :key-type symbol :value-type function)
:group 'muse-journal)
(defun muse-journal-anchorize-title (title)
"This strips tags from TITLE, truncates TITLE at begin parenthesis,
and escapes any remaining non-alphanumeric characters."
(save-match-data
(if (string-match "(" title)
(setq title (substring title 0 (match-beginning 0))))
(if (string-match "<[^>]+>" title)
(setq title (replace-match "" nil nil title)))
(let (pos code len ch)
(while (setq pos (string-match (concat "[^" muse-regexp-alnum "_]")
title pos))
(setq ch (aref title pos)
code (format "%%%02X" (cond ((fboundp 'char-to-ucs)
(char-to-ucs ch))
((fboundp 'char-to-int)
(char-to-int ch))
(t ch)))
len (length code)
title (concat (substring title 0 pos)
code
(when (< pos (length title))
(substring title (1+ pos) nil)))
pos (+ len pos)))
title)))
(defun muse-journal-sort-entries (&optional direction)
(interactive "P")
(sort-subr
direction
(function
(lambda ()
(if (re-search-forward "^\\* [0-9]+" nil t)
(goto-char (match-beginning 0))
(goto-char (point-max)))))
(function
(lambda ()
(if (re-search-forward "^\\* [0-9]+" nil t)
(goto-char (1- (match-beginning 0)))
(goto-char (point-max)))))
(function
(lambda ()
(forward-char 2)))
(function
(lambda ()
(end-of-line)))))
(defun muse-journal-qotd-tag (beg end)
(muse-publish-ensure-block beg end)
(muse-insert-markup (muse-markup-text 'begin-quote))
(muse-insert-markup (muse-markup-text 'begin-quote-item))
(goto-char end)
(muse-insert-markup (muse-markup-text 'end-quote-item))
(muse-insert-markup (muse-markup-text 'end-quote)))
(defun muse-journal-html-munge-buffer ()
(goto-char (point-min))
(let ((heading-regexp muse-journal-html-heading-regexp)
(inhibit-read-only t))
(while (re-search-forward heading-regexp nil t)
(let* ((date (match-string 1))
(orig-date date)
(title (match-string 2))
(clean-title title)
datestamp qotd text)
(delete-region (match-beginning 0) (match-end 0))
(if clean-title
(save-match-data
(while (string-match "\\(^<[^>]+>\\|<[^>]+>$\\)" clean-title)
(setq clean-title (replace-match "" nil nil clean-title)))))
(save-match-data
(when (and date
(string-match
(concat "\\`\\([1-9][0-9][0-9][0-9]\\)[./]?"
"\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
(setq datestamp
(encode-time
0 0 0
(string-to-number (match-string 3 date))
(string-to-number (match-string 2 date))
(string-to-number (match-string 1 date))
nil)
date (concat (format-time-string
muse-journal-date-format datestamp)
(substring date (match-end 0))))))
(save-restriction
(narrow-to-region
(point) (if (re-search-forward
(concat "\\(^<hr>$\\|"
heading-regexp "\\)") nil t)
(match-beginning 0)
(point-max)))
(goto-char (point-max))
(while (and (not (bobp))
(eq ?\ (char-syntax (char-before))))
(delete-char -1))
(goto-char (point-min))
(while (and (not (eobp))
(eq ?\ (char-syntax (char-after))))
(delete-char 1))
(save-excursion
(when (search-forward "<qotd>" nil t)
(let ((tag-beg (match-beginning 0))
(beg (match-end 0))
end)
(re-search-forward "</qotd>\n*")
(setq end (point-marker))
(save-restriction
(narrow-to-region beg (match-beginning 0))
(muse-publish-escape-specials (point-min) (point-max)
nil 'document)
(setq qotd (buffer-substring-no-properties
(point-min) (point-max))))
(delete-region tag-beg end)
(set-marker end nil))))
(setq text (buffer-string))
(delete-region (point-min) (point-max))
(let ((entry muse-journal-html-entry-template))
(muse-insert-file-or-string entry)
(muse-publish-mark-read-only (point-min) (point-max))
(goto-char (point-min))
(while (search-forward "%date%" nil t)
(remove-text-properties (match-beginning 0) (match-end 0)
'(read-only nil rear-nonsticky nil))
(replace-match (or date "") nil t))
(goto-char (point-min))
(while (search-forward "%title%" nil t)
(remove-text-properties (match-beginning 0) (match-end 0)
'(read-only nil rear-nonsticky nil))
(replace-match (or title "&nbsp;") nil t))
(goto-char (point-min))
(while (search-forward "%anchor%" nil t)
(replace-match (muse-journal-anchorize-title
(or clean-title orig-date))
nil t))
(goto-char (point-min))
(while (search-forward "%qotd%" nil t)
(save-restriction
(narrow-to-region (match-beginning 0) (match-end 0))
(delete-region (point-min) (point-max))
(when qotd (muse-insert-markup qotd))))
(goto-char (point-min))
(while (search-forward "%text%" nil t)
(remove-text-properties (match-beginning 0) (match-end 0)
'(read-only nil rear-nonsticky nil))
(replace-match text nil t))
(when (null qotd)
(goto-char (point-min))
(when (search-forward "<div class=\"entry-qotd\">" nil t)
(let ((beg (match-beginning 0)))
(re-search-forward "</div>\n*" nil t)
(delete-region beg (point))))))))))
;; indicate that we are to continue the :before-end processing
nil)
(defun muse-journal-latex-munge-buffer ()
(goto-char (point-min))
(let ((heading-regexp
(concat "^" (regexp-quote (muse-markup-text 'section))
muse-journal-heading-regexp
(regexp-quote (muse-markup-text 'section-end)) "$"))
(inhibit-read-only t))
(when (re-search-forward heading-regexp nil t)
(goto-char (match-beginning 0))
(sort-subr nil
(function
(lambda ()
(if (re-search-forward heading-regexp nil t)
(goto-char (match-beginning 0))
(goto-char (point-max)))))
(function
(lambda ()
(if (re-search-forward heading-regexp nil t)
(goto-char (1- (match-beginning 0)))
(goto-char (point-max)))))
(function
(lambda ()
(forward-char 2)))
(function
(lambda ()
(end-of-line)))))
(while (re-search-forward heading-regexp nil t)
(let ((date (match-string 1))
(title (match-string 2))
;; FIXME: Nothing is done with qotd
qotd section)
(save-match-data
(when (and date
(string-match
(concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
"\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
(setq date (encode-time
0 0 0
(string-to-number (match-string 3 date))
(string-to-number (match-string 2 date))
(string-to-number (match-string 1 date))
nil)
date (format-time-string
muse-journal-date-format date))))
(save-restriction
(narrow-to-region (match-beginning 0) (match-end 0))
(delete-region (point-min) (point-max))
(muse-insert-markup muse-journal-latex-section)
(goto-char (point-min))
(while (search-forward "%title%" nil t)
(replace-match (or title "Untitled") nil t))
(goto-char (point-min))
(while (search-forward "%date%" nil t)
(replace-match (or date "") nil t))))))
(goto-char (point-min))
(let ((subheading-regexp
(concat "^" (regexp-quote (muse-markup-text 'subsection))
"\\([^\n}]+\\)"
(regexp-quote (muse-markup-text 'subsection-end)) "$"))
(inhibit-read-only t))
(while (re-search-forward subheading-regexp nil t)
(let ((title (match-string 1)))
(save-restriction
(narrow-to-region (match-beginning 0) (match-end 0))
(delete-region (point-min) (point-max))
(muse-insert-markup muse-journal-latex-subsection)
(goto-char (point-min))
(while (search-forward "%title%" nil t)
(replace-match title nil t))))))
;; indicate that we are to continue the :before-end processing
nil)
(defun muse-journal-rss-munge-buffer ()
(goto-char (point-min))
(let ((heading-regexp muse-journal-rss-heading-regexp)
(inhibit-read-only t))
(while (re-search-forward heading-regexp nil t)
(let* ((date (match-string 1))
(orig-date date)
(title (match-string 2))
;; FIXME: Nothing is done with qotd
enclosure qotd desc)
(if title
(save-match-data
(if (string-match muse-explicit-link-regexp title)
(setq enclosure (muse-get-link title)
title (muse-get-link-desc title)))))
(save-match-data
(when (and date
(string-match
(concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
"\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
(setq date (encode-time 0 0 0
(string-to-number (match-string 3 date))
(string-to-number (match-string 2 date))
(string-to-number (match-string 1 date))
nil)
;; make sure that date is in a format that RSS
;; readers can handle
date (let ((system-time-locale "C"))
(format-time-string
(muse-style-element :date-format) date)))))
(save-restriction
(narrow-to-region
(match-beginning 0)
(if (re-search-forward heading-regexp nil t)
(match-beginning 0)
(if (re-search-forward "^Footnotes:" nil t)
(match-beginning 0)
(point-max))))
(goto-char (point-min))
(delete-region (point) (muse-line-end-position))
(re-search-forward "</qotd>\n+" nil t)
(while (and (char-after)
(eq ?\ (char-syntax (char-after))))
(delete-char 1))
(let ((beg (point)))
(if (muse-style-element :summarize)
(progn
(forward-sentence 2)
(setq desc (concat (buffer-substring beg (point)) "...")))
(save-restriction
(muse-publish-markup-buffer "rss-entry" "journal-rss-entry")
(goto-char (point-min))
(if (re-search-forward "Page published by Emacs Muse" nil t)
(goto-char (muse-line-end-position))
(muse-display-warning
(concat
"Cannot find 'Page published by Emacs Muse begins here'.\n"
"You will probably need this text in your header."))
(goto-char (point-min)))
(setq beg (point))
(if (re-search-forward "Page published by Emacs Muse" nil t)
(goto-char (muse-line-beginning-position))
(muse-display-warning
(concat
"Cannot find 'Page published by Emacs Muse ends here'.\n"
"You will probably need this text in your footer."))
(goto-char (point-max)))
(setq desc (buffer-substring beg (point))))))
(unless (string= desc "")
(setq desc (concat "<![CDATA[" desc "]]>")))
(delete-region (point-min) (point-max))
(let ((entry (muse-style-element :entry-template)))
(muse-insert-file-or-string entry)
(goto-char (point-min))
(while (search-forward "%date%" nil t)
(replace-match (or date "") nil t))
(goto-char (point-min))
(while (search-forward "%title%" nil t)
(replace-match "")
(save-restriction
(narrow-to-region (point) (point))
(insert (or title "Untitled"))
(remove-text-properties (match-beginning 0) (match-end 0)
'(read-only nil rear-nonsticky nil))
(let ((muse-publishing-current-style (muse-style "html")))
(muse-publish-escape-specials (point-min) (point-max)
nil 'document))))
(goto-char (point-min))
(while (search-forward "%desc%" nil t)
(replace-match desc nil t))
(goto-char (point-min))
(while (search-forward "%enclosure%" nil t)
(replace-match
(if (null enclosure)
""
(save-match-data
(format
"<enclosure url=\"%s\" %stype=\"%s\"/>"
(if (string-match "//" enclosure)
enclosure
(concat (muse-style-element :base-url)
enclosure))
(let ((file
(expand-file-name enclosure
(muse-style-element :path))))
(if (file-readable-p file)
(format "length=\"%d\" "
(nth 7 (file-attributes file)))
""))
(if (string-match "\\.\\([^.]+\\)$" enclosure)
(let* ((ext (match-string 1 enclosure))
(type
(assoc
ext muse-journal-rss-enclosure-types-alist)))
(if type
(cdr type)
"application/octet-stream"))))))
nil t))
(goto-char (point-min))
(while (search-forward "%link%" nil t)
(replace-match
(concat (muse-style-element :base-url)
(concat (muse-page-name)
muse-html-extension))
nil t))
(goto-char (point-min))
(while (search-forward "%anchor%" nil t)
(replace-match
(muse-journal-anchorize-title (or title orig-date))
nil t))
(goto-char (point-min))
(while (search-forward "%maintainer%" nil t)
(replace-match
(or (muse-style-element :maintainer)
(concat "webmaster@" (system-name)))
nil t)))))))
;; indicate that we are to continue the :before-end processing
nil)
;;; Register the Muse Journal Publishers
(muse-derive-style "journal-html" "html"
:before-end 'muse-journal-html-munge-buffer)
(muse-derive-style "journal-xhtml" "xhtml"
:before-end 'muse-journal-html-munge-buffer)
(muse-derive-style "journal-latex" "latex"
:tags 'muse-journal-markup-tags
:before-end 'muse-journal-latex-munge-buffer)
(muse-derive-style "journal-pdf" "pdf"
:tags 'muse-journal-markup-tags
:before-end 'muse-journal-latex-munge-buffer)
(muse-derive-style "journal-book-latex" "book-latex"
;;:nochapters
:tags 'muse-journal-markup-tags
:before-end 'muse-journal-latex-munge-buffer)
(muse-derive-style "journal-book-pdf" "book-pdf"
;;:nochapters
:tags 'muse-journal-markup-tags
:before-end 'muse-journal-latex-munge-buffer)
(muse-define-style "journal-rdf"
:suffix 'muse-journal-rdf-extension
:regexps 'muse-journal-rss-markup-regexps
:functions 'muse-journal-rss-markup-functions
:before 'muse-journal-rss-munge-buffer
:header 'muse-journal-rdf-header
:footer 'muse-journal-rdf-footer
:date-format 'muse-journal-rdf-date-format
:entry-template 'muse-journal-rdf-entry-template
:base-url 'muse-journal-rdf-base-url
:summarize 'muse-journal-rdf-summarize-entries)
(muse-define-style "journal-rss"
:suffix 'muse-journal-rss-extension
:regexps 'muse-journal-rss-markup-regexps
:functions 'muse-journal-rss-markup-functions
:before 'muse-journal-rss-munge-buffer
:header 'muse-journal-rss-header
:footer 'muse-journal-rss-footer
:date-format 'muse-journal-rss-date-format
:entry-template 'muse-journal-rss-entry-template
:base-url 'muse-journal-rss-base-url
:summarize 'muse-journal-rss-summarize-entries)
;; Used by `muse-journal-rss-munge-buffer' to mark up individual entries
(muse-derive-style "journal-rss-entry" "html"
:tags 'muse-journal-markup-tags)
(provide 'muse-journal)
;;; muse-journal.el ends here

669
elpa/muse-3.20/muse-latex.el
View File

@ -1,669 +0,0 @@
;;; muse-latex.el --- publish entries in LaTex or PDF format
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Contributors:
;; Li Daobing (lidaobing AT gmail DOT com) provided CJK support.
;; Trent Buck (trentbuck AT gmail DOT com) gave valuable advice for
;; how to treat LaTeX specials and the like.
;; Matthias Kegelmann (mathias DOT kegelmann AT sdm DOT de) provided a
;; scenario where we would need to respect the <contents> tag.
;; Jean Magnan de Bornier (jean AT bornier DOT net) provided the
;; markup string for link-and-anchor.
;; Jim Ottaway (j DOT ottaway AT lse DOT ac DOT uk) implemented slides
;; and lecture notes.
;; Karl Berry (karl AT freefriends DOT org) suggested how to escape
;; additional special characters in image filenames.
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse LaTeX Publishing
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-publish)
(defgroup muse-latex nil
"Rules for marking up a Muse file as a LaTeX article."
:group 'muse-publish)
(defcustom muse-latex-extension ".tex"
"Default file extension for publishing LaTeX files."
:type 'string
:group 'muse-latex)
(defcustom muse-latex-pdf-extension ".pdf"
"Default file extension for publishing LaTeX files to PDF."
:type 'string
:group 'muse-latex)
(defcustom muse-latex-pdf-browser "open %s"
"The program to use when browsing a published PDF file.
This should be a format string."
:type 'string
:group 'muse-latex)
(defcustom muse-latex-pdf-program "pdflatex"
"The program that is called to generate PDF content from LaTeX content."
:type 'string
:group 'muse-latex)
(defcustom muse-latex-pdf-cruft
'(".aux" ".log" ".nav" ".out" ".snm" ".toc" ".vrb")
"Extensions of files to remove after generating PDF output successfully."
:type 'string
:group 'muse-latex)
(defcustom muse-latex-header
"\\documentclass{article}
\\usepackage[english]{babel}
\\usepackage{ucs}
\\usepackage[utf8x]{inputenc}
\\usepackage[T1]{fontenc}
\\usepackage{hyperref}
\\usepackage[pdftex]{graphicx}
\\def\\museincludegraphics{%
\\begingroup
\\catcode`\\|=0
\\catcode`\\\\=12
\\catcode`\\#=12
\\includegraphics[width=0.75\\textwidth]
}
\\begin{document}
\\title{<lisp>(muse-publish-escape-specials-in-string
(muse-publishing-directive \"title\") 'document)</lisp>}
\\author{<lisp>(muse-publishing-directive \"author\")</lisp>}
\\date{<lisp>(muse-publishing-directive \"date\")</lisp>}
\\maketitle
<lisp>(and muse-publish-generate-contents
(not muse-latex-permit-contents-tag)
\"\\\\tableofcontents\n\\\\newpage\")</lisp>\n\n"
"Header used for publishing LaTeX files. This may be text or a filename."
:type 'string
:group 'muse-latex)
(defcustom muse-latex-footer "<lisp>(muse-latex-bibliography)</lisp>
\\end{document}\n"
"Footer used for publishing LaTeX files. This may be text or a filename."
:type 'string
:group 'muse-latex)
(defcustom muse-latexcjk-header
"\\documentclass{article}
\\usepackage{CJK}
\\usepackage{indentfirst}
\\usepackage[CJKbookmarks=true]{hyperref}
\\usepackage[pdftex]{graphicx}
\\begin{document}
\\begin{CJK*}<lisp>(muse-latexcjk-encoding)</lisp>
\\title{<lisp>(muse-publish-escape-specials-in-string
(muse-publishing-directive \"title\") 'document)</lisp>}
\\author{<lisp>(muse-publishing-directive \"author\")</lisp>}
\\date{<lisp>(muse-publishing-directive \"date\")</lisp>}
\\maketitle
<lisp>(and muse-publish-generate-contents
(not muse-latex-permit-contents-tag)
\"\\\\tableofcontents\n\\\\newpage\")</lisp>\n\n"
"Header used for publishing LaTeX files (CJK). This may be text or a
filename."
:type 'string
:group 'muse-latex)
(defcustom muse-latexcjk-footer
"\n\\end{CJK*}
\\end{document}\n"
"Footer used for publishing LaTeX files (CJK). This may be text or a
filename."
:type 'string
:group 'muse-latex)
(defcustom muse-latex-slides-header
"\\documentclass[ignorenonframetext]{beamer}
\\usepackage[english]{babel}
\\usepackage{ucs}
\\usepackage[utf8x]{inputenc}
\\usepackage[T1]{fontenc}
\\usepackage{hyperref}
\\def\\museincludegraphics{%
\\begingroup
\\catcode`\\|=0
\\catcode`\\\\=12
\\catcode`\\#=12
\\includegraphics[width=0.50\\textwidth]
}
\\title{<lisp>(muse-publish-escape-specials-in-string
(muse-publishing-directive \"title\") 'document)</lisp>}
\\author{<lisp>(muse-publishing-directive \"author\")</lisp>}
\\date{<lisp>(muse-publishing-directive \"date\")</lisp>}
\\begin{document}
\\frame{\\titlepage}
<lisp>(and muse-publish-generate-contents
\"\\\\frame{\\\\tableofcontents}\")</lisp>\n\n"
"Header for publishing of slides using LaTeX.
This may be text or a filename.
You must have the Beamer extension for LaTeX installed for this to work."
:type 'string
:group 'muse-latex)
(defcustom muse-latex-lecture-notes-header
"\\documentclass{article}
\\usepackage{beamerarticle}
\\usepackage[english]{babel}
\\usepackage{ucs}
\\usepackage[utf8x]{inputenc}
\\usepackage[T1]{fontenc}
\\usepackage{hyperref}
\\usepackage[pdftex]{graphicx}
\\def\\museincludegraphics{%
\\begingroup
\\catcode`\\|=0
\\catcode`\\\\=12
\\catcode`\\#=12
\\includegraphics[width=0.50\\textwidth]
}
\\title{<lisp>(muse-publish-escape-specials-in-string
(muse-publishing-directive \"title\") 'document)</lisp>}
\\author{<lisp>(muse-publishing-directive \"author\")</lisp>}
\\date{<lisp>(muse-publishing-directive \"date\")</lisp>}
\\begin{document}
\\frame{\\titlepage}
<lisp>(and muse-publish-generate-contents
\"\\\\frame{\\\\tableofcontents}\")</lisp>\n\n"
"Header for publishing of lecture notes using LaTeX.
This may be text or a filename.
You must have the Beamer extension for LaTeX installed for this to work."
:type 'string
:group 'muse-latex)
(defcustom muse-latex-markup-regexps
`(;; numeric ranges
(10000 "\\([0-9]+\\)-\\([0-9]+\\)" 0 "\\1--\\2")
;; be careful of closing quote pairs
(10100 "\"'" 0 "\"\\\\-'"))
"List of markup regexps for identifying regions in a Muse page.
For more on the structure of this list, see `muse-publish-markup-regexps'."
:type '(repeat (choice
(list :tag "Markup rule"
integer
(choice regexp symbol)
integer
(choice string function symbol))
function))
:group 'muse-latex)
(defcustom muse-latex-markup-functions
'((table . muse-latex-markup-table))
"An alist of style types to custom functions for that kind of text.
For more on the structure of this list, see
`muse-publish-markup-functions'."
:type '(alist :key-type symbol :value-type function)
:group 'muse-latex)
(defcustom muse-latex-markup-strings
'((image-with-desc . "\\begin{figure}[h]
\\centering\\museincludegraphics{%s.%s}|endgroup
\\caption{%s}
\\end{figure}")
(image . "\\begin{figure}[h]
\\centering\\museincludegraphics{%s.%s}|endgroup
\\end{figure}")
(image-link . "%% %s
\\museincludegraphics{%s.%s}|endgroup")
(anchor-ref . "\\ref{%s}")
(url . "\\url{%s}")
(url-and-desc . "\\href{%s}{%s}\\footnote{%1%}")
(link . "\\href{%s}{%s}\\footnote{%1%}")
(link-and-anchor . "\\href{%1%}{%3%}\\footnote{%1%}")
(email-addr . "\\verb|%s|")
(anchor . "\\label{%s}")
(emdash . "---")
(comment-begin . "% ")
(rule . "\\vspace{.5cm}\\hrule\\vspace{.5cm}")
(no-break-space . "~")
(line-break . "\\\\")
(enddots . "\\ldots{}")
(dots . "\\dots{}")
(part . "\\part{")
(part-end . "}")
(chapter . "\\chapter{")
(chapter-end . "}")
(section . "\\section{")
(section-end . "}")
(subsection . "\\subsection{")
(subsection-end . "}")
(subsubsection . "\\subsubsection{")
(subsubsection-end . "}")
(section-other . "\\paragraph{")
(section-other-end . "}")
(footnote . "\\footnote{")
(footnote-end . "}")
(footnotetext . "\\footnotetext[%d]{")
(begin-underline . "\\underline{")
(end-underline . "}")
(begin-literal . "\\texttt{")
(end-literal . "}")
(begin-emph . "\\emph{")
(end-emph . "}")
(begin-more-emph . "\\textbf{")
(end-more-emph . "}")
(begin-most-emph . "\\textbf{\\emph{")
(end-most-emph . "}}")
(begin-verse . "\\begin{verse}\n")
(end-verse-line . " \\\\")
(verse-space . "~~~~")
(end-verse . "\n\\end{verse}")
(begin-example . "\\begin{quote}\n\\begin{verbatim}")
(end-example . "\\end{verbatim}\n\\end{quote}")
(begin-center . "\\begin{center}\n")
(end-center . "\n\\end{center}")
(begin-quote . "\\begin{quote}\n")
(end-quote . "\n\\end{quote}")
(begin-cite . "\\cite{")
(begin-cite-author . "\\citet{")
(begin-cite-year . "\\citet{")
(end-cite . "}")
(begin-uli . "\\begin{itemize}\n")
(end-uli . "\n\\end{itemize}")
(begin-uli-item . "\\item ")
(begin-oli . "\\begin{enumerate}\n")
(end-oli . "\n\\end{enumerate}")
(begin-oli-item . "\\item ")
(begin-dl . "\\begin{description}\n")
(end-dl . "\n\\end{description}")
(begin-ddt . "\\item[")
(end-ddt . "] \\mbox{}\n"))
"Strings used for marking up text.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles."
:type '(alist :key-type symbol :value-type string)
:group 'muse-latex)
(defcustom muse-latex-slides-markup-tags
'(("slide" t t nil muse-latex-slide-tag))
"A list of tag specifications, for specially marking up LaTeX slides."
:type '(repeat (list (string :tag "Markup tag")
(boolean :tag "Expect closing tag" :value t)
(boolean :tag "Parse attributes" :value nil)
(boolean :tag "Nestable" :value nil)
function))
:group 'muse-latex)
(defcustom muse-latexcjk-encoding-map
'((utf-8 . "{UTF8}{song}")
(japanese-iso-8bit . "[dnp]{JIS}{min}")
(chinese-big5 . "{Bg5}{bsmi}")
(mule-utf-8 . "{UTF8}{song}")
(chinese-iso-8bit . "{GB}{song}")
(chinese-gbk . "{GBK}{song}"))
"An alist mapping emacs coding systems to appropriate CJK codings.
Use the base name of the coding system (ie, without the -unix)."
:type '(alist :key-type coding-system :value-type string)
:group 'muse-latex)
(defcustom muse-latexcjk-encoding-default "{GB}{song}"
"The default Emacs buffer encoding to use in published files.
This will be used if no special characters are found."
:type 'string
:group 'muse-latex)
(defun muse-latexcjk-encoding ()
(when (boundp 'buffer-file-coding-system)
(muse-latexcjk-transform-content-type buffer-file-coding-system)))
(defun muse-latexcjk-transform-content-type (content-type)
"Using `muse-cjklatex-encoding-map', try and resolve an emacs coding
system to an associated CJK coding system."
(let ((match (and (fboundp 'coding-system-base)
(assoc (coding-system-base content-type)
muse-latexcjk-encoding-map))))
(if match
(cdr match)
muse-latexcjk-encoding-default)))
(defcustom muse-latex-markup-specials-document
'((?\\ . "\\textbackslash{}")
(?\_ . "\\textunderscore{}")
(?\< . "\\textless{}")
(?\> . "\\textgreater{}")
(?^ . "\\^{}")
(?\~ . "\\~{}")
(?\@ . "\\@")
(?\$ . "\\$")
(?\% . "\\%")
(?\{ . "\\{")
(?\} . "\\}")
(?\& . "\\&")
(?\# . "\\#"))
"A table of characters which must be represented specially.
These are applied to the entire document, sans already-escaped
regions."
:type '(alist :key-type character :value-type string)
:group 'muse-latex)
(defcustom muse-latex-markup-specials-example
'()
"A table of characters which must be represented specially.
These are applied to <example> regions.
With the default interpretation of <example> regions, no specials
need to be escaped."
:type '(alist :key-type character :value-type string)
:group 'muse-latex)
(defcustom muse-latex-markup-specials-literal
'((?\n . "\\\n")
(?\\ . "\\textbackslash{}")
(?_ . "\\textunderscore{}")
(?\< . "\\textless{}")
(?\> . "\\textgreater{}")
(?^ . "\\^{}")
(?\~ . "\\~{}")
(?\$ . "\\$")
(?\% . "\\%")
(?\{ . "\\{")
(?\} . "\\}")
(?\& . "\\&")
(?\# . "\\#"))
"A table of characters which must be represented specially.
This applies to =monospaced text= and <code> regions."
:type '(alist :key-type character :value-type string)
:group 'muse-latex)
(defcustom muse-latex-markup-specials-url
'((?\\ . "\\textbackslash{}")
(?\_ . "\\_")
(?\< . "\\<")
(?\> . "\\>")
(?\$ . "\\$")
(?\% . "\\%")
(?\{ . "\\{")
(?\} . "\\}")
(?\& . "\\&")
(?\# . "\\#"))
"A table of characters which must be represented specially.
These are applied to URLs."
:type '(alist :key-type character :value-type string)
:group 'muse-latex)
(defcustom muse-latex-markup-specials-image
'((?\\ . "\\\\")
(?\< . "\\<")
(?\> . "\\>")
(?\$ . "\\$")
(?\% . "\\%")
(?\{ . "\\{")
(?\} . "\\}")
(?\& . "\\&")
(?\# . "\\#")
(?\| . "\\|"))
"A table of characters which must be represented specially.
These are applied to image filenames."
:type '(alist :key-type character :value-type string)
:group 'muse-latex)
(defun muse-latex-decide-specials (context)
"Determine the specials to escape, depending on CONTEXT."
(cond ((memq context '(underline emphasis document url-desc verbatim
footnote))
muse-latex-markup-specials-document)
((eq context 'image)
muse-latex-markup-specials-image)
((memq context '(email url))
muse-latex-markup-specials-url)
((eq context 'literal)
muse-latex-markup-specials-literal)
((eq context 'example)
muse-latex-markup-specials-example)
(t (error "Invalid context '%s' in muse-latex" context))))
(defcustom muse-latex-permit-contents-tag nil
"If nil, ignore <contents> tags. Otherwise, insert table of contents.
Most of the time, it is best to have a table of contents on the
first page, with a new page immediately following. To make this
work with documents published in both HTML and LaTeX, we need to
ignore the <contents> tag.
If you don't agree with this, then set this option to non-nil,
and it will do what you expect."
:type 'boolean
:group 'muse-latex)
(defun muse-latex-markup-table ()
(let* ((table-info (muse-publish-table-fields (match-beginning 0)
(match-end 0)))
(row-len (car table-info))
(field-list (cdr table-info)))
(when table-info
(muse-insert-markup "\\begin{tabular}{" (make-string row-len ?l) "}\n")
(dolist (fields field-list)
(let ((type (car fields)))
(setq fields (cdr fields))
(if (eq type 'hline)
(muse-insert-markup "\\hline\n")
(when (= type 3)
(muse-insert-markup "\\hline\n"))
(insert (car fields))
(setq fields (cdr fields))
(dolist (field fields)
(muse-insert-markup " & ")
(insert field))
(muse-insert-markup " \\\\\n")
(when (= type 2)
(muse-insert-markup "\\hline\n")))))
(muse-insert-markup "\\end{tabular}"))))
;;; Tags for LaTeX
(defun muse-latex-slide-tag (beg end attrs)
"Publish the <slide> tag in LaTeX.
This is used by the slides and lecture-notes publishing styles."
(let ((title (cdr (assoc "title" attrs))))
(goto-char beg)
(muse-insert-markup "\\begin{frame}[fragile]\n")
(when title
(muse-insert-markup "\\frametitle{")
(insert title)
(muse-insert-markup "}\n"))
(save-excursion
(goto-char end)
(muse-insert-markup "\n\\end{frame}"))))
;;; Post-publishing functions
(defun muse-latex-fixup-dquotes ()
"Fixup double quotes."
(goto-char (point-min))
(let ((open t))
(while (search-forward "\"" nil t)
(unless (get-text-property (match-beginning 0) 'read-only)
(when (or (bobp)
(eq (char-before) ?\n))
(setq open t))
(if open
(progn
(replace-match "``")
(setq open nil))
(replace-match "''")
(setq open t))))))
(defun muse-latex-fixup-citations ()
"Replace semicolons in multi-head citations with colons."
(goto-char (point-min))
(while (re-search-forward "\\\\cite.?{" nil t)
(let ((start (point))
(end (re-search-forward "}")))
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
(while (re-search-forward ";" nil t)
(replace-match ","))))))
(defun muse-latex-fixup-headings ()
"Remove footnotes in headings, since LaTeX does not permit them to exist.
This can happen if there is a link in a heading, because by
default Muse will add a footnote for each link."
(goto-char (point-min))
(while (re-search-forward "^\\\\section.?{" nil t)
(save-restriction
(narrow-to-region (match-beginning 0) (muse-line-end-position))
(goto-char (point-min))
(while (re-search-forward "\\\\footnote{[^}\n]+}" nil t)
(replace-match ""))
(forward-line 1))))
(defun muse-latex-munge-buffer ()
(muse-latex-fixup-dquotes)
(muse-latex-fixup-citations)
(muse-latex-fixup-headings)
(when (and muse-latex-permit-contents-tag
muse-publish-generate-contents)
(goto-char (car muse-publish-generate-contents))
(muse-insert-markup "\\tableofcontents")))
(defun muse-latex-bibliography ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "\\\\cite.?{" nil t)
(concat
"\\bibliography{"
(muse-publishing-directive "bibsource")
"}\n")
"")))
(defun muse-latex-pdf-browse-file (file)
(shell-command (format muse-latex-pdf-browser file)))
(defun muse-latex-pdf-generate (file output-path final-target)
(apply
#'muse-publish-transform-output
file output-path final-target "PDF"
(function
(lambda (file output-path)
(let* ((fnd (file-name-directory output-path))
(command (format "%s \"%s\""
muse-latex-pdf-program
(file-relative-name file fnd)))
(times 0)
(default-directory fnd)
result)
;; XEmacs can sometimes return a non-number result. We'll err
;; on the side of caution by continuing to attempt to generate
;; the PDF if this happens and treat the final result as
;; successful.
(while (and (< times 2)
(or (not (numberp result))
(not (eq result 0))
;; table of contents takes 2 passes
(file-readable-p
(muse-replace-regexp-in-string
"\\.tex\\'" ".toc" file t t))))
(setq result (shell-command command)
times (1+ times)))
(if (or (not (numberp result))
(eq result 0))
t
nil))))
muse-latex-pdf-cruft))
;;; Register the Muse LATEX Publishers
(muse-define-style "latex"
:suffix 'muse-latex-extension
:regexps 'muse-latex-markup-regexps
:functions 'muse-latex-markup-functions
:strings 'muse-latex-markup-strings
:specials 'muse-latex-decide-specials
:before-end 'muse-latex-munge-buffer
:header 'muse-latex-header
:footer 'muse-latex-footer
:browser 'find-file)
(muse-derive-style "pdf" "latex"
:final 'muse-latex-pdf-generate
:browser 'muse-latex-pdf-browse-file
:link-suffix 'muse-latex-pdf-extension
:osuffix 'muse-latex-pdf-extension)
(muse-derive-style "latexcjk" "latex"
:header 'muse-latexcjk-header
:footer 'muse-latexcjk-footer)
(muse-derive-style "pdfcjk" "latexcjk"
:final 'muse-latex-pdf-generate
:browser 'muse-latex-pdf-browse-file
:link-suffix 'muse-latex-pdf-extension
:osuffix 'muse-latex-pdf-extension)
(muse-derive-style "slides" "latex"
:header 'muse-latex-slides-header
:tags 'muse-latex-slides-markup-tags)
(muse-derive-style "slides-pdf" "pdf"
:header 'muse-latex-slides-header
:tags 'muse-latex-slides-markup-tags)
(muse-derive-style "lecture-notes" "slides"
:header 'muse-latex-lecture-notes-header)
(muse-derive-style "lecture-notes-pdf" "slides-pdf"
:header 'muse-latex-lecture-notes-header)
(provide 'muse-latex)
;;; muse-latex.el ends here

277
elpa/muse-3.20/muse-latex2png.el
View File

@ -1,277 +0,0 @@
;; muse-latex2png.el --- generate PNG images from inline LaTeX code
;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Michael Olson <mwolson@gnu.org>
;; Created: 12-Oct-2005
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This was taken from latex2png.el, by Ganesh Swami <ganesh AT
;; iamganesh DOT com>, which was made for emacs-wiki. It has since
;; been extensively rewritten for Muse.
;;; To do
;; Remove stale image files. This could be done by making a function
;; for `muse-before-publish-hook' that deletes according to
;; (muse-page-name).
;;; Code
(require 'muse-publish)
(defgroup muse-latex2png nil
"Publishing LaTeX formulas as PNG files."
:group 'muse-publish)
(defcustom muse-latex2png-img-dest "./latex"
"The folder where the generated images will be placed.
This is relative to the current publishing directory."
:type 'string
:group 'muse-latex2png)
(defcustom muse-latex2png-scale-factor 2.5
"The scale factor to be used for sizing the resulting LaTeX output."
:type 'number
:group 'muse-latex2png)
(defcustom muse-latex2png-fg "Black"
"The foreground color."
:type 'string
:group 'muse-latex2png)
(defcustom muse-latex2png-bg "Transparent"
"The background color."
:type 'string
:group 'muse-latex2png)
(defcustom muse-latex2png-template
"\\documentclass{article}
\\usepackage{fullpage}
\\usepackage{amssymb}
\\usepackage[usenames]{color}
\\usepackage{amsmath}
\\usepackage{latexsym}
\\usepackage[mathscr]{eucal}
%preamble%
\\pagestyle{empty}
\\begin{document}
{%code%}
\\end{document}\n"
"The LaTeX template to use."
:type 'string
:group 'muse-latex2png)
(defun muse-latex2png-move2pubdir (file prefix pubdir)
"Move FILE to the PUBDIR folder.
This is done so that the resulting images do not clutter your
main publishing directory.
Old files with PREFIX in the name are deleted."
(when file
(if (file-exists-p file)
(progn
(unless (file-directory-p pubdir)
(message "Creating latex directory %s" pubdir)
(make-directory pubdir))
(copy-file file (expand-file-name (file-name-nondirectory file)
pubdir)
t)
(delete-file file)
(concat muse-latex2png-img-dest "/" (file-name-nondirectory file)))
(message "Cannot find %s!" file))))
(defun muse-latex2png (code prefix preamble)
"Convert the LaTeX CODE into a png file beginning with PREFIX.
PREAMBLE indicates extra packages and definitions to include."
(unless preamble
(setq preamble ""))
(unless prefix
(setq prefix "muse-latex2png"))
(let* ((tmpdir (cond ((boundp 'temporary-file-directory)
temporary-file-directory)
((fboundp 'temp-directory)
(temp-directory))
(t "/tmp")))
(texfile (expand-file-name
(concat prefix "__" (format "%d" (abs (sxhash code))))
tmpdir))
(defalt-directory default-directory))
(with-temp-file (concat texfile ".tex")
(insert muse-latex2png-template)
(goto-char (point-min))
(while (search-forward "%preamble%" nil t)
(replace-match preamble nil t))
(goto-char (point-min))
(while (search-forward "%code%" nil t)
(replace-match code nil t)))
(setq default-directory tmpdir)
(call-process "latex" nil nil nil texfile)
(if (file-exists-p (concat texfile ".dvi"))
(progn
(call-process
"dvipng" nil nil nil
"-E"
"-fg" muse-latex2png-fg
"-bg" muse-latex2png-bg
"-T" "tight"
"-x" (format "%s" (* muse-latex2png-scale-factor 1000))
"-y" (format "%s" (* muse-latex2png-scale-factor 1000))
"-o" (concat texfile ".png")
(concat texfile ".dvi"))
(if (file-exists-p (concat texfile ".png"))
(progn
(delete-file (concat texfile ".dvi"))
(delete-file (concat texfile ".tex"))
(delete-file (concat texfile ".aux"))
(delete-file (concat texfile ".log"))
(concat texfile ".png"))
(message "Failed to create png file")
nil))
(message (concat "Failed to create dvi file " texfile))
nil)))
(defun muse-latex2png-region (beg end attrs)
"Generate an image for the Latex code between BEG and END.
If a Muse page is currently being published, replace the given
region with the appropriate markup that displays the image.
Otherwise, just return the path of the generated image.
Valid keys for the ATTRS alist are as follows.
prefix: The prefix given to the image file.
preamble: Extra text to add to the Latex preamble.
inline: Display image as inline, instead of a block."
(let ((end-marker (set-marker (make-marker) (1+ end)))
(pubdir (expand-file-name
muse-latex2png-img-dest
(file-name-directory muse-publishing-current-output-path))))
(save-restriction
(narrow-to-region beg end)
(let* ((text (buffer-substring-no-properties beg end))
;; the prefix given to the image file.
(prefix (cdr (assoc "prefix" attrs)))
;; preamble (for extra options)
(preamble (cdr (assoc "preamble" attrs)))
;; display inline or as a block
(display (car (assoc "inline" attrs))))
(when muse-publishing-p
(delete-region beg end)
(goto-char (point-min)))
(unless (file-directory-p pubdir)
(make-directory pubdir))
(let ((path (muse-latex2png-move2pubdir
(muse-latex2png text prefix preamble)
prefix pubdir)))
(when path
(when muse-publishing-p
(muse-insert-markup
(if (muse-style-derived-p "html")
(concat "<img src=\"" path
"\" alt=\"latex2png equation\" "
(if display (concat "class=\"latex-inline\"")
(concat "class=\"latex-display\""))
(if (muse-style-derived-p "xhtml")
" />"
">")
(muse-insert-markup "<!-- " text "-->"))
(let ((ext (or (file-name-extension path) ""))
(path (muse-path-sans-extension path)))
(muse-markup-text 'image path ext))))
(goto-char (point-max)))
path))))))
(defun muse-publish-latex-tag (beg end attrs)
"If the current style is not Latex-based, generate an image for the
given Latex code. Otherwise, don't do anything to the region.
See `muse-latex2png-region' for valid keys for ATTRS."
(unless (assoc "prefix" attrs)
(setq attrs (cons (cons "prefix"
(concat "latex2png-" (muse-page-name)))
attrs)))
(if (or (muse-style-derived-p "latex") (muse-style-derived-p "context"))
(muse-publish-mark-read-only beg end)
(muse-latex2png-region beg end attrs)))
(put 'muse-publish-latex-tag 'muse-dangerous-tag t)
(defun muse-publish-math-tag (beg end)
"Surround the given region with \"$\" characters. Then, if the
current style is not Latex-based, generate an image for the given
Latex math code.
If 6 or more spaces come before the tag, and the end of the tag
is at the end of a line, then surround the region with the
equivalent of \"$$\" instead. This causes the region to be
centered in the published output, among other things."
(let* ((centered (and (re-search-backward
(concat "^[" muse-regexp-blank "]\\{6,\\}\\=")
nil t)
(save-excursion
(save-match-data
(goto-char end)
(looking-at (concat "[" muse-regexp-blank "]*$"))))
(prog1 t
(replace-match "")
(when (and (or (muse-style-derived-p "latex")
(muse-style-derived-p "context"))
(not (bobp)))
(backward-char 1)
(if (bolp)
(delete-char 1)
(forward-char 1)))
(setq beg (point)))))
(tag-beg (if centered
(if (muse-style-derived-p "context")
"\\startformula " "\\[ ")
"$"))
(tag-end (if centered
(if (muse-style-derived-p "context")
" \\stopformula" " \\]")
"$"))
(attrs (nconc (list (cons "prefix"
(concat "latex2png-" (muse-page-name))))
(if centered nil
'(("inline" . t))))))
(goto-char beg)
(muse-insert-markup tag-beg)
(goto-char end)
(muse-insert-markup tag-end)
(if (or (muse-style-derived-p "latex") (muse-style-derived-p "context"))
(muse-publish-mark-read-only beg (point))
(muse-latex2png-region beg (point) attrs))))
(put 'muse-publish-math-tag 'muse-dangerous-tag t)
;;; Insinuate with muse-publish
(add-to-list 'muse-publish-markup-tags
'("latex" t t nil muse-publish-latex-tag)
t)
(add-to-list 'muse-publish-markup-tags
'("math" t nil nil muse-publish-math-tag)
t)
(provide 'muse-latex2png)
;;; muse-latex2png.el ends here

1013
elpa/muse-3.20/muse-mode.el
View File

File diff suppressed because it is too large Load Diff

2
elpa/muse-3.20/muse-pkg.el
View File

@ -1,2 +0,0 @@
(define-package "muse" "3.20"
"Authoring and publishing tool")

263
elpa/muse-3.20/muse-poem.el
View File

@ -1,263 +0,0 @@
;;; muse-poem.el --- publish a poem to LaTex or PDF
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This file specifies a form for recording poetry. It is as follows.
;;
;; Title
;;
;;
;; Body of poem
;;
;;
;; Annotations, history, notes, etc.
;;
;; The `muse-poem' module makes it easy to attractively publish and
;; reference poems in this format, using the "memoir" module for LaTeX
;; publishing. It will also markup poems for every other output
;; style, though none are nearly as pretty.
;;
;; Once a poem is written in this format, just publish it to PDF using
;; the "poem-pdf" style. To make an inlined reference to a poem that
;; you've written -- for example, from a blog page -- there is a
;; "poem" tag defined by this module:
;;
;; <poem title="name.of.poem.page">
;;
;; Let's assume the template above was called "name.of.poem.page";
;; then the above tag would result in this inclusion:
;;
;; ** Title
;;
;; > Body of poem
;;
;; I use this module for publishing all of the poems on my website,
;; which are at: http://www.newartisans.com/johnw/poems.html.
;;; Contributors:
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse Poem Publishing
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-latex)
(require 'muse-project)
(defgroup muse-poem nil
"Rules for marking up a Muse file as a LaTeX article."
:group 'muse-latex)
(defcustom muse-poem-latex-header
"\\documentclass[14pt,oneside]{memoir}
\\usepackage[english]{babel}
\\usepackage[latin1]{inputenc}
\\usepackage[T1]{fontenc}
\\setlength{\\beforepoemtitleskip}{-5.0ex}
\\begin{document}
\\pagestyle{empty}
\\renewcommand{\\poemtoc}{section}
\\settocdepth{section}
\\mbox{}
\\vfill
\\poemtitle{<lisp>(muse-publishing-directive \"title\")</lisp>}
\\settowidth{\\versewidth}{<lisp>muse-poem-longest-line</lisp>}\n\n"
"Header used for publishing LaTeX poems. This may be text or a filename."
:type 'string
:group 'muse-poem)
(defcustom muse-poem-latex-footer "\n\\vfill
\\mbox{}
\\end{document}"
"Footer used for publishing LaTeX files. This may be text or a filename."
:type 'string
:group 'muse-poem)
(defcustom muse-poem-markup-strings
'((begin-verse . "\\begin{verse}[\\versewidth]\n")
(verse-space . "\\vin "))
"Strings used for marking up poems.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles."
:type '(alist :key-type symbol :value-type string)
:group 'muse-poem)
(defcustom muse-chapbook-latex-header
"\\documentclass{book}
\\usepackage[english]{babel}
\\usepackage[latin1]{inputenc}
\\usepackage[T1]{fontenc}
\\setlength{\\beforepoemtitleskip}{-5.0ex}
\\begin{document}
\\title{<lisp>(muse-publishing-directive \"title\")</lisp>}
\\author{<lisp>(muse-publishing-directive \"author\")</lisp>}
\\date{<lisp>(muse-publishing-directive \"date\")</lisp>}
\\maketitle
\\tableofcontents
\\renewcommand{\\poemtoc}{section}
\\settocdepth{section}\n"
"Header used for publishing a book of poems in LaTeX form.
This may be text or a filename."
:type 'string
:group 'muse-poem)
(defcustom muse-chapbook-latex-footer "\n\\end{document}"
"Footer used for publishing a book of poems in LaTeX form.
This may be text or a filename."
:type 'string
:group 'muse-poem)
(defvar muse-poem-longest-line "")
(defcustom muse-poem-chapbook-strings
'((begin-verse . "\\newpage
\\mbox{}
\\vfill
\\poemtitle{<lisp>(muse-publishing-directive \"title\")</lisp>}
\\settowidth{\\versewidth}{<lisp>muse-poem-longest-line</lisp>}
\\begin{verse}[\\versewidth]\n")
(end-verse . "\n\\end{verse}\n\\vfill\n\\mbox{}")
(verse-space . "\\vin "))
"Strings used for marking up books of poems.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles."
:type '(alist :key-type symbol :value-type string)
:group 'muse-poem)
(defun muse-poem-prepare-buffer ()
(goto-char (point-min))
(insert "#title ")
(forward-line 1)
(delete-region (point) (1+ (muse-line-end-position)))
(insert "\n<verse>")
(let ((beg (point)) end line)
(if (search-forward "\n\n\n" nil t)
(progn
(setq end (copy-marker (match-beginning 0) t))
(replace-match "\n</verse>\n")
(delete-region (point) (point-max)))
(goto-char (point-max))
(setq end (point))
(insert "</verse>\n"))
(goto-char (1+ beg))
(set (make-local-variable 'muse-poem-longest-line) "")
(while (< (point) end)
(setq line (buffer-substring-no-properties (point)
(muse-line-end-position)))
(if (> (length line) (length muse-poem-longest-line))
(setq muse-poem-longest-line line))
(forward-line 1))
nil))
(defvar muse-poem-tag '("poem" nil t nil muse-poem-markup-tag))
(defun muse-poem-markup-tag (beg end attrs)
"This markup tag allows a poem to be included from another project page.
The form of usage is:
<poem title=\"page.name\">"
(let ((page (cdr (assoc (cdr (assoc "title" attrs))
(muse-project-file-alist))))
beg end)
(if (null page)
(insert " *Reference to\n unknown poem \""
(cdr (assoc "title" attrs)) "\".*\n")
(setq beg (point))
(insert
(muse-with-temp-buffer
(muse-insert-file-contents page)
(goto-char (point-min))
(if (assoc "nohead" attrs)
(progn
(forward-line 3)
(delete-region (point-min) (point)))
(insert "** ")
(search-forward "\n\n\n")
(replace-match "\n\n"))
(if (search-forward "\n\n\n" nil t)
(setq end (match-beginning 0))
(setq end (point-max)))
(buffer-substring-no-properties (point-min) end)))
(setq end (point-marker))
(goto-char beg)
(unless (assoc "nohead" attrs)
(forward-line 2))
(while (< (point) end)
(insert "> ")
(forward-line 1))
(set-marker end nil))))
(put 'muse-poem-markup-tag 'muse-dangerous-tag t)
(add-to-list 'muse-publish-markup-tags muse-poem-tag)
;;; Register the Muse POEM Publishers
(muse-derive-style "poem-latex" "latex"
:before 'muse-poem-prepare-buffer
:strings 'muse-poem-markup-strings
:header 'muse-poem-latex-header
:footer 'muse-poem-latex-footer)
(muse-derive-style "poem-pdf" "pdf"
:before 'muse-poem-prepare-buffer
:strings 'muse-poem-markup-strings
:header 'muse-poem-latex-header
:footer 'muse-poem-latex-footer)
(muse-derive-style "chapbook-latex" "latex"
:before 'muse-poem-prepare-buffer
:strings 'muse-poem-chapbook-strings
:header 'muse-chapbook-latex-header
:footer 'muse-chapbook-latex-footer)
(muse-derive-style "chapbook-pdf" "pdf"
:before 'muse-poem-prepare-buffer
:strings 'muse-poem-chapbook-strings
:header 'muse-chapbook-latex-header
:footer 'muse-chapbook-latex-footer)
(provide 'muse-poem)
;;; muse-poem.el ends here

973
elpa/muse-3.20/muse-project.el
View File

@ -1,973 +0,0 @@
;;; muse-project.el --- handle Muse projects
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Contributors:
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse Project Maintainance
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide 'muse-project)
(require 'muse)
(require 'muse-publish)
(require 'cus-edit)
(defgroup muse-project nil
"Options controlling the behavior of Muse project handling."
:group 'muse)
(defcustom muse-before-project-publish-hook nil
"A hook run before a project is published.
Each function is passed the project object, a cons with the format
(PROJNAME . SETTINGS)"
:type 'hook
:group 'muse-project)
(defcustom muse-after-project-publish-hook nil
"A hook run after a project is published.
Each function is passed the project object, a cons with the format
(PROJNAME . SETTINGS)"
:type 'hook
:group 'muse-project)
(defvar muse-project-alist-using-customize nil
"Used internally by Muse to indicate whether `muse-project-alist'
has been modified via the customize interface.")
(make-variable-buffer-local 'muse-project-alist-using-customize)
(defmacro with-muse-project (project &rest body)
`(progn
(unless (muse-project ,project)
(error "Can't find project %s" ,project))
(with-temp-buffer
(muse-mode)
(setq muse-current-project (muse-project ,project))
(muse-project-set-variables)
,@body)))
(put 'with-muse-project 'lisp-indent-function 0)
(put 'with-muse-project 'edebug-form-spec '(sexp body))
(defun muse-project-alist-get (sym)
"Turn `muse-project-alist' into something we can customize easily."
(when (boundp sym)
(setq muse-project-alist-using-customize t)
(let* ((val (copy-alist (symbol-value sym)))
(head val))
(while val
(let ((head (car (cdar val)))
res)
;; Turn settings of first part into cons cells, symbol->string
(while head
(cond ((stringp (car head))
(add-to-list 'res (car head) t)
(setq head (cdr head)))
((symbolp (car head))
(add-to-list 'res (list (symbol-name (car head))
(cadr head)) t)
(setq head (cddr head)))
(t
(setq head (cdr head)))))
(setcdr (car val) (cons res (cdr (cdar val)))))
(let ((styles (cdar val)))
;; Symbol->string in every style
(while (cdr styles)
(let ((head (cadr styles))
res)
(while (consp head)
(setq res (plist-put res (symbol-name (car head))
(cadr head)))
(setq head (cddr head)))
(setcdr styles (cons res (cddr styles))))
(setq styles (cdr styles))))
(setq val (cdr val)))
head)))
(defun muse-project-alist-set (sym val)
"Turn customized version of `muse-project-alist' into something
Muse can make use of."
(set sym val)
(when muse-project-alist-using-customize
;; Make sure the unescaped version is written to .emacs
(put sym 'saved-value (list (custom-quote val)))
;; Perform unescaping
(while val
(let ((head (car (cdar val)))
res)
;; Turn cons cells into flat list, string->symbol
(while head
(cond ((stringp (car head))
(add-to-list 'res (car head) t))
((consp (car head))
(add-to-list 'res (intern (caar head)) t)
(add-to-list 'res (car (cdar head)) t)))
(setq head (cdr head)))
(setcdr (car val) (cons res (cdr (cdar val)))))
(let ((styles (cdar val)))
;; String->symbol in every style
(while (cdr styles)
(let ((head (cadr styles))
res)
(while (consp head)
(setq res (plist-put res (intern (car head))
(cadr head)))
(setq head (cddr head)))
(setcdr styles (cons res (cddr styles))))
(setq styles (cdr styles))))
(setq val (cdr val)))))
(define-widget 'muse-project 'default
"A widget that defines a Muse project."
:format "\n%v"
:value-create 'muse-widget-type-value-create
:value-get 'muse-widget-child-value-get
:value-delete 'ignore
:match 'muse-widget-type-match
:type '(cons :format " %v"
(repeat :tag "Settings" :format "%{%t%}:\n%v%i\n\n"
(choice
(string :tag "Directory")
(list :tag "Book function"
(const :tag ":book-funcall" ":book-funcall")
(choice (function)
(sexp :tag "Unknown")))
(list :tag "Book part"
(const :tag ":book-part" ":book-part")
(string :tag "Name"))
(list :tag "Book style"
(const :tag ":book-style" ":book-style")
(string :tag "Style"))
(list :tag "Default file"
(const :tag ":default" ":default")
(string :tag "File"))
(list :tag "End of book"
(const :tag ":book-end" ":book-end")
(const t))
(list :tag "Force publishing"
(const :tag ":force-publish" ":force-publish")
(repeat (string :tag "File")))
(list :tag "Major mode"
(const :tag ":major-mode" ":major-mode")
(choice (function :tag "Mode")
(sexp :tag "Unknown")))
(list :tag "New chapter"
(const :tag ":book-chapter" ":book-chapter")
(string :tag "Name"))
(list :tag "No chapters"
(const :tag ":nochapters" ":nochapters")
(const t))
(list :tag "Project-level publishing function"
(const :tag ":publish-project"
":publish-project")
(choice (function :tag "Function")
(sexp :tag "Unknown")))
(list :tag "Set variables"
(const :tag ":set" ":set")
(repeat (list :inline t
(symbol :tag "Variable")
(sexp :tag "Setting"))))
(list :tag "Visit links using"
(const :tag ":visit-link" ":visit-link")
(choice (function)
(sexp :tag "Unknown")))))
(repeat :tag "Output styles" :format "%{%t%}:\n%v%i\n\n"
(set :tag "Style"
(list :inline t
:tag "Publishing style"
(const :tag ":base" ":base")
(string :tag "Style"))
(list :inline t
:tag "Base URL"
(const :tag ":base-url" ":base-url")
(string :tag "URL"))
(list :inline t
:tag "Exclude matching"
(const :tag ":exclude" ":exclude")
(regexp))
(list :inline t
:tag "Include matching"
(const :tag ":include" ":include")
(regexp))
(list :inline t
:tag "Timestamps file"
(const :tag ":timestamps" ":timestamps")
(file))
(list :inline t
:tag "Path"
(const :tag ":path" ":path")
(string :tag "Path"))))))
(defcustom muse-project-alist nil
"An alist of Muse projects.
A project defines a fileset, and a list of custom attributes for use
when publishing files in that project."
:type '(choice (const :tag "No projects defined." nil)
(repeat (cons :format "%{%t%}:\n\n%v"
:tag "Project" :indent 4
(string :tag "Project name")
muse-project))
(sexp :tag "Cannot parse expression"))
:get 'muse-project-alist-get
:set 'muse-project-alist-set
:group 'muse-project)
;; Make it easier to specify a muse-project-alist entry
(defcustom muse-project-ignore-regexp
(concat "\\`\\(#.*#\\|.*,v\\|.*~\\|\\.\\.?\\|\\.#.*\\|,.*\\)\\'\\|"
"/\\(CVS\\|RCS\\|\\.arch-ids\\|{arch}\\|,.*\\|\\.svn\\|"
"\\.hg\\|\\.git\\|\\.bzr\\|_darcs\\)\\(/\\|\\'\\)")
"A regexp matching files to be ignored in Muse directories.
You should set `case-fold-search' to nil before using this regexp
in code."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-project-publish-private-files t
"If this is non-nil, files will be published even if their permissions
are set so that no one else on the filesystem can read them.
Set this to nil if you would like to indicate that some files
should not be published by manually doing \"chmod o-rwx\" on
them.
This setting has no effect under Windows (that is, all files are
published regardless of permissions) because Windows lacks the
needed filesystem attributes."
:type 'boolean
:group 'muse-project)
(defun muse-project-recurse-directory (base)
"Recusively retrieve all of the directories underneath BASE.
A list of these directories is returned.
Directories starting with \".\" will be ignored, as well as those
which match `muse-project-ignore-regexp'."
(let ((case-fold-search nil)
list dir)
(when (and (file-directory-p base)
(not (string-match muse-project-ignore-regexp base)))
(dolist (file (directory-files base t "^[^.]"))
(when (and (file-directory-p file)
(not (string-match muse-project-ignore-regexp file)))
(setq dir (file-name-nondirectory file))
(push dir list)
(nconc list (mapcar #'(lambda (item)
(concat dir "/" item))
(muse-project-recurse-directory file)))))
list)))
(defun muse-project-alist-styles (entry-dir output-dir style &rest other)
"Return a list of styles to use in a `muse-project-alist' entry.
ENTRY-DIR is the top-level directory of the project.
OUTPUT-DIR is where Muse files are published, keeping directory structure.
STYLE is the publishing style to use.
OTHER contains other definitions to add to each style. It is optional.
For an example of the use of this function, see
`examples/mwolson/muse-init.el' from the Muse distribution."
(let ((fnd (file-name-nondirectory entry-dir)))
(when (string= fnd "")
;; deal with cases like "foo/" that have a trailing slash
(setq fnd (file-name-nondirectory (substring entry-dir 0 -1))))
(cons `(:base ,style :path ,(if (muse-file-remote-p output-dir)
output-dir
(expand-file-name output-dir))
:include ,(concat "/" fnd "/[^/]+$")
,@other)
(mapcar (lambda (dir)
`(:base ,style
:path ,(expand-file-name dir output-dir)
:include ,(concat "/" dir "/[^/]+$")
,@other))
(muse-project-recurse-directory entry-dir)))))
(defun muse-project-alist-dirs (entry-dir)
"Return a list of directories to use in a `muse-project-alist' entry.
ENTRY-DIR is the top-level directory of the project.
For an example of the use of this function, see
`examples/mwolson/muse-init.el' from the Muse distribution."
(cons (expand-file-name entry-dir)
(mapcar (lambda (dir) (expand-file-name dir entry-dir))
(muse-project-recurse-directory entry-dir))))
;; Constructing the file-alist
(defvar muse-project-file-alist nil
"This variable is automagically constructed as needed.")
(defvar muse-project-file-alist-hook nil
"Functions that are to be exectuted immediately after updating
`muse-project-file-alist'.")
(defvar muse-current-project nil
"Project we are currently visiting.")
(make-variable-buffer-local 'muse-current-project)
(defvar muse-current-project-global nil
"Project we are currently visiting. This is used to propagate the value
of `muse-current-project' into a new buffer during publishing.")
(defvar muse-current-output-style nil
"The output style that we are currently using for publishing files.")
(defsubst muse-project (&optional project)
"Resolve the given PROJECT into a full Muse project, if it is a string."
(if (null project)
(or muse-current-project
(muse-project-of-file))
(if (stringp project)
(assoc project muse-project-alist)
(muse-assert (consp project))
project)))
(defun muse-project-page-file (page project &optional no-check-p)
"Return a filename if PAGE exists within the given Muse PROJECT."
(setq project (muse-project project))
(if (null page)
;; if not given a page, return the first directory instead
(let ((pats (cadr project)))
(catch 'done
(while pats
(if (symbolp (car pats))
(setq pats (cddr pats))
(throw 'done (file-name-as-directory (car pats)))))))
(let ((dir (file-name-directory page))
(expanded-path nil))
(when dir
(setq expanded-path (concat (expand-file-name
page
(file-name-directory (muse-current-file)))
(when muse-file-extension
(concat "." muse-file-extension))))
(setq page (file-name-nondirectory page)))
(let ((files (muse-collect-alist
(muse-project-file-alist project no-check-p)
page))
(matches nil))
(if dir
(catch 'done
(save-match-data
(dolist (file files)
(if (and expanded-path
(string= expanded-path (cdr file)))
(throw 'done (cdr file))
(let ((pos (string-match (concat (regexp-quote dir) "\\'")
(file-name-directory
(cdr file)))))
(when pos
(setq matches (cons (cons pos (cdr file))
matches)))))))
;; if we haven't found an exact match, pick a candidate
(car (muse-sort-by-rating matches)))
(dolist (file files)
(setq matches (cons (cons (length (cdr file)) (cdr file))
matches)))
(car (muse-sort-by-rating matches '<)))))))
(defun muse-project-private-p (file)
"Return non-nil if NAME is a private page with PROJECT."
(unless (or muse-under-windows-p
muse-project-publish-private-files)
(setq file (file-truename file))
(if (file-attributes file) ; don't publish if no attributes exist
(or (when (eq ?- (aref (nth 8 (file-attributes
(file-name-directory file))) 7))
(message (concat
"The " (file-name-directory file)
" directory must be readable by others"
" in order for its contents to be published.")))
(eq ?- (aref (nth 8 (file-attributes file)) 7)))
t)))
(defun muse-project-file-entries (path)
(let* ((names (list t))
(lnames names)
(case-fold-search nil))
(cond
((file-directory-p path)
(dolist (file (directory-files
path t (when (and muse-file-extension
(not (string= muse-file-extension "")))
(concat "." muse-file-extension "\\'"))))
(unless (or (string-match muse-project-ignore-regexp file)
(string-match muse-project-ignore-regexp
(file-name-nondirectory file))
(file-directory-p file))
(setcdr lnames
(cons (cons (muse-page-name file) file) nil))
(setq lnames (cdr lnames)))))
((file-readable-p path)
(setcdr lnames
(cons (cons (muse-page-name path) path) nil))
(setq lnames (cdr lnames)))
(t ; regexp
(muse-assert (file-name-directory path))
(dolist (file (directory-files
(file-name-directory path) t
(file-name-nondirectory path)))
(unless (or (string-match muse-project-ignore-regexp file)
(string-match muse-project-ignore-regexp
(file-name-nondirectory file)))
(setcdr lnames
(cons (cons (muse-page-name file) file) nil))
(setq lnames (cdr lnames))))))
(cdr names)))
(defvar muse-updating-file-alist-p nil
"Make sure that recursive calls to `muse-project-file-alist' are bounded.")
(defun muse-project-determine-last-mod (project &optional no-check-p)
"Return the most recent last-modified timestamp of dirs in PROJECT."
(let ((last-mod nil))
(unless (or muse-under-windows-p no-check-p)
(let ((pats (cadr project)))
(while pats
(if (symbolp (car pats))
(setq pats (cddr pats))
(let* ((fnd (file-name-directory (car pats)))
(dir (cond ((file-directory-p (car pats))
(car pats))
((and (not (file-readable-p (car pats)))
fnd
(file-directory-p fnd))
fnd))))
(when dir
(let ((mod-time (nth 5 (file-attributes dir))))
(when (or (null last-mod)
(and mod-time
(muse-time-less-p last-mod mod-time)))
(setq last-mod mod-time)))))
(setq pats (cdr pats))))))
last-mod))
(defun muse-project-file-alist (&optional project no-check-p)
"Return member filenames for the given Muse PROJECT.
Also, update the `muse-project-file-alist' variable.
On UNIX, this alist is only updated if one of the directories'
contents have changed. On Windows, it is always reread from
disk.
If NO-CHECK-P is non-nil, do not update the alist, just return
the current one."
(setq project (muse-project project))
(when (and project muse-project-alist)
(let* ((file-alist (assoc (car project) muse-project-file-alist))
(last-mod (muse-project-determine-last-mod project no-check-p)))
;; Either return the currently known list, or read it again from
;; disk
(if (or (and no-check-p (cadr file-alist))
muse-updating-file-alist-p
(not (or muse-under-windows-p
(null (cddr file-alist))
(null last-mod)
(muse-time-less-p (cddr file-alist) last-mod))))
(cadr file-alist)
(if file-alist
(setcdr (cdr file-alist) last-mod)
(setq file-alist (cons (car project) (cons nil last-mod))
muse-project-file-alist
(cons file-alist muse-project-file-alist)))
;; Read in all of the file entries
(let ((muse-updating-file-alist-p t))
(prog1
(save-match-data
(setcar
(cdr file-alist)
(let* ((names (list t))
(pats (cadr project)))
(while pats
(if (symbolp (car pats))
(setq pats (cddr pats))
(nconc names (muse-project-file-entries (car pats)))
(setq pats (cdr pats))))
(cdr names))))
(run-hooks 'muse-project-file-alist-hook)))))))
(defun muse-project-add-to-alist (file &optional project)
"Make sure FILE is added to `muse-project-file-alist'.
It works by either calling the `muse-project-file-alist' function
if a directory has been modified since we last checked, or
manually forcing the file entry to exist in the alist. This
works around an issue where if several files being saved at the
same time, only the first one will make it into the alist. It is
meant to be called by `muse-project-after-save-hook'.
The project of the file is determined by either the PROJECT
argument, or `muse-project-of-file' if PROJECT is not specified."
(setq project (or (muse-project project) (muse-project-of-file file)))
(when (and project muse-project-alist)
(let* ((file-alist (assoc (car project) muse-project-file-alist))
(last-mod (muse-project-determine-last-mod project)))
;; Determine whether we need to call this
(if (or (null (cddr file-alist))
(null last-mod)
(muse-time-less-p (cddr file-alist) last-mod))
;; The directory will show up as modified, so go ahead and
;; call `muse-project-file-alist'
(muse-project-file-alist project)
;; It is not showing as modified, so forcefully add the
;; current file to the project file-alist
(let ((muse-updating-file-alist-p t))
(prog1
(save-match-data
(setcar (cdr file-alist)
(nconc (muse-project-file-entries file)
(cadr file-alist))))
(run-hooks 'muse-project-file-alist-hook)))))))
(defun muse-project-of-file (&optional pathname)
"Determine which project the given PATHNAME relates to.
If PATHNAME is nil, the current buffer's filename is used."
(if (and (null pathname) muse-current-project)
muse-current-project
(unless pathname (setq pathname (muse-current-file)))
(save-match-data
(when (and (stringp pathname)
muse-project-alist
(not (string= pathname ""))
(not (let ((case-fold-search nil))
(or (string-match muse-project-ignore-regexp
pathname)
(string-match muse-project-ignore-regexp
(file-name-nondirectory
pathname))))))
(let* ((file (file-truename pathname))
(dir (file-name-directory file))
found rating matches)
(catch 'found
(dolist (project-entry muse-project-alist)
(let ((pats (cadr project-entry)))
(while pats
(if (symbolp (car pats))
(setq pats (cddr pats))
(let ((tname (file-truename (car pats))))
(cond ((or (string= tname file)
(string= (file-name-as-directory tname) dir))
(throw 'found project-entry))
((string-match (concat "\\`" (regexp-quote tname))
file)
(setq matches (cons (cons (match-end 0)
project-entry)
matches)))))
(setq pats (cdr pats))))))
;; if we haven't found an exact match, pick a candidate
(car (muse-sort-by-rating matches))))))))
(defun muse-project-after-save-hook ()
"Update Muse's file-alist if we are saving a Muse file."
(let ((project (muse-project-of-file)))
(when project
(muse-project-add-to-alist (buffer-file-name) project))))
(add-hook 'after-save-hook 'muse-project-after-save-hook)
(defun muse-read-project (prompt &optional no-check-p no-assume)
"Read a project name from the minibuffer, if it can't be figured
out."
(if (null muse-project-alist)
(error "There are no Muse projects defined; see `muse-project-alist'")
(or (unless no-check-p
(muse-project-of-file))
(if (and (not no-assume)
(= 1 (length muse-project-alist)))
(car muse-project-alist)
(assoc (funcall muse-completing-read-function
prompt muse-project-alist)
muse-project-alist)))))
(defvar muse-project-page-history nil)
(defun muse-read-project-file (project prompt &optional default)
(let* ((file-list (muse-delete-dups
(mapcar #'(lambda (a) (list (car a)))
(muse-project-file-alist project))))
(name (funcall muse-completing-read-function
prompt file-list nil nil nil
'muse-project-page-history default)))
(cons name (muse-project-page-file name project))))
;;;###autoload
(defun muse-project-find-file (name project &optional command directory)
"Open the Muse page given by NAME in PROJECT.
If COMMAND is non-nil, it is the function used to visit the file.
If DIRECTORY is non-nil, it is the directory in which the page
will be created if it does not already exist. Otherwise, the
first directory within the project's fileset is used."
(interactive
(let* ((project (muse-read-project "Find in project: "
current-prefix-arg))
(default (muse-get-keyword :default (cadr project)))
(entry (muse-read-project-file
project (if default
(format "Find page: (default: %s) "
default)
"Find page: ")
default)))
(list entry project)))
(setq project (muse-project project))
(let ((project-name (car project)))
(unless (interactive-p)
(setq project (muse-project project)
name (cons name (muse-project-page-file name project))))
;; If we're given a relative or absolute filename, open it as-is
(if (and (car name)
(save-match-data
(or (string-match "\\`\\.+/" (car name))
(string-match muse-file-regexp (car name))
(string-match muse-image-regexp (car name)))))
(setcdr name (car name))
;; At this point, name is (PAGE . FILE).
(unless (cdr name)
(let ((pats (cadr project)))
(while (and pats (null directory))
(if (symbolp (car pats))
(setq pats (cddr pats))
(if (file-directory-p (car pats))
(setq directory (car pats) pats nil)
(setq pats (cdr pats))))))
(when directory
(let ((filename (expand-file-name (car name) directory)))
(when (and muse-file-extension
(not (string= muse-file-extension ""))
(not (file-exists-p (car name))))
(setq filename (concat filename "." muse-file-extension)))
(unless (file-exists-p directory)
(make-directory directory t))
(setcdr name filename)))))
;; Open the file
(if (cdr name)
(funcall (or command 'find-file) (cdr name))
(error "There is no page %s in project %s"
(car name) project-name))))
(defun muse-project-choose-style (closure test styles)
"Run TEST on STYLES and return first style where TEST yields non-nil.
TEST should take two arguments. The first is CLOSURE, which is
passed verbatim. The second if the current style to consider.
If no style passes TEST, return the first style."
(or (catch 'winner
(dolist (style styles)
(when (funcall test closure style)
(throw 'winner style))))
(car styles)))
(defun muse-project-choose-style-by-link-suffix (given-suffix style)
"If the given STYLE has a link-suffix that equals GIVEN-SUFFIX,
return non-nil."
(let ((link-suffix (or (muse-style-element :link-suffix style)
(muse-style-element :suffix style))))
(and (stringp link-suffix)
(string= given-suffix link-suffix))))
(defun muse-project-applicable-styles (file styles)
"Given STYLES, return a list of the ones that are considered for FILE.
The name of a project may be used for STYLES."
(when (stringp styles)
(setq styles (cddr (muse-project styles))))
(when (and file styles)
(let ((used-styles nil))
(dolist (style styles)
(let ((include-regexp (muse-style-element :include style))
(exclude-regexp (muse-style-element :exclude style))
(rating nil))
(when (and (or (and (null include-regexp)
(null exclude-regexp))
(if include-regexp
(setq rating (string-match include-regexp file))
(not (string-match exclude-regexp file))))
(file-exists-p file)
(not (muse-project-private-p file)))
(setq used-styles (cons (cons rating style) used-styles)))))
(muse-sort-by-rating (nreverse used-styles)))))
(defun muse-project-get-applicable-style (file styles)
"Choose a style from the STYLES that FILE can publish to.
The user is prompted if several styles are found."
(muse-publish-get-style
(mapcar (lambda (style)
(cons (muse-get-keyword :base style) style))
(muse-project-applicable-styles file styles))))
(defun muse-project-resolve-directory (page local-style remote-style)
"Figure out the directory part of the path that provides a link to PAGE.
LOCAL-STYLE is the style of the current Muse file, and
REMOTE-STYLE is the style associated with PAGE.
If REMOTE-STYLE has a :base-url element, concatenate it and PAGE.
Otherwise, return a relative link."
(let ((prefix (muse-style-element :base-url remote-style)))
(if prefix
(concat prefix page)
(file-relative-name (expand-file-name
(file-name-nondirectory page)
(muse-style-element :path remote-style))
(expand-file-name
(muse-style-element :path local-style))))))
(defun muse-project-resolve-link (page local-style remote-styles)
"Return a published link from the output path of one file to another file.
The best match for PAGE is determined by comparing the link
suffix of the given local style and that of the remote styles.
The remote styles are usually populated by
`muse-project-applicable-styles'.
If no remote style is found, return PAGE verbatim
If PAGE has a :base-url associated with it, return the
concatenation of the :base-url value and PAGE.
Otherwise, return a relative path from the directory of
LOCAL-STYLE to the best directory among REMOTE-STYLES."
(let ((link-suffix (or (muse-style-element :link-suffix local-style)
(muse-style-element :suffix local-style)))
remote-style)
(if (not (stringp link-suffix))
(setq remote-style (car remote-styles))
(setq remote-style (muse-project-choose-style
link-suffix
#'muse-project-choose-style-by-link-suffix
remote-styles)))
(if (null remote-style)
page
(setq page (muse-project-resolve-directory
page local-style remote-style))
(concat (file-name-directory page)
(muse-publish-link-name page remote-style)))))
(defun muse-project-current-output-style (&optional file project)
(or muse-current-output-style
(progn
(unless file (setq file (muse-current-file)))
(unless project (setq project (muse-project-of-file file)))
(car (muse-project-applicable-styles file (cddr project))))))
(defun muse-project-link-page (page)
(let ((project (muse-project-of-file)))
(muse-project-resolve-link page
(muse-project-current-output-style)
(muse-project-applicable-styles
(muse-project-page-file page project)
(cddr project)))))
(defun muse-project-publish-file-default (file style output-dir force)
;; ensure the publishing location is available
(unless (file-exists-p output-dir)
(message "Creating publishing directory %s" output-dir)
(make-directory output-dir t))
;; publish the member file!
(muse-publish-file file style output-dir force))
(defun muse-project-publish-file (file styles &optional force)
(setq styles (muse-project-applicable-styles file styles))
(let (published)
(dolist (style styles)
(if (or (not (listp style))
(not (cdr style)))
(muse-display-warning
(concat "Skipping malformed muse-project-alist style."
"\nPlease double-check your configuration,"))
(let ((output-dir (muse-style-element :path style))
(muse-current-output-style style)
(fun (or (muse-style-element :publish style t)
'muse-project-publish-file-default)))
(when (funcall fun file style output-dir force)
(setq published t)))))
published))
;;;###autoload
(defun muse-project-publish-this-file (&optional force style)
"Publish the currently-visited file according to `muse-project-alist',
prompting if more than one style applies.
If FORCE is given, publish the file even if it is up-to-date.
If STYLE is given, use that publishing style rather than
prompting for one."
(interactive (list current-prefix-arg))
(let ((muse-current-project (muse-project-of-file)))
(if (not muse-current-project)
;; file is not part of a project, so fall back to muse-publish
(if (interactive-p) (call-interactively 'muse-publish-this-file)
(muse-publish-this-file style nil force))
(unless style
(setq style (muse-project-get-applicable-style
buffer-file-name (cddr muse-current-project))))
(let* ((output-dir (muse-style-element :path style))
(muse-current-project-global muse-current-project)
(muse-current-output-style (list :base (car style)
:path output-dir))
(fun (or (muse-style-element :publish style t)
'muse-project-publish-file-default)))
(unless (funcall fun buffer-file-name style output-dir force)
(message (concat "The published version is up-to-date; use"
" C-u C-c C-t to force an update.")))))))
(defun muse-project-save-buffers (&optional project)
(setq project (muse-project project))
(when project
(save-excursion
(map-y-or-n-p
(function
(lambda (buffer)
(and (buffer-modified-p buffer)
(not (buffer-base-buffer buffer))
(or (buffer-file-name buffer)
(progn
(set-buffer buffer)
(and buffer-offer-save
(> (buffer-size) 0))))
(with-current-buffer buffer
(let ((proj (muse-project-of-file)))
(and proj (string= (car proj)
(car project)))))
(if (buffer-file-name buffer)
(format "Save file %s? "
(buffer-file-name buffer))
(format "Save buffer %s? "
(buffer-name buffer))))))
(function
(lambda (buffer)
(set-buffer buffer)
(save-buffer)))
(buffer-list)
'("buffer" "buffers" "save")
(if (boundp 'save-some-buffers-action-alist)
save-some-buffers-action-alist)))))
(defun muse-project-publish-default (project styles &optional force)
"Publish the pages of PROJECT that need publishing."
(setq project (muse-project project))
(let ((published nil))
;; publish all files in the project, for each style; the actual
;; publishing will only happen if the files are newer than the
;; last published output, or if the file is listed in
;; :force-publish. Files in :force-publish will not trigger the
;; "All pages need to be published" message.
(let ((forced-files (muse-get-keyword :force-publish (cadr project)))
(file-alist (muse-project-file-alist project)))
(dolist (pair file-alist)
(when (muse-project-publish-file (cdr pair) styles force)
(setq forced-files (delete (car pair) forced-files))
(setq published t)))
(dolist (file forced-files)
(muse-project-publish-file (cdr (assoc file file-alist)) styles t)))
;; run hook after publishing ends
(run-hook-with-args 'muse-after-project-publish-hook project)
;; notify the user that everything is now done
(if published
(message "All pages in %s have been published." (car project))
(message "No pages in %s need publishing at this time."
(car project)))))
;;;###autoload
(defun muse-project-publish (project &optional force)
"Publish the pages of PROJECT that need publishing."
(interactive (list (muse-read-project "Publish project: " nil t)
current-prefix-arg))
(setq project (muse-project project))
(let ((styles (cddr project))
(muse-current-project project)
(muse-current-project-global project))
;; determine the style from the project, or else ask
(unless styles
(setq styles (list (muse-publish-get-style))))
(unless project
(error "Cannot find a project to publish"))
;; prompt to save any buffers related to this project
(muse-project-save-buffers project)
;; run hook before publishing begins
(run-hook-with-args 'muse-before-project-publish-hook project)
;; run the project-level publisher
(let ((fun (or (muse-get-keyword :publish-project (cadr project) t)
'muse-project-publish-default)))
(funcall fun project styles force))))
(defun muse-project-batch-publish ()
"Publish Muse files in batch mode."
(let ((muse-batch-publishing-p t)
force)
(if (string= "--force" (or (car command-line-args-left) ""))
(setq force t
command-line-args-left (cdr command-line-args-left)))
(if command-line-args-left
(dolist (project command-line-args-left)
(message "Publishing project %s ..." project)
(muse-project-publish project force))
(message "No projects specified."))))
(eval-when-compile
(put 'make-local-hook 'byte-compile nil))
(defun muse-project-set-variables ()
"Load project-specific variables."
(when (and muse-current-project-global (null muse-current-project))
(setq muse-current-project muse-current-project-global))
(let ((vars (muse-get-keyword :set (cadr muse-current-project)))
sym custom-set var)
(while vars
(setq sym (car vars))
(setq custom-set (or (get sym 'custom-set) 'set))
(setq var (if (eq (get sym 'custom-type) 'hook)
(make-local-hook sym)
(make-local-variable sym)))
(funcall custom-set var (car (cdr vars)))
(setq vars (cdr (cdr vars))))))
(custom-add-option 'muse-before-publish-hook 'muse-project-set-variables)
(add-to-list 'muse-before-publish-hook 'muse-project-set-variables)
(defun muse-project-delete-output-files (project)
(interactive
(list (muse-read-project "Remove all output files for project: " nil t)))
(setq project (muse-project project))
(let ((file-alist (muse-project-file-alist project))
(styles (cddr project))
output-file path)
(dolist (entry file-alist)
(dolist (style styles)
(setq output-file
(and (setq path (muse-style-element :path style))
(expand-file-name
(concat (muse-style-element :prefix style)
(car entry)
(or (muse-style-element :osuffix style)
(muse-style-element :suffix style)))
path)))
(if output-file
(muse-delete-file-if-exists output-file))))))
;;; muse-project.el ends here

251
elpa/muse-3.20/muse-protocols.el
View File

@ -1,251 +0,0 @@
;;; muse-protocols.el --- URL protocols that Muse recognizes
;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Brad Collins (brad AT chenla DOT org)
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Here's an example for adding a protocol for the site yubnub, a Web
;; Command line service.
;;
;; (add-to-list 'muse-url-protocols '("yubnub://" muse-browse-url-yubnub
;; muse-resolve-url-yubnub))
;;
;; (defun muse-resolve-url-yubnub (url)
;; "Resolve a yubnub URL."
;; ;; Remove the yubnub://
;; (when (string-match "\\`yubnub://\\(.+\\)" url)
;; (match-string 1)))
;;
;; (defun muse-browse-url-yubnub (url)
;; "If this is a yubnub URL-command, jump to it."
;; (setq url (muse-resolve-url-yubnub url))
;; (browse-url (concat "http://yubnub.org/parser/parse?command="
;; url)))
;;; Contributors:
;; Phillip Lord (Phillip.Lord AT newcastle DOT ac DOT uk) provided a
;; handler for DOI URLs.
;; Stefan Schlee fixed a bug with handling of colons at the end of
;; URLs.
;; Valery V. Vorotyntsev contribued the woman:// protocol handler and
;; simplified `muse-browse-url-man'.
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse URL Protocols
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'info)
(require 'muse-regexps)
(defvar muse-url-regexp nil
"A regexp used to match URLs within a Muse page.
This is autogenerated from `muse-url-protocols'.")
(defun muse-update-url-regexp (sym value)
(setq muse-url-regexp
(concat "\\<\\(" (mapconcat 'car value "\\|") "\\)"
"[^][" muse-regexp-blank "\"'()<>^`{}\n]*"
"[^][" muse-regexp-blank "\"'()<>^`{}.,;:\n]+"))
(set sym value))
(defcustom muse-url-protocols
'(("[uU][rR][lL]:" muse-browse-url-url identity)
("info://" muse-browse-url-info nil)
("man://" muse-browse-url-man nil)
("woman://" muse-browse-url-woman nil)
("google://" muse-browse-url-google muse-resolve-url-google)
("http:/?/?" browse-url identity)
("https:/?/?" browse-url identity)
("ftp:/?/?" browse-url identity)
("gopher://" browse-url identity)
("telnet://" browse-url identity)
("wais://" browse-url identity)
("file://?" browse-url identity)
("dict:" muse-browse-url-dict muse-resolve-url-dict)
("doi:" muse-browse-url-doi muse-resolve-url-doi)
("news:" browse-url identity)
("snews:" browse-url identity)
("mailto:" browse-url identity))
"A list of (PROTOCOL BROWSE-FUN RESOLVE-FUN) used to match URL protocols.
PROTOCOL describes the first part of the URL, including the
\"://\" part. This may be a regexp.
BROWSE-FUN should accept URL as an argument and open the URL in
the current window.
RESOLVE-FUN should accept URL as an argument and return the final
URL, or nil if no URL should be included."
:type '(repeat (list :tag "Protocol"
(string :tag "Regexp")
(function :tag "Browse")
(choice (function :tag "Resolve")
(const :tag "Don't resolve" nil))))
:set 'muse-update-url-regexp
:group 'muse)
(add-hook 'muse-update-values-hook
(lambda ()
(muse-update-url-regexp 'muse-url-protocols muse-url-protocols)))
(defcustom muse-wikipedia-country "en"
"Indicate the 2-digit country code that we use for Wikipedia
queries."
:type 'string
:options '("de" "en" "es" "fr" "it" "pl" "pt" "ja" "nl" "sv")
:group 'muse)
(defun muse-protocol-find (proto list)
"Return the first element of LIST whose car matches the regexp PROTO."
(catch 'found
(dolist (item list)
(when (string-match (concat "\\`" (car item)) proto)
(throw 'found item)))))
;;;###autoload
(defun muse-browse-url (url &optional other-window)
"Handle URL with the function specified in `muse-url-protocols'.
If OTHER-WINDOW is non-nil, open in a different window."
(interactive (list (read-string "URL: ")
current-prefix-arg))
;; Strip text properties
(when (fboundp 'set-text-properties)
(set-text-properties 0 (length url) nil url))
(when other-window
(switch-to-buffer-other-window (current-buffer)))
(when (string-match muse-url-regexp url)
(let* ((proto (match-string 1 url))
(entry (muse-protocol-find proto muse-url-protocols)))
(when entry
(funcall (cadr entry) url)))))
(defun muse-resolve-url (url &rest ignored)
"Resolve URL with the function specified in `muse-url-protocols'."
(when (string-match muse-url-regexp url)
(let* ((proto (match-string 1 url))
(entry (muse-protocol-find proto muse-url-protocols)))
(when entry
(let ((func (car (cddr entry))))
(if func
(setq url (funcall func url))
(setq url nil))))))
url)
(defun muse-protocol-add (protocol browse-function resolve-function)
"Add PROTOCOL to `muse-url-protocols'. PROTOCOL may be a regexp.
BROWSE-FUNCTION should be a function that visits a URL in the
current buffer.
RESOLVE-FUNCTION should be a function that transforms a URL for
publishing or returns nil if not linked."
(add-to-list 'muse-url-protocols
(list protocol browse-function resolve-function))
(muse-update-url-regexp 'muse-url-protocols
muse-url-protocols))
(defun muse-browse-url-url (url)
"Call `muse-protocol-browse-url' to browse URL.
This is used when we are given something like
\"URL:http://example.org/\".
If you're looking for a good example for how to make a custom URL
handler, look at `muse-browse-url-dict' instead."
(when (string-match "\\`[uU][rR][lL]:\\(.+\\)" url)
(muse-browse-url (match-string 1 url))))
(defun muse-resolve-url-dict (url)
"Return the Wikipedia link corresponding with the given URL."
(when (string-match "\\`dict:\\(.+\\)" url)
(concat "http://" muse-wikipedia-country ".wikipedia.org/"
"wiki/Special:Search?search=" (match-string 1 url))))
(defun muse-browse-url-dict (url)
"If this is a Wikipedia URL, browse it."
(let ((dict-url (muse-resolve-url-dict url)))
(when dict-url
(browse-url dict-url))))
(defun muse-resolve-url-doi (url)
"Return the URL through DOI proxy server."
(when (string-match "\\`doi:\\(.+\\)" url)
(concat "http://dx.doi.org/"
(match-string 1 url))))
(defun muse-browse-url-doi (url)
"If this is a DOI URL, browse it.
DOI's (digitial object identifiers) are a standard identifier
used in the publishing industry."
(let ((doi-url (muse-resolve-url-doi url)))
(when doi-url
(browse-url doi-url))))
(defun muse-resolve-url-google (url)
"Return the correct Google search string."
(when (string-match "\\`google:/?/?\\(.+\\)" url)
(concat "http://www.google.com/search?q="
(match-string 1 url))))
(defun muse-browse-url-google (url)
"If this is a Google URL, jump to it."
(let ((google-url (muse-resolve-url-google url)))
(when google-url
(browse-url google-url))))
(defun muse-browse-url-info (url)
"If this in an Info URL, jump to it."
(require 'info)
(cond
((string-match "\\`info://\\([^#\n]+\\)#\\(.+\\)" url)
(Info-find-node (match-string 1 url)
(match-string 2 url)))
((string-match "\\`info://\\([^#\n]+\\)" url)
(Info-find-node (match-string 1 url)
"Top"))
((string-match "\\`info://(\\([^)\n]+\\))\\(.+\\)" url)
(Info-find-node (match-string 1 url) (match-string 2 url)))
((string-match "\\`info://\\(.+\\)" url)
(Info-find-node (match-string 1 url) "Top"))))
(defun muse-browse-url-man (url)
"If this in a manpage URL, jump to it."
(require 'man)
(when (string-match "\\`man://\\([^(]+\\(([^)]+)\\)?\\)" url)
(man (match-string 1 url))))
(defun muse-browse-url-woman (url)
"If this is a WoMan URL, jump to it."
(require 'woman)
(when (string-match "\\`woman://\\(.+\\)" url)
(woman (match-string 1 url))))
(provide 'muse-protocols)
;;; muse-protocols.el ends here

2193
elpa/muse-3.20/muse-publish.el
View File

File diff suppressed because it is too large Load Diff

270
elpa/muse-3.20/muse-regexps.el
View File

@ -1,270 +0,0 @@
;;; muse-regexps.el --- define regexps used by Muse
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This file is the part of the Muse project that describes regexps
;; that are used throughout the project.
;;; Contributors:
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse Regular Expressions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgroup muse-regexp nil
"Regular expressions used in publishing and syntax highlighting."
:group 'muse)
;;; Deal with the lack of character classes for regexps in Emacs21 and
;;; XEmacs
(defcustom muse-regexp-use-character-classes 'undecided
"Indicate whether to use extended character classes like [:space:].
If 'undecided, Muse will use them if your emacs is known to support them.
Emacs 22 and Emacs 21.3.50 are known to support them. XEmacs
does not support them.
Emacs 21.2 or higher support them, but with enough annoying edge
cases that the sanest default is to leave them disabled."
:type '(choice (const :tag "Yes" t)
(const :tag "No" nil)
(const :tag "Let Muse decide" undecided))
:group 'muse-regexp)
(defvar muse-regexp-emacs-revision
(save-match-data
(and (string-match "^[0-9]+\\.[0-9]+\\.\\([0-9]+\\)"
emacs-version)
(match-string 1 emacs-version)
(string-to-number (match-string 1 emacs-version))))
"The revision number of this version of Emacs.")
(defun muse-extreg-usable-p ()
"Return non-nil if extended character classes can be used,
nil otherwise.
This is used when deciding the initial values of the muse-regexp
options."
(cond
((eq muse-regexp-use-character-classes t)
t)
((eq muse-regexp-use-character-classes nil)
nil)
((featurep 'xemacs) nil) ; unusable on XEmacs
((> emacs-major-version 21) t) ; usable if > 21
((< emacs-major-version 21) nil)
((< emacs-minor-version 3) nil)
;; don't use if version is of format 21.x
((null muse-regexp-emacs-revision) nil)
;; only trust 21.3.50 or higher
((>= muse-regexp-emacs-revision 50) t)
(t nil)))
(defcustom muse-regexp-blank
(if (muse-extreg-usable-p)
"[:blank:]"
" \t")
"Regexp to use in place of \"[:blank:]\".
This should be something that matches spaces and tabs.
It is like a regexp, but should be embeddable inside brackets.
Muse will detect the appropriate value correctly most of
the time."
:type 'string
:options '("[:blank:]" " \t")
:group 'muse-regexp)
(defcustom muse-regexp-alnum
(if (muse-extreg-usable-p)
"[:alnum:]"
"A-Za-z0-9")
"Regexp to use in place of \"[:alnum:]\".
This should be something that matches all letters and numbers.
It is like a regexp, but should be embeddable inside brackets.
muse will detect the appropriate value correctly most of
the time."
:type 'string
:options '("[:alnum:]" "A-Za-z0-9")
:group 'muse-regexp)
(defcustom muse-regexp-lower
(if (muse-extreg-usable-p)
"[:lower:]"
"a-z")
"Regexp to use in place of \"[:lower:]\".
This should match all lowercase characters.
It is like a regexp, but should be embeddable inside brackets.
muse will detect the appropriate value correctly most of
the time."
:type 'string
:options '("[:lower:]" "a-z")
:group 'muse-regexp)
(defcustom muse-regexp-upper
(if (muse-extreg-usable-p)
"[:upper:]"
"A-Z")
"Regexp to use in place of \"[:upper:]\".
This should match all uppercase characters.
It is like a regexp, but should be embeddable inside brackets.
muse will detect the appropriate value correctly most of
the time."
:type 'string
:options '("[:upper:]" "A-Z")
:group 'muse-regexp)
;;; Regexps used to define Muse publishing syntax
(defcustom muse-list-item-regexp
(concat "^%s\\(\\([^\n" muse-regexp-blank "].*?\\)?::"
"\\(?:[" muse-regexp-blank "]+\\|$\\)"
"\\|[" muse-regexp-blank "]-[" muse-regexp-blank "]*"
"\\|[" muse-regexp-blank "][0-9]+\\.[" muse-regexp-blank "]*\\)")
"Regexp used to match the beginning of a list item.
The '%s' will be replaced with a whitespace regexp when publishing."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-ol-item-regexp (concat "\\`[" muse-regexp-blank "]+[0-9]+\\.")
"Regexp used to match an ordered list item."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-ul-item-regexp (concat "\\`[" muse-regexp-blank "]+-")
"Regexp used to match an unordered list item."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-dl-term-regexp
(concat "[" muse-regexp-blank "]*\\(.+?\\)["
muse-regexp-blank "]+::\\(?:[" muse-regexp-blank "]+\\|$\\)")
"Regexp used to match a definition list term.
The first match string must contain the term."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-dl-entry-regexp (concat "\\`[" muse-regexp-blank "]*::")
"Regexp used to match a definition list entry."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-table-field-regexp
(concat "[" muse-regexp-blank "]+\\(|+\\)\\(?:["
muse-regexp-blank "]\\|$\\)")
"Regexp used to match table separators when publishing."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-table-line-regexp (concat ".*" muse-table-field-regexp ".*")
"Regexp used to match a table line when publishing."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-table-hline-regexp (concat "[" muse-regexp-blank
"]*|[-+]+|[" muse-regexp-blank
"]*")
"Regexp used to match a horizontal separator line in a table."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-table-el-border-regexp (concat "[" muse-regexp-blank "]*"
"\\+\\(-*\\+\\)+"
"[" muse-regexp-blank "]*")
"Regexp used to match the beginning and end of a table.el-style table."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-table-el-line-regexp (concat "[" muse-regexp-blank "]*"
"|\\(.*|\\)*"
"[" muse-regexp-blank "]*")
"Regexp used to match a table line of a table.el-style table."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-tag-regexp
(concat "<\\([^/" muse-regexp-blank "\n][^" muse-regexp-blank
"</>\n]*\\)\\(\\s-+[^<>]+[^</>\n]\\)?\\(/\\)?>")
"A regexp used to find XML-style tags within a buffer when publishing.
Group 1 should be the tag name, group 2 the properties, and group
3 the optional immediate ending slash."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-explicit-link-regexp
"\\[\\[\\([^][\n]+\\)\\]\\(?:\\[\\([^][\n]+\\)\\]\\)?\\]"
"Regexp used to match [[target][description]] links.
Paren group 1 must match the URL, and paren group 2 the description."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-implicit-link-regexp
(concat "\\([^" muse-regexp-blank "\n]+\\)")
"Regexp used to match an implicit link.
An implicit link is the largest block of text to be checked for
URLs and bare WikiNames by the `muse-link-at-point' function.
Paren group 1 is the text to be checked.
URLs are checked by default. To get WikiNames, load
muse-wiki.el.
This is only used when you are using muse-mode.el, but not
muse-colors.el.
If the above applies, and you want to match things with spaces in
them, you will have to modify this."
:type 'regexp
:group 'muse-regexp)
;;; Regexps used to determine file types
(defcustom muse-file-regexp
(concat "\\`[~/]\\|\\?\\|/\\'\\|\\."
"\\(html?\\|pdf\\|mp3\\|el\\|zip\\|txt\\|tar\\)"
"\\(\\.\\(gz\\|bz2\\)\\)?\\'")
"A link matching this regexp will be regarded as a link to a file."
:type 'regexp
:group 'muse-regexp)
(defcustom muse-image-regexp
"\\.\\(eps\\|gif\\|jp\\(e?g\\)\\|p\\(bm\\|ng\\)\\|tiff\\|x\\([bp]m\\)\\)\\'"
"A link matching this regexp will be published inline as an image.
For example:
[[./wife.jpg][A picture of my wife]]
If you omit the description, the alt tag of the resulting HTML
buffer will be the name of the file."
:type 'regexp
:group 'muse-regexp)
(provide 'muse-regexps)
;;; muse-regexps.el ends here

346
elpa/muse-3.20/muse-texinfo.el
View File

@ -1,346 +0,0 @@
;;; muse-texinfo.el --- publish entries to Texinfo format or PDF
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse 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, or (at your
;; option) any later version.
;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Contributors:
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse Texinfo Publishing
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-publish)
(require 'muse-latex)
(require 'texnfo-upd)
(defgroup muse-texinfo nil
"Rules for marking up a Muse file as a Texinfo article."
:group 'muse-publish)
(defcustom muse-texinfo-process-natively nil
"If non-nil, use the Emacs `texinfmt' module to make Info files."
:type 'boolean
:require 'texinfmt
:group 'muse-texinfo)
(defcustom muse-texinfo-extension ".texi"
"Default file extension for publishing Texinfo files."
:type 'string
:group 'muse-texinfo)
(defcustom muse-texinfo-info-extension ".info"
"Default file extension for publishing Info files."
:type 'string
:group 'muse-texinfo)
(defcustom muse-texinfo-pdf-extension ".pdf"
"Default file extension for publishing PDF files."
:type 'string
:group 'muse-texinfo)
(defcustom muse-texinfo-header
"\\input texinfo @c -*-texinfo-*-
@setfilename <lisp>(concat (muse-page-name) \".info\")</lisp>
@settitle <lisp>(muse-publishing-directive \"title\")</lisp>
@documentencoding iso-8859-1
@iftex
@finalout
@end iftex
@titlepage
@title <lisp>(muse-publishing-directive \"title\")</lisp>
@author <lisp>(muse-publishing-directive \"author\")</lisp>
@end titlepage
<lisp>(and muse-publish-generate-contents \"@contents\")</lisp>
@node Top, Overview, , (dir)
@top Overview
@c Page published by Emacs Muse begins here\n\n"
"Text to prepend to a Muse page being published as Texinfo.
This may be text or a filename.
It may contain <lisp> markup tags."
:type 'string
:group 'muse-texinfo)
(defcustom muse-texinfo-footer
"\n@c Page published by Emacs Muse ends here
@bye\n"
"Text to append to a Muse page being published as Texinfo.
This may be text or a filename.
It may contain <lisp> markup tags."
:type 'string
:group 'muse-texinfo)
(defcustom muse-texinfo-markup-regexps nil
"List of markup rules for publishing a Muse page to Texinfo.
For more on the structure of this list, see `muse-publish-markup-regexps'."
:type '(repeat (choice
(list :tag "Markup rule"
integer
(choice regexp symbol)
integer
(choice string function symbol))
function))
:group 'muse-texinfo)
(defcustom muse-texinfo-markup-functions
'((table . muse-texinfo-markup-table)
(heading . muse-texinfo-markup-heading))
"An alist of style types to custom functions for that kind of text.
For more on the structure of this list, see
`muse-publish-markup-functions'."
:type '(alist :key-type symbol :value-type function)
:group 'muse-texinfo)
(defcustom muse-texinfo-markup-strings
'((image-with-desc . "@center @image{%1%, , , %3%, %2%}@*\n@center %3%")
(image . "@noindent @image{%s, , , , %s}")
(image-link . "@uref{%s, %s.%s}")
(anchor-ref . "@ref{%s, %s}")
(url . "@uref{%s, %s}")
(link . "@ref{Top, %2%, , %1%, }")
(link-and-anchor . "@ref{%3%, %2%, , %1%, %3%}")
(email-addr . "@email{%s}")
(anchor . "@anchor{%s} ")
(emdash . "---")
(comment-begin . "@ignore\n")
(comment-end . "\n@end ignore\n")
(rule . "@sp 1")
(no-break-space . "@w{ }")
(line-break . "@*")
(enddots . "@enddots{}")
(dots . "@dots{}")
(section . "@chapter ")
(subsection . "@section ")
(subsubsection . "@subsection ")
(section-other . "@subsubheading ")
(footnote . "@footnote{")
(footnote-end . "}")
(begin-underline . "_")
(end-underline . "_")
(begin-literal . "@samp{")
(end-literal . "}")
(begin-emph . "@emph{")
(end-emph . "}")
(begin-more-emph . "@strong{")
(end-more-emph . "}")
(begin-most-emph . "@strong{@emph{")
(end-most-emph . "}}")
(begin-verse . "@display\n")
(end-verse-line . "")
(verse-space . "@ @ ")
(end-verse . "\n@end display")
(begin-example . "@example\n")
(end-example . "\n@end example")
(begin-center . "@quotation\n")
(end-center . "\n@end quotation")
(begin-quote . "@quotation\n")
(end-quote . "\n@end quotation")
(begin-cite . "")
(begin-cite-author . "")
(begin-cite-year . "")
(end-cite . "")
(begin-uli . "@itemize @bullet\n")
(end-uli . "\n@end itemize")
(begin-uli-item . "@item\n")
(begin-oli . "@enumerate\n")
(end-oli . "\n@end enumerate")
(begin-oli-item . "@item\n")
(begin-dl . "@table @strong\n")
(end-dl . "\n@end table")
(begin-ddt . "@item "))
"Strings used for marking up text.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles."
:type '(alist :key-type symbol :value-type string)
:group 'muse-texinfo)
(defcustom muse-texinfo-markup-specials
'((?@ . "@@")
(?{ . "@{")
(?} . "@}"))
"A table of characters which must be represented specially."
:type '(alist :key-type character :value-type string)
:group 'muse-texinfo)
(defcustom muse-texinfo-markup-specials-url
'((?@ . "@@")
(?{ . "@{")
(?} . "@}")
(?, . "@comma{}"))
"A table of characters which must be represented specially.
These are applied to URLs."
:type '(alist :key-type character :value-type string)
:group 'muse-texinfo)
(defun muse-texinfo-decide-specials (context)
"Determine the specials to escape, depending on CONTEXT."
(cond ((memq context '(underline literal emphasis email url url-desc image
footnote))
muse-texinfo-markup-specials-url)
(t muse-texinfo-markup-specials)))
(defun muse-texinfo-markup-table ()
(let* ((table-info (muse-publish-table-fields (match-beginning 0)
(match-end 0)))
(row-len (car table-info))
(field-list (cdr table-info)))
(when table-info
(muse-insert-markup "@multitable @columnfractions")
(dotimes (field row-len)
(muse-insert-markup " " (number-to-string (/ 1.0 row-len))))
(dolist (fields field-list)
(let ((type (car fields)))
(unless (eq type 'hline)
(setq fields (cdr fields))
(if (= type 2)
(muse-insert-markup "\n@headitem ")
(muse-insert-markup "\n@item "))
(insert (car fields))
(setq fields (cdr fields))
(dolist (field fields)
(muse-insert-markup " @tab ")
(insert field)))))
(muse-insert-markup "\n@end multitable")
(insert ?\n))))
(defun muse-texinfo-remove-links (string)
"Remove explicit links from STRING, replacing them with the link
description.
If no description exists for the link, use the link itself."
(let ((start nil))
(while (setq start (string-match muse-explicit-link-regexp string
start))
(setq string
(replace-match (or (match-string 2 string)
(match-string 1 string))
t t string)))
string))
(defun muse-texinfo-protect-wikiwords (start end)
"Protect all wikiwords from START to END from further processing."
(and (boundp 'muse-wiki-wikiword-regexp)
(featurep 'muse-wiki)
(save-excursion
(goto-char start)
(while (re-search-forward muse-wiki-wikiword-regexp end t)
(muse-publish-mark-read-only (match-beginning 0)
(match-end 0))))))
(defun muse-texinfo-markup-heading ()
(save-excursion
(muse-publish-markup-heading))
(let* ((eol (muse-line-end-position))
(orig-heading (buffer-substring (point) eol))
(beg (point)))
(delete-region (point) eol)
;; don't allow links to be published in headings
(insert (muse-texinfo-remove-links orig-heading))
(muse-texinfo-protect-wikiwords beg (point))))
(defun muse-texinfo-munge-buffer ()
(muse-latex-fixup-dquotes)
(texinfo-insert-node-lines (point-min) (point-max) t)
(texinfo-all-menus-update t))
(defun muse-texinfo-pdf-browse-file (file)
(shell-command (concat "open " file)))
(defun muse-texinfo-info-generate (file output-path final-target)
;; The version of `texinfmt.el' that comes with Emacs 21 doesn't
;; support @documentencoding, so hack it in.
(when (and (not (featurep 'xemacs))
(eq emacs-major-version 21))
(put 'documentencoding 'texinfo-format
'texinfo-discard-line-with-args))
;; Most versions of `texinfmt.el' do not support @headitem, so hack
;; it in.
(unless (get 'headitem 'texinfo-format)
(put 'headitem 'texinfo-format 'texinfo-multitable-item))
(muse-publish-transform-output
file output-path final-target "Info"
(function
(lambda (file output-path)
(if muse-texinfo-process-natively
(save-window-excursion
(save-excursion
(find-file file)
(let ((inhibit-read-only t))
(texinfo-format-buffer))
(save-buffer)
(kill-buffer (current-buffer))
(let ((buf (get-file-buffer file)))
(with-current-buffer buf
(set-buffer-modified-p nil)
(kill-buffer (current-buffer))))
t))
(let ((result (shell-command
(concat "makeinfo --enable-encoding --output="
output-path " " file))))
(if (or (not (numberp result))
(eq result 0))
t
nil)))))))
(defun muse-texinfo-pdf-generate (file output-path final-target)
(let ((muse-latex-pdf-program "pdftex")
(muse-latex-pdf-cruft '(".aux" ".cp" ".fn" ".ky" ".log" ".pg" ".toc"
".tp" ".vr")))
(muse-latex-pdf-generate file output-path final-target)))
;;; Register the Muse TEXINFO Publishers
(muse-define-style "texi"
:suffix 'muse-texinfo-extension
:regexps 'muse-texinfo-markup-regexps
:functions 'muse-texinfo-markup-functions
:strings 'muse-texinfo-markup-strings
:specials 'muse-texinfo-decide-specials
:after 'muse-texinfo-munge-buffer
:header 'muse-texinfo-header
:footer 'muse-texinfo-footer
:browser 'find-file)
(muse-derive-style "info" "texi"
:final 'muse-texinfo-info-generate
:link-suffix 'muse-texinfo-info-extension
:osuffix 'muse-texinfo-info-extension
:browser 'info)
(muse-derive-style "info-pdf" "texi"
:final 'muse-texinfo-pdf-generate
:link-suffix 'muse-texinfo-pdf-extension
:osuffix 'muse-texinfo-pdf-extension
:browser 'muse-texinfo-pdf-browse-file)
(provide 'muse-texinfo)
;;; muse-texinfo.el ends here

Some files were not shown because too many files have changed in this diff Show More