Browse Source

Merge branch 'master-fixes'

Bastien Guerry 12 years ago
parent
commit
e815ab5f8e
7 changed files with 178 additions and 114 deletions
  1. 80 58
      contrib/lisp/org-contacts.el
  2. 8 9
      contrib/lisp/org-panel.el
  3. 1 0
      doc/org.texi
  4. 1 1
      lisp/org-mobile.el
  5. 1 1
      lisp/org-pcomplete.el
  6. 13 0
      lisp/org-w3m.el
  7. 74 45
      lisp/org.el

+ 80 - 58
contrib/lisp/org-contacts.el

@@ -45,12 +45,12 @@
 (require 'org-agenda)
 
 (defgroup org-contacts nil
-  "Options concerning contacts management."
+  "Options about contacts management."
   :group 'org)
 
 (defcustom org-contacts-files nil
   "List of Org files to use as contacts source.
-If set to nil, all your Org files will be used."
+When set to nil, all your Org files will be used."
   :type '(repeat file)
   :group 'org-contacts)
 
@@ -70,7 +70,8 @@ If set to nil, all your Org files will be used."
   :group 'org-contacts)
 
 (defcustom org-contacts-birthday-format "Birthday: %l (%Y)"
-  "Format of the anniversary agenda entry. The following replacements are available:
+  "Format of the anniversary agenda entry.
+The following replacements are available:
 
   %h - Heading name
   %l - Link to the heading
@@ -146,17 +147,17 @@ This overrides `org-email-link-description-format' if set."
   "Search for a contact maching NAME-MATCH and TAGS-MATCH.
 If both match values are nil, return all contacts."
   (let* (todo-only
-	(tags-matcher
-         (if tags-match
-             (cdr (org-make-tags-matcher tags-match))
-           t))
-        (name-matcher
-         (if name-match
-             '(org-string-match-p name-match (org-get-heading t))
-           t))
-        (contacts-matcher
-         (cdr (org-make-tags-matcher org-contacts-matcher)))
-        markers result)
+	 (tags-matcher
+	  (if tags-match
+	      (cdr (org-make-tags-matcher tags-match))
+	    t))
+	 (name-matcher
+	  (if name-match
+	      '(org-string-match-p name-match (org-get-heading t))
+	    t))
+	 (contacts-matcher
+	  (cdr (org-make-tags-matcher org-contacts-matcher)))
+	 markers result)
     (dolist (file (org-contacts-files))
       (org-check-agenda-file file)
       (with-current-buffer (org-get-agenda-file-buffer file)
@@ -188,10 +189,12 @@ If both match values are nil, return all contacts."
                       (point))))
          (orig (buffer-substring start end))
          (completion-ignore-case org-contacts-completion-ignore-case)
-         (group-completion-p (org-string-match-p (concat "^" org-contacts-group-prefix) orig))
+         (group-completion-p (org-string-match-p
+			      (concat "^" org-contacts-group-prefix) orig))
          (completion-list
           (if group-completion-p
-              (mapcar (lambda (group) (propertize (concat org-contacts-group-prefix group) 'org-contacts-group group))
+              (mapcar (lambda (group) (propertize (concat org-contacts-group-prefix group)
+						  'org-contacts-group group))
                       (org-uniquify
                        (loop for contact in (org-contacts-filter)
                              with group-list
@@ -203,8 +206,8 @@ If both match values are nil, return all contacts."
                   for contact-name = (car contact)
                   ;; Build the list of the user email addresses.
                   for email-list = (split-string (or
-                                                  (cdr (assoc-string org-contacts-email-property (caddr contact)))
-                                                  ""))
+                                                  (cdr (assoc-string org-contacts-email-property
+								     (caddr contact))) ""))
                   ;; If the user has email addresses…
                   if email-list
                   ;; … append a list of USER <EMAIL>.
@@ -216,29 +219,35 @@ If both match values are nil, return all contacts."
     (when (and group-completion-p
                (= (length completion-list) 1))
       (setq completion-list
-            (list (concat (car completion-list) ";: "
-                          (mapconcat 'identity
-                                     (loop for contact in (org-contacts-filter
-                                                           nil
-                                                           (get-text-property 0 'org-contacts-group (car completion-list)))
-                                           ;; The contact name is always the car of the assoc-list
-                                           ;; returned by `org-contacts-filter'.
-                                           for contact-name = (car contact)
-                                           ;; Grab the first email of the contact
-                                           for email = (car (split-string (or
-                                                                           (cdr (assoc-string org-contacts-email-property (caddr contact)))
-                                                                           "")))
-                                           ;; If the user has an email address, append USER <EMAIL>.
-                                           if email collect (org-contacts-format-email contact-name email))
-                                     ", ")))))
-    (list start end (completion-table-case-fold completion-list (not org-contacts-completion-ignore-case)))))
+            (list (concat
+		   (car completion-list) ";: "
+		   (mapconcat 'identity
+			      (loop for contact in (org-contacts-filter
+						    nil
+						    (get-text-property 0 'org-contacts-group
+								       (car completion-list)))
+				    ;; The contact name is always the car of the assoc-list
+				    ;; returned by `org-contacts-filter'.
+				    for contact-name = (car contact)
+				    ;; Grab the first email of the contact
+				    for email = (car (split-string
+						      (or
+						       (cdr (assoc-string org-contacts-email-property
+									  (caddr contact)))
+						       "")))
+				    ;; If the user has an email address, append USER <EMAIL>.
+				    if email collect (org-contacts-format-email contact-name email))
+			      ", ")))))
+    (list start end
+	  (completion-table-case-fold completion-list
+				      (not org-contacts-completion-ignore-case)))))
 
 (defun org-contacts-message-complete-function ()
   "Function used in `completion-at-point-functions' in `message-mode'."
   (let ((mail-abbrev-mode-regexp
          "^\\(Resent-To\\|To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\|Disposition-Notification-To\\|Return-Receipt-To\\):"))
-        (when (mail-abbrev-in-expansion-header-p)
-          (org-contacts-complete-name))))
+    (when (mail-abbrev-in-expansion-header-p)
+      (org-contacts-complete-name))))
 
 (defun org-contacts-gnus-get-name-email ()
   "Get name and email address from Gnus message."
@@ -433,12 +442,12 @@ Depends on Wanderlust been loaded."
                                           (wl-summary-message-number)
                                           'from)))
      ((eq major-mode 'mime-view-mode) (std11-narrow-to-header)
-                                      (prog1
-                                          (std11-fetch-field "From")
-                                        (widen))))))
+      (prog1
+	  (std11-fetch-field "From")
+	(widen))))))
 
 (defun org-contacts-wl-get-name-email ()
-  "Get name and email address from wanderlust email.
+  "Get name and email address from Wanderlust email.
 See `org-contacts-wl-get-from-header-content' for limitations."
   (let ((from (org-contacts-wl-get-from-header-content)))
     (when from
@@ -447,13 +456,14 @@ See `org-contacts-wl-get-from-header-content' for limitations."
 
 (defun org-contacts-template-wl-name (&optional return-value)
   "Try to return the contact name for a template from wl.
-If not found return RETURN-VALUE or something that would ask the user."
+If not found, return RETURN-VALUE or something that would ask the
+user."
   (or (car (org-contacts-wl-get-name-email))
       return-value
       "%^{Name}"))
 
 (defun org-contacts-template-wl-email (&optional return-value)
-  "Try to return the contact email for a template from wl.
+  "Try to return the contact email for a template from Wanderlust.
 If not found return RETURN-VALUE or something that would ask the user."
   (or (cadr (org-contacts-wl-get-name-email))
       return-value
@@ -461,7 +471,8 @@ If not found return RETURN-VALUE or something that would ask the user."
 
 (defun org-contacts-view-send-email (&optional ask)
   "Send email to the contact at point.
-If ASK is set, ask for the email address even if there's only one address."
+If ASK is set, ask for the email address even if there's only one
+address."
   (interactive "P")
   (let ((marker (org-get-at-bol 'org-hd-marker)))
     (org-with-point-at marker
@@ -547,14 +558,22 @@ If ASK is set, ask for the email address even if there's only one address."
              `(,org-contacts-nickname-property . org-contacts-completing-read-nickname))
 
 (defun org-contacts-vcard-escape (str)
-  "Escape ; , and \n in STR for use in the VCard format.
-Thanks to http://www.emacswiki.org/cgi-bin/wiki/bbdb-vcard-export.el for the regexp."
+  "Escape ; , and \n in STR for the VCard format."
+  ;; Thanks to this library for the regexp:
+  ;; http://www.emacswiki.org/cgi-bin/wiki/bbdb-vcard-export.el
   (when str
-    (replace-regexp-in-string "\n" "\\\\n" (replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str))))
+    (replace-regexp-in-string
+     "\n" "\\\\n"
+     (replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str))))
 
 (defun org-contacts-vcard-encode-name (name)
-  "Try to encode NAME as VCard's N property. The N property expects FamilyName;GivenName;AdditionalNames;Prefix;Postfix.
-Org-contacts does not specify how to encode the name. So we try to do our best."
+  "Try to encode NAME as VCard's N property.
+The N property expects
+
+  FamilyName;GivenName;AdditionalNames;Prefix;Postfix.
+
+Org-contacts does not specify how to encode the name.  So we try
+to do our best."
   (concat (replace-regexp-in-string "\\(\\w+\\) \\(.*\\)" "\\2;\\1" name) ";;;"))
 
 (defun org-contacts-vcard-format (contact)
@@ -566,7 +585,6 @@ Org-contacts does not specify how to encode the name. So we try to do our best."
 	 (bday (org-contacts-vcard-escape (cdr (assoc-string org-contacts-birthday-property properties))))
 	 (addr (cdr (assoc-string org-contacts-address-property properties)))
 	 (nick (org-contacts-vcard-escape (cdr (assoc-string org-contacts-nickname-property properties))))
-
 	 (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name)))
     (concat head
 	    (when email (format "EMAIL:%s\n" email))
@@ -582,12 +600,15 @@ Org-contacts does not specify how to encode the name. So we try to do our best."
 	    "END:VCARD\n\n")))
 
 (defun org-contacts-export-as-vcard (&optional name file to-buffer)
-  "Export all contacts matching NAME as VCard 3.0. It TO-BUFFER is nil, the content is written to FILE or `org-contacts-vcard-file'. If TO-BUFFER is non-nil, the buffer is created and the VCard is written into that buffer."
+  "Export all contacts matching NAME as VCard 3.0.
+If TO-BUFFER is nil, the content is written to FILE or
+`org-contacts-vcard-file'.  If TO-BUFFER is non-nil, the buffer
+is created and the VCard is written into that buffer."
   (interactive) ; TODO ask for name?
   (let* ((filename (or file org-contacts-vcard-file))
 	 (buffer (if to-buffer
 		     (get-buffer-create to-buffer)
-		     (find-file-noselect filename))))
+		   (find-file-noselect filename))))
 
     (message "Exporting...")
 
@@ -600,23 +621,24 @@ Org-contacts does not specify how to encode the name. So we try to do our best."
       (set-buffer-file-coding-system coding-system-for-write))
 
     (loop for contact in (org-contacts-filter name)
-	 do (insert (org-contacts-vcard-format contact)))
+	  do (insert (org-contacts-vcard-format contact)))
 
     (if to-buffer
 	(current-buffer)
-	(progn (save-buffer) (kill-buffer)))))
+      (progn (save-buffer) (kill-buffer)))))
 
 (defun org-contacts-show-map (&optional name)
-  "Show contacts on a map. Requires google-maps-el."
+  "Show contacts on a map.
+Requires google-maps-el."
   (interactive)
   (unless (fboundp 'google-maps-static-show)
     (error "`org-contacts-show-map' requires `google-maps-el'"))
   (google-maps-static-show
    :markers
    (loop
-      for contact in (org-contacts-filter name)
-      for addr = (cdr (assoc-string org-contacts-address-property (caddr contact)))
-      if addr
-      collect (cons (list addr) (list :label (string-to-char (car contact)))))))
+    for contact in (org-contacts-filter name)
+    for addr = (cdr (assoc-string org-contacts-address-property (caddr contact)))
+    if addr
+    collect (cons (list addr) (list :label (string-to-char (car contact)))))))
 
 (provide 'org-contacts)

+ 8 - 9
contrib/lisp/org-panel.el

@@ -133,8 +133,6 @@ active.)"
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Hook functions etc
 
-;;(defvar orgpan-this-panel-window nil)
-
 (defun orgpan-delete-panel ()
  "Remove the panel."
  (interactive)
@@ -203,8 +201,7 @@ active.)"
              (unless (and orgpan-point
                           (= (point) orgpan-point))
                ;; Go backward so it is possible to click on a "button":
-               (orgpan-backward-field)))))
-       (setq orgpan-this-panel-window nil))
+               (orgpan-backward-field))))))
    (error (lwarn 't :warning "orgpan-post: %S" err))))
 
 ;; (defun orgpan-window-config-change ()
@@ -294,7 +291,7 @@ active.)"
 
 (defun orgpan-check-panel-mode ()
  (unless (derived-mode-p 'orgpan-mode)
-   (error "Not orgpan-mode in buffer: " major-mode)))
+   (error "Not orgpan-mode in buffer: %s" major-mode)))
 
 (defun orgpan-display-bindings-help ()
  (orgpan-check-panel-mode)
@@ -401,6 +398,9 @@ There can be only one such buffer at any time.")
 (defvar orgpan-point nil)
 ;;(make-variable-buffer-local 'orgpan-point)
 
+(defvar viper-emacs-state-mode-list)
+(defvar viper-new-major-mode-buffer-list)
+
 (defun orgpan-avoid-viper-in-buffer ()
  ;; Fix-me: This is ugly. However see `this-major-mode-requires-vi-state':
  (set (make-local-variable 'viper-emacs-state-mode-list) '(orgpan-mode))
@@ -598,12 +598,11 @@ button changes the binding of the arrow keys."
                org-mode-map))
  ;;(org-back-to-heading)
  ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
- (split-window)
+ (setq orgpan-org-window (selected-window))
+ (setq orgpan-panel-window (split-window nil -4 'below))
+ (select-window orgpan-panel-window)
  (set-window-buffer (selected-window) (orgpan-make-panel-buffer))
- (setq orgpan-panel-window (selected-window))
  ;;(set-window-dedicated-p (selected-window) t)
- (fit-window-to-buffer nil nil 3)
- (setq orgpan-org-window (next-window))
  ;; The minor mode version starts here:
  (when orgpan-minor-mode-version
    (select-window orgpan-org-window)

+ 1 - 0
doc/org.texi

@@ -9472,6 +9472,7 @@ include your @file{.emacs} file, you could use:
 @example
 #+INCLUDE: "~/.emacs" src emacs-lisp
 @end example
+
 @noindent
 The optional second and third parameter are the markup (e.g., @samp{quote},
 @samp{example}, or @samp{src}), and, if the markup is @samp{src}, the

+ 1 - 1
lisp/org-mobile.el

@@ -276,7 +276,7 @@ Also exclude files matching `org-mobile-files-exclude-regexp'."
 		      (list f))
 		     (t nil)))
 		  org-mobile-files)))
