contrib/lisp/org-panel.el

   1 ;;; org-panel.el --- Simple routines for us with bad memory
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: Thu Nov 15 15:35:03 2007
   5 ;; Version: 0.21
   6 ;; Lxast-Updated: Wed Nov 21 03:06:03 2007 (3600 +0100)
   7 ;; URL:
   8 ;; Keywords:
   9 ;; Compatibility:
  10 ;;
  11 ;; Features that might be required by this library:
  12 ;;
  13 ;;   `easymenu', `font-lock', `noutline', `org', `outline', `syntax',
  14 ;;   `time-date'.
  15 ;;
  16 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17 ;;
  18 ;;; Commentary:
  19 ;;
  20 ;; This defines a kind of control panel for `org-mode'. This control
  21 ;; panel should make it fast to move around and edit structure etc.
  22 ;;
  23 ;; To bring up the control panel type
  24 ;;
  25 ;;   M-x orgpan-panel
  26 ;;
  27 ;; Type ? there for help.
  28 ;;
  29 ;; I suggest you add the following to your .emacs for quick access of
  30 ;; the panel:
  31 ;;
  32 ;;   (eval-after-load 'org-mode
  33 ;;     (define-key org-mode-map [(control ?c) ?p] 'orgpan-panel))
  34 ;;
  35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  36 ;;
  37 ;;; Change log:
  38 ;;
  39 ;;
  40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41 ;;
  42 ;; This program is free software; you can redistribute it and/or
  43 ;; modify it under the terms of the GNU General Public License as
  44 ;; published by the Free Software Foundation; either version 2, or
  45 ;; (at your option) any later version.
  46 ;;
  47 ;; This program is distributed in the hope that it will be useful,
  48 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  49 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  50 ;; General Public License for more details.
  51 ;;
  52 ;; You should have received a copy of the GNU General Public License
  53 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  54 ;;
  55 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  56 ;;
  57 ;;; Code:
  58
  59 (require 'org)
  60 (require 'outline)
  61
  62 ;; Fix-me: this is for testing. A minor mode version interferes badly
  63 ;; with emulation minor modes. On the other hand, the other version
  64 ;; interferes badly with (interactive ...).
  65 (defvar orgpan-minor-mode-version t)
  66
  67 (defface orgpan-field
  68  '((t (:inherit 'widget-field)))
  69  "Face for fields."
  70  :group 'winsize)
  71 (defvar orgpan-field-face 'orgpan-field)
  72
  73 (defface orgpan-active-field
  74  '((t (:inherit 'highlight)))
  75  "Face for fields."
  76  :group 'winsize)
  77 (defvar orgpan-active-field-face 'orgpan-active-field)
  78
  79 (defface orgpan-spaceline
  80  '((t (:height 0.2)))
  81  "Face for spacing lines."
  82  :group 'winsize)
  83
  84 (defcustom orgpan-panel-buttons nil
  85  "Panel style, if non-nil use buttons.
  86 If there are buttons in the panel they are used to change the way
  87 the arrow keys work.  The panel looks something like this, with
  88 the first button chosen:
  89
  90  [Navigate] [Restructure] [TODO/Priority]
  91  ----------
  92  up/down, left: Go to, right: Visibility
  93
  94 The line below the buttons try to give a short hint about what
  95 the arrow keys does.  \(Personally I prefer the version without
  96 buttons since I then do not have to remember which button is
  97 active.)"
  98  :type 'boolean
  99  :group 'winsize)
 100
 101 ;; Fix-me: add org-mode-map
 102 (defconst orgpan-org-mode-commands nil)
 103 (defconst orgpan-org-commands
 104  '(
 105    orgpan-copy-subtree
 106    orgpan-cut-subtree
 107    orgpan-paste-subtree
 108    undo
 109    ;;
 110    ;orgpan-occur
 111    ;;
 112    org-cycle
 113    org-global-cycle
 114    outline-up-heading
 115    outline-next-visible-heading
 116    outline-previous-visible-heading
 117    outline-forward-same-level
 118    outline-backward-same-level
 119    org-todo
 120    org-show-todo-tree
 121    org-priority-up
 122    org-priority-down
 123    org-move-subtree-up
 124    org-move-subtree-down
 125    org-do-promote
 126    org-do-demote
 127    org-promote-subtree
 128    org-demote-subtree))
 129
 130
 131 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 132 ;;; Hook functions etc
 133
 134 (defun orgpan-delete-panel ()
 135  "Remove the panel."
 136  (interactive)
 137  (when (buffer-live-p orgpan-panel-buffer)
 138    (delete-windows-on orgpan-panel-buffer)
 139    (kill-buffer orgpan-panel-buffer))
 140  (setq orgpan-panel-buffer nil)
 141  (setq orgpan-panel-window nil)
 142  (orgpan-panel-minor-mode 0)
 143  (remove-hook 'post-command-hook 'orgpan-minor-post-command)
 144  (remove-hook 'post-command-hook 'orgpan-mode-post-command)
 145  ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
 146  )
 147
 148 (defvar orgpan-last-command-was-from-panel nil)
 149 (defun orgpan-mode-pre-command ()
 150  (setq orgpan-last-command-was-from-panel nil)
 151  (condition-case err
 152      (if (not (and (windowp orgpan-org-window)
 153                    (window-live-p orgpan-org-window)))
 154          (progn
 155            (setq this-command 'ignore)
 156            (orgpan-delete-panel)
 157            (message "The window belonging to the panel had disappeared, removed panel."))
 158        (let ((buf (window-buffer orgpan-org-window)))
 159          (when (with-current-buffer buf
 160                  (derived-mode-p 'org-mode))
 161            (setq orgpan-last-org-buffer buf))
 162          ;; Fix me: add a list of those commands that are not
 163          ;; meaningful from the panel (for example org-time-stamp)
 164          (when (or (memq this-command orgpan-org-commands)
 165                    (memq this-command orgpan-org-mode-commands)
 166                    ;; For some reason not all org commands are found above:
 167                    (string= "org-" (substring (format "%s" this-command) 0 4)))
 168            (if (not (with-current-buffer buf
 169                       (derived-mode-p 'org-mode)))
 170                (progn
 171                  (if (buffer-live-p orgpan-org-buffer)
 172                      (set-window-buffer orgpan-org-window orgpan-org-buffer)
 173                    (message "Please use `l' or `b' to choose an org-mode buffer"))
 174                  (setq this-command 'ignore))
 175              (setq orgpan-org-buffer (window-buffer orgpan-org-window))
 176              (setq orgpan-last-command-was-from-panel t)
 177              (select-window orgpan-org-window)
 178              ;;(when (active-minibuffer-window
 179              ;;(set-buffer orgpan-org-buffer)
 180              ))))
 181    (error (lwarn 't :warning "orgpan-pre: %S" err))))
 182
 183 (defun orgpan-mode-post-command ()
 184  (condition-case err
 185      (progn
 186        (unless (and (windowp orgpan-panel-window)
 187                     (window-live-p orgpan-panel-window)
 188                     (bufferp orgpan-panel-buffer)
 189                     (buffer-live-p orgpan-panel-buffer))
 190          ;;(orgpan-delete-panel)
 191          )
 192        (when (and orgpan-last-command-was-from-panel
 193                   (windowp orgpan-panel-window)
 194                   (window-live-p orgpan-panel-window))
 195          (select-window orgpan-panel-window)
 196          (when (derived-mode-p 'orgpan-mode)
 197            (setq deactivate-mark t)
 198            (when orgpan-panel-buttons
 199              (unless (and orgpan-point
 200                           (= (point) orgpan-point))
 201                ;; Go backward so it is possible to click on a "button":
 202                (orgpan-backward-field))))))
 203    (error (lwarn 't :warning "orgpan-post: %S" err))))
 204
 205 ;; (defun orgpan-window-config-change ()
 206 ;;   "Check if any frame is displaying an orgpan panel.
 207 ;; If not remove `orgpan-mode-post-command' and this function from
 208 ;; the hooks."
 209 ;;   (condition-case err
 210 ;;       (unless (and (
 211 ;;       (let ((found-pan nil))
 212 ;;         (dolist (f (frame-list))
 213 ;;           (dolist (w (window-list f 'nomini))
 214 ;;             (with-current-buffer (window-buffer w)
 215 ;;               (when (derived-mode-p 'orgpan-mode)
 216 ;;                 (setq found-pan t)))))
 217 ;;         (unless found-pan
 218 ;;           (remove-hook 'post-command-hook 'orgpan-mode-post-command)
 219 ;;           (remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)))
 220 ;;     (error (lwarn 't :warning "Error in orgpan-config-change: %S" err))))
 221
 222
 223 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 224 ;;; Commands
 225
 226 (defun orgpan-last-buffer ()
 227  "Open last org-mode buffer in panels org window."
 228  (interactive)
 229  (let ((buf (window-buffer orgpan-org-window))
 230        (last-buf orgpan-last-org-buffer))
 231    (when (with-current-buffer buf
 232            (derived-mode-p 'org-mode))
 233      (setq orgpan-last-org-buffer buf))
 234    (when (eq last-buf buf)
 235      (setq last-buf nil))
 236    (if (not last-buf)
 237        (orgpan-switch-buffer)
 238      (set-window-buffer orgpan-org-window last-buf))))
 239
 240 (defun orgpan-switch-buffer ()
 241  "Switch to next org-mode buffer in panels org window."
 242  (interactive)
 243  (let ((buf (window-buffer orgpan-org-window))
 244        (org-buffers nil))
 245    (with-current-buffer buf
 246      (when (derived-mode-p 'org-mode)
 247        (bury-buffer buf)
 248        (setq orgpan-last-org-buffer buf)))
 249    (setq org-buffers (delq nil (mapcar (lambda (buf)
 250                                          (when (with-current-buffer buf
 251                                                  (derived-mode-p 'org-mode))
 252                                            buf))
 253                                        (buffer-list))))
 254    (setq org-buffers (delq buf org-buffers))
 255    (set-window-buffer orgpan-org-window (car org-buffers))
 256    (setq orgpan-org-buffer (car org-buffers))))
 257
 258 (defun orgpan-paste-subtree ()
 259  (interactive)
 260  (if (y-or-n-p "Paste subtree here? ")
 261      (org-paste-subtree)
 262    (message "Nothing was pasted")))
 263
 264 (defun orgpan-cut-subtree ()
 265  (interactive)
 266  (let ((heading (progn
 267                   (org-back-to-heading)
 268                   (buffer-substring (point) (line-end-position))
 269                   )))
 270    (if (y-or-n-p (format "Do you want to cut the subtree\n%s\n? " heading))
 271        (org-cut-subtree)
 272      (message "Nothing was cut"))))
 273
 274 (defun orgpan-copy-subtree ()
 275  (interactive)
 276  (let ((heading (progn
 277                   (org-back-to-heading)
 278                   (buffer-substring (point) (line-end-position))
 279                   )))
 280    (if (y-or-n-p (format "Do you want to copy the subtree\n%s\n? " heading))
 281        (org-copy-subtree)
 282      (message "Nothing was copied"))))
 283
 284
 285 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 286 ;;; Buttons
 287
 288 (defvar orgpan-ovl-help nil)
 289
 290 (defun orgpan-check-panel-mode ()
 291  (unless (derived-mode-p 'orgpan-mode)
 292    (error "Not orgpan-mode in buffer: %s" major-mode)))
 293
 294 (defun orgpan-display-bindings-help ()
 295  (orgpan-check-panel-mode)
 296  (setq orgpan-point (point))
 297  (let* ((ovls (overlays-at (point)))
 298         (ovl (car ovls))
 299         (help (when ovl (overlay-get ovl 'orgpan-explain))))
 300    (dolist (o (overlays-in (point-min) (point-max)))
 301      (overlay-put o 'face orgpan-field-face))
 302    (overlay-put ovl 'face orgpan-active-field-face)
 303    (overlay-put orgpan-ovl-help 'before-string help)))
 304
 305 (defun orgpan-forward-field ()
 306  (interactive)
 307  (orgpan-check-panel-mode)
 308  (let ((pos (next-overlay-change (point))))
 309    (unless (overlays-at pos)
 310      (setq pos (next-overlay-change pos)))
 311    (when (= pos (point-max))
 312      (setq pos (point-min))
 313      (unless (overlays-at pos)
 314        (setq pos (next-overlay-change pos))))
 315    (goto-char pos))
 316  (orgpan-display-bindings-help))
 317
 318 (defun orgpan-backward-field ()
 319  (interactive)
 320  (orgpan-check-panel-mode)
 321  (when (= (point) (point-min))
 322    (goto-char (point-max)))
 323  (let ((pos (previous-overlay-change (point))))
 324    (unless (overlays-at pos)
 325      (setq pos (previous-overlay-change pos)))
 326    (goto-char pos))
 327  (orgpan-display-bindings-help))
 328
 329
 330 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 331 ;;; Mode
 332
 333 (defconst orgpan-mode-map
 334  ;; Fix-me: clean up here!
 335  ;; Fix-me: viper support
 336  (let ((map (make-sparse-keymap)))
 337    (define-key map [?q] 'orgpan-delete-panel)
 338    (define-key map [??] 'orgpan-help)
 339    ;; Copying etc
 340    (define-key map [?c] 'orgpan-copy-subtree)
 341    (define-key map [?x] 'orgpan-cut-subtree)
 342    (define-key map [?p] 'orgpan-paste-subtree)
 343    (define-key map [?z] 'undo)
 344    ;; Buffers:
 345    (define-key map [?b] 'orgpan-switch-buffer)
 346    (define-key map [?l] 'orgpan-last-buffer)
 347    ;; Some keys for moving between headings. Emacs keys for next/prev
 348    ;; line seems ok:
 349    (define-key map [(control ?p)] 'outline-previous-visible-heading)
 350    (define-key map [(control ?n)] 'outline-next-visible-heading)
 351    (define-key map [(shift control ?p)] 'outline-backward-same-level)
 352    (define-key map [(shift control ?n)] 'outline-forward-same-level)
 353    ;; A mnemunic for up:
 354    (define-key map [(control ?u)] 'outline-up-heading)
 355    ;; Search sparse tree:
 356    ;;
 357    ;; Fix-me: Search does not work, some problem with
 358    ;; interactive. Probably have to turn the whole thing around and
 359    ;; always be in the org buffer, but with a minor mode running
 360    ;; there.
 361    ;;
 362    ;;(define-key map [?s] 'org-sparse-tree)
 363    (define-key map [?s] 'orgpan-occur)
 364    ;; Same as in org-mode:
 365    ;;(define-key map [(control ?c)(control ?v)] 'org-show-todo-tree)
 366    ;; Fix-me: This leads to strange problems:
 367    ;;(define-key map [t] 'ignore)
 368    map))
 369
 370 (defun orgpan-occur ()
 371  "Replacement for `org-occur'.
 372 Technical reasons."
 373  (interactive)
 374  (let ((rgx (read-from-minibuffer "my mini Regexp: ")))
 375    (setq orgpan-last-command-was-from-panel t)
 376    (select-window orgpan-org-window)
 377    (org-occur rgx)))
 378
 379 (defvar orgpan-panel-window nil
 380  "The window showing `orgpan-panel-buffer'.")
 381
 382 (defvar orgpan-panel-buffer nil
 383  "The panel buffer.
 384 There can be only one such buffer at any time.")
 385
 386 (defvar orgpan-org-window nil)
 387 ;;(make-variable-buffer-local 'orgpan-org-window)
 388
 389 ;; Fix-me: used?
 390 (defvar orgpan-org-buffer nil)
 391 ;;(make-variable-buffer-local 'orgpan-org-buffer)
 392
 393 (defvar orgpan-last-org-buffer nil)
 394 ;;(make-variable-buffer-local 'orgpan-last-org-buffer)
 395
 396 (defvar orgpan-point nil)
 397 ;;(make-variable-buffer-local 'orgpan-point)
 398
 399 (defvar viper-emacs-state-mode-list)
 400 (defvar viper-new-major-mode-buffer-list)
 401
 402 (defun orgpan-avoid-viper-in-buffer ()
 403  ;; Fix-me: This is ugly. However see `this-major-mode-requires-vi-state':
 404  (set (make-local-variable 'viper-emacs-state-mode-list) '(orgpan-mode))
 405  (set (make-local-variable 'viper-new-major-mode-buffer-list) nil)
 406  (local-set-key [?\ ] 'ignore))
 407
 408 (define-derived-mode orgpan-mode nil "Org-Panel"
 409  "Mode for org-simple.el control panel."
 410  (setq buffer-read-only t)
 411  (unless orgpan-minor-mode-version
 412    (add-hook 'pre-command-hook 'orgpan-mode-pre-command nil t)
 413    (add-hook 'post-command-hook 'orgpan-mode-post-command t))
 414  (orgpan-avoid-viper-in-buffer)
 415  (setq cursor-type nil))
 416
 417
 418 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 419 ;;; Panel layout
 420
 421 (defun orgpan-insert-field (text keymap explain)
 422  (insert text)
 423  (let* ((end (point))
 424         (len (length text))
 425         (beg (- end len))
 426         (ovl (make-overlay beg end)))
 427    (overlay-put ovl 'face orgpan-field-face)
 428    (overlay-put ovl 'keymap keymap)
 429    (overlay-put ovl 'orgpan-explain explain)))
 430
 431 (defconst orgpan-with-keymap
 432  (let ((map (make-sparse-keymap)))
 433    (set-keymap-parent map org-mode-map)
 434    ;; Users are used to tabbing between fields:
 435    (define-key map [(tab)] 'orgpan-forward-field)
 436    (define-key map [(shift tab)] 'orgpan-backward-field)
 437    ;; Now we must use something else for visibility (first does not work if Viper):
 438    (define-key map [(meta tab)] 'org-cycle)
 439    (define-key map [(control meta tab)] 'org-global-cycle)
 440    map))
 441
 442 (defconst orgpan-without-keymap
 443  (let ((map (make-sparse-keymap)))
 444    (set-keymap-parent map org-mode-map)
 445    ;; Visibility (those are in org-mode-map):
 446    ;;(define-key map [tab] 'org-cycle)
 447    ;;(define-key map [(shift tab)] 'org-global-cycle)
 448    ;; Navigate:
 449    (define-key map [left] 'outline-up-heading)
 450    (define-key map [right] 'org-cycle)
 451    (define-key map [up] 'outline-previous-visible-heading)
 452    (define-key map [down] 'outline-next-visible-heading)
 453    (define-key map [(shift down)] 'outline-forward-same-level)
 454    (define-key map [(shift up)] 'outline-backward-same-level)
 455    ;; Restructure:
 456    (define-key map [(control up)] 'org-move-subtree-up)
 457    (define-key map [(control down)] 'org-move-subtree-down)
 458    (define-key map [(control left)] 'org-do-promote)
 459    (define-key map [(control right)] 'org-do-demote)
 460    (define-key map [(control shift left)] 'org-promote-subtree)
 461    (define-key map [(control shift right)] 'org-demote-subtree)
 462    ;; Todo etc
 463    (define-key map [?+] 'org-priority-up)
 464    (define-key map [?-] 'org-priority-down)
 465    (define-key map [?t] 'org-todo)
 466    map))
 467
 468 (defun orgpan-make-panel-without-buttons (buf)
 469  (with-current-buffer buf
 470    (insert (propertize "Org Panel" 'face 'orgpan-active-field))
 471    (insert "  ? for help, q quit\n")
 472    (insert (propertize "arrows" 'face 'font-lock-keyword-face)
 473            ": Go to, "
 474            (propertize "C-arrows" 'face 'font-lock-keyword-face)
 475            ": Edit tree\n"
 476            (propertize "cxpz" 'face 'font-lock-keyword-face)
 477            ": copy cut paste undo, "
 478            (propertize "tT+-" 'face 'font-lock-keyword-face)
 479            ": todo priority, "
 480            (propertize "s" 'face 'font-lock-keyword-face)
 481            " search"
 482            )
 483    (set-keymap-parent orgpan-mode-map orgpan-without-keymap)
 484    ))
 485
 486 (defun orgpan-make-panel-with-buttons (buf)
 487  (with-current-buffer buf
 488    (let* ((base-map (make-sparse-keymap))
 489           (space-line (propertize "\n\n" 'face 'orgpan-spaceline))
 490           (arrow-face 'font-lock-keyword-face)
 491           (L (propertize "left" 'face arrow-face))
 492           (R (propertize "right" 'face arrow-face))
 493           (U (propertize "up" 'face arrow-face))
 494           (D (propertize "down" 'face arrow-face)))
 495      ;;(message D)(sit-for 2)
 496      (define-key base-map [left] 'ignore)
 497      (define-key base-map [right] 'ignore)
 498      (define-key base-map [up] 'ignore)
 499      (define-key base-map [down] 'ignore)
 500      (define-key base-map [?q] 'delete-window)
 501      (define-key base-map [??] 'orgpan-help)
 502      ;; Navigating
 503      (let ((map (copy-keymap base-map)))
 504        (define-key map [left] 'outline-up-heading)
 505        (define-key map [right] 'org-cycle)
 506        (define-key map [up] 'outline-previous-visible-heading)
 507        (define-key map [down] 'outline-next-visible-heading)
 508        (define-key map [(shift down)] 'outline-forward-same-level)
 509        (define-key map [(shift up)] 'outline-backward-same-level)
 510        (orgpan-insert-field "Navigate" map (concat U "/" D ", " L ": Go to, " R ": Visibility")))
 511      (insert "  ")
 512      (let ((map (copy-keymap base-map)))
 513        (define-key map [up] 'org-move-subtree-up)
 514        (define-key map [down] 'org-move-subtree-down)
 515        (define-key map [left] 'org-do-promote)
 516        (define-key map [right] 'org-do-demote)
 517        (define-key map [(shift left)] 'org-promote-subtree)
 518        (define-key map [(shift right)] 'org-demote-subtree)
 519        (orgpan-insert-field
 520         "Restructure" map
 521         (concat U "/" D ": "
 522                 (propertize "Move" 'face 'font-lock-warning-face)
 523                 ", " L "/" R ": "
 524                 (propertize "Level (w S: Subtree Level)" 'face 'font-lock-warning-face))))
 525      (insert "  ")
 526      (let ((map (copy-keymap base-map)))
 527        (define-key map [up] 'org-priority-up)
 528        (define-key map [down] 'org-priority-down)
 529        (define-key map [right] 'org-todo)
 530        (orgpan-insert-field "TODO/priority" map
 531                             (concat R ": TODO, " U "/" D ": Priority")))
 532      )
 533    (insert "   ? for help, q quit\n")
 534    (orgpan-display-bindings-help)
 535    (setq orgpan-ovl-help (make-overlay (point) (point)))
 536    ))
 537
 538 (defun orgpan-make-panel-buffer ()
 539  "Make the panel buffer."
 540  (let* ((buf-name "*Org Panel*"))
 541    (when orgpan-panel-buffer (kill-buffer orgpan-panel-buffer))
 542    (setq orgpan-panel-buffer (get-buffer-create buf-name))
 543    (if orgpan-panel-buttons
 544        (orgpan-make-panel-with-buttons orgpan-panel-buffer)
 545      (orgpan-make-panel-without-buttons orgpan-panel-buffer))
 546    (with-current-buffer orgpan-panel-buffer
 547      (orgpan-mode)
 548      (goto-char (point-min)))
 549    orgpan-panel-buffer))
 550
 551 (defun orgpan-help ()
 552  (interactive)
 553  (set-keymap-parent orgpan-with-keymap nil)
 554  (set-keymap-parent orgpan-without-keymap nil)
 555  (describe-function 'orgpan-panel)
 556  (set-keymap-parent orgpan-with-keymap org-mode-map)
 557  (set-keymap-parent orgpan-without-keymap org-mode-map)
 558  (message "Use 'l' to remove help window")
 559  )
 560
 561 (defun orgpan-panel ()
 562  "Create a control panel for current `org-mode' buffer.
 563 The control panel may be used to quickly move around and change
 564 the headings. The idea is that when you want to to a lot of this
 565 kind of editing you should be able to do that with few
 566 keystrokes (and without having to remember the complicated
 567 keystrokes). A typical situation when this perhaps can be useful
 568 is when you are looking at your notes file \(usually ~/.notes,
 569 see `remember-data-file') where you have saved quick notes with
 570 `remember'.
 571
 572 The keys below are defined in the panel. Note that the commands
 573 are carried out in the `org-mode' buffer that belongs to the
 574 panel.
 575
 576 \\{orgpan-mode-map}
 577
 578 In addition to the keys above most of the keys in `org-mode' can
 579 also be used from the panel.
 580
 581 Note: There are two forms of the control panel, one with buttons
 582 and one without. The default is without, see
 583 `orgpan-panel-buttons'.  If buttons are used choosing a different
 584 button changes the binding of the arrow keys."
 585  (interactive)
 586  (unless (derived-mode-p 'org-mode)
 587    (error "Buffer is not in org-mode"))
 588  (orgpan-delete-panel)
 589  (unless orgpan-org-mode-commands
 590    (map-keymap (lambda (ev def)
 591                  (when (and def
 592                             (symbolp def)
 593                             (fboundp def))
 594                    (setq orgpan-org-mode-commands
 595                          (cons def orgpan-org-mode-commands))))
 596                org-mode-map))
 597  ;;(org-back-to-heading)
 598  ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
 599  (setq orgpan-org-window (selected-window))
 600  (setq orgpan-panel-window (split-window nil -4 'below))
 601  (select-window orgpan-panel-window)
 602  (set-window-buffer (selected-window) (orgpan-make-panel-buffer))
 603  ;;(set-window-dedicated-p (selected-window) t)
 604  ;; The minor mode version starts here:
 605  (when orgpan-minor-mode-version
 606    (select-window orgpan-org-window)
 607    (orgpan-panel-minor-mode 1)
 608    (add-hook 'post-command-hook 'orgpan-minor-post-command t)))
 609
 610 (defun orgpan-minor-post-command ()
 611  (unless (and
 612           ;; Check org window and buffer
 613           (windowp orgpan-org-window)
 614           (window-live-p orgpan-org-window)
 615           (eq orgpan-org-window (selected-window))
 616           (derived-mode-p 'org-mode)
 617           ;; Check panel window and buffer
 618           (windowp orgpan-panel-window)
 619           (window-live-p orgpan-panel-window)
 620           (bufferp orgpan-panel-buffer)
 621           (buffer-live-p orgpan-panel-buffer)
 622           (eq (window-buffer orgpan-panel-window) orgpan-panel-buffer)
 623           ;; Check minor mode
 624           orgpan-panel-minor-mode)
 625    (orgpan-delete-panel)))
 626
 627 (define-minor-mode orgpan-panel-minor-mode
 628  "Minor mode used in `org-mode' buffer when showing panel."
 629  :keymap orgpan-mode-map
 630  :lighter " PANEL"
 631  :group 'orgpan
 632  )
 633
 634
 635 (provide 'org-panel)
 636 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 637
 638 ;;; org-panel.el ends here