Implement speed commands with cursor at beginning-of-headline

This commit is contained in:
Carsten Dominik 2009-10-26 08:50:30 +01:00
parent ad4859028c
commit b5750c8f42
1 changed files with 113 additions and 20 deletions

View File

@ -594,6 +594,28 @@ new-frame Make a new frame each time. Note that in this case
(const :tag "Each time a new frame" new-frame) (const :tag "Each time a new frame" new-frame)
(const :tag "One dedicated frame" dedicated-frame))) (const :tag "One dedicated frame" dedicated-frame)))
(defcustom org-use-speed-commands nil
"Non-nil means, activate single letter commands at beginning of a headline."
:group 'org-structure
:type 'boolean)
(defcustom org-speed-commands-user nil
"Alist of additional speed commands.
This list will be checked before `org-speed-commands-default'
when the variable `org-use-speed-commands' is non-nil
and when the cursor is at the beginning of a headline.
The car if each entry is a string with a single letter, which must
be assigned to `self-insert-command' in the global map.
The cdr is either a command to be called interactively, a function
to be called, or a form to be evaluated."
:group 'org-structure
:type '(repeat
(cons
(string "Command letter")
(choice
(function)
(sexp)))))
(defgroup org-cycle nil (defgroup org-cycle nil
"Options concerning visibility cycling in Org-mode." "Options concerning visibility cycling in Org-mode."
:tag "Org Cycle" :tag "Org Cycle"
@ -14600,15 +14622,85 @@ Some of the options can be changed using the variable
(org-defkey org-mode-map 'button3 'popup-mode-menu)) (org-defkey org-mode-map 'button3 'popup-mode-menu))
(defconst org-speed-commands-default
'(
("c" . org-cycle)
("C" . org-shifttab)
("n" . outline-next-visible-heading)
("p" . outline-previous-visible-heading)
("f" . org-forward-same-level)
("b" . org-backward-same-level)
("u" . outline-up-heading)
("U" . org-shiftmetaup)
("D" . org-shiftmetadown)
("r" . org-metaright)
("l" . org-metaleft)
("R" . org-shiftmetaright)
("L" . org-shiftmetaleft)
("i" . (progn (forward-char 1) (call-interactively
'org-insert-heading-respect-content)))
("a" . org-archive-subtree-default)
("t" . org-todo)
("j" . org-goto)
("1" . (org-priority ?A))
("2" . (org-priority ?B))
("3" . (org-priority ?C))
("." . outline-mark-subtree)
("^" . org-sort)
("w" . org-refile)
("z" . org-add-note)
("/" . org-sparse-tree)
("?" . org-speed-command-help)
)
"The default speed commands.")
(defun org-print-speed-command (e)
(princ (car e))
(princ " ")
(if (symbolp (cdr e))
(princ (symbol-name (cdr e)))
(prin1 (cdr e)))
(princ "\n"))
(defun org-speed-command-help ()
"Show the available speed commands."
(interactive)
(if (not org-use-speed-commands)
(error "Speed commands are not activated, customize `org-use-speed-commands'.")
(with-output-to-temp-buffer "*Help*"
(princ "Speed commands\n==============\n")
(mapc 'org-print-speed-command org-speed-commands-user)
(princ "\n")
(mapc 'org-print-speed-command org-speed-commands-default))))
(defvar org-self-insert-command-undo-counter 0) (defvar org-self-insert-command-undo-counter 0)
(defvar org-table-auto-blank-field) ; defined in org-table.el (defvar org-table-auto-blank-field) ; defined in org-table.el
(defvar org-speed-command nil)
(defun org-self-insert-command (N) (defun org-self-insert-command (N)
"Like `self-insert-command', use overwrite-mode for whitespace in tables. "Like `self-insert-command', use overwrite-mode for whitespace in tables.
If the cursor is in a table looking at whitespace, the whitespace is If the cursor is in a table looking at whitespace, the whitespace is
overwritten, and the table is not marked as requiring realignment." overwritten, and the table is not marked as requiring realignment."
(interactive "p") (interactive "p")
(if (and (cond
((and org-use-speed-commands
(bolp)
(looking-at outline-regexp)
(setq
org-speed-command
(or (cdr (assoc (this-command-keys) org-speed-commands-user))
(cdr (assoc (this-command-keys) org-speed-commands-default)))))
(cond
((commandp org-speed-command)
(setq this-command org-speed-command)
(call-interactively org-speed-command))
((functionp org-speed-command)
(funcall org-speed-command))
((and org-speed-command (listp org-speed-command))
(eval org-speed-command))
(t (let (org-use-speed-commands)
(call-interactively 'org-self-insert-command)))))
((and
(org-table-p) (org-table-p)
(progn (progn
;; check if we blank the field, and if that triggers align ;; check if we blank the field, and if that triggers align
@ -14627,7 +14719,8 @@ overwritten, and the table is not marked as requiring realignment."
(goto-char (1- (match-end 0))) (goto-char (1- (match-end 0)))
(delete-backward-char 1) (delete-backward-char 1)
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(self-insert-command N)) (self-insert-command N)))
(t
(setq org-table-may-need-update t) (setq org-table-may-need-update t)
(self-insert-command N) (self-insert-command N)
(org-fix-tags-on-the-fly) (org-fix-tags-on-the-fly)
@ -14641,7 +14734,7 @@ overwritten, and the table is not marked as requiring realignment."
(not (cadr buffer-undo-list)) ; remove nil entry (not (cadr buffer-undo-list)) ; remove nil entry
(setcdr buffer-undo-list (cddr buffer-undo-list))) (setcdr buffer-undo-list (cddr buffer-undo-list)))
(setq org-self-insert-command-undo-counter (setq org-self-insert-command-undo-counter
(1+ org-self-insert-command-undo-counter))))))) (1+ org-self-insert-command-undo-counter))))))))
(defun org-fix-tags-on-the-fly () (defun org-fix-tags-on-the-fly ()
(when (and (equal (char-after (point-at-bol)) ?*) (when (and (equal (char-after (point-at-bol)) ?*)