-	 (files (delete
+	 (files (delq
 		 nil
 		 (mapcar (lambda (f)
 			   (unless (and (not (string= org-mobile-files-exclude-regexp ""))

+ 1 - 1
lisp/org-pcomplete.el

@@ -290,7 +290,7 @@ This needs more work, to handle headings with lots of spaces in them."
 	(cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers)))
     (pcomplete-here cpllist
 		    (substring pcomplete-stub 1)
-		    (unless (or (not (delete
+		    (unless (or (not (delq
 				      nil
 				      (mapcar (lambda(x)
 						(string-match (substring pcomplete-stub 1) x))

+ 13 - 0
lisp/org-w3m.el

@@ -43,6 +43,19 @@
 
 (require 'org)
 
+(defvar w3m-current-url)
+(defvar w3m-current-title)
+
+(add-hook 'org-store-link-functions 'org-w3m-store-link)
+(defun org-w3m-store-link ()
+  "Store a link to a w3m buffer."
+  (when (eq major-mode 'w3m-mode)
+    (org-store-link-props
+     :type "w3m"
+     :link w3m-current-url
+     :url (url-view-url t)
+     :description (or w3m-current-title w3m-current-url))))
+
 (defun org-w3m-copy-for-org-mode ()
   "Copy current buffer content or active region with `org-mode' style links.
 This will encode `link-title' and `link-location' with

+ 74 - 45
lisp/org.el

@@ -3882,6 +3882,13 @@ Use customize to modify this, or restart Emacs after changing it."
 	   (string :tag "HTML end tag")
 	   (option (const verbatim)))))
 
+(defvar org-syntax-table
+  (let ((st (make-syntax-table)))
+    (mapc (lambda(c) (modify-syntax-entry
+		      (string-to-char (car c)) "w p" st))
+	  org-emphasis-alist)
+    st))
+
 (defvar org-protecting-blocks
   '("src" "example" "latex" "ascii" "html" "docbook" "ditaa" "dot" "r" "R")
   "Blocks that contain text that is quoted, i.e. not processed as Org syntax.
@@ -3975,9 +3982,6 @@ Normal means, no org-mode-specific context."
 (declare-function speedbar-line-directory "speedbar" (&optional depth))
 (declare-function table--at-cell-p "table" (position &optional object at-column))
 
-(defvar w3m-current-url)
-(defvar w3m-current-title)
-
 (defvar org-latex-regexps)
 
 ;;; Autoload and prepare some org modules
@@ -6230,7 +6234,8 @@ in special contexts.
 	      (and org-cycle-level-after-item/entry-creation
 		   (or (org-cycle-level)
 		       (org-cycle-item-indentation))))
-    (let* ((limit-level
+    (let* (message-log-max ; Don't populate the *Messages* buffer
+	   (limit-level
 	    (or org-cycle-max-level
 		(and (boundp 'org-inlinetask-min-level)
 		     org-inlinetask-min-level
@@ -6345,7 +6350,8 @@ in special contexts.
 (defun org-cycle-internal-global ()
   "Do the global cycling action."
   ;; Hack to avoid display of messages for .org  attachments in Gnus
-  (let ((ga (string-match "\\*fontification" (buffer-name))))
+  (let (message-log-max ; Don't populate the *Messages* buffer
+	(ga (string-match "\\*fontification" (buffer-name))))
     (cond
      ((and (eq last-command this-command)
 	   (eq org-cycle-global-status 'overview))
@@ -6377,7 +6383,8 @@ in special contexts.
 
 (defun org-cycle-internal-local ()
   "Do the local cycling action."
-  (let ((goal-column 0) eoh eol eos has-children children-skipped struct)
+  (let (message-log-max ; Don't populate the *Messages* buffer
+	(goal-column 0) eoh eol eos has-children children-skipped struct)
     ;; First, determine end of headline (EOH), end of subtree or item
     ;; (EOS), and if item or heading has children (HAS-CHILDREN).
     (save-excursion
@@ -7189,6 +7196,9 @@ current headline.  If point is not at the beginning, split the line,
 create the new headline with the text in the current line after point
 \(but see also the variable `org-M-RET-may-split-line').
 
+With a double prefix arg, force the heading to be inserted at the
+end of the parent subtree.
+
 When INVISIBLE-OK is set, stop at invisible headlines when going back.
 This is important for non-interactive uses of the command."
   (interactive "P")
@@ -7256,7 +7266,10 @@ This is important for non-interactive uses of the command."
 		tags pos)
 	    (cond
 	     (org-insert-heading-respect-content
-	      (org-end-of-subtree nil t)
+	      (if (not (equal force-heading '(16)))
+		  (org-end-of-subtree nil t)
+		(org-up-heading-safe)
+		(org-end-of-subtree nil t))
 	      (when (featurep 'org-inlinetask)
 		(while (and (not (eobp))
 			    (looking-at "\\(\\*+\\)[ \t]+")
@@ -7368,10 +7381,12 @@ This is a list with the following elements:
 (defun org-insert-todo-heading (arg &optional force-heading)
   "Insert a new heading with the same level and TODO state as current heading.
 If the heading has no TODO state, or if the state is DONE, use the first
-state (TODO by default).  Also with prefix arg, force first state."
+state (TODO by default).  Also one prefix arg, force first state.  With two
+prefix args, force inserting at the end of the parent subtree."
   (interactive "P")
   (when (or force-heading (not (org-insert-item 'checkbox)))
-    (org-insert-heading force-heading)
+    (org-insert-heading (or (and (equal arg '(16)) '(16))
+			    force-heading))
     (save-excursion
       (org-back-to-heading)
       (outline-previous-heading)
@@ -8870,20 +8885,31 @@ type.  For a simple example of an export function, see `org-bbdb.el'."
 This link is added to `org-stored-links' and can later be inserted
 into an org-buffer with \\[org-insert-link].
 
-For some link types, a prefix arg is interpreted:
-For links to usenet articles, arg negates `org-gnus-prefer-web-links'.
-For file links, arg negates `org-context-in-file-links'."
+For some link types, a prefix arg is interpreted.
+For links to Usenet articles, arg negates `org-gnus-prefer-web-links'.
+For file links, arg negates `org-context-in-file-links'.
+
+A double prefix arg force skipping storing functions that are not
+part of Org's core."
   (interactive "P")
   (org-load-modules-maybe)
   (setq org-store-link-plist nil)  ; reset
   (org-with-limited-levels
-   (let (link cpltxt desc description search txt custom-id agenda-link)
+   (let (link cpltxt desc description search txt custom-id agenda-link sfuns sfunsn)
      (cond
-
-      ((run-hook-with-args-until-success 'org-store-link-functions)
-       (setq link (plist-get org-store-link-plist :link)
-	     desc (or (plist-get org-store-link-plist :description) link)))
-
+      ((and (not (equal arg '(16)))
+	    (setq sfuns
+		  (delq
+		   nil (mapcar (lambda (f) (let (fs) (if (funcall f) (push f fs))))
+			       org-store-link-functions))
+		  sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns))
+	    (or (and (cdr sfuns)
+		     (funcall (intern
+			       (completing-read "Which function for creating the link? "
+						sfunsn t (car sfunsn)))))
+		(funcall (caar sfuns)))
+	    (setq link (plist-get org-store-link-plist :link)
+		  desc (or (plist-get org-store-link-plist :description) link))))
       ((org-src-edit-buffer-p)
        (let (label gc)
 	 (while (or (not label)
@@ -8939,11 +8965,6 @@ For file links, arg negates `org-context-in-file-links'."
 	     link (url-view-url t))
        (org-store-link-props :type "w3" :url (url-view-url t)))
 
-      ((eq major-mode 'w3m-mode)
-       (setq cpltxt (or w3m-current-title w3m-current-url)
-	     link w3m-current-url)
-       (org-store-link-props :type "w3m" :url (url-view-url t)))
-
       ((setq search (run-hook-with-args-until-success
 		     'org-create-file-search-functions))
        (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
@@ -9001,10 +9022,13 @@ For file links, arg negates `org-context-in-file-links'."
 			       (buffer-file-name (buffer-base-buffer)))))
 	 ;; Add a context search string
 	 (when (org-xor org-context-in-file-links arg)
-	   (setq txt (cond
+	   (let ((e (org-element-at-point)))
+	     (setq txt (cond
 		      ((org-at-heading-p) nil)
+		      ((eq (org-element-type e) 'keyword)
+		       (plist-get (cadr e) :value))
 		      ((org-region-active-p)
-		       (buffer-substring (region-beginning) (region-end)))))
+		       (buffer-substring (region-beginning) (region-end))))))
 	   (when (or (null txt) (string-match "\\S-" txt))
 	     (setq cpltxt
 		   (concat cpltxt "::"
@@ -9035,14 +9059,19 @@ For file links, arg negates `org-context-in-file-links'."
        (setq link cpltxt))
 
       ((org-called-interactively-p 'interactive)
-       (error "Cannot link to a buffer which is not visiting a file"))
+       (user-error "No method for storing a link from this buffer"))
 
       (t (setq link nil)))
 
      (if (consp link) (setq cpltxt (car link) link (cdr link)))
      (setq link (or link cpltxt)
 	   desc (or desc cpltxt))
-     (if (equal desc "NONE") (setq desc nil))
+     (cond ((equal desc "NONE") (setq desc nil))
+	   ((string-match org-bracket-link-regexp desc)
+	    (setq desc (replace-regexp-in-string
+			org-bracket-link-regexp
+			(concat "\\3" (if (equal (length (match-string 0 desc))
+						 (length desc)) "*" "")) desc))))
 
      (if (and (or (org-called-interactively-p 'any) executing-kbd-macro) link)
 	 (progn
@@ -9111,23 +9140,15 @@ according to FMT (default from `org-email-link-description-format')."
 	(setq fmt (replace-match "from %f" t t fmt))))
     (org-replace-escapes fmt table)))
 
-(defun org-make-org-heading-search-string (&optional string heading)
-  "Make search string for STRING or current headline."
-  (interactive)
-  (let ((s (or string (org-get-heading)))
+(defun org-make-org-heading-search-string (&optional string)
+  "Make search string for the current headline or STRING."
+  (let ((s (or string
+	       (and (derived-mode-p 'org-mode)
+		    (save-excursion
+		      (org-back-to-heading t)
+		      (plist-get (cadr (org-element-at-point))
+				 :raw-value)))))
 	(lines org-context-in-file-links))
-    (unless (and string (not heading))
-      ;; We are using a headline, clean up garbage in there.
-      (if (string-match org-todo-regexp s)
-	  (setq s (replace-match "" t t s)))
-      (if (string-match (org-re ":[[:alnum:]_@#%:]+:[ \t]*$") s)
-	  (setq s (replace-match "" t t s)))
-      (setq s (org-trim s))
-      (if (string-match (concat "^\\(" org-quote-string "\\|"
-				org-comment-string "\\)") s)
-	  (setq s (replace-match "" t t s)))
-      (while (string-match org-ts-regexp s)
-	(setq s (replace-match "" t t s))))
     (or string (setq s (concat "*" s)))  ; Add * for headlines
     (when (and string (integerp lines) (> lines 0))
       (let ((slines (org-split-string s "\n")))
@@ -10893,8 +10914,9 @@ SEPARATOR is passed through to `org-format-outline-path'.  It separates
 the different parts of the path and defaults to \"/\".
 If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
   (interactive "P")
-  (let* ((bfn (buffer-file-name (buffer-base-buffer)))
-	 (case-fold-search nil)
+  (let* (case-fold-search
+	 message-log-max ; Don't populate the *Messages* buffer
+	 (bfn (buffer-file-name (buffer-base-buffer)))
 	 (path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
 	 res)
     (if current (setq path (append path
@@ -18271,6 +18293,7 @@ BEG and END default to the buffer boundaries."
     (org-defkey narrow-map "e" 'org-narrow-to-element)
   (org-defkey org-mode-map "\C-xne" 'org-narrow-to-element))
 (org-defkey org-mode-map "\C-\M-t"  'org-transpose-element)
+(org-defkey org-mode-map "\M-t"  'org-transpose-words)
 (org-defkey org-mode-map "\M-}"     'org-forward-element)
 (org-defkey org-mode-map "\M-{"     'org-backward-element)
 (org-defkey org-mode-map "\C-c\C-^" 'org-up-element)
@@ -22497,6 +22520,12 @@ ones already marked."
        (org-element-property :begin elem)
        (org-element-property :end elem))))))
 
+(defun org-transpose-words ()
+  "Transpose words, using `org-mode' syntax table."
+  (interactive)
+  (with-syntax-table org-syntax-table
+    (call-interactively 'transpose-words)))
+
 (defun org-transpose-element ()
   "Transpose current and previous elements, keeping blank lines between.
 Point is moved after both elements."