diff options
Diffstat (limited to '.emacs.d/elpa/org-20171120/org-macs.el')
| -rw-r--r-- | .emacs.d/elpa/org-20171120/org-macs.el | 429 |
1 files changed, 429 insertions, 0 deletions
diff --git a/.emacs.d/elpa/org-20171120/org-macs.el b/.emacs.d/elpa/org-20171120/org-macs.el new file mode 100644 index 0000000..ff6d8c4 --- /dev/null +++ b/.emacs.d/elpa/org-20171120/org-macs.el @@ -0,0 +1,429 @@ +;;; org-macs.el --- Top-level Definitions for Org -*- lexical-binding: t; -*- + +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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 <https://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains macro definitions, defsubst definitions, other +;; stuff needed for compilation and top-level forms in Org mode, as +;; well lots of small functions that are not Org mode specific but +;; simply generally useful stuff. + +;;; Code: + +(defmacro org-with-gensyms (symbols &rest body) + (declare (debug (sexp body)) (indent 1)) + `(let ,(mapcar (lambda (s) + `(,s (make-symbol (concat "--" (symbol-name ',s))))) + symbols) + ,@body)) + +(defun org-string-nw-p (s) + "Return S if S is a string containing a non-blank character. +Otherwise, return nil." + (and (stringp s) + (string-match-p "[^ \r\t\n]" s) + s)) + +(defun org-split-string (string &optional separators) + "Splits STRING into substrings at SEPARATORS. + +SEPARATORS is a regular expression. When nil, it defaults to +\"[ \f\t\n\r\v]+\". + +Unlike `split-string', matching SEPARATORS at the beginning and +end of string are ignored." + (let ((separators (or separators "[ \f\t\n\r\v]+"))) + (when (string-match (concat "\\`" separators) string) + (setq string (replace-match "" nil nil string))) + (when (string-match (concat separators "\\'") string) + (setq string (replace-match "" nil nil string))) + (split-string string separators))) + +(defun org-string-display (string) + "Return STRING as it is displayed in the current buffer. +This function takes into consideration `invisible' and `display' +text properties." + (let* ((build-from-parts + (lambda (s property filter) + ;; Build a new string out of string S. On every group of + ;; contiguous characters with the same PROPERTY value, + ;; call FILTER on the properties list at the beginning of + ;; the group. If it returns a string, replace the + ;; characters in the group with it. Otherwise, preserve + ;; those characters. + (let ((len (length s)) + (new "") + (i 0) + (cursor 0)) + (while (setq i (text-property-not-all i len property nil s)) + (let ((end (next-single-property-change i property s len)) + (value (funcall filter (text-properties-at i s)))) + (when value + (setq new (concat new (substring s cursor i) value)) + (setq cursor end)) + (setq i end))) + (concat new (substring s cursor))))) + (prune-invisible + (lambda (s) + (funcall build-from-parts s 'invisible + (lambda (props) + ;; If `invisible' property in PROPS means text + ;; is to be invisible, return the empty string. + ;; Otherwise return nil so that the part is + ;; skipped. + (and (or (eq t buffer-invisibility-spec) + (assoc-string (plist-get props 'invisible) + buffer-invisibility-spec)) + ""))))) + (replace-display + (lambda (s) + (funcall build-from-parts s 'display + (lambda (props) + ;; If there is any string specification in + ;; `display' property return it. Also attach + ;; other text properties on the part to that + ;; string (face...). + (let* ((display (plist-get props 'display)) + (value (if (stringp display) display + (cl-some #'stringp display)))) + (when value + (apply #'propertize + ;; Displayed string could contain + ;; invisible parts, but no nested + ;; display. + (funcall prune-invisible value) + 'display + (and (not (stringp display)) + (cl-remove-if #'stringp display)) + props)))))))) + ;; `display' property overrides `invisible' one. So we first + ;; replace characters with `display' property. Then we remove + ;; invisible characters. + (funcall prune-invisible (funcall replace-display string)))) + +(defun org-string-width (string) + "Return width of STRING when displayed in the current buffer. +Unlike `string-width', this function takes into consideration +`invisible' and `display' text properties." + (string-width (org-string-display string))) + +(defun org-not-nil (v) + "If V not nil, and also not the string \"nil\", then return V. +Otherwise return nil." + (and v (not (equal v "nil")) v)) + +(defmacro org-preserve-lc (&rest body) + (declare (debug (body))) + (org-with-gensyms (line col) + `(let ((,line (org-current-line)) + (,col (current-column))) + (unwind-protect + (progn ,@body) + (org-goto-line ,line) + (org-move-to-column ,col))))) + +;; Use `org-with-silent-modifications' to ignore cosmetic changes and +;; `org-unmodified' to ignore real text modifications +(defmacro org-unmodified (&rest body) + "Run BODY while preserving the buffer's `buffer-modified-p' state." + (declare (debug (body))) + (org-with-gensyms (was-modified) + `(let ((,was-modified (buffer-modified-p))) + (unwind-protect + (let ((buffer-undo-list t) + (inhibit-modification-hooks t)) + ,@body) + (set-buffer-modified-p ,was-modified))))) + +(defmacro org-without-partial-completion (&rest body) + (declare (debug (body))) + `(if (and (boundp 'partial-completion-mode) + partial-completion-mode + (fboundp 'partial-completion-mode)) + (unwind-protect + (progn + (partial-completion-mode -1) + ,@body) + (partial-completion-mode 1)) + ,@body)) + +(defmacro org-with-point-at (pom &rest body) + "Move to buffer and point of point-or-marker POM for the duration of BODY." + (declare (debug (form body)) (indent 1)) + (org-with-gensyms (mpom) + `(let ((,mpom ,pom)) + (save-excursion + (if (markerp ,mpom) (set-buffer (marker-buffer ,mpom))) + (org-with-wide-buffer + (goto-char (or ,mpom (point))) + ,@body))))) + +(defmacro org-with-remote-undo (buffer &rest body) + "Execute BODY while recording undo information in two buffers." + (declare (debug (form body)) (indent 1)) + (org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2) + `(let ((,cline (org-current-line)) + (,cmd this-command) + (,buf1 (current-buffer)) + (,buf2 ,buffer) + (,undo1 buffer-undo-list) + (,undo2 (with-current-buffer ,buffer buffer-undo-list)) + ,c1 ,c2) + ,@body + (when org-agenda-allow-remote-undo + (setq ,c1 (org-verify-change-for-undo + ,undo1 (with-current-buffer ,buf1 buffer-undo-list)) + ,c2 (org-verify-change-for-undo + ,undo2 (with-current-buffer ,buf2 buffer-undo-list))) + (when (or ,c1 ,c2) + ;; make sure there are undo boundaries + (and ,c1 (with-current-buffer ,buf1 (undo-boundary))) + (and ,c2 (with-current-buffer ,buf2 (undo-boundary))) + ;; remember which buffer to undo + (push (list ,cmd ,cline ,buf1 ,c1 ,buf2 ,c2) + org-agenda-undo-list)))))) + +(defmacro org-no-read-only (&rest body) + "Inhibit read-only for BODY." + (declare (debug (body))) + `(let ((inhibit-read-only t)) ,@body)) + +(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t + rear-nonsticky t mouse-map t fontified t + org-emphasis t) + "Properties to remove when a string without properties is wanted.") + +(defsubst org-no-properties (s &optional restricted) + "Remove all text properties from string S. +When RESTRICTED is non-nil, only remove the properties listed +in `org-rm-props'." + (if restricted (remove-text-properties 0 (length s) org-rm-props s) + (set-text-properties 0 (length s) nil s)) + s) + +(defsubst org-get-alist-option (option key) + (cond ((eq key t) t) + ((eq option t) t) + ((assoc key option) (cdr (assoc key option))) + (t (let ((r (cdr (assq 'default option)))) + (if (listp r) (delq nil r) r))))) + +(defsubst org-check-external-command (cmd &optional use no-error) + "Check if external program CMD for USE exists, error if not. +When the program does exist, return its path. +When it does not exist and NO-ERROR is set, return nil. +Otherwise, throw an error. The optional argument USE can describe what this +program is needed for, so that the error message can be more informative." + (or (executable-find cmd) + (if no-error + nil + (error "Can't find `%s'%s" cmd + (if use (format " (%s)" use) ""))))) + +(defsubst org-last (list) + "Return the last element of LIST." + (car (last list))) + +(defun org-let (list &rest body) + (eval (cons 'let (cons list body)))) +(put 'org-let 'lisp-indent-function 1) + +(defun org-let2 (list1 list2 &rest body) + (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) +(put 'org-let2 'lisp-indent-function 2) + +(defsubst org-call-with-arg (command arg) + "Call COMMAND interactively, but pretend prefix arg was ARG." + (let ((current-prefix-arg arg)) (call-interactively command))) + +(defsubst org-current-line (&optional pos) + (save-excursion + (and pos (goto-char pos)) + ;; works also in narrowed buffer, because we start at 1, not point-min + (+ (if (bolp) 1 0) (count-lines 1 (point))))) + +(defsubst org-goto-line (N) + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- N)))) + +(defsubst org-current-line-string (&optional to-here) + (buffer-substring (point-at-bol) (if to-here (point) (point-at-eol)))) + +(defsubst org-pos-in-match-range (pos n) + (and (match-beginning n) + (<= (match-beginning n) pos) + (>= (match-end n) pos))) + +(defun org-match-line (regexp) + "Match REGEXP at the beginning of the current line." + (save-excursion + (beginning-of-line) + (looking-at regexp))) + +(defun org-plist-delete (plist property) + "Delete PROPERTY from PLIST. +This is in contrast to merely setting it to 0." + (let (p) + (while plist + (if (not (eq property (car plist))) + (setq p (plist-put p (car plist) (nth 1 plist)))) + (setq plist (cddr plist))) + p)) + +(defmacro org-save-outline-visibility (use-markers &rest body) + "Save and restore outline visibility around BODY. +If USE-MARKERS is non-nil, use markers for the positions. +This means that the buffer may change while running BODY, +but it also means that the buffer should stay alive +during the operation, because otherwise all these markers will +point nowhere." + (declare (debug (form body)) (indent 1)) + (org-with-gensyms (data) + `(let ((,data (org-outline-overlay-data ,use-markers))) + (unwind-protect + (prog1 (progn ,@body) + (org-set-outline-overlay-data ,data)) + (when ,use-markers + (dolist (c ,data) + (when (markerp (car c)) (move-marker (car c) nil)) + (when (markerp (cdr c)) (move-marker (cdr c) nil)))))))) + +(defmacro org-with-wide-buffer (&rest body) + "Execute body while temporarily widening the buffer." + (declare (debug (body))) + `(save-excursion + (save-restriction + (widen) + ,@body))) + +(defmacro org-with-limited-levels (&rest body) + "Execute BODY with limited number of outline levels." + (declare (debug (body))) + `(progn + (defvar org-called-with-limited-levels) + (defvar org-outline-regexp) + (defvar outline-regexp) + (defvar org-outline-regexp-bol) + (let* ((org-called-with-limited-levels t) + (org-outline-regexp (org-get-limited-outline-regexp)) + (outline-regexp org-outline-regexp) + (org-outline-regexp-bol (concat "^" org-outline-regexp))) + ,@body))) + +(defvar org-outline-regexp) ; defined in org.el +(defvar org-odd-levels-only) ; defined in org.el +(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el +(defun org-get-limited-outline-regexp () + "Return outline-regexp with limited number of levels. +The number of levels is controlled by `org-inlinetask-min-level'" + (cond ((not (derived-mode-p 'org-mode)) + outline-regexp) + ((not (featurep 'org-inlinetask)) + org-outline-regexp) + (t + (let* ((limit-level (1- org-inlinetask-min-level)) + (nstars (if org-odd-levels-only + (1- (* limit-level 2)) + limit-level))) + (format "\\*\\{1,%d\\} " nstars))))) + +(defmacro org-eval-in-environment (environment form) + (declare (debug (form form)) (indent 1)) + `(eval (list 'let ,environment ',form))) + +(defun org-make-parameter-alist (flat) + "Return alist based on FLAT. +FLAT is a list with alternating symbol names and values. The +returned alist is a list of lists with the symbol name in car and +the value in cdr." + (when flat + (cons (list (car flat) (cadr flat)) + (org-make-parameter-alist (cddr flat))))) + +;;;###autoload +(defmacro org-load-noerror-mustsuffix (file) + "Load FILE with optional arguments NOERROR and MUSTSUFFIX." + `(load ,file 'noerror nil nil 'mustsuffix)) + +(defun org-unbracket-string (pre post string) + "Remove PRE/POST from the beginning/end of STRING. +Both PRE and POST must be pre-/suffixes of STRING, or neither is +removed." + (if (and (string-prefix-p pre string) + (string-suffix-p post string)) + (substring string (length pre) (- (length post))) + string)) + +(defun org-read-function (prompt &optional allow-empty?) + "Prompt for a function. +If ALLOW-EMPTY? is non-nil, return nil rather than raising an +error when the user input is empty." + (let ((func (completing-read prompt obarray #'fboundp t))) + (cond ((not (string= func "")) + (intern func)) + (allow-empty? nil) + (t (user-error "Empty input is not valid"))))) + +(defconst org-unique-local-variables + '(org-element--cache + org-element--cache-objects + org-element--cache-sync-keys + org-element--cache-sync-requests + org-element--cache-sync-timer) + "List of local variables that cannot be transferred to another buffer.") + +(defun org-get-local-variables () + "Return a list of all local variables in an Org mode buffer." + (delq nil + (mapcar + (lambda (x) + (let* ((binding (if (symbolp x) (list x) (list (car x) (cdr x)))) + (name (car binding))) + (and (not (get name 'org-state)) + (not (memq name org-unique-local-variables)) + (string-match-p + "\\`\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|\ +auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" + (symbol-name name)) + binding))) + (with-temp-buffer + (org-mode) + (buffer-local-variables))))) + +(defun org-clone-local-variables (from-buffer &optional regexp) + "Clone local variables from FROM-BUFFER. +Optional argument REGEXP selects variables to clone." + (dolist (pair (buffer-local-variables from-buffer)) + (pcase pair + (`(,name . ,value) ;ignore unbound variables + (when (and (not (memq name org-unique-local-variables)) + (or (null regexp) (string-match-p regexp (symbol-name name)))) + (ignore-errors (set (make-local-variable name) value))))))) + + +(provide 'org-macs) + +;;; org-macs.el ends here |
